RosettaCodeData/Task/State-name-puzzle/Haskell/state-name-puzzle.hs
2015-11-18 06:14:39 +00:00

87 lines
1.9 KiB
Haskell

{-# LANGUAGE TupleSections #-}
import Data.Char (toLower, isLetter)
import Data.List (sort, sortBy, nub, groupBy)
import Data.Function (on)
stateNames :: [String]
stateNames=
["Alabama",
"Alaska",
"Arizona",
"Arkansas",
"California",
"Colorado",
"Connecticut",
"Delaware",
"Florida",
"Georgia",
"Hawaii",
"Idaho",
"Illinois",
"Indiana",
"Iowa",
"Kansas",
"Kentucky",
"Louisiana",
"Maine",
"Maryland",
"Massachusetts",
"Michigan",
"Minnesota",
"Mississippi",
"Missouri",
"Montana",
"Nebraska",
"Nevada",
"New Hampshire",
"New Jersey",
"New Mexico",
"New York",
"North Carolina",
"North Dakota",
"Ohio",
"Oklahoma",
"Oregon",
"Pennsylvania",
"Rhode Island",
"South Carolina",
"South Dakota",
"Tennessee",
"Texas",
"Utah",
"Vermont",
"Virginia",
"Washington",
"West Virginia",
"Wisconsin",
"Wyoming"]
fakeStateNames :: [String]
fakeStateNames =
["New Kory",
"Wen Kory",
"York New",
"Kory New",
"New Kory"]
pairs :: [a] -> [(a,a)]
pairs [] = []
pairs (y:ys) = map (y,) ys ++ pairs ys
puzzle :: [String] -> [((String,String), (String, String))]
puzzle states =
concatMap (filter isValid.pairs) $
map (map snd) $
filter ((>1) . length ) $
groupBy ((==) `on` fst) $
sortBy (compare `on` fst) [(pkey (a++b), (a,b)) | (a,b) <- pairs (nub $ sort states)] where
pkey = sort . filter isLetter . map toLower
isValid ((a0, a1),(b0, b1)) = (a0 /= b0) && (a0 /= b1) && (a1 /= b0) && (a1 /= b1)
main :: IO ()
main = do
putStrLn $ "Matching pairs generated from "
++ show (length stateNames) ++ " state names and "
++ show (length fakeStateNames) ++ " fake state names:"
mapM_ print $ puzzle $ stateNames ++ fakeStateNames