|
=={{header|Batch File}}==
<lang dos>:: Stable Marriage Problem in Rosetta Code
<lang dos>@echo off
:: Batch File Implementation
@echo off
setlocal enabledelayedexpansion
%==:: Initialization ==%(Index Starts in 0)
set "male= abe bob col dan ed fred gav hal ian jon" ::First whitespace is necessary
set "femalefemm= abi bea cath dee eve fay gay hope ivy jan" ::same here...
set "abe[]=abi, eve, cath, ivy, jan, dee, fay, bea, hope, gay"
::Initialization of pseudo-arrays [Male]
set "cntbob[]=0" & for %%. in (abicath, evehope, cathabi, ivydee, jan, deeeve, fay, bea, hopejan, ivy, gay) do (set abe[!cnt!]=%%.&set /a cnt+=1)"
set "cntcol[]=0" & for %%. in (cathhope, hopeeve, abi, dee, evebea, fay, beaivy, jangay, ivycath, gay) do (set bob[!cnt!]=%%.&set /a cnt+=1)jan"
set "cntdan[]=0" & for %%. in (hopeivy, evefay, abidee, deegay, beahope, fayeve, ivyjan, gaybea, cath, jan) do (set col[!cnt!]=%%.&set /a cnt+=1)abi"
set "cnted[]=0" & for %%. in (ivyjan, faydee, deebea, gaycath, hopefay, eve, janabi, beaivy, cathhope, abi) do (set dan[!cnt!]=%%.&set /a cnt+=1)gay"
set "cntfred[]=0"bea, & for %%. in (janabi, dee, beagay, catheve, fayivy, evecath, abi, ivyjan, hope, gay) do (set ed[!cnt!]=%%.&set /a cnt+=1)fay"
set "cntgav[]=0"gay, & for %%. in (beaeve, abiivy, deebea, gaycath, eveabi, ivydee, cathhope, jan, hope, fay) do (set fred[!cnt!]=%%.&set /a cnt+=1)"
set "cnthal[]=0" & for %%. in (gayabi, eve, ivyhope, beafay, cathivy, abicath, deejan, hopebea, jangay, fay) do (set gav[!cnt!]=%%.&set /a cnt+=1)dee"
set "cntian[]=0"hope, &cath, fordee, %%. in (abigay, evebea, hopeabi, fay, ivy, cath, jan, bea, gay, dee) do (set hal[!cnt!]=%%.&set /a cnt+=1)eve"
set "cntjon[]=0" & for %%. in (hopeabi, cathfay, deejan, gay, eve, bea, abidee, faycath, ivy, jan, eve) do (set ian[!cnt!]=%%.&set /a cnt+=1)hope"
set "cnt=0" & for %%. in (abi, fay, jan, gay, eve, bea, dee, cath, ivy, hope) do (set jon[!cnt!]=%%.&set /a cnt+=1)
set "abi[]=bob, fred, jon, gav, ian, abe, dan, ed, col, hal"
::Initialization of pseudo-arrays [Female]
set "cntbea[]=0" & for %%. in (bob, fredabe, joncol, gavfred, iangav, abedan, danian, ed, coljon, hal) do (set abi[!cnt!]=%%.&set /a cnt+=1)"
set "cntcath[]=0" & for %%. infred, (bob, abeed, colgav, fredhal, gavcol, danian, ianabe, eddan, jon, hal) do (set bea[!cnt!]=%%.&set /a cnt+=1)"
set "cntdee[]=0" & for %%. in (fred, bobjon, edcol, gavabe, halian, colhal, iangav, abedan, danbob, jon) do (set cath[!cnt!]=%%.&set /a cnt+=1)ed"
set "cnteve[]=0"jon, &hal, for %%. in (fred, jon, coldan, abe, iangav, halcol, gaved, danian, bob, ed) do (set dee[!cnt!]=%%.&set /a cnt+=1)"
set "cntfay[]=0"bob, &abe, for %%. in (joned, halian, fredjon, dan, abefred, gav, col, ed, ian, bob) do (set eve[!cnt!]=%%.&set /a cnt+=1)hal"
set "cntgay[]=0" & for %%. in (bobjon, abegav, edhal, ianfred, jonbob, danabe, fredcol, gaved, coldan, hal) do (set fay[!cnt!]=%%.&set /a cnt+=1)ian"
set "cnthope[]=0" & for %%. ingav, (jon, gavbob, halabe, fredian, bobdan, abe, colhal, ed, dancol, ian) do (set gay[!cnt!]=%%.&set /a cnt+=1)fred"
set "cntivy[]=0"ian, &col, forhal, %%. in (gav, jonfred, bob, abe, ian, dan, hal, ed, coljon, fred) do (set hope[!cnt!]=%%.&set /a cnt+=1)dan"
set "cntjan[]=0" & for %%. in (ian, coled, hal, gav, fredabe, bob, abejon, edcol, jonian, fred, dan) do (set ivy[!cnt!]=%%.&set /a cnt+=1)"
set "cnt=0" & for %%. in (ed, hal, gav, abe, bob, jon, col, ian, fred, dan) do (set jan[!cnt!]=%%.&set /a cnt+=1)
%==/Initialization ==%
rem variable notation:
( %== The main thing ==%
rem <boy>{<index>} = <girl>
echo.HISTORY:
rem <boy>[<girl>] = <index>
for %%M in (%male%) do (
set cnt=0
for %%. in (!%%M[]!) do (
set "%%M{!cnt!}=%%."
set "%%M[%%.]=!cnt!"
set /a cnt+=1
)
)
for %%F in (%femm%) do (
set cnt=0
for %%. in (!%%F[]!) do (
set "%%F[%%.]=!cnt!"
set /a cnt+=1
)
)
:: The Main Thing
echo(HISTORY:
call :stableMatching
echo.(
echo.(NEWLYWEDS:
call :display
echo.(
call :isStable
echo.(
echo.(What if ed and hal swapped?
call :swapper ed hal
echo.(
echo.(NEW-NEWLYWEDS:
call :display
echo.(
call :isStable
pause>nul
exit /b 0
) %==/The main thing ==%
%==:: The algorithm ==%Algorithm
:stableMatching
set "free_men=%male%" ::The free-men variable
set "free_fem=%femm%"
set "free_women=%female%" ::The free-women variable
for %%M in (%male%) do set "%%M_tried=0"
set nextgirl=0
:thematchloop
set m=&for %%F in (!free_men!) do (if not defined m set "m=%%F")
if "!m!"=="" goto :EOF
:match_loop
for /f "tokens=1-2 delims==" %%A in ('set !m![!nextgirl!]') do set "w=%%B"
if "%free_men%"=="" goto :EOF
set "propo="
for %%W in (!free_women!) do (
if "%%W"=="!w!" (
set propo=TRUE
set "!w!_=!m!" & set "!m!_=!w!"
set free_women=!free_women: %w%=!
set free_men=!free_men: %m%=!
echo. !w! ACCEPTED !m!.
)
)
if defined propo (set "nextgirl=0" & goto thematchloop)
for /f "tokens=1-2* delims== " %%Am in ('set !w!_'"%free_men%") do set "mbef=%%B"(
rem get woman not yet proposed to, but if man's tries exceeds the number
set "replace=" & for /f "tokens=1-2 delims==" %%R in ('set !w![') do (
rem of women (poor guy), he starts again to his most preferred woman (#0).
if not defined replace (
for /f %%x in ("!%%m_tried!") do if not defined %%m{%%x} (
if "%%S"=="!m!" (
set "%%m_tried=0" & set "w=!%%m{0}!"
set replace=TRUE
) else set "!w!_=!%%m{%%x}!" & set "!m!_=!w!"
set "m=%%m"
set "free_men=!free_men! !mbef!"
set "free_men=!free_men: %m%=!"
set nextgirl=0
echo. !w! LEFT !mbef!.
echo. !w! ACCEPTED !m!.
)
if "%%S"=="!mbef!" (
set /a nextgirl+=1
set replace=FALSE
)
)
)
goto thematchloop
%==/The Algorithm ==%
for /f %%x in ("free_fem:!w!=") do (
%== Output the Couples ==%
if not "!free_fem!"=="!%%x!" (
rem accept because !w! (the woman) is free
set "!m!_=!w!" & set "!w!_=!m!"
set "free_men=%%n" & set "free_fem=!%%x!"
echo( !w! ACCEPTED !m!.
) else (
rem here, !w! already has a pair; get his name and rank.
for /f %%. in ("!w!") do set "cur_man=!%%._!"
for /f %%. in ("!w![!cur_man!]") do set "rank_cur=!%%.!"
rem also, get the rank of current proposing man.
for /f %%. in ("!w![!m!]") do set "rank_new=!%%.!"
if !rank_new! lss !rank_cur! (
rem here, !w! will leave her pair, and choose !m!.
set "free_men=%%n !cur_man!"
echo( !w! LEFT !cur_man!.
rem pair them up now!
set "!m!_=!w!" & set "!w!_=!m!"
echo( !w! ACCEPTED !m!.
)
)
)
set /a "!m!_tried+=1"
)
goto :match_loop
:: Output the Couples
:display
for %%S in (!male!%femm%) do echo. %%S and !%%S_!.
goto :EOF
%==/Output the Couples ==%
%==:: Stability Checking ==%
:isStable
for %%Mf in (!female!%femm%) do (
for %%g in (%male%) do (
set "better="
set "dislike=" & for /f "tokens=1-2 delims==" %%R. in ('set "%%Mf['!%%f_!]") do (set "girl_cur=!%%.!"
set "girl_aboy=!%%f[%%g]!"
if not defined dislike (
if " for /f %%S"==. in ("%%g[!%%M_g_!]" (set dislike=T) elsedo (set "betterboy_cur=!better! %%S.!")
set "boy_agirl=!%%g[%%f]!"
)
)
if !boy_cur! gtr !boy_agirl! (
for %%X in (!better!) do (
if !girl_cur! gtr !girl_aboy! (
for /f "tokens=1-2 delims==" %%F in ('set %%X_') do set curr_partner_of_boy=%%G
echo(STABILITY = FALSE.
set "main_check="
echo(%%f and %%g would rather be together than their current partners.
for /f "tokens=1-2 delims==" %%B in ('set %%X[') do (
goto :EOF
if not defined main_check (
)
if "%%C"=="%%M" (
)
echo.STABILITY = FALSE.
)
echo %%M and %%X would rather be together than their current partners.
goto :EOF
)
if "%%C"=="!curr_partner_of_boy!" set "main_check=CONTINUE"
)
)
)
)
echo.(STABILITY = TRUE.
goto :EOF
%==/Stability Chacking ==%
%==:: Swapper ==%
:swapper
set %~1.tmp=!%~1_!
set %~2.tmp=!%~2_!
set "%~1_=!%~2.tmp!"
set "%~2_=!%~1.tmp!"
set "!%~1.tmp!_=%~2"
set "!%~2.tmp!_=%~1"
goto :EOF</lang>
%==/Swapper==%</lang>
{{Out}}
<pre>HISTORY:
abi ACCEPTED abe.
cath ACCEPTED bob.
hope ACCEPTED col.
ivy ACCEPTED dan.
jan ACCEPTED ed.
bea ACCEPTED fred.
gay ACCEPTED gav.
eve ACCEPTED hal.
hope LEFT col.
hope ACCEPTED ian.
abi LEFT abe.
abi ACCEPTED jon.
dee ACCEPTED col.
ivy LEFT dan.
ivy ACCEPTED abe.
fay ACCEPTED dan.
NEWLYWEDS:
abeabi and ivyjon.
bobbea and cathfred.
colcath and deebob.
dandee and faycol.
edeve and janhal.
fredfay and beadan.
gay and gav and gay.
halhope and eveian.
ianivy and hopeabe.
jonjan and abied.
STABILITY = TRUE.
NEW-NEWLYWEDS:
abeabi and ivyjon.
bobbea and cathfred.
colcath and deebob.
dandee and faycol.
eve and ed and eve.
fredfay and beadan.
gay and gav and gay.
halhope and janian.
ianivy and hopeabe.
jonjan and abihal.
STABILITY = FALSE.
eve and halabe would rather be together than their current partners.</pre>
=={{header|BBC BASIC}}==
|