2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,12 +1,14 @@
|
|||
Solve the [[wp:Stable marriage problem|Stable marriage problem]] using the Gale/Shapley algorithm.
|
||||
|
||||
'''Problem description'''<br>
|
||||
Given an equal number of men and women to be paired for marriage, each man ranks all the women in order of his preference and each women ranks all the men in order of her preference.
|
||||
|
||||
A stable set of engagements for marriage is one where no man prefers a women over the one he is engaged to, where that other woman ''also'' prefers that man over the one she is engaged to. I.e. with consulting marriages, there would be no reason for the engagements between the people to change.
|
||||
'''Problem description'''<br>
|
||||
Given an equal number of men and women to be paired for marriage, each man ranks all the women in order of his preference and each woman ranks all the men in order of her preference.
|
||||
|
||||
A stable set of engagements for marriage is one where no man prefers a woman over the one he is engaged to, where that other woman ''also'' prefers that man over the one she is engaged to. I.e. with consulting marriages, there would be no reason for the engagements between the people to change.
|
||||
|
||||
Gale and Shapley proved that there is a stable set of engagements for any set of preferences and the first link above gives their algorithm for finding a set of stable engagements.
|
||||
|
||||
|
||||
'''Task Specifics'''<br>
|
||||
Given ten males:
|
||||
abe, bob, col, dan, ed, fred, gav, hal, ian, jon
|
||||
|
|
@ -39,6 +41,7 @@ And a complete list of ranked preferences, where the most liked is to the left:
|
|||
# Use the Gale Shapley algorithm to find a stable set of engagements
|
||||
# Perturb this set of engagements to form an unstable set of engagements then check this new set for stability.
|
||||
|
||||
|
||||
'''References'''
|
||||
# [http://www.cs.columbia.edu/~evs/intro/stable/writeup.html The Stable Marriage Problem]. (Eloquent description and background information).
|
||||
# [http://sephlietz.com/gale-shapley/ Gale-Shapley Algorithm Demonstration].
|
||||
|
|
@ -46,3 +49,4 @@ And a complete list of ranked preferences, where the most liked is to the left:
|
|||
# [https://www.youtube.com/watch?v=Qcv1IqHWAzg Stable Marriage Problem - Numberphile] (Video).
|
||||
# [https://www.youtube.com/watch?v=LtTV6rIxhdo Stable Marriage Problem (the math bit)] (Video).
|
||||
# [http://www.ams.org/samplings/feature-column/fc-2015-03 The Stable Marriage Problem and School Choice]. (Excellent exposition)
|
||||
<br><br>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,12 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
import Lens.Micro
|
||||
import Lens.Micro.TH
|
||||
import Data.List (union, delete)
|
||||
|
||||
type Preferences a = (a, [a])
|
||||
type Couple a = (a,a)
|
||||
data State a = State { _freeGuys :: [a]
|
||||
, _guys :: [Preferences a]
|
||||
, _girls :: [Preferences a]}
|
||||
|
||||
makeLenses ''State
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
name n = lens get set
|
||||
where get = head . dropWhile ((/= n).fst)
|
||||
set assoc (_,v) = let (prev, _:post) = break ((== n).fst) assoc
|
||||
in prev ++ (n, v):post
|
||||
|
||||
fianceesOf n = guys.name n._2
|
||||
fiancesOf n = girls.name n._2
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
stableMatching :: Eq a => State a -> [Couple a]
|
||||
stableMatching = getPairs . iterateUntil (null._freeGuys) step
|
||||
where
|
||||
iterateUntil p f = head . dropWhile (not . p) . iterate f
|
||||
getPairs s = map (_2 %~ head) $ s^.guys
|
||||
|
||||
step :: Eq a => State a -> State a
|
||||
step s = foldl propose s (s^.freeGuys)
|
||||
where
|
||||
propose s guy =
|
||||
let girl = s^.fianceesOf guy & head
|
||||
bestGuy : otherGuys = s^.fiancesOf girl
|
||||
modify
|
||||
| guy == bestGuy = freeGuys %~ delete guy
|
||||
| guy `elem` otherGuys = (fiancesOf girl %~ dropWhile (/= guy)) .
|
||||
(freeGuys %~ guy `replaceBy` bestGuy)
|
||||
| otherwise = fianceesOf guy %~ tail
|
||||
in modify s
|
||||
|
||||
replaceBy x y [] = []
|
||||
replaceBy x y (h:t) | h == x = y:t
|
||||
| otherwise = h:replaceBy x y t
|
||||
|
||||
unstablePairs :: Eq a => State a -> [Couple a] -> [(Couple a, Couple a)]
|
||||
unstablePairs s pairs =
|
||||
[ ((m1, w1), (m2,w2)) | (m1, w1) <- pairs
|
||||
, (m2,w2) <- pairs
|
||||
, m1 /= m2
|
||||
, let fm = s^.fianceesOf m1
|
||||
, elemIndex w2 fm < elemIndex w1 fm
|
||||
, let fw = s^.fiancesOf w2
|
||||
, elemIndex m2 fw < elemIndex m1 fw ]
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
guys0 =
|
||||
[("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"])]
|
||||
|
||||
girls0 =
|
||||
[("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"])]
|
||||
|
|
@ -0,0 +1 @@
|
|||
s0 = State (fst <$> guys0) guys0 ((_2 %~ reverse) <$> girls0)
|
||||
|
|
@ -1,99 +0,0 @@
|
|||
import Data.List
|
||||
import Control.Monad
|
||||
import Control.Arrow
|
||||
import Data.Maybe
|
||||
|
||||
mp = map ((head &&& tail). splitNames)
|
||||
["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"]
|
||||
|
||||
fp = map ((head &&& tail). splitNames)
|
||||
["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"]
|
||||
|
||||
splitNames = map (takeWhile(`notElem`",:")). words
|
||||
|
||||
pref x y xs = fromJust (elemIndex x xs) < fromJust (elemIndex y xs)
|
||||
|
||||
task ms fs = do
|
||||
let
|
||||
jos = fst $ unzip ms
|
||||
|
||||
runGS es js ms = do
|
||||
let (m:js') = js
|
||||
(v:vm') = case lookup m ms of
|
||||
Just xs -> xs
|
||||
_ -> []
|
||||
vv = fromJust $ lookup v fs
|
||||
m2 = case lookup v es of
|
||||
Just e -> e
|
||||
_ -> ""
|
||||
ms1 = insert (m,vm') $ delete (m,v:vm') ms
|
||||
|
||||
if null js then do
|
||||
putStrLn ""
|
||||
putStrLn "=== Couples ==="
|
||||
return es
|
||||
|
||||
else if null m2 then
|
||||
do putStrLn $ v ++ " with " ++ m
|
||||
runGS ( insert (v,m) es ) js' ms1
|
||||
|
||||
else if pref m m2 vv then
|
||||
do putStrLn $ v ++ " dumped " ++ m2 ++ " for " ++ m
|
||||
runGS ( insert (v,m) $ delete (v,m2) es ) (if not $ null vm' then js'++[m2] else js') ms1
|
||||
|
||||
else runGS es (if not $ null js' then js'++[m] else js') ms1
|
||||
|
||||
cs <- runGS [] jos ms
|
||||
|
||||
mapM_ (\(f,m) -> putStrLn $ f ++ " with " ++ m ) cs
|
||||
putStrLn ""
|
||||
checkStab cs
|
||||
|
||||
putStrLn ""
|
||||
putStrLn "Introducing error: "
|
||||
let [r1@(a,b), r2@(p,q)] = take 2 cs
|
||||
r3 = (a,q)
|
||||
r4 = (p,b)
|
||||
errcs = insert r4. insert r3. delete r2 $ delete r1 cs
|
||||
putStrLn $ "\tSwapping partners of " ++ a ++ " and " ++ p
|
||||
putStrLn $ (\((a,b),(p,q)) -> "\t" ++ a ++ " is now with " ++ b ++ " and " ++ p ++ " with " ++ q) (r3,r4)
|
||||
putStrLn ""
|
||||
checkStab errcs
|
||||
|
||||
checkStab es = do
|
||||
let
|
||||
fmt (a,b,c,d) = a ++ " and " ++ b ++ " like each other better than their current partners " ++ c ++ " and " ++ d
|
||||
ies = uncurry(flip zip) $ unzip es -- es = [(fem,m)] & ies = [(m,fem)]
|
||||
slb = map (\(f,m)-> (f,m, map (id &&& fromJust. flip lookup ies). fst.break(==m). fromJust $ lookup f fp) ) es
|
||||
hlb = map (\(f,m)-> (m,f, map (id &&& fromJust. flip lookup es ). fst.break(==f). fromJust $ lookup m mp) ) es
|
||||
tslb = concatMap (filter snd. (\(f,m,ls) ->
|
||||
map (\(m2,f2) ->
|
||||
((f,m2,f2,m), pref f f2 $ fromJust $ lookup m2 mp)) ls)) slb
|
||||
thlb = concatMap (filter snd. (\(m,f,ls) ->
|
||||
map (\(f2,m2) ->
|
||||
((m,f2,m2,f), pref m m2 $ fromJust $ lookup f2 fp)) ls)) hlb
|
||||
res = tslb ++ thlb
|
||||
|
||||
if not $ null res then do
|
||||
putStrLn "Marriages are unstable, e.g.:"
|
||||
putStrLn.fmt.fst $ head res
|
||||
|
||||
else putStrLn "Marriages are stable"
|
||||
|
|
@ -1,19 +1 @@
|
|||
0 105 A."_1 matchMake '' NB. swap abi and bea
|
||||
┌───┬────┬───┬───┬───┬────┬───┬───┬────┬───┐
|
||||
│abe│bob │col│dan│ed │fred│gav│hal│ian │jon│
|
||||
├───┼────┼───┼───┼───┼────┼───┼───┼────┼───┤
|
||||
│ivy│cath│dee│fay│jan│abi │gay│eve│hope│bea│
|
||||
└───┴────┴───┴───┴───┴────┴───┴───┴────┴───┘
|
||||
checkStable 0 105 A."_1 matchMake ''
|
||||
Engagements preferred by both members to their current ones:
|
||||
┌────┬───┐
|
||||
│fred│bea│
|
||||
├────┼───┤
|
||||
│jon │fay│
|
||||
├────┼───┤
|
||||
│jon │gay│
|
||||
├────┼───┤
|
||||
│jon │eve│
|
||||
└────┴───┘
|
||||
|assertion failure: assert
|
||||
| assert-.bad
|
||||
checkStable matchMake''
|
||||
|
|
|
|||
19
Task/Stable-marriage-problem/J/stable-marriage-problem-4.j
Normal file
19
Task/Stable-marriage-problem/J/stable-marriage-problem-4.j
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
0 105 A."_1 matchMake '' NB. swap abi and bea
|
||||
┌───┬────┬───┬───┬───┬────┬───┬───┬────┬───┐
|
||||
│abe│bob │col│dan│ed │fred│gav│hal│ian │jon│
|
||||
├───┼────┼───┼───┼───┼────┼───┼───┼────┼───┤
|
||||
│ivy│cath│dee│fay│jan│abi │gay│eve│hope│bea│
|
||||
└───┴────┴───┴───┴───┴────┴───┴───┴────┴───┘
|
||||
checkStable 0 105 A."_1 matchMake ''
|
||||
Engagements preferred by both members to their current ones:
|
||||
┌────┬───┐
|
||||
│fred│bea│
|
||||
├────┼───┤
|
||||
│jon │fay│
|
||||
├────┼───┤
|
||||
│jon │gay│
|
||||
├────┼───┤
|
||||
│jon │eve│
|
||||
└────┴───┘
|
||||
|assertion failure: assert
|
||||
| assert-.bad
|
||||
|
|
@ -0,0 +1,122 @@
|
|||
import java.util.*
|
||||
|
||||
class People(val map: Map<String, Array<String>>) {
|
||||
operator fun get(name: String) = map[name]
|
||||
|
||||
val names: List<String> by lazy { map.keys.toList() }
|
||||
|
||||
fun preferences(k: String, v: String): List<String> {
|
||||
val prefers = get(k)!!
|
||||
return ArrayList<String>(prefers.slice(0..prefers.indexOf(v)))
|
||||
}
|
||||
}
|
||||
|
||||
class EngagementRegistry() : TreeMap<String, String>() {
|
||||
constructor(guys: People, girls: People) : this() {
|
||||
val freeGuys = guys.names.toMutableList()
|
||||
while (freeGuys.any()) {
|
||||
val guy = freeGuys.removeAt(0) // get a load of THIS guy
|
||||
val guy_p = guys[guy]!!
|
||||
for (girl in guy_p)
|
||||
if (this[girl] == null) {
|
||||
this[girl] = guy // girl is free
|
||||
break
|
||||
} else {
|
||||
val other = this[girl]!!
|
||||
val girl_p = girls[girl]!!
|
||||
if (girl_p.indexOf(guy) < girl_p.indexOf(other)) {
|
||||
this[girl] = guy // this girl prefers this guy to the guy she's engaged to
|
||||
freeGuys += other
|
||||
break
|
||||
} // else no change... keep looking for this guy
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
override fun toString(): String {
|
||||
val s = StringBuilder()
|
||||
for ((k, v) in this) s.append("$k is engaged to $v\n")
|
||||
return s.toString()
|
||||
}
|
||||
|
||||
fun analyse(guys: People, girls: People) {
|
||||
if (check(guys, girls))
|
||||
println("Marriages are stable")
|
||||
else
|
||||
println("Marriages are unstable")
|
||||
}
|
||||
|
||||
fun swap(girls: People, i: Int, j: Int) {
|
||||
val n1 = girls.names[i]
|
||||
val n2 = girls.names[j]
|
||||
val g0 = this[n1]!!
|
||||
val g1 = this[n2]!!
|
||||
this[n1] = g1
|
||||
this[n2] = g0
|
||||
println("$n1 and $n2 have switched partners")
|
||||
}
|
||||
|
||||
private fun check(guys: People, girls: People): Boolean {
|
||||
val guy_names = guys.names
|
||||
val girl_names = girls.names
|
||||
if (!keys.containsAll(girl_names) or !values.containsAll(guy_names))
|
||||
return false
|
||||
|
||||
val invertedMatches = TreeMap<String, String>()
|
||||
for ((k, v) in this) invertedMatches[v] = k
|
||||
|
||||
for ((k, v) in this) {
|
||||
val sheLikesBetter = girls.preferences(k, v)
|
||||
val heLikesBetter = guys.preferences(v, k)
|
||||
for (guy in sheLikesBetter) {
|
||||
val fiance = invertedMatches[guy]
|
||||
val guy_p = guys[guy]!!
|
||||
if (guy_p.indexOf(fiance) > guy_p.indexOf(k)) {
|
||||
println("$k likes $guy better than $v and $guy likes $k better than their current partner")
|
||||
return false
|
||||
}
|
||||
}
|
||||
|
||||
for (girl in heLikesBetter) {
|
||||
val fiance = get(girl)
|
||||
val girl_p = girls[girl]!!
|
||||
if (girl_p.indexOf(fiance) > girl_p.indexOf(v)) {
|
||||
println("$v likes $girl better than $k and $girl likes $v better than their current partner")
|
||||
return false
|
||||
}
|
||||
}
|
||||
}
|
||||
return true
|
||||
}
|
||||
}
|
||||
|
||||
fun main(args: Array<String>) {
|
||||
val guys = People(mapOf("abe" to arrayOf("abi", "eve", "cath", "ivy", "jan", "dee", "fay", "bea", "hope", "gay"),
|
||||
"bob" to arrayOf("cath", "hope", "abi", "dee", "eve", "fay", "bea", "jan", "ivy", "gay"),
|
||||
"col" to arrayOf("hope", "eve", "abi", "dee", "bea", "fay", "ivy", "gay", "cath", "jan"),
|
||||
"dan" to arrayOf("ivy", "fay", "dee", "gay", "hope", "eve", "jan", "bea", "cath", "abi"),
|
||||
"ed" to arrayOf("jan", "dee", "bea", "cath", "fay", "eve", "abi", "ivy", "hope", "gay"),
|
||||
"fred" to arrayOf("bea", "abi", "dee", "gay", "eve", "ivy", "cath", "jan", "hope", "fay"),
|
||||
"gav" to arrayOf("gay", "eve", "ivy", "bea", "cath", "abi", "dee", "hope", "jan", "fay"),
|
||||
"hal" to arrayOf("abi", "eve", "hope", "fay", "ivy", "cath", "jan", "bea", "gay", "dee"),
|
||||
"ian" to arrayOf("hope", "cath", "dee", "gay", "bea", "abi", "fay", "ivy", "jan", "eve"),
|
||||
"jon" to arrayOf("abi", "fay", "jan", "gay", "eve", "bea", "dee", "cath", "ivy", "hope")))
|
||||
|
||||
val girls = People(mapOf("abi" to arrayOf("bob", "fred", "jon", "gav", "ian", "abe", "dan", "ed", "col", "hal"),
|
||||
"bea" to arrayOf("bob", "abe", "col", "fred", "gav", "dan", "ian", "ed", "jon", "hal"),
|
||||
"cath" to arrayOf("fred", "bob", "ed", "gav", "hal", "col", "ian", "abe", "dan", "jon"),
|
||||
"dee" to arrayOf("fred", "jon", "col", "abe", "ian", "hal", "gav", "dan", "bob", "ed"),
|
||||
"eve" to arrayOf("jon", "hal", "fred", "dan", "abe", "gav", "col", "ed", "ian", "bob"),
|
||||
"fay" to arrayOf("bob", "abe", "ed", "ian", "jon", "dan", "fred", "gav", "col", "hal"),
|
||||
"gay" to arrayOf("jon", "gav", "hal", "fred", "bob", "abe", "col", "ed", "dan", "ian"),
|
||||
"hope" to arrayOf("gav", "jon", "bob", "abe", "ian", "dan", "hal", "ed", "col", "fred"),
|
||||
"ivy" to arrayOf("ian", "col", "hal", "gav", "fred", "bob", "abe", "ed", "jon", "dan"),
|
||||
"jan" to arrayOf("ed", "hal", "gav", "abe", "bob", "jon", "col", "ian", "fred", "dan")))
|
||||
|
||||
with(EngagementRegistry(guys, girls)) {
|
||||
print(this)
|
||||
analyse(guys, girls)
|
||||
swap(girls, 0, 1)
|
||||
analyse(guys, girls)
|
||||
}
|
||||
}
|
||||
|
|
@ -24,9 +24,6 @@ my %she-likes =
|
|||
jan => < ed hal gav abe bob jon col ian fred dan >,
|
||||
;
|
||||
|
||||
my \guys = %he-likes.keys;
|
||||
my \gals = %she-likes.keys;
|
||||
|
||||
my %fiancé;
|
||||
my %fiancée;
|
||||
my %proposed;
|
||||
|
|
@ -59,7 +56,7 @@ sub match'em { #'
|
|||
}
|
||||
|
||||
sub check-stability {
|
||||
my @instabilities = gather for guys X gals -> $m, $w {
|
||||
my @instabilities = gather for flat %he-likes.keys X %she-likes.keys -> $m, $w {
|
||||
if he-prefers($m, $w) and she-prefers($w, $m) {
|
||||
take "\t$w prefers $m to %fiancé{$w} and $m prefers $w to %fiancée{$m}";
|
||||
}
|
||||
|
|
@ -74,7 +71,7 @@ sub check-stability {
|
|||
}
|
||||
}
|
||||
|
||||
sub unmatched-guy { guys.first: { not %fiancée{$_} } }
|
||||
sub unmatched-guy { %he-likes.keys.first: { not %fiancée{$_} } }
|
||||
|
||||
sub preferred-choice($guy) { %he-likes{$guy}.first: { not %proposed{"$guy $_" } } }
|
||||
|
||||
|
|
|
|||
205
Task/Stable-marriage-problem/REXX/stable-marriage-problem.rexx
Normal file
205
Task/Stable-marriage-problem/REXX/stable-marriage-problem.rexx
Normal file
|
|
@ -0,0 +1,205 @@
|
|||
/*- REXX --------------------------------------------------------------
|
||||
* pref.b Preferences of boy b
|
||||
* pref.g Preferences of girl g
|
||||
* boys List of boys
|
||||
* girls List of girls
|
||||
* plist List of proposals
|
||||
* mlist List of (current) matches
|
||||
* glist List of girls to be matched
|
||||
* glist.b List of girls that proposed to boy b
|
||||
* blen maximum length of boys' names
|
||||
* glen maximum length of girls' names
|
||||
---------------------------------------------------------------------*/
|
||||
|
||||
pref.Charlotte=translate('Bingley Darcy Collins Wickham ')
|
||||
pref.Elisabeth=translate('Wickham Darcy Bingley Collins ')
|
||||
pref.Jane =translate('Bingley Wickham Darcy Collins ')
|
||||
pref.Lydia =translate('Bingley Wickham Darcy Collins ')
|
||||
|
||||
pref.Bingley =translate('Jane Elisabeth Lydia Charlotte')
|
||||
pref.Collins =translate('Jane Elisabeth Lydia Charlotte')
|
||||
pref.Darcy =translate('Elisabeth Jane Charlotte Lydia')
|
||||
pref.Wickham =translate('Lydia Jane Elisabeth Charlotte')
|
||||
|
||||
pref.ABE='ABI EVE CATH IVY JAN DEE FAY BEA HOPE GAY'
|
||||
pref.BOB='CATH HOPE ABI DEE EVE FAY BEA JAN IVY GAY'
|
||||
pref.COL='HOPE EVE ABI DEE BEA FAY IVY GAY CATH JAN'
|
||||
pref.DAN='IVY FAY DEE GAY HOPE EVE JAN BEA CATH ABI'
|
||||
pref.ED='JAN DEE BEA CATH FAY EVE ABI IVY HOPE GAY'
|
||||
pref.FRED='BEA ABI DEE GAY EVE IVY CATH JAN HOPE FAY'
|
||||
pref.GAV='GAY EVE IVY BEA CATH ABI DEE HOPE JAN FAY'
|
||||
pref.HAL='ABI EVE HOPE FAY IVY CATH JAN BEA GAY DEE'
|
||||
pref.IAN='HOPE CATH DEE GAY BEA ABI FAY IVY JAN EVE'
|
||||
pref.JON='ABI FAY JAN GAY EVE BEA DEE CATH IVY HOPE'
|
||||
|
||||
pref.ABI='BOB FRED JON GAV IAN ABE DAN ED COL HAL'
|
||||
pref.BEA='BOB ABE COL FRED GAV DAN IAN ED JON HAL'
|
||||
pref.CATH='FRED BOB ED GAV HAL COL IAN ABE DAN JON'
|
||||
pref.DEE='FRED JON COL ABE IAN HAL GAV DAN BOB ED'
|
||||
pref.EVE='JON HAL FRED DAN ABE GAV COL ED IAN BOB'
|
||||
pref.FAY='BOB ABE ED IAN JON DAN FRED GAV COL HAL'
|
||||
pref.GAY='JON GAV HAL FRED BOB ABE COL ED DAN IAN'
|
||||
pref.HOPE='GAV JON BOB ABE IAN DAN HAL ED COL FRED'
|
||||
pref.IVY='IAN COL HAL GAV FRED BOB ABE ED JON DAN'
|
||||
pref.JAN='ED HAL GAV ABE BOB JON COL IAN FRED DAN'
|
||||
|
||||
If arg(1)>'' Then Do
|
||||
Say 'Input from task description'
|
||||
boys='ABE BOB COL DAN ED FRED GAV HAL IAN JON'
|
||||
girls='ABI BEA CATH DEE EVE FAY GAY HOPE IVY JAN'
|
||||
End
|
||||
Else Do
|
||||
Say 'Input from link'
|
||||
girls=translate('Charlotte Elisabeth Jane Lydia')
|
||||
boys =translate('Bingley Collins Darcy Wickham')
|
||||
End
|
||||
|
||||
debug=0
|
||||
blen=0
|
||||
Do i=1 To words(boys)
|
||||
blen=max(blen,length(word(boys,i)))
|
||||
End
|
||||
glen=0
|
||||
Do i=1 To words(girls)
|
||||
glen=max(glen,length(word(girls,i)))
|
||||
End
|
||||
glist=girls
|
||||
mlist=''
|
||||
Do ri=1 By 1 Until glist='' /* as long as there are girls */
|
||||
Call dbg 'Round' ri
|
||||
plist='' /* no proposals in this round */
|
||||
glist.=''
|
||||
Do gi=1 To words(glist) /* loop over free girls */
|
||||
gg=word(glist,gi) /* an unmathed girl */
|
||||
b=word(pref.gg,1) /* her preferred boy */
|
||||
plist=plist gg'-'||b /* remember this proposal */
|
||||
glist.b=glist.b gg /* add girl to the boy's list */
|
||||
Call dbg left(gg,glen) 'proposes to' b /* tell the user */
|
||||
End
|
||||
Do bi=1 To words(boys) /* loop over all boys */
|
||||
b=word(boys,bi) /* one of them */
|
||||
If glist.b>'' Then /* if he's got proposals */
|
||||
Call dbg b 'has these proposals' glist.b /* show them */
|
||||
End
|
||||
Do bi=1 To words(boys) /* loop over all boys */
|
||||
b=word(boys,bi) /* one of them */
|
||||
bm=pos(b'*',mlist) /* has he been matched yet? */
|
||||
Select
|
||||
When words(glist.b)=1 Then Do /* one girl proposed for him */
|
||||
gg=word(glist.b,1) /* the proposing girl */
|
||||
If bm=0 Then Do /* no, he hasn't */
|
||||
Call dbg b 'accepts' gg /* is accepted */
|
||||
Call set_mlist 'A',mlist b||'*'||gg /* add match to mlist */
|
||||
Call set_glist 'A',remove(gg,glist) /* remove gg from glist*/
|
||||
pref.gg=remove(b,pref.gg) /* remove b from gg's preflist*/
|
||||
End
|
||||
Else Do /* boy has been matched */
|
||||
Parse Var mlist =(bm) '*' go ' ' /* to girl go */
|
||||
If wordpos(gg,pref.b)<wordpos(go,pref.b) Then Do
|
||||
/* the proposing girl is preferred to the current one */
|
||||
/* so we replace go by gg */
|
||||
Call set_mlist 'B',repl(mlist,b||'*'||gg,b||'*'||go)
|
||||
Call dbg b 'releases' go
|
||||
Call dbg b 'accepts ' gg
|
||||
Call set_glist 'B',glist go /* add go to list of girls */
|
||||
Call set_glist 'C',remove(gg,glist) /* and remove gg */
|
||||
End
|
||||
pref.gg=remove(b,pref.gg) /* remove b from gg's preflist*/
|
||||
End
|
||||
End
|
||||
When words(glist.b)>1 Then
|
||||
Call pick_1
|
||||
Otherwise Nop
|
||||
End
|
||||
End
|
||||
Call dbg 'Matches :' mlist
|
||||
Call dbg 'free girls:' glist
|
||||
Call check 'L'
|
||||
End
|
||||
Say 'Success at round' (ri-1)
|
||||
Do While mlist>''
|
||||
Parse Var mlist boy '*' girl mlist
|
||||
Say left(boy,blen) 'matches' girl
|
||||
End
|
||||
Exit
|
||||
|
||||
pick_1:
|
||||
If bm>0 Then Do /* boy has been matched */
|
||||
Parse Var mlist =(bm) '*' go ' ' /* to girl go */
|
||||
pmin=wordpos(go,pref.b)
|
||||
End
|
||||
Else Do
|
||||
go=''
|
||||
pmin=99
|
||||
End
|
||||
Do gi=1 To words(glist.b)
|
||||
gt=word(glist.b,gi)
|
||||
gp=wordpos(gt,pref.b)
|
||||
If gp<pmin Then Do
|
||||
pmin=gp
|
||||
gg=gt
|
||||
End
|
||||
End
|
||||
If bm=0 Then Do
|
||||
Call dbg b 'accepts' gg /* is accepted */
|
||||
Call set_mlist 'A',mlist b||'*'||gg /* add match to mlist */
|
||||
Call set_glist 'A',remove(gg,glist) /* remove gg from glist*/
|
||||
pref.gg=remove(b,pref.gg) /* remove b from gg's preflist*/
|
||||
End
|
||||
Else Do
|
||||
If gg<>go Then Do
|
||||
Call set_mlist 'B',repl(mlist,b||'*'||gg,b||'*'||go)
|
||||
Call dbg b 'releases' go
|
||||
Call dbg b 'accepts ' gg
|
||||
Call set_glist 'B',glist go /* add go to list of girls */
|
||||
Call set_glist 'C',remove(gg,glist) /* and remove gg */
|
||||
pref.gg=remove(b,pref.gg) /* remove b from gg's preflist*/
|
||||
End
|
||||
End
|
||||
Return
|
||||
|
||||
remove:
|
||||
Parse Arg needle,haystack
|
||||
pp=pos(needle,haystack)
|
||||
If pp>0 Then
|
||||
res=left(haystack,pp-1) substr(haystack,pp+length(needle))
|
||||
Else
|
||||
res=haystack
|
||||
Return space(res)
|
||||
|
||||
set_mlist:
|
||||
Parse Arg where,new_mlist
|
||||
Call dbg 'set_mlist' where':' mlist
|
||||
mlist=space(new_mlist)
|
||||
Call dbg 'set_mlist ->' mlist
|
||||
Call dbg ''
|
||||
Return
|
||||
|
||||
set_glist:
|
||||
Parse Arg where,new_glist
|
||||
Call dbg 'set_glist' where':' glist
|
||||
glist=new_glist
|
||||
Call dbg 'set_glist ->' glist
|
||||
Call dbg ''
|
||||
Return
|
||||
|
||||
check:
|
||||
If words(mlist)+words(glist)<>words(boys) Then Do
|
||||
Call dbg 'FEHLER bei' arg(1) (words(mlist)+words(glist))'<>10'
|
||||
say 'match='mlist'<'
|
||||
say ' glist='glist'<'
|
||||
End
|
||||
Return
|
||||
|
||||
dbg:
|
||||
If debug Then
|
||||
Call dbg arg(1)
|
||||
Return
|
||||
repl: Procedure
|
||||
Parse Arg s,new,old
|
||||
Do i=1 To 100 Until p=0
|
||||
p=pos(old,s)
|
||||
If p>0 Then
|
||||
s=left(s,p-1)||new||substr(s,p+length(old))
|
||||
End
|
||||
Return s
|
||||
121
Task/Stable-marriage-problem/Scala/stable-marriage-problem.scala
Normal file
121
Task/Stable-marriage-problem/Scala/stable-marriage-problem.scala
Normal file
|
|
@ -0,0 +1,121 @@
|
|||
import java.util._
|
||||
import scala.collection.JavaConversions._
|
||||
|
||||
object SMP extends App {
|
||||
def run() {
|
||||
Seq("abe" -> Array("abi", "eve", "cath", "ivy", "jan", "dee", "fay", "bea", "hope", "gay"),
|
||||
"bob" -> Array("cath", "hope", "abi", "dee", "eve", "fay", "bea", "jan", "ivy", "gay"),
|
||||
"col" -> Array("hope", "eve", "abi", "dee", "bea", "fay", "ivy", "gay", "cath", "jan"),
|
||||
"dan" -> Array("ivy", "fay", "dee", "gay", "hope", "eve", "jan", "bea", "cath", "abi"),
|
||||
"ed" -> Array("jan", "dee", "bea", "cath", "fay", "eve", "abi", "ivy", "hope", "gay"),
|
||||
"fred" -> Array("bea", "abi", "dee", "gay", "eve", "ivy", "cath", "jan", "hope", "fay"),
|
||||
"gav" -> Array("gay", "eve", "ivy", "bea", "cath", "abi", "dee", "hope", "jan", "fay"),
|
||||
"hal" -> Array("abi", "eve", "hope", "fay", "ivy", "cath", "jan", "bea", "gay", "dee"),
|
||||
"ian" -> Array("hope", "cath", "dee", "gay", "bea", "abi", "fay", "ivy", "jan", "eve"),
|
||||
"jon" -> Array("abi", "fay", "jan", "gay", "eve", "bea", "dee", "cath", "ivy", "hope"))
|
||||
.foreach { e => guyPrefers.put(e._1, e._2.toList) }
|
||||
|
||||
Seq("abi" -> Array("bob", "fred", "jon", "gav", "ian", "abe", "dan", "ed", "col", "hal"),
|
||||
"bea" -> Array("bob", "abe", "col", "fred", "gav", "dan", "ian", "ed", "jon", "hal"),
|
||||
"cath" -> Array("fred", "bob", "ed", "gav", "hal", "col", "ian", "abe", "dan", "jon"),
|
||||
"dee" -> Array("fred", "jon", "col", "abe", "ian", "hal", "gav", "dan", "bob", "ed"),
|
||||
"eve" -> Array("jon", "hal", "fred", "dan", "abe", "gav", "col", "ed", "ian", "bob"),
|
||||
"fay" -> Array("bob", "abe", "ed", "ian", "jon", "dan", "fred", "gav", "col", "hal"),
|
||||
"gay" -> Array("jon", "gav", "hal", "fred", "bob", "abe", "col", "ed", "dan", "ian"),
|
||||
"hope" -> Array("gav", "jon", "bob", "abe", "ian", "dan", "hal", "ed", "col", "fred"),
|
||||
"ivy" -> Array("ian", "col", "hal", "gav", "fred", "bob", "abe", "ed", "jon", "dan"),
|
||||
"jan" -> Array("ed", "hal", "gav", "abe", "bob", "jon", "col", "ian", "fred", "dan"))
|
||||
.foreach { e => girlPrefers.put(e._1, e._2.toList) }
|
||||
|
||||
val matches = matching(guys, guyPrefers, girlPrefers)
|
||||
matches.foreach { e => println(s"${e._1} is engaged to ${e._2}") }
|
||||
if (checkMatches(guys, girls, matches, guyPrefers, girlPrefers))
|
||||
println("Marriages are stable")
|
||||
else
|
||||
println("Marriages are unstable")
|
||||
|
||||
val tmp = matches(girls(0))
|
||||
matches += girls(0) -> matches(girls(1))
|
||||
matches += girls(1) -> tmp
|
||||
println(girls(0) + " and " + girls(1) + " have switched partners")
|
||||
if (checkMatches(guys, girls, matches, guyPrefers, girlPrefers))
|
||||
println("Marriages are stable")
|
||||
else
|
||||
println("Marriages are unstable")
|
||||
}
|
||||
|
||||
private def matching(guys: Iterable[String],
|
||||
guyPrefers: Map[String, List[String]],
|
||||
girlPrefers: Map[String, List[String]]): Map[String, String] = {
|
||||
val engagements = new TreeMap[String, String]
|
||||
val freeGuys = new LinkedList[String](guys)
|
||||
while (!freeGuys.isEmpty) {
|
||||
val guy = freeGuys.remove(0)
|
||||
val guy_p = guyPrefers(guy)
|
||||
var break = false
|
||||
for (girl <- guy_p)
|
||||
if (!break)
|
||||
if (!engagements.containsKey(girl)) {
|
||||
engagements += girl -> guy
|
||||
break = true
|
||||
}
|
||||
else {
|
||||
val other_guy = engagements(girl)
|
||||
val girl_p = girlPrefers(girl)
|
||||
if (girl_p.indexOf(guy) < girl_p.indexOf(other_guy)) {
|
||||
engagements += girl -> guy
|
||||
freeGuys += other_guy
|
||||
break = true
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
engagements
|
||||
}
|
||||
|
||||
private def checkMatches(guys: Iterable[String], girls: Iterable[String],
|
||||
matches: Map[String, String],
|
||||
guyPrefers: Map[String, List[String]],
|
||||
girlPrefers: Map[String, List[String]]): Boolean = {
|
||||
if (!matches.keySet.containsAll(girls) || !matches.values.containsAll(guys))
|
||||
return false
|
||||
|
||||
val invertedMatches = new TreeMap[String, String]
|
||||
matches.foreach { invertedMatches += _.swap }
|
||||
|
||||
for ((k, v) <- matches) {
|
||||
val shePrefers = girlPrefers(k)
|
||||
val sheLikesBetter = new LinkedList[String]
|
||||
sheLikesBetter.addAll(shePrefers.subList(0, shePrefers.indexOf(v)))
|
||||
val hePrefers = guyPrefers(v)
|
||||
val heLikesBetter = new LinkedList[String]
|
||||
heLikesBetter.addAll(hePrefers.subList(0, hePrefers.indexOf(k)))
|
||||
|
||||
for (guy <- sheLikesBetter) {
|
||||
val fiance = invertedMatches(guy)
|
||||
val guy_p = guyPrefers(guy)
|
||||
if (guy_p.indexOf(fiance) > guy_p.indexOf(k)) {
|
||||
println(s"$k likes $guy better than $v and $guy likes $k better than their current partner")
|
||||
return false
|
||||
}
|
||||
}
|
||||
|
||||
for (girl <- heLikesBetter) {
|
||||
val fiance = matches(girl)
|
||||
val girl_p = girlPrefers(girl)
|
||||
if (girl_p.indexOf(fiance) > girl_p.indexOf(v)) {
|
||||
println(s"$v likes $girl better than $k and $girl likes $v better than their current partner")
|
||||
return false
|
||||
}
|
||||
}
|
||||
}
|
||||
true
|
||||
}
|
||||
|
||||
private val guys = "abe" :: "bob" :: "col" :: "dan" :: "ed" :: "fred" :: "gav" :: "hal" :: "ian" :: "jon" :: Nil
|
||||
private val girls = "abi" :: "bea" :: "cath" :: "dee" :: "eve" :: "fay" :: "gay" :: "hope" :: "ivy" :: "jan" :: Nil
|
||||
private val guyPrefers = new HashMap[String, List[String]]
|
||||
private val girlPrefers = new HashMap[String, List[String]]
|
||||
|
||||
run()
|
||||
}
|
||||
|
|
@ -0,0 +1,167 @@
|
|||
#!/usr/bin/env bash
|
||||
main() {
|
||||
# Our ten males:
|
||||
local males=(abe bob col dan ed fred gav hal ian jon)
|
||||
|
||||
# And ten females:
|
||||
local females=(abi bea cath dee eve fay gay hope ivy jan)
|
||||
|
||||
# Everyone's preferences, ranked most to least desirable:
|
||||
local abe=( abi eve cath ivy jan dee fay bea hope gay )
|
||||
local abi=( bob fred jon gav ian abe dan ed col hal )
|
||||
local bea=( bob abe col fred gav dan ian ed jon hal )
|
||||
local bob=(cath hope abi dee eve fay bea jan ivy gay )
|
||||
local cath=(fred bob ed gav hal col ian abe dan jon )
|
||||
local col=(hope eve abi dee bea fay ivy gay cath jan )
|
||||
local dan=( ivy fay dee gay hope eve jan bea cath abi )
|
||||
local dee=(fred jon col abe ian hal gav dan bob ed )
|
||||
local ed=( jan dee bea cath fay eve abi ivy hope gay )
|
||||
local eve=( jon hal fred dan abe gav col ed ian bob )
|
||||
local fay=( bob abe ed ian jon dan fred gav col hal )
|
||||
local fred=( bea abi dee gay eve ivy cath jan hope fay )
|
||||
local gav=( gay eve ivy bea cath abi dee hope jan fay )
|
||||
local gay=( jon gav hal fred bob abe col ed dan ian )
|
||||
local hal=( abi eve hope fay ivy cath jan bea gay dee )
|
||||
local hope=( gav jon bob abe ian dan hal ed col fred)
|
||||
local ian=(hope cath dee gay bea abi fay ivy jan eve )
|
||||
local ivy=( ian col hal gav fred bob abe ed jon dan )
|
||||
local jan=( ed hal gav abe bob jon col ian fred dan )
|
||||
local jon=( abi fay jan gay eve bea dee cath ivy hope)
|
||||
|
||||
# A place to store the engagements:
|
||||
local -A engagements=()
|
||||
|
||||
# Our list of free males, initially comprised of all of them:
|
||||
local freemales=( "${males[@]}" )
|
||||
|
||||
# Now we use the Gale-Shapley algorithm to find a stable set of engagements
|
||||
|
||||
# Loop over the free males. Note that we can't use for..in because the body
|
||||
# of the loop may modify the array we're looping over
|
||||
local -i m=0
|
||||
while (( m < ${#freemales[@]} )); do
|
||||
local male=${freemales[m]}
|
||||
let m+=1
|
||||
|
||||
# This guy's preferences
|
||||
eval 'local his=("${'"$male"'[@]}")'
|
||||
|
||||
# Starting with his favorite
|
||||
local -i f=0
|
||||
local female=${his[f]}
|
||||
|
||||
# Find her preferences
|
||||
eval 'local hers=("${'"$female"'[@]}")'
|
||||
|
||||
# And her current fiancé, if any
|
||||
local fiance=${engagements[$female]}
|
||||
|
||||
# If she has a fiancé and prefers him to this guy, look for this guy's next
|
||||
# best choice
|
||||
while [[ -n $fiance ]] &&
|
||||
(( $(index "$male" "${hers[@]}") > $(index "$fiance" "${hers[@]}") )); do
|
||||
let f+=1
|
||||
female=${his[f]}
|
||||
eval 'hers=("${'"$female"'[@]}")'
|
||||
fiance=${engagements[$female]}
|
||||
done
|
||||
|
||||
# If we're still on someone who's engaged, it means she prefers this guy
|
||||
# to her current fiancé. Dump him and put him at the end of the free list.
|
||||
if [[ -n $fiance ]]; then
|
||||
freemales+=("$fiance")
|
||||
printf '%-4s rejected %-4s\n' "$female" "$fiance"
|
||||
fi
|
||||
|
||||
# We found a match! Record it
|
||||
engagements[$female]=$male
|
||||
printf '%-4s accepted %-4s\n' "$female" "$male"
|
||||
done
|
||||
|
||||
# Display the final result, which should be stable
|
||||
print_couples engagements
|
||||
|
||||
# Verify its stability
|
||||
print_stable engagements "${females[@]}"
|
||||
|
||||
# Try a swap
|
||||
printf '\nWhat if cath and ivy swap partners?\n'
|
||||
local temp=${engagements[cath]}
|
||||
engagements[cath]=${engagements[ivy]}
|
||||
engagements[ivy]=$temp
|
||||
|
||||
# Display the new result, which should be unstable
|
||||
print_couples engagements
|
||||
|
||||
# Verify its instability
|
||||
print_stable engagements "${females[@]}"
|
||||
}
|
||||
|
||||
# utility function - get index of an item in an array
|
||||
index() {
|
||||
local needle=$1
|
||||
shift
|
||||
local haystack=("$@")
|
||||
local -i i
|
||||
for i in "${!haystack[@]}"; do
|
||||
if [[ ${haystack[i]} == $needle ]]; then
|
||||
printf '%d\n' "$i"
|
||||
return 0
|
||||
fi
|
||||
done
|
||||
return 1
|
||||
}
|
||||
|
||||
# print the couples from the engagement array; takes name of array as argument
|
||||
print_couples() {
|
||||
printf '\nCouples:\n'
|
||||
local keys
|
||||
mapfile -t keys < <(eval 'printf '\''%s\n'\'' "${!'"$1"'[@]}"' | sort)
|
||||
local female
|
||||
for female in "${keys[@]}"; do
|
||||
eval 'local male=${'"$1"'["'"$female"'"]}'
|
||||
printf '%-4s is engaged to %-4s\n' "$female" "$male"
|
||||
done
|
||||
printf '\n'
|
||||
}
|
||||
|
||||
# print whether a set of engagements is stable; takes name of engagement array
|
||||
# followed by the list of females
|
||||
print_stable() {
|
||||
if stable "$@"; then
|
||||
printf 'These couples are stable.\n'
|
||||
else
|
||||
printf 'These couples are not stable.\n'
|
||||
fi
|
||||
}
|
||||
|
||||
# determine if a set of engagements is stable; takes name of engagement array
|
||||
# followed by the list of females
|
||||
stable() {
|
||||
local dict=$1
|
||||
shift
|
||||
eval 'local shes=("${!'"$dict"'[@]}")'
|
||||
eval 'local hes=("${'"$dict"'[@]}")'
|
||||
local -i i
|
||||
local -i result=0
|
||||
for (( i=0; i<${#shes[@]}; ++i )); do
|
||||
local she=${shes[i]} he=${hes[i]}
|
||||
eval 'local his=("${'"$he"'[@]}")'
|
||||
local alt
|
||||
for alt in "$@"; do
|
||||
eval 'local fiance=${'"$dict"'["'"$alt"'"]}'
|
||||
eval 'local hers=("${'"$alt"'[@]}")'
|
||||
if (( $(index "$she" "${his[@]}") > $(index "$alt" "${his[@]}")
|
||||
&& $(index "$fiance" "${hers[@]}") > $(index "$he" "${hers[@]}") ))
|
||||
then
|
||||
printf '%-4s is engaged to %-4s but prefers %4s, ' "$he" "$she" "$alt"
|
||||
printf 'while %-4s is engaged to %-4s but prefers %4s.\n' "$alt" "$fiance" "$he"
|
||||
result=1
|
||||
fi
|
||||
done
|
||||
done
|
||||
if (( result )); then printf '\n'; fi
|
||||
return $result
|
||||
}
|
||||
|
||||
main "$@"
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
Sub M_snb()
|
||||
c00 = "_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 " & _
|
||||
"_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 "
|
||||
|
||||
sn = Filter(Filter(Split(c00), "_"), "-", 0)
|
||||
Do
|
||||
c01 = Mid(c00, InStr(c00, sn(0) & " "))
|
||||
st = Split(Left(c01, InStr(Mid(c01, 2), "_")))
|
||||
For j = 1 To UBound(st) - 1
|
||||
If InStr(c00, "_" & st(j) & " ") > 0 Then
|
||||
c00 = Replace(Replace(c00, sn(0), sn(0) & "-" & st(j)), "_" & st(j), "_" & st(j) & "." & Mid(sn(0), 2))
|
||||
Exit For
|
||||
Else
|
||||
c02 = Filter(Split(c00, "_"), st(j) & ".")(0)
|
||||
c03 = Split(Split(c02)(0), ".")(1)
|
||||
If InStr(c02, " " & Mid(sn(0), 2) & " ") < InStr(c02, " " & c03 & " ") Then
|
||||
c00 = Replace(Replace(Replace(c00, c03 & "-" & st(j), c03), sn(0), sn(0) & "-" & st(j)), "_" & st(j), "_" & st(j) & "." & Mid(sn(0), 2))
|
||||
Exit For
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
sn = Filter(Filter(Filter(Split(c00), "_"), "-", 0), ".", 0)
|
||||
Loop Until UBound(sn) = -1
|
||||
|
||||
MsgBox Replace(Join(Filter(Split(c00), "-"), vbLf), "_", "")
|
||||
End Sub
|
||||
|
|
@ -0,0 +1,56 @@
|
|||
Sub M_snb()
|
||||
Set d_00 = CreateObject("scripting.dictionary")
|
||||
Set d_01 = CreateObject("scripting.dictionary")
|
||||
Set d_02 = CreateObject("scripting.dictionary")
|
||||
|
||||
sn = Split("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 ", "_")
|
||||
|
||||
sp = Split("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 ", "_")
|
||||
|
||||
For j = 0 To UBound(sn)
|
||||
d_00(Split(sn(j))(0)) = ""
|
||||
d_01(Split(sp(j))(0)) = ""
|
||||
d_02(Split(sn(j))(0)) = sn(j)
|
||||
d_02(Split(sp(j))(0)) = sp(j)
|
||||
Next
|
||||
|
||||
Do
|
||||
For Each it In d_00.keys
|
||||
If d_00.Item(it) = "" Then
|
||||
st = Split(d_02.Item(it))
|
||||
For jj = 1 To UBound(st)
|
||||
If d_01(st(jj)) = "" Then
|
||||
d_00(st(0)) = st(0) & vbTab & st(jj)
|
||||
d_01(st(jj)) = st(0)
|
||||
Exit For
|
||||
ElseIf InStr(d_02.Item(st(jj)), " " & st(0) & " ") < InStr(d_02.Item(st(jj)), " " & d_01(st(jj)) & " ") Then
|
||||
d_00(d_01(st(jj))) = ""
|
||||
d_00(st(0)) = st(0) & vbTab & st(jj)
|
||||
d_01(st(jj)) = st(0)
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Next
|
||||
Loop Until UBound(Filter(d_00.items, vbTab)) = d_00.Count - 1
|
||||
|
||||
MsgBox Join(d_00.items, vbLf)
|
||||
End Sub
|
||||
Loading…
Add table
Add a link
Reference in a new issue