[Haskell-cafe] Maybe a compiler bug?
Murray Gross
mgross21 at verizon.net
Tue Jan 6 12:32:01 EST 2009
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.
-------------- next part --------------
-- *********************************************************************
-- * *
-- * 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
More information about the Haskell-Cafe
mailing list