-- University of Zagreb
-- Faculty of Electrical Engineering and Computing
--
-- PROGRAMMING IN HASKELL
--
-- Academic Year 2013/2014

-- The following are some *example* solutions to the 3rd homework
-- assignment. You were not required to write them out exactly like
-- this.
--
-- If you spot an error somewhere, please notify us. Thanks!

module Homework where

import Data.List
import Data.Char
import Data.Ord

type SimilarityMetric a = a -> a -> Double

checkTriangleInequality :: SimilarityMetric a -> [a] -> Bool
checkTriangleInequality m xs =
  and [m a b + m b c >= m a c | a <- xs, b <- xs, c <- xs]

-- A version not covering the infinite lists case:
zipN' :: [[a]] -> [[a]]
zipN' xs = [x | x <- transpose xs, length x == length xs]

-- A version covering the infinite lists case, but with explicit recursion.
zipN :: [[a]] -> [[a]]
zipN [] = []
zipN xs
  | any null xs = []
  | otherwise   = map head xs : zipN (map tail xs)

-- Both versions are accepted as correct.

-- Note: we've been using the map function a lot without really
-- knowing. To see what map does, check out problem 1A in HA4.

findSimilar :: a -> [a] -> [SimilarityMetric a] -> Int -> [[(Double, a)]]
findSimilar x ys fs n = take n $ zipN' (map (similars x ys) fs) ++ repeat []
  where
    similars :: a -> [a] -> SimilarityMetric a -> [(Double, a)]
    similars a bs f = reverse $ scoreSort' [(f a b, b) | b <- bs]

-- This sorts the list by only the first element of each tuple.
scoreSort :: [(Double, a)] -> [(Double, a)]
scoreSort xs = [(score, snd $ xs !! i) | (score,i) <- sorted]
  where
    sorted = sort [(score, i) | ((score,_),i) <- zip xs [0..]]

-- There's a nicer way to write scoreSort which we haven't yet learned
-- about. We can use the in-built sortBy and comparing functions from
-- the Data.List and  Data.Ord module.
scoreSort' :: Ord a => [(a, b)] -> [(a, b)]
scoreSort' = sortBy (comparing fst)

infixes :: String -> [String]
infixes [] = []
infixes xs = tail $ sort $ nub [i | t <- tails xs, i <- inits t]

-- How many characters of two strings are the same and in matching positions?
sim :: String -> String -> Double
sim xs ys = sum [2.0 | (x,y) <- zip xs ys, x == y]

stringSim :: String -> String -> Double
stringSim [] _  = 0
stringSim _  [] = 0
stringSim xs ys = largest / realToFrac (length xs + length ys)
  where
    largest = maximum [sim ix iy | ix <- infixes xs, iy <- infixes ys]

findRepresentative :: [String] -> String
findRepresentative [] = error "empty list"
findRepresentative ss = snd $ maximum scores
  where
    scores = [(sum [stringSim a b | a <- ss], b) | b <- ss]

rle :: String -> String
rle s = unwords [show (length gs) ++ [c] | gs@(c:_) <- group s]

rleInverse :: String -> String
rleInverse s = concatMap decode $ words s
  where
    decode w = replicate (read $ init w) $ last w

-- Get all rotations of a string.
rots :: String -> [String]
rots s = let s' = s ++ "#" in [drop i s' ++ take i s' | i <- [0..length s]]

bwt :: String -> String
bwt [] = []
bwt cs = last $ transpose $ sort $ rots cs

easyEval :: String -> Int
easyEval s =
  case words s of
    []     -> 0
    (w:ws) -> eval' (read w) ws
  where
    eval' x ("+":y:rest) = eval' (x + read y) rest
    eval' x ("-":y:rest) = eval' (x - read y) rest
    eval' x _            = x

fromSeed :: Int -> Int
fromSeed s = (1664525*s + 1013904223) `mod` 2147483647

randoms :: Int -> [Int]
randoms s = tail $ iterate fromSeed s

choose :: Int -> [a] -> (Int, a)
choose s xs = (s', xs !! (s' `mod` length xs))
  where
    s' = fromSeed s

encrypt :: String -> String -> String
encrypt [] _  = error "not a valid key"
encrypt ks cs = zipWith encryptChar (cycle ks) $ clean cs

clean :: String -> String
clean s = map toLower $ concat $ words s

encryptChar :: Char -> Char -> Char
encryptChar k c = intToEng $ engToInt c + engToInt k

engToInt :: Char -> Int
engToInt c = ord c - 97

intToEng :: Int -> Char
intToEng i = chr $ i `mod` 26 + 97

decrypt :: String -> String -> String
decrypt [] _  = error "not a valid key"
decrypt ks cs = zipWith decryptChar (cycle ks) cs

decryptChar :: Char -> Char -> Char
decryptChar k c = intToEng $ engToInt c - engToInt k

-- Takes a character after every n positions.
every :: Int -> String -> String
every 0 _  = error "cannot take after every zero chars"
every n cs = [c | (i,c) <- zip [0..] cs, i `rem` n == 0]

stripes :: Int -> String -> [String]
stripes 0 _  = error "must have over zero stripes"
stripes n cs = [every n $ drop i cs | i <- [0..n-1]]

mostFrequent :: String -> Char
mostFrequent "" = error "empty list"
mostFrequent cs =
  head $ maximumBy (comparing length) $ group $ reverse $ sort cs

breakKey :: Int -> String -> String
breakKey n cs = [minusE $ mostFrequent s | s <- stripes n cs]
  where
    minusE c = intToEng $ engToInt c - engToInt 'e'

breakCipher :: Int -> Int -> String -> [(String, String)]
breakCipher a b cs =
  [(key, decrypt key cs) | i <- [a..b], let key = breakKey i cs]