Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I need a function which can take an expression and return a pure function based on the symbols in the expression. The symbols might have values so must be protected from evaluation. It is probably easiest to give an example:

I would like to evaluate something like

x = y = 1;
extractPureFunction[Sin[Pi x^2] + y]

and obtain

Function[{x, y}, Sin[Pi x^2] + y]

or

(Sin[Pi #1^2] + #2) &

Any ideas?

share|improve this question
7  
Just curious: how would you ever going to use the Function if you don't know in which order the variables may end up? I mean, they are sorted alphabetically, so if I swapped x and y the structure of the original function would be the same, but the resulting Function would behave differently. –  Sjoerd C. de Vries Aug 30 '12 at 21:56
    
@SjoerdC.deVries, good question! Essentially I want to be able to transform an expression to a form which matches the pattern func_[vars__]. I wouldn't be using func by itself (despite the wording of my question, the pure function alone is not the final goal) –  Simon Woods Aug 31 '12 at 13:05

6 Answers 6

up vote 15 down vote accepted

What about taking the symbols not in heads that haven't got the NumericFunction or Constant or Protected attribute (thanks @OleksandrR) and that are in the Global` context? The condition can easily be tweaked, and also one can easily add options on attributes, contexts, or extra symbols to be included or always excluded of argmuents

SetAttributes[{extractPureFunction, condition}, HoldFirst];
condition[i_Symbol] := 
  FreeQ[Attributes@i, NumericFunction | Constant | Protected] && 
   Context@i == "Global`";


extractPureFunction[expr_] := 
 Union@Cases[Unevaluated@expr, 
     i_Symbol?condition :> Hold[i], {0, Infinity}]~Thread~Hold /. 
  Hold[vars_] :> Function[vars, expr]


extractPureFunction[Sin[x] x + Pi + y - Total@Through@{Tan, ArcTan}[E]]

Function[{x, y},Sin[x] x + [Pi] + y - Total[Through[{Tan, ArcTan}[E]]]]

Note, this doesn't respect inner scoping constructs so variables from inner Functions or Modules for example would get listed as arguments

share|improve this answer
2  
I was puzzling over whether to post this myself, but I forgot to consider the Attributes--good catch. Also, your use of Thread is nice (I had used a {Flat, HoldAll} function). –  Oleksandr R. Aug 30 '12 at 17:10
    
Thanks @OleksandrR. This kind of manipulations are never easy, at least for me, I don't do them often –  Rojo Aug 30 '12 at 17:27
    
Oh, and also: setting Heads -> True for Cases might be a useful addition, depending on how you want things like Derivative[x][y] to behave. –  Oleksandr R. Aug 30 '12 at 17:34
    
Thinking a bit more about the attributes: isn't it enough just to check for Protected? If something has that then it can't have been meant as a variable in the first place. Constant, on the other hand, just means its derivative is zero, which may or may not be relevant here. –  Oleksandr R. Aug 30 '12 at 19:45
    
@OleksandrR. that's probably a good idea. However, there's a Cases[Names["System`*"], i_ /; FreeQ[Attributes@i, Protected]] long list of unprotected System symbols to think about. Edited to add that check but I'm not sure if the others are redundant –  Rojo Aug 30 '12 at 19:49

Well, since you defined x=y=1, evaluation semantics will make it very difficult to get at them inside your mathematical expression.

The general issue is one of extracting the variables. I show a way to go about that here. With getAllVariables as defined therein, one can then do as below.

extractPureFunction[expr_] := Module[{vars, func},
  vars = Cases[getAllVariables[expr],_Symbol];
  func[vars, expr] /. func -> Function]

Test:

In[38]:= extractPureFunction[Sin[Pi t^2] + w]

(* Out[38]= Function[{w, t}, w + Sin[Pi*t^2]] *)
share|improve this answer
    
extractPureFunction[Sin[Pi t^2] + w[[1]]] –  belisarius Aug 30 '12 at 16:21
    
@Verde Fixed, more or less. That is to say, it will now only accept "variables" that are symbols. I'm sure it's still not bullet proof. –  Daniel Lichtblau Aug 30 '12 at 16:35
    
Sounds fair enough :) –  belisarius Aug 30 '12 at 16:50
    
I like your getAllVariables. Shame that we need something like Internal`LocalizedBlock to actually use most of those expressions as variables, though... –  Oleksandr R. Aug 30 '12 at 17:41
    
Thanks Daniel. Unfortunately I really need something that works when the variables have values. Your getAllVariables is definitely one for the toolbag though. –  Simon Woods Aug 31 '12 at 13:06

I'm sure this is far from watertight, but it seems to work for the expression I've tried. The hard bit was preventing Mathematica from evaluating the symbols prematurely.

toFunction[exp_] := Module[{exp1, syms},
  exp1 = ToExpression[exp, InputForm, Hold];
  syms = SymbolName /@ Pick[#, Not[NumericQ[Unevaluated[#]]] & /@ #] &@
    ReleaseHold[{Unevaluated /@ Level[exp1, {-1}, Hold]}];
  ToExpression["Function[ {" <> StringJoin[Riffle[syms, ","]] <> "}," <> exp <> "]"]]

Example:

a = 2;
ff = toFunction["Sin[abc a+b+Pi/5]^4-5"]

(* Function[{abc, a, b}, Sin[abc a + b + \[Pi]/5]^4 - 5] *)

Edit: I missed the fact that the argument was given as an expression and not as a string. In that case you could do something like

SetAttributes[toFunction, HoldAll]
toFunction[exp_] := Module[{syms},
  syms = SymbolName /@ Pick[#, Not[NumericQ[Unevaluated[#]]] & /@ #] &@
    ReleaseHold[{(Unevaluated /@ Level[Hold[exp], {-1}, Hold])}];
  ToExpression[
   "Function[ {" <> StringJoin[Riffle[syms, ","]] <> "}," <> 
    ToString[Unevaluated[exp], InputForm] <> "]"]]
share|improve this answer
    
Lateral thinking, I like it! The code needs a Union or DeleteDuplicates to catch multiple occurrences of the same symbol. –  Simon Woods Aug 31 '12 at 13:08

Here's my approach. It works by picking out only the non-heads and then filtering out the built-in constants like π, E and numbers.

ClearAll[toPureFunction]
SetAttributes[toPureFunction, HoldAll]
toPureFunction[expr_] := With[{constantQ = MemberQ[Attributes[#], Constant] &}, 
    Module[{vars, func}, 
        vars = Quiet[
            Cases[
                HoldForm@expr // Level[#, {-1}, Unevaluated] &, 
                x_Symbol?(OwnValues[#] =!= {} || ! constantQ[#] &) :> Hold@x], 
            OwnValues::sym];

        Quiet[Function[Evaluate@DeleteDuplicates@vars, expr] // ReleaseHold, Function::flpar]
    ]
]

Here's the output on some of the examples used in the question and other answers:

toPureFunction[Sin[π x^2] + y]
(* Function[{x, y}, Sin[π x^2] + y] *)

toPureFunction[Sin[x] x + Pi + y - Total@Through@{Tan, ArcTan}[E]]
(* Function[{x, y}, Sin[x] x + π + y - Total[Through[{Tan, ArcTan}[E]]]] *)
share|improve this answer
    
Nice. I must say I like the pragmatism of Quieting the warnings rather than doing code gymnastics to avoid them. A minor point is that your approach removes any Hold in the original expression. –  Simon Woods Aug 31 '12 at 13:07

Here's my approach, which is similar to Rojo's in some ways. I'm taking the simple approach that any symbol not in System` is a user variable. (Adjust the condition as needed.)

SetAttributes[extractPureFunction, HoldAll]
SetAttributes[heldVariables, HoldAll]

heldVariables[e_] := 
 Thread[Union[
   Cases[HoldForm[e], 
    s_Symbol /; Context[s] =!= "System`" :> Hold[s], Infinity]], Hold]

extractPureFunction[e_] := 
 ReleaseHold[Function @@@ Thread[{heldVariables[e], Hold[e]}, Hold]]

Here's the test case:

x = y = 1;
extractPureFunction[Sin[Pi x^2] + y]

(*  ==> Function[{x, y}, Sin[\[Pi] x^2] + y]  *)
share|improve this answer

Since I put something together to do this this past fall, I guess I should throw my hat in the ring, too. I think it is close to water tight, but I can't be sure.

First, we need to determine what the variables in the expression are

Clear[GetVariables]
SetAttributes[GetVariables, HoldFirst];
GetVariables[expr_, f_:Identity, excludedContexts:{__String}:{"System`"}]:=
Cases[Unevaluated[expr], 
  a_Symbol /; 
    !(   MemberQ[excludedContexts, Context[a]] 
      || MemberQ[Attributes[a], Locked | ReadProtected]
     ) :> f[a], 
  {0, Infinity}
]//DeleteDuplicates

Unlike the others, it provides flexibility in specifying which Contexts are to be excluded, and removes from consideration both Locked and ReadProtected symbols. As a flaw, it only looks at symbols, so it won't distinguish between Subscript[a,1] and Subscript[a,2]. The second parameter here is special, it allows us to put wrappers, such as Hold, around an accepted symbol to prevent its execution.

Second, we need to use it:

ClearAll[MakeFunction]
Options[MakeFunction]={VariableList->Automatic};
SetAttributes[MakeFunction, HoldFirst];

(* This first form allows pure functions to be used *)
MakeFunction[afcn_Function, opts:OptionsPattern[]]:= afcn

MakeFunction[fexpr_, opts:OptionsPattern[] ]:= 
Module[{vars},
vars = If[OptionValue[VariableList]===Automatic,
             (* GetVariables returns {Hold[x_] ..} we want Hold[{x_ ..}] *)
             Distribute[Sort[GetVariables[fexpr, Hold]], Hold],
             OptionValue[Automatic, Automatic, VariableList, Hold]
           ];
Function @@ Join[vars, Hold[fexpr]]
]

There are a couple things to notice here. First, it allows for pure functions to be passed to it. This is merely for convenience as it makes it more broadly applicable. Second, the option VariableList allows the user to specify what the variables actually are because if we know them already, we might as well use them. This has the added benefit of allowing the user to change the order of the parameters which defaults to lexical sorting.

Through @ (MakeFunction /@ {x^2, Sin[x y^2], x + I y})[3, 4]
(* {9, Sin[48], 3 + 4 I} *)

Through @ (MakeFunction[#, VariableList -> {y, x}] & /@ {x^2, Sin[x y^2], x + I y})[3, 4]
(* {16, Sin[36], 4 + 3 I} *)
share|improve this answer
    
I really wish I could accept two answers. This is excellent, thank you. –  Simon Woods Aug 31 '12 at 13:07
    
@SimonWoods thanks. Admittedly, it isn't entirely my work, Leonid looked at it a while back and had some suggestions. –  rcollyer Aug 31 '12 at 14:36
    
@SimonWoods it was needed to create a function which allowed me to plot along an arbitrary $\mathbb{R}^N \to \mathbb{R}$ function using Plot, and I desperately needed the ability to make an expression executable. –  rcollyer Aug 31 '12 at 14:40

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.