On my machine Haskell runs 52 secs while c++ 30 secs.
are identical.
and learning experience.
even if it is multithreaded and my is not.
{-# LANGUAGE CPP, BangPatterns #-}
{- The Computer Language Benchmarks Game
http://shootout.alioth.debian.org/
contributed by Branimir Maksimovic
-}
import System.Environment
import Text.Printf
import Data.Bits
import qualified Data.Vector.Unboxed.Mutable as VM
import qualified Data.Vector.Generic.Mutable as VG
import qualified Data.Vector.Unboxed as V
main = do
n <- getArgs >>= readIO.head
(checksum,maxflips) <- fannkuch n
printf "%d\nPfannkuchen(%d) = %d\n" checksum n maxflips
fannkuch n = do
!perm <- V.unsafeThaw $ V.fromList [1..n]
!tperm <- VG.new n
!cnt <- VG.replicate n 0
let
loop :: Int -> Int -> Int -> IO(Int,Int)
loop !c !m !pc = do
!b <- next_permutation perm n cnt
if b == False then return (c,m)
else do
VM.unsafeCopy tperm perm
!flips <- count_flips tperm 0
loop (c + (if pc .&. 1 == 0 then flips else -flips))
(max m flips)
(pc+1)
r <- loop 0 0 1
return r
next_permutation :: VM.IOVector Int -> Int -> VM.IOVector Int-> IO(Bool)
next_permutation !perm !n !cnt =
do
!i <- loop 1
if(i >= n)
then return False
else do
!v <- VM.unsafeRead cnt i
VM.unsafeWrite cnt i (v+1)
return True
where
loop :: Int -> IO(Int)
loop !i
| i < n = do
!tmp <- VM.unsafeRead perm 0
let
rotate :: Int -> IO()
rotate !j =
if j >= i
then do
VM.unsafeWrite perm i tmp
return ()
else do
!v <- VM.unsafeRead perm (j+1)
VM.unsafeWrite perm j v
rotate (j+1)
rotate 0
!v <- VM.unsafeRead cnt i
if v >= i
then do
VM.unsafeWrite cnt i 0
loop (i+1)
else return i
| otherwise = return i
count_flips :: VM.IOVector Int -> Int -> IO(Int)
count_flips !tperm !flips = do
!f <- VM.unsafeRead tperm 0
if f == 1
then
return flips
else do
VG.reverse $ VM.unsafeSlice 0 f tperm
count_flips tperm (flips+1)