# [Haskell-cafe] New Benchmark Under Review: Magic Squares

Daniel Fischer daniel.is.fischer at web.de
Mon Jul 3 16:55:58 EDT 2006

```Am Sonntag, 2. Juli 2006 01:58 schrieb Brent Fulgham:
> We recently began considering another benchmark for the shootout,
> namely a Magic Square via best-first search.  This is fairly
> inefficient, and we may need to shift to another approach due to the
> extremely large times required to find a solution for larger squares.

A slightly less naive approach to determining the possible moves dramatically
reduces the effort, while Josh Goldfoot's code did not finish within 4 1/2
hours on my machine, a simple modification (see below) reduced runtime for
N = 5 to 4.3 s, for N = 6 to 86.5 s.
Unfortunately, the squares are now delivered in a different order, so my
programme would probably be rejected :-(

>
> I thought the Haskell community might be interested in the
> performance we have measured so far (see "http://
> shootout.alioth.debian.org/sandbox/fulldata.php?
> test=magicsquares&p1=java-0&p2=javaclient-0&p3=ghc-0&p4=psyco-0"
>
> Interestingly, Java actually beats the tar out of GHC and Python for
> N=5x5 (and I assume higher, though this already takes on the order of
> 2 hours to solve on the benchmark machine).  Memory use in GHC stays
> nice and low, but the time to find the result rapidly grows.
>
> I was hoping for an order of magnitude increase with each increase in
> N, but discovered that it is more like an exponential...
>
> Thanks,
>
> -Brent

Modified code, still best-first search:

import Data.Array.Unboxed
import Data.List
import System.Environment (getArgs)

main :: IO ()

msquare :: Int -> IO ()
msquare n = let mn = (n*(n*n+1)) `quot` 2
grd = listArray ((1,1),(n,n)) (repeat 0)
unus = [1 .. n*n]
ff  = findFewestMoves n mn grd unus
ini = Square grd unus ff (2*n*n)
allSquares = bestFirst (successorNodes n mn) [ini]
in  putStrLn \$ showGrid n . grid \$ head allSquares

data Square = Square { grid :: UArray (Int,Int) Int
, unused :: [Int]
, ffm :: ([Int], Int, Int, Int)
, priority :: !Int
} deriving Eq

instance Ord Square where
compare (Square g1 _ _ p1) (Square g2 _ _ p2)
= case compare p1 p2 of
EQ -> compare g1 g2
ot -> ot

showMat :: [[Int]] -> ShowS
showMat lns = foldr1 ((.) . (. showChar '\n')) \$ showLns
where
showLns = map (foldr1 ((.) . (. showChar ' ')) . map shows)
lns

showGrid :: Int -> UArray (Int,Int) Int -> String
showGrid n g = showMat [[g ! (r,c) | c <- [1 .. n]] | r <- [1 .. n]] ""

bestFirst :: (Square -> [Square]) -> [Square] -> [Square]
bestFirst _ [] = []
bestFirst successors (front:queue)
| priority front == 0 = front : bestFirst successors queue
| otherwise = bestFirst successors \$ foldr insert queue (successors front)

successorNodes n mn sq
= map (place sq n mn (r,c)) possibilities
where
(possibilities,_,r,c) = ffm sq

place :: Square -> Int -> Int -> (Int,Int) -> Int -> Square
place (Square grd unus _ _) n mn (r,c) k
= Square grd' uns moveChoices p
where
grd' = grd//[((r,c),k)]
moveChoices@(_,len,_,_) = findFewestMoves n mn grd' uns
uns = delete k unus
p = length uns + len

findFewestMoves n mn grid unus
| null unus = ([],0,0,0)
| otherwise = (movelist, length movelist, mr, mc)
where
openSquares = [(r,c) | r <- [1 .. n], c <- [1 .. n], grid ! (r,c) ==
0]
pm = possibleMoves n mn grid unus
openMap = map (\(x,y) -> (pm x y,x,y)) openSquares
mycompare (a,_,_) (b,_,_) = compare (length a) (length b)
(movelist,mr,mc) = minimumBy mycompare openMap

possibleMoves n mn grid unus r c
| grid ! (r,c) /= 0 = []
| otherwise = intersect [mi .. ma] unus -- this is the difference that
-- does it: better bounds
where
cellGroups
| r == c && r + c == n + 1 = [d1, d2, theRow, theCol]
| r == c = [d1, theRow, theCol]
| r + c == n + 1 = [d2, theRow, theCol]
| otherwise = [theRow, theCol]
d1 = diag1 grid n
d2 = diag2 grid n
theRow = gridRow grid n r
theCol = gridCol grid n c
lows = scanl (+) 0 unus
higs = scanl (+) 0 \$ reverse unus
rge cg = let k = count0s cg - 1
lft = mn - sum cg
in (lft - (higs!!k),lft - (lows!!k))
(mi,ma) = foldr1 mima \$ map rge cellGroups
mima (a,b) (c,d) = (max a c, min b d)

gridRow grid n r = [grid ! (r,i) | i <- [1 .. n]]
gridCol grid n c = [grid ! (i,c) | i <- [1 .. n]]
diag1 grid n     = [grid ! (i,i) | i <- [1 .. n]]
diag2 grid n     = [grid ! (i,n+1-i) | i <- [1 .. n]]
count0s = length . filter (== 0)

Cheers,
Daniel

--

"In My Egotistical Opinion, most people's C programs should be
indented six feet downward and covered with dirt."
-- Blair P. Houghton

```