https://wiki.haskell.org/api.php?action=feedcontributions&user=Mcclurmc&feedformat=atomHaskellWiki - User contributions [en]2024-03-28T14:05:13ZUser contributionsMediaWiki 1.35.5https://wiki.haskell.org/index.php?title=CamHac&diff=40337CamHac2011-06-02T14:29:00Z<p>Mcclurmc: </p>
<hr />
<div>Haskell Hackaton in Cambridge, UK, '''August 12-14, 2011'''<br />
<br />
== About ==<br />
<br />
Come and spend a weekend in Cambridge hacking Haskell code in great surroundings with fantastic company! Haskell Hackathons are a tradition where everyone is welcome; we get together, work on projects with others or just do your own thing, the overall goal being to improve the Haskell ecosystem.<br />
<br />
CamHac will be held from 12-14 August 2011, at [http://www.homertonconference.com/ Homerton College] in Cambridge. As with previous Hackathons, all are welcome -- you do not have to be a Haskell guru. All you need is a basic knowledge of Haskell, a willingness to learn, and a project you're excited to help with (or a project of your own to work on).<br />
<br />
There will be lots of hacking, good food, and, of course, fun! <br />
<br />
* Organiser: [mailto:marlowsd@gmail.com Simon Marlow] (<tt>JaffaCake</tt> on IRC)<br />
* Mailing list: [http://www.haskell.org/mailman/listinfo/hackathon hackathon@haskell.org]<br />
* IRC channel: #ghc on FreeNode<br />
<br />
Many thanks to [http://research.microsoft.com/en-us/labs/cambridge/default.aspx Microsoft Research Cambridge] for agreeing to sponsor the event.<br />
<br />
== Registration ==<br />
<br />
'''Registration deadline''': Friday 15th July 2011<br />
<br />
Registration is free. To register, please email [mailto:msrcevnt@microsoft.com msrcevnt@microsoft.com] stating that you would like to register for the "Haskell Hackathon", with the following information<br />
<br />
Full name:<br />
Which days you are attending on:<br />
day 1: yes/no<br />
day 2: yes/no<br />
day 3: yes/no<br />
Dietary requirements:<br />
<br />
The venue is '''limited to 50 (edit: now 72!) people''', and registration is first-come first-served, so register quickly to reserve your place! (but only register if you definitely intend to come, and please let us know if you find you cannot make it for any reason after you have registered, so we can re-allocate your place).<br />
<br />
Some people will probably want to travel on Friday morning and join us later on that day - that's absolutely fine.<br />
<br />
== Venue ==<br />
<br />
We're in the [http://www.homertonconference.com/Leah-Manning.html Leah Manning Room] of [http://www.homertonconference.com/ Homerton Conference Centre]. It is about [http://www.google.co.uk/maps?f=d&source=s_d&saddr=United+Kingdom+(Cambridge,+Railway+Station+(Stop+B))&daddr=CB2+8PH&hl=en&geocode=FehrHAMdjhUCACHpLU_p7S-CNg%3BFc5LHAMdNhMCACmn-uB8eXrYRzFlrDhff7fJ9A&mra=iwd&dirflg=w&sll=52.190667,0.134583&sspn=0.021547,0.040598&ie=UTF8&z=16 15 minutes walk from the train station], and Cambridge town centre is about 30 minutes walk.<br />
<br />
'''Times''': we have the room booked all day for the three days, and we'll probably start around 10am and finish around 6pm. Exact time details to be confirmed later. <br />
<br />
There will be WiFi access.<br />
<br />
There will be a projector for giving talks/demos. We will probably reserve a part of the time for talks and demos.<br />
<br />
== Food ==<br />
<br />
Tea and coffee will be supplied. We will have to go out to find lunch, but there are various places to eat and buy food at the [http://www.cambridge-x.co.uk Cambridge Leisure Park] a few minutes walk towards Cambridge town centre. In the evening we will probably head towards the town where there are plenty of good restaurants.<br />
<br />
== Local arrangements ==<br />
<br />
=== Getting to Cambridge ===<br />
<br />
==== By Plane ====<br />
<br />
* [http://www.stanstedairport.com/ Stansted Airport]: Stansted is the nearest of the London-area airports to Cambridge. It is mostly served by flights to and from mainland Europe, Ireland, and elsewhere in the UK. <br />
<br />
* [http://www.heathrowairport.com/ Heathrow Airport]: Heathrow is the principal London-area airport and one of the busiest in Europe with a wide range of national, European, and international services. <br />
<br />
* [http://www.gatwickairport.com/ Gatwick Airport]: Gatwick is the second "London" airport with a wide range of national, European and international services. <br />
<br />
* Other airports: [http://www.london-luton.co.uk/ Luton Airport], [http://www.norwichairport.co.uk/ Norwich airport], and [http://www.southendairport.com/ Southend airport] are other regional airports in the East Anglia region. If you use these, car or taxi is the best option for travel to Cambridge. <br />
<br />
==== Trains from London ====<br />
<br />
London has two train lines into Cambridge, London Kings Cross and London Liverpool Street. There is a regular service on both lines and duration is under an hour on the direct trains. Go to [http://www.nationalrail.co.uk National Rail] to check train times<br />
<br />
=== Getting to the venue ===<br />
<br />
[http://www.google.co.uk/maps?f=d&source=s_d&saddr=United+Kingdom+(Cambridge,+Railway+Station+(Stop+B))&daddr=CB2+8PH&hl=en&geocode=FehrHAMdjhUCACHpLU_p7S-CNg%3BFc5LHAMdNhMCACmn-uB8eXrYRzFlrDhff7fJ9A&mra=iwd&dirflg=w&sll=52.190667,0.134583&sspn=0.021547,0.040598&ie=UTF8&z=16 Walk from the train station] (about 15 minutes)<br />
<br />
[http://www.homertonconference.com/How-to-find-us.html How to find the venue]<br />
<br />
'''Local Taxis''': Panther Taxis 01223 715715<br />
<br />
=== Accommodation ===<br />
<br />
[http://www.visitcambridge.org/VisitCambridge/WhereToStay.aspx VisitCambridge: Where to Stay in Cambridge]<br />
<br />
The nearest hotels to the venue seem to be:<br />
<br />
* [http://www2.travelodge.co.uk/ Travelodge] (Cambridge Central) is just a few minutes walk from the venue. It is currently charging £65.80 per night for 11-14 August.<br />
* [http://www.helenhotel.co.uk/index.htm Helen Hotel]<br />
* [http://www.bandbincambridgeshire.co.uk/ Bridge Guest House]<br />
* [http://www.cheapguesthouses.com/ Fairways Guest House]<br />
* [http://www.abbeyfieldguesthouse.com/ Abbeyfield Guest House]<br />
* [http://rockviewguesthouse.co.uk/default.aspx Rock View Guest House]<br />
* [http://alingtonhouse.com/default.aspx Alington House Guest House]<br />
* [http://www.yha.org.uk/find-accommodation/east-of-england/hostels/cambridge/index.aspx Cambridge Youth Hostel]<br />
* [http://www.cambridgerooms.co.uk/ Stay in Cambridge Colleges]<br />
<br />
If you contact any of the above and find they're booked up, please remove them from the list.<br />
<br />
Microsoft Research recommends the following hotels to visitors, these are closer to the city centre but are probably a lot more expensive than those above:<br />
<br />
* [http://www.hilton.co.uk/cambridgegardenhouse Double Tree by Hilton Garden House Cambridge]<br />
* [http://www.ichotelsgroup.com/h/d/cp/1/en/hotel/cbguk Crowne Plaza Cambridge]<br />
* [http://www.devere.co.uk/our-locations/university-arms.html De Vere University Arms]<br />
<br />
== Projects ==<br />
<br />
Use this space to list projects you are interested in working on, and add your name to projects you are interested in helping with.<br />
<br />
* General hacking away at Snap Framework (exact goals TBD), perhaps adding/improving documentation/tutorials at the same time. (Jurriën Stutterheim)<br />
* Darcs<br />
* Something games/3d related? (Stephen L)<br />
<br />
== Attendees ==<br />
<br />
# Simon Marlow<br />
# Jurriën Stutterheim<br />
# Neil Mitchell<br />
# Jasper Van der Jeugt<br />
# Max Bolingbroke<br />
# Ben Millwood<br />
# Roman Leshchinskiy<br />
# Gregory Collins<br />
# Martijn van Steenbergen<br />
# Sjoerd Visscher<br />
# Sebastiaan Visser<br />
# Tom Lokhorst<br />
# Erik Hesselink<br />
# Jeff Foster<br />
# Sebastian Korten<br />
# Alessandro Vermeulen<br />
# Vlad Hanciuta<br />
# Ganesh Sittampalam<br />
# Eric Kow<br />
# Alexander Njemz<br />
# Mikolaj Konarski<br />
# Ian Lynagh<br />
# Andres Löh<br />
# Jeroen Janssen<br />
# Nicolas Wu<br />
# Duncan Coutts<br />
# Dominic Orchard<br />
# Jacek Generowicz<br />
# Owen Stephens<br />
# Benedict Eastaugh<br />
# Stephen Lavelle<br />
# Sam Martin<br />
# Alex Horsman<br />
# Andy Georges<br />
# Niklas Larsson<br />
# Raeez Lorgat<br />
# Maryna Strelchuk<br />
# Vincent Hanquez<br />
# Chris Done<br />
# Tomas Petricek<br />
# Thomas Schilling<br />
# Dragos Ionita<br />
# Simon Meier<br />
# Will Thompson<br />
# Sergii Strelchuk<br />
# Lennart Kolmodin<br />
# Philippa Cowderoy<br />
# Johannes Weiß<br />
# Steven Keuchel<br />
# Michal Terepeta<br />
# Maciek Makowski<br />
# Alejandro Serrano<br />
# Mike McClurg<br />
<br />
* Add your name here, once registered...</div>Mcclurmchttps://wiki.haskell.org/index.php?title=Ghent_Functional_Programming_Group/BelHac/Register&diff=36757Ghent Functional Programming Group/BelHac/Register2010-09-13T14:11:08Z<p>Mcclurmc: </p>
<hr />
<div>Important: Please wait for a confirmation email before booking any flights/hotels.<br />
<br />
Registration is via email to Jasper Van der Jeugt at<br />
<br />
jaspervdj+belhac@gmail.com<br />
<br />
with the subject<br />
<br />
BelHac registration <br />
<br />
and body containing the following information:<br />
<br />
Name:<br />
#haskell nick: (if applicable)<br />
Email:<br />
Food restrictions:<br />
Days attending: <br />
<br />
Here is an example:<br />
<br />
Name: Jasper Van der Jeugt<br />
Nick: jaspervdj<br />
Email: jaspervdj@gmail.com<br />
Food restrictions: Raw flesh only<br />
Days attending: Friday, saturday and sunday<br />
<br />
If you want, you can also add you name here:<br />
<br />
{| class="wikitable"<br />
! Nickname<br />
! Real Name<br />
! Affiliation<br />
! Mobile #<br />
! Email<br />
! Arriving - Departing<br />
! Accomodation<br />
|-<br />
| jaspervdj<br />
| Jasper Van der Jeugt<br />
| Ghent University<br />
| +32 476 26 48 47<br />
| jaspervdj@gmail.com<br />
| <br />
| Has a small place in Ghent<br />
|-<br />
| Itkovian<br />
| Andy Georges<br />
| Ghent University/FWO<br />
| <br />
| itkovian@gmail.com<br />
|<br />
| Lives in Ostend, arrives by train on daily basis<br />
|-<br />
| Javache<br />
| Pieter De Baets<br />
| Ghent University<br />
| <br />
| pieter.debaets@gmail.com<br />
|<br />
|<br />
|-<br />
| boegel<br />
| Kenneth Hoste<br />
| Ghent University<br />
| <br />
| kenneth.hoste@ugent.be<br />
|<br />
| commute to/from Ghent daily<br />
|-<br />
| BCoppens<br />
| Bart Coppens<br />
| Ghent University<br />
| <br />
| bart.coppens@elis.ugent.be<br />
|<br />
|<br />
|-<br />
| jejansse<br />
| Jeroen Janssen<br />
| VUB<br />
|<br />
| jejansse@gmail.com<br />
|<br />
| Lives in Ghent.<br />
|-<br />
| Feuerbach<br />
| Roman Cheplyaka<br />
| <br />
| +380662285780<br />
| roma@ro-che.info<br />
| unknown yet<br />
| unknown yet<br />
|-<br />
| solidsnack<br />
| Jason Dusek<br />
| Heroku<br />
| +1 415 894 2162<br />
| jason.dusek@gmail.com<br />
| 5th-7th<br />
| Probably Monasterium.<br />
|-<br />
| kosmikus<br />
| Andres L&ouml;h<br />
| Well-Typed LLP<br />
|<br />
| mail@andres-loeh.de<br />
| 5th-7th<br />
|<br />
|-<br />
| Igloo<br />
| Ian Lynagh<br />
| Well-Typed LLP<br />
|<br />
| igloo@earth.li<br />
| 5th-7th<br />
|<br />
|-<br />
| dcoutts<br />
| Duncan Coutts<br />
| Well-Typed LLP<br />
|<br />
| duncan.coutts@googlemail.com<br />
| 5th-7th<br />
|<br />
|-<br />
| ADEpt<br />
| Dmitry Astapov<br />
| Well-Typed LLP<br />
|<br />
| dastapov@gmail.com<br />
| 5th-7th<br />
|<br />
|-<br />
| wvdschel<br />
| Wim Vander Schelden<br />
| Ghent University<br />
| <br />
| belhac@fixnum.org<br />
| <br />
| Lives in Ghent<br />
|-<br />
| sjoerd_visscher<br />
| Sjoerd Visscher<br />
| SDL Xopus<br />
| <br />
| sjoerd@w3future.com<br />
| 5th-7th<br />
| youth hostel<br />
|-<br />
| mietek<br />
| Miëtek Bak<br />
| Erlang Solutions<br />
| <br />
| mietek@gmail.com<br />
| 5th-7th<br />
| Open for suggestions<br />
|<br />
|-<br />
| <br />
| Steven Keuchel<br />
| Utrecht University<br />
| <br />
| <br />
| 5th-7th<br />
| <br />
|-<br />
| chr1s<br />
| Chris Eidhof<br />
| <br />
| <br />
| chris@eidhof.nl<br />
| 5th-7th<br />
| youth hostel<br />
|-<br />
|fphh<br />
|Heinrich Hördegen<br />
|Funktionale Programmierung<br />
|<br />
|hoerdegen@laposte.net<br />
|5th-7th<br />
|Open for suggestions<br />
|-<br />
| <br />
| Tom Lokhorst<br />
| <br />
| <br />
| tom@lokhorst.eu<br />
| 5th-7th<br />
| youth hostel<br />
|-<br />
| sioraiocht<br />
| Tom Harper<br />
| Oxford University Computing Laboratory<br />
| +44 7533 998 591<br />
| rtomharper@gmail.com<br />
| Friday-Sunday<br />
| <br />
|-<br />
| mcclurmc<br />
| Mike McClurg<br />
| <br />
| <br />
| mike.mcclurg@gmail.com<br />
| Friday-Sunday<br />
| <br />
|}</div>Mcclurmchttps://wiki.haskell.org/index.php?title=Haskell_Quiz/The_Solitaire_Cipher&diff=32576Haskell Quiz/The Solitaire Cipher2009-12-14T22:13:54Z<p>Mcclurmc: </p>
<hr />
<div>The first puzzle of the rubyquiz series was to implement the Solitaire cipher [http://en.wikipedia.org/wiki/Solitaire_(cipher)] Bruce Schneier made for Neil Stephenson's Cryptonomicon [http://en.wikipedia.org/wiki/Cryptonomicon]. The twist is that it's designed to be done by a Spy in a containment camp with no other tools than a deck of bridge cards.<br />
<br />
When creating a page, be sure to categorise it as code, with a <nowiki>[[Category:Haskell Quiz]]</nowiki> tag.<br />
<br />
==The problem==<br />
<br />
* http://www.rubyquiz.com/quiz1.html<br />
* http://www.schneier.com/solitaire.html<br />
<br />
==Solutions==<br />
<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Dolio|Dan Doel]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Matthias|Matthias]] (incomplete, but stream generation works)<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Paul|Paul]] ([http://mult.ifario.us/articles/2006/10/25/solitaire-cipher-in-haskell accompanying narrative])<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Burton|Jim]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Igloo|Igloo]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution JFoutz|JFoutz]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Thiago Arrais|Thiago Arrais]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Stoltze|Simon Stoltze]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Tirpen|Tirpen]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Mike McClurg|Mike McClurg]]<br />
<br />
[[Category:Haskell Quiz|Solitaire Cipher]]</div>Mcclurmchttps://wiki.haskell.org/index.php?title=Haskell_Quiz/The_Solitaire_Cipher/Solution_mcclurmc&diff=32575Haskell Quiz/The Solitaire Cipher/Solution mcclurmc2009-12-14T22:13:25Z<p>Mcclurmc: Haskell Quiz/The Solitaire Cipher/Solution mcclurmc moved to Haskell Quiz/The Solitaire Cipher/Solution Mike McClurg</p>
<hr />
<div>#redirect [[Haskell Quiz/The Solitaire Cipher/Solution Mike McClurg]]</div>Mcclurmchttps://wiki.haskell.org/index.php?title=Haskell_Quiz/The_Solitaire_Cipher/Solution_Mike_McClurg&diff=32574Haskell Quiz/The Solitaire Cipher/Solution Mike McClurg2009-12-14T22:13:25Z<p>Mcclurmc: Haskell Quiz/The Solitaire Cipher/Solution mcclurmc moved to Haskell Quiz/The Solitaire Cipher/Solution Mike McClurg</p>
<hr />
<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>Mcclurmchttps://wiki.haskell.org/index.php?title=Haskell_Quiz/The_Solitaire_Cipher/Solution_Mike_McClurg&diff=32573Haskell Quiz/The Solitaire Cipher/Solution Mike McClurg2009-12-14T22:12:08Z<p>Mcclurmc: </p>
<hr />
<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>Mcclurmchttps://wiki.haskell.org/index.php?title=Haskell_Quiz/The_Solitaire_Cipher&diff=32572Haskell Quiz/The Solitaire Cipher2009-12-14T22:10:37Z<p>Mcclurmc: </p>
<hr />
<div>The first puzzle of the rubyquiz series was to implement the Solitaire cipher [http://en.wikipedia.org/wiki/Solitaire_(cipher)] Bruce Schneier made for Neil Stephenson's Cryptonomicon [http://en.wikipedia.org/wiki/Cryptonomicon]. The twist is that it's designed to be done by a Spy in a containment camp with no other tools than a deck of bridge cards.<br />
<br />
When creating a page, be sure to categorise it as code, with a <nowiki>[[Category:Haskell Quiz]]</nowiki> tag.<br />
<br />
==The problem==<br />
<br />
* http://www.rubyquiz.com/quiz1.html<br />
* http://www.schneier.com/solitaire.html<br />
<br />
==Solutions==<br />
<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Dolio|Dan Doel]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Matthias|Matthias]] (incomplete, but stream generation works)<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Paul|Paul]] ([http://mult.ifario.us/articles/2006/10/25/solitaire-cipher-in-haskell accompanying narrative])<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Burton|Jim]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Igloo|Igloo]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution JFoutz|JFoutz]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Thiago Arrais|Thiago Arrais]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Stoltze|Simon Stoltze]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution Tirpen|Tirpen]]<br />
* [[Haskell Quiz/The Solitaire Cipher/Solution mcclurmc|Mike McClurg]]<br />
<br />
[[Category:Haskell Quiz|Solitaire Cipher]]</div>Mcclurmc