Create a gist now

Instantly share code, notes, and snippets.

@Javran /gist:9593215
Last active Aug 29, 2015

What would you like to do?
the notion of invertible function
{-# LANGUAGE DeriveFunctor, RankNTypes #-}
import Data.Char
import Data.List
import Control.Lens
type Invertible a b = Simple Iso a b
{- translation table
into = view
back = view . from
selfInv x = iso x x
rempty = selfInv id
rappend = (.)
flipInv = from
borrow = over
liftInv = mapping
-}
-- examples
-- constructor should be invisible from outside
newtype OnlyUpper a = OnlyUpper
{ getOU :: [a]
} deriving (Eq, Ord, Show, Functor)
ouAsList :: Iso (OnlyUpper a) (OnlyUpper a) [a] [a]
ouAsList = iso getOU OnlyUpper
onlyUpper :: String -> OnlyUpper Char
onlyUpper = OnlyUpper . filter isAsciiUpper
upperAsOrd :: Invertible Char Int
upperAsOrd = iso ord' chr'
where
ord' x = ord x - ord 'A'
chr' x = chr (x + ord 'A')
modShift :: Int -> Int -> Invertible Int Int
modShift base offset = iso f g
where
f x = (x + offset) `mod` base
g y = (y + (base - offset)) `mod` base
caesarShift :: Invertible Int Int
caesarShift = modShift 26 4
caesarCipher :: Invertible (OnlyUpper Char) (OnlyUpper Char)
caesarCipher = mapping ( upperAsOrd
-- Char <-> Int
. caesarShift
-- Int <-> Int
. from upperAsOrd)
-- Int <-> Char
exampleCaesar :: IO ()
exampleCaesar = do
let encF = view caesarCipher
decF = view (from caesarCipher)
encrypted = encF (onlyUpper "THEQUICKBROWNFOX")
decrypted = decF encrypted
encrypted' = over (from caesarCipher
. ouAsList) (++ "JUMPSOVERTHELAZYDOG") encrypted
decrypted' = decF encrypted'
print encrypted
-- OnlyUpper {getOU = "XLIUYMGOFVSARJSB"}
print decrypted
-- OnlyUpper {getOU = "THEQUICKBROWNFOX"}
print encrypted'
-- OnlyUpper {getOU = "XLIUYMGOFVSARJSBNYQTWSZIVXLIPEDCHSK"}
print decrypted'
-- OnlyUpper {getOU = "THEQUICKBROWNFOXJUMPSOVERTHELAZYDOG"}
-- gravitize
compactLeft :: [Int] -> [Int]
compactLeft xs = take (length xs) (nonZeros ++ repeat 0)
where nonZeros = filter (/= 0) xs
data Dir = DU | DD | DL | DR deriving (Eq, Ord, Enum, Show, Bounded)
gravitizeMat :: Dir -> [[Int]] -> [[Int]]
gravitizeMat dir = over isoX (map compactLeft)
where mirrorI = iso (map reverse) (map reverse)
diagonalI = iso transpose transpose
isoX = case dir of
DL -> id
DR -> mirrorI
DU -> diagonalI
DD -> diagonalI . mirrorI
print2DMat :: (Show a) => [[a]] -> IO ()
print2DMat mat = do
putStrLn "Matrix: ["
mapM_ print mat
putStrLn "]"
exampleMatGravitize :: IO ()
exampleMatGravitize = do
let mat = [ [1,0,2,0]
, [0,3,4,0]
, [0,0,0,5]
]
print2DMat mat
let showExample d = do
putStrLn $ "Direction: " ++ show d
print2DMat $ gravitizeMat d mat
mapM_ showExample [minBound .. maxBound]
main :: IO ()
main = do
exampleCaesar
exampleMatGravitize
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment