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.

Assuming I have two function:

example 1:

add[{x_, y_, z_}] := x + y - z
add[{1, 3, 5}]

If use pure function,I know I can write it as :

Function[{x}, x[[1]] + x[[2]] - x[[3]]][{1, 3, 5}]

example 2:

fun[{a_, b_}, y_] := If[y~Mod~2 == 0, {a~Join~{y}, b}, {a, b~Join~{y}}]
Fold[fun, {{}, {}}, Range@10]

Fold[Function[{x, y}, 
  If[y < 5, {Join[x[[1]], {y}], x[[2]]}, {x[[1]], 
    Join[x[[2]], {y}]}]], {{}, {}}, Range[10]]

I think this a little prolix with many "[[]]", can you tell me another simpler way?

Updated

Do[
  If[i[[1]] < i[[4]] < i[[7]] && 
    i[[1]]/(10 i[[2]] + i[[3]]) + i[[4]]/(10*i[[5]] + i[[6]]) + 
      i[[7]]/(10 i[[8]] + i[[9]]) == 1, Print@i
   ],
  {i, Permutations[Range[9]]}
  ] // Timing
{2.153, Null}

============

Do[If[(x /. {a_, b_, c_, d_, e_, f_, g_, h_, i_} :> 
      a < d < g && a/(10 b + c) + d/(10 e + f) + g/(10 h + i) == 1), 
   Print@x], {x, Permutations[Range[9]]}] // Timing
{10.374, Null}
(*can't compiled*)

=============

Block[{a, b, c, d, e, f, g, h, i},
  Do[
   If[{a, b, c, d, e, f, g, h, i} = x;
    a < d < g && a/(10 b + c) + d/(10 e + f) + g/(10 h + i) == 1, 
    Print@x], {x, Permutations[Range[9]]}]
  ] // Timing
{2.543, Null}
(*easy compiled*)
(*If Module or Blcok within Do loop, Module will slower than Block *)
share|improve this question
    
Possible duplicate: mathematica.stackexchange.com/q/8382/121 –  Mr.Wizard Jan 12 '13 at 15:03
    
Thanks, it's useful to me. –  mathe Jan 12 '13 at 15:09
    
Please see my edit which addresses speeding up / compilation within the approach I proposed. –  Leonid Shifrin Jan 12 '13 at 17:31
add comment

4 Answers

up vote 16 down vote accepted

Preamble

This is IMO a very good question. I will try to describe an approach based on code-generation, which in my view would allow one to get the most benefits of declarative rule-based-like definitions without essentially imposing eny limitations or introducing any inconsistencies. The resulting functions can also be Compiled.

General solution via code generation and overloading

Code

As an alternative, one can overload Function, in the following way:

Unprotect[Function];
Function[{left___, {syms__Symbol}, right___}, body_,atts_:{}] :=
  Module[{var},
    With[{
        rules = Thread[# :> Evaluate[  Range[Length[#]]]] &@
          Thread[HoldPattern[{syms}]] /. ind_Integer :> var[[ind]]
      },
      Function @@ (Hold[{left, var, right}, body,atts] /. rules)
    ]
  ];
Protect[Function];

Since by itself, Function does not have such extended syntax, this should be reasonably safe.

Usage

You can then call:

Function[{{x,y,z}},x+y-z]

and what you get will look like

(* Function[{var$28109},var$28109[[1]]+var$28109[[2]]-var$28109[[3]]] *)

so that the above code does some code-generation for you. Your second example also works verbatim, without any modiication:

Fold[
  Function[{{a, b}, y},If[y~Mod~2 == 0, {a~Join~{y}, b}, {a, b~Join~{y}}]], 
  {{}, {}}, 
  Range@10]

(* {{2, 4, 6, 8, 10}, {1, 3, 5, 7, 9}} *)

Function's attributes can also be handled. The following, in particular, will do in-place modifications of a list passed as a first argument:

lst = {0, 0, 0};
Function[{{a, b, c}, d, e, f}, a = d; b = e; c = f, HoldAll][lst, 1, 2, 3];
lst 

(* {1, 2, 3} *)

again, with a transparent and easy to read syntax. Such behavior does not seem to be easy to reproduce in other approaches, at least without some loss of clarity / readability.

Advantages of this scheme

In my opinion, this scheme has a number of advantages w.r.t. other solutions, in particular those based on replacement rules. Some of them:

  • Generality - it can handle all cases without any modifications to the body of the function, w.r.t. how you'd write it in a rule-based style.
  • Support of function's attributes.
  • No impedance mismatch with Function: since the result is good old pure function, it does not have any limitations or inconsistencies in terms of how it can be used (e.g. in Compile, see next item, but perhaps not only)
  • Such functions can be Compile-d rather straightforwardly, which is described in the last section of the answer.

Making it safer with a dynamic environment

Since overloading built-in functions globally is generally a bad idea, you can make it safer by creating a local dynamic environment.

Code

This is done with Internal`InheritedBlock:

ClearAll[withAddedFunctionSyntax];
SetAttributes[withAddedFunctionSyntax, HoldAll];
withAddedFunctionSyntax[code_] :=
  Internal`InheritedBlock[{Function},
    Unprotect[Function];
    Function[{left___, {syms__Symbol}, right___}, body_, atts_:{}] :=
      Module[{var},
        With[{
            rules = Thread[# :> Evaluate[  Range[Length[#]]]] &@
              Thread[HoldPattern[{syms}]] /. ind_Integer :> var[[ind]]
          },
          Function @@ (Hold[{left, var, right}, body,atts] /. rules)
        ]
      ];
    Protect[Function];
    code
  ];

Usage

you can now execute the code in this environment:

withAddedFunctionSyntax[Function[{{x,y,z}},x+y-z][{1,3,5}]]

(* -1 *)

Note that it is enough to execute only the part with your function definition in that environment, you can export it to a global one:

fun= withAddedFunctionSyntax[Function[{{x,y,z}},x+y-z]]

(* Function[{var$357},var$357[[1]]+var$357[[2]]-var$357[[3]]] *)

fun[{1,3,5}]

(* -1  *)

Certain special cases, speed-ups and compilation

As the OP rightly noted, using replacement rules presents also problems for speeding up and / or compiling the functions obtained that way. Here, I will use the OP's added example to show how one can speed up and also compile functions obtained via the procedure I proposed above. I will be using the global (less secure) version of the Function overloading for simplicity, but it is trivial to use also a dynamic environment.

Problems with naive usage in loops etc

First, let us try to run the naive version of the code:

Do[
  Function[{{a, b, c, d, e, f, g, h, i}},
     If[a < d < g && a/(10 b + c) + d/(10 e + f) + g/(10 h + i) == 1, 
         Print[{a, b, c, d, e, f, g, h, i}]
     ]][i], {i,Permutations[Range[9]]}
] // Timing

I had to Abort[] this code, since it was taking way too long. And it is easy to understand why: since Do holds its arguments, the function expansion defined above was used at every function's invocation.

Simple work-around: store a pure function in a variable

The simplest way to deal with this problem is to define a function separately, and store in a variable, like so:

fn = 
 Function[{{a,b,c,d,e,f,g,h,i}},
  If[a<d<g&&a/(10 b+c)+d/(10 e+f)+g/(10 h+i)==1,Print[{a,b,c,d,e,f,g,h,i}]]];

Do[fn[i],{i,Permutations[Range[9]]}]//Timing

During evaluation of In[42]:= {5,3,4,7,6,8,9,1,2}
(*  {4.593750,Null}  *)

This however is not the most general way.

General way out: adding function-expanding macro

Another way would be to write a function-expanding macro. Here it is:

ClearAll[functionExpand];
SetAttributes[functionExpand, HoldAll];
functionExpand[code_] :=
   Unevaluated[code] /. f_Function :> With[{eval = f}, eval /; True]

It uses Trott-Strzebonski in-place evaluation technique, described also here (see also the answer of WReach there), and here, to expand Function inside the code. With it, one can do:

functionExpand[
  Do[
    Function[{{a,b,c,d,e,f,g,h,i}},
      If[a<d<g&&a/(10 b+c)+d/(10 e+f)+g/(10 h+i)==1,Print[{a,b,c,d,e,f,g,h,i}]]
    ][i],{i,Permutations[Range[9]]}
  ]
]//Timing

During evaluation of In[43]:= {5,3,4,7,6,8,9,1,2}
(* {4.546875,Null} *)

Compilation

Let me now show how one would compile the code obtain in this way. The recipe is very simple - use functionExpand again. So, for example:

compiled = 
  functionExpand[
    Compile[{{p, _Integer, 1}},
       Function[{{a, b, c, d, e, f, g, h, i}},
         If[a < d < g && a/(10 b + c) + d/(10 e + f) + g/(10 h + i) == 1, 
           {a, b, c, d, e, f, g, h, i}, 
           {}
         ]][p]
    ]]

where I slightly changed the output so that we return rather than Print, and there are no calls to the main evaluator then. You can check that compiled contains only the byte-code instructions, so it all works. Now, this speeds things up quite a bit:

Do[If[compiled[p]!={},Print[p]],{p,Permutations[Range[9]]}]//Timing

During evaluation of In[36]:= {5,3,4,7,6,8,9,1,2}
(* {0.890625,Null}  *)

This is not the end of the story, however. One improvement would be to compile to C. Another improvement is to compile entire loop as well:

fullCompiled = 
  Compile[{},
     Do[If[compiled[p] != {}, Print[p]], {p, Permutations[Range[9]]}],
     CompilationOptions -> {"InlineCompiledFunctions" -> True}
  ];

One can also test that,apart from Print, we get byte-code instructions again (note that the option "InlineCompiledFunctions" was used). So,

fullCompiled[]//Timing

During evaluation of In[49]:= {5,3,4,7,6,8,9,1,2}
(*  {0.312500,Null}  *)

Finally, we can also inline external definitions:

fullCompiledInlined = 
  Compile[{},
     Do[If[compiled[p] != {}, Print[p]], {p, Permutations[Range[9]]}],
     CompilationOptions -> {
        "InlineCompiledFunctions" -> True, 
        "InlineExternalDefinitions" -> True
     }];

which gives another 2x speedup in this case:

fullCompiledInlined[]//Timing

During evaluation of In[50]:= {5,3,4,7,6,8,9,1,2}
(* {0.187500,Null} *)

So, we got a 20x speedup due to compilation. Compilation to C target would likely bring further speed enhancements.

What I've shown here is the workflow involving the overloaded Function, and ways to speed up and / or compile code using it.

share|improve this answer
    
It's deja vu all over again! :o) –  Mr.Wizard Jan 12 '13 at 16:10
    
@Mr.Wizard But this time, I think this method is even more on target. Apparently, I seem to have used a more elegant code-generation scheme in the destructuring answer, but have no time now to check and refine it here. –  Leonid Shifrin Jan 12 '13 at 16:19
1  
I agree it's on target and you got my vote. ( It's your main purpose in life after all. ;^) ) –  Mr.Wizard Jan 12 '13 at 16:24
2  
Wha?? No preamble? –  rm -rf Jan 12 '13 at 18:21
2  
Performance tuning, code generation, dynamic environments, preamble, several links, and 99999 words of which the 2 most redundant are "Leonid Shiffrin". +1 –  Rojo Jan 13 '13 at 0:41
show 9 more comments

It is not exactly equivalent for all inputs, but neither are your examples. Does this serve your purposes?

# /. {{x_, y_}, z_} :> x + y - z^2 &
share|improve this answer
5  
Function[{x}, Module[{a, b, c}, {a, b, c} = x; a + b - c]][{1, 3, 5}] ? –  belisarius Jan 12 '13 at 15:03
add comment

Depending on your intentions this may be a duplicate of Mathematica Destructuring but if not:

# + #2 - #3 & @@ {1, 3, 5}

Or

# + #2 - #3 & @@ # & @ {1, 3, 5}

And

Fold[
  Function[{x, y}, If[y < 5, {# ~Join~ {y}, #2}, {#, #2 ~Join~ {y}}] & @@ x],
  {{}, {}},
  Range[10]
]

Similar to Rojo's answer (and my answer to Mathematica Destructuring):

Fold[
  # /. {a_, b_} :> If[#2 < 5, {a ~Join~ {#2}, b}, {a, b ~Join~ {#2}}] &,
  {{}, {}},
  Range[10]
]
share|improve this answer
add comment

Mr. Wizard already linked to my previous answer on deconstruction, but I though I'd add a solution using it anyway, since it seems to translate almost directly from the function definition which might be what you are looking for:

First, I define a new function dFunction which is only applied if it can successfully deconstruct its arguments:

 SetAttributes[dFunction, HoldAll]
 dFunction[pattern_, body_][arg___] /; MatchQ[{arg}, pattern] := 
    {arg} /. pattern :> body

Then I add to the definition of Function that whenever it's first argument contains patterns, it should switch to dFunction since this is invalid syntax for Function, it shouldn't cause any trouble:

 Unprotect[Function];
 patternQ[expr_]:=Not[0===Length@Cases[expr,_Pattern,\[Infinity]]]
 Function[a_List/;patternQ[a],body_,attr___]:=dFunction[a,body,attr]
 Protect[Function];

Note that attributes are dropped. My most often used attribute HoldAll doesn't work nicely with SubValues, so I've haven't yet sat down and tried to think about getting attributes handled. Then your example two is simply solved by taking the pattern from your definition and inserting into Function:

  fun[{a_, b_}, y_] := If[y~Mod~2 == 0, {a~Join~{y}, b}, {a, b~Join~{y}}]
  Fold[fun, {{}, {}}, Range@10]

vs.

  Fold[
  Function[{{a_, b_}, y_}, If[y~Mod~2 == 0, {a~Join~{y}, b}, {a, b~Join~{y}}]]
  , {{}, {}}, Range@10]
share|improve this answer
add comment

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.