module Geometry.Algorithms.Contour.Internal (
    module Geometry.Algorithms.Contour.Internal
) where



import           Control.DeepSeq
import           Control.Parallel.Strategies
import           Data.Foldable
import           Data.Set                    (Set)
import qualified Data.Set                    as S
import           Data.Vector                 (Vector, (!))
import qualified Data.Vector                 as V

import Geometry.Core
import Geometry.LookupTable.Lookup2
import Geometry.Trajectory
import Util


-- | Find the iso lines of a function (= where the function has the same height,
-- like e.g. height lines on a map) within a certain 'Grid' (which unifies size and
-- resolution).
--
-- This function can be partially applied to cache the function values when drawing
-- iso lines, which is especially useful if repeatedly sampling the function is
-- expensive:
--
-- @
-- -- BAD! Recalculates the values of f across the grid for each invocation
-- 'isosBad' = ['isoLines' grid f isoHeight | isoHeight <- [1..10]]
--
-- -- Good: Calculates the value table only once
-- 'isosGood' = let iso = 'isoLines' grid f
--              in [iso isoHeight | isoHeight [1..10]]
-- @
--
-- This is also the reason why the contour threshold is not implitly zero but an
-- explicit parameter: if we used the family of functions \(f_h(x) = f(x)-h\) to
-- calculate the iso lines at height \(h\), we would have to recreate the value
-- table for each invocation.
--
-- <<docs/iso_lines/potentials.svg>>
--
-- === __Concrete example__
--
-- Let’s draw some circles! The equation of a circle of radius \(r\) at point \(p\) is
--
-- \[
-- \left\{ x \; \big| \; \| x-p\| = r,  \, x\in\mathbb R^2 \right\}
-- \]
--
-- We can translate this directly into code like so (squaring the equation to save us a costly call to 'sqrt'),
--
-- @
-- circle p = \\x -> 'normSquare' (x '-.' p)
-- @
--
-- and finding the contour lines at height \(r^2\) gives us our circles!
--
-- @
-- grid :: 'Grid'
-- grid = 'Grid' ('Vec2' (-10) (-10), 'Vec2' 10 10) (100, 100)
--
-- circleTrajectory :: 'Double' -> ['Vec2']
-- circleTrajectory =
--     let iso = 'isoLines' grid (circle 'zero')
--     in \\r -> head (iso (r'^'2)) -- NB head is safe here because each of our functions has exactly one iso line at a certain height
--
-- manyCircles :: [['Vec2']]
-- manyCircles = 'map' circleTrajectory [1..9]
-- @
isoLines
    :: Grid
    -> (Vec2 -> Double) -- ^ Scalar field
    -> Double           -- ^ Contour threshold
    -> [[Vec2]]         -- ^ Contours of the field
isoLines :: Grid -> (Vec2 -> Double) -> Double -> [[Vec2]]
isoLines Grid
grid Vec2 -> Double
f  =
    let table :: Vector (Vector Double)
table = Grid -> (Vec2 -> Double) -> Vector (Vector Double)
forall a. Grid -> (Vec2 -> a) -> Vector (Vector a)
valueTable Grid
grid Vec2 -> Double
f
    in \Double
threshold ->
        let tableThresholded :: Vector (Vector XO)
tableThresholded = Double -> Vector (Vector Double) -> Vector (Vector XO)
applyThreshold Double
threshold Vector (Vector Double)
table
            classified :: Vector (Vector CellClassification)
classified = Vector (Vector XO) -> Vector (Vector CellClassification)
classifySquares Vector (Vector XO)
tableThresholded
            edgeSemengts :: Set LineBetweenEdges
edgeSemengts = Vector (Vector CellClassification) -> Set LineBetweenEdges
classificationsToContourEdgeSegments Vector (Vector CellClassification)
classified

            reassembled :: [[IEdge]]
reassembled = (LineBetweenEdges -> (IEdge, IEdge))
-> Set LineBetweenEdges -> [[IEdge]]
forall point (f :: * -> *) line.
(Ord point, Foldable f) =>
(line -> (point, point)) -> f line -> [[point]]
reassembleLines (\(LineBetweenEdges IEdge
e1 IEdge
e2) -> (IEdge
e1, IEdge
e2)) Set LineBetweenEdges
edgeSemengts
            tolerance :: Double
tolerance = Double
1e-3
            sandedDown :: [[Vec2]]
sandedDown = (([IEdge] -> [Vec2]) -> [[IEdge]] -> [[Vec2]]
forall a b. (a -> b) -> [a] -> [b]
map(([IEdge] -> [Vec2]) -> [[IEdge]] -> [[Vec2]])
-> ((IEdge -> Vec2) -> [IEdge] -> [Vec2])
-> (IEdge -> Vec2)
-> [[IEdge]]
-> [[Vec2]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IEdge -> Vec2) -> [IEdge] -> [Vec2]
forall a b. (a -> b) -> [a] -> [b]
map) (\IEdge
iEdge -> Grid -> (Vec2 -> Double) -> Double -> IEdge -> Double -> Vec2
optimizeDiscreteLine Grid
grid Vec2 -> Double
f Double
threshold IEdge
iEdge Double
tolerance) [[IEdge]]
reassembled
        in [[Vec2]]
sandedDown

-- | Find the root of a scalar field along a line.
binarySearchRoot :: (Vec2 -> Double) -> Line -> Double -> Vec2
binarySearchRoot :: (Vec2 -> Double) -> Line -> Double -> Vec2
binarySearchRoot Vec2 -> Double
f line :: Line
line@(Line Vec2
start Vec2
end) Double
tolerance
    | Line -> Double
lineLength Line
line Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
tolerance = Vec2
middle
    | Double -> Double
forall a. Num a => a -> a
signum Double
fStart Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double -> Double
forall a. Num a => a -> a
signum Double
fMiddle = (Vec2 -> Double) -> Line -> Double -> Vec2
binarySearchRoot Vec2 -> Double
f (Vec2 -> Vec2 -> Line
Line Vec2
start Vec2
middle) Double
tolerance
    | Double -> Double
forall a. Num a => a -> a
signum Double
fMiddle Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double -> Double
forall a. Num a => a -> a
signum Double
fEnd = (Vec2 -> Double) -> Line -> Double -> Vec2
binarySearchRoot Vec2 -> Double
f (Vec2 -> Vec2 -> Line
Line Vec2
middle Vec2
end) Double
tolerance

    -- EMERGENCY UNCOMMENT IF THE ERROR BELOW COMES UP
    -- otherwise = middle
    | Bool
otherwise = String -> String -> Vec2
forall a. String -> String -> a
bugError String
"binarySearchRoot" (String -> Vec2) -> ([String] -> String) -> [String] -> Vec2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> Vec2) -> [String] -> Vec2
forall a b. (a -> b) -> a -> b
$
        [ String
"This shouldn’t happen if we only have lines that change sign,"
        , String
"picked by marching squares, but I’m sure we’ll be surprised."
        , String
"Might not be worth investigating though, simply abort the alg"
        , String
"and have one wonky cell." ]
  where
    middle :: Vec2
middle = (Vec2
start Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
end) Vec2 -> Double -> Vec2
forall v. VectorSpace v => v -> Double -> v
/. Double
2
    fStart :: Double
fStart  = Vec2 -> Double
f Vec2
start
    fMiddle :: Double
fMiddle = Vec2 -> Double
f Vec2
middle
    fEnd :: Double
fEnd    = Vec2 -> Double
f Vec2
end

optimizeIsoIntersections
    :: Grid
    -> (Vec2 -> Double)    -- ^ Scalar field
    -> Double              -- ^ Contour threshold
    -> LineBetweenEdges -- ^ Edges of a discrete cell the contour passes through
    -> Double              -- ^ Tolerance
    -> Line                -- ^ Line between points on the discrete edges, which approximates the real contour
optimizeIsoIntersections :: Grid
-> (Vec2 -> Double) -> Double -> LineBetweenEdges -> Double -> Line
optimizeIsoIntersections Grid
grid Vec2 -> Double
f Double
threshold (LineBetweenEdges IEdge
iEdge1 IEdge
iEdge2) Double
tolerance =
    let start :: Vec2
start = Grid -> (Vec2 -> Double) -> Double -> IEdge -> Double -> Vec2
optimizeDiscreteLine Grid
grid Vec2 -> Double
f Double
threshold IEdge
iEdge1 Double
tolerance
        end :: Vec2
end   = Grid -> (Vec2 -> Double) -> Double -> IEdge -> Double -> Vec2
optimizeDiscreteLine Grid
grid Vec2 -> Double
f Double
threshold IEdge
iEdge2 Double
tolerance
    in Vec2 -> Vec2 -> Line
Line Vec2
start Vec2
end

optimizeDiscreteLine :: Grid -> (Vec2 -> Double) -> Double -> IEdge -> Double -> Vec2
optimizeDiscreteLine :: Grid -> (Vec2 -> Double) -> Double -> IEdge -> Double -> Vec2
optimizeDiscreteLine Grid
grid Vec2 -> Double
f Double
threshold (IEdge IVec2
iStart IVec2
iEnd) Double
tolerance =
    let line :: Line
line = Vec2 -> Vec2 -> Line
Line (Grid -> IVec2 -> Vec2
fromGrid Grid
grid IVec2
iStart) (Grid -> IVec2 -> Vec2
fromGrid Grid
grid IVec2
iEnd)
    in (Vec2 -> Double) -> Line -> Double -> Vec2
binarySearchRoot (\Vec2
x -> Vec2 -> Double
f Vec2
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
threshold) Line
line Double
tolerance
    -- in (fromGrid grid iStart +. fromGrid grid iEnd) /. 2

data XO = X | O
    deriving (XO -> XO -> Bool
(XO -> XO -> Bool) -> (XO -> XO -> Bool) -> Eq XO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XO -> XO -> Bool
== :: XO -> XO -> Bool
$c/= :: XO -> XO -> Bool
/= :: XO -> XO -> Bool
Eq, Eq XO
Eq XO
-> (XO -> XO -> Ordering)
-> (XO -> XO -> Bool)
-> (XO -> XO -> Bool)
-> (XO -> XO -> Bool)
-> (XO -> XO -> Bool)
-> (XO -> XO -> XO)
-> (XO -> XO -> XO)
-> Ord XO
XO -> XO -> Bool
XO -> XO -> Ordering
XO -> XO -> XO
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: XO -> XO -> Ordering
compare :: XO -> XO -> Ordering
$c< :: XO -> XO -> Bool
< :: XO -> XO -> Bool
$c<= :: XO -> XO -> Bool
<= :: XO -> XO -> Bool
$c> :: XO -> XO -> Bool
> :: XO -> XO -> Bool
$c>= :: XO -> XO -> Bool
>= :: XO -> XO -> Bool
$cmax :: XO -> XO -> XO
max :: XO -> XO -> XO
$cmin :: XO -> XO -> XO
min :: XO -> XO -> XO
Ord, Int -> XO -> ShowS
[XO] -> ShowS
XO -> String
(Int -> XO -> ShowS)
-> (XO -> String) -> ([XO] -> ShowS) -> Show XO
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XO -> ShowS
showsPrec :: Int -> XO -> ShowS
$cshow :: XO -> String
show :: XO -> String
$cshowList :: [XO] -> ShowS
showList :: [XO] -> ShowS
Show)

instance NFData XO where
    rnf :: XO -> ()
rnf XO
X = ()
    rnf XO
O = ()

data CellClassification = CellClassification !XO !XO !XO !XO
    deriving (CellClassification -> CellClassification -> Bool
(CellClassification -> CellClassification -> Bool)
-> (CellClassification -> CellClassification -> Bool)
-> Eq CellClassification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellClassification -> CellClassification -> Bool
== :: CellClassification -> CellClassification -> Bool
$c/= :: CellClassification -> CellClassification -> Bool
/= :: CellClassification -> CellClassification -> Bool
Eq, Eq CellClassification
Eq CellClassification
-> (CellClassification -> CellClassification -> Ordering)
-> (CellClassification -> CellClassification -> Bool)
-> (CellClassification -> CellClassification -> Bool)
-> (CellClassification -> CellClassification -> Bool)
-> (CellClassification -> CellClassification -> Bool)
-> (CellClassification -> CellClassification -> CellClassification)
-> (CellClassification -> CellClassification -> CellClassification)
-> Ord CellClassification
CellClassification -> CellClassification -> Bool
CellClassification -> CellClassification -> Ordering
CellClassification -> CellClassification -> CellClassification
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CellClassification -> CellClassification -> Ordering
compare :: CellClassification -> CellClassification -> Ordering
$c< :: CellClassification -> CellClassification -> Bool
< :: CellClassification -> CellClassification -> Bool
$c<= :: CellClassification -> CellClassification -> Bool
<= :: CellClassification -> CellClassification -> Bool
$c> :: CellClassification -> CellClassification -> Bool
> :: CellClassification -> CellClassification -> Bool
$c>= :: CellClassification -> CellClassification -> Bool
>= :: CellClassification -> CellClassification -> Bool
$cmax :: CellClassification -> CellClassification -> CellClassification
max :: CellClassification -> CellClassification -> CellClassification
$cmin :: CellClassification -> CellClassification -> CellClassification
min :: CellClassification -> CellClassification -> CellClassification
Ord, Int -> CellClassification -> ShowS
[CellClassification] -> ShowS
CellClassification -> String
(Int -> CellClassification -> ShowS)
-> (CellClassification -> String)
-> ([CellClassification] -> ShowS)
-> Show CellClassification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellClassification -> ShowS
showsPrec :: Int -> CellClassification -> ShowS
$cshow :: CellClassification -> String
show :: CellClassification -> String
$cshowList :: [CellClassification] -> ShowS
showList :: [CellClassification] -> ShowS
Show)

instance NFData CellClassification where
    rnf :: CellClassification -> ()
rnf CellClassification
_ = () -- it’s already strict in all fields

linewiseDeepseq :: NFData a => Vector (Vector a) -> Vector (Vector a)
linewiseDeepseq :: forall a. NFData a => Vector (Vector a) -> Vector (Vector a)
linewiseDeepseq = Strategy (Vector (Vector a))
-> Vector (Vector a) -> Vector (Vector a)
forall a. Strategy a -> a -> a
withStrategy (Strategy (Vector a) -> Strategy (Vector (Vector a))
forall (t :: * -> *) a.
Traversable t =>
Strategy a -> Strategy (t a)
parTraversable Strategy (Vector a)
forall a. NFData a => Strategy a
rdeepseq)

applyThreshold :: Double -> Vector (Vector Double) -> Vector (Vector XO)
applyThreshold :: Double -> Vector (Vector Double) -> Vector (Vector XO)
applyThreshold Double
threshold = Vector (Vector XO) -> Vector (Vector XO)
forall a. NFData a => Vector (Vector a) -> Vector (Vector a)
linewiseDeepseq (Vector (Vector XO) -> Vector (Vector XO))
-> (Vector (Vector Double) -> Vector (Vector XO))
-> Vector (Vector Double)
-> Vector (Vector XO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Vector Double -> Vector XO)
-> Vector (Vector Double) -> Vector (Vector XO)
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Vector Double -> Vector XO)
 -> Vector (Vector Double) -> Vector (Vector XO))
-> ((Double -> XO) -> Vector Double -> Vector XO)
-> (Double -> XO)
-> Vector (Vector Double)
-> Vector (Vector XO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Double -> XO) -> Vector Double -> Vector XO
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Double -> XO
xo
  where
    xo :: Double -> XO
xo Double
v | Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
threshold = XO
X
         | Bool
otherwise      = XO
O

ifor :: Vector a -> (Int -> a -> b) -> Vector b
ifor :: forall a b. Vector a -> (Int -> a -> b) -> Vector b
ifor = ((Int -> a -> b) -> Vector a -> Vector b)
-> Vector a -> (Int -> a -> b) -> Vector b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> a -> b) -> Vector a -> Vector b
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap

classifySquares :: Vector (Vector XO) -> Vector (Vector CellClassification)
classifySquares :: Vector (Vector XO) -> Vector (Vector CellClassification)
classifySquares Vector (Vector XO)
xos = Vector (Vector CellClassification)
-> Vector (Vector CellClassification)
forall a. NFData a => Vector (Vector a) -> Vector (Vector a)
linewiseDeepseq (Vector (Vector CellClassification)
 -> Vector (Vector CellClassification))
-> Vector (Vector CellClassification)
-> Vector (Vector CellClassification)
forall a b. (a -> b) -> a -> b
$
    -- Our squares extend from the top left to the bottom right, so we drop
    -- the last element or the bottom-right would run out of bounds of the Vec.
    Vector (Vector XO)
-> (Int -> Vector XO -> Vector CellClassification)
-> Vector (Vector CellClassification)
forall a b. Vector a -> (Int -> a -> b) -> Vector b
ifor (Vector (Vector XO) -> Vector (Vector XO)
forall a. Vector a -> Vector a
V.init Vector (Vector XO)
xos) ((Int -> Vector XO -> Vector CellClassification)
 -> Vector (Vector CellClassification))
-> (Int -> Vector XO -> Vector CellClassification)
-> Vector (Vector CellClassification)
forall a b. (a -> b) -> a -> b
$
        \Int
i Vector XO
js -> Vector XO
-> (Int -> XO -> CellClassification) -> Vector CellClassification
forall a b. Vector a -> (Int -> a -> b) -> Vector b
ifor (Vector XO -> Vector XO
forall a. Vector a -> Vector a
V.init Vector XO
js) ((Int -> XO -> CellClassification) -> Vector CellClassification)
-> (Int -> XO -> CellClassification) -> Vector CellClassification
forall a b. (a -> b) -> a -> b
$
            \Int
j XO
xo ->
                let topLeft :: XO
topLeft     = XO
xo
                    topRight :: XO
topRight    = Vector (Vector XO)
xosVector (Vector XO) -> Int -> Vector XO
forall a. Vector a -> Int -> a
!(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Vector XO -> Int -> XO
forall a. Vector a -> Int -> a
!Int
j
                    bottomLeft :: XO
bottomLeft  = Vector (Vector XO)
xosVector (Vector XO) -> Int -> Vector XO
forall a. Vector a -> Int -> a
!Int
iVector XO -> Int -> XO
forall a. Vector a -> Int -> a
!(Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                    bottomRight :: XO
bottomRight = Vector (Vector XO)
xosVector (Vector XO) -> Int -> Vector XO
forall a. Vector a -> Int -> a
!(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Vector XO -> Int -> XO
forall a. Vector a -> Int -> a
!(Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                in XO -> XO -> XO -> XO -> CellClassification
CellClassification XO
topLeft XO
topRight XO
bottomLeft XO
bottomRight

data IEdge = IEdge !IVec2 !IVec2
    deriving (IEdge -> IEdge -> Bool
(IEdge -> IEdge -> Bool) -> (IEdge -> IEdge -> Bool) -> Eq IEdge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IEdge -> IEdge -> Bool
== :: IEdge -> IEdge -> Bool
$c/= :: IEdge -> IEdge -> Bool
/= :: IEdge -> IEdge -> Bool
Eq, Eq IEdge
Eq IEdge
-> (IEdge -> IEdge -> Ordering)
-> (IEdge -> IEdge -> Bool)
-> (IEdge -> IEdge -> Bool)
-> (IEdge -> IEdge -> Bool)
-> (IEdge -> IEdge -> Bool)
-> (IEdge -> IEdge -> IEdge)
-> (IEdge -> IEdge -> IEdge)
-> Ord IEdge
IEdge -> IEdge -> Bool
IEdge -> IEdge -> Ordering
IEdge -> IEdge -> IEdge
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IEdge -> IEdge -> Ordering
compare :: IEdge -> IEdge -> Ordering
$c< :: IEdge -> IEdge -> Bool
< :: IEdge -> IEdge -> Bool
$c<= :: IEdge -> IEdge -> Bool
<= :: IEdge -> IEdge -> Bool
$c> :: IEdge -> IEdge -> Bool
> :: IEdge -> IEdge -> Bool
$c>= :: IEdge -> IEdge -> Bool
>= :: IEdge -> IEdge -> Bool
$cmax :: IEdge -> IEdge -> IEdge
max :: IEdge -> IEdge -> IEdge
$cmin :: IEdge -> IEdge -> IEdge
min :: IEdge -> IEdge -> IEdge
Ord, Int -> IEdge -> ShowS
[IEdge] -> ShowS
IEdge -> String
(Int -> IEdge -> ShowS)
-> (IEdge -> String) -> ([IEdge] -> ShowS) -> Show IEdge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IEdge -> ShowS
showsPrec :: Int -> IEdge -> ShowS
$cshow :: IEdge -> String
show :: IEdge -> String
$cshowList :: [IEdge] -> ShowS
showList :: [IEdge] -> ShowS
Show)

instance NFData IEdge where
    rnf :: IEdge -> ()
rnf IEdge
_ = () -- it’s already strict in all fields

data LineBetweenEdges = LineBetweenEdges !IEdge !IEdge
    deriving (LineBetweenEdges -> LineBetweenEdges -> Bool
(LineBetweenEdges -> LineBetweenEdges -> Bool)
-> (LineBetweenEdges -> LineBetweenEdges -> Bool)
-> Eq LineBetweenEdges
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LineBetweenEdges -> LineBetweenEdges -> Bool
== :: LineBetweenEdges -> LineBetweenEdges -> Bool
$c/= :: LineBetweenEdges -> LineBetweenEdges -> Bool
/= :: LineBetweenEdges -> LineBetweenEdges -> Bool
Eq, Eq LineBetweenEdges
Eq LineBetweenEdges
-> (LineBetweenEdges -> LineBetweenEdges -> Ordering)
-> (LineBetweenEdges -> LineBetweenEdges -> Bool)
-> (LineBetweenEdges -> LineBetweenEdges -> Bool)
-> (LineBetweenEdges -> LineBetweenEdges -> Bool)
-> (LineBetweenEdges -> LineBetweenEdges -> Bool)
-> (LineBetweenEdges -> LineBetweenEdges -> LineBetweenEdges)
-> (LineBetweenEdges -> LineBetweenEdges -> LineBetweenEdges)
-> Ord LineBetweenEdges
LineBetweenEdges -> LineBetweenEdges -> Bool
LineBetweenEdges -> LineBetweenEdges -> Ordering
LineBetweenEdges -> LineBetweenEdges -> LineBetweenEdges
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LineBetweenEdges -> LineBetweenEdges -> Ordering
compare :: LineBetweenEdges -> LineBetweenEdges -> Ordering
$c< :: LineBetweenEdges -> LineBetweenEdges -> Bool
< :: LineBetweenEdges -> LineBetweenEdges -> Bool
$c<= :: LineBetweenEdges -> LineBetweenEdges -> Bool
<= :: LineBetweenEdges -> LineBetweenEdges -> Bool
$c> :: LineBetweenEdges -> LineBetweenEdges -> Bool
> :: LineBetweenEdges -> LineBetweenEdges -> Bool
$c>= :: LineBetweenEdges -> LineBetweenEdges -> Bool
>= :: LineBetweenEdges -> LineBetweenEdges -> Bool
$cmax :: LineBetweenEdges -> LineBetweenEdges -> LineBetweenEdges
max :: LineBetweenEdges -> LineBetweenEdges -> LineBetweenEdges
$cmin :: LineBetweenEdges -> LineBetweenEdges -> LineBetweenEdges
min :: LineBetweenEdges -> LineBetweenEdges -> LineBetweenEdges
Ord, Int -> LineBetweenEdges -> ShowS
[LineBetweenEdges] -> ShowS
LineBetweenEdges -> String
(Int -> LineBetweenEdges -> ShowS)
-> (LineBetweenEdges -> String)
-> ([LineBetweenEdges] -> ShowS)
-> Show LineBetweenEdges
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LineBetweenEdges -> ShowS
showsPrec :: Int -> LineBetweenEdges -> ShowS
$cshow :: LineBetweenEdges -> String
show :: LineBetweenEdges -> String
$cshowList :: [LineBetweenEdges] -> ShowS
showList :: [LineBetweenEdges] -> ShowS
Show)

instance NFData LineBetweenEdges where
    rnf :: LineBetweenEdges -> ()
rnf LineBetweenEdges
_ = () -- it’s already strict in all fields

classificationsToContourEdgeSegments :: Vector (Vector CellClassification) -> Set LineBetweenEdges
classificationsToContourEdgeSegments :: Vector (Vector CellClassification) -> Set LineBetweenEdges
classificationsToContourEdgeSegments Vector (Vector CellClassification)
classifiedCells = Vector (Set LineBetweenEdges) -> Set LineBetweenEdges
forall m. Monoid m => Vector m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold(Vector (Set LineBetweenEdges) -> Set LineBetweenEdges)
-> (Vector (Vector (Set LineBetweenEdges))
    -> Vector (Set LineBetweenEdges))
-> Vector (Vector (Set LineBetweenEdges))
-> Set LineBetweenEdges
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Vector (Vector (Set LineBetweenEdges))
-> Vector (Set LineBetweenEdges)
forall m. Monoid m => Vector m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Vector (Vector (Set LineBetweenEdges)) -> Set LineBetweenEdges)
-> Vector (Vector (Set LineBetweenEdges)) -> Set LineBetweenEdges
forall a b. (a -> b) -> a -> b
$ Vector (Vector (Set LineBetweenEdges))
-> Vector (Vector (Set LineBetweenEdges))
forall a. NFData a => Vector (Vector a) -> Vector (Vector a)
linewiseDeepseq (Vector (Vector (Set LineBetweenEdges))
 -> Vector (Vector (Set LineBetweenEdges)))
-> Vector (Vector (Set LineBetweenEdges))
-> Vector (Vector (Set LineBetweenEdges))
forall a b. (a -> b) -> a -> b
$ Vector (Vector CellClassification)
-> (Int
    -> Vector CellClassification -> Vector (Set LineBetweenEdges))
-> Vector (Vector (Set LineBetweenEdges))
forall a b. Vector a -> (Int -> a -> b) -> Vector b
ifor Vector (Vector CellClassification)
classifiedCells ((Int
  -> Vector CellClassification -> Vector (Set LineBetweenEdges))
 -> Vector (Vector (Set LineBetweenEdges)))
-> (Int
    -> Vector CellClassification -> Vector (Set LineBetweenEdges))
-> Vector (Vector (Set LineBetweenEdges))
forall a b. (a -> b) -> a -> b
$ \Int
i Vector CellClassification
cy -> Vector CellClassification
-> (Int -> CellClassification -> Set LineBetweenEdges)
-> Vector (Set LineBetweenEdges)
forall a b. Vector a -> (Int -> a -> b) -> Vector b
ifor Vector CellClassification
cy ((Int -> CellClassification -> Set LineBetweenEdges)
 -> Vector (Set LineBetweenEdges))
-> (Int -> CellClassification -> Set LineBetweenEdges)
-> Vector (Set LineBetweenEdges)
forall a b. (a -> b) -> a -> b
$ \Int
j CellClassification
classification ->
    let topLeft :: IVec2
topLeft     = Int -> Int -> IVec2
IVec2 Int
i      Int
j
        topRight :: IVec2
topRight    = Int -> Int -> IVec2
IVec2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)  Int
j
        bottomLeft :: IVec2
bottomLeft  = Int -> Int -> IVec2
IVec2 Int
i      (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        bottomRight :: IVec2
bottomRight = Int -> Int -> IVec2
IVec2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)  (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

        top :: IEdge
top    = IVec2 -> IVec2 -> IEdge
IEdge IVec2
topLeft IVec2
topRight
        right :: IEdge
right  = IVec2 -> IVec2 -> IEdge
IEdge IVec2
topRight IVec2
bottomRight
        left :: IEdge
left   = IVec2 -> IVec2 -> IEdge
IEdge IVec2
topLeft IVec2
bottomLeft
        bottom :: IEdge
bottom = IVec2 -> IVec2 -> IEdge
IEdge IVec2
bottomLeft IVec2
bottomRight

        -- TODO: do this right: check which kind of saddle point we have. For
        -- now, we pick one of the choices arbitrarily.
        disambiguateSaddle :: p -> p -> p
disambiguateSaddle p
this p
_that = p
this

    in case CellClassification
classification of
        CellClassification XO
X XO
X
                           XO
X XO
X -> Set LineBetweenEdges
forall a. Set a
S.empty

        CellClassification XO
X XO
X
                           XO
X XO
O -> LineBetweenEdges -> Set LineBetweenEdges
forall a. a -> Set a
S.singleton (IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
bottom IEdge
right)

        CellClassification XO
X XO
X
                           XO
O XO
X -> LineBetweenEdges -> Set LineBetweenEdges
forall a. a -> Set a
S.singleton (IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
bottom IEdge
left)

        CellClassification XO
X XO
X
                           XO
O XO
O -> LineBetweenEdges -> Set LineBetweenEdges
forall a. a -> Set a
S.singleton (IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
left IEdge
right)

        CellClassification XO
X XO
O
                           XO
X XO
X -> LineBetweenEdges -> Set LineBetweenEdges
forall a. a -> Set a
S.singleton (IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
top IEdge
right)

        CellClassification XO
X XO
O
                           XO
X XO
O -> LineBetweenEdges -> Set LineBetweenEdges
forall a. a -> Set a
S.singleton (IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
top IEdge
bottom)

        CellClassification XO
X XO
O
                           XO
O XO
X -> [LineBetweenEdges] -> Set LineBetweenEdges
forall a. Ord a => [a] -> Set a
S.fromList ([LineBetweenEdges] -> Set LineBetweenEdges)
-> [LineBetweenEdges] -> Set LineBetweenEdges
forall a b. (a -> b) -> a -> b
$ [LineBetweenEdges] -> [LineBetweenEdges] -> [LineBetweenEdges]
forall {p} {p}. p -> p -> p
disambiguateSaddle
                                    [IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
left IEdge
top, IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
bottom IEdge
right]
                                    [IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
left IEdge
bottom, IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
top IEdge
right]

        CellClassification XO
X XO
O
                           XO
O XO
O -> LineBetweenEdges -> Set LineBetweenEdges
forall a. a -> Set a
S.singleton (IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
left IEdge
top)

        CellClassification XO
O XO
X
                           XO
X XO
X -> LineBetweenEdges -> Set LineBetweenEdges
forall a. a -> Set a
S.singleton (IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
left IEdge
top)

        CellClassification XO
O XO
X
                           XO
X XO
O -> [LineBetweenEdges] -> Set LineBetweenEdges
forall a. Ord a => [a] -> Set a
S.fromList ([LineBetweenEdges] -> Set LineBetweenEdges)
-> [LineBetweenEdges] -> Set LineBetweenEdges
forall a b. (a -> b) -> a -> b
$ [LineBetweenEdges] -> [LineBetweenEdges] -> [LineBetweenEdges]
forall {p} {p}. p -> p -> p
disambiguateSaddle
                                    [IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
left IEdge
top, IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
bottom IEdge
right]
                                    [IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
left IEdge
bottom, IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
top IEdge
right]

        CellClassification XO
O XO
X
                           XO
O XO
X -> LineBetweenEdges -> Set LineBetweenEdges
forall a. a -> Set a
S.singleton (IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
top IEdge
bottom)

        CellClassification XO
O XO
X
                           XO
O XO
O -> LineBetweenEdges -> Set LineBetweenEdges
forall a. a -> Set a
S.singleton (IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
top IEdge
right)

        CellClassification XO
O XO
O
                           XO
X XO
X -> LineBetweenEdges -> Set LineBetweenEdges
forall a. a -> Set a
S.singleton (IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
left IEdge
right)

        CellClassification XO
O XO
O
                           XO
X XO
O -> LineBetweenEdges -> Set LineBetweenEdges
forall a. a -> Set a
S.singleton (IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
left IEdge
bottom)

        CellClassification XO
O XO
O
                           XO
O XO
X -> LineBetweenEdges -> Set LineBetweenEdges
forall a. a -> Set a
S.singleton (IEdge -> IEdge -> LineBetweenEdges
LineBetweenEdges IEdge
right IEdge
bottom)

        CellClassification XO
O XO
O
                           XO
O XO
O -> Set LineBetweenEdges
forall a. Set a
S.empty