Set consolidation: Difference between revisions
Add Draco
m (→{{header|REXX}}: change the case for subroutines titles.) |
Not a robot (talk | contribs) (Add Draco) |
||
(76 intermediate revisions by 35 users not shown) | |||
Line 4:
* The single set that is the union of the two input sets if they share a common item.
<br>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.
Line 12:
:Given the two sets <tt>{A,B}</tt> and <tt>{B,D}</tt> then there is a common element <tt>B</tt> between the sets and the result is the single set <tt>{B,D,A}</tt>. (Note that order of items in a set is immaterial: <tt>{A,B,D}</tt> is the same as <tt>{B,D,A}</tt> and <tt>{D,A,B}</tt>, etc).
;'''Example 3:'''
:Given the three sets <tt>{A,B}</tt> and <tt>{C,D}</tt> and <tt>{D,B}</tt> then there is no common element between the sets <tt>{A,B}</tt> and <tt>{C,D}</tt> but the sets <tt>{A,B}</tt> and <tt>{D,B}</tt> do share a common element that consolidates to produce the result <tt>{B,D,A}</tt>. On examining this result with the remaining set, <tt>{C,D}</tt>, they share a common element and so consolidate to the final output of the single set <tt>{A,B,C,D}</tt>
;'''Example 4:'''
:The consolidation of the five sets:
Line 19 ⟶ 18:
:Is the two sets:
::<tt>{A, C, B, D}</tt>, and <tt>{G, F, I, H, K}</tt>
<br>
'''See also
* [[wp:Connected component (graph theory)|Connected component (graph theory)]]
* [[Range consolidation]]
<br><br>
=={{header|Ada}}==
We start with specifying a generic package Set_Cons that provides the neccessary tools, such as contructing and manipulating sets, truning them,
<
type Element is (<>);
with function Image(E: Element) return String;
Line 53 ⟶ 54:
type Set is array(Element) of Boolean;
end Set_Cons;</
Here is the implementation of Set_Cons:
<
function "+"(E: Element) return Set is
Line 133 ⟶ 134:
end Image;
end Set_Cons;</
Given that package, the task is easy:
<
procedure Set_Consolidation is
Line 176 ⟶ 177:
Ada.Text_IO.Put_Line
(Image(Consolidate((H+I+K) & (A+B) & (C+D) & (D+B) & (F+G+H))));
end Set_Consolidation;</
{{out}}
Line 185 ⟶ 186:
=={{header|Aime}}==
<syntaxhighlight lang="aime">display(list l)
{
for (integer i
text u, v;
o_text(
}
o_text("}");
}
Line 214 ⟶ 202:
}
intersect(record r, record u)
{
trap_q(r_vcall, r, r_put, 1, record().copy(u), 0);
}
consolidate(list l)
{
for (integer i
integer j;
i -= 1;
break;
}
Line 271 ⟶ 223:
}
}
R(...)
{
ucall.2(r_put, 1, record(), 0);
}
main(void)
{
display(consolidate(
display(consolidate(
display(consolidate(
display(consolidate(
R("D", "B"), R("F", "G", "K"))));
}</
{{out}}
<pre>{A, B}, {C, D}
Line 320 ⟶ 246:
{A, B, C, D}
{A, B, C, D}, {F, G, H, I, K}</pre>
=={{header|APL}}==
<syntaxhighlight lang="apl">consolidate ← (⊢((⊂∘∪∘∊(/⍨)),(/⍨)∘~)(((⊃∘⍒+/)⊃↓)∘.(∨/∊)⍨))⍣≡</syntaxhighlight>
{{out}}
<syntaxhighlight lang="apl"> consolidate 'AB' 'CD'
AB CD
consolidate 'AB' 'BD'
ABD
consolidate 'AB' 'CD' 'DB'
ABCD
consolidate 'HIK' 'AB' 'CD' 'DB' 'FGH'
HIKFG ABCD </syntaxhighlight>
=={{header|AutoHotkey}}==
<syntaxhighlight lang="autohotkey">SetConsolidation(sets){
arr2 := [] , arr3 := [] , arr4 := [] , arr5 := [], result:=[]
; sort each set individually
for i, obj in sets
{
arr1 := []
for j, v in obj
arr1[v] := true
arr2.push(arr1)
}
; sort by set's first item
for i, obj in arr2
for k, v in obj
{
arr3[k . i] := obj
break
}
; use numerical index
for k, obj in arr3
arr4[A_Index] := obj
j := 1
for i, obj in arr4
{
common := false
for k, v in obj
if arr5[j-1].HasKey(k)
{
common := true
break
}
if common
for k, v in obj
arr5[j-1, k] := true
else
arr5[j] := obj, j++
}
; clean up
for i, obj in arr5
for k , v in obj
result[i, A_Index] := k
return result
}</syntaxhighlight>
Examples:<syntaxhighlight lang="autohotkey">test1 := [["A","B"], ["C","D"]]
test2 := [["A","B"], ["B","D"]]
test3 := [["A","B"], ["C","D"], ["D","B"]]
test4 := [["H","I","K"], ["A","B"], ["C","D"], ["D","B"], ["F","G","H"]]
result := "["
loop, 4
{
for i, obj in SetConsolidation(test%A_Index%)
{
output := "["
for j, v in obj
output .= """" v ""","
result .= RTrim(output, ", ") . "] , "
}
result := RTrim(result, ", ") "]`n["
}
MsgBox % RTrim(result, "`n[")
return</syntaxhighlight>
{{out}}
<pre>[["A","B"] , ["C","D"]]
[["A","B","D"]]
[["A","B","C","D"]]
[["A","B","C","D"] , ["F","G","H","I","K"]]</pre>
=={{header|BASIC}}==
==={{header|BASIC256}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">dim test$(4)
test$[0] = "AB"
test$[1] = "AB,CD"
test$[2] = "AB,CD,DB"
test$[3] = "HIK,AB,CD,DB,FGH"
for t = 0 to 3 #test$[?]
print Consolidate(test$[t])
next t
end
function Consolidate(s$)
dim sets$(100)
# Split the string into substrings
pio = 1
n = 0
for i = 1 to length(s$)
if mid(s$, i, 1) = "," then
fin = i - 1
sets$[n] = mid(s$, pio, fin - pio + 1)
pio = i + 1
n += 1
end if
next i
sets$[n] = mid(s$, pio, length(s$) - pio + 1)
# Main logic
for i = 0 to n
p = i
ts$ = ""
for j = i to 0 step -1
if ts$ = "" then p = j
ts$ = ""
for k = 1 to length(sets$[p])
if j > 0 then
if instr(sets$[j-1], mid(sets$[p], k, 1)) = 0 then
ts$ += mid(sets$[p], k, 1)
end if
end if
next k
if length(ts$) < length(sets$[p]) then
if j > 0 then
sets$[j-1] = sets$[j-1] + ts$
sets$[p] = "-"
ts$ = ""
end if
else
p = i
end if
next j
next i
# Join the substrings into a string
temp$ = sets$[0]
for i = 1 to n
temp$ += "," + sets$[i]
next i
return s$ + " = " + temp$
end function</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
==={{header|Chipmunk Basic}}===
{{works with|Chipmunk Basic|3.6.4}}
Same code as [[#GW-BASIC|GW-BASIC]]
==={{header|FreeBASIC}}===
{{trans|Ring}}
<syntaxhighlight lang="vbnet">Function Consolidate(s As String) As String
Dim As Integer i, j, k, p, n, pio, fin
Dim As String ts, sets(0 To 100), temp
' Split the string into substrings
pio = 1
n = 0
For i = 1 To Len(s)
If Mid(s, i, 1) = "," Then
fin = i - 1
sets(n) = Mid(s, pio, fin - pio + 1)
pio = i + 1
n += 1
End If
Next i
sets(n) = Mid(s, pio, Len(s) - pio + 1)
' Main logic
For i = 0 To n
p = i
ts = ""
For j = i To 0 Step -1
If ts = "" Then p = j
ts = ""
For k = 1 To Len(sets(p))
If j > 0 Then
If Instr(sets(j-1), Mid(sets(p), k, 1)) = 0 Then ts += Mid(sets(p), k, 1)
End If
Next k
If Len(ts) < Len(sets(p)) Then
If j > 0 Then
sets(j-1) += ts
sets(p) = "-"
ts = ""
End If
Else
p = i
End If
Next j
Next i
' Join the substrings into a string
temp = sets(0)
For i = 1 To n
temp += "," + sets(i)
Next i
Return s + " = " + temp
End Function
Dim As String test(3) = {"AB", "AB,CD", "AB,CD,DB", "HIK,AB,CD,DB,FGH"}
For t As Integer = Lbound(test) To Ubound(test)
Print Consolidate(test(t))
Next t
Sleep</syntaxhighlight>
{{out}}
<pre>Same as Ring entry.</pre>
==={{header|Gambas}}===
{{trans|Ring}}
<syntaxhighlight lang="vbnet">Public test As String[] = ["AB", "AB,CD", "AB,CD,DB", "HIK,AB,CD,DB,FGH"]
Public Sub Main()
For t As Integer = 0 To test.Max
Print Consolidate(test[t])
Next
End
Public Function Consolidate(s As String) As String
Dim sets As New String[100]
Dim n As Integer, i As Integer, j As Integer, k As Integer, p As Integer
Dim ts As String, tmp As String
n = 0
For i = 1 To Len(s)
If Mid(s, i, 1) = "," Then
n += 1
Else
sets[n] = sets[n] & Mid(s, i, 1)
Endif
Next
For i = 0 To n
p = i
ts = ""
For j = i To 0 Step -1
If ts = "" Then p = j
ts = ""
For k = 1 To Len(sets[p])
If j > 0 Then
If InStr(sets[j - 1], Mid(sets[p], k, 1)) = 0 Then
ts &= Mid(sets[p], k, 1)
Endif
Endif
Next
If Len(ts) < Len(sets[p]) Then
If j > 0 Then
sets[j - 1] &= ts
sets[p] = "-"
ts = ""
Endif
Else
p = i
Endif
Next
Next
tmp = sets[0]
For i = 1 To n
tmp &= "," & sets[i]
Next
Return s & " = " & tmp
End</syntaxhighlight>
{{out}}
<pre>Same as Ring entry.</pre>
==={{header|GW-BASIC}}===
{{works with|PC-BASIC|any}}
{{works with|BASICA}}
{{works with|Chipmunk Basic}}
{{works with|QBasic}}
{{works with|MSX BASIC}}
<syntaxhighlight lang="qbasic">100 CLS
110 S$ = "AB" : GOSUB 160
120 S$ = "AB,CD" : GOSUB 160
130 S$ = "AB,CD,DB" : GOSUB 160
140 S$ = "HIK,AB,CD,DB,FGH" : GOSUB 160
150 END
160 DIM R$(20)
170 N = 0
180 FOR I = 1 TO LEN(S$)
190 IF MID$(S$,I,1) = "," THEN N = N+1 : GOTO 210
200 R$(N) = R$(N)+MID$(S$,I,1)
210 NEXT I
220 FOR I = 0 TO N
230 P = I
240 TS$ = ""
250 FOR J = I TO 0 STEP -1
260 IF TS$ = "" THEN P = J
270 TS$ = ""
280 FOR K = 1 TO LEN(R$(P))
290 IF J > 0 THEN IF INSTR(R$(J-1),MID$(R$(P),K,1)) = 0 THEN TS$ = TS$+MID$(R$(P),K,1)
300 NEXT K
310 IF LEN(TS$) < LEN(R$(P)) THEN IF J > 0 THEN R$(J-1) = R$(J-1)+TS$ : R$(P) = "-" : TS$ = ""
320 NEXT J
330 NEXT I
340 T$ = R$(0)
350 FOR I = 1 TO N
360 T$ = T$+","+R$(I)
370 NEXT I
380 PRINT S$;" = ";T$
390 ERASE R$
400 RETURN</syntaxhighlight>
{{out}}
<pre>AB = AB
AB,CD = AB,CD
AB,CD,DB = ABCD,-,-
HIK,AB,CD,DB,FGH = HIKFG,ABCD,-,-,-</pre>
==={{header|MSX Basic}}===
{{works with|MSX BASIC|any}}
Same code as [[#GW-BASIC|GW-BASIC]]
==={{header|PureBasic}}===
<syntaxhighlight lang="purebasic">Procedure.s Consolidate(s.s)
Dim sets.s(100)
Define.i n, i, j, k, p
Define.s ts.s, temp.s
n = 0
For i = 1 To Len(s)
If Mid(s, i, 1) = ",":
n + 1
Else
sets(n) = sets(n) + Mid(s, i, 1)
EndIf
Next i
For i = 0 To n
p = i
ts = ""
For j = i To 0 Step -1
If ts = "":
p = j
EndIf
ts = ""
For k = 1 To Len(sets(p))
If j > 0:
If FindString(sets(j-1), Mid(sets(p), k, 1)) = 0:
ts = ts + Mid(sets(p), k, 1)
EndIf
EndIf
Next k
If Len(ts) < Len(sets(p)):
If j > 0:
sets(j-1) = sets(j-1) + ts
sets(p) = "-"
ts = ""
EndIf
Else
p = i
EndIf
Next j
Next i
temp = sets(0)
For i = 1 To n
temp = temp + "," + sets(i)
Next i
ProcedureReturn s + " = " + temp
EndProcedure
OpenConsole()
Dim test.s(3) ;= {"AB","AB,CD","AB,CD,DB","HIK,AB,CD,DB,FGH"}
test(0) = "AB"
test(1) = "AB,CD"
test(2) = "AB,CD,DB"
test(3) = "HIK,AB,CD,DB,FGH"
For t.i = 0 To 3
PrintN(Consolidate(test(t)))
Next t
PrintN(#CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()</syntaxhighlight>
{{out}}
<pre>Same as Ring entry.</pre>
==={{header|QBasic}}===
{{trans|Ring}}
{{works with|QBasic|1.1}}
{{works with|QuickBasic|4.5}}
<syntaxhighlight lang="qbasic">SUB consolidate (s$)
DIM sets$(100)
n = 0
FOR i = 1 TO LEN(s$)
IF MID$(s$, i, 1) = "," THEN
n = n + 1
ELSE
sets$(n) = sets$(n) + MID$(s$, i, 1)
END IF
NEXT i
FOR i = 0 TO n
p = i
ts$ = ""
FOR j = i TO 0 STEP -1
IF ts$ = "" THEN
p = j
END IF
ts$ = ""
FOR k = 1 TO LEN(sets$(p))
IF j > 0 THEN
IF INSTR(sets$(j - 1), MID$(sets$(p), k, 1)) = 0 THEN
ts$ = ts$ + MID$(sets$(p), k, 1)
END IF
END IF
NEXT k
IF LEN(ts$) < LEN(sets$(p)) THEN
IF j > 0 THEN
sets$(j - 1) = sets$(j - 1) + ts$
sets$(p) = "-"
ts$ = ""
END IF
ELSE
p = i
END IF
NEXT j
NEXT i
temp$ = sets$(0)
FOR i = 1 TO n
temp$ = temp$ + "," + sets$(i)
NEXT i
PRINT s$; " = "; temp$
END SUB
DIM test$(3)
test$(0) = "AB"
test$(1) = "AB,CD"
test$(2) = "AB,CD,DB"
test$(3) = "HIK,AB,CD,DB,FGH"
FOR t = 0 TO 3
CALL consolidate(test$(t))
NEXT t</syntaxhighlight>
{{out}}
<pre>Same as Ring entry.</pre>
==={{header|Run BASIC}}===
{{trans|QBasic}}
<syntaxhighlight lang="vbnet">function consolidate$(s$)
dim sets$(100)
n = 0
for i = 1 to len(s$)
if mid$(s$, i, 1) = "," then
n = n + 1
else
sets$(n) = sets$(n) + mid$(s$, i, 1)
end if
next i
for i = 0 to n
p = i
ts$ = ""
for j = i to 0 step -1
if ts$ = "" then p = j
ts$ = ""
for k = 1 to len(sets$(p))
if j > 0 then
if instr(sets$(j-1), mid$(sets$(p), k, 1)) = 0 then
ts$ = ts$ + mid$(sets$(p), k, 1)
end if
end if
next k
if len(ts$) < len(sets$(p)) then
if j > 0 then
sets$(j-1) = sets$(j-1) + ts$
sets$(p) = "-"
ts$ = ""
end if
else
p = i
end if
next j
next i
temp$ = sets$(0)
for i = 1 to n
temp$ = temp$ + "," + sets$(i)
next i
consolidate$ = s$ + " = " + temp$
end function
dim test$(3)
test$(0) = "AB"
test$(1) = "AB,CD"
test$(2) = "AB,CD,DB"
test$(3) = "HIK,AB,CD,DB,FGH"
for t = 0 to 3
print consolidate$(test$(t))
next t</syntaxhighlight>
==={{header|XBasic}}===
{{trans|BASIC256}}
{{works with|Windows XBasic}}
<syntaxhighlight lang="qbasic">PROGRAM "Set consolidation"
VERSION "0.0001"
DECLARE FUNCTION Entry ()
DECLARE FUNCTION Consolidate$ (s$)
FUNCTION Entry ()
DIM test$[4]
test$[0] = "AB"
test$[1] = "AB,CD"
test$[2] = "AB,CD,DB"
test$[3] = "HIK,AB,CD,DB,FGH"
FOR t = 0 TO 3
PRINT Consolidate$(test$[t])
NEXT t
END FUNCTION
FUNCTION Consolidate$ (s$)
DIM sets$[100]
' Split the STRING into substrings
pio = 1
n = 0
FOR i = 1 TO LEN(s$)
IF MID$(s$, i, 1) = "," THEN
fin = i - 1
sets$[n] = MID$(s$, pio, fin - pio + 1)
pio = i + 1
INC n
END IF
NEXT i
sets$[n] = MID$(s$, pio, LEN(s$) - pio + 1)
' Main logic
FOR i = 0 TO n
p = i
ts$ = ""
FOR j = i TO 0 STEP -1
IF ts$ = "" THEN p = j
ts$ = ""
FOR k = 1 TO LEN(sets$[p])
IF j > 0 THEN
IF INSTR(sets$[j-1], MID$(sets$[p], k, 1)) = 0 THEN
ts$ = ts$ + MID$(sets$[p], k, 1)
END IF
END IF
NEXT k
IF LEN(ts$) < LEN(sets$[p]) THEN
IF j > 0 THEN
sets$[j-1] = sets$[j-1] + ts$
sets$[p] = "-"
ts$ = ""
END IF
ELSE
p = i
END IF
NEXT j
NEXT i
' Join the substrings into a STRING
temp$ = sets$[0]
FOR i = 1 TO n
temp$ = temp$ + "," + sets$[i]
NEXT i
RETURN s$ + " = " + temp$
END FUNCTION
END PROGRAM</syntaxhighlight>
{{out}}
<pre>Same as BASIC256 entry.</pre>
==={{header|Yabasic}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">dim test$(3)
test$(0) = "AB"
test$(1) = "AB,CD"
test$(2) = "AB,CD,DB"
test$(3) = "HIK,AB,CD,DB,FGH"
for t = 0 to arraysize(test$(), 1)
print Consolidate$(test$(t))
next t
end
sub Consolidate$(s$)
dim sets$(100)
// Split the string into substrings
pio = 1
n = 0
for i = 1 to len(s$)
if mid$(s$, i, 1) = "," then
fin = i - 1
sets$(n) = mid$(s$, pio, fin - pio + 1)
pio = i + 1
n = n + 1
fi
next i
sets$(n) = mid$(s$, pio, len(s$) - pio + 1)
// Main logic
for i = 0 to n
p = i
ts$ = ""
for j = i to 0 step -1
if ts$ = "" p = j
ts$ = ""
for k = 1 to len(sets$(p))
if j > 0 then
if instr(sets$(j-1), mid$(sets$(p), k, 1)) = 0 then
ts$ = ts$ + mid$(sets$(p), k, 1)
fi
fi
next k
if len(ts$) < len(sets$(p)) then
if j > 0 then
sets$(j-1) = sets$(j-1) + ts$
sets$(p) = "-"
ts$ = ""
fi
else
p = i
fi
next j
next i
// Join the substrings into a string
temp$ = sets$(0)
for i = 1 to n
temp$ = temp$ + "," + sets$(i)
next i
return s$ + " = " + temp$
end sub</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
=={{header|Bracmat}}==
<
= a m z mm za zm zz
. ( removeNumFactors
Line 349 ⟶ 919:
& test$(A+B C+D D+B)
& test$(H+I+K A+B C+D D+B F+G+H)
);</
{{out}}
<pre>A+B C+D ==> A+B C+D
Line 364 ⟶ 934:
=={{header|C}}==
<
#define s(x) (1U << ((x) - 'A'))
Line 400 ⟶ 970:
puts("\nAfter:"); show_sets(x, consolidate(x, len));
return 0;
}</
The above is O(N<sup>2</sup>) 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:
<
#include <stdlib.h>
#include <string.h>
Line 504 ⟶ 1,074:
return 0;
}</
=={{header|C sharp}}==
<syntaxhighlight lang="csharp">using System;
using System.Linq;
using System.Collections.Generic;
public class SetConsolidation
{
public static void Main()
{
var setCollection1 = new[] {new[] {"A", "B"}, new[] {"C", "D"}};
var setCollection2 = new[] {new[] {"A", "B"}, new[] {"B", "D"}};
var setCollection3 = new[] {new[] {"A", "B"}, new[] {"C", "D"}, new[] {"B", "D"}};
var setCollection4 = new[] {new[] {"H", "I", "K"}, new[] {"A", "B"}, new[] {"C", "D"},
new[] {"D", "B"}, new[] {"F", "G", "H"}};
var input = new[] {setCollection1, setCollection2, setCollection3, setCollection4};
foreach (var sets in input) {
Console.WriteLine("Start sets:");
Console.WriteLine(string.Join(", ", sets.Select(s => "{" + string.Join(", ", s) + "}")));
Console.WriteLine("Sets consolidated using Nodes:");
Console.WriteLine(string.Join(", ", ConsolidateSets1(sets).Select(s => "{" + string.Join(", ", s) + "}")));
Console.WriteLine("Sets consolidated using Set operations:");
Console.WriteLine(string.Join(", ", ConsolidateSets2(sets).Select(s => "{" + string.Join(", ", s) + "}")));
Console.WriteLine();
}
}
/// <summary>
/// Consolidates sets using a connected-component-finding-algorithm involving Nodes with parent pointers.
/// The more efficient solution, but more elaborate code.
/// </summary>
private static IEnumerable<IEnumerable<T>> ConsolidateSets1<T>(IEnumerable<IEnumerable<T>> sets,
IEqualityComparer<T> comparer = null)
{
var elements = new Dictionary<T, Node<T>>(comparer );
foreach (var set in sets) {
Node<T> top = null;
foreach (T value in set) {
Node<T> element;
if (elements.TryGetValue(value, out element)) {
if (top != null) {
var newTop = element.FindTop();
top.Parent = newTop;
element.Parent = newTop;
top = newTop;
} else {
top = element.FindTop();
}
} else {
elements.Add(value, element = new Node<T>(value));
if (top == null) top = element;
else element.Parent = top;
}
}
}
foreach (var g in elements.Values.GroupBy(element => element.FindTop().Value))
yield return g.Select(e => e.Value);
}
private class Node<T>
{
public Node(T value, Node<T> parent = null) {
Value = value;
Parent = parent ?? this;
}
public T Value { get; }
public Node<T> Parent { get; set; }
public Node<T> FindTop() {
var top = this;
while (top != top.Parent) top = top.Parent;
//Set all parents to the top element to prevent repeated iteration in the future
var element = this;
while (element.Parent != top) {
var parent = element.Parent;
element.Parent = top;
element = parent;
}
return top;
}
}
/// <summary>
/// Consolidates sets using operations on the HashSet<T> class.
/// Less efficient than the other method, but easier to write.
/// </summary>
private static IEnumerable<IEnumerable<T>> ConsolidateSets2<T>(IEnumerable<IEnumerable<T>> sets,
IEqualityComparer<T> comparer = null)
{
if (comparer == null) comparer = EqualityComparer<T>.Default;
var currentSets = sets.Select(s => new HashSet<T>(s)).ToList();
int previousSize;
do {
previousSize = currentSets.Count;
for (int i = 0; i < currentSets.Count - 1; i++) {
for (int j = currentSets.Count - 1; j > i; j--) {
if (currentSets[i].Overlaps(currentSets[j])) {
currentSets[i].UnionWith(currentSets[j]);
currentSets.RemoveAt(j);
}
}
}
} while (previousSize > currentSets.Count);
foreach (var set in currentSets) yield return set.Select(value => value);
}
}</syntaxhighlight>
{{out}}
<pre>
Start sets:
{A, B}, {C, D}
Sets consolidated using nodes:
{A, B}, {C, D}
Sets consolidated using Set operations:
{A, B}, {C, D}
Start sets:
{A, B}, {B, D}
Sets consolidated using nodes:
{A, B, D}
Sets consolidated using Set operations:
{A, B, D}
Start sets:
{A, B}, {C, D}, {B, D}
Sets consolidated using nodes:
{A, B, C, D}
Sets consolidated using Set operations:
{A, B, D, C}
Start sets:
{H, I, K}, {A, B}, {C, D}, {D, B}, {F, G, H}
Sets consolidated using nodes:
{H, I, K, F, G}, {A, B, C, D}
Sets consolidated using Set operations:
{H, I, K, F, G}, {A, B, D, C}</pre>
=={{header|C++}}==
<syntaxhighlight lang="cpp">#include <algorithm>
#include <iostream>
#include <unordered_map>
#include <unordered_set>
#include <vector>
using namespace std;
// Consolidation using a brute force approach
void SimpleConsolidate(vector<unordered_set<char>>& sets)
{
// Loop through the sets in reverse and consolidate them
for(auto last = sets.rbegin(); last != sets.rend(); ++last)
for(auto other = last + 1; other != sets.rend(); ++other)
{
bool hasIntersection = any_of(last->begin(), last->end(),
[&](auto val)
{ return other->contains(val); });
if(hasIntersection)
{
other->merge(*last);
sets.pop_back();
break;
}
}
}
// As a second approach, use the connected-component-finding-algorithm
// from the C# entry to consolidate
struct Node
{
char Value;
Node* Parent = nullptr;
};
Node* FindTop(Node& node)
{
auto top = &node;
while (top != top->Parent) top = top->Parent;
for(auto element = &node; element->Parent != top; )
{
// Point the elements to top to make it faster for the next time
auto parent = element->Parent;
element->Parent = top;
element = parent;
}
return top;
}
vector<unordered_set<char>> FastConsolidate(const vector<unordered_set<char>>& sets)
{
unordered_map<char, Node> elements;
for(auto& set : sets)
{
Node* top = nullptr;
for(auto val : set)
{
auto itr = elements.find(val);
if(itr == elements.end())
{
// A new value has been found
auto& ref = elements[val] = Node{val, nullptr};
if(!top) top = &ref;
ref.Parent = top;
}
else
{
auto newTop = FindTop(itr->second);
if(top)
{
top->Parent = newTop;
itr->second.Parent = newTop;
}
else
{
top = newTop;
}
}
}
}
unordered_map<char, unordered_set<char>> groupedByTop;
for(auto& e : elements)
{
auto& element = e.second;
groupedByTop[FindTop(element)->Value].insert(element.Value);
}
vector<unordered_set<char>> ret;
for(auto& itr : groupedByTop)
{
ret.push_back(move(itr.second));
}
return ret;
}
void PrintSets(const vector<unordered_set<char>>& sets)
{
for(const auto& set : sets)
{
cout << "{ ";
for(auto value : set){cout << value << " ";}
cout << "} ";
}
cout << "\n";
}
int main()
{
const unordered_set<char> AB{'A', 'B'}, CD{'C', 'D'}, DB{'D', 'B'},
HIJ{'H', 'I', 'K'}, FGH{'F', 'G', 'H'};
vector <unordered_set<char>> AB_CD {AB, CD};
vector <unordered_set<char>> AB_DB {AB, DB};
vector <unordered_set<char>> AB_CD_DB {AB, CD, DB};
vector <unordered_set<char>> HIJ_AB_CD_DB_FGH {HIJ, AB, CD, DB, FGH};
PrintSets(FastConsolidate(AB_CD));
PrintSets(FastConsolidate(AB_DB));
PrintSets(FastConsolidate(AB_CD_DB));
PrintSets(FastConsolidate(HIJ_AB_CD_DB_FGH));
SimpleConsolidate(AB_CD);
SimpleConsolidate(AB_DB);
SimpleConsolidate(AB_CD_DB);
SimpleConsolidate(HIJ_AB_CD_DB_FGH);
PrintSets(AB_CD);
PrintSets(AB_DB);
PrintSets(AB_CD_DB);
PrintSets(HIJ_AB_CD_DB_FGH);
}
</syntaxhighlight>
{{out}}
<pre>
{ B A } { D C }
{ B A D }
{ B A D C }
{ B A D C } { I K H G F }
{ B A } { D C }
{ D A B }
{ D C A B }
{ F G H K I } { D C A B }
</pre>
=={{header|Clojure}}==
<syntaxhighlight lang="clojure">(defn consolidate-linked-sets [sets]
(apply clojure.set/union sets))
(defn linked? [s1 s2]
(not (empty? (clojure.set/intersection s1 s2))))
(defn consolidate [& sets]
(loop [seeds sets
sets sets]
(if (empty? seeds)
sets
(let [s0 (first seeds)
linked (filter #(linked? s0 %) sets)
remove-used (fn [sets used]
(remove #(contains? (set used) %) sets))]
(recur (remove-used (rest seeds) linked)
(conj (remove-used sets linked)
(consolidate-linked-sets linked)))))))</syntaxhighlight>
{{out}}
<pre>
(consolidate #{:a :b} #{:c :d}) ; ==> (#{:c :d} #{:b :a})
(consolidate #{:a :b} #{:c :b}) ; ==> (#{:c :b :a})
(consolidate #{:a :b} #{:c :d} #{:d :b}) ; ==> (#{:c :b :d :a})
(consolidate #{:h :i :k} #{:a :b} #{:c :d} #{:d :b} #{:f :g :h})
; ==> (#{:c :b :d :a} #{:k :g :h :f :i})
</pre>
=={{header|Common Lisp}}==
{{trans|Racket}}
<
(labels ((comb (cs s)
(cond ((null s) cs)
Line 515 ⟶ 1,399:
(cons (first cs) (comb (rest cs) s)))
((consolidate (cons (union s (first cs)) (rest cs)))))))
(reduce #'comb ss :initial-value nil)))</
{{Out}}
Line 529 ⟶ 1,413:
=={{header|D}}==
{{trans|Go}}
<
dchar[][] consolidate(dchar[][] sets) @safe {
Line 557 ⟶ 1,441:
[['H','I','K'], ['A','B'], ['C','D'],
['D','B'], ['F','G','H']].consolidate.writeln;
}</
{{out}}
<pre>["AB", "CD"]
Line 565 ⟶ 1,449:
'''Recursive version''', as described on talk page.
<
dchar[][] consolidate(dchar[][] sets) @safe {
Line 596 ⟶ 1,480:
[['H','I','K'], ['A','B'], ['C','D'],
['D','B'], ['F','G','H']].consolidate.writeln;
}</
<pre>["AB", "CD"]
["ABD"]
["ABCD"]
["FGHIK", "ABCD"]</pre>
=={{header|Draco}}==
<syntaxhighlight lang="draco">type Set = word;
proc make_set(*char setdsc) Set:
Set set;
byte pos;
set := 0;
while setdsc* /= '\e' do
pos := setdsc* - 'A';
if pos < 16 then set := set | (1 << pos) fi;
setdsc := setdsc + 1
od;
set
corp
proc write_set(Set set) void:
char item;
write('(');
for item from 'A' upto ('A'+15) do
if set & 1 /= 0 then write(item) fi;
set := set >> 1
od;
write(')')
corp
proc consolidate([*]Set sets) word:
word i, j, n;
bool change;
n := dim(sets, 1);
change := true;
while change do
change := false;
for i from 0 upto n-1 do
for j from i+1 upto n-1 do
if sets[i] & sets[j] /= 0 then
sets[i] := sets[i] | sets[j];
sets[j] := 0;
change := true
fi
od
od
od;
for i from 1 upto n-1 do
if sets[i] = 0 then
for j from i+1 upto n-1 do
sets[j-1] := sets[j]
od
fi
od;
i := 0;
while i<n and sets[i] /= 0 do i := i+1 od;
i
corp
proc test([*]Set sets) void:
word i, n;
n := dim(sets, 1);
for i from 0 upto n-1 do write_set(sets[i]) od;
write(" -> ");
n := consolidate(sets);
for i from 0 upto n-1 do write_set(sets[i]) od;
writeln()
corp
proc main() void:
[2]Set ex1;
[2]Set ex2;
[3]Set ex3;
[5]Set ex4;
ex1[0]:=make_set("AB"); ex1[1]:=make_set("CD");
ex2[0]:=make_set("AB"); ex2[1]:=make_set("BC");
ex3[0]:=make_set("AB"); ex3[1]:=make_set("CD"); ex3[2]:=make_set("DB");
ex4[0]:=make_set("HIK"); ex4[1]:=make_set("AB"); ex4[2]:=make_set("CD");
ex4[3]:=make_set("DB"); ex4[4]:=make_set("FGH");
test(ex1);
test(ex2);
test(ex3);
test(ex4);
corp</syntaxhighlight>
{{out}}
<pre>(AB)(CD) -> (AB)(CD)
(AB)(BC) -> (ABC)
(AB)(CD)(BD) -> (ABCD)
(HIK)(AB)(CD)(BD)(FGH) -> (FGHIK)(ABCD)</pre>
=={{header|EchoLisp}}==
<syntaxhighlight lang="scheme">
;; utility : make a set of sets from a list
(define (make-set* s)
(or (when (list? s) (make-set (map make-set* s))) s))
;; union of all sets which intersect - O(n^2)
(define (make-big ss)
(make-set
(for/list ((u ss))
(for/fold (big u) ((v ss)) #:when (set-intersect? big v) (set-union big v)))))
;; remove sets which are subset of another one - O(n^2)
(define (remove-small ss)
(for/list ((keep ss))
#:when (for/and ((v ss)) #:continue (set-equal? keep v) (not (set-subset? v keep)))
keep))
(define (consolidate ss) (make-set (remove-small (make-big ss))))
(define S (make-set* ' ((h i k) ( a b) ( b c) (c d) ( f g h))))
→ { { a b } { b c } { c d } { f g h } { h i k } }
(consolidate S)
→ { { a b c d } { f g h i k } }
</syntaxhighlight>
=={{header|Egison}}==
<
(define $consolidate
(lambda [$xss]
Line 615 ⟶ 1,617:
(test (consolidate {{'H' 'I' 'K'} {'A' 'B'} {'C' 'D'} {'D' 'B'} {'F' 'G' 'H'}}))
</syntaxhighlight>
{{out}}
<
{"DBAC" "HIKFG"}
</syntaxhighlight>
=={{header|Ela}}==
This solution emulate sets using linked lists:
<
merge [] ys = ys
Line 633 ⟶ 1,635:
where conso xs [] = xs
conso (x::xs)@r (y::ys) | intersect x y <> [] = conso ((merge x y)::xs) ys
| else = conso (r ++ [y]) ys</
Usage:
<
:::IO
do
x <- return $ consolidate [['H','I','K'], ['A','B'], ['C','D'], ['D','B'], ['F','G','H']]
putLn x
y <- return $ consolidate [['A','B'], ['B','D']]
putLn y</syntaxhighlight>
Output:<pre>[['K','I','F','G','H'],['A','C','D','B']]
[['A','B','D']]</pre>
=={{header|Elixir}}==
<syntaxhighlight lang="elixir">defmodule RC do
def set_consolidate(sets, result\\[])
def set_consolidate([], result), do: result
def set_consolidate([h|t], result) do
case Enum.find(t, fn set -> not MapSet.disjoint?(h, set) end) do
nil -> set_consolidate(t, [h | result])
set -> set_consolidate([MapSet.union(h, set) | t -- [set]], result)
end
end
end
examples = [[[: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]]]
|> Enum.map(fn sets ->
Enum.map(sets, fn set -> MapSet.new(set) end)
end)
Enum.each(examples, fn sets ->
IO.write "#{inspect sets} =>\n\t"
IO.inspect RC.set_consolidate(sets)
end)</syntaxhighlight>
{{out}}
<pre>
[#MapSet<[:A, :B]>, #MapSet<[:C, :D]>]
[#MapSet<[:C, :D]>, #MapSet<[:A, :B]>]
[#MapSet<[:A, :B]>, #MapSet<[:B, :D]>] =>
[#MapSet<[:A, :B, :D]>]
[#MapSet<[:A, :B]>, #MapSet<[:C, :D]>, #MapSet<[:B, :D]>] =>
[#MapSet<[:A, :B, :C, :D]>]
[#MapSet<[:H, :I, :K]>, #MapSet<[:A, :B]>, #MapSet<[:C, :D]>, #MapSet<[:B, :D]>, #MapSet<[:F, :G, :H]>] =>
[#MapSet<[:A, :B, :C, :D]>, #MapSet<[:F, :G, :H, :I, :K]>]
</pre>
=={{header|F_Sharp|F#}}==
<
if Seq.isEmpty s then SeqEmpty
else SeqNode ((Seq.head s), Seq.skip 1 s)
Line 669 ⟶ 1,713:
[["H";"I";"K"]; ["A";"B"]; ["C";"D"]; ["D";"B"]; ["F";"G";"H"]]
]
0</
{{out}}
<pre>seq [set ["C"; "D"]; set ["A"; "B"]]
Line 675 ⟶ 1,719:
seq [set ["A"; "B"; "C"; "D"]]
seq [set ["A"; "B"; "C"; "D"]; set ["F"; "G"; "H"; "I"; "K"]]</pre>
=={{header|Factor}}==
<syntaxhighlight lang="factor">USING: arrays kernel sequences sets ;
: comb ( x x -- x )
over empty? [ nip 1array ] [
dup pick first intersects?
[ [ unclip ] dip union comb ]
[ [ 1 cut ] dip comb append ] if
] if ;
: consolidate ( x -- x ) { } [ comb ] reduce ;</syntaxhighlight>
{{out}}
<pre>
IN: scratchpad USE: qw
IN: scratchpad qw{ AB CD } consolidate .
{ "AB" "CD" }
IN: scratchpad qw{ AB BC } consolidate .
{ "ABC" }
IN: scratchpad qw{ AB CD DB } consolidate .
{ "CDAB" }
IN: scratchpad qw{ HIK AB CD DB FGH } consolidate .
{ "CDAB" "HIKFG" }
</pre>
=={{header|Go}}==
{{trans|Python}}
<
import "fmt"
Line 733 ⟶ 1,801:
}
return true
}</
{{out}}
<pre>
Line 741 ⟶ 1,809:
=={{header|Haskell}}==
<syntaxhighlight lang
import qualified Data.Set as S
consolidate
:: Ord a
consolidate =
where
comb s_ [] = [s_]
comb s_ (s:ss)
| S.null (s `S.intersection` s_) = s : comb s_ ss
| otherwise = comb (s `S.union` s_) ss
-- TESTS -------------------------------------------------
main :: IO ()
main =
(putStrLn . unlines)
((intercalate ", and " . fmap showSet . consolidate) . fmap S.fromList <$>
[ ["ab", "cd"]
, ["ab", "bd"]
, ["ab", "cd", "db"]
, ["hik", "ab", "cd", "db", "fgh"]
])
showSet :: S.Set Char -> String
showSet = flip intercalate ["{", "}"] . intersperse ',' . S.elems</syntaxhighlight>
{{Out}}
<pre>{c,d}, and {a,b}
{a,b,d}
{a,b,c,d}
{a,b,c,d}, and {f,g,h,i,k}</pre>
=={{header|J}}==
<
b=. y 1&e.@e.&> x
(1,-.b)#(~.;x,b#y);y
)</
In other words, fold each set into a growing list of consolidated sets. When there's any overlap between the newly considered set (<code>x</code>) and any of the list of previously considered sets (<code>y</code>), merge the unique values from all of those into a single set (any remaining sets remain as-is). Here, <code>b</code> selects the overlapping sets from y (and <code>-.b</code> selects the rest of those sets).
Examples:
<
┌──┬──┐
│ab│cd│
Line 785 ⟶ 1,868:
┌─────┬────┐
│hijfg│abcd│
└─────┴────┘</
=={{header|Java}}==
{{trans|D}}
{{works with|Java|7}}
<
public class SetConsolidation {
Line 852 ⟶ 1,935:
return r;
}
}</
<pre>[A, B] [D, C]
[D, A, B]
[D, A, B, C]
[F, G, H, I, K] [D, A, B, C]</pre>
=={{header|JavaScript}}==
<syntaxhighlight lang="javascript">(() => {
'use strict';
// consolidated :: Ord a => [Set a] -> [Set a]
const consolidated = xs => {
const go = (s, xs) =>
0 !== xs.length ? (() => {
const h = xs[0];
return 0 === intersection(h, s).size ? (
[h].concat(go(s, tail(xs)))
) : go(union(h, s), tail(xs));
})() : [s];
return foldr(go, [], xs);
};
// TESTS ----------------------------------------------
const main = () =>
map(xs => intercalate(
', and ',
map(showSet, consolidated(xs))
),
map(x => map(
s => new Set(chars(s)),
x
),
[
['ab', 'cd'],
['ab', 'bd'],
['ab', 'cd', 'db'],
['hik', 'ab', 'cd', 'db', 'fgh']
]
)
).join('\n');
// GENERIC FUNCTIONS ----------------------------------
// chars :: String -> [Char]
const chars = s => s.split('');
// concat :: [[a]] -> [a]
// concat :: [String] -> String
const concat = xs =>
0 < xs.length ? (() => {
const unit = 'string' !== typeof xs[0] ? (
[]
) : '';
return unit.concat.apply(unit, xs);
})() : [];
// elems :: Dict -> [a]
// elems :: Set -> [a]
const elems = x =>
'Set' !== x.constructor.name ? (
Object.values(x)
) : Array.from(x.values());
// flip :: (a -> b -> c) -> b -> a -> c
const flip = f =>
1 < f.length ? (
(a, b) => f(b, a)
) : (x => y => f(y)(x));
// Note that that the Haskell signature of foldr differs from that of
// foldl - the positions of accumulator and current value are reversed
// foldr :: (a -> b -> b) -> b -> [a] -> b
const foldr = (f, a, xs) => xs.reduceRight(flip(f), a);
// intercalate :: [a] -> [[a]] -> [a]
// intercalate :: String -> [String] -> String
const intercalate = (sep, xs) =>
0 < xs.length && 'string' === typeof sep &&
'string' === typeof xs[0] ? (
xs.join(sep)
) : concat(intersperse(sep, xs));
// intersection :: Ord a => Set a -> Set a -> Set a
const intersection = (s, s1) =>
new Set([...s].filter(x => s1.has(x)));
// intersperse :: a -> [a] -> [a]
// intersperse :: Char -> String -> String
const intersperse = (sep, xs) => {
const bln = 'string' === typeof xs;
return xs.length > 1 ? (
(bln ? concat : x => x)(
(bln ? (
xs.split('')
) : xs)
.slice(1)
.reduce((a, x) => a.concat([sep, x]), [xs[0]])
)) : xs;
};
// map :: (a -> b) -> [a] -> [b]
const map = (f, xs) => xs.map(f);
// showSet :: Set -> String
const showSet = s =>
intercalate(elems(s), ['{', '}']);
// sort :: Ord a => [a] -> [a]
const sort = xs => xs.slice()
.sort((a, b) => a < b ? -1 : (a > b ? 1 : 0));
// tail :: [a] -> [a]
const tail = xs => 0 < xs.length ? xs.slice(1) : [];
// union :: Ord a => Set a -> Set a -> Set a
const union = (s, s1) =>
Array.from(s1.values())
.reduce(
(a, x) => (a.add(x), a),
new Set(s)
);
// MAIN ---
return main();
})();</syntaxhighlight>
{{Out}}
<pre>{c,d}, and {a,b}
{b,d,a}
{d,b,c,a}
{d,b,c,a}, and {f,g,h,i,k}</pre>
=={{header|jq}}==
Line 862 ⟶ 2,073:
Currently, jq does not have a "Set" library, so to save space here, we will use simple but inefficient implementations of set-oriented functions as they are fast for sets of moderate size. Nevertheless, we will represent sets as sorted arrays.
<
def union(A; B): (A + B) | unique;
Line 868 ⟶ 2,079:
# boolean
def intersect(A;B):
reduce A[] as $x (false; if . then . else (B|index($x)) end) | not | not;</
'''Consolidation''':
For clarity, the helper functions are presented as top-level functions, but they could be defined as inner functions of the main function, consolidate/0.
<
# Return [i,j] for a pair that can be combined, else null
def combinable:
Line 903 ⟶ 2,114:
end
end;
</syntaxhighlight>
'''Examples''':
<
[["A", "B"], ["C","D"]],
[["A","B"], ["B","D"]],
Line 915 ⟶ 2,126:
tests | to_set | consolidate;
test</
{{Out}}
<
[["A","B"],["C","D"]]
[["A","B","D"]]
[["A","B","C","D"]]
[["A","B","C","D"],["F","G","H","I","K"]]</
=={{header|
'''The consolidate Function'''
Here I assume that the data are contained in a list of sets. Perhaps a recursive solution would be more elegant, but in this case playing games with a stack works well enough.
<syntaxhighlight lang="julia">
function consolidate{T}(a::Array{Set{T},1})
1 < length(a) || return a
b = copy(a)
c = Set{T}[]
while 1 < length(b)
x = shift!(b)
cme = true
for (i, y) in enumerate(b)
!isempty(intersect(x, y)) || continue
cme = false
b[i] = union(x, y)
break
end
!cme || push!(c, x)
end
push!(c, b[1])
return c
end
</syntaxhighlight>
'''Main'''
<syntaxhighlight lang="julia">
p = Set(["A", "B"])
q = Set(["C", "D"])
r = Set(["B", "D"])
s = Set(["H", "I", "K"])
t = Set(["F", "G", "H"])
println("p = ", p)
println("q = ", q)
println("r = ", r)
println("s = ", s)
println("t = ", t)
println("consolidate([p, q]) =\n ", consolidate([p, q]))
println("consolidate([p, r]) =\n ", consolidate([p, r]))
println("consolidate([p, q, r]) =\n ", consolidate([p, q, r]))
println("consolidate([p, q, r, s, t]) =\n ",
consolidate([p, q, r, s, t]))
</syntaxhighlight>
{{out}}
<pre>
p = Set{ASCIIString}({"B","A"})
q = Set{ASCIIString}({"C","D"})
r = Set{ASCIIString}({"B","D"})
s = Set{ASCIIString}({"I","K","H"})
t = Set{ASCIIString}({"G","F","H"})
consolidate([p, q]) =
[Set{ASCIIString}({"B","A"}),Set{ASCIIString}({"C","D"})]
consolidate([p, r]) =
[Set{ASCIIString}({"B","A","D"})]
consolidate([p, q, r]) =
[Set{ASCIIString}({"B","A","C","D"})]
consolidate([p, q, r, s, t]) =
[Set{ASCIIString}({"B","A","C","D"}),Set{ASCIIString}({"I","G","K","H","F"})]
</pre>
=={{header|Kotlin}}==
<syntaxhighlight lang="scala">// version 1.0.6
fun<T : Comparable<T>> consolidateSets(sets: Array<Set<T>>): Set<Set<T>> {
val size = sets.size
val consolidated = BooleanArray(size) // all false by default
var i = 0
while (i < size - 1) {
if (!consolidated[i]) {
while (true) {
var intersects = 0
for (j in (i + 1) until size) {
if (consolidated[j]) continue
if (sets[i].intersect(sets[j]).isNotEmpty()) {
sets[i] = sets[i].union(sets[j])
consolidated[j] = true
intersects++
}
}
if (intersects == 0) break
}
}
i++
}
return (0 until size).filter { !consolidated[it] }.map { sets[it].toSortedSet() }.toSet()
}
fun main(args: Array<String>) {
val unconsolidatedSets = arrayOf(
arrayOf(setOf('A', 'B'), setOf('C', 'D')),
arrayOf(setOf('A', 'B'), setOf('B', 'D')),
arrayOf(setOf('A', 'B'), setOf('C', 'D'), setOf('D', 'B')),
arrayOf(setOf('H', 'I', 'K'), setOf('A', 'B'), setOf('C', 'D'), setOf('D', 'B'), setOf('F', 'G', 'H'))
)
for (sets in unconsolidatedSets) println(consolidateSets(sets))
}</syntaxhighlight>
{{out}}
<pre>
[[A, B], [C, D]]
[[A, B, D]]
[[A, B, C, D]]
[[F, G, H, I, K], [A, B, C, D]]
</pre>
=={{header|Lua}}==
<syntaxhighlight lang="lua">-- SUPPORT:
function T(t) return setmetatable(t, {__index=table}) end
function S(t) local s=T{} for k,v in ipairs(t) do s[v]=v end return s end
table.each = function(t,f,...) for _,v in pairs(t) do f(v,...) end end
table.copy = function(t) local s=T{} for k,v in pairs(t) do s[k]=v end return s end
table.keys = function(t) local s=T{} for k,_ in pairs(t) do s[#s+1]=k end return s end
table.intersects = function(t1,t2) for k,_ in pairs(t1) do if t2[k] then return true end end return false end
table.union = function(t1,t2) local s=t1:copy() for k,_ in pairs(t2) do s[k]=k end return s end
table.dump = function(t) print('{ '..table.concat(t, ', ')..' }') end
-- TASK:
table.consolidate = function(t)
for a = #t, 1, -1 do
local seta = t[a]
for b = #t, a+1, -1 do
local setb = t[b]
if setb and seta:intersects(setb) then
t[a], t[b] = seta:union(setb), nil
end
end
end
return t
end
-- TESTING:
examples = {
T{ S{"A","B"}, S{"C","D"} },
T{ S{"A","B"}, S{"B","D"} },
T{ S{"A","B"}, S{"C","D"}, S{"D","B"} },
T{ S{"H","I","K"}, S{"A","B"}, S{"C","D"}, S{"D","B"}, S{"F","G","H"} },
}
for i,example in ipairs(examples) do
print("Given input sets:")
example:each(function(set) set:keys():dump() end)
print("Consolidated output sets:")
example:consolidate():each(function(set) set:keys():dump() end)
print("")
end</syntaxhighlight>
{{out}}
<pre>Given input sets:
{ A, B }
{ C, D }
Consolidated output sets:
{ A, B }
{ C, D }
Given input sets:
{ A, B }
{ D, B }
Consolidated output sets:
{ A, D, B }
Given input sets:
{ A, B }
{ C, D }
{ B, D }
Consolidated output sets:
{ A, D, C, B }
Given input sets:
{ I, H, K }
{ A, B }
{ C, D }
{ B, D }
{ H, G, F }
Consolidated output sets:
{ I, H, K, G, F }
{ A, D, C, B }</pre>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">reduce[x_] :=
Block[{pairs, unique},
pairs =
Line 932 ⟶ 2,321:
unique = Complement[Range@Length@x, Flatten@pairs];
Join[Union[Flatten[x[[#]]]] & /@ pairs, x[[unique]]]]
consolidate[x__] := FixedPoint[reduce, {x}]</syntaxhighlight>
<pre>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}}</pre>
=={{header|Nim}}==
{{trans|Python}}
<syntaxhighlight lang="nim">proc consolidate(sets: varargs[set[char]]): seq[set[char]] =
if len(sets) < 2:
return @sets
var (r, b) = (@[sets[0]], consolidate(sets[1..^1]))
for x in b:
if len(r[0] * x) != 0:
r[0] = r[0] + x
else:
r.add(x)
r
echo consolidate({'A', 'B'}, {'C', 'D'})
echo consolidate({'A', 'B'}, {'B', 'D'})
echo consolidate({'A', 'B'}, {'C', 'D'}, {'D', 'B'})
echo consolidate({'H', 'I', 'K'}, {'A', 'B'}, {'C', 'D'}, {'D', 'B'}, {'F', 'G', 'H'})</syntaxhighlight>
{{out}}
<pre>
@[{'A', 'B'}, {'C', 'D'}]
@[{'A', 'B', 'D'}]
@[{'A', 'B', 'C', 'D'}]
@[{'F', 'G', 'H', 'I', 'K'}, {'A', 'B', 'C', 'D'}]
</pre>
=={{header|OCaml}}==
<
List.fold_left (fun acc v ->
if List.mem v acc then acc else v::acc
Line 987 ⟶ 2,398:
print_sets (consolidate [["H";"I";"K"]; ["A";"B"]; ["C";"D"]; ["D";"B"];
["F";"G";"H"]]);
;;</
{{out}}
Line 996 ⟶ 2,407:
=={{header|ooRexx}}==
<
* 04.08.2013 Walter Pachl using ooRexx features
* (maybe not in the best way -improvements welcome!)
Line 1,111 ⟶ 2,522:
End
End
Return strip(ol)</
{{out}}
<pre>
Line 1,143 ⟶ 2,554:
=={{header|PARI/GP}}==
<
my(v,u,s);
for(i=1,#V,
Line 1,154 ⟶ 2,565:
V=select(v->#v,V);
if(s,cons(V),V)
};</
=={{header|Perl
We implement the key data structure, a set of sets, as an array containing references to arrays of scalars.
<syntaxhighlight lang="perl">use strict;
use English;
use Smart::Comments;
my @ex1 = consolidate( (['A', 'B'], ['C', 'D']) );
### Example 1: @ex1
my @ex2 = consolidate( (['A', 'B'], ['B', 'D']) );
### Example 2: @ex2
my @ex3 = consolidate( (['A', 'B'], ['C', 'D'], ['D', 'B']) );
### Example 3: @ex3
my @ex4 = consolidate( (['H', 'I', 'K'], ['A', 'B'], ['C', 'D'], ['D', 'B'], ['F', 'G', 'H']) );
### Example 4: @ex4
exit 0;
sub consolidate {
scalar(@ARG) >= 2 or return @ARG;
my @result = ( shift(@ARG) );
my @recursion = consolidate(@ARG);
foreach my $r (@recursion) {
if (set_intersection($result[0], $r)) {
$result[0] = [ set_union($result[0], $r) ];
}
else {
push @result, $r;
}
}
return @result;
}
sub set_union {
my ($a, $b) = @ARG;
my %union;
foreach my $a_elt (@{$a}) { $union{$a_elt}++; }
foreach my $b_elt (@{$b}) { $union{$b_elt}++; }
return keys(%union);
}
sub set_intersection {
my ($a, $b) = @ARG;
my %a_hash;
foreach my $a_elt (@{$a}) { $a_hash{$a_elt}++; }
my @result;
foreach my $b_elt (@{$b}) {
push(@result, $b_elt) if exists($a_hash{$b_elt});
}
return @result;
}</syntaxhighlight>
{{out}}
<pre>
###
### 'A',
###
### ],
###
### 'C',
###
### ]
### ]
### Example 2: [
### [
### 'D',
### 'B',
### 'A'
### ]
### ]
### Example 3: [
### [
### 'A',
### 'C',
### 'D',
### 'B'
### ]
### ]
### Example 4: [
### [
### 'H',
### 'F',
### 'K',
### 'G',
### 'I'
### ],
### [
### 'D',
### 'B',
### 'A',
### 'C'
### ]
### ]</pre>
=={{header|Phix}}==
Using strings to represent sets of characters
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">has_intersection</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">set1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">set2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set1</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set1</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">set2</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">true</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">false</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">get_union</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">set1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">set2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set2</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set2</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">set1</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">set1</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">set2</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">set1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">consolidate</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">sets</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sets</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">to</span> <span style="color: #000000;">1</span> <span style="color: #008080;">by</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sets</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">to</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span> <span style="color: #008080;">by</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">has_intersection</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sets</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">sets</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">])</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">sets</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">get_union</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sets</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">sets</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">sets</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">..</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">sets</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">consolidate</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"AB"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"CD"</span><span style="color: #0000FF;">})</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">consolidate</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"AB"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"BD"</span><span style="color: #0000FF;">})</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">consolidate</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"AB"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"CD"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"DB"</span><span style="color: #0000FF;">})</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">consolidate</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"HIK"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"AB"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"CD"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"DB"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"FGH"</span><span style="color: #0000FF;">})</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
{"AB","CD"}
{"ABD"}
{"ABCD"}
{"HIKFG","ABCD"}
</pre>
=={{header|PicoLisp}}==
{{trans|Python}}
<
(when S
(let R (cons (car S))
Line 1,193 ⟶ 2,717:
(set R (uniq (conc X (car R))))
(conc R (cons X)) ) )
R ) ) )</
Test:
<
-> ((A B) (C D))
: (consolidate '((A B) (B D)))
Line 1,202 ⟶ 2,726:
-> ((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))</
=={{header|PL/I}}==
<
declare set(20) character (200) varying;
declare e character (1);
Line 1,262 ⟶ 2,786:
end print;
end Set;</
<pre>
The original sets: {A,B}
Line 1,280 ⟶ 2,804:
Results: {A,B,E,F,G,H} {C,D}
</pre>
=={{header|PL/M}}==
<syntaxhighlight lang="plm">100H:
BDOS: PROCEDURE (F,A); DECLARE F BYTE, A ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; GO TO 0; END EXIT;
PUTC: PROCEDURE (C); DECLARE C BYTE; CALL BDOS(2, C); END PUTC;
PUTS: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9, S); END PUTS;
BIT: PROCEDURE (I) ADDRESS;
DECLARE I BYTE;
IF I=0 THEN RETURN 1;
RETURN SHL(DOUBLE(1), I);
END BIT;
PRINT$SET: PROCEDURE (SET);
DECLARE SET ADDRESS, I BYTE;
CALL PUTC('(');
DO I=0 TO 15;
IF (BIT(I) AND SET) <> 0 THEN CALL PUTC('A' + I);
END;
CALL PUTC(')');
END PRINT$SET;
MAKE$SET: PROCEDURE (SETSTR) ADDRESS;
DECLARE SETSTR ADDRESS, ITEM BASED SETSTR BYTE;
DECLARE SET ADDRESS, POS ADDRESS;
SET = 0;
DO WHILE ITEM <> '$';
POS = ITEM - 'A';
IF POS < 16 THEN SET = SET OR BIT(POS);
SETSTR = SETSTR + 1;
END;
RETURN SET;
END MAKE$SET;
CONSOLIDATE: PROCEDURE (SETS, N) BYTE;
DECLARE (SETS, S BASED SETS) ADDRESS;
DECLARE (N, I, J, CHANGE) BYTE;
STEP:
CHANGE = 0;
DO I=0 TO N-1;
DO J=I+1 TO N-1;
IF (S(I) AND S(J)) <> 0 THEN DO;
S(I) = S(I) OR S(J);
S(J) = 0;
CHANGE = 1;
END;
END;
END;
IF CHANGE THEN GO TO STEP;
DO I=0 TO N-1;
IF S(I)=0 THEN
DO J=I+1 TO N-1;
S(J-1) = S(J);
END;
END;
DO I=0 TO N-1;
IF S(I)=0 THEN RETURN I;
END;
RETURN N;
END CONSOLIDATE;
TEST: PROCEDURE (SETS, N);
DECLARE (SETS, S BASED SETS) ADDRESS;
DECLARE (N, I) BYTE;
DO I=0 TO N-1;
CALL PRINT$SET(S(I));
END;
CALL PUTS(.' -> $');
N = CONSOLIDATE(SETS, N);
DO I=0 TO N-1;
CALL PRINT$SET(S(I));
END;
CALL PUTS(.(13,10,'$'));
END TEST;
DECLARE S (5) ADDRESS;
S(0) = MAKE$SET(.'AB$'); S(1) = MAKE$SET(.'CD$');
CALL TEST(.S, 2);
S(0) = MAKE$SET(.'AB$'); S(1) = MAKE$SET(.'BD$');
CALL TEST(.S, 2);
S(0) = MAKE$SET(.'AB$'); S(1) = MAKE$SET(.'CD$');
S(2) = MAKE$SET(.'DB$');
CALL TEST(.S, 3);
S(0) = MAKE$SET(.'HIK$'); S(1) = MAKE$SET(.'AB$');
S(2) = MAKE$SET(.'CD$'); S(3) = MAKE$SET(.'DB$');
S(4) = MAKE$SET(.'FGH$');
CALL TEST(.S, 5);
CALL EXIT;
EOF</syntaxhighlight>
{{out}}
<pre>(AB)(CD) -> (AB)(CD)
(AB)(BD) -> (ABD)
(AB)(CD)(BD) -> (ABCD)
(HIK)(AB)(CD)(BD)(FGH) -> (FGHIK)(ABCD)</pre>
=={{header|Python}}==
===Python: Iterative===
<
setlist = [s for s in sets if s]
for i, s1 in enumerate(setlist):
Line 1,293 ⟶ 2,916:
s1.clear()
s1 = s2
return [s for s in setlist if s]</
===Python: Recursive===
<
if len(s) < 2: return s
Line 1,303 ⟶ 2,926:
if r[0].intersection(x): r[0].update(x)
else: r.append(x)
return r</
===Python: Testing===
The <code>_test</code> 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.
<
def freze(list_of_sets):
Line 1,340 ⟶ 2,963:
if __name__ == '__main__':
_test(consolidate)
_test(conso)</
{{out}}
<pre>_test(consolidate) complete
_test(conso) complete</pre>
===Python: Functional===
As a fold (catamorphism), using '''union''' in preference to mutation:
{{Trans|Haskell}}
{{Trans|JavaScript}}
{{Works with|Python|3.7}}
<syntaxhighlight lang="python">'''Set consolidation'''
from functools import (reduce)
# consolidated :: Ord a => [Set a] -> [Set a]
def consolidated(sets):
'''A consolidated list of sets.'''
def go(xs, s):
if xs:
h = xs[0]
return go(xs[1:], h.union(s)) if (
h.intersection(s)
) else [h] + go(xs[1:], s)
else:
return [s]
return reduce(go, sets, [])
# TESTS ---------------------------------------------------
# main :: IO ()
def main():
'''Illustrative consolidations.'''
print(
tabulated('Consolidation of sets of characters:')(
lambda x: str(list(map(compose(concat)(list), x)))
)(str)(
consolidated
)(list(map(lambda xs: list(map(set, xs)), [
['ab', 'cd'],
['ab', 'bd'],
['ab', 'cd', 'db'],
['hik', 'ab', 'cd', 'db', 'fgh']
])))
)
# DISPLAY OF RESULTS --------------------------------------
# compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
def compose(g):
'''Right to left function composition.'''
return lambda f: lambda x: g(f(x))
# concat :: [String] -> String
def concat(xs):
'''Concatenation of strings in xs.'''
return ''.join(xs)
# tabulated :: String -> (a -> String) ->
# (b -> String) ->
# (a -> b) -> [a] -> String
def tabulated(s):
'''Heading -> x display function -> fx display function ->
f -> value list -> tabular string.'''
def go(xShow, fxShow, f, xs):
w = max(map(compose(len)(xShow), xs))
return s + '\n' + '\n'.join([
xShow(x).rjust(w, ' ') + ' -> ' + fxShow(f(x)) for x in xs
])
return lambda xShow: lambda fxShow: (
lambda f: lambda xs: go(
xShow, fxShow, f, xs
)
)
# MAIN ---
if __name__ == '__main__':
main()</syntaxhighlight>
{{Out}}
<pre>Consolidation of sets of characters:
['ba', 'cd'] -> [{'b', 'a'}, {'c', 'd'}]
['ba', 'bd'] -> [{'b', 'd', 'a'}]
['ba', 'cd', 'db'] -> [{'d', 'a', 'c', 'b'}]
['ikh', 'ba', 'cd', 'db', 'gfh'] -> [{'d', 'a', 'c', 'b'}, {'i', 'k', 'g', 'h', 'f'}]</pre>
=={{header|Quackery}}==
<syntaxhighlight lang="Quackery"> [ 0 swap witheach [ bit | ] ] is ->set ( $ --> { )
[ say "{" 0 swap
[ dup 0 != while
dup 1 & if [ over emit ]
1 >> dip 1+ again ]
2drop say "} " ] is echoset ( { --> )
[ [] swap dup size 1 - times
[ behead over witheach
[ 2dup & iff
[ | swap i^ poke
[] conclude ]
else drop ]
swap dip join ]
join ] is consolidate ( [ --> [ )
[ dup witheach echoset
say "--> "
consolidate witheach echoset
cr ] is task ( [ --> )
$ "AB" ->set
$ "CD" ->set join
task
$ "AB" ->set
$ "BD" ->set join
task
$ "AB" ->set
$ "CD" ->set join
$ "DB" ->set join
task
$ "HIK" ->set
$ "AB" ->set join
$ "CD" ->set join
$ "DB" ->set join
$ "FGH" ->set join
task</syntaxhighlight>
{{out}}
<pre>{AB} {CD} --> {AB} {CD}
{AB} {BD} --> {ABD}
{AB} {CD} {BD} --> {ABCD}
{HIK} {AB} {CD} {BD} {FGH} --> {ABCD} {FGHIK}
</pre>
=={{header|Racket}}==
<
#lang racket
(define (consolidate ss)
Line 1,362 ⟶ 3,121:
(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)))
</syntaxhighlight>
{{out}}
<
(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))
</syntaxhighlight>
=={{header|Raku}}==
(formerly Perl 6)
<syntaxhighlight lang="raku" line>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)];</syntaxhighlight>
{{out}}
<pre>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)</pre>
=={{header|Refal}}==
<syntaxhighlight lang="refal">$ENTRY Go {
= <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)>;
};
Test {
e.S = <Prout e.S ' -> ' <Consolidate e.S>>;
};
Consolidate {
e.SS, <Consolidate1 () e.SS>: {
e.SS = e.SS;
e.SS2 = <Consolidate e.SS2>;
};
};
Consolidate1 {
(e.CSS) = e.CSS;
(e.CSS) (e.S) e.SS,
<Consolidate2 (e.CSS) (e.S)>: e.CSS2 =
<Consolidate1 (e.CSS2) e.SS>;
};
Consolidate2 {
() (e.S) = (e.S);
((e.S1) e.SS) (e.S), <Overlap (e.S1) (e.S)>: {
True = (<Set e.S1 e.S>) e.SS;
False = (e.S1) <Consolidate2 (e.SS) (e.S)>;
};
};
Overlap {
(e.S1) () = False;
(e.S1) (s.I e.S2), e.S1: {
e.L s.I e.R = True;
e.S1 = <Overlap (e.S1) (e.S2)>;
};
};
Set {
= ;
s.I e.S, e.S: {
e.L s.I e.R = <Set e.S>;
e.S = s.I <Set e.S>;
};
};</syntaxhighlight>
{{out}}
<pre>(A B )(C D ) -> (A B )(C D )
(A B )(B D ) -> (A B D )
(A B )(C D )(D B ) -> (A B C D )
(H I K )(A B )(C D )(D B )(F G H ) -> (I K F G H )(A B C D )</pre>
=={{header|REXX}}==
<
do j=1 while
call
end /*j*/
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isIn: return wordpos(arg(1), arg(2))\==0 /*is (word) argument 1 in the set arg2?*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
SETconsolidate: procedure; parse arg old; #= words(old); new=
say ' the old set=' space(old)
do k=1 for
end /*k*/ /* [↑] ··· and also remove the braces.*/
do until \changed; changed= 0 /*consolidate some sets (well, maybe).*/
do set=1 for
do item=1 for words(
do other=set+1 to
if isIn(x,
iterate set
end
end /*other*/
end /*item */
end /*set */
end /*until ¬changed*/
do set=1 for
do items=1 for words(
if x==',' then iterate; if x=='' then leave
do until \isIn(x,
_= wordpos(x,
end /*items*/
end /*set*/
do
new= space(new '{'!.i"}") /*prepend and append a set identifier. */
end /*
say ' the new
return</syntaxhighlight>
{{out|output|text= when using the (internal) default supplied sample sets:}}
<pre>
the old
the new
the old
the new
the old
the new
the old
the new
the old
the new
</pre>
=={{header|Ring}}==
<syntaxhighlight lang="ring">
# Project : Set consolidation
load "stdlib.ring"
test = ["AB","AB,CD","AB,CD,DB","HIK,AB,CD,DB,FGH"]
for t in test
see consolidate(t) + nl
next
func consolidate(s)
sets = split(s,",")
n = len(sets)
for i = 1 to n
p = i
ts = ""
for j = i to 1 step -1
if ts = ""
p = j
ok
ts = ""
for k = 1 to len(sets[p])
if j > 1
if substring(sets[j-1],substr(sets[p],k,1),1) = 0
ts = ts + substr(sets[p],k,1)
ok
ok
next
if len(ts) < len(sets[p])
if j > 1
sets[j-1] = sets[j-1] + ts
sets[p] = "-"
ts = ""
ok
else
p = i
ok
next
next
consolidate = s + " = " + substr(list2str(sets),nl,",")
return consolidate
</syntaxhighlight>
Output:
<pre>
AB = AB
AB,CD = AB,CD
AB,CD,DB = ABCD,-,-
HIK,AB,CD,DB,FGH = HIKFG,ABCD,-,-,-
</pre>
=={{header|Ruby}}==
<
tests = [[[:A,:B], [:C,:D]],
Line 1,457 ⟶ 3,347:
end
p sets
end</
{{out}}
<pre>
Line 1,468 ⟶ 3,358:
=={{header|Scala}}==
<
def consolidate[Type](sets: Set[Set[Type]]): Set[Set[Type]] = {
var result = sets // each iteration combines two sets and reiterates, else returns
Line 1,494 ⟶ 3,384:
})
}</
{{out}}
<pre>{A,B} {C,D} -> {A,B} {C,D}
Line 1,500 ⟶ 3,390:
{A,B} {C,D} {D,B} -> {C,D,A,B}
{D,B} {F,G,H} {A,B} {C,D} {H,I,K} -> {F,I,G,H,K} {A,B,C,D}</pre>
=={{header|SETL}}==
<syntaxhighlight lang="setl">program set_consolidation;
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'}}
];
loop for t in tests do
print(consolidate(t));
end loop;
proc consolidate(sets);
outp := {};
loop while sets /= {} do
set_ from sets;
loop until overlap = {} do
overlap := {s : s in sets | exists el in s | el in set_};
set_ +:= {} +/ overlap;
sets -:= overlap;
end loop;
outp with:= set_;
end loop;
return outp;
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>{{A B} {C D}}
{{A B D}}
{{A B C D}}
{{A B C D} {F G H I K}}</pre>
=={{header|Sidef}}==
{{trans|Raku}}
<syntaxhighlight lang="ruby">func consolidate() { [] }
func consolidate(this, *those) {
gather {
consolidate(those...).each { |that|
if (this & that) { this |= that }
else { take that }
}
take this;
}
}
enum |A="A", B, C, D, _E, F, G, H, I, _J, K|;
func format(ss) {
ss.map{ '(' + .join(' ') + ')' }.join(' ')
}
[
[[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]]
].each { |ss|
say (format(ss), "\n\t==> ", format(consolidate(ss...)));
}</syntaxhighlight>
{{out}}
<pre>
(A B) (C D)
==> (C D) (A B)
(A B) (B D)
==> (A D B)
(A B) (C D) (D B)
==> (A C D B)
(H I K) (A B) (C D) (D B) (F G H)
==> (A C D B) (I K F G H)
</pre>
=={{header|SQL}}==
{{works with|ORACLE 19c}}
This is not a particularly efficient solution, but it gets the job done.
<syntaxhighlight lang="sql">
/*
This code is an implementation of "Set consolidation" in SQL ORACLE 19c
p_list_of_sets -- input string
delimeter by default "|"
*/
with
function set_consolidation(p_list_of_sets in varchar2)
return varchar2 is
--
v_list_of_sets varchar2(32767) := p_list_of_sets;
v_output varchar2(32767) ;
v_set_1 varchar2(2000) ;
v_set_2 varchar2(2000) ;
v_pos_set_1 pls_integer;
v_pos_set_2 pls_integer;
--
function remove_duplicates(p_set varchar2)
return varchar2 is
v_set varchar2(1000) := p_set;
begin
for i in 1..length(v_set)
loop
v_set := regexp_replace(v_set, substr(v_set, i, 1), '', i+1, 0) ;
end loop;
return v_set;
end;
--
begin
--cleaning
v_list_of_sets := ltrim(v_list_of_sets, '{') ;
v_list_of_sets := rtrim(v_list_of_sets, '}') ;
v_list_of_sets := replace(v_list_of_sets, ' ', '') ;
v_list_of_sets := replace(v_list_of_sets, ',', '') ;
--set delimeter "|"
v_list_of_sets := replace(v_list_of_sets, '}{', '|') ;
--
<<loop_through_sets>>
while regexp_count(v_list_of_sets, '[^|]+') > 0
loop
v_set_1 := regexp_substr(v_list_of_sets, '[^|]+', 1, 1) ;
v_pos_set_1 := regexp_instr(v_list_of_sets, '[^|]+', 1, 1) ;
--
<<loop_for>>
for i in 1..regexp_count(v_list_of_sets, '[^|]+')-1
loop
--
v_set_2 := regexp_substr(v_list_of_sets, '[^|]+', 1, i+1) ;
v_pos_set_2 := regexp_instr(v_list_of_sets, '[^|]+', 1, i+1) ;
--
if regexp_count(v_set_2, '['||v_set_1||']') > 0 then
v_list_of_sets := regexp_replace(v_list_of_sets, v_set_1, remove_duplicates(v_set_1||v_set_2), v_pos_set_1, 1) ;
v_list_of_sets := regexp_replace(v_list_of_sets, v_set_2, '', v_pos_set_2, 1) ;
continue loop_through_sets;
end if;
--
end loop loop_for;
--
v_output := v_output||'{'||rtrim(regexp_replace(v_set_1, '([A-Z])', '\1,'), ',') ||'}';
v_list_of_sets := regexp_replace(v_list_of_sets, v_set_1, '', 1, 1) ;
--
end loop loop_through_sets;
--
return replace(nvl(v_output,'{}'),'}{','},{') ;
end;
--Test
select lpad('{}',50) || ' ==> ' || set_consolidation('{}') as output from dual
union all
select lpad('{},{}',50) || ' ==> ' || set_consolidation('{},{}') as output from dual
union all
select lpad('{},{B}',50) || ' ==> ' || set_consolidation('{},{B}') as output from dual
union all
select lpad('{D}',50) || ' ==> ' || set_consolidation('{D}') as output from dual
union all
select lpad('{F},{A},{A}',50) || ' ==> ' || set_consolidation('{F},{A},{A}') as output from dual
union all
select lpad('{A,B},{B}',50) || ' ==> ' || set_consolidation('{A,B},{B}') as output from dual
union all
select lpad('{A,D},{D,A}',50) || ' ==> ' || set_consolidation('{A,D},{D,A}') as output from dual
union all
--Test RosettaCode
select '-- Test RosettaCode' as output from dual
union all
select lpad('{A,B},{C,D}',50) || ' ==> ' || set_consolidation('{A,B},{C,D}') as output from dual
union all
select lpad('{A,B},{B,D}',50) || ' ==> ' || set_consolidation('{A,B},{B,D}') as output from dual
union all
select lpad('{A,B},{C,D},{D,B}',50) || ' ==> ' || set_consolidation('{A,B},{C,D},{D,B}') as output from dual
union all
select lpad('{H, I, K}, {A,B}, {C,D}, {D,B}, {F,G,H}',50) || ' ==> ' || set_consolidation('{H, I, K}, {A,B}, {C,D}, {D,B}, {F,G,H}') as output from dual
union all
select lpad('HIK|AB|CD|DB|FGH',50) || ' ==> ' || set_consolidation('HIK|AB|CD|DB|FGH') as output from dual
;
/
</syntaxhighlight>
{{out}}
<pre>
{} ==> {}
{},{} ==> {}
{},{B} ==> {B}
{D} ==> {D}
{F},{A},{A} ==> {F},{A}
{A,B},{B} ==> {A,B}
{A,D},{D,A} ==> {A,D}
-- Test RosettaCode
{A,B},{C,D} ==> {A,B},{C,D}
{A,B},{B,D} ==> {A,B,D}
{A,B},{C,D},{D,B} ==> {A,B,D,C}
{H, I, K}, {A,B}, {C,D}, {D,B}, {F,G,H} ==> {H,I,K,F,G},{A,B,D,C}
HIK|AB|CD|DB|FGH ==> {H,I,K,F,G},{A,B,D,C}
</pre>
=={{header|Tcl}}==
Line 1,505 ⟶ 3,585:
{{tcllib|struct::set}}
This uses just the recursive version, as this is sufficient to handle substantial merges.
<
proc consolidate {sets} {
Line 1,522 ⟶ 3,602:
}
return [lset r 0 $r0]
}</
Demonstrating:
<
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}}]</
{{out}}
<pre>1:{A B} {C D}
Line 1,538 ⟶ 3,618:
Original solution:
<syntaxhighlight lang="txrlisp">(defun mkset (p x) (set [p x] (or [p x] x)))
{{out}}
<pre>((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)) -> (
{{trans|Racket}}
<syntaxhighlight lang="txrlisp">(defun mkset (items) [group-by identity items])
{{out}}
<pre>((a b) (c d)) -> ((b a) (d c))
((a b) (b d)) -> ((d b a
((a b) (c d) (d b)) -> ((
((h i k) (a b) (c d) (d b) (f g h)) -> ((g f k i h) (
=={{header|VBA}}==
{{trans|Phix}}
This solutions uses collections as sets. The first three coroutines are based on the Phix solution. Two coroutines are written to create the example sets as collections, and another coroutine to show the consolidated set.
<syntaxhighlight lang="vb">Private Function has_intersection(set1 As Collection, set2 As Collection) As Boolean
For Each element In set1
On Error Resume Next
tmp = set2(element)
If tmp = element Then
has_intersection = True
Exit Function
End If
Next element
End Function
Private Sub union(set1 As Collection, set2 As Collection)
For Each element In set2
On Error Resume Next
tmp = set1(element)
If tmp <> element Then
set1.Add element, element
End If
Next element
End Sub
Private Function consolidate(sets As Collection) As Collection
For i = sets.Count To 1 Step -1
For j = sets.Count To i + 1 Step -1
If has_intersection(sets(i), sets(j)) Then
union sets(i), sets(j)
sets.Remove j
End If
Next j
Next i
Set consolidate = sets
End Function
Private Function mc(s As Variant) As Collection
Dim res As New Collection
For i = 1 To Len(s)
res.Add Mid(s, i, 1), Mid(s, i, 1)
Next i
Set mc = res
End Function
Private Function ms(t As Variant) As Collection
Dim res As New Collection
Dim element As Collection
For i = LBound(t) To UBound(t)
Set element = t(i)
res.Add t(i)
Next i
Set ms = res
End Function
Private Sub show(x As Collection)
Dim t() As String
Dim u() As String
ReDim t(1 To x.Count)
For i = 1 To x.Count
ReDim u(1 To x(i).Count)
For j = 1 To x(i).Count
u(j) = x(i)(j)
Next j
t(i) = "{" & Join(u, ", ") & "}"
Next i
Debug.Print "{" & Join(t, ", ") & "}"
End Sub
Public Sub main()
show consolidate(ms(Array(mc("AB"), mc("CD"))))
show consolidate(ms(Array(mc("AB"), mc("BD"))))
show consolidate(ms(Array(mc("AB"), mc("CD"), mc("DB"))))
show consolidate(ms(Array(mc("HIK"), mc("AB"), mc("CD"), mc("DB"), mc("FGH"))))
End Sub</syntaxhighlight>{{out}}
<pre>{{A, B}, {C, D}}
{{A, B, D}}
{{A, B, C, D}}
{{H, I, K, F, G}, {A, B, C, D}}</pre>
=={{header|VBScript}}==
<syntaxhighlight lang="vb">
Function consolidate(s)
sets = Split(s,",")
n = UBound(sets)
For i = 1 To n
p = i
ts = ""
For j = i To 1 Step -1
If ts = "" Then
p = j
End If
ts = ""
For k = 1 To Len(sets(p))
If InStr(1,sets(j-1),Mid(sets(p),k,1)) = 0 Then
ts = ts & Mid(sets(p),k,1)
End If
Next
If Len(ts) < Len(sets(p)) Then
sets(j-1) = sets(j-1) & ts
sets(p) = "-"
ts = ""
Else
p = i
End If
Next
Next
consolidate = s & " = " & Join(sets," , ")
End Function
'testing
test = Array("AB","AB,CD","AB,CD,DB","HIK,AB,CD,DB,FGH")
For Each t In test
WScript.StdOut.WriteLine consolidate(t)
Next
</syntaxhighlight>
{{Out}}
<pre>
AB = AB
AB,CD = AB , CD
AB,CD,DB = ABCD , - , -
HIK,AB,CD,DB,FGH = HIKFG , ABCD , - , - , -
</pre>
=={{header|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-set}}
Note that (as implemented in the above module) it is not possible to have a 'Set of Sets' because Set elements can only be certain primitives which can act as Map keys. However, you can have a List of Sets and so that's what we use here.
As Sets are Map-based, iteration (and hence printing) order are undefined.
<syntaxhighlight lang="wren">import "./set" for Set
var consolidateSets = Fn.new { |sets|
var size = sets.count
var consolidated = List.filled(size, false)
var i = 0
while (i < size - 1) {
if (!consolidated[i]) {
while (true) {
var intersects = 0
for (j in i+1...size) {
if (!consolidated[j]) {
if (!sets[i].intersect(sets[j]).isEmpty) {
sets[i].addAll(sets[j])
consolidated[j] = true
intersects = intersects + 1
}
}
}
if (intersects == 0) break
}
}
i = i + 1
}
return (0...size).where { |i| !consolidated[i] }.map { |i| sets[i] }.toList
}
var unconsolidatedSets = [
[Set.new(["A", "B"]), Set.new(["C", "D"])],
[Set.new(["A", "B"]), Set.new(["B", "D"])],
[Set.new(["A", "B"]), Set.new(["C", "D"]), Set.new(["D", "B"])],
[Set.new(["H", "I", "K"]), Set.new(["A", "B"]), Set.new(["C", "D"]),
Set.new(["D", "B"]), Set.new(["F", "G", "H"])]
]
for (sets in unconsolidatedSets) {
System.print("Unconsolidated: %(sets)")
System.print("Cosolidated : %(consolidateSets.call(sets))\n")
}</syntaxhighlight>
{{out}}
<pre>
Unconsolidated: [<B, A>, <C, D>]
Cosolidated : [<B, A>, <C, D>]
Unconsolidated: [<B, A>, <D, B>]
Cosolidated : [<D, B, A>]
Unconsolidated: [<B, A>, <C, D>, <D, B>]
Cosolidated : [<C, D, B, A>]
Unconsolidated: [<I, H, K>, <B, A>, <C, D>, <D, B>, <G, H, F>]
Cosolidated : [<I, G, H, F, K>, <C, D, B, A>]
</pre>
=={{header|zkl}}==
{{trans|Tcl}}
<syntaxhighlight lang="zkl">fcn consolidate(sets){ // set are munged if they are read/write
if(sets.len()<2) return(sets);
r,r0 := List(List()),sets[0];
foreach x in (consolidate(sets[1,*])){
i,ni:=x.filter22(r0.holds); //-->(intersection, !intersection)
if(i) r0=r0.extend(ni);
else r.append(x);
}
r[0]=r0;
r
}</syntaxhighlight>
<syntaxhighlight lang="zkl">fcn prettize(sets){
sets.apply("concat"," ").pump(String,"(%s),".fmt)[0,-1]
}
foreach sets in (T(
T(L("A","B")),
T(L("A","B"),L("C","D")),
T(L("A","B"),L("B","D")),
T(L("A","B"),L("C","D"),L("D","B")),
T(L("H","I","K"),L("A","B"),L("C","D"),L("D","B"),L("F","G","H")),
T(L("A","H"),L("H","I","K"),L("A","B"),L("C","D"),L("D","B"),L("F","G","H")),
T(L("H","I","K"),L("A","B"),L("C","D"),L("D","B"),L("F","G","H"), L("A","H")),
)){
prettize(sets).print(" --> ");
consolidate(sets) : prettize(_).println();
}</syntaxhighlight>
{{out}}
<pre>
(A B) --> (A B)
(A B),(C D) --> (A B),(C D)
(A B),(B D) --> (A B D)
(A B),(C D),(D B) --> (A B C D)
(H I K),(A B),(C D),(D B),(F G H) --> (H I K F G),(A B C D)
(A H),(H I K),(A B),(C D),(D B),(F G H) --> (A H I K F G B C D)
(H I K),(A B),(C D),(D B),(F G H),(A H) --> (H I K A B C D F G)
</pre>
|