如何最有效地分配房間？

Question

故事：

我們公司即將開業。對於我們住在度假村，我們每兩個同事將共用一個房間。我們的管理員助理收集了我們與誰共用房間的偏好，現在她必須決定如何安排房間以儘量減少所需的房間數量。每個人都將被安排與他或她想要的人分享一個房間。例如，只有同事，艾倫想與鮑勃或克里斯分享一個房間，鮑勃想與克里斯分享，克里斯想與艾倫分享;那麼唯一的結果就是：艾倫和克里斯分享一個房間，而鮑勃單獨使用一個房間，總共需要2個房間。

問：

爲了簡化故事的算法問題（這可能不是最好的簡化雖然）：我們在圖中的幾個節點，以及節點相互連接。我們只關心雙向連接的節點，所以現在我們有一個無向圖。如何將單向圖中的節點劃分成組，以便1）任何組最多包含2個節點，2）如果一個組包含2個節點，則連接節點，3）組數最小化。

算法：

什麼是我的頭是貪婪地解決問題。在每個安排步驟中，只需刪除一個孤立節點或兩個節點，以使圖中邊緣的數量最大化。通過反覆這樣做，我們將最終找到解決方案。

請以最佳方式解決問題（並且我不想嘗試所有組合）或者證明上述貪婪算法是最優的。

Answer 1

您正在解決的問題是在圖表中找到maximum matching。這意味着找到不共享頂點的最大邊數。在你的情況下，這些邊將對應於共享房間，其餘的頂點將是單個房間。

在多項式時間內使用Blossom algorithm可以找到最大匹配。

Answer 2

這是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' (x@(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 a@(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 (x@[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