RosettaCodeData/Task/Stable-marriage-problem/Ursala/stable-marriage-problem.ursala
2023-07-01 13:44:08 -04:00

48 lines
2.1 KiB
Text

men =
{
'abe': <'abi','eve','cath','ivy','jan','dee','fay','bea','hope','gay'>,
'bob': <'cath','hope','abi','dee','eve','fay','bea','jan','ivy','gay'>,
'col': <'hope','eve','abi','dee','bea','fay','ivy','gay','cath','jan'>,
'dan': <'ivy','fay','dee','gay','hope','eve','jan','bea','cath','abi'>,
'ed': <'jan','dee','bea','cath','fay','eve','abi','ivy','hope','gay'>,
'fred': <'bea','abi','dee','gay','eve','ivy','cath','jan','hope','fay'>,
'gav': <'gay','eve','ivy','bea','cath','abi','dee','hope','jan','fay'>,
'hal': <'abi','eve','hope','fay','ivy','cath','jan','bea','gay','dee'>,
'ian': <'hope','cath','dee','gay','bea','abi','fay','ivy','jan','eve'>,
'jon': <'abi','fay','jan','gay','eve','bea','dee','cath','ivy','hope'>}
women =
{
'abi': <'bob','fred','jon','gav','ian','abe','dan','ed','col','hal'>,
'bea': <'bob','abe','col','fred','gav','dan','ian','ed','jon','hal'>,
'cath': <'fred','bob','ed','gav','hal','col','ian','abe','dan','jon'>,
'dee': <'fred','jon','col','abe','ian','hal','gav','dan','bob','ed'>,
'eve': <'jon','hal','fred','dan','abe','gav','col','ed','ian','bob'>,
'fay': <'bob','abe','ed','ian','jon','dan','fred','gav','col','hal'>,
'gay': <'jon','gav','hal','fred','bob','abe','col','ed','dan','ian'>,
'hope': <'gav','jon','bob','abe','ian','dan','hal','ed','col','fred'>,
'ivy': <'ian','col','hal','gav','fred','bob','abe','ed','jon','dan'>,
'jan': <'ed','hal','gav','abe','bob','jon','col','ian','fred','dan'>}
match = # finds a stable list of engagements from data as given above
-+
^=rrmhPnXS ^/~&l ^/~&rl ^|DlrHSs/~& ^TlK2hlPrSLPAS\~&r -+
~&lK2hlPrSXS,
*=rnmihBPK12D ~&mmhPnXNCB^rnPrmPllSPcA\~&r ~&lrrPwZK17@rnPlX+-,
^|rrPlrlPXX/~& ^/~&nNAS ^/~&l+ ^|H\~&+ -:+ * ^|/~& -<+ \/-=+ ~&DSL@tK33+-
preferred = # finds non-couples that would prefer each other to their betrothed
~&lSLPrSLrlXS2c^|DlrHS\~& ~~irlXX+ ^D/~&l+ ^|H\~&+ -:+ *T ^|/~& //~=;+ -~l;+ \/~&H
#cast %sWLm
main = # stable, perturbed, and preferred alternatives to the perturbed
<
'stable': match/men women,
'perturbed': ~&lSrSxPp match/men women,
'preferred': preferred/(men,women) ~&lSrSxPp match/men women>