If you believe this is a compiler bug, please report it: http://hackage.haskell.org/trac/ghc/newticket?type=bug mgross21:
My last note had an error in it, and the code originally sent to the list should be ignored. I have attached the current version of the code, and here is some further information (the behavior is different, by the way, but still apparently wrong).
I have attached the current version of the program, which behaves slightly differently from the version originally sent.
I am running ghc 6.6, gcc 4.1.2, g++ 4.1.1, on Debian Linux. The compile lines are ghc -threaded solve.hs or ghc -threaded -O2 solve.hs. The execution line is ./a.out, which should give me single-threaded execution.
Ignore the output on stdout; it is the same for both versions.
On stderr, the unoptimized version of the attached code gives me both "fail" and "goOn" (see lines #150 and #153). The optimized version gives me only "goOn." I think that both should give me both "fail" and "goOn."
Were circumstances different, I might suspect that laziness and optimization had something to do with this. However, earlier tests showed inconsistency between the result of the test in gTst3 and the code where the value of gTst3 is used.
A copy of the current version of solve.hs is attached.
Best,
Murray Gross
P.S.: For anyone who has actually looked at the logic, I am aware that the test in gTst3 can be sharpened. That will come later. The current version is adequate for the time being.
Content-Description: Current version of solve.hs
-- ********************************************************************* -- * * -- * Eternity II puzzle. Each puzzle piece is represented by a * -- * 5-tuple, in which the first 4 entries represent the four * -- * edge colors in the order left, top, right, bottom, and the * -- * fifth member is the (numerical) identifier for the piece. * -- * * -- *********************************************************************
-- module Solve where
import Data.Array.IArray import Control.Parallel import Control.Parallel.Strategies import List import Debug.Trace
main = putStrLn (show corns) >> putStrLn (corpic) >> putStrLn "Left sides\n">>
putStrLn (pArrayPic (pArray pSides)) >> putStrLn "Right sides\n">> putStrLn (pArrayPic (rightArray ))>> putStrLn (show (length (perims (pArray pSides) corTemp))) >> putStrLn (show (perims (pArray pSides) corTemp))>> putStrLn "done"
-- ********************************************************************* -- * * -- * Make a list of all possible perimeters. Run the operation in * -- * parallel over the list of possible corner configurations. * -- * * -- *********************************************************************
perims:: Array (Int) [Int]-> [(Int,Int,Int,Int)]->[[Int]] perims pArray corTemp = concat $ parMap rwhnf (\oneCor->makPerim oneCor pArray ) corTemp
-- ********************************************************************* -- * * -- * We build a list of perimeters by constructing each backward * -- * from position 59. However, position 59 needs special handling * -- * because it must match position 0 as well as 58. Each of the * -- * other corners will also need special handling, which is done * -- * by a case statement. * -- * * -- * Note that pArray is organized by the left sides of the pieces, * -- * while in makePerim we need to check the right side of a * -- * against the bottom of the first corner. This results in the * -- * need for rightArray, and some tricky indexing. * -- * * -- *********************************************************************
makPerim :: (Int,Int,Int,Int) -> Array (Int) [Int] -> [[Int]] makPerim oneCor pArray = [a:b | a <- ((rightArray) ! startCol), b <- (restPerim a (pArray // [(left(refPerim!a), (pArray!(left(refPerim!a)))\\[a])])
(rightArray //[(startCol, (rightArray ! startCol) \\ [a])]) oneCor 58), trace (show b) b /=[] ] where startCol = bot (corns !! (fst4 oneCor))
-- ********************************************************************* -- * * -- * Once past the first piece in a perimeter, move to next. * -- * Check for a corner piece, which needs special handling. * -- * If there are no candidates left to match last, terminate * -- * the recursion, indicating there is no way to continue. * -- * Otherwise, construct the list of possible continuations of * -- * the perimeter. * -- * * -- ********************************************************************* --
restPerim last leftRay rightRay oneCor iAm | -- trace ((show iAm)++" "++ (show last)) elem iAm [0,15,30,45] = corner last leftRay rightRay oneCor iAm
| useRow /= [] = extend
| otherwise = []
where useRow = rightRay ! (left (refPerim ! last)) extend = [b:c | b <- (rightRay ! (left (refPerim ! last))), c <- restPerim b (newLeft b) (newRight b) oneCor (iAm - 1), --trace (show c) c/=[]] newLeft b = leftRay // [((left (refPerim ! b)), (leftRay ! (left (refPerim ! b))) \\ [b])] newRight b = rightRay // [((right (refPerim ! b)), (rightRay ! (right (refPerim ! b))) \\ [b])]
-- ********************************************************************* -- * * -- * Corners get special handling. The corner in the upper left is * -- * always piece 1, because of rotational symmetry. * -- * * -- ********************************************************************* --
corner last leftRay rightRay oneCor iAm
| -- trace ((show last)++" "++(show iAm)) iAm == 15 = if (gTst3 leftRay rightRay) then (trace "goOn") goOn (snd4 oneCor) else trace "fail" [] | -- trace "goo" iAm == 30 = goOn (thd4 oneCor) | -- trace "gah" iAm == 45 = goOn (fth4 oneCor) | -- trace "gii" iAm == 0 = if (lastLeft == rightCor 1) then [[1]] else [] | otherwise = error ("\n\n *** You can't get here"++ " *** \n\n")
where lastLeft = left (refPerim ! last) rightCor b = right (refPerim ! b) botCor b = bot (refPerim ! b) nLeft b = left (refPerim ! b)
goOn q = if (lastLeft /= rightCor q) then [] else [q:c:d | c <- (leftRay ! (botCor q)), d <- -- trace ((show q)++" "++ -- (show c)++"xx ")
restPerim c (newleft c) (newright c) oneCor (iAm - 2) ] newleft c = leftRay // [((nLeft c), leftRay!(nLeft c)\\[c])] newright c = rightRay // [((rightCor c), rightRay!(rightCor c)\\ [c])]
-- ********************************************************************* -- * * -- * agTst is a simple heuristic test to determine whether it is * -- * possible for a perimeter to be built with the remaining * -- * pieces: it tests to find out whether there are an equal no. of * -- * pieces whose right side matches the left sides of available * -- * pieces, except, perhaps for 1, which will fit a corner piece. * -- * * -- * And it doesn't work, at least at the beginning of the solution.* -- * In the first 10,000,000 passages through corner 15, there is * -- * only 1 fail. * -- * * -- *********************************************************************
gTst :: Array Int [Int] -> Array Int [Int] -> Bool gTst right left = and $ map tryme (indices right)
where iList = indices right tryme x | (length (right ! x)) == (length (left ! x)) = True
| abs ((length (right ! x))- (length (left ! x))) == 1 = True | otherwise = False
gTst1:: Array Int [Int] -> Array Int [Int] -> Bool gTst1 right left = if (sum $ map tryme (indices right)) > 2 then False else True where tryme x = abs ((length (right ! x)) - (length (left ! x))) gTst2 right left = if (length (left ! 2)) > 0 then True else False
gTst3 right left = if ((lr > ll+2)||(lr < ll-2)) then False else True where lr = length (right ! 2) ll = length (left ! 2)
-- ********************************************************************* -- * * -- * Here we make up a list of the 6 possible corner configurations * -- * There are only 6 such because the remaining permutations of * -- * corner pieces are merely rotations of the six used here. * -- * * -- *********************************************************************
corTemp :: [(Int,Int,Int,Int)] corTemp = [(1,2,3,4),(1,2,4,3),(1,3,2,4),(1,3,4,2),(1,4,2,3),(1,4,3,2)]
corns = [(0,0,0,0,0), (0,0,2,1,1),(0,0,2,3,2),(0,0,4,1,3),(0,0,1,4,4)]
-- ********************************************************************* -- * * -- * Construct an array in which each entry is a list of pieces * -- * that have the same color on the left side. This array will be * -- * used to construct the perimeters of the puzzle. * -- * * -- * We use pArray as an array of available pieces, and refPerim * -- * in order to find the matching colors; since it changes a lot, * -- * the reduced item count will reduce overhead from building new * -- * pArray's. * -- * * -- *********************************************************************
pSides:: [(Int,Int,Int,Int,Int)] pSides = [(2,0,2,5,5),(4,0,2,6,6),(2,0,2,7,7),(8,0,2,7,8),(1,0,2,9,9), (3,0,2,10,10),(4,0,2,11,11),(3,0,2,12,12),(8,0,2,12,13), (3,0,2,13,14),(2,0,4,6,15),(1,0,4,14,16),(8,0,4,15,17), (8,0,4,16,18),(4,0,4,10,19),(4,0,4,11,20),(3,0,4,17,21), (2,0,4,18,22),(8,0,4,18,23),(2,0,4,19,24),(2,0,4,13,25), (4,0,1,5,26),(1,0,1,5,27),(1,0,1,6,28),(1,0,1,14,29), (8,0,1,10,30),(4,0,1,11,31),(1,0,1,19,32),(4,0,1,12,33),
(3,0,1,12,34),(8,0,1,20,35),(3,0,1,21,36),(2,0,3,14,37), (8,0,3,22,38),(8,0,3,9,39),(4,0,3,16,40),(1,0,3,16,41), (2,0,3,11,42),(4,0,3,11,43),(1,0,3,11,44),(2,0,3,17,45), (3,0,3,19,46),(3,0,3,12,47),(3,0,3,20,48),(8,0,8,5,49),
(2,0,8,6,50),(4,0,8,6,51),(2,0,8,7,52),(3,0,8,10,53), (3,0,8,17,54),(8,0,8,17,55),(1,0,8,12,56),(2,0,8,20,57), (8,0,8,20,58),(4,0,8,13,59),(1,0,8,21,60)]
pArray:: [(Int,Int,Int,Int,Int)] -> Array (Int) [Int] pArray pSides = accumArray (++) [] (1,8) accumPlist
rightArray:: Array (Int) [Int] rightArray = accumArray (++) [] (1,8) rightAccum rightAccum = map (\item ->((right item),[piece item])) pSides
accumPlist = map (\item ->((left item),[piece item])) pSides
refPerim:: Array (Int) (Int,Int,Int,Int,Int)
refPerim = listArray (1,60) (trace "don't get here"(drop 1 corns)++pSides)
-- ********************************************************************* -- * * -- * Pretty-printer for corner configurations. * -- * * -- * * -- *********************************************************************
corpic = concat $ map oneSq corTemp
oneSq (a,b,c,d) = show (corns !! a) ++ " " ++ show (corns !! b) ++ "\n\n" ++ show (corns !! c)++" "++show (corns !! d) ++ "\n\n\n"
-- ********************************************************************* -- * * -- * Ugly-printer for pArray, the array of pieces for the * -- * perimeter. * -- * * -- * * -- *********************************************************************
pArrayPic myray = concatMap (\x-> (show x)++"\n\n") (elems myray)
-- ********************************************************************* -- * * -- * Convenience functions. * -- * * -- *********************************************************************
left:: (Int,Int,Int,Int,Int) -> Int left (a,b,c,d,e) = a fst4 (a,b,c,d) = a
top (a,b,c,d,e) = b snd4 (a,b,c,d) =b
right (a,b,c,d,e) = c thd4 (a,b,c,d) = c
bot (a,b,c,d,e) = d fth4 (a,b,c,d) = d
piece (a,b,c,d,e) = e
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe