Am Dienstag, 4. Juli 2006 18:20 schrieben Sie:
-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1
Daniel,
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).
Thanks for your efforts on this project. I'm actually more interested in using your earlier solution, since it is so much faster. Right now, the magic square code rises in runtime from 1.5 seconds to 4 hours with an increase of 1 in the square's dimension. I would much rather use a technique that had a more linear (or even exponential) increase!
I would propose modifying the other entries (since there are only a handful) to match the output of your original solution.
What do you think?
Cool, though the problem of exploding runtime remains, it's only pushed a little further. Now I get a 5x5 magig square in 1 s, a 6x6 in 5.4 s, but 7x7 segfaulted after about 2 1/2 hours - out of memory, I believe. And, as mentioned in passing, using 'intersect' in the first version is slowing things down, so here is my currently fastest (undoubtedly, the experts could still make it faster by clever unboxing): import Data.Array.Unboxed import Data.List import System.Environment (getArgs) main :: IO () main = getArgs >>= return . read . head >>= msquare 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 :: Int -> Int -> UArray (Int,Int) Int -> [Int] -> ([Int],Int,Int,Int) 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 :: Int -> Int -> UArray (Int,Int) Int -> [Int] -> Int -> Int -> [Int] possibleMoves n mn grid unus r c | grid ! (r,c) /= 0 = [] | otherwise = takeWhile (<= ma) $ dropWhile (< mi) unus 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 :: [Int] -> (Int,Int) 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, gridCol :: UArray (Int,Int) Int -> Int -> Int -> [Int] diag1, diag2 :: UArray (Int,Int) Int -> Int -> [Int] 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 :: [Int] -> Int count0s = length . filter (== 0)
- -Brent -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.2.2 (Darwin)
iD8DBQFEqpVmzGDdrzfvUpURAkPpAJ9oKTwzmUyTAoA6yQdOo7APKnXCqACghJEV id5EqEyVKrvSlJlLH9JZTN0= =jNXB -----END PGP SIGNATURE-----
Cheers, Daniel -- "In My Egotistical Opinion, most people's C programs should be indented six feet downward and covered with dirt." -- Blair P. Houghton