{{1,2}, {3}, {4,5}, {6}} 

I want to determine the finest partition :

 {{1,2},{3},{4,5},{6}} , {{1,2,3},{4,5},{6}} , {{1,2,4,5},{3},{6}} , {{1,2,6},{3},{4,5}} , {{1,2},{3,4,5},{6}} , {{1,2},{3,6},{4,5}} , {{1,2},{3},{4,5,6}} , {{1,2,3,4,5},{6}} , {{1,2,3,6},{4,5}} , {{1,2},{3,4,5,6}} , {{1,2,4,5,6},{3}} , {1,2,3,4,5,6}

i have a procedure that generates all possible partitions of a given set, For example, for the set {1,2,3} it should give 
       
          {1,2,3}, {1,{2,3}}, {2,{1,3}}, {3,{1,2}}, {{1,2,3}}.


There doesn't appear to be a built in Maple function that calculates all possible partitions of a given set.  The attached worksheet contains an algorithm from Knuth that produces a "restricted growth string" representation of all possible partitions.  The output from this algorithm is then used to categorize a list of the integers 1 .. n producing all possible partitions.  The number of partitions is equal to the n'th Bell number.


       > restart;
> delta := (a,b) -> `if`(a=b, 1, 0);  # Kronecker delta function

                 delta := (a, b) -> `if`(a = b, 1, 0)

> # Knuth, Donald E., The Art of Computer Programming (Fascicle 3B), 
> # Combinatorial Algorithms Generating All Combinations and Partitions, 
> # Section 7.2.1.5. Generating all set partitions
> NbBell := proc(n)
>     description "Algorithm H (Restricted growth strings in lexicographic order.)";
>     local a, b, m, state, j, S;
>     state := 1: 
>     S := {};
>     while state > 0 do
>         if state = 1 then
>             a := Array(1 .. n, fill=0):  b := Array(1 .. n-1, fill=1):  m := 1:
>             state := 2;
>         elif state = 2 then
>             if a[n] = m then
>                 state := 4
>             else
>                 state := 3
>             end if;
>         elif state = 3 then
>             a[n] := a[n] + 1;
>             state := 2
>         elif state = 4 then
>             j := n - 1;
>             while a[j] = b[j] do
>                 j := j - 1
>             end do;
>             state := 5
>         elif state = 5 then
>             if j = 1 then
>                 state := -1
>             else
>                 a[j] := a[j] + 1;
>                 state := 6
>             end if
>         elif state = 6 then
>             m := b[j] + delta(a[j], b[j]);
>             j := j + 1;
>             while j < n do
>                 a[j] := 0;
>                 b[j] := m;
>                 j := j + 1
>             end do;
>             a[n] := 0;
>             state := 2
>         else
>             state := -1
>         end if;
>         S := S union {convert(a, list)};
>     end do;
>     S;
> end proc;

  

      > n := 5:
> S := NbBell(n);
> nops(S);
> combinat[bell](n); 
> # The number of partitions of the integers 1 .. n is equal to the n'th Bell number.

  

> # Use ListTools[Categorize] to partition the integers 1..n using restricted growth strings.
> # For each element of set S, Categorize the elements of list L according to a routine that takes an element of S
> L := [seq(i, i = 1 .. n)];
> f := (a,b) -> s[a] = s[b]:
> LL := NULL:
> for s in S do
>     t := ListTools[Categorize](f, L);
>     LL := LL, [t]
> end do:
> LL;
> whattype(LL);
> print("step One");
> parti:=map(x->map(convert,x,set),map(convert,{LL},set));
> print("step Two");
> subs({seq(i=op(P[i]),i=1..4)},parti);
> print("step Three");
> convert(map(x->M[x],%),`+`);
> print("step Four");
> whattype(parti);
> nops([LL]);        # How many partitions are there?
> combinat[bell](n); # How many partitions should there be?

                
  parti := {{{1, 2, 3, 4, 5}}, {{1}, {2, 3, 4, 5}},

        {{2}, {1, 3, 4, 5}}, {{3}, {1, 2, 4, 5}}, {{4}, {1, 2, 3, 5}},

        {{5}, {1, 2, 3, 4}}, {{1, 2}, {3, 4, 5}}, {{1, 3}, {2, 4, 5}},

        {{1, 4}, {2, 3, 5}}, {{1, 5}, {2, 3, 4}}, {{2, 3}, {1, 4, 5}},

        {{2, 4}, {1, 3, 5}}, {{2, 5}, {1, 3, 4}}, {{3, 4}, {1, 2, 5}},

        {{3, 5}, {1, 2, 4}}, {{4, 5}, {1, 2, 3}},

        {{1}, {2}, {3, 4, 5}}, {{1}, {3}, {2, 4, 5}},

        {{1}, {4}, {2, 3, 5}}, {{1}, {5}, {2, 3, 4}},

        {{1}, {2, 3}, {4, 5}}, {{1}, {2, 4}, {3, 5}},

        {{1}, {2, 5}, {3, 4}}, {{2}, {3}, {1, 4, 5}},

        {{2}, {4}, {1, 3, 5}}, {{2}, {5}, {1, 3, 4}},

        {{2}, {1, 3}, {4, 5}}, {{2}, {1, 4}, {3, 5}},

        {{2}, {1, 5}, {3, 4}}, {{3}, {4}, {1, 2, 5}},

        {{3}, {5}, {1, 2, 4}}, {{3}, {1, 2}, {4, 5}},

        {{3}, {1, 4}, {2, 5}}, {{3}, {1, 5}, {2, 4}},

        {{4}, {5}, {1, 2, 3}}, {{4}, {1, 2}, {3, 5}},

        {{4}, {1, 3}, {2, 5}}, {{4}, {1, 5}, {2, 3}},

        {{5}, {1, 2}, {3, 4}}, {{5}, {1, 3}, {2, 4}},

        {{5}, {1, 4}, {2, 3}}, {{1}, {2}, {3}, {4, 5}},

        {{1}, {2}, {4}, {3, 5}}, {{1}, {2}, {5}, {3, 4}},

        {{1}, {3}, {4}, {2, 5}}, {{1}, {3}, {5}, {2, 4}},

        {{1}, {4}, {5}, {2, 3}}, {{2}, {3}, {4}, {1, 5}},

        {{2}, {3}, {5}, {1, 4}}, {{2}, {4}, {5}, {1, 3}},

        {{3}, {4}, {5}, {1, 2}}, {{1}, {2}, {3}, {4}, {5}}}


                              "step Two"


  {{{1, 2, 3, 4, 5}}, {{1}, {2, 3, 4, 5}}, {{2}, {1, 3, 4, 5}},

        {{3}, {1, 2, 4, 5}}, {{4}, {1, 2, 3, 5}}, {{5}, {1, 2, 3, 4}},

        {{1, 2}, {3, 4, 5}}, {{1, 3}, {2, 4, 5}}, {{1, 4}, {2, 3, 5}},

        {{1, 5}, {2, 3, 4}}, {{2, 3}, {1, 4, 5}}, {{2, 4}, {1, 3, 5}},

        {{2, 5}, {1, 3, 4}}, {{3, 4}, {1, 2, 5}}, {{3, 5}, {1, 2, 4}},

        {{4, 5}, {1, 2, 3}}, {{1}, {2}, {3, 4, 5}},

        {{1}, {3}, {2, 4, 5}}, {{1}, {4}, {2, 3, 5}},

        {{1}, {5}, {2, 3, 4}}, {{1}, {2, 3}, {4, 5}},

        {{1}, {2, 4}, {3, 5}}, {{1}, {2, 5}, {3, 4}},

        {{2}, {3}, {1, 4, 5}}, {{2}, {4}, {1, 3, 5}},

        {{2}, {5}, {1, 3, 4}}, {{2}, {1, 3}, {4, 5}},

        {{2}, {1, 4}, {3, 5}}, {{2}, {1, 5}, {3, 4}},

        {{3}, {4}, {1, 2, 5}}, {{3}, {5}, {1, 2, 4}},

        {{3}, {1, 2}, {4, 5}}, {{3}, {1, 4}, {2, 5}},

        {{3}, {1, 5}, {2, 4}}, {{4}, {5}, {1, 2, 3}},

        {{4}, {1, 2}, {3, 5}}, {{4}, {1, 3}, {2, 5}},

        {{4}, {1, 5}, {2, 3}}, {{5}, {1, 2}, {3, 4}},

        {{5}, {1, 3}, {2, 4}}, {{5}, {1, 4}, {2, 3}},

        {{1}, {2}, {3}, {4, 5}}, {{1}, {2}, {4}, {3, 5}},

        {{1}, {2}, {5}, {3, 4}}, {{1}, {3}, {4}, {2, 5}},

        {{1}, {3}, {5}, {2, 4}}, {{1}, {4}, {5}, {2, 3}},

        {{2}, {3}, {4}, {1, 5}}, {{2}, {3}, {5}, {1, 4}},

        {{2}, {4}, {5}, {1, 3}}, {{3}, {4}, {5}, {1, 2}},

        {{1}, {2}, {3}, {4}, {5}}}


                             "step Three"

I found the problem ;)

now, for a partition example {{1,2}, {3}, {4,5}, {6}} 

I want to determine the finest partition :

{{1,2},{3},{4,5},{6}}  ,  {{1,2,3},{4,5},{6}}  ,  {{1,2,4,5},{3},{6}}  ,  {{1,2,6},{3},{4,5}}  ,  {{1,2},{3,4,5},{6}} , {{1,2},{3,6},{4,5}} , {{1,2},{3},{4,5,6}} , {{1,2,3,4,5},{6}} , {{1,2,3,6},{4,5}} , {{1,2},{3,4,5,6}} , {{1,2,4,5,6},{3}} , {1,2,3,4,5,6}

thank you

I make this code to do the math

> P1 := {{1}, {4}, {5}, {6}, {2, 3}};

 P2 := {{4, 6}, {1, 2, 3, 5}}; 

convert(map(proc (x) options operator, arrow; factorial(nops(x)-1) end proc, [seq(select(has, P1, P2), `in`(p, P2))]), `*`);

                      {{1}, {4}, {5}, {6}, {2, 3}}
                      {{4, 6}, {1, 2, 3, 5}}

Error, (in unknown) numeric exception: division by zero

can you give me clue to solve the error ?

Yes but here i have for example , if we have :

> p11 := {{1}, {4}, {5}, {6}, {2, 3}};

                  {{1}, {4}, {5}, {6}, {2, 3}}

> p22 := {{4, 6}, {1, 2, 3, 5}};
                     {{4, 6}, {1, 2, 3, 5}}

> res := map[3](select, `subset`, `minus`(p11, p22), `minus`(p11, p22));
             {{{1}}, {{4}}, {{5}}, {{6}}, {{2, 3}}}

I want to have the elements associated with each partition apart

=> res := { {{1},{2, 3},{5}},  {{4},{6}} }

to calculate the value x(p11,P22):=(-1)^(p+q) *(n_{i} - 1)!

with p : number of part in p11

      q : number of part in p22

      n_{i} : number of subset in each part of p22 .

so the final result of our example is : (-1)^{3} * (3-1)! * (2-1)! = -2

hi 

if I have two partition Pi and Pi 'I want to know the decomposition of Pi' by elementsof Pi if possible,

Example:tition

Pi = {{1,3},{2},{4,6},{5}}

Pi' = {{1,2,3},{4,6},{5}}

=> sought to determine q=3

                                   Pi'={{1,3} union {2},{4,6},{5}}

                                   and the nember 2 = Card({1,3} union {2}) 

haw do this .

thinks

hi 

if I have two partition Pi and Pi 'I want to know the decomposition of Pi' by elementsof Pi if possible,

Example:tition

Pi = {{1,3},{2},{4,6},{5}}

Pi' = {{1,2,3},{4,6},{5}}

=> sought to determine q=3

                                   Pi'={{1,3} union {2},{4,6},{5}}

                                   and the nember 2 = Card({1,3} union {2}) 

haw do this .

thinks