日々の破片

_ 10日の続き

check :: String -> (Char, Int) -> ([Int], String)
check key (x, i) | elem x key = ([i], [x])
                 | otherwise = ([], [])
 
comp :: String -> ([Int], String) -> Bool
comp key v = length key == length (snd v)
 
pile :: ([Int], String) -> ([Int], String) -> ([Int], String)
pile (is, x) (is2, x2) | x == x2          = (is2, x2)
                       | elem (head x2) x = (is, x)
                       | otherwise        = (is ++ is2, x ++ x2)
                
pileAll :: String -> [([Int], String)] -> [([Int], String)]
pileAll _ [] = []
pileAll key (v:vs) = (foldl pile v vs) : (pileAll key vs)
 
findSections :: String -> String -> [([Int], String)]
findSections key str = filter (comp key) $ pileAll key 
                       [(a, s) | (a, s) <- map (check key) $ zip str [0..], not $ null a]
 
main :: IO ()
main = do
--  readFile "nkdata.txt" >>= putStrLn . show . (findSections "pma")
  putStrLn $ show (findSections "pma" "program-promnade")

約1時間30分かかった(実際に動くまで。推敲は別)。