https://wiki.haskell.org/index.php?title=Haskell_Quiz/The_Solitaire_Cipher/Solution_Mike_McClurg&feed=atom&action=history
Haskell Quiz/The Solitaire Cipher/Solution Mike McClurg - Revision history
2024-03-29T01:07:20Z
Revision history for this page on the wiki
MediaWiki 1.35.5
https://wiki.haskell.org/index.php?title=Haskell_Quiz/The_Solitaire_Cipher/Solution_Mike_McClurg&diff=33663&oldid=prev
Newacct at 04:59, 19 February 2010
2010-02-19T04:59:47Z
<p></p>
<table class="diff diff-contentalign-left diff-editfont-monospace" data-mw="interface">
<col class="diff-marker" />
<col class="diff-content" />
<col class="diff-marker" />
<col class="diff-content" />
<tr class="diff-title" lang="en">
<td colspan="2" style="background-color: #fff; color: #202122; text-align: center;">← Older revision</td>
<td colspan="2" style="background-color: #fff; color: #202122; text-align: center;">Revision as of 04:59, 19 February 2010</td>
</tr><tr>
<td colspan="2" class="diff-lineno">Line 5:</td>
<td colspan="2" class="diff-lineno">Line 5:</td>
</tr>
<tr>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"></td>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"></td>
</tr>
<tr>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>import Char (chr, ord, toUpper)</div></td>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>import Char (chr, ord, toUpper)</div></td>
</tr>
<tr>
<td class="diff-marker">−</td>
<td style="color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #ffe49c; vertical-align: top; white-space: pre-wrap;"><div>import Data.List (delete, findIndices)</div></td>
<td class="diff-marker">+</td>
<td style="color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #a3d3ff; vertical-align: top; white-space: pre-wrap;"><div>import Data.List (delete<ins class="diffchange diffchange-inline">, elemIndices</ins>, findIndices)</div></td>
</tr>
<tr>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>import System.Environment (getArgs, getProgName)</div></td>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>import System.Environment (getArgs, getProgName)</div></td>
</tr>
<tr>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"></td>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"></td>
</tr>
<tr>
<td colspan="2" class="diff-lineno">Line 79:</td>
<td colspan="2" class="diff-lineno">Line 79:</td>
</tr>
<tr>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>moveJoker :: Card -> Int -> Deck -> Deck</div></td>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>moveJoker :: Card -> Int -> Deck -> Deck</div></td>
</tr>
<tr>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>moveJoker j n d = a ++ [j] ++ b</div></td>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div>moveJoker j n d = a ++ [j] ++ b</div></td>
</tr>
<tr>
<td class="diff-marker">−</td>
<td style="color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #ffe49c; vertical-align: top; white-space: pre-wrap;"><div> where n' = let i = (<del class="diffchange diffchange-inline">findIndices</del> <del class="diffchange diffchange-inline">(==</del>j<del class="diffchange diffchange-inline">)</del> d)!!0 in</div></td>
<td class="diff-marker">+</td>
<td style="color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #a3d3ff; vertical-align: top; white-space: pre-wrap;"><div> where n' = let i = (<ins class="diffchange diffchange-inline">elemIndices</ins> j d)!!0 in</div></td>
</tr>
<tr>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div> if (i + n == 54) -- special case where joker would end up as top card; need to move under top one or two</div></td>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div> if (i + n == 54) -- special case where joker would end up as top card; need to move under top one or two</div></td>
</tr>
<tr>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div> then (i + n + 1) `mod` 54</div></td>
<td class="diff-marker"> </td>
<td style="background-color: #f8f9fa; color: #202122; font-size: 88%; border-style: solid; border-width: 1px 1px 1px 4px; border-radius: 0.33em; border-color: #eaecf0; vertical-align: top; white-space: pre-wrap;"><div> then (i + n + 1) `mod` 54</div></td>
</tr>
</table>
Newacct
https://wiki.haskell.org/index.php?title=Haskell_Quiz/The_Solitaire_Cipher/Solution_Mike_McClurg&diff=32574&oldid=prev
Mcclurmc: Haskell Quiz/The Solitaire Cipher/Solution mcclurmc moved to Haskell Quiz/The Solitaire Cipher/Solution Mike McClurg
2009-12-14T22:13:25Z
<p>Haskell Quiz/The Solitaire Cipher/Solution mcclurmc moved to Haskell Quiz/The Solitaire Cipher/Solution Mike McClurg</p>
<table class="diff diff-contentalign-left diff-editfont-monospace" data-mw="interface">
<col class="diff-marker" />
<col class="diff-content" />
<col class="diff-marker" />
<col class="diff-content" />
<tr class="diff-title" lang="en">
<td colspan="2" style="background-color: #fff; color: #202122; text-align: center;">← Older revision</td>
<td colspan="2" style="background-color: #fff; color: #202122; text-align: center;">Revision as of 22:13, 14 December 2009</td>
</tr>
<!-- diff cache key wikidb_haskell:diff:wikidiff2:1.12:old-32573:rev-32574:1.10.0 -->
</table>
Mcclurmc
https://wiki.haskell.org/index.php?title=Haskell_Quiz/The_Solitaire_Cipher/Solution_Mike_McClurg&diff=32573&oldid=prev
Mcclurmc at 22:12, 14 December 2009
2009-12-14T22:12:08Z
<p></p>
<p><b>New page</b></p><div>[[Category:Haskell Quiz solutions|Solitaire Cipher]]<br />
<br />
<haskell><br />
module Main where<br />
<br />
import Char (chr, ord, toUpper)<br />
import Data.List (delete, findIndices)<br />
import System.Environment (getArgs, getProgName)<br />
<br />
-- Driver for the program<br />
main :: IO ()<br />
main = getArgs >>= parse<br />
<br />
parse :: [String] -> IO ()<br />
parse (key:[msg]) = putStrLn $ encodeWithKey key msg<br />
parse ("-d":key:[msg]) = putStrLn $ decodeWithKey key msg<br />
parse ["-h"] = usage<br />
parse _ = usage<br />
<br />
usage :: IO ()<br />
usage = do prog <- getProgName<br />
putStrLn $ "usage: " ++ prog ++ " [-d] <keyphrase> <message>"<br />
<br />
-- Define the deck we'll be using<br />
type Deck = [Card]<br />
<br />
data Card = Card !Int<br />
| JokerA<br />
| JokerB<br />
deriving (Eq, Show)<br />
<br />
<br />
-- Standard deck, in bridge order (0==Ace Spades, 51==King Clubs), jokers at end<br />
mkStdDeck :: Deck<br />
mkStdDeck = map Card [0..51] ++ [JokerA, JokerB]<br />
<br />
-- Encode and decode<br />
encode :: Deck -> String -> String<br />
encode d msg = formatOutput $ map (uncurry add) $ zip (formatInput msg) $ keystream d<br />
<br />
decode :: Deck -> String -> String<br />
decode d cph = formatOutput $ map (uncurry add) $ zip (formatInput cph) $ map (0-) $ keystream d<br />
<br />
encodeWithKey :: String -> String -> String<br />
encodeWithKey key msg = encode (keyDeck key mkStdDeck) msg<br />
<br />
decodeWithKey :: String -> String -> String<br />
decodeWithKey key msg = decode (keyDeck key mkStdDeck) msg<br />
<br />
-- Initialize the deck with the given key<br />
keyDeck :: String -> Deck -> Deck<br />
keyDeck [] = id<br />
keyDeck (k:ks) = keyDeck ks . countCut' (charVal k) . countCut . tripleCut . moveJokers<br />
where charVal c = (ord $ toUpper c) - (ord 'A') + 1<br />
<br />
-- Generate an infinite keystream<br />
keystream :: Deck -> [Int]<br />
keystream d = let d' = step d in<br />
case getOutput d' of<br />
Nothing -> keystream d' -- skip jokers<br />
Just i -> i : keystream d'<br />
where step = countCut . tripleCut . moveJokers<br />
<br />
-- Plaintext must have no spaces, and be padded to multiple of five<br />
formatInput :: String -> String<br />
formatInput s = pad $ map toUpper $ filter (/=' ') s<br />
where pad s = if (length s `mod` 5 == 0)<br />
then s<br />
else pad $ s ++ "X"<br />
<br />
formatOutput :: String -> String<br />
formatOutput [] = []<br />
formatOutput cs = (take 5 cs) ++ " " ++ (formatOutput $ drop 5 cs)<br />
<br />
-- Move jokers<br />
moveJokers :: Deck -> Deck<br />
moveJokers = moveJoker JokerB 2 . moveJoker JokerA 1<br />
<br />
moveJoker :: Card -> Int -> Deck -> Deck<br />
moveJoker j n d = a ++ [j] ++ b<br />
where n' = let i = (findIndices (==j) d)!!0 in<br />
if (i + n == 54) -- special case where joker would end up as top card; need to move under top one or two<br />
then (i + n + 1) `mod` 54<br />
else (i + n) `mod` 54<br />
(a,b) = splitAt n' $ delete j d<br />
<br />
-- Triple cut: swap cards above first joker with cards below second joker<br />
tripleCut :: Deck -> Deck<br />
tripleCut d = let a = take j1 d -- first 'third'<br />
b = take (j2 - j1 + 1) $ drop j1 d -- second 'third' (drop first third, then take up to next joker)<br />
c = drop (j2 + 1) d in -- third 'third'<br />
c ++ b ++ a<br />
where is = findIndices (\e -> (e==JokerA) || (e==JokerB)) d<br />
j1 = is!!0<br />
j2 = is!!1<br />
<br />
-- Count cut: cut deck at n cards, where n is value of last card, leave last card in place<br />
countCut :: Deck -> Deck<br />
countCut d = countCut' i d<br />
where i = (cardVal $ last d)<br />
<br />
countCut' :: Int -> Deck -> Deck<br />
countCut' i d = (drop i d') ++ (take i d') ++ [l]<br />
where d' = take 53 d<br />
l = last d<br />
<br />
-- Return value of output card, or Nothing if joker<br />
getOutput :: Deck -> Maybe Int<br />
getOutput [] = Nothing<br />
getOutput (c:cs) = let i = (cardVal c) in<br />
case (c:cs)!!i of<br />
JokerA -> Nothing<br />
JokerB -> Nothing<br />
(Card a) -> Just $ a+1<br />
<br />
-- Int value of Card<br />
cardVal :: Card -> Int<br />
cardVal JokerA = 53<br />
cardVal JokerB = 53<br />
cardVal (Card c) = c + 1<br />
<br />
-- Add Chars and Ints, modulo 26<br />
add :: Char -> Int -> Char<br />
add c i = intToChar $ i + charToInt c<br />
where charToInt c = (ord $ toUpper c) - ord 'A'<br />
intToChar i = chr $ i `mod` 26 + ord 'A'<br />
</haskell></div>
Mcclurmc