gistfile1.hs

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Prelude hiding (minimum, sum)
import Data.List (permutations)
import Control.Monad.ST
import Data.Bifunctor (second)
-- import Control.Monad
-- import Data.Array.ST
-- import Data.Array.Unboxed
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] 

eval :: STVector s Int -> Exp -> ST s Int
eval a (IfGt i j b1 b2) = do
  ai <- a `UM.unsafeRead` i
  aj <- a `UM.unsafeRead` j
  let b = if ai > aj then b1 else b2
  n <- evalBlock a b 
  return (n+1)
eval a (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 a (Copy i j) = do
  aj <- a `UM.unsafeRead` j
  UM.unsafeWrite a i aj
  return 1

evalBlock :: STVector s Int -> Block -> ST s Int
evalBlock a = foldlM f 0 where
  f !cnt exp = (+cnt) <$> eval a exp

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 $ replicate 40 (calcScore sornet)