SICP Chapter #01 Examples in Oz
% 1.1.1 The Elements of Programming - Expressions
{Browse 486}
{Browse 137 + 349}
{Browse 1000 - 334}
{Browse 5 * 99}
{Browse 10 div 5}
{Browse 2.7 + 10.0}
{Browse 21 + 35 + 12 + 7}
{Browse 25 * 4 * 12}
{Browse 3 * 5 + 10 - 6}
{Browse 3 * (2 * 4 + 3 + 5) + 10 - 7 + 6}
% 1.1.2 The Elements of Programming - Naming and the Environment
Size = 2
{Browse Size}
{Browse 5 * Size}
Pi = 3.14159
Radius = 10.0
{Browse Pi * Radius * Radius}
Circumference = 2.0 * Pi * Radius
{Browse Circumference}
% 1.1.3 The Elements of Programming - Evaluating Combinations
{Browse (2 + 4 * 6) * (3 + 5 + 7)}
% 1.1.4 The Elements of Programming - Compound Procedures
fun {Square X} X * X end
{Browse {Square 21}}
{Browse {Square 2 + 5}}
{Browse {Square {Square 3}}}
fun {Sum_of_Squares X Y} {Square X} + {Square Y} end
{Browse {Sum_of_Squares 3 4}}
fun {F A} {Sum_of_Squares A+1 A*2} end
{Browse {F 5}}
% 1.1.5 The Elements of Programming - The Substitution Model for Procedure Application
{Browse {F 5}}
{Browse {Sum_of_Squares 5+1 5*2}}
{Browse {Square 6} + {Square 10}}
{Browse 6*6 + 10*10}
{Browse 36 + 100}
{Browse {F 5}}
{Browse {Sum_of_Squares 5+1 5*2}}
{Browse {Square 5+1} + {Square 5*2}}
{Browse ((5 + 1) * (5 + 1)) + ((5 * 2) * (5 * 2))}
{Browse (6 * 6) + (10 * 10)}
{Browse 36 + 100}
{Browse 136}
% 1.1.6 The Elements of Programming - Conditional Expressions and Predicates
fun {Abs X}
if {IsInt X} then
if X > 0 then
X
elseif X == 0 then
0
else
~X
end
elseif {IsFloat X} then
if X > 0.0 then
X
elseif X == 0.0 then
0.0
else
~X
end
end
end
fun {Abs_1 X}
if {IsInt X} then
if X < 0 then
~X
else
X
end
elseif {IsFloat X} then
if X < 0.0 then
~X
else
X
end
end
end
X = 6
{Browse X > 5 andthen X < 10}
fun {GE X Y}
x > y orelse x == y
end
fun {GE_1 X Y}
{Not X < Y}
end
% Exercise 1.1
{Browse 10}
{Browse 5 + 3 + 4}
{Browse 9 - 1}
{Browse 6 div 2}
{Browse 2*4 + 4 - 6}
A = 3
B = A + 1
{Browse A + B + A*B}
{Browse A == B}
{Browse
if B > A andthen B < A * B then
B
else
A
end}
{Browse
if A == 4 then
6
elseif B == 4 then
6 + 7 + A
else
25
end}
{Browse 2 + if B > A then B else A end}
{Browse
if A > B then
A
elseif A < B then
B
else
~1
end * (A + 1)}
% Exercise 1.2
% Note: Oz does not have built in rational types, so we'll cheat and do it in floating point
{Browse (5.0 + 4.0 + (2.0 - (3.0 - (6.0 + 4.0/5.0)))) /
(3.0 * (6.0 - 2.0) * (2.0 - 7.0))}
% Note: The question asks for prefix form
{Browse {Float.'/' {Number.'+' 5.0 {Number.'+' 4.0 {Number.'-' 2.0 {Number.'-' 3.0 {Number.'+' 6.0 {Float.'/' 4.0 5.0}}}}}}
{Number.'*' 3.0 {Number.'*' {Number.'-' 6.0 2.0} {Number.'-' 2.0 7.0}}}}}
% Note: To do rationals properly, we need some stuff from chapter 2
RATIONAL =
functor
export
make : Make
imake : IMake
'+' : AddRat
'-' : SubRat
'*' : MulRat
'/' : DivRat
define
fun {Gcd A B} if B == 0 then A else {Gcd B (A mod B)} end end
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 {IMake N} {Make N 1} end
fun {Numer rational(N D)} N end
fun {Denom rational(N D)} D end
fun {AddRat X Y} {Make {Numer X}*{Denom Y} + {Numer Y}*{Denom X} {Denom X}*{Denom Y}} end
fun {SubRat X Y} {Make {Numer X}*{Denom Y} - {Numer Y}*{Denom X} {Denom X}*{Denom Y}} end
fun {MulRat X Y} {Make {Numer X}*{Numer Y} {Denom X}*{Denom Y}} end
fun {DivRat X Y} {Make {Numer X}*{Denom Y} {Denom X}*{Numer Y}} end
end
[Rational] = {Module.apply [RATIONAL]}
{Browse {Rational.'/' {Rational.'+' {Rational.imake 5} {Rational.'+' {Rational.imake 4} {Rational.'-' {Rational.imake 2} {Rational.'-' {Rational.imake 3} {Rational.'+' {Rational.imake 6} {Rational.make 4 5}}}}}}
{Rational.imake 3 * (6 - 2) * (2 - 7) }}}
% Exercise 1.3
fun {SumSquareMax A B C}
if A > B then
if A > C then
if B > C then
A*A + B*B
else
A*A + C*C
end
else
A*A + C*C
end
else
if B > C then
if A > C then
B*B + A*A
else
B*B + C*C
end
else
B*B + C*C
end
end
end
% or more concisely
fun {SumSquareMax_1 A B C}
X#Y = if A > B then A#B else B#A end
Z = if Y > C then Y else C end
in
X*X + Z*Z
end
% Exercise 1.4
fun {A_Plus_Abs_B A B}
{if B > 0 then Number.'+' else Number.'-' end A B}
end
% Exercise 1.5
fun {P} {P} end
fun {Test X Y}
if X == 0 then
0
else
Y
end
end
% commented out as this is in infinite loop
% {Browse {Test 0 {P}}}
% 1.1.7 The Elements of Programming - Example: Square Roots by Newton's Method
fun {GoodEnough Guess X}
{Abs {Square Guess} - X} < 0.001
end
fun {Average X Y}
(X + Y) / 2.0
end
fun {Improve Guess X}
{Average Guess X/Guess}
end
fun {SqrtIter Guess X}
if {GoodEnough Guess X} then
Guess
else
{SqrtIter {Improve Guess X} X}
end
end
fun {Sqrt_0 X}
{SqrtIter 1.0 X}
end
{Browse {Sqrt_0 9.0}}
{Browse {Sqrt_0 100.0 + 37.0}}
{Browse {Sqrt_0 {Sqrt_0 2.0}+{Sqrt_0 3.0}}}
{Browse {Square {Sqrt_0 1000.0}}}
% Exercise 1.6
fun {NewIf Predicate ThenClause ElseClause}
case Predicate
of true then ThenClause
else ElseClause
end
end
{Browse {NewIf 2==3 0 5}}
{Browse {NewIf 1==1 0 5}}
fun {SqrtIterNewIf Guess X}
{NewIf {GoodEnough Guess X}
Guess
{SqrtIterNewIf {Improve Guess X} X}}
end
fun {SqrtNewIf X}
{SqrtIterNewIf 1.0 X}
end
% commented out as this is in infinite loop
% {Browse {SqrtNewIf 9.0}}
% Exercise 1.7
fun {GoodEnoughGP Guess Prev}
{Abs Guess-Prev} / Guess < 0.001
end
fun {SqrtIterGP Guess Prev X}
if {GoodEnoughGP Guess Prev} then
Guess
else
{SqrtIterGP {Improve Guess X} Guess X}
end
end
fun {SqrtGP X}
{SqrtIterGP 4.0 1.0 X}
end
% Exercise 1.8
fun {ImproveCube Guess X}
(2.0*Guess + X/(Guess * Guess)) / 3.0
end
fun {CubeIter Guess Prev X}
if {GoodEnoughGP Guess Prev} then
Guess
else
{CubeIter {ImproveCube Guess X} Guess X}
end
end
fun {CubeRoot_0 X}
{CubeIter 27.0 1.0 X}
end
% 1.1.8 The Elements of Programming - Procedures as Black-Box Abstractions
% Same as above
% fun {Square X} X * X end
fun {Double X} X + X end
fun {Square_1 X} {Exp {Double {Log X}}} end
fun {GoodEnough_1 Guess X}
{Abs {Square Guess}-X} < 0.001
end
fun {Improve_1 Guess X}
{Average Guess X/Guess}
end
fun {SqrtIter_1 Guess X}
if {GoodEnough_1 Guess X} then
Guess
else
{SqrtIter_1 {Improve_1 Guess x} X}
end
end
fun {Sqrt_1 X}
{SqrtIter_1 1.0 X}
end
{Browse {Square 5.0}}
% Block-structured
fun {Sqrt_2 X}
fun {GoodEnough Guess X}
{Abs {Square Guess}-X} < 0.001
end
fun {Improve Guess X}
{Average Guess X/Guess}
end
fun {SqrtIter Guess X}
if {GoodEnough Guess X} then
Guess
else
{SqrtIter {Improve Guess X} X}
end
end
in
{SqrtIter 1.0 X}
end
% Taking advantage of lexical scoping
fun {Sqrt_3 X}
fun {GoodEnough Guess}
{Abs {Square Guess}-X} < 0.001
end
fun {Improve Guess}
{Average Guess X/Guess}
end
fun {SqrtIter Guess}
if {GoodEnough Guess} then
Guess
else
{SqrtIter {Improve Guess}}
end
end
in
{SqrtIter 1.0}
end
% 1.2.1 Procedures and the Processes They Generate - Linear Recursion and Iteration
% Recursive
fun {Factorial N}
if N == 1 then
1
else
N * {Factorial N-1}
end
end
{Browse {Factorial 6}}
% Iterative
fun {FactIter Product Counter MaxCount}
if Counter > MaxCount then
Product
else
{FactIter Counter*Product Counter+1 MaxCount}
end
end
fun {Factorial_1 N}
{FactIter 1 1 N}
end
% Iterative, block-structured (from footnote)
fun {Factorial_2 N}
fun {Iter Product Counter}
if Counter > N then
Product
else
{Iter Counter*Product Counter+1}
end
end
in
{Iter 1 1}
end
% Exercise 1.9
fun {Inc A} A + 1 end
fun {Dec A} A - 1 end
fun {Plus A B}
if A == 0 then
B
else
{Inc {Plus {Dec A} B}}
end
end
fun {Plus_1 A B}
if A == 0 then
B
else
{Plus_1 {Dec A} {Inc B}}
end
end
% Exercise 1.10
fun {Ax X Y}
case X#Y
of X#0 then 0
[] 0#Y then 2 * Y
[] X#1 then 2
[] X#Y then {Ax X-1 {Ax X Y-1}}
end
end
{Browse {Ax 1 10}}
{Browse {Ax 2 4}}
{Browse {Ax 3 3}}
fun {Fx N} {Ax 0 N} end
fun {G N} {Ax 1 N} end
fun {H N} {Ax 2 N} end
fun {K N} 5 * N * N end
% 1.2.2 Procedures and the Processes They Generate - Tree Recursion
% Recursive
fun {Fib N}
case N
of 0 then 0
[] 1 then 1
else {Fib N-1} + {Fib N-2}
end
end
% Iterative
fun {FibIter A B Count}
if Count == 0 then
B
else
{FibIter A+B A Count-1}
end
end
fun {Fib_1 N}
{FibIter 1 0 N}
end
% Counting change
fun {FirstDenomination KindsOfCoins}
case KindsOfCoins
of 1 then 1
[] 2 then 5
[] 3 then 10
[] 4 then 25
[] 5 then 50
end
end
fun {CC Amount KindsOfCoins}
if Amount == 0 then
1
elseif Amount < 0 then
0
elseif KindsOfCoins == 0 then
0
else
{CC Amount KindsOfCoins-1} +
{CC Amount-{FirstDenomination KindsOfCoins} KindsOfCoins}
end
end
fun {CountChange Amount}
{CC Amount 5}
end
{Browse {CountChange 100}}
% Exercise 1.11
fun {Fy N}
if N < 3 then
N
else
{Fy N-1} + 2*{Fy N-2} + 3*{Fy N-3}
end
end
fun {FIter A B C Count}
if Count == 0 then
C
else
{FIter (A + 2*B + 3*C) A B Count-1}
end
end
fun {Fz N}
{FIter 2 1 0 N}
end
% Exercise 1.12
fun {PascalsTriangle Row Col}
if Row == 0 then
1
elseif Col == 0 then
1
elseif Row == Col then
1
else
{PascalsTriangle Row-1 Col-1} + {PascalsTriangle Row-1 Col}
end
end
% 1.2.3 Procedures and the Processes They Generate - Orders of Growth
% Exercise 1.15
fun {Cube X} X * X * X end
fun {Px X} 3.0*X - 4.0*{Cube X} end
fun {Sine Angle}
if {Not {Abs Angle} > 0.1} then
Angle
else
{Px {Sine Angle/3.0}}
end
end
% 1.2.4 Procedures and the Processes They Generate - Exponentiation
% Linear recursion
fun {Expt B N}
if N == 0 then
1
else
B * {Expt B N-1}
end
end
% Linear iteration
fun {ExptIter B Counter Product}
if Counter == 0 then
Product
else
{ExptIter B Counter-1 B*Product}
end
end
fun {Expt_1 B N}
{ExptIter B N 1}
end
% Logarithmic iteration
fun {Even N} N mod 2 == 0 end
fun {FastExpt B N}
if N == 0 then
1
elseif {Even N} then
{Square {FastExpt B (N div 2)}}
else
B * {FastExpt B N-1}
end
end
% Exercise 1.16
fun {FastExpIter B N}
fun {Exp B N A}
if N == 0 then
A
elseif {Even N} then
{Exp {Square B} (N div 2) A}
else
{Exp B N-1 B*A}
end
end
in
{Exp B N 1}
end
% Exercise 1.17
fun {Multiply A B}
if B == 0 then
0
else
{Plus A {Multiply A B-1}}
end
end
fun {Halve X} X div 2 end
fun {FastMultiply A B}
if B == 0 then
0
elseif {Even B} then
{Double {FastMultiply A {Halve B}}}
else
{Plus A {Multiply A B-1}}
end
end
% Exercise 1.18
fun {PeasantMultiply A B}
fun {Iter A B Accumulator}
if B == 0 then
Accumulator
elseif {Even B} then
{Iter {Double A} {Halve B} Accumulator}
else
{Iter A B-1 Accumulator+A}
end
end
in
{Iter A B 0}
end
% Exercise 1.19
fun {FibIter_ A B P Q Count}
if Count == 0 then
B
elseif {Even Count} then
{FibIter_ A B (P*P + Q*Q) (2*P*Q + Q*Q) (Count div 2)}
else
{FibIter_ (B*Q + A*Q + A*P) (B*P + A*Q) P Q Count-1}
end
end
fun {Fib_ N}
{FibIter_ 1 0 0 1 N}
end
% 1.2.5 Procedures and the Processes They Generate - Greatest Common Divisors
fun {Gcd A B}
if B == 0 then
A
else
{Gcd B (A mod B)}
end
end
{Browse {Gcd 40 6}}
% Exercise 1.20
fun lazy {NormalOrderMod A B} A mod B end
fun lazy {NormalOrderGcd A B}
if B == 0 then
A
else
{NormalOrderGcd B {NormalOrderMod A B}}
end
end
fun {Force A} {Wait A} A end
{Browse {Gcd 206 40}}
{Browse {Force {NormalOrderGcd 206 40}}}
% 1.2.6 Procedures and the Processes They Generate - Example: Testing for Primality
% prime
fun {Divides A B} B mod A == 0 end
fun {FindDivisor N TestDivisor}
if {Square TestDivisor} > N then
N
elseif {Divides TestDivisor N} then
TestDivisor
else
{FindDivisor N TestDivisor+1}
end
end
fun {SmallestDivisor N} {FindDivisor N 2} end
fun {Prime N} N == {SmallestDivisor N} end
% fast_prime
fun {ExpMod NBase NExp M}
if NExp == 0 then
1
elseif {Even NExp} then
{Square {ExpMod NBase (NExp div 2) M}} mod M
else
NBase * {ExpMod NBase NExp-1 M} mod M
end
end
{OS.srand 0}
fun {RandomInt Min Max}
X = {OS.rand}
MinOS
MaxOS
in
{OS.randLimits ?MinOS ?MaxOS}
Min + X*(Max - Min) div (MaxOS - MinOS)
end
fun {FermatTest N}
fun {TryIt A} {ExpMod A N N} == A end
Z = {RandomInt 0 N-1}
in
{TryIt 1+Z}
end
fun {FastPrime N NTimes}
if NTimes == 0 then
true
elseif {FermatTest N} then
{FastPrime N NTimes-1}
else
false
end
end
% Exercise 1.21
{Browse {SmallestDivisor 199}}
{Browse {SmallestDivisor 1999}}
{Browse {SmallestDivisor 19999}}
% Exercise 1.22
proc {ReportPrime N ElapsedTime}
{Browse ' *** '#N#ElapsedTime}
end
fun {StartPrimeTest N StartTime}
if {Prime N} then
{ReportPrime N {Property.get 'time.user'}-StartTime}
true
else
false
end
end
fun {TimedPrimeTest N}
{StartPrimeTest N {Property.get 'time.user'}}
end
proc {SearchForPrimes N I}
if N > 2 andthen {Even N} then
{SearchForPrimes N+1 I}
elseif {TimedPrimeTest N} then
if I > 1 then
{SearchForPrimes N+2 I-1}
end
else
{SearchForPrimes N+2 I}
end
end
{SearchForPrimes 1000 3}
{SearchForPrimes 10000 3}
{SearchForPrimes 100000 3}
{SearchForPrimes 1000000 3}
% Exercise 1.23
fun {NextDivisor N}
if N == 2 then
3
else
N+2
end
end
fun {FindDivisor_1 N TestDivisor}
if {Square TestDivisor} > N then
N
elseif {Divides TestDivisor N} then
TestDivisor
else
{FindDivisor_1 N {NextDivisor TestDivisor}}
end
end
% Exercise 1.24
fun {FastStartPrimeTest N StartTime}
if {FastPrime N 100} then
{ReportPrime N {Property.get 'time.user'}-StartTime}
true
else
false
end
end
fun {FastTimedPrimeTest N}
{FastStartPrimeTest N {Property.get 'time.user'}}
end
proc {FastSearchForPrimes N I}
if N > 2 andthen {Even N} then
{FastSearchForPrimes N+1 I}
elseif {FastTimedPrimeTest N} then
if I > 1 then
{FastSearchForPrimes N+2 I-1}
end
else
{FastSearchForPrimes N+2 I}
end
end
{FastSearchForPrimes 1000 3}
{FastSearchForPrimes 10000 3}
{FastSearchForPrimes 100000 3}
{FastSearchForPrimes 1000000 3}
% Exercise 1.25
fun {ExpMod_1 NBase NExp M}
{FastExpt NBase NExp} mod M
end
% Exercise 1.26
fun {ExpMod_2 NBase NExp M}
if NExp == 0 then
1
elseif {Even NExp} then
{ExpMod_2 NBase (NExp div 2) M} * {ExpMod_2 NBase (NExp div 2) M} mod M
else
NBase * {ExpMod_2 NBase NExp-1 M} mod M
end
end
% Exercise 1.27
fun {Carmichael N}
{FastPrime N 100} andthen {Not {Prime N}}
end
{Browse {Carmichael 1105}}
{Browse {Carmichael 1729}}
{Browse {Carmichael 2465}}
{Browse {Carmichael 2821}}
{Browse {Carmichael 6601}}
% Exercise 1.28
fun {ExpMod_3 NBase NExp M}
if NExp == 0 then
1
elseif {Even NExp} then
local
Candidate = {ExpMod_3 NBase (NExp div 2) M}
Root = {Square Candidate} mod M
in
if Candidate \= 1 andthen Candidate \= M-1 andthen Root == 1 then
0
else
Root
end
end
else
NBase * {ExpMod_3 NBase NExp-1 M} mod M
end
end
fun {MillerRabinTest N}
fun {MillerRabinIteration A T N}
fun {TryIt A}
{ExpMod_3 A N-1 N} == 1
end
in
if A == N then
T > N div 2
else
if {TryIt A} then
{MillerRabinIteration A+1 T+1 N}
else
{MillerRabinIteration A+1 T N}
end
end
end
in
{MillerRabinIteration 1 0 N}
end
{Browse {MillerRabinTest 5}}
{Browse {MillerRabinTest 15}}
{Browse {MillerRabinTest 97}}
{Browse {MillerRabinTest 121}}
{Browse {MillerRabinTest 1003}}
{Browse {MillerRabinTest 1009}}
{Browse {MillerRabinTest 100003}}
{Browse {MillerRabinTest 100005}}
{Browse {MillerRabinTest 561}}
{Browse {MillerRabinTest 1105}}
{Browse {MillerRabinTest 1729}}
{Browse {MillerRabinTest 2465}}
{Browse {MillerRabinTest 2821}}
{Browse {MillerRabinTest 6601}}
% 1.3 Formulating Abstractions with Higher-Order Procedures
fun {Cube_1 X} X * X * X end
% 1.3.1 Formulating Abstractions with Higher-Order Procedures - Procedures as Arguments
fun {SumIntegers A B}
if A > B then
0
else
A + {SumIntegers A+1 B}
end
end
fun {SumCubes A B}
if A > B then
0
else
{Cube A} + {SumCubes A+1 B}
end
end
fun {PiSum A B}
if A > B then
0.0
else
1.0/(A * (A + 2.0)) + {PiSum A+4.0 B}
end
end
fun {Sum Term A Next B}
if A > B then
0
else
{Term A} + {Sum Term {Next A} Next B}
end
end
% Using sum
fun {Inc_1 N} N + 1 end
fun {SumCubes_1 A B}
{Sum Cube_1 A Inc B}
end
{Browse {SumCubes_1 1 10}}
fun {Identity X} X end
fun {SumIntegers_1 A B}
{Sum Identity A Inc_1 B}
end
{Browse {SumIntegers_1 1 10}}
fun {SumReal Term A Next B}
if A > B then
0.0
else
{Term A} + {SumReal Term {Next A} Next B}
end
end
fun {PiSum_1 A B}
fun {PiTerm X} 1.0 / (X * (X + 2.0)) end
fun {PiNext X} X + 4.0 end
in
{SumReal PiTerm A PiNext B}
end
{Browse 8.0 * {PiSum_1 1.0 1000.0}}
fun {Integral F A B Dx}
fun {AddDx X} X + Dx end
in
{SumReal F A+(Dx / 2.0) AddDx B} * Dx
end
fun {CubeReal X} X * X * X end
{Browse {Integral CubeReal 0.0 1.0 0.01}}
{Browse {Integral CubeReal 0.0 1.0 0.001}}
% Exercise 1.29
fun {Simpson F A B N}
H = {Abs B-A} / {IntToFloat N}
fun {SumIter Term Start Next Stop Acc}
if Start > Stop then
Acc
else
{SumIter Term {Next Start} Next Stop (Acc + {Term A + {IntToFloat Start}*H})}
end
end
in
H * {SumIter F 1 Inc N 0.0}
end
{Browse {Simpson CubeReal 0.0 1.0 100}}
% Exercise 1.30
fun {Sum_1 Term A Next B}
fun {Iter A Result}
if A > B then
Result
else
{Iter {Next A} (Result + {Term A})}
end
end
in
{Iter A 0}
end
fun {SumCubes_2 A B}
{Sum_1 Cube A Inc B}
end
{Browse {SumCubes_2 1 10}}
% Exercise 1.31
fun {Product Term A Next B}
if A > B then
1
else
{Term A} * {Product Term {Next A} Next B}
end
end
fun {Factorial_3 N}
{Product Identity 1 Inc N}
end
{Browse {Factorial_3 5}}
fun {ProductIter Term A Next B Acc}
if A > B then
Acc
else
{ProductIter Term {Next A} Next B (Acc * {Term A})}
end
end
fun {WallisPi N}
fun {WallisTerm K}
Nom = K + if {Even K} then 2 else 1 end
Denom = K + if {Even K} then 1 else 2 end
in
{IntToFloat Nom} / {IntToFloat Denom}
end
in
4.0 * {ProductIter WallisTerm 1 Inc N 1.0}
end
{Browse {WallisPi 100}}
% Exercise 1.32
fun {Accumulate Combiner NullValue Term A Next B}
if A > B then
NullValue
else
{Combiner {Term A} {Accumulate Combiner NullValue Term {Next A} Next B}}
end
end
fun {Sum_2 A B} {Accumulate Number.'+' 0 Identity A Inc B} end
fun {Product_2 A B} {Accumulate Number.'*' 1 Identity A Inc B} end
fun {AccumulateIter Combiner Term A Next B Acc}
if A > B then
Acc
else
{AccumulateIter Combiner Term {Next A} Next B {Combiner Acc {Term A}}}
end
end
fun {Sum_3 A B} {AccumulateIter Number.'+' Identity A Inc B 0} end
fun {Product_3 A B} {AccumulateIter Number.'*' Identity A Inc B 1} end
% Exercise 1.33
fun {FilteredAccumulate Combiner NullValue Term A Next B Pred}
if A > B then
NullValue
elseif {Pred A} then
{Combiner {Term A} {FilteredAccumulate Combiner NullValue Term {Next A} Next B Pred}}
else
{FilteredAccumulate Combiner NullValue Term {Next A} Next B Pred}
end
end
fun {SumSquaresOfPrimes A B}
{FilteredAccumulate Number.'+' 0 Square A Inc B Prime}
end
{Browse {SumSquaresOfPrimes 2 5}}
fun {ProductOfRelativelyPrime N}
fun {IsRelativelyPrimeToN K}
{Gcd K N} == 1
end
in
{FilteredAccumulate Number.'*' 1 Identity 1 Inc N-1 IsRelativelyPrimeToN}
end
% 1.3.2 Formulating Abstractions with Higher-Order Procedures - Constructing Procedures Using Lambda
fun {PiSum_2 A B}
{SumReal fun {$ X} 1.0 / (X * (X + 2.0)) end A fun {$ X} X + 4.0 end B}
end
fun {Integral_1 F A B Dx}
{SumReal F A+(Dx / 2.0) fun {$ X} X + Dx end B} * Dx
end
fun {Plus4 X} X + 4 end
Plus4_1 = fun {$ X} X + 4 end
{Browse {fun {$ X Y Z} X + Y + {Square Z} end 1 2 3}}
% Using let
fun {F_1 X Y}
fun {FHelper A B}
X*{Square A} + Y*B + A*B
end
in
{FHelper (1 + X*Y) 1-Y}
end
fun {F_2 X Y}
{fun {$ A B} X*{Square A} + Y*B + A*B end
(1 + X*Y) 1-Y}
end
fun {F_3 X Y}
A = 1 + X*Y
B = 1 - Y
in
X*{Square A} + Y*B + A*B
end
Xa = 5
{Browse
local
Xa = 3
in
Xa + Xa*10
end + Xa}
Xb = 2
{Browse
local
Xb = 3
Y = Xb + 2
in
Xb * Y
end}
fun {F_4 X Y}
A = 1 + X*Y
B = 1 - Y
in
X*{Square A} + Y*B + A*B
end
% Exercise 1.34
fun {F_5 G} {G 2} end
{Browse {F_5 Square}}
{Browse {F_5 fun {$ Z} Z * (Z + 1) end}}
% {Browse {F_5 F_5}}
% 1.3.3 Formulating Abstractions with Higher-Order Procedures - Procedures as General Methods
% Half-interval method
fun {CloseEnough X Y}
{Abs X-Y} < 0.001
end
fun {Positive X} X >= 0.0 end
fun {Negative X} {Not {Positive X}} end
fun {Searchx F NegPoint PosPoint}
MidPoint = {Average NegPoint PosPoint}
in
if {CloseEnough NegPoint PosPoint} then
MidPoint
else
local
TestValue = {F MidPoint}
in
if {Positive TestValue} then
{Searchx F NegPoint MidPoint}
elseif {Negative TestValue} then
{Searchx F MidPoint PosPoint}
else
MidPoint
end
end
end
end
fun {HalfIntervalMethod F A B}
AValue = {F A}
BValue = {F B}
in
if {Negative AValue} andthen {Positive BValue} then
{Searchx F A B}
elseif {Negative BValue} andthen {Positive AValue} then
{Searchx F B A}
else
raise invalid('Values are not of opposite sign ' # A # ' ' # B) end
end
end
{Browse {HalfIntervalMethod Sin 2.0 4.0}}
{Browse {HalfIntervalMethod fun {$ X} X*X*X - 2.0*X - 3.0 end 1.0 2.0}}
% Fixed points
Tolerance = 0.00001
fun {FixedPoint F FirstGuess}
fun {CloseEnough V1 V2}
{Abs V1-V2} < Tolerance
end
fun {Try Guess}
Next = {F Guess}
in
if {CloseEnough Guess Next} then
Next
else
{Try Next}
end
end
in
{Try FirstGuess}
end
{Browse {FixedPoint Cos 1.0}}
{Browse {FixedPoint fun {$ Y} {Sin Y} + {Cos Y} end 1.0}}
% note: this function does not converge
fun {Sqrt_4 X}
{FixedPoint fun {$ Y} X / Y end 1.0}
end
fun {Sqrt_5 X}
{FixedPoint fun {$ Y} {Average Y X/Y} end 1.0}
end
% Exercise 1.35
fun {GoldenRatio}
{FixedPoint fun {$ X} 1.0 + 1.0/X end 1.0}
end
{Browse {GoldenRatio}}
% Exercise 1.36
% 35 guesses before convergence
{Browse {FixedPoint fun {$ X} {Log 1000.0} / {Log X} end 1.5}}
% 11 guesses before convergence (AverageDamp defined below)
%{Browse {FixedPoint {AverageDamp fun {$ X} {Log 1000.0} / {Log X} end} 1.5}}
% Exercise 1.37
fun {ContFrac N D K}
fun {Frac I}
{N I} / ({D I} + if I == K then 0.0 else {Frac I+1} end)
end
in
{Frac 1}
end
{Browse {ContFrac fun {$ I} 1.0 end fun {$ I} 1.0 end 11}}
fun {ContFracIter N D K}
fun {FracIter I Result}
if I == 0 then
Result
else
{FracIter I-1 {N I}/({D I} + Result)}
end
end
in
{FracIter K 0.0}
end
{Browse {ContFracIter fun {$ I} 1.0 end fun {$ I} 1.0 end 11}}
% Exercise 1.38
{Browse
{ContFrac
fun {$ I} 1.0 end
fun {$ I}
if (I+1) mod 3 == 0 then
2.0 * ({IntToFloat I}+1.0)/3.0
else
1.0
end
end
10}}
% Exercise 1.39
fun {TanCF X K}
fun {N I}
if I == 1 then
X
else
~(X*X)
end
end
fun {D I}
{IntToFloat I}*2.0 - 1.0
end
in
{ContFrac N D K}
end
fun {DegreesToRadians D}
(D/360.0) * 2.0 * 3.14
end
{Browse {TanCF {DegreesToRadians 30.0} 1000}}
% 1.3.4 Formulating Abstractions with Higher-Order Procedures - Procedures as Returned Values
fun {AverageDamp F}
fun {$ X} {Average X {F X}} end
end
{Browse {{AverageDamp Square} 10.0}}
fun {Sqrt_6 X}
{FixedPoint {AverageDamp fun {$ Y} X / Y end} 1.0}
end
fun {CubeRoot X}
{FixedPoint {AverageDamp fun {$ Y} X / {Square Y} end} 1.0}
end
% Newton's method
Dx = 0.00001
fun {Deriv G}
fun {$ X} ({G X+Dx} - {G X}) / Dx end
end
fun {Cube_2 X} X * X * X end
{Browse {{Deriv Cube_2} 5.0}}
fun {NewtonTransform G}
fun {$ X} X - {G X} / {{Deriv G} X} end
end
fun {NewtonsMethod G Guess}
{FixedPoint {NewtonTransform G} Guess}
end
fun {Sqrt_7 X}
{NewtonsMethod fun {$ Y} {Square Y} - X end 1.0}
end
% Fixed point of transformed function
fun {FixedPointOfTransform G Transform Guess}
{FixedPoint {Transform G} Guess}
end
fun {Sqrt_8 X}
{FixedPointOfTransform fun {$ Y} X / Y end AverageDamp 1.0}
end
fun {Sqrt_9 X}
{FixedPointOfTransform fun {$ Y} {Square Y} - X end NewtonTransform 1.0}
end
% Exercise 1.40
fun {Cubic A B C}
fun {$ X} {Cube X} + A*X*X + B*X + C end
end
{Browse {NewtonsMethod {Cubic 5.0 3.0 2.5} 1.0}}
% Exercise 1.41
fun {Double_ F}
fun {$ X} {F {F X}} end
end
{Browse {{Double_ Inc} 5}}
{Browse {{{Double_ Double_} Inc} 5}}
{Browse {{{Double_ {Double_ Double_}} Inc} 5}}
% Exercise 1.42
fun {Compose F G}
fun {$ X} {F {G X}} end
end
{Browse {{Compose Square Inc} 6}}
% Exercise 1.43
fun {Repeated F N}
if N == 0 then
Identity
else
{Compose F {Repeated F N-1}}
end
end
{Browse {{Repeated Square 2} 5}}
% Exercise 1.44
fun {Smooth F}
Dx = 0.00001
in
fun {$ X} ({F X-Dx} + {F X} + {F X+Dx}) / 3.0 end
end
{Browse {FixedPoint {Smooth fun {$ X} {Log 1000.0} / {Log X} end} 1.5}}
fun {NFoldSmooth F N}
{Repeated {Smooth F} N}
end
% Exercise 1.45
fun {RepeatedDampenRoot X NRoot NRepeat}
{FixedPointOfTransform
fun {$ Y} {Average Y X/{Pow Y {IntToFloat NRoot-1}}} end
{Repeated AverageDamp NRepeat}
1.0}
end
{Browse {RepeatedDampenRoot 625.0 4 2}}
% Exercise 1.46
fun {IterativeImprove GoodEnough Improve}
fun {Iterate Guess}
Next = {Improve Guess}
in
if {GoodEnough Guess Next} then
Next
else
{Iterate Next}
end
end
in
fun {$ X} {Iterate X} end
end
fun {Sqrt_10 X}
ToleranceX = 0.00001
in
{
{IterativeImprove
fun {$ G N}
{Abs N*N - X} < ToleranceX
end
fun {$ G}
(G + X/G) / 2.0
end}
1.0
}
end
{Browse {Sqrt_10 25.0}}
fun {FixedPoint_ F FirstGuess}
ToleranceX = 0.00001
fun {GoodEnough V1 V2}
{Abs V1-V2} < ToleranceX
end
in
{{IterativeImprove GoodEnough F} FirstGuess}
end
{Browse {FixedPoint_ {AverageDamp fun {$ X} {Log 1000.0} / {Log X} end} 1.5}}
|