patternMinor
Vigenere cipher exercise in Haskell
Viewed 0 times
vigenereexercisehaskellcipher
Problem
This is my implementation using the dreadful
I found that the most "annoying" thing when coming from background such as
How would you do it? Or is there some "standard" wa
!!:import Data.Char (chr, ord, toUpper)
-- A bit of self documentation help
type Key = String
type Msg = String
key :: Key
key = "TSTING"
msg :: Msg
msg = "I'm not even mad... This is impressive!"
-- | Checks if character is valid for encoding
isValid :: Char -> Bool
isValid c = let cUp = toUpper c :: Char
in 'A' Msg -> [Maybe Int]
toIdx k m = map (flip mod keyN ) $ toIdx_ 0 m
where keyN = length k :: Int
toIdx_ :: Int -> Msg -> [Maybe Int]
toIdx_ _ "" = []
toIdx_ acc (c:cs)
| isValid c = Just acc : toIdx_ (acc + 1) cs
| otherwise = Nothing : toIdx_ acc cs
-- | Given 'key' & 'msg' generate a list of numbers representing
-- the amount to shift 'msg' characters based on 'key'
toShifts :: Key -> Msg -> [Int]
toShifts k m = map toKey (toIdx k m)
where kUp = map toUpper k :: Key
toKey :: Maybe Int -> Int
toKey Nothing = 0
toKey (Just x) = ord (kUp!!x) - ord 'A'
-- | Given 'by' & 'c', shift the Char 'c' by amount 'by'. 'by' can be both
-- positive & negative as well as 0.
shift :: Int -> Char -> Char
shift by c
| isValid c && c >= 'a' = shift_ $ ord 'a'
| isValid c && c >= 'A' = shift_ $ ord 'A'
| otherwise = c
where cONorm = ord (toUpper c) - ord 'A' :: Int
azN = ord 'Z' - ord 'A' :: Int
shift_ :: Int -> Char
shift_ aO = chr $ aO + mod (by + cONorm) azN
-- Encode & decode a message using the given key.
vigenere, unVigenere :: Key -> Msg -> Msg
vigenere k m = zipWith shift (toShifts k m) m
unVigenere k m = zipWith shift (map negate $ toShifts k m) mI found that the most "annoying" thing when coming from background such as
Python is to be able to keep track of things, for example when figuring out how to convert valid characters into usable positions to be then mapped with the key. That thing took me half a day to figure out!How would you do it? Or is there some "standard" wa
Solution
To get rid of
Of course, there is hardly a need to separate all these steps.
!! here, you can use it earlier and earlier until you never even generate an Int.-- | Given 'key' & 'msg' generate a list of [Maybe Int] indices
-- to map 'msg' from 'key', skipping invalid characters
toIdx :: Key -> Msg -> [Maybe Char]
toIdx k m = toIdx_ (cycle $ map toUpper k) m
where toIdx_ :: Key -> Msg -> [Maybe Char]
toIdx_ _ "" = []
toIdx_ key@(k:ey) (c:cs)
| isValid c = Just k : toIdx_ ey cs
| otherwise = Nothing : toIdx_ key cs
-- | Given 'key' & 'msg' generate a list of numbers representing
-- the amount to shift 'msg' characters based on 'key'
toShifts :: Key -> Msg -> [Int]
toShifts k m = map toKey (toIdx k m)
where toKey :: Maybe Char -> Int
toKey Nothing = 0
toKey (Just x) = ord x - ord 'A'Of course, there is hardly a need to separate all these steps.
base :: Char -> Maybe Char
base c
| 'a' String -> String
[vigenere, unVigenere] = (`map` [(+), (-)]) $ \direction k ->
(.) snd $ (`mapAccumL` cycle k) $ \key@(k:ey) c -> case base c of
Nothing -> (key, c)
Just a -> (,) ey $ chr $ ord a +
mod ((ord c - ord a) `direction` (ord (toUpper k) - ord 'A')) (ord 'Z' - ord 'A')Code Snippets
-- | Given 'key' & 'msg' generate a list of [Maybe Int] indices
-- to map 'msg' from 'key', skipping invalid characters
toIdx :: Key -> Msg -> [Maybe Char]
toIdx k m = toIdx_ (cycle $ map toUpper k) m
where toIdx_ :: Key -> Msg -> [Maybe Char]
toIdx_ _ "" = []
toIdx_ key@(k:ey) (c:cs)
| isValid c = Just k : toIdx_ ey cs
| otherwise = Nothing : toIdx_ key cs
-- | Given 'key' & 'msg' generate a list of numbers representing
-- the amount to shift 'msg' characters based on 'key'
toShifts :: Key -> Msg -> [Int]
toShifts k m = map toKey (toIdx k m)
where toKey :: Maybe Char -> Int
toKey Nothing = 0
toKey (Just x) = ord x - ord 'A'base :: Char -> Maybe Char
base c
| 'a' <= c && c <= 'z' = Just 'a'
| 'A' <= c && c <= 'Z' = Just 'A'
| otherwise = Nothing
vigenere, unVigenere :: String -> String -> String
[vigenere, unVigenere] = (`map` [(+), (-)]) $ \direction k ->
(.) snd $ (`mapAccumL` cycle k) $ \key@(k:ey) c -> case base c of
Nothing -> (key, c)
Just a -> (,) ey $ chr $ ord a +
mod ((ord c - ord a) `direction` (ord (toUpper k) - ord 'A')) (ord 'Z' - ord 'A')Context
StackExchange Code Review Q#161577, answer score: 3
Revisions (0)
No revisions yet.