Task: Set








VB: 





Private Function createSet(t As Variant) As Collection
    Dim x As New Collection
    For Each elem In t
        x.Add elem, elem
    Next elem
    Set createSet = x
End Function
Private Function isElement(s As Variant, x As Collection) As Boolean
    Dim errno As Integer, t As Variant
    On Error GoTo err
    t = x(s)
    isElement = True
    Exit Function
err:
    isElement = False
End Function
Private Function setUnion(A As Collection, B As Collection) As Collection
    Dim x As New Collection
    For Each elem In A
        x.Add elem, elem
    Next elem
    For Each elem In B
        On Error Resume Next 
        x.Add elem, elem
    Next elem
    Set setUnion = x
End Function
Private Function intersection(A As Collection, B As Collection) As Collection
    Dim x As New Collection
    For Each elem In A
        If isElement(elem, B) Then x.Add elem, elem
    Next elem
    For Each elem In B
        If isElement(elem, A) Then
            On Error Resume Next
            x.Add elem, elem
        End If
    Next elem
    Set intersection = x
End Function
Private Function difference(A As Collection, B As Collection) As Collection
    Dim x As New Collection
    For Each elem In A
        If Not isElement(elem, B) Then x.Add elem, elem
    Next elem
    Set difference = x
End Function
Private Function subset(A As Collection, B As Collection) As Boolean
    Dim flag As Boolean
    flag = True
    For Each elem In A
        If Not isElement(elem, B) Then
            flag = False
            Exit For
        End If
    Next elem
    subset = flag
End Function
Private Function equality(A As Collection, B As Collection) As Boolean
    Dim flag As Boolean
    flag = True
    If A.Count = B.Count Then
        For Each elem In A
            If Not isElement(elem, B) Then
                flag = False
                Exit For
            End If
        Next elem
    Else
        flag = False
    End If
    equality = flag
End Function
Private Function properSubset(A As Collection, B As Collection) As Boolean
    Dim flag As Boolean
    flag = True
    If A.Count < B.Count Then
        For Each elem In A
            If Not isElement(elem, B) Then
                flag = False
                Exit For
            End If
        Next elem
    Else
        flag = False
    End If
    properSubset = flag
End Function
Public Sub main()
    
    Dim s As Variant
    Dim A As Collection, B As Collection, C As Collection
    s = [{"Apple","Banana","Pear","Pineapple"}]
    Set A = createSet(s) 
    
    Debug.Print isElement("Apple", A) 
    Debug.Print isElement("Fruit", A) 
    
    s = [{"Fruit","Banana","Pear","Orange"}]
    Set B = createSet(s)
    Set C = setUnion(A, B)
    
    Set C = intersection(A, B)
    
    Set C = difference(A, B)
    
    Debug.Print subset(A, B)
    
    Debug.Print equality(A, B)
    
    Debug.Print properSubset(A, B)
    
    A.Remove "Apple"
    
    A.Remove 1
    
    A.Add "10", "10"
End Sub




Ada: with ada.containers.ordered_sets, ada.text_io;
use ada.text_io;

procedure set_demo is
	package cs is new ada.containers.ordered_sets (character); use cs;

	function "+" (s : string) return set is
	(if s = "" then empty_set else Union(+ s(s'first..s'last - 1), To_Set (s(s'last))));

	function "-" (s : Set) return string is
	(if s = empty_set then "" else - (s - To_Set (s.last_element)) & s.last_element);
	s1, s2 : set;
begin
	loop
		put ("s1= ");
		s1 := + get_line;		
		exit when s1 = +"Quit!";
		put ("s2= ");
		s2 := + get_line;
		Put_Line("Sets [" & (-s1) & "], [" & (-s2) & "] of size"
                & S1.Length'img & " and" & s2.Length'img & ".");
  		Put_Line("Intersection:   [" & (-(Intersection(S1, S2))) & "],");
  		Put_Line("Union:          [" & (-(Union(s1, s2)))        & "],");
  		Put_Line("Difference:     [" & (-(Difference(s1, s2)))   & "],");
  		Put_Line("Symmetric Diff: [" & (-(s1 xor s2)) & "],");
  		Put_Line("Subset: "  & Boolean'Image(s1.Is_Subset(s2))
              & ", Equal: " & Boolean'Image(s1 = s2) & ".");
	end loop;
end set_demo;