| {-# LANGUAGE ScopedTypeVariables #-} |
| {-# LANGUAGE BangPatterns #-} |
| {-# OPTIONS_GHC -Wall -Wno-orphans #-} |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
|
|
| module Main where |
|
|
| import Data.Complex |
| import qualified Data.Vector.Storable as VS |
| import Numeric (showFFloat) |
| import System.Environment (getArgs) |
| import System.Time.It (timeIt) |
| import Text.Printf (printf) |
|
|
| type StorableVec = VS.Vector (Complex Double) |
|
|
| |
| |
| johnsonWalkStorable :: Int -> Int -> Int -> StorableVec -> StorableVec |
| johnsonWalkStorable l b w old = |
| let msgSize = 2 ^ (l * b) |
| cvSize = 2 ^ w |
| n = msgSize * cvSize * 2 |
| in VS.generate n $ \idx -> |
| let msg = idx `div` (cvSize * 2) |
| rest = idx `mod` (cvSize * 2) |
| cv = rest `div` 2 |
| flag = rest `mod` 2 |
| msg' = (msg + 1) `mod` msgSize |
| oldOff = ((msg' * cvSize) + cv) * 2 + flag |
| in VS.unsafeIndex old oldOff |
|
|
| main :: IO () |
| main = do |
| args <- getArgs |
| case args of |
| [ls, bs, ws] -> do |
| let l = read ls; b = read bs; w = read ws |
| n = 2 ^ (l * b + w + 1) :: Int |
| bytes = (fromIntegral n * 16 :: Double) / (1024^(3::Int)) |
| putStrLn $ "State space N = 2^" ++ show (l*b+w+1) |
| ++ " (" ++ show n ++ " states, ~" |
| ++ printf "%.2f" bytes ++ " GB RAM)" |
| let vec = VS.generate n $ \i -> if i == 0 then 1 :+ 0 else 0 :+ 0 |
| putStrLn "Executing Johnson Walk (unboxed storable)..." |
| timeIt $ do |
| let !out = johnsonWalkStorable l b w vec |
| let (r :+ im) = VS.unsafeIndex out 0 |
| putStrLn $ "First amplitude: " |
| ++ showFFloat (Just 6) r "" ++ " " |
| ++ showFFloat (Just 6) im "" |
| _ -> putStrLn "Usage: ./johnsonWalkStorable <L> <b> <w>" |
|
|
