Enhancements of Combinatorica, Re:List help needed
- To: mathgroup at smc.vnet.net
- Subject: [mg5114] Enhancements of Combinatorica, Re:[mg5065] List help needed
- From: Allan Hayes <hay at haystack>
- Date: Wed, 30 Oct 1996 22:04:22 -0500
- Sender: owner-wri-mathgroup at wolfram.com
John Rowney <jrowney at 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` :
Allan Hayes
hay at 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_}] :=
Segments[h_[],0] := {h[]};
Segments[s:h_[__], k_Integer]/;0<k<=Length[s] :=
Examples:
Segments[Range[4],2]
Segments[Range[12],6];//Timing//First
Segments[h[1,2,3,4],2]
(*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] :=
Compositions[4,2]
Compositions2[4,2]
Compositions[12,6];//Timing//First
Compositions2[12,6];//Timing//First
(*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]&,
Map[
Flatten,
]
]
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
******************