fork download
copy 
  1. program ideone;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   Classes;
  7.  
  8. type
  9.   TElem=integer;
  10.   PNode=^TNode;
  11.   TNode=record
  12.     data:TElem;
  13.     prev,next:PNode;
  14.   end;
  15.   TList=record
  16.     head,tail:PNode;
  17.   end;
  18.   PBranch=^TBranch;
  19.   TBranch=record
  20.     data:TElem;
  21.     lf,rt,up:PBranch;
  22.   end;
  23.   TTree=record
  24.     root:PBranch;
  25.   end;
  26.  
  27. procedure appendList(var list:TList;data:TElem);
  28. var curr:PNode;
  29. begin
  30.   New(curr);
  31.   curr^.data:=data;
  32.   curr^.prev:=list.tail;
  33.   curr^.next:=nil;
  34.   if list.tail<>nil then list.tail^.next:=curr
  35.   else list.head:=curr;
  36.   list.tail:=curr;
  37. end;
  38.  
  39. procedure ShowForward(list:TList);
  40. var curr:PNode;
  41. begin
  42.   curr:=list.head;
  43.   while curr<>nil do
  44.   begin
  45.     Write(curr^.data,' ');
  46.     curr:=curr^.next;
  47.   end;
  48.   WriteLn;
  49. end;
  50.  
  51. procedure ShowBackward(list:TList);
  52. var curr:PNode;
  53. begin
  54.   curr:=list.tail;
  55.   while curr<>nil do
  56.   begin
  57.     Write(curr^.data,' ');
  58.     curr:=curr^.prev;
  59.   end;
  60.   WriteLn;
  61. end;
  62.  
  63. procedure _appendTree(data:TElem;var branch:PBranch;up:PBranch=nil);
  64. begin
  65.   if branch=nil then
  66.   begin
  67.     New(branch);
  68.     branch^.data:=data;
  69.     branch^.lf:=nil;
  70.     branch^.rt:=nil;
  71.     branch^.up:=up;
  72.   end
  73.   else if branch^.data>data then _appendTree(data,branch^.lf,branch)
  74.   else if branch^.data<data then _appendTree(data,branch^.rt,branch)
  75.   else ;
  76. end;
  77.  
  78. procedure appendTree(var tree:TTree;data:TElem);
  79. begin
  80.   _appendTree(data,tree.root);
  81. end;
  82.  
  83. function makeTestTree:TTree;
  84. var x:TElem;
  85. const data:array[0..10]of TElem=(6,2,9,1,4,7,11,3,5,8,10);
  86. begin
  87.   Result.root:=nil;
  88.   for x in data do appendTree(Result,x);
  89. end;
  90.  
  91. procedure inorderTree(curr:PBranch);
  92. begin
  93.   if curr=nil then Exit;
  94.   inorderTree(curr^.lf);
  95.   Write(curr^.data,' ');
  96.   inorderTree(curr^.rt);
  97. end;
  98.  
  99. function treeToList(tree:TTree):TList;
  100. var curr:PBranch;
  101. begin
  102.   Result.head:=nil;
  103.   Result.tail:=nil;
  104.   curr:=tree.root;
  105.   if curr=nil then Exit;
  106.   while curr^.lf<>nil do curr:=curr^.lf;
  107.   while curr<>nil do
  108.   begin
  109.     appendList(Result,curr^.data);
  110.     if curr^.rt<>nil then
  111.     begin
  112.       curr:=curr^.rt;
  113.       while curr^.lf<>nil do curr:=curr^.lf;
  114.     end
  115.     else
  116.     begin
  117.       while (curr^.up<>nil)and(curr^.up^.rt=curr) do curr:=curr^.up;
  118.       curr:=curr^.up;
  119.     end;
  120.   end;
  121. end;
  122.  
  123. procedure Test;
  124. var tree:TTree;
  125. var list:TList;
  126. begin
  127.   tree:=makeTestTree;
  128.   inorderTree(tree.root);
  129.   WriteLn;
  130.   list:=treeToList(tree);
  131.   ShowForward(list);
  132.   ShowBackward(list);
  133. end;
  134.  
  135. begin
  136.   Test;
  137. end.
  138.  
Success #stdin #stdout 0s 4272KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
1 2 3 4 5 6 7 8 9 10 11 
1 2 3 4 5 6 7 8 9 10 11 
11 10 9 8 7 6 5 4 3 2 1
https://ideone.com/LMKnSr
language:
Pascal (fpc 3.0.4)
created:
4 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!