Set consolidation

From Rosetta Code
Revision as of 22:45, 30 June 2012 by Rdm (talk | contribs) (J implementation)
Task
Set consolidation
You are encouraged to solve this task according to the task description, using any language you may know.

Given two sets of items then if any item is common to any set then the result of applying consolidation to those sets is a set of sets whose contents is:

  • The two input sets if no common item exists between the two input sets of items.
  • The single set that is the union of the two input sets if they share a common item.

Given N sets of items where N>2 then the result is the same as repeatedly replacing all combinations of two sets by their consolidation until no further consolidation between set pairs is possible. If N<2 then consolidation has no strict meaning and the input can be returned.

Example 1:
Given the two sets {A,B} and {C,D} then there is no common element between the sets and the result is the same as the input.
Example 2:
Given the two sets {A,B} and {B,D} then there is a common element B between the sets and the result is the single set {B,D,A}. (Note that order of items in a set is immaterial: {A,B,D} is the same as {B,D,A} and {D,A,B}, etc).
Example 3:
Given the three sets {A,B} and {C,D} and {D,B} then there is no common element between the sets {A,B} and {C,D} but the sets {A,B} and {D,B} do share a common element that consolidates to produce the result {B,D,A}. On examining this result with the remaining set, {C,D}, they share a common element and so consolidate to the final output of the single set {A,B,C,D}
Example 4:
The consolidation of the five sets:
{H,I,K}, {A,B}, {C,D}, {D,B}, and {F,G,H}
Is the two sets:
{A, C, B, D}, and {G, F, I, H, K}

See also:

Ada

We start with specifying a generic package Set_Cons that provides the neccessary tools, such as contructing and manipulating sets, truning them, ect.:

<lang Ada>generic 

  type Element is (<>);
  with function Image(E: Element) return String;

package Set_Cons is 

  type Set is private;

  -- constructor and manipulation functions for type Set
  function "+"(E: Element) return Set;
  function "+"(Left, Right: Element) return Set;
  function "+"(Left: Set; Right: Element) return Set;
  function "-"(Left: Set; Right: Element) return Set;

  -- compare, unite or output a Set
  function Nonempty_Intersection(Left, Right: Set) return Boolean;
  function Union(Left, Right: Set) return Set;
  function Image(S: Set) return String;

  type Set_Vec is array(Positive range <>) of Set;

  -- output a Set_Vec
  function Image(V: Set_Vec) return String;

private 

  type Set is array(Element) of Boolean;

end Set_Cons;</lang>

Here is the implementation of Set_Cons:

<lang Ada>package body Set_Cons is 

  function "+"(E: Element) return Set is
     S: Set := (others => False);
  begin
     S(E) := True;
     return S;
  end "+";

  function "+"(Left, Right: Element) return Set is
  begin
     return (+Left) + Right;
  end "+";

  function "+"(Left: Set; Right: Element) return Set is
     S: Set := Left;
  begin
     S(Right) := True;
     return S;
  end "+";

  function "-"(Left: Set; Right: Element) return Set is
     S: Set := Left;
  begin
     S(Right) := False;
     return S;
  end "-";

  function Nonempty_Intersection(Left, Right: Set) return Boolean is
  begin
     for E in Element'Range loop
        if Left(E) and then Right(E) then return True;
        end if;
     end loop;
     return False;
  end Nonempty_Intersection;

  function Union(Left, Right: Set) return Set is
     S: Set := Left;
  begin
     for E in Right'Range loop
        if Right(E) then S(E) := True;
        end if;
     end loop;
     return S;
  end Union;

  function Image(S: Set) return String is

     function Image(S: Set; Found: Natural) return String is
     begin
        for E in S'Range loop
           if S(E) then
              if Found = 0 then
                 return Image(E) & Image((S-E), Found+1);
              else
                 return "," & Image(E) & Image((S-E), Found+1);
              end if;
           end if;
        end loop;
        return "";
     end Image;

  begin
     return "{" & Image(S, 0) & "}";
  end Image;

  function Image(V: Set_Vec) return String is
   begin
     if V'Length = 0 then
        return "";
     else
        return Image(V(V'First)) & Image(V(V'First+1 .. V'Last));
     end if;
  end Image;

end Set_Cons;</lang>

Given that package, the task is easy:

<lang Ada>with Ada.Text_IO, Set_Cons;

procedure Set_Consolidation is 

  type El_Type is (A, B, C, D, E, F, G, H, I, K);

  function Image(El: El_Type) return String is
  begin
     return El_Type'Image(El);
  end Image;

  package Helper is new Set_Cons(Element => El_Type, Image => Image);
  use Helper;

  function Consolidate(List: Set_Vec) return Set_Vec is
  begin
     for I in List'First .. List'Last - 1 loop
        for J in I+1 .. List'Last loop
           -- if List(I) and List(J) share an element
           -- then recursively consolidate
           --   (List(I) union List(J)) followed by List(K), K not in {I, J}
           if Nonempty_Intersection(List(I), List(J)) then
              return Consolidate
                (Union(List(I), List(J)) 
                   & List(List'First .. I-1) 
                   & List(I+1        .. J-1) 
                   & List(J+1        .. List'Last));
           end if;
        end loop;
     end loop;
     return List;
  end Consolidate;

begin 

  Ada.Text_IO.Put_Line(Image(Consolidate((A+B) & (C+D))));
  Ada.Text_IO.Put_Line(Image(Consolidate((A+B) & (B+D))));
  Ada.Text_IO.Put_Line(Image(Consolidate((A+B) & (C+D) & (D+B))));
  Ada.Text_IO.Put_Line
    (Image(Consolidate((H+I+K) & (A+B) & (C+D) & (D+B) & (F+G+H))));

end Set_Consolidation;</lang>

This generates the following output: 

{A,B}{C,D}
{A,B,D}
{A,B,C,D}
{A,B,C,D}{F,G,H,I,K}


Bracmat

<lang bracmat>( ( consolidate 

 =   a m z mm za zm zz
   .     ( removeNumFactors
         =   a m z
           .     !arg:?a+#%*?m+?z
               & !a+!m+removeNumFactors$!z
             | !arg
         )
       &   !arg
         :   ?a
             %?`m
             ( %?z
             &   !m
               :   ?
                 + ( %@?mm
                   & !z:?za (?+!mm+?:?zm) ?zz
                   )
                 + ?
             )
       & consolidate$(!a removeNumFactors$(!m+!zm) !za !zz)
     | !arg
 )

& (test=.out$(!arg "==>" consolidate$!arg)) & test$(A+B C+D) & test$(A+B B+D) & test$(A+B C+D D+B) & test$(H+I+K A+B C+D D+B F+G+H) );</lang> Output: 

A+B C+D ==> A+B C+D
A+B B+D ==> A+B+D
A+B C+D B+D ==> A+B+C+D
  H+I+K
  A+B
  C+D
  B+D
  F+G+H
  ==>
  F+G+H+I+K
  A+B+C+D

C

<lang c>#include <stdio.h>

  1. define s(x) (1U << ((x) - 'A'))

typedef unsigned int bitset;

int consolidate(bitset *x, int len) { int i, j; for (i = len - 2; i >= 0; i--) for (j = len - 1; j > i; j--) if (x[i] & x[j]) x[i] |= x[j], x[j] = x[--len]; return len; }

void show_sets(bitset *x, int len) { bitset b; while(len--) { for (b = 'A'; b <= 'Z'; b++) if (x[len] & s(b)) printf("%c ", b); putchar('\n'); } }

int main(void) { bitset x[] = { s('A') | s('B'), s('C') | s('D'), s('B') | s('D'), s('F') | s('G') | s('H'), s('H') | s('I') | s('K') };

int len = sizeof(x) / sizeof(x[0]);

puts("Before:"); show_sets(x, len); puts("\nAfter:"); show_sets(x, consolidate(x, len)); return 0; }</lang>

Ela

This solution emulate sets using linked lists: <lang ela>open Core

let merge [] ys = ys 

   merge (x::xs) ys | x `elem` ys = merge xs ys
                    | else = merge xs (x::ys)

let consolidate (_::[])@xs = xs 

   consolidate (x::xs) = conso [x] (consolidate xs)
                   where conso xs [] = xs
                         conso (x::xs)@r (y::ys) | intersect x y <> [] = conso ((merge x y)::xs) ys
                                                 | else = conso (r ++ [y]) ys</lang>

Usage:

In this example sets are filled with variants (somewhat similar to atoms in Lisp). One can use any other values (such as strings or chars) as well. <lang ela>open Console

consolidate [[H,I,K], [A,B], [C,D], [D,B], [F,G,H]] |> writen $ consolidate [[A,B], [B,D]] |> writen</lang>

Output:
[[K,I,F,G,H],[A,C,D,B]]
[[A,B,D]]

Go

Translation of: Python

<lang go>package main

import "fmt"

type set map[string]bool

var testCase = []set{ 

   set{"H": true, "I": true, "K": true},
   set{"A": true, "B": true},
   set{"C": true, "D": true},
   set{"D": true, "B": true},
   set{"F": true, "G": true, "H": true},

}

func main() { 

   fmt.Println(consolidate(testCase))

}

func consolidate(sets []set) []set { 

   setlist := []set{}
   for _, s := range sets {
       if s != nil && len(s) > 0 {
           setlist = append(setlist, s)
       }
   }
   for i, s1 := range setlist {
       if len(s1) > 0 {
           for _, s2 := range setlist[i+1:] {
               if s1.disjoint(s2) {
                   continue
               }
               for e := range s1 {
                   s2[e] = true
                   delete(s1, e)
               }
               s1 = s2
           }
       }
   }
   r := []set{}
   for _, s := range setlist {
       if len(s) > 0 {
           r = append(r, s)
       }
   }
   return r

}

func (s1 set) disjoint(s2 set) bool { 

   for e := range s2 {
       if s1[e] {
           return false
       }
   }
   return true

}</lang>

Output:
[map[A:true C:true B:true D:true] map[G:true F:true I:true H:true K:true]]

J

<lang J>consolidate=:4 :0/ 

 b=. y 1&e.@e.S:_1 x
 if. 0 e. b do. (~.;x,b#y);(-.b)#y
 else. ,<~.;x,b#y end.

)</lang>

Examples:

<lang J> consolidate 'ab';'cd' ┌──┬──┐ │ab│cd│ └──┴──┘ 

  consolidate 'ab';'bd'

┌───┐ │abd│ └───┘ 

  consolidate 'ab';'cd';'db'

┌────┐ │abcd│ └────┘ 

  consolidate 'hij';'ab';'cd';'db';'fgh'

┌─────┬────┐ │hijfg│abcd│ └─────┴────┘</lang>

OCaml

<lang ocaml>let join a b = 

 List.fold_left (fun acc v ->
   if List.mem v acc then acc else v::acc
 ) b a

let share a b = List.exists (fun x -> List.mem x b) a

let extract p lst = 

 let rec aux acc = function
 | x::xs -> if p x then Some (x, List.rev_append acc xs) else aux (x::acc) xs
 | [] -> None
 in
 aux [] lst

let consolidate sets = 

 let rec aux acc = function
 | [] -> List.rev acc
 | x::xs ->
     match extract (share x) xs with
     | Some (y, ys) -> aux acc ((join x y) :: ys)
     | None -> aux (x::acc) xs
 in
 aux [] sets

let print_sets sets = 

 print_string "{ ";
 List.iter (fun set ->
   print_string "{";
   print_string (String.concat " " set);
   print_string "} "
 ) sets;
 print_endline "}"

let () = 

 print_sets (consolidate [["A";"B"]; ["C";"D"]]);
 print_sets (consolidate [["A";"B"]; ["B";"C"]]);
 print_sets (consolidate [["A";"B"]; ["C";"D"]; ["D";"B"]]);
 print_sets (consolidate [["H";"I";"K"]; ["A";"B"]; ["C";"D"]; ["D";"B"];
                          ["F";"G";"H"]]);
</lang>

Output: 

{ {A B} {C D} }
{ {A B C} }
{ {B A C D} }
{ {K I F G H} {B A C D} }

Perl 6

Works with: niecza version 2012-06

<lang perl6>multi consolidate() { () } multi consolidate(Set \this is copy, *@those) { 

   gather {
       for consolidate |@those -> \that {
           if this ∩ that { this ∪= that }
           else           { take that }
       }
       take this;
   }

}

enum Elems ('A'..'Z'); say $_, "\n ==> ", consolidate |$_ 

   for [set(A,B), set(C,D)],
       [set(A,B), set(B,D)],
       [set(A,B), set(C,D), set(D,B)],
       [set(H,I,K), set(A,B), set(C,D), set(D,B), set(F,G,H)];</lang>
Output:
set(A, B) set(C, D)
    ==> set(C, D) set(A, B)
set(A, B) set(B, D)
    ==> set(A, B, D)
set(A, B) set(C, D) set(D, B)
    ==> set(A, B, C, D)
set(H, I, K) set(A, B) set(C, D) set(D, B) set(F, G, H)
    ==> set(A, B, C, D) set(H, I, K, F, G)

PicoLisp

Translation of: Python

<lang PicoLisp>(de consolidate (S) 

  (when S
     (let R (cons (car S))
        (for X (consolidate (cdr S))
           (if (mmeq X (car R))
              (set R (uniq (conc X (car R))))
              (conc R (cons X)) ) )
        R ) ) )</lang>

Test: <lang PicoLisp>: (consolidate '((A B) (C D))) -> ((A B) (C D))

(consolidate '((A B) (B D)))

-> ((B D A))

(consolidate '((A B) (C D) (D B)))

-> ((D B C A))

(consolidate '((H I K) (A B) (C D) (D B) (F G H)))

-> ((F G H I K) (D B C A))</lang>

Python

Iterative

The docstring contains solutions to all the examples as well as a check to show the order-independence of the sets given to the consolidate function. <lang python>def consolidate(sets): 

   
   >>> # Define some variables
   >>> A,B,C,D,E,F,G,H,I,J,K = 'A,B,C,D,E,F,G,H,I,J,K'.split(',')
   >>> # Consolidate some lists of sets
   >>> consolidate([{A,B}, {C,D}])
   [{'A', 'B'}, {'C', 'D'}]
   >>> consolidate([{A,B}, {B,D}])
   [{'A', 'B', 'D'}]
   >>> consolidate([{A,B}, {C,D}, {D,B}])
   [{'A', 'C', 'B', 'D'}]
   >>> consolidate([{H,I,K}, {A,B}, {C,D}, {D,B}, {F,G,H}])
   [{'A', 'C', 'B', 'D'}, {'G', 'F', 'I', 'H', 'K'}]
   >>> consolidate([{A,H}, {H,I,K}, {A,B}, {C,D}, {D,B}, {F,G,H}])
   [{'A', 'C', 'B', 'D', 'G', 'F', 'I', 'H', 'K'}]
   >>> consolidate([{H,I,K}, {A,B}, {C,D}, {D,B}, {F,G,H}, {A,H}])
   [{'A', 'C', 'B', 'D', 'G', 'F', 'I', 'H', 'K'}]
   >>> # Confirm order-independence
   >>> from copy import deepcopy
   >>> import itertools
   >>> sets = [{H,I,K}, {A,B}, {C,D}, {D,B}, {F,G,H}, {A,H}]
   >>> answer = consolidate(deepcopy(sets))
   >>> for perm in itertools.permutations(sets):
           assert consolidate(deepcopy(perm)) == answer



   >>> answer
   [{'A', 'C', 'B', 'D', 'G', 'F', 'I', 'H', 'K'}]
   >>> len(list(itertools.permutations(sets)))
   720
   >>>     
   
   setlist = [s for s in sets if s]
   for i, s1 in enumerate(setlist):
       if s1:
           for s2 in setlist[i+1:]:
               intersection = s1.intersection(s2)
               if intersection:
                   s2.update(s1)
                   s1.clear()
                   s1 = s2
   return [s for s in setlist if s]</lang>

Recursive

<lang python>def conso(s): if len(s) < 2: return s

r, b = [s[0]], conso(s[1:]) for x in b: if r[0].intersection(x): r[0].update(x) else: r.append(x) return r</lang>

REXX

<lang rexx>/*REXX program shows how to consolidate a sample bunch of sets. */ sets.= /*assign all SETS. to null. */ sets.1 = '{A,B} {C,D}' sets.2 = "{A,B} {B,D}" sets.3 = '{A,B} {C,D} {D,B}' sets.4 = '{H,I,K} {A,B} {C,D} {D,B} {F,G,H}' sets.5 = '{snow,ice,slush,frost,fog} {iceburgs,icecubes} {rain,fog,sleet}' 

       do j=1 while sets.j\==       /*traipse through the sample sets*/
       call SETcombo sets.j           /*have the other guy do the work.*/
       end   /*j*/

exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────SETcombo subroutine─────────────────*/ SETcombo: procedure; parse arg bunch; n=words(bunch); newBunch= say ' the old sets=' space(bunch) 

 do k=1 for n                         /*change all commas to a blank.  */
 @.k=translate(word(bunch,k),,'},{')  /*create a list of words (=a set)*/
 end    /*k*/                              /*... and also remove the braces.*/

 do until \changed;   changed=0       /*consolidate some sets  (maybe).*/
      do set=1 for n-1
          do item=1 for words(@.set);   x=word(@.set,item)
              do other=set+1 to n
              if isIn(x,@.other) then do;   changed=1
                                      @.set=@.set @.other;   @.other=
                                      iterate set
                                      end
              end   /*other*/
          end       /*item*/
      end           /*set*/
 end                /*until ¬changed*/

    do set=1 for n;   new=            /*remove duplicates in a set.    */
      do items=1 for words(@.set)
      x=word(@.set,items);   if x==',' then iterate;  if x== then leave
      new=new x                       /*start building the new set.    */
        do forever;  if \isIn(x,@.set) then leave
        _=wordpos(x,@.set)
        @.set=subword(@.set,1,_-1) ',' subword(@.set,_+1) /*purify set.*/
        end    /*forever*/
      end      /*items*/
    @.set=translate(strip(new),','," ")
    end        /*set*/

 do new=1 for n;   if @.new== then iterate
 newBunch=space(newbunch '{'@.new"}")
 end   /*new*/

say ' the new sets=' newBunch; say return /*──────────────────────────────────isIn subroutine─────────────────────*/ isIn: return wordpos(arg(1),arg(2))\==0 /*is (word) arg1 in set arg2? */</lang> output when using the default supplied sample sets 

 the old sets= {A,B} {C,D}
 the new sets= {A,B} {C,D}

 the old sets= {A,B} {B,D}
 the new sets= {A,B,D}

 the old sets= {A,B} {C,D} {D,B}
 the new sets= {A,B,D,C}

 the old sets= {H,I,K} {A,B} {C,D} {D,B} {F,G,H}
 the new sets= {H,I,K,F,G} {A,B,D,C}

 the old sets= {snow,ice,slush,frost,fog} {iceburgs,icecubes} {rain,fog,sleet}
 the new sets= {snow,ice,slush,frost,fog,rain,sleet} {iceburgs,icecubes}

Tcl

Translation of: Python
Library: Tcllib (Package: struct::set)

This uses just the recursive version, as this is sufficient to handle substantial merges. <lang tcl>package require struct::set

proc consolidate {sets} { 

   if {[llength $sets] < 2} {

return $sets 

   }

   set r [list {}]
   set r0 [lindex $sets 0]
   foreach x [consolidate [lrange $sets 1 end]] {

if {[struct::set size [struct::set intersect $x $r0]]} { struct::set add r0 $x } else { lappend r $x } 

   }
   return [lset r 0 $r0]

}</lang> Demonstrating: <lang tcl>puts 1:[consolidate {{A B} {C D}}] puts 2:[consolidate {{A B} {B D}}] puts 3:[consolidate {{A B} {C D} {D B}}] puts 4:[consolidate {{H I K} {A B} {C D} {D B} {F G H}}]</lang>

Output:
1:{A B} {C D}
2:{D A B}
3:{D A B C}
4:{H I F G K} {D A B C}
Retrieved from "https://rosettacode.org/wiki/Set_consolidation?oldid=214545"