Re: Wick like theorem and "symbolic" compilation

*To*: mathgroup at smc.vnet.net*Subject*: [mg61132] Re: [mg61062] Wick like theorem and "symbolic" compilation*From*: "Carl K. Woll" <carl at woll2woll.com>*Date*: Tue, 11 Oct 2005 03:20:32 -0400 (EDT)*References*: <200510090535.BAA18517@smc.vnet.net>*Sender*: owner-wri-mathgroup at wolfram.com

Alexander wrote: > Dear MathGroup! > > I wrote simple programm to perform "Wick" expanding. > Here is the code: > > (*St1 - basic function to extract couples of fields from a given list*) > > st1[x_] := If[Length[ > x] === 2, Wick[Sequence @@ x], Plus @@ > ReplaceList[List @@ (x), {e___, a_, c___, > b_, d___} -> Wick[a, b] e c d]]; > > (* Some transformation rules for this function *) > > st1[x_Wick y_] := x st1[y]; > st1[a_ + b_] := st1[a] + st1[b]; > > (* Formatting rules *) > > \!\(\(Format[Wick[x_, y_]] := \(x\ y\)\&^;\)\) > > (* Final function *) > > WickTheorem[x_] := Expand[Plus @@ FixedPointList[st1, x]] //. a_ + > b_Integer c_ -> a + c; > > Simple example, showing how it works: > > In[6]:= WickTheorem[a b c d] > [snip] > Maybe there is more simple and elegant realization of this theorem than > my code ??? > I would code this using recursion. For example, with a b c d, take the first term a. It can either be unpaired, or paired up with b, c or d. After removing a and anything its paired up with, repeat with the remaining terms. Here is the code. Note that I use a sequence of arguments to wick instead of a product, and for output I use the head pair instead of wick. wick[a_] := a wick[a_, b_] := a b + pair[a, b] wick[a_, b__] := a wick[b] + Sum[pair[a, {b}[[i]]]Delete[Unevaluated[wick[b]], i], {i, Length[{b}]}] As an example, we have: In[15]:= Expand[wick[a,b,c,d]] Out[15]= a b c d+c d pair[a,b]+b d pair[a,c]+b c pair[a,d]+a d pair[b,c]+ pair[a,d] pair[b,c]+a c pair[b,d]+pair[a,c] pair[b,d]+a b pair[c,d]+ pair[a,b] pair[c,d] For the larger example you gave: In[16]:= Length[Expand[wick[a,b,c,d,e,f,w,t]]] //Timing Out[16]= {0.031 Second,764} Another example with 10 terms: In[17]:= Length[Expand[wick[a,b,c,d,e,f,g,h,i,j]]] //Timing Out[17]= {0.531 Second,9496} A final example with 13 terms: In[18]:= Length[Expand[wick[a,b,c,d,e,f,g,h,i,j,k,l,m]]] //Timing Out[18]= {51.125 Second,568504} The above code seems to be much quicker than other proposed solutions, and agrees with the OEIS link given by Peter Pein. > Second question is about optimization. > > In current realization, on my Cleleron 1700 (with 128Mb of ram) using > Mathematica 5.1 for Windows, I have following timings: > > In[7]:= WickTheorem[a b c d e f w t] // Timing // Print["Time = ", #[[ > 1]], ", Length = ", Length[#[[2]]]] & > Out[7]:= Time = 10.688 Second, Length = 764 > > So, in final expression there was 764 terms and it takes ~10 seconds to > evaluate them. Input expression contains only 8 fields, with 9 fields > computation takes a relatively long time,about 600 seconds. > > Why so long? > And what are the ways to reduce this time ? > > I have tried to use CompileEvaluate from Experimental package, but this > doesn't reduce evaluation time greatly. > > Resuming, second question sounds like: > Should I rewrite the program in more elegant and efficient way to > reduce > evaluation time or there is "symbolic" compilation technique to do > that? > > Thanks for your help! > > Alexander. > Carl Woll Wolfram Research

**References**:**Wick like theorem and "symbolic" compilation***From:*"Alexander" <beginning.physst@mail.ru>