fix issue with incorrect subdivision in fit

* was using `Max ( Arg t sq_dist )` instead of `Max ( Arg sq_dist t )`
This commit is contained in:
sheaf 2020-09-14 06:28:35 +02:00
parent e3d920573d
commit 808e37b1b3
2 changed files with 6 additions and 6 deletions

View file

@ -215,8 +215,8 @@ main = do
fitParametersTVar <- STM.newTVarIO @FitParameters fitParametersTVar <- STM.newTVarIO @FitParameters
( FitParameters ( FitParameters
{ maxSubdiv = 3 { maxSubdiv = 3
, nbSegments = 30 , nbSegments = 13
, dist_tol = 5e-4 , dist_tol = 5e-3
, t_tol = 1e-4 , t_tol = 1e-4
, maxIters = 100 , maxIters = 100
} }

View file

@ -134,7 +134,7 @@ fitSpline ( FitParameters {..} ) = go 0
qs = [ fst $ curve ( dt * fromIntegral j ) | j <- [ 1 .. nbSegments - 1 ] ] qs = [ fst $ curve ( dt * fromIntegral j ) | j <- [ 1 .. nbSegments - 1 ] ]
in in
case fitPiece dist_tol t_tol maxIters p tp qs r tr of case fitPiece dist_tol t_tol maxIters p tp qs r tr of
( bez, Max ( Arg t_split sq_d ) ) ( bez, Max ( Arg sq_d t_split ) )
| subdiv >= maxSubdiv | subdiv >= maxSubdiv
|| sq_d <= dist_tol ^ ( 2 :: Int ) || sq_d <= dist_tol ^ ( 2 :: Int )
-> ( Seq.singleton bez, ( FitTangent p tp :<| Seq.fromList ( map FitPoint qs ) ) :|> FitTangent r tr ) -> ( Seq.singleton bez, ( FitTangent p tp :<| Seq.fromList ( map FitPoint qs ) ) :|> FitTangent r tr )
@ -150,7 +150,7 @@ fitSpline ( FitParameters {..} ) = go 0
-- * ends at \( r \) with tangent \( \textrm{t}_r \), -- * ends at \( r \) with tangent \( \textrm{t}_r \),
-- * best fits the intermediate sequence of points \( \left ( q_i \right )_{i=1}^n \). -- * best fits the intermediate sequence of points \( \left ( q_i \right )_{i=1}^n \).
-- --
-- This function also returns \( \textrm{ArgMax}\ t_\textrm{max}\ d^2_\textrm{max}: \) -- This function also returns \( \textrm{ArgMax}\ d^2_\textrm{max}\ t_\textrm{max}: \)
-- the parameter and squared distance of the worst-fitting point. -- the parameter and squared distance of the worst-fitting point.
-- It is guaranteed that all points to fit lie within the tubular neighbourhood -- It is guaranteed that all points to fit lie within the tubular neighbourhood
-- of radius \( d_\textrm{max} \) of the fitted curve. -- of radius \( d_\textrm{max} \) of the fitted curve.
@ -254,11 +254,11 @@ fitPiece dist_tol t_tol maxIters p tp qs r tr =
let let
sq_dist :: Double sq_dist :: Double
sq_dist = quadrance @( Vector2D Double ) q ( Cubic.bezier @( Vector2D Double ) bez ti' ) sq_dist = quadrance @( Vector2D Double ) q ( Cubic.bezier @( Vector2D Double ) bez ti' )
modify' ( second ( <> Max ( Arg ti' sq_dist ) ) ) modify' ( second ( <> Max ( Arg sq_dist ti' ) ) )
lift ( Unboxed.MVector.unsafeWrite ts i ti' ) lift ( Unboxed.MVector.unsafeWrite ts i ti' )
case argmax_sq_dist of case argmax_sq_dist of
Max ( Arg _ max_sq_dist ) Max ( Arg max_sq_dist _ )
| count < maxIters | count < maxIters
&& ( dts_changed || max_sq_dist > dist_tol ^ ( 2 :: Int ) ) && ( dts_changed || max_sq_dist > dist_tol ^ ( 2 :: Int ) )
-> loop ts ( count + 1 ) -> loop ts ( count + 1 )