Re: combinatorics problem
- To: mathgroup at smc.vnet.net
- Subject: [mg40110] Re: combinatorics problem
- From: Paul Abbott <paul at physics.uwa.edu.au>
- Date: Fri, 21 Mar 2003 02:36:24 -0500 (EST)
- Organization: The University of Western Australia
- References: <b59a1e$sb3$1@smc.vnet.net> <b5bjfj$5qv$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
In article <b5bjfj$5qv$1 at smc.vnet.net>,
Paul Abbott <paul at physics.uwa.edu.au> wrote:
> Here is such a function (it still uses pruning so can be made more
> efficient):
>
> <<DiscreteMath`
>
> myfunc[l_, p_] :=
> Module[{pre2, pre3, pre4},
> pre2 = Sort /@ Map[Tr, Select[KSetPartitions[l, Length[p]],
> Sort[Length /@ #] == Sort[p] &], {2}];
> pre3 = Union[pre2];
> pre4 = Count[pre2, #] & /@ pre3;
> Thread[{pre3, pre4}]
> ]
Here is a simpler version (using Split to do the run length encoding):
<<DiscreteMath`
myfunc[l_, p_] :=
Split[
Sort[
Sort /@ Map[Tr, Select[KSetPartitions[l, Length[p]],
Sort[Length /@ #] == Sort[p] & ], {2}]
]
] /. x_?MatrixQ :> {First[x], Length[x]}
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