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

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