[Date Index]
[Thread Index]
[Author Index]
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**
| |