Set consolidation

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.

Set consolidation
You are encouraged to solve this task according to the task description, using any language you may know.

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.&> 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}