# How to programmatically construct a function or a compiled function?

I'd like to programmatically construct a function from a long expression with many duplicate terms. The objective is to programmatically create a set of compiled functions with expressions that were previously created programmatically. This is somewhat related to Stack Exchange Question: How to speed up an optimization with very long symbolic expressions?

The question may be clarified with a minimal non-working example. The example is a bit silly, but it expresses the idea.

Suppose I have a list of expressions:

exampleTerms =  {(x - y)^2, x y, (x - y)^4};
exprList = Expand /@ RandomChoice[exampleTerms, 10]
(*{x^4 - 4 x^3 y + 6 x^2 y^2 - 4 x y^3 + y^4,....}*)


Here is a list of terms that I'd like to precompute for insertion into a Function, or Compile:

vars =Union[Flatten[(List @@@ exprList) /. _?IntegerQ t_ :> t]]
(*{x y, x^3 y, x^2 y^2, x y^3}*)


Here is a list of rules pointing to intermediate variables:

assigments =
Thread[vars -> (Indexed[term, #] & /@ Range[Length[vars]])]


and here is what I want as the expr in Compile:

 expr = exprList /. assigments
(*{x^2 -> Indexed[term, {1}], x^4 -> Indexed[term, {2}],
x y -> Indexed[term, {3}],...}*)

local = With[{termList = Indexed[term, #] & /@ Range[Length[vars]]},
MapThread[HoldForm[#1 = #2] &, {termList, vars}]]


Here is something that looks like what I want:

tmpF = Function[{x, y},
Evaluate[Block[Evaluate[local], Evaluate[expr]]]
]


But that fails because Block objects to the local variable assignment. (Also, the evaluates seem redundant, but it doesn't work if I remove them) It also fails if I don't use Indexed:

tmpF = Function[{x, y},
Evaluate[
Block[Evaluate[local /. Indexed[term, i_] :> term[i]],
Evaluate[expr]]]
]


Or, which seems to be to be a total kludge by creating my own symbol names:

localAlt = With[{termList =
ToExpression["term" <> ToString[#]] & /@ Range[Length[vars]]},
MapThread[HoldForm[#1 = #2] &, {termList, vars}]]

exprAlt =
expr /. Indexed[p_, i_] :> ToExpression[ToString[p] <> ToString[i]]

tmpF = Function[{x, y},
Evaluate[Block[localAlt, Evaluate[exprAlt]]]
]

• One reason your Blockexamples don't work is because Evaluate will fully evaluate its arguments, including the assignments. This is course is not what you want for Block. What I usually do is to wrap my expressions in Hold, and then use a series of replacement to build uf the full expression, all inside the Hold wrapper. You have to make sure you are only relying on structural transformations, since your arguments (to Block in this case) should never be actually evaluated. yesterday
• @LukasLang, Hmm, I've tried to implement your hint, but I've made no progress. Do you mean something along the lines of this: Hold[ exampleTerms = {(x - y)^2, x y, (x - y)^4}; exprList = Expand /@ RandomChoice[exampleTerms, 10]; vars = Union[Flatten[(List @@@ exprList) /. _?IntegerQ t_ :> t]]; assigments = Thread[vars -> (Indexed[term, #] & /@ Range[Length[vars]])]; expr = exprList /. assigments; tmpF = Function[{x, y}, Evaluate[Block[Evaluate[local], Evaluate[expr]]]] ]; ReleaseHold[%] yesterday
• I initially tried to write an answer demonstrating the strategy I had in mind, but then I noticed that it can be done far simpler in this instance... (if you really want, I could add some demonstration to the answer, but it will be a lot messier in this case. Might be something for a second question with a more complicated goal) yesterday

Here's one way: Starting with your code, to define vars and expr, we can build the function like this:

With[
{expr = expr, vars = vars},
Function @@ Hold[{x, y}, Block[{term = vars}, expr]]
]
(* Function[{x, y},
Block[{term = {x, x^2, x^4, y, x y, x^3 y, y^2, x^2 y^2, x y^3,
y^4}}, {Indexed[term, {3}] - 4 Indexed[term, {6}] +
6 Indexed[term, {8}] - 4 Indexed[term, {9}] + ...}]] *)


There are two things to note:

• I'm using With to inject expr and vars into the function body without evaluating anything else.

• I'm using Function@@Hold[...] instead of Function[...] to ensure that With doesn't see that {x,y} are the arguments of Function. If it did, it would replace the names to prevent collisions with the x and y in vars and expr:

With[
{expr = expr, vars = vars},
Function[{x, y}, Block[{term = vars}, expr]]
]
(* Function[{x$$, y$$},
Block[{term = {x, x^2, x^4, y, x y, x^3 y, y^2, x^2 y^2, x y^3,
y^4}}, {Indexed[term, {3}] - 4 Indexed[term, {6}] +
6 Indexed[term, {8}] - 4 Indexed[term, {9}] + ...}]] *)


That being said, you can simply use ExperimentalOptimizeExpression to automatically perform the task for you:

Function[{x, y}, Evaluate@ExperimentalOptimizeExpression[exprList]]
(* Function[{x, y},
Block[{Compile$$13, Compile$$14, Compile$15, Compile$$16, Compile$$17, Compile$18, Compile$$19, Compile$$20, Compile$21, Compile$$22, Compile$$23, Compile$24}, Compile$$13 = x^4; Compile$$14 = x^3; Compile$15 = -4 Compile$$14 y; Compile$$16 = x^2; Compile$17 = y^2;
Compile$$18 = 6 Compile$$16 Compile$17; Compile$$19 = y^3; Compile$$20 = -4 x Compile$19; Compile$$21 = y^4; Compile$$22 =
Compile$13 + Compile$$15 + Compile$$18 + Compile$20 +
Compile$$21; Compile$$23 = -2 x y;
Compile$24 = Compile$$16 + Compile$$23 + Compile$17; {Compile$$22, Compile$$22, Compile$24, Compile$$24, Compile$$22, Compile$22,
Compile$$24, x y, Compile$$22, Compile\$24}]] *)

• It is interesting that "ExperimentalOptimizeExpression[exprList]" is different from what Compile[..., CompilationOptions -> {"ExpressionOptimization" -> True}] is doing under the hood. The expressions are close, but "CompiledFunctionTools`CompilePrint" gives a result which is a little different. Puzzling why that effort appears to be roughly duplicated (I don't know how to make the back ticks not format like code in the above) yesterday