85 lines
2.6 KiB
Plaintext
85 lines
2.6 KiB
Plaintext
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
|