Stable marriage problem: Difference between revisions

→‎The solution: Added general type annotations
(→‎{{header|Haskell}}: Changed to more idiomatic and clear solution)
(→‎The solution: Added general type annotations)
Line 2,540:
import Data.List (union, delete)
 
type Preferences a = (a, [a])
data State = State { _freeGuys :: [String]
type Couple a = (a,a)
, _guys :: [(String,[String])]
data State a = State { _freeGuys :: [Stringa]
, _girls :: [(String,[String])]}
, _guys :: [(String,[String])Preferences a]
, _girls :: [(String,[String])Preferences a]}
 
makeLenses ''State</lang>
Line 2,554 ⟶ 2,556:
 
fianceesOf n = guys.name n._2
fiancesOf n = girls.name n._2</lang>
 
Note that in following we use lens operators:
theBestGirlFor name = fianceesOf name._head
theBestGuyFor name = fiancesOf name._head</lang>
 
Here we see that the best choice for guys and for girls is expected to appear on the top of their preference lists. Note that in following we use lens operators:
 
^. -- access to a field
Line 2,565 ⟶ 2,564:
.~ -- setting a field the value
 
Further we use a trick: guys list girls in a descending order of preference (the most liked is the first), while girls expect guys in opposite order -- the most liked is the last. In any case, we assume that the current best choice for guys and for girls is expected to appear on the top of their preference lists.
 
With these tools and notes we are ready to implement the Gale/Shapley algorithm and the stability test as they are given in a textbook:
 
<lang Haskell>stableMatching :: Eq a => getPairsState .a iterateUntil-> (null._freeGuys)[Couple stepa]
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
Line 2,590 ⟶ 2,591:
| 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
Line 2,598 ⟶ 2,600:
, let fw = s^.fiancesOf w2
, elemIndex m2 fw < elemIndex m1 fw ]</lang>
 
This solution works not only for strings, but for any equable data.
 
=== The task ===
 
Anonymous user