Tis the season for gift-wrapping

Question 1

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?

Question 2

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.

Leave a Reply Cancel reply