RE: Re: doing things on a procedural way and doing them on a functional way
- To: mathgroup at smc.vnet.net
- Subject: [mg46991] RE: [mg46988] Re: doing things on a procedural way and doing them on a functional way
- From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
- Date: Fri, 19 Mar 2004 01:35:45 -0500 (EST)
- Sender: owner-wri-mathgroup at wolfram.com
>-----Original Message----- >From: Paul Abbott [mailto:paul at physics.uwa.edu.au] To: mathgroup at smc.vnet.net >Sent: Thursday, March 18, 2004 10:38 AM >To: mathgroup at smc.vnet.net >Subject: [mg46991] [mg46988] Re: doing things on a procedural way and doing them >on a functional way > > >In article <c3bgd8$7q2$1 at smc.vnet.net>, > Andrzej Kozlowski <akoz at mimuw.edu.pl> wrote: > >> I guess a little self-advertisement is not a major offence on this >> list, so I suggest looking at my article in the forthcoming >Mathematica >> Journal. If you can't wait you or don't have a subscription you can >> download it form >> >> <http://www.mimuw.edu.pl/~akoz/Mathematica/AlgebraicProgramming.nb> > >Nice article. > >Here is another approach for this particular problem: > > l = {a, b, c, d, e}; > > Flatten[Nest[ > Flatten[ReplaceList[#, {a___,b_,c_,d___} :> {a,{b,c},d}]& /@ #, 1]&, > {l}, Length[l]-1], 1] // Union > >I can't help but feel that there should be an elegant way to do this >using Distribute ... > >Cheers, >Paul > >-- >Paul Abbott Phone: +61 8 9380 2734 >School of Physics, M013 Fax: +61 8 9380 1014 >The University of Western Australia (CRICOS Provider No >00126G) >35 Stirling Highway >Crawley WA 6009 mailto:paul at physics.uwa.edu.au >AUSTRALIA http://physics.uwa.edu.au/~paul > You're completely right, the solution, I published yesterday, also works with distribute (instead of Outer): In[32]:= nocnac[{arg_}, op_] := {arg} In[33]:= nocnac[{args__}, op_] := Flatten[ReplaceList[{args}, {a__, b__} :> Distribute[op[nocnac[{a}, op], nocnac[{b}, op]], List]], 1] In[34]:= nocnac[{1}, CenterDot] Out[34]= {1} In[35]:= nocnac[{1, 2}, CenterDot] Out[35]= {1·2} In[36]:= nocnac[{1, 2, 3}, CenterDot] Out[36]= {1·(2·3), (1·2)·3} In[37]:= nocnac[{1, 2, 3, 4}, CenterDot] Out[37]= {1·(2·(3·4)), 1·((2·3)·4), (1·2)·(3·4), (1·(2·3))·4, ((1·2)·3)·4} In[38]:= nocnac[{1, 2, 3, 4, 5}, CenterDot] Out[38]= {1·(2·(3·(4·5))), 1·(2·((3·4)·5)), 1·((2·3)·(4·5)), 1·((2·(3·4))·5), 1·(((2·3)·4)·5), (1·2)·(3·(4·5)), (1·2)·((3·4)·5), (1·(2·3))·(4·5), ((1·2)·3)·(4·5), (1·(2·(3·4)))·5, (1·((2·3)·4))·5, ((1·2)·(3·4))·5, ((1·(2·3))·4)·5, (((1·2)·3)·4)·5} In[39]:= Length[nocnac[Range[#], op]] & /@ Range[10] Out[39]= {1, 1, 2, 5, 14, 42, 132, 429, 1430, 4862} If we only want to have the number of possible nestings we may have that cheaper: In[49]:= nc[1] = 1; In[50]:= nc[n_] := (nc[n] = Sum[nc[i]*nc[n - i], {i, 1, n - 1}]) In[53]:= nc /@ Range[20] Out[53]= {1, 1, 2, 5, 14, 42, 132, 429, 1430, 4862, 16796, 58786, 208012, 742900, 2674440, 9694845, 35357670, 129644790, 477638700, 1767263190} I don't know, but assume that this can be expressed simply through some sort of combinatorical numbers. Interestingly I observe... In[57]:= nc[#]/nc[# - 1] & /@ Range[2, 30] // N Out[57]= {1., 2., 2.5, 2.8, 3., 3.14286, 3.25, 3.33333, 3.4, 3.45455, 3.5, 3.53846, 3.57143, 3.6, 3.625, 3.64706, 3.66667, 3.68421, 3.7, 3.71429, 3.72727, 3.73913, 3.75, 3.76, 3.76923, 3.77778, 3.78571, 3.7931, 3.8} ...and... In[58]:= nc[#]/nc[# - 1] &[100] // N Out[58]= 3.94 In[59]:= nc[#]/nc[# - 1] &[200] // N Out[59]= 3.97 In[61]:= nc[#]/nc[# - 1] &[400] // N Out[61]= 3.985 In[65]:= nc[#]/nc[# - 1] &[800] // N Out[65]= 3.9925 In[73]:= nc[#]/nc[# - 1] &[1600] // N Out[73]= 3.99625 The conjecture of course is, that asymtotically nc[n] ~ 4^n. -- Hartmut Wolf