Wolfram mathematica Mathematica:展平后重建任意嵌套列表

Wolfram mathematica Mathematica:展平后重建任意嵌套列表,wolfram-mathematica,Wolfram Mathematica,将任意嵌套列表映射到函数unflatten以使expr==unflatten的最简单方法是什么@@Flatten@expr 动机: Compile只能处理完整数组(这是我刚学到的,但不是从错误消息中学到的),因此,我们的想法是将unflatten与平坦表达式的编译版本一起使用: fPrivate=Compile[{x,y},Evaluate@Flatten@expr]; f[x_?NumericQ,y_?NumericQ]:=unflatten@@fPrivate[x,y] 解决不太一般问题

将任意嵌套列表映射到函数
unflatten
以使
expr==unflatten的最简单方法是什么@@Flatten@expr

动机:
Compile
只能处理完整数组(这是我刚学到的,但不是从错误消息中学到的),因此,我们的想法是将
unflatten
与平坦表达式的编译版本一起使用:

fPrivate=Compile[{x,y},Evaluate@Flatten@expr];
f[x_?NumericQ,y_?NumericQ]:=unflatten@@fPrivate[x,y] 
解决不太一般问题的示例: 我实际上需要做的是计算一个给定的多元函数在某个阶上的所有导数。在这种情况下,我会这样做:

expr=Table[D[x^2 y+y^3,{{x,y},k}],{k,0,2}];
unflatten=Module[{f,x,y,a,b,sslot,tt},
  tt=Table[D[f[x,y],{{x,y},k}],{k,0,2}] /. 
    {Derivative[a_,b_][_][__]-> x[a,b], f[__]-> x[0,0]};
  (Evaluate[tt/.MapIndexed[#1->sslot[#2[[1]]]&, 
            Flatten[tt]]/. sslot-> Slot]&) ] 

Out[1]= {x^2 y + y^3, {2 x y, x^2 + 3 y^2}, {{2 y, 2 x}, {2 x, 6 y}}}
Out[2]= {#1, {#2, #3}, {{#4, #5}, {#5, #7}}} &
这是可行的,但它既不优雅也不一般

编辑:以下是aaz提供的解决方案的“工作安全”版本:

makeUnflatten[expr_List]:=Module[{i=1},
    Function@Evaluate@ReplaceAll[
        If[ListQ[#1],Map[#0,#1],i++]&@expr,
        i_Integer-> Slot[i]]]
它很有魅力:

In[2]= makeUnflatten[expr]
Out[2]= {#1,{#2,#3},{{#4,#5},{#6,#7}}}&

我不知道你想用Compile做什么。当你想在数值上快速计算程序表达式或函数表达式时,可以使用它,所以我认为它在这里没有帮助。如果重复计算D[f,…]会影响您的性能,您可以使用以下方法预计算并存储它们
表[d[k]=d[f,{x,y},k}],{k,0,kk}]


然后调用d[k]得到第k个导数。

您显然需要保存一些关于列表结构的信息,因为
Flatten[{a,{b,c}]==Flatten[{a,b},c}]

如果
ArrayQ[expr]
,则列表结构由
Dimensions[expr]
给出,您可以使用
分区来重构它。例如

expr = {{a, b, c}, {d, e, f}};
dimensions = Dimensions[expr]

  {2,3}

unflatten = Fold[Partition, #1, Reverse[Drop[dimensions, 1]]]&;
expr == unflatten @ Flatten[expr]
分区
手册页实际上有一个类似的示例,名为
unflatten


如果
expr
不是数组,可以尝试以下操作:

expr = {a, {b, c}};
indexes = Module[{i=0}, If[ListQ[#1], Map[#0, #1], ++i]& @expr]

  {1, {2, 3}}

slots = indexes /. {i_Integer -> Slot[i]}

  {#1, {#2, #3}}

unflatten = Function[Release[slots]]

  {#1, {#2, #3}} &

expr == unflatten @@ Flatten[expr]

我只是想更新aaz和Janus的优秀解决方案。看起来,至少在MacOSX上的Mathematica 9.0.1.0中,分配(参见aaz的解决方案)

失败了。但是,如果我们使用

{i_Integer :> Slot[i]}
相反,我们成功了。当然,Janus的“工作安全”版本中的
ReplaceAll
调用也是如此

为了更好的衡量,我加入了我自己的函数

unflatten[ex_List, exOriginal_List] := 
  Module[
   {indexes, slots, unflat},
   indexes = 
     Module[
       {i = 0}, 
       If[ListQ[#1], Map[#0, #1], ++i] &@exOriginal
       ];
   slots = indexes /. {i_Integer :> Slot[i]};
   unflat = Function[Release[slots]];
   unflat @@ ex
   ];

(* example *)
expr = {a, {b, c}};
expr // Flatten // unflatten[#, expr] &
在函数中使用原始表达式似乎有点像作弊,但正如aaz指出的,我们需要原始表达式中的一些信息。虽然您不需要全部功能,但为了使单个功能能够
取消平台
,所有功能都是必需的


我的应用程序与Janus的类似:我对张量的
Simplify
调用进行并行化。使用
ParallelTable
I可以显著提高性能,但在这个过程中破坏了张量结构。这为我提供了一种快速重建原始张量的方法,简化了。

谢谢。我非常同意我不需要编译这个例子,但我不认为任何人会感谢我发布了我正在使用的实际表达式:)我的问题是第一句话,其他的都是背景。我没有测试它,但是修改Leonid Shifrin的
Reaginas
可能会有用,谢谢,亚罗斯拉夫:这看起来确实有关联——但有点难以理解:)。最后我自己做了一件事,如果没有人咬我,我会把它贴出来。。。同样的故事总是这样:1)针对具体情况解决问题,2)意识到更一般的解决方案可能会很有趣,3)为了避免在切线上浪费时间,将其发布,以便其他人做您的切线工作,4)自己也做。sigh这个问题似乎与@Yaroslav有关。我根据这个问题调整了我的版本,最终得到了与@aaz的解决方案非常相似的结果,但后者更简单、更优雅。@dbjohn:谢谢。您提到的问题只涉及“完整数组”——顺便说一句,对于“完整数组”,没有必要使用这种方法,因为Compile可以很好地处理这些数组。是的,我已经多次使用了第一个数组,但第二个版本正是我所需要的——而且做得非常好!使用插槽[0]进行匿名递归我从未想过:)谢谢。我在写这篇文章的时候才发现关于
插槽[0]
;很明显,这是一个简洁的例子:)是否有
Release
文档?谁能告诉我一些信息吗?我正在使用Mma 7(M.Trott在《编程》中说它没有文档记录,但据我所知,没有提供进一步的信息)。@TomD-。在这里,它的工作原理与
Evaluate
@TomD,@aaz:当我第一次看到aaz的解决方案时,我认为这个版本是我不知何故错过的一些很酷的功能。但在查找之后,我实际上在我的摘要更新中使用了Evaluate:)原始版本在v9中仍然可以正常工作。
makeUnflatten
的目的正是将有关
expr
结构的信息存储到匿名解包函数中,因此无需保留原始表达式。
unflatten[ex_List, exOriginal_List] := 
  Module[
   {indexes, slots, unflat},
   indexes = 
     Module[
       {i = 0}, 
       If[ListQ[#1], Map[#0, #1], ++i] &@exOriginal
       ];
   slots = indexes /. {i_Integer :> Slot[i]};
   unflat = Function[Release[slots]];
   unflat @@ ex
   ];

(* example *)
expr = {a, {b, c}};
expr // Flatten // unflatten[#, expr] &