SICP Chapter #02 Examples in Oz
% Functions defined in previous chapters
fun {Gcd A B}
   if B == 0 then
      A
   else
      {Gcd B (A mod B)}
   end
end

fun {Fib N}
   case N
   of 0 then 0
   [] 1 then 1
   else {Fib N-1} + {Fib N-2}
   end
end

fun {Identity X} X end

fun {Square X} X * X end

% 2 Building Abstractions with Data
fun {LinearCombination A B X Y}
   A*X + B*Y
end

fun {Mul A B}
   A * B
end
fun {LinearCombination1 A B X Y}
   {Mul A X} + {Mul B Y}
end

% 2.1.1 Introduction to Data Abstraction - Example: Arithmetic Operations for Rational Numbers

fun {MakeRat N D} N#D end
fun {Numer X} X.1 end
fun {Denom X} X.2 end

fun {AddRat X Y}
   {MakeRat
      {Numer X}*{Denom Y} + {Numer Y}*{Denom X}
      {Denom X}*{Denom Y}}
end

fun {SubRat X Y}
   {MakeRat
      {Numer X}*{Denom Y} - {Numer Y}*{Denom X}
      {Denom X}*{Denom Y}}
end

fun {MulRat X Y}
   {MakeRat
      {Numer X}*{Numer Y}
      {Denom X}*{Denom Y}}
end

fun {DivRat X Y}
   {MakeRat
      {Numer X}*{Denom Y}
      {Denom X}*{Numer Y}}
end

fun {EqualRat X Y}
   {Numer X}*{Denom Y} == {Numer Y}*{Denom X}
end

fun {CONS X Y} X|Y end
fun {CAR L} L.1 end
fun {CDR L} L.2 end

% Compose function courtesy of Kevin Glyn via Oz mailing list
fun {Compose F G}
   fun {$ X}
      {F {G X}}
   end
end
CADR = {Compose CAR CDR}

X = {CONS 1 2}
Y = {CADR 1|2|3|4}
{Browse Y}

{Browse {CAR X}}
{Browse {CDR X}}

X1 = {CONS 1 2}
Y1 = {CONS 3 4}
Z1 = {CONS X1 Y1}
{Browse {CAR {CAR Z1}}}
{Browse {CAR {CDR Z1}}}

% footnote -- alternative definitions
MakeRat1 = CONS
Numer1 = CAR
Denom1 = {Compose CAR CDR}

proc {PrintRat X}
   {Browse {StringToAtom {Append {IntToString {Numer X}} {Append "/" {IntToString {Denom X}}}}}}
end

OneHalf = {MakeRat 1 2}
{PrintRat OneHalf}

OneThird = {MakeRat 1 3}
{PrintRat {AddRat OneHalf OneThird}}
{PrintRat {MulRat OneHalf OneThird}}
{PrintRat {AddRat OneThird OneThird}}

% reducing to lowest terms in constructor
fun {MakeRatGcd N D}
   G = {Gcd N D}
in
   (N div G)#(D div G)
end

fun {AddRatGcd X Y}
   {MakeRatGcd
      {Numer X}*{Denom Y} + {Numer Y}*{Denom X}
      {Denom X}*{Denom Y}}
end

{PrintRat {AddRatGcd OneThird OneThird}}

% Exercise 2.1
fun {MakeRat_ N D}
   if (D < 0 andthen N < 0) orelse N < 0 then
      (D * ~1)#(N * ~1)
   else
      D#N
   end
end

% Module Translation
   RATIONAL =
      functor
      export
         numericType : NumericType
         make        : Make
         numer       : Numer
         denom       : Denom
         add         : Add
         subtract    : Sub
         multiply    : Mul
         divide      : Div
         equal       : Equal
         toString    : ToString
      define
         NumericType = rational
         fun {Make N D} G = {Abs {Gcd N D}} in rational(if D >= 0 then N else ~N end div G {Abs D} div G) end
         fun {Numer rational(N D)} N end
         fun {Denom rational(N D)} D end
         fun {Add X Y} {Make {Numer X}*{Denom Y} + {Numer Y}*{Denom X} {Denom X}*{Denom Y}} end
         fun {Sub X Y} {Make {Numer X}*{Denom Y} - {Numer Y}*{Denom X} {Denom X}*{Denom Y}} end
         fun {Mul X Y} {Make {Numer X}*{Numer Y} {Denom X}*{Denom Y}} end
         fun {Div X Y} {Make {Numer X}*{Denom Y} {Denom X}*{Numer Y}} end
         fun {Equal X Y} {Numer X}*{Denom Y} == {Numer Y}*{Denom X} end
         fun {ToString X}
            {StringToAtom {Append {IntToString {Numer X}} {Append "/" {IntToString {Denom X}}}}}
         end
      end
   [Rational] = {Module.apply [RATIONAL]}

   local
      OneHalf = {Rational.make 1 2}
      OneThird = {Rational.make 1 3}
   in
      {Browse {Rational.toString OneHalf}}
      {Browse {Rational.toString {Rational.add OneHalf OneThird}}}
      {Browse {Rational.toString {Rational.multiply OneHalf OneThird}}}
      {Browse {Rational.toString {Rational.add OneThird OneThird}}}
   end
% end Module Translation

% Object Translation
   class RationalOO
      feat Numer Denom
      meth init(N D)
         G = {Abs {Gcd N D}}
      in
         self.Numer = if D >= 0 then N else ~N end div G
         self.Denom = {Abs D} div G
      end
      meth add(Other ?$)
         {New RationalOO init(self.Numer*Other.Denom + Other.Numer*self.Denom self.Denom*Other.Denom)}
      end
      meth subtract(Other ?$)
         {New RationalOO init(self.Numer*Other.Denom - Other.Numer*self.Denom self.Denom*Other.Denom)}
      end
      meth multiply(Other ?$)
         {New RationalOO init(self.Numer*Other.Numer self.Denom*Other.Denom)}
      end
      meth divide(Other ?$)
         {New RationalOO init(self.Numer*Other.Denom self.Denom*Other.Numer)}
      end
      meth equal(Other ?$)
         self.Numer * Other.Denom == Other.Numer * self.Denom
      end
      meth toString(?$)
         {StringToAtom {Append {IntToString self.Numer} {Append "/" {IntToString self.Denom}}}}
      end
   end

   local
      OneHalf = {New RationalOO init(1 2)}
      OneThird = {New RationalOO init(1 3)}
   in
      {Browse {OneHalf toString($)}}
      {Browse {{OneHalf add(OneThird $)} toString($)}}
      {Browse {{OneHalf multiply(OneThird $)} toString($)}}
      {Browse {{OneThird add(OneThird $)} toString($)}}
   end
% end Object Translation

% 2.1.2 Introduction to Data Abstraction - Abstraction barriers

% reducing to lowest terms in selectors
fun {MakeRat2 N D} N#D end

fun {Numer2 N#D}
   G = {Gcd N D}
in
   N div G
end

fun {Denom2 N#D}
   G = {Gcd N D}
in
   D div G
end

% Exercise 2.2
fun {MakePoint X Y} X#Y end
fun {XPoint Point} Point.1 end
fun {YPoint Point} Point.2 end
fun {MakeSegment StartSegment EndSegment} StartSegment#EndSegment end
fun {StartSegment Segment} Segment.1 end
fun {EndSegment Segment} Segment.2 end
fun {MidpointSegment Segment}
   S = {StartSegment Segment}
   E = {EndSegment Segment}
in
   {MakePoint (({XPoint S} + {XPoint E}) / 2.0) (({YPoint S} + {YPoint E}) / 2.0)}
end
proc {PrintPoint P}
   {Browse {StringToAtom {Append "(" {Append {FloatToString {XPoint P}} {Append "," {Append {FloatToString {YPoint P}} ")"}}}}}}
end
{PrintPoint {MidpointSegment {MakeSegment {MakePoint 4.0 6.0} {MakePoint 9.0 15.0}}}}

% Exercise 2.3
fun {RectPerimeter Rect}
   2.0*{RectWidth Rect} + 2.0*{RectHeight Rect}
end
fun {RectArea Rect}
   {RectWidth Rect} * {RectHeight Rect}
end

% Representation 1: stores the two opposing points P1 and P2
fun {PtsMakeRectangle P1 P2} pts(P1 P2) end
fun {PtsRectWidth pts(P1 P2)} {Abs {XPoint P1} - {XPoint P2}} end
fun {PtsRectHeight pts(P1 P2)} {Abs {YPoint P1} - {YPoint P2}} end

% Representation 2: stores the achor point and width/height
fun {PwhMakeRectangle P Width Height} pwh(P Width Height) end
fun {PwhRectWidth pwh(P Width Height)} Width end
fun {PwhRectHeight pwh(P Width Height)} Height end

fun {RectWidth Rect}
   case Rect
   of pts(...) then {PtsRectWidth Rect}
   [] pwh(...) then {PwhRectWidth Rect}
   end
end
fun {RectHeight Rect}
   case Rect
   of pts(...) then {PtsRectHeight Rect}
   [] pwh(...) then {PwhRectHeight Rect}
   end
end

Rx = {PtsMakeRectangle {MakePoint 10.0 15.0} {MakePoint 30.0 40.0}}
Ry = {PwhMakeRectangle {MakePoint 10.0 15.0} 20.0 25.0}

{Browse {RectPerimeter Rx}#{RectArea Rx}}
{Browse {RectPerimeter Ry}#{RectArea Ry}}

% 2.1.3 Introduction to Data Abstraction - What is meant by data?
fun {CONS1 X Y}
   fun {$ N}
      case N
      of 0 then X
      [] 1 then Y
      else raise illFormedExpression('Argument not 0 or 1 -- CONS ' # m) end
      end
   end
end
fun {CAR1 Z} {Z 0} end
fun {CDR1 Z} {Z 1} end

% Exercise 2.4
fun {CONS2 X Y}
   fun {$ M}
      {M X Y}
   end
end
fun {CAR2 Z}
   {Z fun {$ P Q} P end}
end
fun {CDR2 Z}
   {Z fun {$ P Q} Q end}
end

% Exercise 2.5
fun {CountPowers N D}
   fun {Iter I Pow}
      if I mod D == 0 then
         {Iter (I div D) Pow+1}
      else
         Pow
      end
   end
in
   {Iter N 0}
end
fun {CONS3 X Y}
   {Pow 2 X} * {Pow 3 Y}
end
fun {CAR3 Z}
   {CountPowers Z 2}
end
fun {CDR3 Z}
   {CountPowers Z 3}
end

{Browse {CONS3 1 2}}
{Browse {CAR3 {CONS3 1 2}}}
{Browse {CDR3 {CONS3 1 2}}}

% Exercise 2.6
Zero = fun {$ F} fun {$ X} X end end
fun {Add1 N}
   fun {$ F}
      fun {$ X}
         {F {{N F} X}}
      end
   end
end

% 2.1.4 Introduction to Data Abstraction - Extended Exercise: Interval Arithmetic
fun {AddInterval X Y}
   {MakeInterval {LowerBound X}+{LowerBound Y} {UpperBound X}+{UpperBound Y}}
end

fun {MulInterval X Y}
   P1 = {LowerBound X} * {LowerBound Y}
   P2 = {LowerBound X} * {UpperBound Y}
   P3 = {UpperBound X} * {LowerBound Y}
   P4 = {UpperBound X} * {UpperBound Y}
in
   {MakeInterval
      {Min {Min P1 P2} {Min P3 P4}}
      {Max {Max P1 P2} {Max P3 P4}}}
end

fun {DivInterval X Y}
   Z = {MakeInterval 1.0/{UpperBound Y} 1.0/{LowerBound Y}}
in
   {MulInterval X Z}
end

fun {MakeCenterWidth C W}
   {MakeInterval C-W C+W}
end

fun {Center I}
   ({LowerBound I} + {UpperBound I}) / 2.0
end

fun {Width I}
   ({UpperBound I} - {LowerBound I}) / 2.0
end

% Exercise 2.7
fun {MakeInterval A B} A#B end
fun {LowerBound X#Y} X end
fun {UpperBound X#Y} Y end

% Exercise 2.8
fun {SubInterval X Y}
   {MakeInterval {LowerBound X}-{UpperBound Y} {UpperBound X}-{LowerBound Y}}
end

% Exercise 2.9
I = {MakeInterval 5.0 10.0}
J = {MakeInterval 15.0 25.0}

% width of the sum (or difference) of two intervals *is* a function only of the widths of
% the intervals being added (or subtracted)
{Browse {Width {AddInterval I J}}#({Width I} + {Width J})}
{Browse {Width {SubInterval I J}}#({Width I} + {Width J})}

% width of the product (or quotient) of two intervals *is not* a function only of the widths
% of the intervals being multiplied (or divided)
{Browse {Width {MulInterval I J}}#({Width I} + {Width J})}
{Browse {Width {DivInterval I J}}#({Width I} + {Width J})}

% Exercise 2.10
fun {IsZeroInterval I}
   ({LowerBound I} == 0) orelse ({UpperBound I} == 0)
end
fun {DivIntervalZeroCheck X Y}
   if {IsZeroInterval Y} then
      raise error("Zero interval divisor") end
   else
      {DivInterval X Y}
   end
end

% Exercise 2.11
fun {OptMulInterval X Y}
   UpperX = {UpperBound X}
   LowerX = {LowerBound X}
   UpperY = {UpperBound Y}
   LowerY = {LowerBound Y}
in
   case (UpperX >= 0)#(LowerX >= 0)#(UpperY >= 0)#(LowerY >= 0)
      of true #true #true #true  then {MakeInterval LowerX*LowerY UpperX*UpperY}
      [] true #true #true #false then {MakeInterval UpperX*LowerY UpperX*UpperY}
      [] true #true #false#false then {MakeInterval UpperX*LowerY LowerX*UpperY}
      [] true #false#true #true  then {MakeInterval UpperY*LowerX UpperY*UpperX}
      [] true #false#false#false then {MakeInterval UpperX*LowerY LowerX*LowerY}
      [] false#false#true #true  then {MakeInterval LowerX*UpperY LowerY*UpperX}
      [] false#false#true #false then {MakeInterval LowerX*UpperY LowerY*LowerX}
      [] false#false#false#false then {MakeInterval UpperX*UpperY LowerY*LowerX}
      [] true #false#true #false then
         local
            P1 = {LowerBound X} * {LowerBound Y}
            P2 = {LowerBound X} * {UpperBound Y}
            P3 = {UpperBound X} * {LowerBound Y}
            P4 = {UpperBound X} * {UpperBound Y}
         in
            {MakeInterval
               {Min {Min P1 P2} {Min P3 P4}}
               {Max {Max P1 P2} {Max P3 P4}}}
         end
      else raise 'multiply interval exception' end
   end
end

% Exercise 2.12
fun {MakeCenterPercent C P}
   {MakeCenterWidth C {Abs P*C/100.0}}
end
fun {Percent I}
   {Width I} / {Abs {Center I}} * 100.0
end

% Exercise 2.14
% parallel resistors
fun {Par1 R1 R2}
   {DivInterval {MulInterval R1 R2} {AddInterval R1 R2}}
end

fun {Par2 R1 R2}
   One = {MakeInterval 1.0 1.0}
in
   {DivInterval One {AddInterval {DivInterval One R1} {DivInterval One R2}}}
end

R1 = {MakeCenterWidth 5.0 0.1}
R2 = {MakeCenterWidth 10.0 0.1}
{Browse {Par1 R1 R2}}
{Browse {Par2 R1 R2}}

% Module Translation
   INTERVAL =
      functor
      export
         makeInterval    : MakeInterval
         lowerBound      : LowerBound
         upperBound      : UpperBound
         addInterval     : AddInterval
         mulInterval     : MulInterval
         divInterval     : DivInterval
         makeCenterWidth : MakeCenterWidth
         center          : Center
         width           : Width
      define
         fun {MakeInterval A B} A#B end
         fun {LowerBound X#Y} X end
         fun {UpperBound X#Y} Y end
         fun {AddInterval X Y}
            {MakeInterval {LowerBound X}+{LowerBound Y} {UpperBound X}+{UpperBound Y}}
         end
         fun {MulInterval X Y}
            P1 = {LowerBound X} * {LowerBound Y}
            P2 = {LowerBound X} * {UpperBound Y}
            P3 = {UpperBound X} * {LowerBound Y}
            P4 = {UpperBound X} * {UpperBound Y}
         in
            {MakeInterval {Min {Min P1 P2} {Min P3 P4}} {Max {Max P1 P2} {Max P3 P4}}}
         end
         fun {DivInterval X Y}
            Z = {MakeInterval 1.0/{UpperBound Y} 1.0/{LowerBound Y}}
         in
            {MulInterval X Z}
         end
         fun {MakeCenterWidth C W} {MakeInterval C-W C+W} end
         fun {Center I} ({LowerBound I} + {UpperBound I}) / 2.0 end
         fun {Width I} ({UpperBound I} - {LowerBound I}) / 2.0 end
      end

   [Interval] = {Module.apply [INTERVAL]}
% end Module Translation *)

% Object Translation
   class IntervalOO
      feat UpperBound LowerBound
      meth init(X Y)
         self.UpperBound = X
         self.LowerBound = Y
      end
      meth addInterval(Other ?$)
         {New IntervalOO init(self.LowerBound*Other.LowerBound self.UpperBound*Other.UpperBound)}
      end
      meth mulInterval(Other ?$)
         P1 = self.LowerBound * Other.LowerBound
         P2 = self.LowerBound * Other.UpperBound
         P3 = self.UpperBound * Other.LowerBound
         P4 = self.UpperBound * Other.UpperBound
      in
         {New IntervalOO init({Min {Min P1 P2} {Min P3 P4}} {Max {Max P1 P2} {Max P3 P4}})}
      end
      meth divInterval(Other ?$)
         Z = {New IntervalOO init(1.0/Other.UpperBound 1.0/Other.LowerBound)}
      in
         {MulInterval X Z}
      end
      meth makeCenterWidth(C W ?$)
         {New IntervalOO init(C-W C+W)}
      end
      meth center(?$)
         (self.LowerBound + self.UpperBound) / 2.0
      end
      meth width(?$)
         (self.UpperBound - self.LowerBound) / 2.0
      end
   end
% end Object Translation *)

% 2.2.1 Hierarchical Data and the Closure Property - Representing Sequences

{Browse 1|2|3|4|nil}

fun {Head L} L.1 end
fun {Tail L} L.2 end

OneThroughFour = [1 2 3 4]

{Browse OneThroughFour}
{Browse {Head OneThroughFour}}
{Browse {Tail OneThroughFour}}
{Browse {Head {Tail OneThroughFour}}}
{Browse 10|OneThroughFour}
{Browse 5|OneThroughFour}

fun {ListRef Items N}
   case N
   of 0 then {Head Items}
   else {ListRef {Tail Items} N-1}
   end
end

Squares = [1 4 9 16 25]
{Browse {ListRef Squares 3}}

fun {Length1 Items}
   case Items
   of nil then 0
   else 1 + {Length1 {Tail Items}}
   end
end

Odds = [1 3 5 7]
{Browse {Length1 Odds}}

fun {Length2 Items}
   fun {LengthIter L Count}
      case L
      of nil then Count
      else {LengthIter {Tail L} 1+Count}
      end
   end
in
   {LengthIter Items 0}
end

fun {Append1 L1 L2}
   case L1
   of nil then L2
   else {Head L1}|{Append1 {Tail L1} L2}
   end
end

{Browse {Append1 Squares Odds}}
{Browse {Append1 Odds Squares}}

% Mapping over lists
fun {ScaleList Items Factor}
   case Items
   of nil then nil
   else {Head Items} * Factor | {ScaleList {Tail Items} Factor}
   end
end

{Browse {ScaleList [1 2 3 4 5] 10}}

fun {Map1 Items Proc}
   case Items
   of nil then nil
   else
      {Proc {Head Items}} | {Map1 {Tail Items} Proc}
   end
end

{Browse {Map1 [~10.0 2.5 ~11.6 17.0] Abs}}

{Browse {Map1 [1 2 3 4] fun {$ X} X * X end}}

fun {ScaleList2 Items Factor}
   {Map1 Items fun {$ X} X * Factor end}
end

/* Not sure how to translate these to Oz?
   (map + (list 1 2 3) (list 40 50 60) (list 700 800 900))
   (map (lambda (x y) (+ x ( * 2 y))) (list 1 2 3) (list 4 5 6))
*/

% Exercise 2.17
fun {LastPair L}
   case L
   of nil then nil
   [] H|nil then L
   [] H|T then {LastPair T}
   end
end
{Browse {LastPair [23 72 149 34]}}

% Exercise 2.18
fun {Reverse1 L}
   case L
   of nil then nil
   [] H|T then {Append {Reverse1 T} [H]}
   end
end
fun {Reverse2 L}
   fun {ReverseIter L Accum}
      case L
      of nil then Accum
      [] H|T then {ReverseIter T H|Accum}
      end
   end
in
   {ReverseIter L nil}
end
{Browse {Reverse1 [1 4 9 16 25]}}
{Browse {Reverse2 [1 4 9 16 25]}}

% Exercise 2.19
fun {NoMore CoinValues} CoinValues == nil end
fun {ExceptFirstDenomination CoinValues} CoinValues.2 end
fun {FirstDenomination CoinValues} CoinValues.1 end
fun {CC Amount CoinValues}
   if Amount == 0 then
      1
   else
      if Amount < 0 orelse {NoMore CoinValues} then
         0
      else
         {CC Amount {ExceptFirstDenomination CoinValues}} +
         {CC Amount-{FirstDenomination CoinValues} CoinValues}
      end
   end
end
USCoins = [50 25 10 5 1]
{Browse {CC 100 USCoins}}
% Note: Oz doesn't like mixing ints and floats - scale by 2 and convert to int
UKCoins = {Map1 {ScaleList [100.0 50.0 20.0 10.0 5.0 2.0 1.0 0.5] 2.0} FloatToInt}
{Browse {CC 2*100 UKCoins}}

% Exercise 2.20
fun {Filter1 L Pred}
   case L
   of nil then nil
   [] H|T then
      if {Pred H} then
         H|{Filter1 T Pred}
      else
         {Filter1 T Pred}
      end
   end
end
fun {SameParity L}
   Pred = if {IsOdd L.1} then IsOdd else IsEven end
in
   {Filter1 L.2 Pred}
end
{Browse {SameParity [1 2 3 4 5 6 7]}}
{Browse {SameParity [2 3 4 5 6 7]}}

% Exercise 2.21
fun {SquareList1 L}
   case L
   of nil then nil
   [] H|T then (H*H)|{SquareList1 T}
   end
end
fun {SquareList2 L}
   {Map L fun {$ X} X*X end}
end
{Browse {SquareList1 [1 2 3 4]}}
{Browse {SquareList2 [1 2 3 4]}}

% Exercise 2.22
fun {SquareList3 L}
   fun {Iter L Answer}
      case L
      of nil then Answer
      [] H|T then {Iter T (H*H)|Answer}
      end
   end
in
   {Iter L nil}
end
fun {SquareList4 L}
   fun {Iter L Answer}
      case L
      of nil then Answer
      [] H|T then {Iter T {Append Answer [H*H]}}
      end
   end
in
   {Iter L nil}
end
fun {SquareList5 L}
   fun {Iter L Answer}
      case L
      of nil then Answer
      [] H|T then {Iter T (H*H)|Answer}
      end
   end
in
   {Reverse {Iter L nil}}
end
{Browse {SquareList3 [1 2 3 4]}}
{Browse {SquareList4 [1 2 3 4]}}
{Browse {SquareList5 [1 2 3 4]}}

% Exercise 2.23
proc {ForEach L F}
   case L
   of nil then skip
   [] H|T then
      {F H}
      {ForEach T F}
   end
end
{ForEach [57 321 88] proc {$ X} {Browse X} end}

% 2.2.2 Hierarchical Data and the Closure Property - Hierarchical Structures
fun {CountLeaves Tree}
   case Tree
   of nil then 0
   [] (H|S)|T then 1 + {CountLeaves S} + {CountLeaves T}
   [] H|T then 1 + {CountLeaves T}
   end
end

X2 = [[1 2] [3 4]]
{Browse {Length X2}}
{Browse {CountLeaves X2}}

% Mapping over trees
fun {ScaleTree Tree Factor}
   case Tree
   of nil then nil
   [] (H|S)|T then (H * Factor | {ScaleTree S Factor}) | {ScaleTree T Factor}
   [] H|T then H * Factor | {ScaleTree T Factor}
   end
end

{Browse {ScaleTree [1 [2 [3 4] 5] [6 7]] 10}}

fun {ScaleTree2 Tree Factor}
   {Map
      Tree
      fun {$ SubTree}
         case SubTree
         of H|T then {ScaleTree2 SubTree Factor}
         else SubTree * Factor
         end
      end}
end

% Exercise 2.24
{Browse [1 [2 [3 4]]]}

% Exercise 2.25
{Browse [1 3 [5 7] 9]}
{Browse [[7]]}
{Browse [1 [2 [3 [4 [5 [6 7]]]]]]}

% Exercise 2.26
X3 = [1 2 3]
Y3 = [4 5 6]
{Browse {Append X3 Y3}}
{Browse X3|Y3}
{Browse [X3 Y3]}

% Exercise 2.27
fun {DeepReverse L}
   case L
   of nil then nil
   [] H|T then
      if {IsList H} then
         {Append {DeepReverse T} [{DeepReverse H}]}
      else
         {Append {DeepReverse T} [H]}
      end
   end
end
X4 = [[1 2] [3 4]]
{Browse X4}
{Browse {Reverse X4}}
{Browse {DeepReverse X4}}

% Exercise 2.28
fun {Fringe L}
   case L
   of nil then nil
   [] H|T then
      if {IsList H} then
         {Append {Fringe H} {Fringe T}}
      else
         H|{Fringe T}
      end
   end
end
X5 = [[1 2] [3 4]]
{Browse {Fringe X5}}
{Browse {Fringe [X5 X5]}}

% Exercise 2.29
% List-based representation
% a.
fun {MakeMobile Left Right} [Left Right] end
fun {MakeBranch Length Struct} [Length Struct] end
fun {LeftBranch Mobile} Mobile.1 end
fun {RightBranch Mobile} Mobile.2.1 end
fun {BranchLength Branch} Branch.1 end
fun {BranchStruct Branch} Branch.2.1 end

% Helpers for b. and c.
fun {BranchWeight Branch}
   local
      Struct = {BranchStruct Branch}
   in
      if {IsList Struct} then
         {BranchWeight {LeftBranch Struct}} + {BranchWeight {RightBranch Struct}}
      else
         Struct
      end
   end
end

% b.
fun {TotalWeight Mobile}
   {BranchWeight {LeftBranch Mobile}} + {BranchWeight {RightBranch Mobile}}
end

% c.
fun {IsMobileBalanced Mobile}
   L = {LeftBranch Mobile}
   R = {RightBranch Mobile}
   Lmwl = {BranchLength L} * {BranchWeight L}
   Rmwl = {BranchLength R} * {BranchWeight R}
in
   if Lmwl == Rmwl then
      if {IsList {BranchStruct L}} andthen {IsList {BranchStruct R}} then
         {IsMobileBalanced {BranchStruct L}} andthen  {IsMobileBalanced {BranchStruct R}}
      elseif {IsList {BranchStruct L}} then
         {IsMobileBalanced {BranchStruct L}}
      elseif {IsList {BranchStruct R}} then
         {IsMobileBalanced {BranchStruct R}}
      else
         true
      end
   else
      false
   end
end

M1 = {MakeMobile {MakeBranch 10 100}
                 {MakeBranch 10 {MakeMobile {MakeBranch 40 20}
                                            {MakeBranch 10 80}}}}
M2 = [[10 100] [10 [[40 20] [10 80]]]]
{Browse {TotalWeight M1}#{TotalWeight M2}}
{Browse {IsMobileBalanced M1}#{IsMobileBalanced M2}}

% d.
%fun {MakeMobile Left Right} Left#Right end
%fun {MakeBranch Length Struc} Length#Struc end
%fun {RightBranch Mobile} Mobile.2 end
%fun {BranchStruct Branch} Branch.2 end

% Exercise 2.30
fun {SquareTree Tree}
   case Tree
   of nil then nil
   [] H|T then
      if {IsList H} then
         {Append [{SquareTree H}] {SquareTree T}}
      else
         (H*H)|{SquareTree T}
      end
   end
end
{Browse {SquareTree [1 [2 [3 4] 5] [6 7]]}}
fun {SquareTree1 Tree}
   {Map Tree
      fun {$ SubTree}
         if {IsList SubTree} then
            {SquareTree1 SubTree}
         else
            SubTree*SubTree
         end
      end}
end
{Browse {SquareTree1 [1 [2 [3 4] 5] [6 7]]}}

% Exercise 2.31
fun {TreeMap Tree Proc}
   case Tree
   of nil then nil
   [] H|T then
      if {IsList H} then
         {Append [{TreeMap H Proc}] {TreeMap T Proc}}
      else
         {Proc H}|{TreeMap T Proc}
      end
   end
end
fun {SquareTree2 Tree}
   {TreeMap Tree fun {$ X} X * X end}
end
{Browse {SquareTree2 [1 [2 [3 4] 5] [6 7]]}}

% Exercise 2.32
fun {Subsets S}
   case S
   of nil then [nil]
   [] H|T then
      local
         Rest = {Subsets T}
      in
         {Append Rest {Map Rest fun {$ X} H|X end}}
      end
   end
end
{Browse {Subsets [1 2 3]}}


% Alternate Translation Using Records instead of lists
   local
      fun {LengthTree Tree}
         case Tree
         of node(L) then {Length L}
         [] leaf(X) then 1
         end
      end

      fun {CountLeaves Tree}
         case Tree
         of node(nil) then 0
         [] node(H|T) then {CountLeaves H} + {CountLeaves node(T)}
         [] leaf(X) then 1
         end
      end

      X2 = node([node([leaf(1) leaf(2)]) node([leaf(3) leaf(4)])])

      {Browse X2}
      {Browse {LengthTree X2}}
      {Browse {CountLeaves X2}}
      {Browse node([X2 X2])}
      {Browse {LengthTree node([X2 X2])}}
      {Browse {CountLeaves node([X2 X2])}}

      % Mapping over trees
      fun {ScaleTree Tree Factor}
         {Browse Tree}
         case Tree
         of leaf(X) then leaf(X * Factor)
         [] node(nil) then node(nil)
         [] node(H|T) then {ScaleTree H Factor} | {ScaleTree node(T) Factor}
         end
      end

      {Browse {ScaleTree node([leaf(1) node([leaf(2) node([leaf(3) leaf(4)]) leaf(5)]) node([leaf(6) leaf(7)])]) 10}}

      % Exercise 2.24
      {Browse node([leaf(1) node([leaf(2) node([leaf(3) leaf(4)])])])}

      % Exercise 2.25
      {Browse node([leaf(1) leaf(3) node([leaf(5) leaf(7)]) leaf(9)])}
      {Browse node([node([leaf(7)])])}
      {Browse node([leaf(1) node([leaf(2) node([leaf(3) node([leaf(4) node([leaf(5) node([leaf(6) leaf(7)])])])])])])}

      % Exercise 2.26
      fun {AppendTree Tree1 Tree2}
         case Tree1#Tree2
         of node(X)#leaf(Y) then {Append X [leaf(Y)]}
         [] leaf(X)#node(Y) then node(leaf(X)|Y)
         [] node(X)#node(Y) then node({Append X Y})
         [] leaf(X)#leaf(Y) then node([leaf(X) leaf(Y)])
         end
      end
      X3 = node([leaf(1) leaf(2) leaf(3)])
      Y3 = node([leaf(4) leaf(5) leaf(6)])
      {Browse {AppendTree X3 Y3}}
      {Browse node([X3 node(Y3)])}
      {Browse node([X3 Y3])}

      % Exercise 2.27
      fun {ReverseTree Tree}
         case Tree
         of leaf(X) then leaf(X)
         [] node(L) then node({Reverse L})
         end
      end
      fun {DeepReverseTree Tree}
         case Tree
         of leaf(X) then leaf(X)
         [] node(L) then node({Reverse {Map L DeepReverseTree}})
         end
      end
      X4 = node([node([leaf(1) leaf(2)]) node([leaf(3) leaf(4)])])
      {Browse X4}
      {Browse {ReverseTree X4}}
      {Browse {DeepReverseTree X4}}

      % Exercise 2.28
      fun {Fringe Tree}
         {Browse Tree}
         case Tree
         of leaf(X) then [X]
         [] node(nil) then nil
         [] node(H|T) then {Append {Fringe H} {Fringe node(T)}}
         end
      end
      X5 = node([node([leaf(1) leaf(2)]) node([leaf(3) leaf(4)])])
      {Browse {Fringe X5}}
      {Browse {Fringe node([X5 X5])}}

      % Exercise 2.29
      % Record-based representation
      % a.
      fun {MakeMobile Left Right} mobile(Left Right) end
      fun {MakeBranch Len Struct} branch(Len Struct) end
      fun {MakeWeight Weight} weight(Weight) end

      fun {LeftBranch Mobile=mobile(Left Right)} Left end
      fun {RightBranch Mobile=mobile(Left Right)} Right end
      fun {BranchLength Branch=branch(Len Struct)} Len end
      fun {BranchStruct Branch=branch(Len Struct)} Struct end

      % Helpers for b. and c.
      fun {BranchWeight Branch}
         case Branch
         of branch(Len mobile(Left Right)) then {BranchWeight Left} + {BranchWeight Right}
         [] branch(Len weight(Weight)) then Weight
         end
      end

      % b.
      fun {TotalWeight Mobile}
         {BranchWeight {LeftBranch Mobile}} + {BranchWeight {RightBranch Mobile}}
      end

      % c.
      fun {IsMobileBalanced Mobile}
         Lmwl = {BranchLength {LeftBranch Mobile}} * {BranchWeight {LeftBranch Mobile}}
         Rmwl = {BranchLength {RightBranch Mobile}} * {BranchWeight {RightBranch Mobile}}
      in
         if Lmwl == Rmwl then
            case Mobile
            of mobile(branch(_ M1=mobile(_ _)) branch(_ M2=mobile(_ _))) then {IsMobileBalanced M1} andthen {IsMobileBalanced M2}
            [] mobile(branch(_ M1=mobile(_ _)) _) then {IsMobileBalanced M1}
            [] mobile(_ branch(_ M2=mobile(_ _))) then {IsMobileBalanced M2}
            else true
            end
         else
            false
         end
      end

      M1 = {MakeMobile {MakeBranch 10 {MakeWeight 100}}
                       {MakeBranch 10 {MakeMobile {MakeBranch 40 {MakeWeight 20}}
                                                  {MakeBranch 10 {MakeWeight 80}}}}}
      M2 = mobile(branch(10 weight(100))
                  branch(10 mobile(branch(40 weight(20))
                                   branch(10 weight(80)))))
      {Browse {TotalWeight M1}#{TotalWeight M2}}
      {Browse {IsMobileBalanced M1}#{IsMobileBalanced M2}}

      % Exercise 2.30
      fun {NodeList node(Xs)} Xs end
      fun {SquareTree Tree}
         case Tree
         of leaf(X) then leaf(X * X)
         [] node(nil) then node(nil)
         [] node(H|T) then node({SquareTree H} | {NodeList {SquareTree node(T)}})
         end
      end
      {Browse {SquareTree node([leaf(1) node([leaf(2) node([leaf(3) leaf(4)]) leaf(5)]) node([leaf(6) leaf(7)])])}}
      fun {SquareTree1 Tree}
         case Tree
         of leaf(X) then leaf(X * X)
         [] node(L) then node({Map L SquareTree1})
         end
      end
      {Browse {SquareTree1 node([leaf(1) node([leaf(2) node([leaf(3) leaf(4)]) leaf(5)]) node([leaf(6) leaf(7)])])}}

      % Exercise 2.31
      fun {TreeMap Tree Proc}
         case Tree
         of leaf(X) then leaf({Proc X})
         [] node(L) then node({Map L fun {$ Y} {TreeMap Y Proc} end})
         end
      end
      fun {SquareTree2 Tree}
         {TreeMap Tree fun {$ X} X * X end}
      end
      {Browse {SquareTree2 node([leaf(1) node([leaf(2) node([leaf(3) leaf(4)]) leaf(5)]) node([leaf(6) leaf(7)])])}}
   in
      skip
   end

% 2.2.3 Hierarchical Data and the Closure Property - Sequences as Conventional Interfaces
fun {SumOddSquares Tree}
   case Tree
   of nil then 0
   [] (H|S)|T then {SumOddSquares H|S} + {SumOddSquares T}
   [] H|T then
      if {IsOdd H} == true then
         {Square H} + {SumOddSquares T}
      else
         {SumOddSquares T}
      end
   end
end

fun {EvenFibs N}
   fun {Next K}
      if K > N then
         nil
      else
         local
            F = {Fib K}
         in
            if {IsEven F} then
               F|{Next K+1}
            else
               {Next K+1}
            end
         end
      end
   end
in
   {Next 0}
end

% Sequence operations
{Browse {Map [1 2 3 4 5] Square}}

fun {Filter2 Sequence Predicate}
   case Sequence
   of nil then nil
   [] H|T then
      if {Predicate H} then
         H|{Filter2 T Predicate}
      else
         {Filter2 T Predicate}
      end
   end
end

{Browse {Filter2 [1 2 3 4 5] IsOdd}}

% Accumulate is equivalent to FoldR
fun {Accumulate Sequence Oper Initial}
   case Sequence
   of nil then Initial
   [] H|T then {Oper H {Accumulate T Oper Initial}}
   end
end
{Browse {Accumulate [1 2 3 4 5] Number.'+' 0}}
{Browse {Accumulate [1 2 3 4 5] Number.'*' 1}}
{Browse {Accumulate [1 2 3 4 5] fun {$ A B} A | B end nil}}

fun {EnumerateInterval Low High}
   if Low > High then
      nil
   else
      Low | {EnumerateInterval Low+1 High}
   end
end

{Browse {EnumerateInterval 2 7}}

fun {EnumerateTree Tree}
   case Tree
   of nil then nil
   [] (H|S)|T then {Append {EnumerateTree H|S} {EnumerateTree T}}
   [] H|T then H|{EnumerateTree T}
   end
end

{Browse {EnumerateTree [1 [2 [3 4] 5]]}}

fun {SumOddSquares2 Tree}
   {Accumulate {Map {Filter {EnumerateTree Tree} IsOdd} Square} Number.'+' 0}
end

{Browse {SumOddSquares2 [1 [2 [3 4] 5]]}}

fun {EvenFibs2 N}
   {Accumulate
      {Filter {Map {EnumerateInterval 0 N} Fib} IsEven}
      fun {$ A B} A | B end
      nil}
end

{Browse {EvenFibs2 10}}

fun {ListFibSquares N}
   {Accumulate
      {Map {Map {EnumerateInterval 0 N} Fib} Square}
      fun {$ A B} A | B end
      nil}
end

{Browse {ListFibSquares 10}}

fun {ProductOfSquaresOfOddElements Sequence}
   {Accumulate {Map {Filter Sequence IsOdd} Square} Number.'*' 1}
end

{Browse {ProductOfSquaresOfOddElements [1 2 3 4 5]}}

fun {IsProgrammer Emp}
   case Emp
   of employee(jobtitle:X ...) then X == "Programmer"
   end
end
{Browse {IsProgrammer employee(name:"Fred" jobtitle:"Programmer" salary:180)}}

fun {Salary Emp}
   case Emp
   of employee(salary:X ...) then X
   end
end
{Browse {Salary employee(name:"Fred" jobtitle:"Programmer" salary:180)}}

fun {SalaryOfHighestPaidProgrammer Records}
   {Accumulate {Map {Filter Records IsProgrammer} Salary} Max 0}
end

Recs = [employee(name:"Fred" jobtitle:"Programmer" salary:180)
        employee(name:"Hank" jobtitle:"Programmer" salary:150)]

{Browse {SalaryOfHighestPaidProgrammer Recs}}

% Nested mappings
N = 10                   % book doesn't define N
{Browse
   {Accumulate
      {Map
         {EnumerateInterval 1 N}
         fun {$ I}
            {Map
               {EnumerateInterval 1 I-1}
               fun {$ J} [I J] end}
         end}
      Append
      nil}}

fun {Flatmap Seq Proc}
   {Accumulate {Map Seq Proc} Append nil}
end

fun {HasNoDivisors N C}
   case C
   of 1 then true
   else
      if N mod C == 0 then
         false
      else
         {HasNoDivisors N C-1}
      end
   end
end

fun {IsPrime N}
   {HasNoDivisors N N-1}
end

fun {PrimeSum L}
   case L
   of [X Y] then {IsPrime X+Y}
   end
end

fun {MakePairSum L}
   case L
   of [X Y] then [X Y X+Y]
   end
end

fun {PrimeSumPairs N}
   {Map
      {Filter
         {Flatmap
            {EnumerateInterval 1 N}
            fun {$ I}
               {Map
                  {EnumerateInterval 1 I-1}
                  fun {$ J} [I J] end}
            end}
         PrimeSum}
      MakePairSum}
end

fun {Remove Sequence Item}
   {Filter Sequence fun {$ X} X \= Item end}
end

fun {Permutations Seq}
   case Seq
   of nil then [nil]
   else
      {Flatmap
         Seq
         fun {$ X}
            {Map
               {Permutations {Remove Seq X}}
               fun {$ P} X|P end}
         end}
   end
end
{Browse {Permutations [1 2 3]}}

% Exercise 2.33
fun {Map2 Seq Proc}
   {Accumulate Seq fun {$ A B} {Proc A} | B end nil}
end
fun {Append2 Seq1 Seq2}
   {Accumulate Seq1 fun {$ A B} A|B end Seq2}
end
fun {Length3 Seq}
   {Accumulate Seq fun {$ X Y} Y+1 end 0}
end

% Exercise 2.34
fun {HornerEval C CoefficientSequence}
   {Accumulate
      CoefficientSequence
      fun {$ ThisCoeff HigherTerms}
         C*HigherTerms + ThisCoeff
      end
      0}
end
{Browse {HornerEval 2 [1 3 0 5 0 1]}}

% Exercise 2.35
fun {CountLeaves2 Tree}
   {Accumulate {Map {EnumerateTree Tree} fun {$ X} 1 end} Number.'+' 0}
 end
{Browse {CountLeaves2 X2}}

% Exercise 2.36
fun {AccumulateN Seq Oper Init}
   case Seq
   of nil|_ then nil
   else
      {Accumulate {Map Seq Head} Oper Init} |
         {AccumulateN {Map Seq Tail} Oper Init}
   end
end
{Browse {AccumulateN [[1 2 3] [4 5 6] [7 8 9] [10 11 12]] Number.'+' 0}}

% Exercise 2.37
% Still not quite right since won't handle multiply in nested arrays
fun {ExtendedMap L Proc}
   case L
   of (H1|T1)#(H2|T2) then {Proc H1 H2} | {ExtendedMap T1#T2 Proc}
   [] (H1|T1)#(H2|T2)#(H3|T3) then {Proc {Proc H1 H2} H3} | {ExtendedMap T1#T2#T3 Proc}
   else nil
   end
end
{Browse {ExtendedMap [1 2 3]#[40 50 60]#[700 800 900] Number.'+'}}

fun {DotProduct V W}
   {AccumulateN
      {Map V fun {$ L} {ExtendedMap L#W Number.'*'} end}
      Number.'+'
      0}
end
{Browse {DotProduct [[1 2 3 4] [4 5 6 6] [6 7 8 9]] [1 1 1 1]}}

fun {MatrixTimesVector M V}
   {Map M fun {$ Row} {DotProduct Row V} end}
end

fun {Transpose M}
   {AccumulateN M fun {$ A B} A|B end nil}
end

fun {MatrixTimesMatrix M N}
   Cols = {Transpose N}
in
   {Map M fun {$ Row} {MatrixTimesVector Cols Row} end}
end

% Exercise 2.38
FoldRight = Accumulate
fun {FoldLeft Sequence Oper Initial}
   fun {Iter L Result}
      case L
      of nil then Result
      [] H|T then {Iter T {Oper Result H}}
      end
   end
in
   {Iter Sequence Initial}
end
{Browse {FoldRight [1.0 2.0 3.0] Float.'/' 1.0}}
{Browse {FoldLeft  [1.0 2.0 3.0] Float.'/' 1.0}}
{Browse {FoldRight [1 2 3] fun {$ A B} A | B end nil}}
{Browse {FoldLeft [1 2 3] fun {$ A B} A | B end nil}}

% Exercise 2.39
fun {ReverseR Seq}
   {FoldR Seq fun {$ X Y} {Append Y [X]} end nil}
end
fun {ReverseL Seq}
   {FoldL Seq fun {$ X Y} Y | X end nil}
end
{Browse {ReverseR [1 2 3 4]}}
{Browse {ReverseL [1 2 3 4]}}

% Exercise 2.40
fun {UniquePairs N}
   {Flatmap
      {EnumerateInterval 1 N}
      fun {$ I}
         {Map
            {EnumerateInterval 1 I-1}
            fun {$ J} [I J] end}
      end
   }
end
fun {PrimeSumPairs_ N}
   {Map
      {Filter {UniquePairs N} PrimeSum}
      MakePairSum}
end

% Exercise 2.41
fun {UniqueTriples N}
   {Flatmap
      {EnumerateInterval 1 N}
      fun {$ I}
         {Flatmap
            {EnumerateInterval 1 I-1}
            fun {$ J}
               {Map
                  {EnumerateInterval 1 J-1}
                  fun {$ K} [I J K] end}
            end}
      end}
end
fun {TriplesSumS SumsTo N}
   {Filter
      {UniqueTriples N}
      fun {$ Triple}
         {Accumulate Triple Number.'+' 0} == SumsTo
      end}
end
{Browse {TriplesSumS 10 5}}

% Exercise 2.42
fun {Queens BoardSize}
   fun {QueenCols K}
      case K
      of 0 then [EmptyBoard]
      else
         {Filter
            {Flatmap
               {QueenCols K-1}
               fun {$ RestOfQueens}
                  {Map
                     {EnumerateInterval 1 BoardSize}
                     fun {$ NewRow}
                        {AdjoinPosition NewRow K RestOfQueens}
                     end}
               end}
            fun {$ Positions} {IsSafe K Positions} end}
      end
   end
in
   {QueenCols BoardSize}
end

EmptyBoard = nil

fun {AdjoinPosition NewRow K RestOfQueens}
   case RestOfQueens
   of nil then [K#NewRow]
   else (K#NewRow)|RestOfQueens
   end
end

fun {RemoveTargetColumn Column Board}
   {Filter Board fun {$ X} X.1 \= Column end}
end

fun {GetTargetColumn Column Board}
   {Head {Filter Board fun {$ X} X.1 == Column end}}
end

fun {IsCheck Pos1 Pos2}
   H1#T1 = Pos1
   H2#T2 = Pos2
in
   if H1 == H2 then
      true
   elseif T1 == T2 then
      true
   elseif {Abs H1-H2} == {Abs T1-T2} then
      true
   else
      false
   end
end

fun {BoardChecks Pos Board}
   case Board
   of nil then true
   [] H|T then
      if {IsCheck Pos H} then
         false
      else
         {BoardChecks Pos T}
      end
   end
end

fun {IsSafe X Y}
   {BoardChecks {GetTargetColumn X Y} {RemoveTargetColumn X Y}}
end

{Browse {Queens 4}}

% Exercise 2.43
fun {Queens_ BoardSize}
   fun {QueenCols K}
      case K
      of 0 then [EmptyBoard]
      else
         {Filter
            {Flatmap
               {EnumerateInterval 1 BoardSize}
               fun {$ NewRow}
                  {Map
                     {QueenCols K-1}
                     fun {$ RestOfQueens}
                        {AdjoinPosition NewRow K RestOfQueens}
                     end}
               end}
            fun {$ Positions} {IsSafe K Positions} end}
      end
   end
in
   {QueenCols BoardSize}
end

{Browse {Queens_ 4}}

% 2.2.4 Hierarchical Data and the Closure Property - Example: a picture language

% drawing primitives - output a postscript file
[File]={Module.link ['File.ozf']}
{File.writeOpen 'picture-lang.ps'}
PostscriptPageIndex = {NewCell 0}
{File.write "%!PS-Adobe-3.0\n"}
{File.write "%%Pages: 9\n\n"}              % note: I'm hard coding the number of postscript pages (9) that are generated below.
proc {Postscript Wave}
   PostscriptPageIndex := @PostscriptPageIndex + 1
   {File.write "%%Page: "}
   {File.write @PostscriptPageIndex}
   {File.write " "}
   {File.write @PostscriptPageIndex}
   {File.write "\n"}
   {File.write "/inch {72 8 mul mul} def\n"}
   {Wave {MakeFrame {MakeVect 0.0 0.0} {MakeVect 1.0 0.0} {MakeVect 0.0 1.0}}}
   {File.write "showpage\n"}
   {File.write "\n"}
end
proc {DrawLine X Y}
   {File.write "newpath\n"}
   case X#Y
   of (vect(x:X0 y:Y0))#(vect(x:X1 y:Y1)) then
      {File.write X0#" inch "#Y0#" inch moveto\n"}
      {File.write X1#" inch "#Y1#" inch lineto\n"}
   end
   {File.write "closepath\n"}
   {File.write "stroke\n"}
end

proc {Wave XFrame}
   Segs = [{MakeSegment_1 {MakeVect 0.40 1.00} {MakeVect 0.35 0.80}}
           {MakeSegment_1 {MakeVect 0.35 0.80} {MakeVect 0.40 0.60}}
           {MakeSegment_1 {MakeVect 0.40 0.60} {MakeVect 0.30 0.60}}
           {MakeSegment_1 {MakeVect 0.30 0.60} {MakeVect 0.20 0.55}}
           {MakeSegment_1 {MakeVect 0.20 0.55} {MakeVect 0.00 0.80}}
           {MakeSegment_1 {MakeVect 0.00 0.60} {MakeVect 0.20 0.45}}
           {MakeSegment_1 {MakeVect 0.20 0.45} {MakeVect 0.30 0.55}}
           {MakeSegment_1 {MakeVect 0.30 0.55} {MakeVect 0.35 0.50}}
           {MakeSegment_1 {MakeVect 0.35 0.50} {MakeVect 0.25 0.00}}
           {MakeSegment_1 {MakeVect 0.40 0.00} {MakeVect 0.50 0.20}}
           {MakeSegment_1 {MakeVect 0.50 0.20} {MakeVect 0.60 0.00}}
           {MakeSegment_1 {MakeVect 0.75 0.00} {MakeVect 0.65 0.50}}
           {MakeSegment_1 {MakeVect 0.65 0.50} {MakeVect 1.00 0.20}}
           {MakeSegment_1 {MakeVect 1.00 0.40} {MakeVect 0.70 0.60}}
           {MakeSegment_1 {MakeVect 0.70 0.60} {MakeVect 0.60 0.60}}
           {MakeSegment_1 {MakeVect 0.60 0.60} {MakeVect 0.65 0.80}}
           {MakeSegment_1 {MakeVect 0.65 0.80} {MakeVect 0.60 1.00}}]
in
   {{SegmentsPainter Segs} XFrame}
end

fun {MakeVect X Y} vect(x:X y:Y) end
fun {XcorVect V} case V of vect(x:X ...) then X end end
fun {YcorVect V} case V of vect(y:Y ...) then Y end end
fun {AddVect V1 V2} {MakeVect {XcorVect V1}+{XcorVect V2} {YcorVect V1}+{YcorVect V2}} end
fun {SubVect V1 V2} {MakeVect {XcorVect V1}-{XcorVect V2} {YcorVect V1}-{YcorVect V2}} end
fun {ScaleVect S V} {MakeVect S*{XcorVect V} S*{YcorVect V}} end

fun {MakeFrame Origin Edge1 Edge2} frame(origin:Origin edge1:Edge1 edge2:Edge2) end
fun {OriginFrame F} case F of frame(origin:Origin ...) then Origin end end
fun {Edge1Frame F} case F of  frame(edge1:Edge1 ...) then Edge1 end end
fun {Edge2Frame F} case F of  frame(edge2:Edge2 ...) then Edge2 end end
AFrame = {MakeFrame {MakeVect 0.0 0.0} {MakeVect 1.0 0.0} {MakeVect 0.0 1.0}}

fun {MakeSegment_1 StartSegment EndSegment} segment(x:StartSegment y:EndSegment) end
fun {StartSegment_1 S} case S of segment(x:X ...) then X end end
fun {EndSegment_1 S} case S of segment(y:Y ...) then Y end end

% Frames
fun {FrameCoordMap XFrame}
   fun {$ V}
      {AddVect
         {OriginFrame XFrame}
         {AddVect
            {ScaleVect {XcorVect V} {Edge1Frame XFrame}}
            {ScaleVect {YcorVect V} {Edge2Frame XFrame}}}}
   end
end

_ = {{FrameCoordMap AFrame} {MakeVect 0.0 0.0}}
_ = {OriginFrame AFrame}

% Painters
fun {SegmentsPainter SegmentList}
   proc {$ XFrame}
      {ForEach
         SegmentList
         proc {$ Segment}
            {DrawLine
               {{FrameCoordMap XFrame} {StartSegment_1 Segment}}
               {{FrameCoordMap XFrame} {EndSegment_1 Segment}}}
         end}
   end
end

{Postscript Wave}

fun {TransformPainter Painter Origin Corner1 Corner2}
   proc {$ XFrame}
      M = {FrameCoordMap XFrame}
      NewOrigin = {M Origin}
   in
      {Painter
         {MakeFrame
            NewOrigin
            {SubVect {M Corner1} NewOrigin}
            {SubVect {M Corner2} NewOrigin}}}
   end
end

fun {FlipVert Painter}
   {TransformPainter
      Painter
      {MakeVect 0.0 1.0}
      {MakeVect 1.0 1.0}
      {MakeVect 0.0 0.0}}
end

fun {ShrinkToUpperRight Painter}
   {TransformPainter
      Painter
      {MakeVect 0.5 0.5}
      {MakeVect 1.0 0.5}
      {MakeVect 0.5 1.0}}
end

fun {Rotate90 Painter}
   {TransformPainter
      Painter
      {MakeVect 1.0 0.0}
      {MakeVect 1.0 1.0}
      {MakeVect 0.0 0.0}}
end

fun {SquashInwards Painter}
   {TransformPainter
      Painter
      {MakeVect 0.0 0.0}
      {MakeVect 0.65 0.35}
      {MakeVect 0.35 0.65}}
end

fun {Beside Painter1 Painter2}
   proc {$ XFrame}
      SplitPoint = {MakeVect 0.5 0.0}
      PaintLeft =
         {TransformPainter
            Painter1
            {MakeVect 0.0 0.0}
            SplitPoint
            {MakeVect 0.0 1.0}}
      PaintRight =
         {TransformPainter
            Painter2
            SplitPoint
            {MakeVect 1.0 0.0}
            {MakeVect 0.5 1.0}}
   in
      {PaintLeft XFrame}
      {PaintRight XFrame}
   end
end

fun {Below Painter1 Painter2}
   proc {$ XFrame}
      SplitPoint = {MakeVect 0.0 0.5}
      PaintBelow =
         {TransformPainter
            Painter1
            {MakeVect 0.0 0.0}
            {MakeVect 1.0 0.0}
            SplitPoint}
      PaintAbove =
         {TransformPainter
            Painter2
            SplitPoint
            {MakeVect 1.0 0.5}
            {MakeVect 0.0 1.0}}
   in
      {PaintBelow XFrame}
      {PaintAbove XFrame}
   end
end

Wave2 = {Beside Wave {FlipVert Wave}}
Wave4 = {Below Wave2 Wave2}

{Postscript Wave2}
{Postscript Wave4}

fun {FlippedPairs Painter}
   Painter2 = {Beside Painter {FlipVert Painter}}
in
   {Below Painter2 Painter2}
end

Wave4_ = {FlippedPairs Wave}
{Postscript Wave4_}

fun {RightSplit Painter N}
   case N
   of 0 then Painter
   else
      local
         Smaller = {RightSplit Painter N-1}
      in
         {Beside Painter {Below Smaller Smaller}}
      end
   end
end

fun {CornerSplit Painter N}
   case N
   of 0 then Painter
   else
      local
         Up = {UpSplit Painter N-1}
         Right = {RightSplit Painter N-1}
         TopLeft = {Beside Up Up}
         BottomRight = {Below Right Right}
         Corner = {CornerSplit Painter N-1}
      in
         {Beside {Below Painter TopLeft} {Below BottomRight Corner}}
      end
   end
end

fun {SquareLimit Painter N}
   Quarter = {CornerSplit Painter N}
   Half = {Beside {FlipHoriz Quarter} Quarter}
in
   {Below {FlipVert Half} Half}
end

% Higher_order operations
fun {SquareOfFour TLeft TRight BLeft BRight}
   fun {$ Painter}
      Top = {Beside {TLeft Painter} {TRight Painter}}
      Bottom = {Beside {BLeft Painter} {BRight Painter}}
   in
      {Below Bottom Top}
   end
end

fun {FlippedPairs2 Painter}
   Combine4 = {SquareOfFour Identity FlipVert Identity FlipVert}
in
   {Combine4 Painter}
end

% footnote
FlippedPairs3 = {SquareOfFour Identity FlipVert Identity FlipVert}

fun {SquareLimit2 Painter N}
   Combine4 = {SquareOfFour FlipHoriz Identity Rotate180 FlipVert}
in
   {Combine4 {CornerSplit Painter N}}
end

% Exercise 2.44
fun {UpSplit Painter N}
   case N
   of 0 then Painter
   else
      local
         Smaller = {UpSplit Painter N-1}
      in
         {Below Painter {Beside Smaller Smaller}}
      end
   end
end
{Postscript {UpSplit Wave 4}}

% Exercise 2.45
fun {Split CombineMain CombineSmaller}
   fun {$ Painter N}
      if N == 0 then
         Painter
      else
         local
            Smaller = {{Split CombineMain CombineSmaller} Painter N-1}
         in
            {CombineMain Painter {CombineSmaller Smaller Smaller}}
         end
      end
   end
end
RightSplit_ = {Split Beside Below}
UpSplit_ = {Split Below Beside}
{Postscript {UpSplit_ Wave 4}}
{Postscript {RightSplit_ Wave 4}}

% Exercise 2.46
fun {MakeVect_ X Y} X#Y end
fun {XcorVect_ X#Y} X end
fun {YcorVect_ X#Y} Y end
fun {AddVect_ V1 V2}
   {MakeVect_ {XcorVect_ V1}+{XcorVect_ V2} {YcorVect_ V1}+{YcorVect_ V2}}
end
fun {SubVect_ V1 V2}
   {MakeVect_ {XcorVect_ V1}-{XcorVect_ V2} {YcorVect_ V1}-{YcorVect_ V2}}
end
fun {ScaleVect_ S V}
   {MakeVect_ S*{XcorVect_ V} S*{YcorVect_ V}}
end

% Exercise 2.47
fun {MakeFrame2 Origin Edge1 Edge2} [Origin Edge1 Edge2] end
fun {MakeFrame3 Origin Edge1 Edge2} [Origin [Edge1 Edge2]] end

fun {OriginFrame2 F} F.1 end
fun {Edge1Frame2 F} F.2.1 end
fun {Edge2Frame2 F} F.2.2.1 end

fun {OriginFrame3 F} F.1 end
fun {Edge1Frame3 F} F.2.1.1 end
fun {Edge2Frame3 F} F.2.1.2.1 end

% Exercise 2.48
fun {MakeSegment_ VStart VEnd} VStart#VEnd end
fun {StartSegment_ VStart#VEnd} VStart end
fun {EndSegment_ VStart#VEnd} VEnd end

% Exercise 2.49
proc {Outline XFrame}
   Segs = [{MakeSegment_1 {MakeVect 0.0 0.0} {MakeVect 0.0 1.0}}
           {MakeSegment_1 {MakeVect 0.0 0.0} {MakeVect 1.0 0.0}}
           {MakeSegment_1 {MakeVect 1.0 0.0} {MakeVect 1.0 1.0}}
           {MakeSegment_1 {MakeVect 0.0 1.0} {MakeVect 1.0 1.0}}]
in
   {{SegmentsPainter Segs} XFrame}
end
proc {XXX XFrame}
   Segs = [{MakeSegment_1 {MakeVect 1.0 0.0} {MakeVect 0.0 1.0}}
           {MakeSegment_1 {MakeVect 0.0 0.0} {MakeVect 1.0 1.0}}]
in
   {{SegmentsPainter Segs} XFrame}
end

proc {Diamond XFrame}
   Segs = [{MakeSegment_1 {MakeVect 0.5 0.0} {MakeVect 1.0 0.5}}
           {MakeSegment_1 {MakeVect 1.0 0.5} {MakeVect 0.5 1.0}}
           {MakeSegment_1 {MakeVect 0.0 0.5} {MakeVect 0.5 0.0}}
           {MakeSegment_1 {MakeVect 0.0 0.5} {MakeVect 0.5 1.0}}]
in
   {{SegmentsPainter Segs} XFrame}
end
{Postscript {Below {Beside Outline XXX} {Beside Diamond Wave}}}

% Exercise 2.50
fun {FlipHoriz Painter}
   {TransformPainter
      Painter
      {MakeVect 1.0 0.0}
      {MakeVect 0.0 0.0}
      {MakeVect 1.0 1.0}}
end
fun {Rotate180 Painter}
   {TransformPainter
      Painter
      {MakeVect 1.0 1.0}
      {MakeVect 0.0 1.0}
      {MakeVect 1.0 0.0}}
end
fun {Rotate270 Painter}
   {TransformPainter
      Painter
      {MakeVect 1.0 0.0}
      {MakeVect 1.0 1.0}
      {MakeVect 0.0 0.0}}
end

% Exercise 2.51
% see definition of Below given above
fun {BelowRot Painter1 Painter2}
   {Rotate90 {Beside {Rotate270 Painter1} {Rotate270 Painter2}}}
end

% Exercise 2.52
% see definition of CornerSplit given above
{Postscript {SquareLimit Wave 4}}

{File.writeClose}

% 2.3.1 Symbolic Data - Quotation

% To Be Done.


% 2.3.2 Symbolic Data - Example: Symbolic Differentiation

fun {IsSameNumber X Y}
   {IsNumber X} andthen {IsNumber Y} andthen X == Y
end

fun {IsVariable X}
   {IsAtom X}
end

fun {IsSameVariable X Y}
   {IsVariable X} andthen {IsVariable Y} andthen X == Y
end

fun {IsSum L}
   case L
   of sum(...) then true
   else false
   end
end

fun {IsProduct L}
   case L
   of product(...) then true
   else false
   end
end

fun {MakeSum X Y}
   if {IsNumber X} andthen {IsNumber Y} then
      X + Y
   else
      sum(X Y)
   end
end

fun {MakeProduct X Y}
   if {IsNumber X} andthen {IsNumber Y} then
      X * Y
   else
      product(X Y)
   end
end

fun {AddEnd L}
   case L
   of sum(X ...) then X
   else raise invalid('a - Invalid pattern match ' # L) end
   end
end

fun {AugEnd L}
   case L
   of sum(_ Y) then Y
   else raise invalid('b - Invalid pattern match ' # L) end
   end
end

fun {Multiplier L}
   case L
   of product(X ...) then X
   else raise invalid('c - Invalid pattern match ' # L) end
   end
end

fun {Multiplicand L}
   case L
   of product(_ Y) then Y
   else raise invalid('d - Invalid pattern match ' # L) end
   end
end

fun {Deriv Expr Var}
   if {IsNumber Expr} then
      0
   elseif {IsVariable Expr} then
      if {IsSameVariable Expr Var} then
         1
      else
         0
      end
   elseif {IsSum Expr} then
      {MakeSum {Deriv {AddEnd Expr} Var}
               {Deriv {AugEnd Expr} Var}}
   elseif {IsProduct Expr} then
      {MakeSum {MakeProduct {Multiplier Expr} {Deriv {Multiplicand Expr} Var}}
               {MakeProduct {Deriv {Multiplier Expr} Var} {Multiplicand Expr}}}
   else raise invalid('Invalid Exprression ' # Expr) end
   end
end

% dx(x + 3) = 1
{Browse {Deriv sum(x 3) x}}

% dx(x*y) = y
{Browse {Deriv product(x y) x}}

% dx(x*y + x + 3) = y + 1
{Browse {Deriv sum(sum(product(x y) x) 3) x}}

% with simplification
fun {MakeSum1 X Y}
   if {IsNumber X} andthen X == 0 then
      Y
   elseif {IsNumber Y} andthen Y == 0 then
      X
   elseif {IsNumber X} andthen {IsNumber Y} then
      X + Y
   else
      sum(X Y)
   end
end

fun {MakeProduct1 X Y}
   if {IsNumber X} andthen X == 0 then
      0
   elseif {IsNumber Y} andthen Y == 0 then
      0
   elseif {IsNumber X} andthen X == 1 then
      Y
   elseif {IsNumber Y} andthen Y == 1 then
      X
   elseif {IsNumber X} andthen {IsNumber Y} then
      X * Y
   else
      product(X Y)
   end
end

fun {Deriv1 Expr Var}
   if {IsNumber Expr} then
      0
   elseif {IsVariable Expr} then
      if {IsSameVariable Expr Var} then
         1
      else
         0
      end
   elseif {IsSum Expr} then
      {MakeSum1 {Deriv1 {AddEnd Expr} Var}
                {Deriv1 {AugEnd Expr} Var}}
   elseif {IsProduct Expr} then
      {MakeSum1 {MakeProduct1 {Multiplier Expr} {Deriv1 {Multiplicand Expr} Var}}
                {MakeProduct1 {Deriv1 {Multiplier Expr} Var} {Multiplicand Expr}}}
   else
      raise invalid('Invalid Exprression ' # Expr) end
   end
end

% dx(x + 3) = 1
{Browse {Deriv1 sum(x 3) x}}

% dx(x*y) = y
{Browse {Deriv1 product(x y) x}}

% dx(x*y + x + 3) = y + 1
{Browse {Deriv1 sum(sum(product(x y) x) 3) x}}

% Exercise 2.56
fun {MakeExponentiation Base Exp}
   if {IsNumber Exp} andthen Exp == 0 then
      1
   elseif {IsNumber Exp} andthen Exp == 1 then
      Base
   elseif {IsNumber Exp} andthen {IsNumber Base} then
      {Pow Base Exp}
   else
      power(Base Exp)
   end
end

fun {IsExponentiation L}
   case L
   of power(X Y) then true
   else false
   end
end

fun {Base L}
   case L
   of power(X _) then X
   else raise invalid('e - Invalid pattern match ' # L) end
   end
end

fun {Exponent L}
   case L
   of power(_ Y) then Y
   else raise invalid('f - Invalid pattern match ' # L) end
   end
end

fun {Deriv2 Expr Var}
   if {IsNumber Expr} then
      0
   elseif {IsVariable Expr} then
      if {IsSameVariable Expr Var} then
         1
      else
         0
      end
   elseif {IsExponentiation Expr} then
      {MakeProduct1 {MakeProduct1 {Exponent Expr}
                                  {MakeExponentiation {Base Expr} {MakeSum1 {Exponent Expr} ~1}}}
                    {Deriv2 {Base Expr} Var}}
   elseif {IsSum Expr} then
      {MakeSum1 {Deriv2 {AddEnd Expr} Var}
                {Deriv2 {AugEnd Expr} Var}}
   elseif {IsProduct Expr} then
      {MakeSum1 {MakeProduct1 {Multiplier Expr} {Deriv2 {Multiplicand Expr} Var}}
                {MakeProduct1 {Deriv2 {Multiplier Expr} Var} {Multiplicand Expr}}}
   else
      raise invalid('Invalid Exprression ' # Expr) end
   end
end

% Exercise 2.57
fun {AugEnd2 L}
   case L
   of sum(_ Y) then Y
   [] sum(_ Y ...) then {List.toTuple {Label L} {Record.toList L}.2}
   else raise invalid('g - Invalid pattern match ' # L) end
   end
end

fun {Multiplicand2 L}
   case L
   of product(_ Y) then Y
   [] product(_ Y ...) then {List.toTuple {Label L} {Record.toList L}.2}
   else raise invalid('h - Invalid pattern match ' # L) end
   end
end

fun {Deriv3 Expr Var}
   if {IsNumber Expr} then
      0
   elseif {IsVariable Expr} then
      if {IsSameVariable Expr Var} then
         1
      else
         0
      end
   elseif {IsExponentiation Expr} then
      {MakeProduct1 {MakeProduct1 {Exponent Expr}
                                  {MakeExponentiation {Base Expr} {MakeSum1 {Exponent Expr} ~1}}}
                    {Deriv3 {Base Expr} Var}}
   elseif {IsSum Expr} then
      {MakeSum1 {Deriv3 {AddEnd Expr} Var}
                {Deriv3 {AugEnd2 Expr} Var}}
   elseif {IsProduct Expr} then
      {MakeSum1 {MakeProduct1 {Multiplier Expr} {Deriv3 {Multiplicand2 Expr} Var}}
                {MakeProduct1 {Deriv3 {Multiplier Expr} Var} {Multiplicand2 Expr}}}
   else
      raise invalid('Invalid Exprression ' # Expr) end
   end
end

% dx(x*y*(x+3)) = dx(x*x*y + 3*x*y) = 2xy + 3y
{Browse {Deriv3 sum(product(x x y) product(3 x y)) x}}

% Exercise 2.58
% To Be Done

% 2.3.3 Symbolic Data - Example: Representing Sets

% unordered
fun {IsElementOfSet X L}
   case L
   of nil then false
   [] H|T then
      if X == H then
         true
      else
         {IsElementOfSet X T}
      end
   end
end

fun {AdjoinSet X Set}
   if {IsElementOfSet X Set} then
      Set
   else
      X|Set
   end
end

fun {IntersectionSet Set1 Set2}
   case Set1#Set2
   of nil#_ then nil
   [] _#nil then nil
   [] (H|T)#_ then
      if {IsElementOfSet H Set2} then
         H|{IntersectionSet T Set2}
      else
         {IntersectionSet T Set2}
      end
   end
end

% ordered
fun {IsElementOfSet1 X L}
   case L
   of nil then false
   [] H|T then
      if X == H then
         true
      else
         if X < H then
            false
         else
            {IsElementOfSet1 X T}
         end
      end
   end
end

fun {IntersectionSet1 Set1 Set2}
   case Set1#Set2
   of nil#_ then nil
   [] _#nil then nil
   [] (X|Xs)#(Y|Ys) then
      if X == Y then
         X|{IntersectionSet1 Xs Ys}
      elseif X < Y then
         {IntersectionSet1 Xs Set2}
      else
         {IntersectionSet1 Set1 Ys}
      end
   end
end

% Sets as binary trees
fun {IsElementOfSet2 X Node}
   case Node
   of leaf then false
   [] tree(Y Left Right) then
      if X == Y then
         true
      else
         if X < Y then
            {IsElementOfSet2 X Left}
         else
            {IsElementOfSet2 X Right}
         end
      end
   end
end

{Browse {IsElementOfSet2 3 tree(2 tree(1 leaf leaf) tree(3 leaf leaf))}}

fun {AdjoinSet2 X Node}
   case Node
   of leaf then tree(X leaf leaf)
   [] tree(Y Left Right) then
      if X == Y then
         Node
      else
         if X < Y then
            tree(Y {AdjoinSet2 X Left} Right)
         else
            tree(Y Left {AdjoinSet2 X Right})
         end
      end
   end
end

{Browse {AdjoinSet2 3 tree(4 tree(2 leaf leaf) tree(6 leaf leaf))}}

% information retrieval
fun {Lookup GivenKey L}
   case L
   of information(Key Name Age)|T then
      if GivenKey == Key then
         L.1
      else
         {Lookup GivenKey T}
      end
   else raise invalid('Invalid pattern match ' # L) end
   end
end

% Exercise 2.59
fun {UnionSet Set1 Set2}
   {Append
      Set1
      {Filter Set2 fun {$ X} {Not {IsElementOfSet X Set1}} end}}
end
{Browse {UnionSet [3 1 2] [4 3 2 5]}}

% Exercise 2.60
fun {IsElementOfMultiSet X L}
   {Member X L}
end
fun {IntersectionMultiSet Set1 Set2}
   case Set1#Set2
   of (X|Xs)#(Y|Ys) then
      if {IsElementOfMultiSet X Set2} then
         X|{IntersectionMultiSet Xs Set2}
      else
         {IntersectionMultiSet Xs Set2}
      end
   else nil
   end
end
fun {AdjoinMultiSet X Set}
   X|Set
end
fun {UnionMultiSet Set1 Set2}
   {Append Set1 Set2}
end
{Browse {IsElementOfMultiSet 3 [2 3 2 1 3 2 2]}}
{Browse {IntersectionMultiSet [2 3 2 1 3 2 2] [4 2 3 2 5]}}
{Browse {AdjoinMultiSet 5 [2 3 2 1 3 2 2]}}
{Browse {UnionMultiSet [2 3 2 1 3 2 2] [4 2 3 2 5]}}

% Exercise 2.61
fun {AdjoinSet1 X Set}
   case Set
   of nil then [X]
   [] H|T then
      if H == X then
         Set
      elseif H > X then
         X|Set
      else
         H|{AdjoinSet1 X T}
      end
   end
end
{Browse {AdjoinSet1 3 [2 4 6]}}

% Exercise 2.62
fun {UnionSet1 Set1 Set2}
   case Set1#Set2
   of _#nil then Set1
   [] nil#_ then Set2
   [] (X|Xs)#(Y|Ys) then
      if X == Y then
         X|{UnionSet1 Xs Ys}
      elseif X < Y then
         X|{UnionSet1 Xs Set2}
      else
         Y|{UnionSet1 Set1 Ys}
      end
   end
end
{Browse {UnionSet1 [1 2 3] [2 3 4 5]}}

% Exercise 2.63
fun {TreeToList1 Node}
   case Node
   of leaf then nil
   [] tree(Y Left Right) then
      {Append {TreeToList1 Left} Y|{TreeToList1 Right}}
   end
end
{Browse {TreeToList1 tree(4 tree(2 leaf leaf) tree(6 leaf leaf))}}

fun {TreeToList2 Node}
   fun {CopyToList T L}
      case T
      of leaf then L
      [] tree(X Left Right) then
         {CopyToList Left X|{CopyToList Right L}}
      end
   end
in
   {CopyToList Node nil}
end
{Browse {TreeToList2 tree(4 tree(2 leaf leaf) tree(6 leaf leaf))}}

% Exercise 2.64
fun {PartialTree Elts N}
   if N == 0 then
      leaf#Elts
   else
      local
         LeftSize = (N-1) div 2
         RightSize = N - (LeftSize + 1)
         LeftResult = {PartialTree Elts LeftSize}
         LeftTree#NonLeftElts = LeftResult
         ThisEntry = NonLeftElts.1
         RightResult = {PartialTree NonLeftElts.2 RightSize}
         RightTree#RemainingElts = RightResult
      in
         tree(ThisEntry LeftTree RightTree)#RemainingElts
      end
   end
end

fun {ListToTree Elements}
   Result#_ = {PartialTree Elements {Length Elements}}
in
   Result
end

{Browse {ListToTree [2 4 6]}}

% Exercise 2.65
fun {UnionSetBinTree Set1 Set2}
   {ListToTree {UnionSet {TreeToList2 Set1} {TreeToList2 Set2}}}
end
fun {IntersectionSetBinTree Set1 Set2}
   {ListToTree {IntersectionSet {TreeToList2 Set1} {TreeToList2 Set2}}}
end

% Exercise 2.66
fun {Lookup1 GivenKey Tree}
   case Tree
   of tree(Item=information(Key Name Age) Left Right) then
      if GivenKey == Key then
         Item
      elseif GivenKey < Key then
         {Lookup GivenKey Left}
      else
         {Lookup GivenKey Right}
      end
   else raise invalid('Invalid pattern match ' # GivenKey) end
   end
end

% 2.3.4 Symbolic Data - Example: Huffman Encoding Trees

fun {MakeLeaf Symbol Weight}
   leaf(Symbol Weight)
end

fun {IsLeaf Node}
   case Node
   of leaf(_ _) then true
   else false
   end
end

fun {SymbolLeaf Node}
   case Node
   of leaf(Symbol _) then Symbol
   else raise invalid('Invalid pattern match ' # Node) end
   end
end

fun {WeightLeaf Node}
   case Node
   of leaf(_ Weight) then Weight
   else raise invalid('Invalid pattern match ' # Node) end
   end
end

fun {Symbols Node}
   case Node
   of leaf(Symbol _) then [Symbol]
   [] tree(SubSymbols _ _ _) then SubSymbols
   end
end

fun {Weight Node}
   case Node
   of leaf(_ Weight) then Weight
   [] tree(_ Weight _ _) then Weight
   end
end

fun {MakeCodeTree Left Right}
   tree(
      {Append {Symbols Left} {Symbols Right}}
      ({Weight Left} + {Weight Right})
      Left
      Right)
end

fun {LeftNode Node}
   case Node
   of tree(_ _ Left _) then Left
   else raise invalid('Invalid pattern match ' # Node) end
   end
end
fun {RightNode Node}
   case Node
   of tree(_ _ _ Right) then Right
   else raise invalid('Invalid pattern match ' # Node) end
   end
end

fun {ChooseNode N Node}
   case N
   of 0 then {LeftNode Node}
   [] 1 then {RightNode Node}
   else raise invalid('Invalid pattern match ' # N) end
   end
end

% decoding
fun {Decode Bits Tree}
   fun {Decode_1 Bits CurrentNode}
      case Bits
      of nil then nil
      [] H|T then
         local
            NextNode = {ChooseNode H CurrentNode}
         in
            if {IsLeaf NextNode} then
               {SymbolLeaf NextNode} | {Decode_1 T Tree}
            else
               {Decode_1 T NextNode}
            end
         end
      end
   end
in
   {Decode_1 Bits Tree}
end

% sets
fun {AdjoinSet3 X Set}
   case Set
   of nil then [X]
   [] H|T then
      if {Weight X} < {Weight H} then
         X|Set
      else
         H|{AdjoinSet3 X T}
      end
   end
end

fun {MakeLeafSet Node}
   case Node
   of (Symbol#Weight)|Pairs then {AdjoinSet3 {MakeLeaf Symbol Weight} {MakeLeafSet Pairs}}
   [] nil then nil
   else raise invalid('Invalid pattern match ' # Node) end
   end
end

% Exercise 2.67
SampleTree = {MakeCodeTree
      {MakeLeaf &A 4}
      {MakeCodeTree
         {MakeLeaf &B 2}
         {MakeCodeTree
            {MakeLeaf &D 1}
            {MakeLeaf &C 1}}}}
SampleMessage = [0 1 1 0 0 1 0 1 0 1 1 1 0]
{Browse {StringToAtom {Decode SampleMessage SampleTree}}}

% Exercise 2.68
fun {EncodeSymbol C Tree}
   if {Member C {Symbols Tree}} then
      local
         L = {LeftNode Tree}
         R = {RightNode Tree}
      in
         if {IsLeaf L} andthen C == {SymbolLeaf L} then
            [0]
         elseif {IsLeaf R} andthen C == {SymbolLeaf R} then
            [1]
         elseif {Not {IsLeaf L}} andthen {Member C {Symbols L}} then
            0|{EncodeSymbol C L}
         elseif {Not {IsLeaf R}} andthen {Member C {Symbols R}} then
            1|{EncodeSymbol C R}
         end
      end
   else
      raise encodingXXX end
   end
end
fun {Encode Message Tree}
   case Message
   of nil then nil
   [] H|T then {Append {EncodeSymbol H Tree} {Encode T Tree}}
   end
end
{Browse {StringToAtom {Decode {Encode "ADABBCA" SampleTree} SampleTree}}}

% Exercise 2.69
fun {GenerateHuffmanTree Pairs}
   {SuccessiveMerge {MakeLeafSet Pairs}}
end
fun {SuccessiveMerge NodeSet}
   case NodeSet
   of H|nil then H
   [] H|S|T then {SuccessiveMerge {AdjoinSet3 {MakeCodeTree H S} T}}
   end
end
{Browse {GenerateHuffmanTree [&A#8 &B#3 &C#1 &D#1 &E#1 &F#1 &G#1 &H#1]}}

% Exercise 2.70
Rock50sTree = {GenerateHuffmanTree [a#2 boom#1 get#2 job#2 na#16 sha#3 yip#9 wah#1]}
{Browse {Length {Encode [get a job sha na na na na na na na na
                         get a job sha na na na na na na na na
                         wah yip yip yip yip yip yip yip yip yip
                         sha boom]
                        Rock50sTree}}}

% Exercise 2.71
% n = 5
{Browse  {GenerateHuffmanTree [a#1 b#2 c#4 d#8 e#16]}}
% n = 10
{Browse  {GenerateHuffmanTree [a#1 b#2 c#4 d#8 e#16 f#32 g#64 h#128 i#256 j#512]}}

% 2.4.1 Multiple Representations for Abstract Data - Representations for Complex Numbers

% Same as above
% fun {Square X} X * X end

% Rectangular
fun {RealPartR Real#_} Real end
fun {ImagPartR _#Imag} Imag end

fun {MagnitudeR Z} {Sqrt {Square {RealPartR Z}} + {Square {ImagPartR Z}}} end
fun {AngleR Z} {Atan2 {ImagPartR Z} {RealPartR Z}} end

fun {MakeFromRealImagR R I} R#I end
fun {MakeFromMagAngR M A} M*{Cos A}#M*{Sin A} end

% polar
fun {MagnitudeP Mag#_} Mag end
fun {AngleP _#Ang} Ang end

fun {RealPartP Z} {MagnitudeP Z} * {Cos {AngleP Z}} end
fun {ImagPartP Z} {MagnitudeP Z} * {Sin {AngleP Z}} end

fun {MakeFromRealImagP X Y} {Sqrt {Square X} + {Square Y}}#{Atan2 Y X} end
fun {MakeFromMagAngP M A} M#A end

% using the abstract type
Magnitude = MagnitudeP
Angle = AngleP
RealPart = RealPartP
ImagPart = ImagPartP
MakeFromRealImag = MakeFromRealImagP
MakeFromMagAng = MakeFromMagAngP

Z = 1.0#2.0
{Browse {MakeFromRealImag {RealPart Z} {ImagPart Z}}}
{Browse {MakeFromMagAng {Magnitude Z} {Angle Z}}}

fun {AddComplex Z1 Z2}
   {MakeFromRealImag
      {RealPart Z1} + {RealPart Z2}
      {ImagPart Z1} + {ImagPart Z2}}
end

fun {SubComplex Z1 Z2}
   {MakeFromRealImag
      {RealPart Z1} - {RealPart Z2}
      {ImagPart Z1} - {ImagPart Z2}}
end

fun {MulComplex Z1 Z2}
   {MakeFromMagAng
      {Magnitude Z1} * {Magnitude Z2}
      {Angle Z1} + {Angle Z2}}
end

fun {DivComplex Z1 Z2}
   {MakeFromMagAng
      {Magnitude Z1} / {Magnitude Z2}
      {Angle Z1} - {Angle Z2}}
end

% 2.4.2 Multiple Representations for Abstract Data - Tagged Data

fun {AttachTag TypeTag Contents} TypeTag(Contents) end

fun {TypeTag A}
   case A
   of rectangular(...) then rectangular
   [] polar(...) then polar
   else raise invalid('Invalid pattern match ' # A) end
   end
end

fun {Contents A}
   case A
   of rectangular(X) then X
   [] polar(X) then X
   else raise invalid('Invalid pattern match ' # A) end
   end
end

fun {IsRectangular A}
   case A
   of rectangular(...) then true
   else false
   end
end

fun {IsPolar A}
   case A
   of polar(...) then true
   else false
   end
end

% Rectangular
fun {MakeFromRealImagRectangular X Y}
   rectangular(X#Y)
end
fun {MakeFromMagAngRectangular M A}
   rectangular(M*{Cos A} # M*{Sin A})
end

fun {RealPartRectangular rectangular(X#_)} X end
fun {ImagPartRectangular rectangular(_#Y)} Y end

fun {MagnitudeRectangular Z}
   {Sqrt {Square {RealPartRectangular Z}} +
         {Square {ImagPartRectangular Z}}}
end
fun {AngleRectangular Z}
   {Atan2 {ImagPartRectangular Z} {RealPartRectangular Z}}
end

% Polar
fun {MakeFromRealImagPolar X Y}
   polar({Sqrt {Square X} + {Square Y}} # {Atan2 Y X})
end
fun {MakeFromMagAngPolar M A}
   polar(M A)
end

fun {MagnitudePolar polar(X#_)} X end
fun {AnglePolar polar(_#Y)} Y end

fun {RealPartPolar Z}
   {MagnitudePolar Z} * {Cos {AnglePolar Z}}
end
fun {ImagPartPolar Z}
   {MagnitudePolar Z} * {Sin {AnglePolar Z}}
end

% Generic selectors
fun {RealPartG A}
   case A
   of rectangular(_) then {RealPartRectangular A}
   [] polar(_) then {RealPartPolar A}
   else raise invalid('Invalid pattern match ' # A) end
   end
end
fun {ImagPartG A}
   case A
   of rectangular(_) then {ImagPartRectangular A}
   [] polar(_) then {ImagPartPolar A}
   else raise invalid('Invalid pattern match ' # A) end
   end
end

fun {MagnitudeG A}
   case A
   of rectangular(_) then {MagnitudeRectangular A}
   [] polar(_) then {MagnitudePolar A}
   else raise invalid('Invalid pattern match ' # A) end
   end
end
fun {AngleG A}
   case A
   of rectangular(_) then {AngleRectangular A}
   [] polar(_) then {AnglePolar A}
   else raise invalid('Invalid pattern match ' # A) end
   end
end

% Constructors for complex numbers
fun {MakeFromRealImagG X Y}
   {MakeFromRealImagRectangular X Y}
end
fun {MakeFromMagAngG M A}
   {MakeFromMagAngPolar M A}
end

% same as before
fun {AddComplexG Z1 Z2}
   {MakeFromRealImagG
      {RealPartG Z1} + {RealPartG Z2}
      {ImagPartG Z1} + {ImagPartG Z2}}
end

fun {SubComplexG Z1 Z2}
   {MakeFromRealImagG
      {RealPartG Z1} - {RealPartG Z2}
      {ImagPartG Z1} - {ImagPartG Z2}}
end

fun {MulComplexG Z1 Z2}
   {MakeFromMagAngG
      {MagnitudeG Z1} * {MagnitudeG Z2}
      {AngleG Z1} + {AngleG Z2}}
end

fun {DivComplexG Z1 Z2}
   {MakeFromMagAngG
      {MagnitudeG Z1} / {MagnitudeG Z2}
      {AngleG Z1} - {AngleG Z2}}
end

{Browse {AddComplexG {MakeFromRealImagG 3.0 4.0}
                     {MakeFromRealImagG 3.0 4.0}}}

% 2.4.3 Multiple Representations for Abstract Data - Data-Directed Programming and Additivity

RECTANGULAR =
   functor
   export
      makeFromRealImag : MakeFromRealImag
      makeFromMagAng   : MakeFromMagAng
      realPart         : RealPart
      imagPart         : ImagPart
      magnitude        : Magnitude
      angle            : Angle
      toString         : ToString
   define
      fun {MakeFromRealImag R I}
         rectangular(R#I)
      end
      fun {MakeFromMagAng M A}
         rectangular(M*{Cos A} # M*{Sin A})
      end
      fun {RealPart rectangular(X#_)} X end
      fun {ImagPart rectangular(_#Y)} Y end
      fun {Magnitude Z}
         {Sqrt {Square {RealPart Z}} +
               {Square {ImagPart Z}}}
      end
      fun {Angle Z}
         {Atan2 {ImagPart Z} {RealPart Z}}
      end
      fun {ToString Z}
         {StringToAtom {Append "r:" {Append {FloatToString {RealPart Z}} {Append " i:" {FloatToString {ImagPart Z}}}}}}
      end
   end
[Rectangular] = {Module.apply [RECTANGULAR]}

POLAR =
   functor
   export
      makeFromRealImag : MakeFromRealImag
      makeFromMagAng   : MakeFromMagAng
      realPart         : RealPart
      imagPart         : ImagPart
      magnitude        : Magnitude
      angle            : Angle
      toString         : ToString
   define
      fun {MakeFromRealImag R I}
         polar({Sqrt {Square R} + {Square I}} # {Atan2 Y I})
      end
      fun {MakeFromMagAng M A}
         polar(M A)
      end
      fun {Magnitude polar(M#_)} M end
      fun {Angle polar(_#A)} A end
      fun {RealPart Z}
         {Magnitude Z} * {Cos {Angle Z}}
      end
      fun {ImagPart Z}
         {Magnitude Z} * {Sin {Angle Z}}
      end
      fun {ToString Z}
         {StringToAtom {Append "m:" {Append {FloatToString {Magnitude Z}} {Append " a:" {FloatToString {Angle Z}}}}}}
      end
   end
[Polar] = {Module.apply [POLAR]}

COMPLEX =
   functor
   export
      numericType      : NumericType
      makeFromRealImag : MakeFromRealImag
      makeFromMagAng   : MakeFromMagAng
      add              : Add
      subtract         : Sub
      multiply         : Mul
      divide           : Div
      equal            : Equal
      toString         : ToString
   define
      NumericType = complex
      fun {ExtractFunctor F#_} F end
      fun {ExtractValue _#Z} Z end

      fun {MakeFromRealImag R I}
         Rectangular#{Rectangular.makeFromRealImag R I}
      end
      fun {MakeFromMagAng M A}
         Polar#{Polar.makeFromMagAng M A}
      end

      fun {Add F1#Z1 F2#Z2}
         {MakeFromRealImag
            {F1.realPart Z1} + {F2.realPart Z2}
            {F1.imagPart Z1} + {F2.imagPart Z2}}
      end
      fun {Sub F1#Z1 F2#Z2}
         {MakeFromRealImag
            {F1.realPart Z1} - {F2.realPart Z2}
            {F1.imagPart Z1} - {F2.imagPart Z2}}
      end
      fun {Mul F1#Z1 F2#Z2}
         {MakeFromMagAng
            {F1.magnitude Z1} * {F2.magnitude Z2}
            {F1.angle Z1} + {F2.angle Z2}}
      end
      fun {Div F1#Z1 F2#Z2}
         {MakeFromMagAng
            {F1.magnitude Z1} / {F2.magnitude Z2}
            {F1.angle Z1} - {F2.angle Z2}}
      end
      fun {Equal F1#Z1 F2#Z2}
         {F1.realPart Z1} == {F2.realPart Z2} andthen {F1.imagPart Z1} == {F2.imagPart Z2}
      end
      fun {ToString F#Z}
         {F.toString Z}
      end
   end
[Complex] = {Module.apply [COMPLEX]}

{Browse {Complex.toString {Complex.add {Complex.makeFromRealImag 3.0 4.0}
                          {Complex.makeFromRealImag 3.0 4.0}}}}

% Message Passing (aka OOP)
local
   class ComplexOO
      % abstract methods to be implemented by subclasses
      meth makeFromRealImag(R I ?$) raise abstract end end
      meth makeFromMagAng(M A ?$) raise abstract end end
      meth realPart(?$) raise abstract end end
      meth imagPart(?$) raise abstract end end
      meth magnitude(?$) raise abstract end end
      meth angle(?$) raise abstract end end
      meth toString(?$) raise abstract end end

      % base class methods
      meth add(Z ?$)
         R = {self realPart($)} + {Z realPart($)}
         I = {self imagPart($)} + {Z imagPart($)}
      in
         {self makeFromRealImag(R I $)}
      end
      meth subtract(Z ?$)
         R = {self realPart($)} - {Z realPart($)}
         I = {self imagPart($)} - {Z imagPart($)}
      in
         {self makeFromRealImag(R I $)}
      end
      meth multiply(Z ?$)
         M = {self magnitude($)} * {Z magnitude($)}
         A = {self angle($)} + {Z angle($)}
      in
         {self makeFromMagAng(M A $)}
      end
      meth divide(Z ?$)
         M = {self magnitude($)} / {Z magnitude($)}
         A = {self angle($)} - {Z angle($)}
      in
         {self makeFromMagAng(M A $)}
      end
      meth equal(Z ?$)
         {self realPart($)} == {Z realPart($)} andthen {self imagPart($)} == {Z imagPart($)}
      end
   end

   class RectangularOO from ComplexOO
      feat RealPart ImagPart
      meth init(R I)
         self.RealPart = R
         self.ImagPart = I
      end
      meth makeFromRealImag(R I ?$)
         {New RectangularOO init(R I)}
      end
      meth makeFromMagAng(M A ?$)
         {New RectangularOO init(M*{Cos A} M*{Sin A})}
      end
      meth realPart(?$) self.RealPart end
      meth imagPart(?$) self.ImagPart end
      meth magnitude(?$)
         {Sqrt {Square self.RealPart} +
               {Square self.ImagPart}}
      end
      meth angle(?$)
         {Atan2 self.ImagPart self.RealPart}
      end
      meth toString(?$)
         {StringToAtom {Append "r:" {Append {FloatToString self.RealPart} {Append " i:" {FloatToString self.ImagPart}}}}}
      end
   end

   class PolarOO from ComplexOO
      feat Magnitude Angle
      meth init(M A)
         self.Magnitude = M
         self.Angle = A
      end
      meth makeFromRealImag(R I ?$)
         {New PolarOO init({Sqrt {Square R} + {Square I}} {Atan2 I R})}
      end
      meth makeFromMagAng(M A ?$)
         {New PolarOO init(M A)}
      end
      meth magnitude(?$) self.Magnitude end
      meth angle(?$) self.Angle end
      meth realPart(?$)
         self.Magnitude * {Cos self.Angle}
      end
      meth imagPart(?$)
         self.Magnitude * {Sin self.Angle}
      end
      meth toString(?$)
         {StringToAtom {Append "m:" {Append {FloatToString self.Magnitude} {Append " a:" {FloatToString self.Angle}}}}}
      end
   end
in
   RecX = {New RectangularOO init(3.0 4.0)}
   {Browse {RecX realPart($)}#{RecX imagPart($)}}
   {Browse {RecX magnitude($)}#{RecX angle($)}}

   PolX = {New PolarOO init({RecX magnitude($)} {RecX angle($)})}
   {Browse {PolX realPart($)}#{PolX imagPart($)}}
   {Browse {PolX magnitude($)}#{PolX angle($)}}

   AddX = {PolX add(RecX $)}
   {Browse {AddX realPart($)}#{AddX imagPart($)}}
   {Browse {AddX magnitude($)}#{AddX angle($)}}
end

% footnote
{Browse {FoldL [1 2 3 4] Number.'+' 0}}

% 2.5.1 Systems with Generic Operations - Generic Arithmetic Operations

% functor solution
OZINTEGER =
   functor
   export
      numericType : NumericType
      make        : Make
      add         : Add
      subtract    : Sub
      multiply    : Mul
      divide      : Div
      equal       : Equal
      toString    : ToString
   define
      NumericType = ozinteger
      fun {Make X} X end
      fun {Add X Y} X + Y end
      fun {Sub X Y} X - Y end
      fun {Mul X Y} X * Y end
      fun {Div X Y} X div Y end
      fun {Equal X Y} X == Y end
      fun {ToString X} {StringToAtom {IntToString X}} end
   end
[OzInteger] = {Module.apply [OZINTEGER]}

OZFLOAT =
   functor
   export
      numericType : NumericType
      make        : Make
      add         : Add
      subtract    : Sub
      multiply    : Mul
      divide      : Div
      equal       : Equal
      toString    : ToString
   define
      NumericType = ozfloat
      fun {Make X} X end
      fun {Add X Y} X + Y end
      fun {Sub X Y} X - Y end
      fun {Mul X Y} X * Y end
      fun {Div X Y} X / Y end
      fun {Equal X Y} X == Y end
      fun {ToString X} {StringToAtom {FloatToString X}} end
   end
[OzFloat] = {Module.apply [OZFLOAT]}

local
   NUMERIC =
      functor
      export
         make     : Make
         add      : Add
         subtract : Sub
         multiply : Mul
         divide   : Div
         equal    : Equal
         toString : ToString
      define
         fun {Make F X} F#X end
         fun {Add F1#X F2#Y} F1#{F1.add X Y} end
         fun {Sub F1#X F2#Y} F1#{F1.subtract X Y} end
         fun {Mul F1#X F2#Y} F1#{F1.multiply X Y} end
         fun {Div F1#X F2#Y} F1#{F1.divide X Y} end
         fun {Equal F1#X F2#Y} {F1.equal X Y} end
         fun {ToString F#X} {F.toString X} end
      end
   [Numeric] = {Module.apply [NUMERIC]}

   NR1 = {Numeric.make Rational {Rational.make 3 4}}
   NC1 = {Numeric.make Complex {Complex.makeFromRealImag 3.0 4.0}}
   NI1 = {Numeric.make OzInteger {OzInteger.make 3}}
   NF1 = {Numeric.make OzFloat {OzFloat.make 3.0}}

   NR2 = {Numeric.make Rational {Rational.make 5 6}}
   NC2 = {Numeric.make Complex {Complex.makeFromRealImag 5.0 6.0}}
   NI2 = {Numeric.make OzInteger {OzInteger.make 5}}
   NF2 = {Numeric.make OzFloat {OzFloat.make 5.0}}
in
   {Browse {Numeric.toString NR1}#{Numeric.toString NR2}}
   {Browse {Numeric.toString NC1}#{Numeric.toString NC2}}
   {Browse {Numeric.toString NI1}#{Numeric.toString NI2}}
   {Browse {Numeric.toString NF1}#{Numeric.toString NF2}}

   {Browse {Numeric.toString {Numeric.add NR1 NR2}}}
   {Browse {Numeric.toString {Numeric.add NC1 NC2}}}
   {Browse {Numeric.toString {Numeric.add NI1 NI2}}}
   {Browse {Numeric.toString {Numeric.add NF1 NF2}}}
end

% Object Solution
local
   class NumericOO
      % abstract methods to be implemented by subclasses
      meth add(X Y ?$) raise abstract end end
      meth subtract(X Y ?$) raise abstract end end
      meth multiply(X Y ?$) raise abstract end end
      meth divide(X Y ?$) raise abstract end end
      meth equal(X Y ?$) raise abstract end end
      meth toString(X ?$) raise abstract end end
   end

   class ComplexOO from NumericOO
      % abstract methods to be implemented by subclasses
      meth makeFromRealImag(R I ?$) raise abstract end end
      meth makeFromMagAng(M A ?$) raise abstract end end
      meth realPart(?$) raise abstract end end
      meth imagPart(?$) raise abstract end end
      meth magnitude(?$) raise abstract end end
      meth angle(?$) raise abstract end end

      % base class methods
      meth add(Z ?$)
         R = {self realPart($)} + {Z realPart($)}
         I = {self imagPart($)} + {Z imagPart($)}
      in
         {self makeFromRealImag(R I $)}
      end
      meth subtract(Z ?$)
         R = {self realPart($)} - {Z realPart($)}
         I = {self imagPart($)} - {Z imagPart($)}
      in
         {self makeFromRealImag(R I $)}
      end
      meth multiply(Z ?$)
         M = {self magnitude($)} * {Z magnitude($)}
         A = {self angle($)} + {Z angle($)}
      in
         {self makeFromMagAng(M A $)}
      end
      meth divide(Z ?$)
         M = {self magnitude($)} / {Z magnitude($)}
         A = {self angle($)} - {Z angle($)}
      in
         {self makeFromMagAng(M A $)}
      end
      meth equal(Z ?$)
         {self realPart($)} == {Z realPart($)} andthen {self imagPart($)} == {Z imagPart($)}
      end
   end

   class RectangularOO from ComplexOO
      feat RealPart ImagPart
      meth init(R I)
         self.RealPart = R
         self.ImagPart = I
      end
      meth makeFromRealImag(R I ?$)
         {New RectangularOO init(R I)}
      end
      meth makeFromMagAng(M A ?$)
         {New RectangularOO init(M*{Cos A} M*{Sin A})}
      end
      meth realPart(?$) self.RealPart end
      meth imagPart(?$) self.ImagPart end
      meth magnitude(?$)
         {Sqrt {Square self.RealPart} +
               {Square self.ImagPart}}
      end
      meth angle(?$)
         {Atan2 self.ImagPart self.RealPart}
      end
      meth toString(?$)
         {StringToAtom {Append "r:" {Append {FloatToString self.RealPart} {Append " i:" {FloatToString self.ImagPart}}}}}
      end
   end

   class PolarOO from ComplexOO
      feat Magnitude Angle
      meth init(M A)
         self.Magnitude = M
         self.Angle = A
      end
      meth makeFromRealImag(R I ?$)
         {New PolarOO init({Sqrt {Square R} + {Square I}} {Atan2 I R})}
      end
      meth makeFromMagAng(M A ?$)
         {New PolarOO init(M A)}
      end
      meth magnitude(?$) self.Magnitude end
      meth angle(?$) self.Angle end
      meth realPart(?$)
         self.Magnitude * {Cos self.Angle}
      end
      meth imagPart(?$)
         self.Magnitude * {Sin self.Angle}
      end
      meth toString(?$)
         {StringToAtom {Append "m:" {Append {FloatToString self.Magnitude} {Append " a:" {FloatToString self.Angle}}}}}
      end
   end

   class OzIntegerOO from NumericOO
      feat val
      meth init(X) self.val = X end
      meth add(Y ?$) {New OzIntegerOO init(self.val + Y.val)} end
      meth subtract(Y ?$) {New OzIntegerOO init(self.val - Y.val)} end
      meth multiply(Y ?$) {New OzIntegerOO init(self.val * Y.val)} end
      meth divide(Y ?$) {New OzIntegerOO init(self.val div Y.val)} end
      meth equal(Y $) self.val == Y.val end
      meth toString(?$) {StringToAtom {IntToString self.val}} end
   end

   class OzFloatOO from NumericOO
      feat val
      meth init(X) self.val = X end
      meth add(Y ?$) {New OzFloatOO init(self.val + Y.val)} end
      meth subtract(Y ?$) {New OzFloatOO init(self.val - Y.val)} end
      meth multiply(Y ?$) {New OzFloatOO init(self.val * Y.val)} end
      meth divide(Y ?$) {New OzFloatOO init(self.val div Y.val)} end
      meth equal(Y $) self.val == Y.val end
      meth toString(?$) {StringToAtom {FloatToString self.val}} end
   end

   NR1 = {New RationalOO init(3 4)}
   NC1 = {New RectangularOO init(3.0 4.0)}
   NI1 = {New OzIntegerOO init(3)}
   NF1 = {New OzFloatOO init(3.0)}

   NR2 = {New RationalOO init(5 6)}
   NC2 = {New RectangularOO init(5.0 6.0)}
   NI2 = {New OzIntegerOO init(5)}
   NF2 = {New OzFloatOO init(5.0)}
in
   {Browse {NR1 toString($)}#{NR2 toString($)}}
   {Browse {NC1 toString($)}#{NC2 toString($)}}
   {Browse {NI1 toString($)}#{NI2 toString($)}}
   {Browse {NF1 toString($)}#{NF2 toString($)}}

   {Browse {{NR1 add(NR2 $)} toString($)}}
   {Browse {{NC1 add(NC2 $)} toString($)}}
   {Browse {{NI1 add(NI2 $)} toString($)}}
   {Browse {{NF1 add(NF2 $)} toString($)}}
end

% 2.5.2 Systems with Generic Operations - Combining Data of Different Types

local
   NUMERIC =
      functor
      export
         make     : Make
         add      : Add
         subtract : Sub
         multiply : Mul
         divide   : Div
         equal    : Equal
         toString : ToString
      define
         fun {Integer2Rational X}
            {Rational.make X 1}
         end
         fun {Rational2Float X}
            {IntToFloat {Rational.numer X}} / {IntToFloat {Rational.denom X}}
         end
         fun {Float2Complex X}
            {Complex.makeFromRealImag X 0.0}
         end

         D = {NewDictionary}
         {Dictionary.put D ozinteger2rational [Integer2Rational]}
         {Dictionary.put D ozinteger2ozfloat  [Rational2Float Integer2Rational]}
         {Dictionary.put D ozinteger2complex  [Float2Complex Rational2Float Integer2Rational]}
         {Dictionary.put D rational2ozfloat   [Rational2Float]}
         {Dictionary.put D rational2complex   [Float2Complex Rational2Float]}
         {Dictionary.put D ozfloat2complex    [Float2Complex]}

         fun {Coerce F1#X F2#Y}
            if F1 == F2 then
               F1#X#Y
            else
               local
                  T1 = {AtomToString F1.numericType}
                  T2 = {AtomToString F2.numericType}
                  X2Y = {StringToAtom {Append T1 {Append "2" T2}}}
                  Y2X = {StringToAtom {Append T2 {Append "2" T1}}}
               in
                  if {Dictionary.member D X2Y} then
                     F2#{Accumulate {Dictionary.get D X2Y} fun {$ F N} {F N} end X}#Y
                  elseif {Dictionary.member D Y2X} then
                     F1#X#{Accumulate {Dictionary.get D Y2X} fun {$ F N} {F N} end Y}
                  else
                     raise coerce({StringToAtom T1} {StringToAtom T2}) end
                  end
               end
            end
         end

         fun {Make F X} F#X end
         fun {Add X Y} F#A#B = {Coerce X Y} in F#{F.add A B} end
         fun {Sub X Y} F#A#B = {Coerce X Y} in F#{F.subtract A B} end
         fun {Mul X Y} F#A#B = {Coerce X Y} in F#{F.multiply A B} end
         fun {Div X Y} F#A#B = {Coerce X Y} in F#{F.divide A B} end
         fun {Equal X Y} F#A#B = {Coerce X Y} in F#{F.equal A B} end
         fun {ToString F#X} {F.toString X} end
      end
   [Numeric] = {Module.apply [NUMERIC]}

   NR1 = {Numeric.make Rational {Rational.make 3 4}}
   NC1 = {Numeric.make Complex {Complex.makeFromRealImag 3.0 4.0}}
   NI1 = {Numeric.make OzInteger {OzInteger.make 3}}
   NF1 = {Numeric.make OzFloat {OzFloat.make 3.0}}

   NR2 = {Numeric.make Rational {Rational.make 5 6}}
   NC2 = {Numeric.make Complex {Complex.makeFromRealImag 5.0 6.0}}
   NI2 = {Numeric.make OzInteger {OzInteger.make 5}}
   NF2 = {Numeric.make OzFloat {OzFloat.make 5.0}}
in
   {Browse {Numeric.toString {Numeric.add NI1 NI2}}}
   {Browse {Numeric.toString {Numeric.add NI1 NR2}}}
   {Browse {Numeric.toString {Numeric.add NI1 NF2}}}
   {Browse {Numeric.toString {Numeric.add NI1 NC2}}}

   {Browse {Numeric.toString {Numeric.add NR1 NI2}}}
   {Browse {Numeric.toString {Numeric.add NR1 NR2}}}
   {Browse {Numeric.toString {Numeric.add NR1 NF2}}}
   {Browse {Numeric.toString {Numeric.add NR1 NC2}}}

   {Browse {Numeric.toString {Numeric.add NF1 NI2}}}
   {Browse {Numeric.toString {Numeric.add NF1 NR2}}}
   {Browse {Numeric.toString {Numeric.add NF1 NF2}}}
   {Browse {Numeric.toString {Numeric.add NF1 NC2}}}

   {Browse {Numeric.toString {Numeric.add NC1 NI2}}}
   {Browse {Numeric.toString {Numeric.add NC1 NR2}}}
   {Browse {Numeric.toString {Numeric.add NC1 NF2}}}
   {Browse {Numeric.toString {Numeric.add NC1 NC2}}}
end

% 2.5.3 Systems with Generic Operations - Example: Symbolic Algebra

% To Be Done.