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