Combinator Calculator: The purest math you'll ever see

[STxAxTIC]

Alright, this post will mostly appeal to the theory-heads out there, but maybe there's some unforseen value in making a general-audience post about this, so here we go.

Today the Science Department of QB64 brings your attention to the oldest, most powerful model of computing ever conceived. Before Turing machines, before lambda calculus - in December 1920, the world was alerted to the S and K combinators. These are abstract functions that you can implement very easily on a computer or another device to make that device become a computer. Here are the functions:

Code: [Select]

s[x][y][z] = x[z][y[z]]
k[x][y] = x

... and that's it. The entirety of computing is in those two functions. All data, all algorithms. Everything you've ever written or will write, whether it be code or it be mathematics, can be compiled to/from those S and K combinators as such. One paper I came across said something like "S and K combinators are the machine language of mathematics". I totally jive with this statement. I got so into this actually, that I had to implement this language in QB64. I'll 'splain you it all.

But first, quiz time. You fall into one of three categories right now:

1)
If you're lost or mostly uninterested, forget about whatever you just read and check out the calculator I made. It does plus, times, and exponents, but only on the integers. Code at the bottom!

2)
If you want to know what's going on so far, and want to hear it *from me*, then I wrote all about this (in Notepad with no spell check and in a hurry, and I still need to add images):
http://barnes.x10host.com/pages/Function-Officium/Function-Officium-One.php
http://barnes.x10host.com/pages/Function-Officium/Function-Officium-Two.php

3)
If you want it straight from the horse's mouth, I suggest you start with this:
https://people.cs.uchicago.edu/~odonnell/Teacher/Lectures/Formal_Organization_of_Knowledge/Examples/combinator_calculus/
https://writings.stephenwolfram.com/2020/12/combinators-a-centennial-view/

To play with this, have it crank out some math for you. You can thumb through the examples in the code I commented out - they will make more sense if read alongside my online notes.

Code: QB64: [Select]

1. OPTION _EXPLICIT
2.  
3. DIM a AS INTEGER
4. DIM b AS INTEGER
5. DIM c AS INTEGER
6. DIM d AS STRING
7. DIM e AS STRING
8.  
9. DO
10.     _KEYCLEAR
11.     INPUT "Enter first integer: ", a
12.     INPUT "Enter second integer: ", b
13.     c = -1
14.     DO WHILE ((c < 1) OR (c > 3))
15.         INPUT "Enter operation. 1 for add, 2 for multiply, 3 for exponent: ", c
16.     LOOP
17.     PRINT
18.  
19.     SELECT CASE c
20.         CASE 1
21.             d = "+"
22.             e = "s[k[s]][s[k[s[k[s]]]][s[k[k]]]]"
23.         CASE 2
24.             d = "*"
25.             e = "s[k[s]][k]"
26.         CASE 3
27.             d = "^"
28.             e = "s[k[s[s[k][k]]]][k]"
29.     END SELECT
30.  
31.     PRINT "You entered:"
32.     PRINT a; d; b
33.     PRINT
34.     PRINT "Translation of problem: "
35.     PRINT NumberPrefix$(a); e; NumberPrefix$(b)
36.     PRINT
37.     PRINT "Press any key to compute..."
38.     SLEEP
39.  
40.     SELECT CASE c
41.         CASE 1
42.             PRINT InterpretInteger&(EvalLoop$(SumPrefix$(a, b) + "[s][k]"))
43.             PRINT "Result:"; a; d; b; "="; a + b
44.         CASE 2
45.             PRINT InterpretInteger&(EvalLoop$(ProductPrefix$(a, b) + "[s][k]"))
46.             PRINT "Result:"; a; d; b; "="; a * b
47.         CASE 3
48.             PRINT InterpretInteger&(EvalLoop$(ExponentPrefix$(a, b) + "[s][k]"))
49.             PRINT "Result:"; a; d; b; "="; a ^ b
50.     END SELECT
51.     PRINT
52.  
53. LOOP
54.  
55. '' Identity
56. 'PRINT EvalLoop$("s[k][k]" + "[a]")
57.  
58. '' Wolfram's example
59. 'PRINT EvalLoop$("s[s[k[s]][s[k[k]][s[k[s]][k]]]][s[k[s[s[k][k]]]][k]]")
60. 'PRINT EvalLoop$("s[s[k[s]][s[k[k]][s[k[s]][k]]]][s[k[s[s[k][k]]]][k]][a][b][c]")
61.  
62. '' Zero
63. 'PRINT EvalLoop$("s[k]" + "[s][k]")
64. 'PRINT EvalLoop$(NumberPrefix$(0) + "[s][k]")
65.  
66. '' One
67. 'PRINT EvalLoop$("s[s[k[s]][k]][s[k]]" + "[s][k]")
68. 'PRINT EvalLoop$("s[s[k[s]][k]]" + "[s[k]][s][k]")
69. 'PRINT EvalLoop$(NumberPrefix$(1) + "[s][k]")
70.  
71. '' Two
72. 'PRINT EvalLoop$("s[s[k[s]][k]][s[s[k[s]][k]][s[k]]]" + "[s][k]")
73. 'PRINT EvalLoop$("s[s[k[s]][k]]" + "[" + "s[s[k[s]][k]]" + "[s[k]]][s][k]")
74. 'PRINT EvalLoop$(NumberPrefix$(2) + "[s][k]")
75.  
76. '' Three
77. 'PRINT EvalLoop$("s[s[k[s]][k]][s[s[k[s]][k]][s[s[k[s]][k]][s[k]]]]" + "[s][k]")
78. 'PRINT EvalLoop$("s[s[k[s]][k]]" + "[" + "s[s[k[s]][k]]" + "[" + "s[s[k[s]][k]]" + "[s[k]]]][s][k]")
79. 'PRINT EvalLoop$(NumberPrefix$(3) + "[s][k]")
80.  
81. '' Sum
82. 'PRINT EvalLoop$("s[k[s]][s[k[s[k[s]]]][s[k[k]]]][s[s[k[s]][k]][s[k]]][s[s[k[s]][k]][s[s[k[s]][k]][s[k]]]][s][k]")
83. 'PRINT EvalLoop$(SumPrefix$(1, 2) + "[s][k]")
84. 'PRINT EvalLoop$(SumPrefix$(3, 4) + "[s][k]")
85. 'PRINT EvalLoop$(SumPrefix$(30, 40) + "[s][k]")
86.  
87. '' Product
88. 'PRINT EvalLoop$("s[k[s]][k][s[s[k[s]][k]][s[s[k[s]][k]][s[k]]]][s[s[k[s]][k]][s[s[k[s]][k]][s[k]]]][s][k]")
89. 'PRINT EvalLoop$(ProductPrefix$(2, 2) + "[s][k]")
90. 'PRINT EvalLoop$(ProductPrefix$(3, 2) + "[s][k]")
91. 'PRINT EvalLoop$(ProductPrefix$(2, 3) + "[s][k]")
92.  
93. '' Exponent
94. 'PRINT EvalLoop$(ExponentPrefix$(3, 2) + "[s][k]")
95.  
96. '' Self-apply: siix
97. 'PRINT EvalLoop$("s[s[k][k]][s[k][k]][x]")
98.  
99. '' Infinite loop: sii(sii)
100. 'PRINT EvalLoop$("s[s[k][k]][s[k][k]][s[s[k][k]][s[k][k]]]")
101.  
102. '' Swap: s(k(si))(s(kk)i)ab
103. 'PRINT EvalLoop$("s[k[s[s[k][k]]]][s[k[k]][s[k][k]]][a][b]")
104.  
105. '' Self-reference 1:
106. 'PRINT EvalLoop$("s[k[x]][s[s[k][k]][s[k][k]]][y]")
107.  
108. '' Self-reference 2: (infinite loop)
109. 'PRINT EvalLoop$("s[k[x]][s[s[k][k]][s[k][k]]][s[k[x]][s[s[k][k]][s[k][k]]]]")
110.  
111. END
112.  
113. ' Human helper fucntion(s)
114.  
115. FUNCTION InterpretInteger& (t AS STRING)
116.     DIM TheReturn AS LONG
117.     DIM j AS INTEGER
118.     DIM w AS STRING
119.     TheReturn = 0
120.     w = t
121.     j = INSTR(w, "s")
122.     DO WHILE (j <> 0)
123.         TheReturn = TheReturn + 1
124.         w = RIGHT$(w, LEN(w) - j - 1)
125.         j = INSTR(w, "s")
126.     LOOP
127.     InterpretInteger& = TheReturn
128. END FUNCTION
129.  
130. ' Math functions
131.  
132. FUNCTION ExponentPrefix$ (a AS INTEGER, b AS INTEGER)
133.     ExponentPrefix$ = "s[k[s[s[k][k]]]][k]" + "[" + NumberPrefix$(a) + "]" + "[" + NumberPrefix$(b) + "]"
134. END FUNCTION
135.  
136. FUNCTION ProductPrefix$ (a AS INTEGER, b AS INTEGER)
137.     ProductPrefix$ = "s[k[s]][k]" + "[" + NumberPrefix$(a) + "]" + "[" + NumberPrefix$(b) + "]"
138. END FUNCTION
139.  
140. FUNCTION SumPrefix$ (a AS INTEGER, b AS INTEGER)
141.     SumPrefix$ = "s[k[s]][s[k[s[k[s]]]][s[k[k]]]]" + "[" + NumberPrefix$(a) + "]" + "[" + NumberPrefix$(b) + "]"
142. END FUNCTION
143.  
144. FUNCTION NumberPrefix$ (n AS LONG)
145.     NumberPrefix$ = Nest$("s[s[k[s]][k]]", "s[k]", n)
146. END FUNCTION
147.  
148. ' Higher-order functions
149.  
150. FUNCTION Nest$ (f AS STRING, x AS STRING, n AS LONG)
151.     DIM TheReturn AS STRING
152.     DIM AS LONG j
153.     TheReturn = x
154.     IF (n > 0) THEN
155.         FOR j = 1 TO n
156.             TheReturn = f + "[" + TheReturn + "]"
157.         NEXT
158.     END IF
159.     Nest$ = TheReturn
160. END FUNCTION
161.  
162. ' Eval functions
163.  
164. FUNCTION EvalLoop$ (TheStringIn AS STRING)
165.     DIM TheReturn AS STRING
166.     DIM Tmp AS STRING
167.     DIM k AS INTEGER
168.     Tmp = TheStringIn
169.     TheReturn = TheStringIn
170.     PRINT TheReturn
171.     k = 0
172.     DO
173.         Tmp = EvalStep$(TheReturn)
174.         IF (Tmp <> TheReturn) THEN
175.             k = k + 1
176.             TheReturn = Tmp
177.             PRINT "Step "; _TRIM$(STR$(k)); ": "; TheReturn
178.         ELSE
179.             EXIT DO
180.         END IF
181.         '_DELAY .025
182.     LOOP
183.     EvalLoop$ = TheReturn
184. END FUNCTION
185.  
186. FUNCTION EvalStep$ (TheStringIn AS STRING)
187.     DIM TheReturn AS STRING
188.     DIM AS STRING ArgListS(3)
189.     DIM AS STRING ArgListK(2)
190.     DIM AS LONG s0, k0
191.     DIM AS STRING t1, t2
192.     TheReturn = TheStringIn
193.     s0 = FindValidS(TheStringIn, ArgListS())
194.     k0 = FindValidK(TheStringIn, ArgListK())
195.     IF (s0 < k0) THEN
196.         t1 = "s" + ArgListS(1) + ArgListS(2) + ArgListS(3)
197.         t2 = Shave$(ArgListS(1)) + "[" + Shave$(ArgListS(3)) + "][" + Shave$(ArgListS(2)) + "[" + Shave$(ArgListS(3)) + "]]"
198.         TheReturn = Replace$(TheStringIn, t1, t2)
199.     END IF
200.     IF (k0 < s0) THEN
201.         t1 = "k" + ArgListK(1) + ArgListK(2)
202.         t2 = Shave$(ArgListK(1))
203.         TheReturn = Replace$(TheStringIn, t1, t2)
204.     END IF
205.     EvalStep$ = TheReturn
206. END FUNCTION
207.  
208. ' Parsing functions
209.  
210. FUNCTION Shave$ (TheStringIn AS STRING)
211.     DIM TheReturn AS STRING
212.     TheReturn = TheStringIn
213.     TheReturn = LEFT$(TheReturn, LEN(TheReturn) - 1)
214.     TheReturn = RIGHT$(TheReturn, LEN(TheReturn) - 1)
215.     Shave$ = TheReturn
216. END FUNCTION
217.  
218. FUNCTION Replace$ (TheStringIn AS STRING, TargetSegment AS STRING, NewSegment AS STRING)
219.     DIM TheReturn AS STRING
220.     DIM k AS INTEGER
221.     k = INSTR(TheStringIn, TargetSegment)
222.     IF (k <> 0) THEN
223.         TheReturn = LEFT$(TheStringIn, k - 1) + NewSegment + RIGHT$(TheStringIn, LEN(TheStringIn) - k - LEN(TargetSegment) + 1)
224.     ELSE
225.         TheReturn = TheStringIn
226.     END IF
227.     Replace$ = TheReturn
228. END FUNCTION
229.  
230. SUB FindArgs (TheStringIn AS STRING, StartPos AS LONG, NumArgs AS LONG, arr() AS STRING)
231.     DIM TheString AS STRING
232.     DIM AS LONG i, j0, j1, j2, bal
233.     TheString = TheStringIn
234.     j0 = 0
235.     j1 = 0
236.     j2 = 0
237.     bal = 0
238.     i = StartPos
239.     DO WHILE (i <= LEN(TheString))
240.         i = i + 1
241.         IF (MID$(TheString, i, 1) = "[") THEN
242.             bal = bal + 1
243.             IF (bal = 1) THEN j1 = i
244.         END IF
245.         IF (MID$(TheString, i, 1) = "]") THEN
246.             bal = bal - 1
247.             IF (bal = 0) THEN j2 = i
248.         END IF
249.         IF ((j1 <> 0) AND (j2 <> 0) AND (bal = 0)) THEN
250.             j0 = j0 + 1
251.             arr(j0) = MID$(TheString, j1, j2 - j1 + 1)
252.             j1 = 0
253.             j2 = 0
254.             bal = 0
255.             IF (j0 = NumArgs) THEN EXIT DO
256.         END IF
257.     LOOP
258. END SUB
259.  
260. FUNCTION FindValidS& (TheStringIn AS STRING, arr() AS STRING)
261.     DIM TheReturn AS LONG
262.     DIM Tmp AS STRING
263.     DIM AS LONG j, n
264.     TheReturn = 2147483647
265.     Tmp = TheStringIn
266.     FOR j = 1 TO UBOUND(arr)
267.         arr(j) = ""
268.     NEXT
269.     n = 0
270.     DO
271.         j = INSTR(Tmp, "s")
272.         IF (j > 0) THEN
273.             CALL FindArgs(Tmp, j, 3, arr())
274.             IF ((arr(1) <> "") AND (arr(2) <> "") AND (arr(3) <> "")) THEN
275.                 TheReturn = j + n
276.                 EXIT DO
277.             ELSE
278.                 Tmp = RIGHT$(Tmp, LEN(Tmp) - j)
279.                 n = LEN(TheStringIn) - LEN(Tmp)
280.             END IF
281.         ELSE
282.             EXIT DO
283.         END IF
284.     LOOP
285.     FindValidS& = TheReturn
286. END FUNCTION
287.  
288. FUNCTION FindValidK& (TheStringIn AS STRING, arr() AS STRING)
289.     DIM TheReturn AS LONG
290.     DIM Tmp AS STRING
291.     DIM AS LONG j, n
292.     TheReturn = 2147483647
293.     Tmp = TheStringIn
294.     FOR j = 1 TO UBOUND(arr)
295.         arr(j) = ""
296.     NEXT
297.     n = 0
298.     DO
299.         j = INSTR(Tmp, "k")
300.         IF (j > 0) THEN
301.             CALL FindArgs(Tmp, j, 2, arr())
302.             IF ((arr(1) <> "") AND (arr(2) <> "")) THEN
303.                 TheReturn = j + n
304.                 EXIT DO
305.             ELSE
306.                 Tmp = RIGHT$(Tmp, LEN(Tmp) - j)
307.                 n = LEN(TheStringIn) - LEN(Tmp)
308.             END IF
309.         ELSE
310.             EXIT DO
311.         END IF
312.     LOOP
313.     FindValidK& = TheReturn
314. END FUNCTION

EDIT:

Here is a screenshot of calculating 4^4. It took almost 3000 steps!
 

[bplus]

I am book marking this for when I have time to dig into, look really interesting.

[QB64Curious]

Pure Functional programming, in QB. Who wouldda seen this coming, in the 90s?