View source for Set consolidation

{{task}}
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.

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

;'''Example 1:'''
:Given the two sets <tt>{A,B}</tt> and <tt>{C,D}</tt> then there is no common element between the sets and the result is the same as the input.
;'''Example 2:'''
: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:
::<tt>{H,I,K}</tt>, <tt>{A,B}</tt>, <tt>{C,D}</tt>, <tt>{D,B}</tt>, and <tt>{F,G,H}</tt>
: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, etc.:

<syntaxhighlight 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;</syntaxhighlight>

Here is the implementation of Set_Cons:

<syntaxhighlight 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;</syntaxhighlight>

Given that package, the task is easy:

<syntaxhighlight 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;</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|Aime}}==
<syntaxhighlight lang="aime">display(list l)
{
    for (integer i, record r in l) {
        text u, v;

        o_text(i ? ", {" : "{");
        for (u in r) {
            o_(v, u);
            v = ", ";
        }
        o_text("}");
    }

    o_text("\n");
}

intersect(record r, record u)
{
    trap_q(r_vcall, r, r_put, 1, record().copy(u), 0);
}

consolidate(list l)
{
    for (integer i, record r in l) {
        integer j;

        j = i - ~l;
        while (j += 1) {
            if (intersect(r, l[j])) {
                r.wcall(r_add, 1, 2, l[j]);
                l.delete(i);
                i -= 1;
                break;
            }
        }
    }

    l;
}

R(...)
{
    ucall.2(r_put, 1, record(), 0);
}

main(void)
{
    display(consolidate(list(R("A", "B"), R("C", "D"))));
    display(consolidate(list(R("A", "B"), R("B", "D"))));
    display(consolidate(list(R("A", "B"), R("C", "D"), R("D", "B"))));
    display(consolidate(list(R("H", "I", "K"), R("A", "B"), R("C", "D"),
                             R("D", "B"), R("F", "G", "K"))));

    0;
}</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|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}}==
<syntaxhighlight 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)
);</syntaxhighlight>
{{out}}
<pre>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</pre>

=={{header|C}}==
<syntaxhighlight 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;
}</syntaxhighlight>

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:
<syntaxhighlight 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;
}</syntaxhighlight>

=={{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&lt;T&gt; 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}}
<syntaxhighlight lang="lisp">(defun consolidate (ss)
  (labels ((comb (cs s)
             (cond ((null s) cs)
                   ((null cs) (list s))
                   ((null (intersection s (first cs)))
                    (cons (first cs) (comb (rest cs) s)))
                   ((consolidate (cons (union s (first cs)) (rest cs)))))))
    (reduce #'comb ss :initial-value nil)))</syntaxhighlight>

{{Out}}
<pre>> (consolidate '((a b) (c d)))
((A B) (C D))
> (consolidate '((a b) (b c)))
((C A B))
> (consolidate '((a b) (c d) (d b)))
((C D A B))
> (consolidate '((h i k) (a b) (c d) (d b) (f g h)))
((F G H I K) (C D A B))</pre>

=={{header|D}}==
{{trans|Go}}
<syntaxhighlight lang="d">import std.stdio, std.algorithm, std.array;

dchar[][] consolidate(dchar[][] sets) @safe {
    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() @safe {
    [['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;
}</syntaxhighlight>
{{out}}
<pre>["AB", "CD"]
["ABD"]
["ABCD"]
["ABCD", "FGHIK"]</pre>

'''Recursive version''', as described on talk page. 
<syntaxhighlight lang="d">import std.stdio, std.algorithm, std.array;

dchar[][] consolidate(dchar[][] sets) @safe {
    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() @safe {
    [['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;
}</syntaxhighlight>
<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}}==

<syntaxhighlight 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'}}))
</syntaxhighlight>
{{out}}
<syntaxhighlight lang="egison">
{"DBAC" "HIKFG"}
</syntaxhighlight>

=={{header|Ela}}==
This solution emulate sets using linked lists:
<syntaxhighlight 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</syntaxhighlight>
Usage:
<syntaxhighlight lang="ela">open monad io

:::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#}}==
<syntaxhighlight 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</syntaxhighlight>
{{out}}
<pre>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"]]</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}}
<syntaxhighlight 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
}</syntaxhighlight>
{{out}}
<pre>
[map[A:true C:true B:true D:true] map[G:true F:true I:true H:true K:true]]
</pre>

=={{header|Haskell}}==

<syntaxhighlight lang="haskell">import Data.List (intersperse, intercalate)
import qualified Data.Set as S

consolidate
  :: Ord a
  => [S.Set a] -> [S.Set a]
consolidate = foldr comb []
  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}}==

<syntaxhighlight lang="j">consolidate=:4 :0/
  b=. y 1&e.@e.&> x
  (1,-.b)#(~.;x,b#y);y
)</syntaxhighlight>

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:

<syntaxhighlight lang="j">   consolidate 'ab';'cd'
┌──┬──┐
│ab│cd│
└──┴──┘
   consolidate 'ab';'bd'
┌───┐
│abd│
└───┘
   consolidate 'ab';'cd';'db'
┌────┐
│abcd│
└────┘
   consolidate 'hij';'ab';'cd';'db';'fgh'
┌─────┬────┐
│hijfg│abcd│
└─────┴────┘</syntaxhighlight>

=={{header|Java}}==
{{trans|D}}
{{works with|Java|7}}
<syntaxhighlight 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;
    }
}</syntaxhighlight>
<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}}==
'''Infrastructure''':

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.
<syntaxhighlight lang="jq">def to_set: unique;

def union(A; B): (A + B) | unique;

# boolean
def intersect(A;B):
  reduce A[] as $x (false; if . then . else (B|index($x)) end) | not | not;</syntaxhighlight>
'''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.

<syntaxhighlight lang="jq"># Input: [i, j, sets] with i < j
# Return [i,j] for a pair that can be combined, else null
def combinable:
   .[0] as $i | .[1] as $j | .[2] as $sets
   | ($sets|length) as $length
   | if intersect($sets[$i]; $sets[$j]) then [$i, $j]
     elif $i < $j - 1      then (.[0] += 1 | combinable)
     elif $j < $length - 1 then [0, $j+1, $sets] | combinable
     else null
     end;

# Given an array of arrays, remove the i-th and j-th elements,
# and add their union:
def update(i;j): 
  if i > j then update(j;i)
  elif i == j then del(.[i])
  else 
    union(.[i]; .[j]) as $c
    | union(del(.[j]) | del(.[i]); [$c])
  end;

# Input: a set of sets
def consolidate: 
   if length <= 1 then .
   else
     ([0, 1, .] | combinable) as $c
     | if $c then update($c[0]; $c[1]) | consolidate
       else .
       end
   end;
</syntaxhighlight>
'''Examples''':
<syntaxhighlight lang="jq">def 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"]]
;

def test: 
  tests | to_set | consolidate;

test</syntaxhighlight>
{{Out}}
<syntaxhighlight lang="sh">$ jq -c -n -f Set_consolidation.rc
[["A","B"],["C","D"]]
[["A","B","D"]]
[["A","B","C","D"]]
[["A","B","C","D"],["F","G","H","I","K"]]</syntaxhighlight>

=={{header|Julia}}==
'''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 = 
   DeleteCases[
    Subsets[Range@
      Length@x, {2}], _?(Intersection @@ x[[#]] == {} &)];
  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}}==

<syntaxhighlight 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"]]);
;;</syntaxhighlight>

{{out}}
<pre>{ {A B} {C D} }
{ {A B C} }
{ {B A C D} }
{ {K I F G H} {B A C D} }</pre>

=={{header|ooRexx}}==
<syntaxhighlight 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)</syntaxhighlight>
{{out}}
<pre>
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): ()
====
</pre>

=={{header|PARI/GP}}==
<syntaxhighlight 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)
};</syntaxhighlight>

=={{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>### Example 1: [
###              [
###                'A',
###                'B'
###              ],
###              [
###                'C',
###                'D'
###              ]
###            ]

### 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}}
<syntaxhighlight 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 ) ) )</syntaxhighlight>
Test:
<syntaxhighlight 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))</syntaxhighlight>

=={{header|PL/I}}==
<syntaxhighlight 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;</syntaxhighlight>
<pre>
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} 
</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===
<syntaxhighlight 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]</syntaxhighlight>

===Python: Recursive===
<syntaxhighlight 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</syntaxhighlight>

===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.
<syntaxhighlight 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)</syntaxhighlight>

{{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}}==
<syntaxhighlight 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)))
</syntaxhighlight>
{{out}}
<syntaxhighlight 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))
</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}}==
<syntaxhighlight lang="rexx">/*REXX program demonstrates a method of    set consolidating    using some sample sets. */
@.=;               @.1 = '{A,B}     {C,D}'
                   @.2 = "{A,B}     {B,D}"
                   @.3 = '{A,B}     {C,D}     {D,B}'
                   @.4 = '{H,I,K}   {A,B}     {C,D}     {D,B}     {F,G,H}'
                   @.5 = '{snow,ice,slush,frost,fog} {icebergs,icecubes} {rain,fog,sleet}'

           do j=1  while @.j\==''                /*traipse through each of sample sets. */
           call SETconsolidate @.j               /*have the function do the heavy work. */
           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 #                           /* [↓]  change all commas to a blank.  */
         !.k= translate( word(old, k), , '},{')  /*create a list of words  (aka, a set).*/
         end   /*k*/                             /* [↑]  ··· and also remove the braces.*/

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

            do set=1  for #;                  $=                            /*elide dups*/
              do items=1  for words(!.set);   x= word(!.set, items)
              if x==','  then iterate;        if x==''  then leave
              $= $ x                                                        /*build new.*/
                     do  until  \isIn(x, !.set);      _= wordpos(x, !.set)
                     _= wordpos(x, !.set)
                     !.set= subword(!.set, 1, _-1) ',' subword(!.set, _+1)  /*purify set*/
                     end   /*until ¬isIn ··· */
              end          /*items*/
            !.set= translate( strip($), ',', " ")
            end            /*set*/

         do i=1  for #; if !.i==''  then iterate /*ignore any  set  that is a null set. */
         new= space(new   '{'!.i"}")             /*prepend and append a set identifier. */
         end   /*i*/

       say ' the new set='  new;         say
       return</syntaxhighlight>
{{out|output|text=&nbsp; when using the (internal) default supplied sample sets:}}
<pre>
 the old set= {A,B} {C,D}
 the new set= {A,B} {C,D}

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

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

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

 the old set= {snow,ice,slush,frost,fog} {icebergs,icecubes} {rain,fog,sleet}
 the new set= {snow,ice,slush,frost,fog,rain,sleet} {icebergs,icecubes}
</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}}==
<syntaxhighlight 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.map!{|sets| sets.map(&:to_set)}

tests.each do |sets|
  until sets.combination(2).none?{|a,b| a.merge(b) && sets.delete(b) if a.intersect?(b)}
  end
  p sets
end</syntaxhighlight>
{{out}}
<pre>
[#<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}>]
</pre>
Note: After execution, the contents of tests are exchanged.

=={{header|Scala}}==
<syntaxhighlight lang="scala">object SetConsolidation extends App {
    def consolidate[Type](sets: Set[Set[Type]]): Set[Set[Type]] = {
        var result = sets // each iteration combines two sets and reiterates, else returns
        for (i <- sets; j <- sets - i; k = i.intersect(j);
            if result == sets && k.nonEmpty) result = result - i - j + i.union(j)
        if (result == sets) sets else consolidate(result)
    }

    // Tests:
    def parse(s: String) =
        s.split(",").map(_.split("").toSet).toSet
    def pretty[Type](sets: Set[Set[Type]]) =
        sets.map(_.mkString("{",",","}")).mkString(" ")
    val tests = List(
        parse("AB,CD") -> Set(Set("A", "B"), Set("C", "D")),
        parse("AB,BD") -> Set(Set("A", "B", "D")),
        parse("AB,CD,DB") -> Set(Set("A", "B", "C", "D")),
        parse("HIK,AB,CD,DB,FGH") -> Set(Set("A", "B", "C", "D"), Set("F", "G", "H", "I", "K"))
    )
    require(Set("A", "B", "C", "D") == Set("B", "C", "A", "D"))
    assert(tests.forall{case (test, expect) =>
        val result = consolidate(test)
        println(s"${pretty(test)} -> ${pretty(result)}")
        expect == result
    })

}</syntaxhighlight>
{{out}}
<pre>{A,B} {C,D} -> {A,B} {C,D}
{A,B} {B,D} -> {A,B,D}
{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}}==
{{trans|Python}}
{{tcllib|struct::set}}
This uses just the recursive version, as this is sufficient to handle substantial merges.
<syntaxhighlight 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]
}</syntaxhighlight>
Demonstrating:
<syntaxhighlight 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}}]</syntaxhighlight>
{{out}}
<pre>1:{A B} {C D}
2:{D A B}
3:{D A B C}
4:{H I F G K} {D A B C}</pre>

=={{header|TXR}}==

Original solution:

<syntaxhighlight lang="txrlisp">(defun mkset (p x) (set [p x] (or [p x] x)))

(defun fnd (p x) (if (eq [p x] x) x (fnd p [p x])))

(defun uni (p x y)
  (let ((xr (fnd p x)) (yr (fnd p y)))
    (set [p xr] yr)))

(defun consoli (sets)
  (let ((p (hash)))
    (each ((s sets))
      (each ((e s))
        (mkset p e)
        (uni p e (car s))))
    (hash-values 
      [group-by (op fnd p) (hash-keys 
                             [group-by identity (flatten sets)])])))

;; tests

(each ((test '(((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)))))
  (format t "~s -> ~s\n" test (consoli test)))</syntaxhighlight>

{{out}}
<pre>((a b) (c d)) -> ((b a) (d c))
((a b) (b d)) -> ((b a d))
((a b) (c d) (d b)) -> ((b a d c))
((h i k) (a b) (c d) (d b) (f g h)) -> ((g f k i h) (b a d c)</pre>

{{trans|Racket}}

<syntaxhighlight lang="txrlisp">(defun mkset (items) [group-by identity items])

(defun empty-p (set) (zerop (hash-count set)))

(defun consoli (ss)
  (defun combi (cs s)
    (cond ((empty-p s) cs)
          ((null cs) (list s))
          ((empty-p (hash-isec s (first cs)))
           (cons (first cs) (combi (rest cs) s)))
          (t (consoli (cons (hash-uni s (first cs)) (rest cs))))))
  [reduce-left combi ss nil])

;; tests
(each ((test '(((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)))))
  (format t "~s -> ~s\n" test
          [mapcar hash-keys (consoli [mapcar mkset test])]))</syntaxhighlight>

{{out}}
<pre>((a b) (c d)) -> ((b a) (d c))
((a b) (b d)) -> ((d b a))
((a b) (c d) (d b)) -> ((d c b a))
((h i k) (a b) (c d) (d b) (f g h)) -> ((g f k i h) (d c b a))</pre>

=={{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>