bazzargh · November 27, 2018 19:07
diff --git a/puzzle.hs b/puzzle.hs
 import Data.List
 import Data.Function (on)

 -- I don't like the formulation of the exercise, since it seems to suggest you should
 -- just look at the picture to get the local over/under relations then solve for the global order.
 -- Shouldn't haskell be able to figure out the local relations too?
 -- so, as input, just give it the puzzle:
 puzzle=zip [0..15] [7,7,8,8,7,1,1,2,6,1,1,5,3,3,4,5]
 -- here I'm numbering cells 0..15, top left to bottom right.
 -- The top left cells of each square are all different (otherwise a square would be completely
 -- covered). So they are all positions but one of a permutation of [0,1,2,4,5,6,8,9,10].
 -- For convenience, let's say there is a 9th square labelled 0, so I can just use permutations
 -- of that list to give all the possible positions of the squares.
 -- next, given the top left cell of each paper square, generate the list of squares covered:
 cover tl = concatMap(\(a,b)->[(a,b),(a+1,b),(a+4,b),(a+5,b)]) $ zip tl [0..8]
 -- so eg if the top left position of square 7 was 0, this generates [(0,7),(1,7),(4,7),(5,7),...]
 -- a cover is part of a valid solution if every element of 'puzzle' is an element of the cover;
 -- we can use this to shortcut the solution a bit to check the cover without checking the
 -- permutation of levels.
 -- Next given the levels of the paper squares, and a cover, what is visible?
 -- levels are permutations of [0..8]; I'll fix the fake square 0 to be at level 8 later.
 addLevels lev cov = map (\(a,b)->(a,(lev!!b,b))) cov
 groupCells xs = groupBy ((==)`on`fst) $ sort xs
 removeHiddenLabels = map head
 removeLevels = map (\a->(fst a, snd $ snd a)) 
 visible lev cov = removeLevels $ removeHiddenLabels $ groupCells $ addLevels lev cov
 -- now find the solution. It's the label at level 7, since level 8 is fixed to be label 0.
 solution = [elemIndex 7 lev|tl<-permutations [0,1,2,4,5,6,8,9,10],let cov=cover tl,all (`elem`cov) puzzle,lev<-permutations [0..8],head lev==8,all (`elem`(visible lev cov)) puzzle]
	import Data.List
	import Data.Function (on)

	-- I don't like the formulation of the exercise, since it seems to suggest you should
	-- just look at the picture to get the local over/under relations then solve for the global order.
	-- Shouldn't haskell be able to figure out the local relations too?
	-- so, as input, just give it the puzzle:
	puzzle=zip [0..15] [7,7,8,8,7,1,1,2,6,1,1,5,3,3,4,5]
	-- here I'm numbering cells 0..15, top left to bottom right.
	-- The top left cells of each square are all different (otherwise a square would be completely
	-- covered). So they are all positions but one of a permutation of [0,1,2,4,5,6,8,9,10].
	-- For convenience, let's say there is a 9th square labelled 0, so I can just use permutations
	-- of that list to give all the possible positions of the squares.
	-- next, given the top left cell of each paper square, generate the list of squares covered:
	cover tl = concatMap(\(a,b)->[(a,b),(a+1,b),(a+4,b),(a+5,b)]) $ zip tl [0..8]
	-- so eg if the top left position of square 7 was 0, this generates [(0,7),(1,7),(4,7),(5,7),...]
	-- a cover is part of a valid solution if every element of 'puzzle' is an element of the cover;
	-- we can use this to shortcut the solution a bit to check the cover without checking the
	-- permutation of levels.
	-- Next given the levels of the paper squares, and a cover, what is visible?
	-- levels are permutations of [0..8]; I'll fix the fake square 0 to be at level 8 later.
	addLevels lev cov = map (\(a,b)->(a,(lev!!b,b))) cov
	groupCells xs = groupBy ((==)`on`fst) $ sort xs
	removeHiddenLabels = map head
	removeLevels = map (\a->(fst a, snd $ snd a))
	visible lev cov = removeLevels $ removeHiddenLabels $ groupCells $ addLevels lev cov
	-- now find the solution. It's the label at level 7, since level 8 is fixed to be label 0.
	solution = [elemIndex 7 lev\|tl<-permutations [0,1,2,4,5,6,8,9,10],let cov=cover tl,all (`elem`cov) puzzle,lev<-permutations [0..8],head lev==8,all (`elem`(visible lev cov)) puzzle]