Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2000
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2000

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Help on Partitions, Again!!!

  • To: mathgroup at smc.vnet.net
  • Subject: [mg24656] Re: [mg24636] Help on Partitions, Again!!!
  • From: Andrzej Kozlowski <andrzej at tuins.ac.jp>
  • Date: Mon, 31 Jul 2000 09:23:25 -0400 (EDT)
  • Sender: owner-wri-mathgroup at wolfram.com

on 7/28/00 11:24 PM, Jose Prado de Melo at jpmelo at iconet.com.br wrote:

> 
> 
> Hello, MathGroup
> First of all, thanks for your attention.
> To be more specific:
> It's not too dificult to calculate the solution of the problem:
> How many ways, can the set {A,B,C,D,E,F} be separeted into two parts
> with three elements in each?
> Answer:   x = 6!/(2!.3!.3!) = 10
> I'm looking for a function to generate all the partitions using
> Mathematica 3.0 .
> I'm not sure, but I think the package Combinatorica doesn't have a
> function to do this.
> For example, I'm trying to think up a function f  like this one:
> 
> In[ ] = f [ {A,B,C,D,E,F},{3,3}]
> Out [ ] = { { {A,B,C},{D,E,F} }, { {
> A,B,F},{C,D,E}},...................} and so on.
> In [ ] = Length[%]
> Out [ ] = 10
> 
> Please, help me.
> Thanks!
> 
> 
> 
> 
One can usually produce an almost unlimited number of different solutions to
a question like this. I shall give one based on the Combinatorica package
and one which does not need it. Neither seems very fast.

 (The Combinatorica package seems not to contain the function you want but
it contians the KSubsets function which comes pretty close).

In[1]:=
<< DiscreteMath`Combinatorica`

In[2]:=
funct[lis_List] := 
  Union[Map[{#, Complement[lis, #]} &, KSubsets[lis, 3]],
    SameTest -> (#1[[1]] === #2[[2]] &)]

In[3]:=
ls = {A, B, C, D, E, F}
Out[3]=
{A, B, C, D, E, F}

In[4]:=
funct[ls]
Out[4]=
{{{A, B, C}, {D, E, F}}, {{A, B, D}, {C, E, F}},
 
  {{A, B, E}, {C, D, F}}, {{A, B, F}, {C, D, E}},
 
  {{A, C, D}, {B, E, F}}, {{A, C, E}, {B, D, F}},
 
  {{A, C, F}, {B, D, E}}, {{A, D, E}, {B, C, F}},
 
  {{A, D, F}, {B, C, E}}, {{A, E, F}, {B, C, D}}}

In[5]:=
Length[%]
Out[5]=
10


Here is an alternative which does not use the Combinatorica package:

In[6]:=
ReplaceList[{A, B, C, D, E,
    F}, {a___, x_, b___, y_, c___, z_} :> {{a, b, c}, {x, y, z}}]
Out[6]=
{{{C, D, E}, {A, B, F}}, {{B, D, E}, {A, C, F}}, {{A, D, E}, {B, C, F}},
 
  {{B, C, E}, {A, D, F}}, {{A, C, E}, {B, D, F}}, {{A, B, E}, {C, D, F}},
 
  {{B, C, D}, {A, E, F}}, {{A, C, D}, {B, E, F}}, {{A, B, D}, {C, E, F}},
 
  {{A, B, C}, {D, E, F}}}
In[7]:=
Length[%]
Out[7]=
10

Andrzej


-- 
Andrzej Kozlowski
Toyama International University, JAPAN

For Mathematica related links and resources try:
<http://www.sstreams.com/Mathematica/>



  • Prev by Date: Re: 2D..Ticks...
  • Next by Date: Re: Help on Partitions, Again!!!
  • Previous by thread: Re: Help on Partitions, Again!!!
  • Next by thread: Can I solve PDE in Mathematica?