Skip to content

Instantly share code, notes, and snippets.

@jkff
Forked from qnikst/gist:f832a50a957ce20fb67b
Created January 6, 2015 06:40
Show Gist options
  • Save jkff/7d85da1e409c8725f282 to your computer and use it in GitHub Desktop.
Save jkff/7d85da1e409c8725f282 to your computer and use it in GitHub Desktop.
{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Prelude hiding (minimum, sum)
import Data.List (permutations)
import Control.Monad.ST
import Data.Bifunctor (second)
import Data.Vector.Unboxed (Vector)
import qualified Data.Vector.Unboxed as U
import Data.Vector.Unboxed.Mutable (STVector)
import qualified Data.Vector.Unboxed.Mutable as UM
import Data.Foldable
data Exp = IfGt !Int !Int !Block !Block -- if a[i] > a[j] then blk1 else blk2
| Swap !Int !Int -- a[i] <-> a[j] (i,j < 8)
| Copy !Int !Int -- a[i] <- a[j] (i > 7)
deriving Show
type Block = [Exp]
evalBlock :: STVector s Int -> Block -> ST s Int
evalBlock a es = go es 0
where
go [] !n = return n
go (e:es) !n = do
!n2 <- eval e
go es (n + n2)
eval (IfGt i j !b1 !b2) = do
ai <- a `UM.unsafeRead` i
aj <- a `UM.unsafeRead` j
if ai > aj then go b1 1 else go b2 1
eval (Swap i j) = do
ai <- a `UM.unsafeRead` i
aj <- a `UM.unsafeRead` j
UM.unsafeWrite a i aj
UM.unsafeWrite a j ai
return 1
eval (Copy i j) = do
aj <- a `UM.unsafeRead` j
UM.unsafeWrite a i aj
return 1
numSteps :: Block -> Vector Int -> Int
numSteps blk ua = runST $ do
a <- U.thaw ua
n <- evalBlock a blk
r1 <- a `UM.unsafeRead` 1
r6 <- a `UM.unsafeRead` 6
return $ if r1 == 2 && r6 == 7 then n else 25000
inputs :: [Vector Int]
inputs = let ps = permutations [1..8]
zs = [0,0,0,0]
in [ U.fromListN 12 (p ++ zs) | p <- ps]
calcScore :: Block -> Int
calcScore blk = sum $ map (numSteps blk) inputs
cmp_swap i j = IfGt i j [Swap i j] []
mksornet cmp =
[cmp 0 1, cmp 2 3, cmp 4 5, cmp 6 7,
cmp 0 2, cmp 1 3, cmp 4 6, cmp 5 7,
cmp 1 2, cmp 5 6, cmp 0 4, cmp 3 7,
cmp 1 5, cmp 2 6,
cmp 1 4, cmp 3 6]
sornet :: Block
sornet = mksornet cmp_swap
main = print . minimum . map calcScore $ [Copy 10 (x `mod` 10) : sornet | x <- [1..40]]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment