From ca4d88e67d39d3071304508017e6543ab19d160d Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 31 May 2017 11:40:49 +0200
Subject: Move stable-marriage-problem to submodule

---
 ss2017/stable_marriage_problem/ausarbeitung.lhs | 127 ------------------------
 1 file changed, 127 deletions(-)
 delete mode 100644 ss2017/stable_marriage_problem/ausarbeitung.lhs

(limited to 'ss2017/stable_marriage_problem/ausarbeitung.lhs')

diff --git a/ss2017/stable_marriage_problem/ausarbeitung.lhs b/ss2017/stable_marriage_problem/ausarbeitung.lhs
deleted file mode 100644
index ca03280..0000000
--- a/ss2017/stable_marriage_problem/ausarbeitung.lhs
+++ /dev/null
@@ -1,127 +0,0 @@
-Preliminaries
-=============
-
-  - Efficient finite maps
-
-> import Data.Map (Map, (!))
-> import qualified Data.Map as Map
-
-  - Efficient finite sets
-
-> import Data.Set (Set)
-> import qualified Data.Set as Set
-
-  - Some convenience functions for manipulating lists and endomorphisms
-
-> import Control.Monad (guard, when)
-> import Data.Monoid (Endo(..))
-
-  - An arbitrary representation of a person
-
-> type Person = Integer
-
-Utilities
----------
-
-> (&!) :: a -> [a -> a] -> a
-> -- ^ Reverse application of a list of endomorphisms
-> x &! fs = foldMap Endo fs `appEndo` x
-> 
-> infix 3 ==>
-> -- | Logical implication
-> (==>) :: Bool -> Bool -> Bool
-> False ==> _     = True
-> True  ==> True  = True
-> True  ==> False = False
-
-<!--
-
-> pPrint :: PreferenceTable -> IO ()
-> pPrint = putStr . unlines . map (\(k, prefs) -> show k ++ ": " ++ unwords (map show prefs)) . Map.toList
->
-> stepPhase1 :: PreferenceTable -> IO (Maybe PreferenceTable)
-> stepPhase1 = phase1Iter Set.empty
->   where
->     phase1Iter :: Set Person -> PreferenceTable -> IO (Maybe PreferenceTable)
->     -- ^ Call `phase1'` until no person is free
->     phase1Iter engaged table = do
->         let r = phase1' engaged table
->         case r of
->             Just (engaged', table') -> do
->                 when (table' /= table) $ do
->                     pPrint table'
->                     () <$ getLine
->                 if engaged' == Map.keysSet table'
->                     then return (Just table')
->                     else phase1Iter engaged' table'
->             Nothing -> return Nothing
-
-
--->
-
-Definitions
-===========
-
-\begin{def*}
-A \emph{preference table} is a finite set of persons, each associated with a list of other persons, ordered by preference.
-\end{def*}
-
-> type PreferenceTable = Map Person [Person]
-
-\begin{def*}
-We call a pair ${a, b}$ \emph{embedded} in a preference table if $a$ occurs in $b$s preference list and vice versa.
-\end{def*}
-
-Deleting a pair from a table means removing each from the others preference list:
-
-> delPair :: (Person, Person) -> (PreferenceTable -> PreferenceTable)
-> delPair (p1, p2) = Map.mapWithKey delPair'
->   where
->     delPair' k v = do
->         z <- v
->         guard $ k == p1 ==> z /= p2
->         guard $ k == p2 ==> z /= p1
->         return z
-
-\begin{def*}
-An ordered pair $(a, b)$ is said to be \emph{semiengaged} if $a$ occurs last in $b$s preference table and $b$ occurs first in $a$s.
-
-This means that, while $b$ is $a$s best choice of partner, $a$ has no worse choice in partner than $a$
-\end{def*}
-
-> semiEngaged :: (Person, Person) -> PreferenceTable -> Bool
-> -- ^ `semiEngaged (x, y)`; is `x` last in `y`s preference list?
-> semiEngaged (x, y) table = x == (last $ table ! y)
-
-Phase 1
-=======
-
-> phase1' :: Set Person -> PreferenceTable -> Maybe (Set Person, PreferenceTable)
-> phase1' engaged table
->   | any null (Map.elems table)
->   = Nothing -- If a preference list became empty: fail
->   | Set.null free
->   = Just (engaged, table) -- If nobody is free, we have nobody left to engage
->   | otherwise
->   = let x = Set.findMin free -- Arbitrary choice of free person
->         y = head $ table ! x -- Best choice of engagement for x
->         adjTable = [ delPair (x', y) | x' <- dropWhile (/= x) (table ! y), x' /= x ]
->         -- ^ For all worse (than x) choices x' for y; drop them from y's preference list
->         adjEngaged = [ Set.insert x -- x is now engaged
->                      ] ++ [ Set.delete z | z <- Map.keys table, semiEngaged (z, y) table, z /= x ] -- Nobody else is engaged to y
->      in Just (engaged &! adjEngaged, table &! adjTable)
->   where
->     free = Map.keysSet table `Set.difference` engaged
-
-The algorithm is iterated until all participants are engaged
-
-> phase1 :: PreferenceTable -> Maybe PreferenceTable
-> phase1 = phase1Iter Set.empty
->   where
->     phase1Iter :: Set Person -> PreferenceTable -> Maybe PreferenceTable
->     -- ^ Call `phase1'` until no person is free
->     phase1Iter engaged table = do
->         (engaged', table') <- phase1' engaged table
->         if engaged' == Map.keysSet table'
->             then return table'
->             else phase1Iter engaged' table'
-- 
cgit v1.2.3