bc15ae8de777a3ad40fe126cbe7500f02edd4890
[lambda.git] / arithmetic.mdwn
1 Here are a bunch of pre-tested operations for the untyped lambda calculus. In some cases multiple versions are offered.
2
3         ; booleans
4         let true = \y n. y  in ; aka K
5         let false = \y n. n  in ; aka K I
6         let and = \p q. p q false  in ; or
7         let and = \p q. p q p  in ; aka S C I
8         let or = \p q. p true q  in ; or
9         let or = \p q. p p q  in ; aka M
10         let not = \p. p false true  in ; or
11         let not = \p y n. p n y  in ; aka C
12         let xor = \p q. p (not q) q  in
13         let iff = \p q. not (xor p q)  in ; or
14         let iff = \p q. p q (not q)  in
15
16         ; pairs
17         let make_pair = \x y f. f x y  in
18         let get_1st = \x y. x  in ; aka true
19         let get_2nd = \x y. y  in ; aka false
20
21         ; triples
22         let make_triple = \x y z f. f x y z  in
23
24
25         ; Church numerals: basic operations
26
27         let zero = \s z. z  in ; aka false
28         let one = \s z. s z  in ; aka I
29         let succ = \n s z. s (n s z)  in
30         ; for any Church numeral n > zero : n (K y) z ~~> y
31         let iszero = \n. n (\x. false) true  in
32
33
34         ; version 3 lists
35
36         let empty = \f z. z  in
37         let make_list = \h t f z. f h (t f z)  in
38         let isempty = \lst. lst (\h sofar. false) true  in
39         let head = \lst. lst (\h sofar. h) junk  in
40         let tail = \lst. (\shift lst. lst shift (make_pair empty junk) get_2nd)
41                                 ; where shift is
42                                 (\h p. p (\t y. make_pair (make_list h t) t))  in
43         let length = \lst. lst (\h sofar. succ sofar) 0  in
44         let map = \f lst. lst (\h sofar. make_list (f h) sofar) empty  in
45         let filter = \f lst. lst (\h sofar. f h (make_list h sofar) sofar) empty  in ; or
46         let filter = \f lst. lst (\h. f h (make_list h) I) empty  in
47         let reverse = \lst. lst (\h t. t make_list (\f n. f h n)) empty  in
48         
49
50         ; version 1 lists
51
52         let empty = make_pair true junk  in
53         let make_list = \h t. make_pair false (make_pair h t)  in
54         let isempty = \lst. lst get_1st  in
55         let head = \lst. isempty lst err (lst get_2nd get_1st)  in
56         let tail_empty = empty  in
57         let tail = \lst. isempty lst tail_empty (lst get_2nd get_2nd)  in
58         
59
60         ; more math with Church numerals
61
62         let add = \m n. m succ n  in ; or
63         let add = \m n s z. m s (n s z)  in
64         let mul = \m n. m (\z. add n z) zero  in ; or
65         let mul = \m n s. m (n s)  in
66         let pow = \b exp. exp (mul b) one  in ; or
67         ; b succ : adds b
68         ; b (b succ) ; adds b b times, ie adds b^2
69         ; b (b (b succ)) ; adds b^2 b times, ie adds b^3
70         ; exp b succ ; adds b^exp
71         let pow = \b exp s z. exp b s z  in
72
73
74         ; three strategies for predecessor
75         let pred_zero = zero  in
76         let pred = (\shift n. n shift (make_pair zero pred_zero) get_2nd)
77                 ; where shift is
78                 (\p. p (\x y. make_pair (succ x) x))  in ; or
79         ; from Oleg; observe that for any Church numeral n: n I ~~> I
80         let pred = \n. iszero n zero
81                                         ; else
82                                         (n (\x. x I ; when x is the base term, this will be K zero
83                                                           ; when x is a Church numeral, it will be I
84                                                 (succ x))
85                                           ; base term
86                                           (K (K zero))
87                                         )  in
88         ; from Bunder/Urbanek
89         let pred = \n s z. n (\u v. v (u s)) (K z) I  in ; or
90
91                                         
92         ; inefficient but simple comparisons
93         let leq = \m n. iszero (n pred m)  in
94         let lt = \m n. not (leq n m)  in
95         let eq = \m n. and (leq m n) (leq n m)  in ; or
96
97
98         ; more efficient comparisons, Oleg's gt provided some simplifications
99         let leq = (\base build consume. \m n. n consume (m build base) get_1st)
100                         ; where base is
101                         (make_pair true junk)
102                         ; and build is
103                         (\p. make_pair false p)
104                         ; and consume is
105                         (\p. p get_1st p (p get_2nd))  in
106         let lt = \m n. not (leq n m)  in
107         let eq = (\base build consume. \m n. n consume (m build base) get_1st)
108                         ; 2nd element of a pair will now be of the form (K sthg) or I
109                         ; we supply the pair being consumed itself as an argument
110                         ; getting back either sthg or the pair we just consumed
111                         ; base is
112                         (make_pair true (K (make_pair false I)))
113                         ; and build is
114                         (\p. make_pair false (K p))
115                         ; and consume is
116                         (\p. p get_2nd p)  in
117         
118
119         ; -n is a fixedpoint of \x. add (add n x) x
120         ; but unfortunately Y that_function doesn't normalize
121         ; instead:
122         let sub = \m n. n pred m  in ; or
123         ; how many times we can succ n until m <= result
124         let sub = \m n. (\base build. m build base (\cur fin sofar. sofar))
125                                 ; where base is
126                                 (make_triple n false zero)
127                                 ; and build is
128                                 (\t. t (\cur fin sofar. or fin (leq m cur)
129                                                 (make_triple cur true sofar) ; enough
130                                                 (make_triple (succ cur) false (succ sofar)) ; continue
131                                 ))  in
132         ; or
133         let sub = (\base build consume. \m n. n consume (m build base) get_1st)
134                         ; where base is
135                         (make_pair zero I) ; see second defn of eq for explanation of 2nd element
136                         ; and build is
137                         (\p. p (\x y. make_pair (succ x) (K p)))
138                         ; and consume is
139                         (\p. p get_2nd p)  in
140
141
142         let min = \m n. sub m (sub m n) in
143         let max = \m n. add n (sub m n) in
144
145
146         ; (m/n) is a fixedpoint of \x. add (sub (mul n x) m) x
147         ; but unfortunately Y that_function doesn't normalize
148         ; instead:
149         ; how many times we can sub n from m while n <= result
150         let div = \m n. (\base build. m build base (\cur go sofar. sofar))
151                                 ; where base is
152                                 (make_triple m true zero)
153                                 ; and build is
154                                 (\t. t (\cur go sofar. and go (leq n cur)
155                                                 (make_triple (sub cur n) true (succ sofar)) ; continue
156                                                 (make_triple cur false sofar) ; enough
157                                 ))  in
158     ; what's left after sub n from m while n <= result
159     let mod = \m n. (\base build. m build base (\cur go. cur))
160                 ; where base is
161                 (make_pair m true)
162                 ; and build is
163                 (\p. p (\cur go. and go (leq n cur)
164                         (make_pair (sub cur n) true) ; continue
165                         (make_pair cur false) ; enough
166                 ))  in
167
168         ; or
169         let divmod = (\base build mtail. \m n.
170                                         (\dhead. m (mtail dhead) (\sel. dhead (sel 0 0)))
171                                                         (n build base (\x y z. z junk))
172                                                         (\t u x y z. make_pair t u) )
173                                 ; where base is
174                                 (make_triple succ (K 0) I) ; see second defn of eq for explanation of 3rd element
175                                 ; and build is
176                         (\t. make_triple I succ (K t))
177                                 ; and mtail is
178                                 (\dhead d. d (\dz mz df mf drest sel. drest dhead (sel (df dz) (mf mz))))
179         in
180         let div = \n d. divmod n d get_1st  in
181         let mod = \n d. divmod n d get_2nd  in
182
183
184         ; sqrt n is a fixedpoint of \x. div (div (add n (mul x x)) 2) x
185         ; but unfortunately Y that_function doesn't normalize
186
187
188         ; (log base b of m) is a fixedpoint of \x. add (sub (pow b x) m) x
189         ; but unfortunately Y that_function doesn't normalize
190         ; instead:
191         ; how many times we can mul b by b while result <= m
192         let log = \m b. (\base build. m build base (\cur go sofar. sofar))
193                 ; where base is
194                 (make_triple b true 0)
195                 ; and build is
196                 (\t. t (\cur go sofar. and go (leq cur m)
197                            (make_triple (mul cur b) true (succ sofar)) ; continue
198                            (make_triple cur false sofar) ; enough
199                 ))  in
200
201
202         ; Rosenbloom's fixed point combinator
203         let Y = \f. (\h. f (h h)) (\h. f (h h)) in
204         ; Turing's fixed point combinator
205         let Theta = (\u f. f (u u f)) (\u f. f (u u f))  in
206
207
208         ; length for version 1 lists
209         let length = Y (\self lst. isempty lst 0 (succ (self (tail lst))))  in
210
211
212         ; numhelper 0 f z ~~> z
213         ; when n > 0: numhelper n f z ~~> f (pred n)
214         ; compare Bunder/Urbanek pred
215         let numhelper = \n. n (\u v. v (u succ)) (K 0) (\p f z. f p)  in
216
217         ; accepts fixed point combinator as a parameter, so you can use different ones
218         let fact = \y. y (\self n. numhelper n (\p. mul n (self p)) 1)  in
219
220
221
222         fact Theta 3  ; returns 6
223
224
225 <!--
226         ; my original efficient comparisons
227         let leq = (\base build consume. \m n. n consume (m build base) get_1st (\x. false) true)
228                         ; where base is
229                         (make_pair zero I) ; supplying this pair as an arg to its 2nd term returns the pair
230                         ; and build is
231                         (\p. p (\x y. make_pair (succ x) (K p))) ; supplying the made pair as an arg to its 2nd term returns p (the previous pair)
232                         ; and consume is
233                         (\p. p get_2nd p)  in
234         let lt = \m n. not (leq n m) in
235         let eq = (\base build consume. \m n. n consume (m build base) true (\x. false) true)
236                         ; where base is
237                         (make_pair zero (K (make_pair one I)))
238                         ; and build is
239                         (\p. p (\x y. make_pair (succ x) (K p)))
240                         ; and consume is
241                         (\p. p get_2nd p)  in ; or
242 -->
243
244 <!--
245         gcd
246         pow_mod
247
248
249         show Oleg's definition of integers:
250                 church_to_int = \n sign. n
251                 church_to_negint = \n sign s z. sign (n s z)
252
253                 ; int_to_church
254                 abs = \int. int I
255
256                 sign_case = \int ifpos ifzero ifneg. int (K ifneg) (K ifpos) ifzero
257
258                 negate_int = \int. sign_case int (church_to_negint (abs int)) zero (church_to_int (abs int))
259
260         for more, see http://okmij.org/ftp/Computation/lambda-arithm-neg.scm
261
262 -->