Topics:SICP in other languages:Oz:Chapter 2
From CTMWiki
| Table of contents |
[edit]
About SICP
The following Oz code is derived from the examples provided in the book:
"Structure and Interpretation of Computer Programs, Second Edition"
by Harold Abelson and Gerald Jay Sussman with Julie Sussman.
http://mitpress.mit.edu/sicp/
[edit]
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
[edit]
% 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
[edit]
% 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
[edit]
% 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}}
[edit]
% 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
[edit]
% 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 *)
[edit]
% 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}
[edit]
% 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
[edit]
% 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}}
[edit]
% 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}
[edit]
% 2.3.1 Symbolic Data - Quotation
% To Be Done.
[edit]
% 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
[edit]
% 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
[edit]
% 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]}}
[edit]
% 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
[edit]
% 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}}}
[edit]
% 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}}
[edit]
% 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
[edit]
% 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
[edit]
% 2.5.3 Systems with Generic Operations - Example: Symbolic Algebra
% To Be Done.
![[Main Page]](/wiki/stylesheets/images/wiki.png)