Mathematica: восстановление произвольного вложенного списка после сглаживания

каков самый простой способ отображения произвольно фанки вложенного списка expr функции 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}}} &

это работает, но это ни элегантно, ни вообще.

Edit: вот" безопасность работы " версия решения, предоставляемого 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}}}&
8
wolfram-mathematica

3 ответов

Вам, очевидно, нужно сохранить некоторую информацию о структуре списка, потому что Flatten[{a,{b,c}}]==Flatten[{{a,b},c}].

если ArrayQ[expr], тогда структура списка определяется Dimensions[expr] и вы можете восстановить его с Partition. Е. Г.

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

  {2,3}

unflatten = Fold[Partition, #1, Reverse[Drop[dimensions, 1]]]&;
expr == unflatten @ Flatten[expr]

(том Partition man page на самом деле имеет аналогичный пример под названием 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]
6

Я не уверен, что вы пытаетесь сделать с компиляции. Он используется, когда вы хотите очень быстро оценить процедурные или функциональные выражения на числовых значениях, поэтому я не думаю, что это поможет здесь. Если повторные вычисления D[f,...] препятствуют вашей производительности, вы можете предварительно вычислить и сохранить их с чем - то вроде Table[d[k]=D[f,{{x,y},k}],{k,0,kk}];

затем просто вызовите d[k], чтобы получить K-ю производную.

1

Я просто хотел обновить отличные решения aaz и Janus. Кажется, что, по крайней мере, в Mathematica 9.0.1.0 на Mac OSX, назначение (см. решение aaz)

{i_Integer -> Slot[i]}

не удается. Если, однако, мы используем

{i_Integer :> Slot[i]}

вместо этого мы добьемся успеха. То же самое, конечно, относится и к 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, нам нужно некоторые информация из исходного выражения. Пока вам это не нужно все, чтобы один функция, которая может unflatten, все необходимые.

мое приложение похоже на приложение Януса: я распараллеливаю вызовы Simplify для тензора. Используя ParallelTable Я могу значительно улучшить производительность, но я разрушаю тензорную структуру в процессе. Это дает мне быстрый способ восстановить мой оригинальный тензор, упрощенный.

1