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;
>    ]

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

```

• Prev by Date: Re: simple question if/while loop
• Next by Date: Re: Re: Simplify[x.Cross[x,y]] does not work.
• Previous by thread: Re: combinatorics problem
• Next by thread: Newbie question