69 lines
2.5 KiB
Plaintext
69 lines
2.5 KiB
Plaintext
N = 10
|
|
DIM mname$(N), wname$(N), mpref$(N), wpref$(N), mpartner%(N), wpartner%(N)
|
|
DIM proposed&(N,N)
|
|
mname$() = "", "Abe","Bob","Col","Dan","Ed","Fred","Gav","Hal","Ian","Jon"
|
|
wname$() = "", "Abi","Bea","Cath","Dee","Eve","Fay","Gay","Hope","Ivy","Jan"
|
|
mpref$() = "", "AECIJDFBHG","CHADEFBJIG","HEADBFIGCJ","IFDGHEJBCA","JDBCFEAIHG",\
|
|
\ "BADGEICJHF","GEIBCADHJF","AEHFICJBGD","HCDGBAFIJE","AFJGEBDCIH"
|
|
wpref$() = "", "BFJGIADECH","BACFGDIEJH","FBEGHCIADJ","FJCAIHGDBE","JHFDAGCEIB",\
|
|
\ "BAEIJDFGCH","JGHFBACEDI","GJBAIDHECF","ICHGFBAEJD","EHGABJCIFD"
|
|
|
|
REM The Gale-Shapley algorithm:
|
|
REPEAT
|
|
FOR m% = 1 TO N
|
|
REPEAT
|
|
IF mpartner%(m%) EXIT REPEAT
|
|
FOR i% = 1 TO N
|
|
w% = ASCMID$(mpref$(m%),i%) - 64
|
|
IF proposed&(m%,w%) = 0 EXIT FOR
|
|
NEXT i%
|
|
IF i% > N EXIT REPEAT
|
|
proposed&(m%,w%) = 1
|
|
IF wpartner%(w%) = 0 THEN
|
|
mpartner%(m%) = w% : REM Get engaged
|
|
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 : REM Split up
|
|
mpartner%(m%) = w% : REM Get engaged
|
|
wpartner%(w%) = m%
|
|
ENDIF
|
|
ENDIF
|
|
UNTIL TRUE
|
|
NEXT m%
|
|
UNTIL SUM(mpartner%()) = (N*(N+1))/2
|
|
|
|
FOR m% = 1 TO N
|
|
PRINT mname$(m%) " is engaged to " wname$(mpartner%(m%))
|
|
NEXT
|
|
PRINT "Relationships are ";
|
|
IF FNstable PRINT "stable." ELSE PRINT "unstable."
|
|
|
|
a% = RND(N)
|
|
REPEAT b% = RND(N) : UNTIL b%<>a%
|
|
PRINT '"Now swapping " mname$(a%) "'s and " mname$(b%) "'s partners:"
|
|
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 ";
|
|
IF FNstable PRINT "stable." ELSE PRINT "unstable."
|
|
END
|
|
|
|
DEF FNstable
|
|
LOCAL 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
|
|
= FALSE
|
|
ENDIF
|
|
NEXT o%
|
|
NEXT m%
|
|
= TRUE
|