Fix several errors in Sectionable of SegTree

- section failed for p1 < 0 ∧ p2 = 0 because treeL was empty
- fix div by zero when p2 is at the end of a segment
- document the safety of the divisions in sectionAtParam'
- fix error in rescale when p2 is at the end of a segment
- add test cases for when ps are domain ends on relevent domains

src/Diagrams/Trail.hs

@@ -238,17 +238,27 @@ splitAtParam' (SegTree t) p
     (treeL, treeR) | pParam == 0 = (before        , seg  <| after)
                    | pParam == 1 = (before |> seg ,         after)
                    | otherwise   = (before |> segL, segR <| after)
-    rescale u | pSegs == uSegs  = (uSegs + uParam / pParam) / (pSegs + 1)
-              | otherwise       = u * tSegs / (pSegs + 1)
-      where (uSegs, uParam) = splitParam u
+    -- section uses rescale to find the new value of p1 after the split at p2
+    rescale u | pSegs' == uSegs = (uSegs + uParam / pParam' {-^1-}) / (pSegs' + 1) {-^2-}
+              | otherwise       = u * tSegs / (pSegs' + 1) {-^3-}
+      where
+        -- param 0 on a segment is param 1 on the previous segment
+        (pSegs', pParam') | pParam == 0 = (pSegs-1, 1)
+                          | otherwise   = (pSegs  , pParam)
+        (uSegs , uParam ) = splitParam u
+        -- ^1 (pParam ≠ 0 → pParam' = pParam) ∧ (pParam = 0 → pParam' = 1) → pParam' ≠ 0
+        -- ^2 uSegs ≥ 0 ∧ pSegs' = uSegs → pSegs' ≥ 0 → pSegs' + 1 > 0
+        -- ^3 pSegs' + 1 = 0 → pSegs' = -1 → pSegs = 0 ∧ pParam = 0 → p = 0
+        --    → rescale is not called
 
 instance (Metric v, OrderedField n, Real n) => Sectionable (SegTree v n) where
   splitAtParam tree p = fst $ splitAtParam' tree p
 
   reverseDomain (SegTree t) = SegTree $ FT.reverse t'
     where t' = FT.fmap' reverseSegment t
 
-  section x p1 p2 | p1 <= p2  = let ((a, _), rescale) = splitAtParam' x p2
+  section x p1 p2 | p2 == 0   = reverseDomain . fst $ splitAtParam x p1
+                  | p1 <= p2  = let ((a, _), rescale) = splitAtParam' x p2
                                 in  snd $ splitAtParam a (rescale p1)
                   | otherwise = reverseDomain $ section x p2 p1
 

test/Diagrams/Test/Trail.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
-
+{-# LANGUAGE TypeFamilies #-}
 
 module Diagrams.Test.Trail where
 
@@ -50,9 +50,27 @@ tests = testGroup "Trail"
 
   , testProperty "section on Trail' Line endpoints match paramaters" $
     \t (Param a) (Param b) ->
-      let t' = section (t :: Located (Trail' Line V2 Double)) a b
-      in  t `atParam` a =~ t' `atParam` 0 &&
-          t `atParam` b =~ t' `atParam` 1
+      let s = section (t :: Located (Trail' Line V2 Double)) a b
+      in  t `atParam` a =~ s `atParam` 0 &&
+          t `atParam` b =~ s `atParam` 1
+
+  , testProperty "section on Trail' Line where a paramater is 0 or 1" $
+    \t (Param a) ->
+      let l = section (t :: Located (Trail' Line V2 Double)) 0 a
+          r = section (t :: Located (Trail' Line V2 Double)) a 1
+      in  t `atParam` 0 =~ l `atParam` 0 &&
+          t `atParam` a =~ l `atParam` 1 &&
+          t `atParam` a =~ r `atParam` 0 &&
+          t `atParam` 1 =~ r `atParam` 1
+
+  , testProperty "section on Trail' Line where a segment paramater is 0 or 1" $
+    \t (Param a) i ->
+      let st = unLoc t # \(Line st) -> st :: SegTree V2 Double
+          b | numSegs st > 0 = (fromIntegral (i `mod` (numSegs st + 1) :: Word)) / numSegs st
+            | otherwise      = 0
+          s = section (t :: Located (Trail' Line V2 Double)) a b
+      in  t `atParam` a =~ s `atParam` 0 &&
+          t `atParam` b =~ s `atParam` 1
 
   , testProperty "section on Trail' Line matches section on FixedSegment" $
     \t (Param a) (Param b) -> sectionTrailSectionFixedSegment t a b