使用 Mathematica 进行柯里化

Question

可以在 Mathematica 中实现有限形式的 Currying，使用这个结构：

f[a_][b_][c_] := (a^2 + b^2)/c^2

允许一个人做，例如：

f[4][3] /@ Range@5

 {25, 25/4, 25/9, 25/16, 1}

---

有一个问题：Attributes 仅适用于第一个（一组）参数。考虑：

ClearAll[f]
SetAttributes[f, HoldAllComplete]

f[a_][b_][c_] :=
  {ToString@Unevaluated@a,
   ToString@Unevaluated@b,
   ToString@Unevaluated@c}

f[2 + 2][ 8/4 ][3 + 5]

  {"2 + 2", "2", "8"}  

我的意图是在列表中返回"8 / 4" 和"3 + 5"。

---

因此：

• 有没有办法将属性扩展到这个结构？

• 是否有其他方便的构造来实现这一点？

• 除了属性之外，还有其他方法可以在 Mathematica 中扩展柯里化吗？

Answer 1

我认为没有任何方法可以将属性应用于这种“upvalue”模式定义的后面部分。

另一种方法是使用带有属性的纯函数。不如模式匹配方便，但是当您评估 f[2+2][8/4] 时，它实际上给出了 Curry 想要的结果。 （“函数”是 Mathematica 的“lambda”，如果您熟悉 lambda 演算的话。）

f = Function[a,Function[b,Function[c,HoldForm@{a,b,c},HoldAll],HoldAll],HoldAll]

我认为您希望能够执行以下操作：

f[2+2][2/1] /@ Unevaluated@{1+1,3+3}    →    {{2+2, 2/1, 1+1}, {2+2, 2/1, 3+3}}

如果你要经常做这种事情，你可以让它更容易输入：

hf[args_,body_]:=Function[args,body,HoldAll]; SetAttributes[hf,HoldAll];

f = hf[a, hf[b, hf[c, HoldForm@{a, b, c}]]]

Mathematica Cookbook 在第 73-77 页展示了一种完全不同的柯里化方法。

作为一般准则，如果您试图控制 Mathematica 计算表达式的时间，您会让自己感到痛苦。在许多情况下，更好的方法是使用符号作为您还不想评估的表达式的占位符，然后在需要评估时，您可以用所需的表达式替换符号。

Answer 2

对不起，可能不相关的评论。我刚刚搜索了«currying with Mathematica»，这个问题是 Google 列表中的第一个问题。虽然它已经 1 岁并且已经得到了答案，但我发现提出的解决方案并不是很优雅恕我直言。初始代码的简单修改应该如下：

ClearAll[f]
SetAttributes[f, HoldAllComplete]
f[a_, b_, c_] := {ToString@Unevaluated@a, ToString@Unevaluated@b,
ToString@Unevaluated@c}
f[a__] := Function[x, f[a, x], HoldAll]

它会导致所需的携带：

f[2+2][2+1] /@ Unevaluated@{1+1, 3+3} → {{2+2, 2+1, 1+1}, {2+2, 2+1, 3+3}}

它适用于三个可能的参数分区

f[1 + 1, 2 + 2, 6 + 1]
f[1 + 1, 2 + 2][6 + 1]
f[1 + 1][2 + 2][6 + 1]

并给出正确的结果： {"1+1", "2+2", "6+1"}}，但 f[1 + 1][2 + 2, 6 + 1] 失败。对于这个，可以使用更高级的版本：

ClearAll[f, g]
SetAttributes[f, HoldAllComplete]
SetAttributes[g, HoldAllComplete]
f[a_, b_, c_] := (ClearAll[g]; SetAttributes[g, HoldAllComplete]; 
  Thread[Hold[{a, b, c}]] /. {Hold[e_] :> ToString@Unevaluated[e]})
f[a__] := (g[x__] := f[a, x]; g)

Answer 3

我不知道有什么方法可以将属性扩展到第二个或以后的柯里化参数列表——尽管我很想听听。

您可以通过使用纯函数来实现具有与柯里化表达式相同外观的表达式的定义（尽管我不愿称其为“方便”）：

ClearAll[f, f1, f2]
SetAttributes[{f, f1, f2}, HoldAllComplete]
f[a_] := Function[b, f1[a, b], HoldAllComplete]
f1[a_, b_] := Function[c, f2[a, b, c], HoldAllComplete]
f2[a_, b_, c_] :=
  { ToString@Unevaluated@a
  , ToString@Unevaluated@b
  , ToString@Unevaluated@c
  }

f[2+2][8/4][3+5]

可以使用现在未记录的符号 HeadCompose 来匹配柯里化表达式：

In[65]:= MatchQ[g[x][y][z], HeadCompose[g, x_, y_, z_]]
Out[65]= True

...虽然这种能力对手头的事情没有帮助。 HeadCompose 在几个版本前已被弃用，以至于最终从文档中删除。但我不知道有任何其他方式来模式匹配咖喱表达式。我推测它已被弃用，正是因为人们无法有效地将属性和定义附加到它，从而使其处于可怕的状态：此符号尚未完全集成到长期的 Mathematica 系统中，并且可能会发生变化。 em>

Answer 4

聚会迟到了 - 所以不是直接回答这个问题（其他帖子已经很好地回答了）。我只想指出，可以通过使用Stack 和异常来对评估进行非本地控制。这有点难看，但我认为它没有被充分探索。这是一个例子：

ClearAll[f];
f := With[{stack = Stack[_]},
   With[{fcallArgs = 
      Cases[stack, HoldForm[f[x_][y_][z_]] :> Hold[x, y, z]]},
      Throw[First@fcallArgs] /; fcallArgs =!= {}]];


In[88]:= Catch[f[2+2][8/4][3+5]]

Out[88]= Hold[2+2,8/4,3+5]

这使用了在元素之前递归地评估头部的事实。从这里你可以看到，人们能够以这种方式提取未评估的参数，并且也许可以在进一步的处理中使用它们。但是计算被中断了。还应该可以从Stack[_] 中提取足够的信息来恢复计算。我不确定是否可以在 Mathematica 中实现延续，但如果可以，那应该是沿着这些思路。

Answer 5

有一种方法可以自动完成。考虑函数

f[a_, b_, c_] := {a, b, c}

我们想让它隐式地“可咖喱”，因此可以通过以下任何一种方式调用它：

f[1, 2, 3]
f[1, 2][3]
f[1][2][3]

如果有一种方法可以自动生成以下定义（我们将在下面进行），则可以实现这一点：

f[a_, b_, c_] := {a, b, c}
f[a_, b_] := Function[c, f[a, b, c]]
f[a_] := Function[b, Function[c, f[a, b, c]]]

正如上面 Matt 的另一个答案，我们可以只做一个定义：f:=Function[a,Function[b,Function[c, BODY]]]，但是我们将无法调用 f通过 f[a,b,c] 或 f[a,b]，并且只能将其称为 f[a][b] 或 f[a][b][c]。有了多个定义，我们可以选择任何一种样式。

生成这些定义可以由函数（定义如下）CurryableSetDelayed 完成，只需调用：

CurryableSetDelayed[f[a_, b_, c_], {a, b, c}]

即使定义了这些符号中的任何一个，它也会按预期工作，就像 SetDelayed 一样。

此外，使用 Notation 包，您可以使其显示为赋值运算符；说 f[a_,b_,c]#={c,b,a}，但我没试过。

在下面的源代码中，我使用了一些可能与会话冲突的临时符号，因此如果您要使用它，请将其包含在包命名空间中。

完整代码：

ClearAll[UnPattern];
ClearAll[MakeFunction]
ClearAll[CurriedDefinitions]
ClearAll[MyHold]
ClearAll[MyHold2]
ClearAll[CurryableSetDelayed]

SetAttributes[UnPattern,HoldAllComplete];
SetAttributes[MakeFunction,HoldAllComplete];
SetAttributes[CurriedDefinitions,HoldAllComplete]
SetAttributes[MyHold,HoldAllComplete]
SetAttributes[MyHold2,HoldAllComplete]
SetAttributes[CurryableSetDelayed,HoldAllComplete]

UnPattern[x_]:=Block[{pattern},MyHold[x]/. Pattern->pattern/. pattern[v_,_]:>v]

MakeFunction[param_,body_,attrs_]:=With[{p=UnPattern[param],b=UnPattern[body]},
  Block[{function},MyHold[function[p,b,attrs]]/. function->Function]]

CurriedDefinitions[fname_[args__],body_,attrs_]:=MapThread[MyHold2[#1:=#2]&,
  {Rest[(MyHold[fname]@@#1&)/@NestList[Drop[#1,-1]&,{args},Length[{args}]-1]],
   Rest[FoldList[MakeFunction[#2,MyHold[#1],Evaluate[attrs]]&,MyHold[fname[args]],
     Reverse[Drop[{args},1]]]]}]

CurryableSetDelayed[fname_[args__],body_]:={MyHold2[fname[args]:=body],
  Sequence@@CurriedDefinitions[fname[args],body,Attributes[fname]]}
  //. MyHold[x_]:>x/. MyHold2[x_]:>x

更新，现在属性（HoldAllComplete 等）扩展到所有参数，所以以下工作按预期工作，只要您在调用 CurryableSetDelayed 之前设置属性：

In[1185]:= ClearAll[f];
SetAttributes[f, {HoldAllComplete}]
CurryableSetDelayed[
  f[a_, b_, c_], {ToString@Unevaluated@a, ToString@Unevaluated@b, 
   Unevaluated@c, Hold@c}];
f[1 + 1, 2 + 2, c + 1]
f[1 + 1, 2 + 2][c + 1]
f[1 + 1][2 + 2][c + 1]

Out[1188]= {"1 + 1", "2 + 2", Unevaluated[c + 1], Hold[c + 1]}

Out[1189]= {"1 + 1", "2 + 2", Unevaluated[c + 1], Hold[c + 1]}

Out[1190]= {"1 + 1", "2 + 2", Unevaluated[c + 1], Hold[c + 1]}