When reviewing a Graham scan convex hull algorithm implementation, I wrote the following function in an answer:
giftWrap :: [Vector2] -> [Vector2] giftWrap vs = result where -- Decides whether to keep or reject vertex b. -- Vertex b is provisionally kept if a left turn occurs there; the result -- is finalized only when a closed left-turn-only tour is completed. giftWrap' (a:b:c:vs) | vs ==  && dir == TurnLeft = (True, [b, c]) | vs ==  = (False, [c]) | dir == TurnLeft && final = (True, (b:gw)) | dir == TurnLeft = giftWrap' (a:gw) | otherwise = (False, (a : c : vs)) where dir = turn a b c (final, gw) = giftWrap' (b:c:vs) (_, result) = giftWrap' (vs ++ [head vs])
The purpose of this function is to keep only the vertices in the input sequence at which a left turn occurs. However, if a right turn is encountered, we must drop the right-turn vertex from consideration, backtrack, and try again.
To achieve backtracking, I’ve designed the inner function to return a status flag in addition to the result. I’m not satisfied with it though, as it looks ugly and is hard to follow.
Is there a better way to implement recursion with possible backtracking?
Is recursion the appropriate technique to use in the first place?
The simplest implementation that comes to my mind would keep the list split into two parts: One the already traversed points in reverse order, so that we can easily backtrack, and rest of unvisited points:
giftWrap :: [Vector2] -> [Vector2] giftWrap (a:rest) = gw  a rest where gw  b (c:xs) = gw [b] c xs -- beginning - just add the first point gw as@(a:as') b cs@(c:cs') | TurnRight <- turn a b c = gw as' a cs -- backtrack | otherwise = gw (b:as) c cs' -- advance gw as b  = reverse (b : as)
At the end, we need to reverse the result (unless we don’t mind having the points reversed).
There is no need to check the case of the first point in the list, as it’s always chosen so that it’s a left turn.
Using pattern guards simplifies the call to
I also added a small snippet that uses
Test.QuickCheck to test the algorithm:
vectors :: Gen [Vector2] vectors = nub <$> (listOf1 $ Vector2 <$> r <*> r) where r = fromIntegral <$> choose (-2 :: Int, 2 :: Int) gwconvex_property :: Property gwconvex_property = forAllShrink vectors (shrinkList shrinkNothing) $ xs -> let rotate (x:xs) = xs ++ [x] vs = hull xs vs' = rotate vs vs'' = rotate vs' in counterexample ("Input: " ++ show vs) $ counterexample ("Chained: " ++ show (chain vs)) $ conjoin $ zipWith3 (a b c -> turn a b c /= TurnRight) vs vs' vs'' main = quickCheck gwconvex_property
Note that the original implementation of
giftWrap fails the test, either with
Non-exhaustive patterns in function
or producing non-convex result, but I didn’t have time to explore the details.