MathGroup Archive 1996

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

Search the Archive

Re: Goldberg Variationen

  • To: mathgroup at smc.vnet.net
  • Subject: [mg4068] Re: [mg4015] Goldberg Variationen
  • From: brucec (Bruce Carpenter)
  • Date: Thu, 30 May 1996 02:50:51 -0400
  • Sender: owner-wri-mathgroup at wolfram.com

>>In article <4menll$jva at dragonfly.wolfram.com>,
>>Jack Goldberg  <jackgold at admin.lsa.umich.edu> wrote:
>>Hello Mma users,
>>
>>...  I need to write the trinomial expansion
>>out in terms of Sum.  Something like this:
>>
>>tri[a_,b_,c_,n_] := Sum[Multinomial[i,j,k]*a^i*b^j*c*k, ???]
>>where  i+j+k = n.  (Multinomial is a built-in function.)
>>
>>. . .[snip]. . .
>>
>>Your thoughts are more than welcome!
>
>and Dave Wagner answered:
>
>>The most general solution to the problem is to write a function that
>>generates a list of all of the indices, map the summand over the list
>>(the summand has to be converted to a pure function first), and
>>then apply Plus to the result.  The generator function would be different
>>for every special sum, but the rest could be automated.  For example,
>>you could make a new definition for Sum[summand_Function, generator_],
>>in which the first argument is the summand and the second argument
>>is the index-set generator function.  The definition would be
>>*something* like this (untested!):
>>
>>       Sum[summand_Function, generator_] :=
>>               Plus @@ summand /@ generator[]
>>
>>For the multinomial problem, you might use:
>>
>>       Sum[ Times @@ {a,b,c}^# &, f]
>>
>>where f is a suitable function from DiscreteMath`Combinatorics` that
>>generates a list of the indices.  The result should be a list of
>>triples {i, j, k}.
>>
>>I don't have time to work out the details, but you asked for my
>>thoughts, and those are them.
>>
>
>Elementary, my dear Watson...
>
>so I took a look in 'The Book' pg 133 and found no
>suitable function from DiscreteMath`Combinatorics` that generates a list of
>the indices.
>next I looked in 'The Guide to Standard Mma Packages' and again came up blank.
>
>so, not being a mathematician but a chemist, I fiddled around with this
>beautiful gem of a problem, and came up with a 'messy chemists' workaround :
>
>the list of indices for a general case with r variables is:
>
>n=3;
>r=3;
>indic=i/@Range[r];
>DeleteCases[
>        Table[indic , Evaluate[Sequence@@Map[{#,0,n}& , indic]]]~Flatten~(r-1),
>a_/;Plus@@a !=n]
>
>this produces:
>
>{{0, 0, 3}, {0, 1, 2}, {0, 2, 1}, {0, 3, 0}, {1, 0, 2}, {1, 1, 1}, {1, 2,
>0}, {2, 0, 1}, {2, 1, 0}, {3, 0, 0}}
>
>Of course, generaly, n and r need not be equal.
>
>I dare (sorry, read: 'invite') you mathematicians out there,
>to demonstrate us how it should be done properly...
>If anyone out there could come up with a 'elegant' method, not by first
>generating all combinations and then leaving out the bad ones, I would be
>interested to know how (and how it was found).
>The beauty of the problem (hence forward known as 'Goldberg Variations')
>deserves it.
>
>Wouter.

Hi!

I don't claim that the following is either proper or elegant, but it is
functional(!):

In[2]:=
Clear[Indices]
Indices[1, n_Integer] := {{n}}
Indices[r_Integer?Positive, n_Integer] :=
  Flatten /@  Flatten[Function[temp,{#, temp}] /@ Indices[r-1, n-#]& /@
Range[0, n], 1]

In[5]:=
Indices[3,3]

Out[5]=
{{0,0,3},{0,1,2},{0,2,1},{0,3,0},{1,0,2},{1,1,1},{1,2,0},{2,0,1},{2,1,0},{3,
0,0}}

Some comments:

--In the course of calculating Indices[6,6], say, the value of Indices[2,2]
is calculated 35 times.
I didn't use dynamic programming to store previously calculated values
because of the exponential increase in storage space requirements.

--With just a little modification of the code above, we can get
compositions (a composition of n represents n as a sum of non-negative
integers where order matters)

In[6]:=
Clear[Compositions]
Compositions[1,n_Integer] := {{n}}
Compositions[r_Integer?Positive, n_Integer] :=
  Flatten /@  Flatten[Function[temp, {#, temp}] /@ Compositions[r-1, n-#]&
/@ Range[1, n-1], 1]
Compositions[n_Integer?Positive] :=
        Flatten[Table[Compositions[i,n],{i,n}],1]

In[10]:=
Compositions[6]

Out[10]=
{{6},{1,5},{2,4},{3,3},{4,2},{5,1},{1,1,4},{1,2,3},{1,3,2},{1,4,1},{2,1,3},{2,
    2,2},{2,3,1},{3,1,2},{3,2,1},{4,1,1},{1,1,1,3},{1,1,2,2},{1,1,3,1},{1,2,1,
    2},{1,2,2,1},{1,3,1,1},{2,1,1,2},{2,1,2,1},{2,2,1,1},{3,1,1,1},{1,1,1,1,
    2},{1,1,1,2,1},{1,1,2,1,1},{1,2,1,1,1},{2,1,1,1,1},{1,1,1,1,1,1}}

--It is also easy to get partitions (a partition of n represents n as a sum
of non-negative integers where order doesn't matter)

In[11]:=
Clear[Partitions]
Partitions[n_Integer] := Union[Sort /@ Compositions[n]]

In[13]:=
Partitions[8]

Out[13]=
{{8},{1,7},{2,6},{3,5},{4,4},{1,1,6},{1,2,5},{1,3,4},{2,2,4},{2,3,3},{1,1,1,
    5},{1,1,2,4},{1,1,3,3},{1,2,2,3},{2,2,2,2},{1,1,1,1,4},{1,1,1,2,3},{1,1,2,
    2,2},{1,1,1,1,1,3},{1,1,1,1,2,2},{1,1,1,1,1,1,2},{1,1,1,1,1,1,1,1}}

--Mathematica has built in functions PartitionsP(giving the number of
unrestricted partitions of n) and PartitionsQ(giving the number of
partitions of n into distinct parts)

In[14]:=
Length[Partitions[8]] == PartitionsP[8]

Out[14]=
True

--You can find a different way of calculating partitions(given in reverse
lexicographic order) in the package DiscreteMath`Combinatorica`, which
contains all the programs from the excellent book, Implementing Discrete
Mathematics: Combinatorics and Graph Theory with Mathematica, by Steven S.
Skiena.

Best Regards,
Bruce Carpenter

-----------------------
Bruce Carpenter
Courseware Coordinator         phone: (217) 398-0700
Wolfram Research, Inc.           fax: (217) 398-0747
100 Trade Centre Drive         email: brucec at wolfram.com
Champaign, IL  61820             web:  http://www.wolfram.com



==== [MESSAGE SEPARATOR] ====


  • Prev by Date: mathlink
  • Next by Date: Re: How to find path to running notebook on a mac ?
  • Previous by thread: Goldberg Variationen
  • Next by thread: Innacurate Solve results