Re: doing things on a procedural way and doing them on a functional way
- To: mathgroup at smc.vnet.net
- Subject: [mg47019] Re: doing things on a procedural way and doing them on a functional way
- From: drbob at bigfoot.com (Bobby R. Treat)
- Date: Sat, 20 Mar 2004 03:50:30 -0500 (EST)
- References: <c3e516$qk9$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
These are the Catalan numbers:
Needs["DiscreteMath`CombinatorialFunctions`"]
CatalanNumber/@Range@20
{1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900,2674440,9694845,\
35357670,129644790,477638700,1767263190,6564120420}
Bobby
"Wolf, Hartmut" <Hartmut.Wolf at t-systems.com> wrote in message news:<c3e516$qk9$1 at smc.vnet.net>...
> >-----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: [mg47019] 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.