# Tis the season for gift-wrapping

Posted on

Problem

When reviewing a Graham scan convex hull algorithm implementation, I wrote the following function in an answer:

``````giftWrap :: [Vector2] -> [Vector2]
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.
| 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
``````

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?

Solution

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 `turn`.

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 `giftWrap'`

or producing non-convex result, but I didn’t have time to explore the details.