這是Haskell中粗糙的東西。函數「對」列出所有具有相互偏好的對,以及沒有相互夥伴的人(與「」配對)。函數「choose」從對列表中返回對。如果一對中的兩個人也與另一個(同一)第三個人配對,則「選擇」會將這兩個人從配對清單的其餘部分中刪除,以及因此而清空的配對。所需房間的數量等於最終列表的長度。
輸出(這將是很好有更多的變化的實施例進行測試):
*Main> choose graph
[["Chris","Allen"],["Bob","Isaak"]]
*Main> choose graph1
[["Allen","Chris"],["Bob",""],["Dave",""],["Chris","Max"]] --four rooms
would be needed, although Chris appears in two pairs (..figured they can
decide later who stays where.)
*Main> choose graph2 --example given by Dante is not a Geek
[["Allen","Chris"],["Bob",""]]
代碼:
import Data.List (group, sort, delete)
graph = [("Chris",["Isaak","Bob","Allen"]) --(person,preferences)
,("Allen",["Chris","Bob"])
,("Bob",["Allen","Chris","Isaak"])
,("Isaak",["Bob","Chris"])]
graph1 = [("Allen",["Bob","Chris"]), ("Bob",["Chris"]), ("Dave",[])
,("Chris",["Allen", "Max"]), ("Max", ["Chris"])]
graph2 = [("Allen",["Bob","Chris"]), ("Bob",["Chris"]), ("Chris",["Allen"])]
pairs graph = pairs' graph [] where
pairs' [] result = concat result
pairs' ([email protected](person1,_):xs) result
| null test = if elem [[person1, ""]] result
then pairs' xs result
else pairs' xs ([[person1,""]]:result)
| otherwise =
pairs' xs ((filter (\[x,y] -> notElem [y,x] (concat result)) test):result)
where isMutual a b = elem (fst a) (snd b) && elem (fst b) (snd a)
test = foldr comb [] graph
comb [email protected](person2,_) b =
if isMutual a x then [person1,person2]:b else b
choose graph = comb paired [] where
paired = pairs graph
comb [] result = filter (/=["",""]) result
comb ([email protected][p1,p2]:xs) result
| x == ["",""] = comb xs result
| test =
comb (map delete' xs) (x:map delete' result)
| otherwise = comb xs (x:result)
where delete' [x,y] = if elem x [p1,p2] then ["",y]
else if elem y [p1,p2] then [x,""]
else [x,y]
test = if not . null . filter ((>=2) . length) . group
. sort . map (delete p2 . delete p1)
. filter (\y -> y /= x && (elem p1 y || elem p2 y)) $ paired
then True
else False
的貪婪算法不是最佳的。考慮兩個由單個邊連接的5個週期。沒有理由你的算法不會刪除與3度頂點相對的一條邊,這不屬於最大匹配。 –