Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2000
*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 2000

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

Search the Archive

Re: fastest way to do pair-sum / make pair-list

  • To: mathgroup at smc.vnet.net
  • Subject: [mg23213] Re: [mg23170] fastest way to do pair-sum / make pair-list
  • From: "Mark Harder" <harderm at ucs.orst.edu>
  • Date: Mon, 24 Apr 2000 01:12:20 -0400 (EDT)
  • Sender: owner-wri-mathgroup at wolfram.com

Winand wrote:


>1.
>
>What is the most efficient way to calculate the sum
>Sum f [ (x[[i]]-x[[j]])^2 ] , i<j??
>
>Example:
>I have a vector of real numbers:
>lst = N[Range[100]];
>and a function operating on a number:
>f[r2_]:=(r2-1.0)^2
>
>Is
>
>Sum[  Sum[  f [ (lst[[i]]-lst[[j]])^2 ] , {j,i+1,Length[lst]}],
>{i,1,Length[lst-1]}]
>
>the fastest way??
>
>This kind of sum is very common in Molecular Modelling, where the total
>energy of a system is often a sum of pair-energies, which only depend on
>the distance between atoms.
>I was surprised that I didn't find anything on sums over pairs in
>Mathematica...
>
>2.
>
>What is the most efficient way to generate a list of pairs starting from
>a list??
>Is there a standard Mathematica routine which does this?
>
>e.g.  {a,b,c,d} ----> {{a,b},{a,c},{a,d},{b,c},{b,d},{c,d}}
>
>or {x1,x2,...} -----> { {xi,xj} ...}
>with i<j
>
>Best solution I found was
>topairs[lst_] :=
>  Module[{l=Length[lst]},
>     Map[(Sequence @@ #1) &,
>             Table[ lst [[{i, j}]], {i, 1, l - 1}, {j, i + 1, l}]
>     ]
>  ]
>
>Another possibility would be
>topairs2[lst_] :=
>  Module[{l = Length[lst]},
>    Partition[
>       Flatten[
>           Table[ lst[[{i, j}]], {i, 1, l - 1}, {j, i + 1, l}]
>       ], 2
>    ]
> ]
>
>but this doesn't have the same effect if operating on a list of lists
>  topairs[{{a1, a2}, {b1, b2}, {c1, c2}}]
>gives what we want,
>  topairs2[{{a1, a2}, {b1, b2}, {c1, c2}}]
>not

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

    I don't know if I have the *most* efficient ways to do these things, but
I took an interest in this & here are some results:

    First, it is not necessary to reiterate the Sum[] function (at least not
in v4.0); look at the documentation & you will see that  Sum accepts double
indices, with the outermost index first.  Your Sum[Sum[... method executes
on my machine in .7+ seconds compared with the following:

Timing[ Sum[ (lst[[i]] - lst[[j]])^2 , {i, 1, Length[lst - 1]}, {j, i + 1,
Length[lst]} ]  ]

Out[484]=
{0.29 Second, 8332500}

In working on this problem at one point, I  tried to avoid double indices
althogether (by replacing one copy of the list with Drop[lst,i], and using
some other Mathematica tricks (see below) ), but that method for calculating
(lst[[i]] - lst[[j]])^2 was significantly slower than the above.

As for creating the list of pairs, I created the following:

In[477]:=lst = Range[1, 100];

In[465]:=ClearAll[Pairs ];
               Pairs[lst1_List, lst2_List, len_Integer] /; (Length[lst1] ==
Length[lst2]) :=
               Flatten[Table[Map[{lst1[[i]], #} &, Drop[lst2, i ] ], {i,
len - 1} ], 1 ];

In[478]:=Timing[rslt = Pairs[lst, lst, Length[lst] ];  ]
                lr = Length[rslt]

Out[478]={0.892 Second, Null}
Out[479]=4950

This method produced the right result, but Table[], like Sum[] takes
multiple indices, so I tried the following, even simpler method:

In[487]:=ll = Length[lst2 ];
               Flatten[Table[{lst2[[i]], lst2[[j]]}, {i, ll}, {j, i + 1,
ll} ], 1 ]
Out[488]={{a, b}, {a, c}, {a, d}, {a, e}, {b, c}, {b, d}, {b, e}, {c, d},
{c, e}, {d, e}}

In[493]:=ll = Length[lst]
               rslt = Flatten[Table[{lst[[i]], lst[[j]]}, {i, ll}, {j, i +
1, ll} ], 1 ]; // Timing
               Length[rslt]
Out[493]=100
Out[494]={0.12 Second, Null}
Out[495]=4950

Lots better!

You asked for a built-in function. Here's an add-on function called
KSubsets[] :
In[509]:=Needs["DiscreteMath`Combinatorica`"]
               KSubsets[lst2, 2]
Out[509]={{a, b}, {a, c}, {a, d}, {a, e}, {b, c}, {b, d}, {b, e}, {c, d},
{c, e}, {d, e}}

but run with lst=Range[1,100], it is almost 3x slower than "brute force"
with Table[] ! :

In[508]:=KSubsets[lst, 2]; // Timing
Out[508]={0.33 Second, Null}

I've often wondered if Mathematica can be used to do MM, since I'm a
biophysical chemist myself.  Let us know how you're doing with it.

-mark harder
harderm at ucs.orst.edu




  • Prev by Date: Re: Demonstrate that 1==-1
  • Next by Date: Re: A simple programming question.
  • Previous by thread: Re: fastest way to do pair-sum / make pair-list
  • Next by thread: fastest way to do pair-sum / make pair-list