home *** CD-ROM | disk | FTP | other *** search
/ Mega Top 1 / os2_top1.zip / os2_top1 / APPS / TEKST / FUNNEL_S / ANSWERS / HI09.OUT < prev    next >
Text File  |  1992-05-27  |  3KB  |  99 lines
  1.  
  2. [inherit ('NaryTree'), environment ('NaryTreeSet')]
  3.  
  4. module NaryTreeSet;
  5.  
  6. type  NaryTreeSet = ^NaryTreeSetRecord;
  7.       NaryTreeSetRecord = record
  8.          Member: NaryTree;
  9.          Next: NaryTreeSet;
  10.          end;
  11.  
  12. procedure NullNaryTreeSet (var Result: NaryTreeSet);
  13. begin new (Result);
  14. Result^.Member := (- MaxInt)::NaryTree;
  15. Result^.Next := nil end;
  16.  
  17. function IsNullNaryTreeSet (S: NaryTreeSet): boolean;
  18. begin IsNullNaryTreeSet := S^.Member::integer = - MaxInt end;
  19.  
  20. procedure ForEachNaryTree (S: NaryTreeSet; procedure DoIt (i: NaryTree));
  21. var   ThisS, NextS: NaryTreeSet;
  22. begin ThisS := S;
  23. while ThisS^.Member::integer <> - MaxInt do
  24.    begin NextS := ThisS^.Next;
  25.    DoIt (ThisS^.Member);
  26.    ThisS := NextS end;
  27. end;
  28.  
  29. function FirstNaryTree (S: NaryTreeSet): NaryTree;
  30. begin FirstNaryTree := S^.Member end;
  31.  
  32. function IsNaryTreeInSet (i: NaryTree; S: NaryTreeSet): boolean;
  33.    procedure TestEquals (j: NaryTree);
  34.    begin if EqualNaryTree (i, j) then IsNaryTreeInSet := true; end;
  35. begin IsNaryTreeInSet := false; ForEachNaryTree (S, TestEquals); end;
  36.  
  37. function IncludesNaryTreeSet (S1, S2: NaryTreeSet): boolean;
  38. var Result: boolean;
  39.    procedure TestIfInS1 (i: NaryTree);
  40.    begin if Result then if not IsNaryTreeInSet (i, S1) then Result := false; end;
  41. begin Result := true;
  42. ForEachNaryTree (S2, TestIfInS1);
  43. IncludesNaryTreeSet := Result end;
  44.  
  45. function DisjointNaryTreeSets (S1, S2: NaryTreeSet): boolean;
  46. var Result: boolean;
  47.    procedure TestIfInS1 (i: NaryTree);
  48.    begin if Result then if IsNaryTreeInSet (i, S1) then Result := false; end;
  49. begin Result := true;
  50. ForEachNaryTree (S2, TestIfInS1);
  51. DisjointNaryTreeSets := Result end;
  52.  
  53. function EqualNaryTreeSet (S1, S2: NaryTreeSet): boolean;
  54. begin
  55. EqualNaryTreeSet := IncludesNaryTreeSet (S1, S2) and IncludesNaryTreeSet (S2, S1);
  56. end;
  57.  
  58. procedure InsertNaryTree (i: NaryTree; var S: NaryTreeSet);
  59. var   This, Pred, Succ: NaryTreeSet;
  60. begin
  61. if not IsNaryTreeInSet (i, S) then
  62.    begin
  63.    Pred := nil; Succ := S;
  64.    while Succ^.Member::integer > i::integer do begin
  65.       Pred := Succ; Succ := Succ^.Next end;
  66.    if Succ^.Member::integer < i::integer then begin
  67.       new (This); This^.Next := Succ; This^.Member := i;
  68.       if Pred <> nil then Pred^.Next := This else S := This;
  69.       end;
  70.    end;
  71. end;
  72.  
  73. procedure InsertNaryTrees (S1: NaryTreeSet; var S2: NaryTreeSet);
  74. var   This, Pred, Succ: NaryTreeSet;
  75.    procedure AddNaryTree (i: NaryTree);
  76.    begin InsertNaryTree (i, S2) end;
  77. begin
  78. ForEachNaryTree (S1, AddNaryTree);
  79. end;
  80.  
  81. procedure RemoveNaryTree (i: NaryTree; var S: NaryTreeSet);
  82. var   Pred, This: NaryTreeSet;
  83. begin
  84. Pred := nil; This := S;
  85. while not EqualNaryTree (This^.Member, i) do begin
  86.    Pred := This; This := This^.Next end;
  87. if Pred <> nil then Pred^.Next := This^.Next else S := This^.Next;
  88. Dispose (This);
  89. end;
  90.  
  91. procedure DisposeNaryTreeSet (var S: NaryTreeSet);
  92. var   Old: NaryTreeSet;
  93. begin
  94. while S <> nil do begin Old := S; S := S^.Next; Dispose (Old) end;
  95. end;
  96.  
  97. end.
  98.  
  99.