Bacon cipher: Difference between revisions

Content added Content deleted
(→‎{{header|Haskell}}: Applied hlint, hindent, inlined comments, added main.)
Line 938: Line 938:
=={{header|Haskell}}==
=={{header|Haskell}}==


Necessary imports
<lang haskell>-- Necessary imports
<lang Haskell>import Data.List (findIndex, unfoldr)
import Data.List (elemIndex, unfoldr)
import Data.Char (isAlpha, isUpper, toUpper, toLower)
import Data.Bool (bool)
import Data.Bool (bool)</lang>
import Data.Char (isAlpha, isUpper, toLower, toUpper)
import Data.List.Split (chunksOf)


The list of characters to be encoded:
-- The list of characters to be encoded:
chars :: String
<lang Haskell>chars = ['a'..'z'] ++ ['0'..'9'] ++ ",.;?! "
chars = ['a' .. 'z'] ++ ['0' .. '9'] ++ ",.;?! "
⚫
bitsPerChar = 6 :: Int</lang>


⚫
bitsPerChar :: Int
⚫
Some simple helper functions:
bitsPerChar = 6
⚫
<lang Haskell>toBinary :: Int -> [Bool]

⚫
toBinary = unfoldr (pure . (\(a,b)->(odd b,a)) . (`divMod` 2))
⚫
-- Some simple helper functions:
⚫
toBinary :: Int -> [Bool]
⚫
toBinary = unfoldr (pure . (\(a, b) -> (odd b, a)) . (`divMod` 2))


fromBinary :: [Bool] -> Int
fromBinary :: [Bool] -> Int
fromBinary = foldr (\x n -> 2*n + bool 0 1 x) 0</lang>
fromBinary = foldr (\x n -> (2 * n) + bool 0 1 x) 0


And, finally main functions -- encoding:
-- And finally, main functions -- encoding:
<lang Haskell>encode :: String -> String -> Either String String
encode :: String -> String -> Either String String
encode message txt = do
encode txt message = do
mask <- traverse coding message
mask <- traverse coding message
zipAlphas (bool toLower toUpper) (concat mask) txt
zipAlphas (bool toLower toUpper) (concat mask) txt
where
where
coding ch = case findIndex (== ch) chars of
coding ch =
case elemIndex ch chars of
Nothing -> Left $ "Unknown symbol " ++ show ch
Just i -> Right $ take bitsPerChar (toBinary i)
Nothing -> Left $ "Unknown symbol " ++ show ch
Just i -> Right $ take bitsPerChar (toBinary i)

zipAlphas f = go
zipAlphas f = go
where go _ [] = Left "Text is not long enough!"
where
go [] _ = Right []
go _ [] = Left "Text is not long enough!"
go (x:xs) (y:ys) | isAlpha y = (f x y :) <$> go xs ys
go [] _ = Right []
| otherwise = (y :) <$> go (x:xs) ys</lang>
go (x:xs) (y:ys)
| isAlpha y = (f x y :) <$> go xs ys
| otherwise = (y :) <$> go (x : xs) ys


And decoding:
-- And decoding:
<lang Haskell>decode :: String -> String
decode :: String -> String
decode = map decipher . chunksOf bitsPerChar . filter isAlpha
decode = map decipher . chunksOf bitsPerChar . filter isAlpha
where
where
decipher = (chars !!) . min (length chars-1) . fromBinary . map isUpper
decipher = (chars !!) . min (length chars - 1) . fromBinary . map isUpper
chunksOf n = takeWhile (not . null) . unfoldr (pure . splitAt n)</lang>
chunksOf n = takeWhile (not . null) . unfoldr (pure . splitAt n)

⚫
-- Examples
text :: String
text =
unwords
⚫
[ "Bacon's cipher is a method of steganography created by Francis Bacon."
⚫
, "This task is to implement a program for encryption and decryption of"
⚫
, "plaintext using the simple alphabet of the Baconian cipher or some"
⚫
, "other kind of representation of this alphabet (make anything signify"
⚫
, "anything). The Baconian alphabet may optionally be extended to encode"
⚫
, "all lower case characters individually and/or adding a few punctuation"
⚫
, "characters such as the space."
]

message :: String
⚫
message = "the quick brown fox jumps over the lazy dog"

main :: IO ()
main = do
⚫
let m = encode text message
mapM_
(either
(putStrLn . ("-> " ++))
(putStrLn . (++ "\n") . unlines . fmap unwords . chunksOf 10 . words))
[ m
⚫
, decode <$> m
⚫
, encode text "something wrong @ in the message"
, encode "abc" message
]</lang>
{{Out}}
<pre>BAcoN's CIPher is A metHod Of StegaNogrApHy creAted By franCiS
baCon. ThIS task iS to iMplEMEnt a PRoGrAm FOr eNcrYpTIoN
and dECRypTIOn Of PlaInTExt Using ThE simPLe aLPHAbet Of tHe
BacOnIaN CIphEr Or Some OtheR kinD oF rePrESEntAtION of thiS
alpHabEt (MAKe Anything sIgnIFy anyTHiNg). tHe BAConian ALPhabET may


⚫
'''Examples'''


⚫
the quick brown fox jumps over the lazy dog
⚫
<lang Haskell>text = concat ["Bacon's cipher is a method of steganography created by Francis Bacon. "
⚫
,"This task is to implement a program for encryption and decryption of "
⚫
,"plaintext using the simple alphabet of the Baconian cipher or some "
⚫
,"other kind of representation of this alphabet (make anything signify "
⚫
,"anything). The Baconian alphabet may optionally be extended to encode "
⚫
,"all lower case characters individually and/or adding a few punctuation "
⚫
,"characters such as the space." ]


⚫
message = "the quick brown fox jumps over the lazy dog"</lang>


⚫
-> Unknown symbol '@'
⚫
<lang Haskell>λ> let m = encode message text
⚫
-> Text is not long enough!</pre>
λ> m
Right "BAcoN's CIPher is A metHod Of StegaNogrApHy creAted By franCiS baCon. ThIS task iS to iMplEMEnt a PRoGrAm FOr eNcrYpTIoN and dECRypTIOn Of PlaInTExt Using ThE simPLe aLPHAbet Of tHe BacOnIaN CIphEr Or Some OtheR kinD oF rePrESEntAtION of thiS alpHabEt (MAKe Anything sIgnIFy anyTHiNg). tHe BAConian ALPhabET may"
⚫
λ> decode <$> m
⚫
Right "the quick brown fox jumps over the lazy dog"
⚫
λ> encode "something wrong @ in the message" text
⚫
Left "Unknown symbol '@'"
λ> encode message "abc"
⚫
Left "Text is not long enough!"</lang>


=={{header|J}}==
=={{header|J}}==
Retrieved from "https://rosettacode.org/wiki/Bacon_cipher"