Drexel dragonThe Math ForumDonate to the Math Forum



Search All of the Math Forum:

Views expressed in these public forums are not endorsed by Drexel University or The Math Forum.


Math Forum » Discussions » Software » comp.soft-sys.math.mathematica

Topic: Enhancements of Combinatorica, Re:[mg5065] List help needed
Replies: 0  

Advanced Search

Back to Topic List Back to Topic List  
Allan Hayes

Posts: 1,508
Registered: 12/6/04
Enhancements of Combinatorica, Re:[mg5065] List help needed
Posted: Oct 30, 1996 12:26 AM
  Click to see the message monospaced in plain text Plain Text   Click to reply to this topic Reply

John Rowney <jrowney@inetg1.Arco.COM>
[mg5065] List help needed
writes

> What I would like to do is the following:
> 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}}


John,

The function Segments, below does what you seem to want.
I include new versions of two functions from the package
DiscreteMath`Combinatorica` :
Compositions2: a speed-up of Compositions
KSubsetsList: an extension and speed-up of KSubsets

Allan Hayes
hay@haystack.demon.co.uk
http://www.haystack.demon.co.uk/


***********

CombinatoricaPlus

Enhancements to the package DiscreteMath`Combinatorica`
Copyright Allan Hayes 1996

(*Segments*)

Segments::usage =
"Segments[s, k] for a list s and integer k with 0<k<=Length[s] gives
a list of k segments of s ,{s1,s2,...},with Join[s1,s2,...] = s.
Segments also works when s is of the form h[x1, ...].
Segments[h[0],0] = {h[0]}.
"

splits[{x___,s_}] :=
Table[{x,Take[s,k], Drop[s,k]}, {k,1,Length[s]-1}]
Segments[h_[],0] := {h[]};
Segments[s:h_[__], k_Integer]/;0<k<=Length[s] :=
Module[{d=1},
Flatten[Nest[Map[splits,#,{d++}]&, {{s}},k-1],k-1]
]

Examples:
Segments[Range[4],2]
{{{1}, {2, 3, 4}}, {{1, 2}, {3, 4}}, {{1, 2, 3}, {4}}}

Segments[Range[12],6];//Timing//First
1.45 Second

Segments[h[1,2,3,4],2]
{{h[1], h[2, 3, 4]}, {h[1, 2], h[3, 4]}, {h[1, 2, 3], h[4]}}


(*Compositions*)

<<DiscreteMath`Combinatorica`

Segments::usage =
"Compositions2[n, k] for positive integer k,and non negative
integer n gives a list of all lists of k non-negative integers
{n1,n2,...},with n1+n2 + = n (each of these lists is called a
composition of n).
Compositions2[0,0] = {{}}
";

comp[{x___,s_}] := Thread[{x,#,Reverse[#]}]&[Range[0,s]];
Compositions2[0,0] = {{}};
Compositions2[n_Integer?NonNegative,k_Integer?Positive] :=
Module[{d=1}, Flatten[Nest[Map[comp,#,{d++}]&, {{n}},k-1],k-1]]

Compositions[4,2]
Compositions2[4,2]
{{0, 4}, {1, 3}, {2, 2}, {3, 1}, {4, 0}}
{{0, 4}, {1, 3}, {2, 2}, {3, 1}, {4, 0}}

Compositions[12,6];//Timing//First
Compositions2[12,6];//Timing//First
54.3667 Second
4.7 Second


(*KSubsets*)

KSubsetsList::usage =
"KSubsetsList[l, {m, n}] for non negatives integers m, n with m <= n
gives {Sm,S(m+1),...,Sn} where Si is the list of all subsets of
the list l with exactly k elements, ordered lexicographically.
\nKSubsetsList[l, {m}] = KSubsetsList[l, {m,m}];
\nKSubsetsList[l, m] = KSubsetsList[l, {m,m}][[1]];
\nKSubsetsList[l] = KSubsetsList[l, {0,Length[l]}] = all subsets.
";

KSubsetsList[_,{0,0}] := {{}}
KSubsetsList[{},___] := {}
KSubsetsList[l_,{n_Integer?Positive,n_}]/;n== Length[l] := {{l}};
KSubsetsList[l_,{1,1}] := {List/@l};
KSubsetsList[l_,{n_Integer?NonNegative}] := KSubsetsList[l,{n,n}]
KSubsetsList[l_,n_Integer?NonNegative] := KSubsetsList[l,{n,n}]//First
KSubsetsList[l_] := KSubsetsList[l, {0, Length[l]}]
KSubsetsList[l_,{n_}] := KSubsetsList[l, {n,n}]
KSubsetsList[l_,{m_Integer?NonNegative,n_Integer?NonNegative}]/;m<=n:=
Module[{c = 0,step,ln = Length[l]},
step[d:{a___,_}, p_] :=
Apply[Join[Thread[{p,#2}],#1]&,
Thread[If[(++c <= ln-m),{d,{{},a}},{Drop[d,1],{a}}]],
{1}
];
Map[
Flatten,
Fold[step, Join[{{{}}},Table[{},{n}]],Reverse[l]],
{2}
]
]

KSubsetsList[Range[4],2]
KSubsetsList[Range[4],2]
KSubsetsList[Range[4],{1,3}]

{{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 4}}
{{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 4}}
{ {{1}, {2}, {3}, {4}},
{{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 4}},
{{1, 2, 3}, {1, 2, 4}, {1, 3, 4}, {2, 3, 4}}
}

KSubsets[Range[12],6];//Timing//First
KSubsetsList[Range[12],6];//Timing//First
3.31667 Second
0.433333 Second

******************









Point your RSS reader here for a feed of the latest messages in this topic.

[Privacy Policy] [Terms of Use]

© Drexel University 1994-2014. All Rights Reserved.
The Math Forum is a research and educational enterprise of the Drexel University School of Education.