No unsafe perform (except what may be hidden in trace), nothing, fancy, no
gimmicks (very pedestrian, even heavy-handed) code. Complete code is
attached (I don't have smaller snippets, because I just discovered the
problem).
Best,
Murray Gross
On Mon, 5 Jan 2009, Luke Palmer wrote:
On Mon, Jan 5, 2009 at 4:34 PM, Murray Gross <[email protected]> wrote:
When using any of -O, -O1, -O2 with the Debian binary build of GHC 6.6,
trace shows that the expression
if (lr > ll) then False else True
is (at least partially) evaluated, but the value returned is always True,
even though trace reports that (lr > ll) is True. When I use only the native
code generator (without optimization), the correct value (False) is
returned.
Further detail and complete code on request.
Of course! This is obviously incorrect behavior. Are you doing any
unsafePerformIO? Please, complete code (minimal test case if possible, but
don't let that stop you).
Luke
Best,
Murray Gross
_______________________________________________
Haskell-Cafe mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe
-- *********************************************************************
-- * *
-- * 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
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) 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
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe
