未评估的[[i]]形式

Question

请考虑以下简单的说明示例

cf = Block[{a, x, degree = 3},
  With[{expr = Product[x - a[[i]], {i, degree}]},
   Compile[{{x, _Real, 0}, {a, _Real, 1}}, expr]
   ]
  ]

这是在Compile语句的主体中传输代码的可能方法之一.它产生Part :: partd错误,因为[[i]]在评估时不是列表.

简单的解决方案是忽略此消息或将其关闭.当然还有其他方法.例如,一个可能规避的评价[[I]]通过替换它的编译体内之前它被编译

cf = ReleaseHold[Block[{a, x, degree = 3},
   With[{expr = Product[x - a[i], {i, degree}]},
    Hold[Compile[{{x, _Real, 0}, {a, _Real, 1}}, expr]] /. 
     a[i_] :> a[[i]]]
   ]
  ]

如果编译后的函数有大量的代码,那么Hold,Release和最后的替换会对我的漂亮代码的想法产生一些影响.我还没有考虑过一个简短而好的解决方案吗？

回答Szabolcs的帖子

你能告诉我为什么你在这里使用吗？

是的,这与我无法使用的原因有关:= here.我使用With,有一个类似于#defineC的东西,这意味着在我需要的地方进行代码替换.使用:= in延迟评估和Compile的主体看到的不是它应该编译的最后一段代码.因此,

<< CompiledFunctionTools`
cf = Block[{a, x, degree = 3}, 
   With[{expr := Product[x - a[[i]], {i, degree}]}, 
    Compile[{{x, _Real, 0}, {a, _Real, 1}}, expr]]];
CompilePrint[cf]

向您展示在编译函数中调用Mathematica内核

I4 = MainEvaluate[ Function[{x, a}, degree][ R0, T(R1)0]]

这很糟糕,因为Compile应该只使用局部变量来计算结果.

更新

Szabolcs解决方案适用于这种情况,但它使整个表达式无法评估.让我解释一下,为什么在编译之前扩展表达式很重要.我不得不承认,我的玩具示例并不是最好的.所以让我们在Szabolcs的解决方案中尝试使用With和SetDelayed更好的一个

Block[{a, x}, With[
  {expr := D[Product[x - a[[i]], {i, 3}], x]}, 
  Compile[{{x, _Real, 0}, {a, _Real, 1}}, expr]
  ]
 ]

假设我有一个3阶多项式,我需要在Compile中导出它.在上面的代码我想数学计算用于未分配的根衍生物[[I]]所以可以用公式非常在已编译的代码经常.看看上面编译的代码,看到D [..]不能像产品一样编译得很好并且保持不被评估

11  R1 = MainEvaluate[ Hold[D][ R5, R0]]

因此,我更新的问题是:是否可以在不评估Part []的情况下评估一段代码 - 其中的访问比使用更好/更好

Block[{a, x}, With[
  {expr = D[Quiet@Product[x - a[[i]], {i, 3}], x]}, 
  Compile[{{x, _Real, 0}, {a, _Real, 1}}, expr]
  ]
 ]

编辑:我把Quiet放到它所属的地方.我在代码块前面让它对所有人都可见,我在这里使用Quiet来抑制警告.正如Ruebenko已经指出的那样,它应该在实际代码中始终尽可能接近它所属的位置.使用这种方法,您可能不会错过其他重要的警告/错误.

更新2

由于我们正在远离原始问题,我们应该将此讨论转移到一个新的主题.我不知道应该向谁提出最佳答案 - 因为我们讨论Mathematica和范围更多而不是如何压制[[i]]问题.

更新3

为了给出最终的解决方案:我简单地用Quiet来抑制(不幸的是我一直都是这样做)a [[i]]警告.在下面的一个实例中,我必须在完整Block之外使用Quiet来抑制警告.

要将所需的代码注入Compile的主体,我使用一个纯函数,并将代码作为参数内联.这与Michael Trott使用的方法相同,例如他的Numerics书籍.这有点像whereHaskell中的子句,您可以在其中定义之后使用的内容.

newtonC = Function[{degree, f, df, colors},
   Compile[{{x0, _Complex, 0}, {a, _Complex, 1}},
    Block[{x = x0, xn = 0.0 + 0.0 I, i = 0, maxiter = 256, 
      eps = 10^(-6.), zeroId = 1, j = 1},
     For[i = 0, i < maxiter, ++i,
      xn = x - f/(df + eps);
      If[Abs[xn - x] < eps,
       Break[]
       ];
      x = xn;
      ];
     For[j = 1, j <= degree, ++j,
      If[Abs[xn - a[[j]]] < eps*10^2,
        zeroId = j + 1;
        Break[];
        ];
      ];
     colors[[zeroId]]*(1 - (i/maxiter)^0.3)*1.5
     ],
    CompilationTarget -> "C", RuntimeAttributes -> {Listable}, 
    RuntimeOptions -> "Speed", Parallelization -> True]]@@
    (Quiet@Block[{degree = 3, polynomial, a, x},
     polynomial = HornerForm[Product[x - a[[i]], {i, degree}]];
     {degree, polynomial, HornerForm[D[polynomial, x]], 
      List @@@ (ColorData[52, #] & /@ Range[degree + 1])}])

而且这个函数现在足够快,可以计算多项式的牛顿分形,其中根的位置不固定.因此,我们可以动态调整根.随意调整n.在这里它可以流畅地运行到n = 756

(* ImageSize n*n, Complex plange from -b-I*b to b+I*b *)
With[{n = 256, b = 2.0},
 DynamicModule[{
   roots = RandomReal[{-b, b}, {3, 2}],
   raster = Table[x + I y, {y, -b, b, 2 b/n}, {x, -b, b, 2 b/n}]},
  LocatorPane[Dynamic[roots],
   Dynamic[
    Graphics[{Inset[
       Image[Reverse@newtonC[raster, Complex @@@ roots], "Real"],
       {-b, -b}, {1, 1}, 2 {b, b}]}, PlotRange -> {{-b, b}, {-
         b, b}}, ImageSize -> {n, n}]], {{-b, -b}, {b, b}}, 
   Appearance -> Style["\[Times]", Red, 20]
   ]
  ]
 ]

预告:

Answer 1

好吧,这里是很我使用各种用途的代码生成框架的过于简单的版本:

ClearAll[symbolToHideQ]
SetAttributes[symbolToHideQ, HoldFirst];
symbolToHideQ[s_Symbol, expandedSymbs_] :=! MemberQ[expandedSymbs, Unevaluated[s]];

ClearAll[globalProperties]
globalProperties[] := {DownValues, SubValues, UpValues (*,OwnValues*)};

ClearAll[getSymbolsToHide];
Options[getSymbolsToHide] = {
     Exceptions -> {List, Hold, HoldComplete, 
        HoldForm, HoldPattern, Blank, BlankSequence, BlankNullSequence, 
       Optional, Repeated, Verbatim, Pattern, RuleDelayed, Rule, True, 
       False, Integer, Real, Complex, Alternatives, String, 
       PatternTest,(*Note-  this one is dangerous since it opens a hole 
                    to evaluation leaks. But too good to be ingored *)
       Condition, PatternSequence, Except
      }
 };

getSymbolsToHide[code_Hold, headsToExpand : {___Symbol}, opts : OptionsPattern[]] :=
  Join @@ Complement[
       Cases[{
          Flatten[Outer[Compose, globalProperties[], headsToExpand]], code},
            s_Symbol /; symbolToHideQ[s, headsToExpand] :> Hold[s],
            Infinity,
            Heads -> True
       ],
       Hold /@ OptionValue[Exceptions]];

ClearAll[makeHidingSymbol]
SetAttributes[makeHidingSymbol, HoldAll];
makeHidingSymbol[s_Symbol] := 
    Unique[hidingSymbol(*Unevaluated[s]*) (*,Attributes[s]*)];

ClearAll[makeHidingRules]
makeHidingRules[symbs : Hold[__Symbol]] :=
     Thread[List @@ Map[HoldPattern, symbs] -> List @@ Map[makeHidingSymbol, symbs]];

ClearAll[reverseHidingRules];
reverseHidingRules[rules : {(_Rule | _RuleDelayed) ..}] :=
   rules /. (Rule | RuleDelayed)[Verbatim[HoldPattern][lhs_], rhs_] :> (rhs :> lhs);


FrozenCodeEval[code_Hold, headsToEvaluate : {___Symbol}] :=   
   Module[{symbolsToHide, hidingRules, revHidingRules,  result}, 
      symbolsToHide = getSymbolsToHide[code, headsToEvaluate];
      hidingRules = makeHidingRules[symbolsToHide];
      revHidingRules = reverseHidingRules[hidingRules];
      result = 
         Hold[Evaluate[ReleaseHold[code /. hidingRules]]] /. revHidingRules;
      Apply[Remove, revHidingRules[[All, 1]]];
      result];

该代码通过暂时隐藏大多数具有一些虚拟符号的符号来工作,并允许评估某些符号.这是在这里如何工作:

In[80]:= 
FrozenCodeEval[
  Hold[Compile[{{x,_Real,0},{a,_Real,1}},D[Product[x-a[[i]],{i,3}],x]]],
  {D,Product,Derivative,Plus}
]

Out[80]= 
Hold[Compile[{{x,_Real,0},{a,_Real,1}},
  (x-a[[1]]) (x-a[[2]])+(x-a[[1]]) (x-a[[3]])+(x-a[[2]]) (x-a[[3]])]]

因此,要使用它,您必须包装代码Hold并指出要评估的头.剩下的就是申请ReleseHold它.请注意,上面的代码只是说明了这些想法,但仍然非常有限.我的方法的完整版本涉及其他步骤,使其更强大,但也更复杂.

编辑

虽然上面的代码仍然太有限,无法容纳许多真正有趣的案例,但这里有一个额外的简洁例子, 用传统的评估控制工具很难实现:

In[102]:= 
FrozenCodeEval[
  Hold[f[x_, y_, z_] := 
    With[Thread[{a, b, c} = Map[Sqrt, {x, y, z}]], 
       a + b + c]], 
  {Thread, Map}]

Out[102]= 
Hold[
  f[x_, y_, z_] := 
    With[{a = Sqrt[x], b = Sqrt[y], c = Sqrt[z]}, a + b + c]]

Answer 2

单程：

cf = Block[{a, x, degree = 3}, 
  With[{expr = Quiet[Product[x - a[[i]], {i, degree}]]}, 
   Compile[{{x, _Real, 0}, {a, _Real, 1}}, expr]]]

但要小心，如果你真的想要这个。