Search code examples
wolfram-mathematicaoperator-precedence

Unevaluated form of a[[i]]


Consider following simple, illustrating example

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

This is one of the possible ways to transfer code in the body of a Compile statement. It produces the Part::partd error, since a[[i]] is at the moment of evaluation not a list.

The easy solution is to just ignore this message or turn it off. There are of course other ways around it. For instance one could circumvent the evaluation of a[[i]] by replacing it inside the Compile-body before it is compiled

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]]]
   ]
  ]

If the compiled function a large bit of code, the Hold, Release and the replacement at the end goes a bit against my idea of beautiful code. Is there a short and nice solution I have not considered yet?

Answer to the post of Szabolcs

Could you tell me though why you are using With here?

Yes, and it has to do with the reason why I cannot use := here. I use With, to have something like a #define in C, which means a code-replacement at the place I need it. Using := in With delays the evaluation and what the body of Compile sees is not the final piece of code which it is supposed to compile. Therefore,

<< 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]

shows you, that there is a call to the Mathematica-kernel in the compiled function

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

This is bad because Compile should use only the local variables to calculate the result.

Update

Szabolcs solution works in this case but it leaves the whole expression unevaluated. Let me explain, why it is important that the expression is expanded before it is compiled. I have to admit, my toy-example was not the best. So lets try a better one using With and SetDelayed like in the solution of Szabolcs

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

Say I have a polynomial of degree 3 and I need the derivative of it inside the Compile. In the above code I want Mathematica to calculate the derivative for unassigned roots a[[i]] so I can use the formula very often in the compiled code. Looking at the compiled code above one sees, that the D[..] cannot be compiled as nicely as the Product and stays unevaluated

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

Therefore, my updated question is: Is it possible to evaluate a piece of code without evaluating the Part[]-accesses in it better/nicer than using

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

Edit: I put the Quiet to the place it belongs. I had it in front of code block to make it visible to everyone that I used Quiet here to suppress the warning. As Ruebenko pointed already out, it should in real code always be as close as possible to where it belongs. With this approach you probably don't miss other important warnings/errors.

Update 2

Since we're moving away from the original question, we should move this discussion maybe to a new thread. I don't know to whom I should give the best answer-award to my question since we discussed Mathematica and Scoping more than how to suppress the a[[i]] issue.

Update 3

To give the final solution: I simply suppress (unfortunately like I did all the time) the a[[i]] warning with Quiet. In a real example below, I have to use Quiet outside the complete Block to suppress the warning.

To inject the required code into the body of Compile I use a pure function and give the code to inline as argument. This is the same approach Michael Trott is using in, e.g. his Numerics book. This is a bit like the where clause in Haskell, where you define stuff you used afterwards.

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])}])

And this function is now fast enough to calculate the Newton-fractal of a polynomial where the position of the roots is not fixed. Therefore, we can adjust the roots dynamically. Feel free to adjust n. Here it runs up to n=756 fluently

(* 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]
   ]
  ]
 ]

Teaser:

Dynamic Newton fractal


Solution

  • One way:

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

    be careful though, it you really want this.