Re: Wick like theorem and "symbolic" compilation
- To: mathgroup at smc.vnet.net
- Subject: [mg61105] Re: [mg61062] Wick like theorem and "symbolic" compilation
- From: "David Park" <djmp at earthlink.net>
- Date: Mon, 10 Oct 2005 02:40:07 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Alexander,
Well, the following is 10 times faster. I use KSetPartitions from
Combinatorica, select out the desired terms and use Union to eliminate
duplicates.
Needs["DiscreteMath`Combinatorica`"]
WickTheorem2[args__] /; Length[List @@ args] > 1 :=
Module[{w = List @@ args, n, subterms, work, i},
n = Length[w];
Do[work = Cases[KSetPartitions[w, i], {___, {_, _}, ___}];
work = Map[If[Length[#] == 2, Wick @@ #, Sequence @@ #] &, work, {2}];
subterms[i] = Map[Times @@ # &, work, {1}], {i, 2, n - 1}];
args + Plus @@ Union[Flatten[Table[subterms[i], {i, 2, n - 1}]]]
]
The original WickTheorem took 8.02 seconds on my computer and the
WickTheorem2 took 0.71 seconds on the timing test. Both theorems generated
764 terms.
But it's not over until Carl Woll and a few other people reply.
David Park
djmp at earthlink.net
http://home.earthlink.net/~djmp/
From: Alexander [mailto:beginning.physst at mail.ru]
To: mathgroup at smc.vnet.net
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]
Out[6]:= \!\(\*FormBox[
RowBox[{\(a\ b\ c\ d\), "+",
RowBox[{"c", " ",
FormBox[\(\(a\ b\)\&^\),
"TraditionalForm"], " ", "d"}], "+",
RowBox[{"b", " ",
FormBox[\(\(a\ c\)\&^\),
"TraditionalForm"], " ", "d"}], "+",
RowBox[{"a", " ",
FormBox[\(\(b\ c\)\&^\),
"TraditionalForm"], " ", "d"}], "+",
RowBox[{"b", " ", "c", " ",
FormBox[\(\(a\ d\)\&^\),
"TraditionalForm"]}], "+",
RowBox[{
FormBox[\(\(a\ d\)\&^\),
"TraditionalForm"], " ",
FormBox[\(\(b\ c\)\&^\),
"TraditionalForm"]}], "+",
RowBox[{"a", " ", "c", " ",
FormBox[\(\(b\ d\)\&^\),
"TraditionalForm"]}], "+",
RowBox[{
FormBox[\(\(a\ c\)\&^\),
"TraditionalForm"], " ",
FormBox[\(\(b\ d\)\&^\),
"TraditionalForm"]}], "+",
RowBox[{"a", " ", "b", " ",
FormBox[\(\(c\ d\)\&^\),
"TraditionalForm"]}], "+",
RowBox[{
FormBox[\(\(a\ b\)\&^\),
"TraditionalForm"], " ",
FormBox[\(\(c\ d\)\&^\),
"TraditionalForm"]}]}], TraditionalForm]\)
Maybe there is more simple and elegant realization of this theorem than
my code ???
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.