Program binary_tree_procedures;

uses crt;

type
  pointer = ^node;
  node = record
    val:integer;
    left:pointer;
    right:pointer;
  end;

  procedure write_tree(tree:pointer);
  begin
    if tree = nil then write('nil')
    else begin
      write(tree^.val);
      write('(');
      write_tree(tree^.left);
      write('-');
      write_tree(tree^.right);
      write(')');
    end;
  end;

  procedure preorder(tree:pointer);
  begin
    if tree <> nil then
    begin
      writeln(tree^.val);
      preorder(tree^.left);
      preorder(tree^.right);
    end;
  end;

  procedure inorder(tree:pointer);
  begin
    if tree<> nil then
    begin
      inorder(tree^.left);
      writeln(tree^.val);
      inorder(tree^.right);
    end;
  end;

  procedure postorder(tree:pointer);
  begin
    if tree<> nil then
    begin
      postorder(tree^.left);
      postorder(tree^.right);
      writeln(tree^.val);
    end;
  end;

  function sizeof_tree(tree:pointer):integer;
  begin
    if tree=nil then sizeof_tree := 0
    else sizeof_tree := 1+sizeof_tree(tree^.left)+sizeof_tree(tree^.right);
  end;

  function leaves(tree:pointer):integer;
  begin
    if tree=nil then leaves := 0
    else begin
      if (tree^.left=nil) and (tree^.right=nil) then leaves := 1
      else leaves := leaves(tree^.left)+leaves(tree^.right);
    end;
  end;

  function sumof_tree(tree:pointer):integer;
  begin
    if tree=nil then sumof_tree := 0
    else sumof_tree := tree^.val+sumof_tree(tree^.left)+sumof_tree(tree^.right);
  end;

  function height_tree(tree:pointer):integer;
  var
    lt,rt:integer;
  begin
    if tree=nil then height_tree := 0
    else begin
      lt := height_tree(tree^.left);
      rt := height_tree(tree^.right);
      if lt>rt then height_tree := 1 + lt
      else height_tree := 1 + rt;
    end;
  end;

  function width_tree(tree:pointer;dir:integer):integer;
  begin
    if tree=nil then width_tree := 0
    else if dir=0 then
      width_tree := 1 + width_tree(tree^.left,-1)+width_tree(tree^.right,1)
    else if dir=-1 then
      width_tree := 1 + width_tree(tree^.left,-1)
    else if dir=1 then
      width_tree := 1 + width_tree(tree^.right,1);
  end;

  procedure kil_tree(tree:pointer);
  begin
    if tree <> nil then
    begin
      kil_tree(tree^.left);
      kil_tree(tree^.right);
      dispose(tree);
    end;
  end;

  function search(tree:pointer;s:integer):boolean;
  begin
    if tree=nil then search := false
    else if tree^.val=s then search := true
    else search := (search(tree^.left,s)) or (search(tree^.right,s));
  end;

  function left_sons(tree:pointer;dir:integer):integer;
  begin
    if tree=nil then left_sons := 0
    else if dir=0 then
      left_sons := left_sons(tree^.left,-1)
    else if dir=-1 then
      left_sons := 1 + left_sons(tree^.left,-1);
  end;

  procedure mirror(var tree:pointer);
  var
    temp:pointer;
  begin
    if tree <> nil then
    begin
      mirror(tree^.left);
      mirror(tree^.right);
      temp := tree^.right;
      tree^.right := tree^.left;
      tree^.left := temp;
    end;
  end;

  procedure add_node_end(var tree,nod:pointer);
  begin
    if tree=nil then tree := nod
    else begin
      if tree^.val>nod^.val then add_node_end(tree^.left,nod)
      else if tree^.val<nod^.val then add_node_end(tree^.right,nod);
    end;
  end;

  procedure make_tree(var tree:pointer);
  var
    temp:pointer;
    v:integer;
  begin
    write('Enter first:');
    readln(v);
    new(tree);
    tree^.val := v;
    tree^.left := nil;
    tree^.right := nil;
    while v<>-1 do
    begin
      write('Enter next(-1 to stop):');
      readln(v);
      if v<>-1 then
      begin
        new(temp);
        temp^.val := v;
        temp^.left := nil;
        temp^.right := nil;
        add_node_end(tree,temp);
      end;
    end;
  end;

  procedure kil_node(var tree:pointer;k:integer);
  var
    temp:pointer;
  begin
    if tree <> nil then
    begin
      if k=tree^.val then
      begin
        if tree^.left = nil then
        begin
          temp := tree;
          tree := tree^.right;
          dispose(temp);
        end else if tree^.right=nil then
        begin
          temp := tree;
          tree := tree^.left;
          dispose(temp)
        end else begin
          temp := tree^.right;
          while temp^.left <> nil do temp := temp^.left;
          tree^.val := temp^.val;
          kil_node(tree^.right,tree^.val);
        end;
      end else if k<tree^.val then kil_node(tree^.left,k)
      else kil_node(tree^.right,k);
    end;
  end;

  function path(tree:pointer;find:integer;show:boolean):integer;
  var
    lt,rt:integer;
  begin
    if tree=nil then
    begin
      if find=0 then path:=0
        else path := -1;
    end else begin
      if tree^.val>find then path:=-1
      else begin
        lt := path(tree^.left,find-tree^.val,false);
        rt := path(tree^.right,find-tree^.val,false);
        if (lt=0) or (rt=0) then
        begin
          if show=true then writeln('found path');
          path := 0;
        end;
      end;
    end;
  end;

  procedure main;
  var
    tree:pointer;
    n:integer;
  begin
    make_tree(tree);
    writeln('preorder');
    preorder(tree);
    writeln;
    readln;
    writeln('inorder');
    inorder(tree);
    writeln;
    readln;
    writeln('postorder');
    postorder(tree);
    writeln;
    readln;
    writeln('There are ',sizeof_tree(tree),' nodes.');
    readln;
    writeln('There are ',leaves(tree),' leaves.');
    readln;
    writeln('The sum is:',sumof_tree(tree));
    readln;
    writeln('The height is:',height_tree(tree));
    readln;
    writeln('The width is:',width_tree(tree,0));
    readln;
    writeln('There are ',left_sons(tree,0),' left sons.');
    readln;
    writeln;
    write('Enter node to delete:');
    readln(n);
    kil_node(tree,n);
    writeln;
    write('Enter node to search for:');
    readln(n);
    if search(tree,n) then writeln('found') else writeln('not found');
    writeln;
    write('Enter path to find:');
    readln(n);
    n:=path(tree,n,true);
    readln;
    writeln('Current tree:');
    write_tree(tree);
    writeln;
    writeln('Mirror tree:');
    mirror(tree);
    write_tree(tree);
    writeln;
    writeln('I''m killing the tree, realy!');
    kil_tree(tree);
  end;

begin
  clrscr;
  main;
  repeat until keypressed;
end.
