math - 组合器归约 Wolfram Mathematica

Question

如何在 Mathematica 中实现组合器 {S,K,I} 的正常归约策略？
以下是规则:
S[x][y][z]->x[y][z[y]]
K[x][y][z]->x

我们还有一个 Y 组合器(固定点)，因此 Y[a]=a[Ya]]。

我们必须“评估”表达式，例如，S[K][K][a] = K[a][K[a]]=a

一步减少是非常重要的。因此，结果将在一步应用中多次..

感谢您的任何建议!!!!

Answer 1

让我们定义一个名为 eval 的函数这将执行组合器评估的一步。首先，我们需要考虑究竟是什么构成了一个步骤。任意地，我们将首先评估最左边的表达式，然后从那里向内工作。

ClearAll[eval]
eval[e_] := Module[{r = eval1[e]}, r /; r =!= e]
eval[e:f_[g_]] := Module[{r = eval[f][g]}, r /; r =!= e]
eval[e:f_[g_]] := Module[{r = f[eval[g]]}, r /; r =!= e]
eval[e_] := e

请注意，这些规则仅在它们实际更改表达式时才适用。这些定义的尴尬是由于 Mathematica 缺少一个模式表达式来匹配任意长的柯里化(Currying)参数列表。

现在我们可以定义已识别的组合子 S、K 和 I:

ClearAll[eval1]
eval1[s[f_][g_][h_]] := f[h][g[h]]
eval1[k[f_][_]] := f
eval1[i[f_]] := f

这里的符号都是小写的，主要是为了避免 Mathematica 呈现内置符号 I 的方式。 ，虚数单位。

任何其他组合子都将被视为变量并且不予评估:

eval1[e_] := e

现在我们可以尝试基本情况:

i[f] // eval

(* f *)

k[f][g] // eval

(* f *)

s[f][g][h] // eval

(* f[h][g[h]] *)

对于更有趣的情况，让我们定义 evalAll显示了评估链中的所有步骤:

ClearAll[evalAll]
evalAll[e_, n_:Infinity] := FixedPointList[eval, e, n+1] // Most // Column

s[k][k][a] // evalAll 

(*
s[k][k][a]
k[a][k[a]]
a
*)

s[s[m][n][r]][k[a][b]][c] // evalAll

(*
s[s[m][n][r]][k[a][b]][c]
s[m][n][r][c][k[a][b][c]]
m[r][n[r]][c][k[a][b][c]]
m[r][n[r]][c][a[c]]
*)

f[s[i[k]][k][g][i[f]]] // evalAll
(*
f[s[i[k]][k][g][i[f]]]
f[i[k][g][k[g]][i[f]]]
f[k[g][k[g]][i[f]]]
f[g[i[f]]]
f[g[f]]
*)

evalAll采用可选的“count”参数来限制显示的步骤数。这对于发散表达式很有用——比如 Y 组合子的直接表达式:

eval1[y[f_]] := f[y[f]]

y[f] // evalAll[#, 4]&

(*
y[f]
f[y[f]]
f[f[y[f]]]
f[f[f[y[f]]]]
f[f[f[f[y[f]]]]]
*)

...但是用 SKI 来表达这样的序列会更有趣:

Module[{y = s[k[s[i][i]]][s[s[k[s]][k]][k[s[i][i]]]]}
, evalAll[y[f], 28]
]

(*
s[k[s[i][i]]][s[s[k[s]][k]][k[s[i][i]]]][f]
k[s[i][i]][f][s[s[k[s]][k]][k[s[i][i]]][f]]
s[i][i][s[s[k[s]][k]][k[s[i][i]]][f]]
i[s[s[k[s]][k]][k[s[i][i]]][f]][i[s[s[k[s]][k]][k[s[i][i]]][f]]]
s[s[k[s]][k]][k[s[i][i]]][f][i[s[s[k[s]][k]][k[s[i][i]]][f]]]
s[k[s]][k][f][k[s[i][i]][f]][i[s[s[k[s]][k]][k[s[i][i]]][f]]]
k[s][f][k[f]][k[s[i][i]][f]][i[s[s[k[s]][k]][k[s[i][i]]][f]]]
s[k[f]][k[s[i][i]][f]][i[s[s[k[s]][k]][k[s[i][i]]][f]]]
k[f][i[s[s[k[s]][k]][k[s[i][i]]][f]]][k[s[i][i]][f][i[s[s[k[s]][k]][k[s[i][i]]][f]]]]
f[k[s[i][i]][f][i[s[s[k[s]][k]][k[s[i][i]]][f]]]]              <-- f[...]
f[s[i][i][i[s[s[k[s]][k]][k[s[i][i]]][f]]]]
f[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]][i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]
f[i[s[s[k[s]][k]][k[s[i][i]]][f]][i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]
f[s[s[k[s]][k]][k[s[i][i]]][f][i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]
f[s[k[s]][k][f][k[s[i][i]][f]][i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]
f[k[s][f][k[f]][k[s[i][i]][f]][i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]
f[s[k[f]][k[s[i][i]][f]][i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]
f[k[f][i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]][k[s[i][i]][f][i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]]
f[f[k[s[i][i]][f][i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]]       <-- f[f[...]]
f[f[s[i][i][i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]]
f[f[i[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]][i[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]]]
f[f[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]][i[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]]]
f[f[i[s[s[k[s]][k]][k[s[i][i]]][f]][i[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]]]
f[f[s[s[k[s]][k]][k[s[i][i]]][f][i[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]]]
f[f[s[k[s]][k][f][k[s[i][i]][f]][i[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]]]
f[f[k[s][f][k[f]][k[s[i][i]][f]][i[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]]]
f[f[s[k[f]][k[s[i][i]][f]][i[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]]]
f[f[k[f][i[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]][k[s[i][i]][f][i[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]]]]
f[f[f[k[s[i][i]][f][i[i[i[s[s[k[s]][k]][k[s[i][i]]][f]]]]]]]] <-- f[f[f[...]]]
*)