How to programmatically construct a function or a compiled function?

Question

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

Answer 1

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 Experimental`OptimizeExpression to automatically perform the task for you:

Function[{x, y}, Evaluate@Experimental`OptimizeExpression[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}]] *)