diff options
Diffstat (limited to '95-99')
| -rw-r--r-- | 95-99/95.hs | 5 | ||||
| -rw-r--r-- | 95-99/96.hs | 9 | ||||
| -rw-r--r-- | 95-99/97.hs | 0 | ||||
| -rw-r--r-- | 95-99/98.hs | 39 | ||||
| -rw-r--r-- | 95-99/99.hs | 37 |
5 files changed, 90 insertions, 0 deletions
diff --git a/95-99/95.hs b/95-99/95.hs new file mode 100644 index 0000000..4a6ff49 --- /dev/null +++ b/95-99/95.hs @@ -0,0 +1,5 @@ +fullWords :: Int -> String + +fullWords x = if x < 10 then s else fullWords (x `quot` 10) ++ "-" ++ s + where s = ["zero", "one", "two", "three", "four", + "five", "six", "seven", "eight", "nine"]!!(x `mod` 10) diff --git a/95-99/96.hs b/95-99/96.hs new file mode 100644 index 0000000..b051d8b --- /dev/null +++ b/95-99/96.hs @@ -0,0 +1,9 @@ +import Data.Char (isLetter, isDigit) + +identifier :: String -> Bool + +identifier [] = False +identifier (c:xc) = isLetter c && loop xc + where loop [] = True + loop ('-':c:xc) = (isLetter c || isDigit c) && loop xc + loop (c:xc) = (isLetter c || isDigit c) && loop xc diff --git a/95-99/97.hs b/95-99/97.hs new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/95-99/97.hs diff --git a/95-99/98.hs b/95-99/98.hs new file mode 100644 index 0000000..02dbc99 --- /dev/null +++ b/95-99/98.hs @@ -0,0 +1,39 @@ +import Data.List (intersperse) + +-- generate all possible patterns given row/col constraints +gen n [] + | n >= -1 = return [] + | otherwise = [] +gen n (x:xs) = do p <- [0..n-x] + s <- gen (n - (p + x + 1)) xs + return ([p..p+x-1] ++ map (+ (p + x + 1)) s) + +output sols = [do b <- sol + ('|':(intersperse '|' $ + map (\x -> if x `elem` b then 'X' else '_') [0..7]) + ++ "|\n") | sol <- sols] + +-- eliminate the possible patterns according to the given information in +-- a column (b stands for 'X') +elim b w ps = filter (\p -> all (\x -> x `elem` p) b && + all (\x -> x `notElem` p) w) ps + +nonogram row col = output $ find 0 (map (gen 8) row) (map (gen 9) col) + (replicate 8 []) (replicate 8 []) + where find _ [] colps _ _ + | any (== []) colps = [] + | otherwise = return [] + find i (rs:rowps) colps cb cw + | any (== []) colps = [] + | otherwise = do r <- rs + let cb' = [b' | (c, b) <- zip [0..7] cb, + let b' = if c `elem` r then i:b else b] + let cw' = [w' | (c, w) <- zip [0..7] cw, + let w' = if c `notElem` r then i:w else w] + sol <- find (i + 1) rowps + (map ((uncurry . uncurry) elim) + (zip (zip cb' cw') colps)) + cb' cw' + return (r:sol) + +-- mapM_ putStr (nonogram [[3],[2,1],[3,2],[2,2],[6],[1,5],[6],[1],[2]] [[1,2],[3,1],[1,5],[7,1],[5],[3],[4],[3]]) diff --git a/95-99/99.hs b/95-99/99.hs new file mode 100644 index 0000000..d682683 --- /dev/null +++ b/95-99/99.hs @@ -0,0 +1,37 @@ +import Data.Function (on) +import Data.List (groupBy, delete) + +toSites lines = sites id lines ++ sites transpose lines + where sites trans ls = concatMap ( + (filter ((> 1) . snd)) . + (map (\l -> (map fst l, length l))) . + (filter ((== '.') . snd . head)) . + (groupBy ((==) `on` snd))) $ + trans ((zipWith (\r line -> zip [(r, c) | c <- [0..]] line) [0..]) ls) + +transpose mat + | head mat == [] = [] + | otherwise = (\(a, b) -> a:transpose b) $ unzip (map (\(x:xs) -> (x, xs)) mat) + + +solve :: String -> [[((Int, Int), Char)]] + +solve str = solve' words sites [] + where solve' _ [] wrote = return wrote + solve' words (s:ss) wrote = + do w <- filter (\w -> length w == snd s) words + let t = takeWhile snd $ + scanl (\(wr, f) (c, p@(x, y)) -> + let t = filter ((== p). fst) wrote in + if t == [] then ((p, c):wr, f) + else if (snd . head) t == c then + (wr, f) else ([], False)) + (wrote, True) + (zip w $ fst s) + if length t == snd s + 1 then + solve' (delete w words) ss (fst $ last t) + else [] + + + (words, sitesin) = break (== "") $ lines str + sites = toSites $ tail sitesin |