Search All of the Math Forum:

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

Notice: We are no longer accepting new posts, but the forums will continue to be readable.

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

 Allan Hayes Posts: 1,508 Registered: 12/6/04
Enhancements of Combinatorica, Re:[mg5065] List help needed
Posted: Oct 30, 1996 12:26 AM

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`

(*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] = {{}}
";

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_] :=
{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

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