Skip to main content

programming - Using Apply inside Compile


In this great answer a compiled version of the Nelder-Mead algorithm is presented.


Since it works on arbitrary dimensions (i.e. arbitrary number of arguments), it has to use apply on the objective function. The problem is that Apply is not directly supported inside Compile. To overcome this limitation the following code is used:


(* Produces compiled code for the Nelder-Mead algorithm with the objective function inlined *)
ClearAll[apply];
SetAttributes[apply, HoldAll];
apply[f : (_Function | _CompiledFunction), vars : {__Symbol}] :=
With[{applied := f @@ vars},
Function[arglist, Block[vars, vars = arglist; applied]]
];


This seems to work (inside the package), but I have no idea, how it works.


Could somebody explain the techniques behind this code snippet? Specifically:



  • What does SetDelayed do inside With?


  • Why does vars appear twice in the arguments to Block?




  • Why doesn't this minimal example work? (I believe it mimics what is done in the mentioned answer...)



    Clear[a, b, c, x, y, z, objectiveFunction, cfunc];
    objectiveFunction = Compile[{a, b, c, x, y, z} ,
    (a - x)^2 + 50 (b - y)^2 + (c - z)^2];

    cfunc = With[{f = apply[objectiveFunction, {a, b, c, x, y, z}]},
    Compile[ {{pts, _Real, 1}}, f@pts]
    ]
    << CompiledFunctionTools`
    CompilePrint[cfunc]



EDIT:


Here is the working snippet. Note that "InlineCompiledFunctions" must be set to True to avoid the call to MainEvaluate.


ClearAll[a, b, c, x, y, z, apply, objectiveFunction, cfunc];
(* Produces inlinable code for use inside Compile (where Apply is not \
supported directly) *)
SetAttributes[apply, HoldRest];
apply[f : (_Function | _CompiledFunction), vars : {__Symbol}] :=
Function[arglist, Block[vars, vars = arglist; f @@ vars]];


objectiveFunction = Compile[{a, b, c, x, y, z} ,
(a - x)^2 + 50 (b - y)^2 + (c - z)^2];
apply[objectiveFunction, {a, b, c, x, y, z}]
cfunc = With[{f = apply[objectiveFunction, {a, b, c, x, y, z}]},
Compile[ {{pts, _Real, 1}}, f@pts,
CompilationOptions -> {"InlineCompiledFunctions" -> True}]
]
<< CompiledFunctionTools`
CompilePrint[cfunc]

Answer




First question : With accepts a syntax like


  With[{var:=value}, expression]

in which case, value is injected into expression unevaluated. As far as I know, this syntax is not documented. You can achieve a similar effect with the replacement rules, by using


Unevaluated[expression]/.HoldPattern[var]:>value

There are some subtle differences between the semantics of With and repalcement rules though, mostly related to the treatment of nested scoping constructs and variable name conflicts in them.


Second question: vars appear twice because they must first be Block-ed, and then there is a massive assignment to them performed in the body of the Block. This is probably the most economical way of blocking a number of variables and assigning values to them simultaneously - otherwise a more complex code-generation will be needed. You can see another example of that in this answer (and if you look at the revision history for that answer, you can find an alternative, harder way to do this, in one of the previous revisions).


Third question: this does not work because the apply function was made HoldAll (which isn't quite necessary), and the pattern-matching does not work. There were some past discussions on this topic on SO, but can't find them right now. But I discussed this topic at length also in my book. The idea is that at the pattern-matching time, all seen by apply is a variable objectiveFunction, and because it does not evaluate it, the pattern _CompiledFunction is not matched. The solution is to make apply HoldRest, and then it works:


ClearAll[apply];

SetAttributes[apply, HoldRest];
apply[...]:=...

Comments

Popular posts from this blog

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...