Const n As Integer = 10

Dim As Integer i, m, w, o, a, b
Dim Shared As Integer mpartner(n), wpartner(n), proposed(n, n)
Dim Shared As String mpref(n), wname(n), wpref(n), mname(n)

Data "AECIJDFBHG","CHADEFBJIG","HEADBFIGCJ","IFDGHEJBCA","JDBCFEAIHG","BADGEICJHF","GEIBCADHJF","AEHFICJBGD","HCDGBAFIJE","AFJGEBDCIH"
For i = 1 To n: Read mpref(i): Next
Data "Abi","Bea","Cath","Dee","Eve","Fay","Gay","Hope","Ivy","Jan"
For i = 1 To n: Read wname(i): Next
Data "BFJGIADECH","BACFGDIEJH","FBEGHCIADJ","FJCAIHGDBE","JHFDAGCEIB","BAEIJDFGCH","JGHFBACEDI","GJBAIDHECF","ICHGFBAEJD","EHGABJCIFD"
For i = 1 To n: Read wpref(i): Next
Data "Abe","Bob","Col","Dan","Ed","Fred","Gav","Hal","Ian","Jon"
For i = 0 To n: Read mname(i): Next

Function isStable() As Boolean
    Dim As Integer m, w, o, p
    For m = 1 To n
        w = mpartner(m)
        For o = 1 To n
            p = wpartner(o)
            If Instr(mpref(m), Left(wname(o), 1)) < Instr(mpref(m), Left(wname(w), 1)) And _
                Instr(wpref(o), Left(mname(m), 1)) < Instr(wpref(o), Left(mname(p), 1)) Then
                Return False
            End If
        Next o
    Next m
    Return True
End Function

Function arraySum(arr() As Integer) As Integer
    Dim total As Integer = 0
    For i As Integer = Lbound(arr) To Ubound(arr)
        total += arr(i)
    Next
    Return total
End Function

' The Gale-Shapley algorithm
Do
    For m = 1 To n
        Do
            If mpartner(m) <> 0 Then Exit Do
            For i = 1 To n
                w = Asc(Mid(mpref(m), i, 1)) - 64
                If proposed(m, w) = 0 Then Exit For
            Next i
            If i > n Then Exit Do
            proposed(m, w) = 1
            If wpartner(w) = 0 Then
                mpartner(m) = w
                wpartner(w) = m
            Else
                o = wpartner(w)
                If Instr(wpref(w), Left(mname(m), 1)) < Instr(wpref(w), Left(mname(o), 1)) Then
                    mpartner(o) = 0
                    mpartner(m) = w
                    wpartner(w) = m
                End If
            End If
        Loop
    Next m
Loop Until arraySum(mpartner()) = (n * (n + 1)) \ 2

For m = 1 To n
    Print mname(m) & " is engaged to " & wname(mpartner(m))
Next
Print "Relationships are ";
Print Iif(isStable(), "stable.", "unstable.")

Randomize Timer
a = Int(Rnd * n) + 1
Do
    b = Int(Rnd * n) + 1
Loop Until b <> a

Print !"\nNow exchanging the pairs of " & mname(a) & " and " & mname(b) & ":"
Swap mpartner(a), mpartner(b)
Print mname(a) & " is engaged to " & wname(mpartner(a))
Print mname(b) & " is engaged to " & wname(mpartner(b))
Print "Relationships are ";
Print Iif(isStable(), "stable.", "unstable.")

Sleep