61 lines
1.8 KiB
Haskell
61 lines
1.8 KiB
Haskell
|
module Pissoir where
|
|||
|
|
|
|||
|
|
import Data.Tree
|
|||
|
|
import Data.List
|
|||
|
|
import Data.Function (on)
|
|||
|
|
import qualified Data.Set as Set
|
|||
|
|
|
|||
|
|
type Urinal = Int
|
|||
|
|
|
|||
|
|
-- |Occupied ∪ Free| = n (size of pissoir)
|
|||
|
|
-- Occupied ∩ Free = ∅
|
|||
|
|
data Pissoir = Pissoir {occupied :: Set.Set Urinal, free :: Set.Set Urinal}
|
|||
|
|
deriving (Show)
|
|||
|
|
|
|||
|
|
maximumsBy :: (Ord o, Eq a) => (a -> o) -> [a] -> [a]
|
|||
|
|
maximumsBy f xs = filter ((== theMaximum) . f) xs
|
|||
|
|
where theMaximum = maximum $ map f xs
|
|||
|
|
|
|||
|
|
mkPissoir :: Int -> Pissoir
|
|||
|
|
mkPissoir number = Pissoir {occupied = Set.empty, free = Set.fromList [1..number]}
|
|||
|
|
|
|||
|
|
next :: Pissoir -> [Pissoir]
|
|||
|
|
next pissoir
|
|||
|
|
| Set.null (occupied pissoir) = insertPossibilites (Set.toList (free pissoir))
|
|||
|
|
| Set.null (free pissoir) = []
|
|||
|
|
| otherwise =
|
|||
|
|
let distances = (\freeOne -> map (abs . subtract freeOne) $ Set.toList $ occupied pissoir)
|
|||
|
|
urinals = maximumsBy (minimum . distances) $ Set.toList $ free pissoir
|
|||
|
|
in insertPossibilites urinals
|
|||
|
|
where
|
|||
|
|
insertPossibilites =
|
|||
|
|
map
|
|||
|
|
(\urinal ->
|
|||
|
|
pissoir
|
|||
|
|
{ occupied = Set.insert urinal (occupied pissoir)
|
|||
|
|
, free = Set.delete urinal (free pissoir)
|
|||
|
|
}
|
|||
|
|
)
|
|||
|
|
|
|||
|
|
renderPissoir :: Pissoir -> String
|
|||
|
|
renderPissoir pissoir =
|
|||
|
|
map
|
|||
|
|
(\x ->
|
|||
|
|
if Set.member x (occupied pissoir)
|
|||
|
|
then '■'
|
|||
|
|
else if Set.member x (free pissoir)
|
|||
|
|
then '□'
|
|||
|
|
else '?')
|
|||
|
|
allUrinals
|
|||
|
|
where allUrinals = sort (Set.toList (Set.union (occupied pissoir) (free pissoir)))
|
|||
|
|
|
|||
|
|
pissoirTree :: Pissoir -> Tree Pissoir
|
|||
|
|
pissoirTree initialPissoir = Node initialPissoir (map pissoirTree $ next initialPissoir)
|
|||
|
|
|
|||
|
|
printPissoirTree :: Tree Pissoir -> IO ()
|
|||
|
|
printPissoirTree = putStrLn . drawTree . fmap renderPissoir
|
|||
|
|
|
|||
|
|
-- [1,2,4,8,20,48,216,576,1392,7200,43200,184320,
|
|||
|
|
pissoirProblemN :: Int -> Int
|
|||
|
|
pissoirProblemN = length . last . levels . pissoirTree . mkPissoir
|