Set consolidation: Difference between revisions
add Egison code |
Alpha bravo (talk | contribs) Added AutoHotkey |
||
Line 320: | Line 320: | ||
{A, B, C, D} |
{A, B, C, D} |
||
{A, B, C, D}, {F, G, H, I, K}</pre> |
{A, B, C, D}, {F, G, H, I, K}</pre> |
||
=={{header|AutoHotkey}}== |
|||
<lang AutoHotkey>Consolidate(Sets){ |
|||
for i, set in Sets |
|||
{ |
|||
thisSet := Sets[i] |
|||
loop, % Sets.MaxIndex() - i |
|||
if (intersected(Sets[i], Sets[j := Sets.MaxIndex() - A_Index + 1])) |
|||
list .= (list ~= "~" i "|" j "~") ? i "~" j "~" : "`n~" i "~" j "~" |
|||
} |
|||
loop, parse, list, `n |
|||
{ |
|||
Line := A_Index, CSet%Line% := [] |
|||
loop, parse, A_LoopField, ~ |
|||
aa .= (aa?"`n":"") line , CSet%Line% := Union(Sets[A_LoopField], CSet%Line%) |
|||
} |
|||
Sort, aa, U |
|||
loop, parse, aa, `n |
|||
{ |
|||
out .= A_Index=1?"":"}`n" |
|||
for k , v in CSet%A_LoopField% |
|||
out .= (A_Index=1?"{":", ") v |
|||
} |
|||
return out .= "}" |
|||
} |
|||
Union(SetA,SetB:=""){ |
|||
SetC:=[], Temp:=[] |
|||
for i, val in SetA |
|||
SetC.Insert(val), Temp[val] := true |
|||
for i, val in SetB |
|||
if !Temp[val] |
|||
SetC.Insert(val) |
|||
return SetC |
|||
} |
|||
intersected(SetA,SetB){ |
|||
SetC:=[], Temp:=[] |
|||
for i, val in SetA |
|||
Temp[val] := true |
|||
for i, val in SetB |
|||
if Temp[val] |
|||
return 1 |
|||
return 0 |
|||
}</lang> |
|||
Examples:<lang AutoHotkey>A:=["H","I","K"] |
|||
B:=["A","B"] |
|||
C:=["C","D"] |
|||
D:=["D","B"] |
|||
E:=["F","G","H"] |
|||
Sets := [A,B,C,D,E,F] |
|||
MsgBox % Consolidate(Sets)</lang> |
|||
Outputs:<pre>{F, G, H, I, K} |
|||
{D, B, C, A}</pre> |
|||
=={{header|Bracmat}}== |
=={{header|Bracmat}}== |
Revision as of 18:48, 2 February 2014
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}
Aime
<lang aime>void display(list l) {
integer i; text s;
i = -l_length(l); while (i) { record r; text u, v;
o_text(s); s = ", "; o_text("{"); r = l_q_record(l, i); if (r_first(r, u)) { do { o_text(v); v = ", "; o_text(u); } while (r_greater(r, u, u)); } o_text("}"); i += 1; }
o_text("\n");
}
integer intersect(record r, record u) {
integer a; text s;
a = 0; if (r_first(r, s)) { do { if (r_key(u, s)) { a = 1; break; } } while (r_greater(r, s, s)); }
return a;
}
void merge(record u, record r) {
text s;
if (r_first(r, s)) { do { r_add(u, s, r_query(r, s)); } while (r_greater(r, s, s)); }
}
list consolidate(list l) {
integer i;
i = -l_length(l); while (i) { integer j; record r;
r = l_q_record(l, i); i += 1; j = i; while (j) { record u;
u = l_q_record(l, j); j += 1; if (intersect(r, u)) { merge(u, r); l_delete(l, i - 1); break; } } }
return l;
}
list L(...) {
integer i; list l;
i = -count(); while (i) { l_link(l, -1, $i); i += 1; }
return l;
}
record R(...) {
integer i; record r;
i = -count(); while (i) { r_p_integer(r, $i, 0); i += 1; }
return r;
}
integer main(void) {
display(consolidate(L(R("A", "B"), R("C", "D")))); display(consolidate(L(R("A", "B"), R("B", "D")))); display(consolidate(L(R("A", "B"), R("C", "D"), R("D", "B")))); display(consolidate(L(R("H", "I", "K"), R("A", "B"), R("C", "D"), R("D", "B"), R("F", "G", "K"))));
return 0;
}</lang>
- Output:
{A, B}, {C, D} {A, B, D} {A, B, C, D} {A, B, C, D}, {F, G, H, I, K}
AutoHotkey
<lang AutoHotkey>Consolidate(Sets){ for i, set in Sets { thisSet := Sets[i] loop, % Sets.MaxIndex() - i if (intersected(Sets[i], Sets[j := Sets.MaxIndex() - A_Index + 1])) list .= (list ~= "~" i "|" j "~") ? i "~" j "~" : "`n~" i "~" j "~" }
loop, parse, list, `n { Line := A_Index, CSet%Line% := [] loop, parse, A_LoopField, ~ aa .= (aa?"`n":"") line , CSet%Line% := Union(Sets[A_LoopField], CSet%Line%) } Sort, aa, U loop, parse, aa, `n { out .= A_Index=1?"":"}`n" for k , v in CSet%A_LoopField% out .= (A_Index=1?"{":", ") v } return out .= "}" }
Union(SetA,SetB:=""){
SetC:=[], Temp:=[]
for i, val in SetA
SetC.Insert(val), Temp[val] := true
for i, val in SetB
if !Temp[val]
SetC.Insert(val)
return SetC
}
intersected(SetA,SetB){ SetC:=[], Temp:=[] for i, val in SetA Temp[val] := true for i, val in SetB if Temp[val] return 1 return 0 }</lang> Examples:<lang AutoHotkey>A:=["H","I","K"] B:=["A","B"] C:=["C","D"] D:=["D","B"] E:=["F","G","H"] Sets := [A,B,C,D,E,F]
MsgBox % Consolidate(Sets)</lang>
Outputs:
{F, G, H, I, K} {D, B, C, A}
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>
- 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>
The above is O(N2) in terms of number of input sets. If input is large (many sets or huge number of elements), here's an O(N) method, where N is the sum of the sizes of all input sets: <lang c>#include <stdio.h>
- include <stdlib.h>
- include <string.h>
struct edge { int to; struct edge *next; }; struct node { int group; struct edge *e; };
int **consolidate(int **x) {
- define alloc(v, size) v = calloc(size, sizeof(v[0]));
int group, n_groups, n_nodes; int n_edges = 0; struct edge *edges, *ep; struct node *nodes; int pos, *stack, **ret;
void add_edge(int a, int b) { ep->to = b; ep->next = nodes[a].e; nodes[a].e = ep; ep++; }
void traverse(int a) { if (nodes[a].group) return;
nodes[a].group = group; stack[pos++] = a;
for (struct edge *e = nodes[a].e; e; e = e->next) traverse(e->to); }
n_groups = n_nodes = 0; for (int i = 0; x[i]; i++, n_groups++) for (int j = 0; x[i][j]; j++) { n_edges ++; if (x[i][j] >= n_nodes) n_nodes = x[i][j] + 1; }
alloc(ret, n_nodes); alloc(nodes, n_nodes); alloc(stack, n_nodes); ep = alloc(edges, n_edges);
for (int i = 0; x[i]; i++) for (int *s = x[i], j = 0; s[j]; j++) add_edge(s[j], s[j + 1] ? s[j + 1] : s[0]);
group = 0; for (int i = 1; i < n_nodes; i++) { if (nodes[i].group) continue;
group++, pos = 0; traverse(i);
stack[pos++] = 0; ret[group - 1] = malloc(sizeof(int) * pos); memcpy(ret[group - 1], stack, sizeof(int) * pos); }
free(edges); free(stack); free(nodes);
// caller is responsible for freeing ret return realloc(ret, sizeof(ret[0]) * (1 + group));
- undef alloc
}
void show_sets(int **x) { for (int i = 0; x[i]; i++) { printf("%d: ", i); for (int j = 0; x[i][j]; j++) printf(" %d", x[i][j]); putchar('\n'); } }
int main(void) { int *x[] = { (int[]) {1, 2, 0}, // 0: end of set (int[]) {3, 4, 0}, (int[]) {3, 1, 0}, (int[]) {0}, // empty set (int[]) {5, 6, 0}, (int[]) {7, 6, 0}, (int[]) {3, 9, 10, 0}, 0 // 0: end of sets };
puts("input:"); show_sets(x);
puts("components:"); show_sets(consolidate(x));
return 0; }</lang>
D
<lang d>import std.stdio, std.algorithm, std.array;
dchar[][] consolidate(dchar[][] sets) {
foreach (set; sets) set.sort;
foreach (i, ref si; sets[0 .. $ - 1]) { if (si.empty) continue; foreach (ref sj; sets[i + 1 .. $]) if (!sj.empty && !si.setIntersection(sj).empty) { sj = si.setUnion(sj).uniq.array; si = null; } }
return sets.filter!"!a.empty".array;
}
void main() {
[['A', 'B'], ['C','D']].consolidate.writeln;
[['A','B'], ['B','D']].consolidate.writeln;
[['A','B'], ['C','D'], ['D','B']].consolidate.writeln;
[['H','I','K'], ['A','B'], ['C','D'], ['D','B'], ['F','G','H']].consolidate.writeln;
}</lang>
- Output:
["AB", "CD"] ["ABD"] ["ABCD"] ["ABCD", "FGHIK"]
Recursive version, as described on talk page. <lang d>import std.stdio, std.algorithm, std.array;
dchar[][] consolidate(dchar[][] sets) {
foreach (set; sets) set.sort;
dchar[][] consolidateR(dchar[][] s) { if (s.length < 2) return s; auto r = [s[0]]; foreach (x; consolidateR(s[1 .. $])) { if (!r[0].setIntersection(x).empty) { r[0] = r[0].setUnion(x).uniq.array; } else r ~= x; } return r; }
return consolidateR(sets);
}
void main() {
[['A', 'B'], ['C','D']].consolidate.writeln;
[['A','B'], ['B','D']].consolidate.writeln;
[['A','B'], ['C','D'], ['D','B']].consolidate.writeln;
[['H','I','K'], ['A','B'], ['C','D'], ['D','B'], ['F','G','H']].consolidate.writeln;
}</lang>
["AB", "CD"] ["ABD"] ["ABCD"] ["FGHIK", "ABCD"]
Egison
<lang egison> (define $consolidate
(lambda [$xss] (match xss (multiset (set char)) {[<cons <cons $m $xs> <cons <cons ,m $ys> $rss>> (consolidate {(unique/m char {m @xs @ys}) @rss})] [_ xss]})))
(test (consolidate {{'H' 'I' 'K'} {'A' 'B'} {'C' 'D'} {'D' 'B'} {'F' 'G' 'H'}})) </lang> Output: <lang egison> {"DBAC" "HIKFG"} </lang>
Ela
This solution emulate sets using linked lists: <lang ela>open list
merge [] ys = ys merge (x::xs) ys | x `elem` ys = merge xs ys
| else = merge xs (x::ys)
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: <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]]
F#
<lang fsharp>let (|SeqNode|SeqEmpty|) s =
if Seq.isEmpty s then SeqEmpty else SeqNode ((Seq.head s), Seq.skip 1 s)
let SetDisjunct x y = Set.isEmpty (Set.intersect x y)
let rec consolidate s = seq {
match s with | SeqEmpty -> () | SeqNode (this, rest) -> let consolidatedRest = consolidate rest for that in consolidatedRest do if (SetDisjunct this that) then yield that yield Seq.fold (fun x y -> if not (SetDisjunct x y) then Set.union x y else x) this consolidatedRest
}
[<EntryPoint>] let main args =
let makeSeqOfSet listOfList = List.map (fun x -> Set.ofList x) listOfList |> Seq.ofList List.iter (fun x -> printfn "%A" (consolidate (makeSeqOfSet x))) [ [["A";"B"]; ["C";"D"]]; [["A";"B"]; ["B";"C"]]; [["A";"B"]; ["C";"D"]; ["D";"B"]]; [["H";"I";"K"]; ["A";"B"]; ["C";"D"]; ["D";"B"]; ["F";"G";"H"]] ] 0</lang>
Output
seq [set ["C"; "D"]; set ["A"; "B"]] seq [set ["A"; "B"; "C"]] seq [set ["A"; "B"; "C"; "D"]] seq [set ["A"; "B"; "C"; "D"]; set ["F"; "G"; "H"; "I"; "K"]]
Go
<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]]
Haskell
<lang Haskell>import qualified Data.Set as S
consolidate :: Ord a => [S.Set a] -> [S.Set a] consolidate = foldl comb []
where comb [] s' = [s'] comb (s:ss) s' | S.null (s `S.intersection` s') = s : comb ss s' | otherwise = comb ss (s `S.union` s')
</lang>
J
<lang J>consolidate=:4 :0/
b=. y 1&e.@e.&> x (1,-.b)#(~.;x,b#y);y
)</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>
Java
<lang java>import java.util.*;
public class SetConsolidation {
public static void main(String[] args) { List<Set<Character>> h1 = hashSetList("AB", "CD"); System.out.println(consolidate(h1));
List<Set<Character>> h2 = hashSetList("AB", "BD"); System.out.println(consolidateR(h2));
List<Set<Character>> h3 = hashSetList("AB", "CD", "DB"); System.out.println(consolidate(h3));
List<Set<Character>> h4 = hashSetList("HIK", "AB", "CD", "DB", "FGH"); System.out.println(consolidateR(h4)); }
// iterative private static <E> List<Set<E>> consolidate(Collection<? extends Set<E>> sets) {
List<Set<E>> r = new ArrayList<>(); for (Set<E> s : sets) { List<Set<E>> new_r = new ArrayList<>(); new_r.add(s); for (Set<E> x : r) { if (!Collections.disjoint(s, x)) { s.addAll(x); } else { new_r.add(x); } } r = new_r; } return r;
}
// recursive private static <E> List<Set<E>> consolidateR(List<Set<E>> sets) { if (sets.size() < 2) return sets; List<Set<E>> r = new ArrayList<>(); r.add(sets.get(0)); for (Set<E> x : consolidateR(sets.subList(1, sets.size()))) { if (!Collections.disjoint(r.get(0), x)) { r.get(0).addAll(x); } else { r.add(x); } } return r; }
private static List<Set<Character>> hashSetList(String... set) { List<Set<Character>> r = new ArrayList<>(); for (int i = 0; i < set.length; i++) { r.add(new HashSet<Character>()); for (int j = 0; j < set[i].length(); j++) r.get(i).add(set[i].charAt(j)); } return r; }
}</lang>
[A, B] [D, C] [D, A, B] [D, A, B, C] [F, G, H, I, K] [D, A, B, C]
Mathematica
<lang Mathematica>reduce[x_] :=
Block[{pairs, unique}, pairs = DeleteCases[ Subsets[Range@ Length@x, {2}], _?(Intersection @@ x# == {} &)]; unique = Complement[Range@Length@x, Flatten@pairs]; Join[Union[Flatten[x#]] & /@ pairs, xunique]]
consolidate[x__] := FixedPoint[reduce, {x}]</lang>
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, b, c, d}} consolidate[{h, i, k}, {a, b}, {c, d}, {d, b}, {f, g, h}] -> {{a,b,c,d},{f,g,h,i,k}}
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} }
ooRexx
<lang oorexx>/* REXX ***************************************************************
- 04.08.2013 Walter Pachl using ooRexx features
- (maybe not in the best way -improvements welcome!)
- but trying to demonstrate the algorithm
- /
s.1=.array~of(.set~of('A','B'),.set~of('C','D')) s.2=.array~of(.set~of('A','B'),.set~of('B','D')) s.3=.array~of(.set~of('A','B'),.set~of('C','D'),.set~of('D','B')) s.4=.array~of(.set~of('H','I','K'),.set~of('A','B'),.set~of('C','D'),,
.set~of('B','D'),.set~of('F','G','H'))
s.5=.array~of(.set~of('snow','ice','slush','frost','fog'),,
.set~of('iceburgs','icecubes'),, .set~of('rain','fog','sleet'))
s.6=.array~of('one') s.7=.array~new s.8=.array~of() Do si=1 To 8 /* loop through the test data */
na=s.si /* an array of sets */ head='Output(s):' Say left('Input' si,10) list_as(na) /* show the input */ Do While na~items()>0 /* while the array ain't empty*/ na=cons(na) /* consolidate and get back */ /* array of remaining sets */ head=' ' End Say '====' /* separator line */ End
Exit
cons: Procedure Expose head /**********************************************************************
- consolidate the sets in the given array
- /
Use Arg a w=a /* work on a copy */ n=w~items() /* number of sets in the array*/ Select When n=0 Then /* no set in array */ Return .array~new /* retuns an empty array */ When n=1 Then Do /* one set in array */ Say head list(w[1]) /* show its contents */ Return .array~new /* retuns an empty array */ End Otherwise Do /* at least two sets are there*/ b=.array~new /* use for remaining sets */ r=w[n] /* start with last set */ try=1 Do until changed=0 /* loop until result is stable*/ changed=0 new=0 n=w~items() /* number of sets */ Do i=1 To n-try /* loop first through n-1 sets*/ try=0 /* then through all of them */ is=r~intersection(w[i]) If is~items>0 Then Do /* any elements in common */ r=r~union(w[i]) /* result is the union */ Changed=1 /* and result is now larger */ End Else Do /* no elemen in common */ new=new+1 /* add the set to the array */ b[new]=w[i] /* of remaining sets */ End End If b~items()=0 Then Do /* no remaining sets */ w=.array~new Leave /* we are done */ End w=b /* repeat with remaining sets */ b=.array~new /* prepare for next iteration */ End End Say head list(r) /* show one consolidated set */ End Return w /* return array of remaining */
list: Procedure /**********************************************************************
- list elements of given set
- /
Call trace ?O Use Arg set arr=set~makeArray arr~sort() ol='(' Do i=1 To arr~items() If i=1 Then ol=ol||arr[i] Else ol=ol||','arr[i] End Return ol')'
list_as: Procedure /**********************************************************************
- List an array of sets
- /
Call trace ?O Use Arg a n=a~items() If n=0 Then ol='no element in array' Else Do ol= Do i=1 To n ol=ol '(' arr=a[i]~makeArray Do j=1 To arr~items() If j=1 Then ol=ol||arr[j] Else ol=ol','arr[j] End ol=ol') ' End End Return strip(ol)</lang>
Output:
Input 1 (B,A) (C,D) Output(s): (C,D) (A,B) ==== Input 2 (B,A) (B,D) Output(s): (A,B,D) ==== Input 3 (B,A) (C,D) (B,D) Output(s): (A,B,C,D) ==== Input 4 (H,I,K) (B,A) (C,D) (F,G,H) Output(s): (F,G,H,I,K) (A,B,C,D) ==== Input 5 (snow,fog,ice,frost,slush) (icecubes,iceburgs) (fog,sleet,rain) Output(s): (fog,frost,ice,rain,sleet,slush,snow) (iceburgs,icecubes) ==== Input 6 (one) Output(s): (one) ==== Input 7 no element in array ==== Input 8 () Output(s): () ====
PARI/GP
<lang parigp>cons(V)={
my(v,u,s); for(i=1,#V, v=V[i]; for(j=i+1,#V, u=V[j]; if(#setintersect(u,v),V[i]=v=vecsort(setunion(u,v));V[j]=[];s++) ) ); V=select(v->#v,V); if(s,cons(V),V)
};</lang>
Perl 6
<lang perl6>multi consolidate() { () } multi consolidate(Set \this is copy, *@those) {
gather { for consolidate |@those -> \that { if this ∩ that { this = this ∪ that } else { take that } } take this; }
}
enum Elems <A B C D E F G H I J K>; 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
<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>
PL/I
<lang PL/I>Set: procedure options (main); /* 13 November 2013 */
declare set(20) character (200) varying; declare e character (1); declare (i, n) fixed binary;
set = ; n = 1; do until (e = ']'); get edit (e) (a(1)); put edit (e) (a(1)); if e = '}' then n = n + 1; /* end of set. */ if e ^= '{' & e ^= ',' & e ^= '}' & e ^= ' ' then set(n) = set(n) || e; /* Build set */ end; /* We have read in all sets. */ n = n - 1; /* we have n sets */ /* Display the sets: */ put skip list ('The original sets:'); do i = 1 to n; call print(i); end; /* Look for sets to combine: */ do i = 2 to n; if length(set(i)) > 0 then if search(set(1), set(i)) > 0 then /* there's at least one common element */ do; call combine (1, i); set(i) = ; end; end;
put skip (2) list ('Results:'); do i = 1 to n; if length(set(i)) > 0 then call print (i); end;
combine: procedure (p, q);
declare (p, q) fixed binary; declare e character (1); declare i fixed binary;
do i = 1 to length(set(q)); e = substr(set(q), i, 1); if index(set(p), e) = 0 then set(p) = set(p) || e; end;
end combine;
print: procedure(k);
declare k fixed binary; declare i fixed binary;
put edit ('{') (a); do i = 1 to length(set(k)); put edit (substr(set(k), i, 1)) (a); if i < length(set(k)) then put edit (',') (a); end; put edit ('} ') (a);
end print;
end Set;</lang>
The original sets: {A,B} Results: {A,B} The original sets: {A,B} {C,D} Results: {A,B} {C,D} The original sets: {A,B} {B,C} Results: {A,B,C} The original sets: {A,B} {C,D} {E,B,F,G,H} Results: {A,B,E,F,G,H} {C,D}
Python
Python: Iterative
<lang python>def consolidate(sets):
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>
Python: 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>
Python: Testing
The _test
function 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 _test(consolidate=consolidate):
def freze(list_of_sets): 'return a set of frozensets from the list of sets to allow comparison' return set(frozenset(s) for s in list_of_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 assert (freze(consolidate([{A,B}, {C,D}])) == freze([{'A', 'B'}, {'C', 'D'}])) assert (freze(consolidate([{A,B}, {B,D}])) == freze([{'A', 'B', 'D'}])) assert (freze(consolidate([{A,B}, {C,D}, {D,B}])) == freze([{'A', 'C', 'B', 'D'}])) assert (freze(consolidate([{H,I,K}, {A,B}, {C,D}, {D,B}, {F,G,H}])) == freze([{'A', 'C', 'B', 'D'}, {'G', 'F', 'I', 'H', 'K'}])) assert (freze(consolidate([{A,H}, {H,I,K}, {A,B}, {C,D}, {D,B}, {F,G,H}])) == freze([{'A', 'C', 'B', 'D', 'G', 'F', 'I', 'H', 'K'}])) assert (freze(consolidate([{H,I,K}, {A,B}, {C,D}, {D,B}, {F,G,H}, {A,H}])) == freze([{'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 assert (answer == [{'A', 'C', 'B', 'D', 'G', 'F', 'I', 'H', 'K'}]) assert (len(list(itertools.permutations(sets))) == 720) print('_test(%s) complete' % consolidate.__name__)
if __name__ == '__main__':
_test(consolidate) _test(conso)</lang>
- Output:
_test(consolidate) complete _test(conso) complete
Racket
<lang racket>
- lang racket
(define (consolidate ss)
(define (comb s cs) (cond [(set-empty? s) cs] [(empty? cs) (list s)] [(set-empty? (set-intersect s (first cs))) (cons (first cs) (comb s (rest cs)))] [(consolidate (cons (set-union s (first cs)) (rest cs)))])) (foldl comb '() ss))
(consolidate (list (set 'a 'b) (set 'c 'd))) (consolidate (list (set 'a 'b) (set 'b 'c))) (consolidate (list (set 'a 'b) (set 'c 'd) (set 'd 'b))) (consolidate (list (set 'h 'i 'k) (set 'a 'b) (set 'c 'd) (set 'd 'b) (set 'f 'g 'h))) </lang> Output: <lang racket> (list (set 'b 'a) (set 'd 'c)) (list (set 'a 'b 'c)) (list (set 'a 'b 'd 'c)) (list (set 'g 'h 'k 'i 'f) (set 'a 'b 'd 'c)) </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}
Ruby
<lang ruby>require 'set'
tests = [[['A', 'B'], ['C','D']], [['A','B'], ['B','D']], [['A','B'], ['C','D'], ['D','B']], [['H','I','K'], ['A','B'], ['C','D'], ['D','B'], ['F','G','H']]] tests = tests.map{|sets| sets.map(&:to_set)}
tests.map do |sets|
loop until sets.combination(2).none? do |a,b| if a.intersect?(b) then a.merge(b) sets.delete(b) end end p sets
end </lang>
- Output:
[#<Set: {"A", "B"}>, #<Set: {"C", "D"}>] [#<Set: {"A", "B", "D"}>] [#<Set: {"A", "B", "D", "C"}>] [#<Set: {"H", "I", "K", "F", "G"}>, #<Set: {"A", "B", "D", "C"}>]
Tcl
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}