Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2005
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2005

[Date Index] [Thread Index] [Author Index]

Search the Archive

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





  • Prev by Date: Re: Problem with circles in complex plane
  • Next by Date: Re: Language vs. Library
  • Previous by thread: Wick like theorem and "symbolic" compilation
  • Next by thread: Re: Wick like theorem and "symbolic" compilation