section on trail producing incorrect result when upper param is >= 1 (domainUpper)

[bacchanalia]

Red sections should be equal to green sections.

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
module Main where
import Diagrams.Prelude
import Diagrams.Backend.Cairo.CmdLine

ex :: Located (Trail V2 Double) -> Diagram Cairo
ex shape = foldl1 (|||) $ map (frame 5) $ [stroke shape] ++ segs 0.5 ++ segs 0.95
  where
    ε = 2**(-53) -- machine epsilon
    segs n = [base # lc green, good # lc blue, bad # lc red]
      where
        base = stroke $ section  (head $ fixTrail shape)                       n 1
        good = stroke $ section' (unfixTrail . return . head $ fixTrail shape) n (1-ε)
        bad  = stroke $ section' (unfixTrail . return . head $ fixTrail shape) n 1

ex1, ex2 :: Diagram Cairo
ex1 = ex $ vrule  100
ex2 = ex $ circle 100

dia :: Diagram Cairo
dia = (ex1 # pad 1.1) ||| (ex2 # pad 1.1)

main = mainWith (dia # bg white)

-- fix for diagrams-lib #322
class Sectionable' p where
  section' :: p -> N p -> N p -> p
instance (InSpace v n a, Fractional n, Parametric a, Sectionable' a, Codomain a ~ v) => Sectionable' (Located a) where
  section' (Loc x a) p1 p2 = Loc (x .+^ (a `atParam` p1)) (section' a p1 p2)
instance (Metric v, OrderedField n, Real n) => Sectionable' (Trail v n) where
  section' t p1 p2 = withLine (wrapLine . (\l -> section' l p1 p2)) t
instance (Metric v, OrderedField n, Real n) => Sectionable' (Trail' Line v n) where
  section' (Line t) p1 p2 = Line (section t p1 p2)

[bacchanalia]

This can be fixed narrowly by changing (>=) to (>) here, but the p > 0 case is still wrong. I've eyeballed some outputs for the p < 0 and they look plausible.

[fryguybob]

The equation on line 241 looks wrong to me:

diagrams-lib/src/Diagrams/Trail.hs

Line 241 in 7ff9922

case seg `splitAtParam` (1 - (1 - p)*tSegs) of

[bacchanalia]

On 243, I think the lambda should be id, since the number of segments doesn't change, but that doesn't completely fix it, so maybe an issue on 241 also.

diagrams-lib/src/Diagrams/Trail.hs

Line 243 in 7ff9922

( (SegTree $ t' |> seg1, \u -> u * tSegs / (tSegs + 1))

[bacchanalia]

I think 241 is more naturally expressed as 1 + (p - 1)*tsegs, but I think it's correct.

I think 243 is only id when u corresponds to a previous segment, and in the case it's on the same segment it needs to be rescaled.

[fryguybob]

Ah, yes, I was reading the code wrong. I can make sense of 241 now.

[bacchanalia]

I want to rewrite sectionAtParam' for more clarity. Right now it returns ((Segtree v n, n -> n), (Segtree v n, n -> n)) but the second (n -> n) which represents the reparamaterization of the second tree is never used. Is there any reason to keep that code?

[fryguybob]

The uses I can think of would be fine with sectionAtParam' only giving one remapping. However, having both could be nice for testing as you could check the consistency of computing section by comparing the results from both methods:

sectionA x t1 t2 = let ((a,fa),_) = splitAtParam' x t2 in snd $ splitAtParam a (fa t1)
sectionB x t1 t2 = let (_,(b,fb)) = splitAtParam' x t1 in fst $ splitAtParam b (fb t2)

prop_section x t1 t2 = sectionA x t1 t2 =~= sectionB x t1 t2

For some appropriate =~=.

[bacchanalia]

In order to have that test we'd need to export splitAtParam', which I'm not sure is worth doing just to have that test.