HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Vigenere cipher exercise in Haskell

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
vigenereexercisehaskellcipher

Problem

This is my implementation using the dreadful !!:

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) m


I 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 !! 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.