Am Mittwoch, 5. Juli 2006 21:28 schrieben Sie:
Hi Daniel,
In the paragraph below it looks like you improved the performance of 5x5 from one and one half hours to one second. Is that a typo or should I be very, very impressed. :-)
Cheers, David
Err, neither, really. Apparently, I haven't expressed myself immaculately clearly, so let me try again. Josh Goldfoot's original code produced a 5x5 magic square on the benchmarking computer in 8063.01s, on my computer, I hit ctrl-C after about 4 1/2 hours. My first version produced a 5x5 square in a little over 4 seconds (or was it a little over 5s, I'm not sure), and a 6x6 square in 86.5s, but since I used better bounds for the possible moves - e.g., if we regard a 5x5 square with two entries, 1 at (1,1) and 2 at (1,2), JG's code would give [3 .. 25] as the list of possible moves for (1,3), whereas I took into account that the sum of (1,4) and (1,5) is at most 24 + 25 = 49 (and at least 3+4, but that doesn't help here), thus finding that (1,3) must be at leat 65 - (1+2) - 49 = 13 and [13 .. 25] as the list of possible moves. So I avoided a lot of dead ends, but produced a different magic square. This code I have pushed down to 1s for the 5x5 square and 5.4s for the 6x6 square (simply by replacing "intersect [a .. b]" with "takeWhile (<= b) : dropWhile (< a)"). I have then tuned Josh Goldfoot's code (throwing out the List <-> Set conversions, keeping a list of unused numbers and not much else), so that it produced a 5x5 square in 1 1/2 hours on my computer, giving the same list of possible moves as the original and hence the same magic square. That's not bad, but not really awe-inspiring. However, I've also combined the algorithms, using my better bounds, thus avoiding many dead ends, but calculating the priorities as if I used the original bounds, so exploring the branches in the same order and producing the same square as the original. This took about 12 minutes for a 5x5 square and impressed me - I expected it to be significantly slower than the fast code, but a factor of 720 was much more than I dreamed of. Cheers, Daniel
On Jul 4, 2006, at 6:48 AM, Daniel Fischer wrote:
Hi, I have now tuned Josh Goldfoot's code without changing the order in which the magic squares are produced, for a 5x5 magic square, my machine took about 1 1/2 hours and used 2Mb memory (considering that the original code did not finish within 4 1/2 hours here, that should push time on the benchmarking machine under 3000s and put us in the lead, I hope). However, with the improved bounds for the possibilities, I can now get a 5x5 square in 1s, a 6x6 square in 5.5s (replacing intersect by takeWhile & dropWhile), so it's still sloooowwww.
Brent, can I informally submit the code thus, or what formalities would I have to perform to submit my code?
---------------------------------------------------------------------- ----------------------------- {- The Computer Language Shootout http://shootout.alioth.debian.org/
benchmark implementation contributed by Josh Goldfoot modified by Daniel Fischer to improve performance -}
{- An implementation using Data.Graph would be much faster. This implementation is designed to demonstrate the benchmark algorithm. -}
import Data.Array import Data.List import System (getArgs)
main = do n <- getArgs >>= return . read . head let mn = (n * (1 + n * n)) `div` 2 -- the magic number initialNode = makeSquare n mn (listArray ((1,1),(n,n)) (repeat 0), [1 .. n^2]) allSquares = bestFirst (successorNodes n mn) (initialNode:[]) putStrLn $ printMatrix n $ grid $ head allSquares where printMatrix n grid = unlines [ (rowlist grid n y) | y <- [1..n]] where rowlist grid n y = unwords [show $ grid ! (x,y) | x <- [1..n]]
data Square = Square { grid :: Array (Int,Int) Int, ffm :: ([Int], Int, Int), unused :: [Int], priority :: !Int }
{- bestFirst: Given a queue with one initial node and a function, successors, that takes a node and returns a list of nodes that are created by making all possible moves in a single cell, implements the Best-First algorithm, and returns a list of all nodes that end up with priority zero. In this implementation we only ever use the first node. -} bestFirst _ [] = [] bestFirst successors (frontnode:priorityq)
| priority frontnode == 0 = frontnode:bestFirst successors
priorityq
| otherwise = bestFirst successors $ foldr (insertBy
compSquare) priorityq (successors frontnode) where {- The priority queue is sorted first by the node's calculated priority; then, if the priorities are equal, by whichever node has the lowest numbers in the top-left of the array (or the next cell over, and so on). -} compSquare a b = case compare (priority a) (priority b) of EQ -> compare (grid a) (grid b) ot -> ot
{- successorNodes: Find the cell with the fewest possible moves left, and then creates a new node for each possible move in that cell. -} successorNodes n mn squarenode = map (makeSquare n mn) [(thegrid//[((x, y), i)], delete i un) | i <- possibilities] where thegrid = grid squarenode un = unused squarenode (possibilities, x, y) = ffm squarenode
{- makeSquare: Creates a node for the priority queue. In the process, this calculates the cell with the fewest possible moves, and also calculates this node's priority. The priority function is: (number of zeros in the grid) plus (number of possible moves in the cell with the fewest possible moves) the lower the priority, the sooner the node will be popped from the queue. -} makeSquare n mn (thegrid,un) = Square { grid = thegrid, ffm = moveChoices, unused = un, priority = calcPriority } where moveChoices@(poss,_,_) = findFewestMoves n mn thegrid un calcPriority = length un + length poss
{- findFewestMoves: Go through the grid (starting at the top-left, and moving right and down), checking all 0 cells to find the cell with the fewest possible moves. -} findFewestMoves n mn grid un
| null un = ([],0,0) | otherwise = (movelist, mx, my)
where openSquares = [ (x,y) | y <- [1..n], x <- [1..n], (grid ! (x,y)) == 0] pm = possibleMoves n mn grid un openMap = map (\(x,y) -> (pm (x,y), (x,y))) openSquares mycompare f g = compare ((length . fst) f) ((length . fst) g) (movelist, (mx, my)) = minimumBy mycompare openMap
{- possibleMoves: Return all moves that can go in the cell x,y for a given grid. A move is possible if the move (number) is not already in the grid, and if, after making that move, it is still possible to satisfy the magic square conditions (all rows, columns, diagonals adding up to mn, the magic number) -} possibleMoves n mn grid un (x,y)
| grid ! (x,y) /= 0 = [] | null oneZeroGroups = takeWhile (<= highest) un -- [1 .. highest]
`intersect` un
| otherwise = case onePossible of
[p] | p `elem` un -> [p] _ -> [] where cellGroups
| x + y == n + 1 && x == y = [diag1 grid n, diag2 grid
n, theRow, theCol]
| x == y = [diag1 grid n, theRow, theCol] | x + y == n + 1 = [diag2 grid n, theRow, theCol ] | otherwise = [theRow, theCol]
theRow = gridRow grid n x y theCol = gridCol grid n x y oneZeroGroups = filter (\x -> count 0 x == 1) cellGroups onePossible = nub ( [mn - (sum g) | g <- oneZeroGroups ] ) highest = minimum ( (n*n):[mn - (sum g) | g <- cellGroups] )
{- Utility functions to extract a single row, column, or diagonal. -} gridRow grid n _ y = [grid ! (xx, y) | xx <- [1..n]] gridCol grid n x _ = [grid ! (x, yy) | yy <- [1..n]] diag1 grid n = [grid ! (i, i) | i <- [1..n]] diag2 grid n = [grid ! (i, n - i + 1) | i <- [1..n]]
{- Returns the number of times n appears n list xs -} count n xs = length $ filter ((==) n) xs
---------------------------------------------------------------------- -----------------------------
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.
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
Cheers, Daniel
--
"In My Egotistical Opinion, most people's C programs should be indented six feet downward and covered with dirt." -- Blair P. Houghton
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-------------------------------- David F. Place mailto:d@vidplace.com
-- "In My Egotistical Opinion, most people's C programs should be indented six feet downward and covered with dirt." -- Blair P. Houghton