Skip to content

Instantly share code, notes, and snippets.

@KWMalik
Forked from supki/Main.hs
Created July 30, 2012 20:04
Show Gist options
  • Save KWMalik/3209715 to your computer and use it in GitHub Desktop.
Save KWMalik/3209715 to your computer and use it in GitHub Desktop.
Cryptography coursera class exercise #5.
{-# LANGUAGE UnicodeSyntax #-}
import Control.Monad (foldM_, join)
import qualified Data.HashMap.Lazy as H
b ∷ Int
b = 1048576
p ∷ Integer
p = 13407807929942597099574024998205846127479365820592393377723561443721764030073546976801874298166903427690031858186486050853753882811946569946433649006084171
g ∷ Integer
g = 11717829880366207009516117596335367088558084999998952205599979459063929499736583746670572176471460312928594829675428279466566527115212748467589894601965568
h ∷ Integer
h = 3239475104050450443565264378728065788649097520952449527834792452971981976143292558073856937958553180532878928001494706097394108577585732452307673444020333
(×) ∷ Integer → Integer → Integer
m × n = (m * n) `rem` p
main ∷ IO ()
main =
do let hm = H.fromList victims
foldM_ (\_ (v,x0) → maybe (return ()) (\x1 → print $ x0 * b + x1) $ H.lookup v hm) () hunters
victims ∷ [(Integer,Int)]
victims = zip (map ((h×) . inverse p) $ powers g) [0..b-1]
hunters ∷ [(Integer,Int)]
hunters = zip (powers $ g `powMod` b) [0..b-1]
inverse ∷ Integral a ⇒ a → a → a
inverse _ 1 = 1
inverse q x = (n * q + 1) `quot` x
where
n = x - inverse x (q `rem` x)
powers ∷ Integer → [Integer]
powers m = 1 : iterate (m×) m
powMod ∷ Integer → Int → Integer
powMod _ 0 = 1
powMod x' n' = f x' n' 1
where
f x n y
| n == 1 = x × y
| r == 0 = f x2 q y
| otherwise = f x2 q (x × y)
where
(q,r) = quotRem n 2
x2 = join (×) x
@KWMalik
Copy link
Author

KWMalik commented Jul 30, 2012

% ./Main
375374217830

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment