Re: Manipulating Slot objects in Compile
- To: mathgroup at smc.vnet.net
- Subject: [mg24601] Re: Manipulating Slot objects in Compile
- From: "Rasmus Debitsch" <debitsch at Zeiss.de>
- Date: Fri, 28 Jul 2000 17:23:40 -0400 (EDT)
- References: <8lj87k$8ot@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Hello,
in one of my packages I'm using a solution like this :
Clear[compileF];
compileF[f_, nvars_] := Module[{
fx, j, vars
},
vars = Table[Unique[], {nvars}];
fx = f[vars];
Global`fc = Compile @@ {vars, fx};
j = (D[fx, #1] & ) /@ vars;
Global`dfc = Compile @@ {vars, j};
];
and
f[{x_, y_}] := x^2*y^3;
compileF[f, 2]
fc[1, 2]
dfc[1, 2]
Information["fc", LongForm -> False]
"Global`fc"
fc = CompiledFunction[{_Real, _Real},
{{3, 0, 0}, {3, 0, 1}}, {0, 0, 7, 0, 0},
{{1, 3}, {15, 0, 2}, {34, 2, 2, 3}, {15, 1, 4},
{34, 4, 4, 4, 5}, {34, 3, 5, 6}, {4, 6}},
Function[{$15, $16}, $15^2*$16^3]]
Information["dfc", LongForm -> False]
"Global`dfc"
dfc = CompiledFunction[{_Real, _Real},
{{3, 0, 0}, {3, 0, 1}}, {0, 2, 12, 0, 1},
{{1, 3}, {9, 2, 0}, {15, 1, 2}, {34, 2, 2, 2, 3},
{19, 1, 0, 4}, {34, 4, 0, 3, 5}, {9, 3, 1},
{15, 0, 6}, {34, 6, 6, 7}, {15, 1, 8},
{34, 8, 8, 9}, {19, 1, 1, 10}, {34, 10, 7, 9, 11},
{68, 5, 11, 3, 0}, {6, 3, 1, 0}},
Function[{$15, $16}, {2*$15*$16^3, 3*$15^2*$16^2}]]
The main trick is the Apply in the statements, which create the functions fc
and dfc. The Global context is given, because definition of the module
compileF is in a Private context of a package. In my application the code of
the function is optimized with the Optimize package of Terry Rob before the
compilation. This speeds up the calculations a little bit more.
Regards
Rasmus Debitsch
--
Rasmus Debitsch
Carl Zeiss Lithos GmbH
Carl Zeiss Strasse
D-73447 Oberkochen
eMail : debitsch at zeiss.de
Johannes Ludsteck <ludsteck at zew.de> schrieb in im Newsbeitrag:
8lj87k$8ot at smc.vnet.net...
> Dear Mathgroup Members,
> I want to write a program which computes the gradient of any
> function and then compiles this expression. I tried to do this by
> manipulating Slot objects.
> Unfortunately there is the following problem:
> First I define an example function.
>
> f[{x_, y_}] := x^2 y^3,
>
> Then I generate a list of (unique) variables for differentiation:
>
> arg = Table[Unique[], {2}]
> {$1,$2}
> and compute the gradient:
>
> grad = Map[D[f[arg], #] &, arg]
> {2 $1 $2^3, 3 $1^2 $2^2}
>
> Then I generate a set of replacement rules
> rules = Table[arg[[i]] -> Slot[][[i]], {i, 2}]
>
> and use them in order to get compiled code by
> applying r to grad
>
> c = Compile[{{cArg, _Real, 1}},
> Evaluate[Evaluate[grad /. r] &[cArg]]]
> Unfortunately, Mathematica doesn't replace the Slot[] object by
> cArg and I get the following Output:
>
> CompiledFunction[{cArg},
> ( { 2 Slot[][[1]] Slot[][[2]]^3, 3 Slot[][[1]]^2 Slot[][[2]]^2 }
& )[cArg],
> -CompiledCode-]
>
> Thus I tried to circumvent the problem by using Slot[1] instead:
> rules = Table[arg[[i]] -> Slot[][[i]], {i, 2}]
>
> Now the Slot[1] object disappeared, but Slot[1][[1]] was replaced
> by 1 and I got again the false result:
>
> c = Compile[{{cArg, _Real, 1}},
> Evaluate[Evaluate[grad /. r] &[cArg]]]
> now evaluates to
>
> CompiledFunction[{cArg},
> { 2 cArg[[2]]^3, 3 cArg[[2]]^2}, -CompiledCode-]
>
> The Problem here is that Slot[1][[1]] is replaced by 1.
> How can I force Mathematica to replace Slot[][[i]] by cArg[[i]] or
> to replace Slot[[1]][[1]] by cArg[[1]] instead, or is there any other
> way to get a compiled gradient from any function?
>
> Any suggestions?
>
> Of course, the seemingly awkward usage of Unique[]
> and Tables of rules is in order to collect the pieces of code into
> one Module which does the job for any function of any dimension
> (lenArg is the dimension of the argument list of function fun):
>
> compiledGradient[fun_, lenArg_] :=
> Module[{arg, rules, grad},
> arg = Table[Unique[], {lenArg}];
> grad = Map[D[fun[arg], #] &, arg];
> rules = Table[arg[[i]] -> Slot[][[i]], {i, lenArg}];
> Compile[{{cArg, _Real, 1}},
> Evaluate[Evaluate[grad /. rules] &[cArg]]]]
>
> Thank you and best regards,
> Johannes Ludsteck
>
>
> Johannes Ludsteck
> Centre for European Economic Research (ZEW)
> Department of Labour Economics,
> Human Resources and Social Policy
> Phone (+49)(0)621/1235-157
> Fax (+49)(0)621/1235-225
>
> P.O.Box 103443
> D-68034 Mannheim
> GERMANY
>
> Email: ludsteck at zew.de
>
>