• 43
• 4

Stable marrigemarriage in Haskell

• 43
• 4

I implemented a stable marrige problem in Haskell few month ago. It's not optimized at all and I'd like to know how to make it better from performance and readability perspective.

data Sex = Male | Female deriving (Eq, Show)
data Virtue = Intelligence | Appearence | Kindness deriving (Eq, Show, Enum)
data Parameter = Parameter{
 virtue :: Virtue,
 value :: Int
} deriving (Eq, Show)
data Person = Person{
 name :: String,
 sex :: Sex,
 preferences :: [Virtue],
 parameters :: [Parameter],
 partner :: Maybe Person
} deriving (Eq, Show)

Results list of women sorted by preferences of one man by defaultRateFunction :: Person -> Person -> Int. In my implementation it depends on judges preferences and rated person parameters. I won't put it there for brevity. You can find full program in a link to Gist at the bottom of post. Imagine that function to be anything you want.

personalRating :: Person -> [Person] -> [Person]
personalRating x ys = sortBy (comparing (\y -> defaultRateFunction x y)) ys

Man makes an engagement proposal for the woman and if she don't have partner — she replies positively (True) and if she does, if new partner's rating > than the old one's — "returns" True and if it does not — False

proposal :: Person -> Person -> Bool
proposal male female
 | isNothing (partner female) = True
 | defaultRateFunction female male > defaultRateFunction female (fromJust $ partner female) = True
 | otherwise = False

Man makes a proposal for each woman in females untill he'll find the one who'll reply positively. Assumed that there are at least one of this type in the array

findTheBride :: Person -> [Person] -> Person
findTheBride male females 
 | proposal male (head females) == True = head females
 | otherwise = findTheBride male (tail females)

The ugliest part is marrige algorhitm itself. As I call it recursively I have to clean person from array of corresponded sexes every time it finds partner and also check if woman has an ex-partner, and deal with thier "breakup" also.

marrige :: [Person] -> [Person] -> [Person]
marrige males females
 | sm == [] = females
 | isNothing ex = marrige
 (fsmWithNewPartner:(delete fsm males))
 (fsmPartnerWithFsm:(delete fsmPartner females))
 | otherwise = marrige 
 (fsmWithNewPartner:((fromJust ex) {partner = Nothing}):(delete fsm $ delete (fromJust ex) males))
 (fsmPartnerWithFsm:(delete fsmPartner females))
 where 
 sm = filter (\x -> partner x == Nothing) males -- Single males
 fsm = head sm -- Fist single male
 fsmPartner = findTheBride fsm (personalRating fsm females) -- Fist single male's partner
 ex = partner fsmPartner -- Partner's ex (Maybe)
 fsmWithNewPartner = fsm {partner = Just fsmPartner}
 fsmPartnerWithFsm = fsmPartner {partner = Just fsm}

Full version of program (where random Person data are generated) avialible on Gist.