[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
Prev by Date:
**Re: doing things on a procedural way and doing them on a functional way**
Next by Date:
**LaTex**
Previous by thread:
**RE: doing things on a procedural way and doing them on a functional way**
Next by thread:
**RE: RE: Re: doing things on a procedural way and doing them on a functional way**
| |