cryptopangrams.hs

import Data.List (sort, group)
import qualified Data.Map as M
import Control.Monad

sampleStr = "CJQUIZKNOWBEVYOFDPFLUXALGORITHMS" :: String

sampleN = 103 :: Integer
sampleNums =  [217, 1891, 4819, 2291, 2987, 3811, 1739, 2491, 4717, 445, 65, 1079, 8383, 5353, 901, 187, 649, 1003, 697, 3239, 7663, 291, 123, 779, 1007, 3551, 1943, 2117, 1679, 989, 3053] :: [Integer]
sampleNums2 = [9, 9, 9, 21, 217, 1891, 4819, 2291, 2987, 3811, 1739, 2491, 4717, 445, 65, 1079, 8383, 5353, 901, 187, 649, 1003, 697, 3239, 7663, 291, 123, 779, 1007, 3551, 1943, 2117, 1679, 989, 3053] :: [Integer]
sampleNums3 = [15, 15, 15, 35, 217, 1891, 4819, 2291, 2987, 3811, 1739, 2491, 4717, 445, 65, 1079, 8383, 5353, 901, 187, 649, 1003, 697, 3239, 7663, 291, 123, 779, 1007, 3551, 1943, 2117, 1679, 989, 3053] :: [Integer]
sampleNums4 = [9, 9, 9, 15, 15, 15, 35, 217, 1891, 4819, 2291, 2987, 3811, 1739, 2491, 4717, 445, 65, 1079, 8383, 5353, 901, 187, 649, 1003, 697, 3239, 7663, 291, 123, 779, 1007, 3551, 1943, 2117, 1679, 989, 3053] :: [Integer]


alphabetChars = ['A'..'Z'] :: String

factorizeCiphertext4 :: [Integer] -> [Integer]
factorizeCiphertext4 (n:nums)
    | isEdge = (scanr (\n1 n2 -> n1 `div` n2) (head factorTail) groupHeads) ++ (tail factorTail)
    | otherwise = factorTail
    where groupHeads = groupHead ([n] ++ nums)
          isEdge = if (length groupHeads) > 0 then True else False
          listToScan = groupTail ([n] ++ nums)
          firstFactor = (head listToScan) `div` (commonFactor (head listToScan) (head $ tail listToScan))
          factorTail = scanl (\f n -> n `div` f) firstFactor listToScan

groupHead :: [Integer] -> [Integer]
groupHead (x:xs)
    | x == (head xs) = [x] ++ (takeWhile (==x) xs) ++ groupHead (dropWhile (==x) xs)
    | otherwise = []

groupTail :: [Integer] -> [Integer]
groupTail (x:xs)
    | x == (head xs) = groupTail (dropWhile (==x) xs)
    | otherwise = [x] ++ xs

commonFactor :: Integer -> Integer -> Integer
commonFactor a b
    | remainder == 1 = 1
    | remainder == 0 = if a > b then b else a
    | otherwise = if a > b then commonFactor b remainder else commonFactor a remainder 
    where remainder = if a > b then snd (quotRem a b) else snd (quotRem b a)    

getPlainText :: [Integer] -> Integer -> Maybe String
getPlainText nums lnums = sequence [M.lookup num charmap | num <- faclist]
    where faclist = factorizeCiphertext4 nums
          primes = map head (group $ sort faclist)
          charmap = M.fromList (zip primes alphabetChars)
          

checkFactorization :: [(Integer, Integer)] -> [Integer] -> Bool
checkFactorization faclist orig = recovered == orig
    where recovered = map (\fs -> (fst fs)*(snd fs)) faclist

primeFactorize2 :: Integer -> (Integer, Integer)
primeFactorize2 num = (f1 ,f2) 
    where lim = floor ((sqrt (fromIntegral num)) + 2) `div` 2
          nums2check = [2*x + 1 | x <- [1..lim]]
          f1 = (head $ dropWhile (\x -> (mod num x) /= 0) nums2check)
          f2 = num `div` f1

printMaybe :: Show a => Maybe a -> IO ()
printMaybe (Just x) = print x
printMaybe n = print n

printCaseSolution :: Integer -> Maybe [Char] -> IO ()
printCaseSolution i (Just x) = putStrLn ("Case #" ++ show i ++ ": " ++ x)
printCaseSolution i x = putStrLn ("Case #" ++ show i ++ ": " ++ show x)

solveCase :: (Integer, Integer, Integer, [Integer]) -> IO ()
solveCase (i, nMax, listLen, lst) = printCaseSolution i (getPlainText lst listLen)

readCase :: Integer -> IO (Integer, Integer, Integer, [Integer])
readCase i = do 
    dl <- getLine
    let [nMax, listLen] = (map read (words dl)) :: [Integer]
    lstline <- getLine
    let lst = (map read (words lstline)) :: [Integer]
    return (i, nMax, listLen, lst)

main = do
    t <- getLine
    let tn = read t :: Integer
    cases <- forM [1..tn] readCase
    mapM solveCase cases