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] ====