Re: List help needed
- To: mathgroup at smc.vnet.net
- Subject: [mg5103] Re: List help needed
- From: Todd Gayley <tgayley>
- Date: Wed, 30 Oct 1996 22:03:55 -0500
- Sender: owner-wri-mathgroup at wolfram.com
John Rowney wrote:
>
> Hi,
>
> I need a little help with lists. What I would like to do is the
> following:
>
> From a list of length N, construct all possible lists of length n<N from
> N by combining adjacent elements of the original list into sub lists.
> This might become clearer with an example.
>
> Given {a,b,c,d,e} of length 5, ALL possible length 4 lists subject to
> the conditions above are:
>
> {{a,b},c,d,e}, {a,{b,c},d,e}, {a,b,{c,d},e} and {a,b,c,{d,e}}
>
> two of the possible length 3 lists are
>
> {a,{b,c,d},e} and {{a,b},c,{d,e}}
>
> I hope you get the picture.
>
> In the "real" problem, N would be around 20 and n would be around 10.
>
> Thanks in advance
>
> John
> jrowney at arco.com
Mathematica 3.0 has a new function, ReplaceList, which solves this problem
easily. Many patterns used in replacement rules can match an expression in
more than one way (e.g., patterns with __ or ___ in them). ReplaceList is
like Replace except that instead of replacing the first match Mathematica
finds, it returns a list of the results of all possible replacements.
Here are the 4 length-4 lists from {a,b,c,d,e}:
In[1]:= ReplaceList[{a,b,c,d,e}, {w__,x__,y__,z__} :> {{w},{x},{y},{z}}]
Out[1]= {{{a},{b},{c},{d,e}},{{a},{b},{c,d},{e}},
{{a},{b,c},{d},{e}},{{a,b},{c},{d},{e}}}
This result has the singleton elements wrapped in {}, but that's easy to fix.
The following function is specific to lists whose elements are symbols, but
that could be changed easily, say by changing the x_Symbol to x_?AtomQ (but
that would slow it down a bit).
lengthNLists[lis_, n_] :=
With[{v = Table[Unique[], {n}]},
ReplaceList[lis, Pattern[#, __]& /@ v -> List /@ v] /. {x_Symbol} :> x
]
Here are all the length-3 lists:
In[3]:= lengthNLists[{a,b,c,d,e}, 3]
Out[3]= {{a,b,{c,d,e}}, {a,{b,c},{d,e}}, {{a,b},c,{d,e}}, {a,{b,c,d},e},
{{a,b},{c,d},e}, {{a,b,c},d,e}}
It's not unreasonably slow for N = 20, n = 10:
In[4]:= result = lengthNLists[{a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,
a14,a15,a16,a17,a18,a19,a20}, 10]; //Timing
Out[4]= {183.84 Second, Null}
In[5]:= Length[result]
Out[5]= 92378
In[6]:= ByteCount[result]
Out[6]= 19618384
--Todd