module Data.Geometry.PlanarSubdivision.Dynamic
  ( splitEdge, unSplitEdge
  , sproutIntoFace
  , splitFace
  ) where

import           Control.Lens
import           Data.Ext
import           Data.Functor.Identity
import           Data.Geometry hiding (Vector, head, imap)
import           Data.Geometry.PlanarSubdivision
import           Data.Geometry.PlanarSubdivision.Basic
import           Data.Geometry.PlanarSubdivision.Raw
import           Data.List (sort, sortOn, findIndex)
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.PlanarGraph (Dart (Dart), Arc (Arc), VertexId (VertexId), FaceId (FaceId), Direction (Positive, Negative))
import           Data.PlaneGraph (PlaneGraph)
import qualified Data.PlaneGraph as PG
import qualified Data.PlaneGraph.AdjRep as AR (id, vData, fData, faces, Face (..))
import           Data.PlaneGraph.AdjRep hiding (id, vData, faces)
import           Data.Vector (Vector, toList, (//), empty)
import qualified Data.Vector as V

import           Debug.Trace


tracingOn :: Bool
tracingOn = Bool
False

tr :: Show a => String -> a -> a
tr :: String -> a -> a
tr String
s a
a | Bool
tracingOn = String -> a -> a
forall a. String -> a -> a
trace (String
"\9608 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a) a
a
       | Bool
otherwise = a
a


-- TO DO:
-- ADD EDGE JOINING TWO COMPONENTS
-- CREATE NEW COMPONENT (SINGLE VERTEX)
-- DELETIONS


-- | Splits a given edge of a planar subdivision by inserting a new vertex on the edges.
--   Increases #vertices and #edges by 1.
splitEdge
  :: (Show v, Show e, Show f, Show r)
  => VertexId' s
  -> VertexId' s
  -> Point 2 r
  -> v
  -> (e -> (e, e))
  -> PlanarSubdivision s v e f r
  -> PlanarSubdivision s v e f r

splitEdge :: VertexId' s
-> VertexId' s
-> Point 2 r
-> v
-> (e -> (e, e))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
splitEdge VertexId' s
a VertexId' s
b Point 2 r
p v
v e -> (e, e)
f PlanarSubdivision s v e f r
d =
  let (ComponentId s
_, VertexId' (Wrap s)
la, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV VertexId' s
a PlanarSubdivision s v e f r
d
      (ComponentId s
_, VertexId' (Wrap s)
lb, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV VertexId' s
b PlanarSubdivision s v e f r
d
      v' :: (VertexId' s, v)
v' = (PlanarSubdivision s v e f r -> VertexId' s
forall k (s :: k) v e f r.
PlanarSubdivision s v e f r -> VertexId' s
freeVertexId PlanarSubdivision s v e f r
d, v
v)
      fd :: Dart s
fd = PlanarSubdivision s v e f r -> Dart s
forall k (s :: k) v e f r. PlanarSubdivision s v e f r -> Dart s
freeDart PlanarSubdivision s v e f r
d
      f' :: (Dart s, e) -> ((Dart s, e), (Dart s, e))
f' (Dart Arc s
i Direction
Positive, e
e) = ((Arc s -> Direction -> Dart s
forall k (s :: k). Arc s -> Direction -> Dart s
Dart Arc s
i Direction
Positive, (e, e) -> e
forall a b. (a, b) -> a
fst ((e, e) -> e) -> (e, e) -> e
forall a b. (a -> b) -> a -> b
$ e -> (e, e)
f e
e), (Dart s
fd, (e, e) -> e
forall a b. (a, b) -> b
snd ((e, e) -> e) -> (e, e) -> e
forall a b. (a -> b) -> a -> b
$ e -> (e, e)
f e
e))
      f' (Dart Arc s
i Direction
Negative, e
e) = ((Dart s -> Dart s
forall k (s :: k). Dart s -> Dart s
twin Dart s
fd, (e, e) -> e
forall a b. (a, b) -> a
fst ((e, e) -> e) -> (e, e) -> e
forall a b. (a -> b) -> a -> b
$ e -> (e, e)
f e
e), (Arc s -> Direction -> Dart s
forall k (s :: k). Arc s -> Direction -> Dart s
Dart Arc s
i Direction
Negative, (e, e) -> e
forall a b. (a, b) -> b
snd ((e, e) -> e) -> (e, e) -> e
forall a b. (a -> b) -> a -> b
$ e -> (e, e)
f e
e))
  in  String
-> PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r
forall a. Show a => String -> a -> a
tr String
"splitEdge" (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r
forall a b. (a -> b) -> a -> b
$ PlanarSubdivision s v e f r
d PlanarSubdivision s v e f r
-> (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r
forall a b. a -> (a -> b) -> b
& (Vector (Component' s v e f r)
 -> Identity (Vector (Component' s v e f r)))
-> PlanarSubdivision s v e f r
-> Identity (PlanarSubdivision s v e f r)
forall k v e f r (s :: k).
(Show v, Show e, Show f, Show r) =>
Lens' (PlanarSubdivision s v e f r) (Vector (Component' s v e f r))
components' ((Vector (Component' s v e f r)
  -> Identity (Vector (Component' s v e f r)))
 -> PlanarSubdivision s v e f r
 -> Identity (PlanarSubdivision s v e f r))
-> (Vector (Component' s v e f r) -> Vector (Component' s v e f r))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Component' s v e f r -> Component' s v e f r)
-> Vector (Component' s v e f r) -> Vector (Component' s v e f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VertexId' (Wrap s)
-> VertexId' (Wrap s)
-> Point 2 r
-> (VertexId' s, v)
-> ((Dart s, e) -> ((Dart s, e), (Dart s, e)))
-> Component' s v e f r
-> Component' s v e f r
forall k v e f r (s :: k).
(Show v, Show e, Show f, Show r) =>
VertexId' s
-> VertexId' s
-> Point 2 r
-> v
-> (e -> (e, e))
-> PlaneGraph s v e f r
-> PlaneGraph s v e f r
splitEdgeInPlaneGraph VertexId' (Wrap s)
la VertexId' (Wrap s)
lb Point 2 r
p (VertexId' s, v)
v' (Dart s, e) -> ((Dart s, e), (Dart s, e))
f')

-- | Sprouts a new edge from a given vertex into the interior of a given (incident) face.
--   Increases #vertices and #edges by 1.
sproutIntoFace
  :: (Show v, Show e, Show f, Show r)
  => VertexId' s
  -> FaceId' s
  -> Point 2 r
  -> v
  -> (e, e)
  -> PlanarSubdivision s v e f r
  -> PlanarSubdivision s v e f r

sproutIntoFace :: VertexId' s
-> FaceId' s
-> Point 2 r
-> v
-> (e, e)
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
sproutIntoFace VertexId' s
a FaceId' s
f Point 2 r
p v
v (e
e1, e
e2) PlanarSubdivision s v e f r
d =
  let [Dart s
ea] = String -> [Dart s] -> [Dart s]
forall a. Show a => String -> a -> a
tr String
"[ea]" ([Dart s] -> [Dart s]) -> [Dart s] -> [Dart s]
forall a b. (a -> b) -> a -> b
$ (Dart s -> Bool) -> [Dart s] -> [Dart s]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Dart s
e -> Dart s -> PlanarSubdivision s v e f r -> VertexId' s
forall k (s :: k) v e f r.
Dart s -> PlanarSubdivision s v e f r -> VertexId' s
headOf Dart s
e PlanarSubdivision s v e f r
d VertexId' s -> VertexId' s -> Bool
forall a. Eq a => a -> a -> Bool
== VertexId' s
a Bool -> Bool -> Bool
&& Dart s -> PlanarSubdivision s v e f r -> FaceId' s
forall k (s :: k) v e f r.
Dart s -> PlanarSubdivision s v e f r -> FaceId' s
leftFace Dart s
e PlanarSubdivision s v e f r
d FaceId' s -> FaceId' s -> Bool
forall a. Eq a => a -> a -> Bool
== FaceId' s
f) ([Dart s] -> [Dart s]) -> [Dart s] -> [Dart s]
forall a b. (a -> b) -> a -> b
$ PlanarSubdivision s v e f r -> VertexId' s -> FaceId' s -> [Dart s]
forall k (s :: k) a b v e f r.
(Incident s a (Dart s), Incident s b (Dart s)) =>
PlanarSubdivision s v e f r -> a -> b -> [Dart s]
commonDarts PlanarSubdivision s v e f r
d VertexId' s
a FaceId' s
f
      (ComponentId s
_, VertexId' (Wrap s)
la, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV VertexId' s
a PlanarSubdivision s v e f r
d
      (ComponentId s
_, VertexId' (Wrap s)
lc, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV (Dart s -> PlanarSubdivision s v e f r -> VertexId' s
forall k (s :: k) v e f r.
Dart s -> PlanarSubdivision s v e f r -> VertexId' s
tailOf Dart s
ea PlanarSubdivision s v e f r
d) PlanarSubdivision s v e f r
d
      v' :: (VertexId' s, v)
v' = (PlanarSubdivision s v e f r -> VertexId' s
forall k (s :: k) v e f r.
PlanarSubdivision s v e f r -> VertexId' s
freeVertexId PlanarSubdivision s v e f r
d, v
v)
      fd :: Dart s
fd = PlanarSubdivision s v e f r -> Dart s
forall k (s :: k) v e f r. PlanarSubdivision s v e f r -> Dart s
freeDart PlanarSubdivision s v e f r
d
      e1' :: (Dart s, e)
e1' = (Dart s
fd, e
e1)
      e2' :: (Dart s, e)
e2' = (Dart s -> Dart s
forall k (s :: k). Dart s -> Dart s
twin Dart s
fd, e
e2)
  in  String
-> PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r
forall a. Show a => String -> a -> a
tr String
"sproutIntoFace" (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r
forall a b. (a -> b) -> a -> b
$ PlanarSubdivision s v e f r
d PlanarSubdivision s v e f r
-> (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r
forall a b. a -> (a -> b) -> b
& (Vector (Component' s v e f r)
 -> Identity (Vector (Component' s v e f r)))
-> PlanarSubdivision s v e f r
-> Identity (PlanarSubdivision s v e f r)
forall k v e f r (s :: k).
(Show v, Show e, Show f, Show r) =>
Lens' (PlanarSubdivision s v e f r) (Vector (Component' s v e f r))
components' ((Vector (Component' s v e f r)
  -> Identity (Vector (Component' s v e f r)))
 -> PlanarSubdivision s v e f r
 -> Identity (PlanarSubdivision s v e f r))
-> (Vector (Component' s v e f r) -> Vector (Component' s v e f r))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Component' s v e f r -> Component' s v e f r)
-> Vector (Component' s v e f r) -> Vector (Component' s v e f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VertexId' (Wrap s)
-> VertexId' (Wrap s)
-> Point 2 r
-> (VertexId' s, v)
-> ((Dart s, e), (Dart s, e))
-> Component' s v e f r
-> Component' s v e f r
forall k v e f r (s :: k).
(Show v, Show e, Show f, Show r) =>
VertexId' s
-> VertexId' s
-> Point 2 r
-> v
-> (e, e)
-> PlaneGraph s v e f r
-> PlaneGraph s v e f r
sproutIntoFaceInPlaneGraph VertexId' (Wrap s)
la VertexId' (Wrap s)
lc Point 2 r
p (VertexId' s, v)
v' ((Dart s, e)
e1', (Dart s, e)
e2'))

-- | Inserts a new edge between two given vertices, adjacent to a common face.
--   Increases #edges and #faces by 1.
splitFace
  :: (Show v, Show e, Show f, Show r)
  => VertexId' s
  -> VertexId' s
  -> (e, e)
  -> (f -> (f, f))
  -> PlanarSubdivision s v e f r
  -> PlanarSubdivision s v e f r

splitFace :: VertexId' s
-> VertexId' s
-> (e, e)
-> (f -> (f, f))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
splitFace VertexId' s
a VertexId' s
b (e, e)
e f -> (f, f)
g PlanarSubdivision s v e f r
d =
  let (ComponentId s
ca, VertexId' (Wrap s)
_, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV VertexId' s
a PlanarSubdivision s v e f r
d
      (ComponentId s
cb, VertexId' (Wrap s)
_, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV VertexId' s
b PlanarSubdivision s v e f r
d
  in if ComponentId s
ca ComponentId s -> ComponentId s -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentId s
cb then VertexId' s
-> VertexId' s
-> (e, e)
-> (f -> (f, f))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall k r v e f (s :: k).
(Show r, Show v, Show e, Show f) =>
VertexId' s
-> VertexId' s
-> (e, e)
-> (f -> (f, f))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
splitFaceSameComponent VertexId' s
a VertexId' s
b (e, e)
e f -> (f, f)
g PlanarSubdivision s v e f r
d
                 else VertexId' s
-> VertexId' s
-> (e, e)
-> (f -> (f, f))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall a. a
splitFaceDifferentComponents VertexId' s
a VertexId' s
b (e, e)
e f -> (f, f)
g PlanarSubdivision s v e f r
d

splitFaceSameComponent :: VertexId' s
-> VertexId' s
-> (e, e)
-> (f -> (f, f))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
splitFaceSameComponent VertexId' s
a VertexId' s
b (e, e)
e f -> (f, f)
g PlanarSubdivision s v e f r
d =
  let fs :: [FaceId' s]
fs   = PlanarSubdivision s v e f r
-> VertexId' s -> VertexId' s -> [FaceId' s]
forall k (s :: k) a b v e f r.
(Incident s a (FaceId' s), Incident s b (FaceId' s)) =>
PlanarSubdivision s v e f r -> a -> b -> [FaceId' s]
commonFaces PlanarSubdivision s v e f r
d VertexId' s
a VertexId' s
b
      f :: FaceId' s
f | [FaceId' s] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FaceId' s]
fs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String -> FaceId' s -> FaceId' s
forall a. Show a => String -> a -> a
tr String
"f(a)" (FaceId' s -> FaceId' s) -> FaceId' s -> FaceId' s
forall a b. (a -> b) -> a -> b
$ String -> [FaceId' s] -> FaceId' s
forall a. String -> [a] -> a
headTrace String
"splitFaceSameComponent f" [FaceId' s]
fs
        | Bool
otherwise = String -> FaceId' s -> FaceId' s
forall a. Show a => String -> a -> a
tr String
"f(b)" (FaceId' s -> FaceId' s) -> FaceId' s -> FaceId' s
forall a b. (a -> b) -> a -> b
$ String -> [FaceId' s] -> FaceId' s
forall a. String -> [a] -> a
headTrace String
"splitFaceSameComponent f" ([FaceId' s] -> FaceId' s) -> [FaceId' s] -> FaceId' s
forall a b. (a -> b) -> a -> b
$ (FaceId' s -> Bool) -> [FaceId' s] -> [FaceId' s]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FaceId' s -> Bool) -> FaceId' s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FaceId' s -> Bool
forall k (s :: k). FaceId' s -> Bool
isOuterFace) [FaceId' s]
fs
      [Dart s
ea] = String -> [Dart s] -> [Dart s]
forall a. Show a => String -> a -> a
tr String
"[ea]" ([Dart s] -> [Dart s]) -> [Dart s] -> [Dart s]
forall a b. (a -> b) -> a -> b
$ (Dart s -> Bool) -> [Dart s] -> [Dart s]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Dart s
e -> Dart s -> PlanarSubdivision s v e f r -> VertexId' s
forall k (s :: k) v e f r.
Dart s -> PlanarSubdivision s v e f r -> VertexId' s
headOf Dart s
e PlanarSubdivision s v e f r
d VertexId' s -> VertexId' s -> Bool
forall a. Eq a => a -> a -> Bool
== VertexId' s
a Bool -> Bool -> Bool
&& Dart s -> PlanarSubdivision s v e f r -> FaceId' s
forall k (s :: k) v e f r.
Dart s -> PlanarSubdivision s v e f r -> FaceId' s
leftFace Dart s
e PlanarSubdivision s v e f r
d FaceId' s -> FaceId' s -> Bool
forall a. Eq a => a -> a -> Bool
== FaceId' s
f) ([Dart s] -> [Dart s]) -> [Dart s] -> [Dart s]
forall a b. (a -> b) -> a -> b
$ PlanarSubdivision s v e f r -> VertexId' s -> FaceId' s -> [Dart s]
forall k (s :: k) a b v e f r.
(Incident s a (Dart s), Incident s b (Dart s)) =>
PlanarSubdivision s v e f r -> a -> b -> [Dart s]
commonDarts PlanarSubdivision s v e f r
d VertexId' s
a FaceId' s
f
      [Dart s
eb] = String -> [Dart s] -> [Dart s]
forall a. Show a => String -> a -> a
tr String
"[eb]" ([Dart s] -> [Dart s]) -> [Dart s] -> [Dart s]
forall a b. (a -> b) -> a -> b
$ (Dart s -> Bool) -> [Dart s] -> [Dart s]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Dart s
e -> Dart s -> PlanarSubdivision s v e f r -> VertexId' s
forall k (s :: k) v e f r.
Dart s -> PlanarSubdivision s v e f r -> VertexId' s
headOf Dart s
e PlanarSubdivision s v e f r
d VertexId' s -> VertexId' s -> Bool
forall a. Eq a => a -> a -> Bool
== VertexId' s
b Bool -> Bool -> Bool
&& Dart s -> PlanarSubdivision s v e f r -> FaceId' s
forall k (s :: k) v e f r.
Dart s -> PlanarSubdivision s v e f r -> FaceId' s
leftFace Dart s
e PlanarSubdivision s v e f r
d FaceId' s -> FaceId' s -> Bool
forall a. Eq a => a -> a -> Bool
== FaceId' s
f) ([Dart s] -> [Dart s]) -> [Dart s] -> [Dart s]
forall a b. (a -> b) -> a -> b
$ PlanarSubdivision s v e f r -> VertexId' s -> FaceId' s -> [Dart s]
forall k (s :: k) a b v e f r.
(Incident s a (Dart s), Incident s b (Dart s)) =>
PlanarSubdivision s v e f r -> a -> b -> [Dart s]
commonDarts PlanarSubdivision s v e f r
d VertexId' s
b FaceId' s
f
      (ComponentId s
_, VertexId' (Wrap s)
la, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV VertexId' s
a PlanarSubdivision s v e f r
d
      (ComponentId s
_, VertexId' (Wrap s)
lb, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV VertexId' s
b PlanarSubdivision s v e f r
d
      (ComponentId s
_, VertexId' (Wrap s)
lc, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV (Dart s -> PlanarSubdivision s v e f r -> VertexId' s
forall k (s :: k) v e f r.
Dart s -> PlanarSubdivision s v e f r -> VertexId' s
tailOf Dart s
ea PlanarSubdivision s v e f r
d) PlanarSubdivision s v e f r
d
      (ComponentId s
_, VertexId' (Wrap s)
ld, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV (Dart s -> PlanarSubdivision s v e f r -> VertexId' s
forall k (s :: k) v e f r.
Dart s -> PlanarSubdivision s v e f r -> VertexId' s
tailOf Dart s
eb PlanarSubdivision s v e f r
d) PlanarSubdivision s v e f r
d
      (ComponentId s
_, FaceId' (Wrap s)
lf, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) :| [] = FaceId' s
-> PlanarSubdivision s v e f r
-> NonEmpty
     (ComponentId s, FaceId' (Wrap s),
      PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
FaceId' s
-> PlanarSubdivision s v e f r
-> NonEmpty (ComponentId s, FaceId' (Wrap s), Component s r)
asLocalF FaceId' s
f PlanarSubdivision s v e f r
d
      fd :: Dart s
fd = PlanarSubdivision s v e f r -> Dart s
forall k (s :: k) v e f r. PlanarSubdivision s v e f r -> Dart s
freeDart PlanarSubdivision s v e f r
d
      e' :: ((Dart s, e), (Dart s, e))
e' = ((Dart s
fd, (e, e) -> e
forall a b. (a, b) -> a
fst (e, e)
e), (Dart s -> Dart s
forall k (s :: k). Dart s -> Dart s
twin Dart s
fd, (e, e) -> e
forall a b. (a, b) -> b
snd (e, e)
e))
      tf :: FaceId' s
tf = PlanarSubdivision s v e f r -> FaceId' s
forall k (s :: k) v e f r. PlanarSubdivision s v e f r -> FaceId' s
freeFaceId PlanarSubdivision s v e f r
d
      g' :: (FaceId' s, f) -> ((FaceId' s, f), (FaceId' s, f))
g' (FaceId' s
ef, f
x) = ((FaceId' s
ef, (f, f) -> f
forall a b. (a, b) -> a
fst ((f, f) -> f) -> (f, f) -> f
forall a b. (a -> b) -> a -> b
$ f -> (f, f)
g f
x), (FaceId' s
tf, (f, f) -> f
forall a b. (a, b) -> b
snd ((f, f) -> f) -> (f, f) -> f
forall a b. (a -> b) -> a -> b
$ f -> (f, f)
g f
x))
  in String
-> PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r
forall a. Show a => String -> a -> a
tr String
"splitFaceSameComponent" (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r
forall a b. (a -> b) -> a -> b
$ PlanarSubdivision s v e f r
d PlanarSubdivision s v e f r
-> (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r
forall a b. a -> (a -> b) -> b
& (Vector (Component' s v e f r)
 -> Identity (Vector (Component' s v e f r)))
-> PlanarSubdivision s v e f r
-> Identity (PlanarSubdivision s v e f r)
forall k v e f r (s :: k).
(Show v, Show e, Show f, Show r) =>
Lens' (PlanarSubdivision s v e f r) (Vector (Component' s v e f r))
components' ((Vector (Component' s v e f r)
  -> Identity (Vector (Component' s v e f r)))
 -> PlanarSubdivision s v e f r
 -> Identity (PlanarSubdivision s v e f r))
-> (Vector (Component' s v e f r) -> Vector (Component' s v e f r))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Component' s v e f r -> Component' s v e f r)
-> Vector (Component' s v e f r) -> Vector (Component' s v e f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VertexId' (Wrap s)
-> VertexId' (Wrap s)
-> VertexId' (Wrap s)
-> VertexId' (Wrap s)
-> FaceId' (Wrap s)
-> ((Dart s, e), (Dart s, e))
-> ((FaceId' s, f) -> ((FaceId' s, f), (FaceId' s, f)))
-> Component' s v e f r
-> Component' s v e f r
forall k v e f r (s :: k).
(Show v, Show e, Show f, Show r) =>
VertexId' s
-> VertexId' s
-> VertexId' s
-> VertexId' s
-> FaceId' s
-> (e, e)
-> (f -> (f, f))
-> PlaneGraph s v e f r
-> PlaneGraph s v e f r
splitFaceInPlaneGraph (String -> VertexId' (Wrap s) -> VertexId' (Wrap s)
forall a. Show a => String -> a -> a
tr String
"la" VertexId' (Wrap s)
la) (String -> VertexId' (Wrap s) -> VertexId' (Wrap s)
forall a. Show a => String -> a -> a
tr String
"lb" VertexId' (Wrap s)
lb) (String -> VertexId' (Wrap s) -> VertexId' (Wrap s)
forall a. Show a => String -> a -> a
tr String
"lc" VertexId' (Wrap s)
lc) (String -> VertexId' (Wrap s) -> VertexId' (Wrap s)
forall a. Show a => String -> a -> a
tr String
"ld" VertexId' (Wrap s)
ld) (String -> FaceId' (Wrap s) -> FaceId' (Wrap s)
forall a. Show a => String -> a -> a
tr String
"lf" FaceId' (Wrap s)
lf) ((Dart s, e), (Dart s, e))
e' (FaceId' s, f) -> ((FaceId' s, f), (FaceId' s, f))
g')

splitFaceDifferentComponents :: a
splitFaceDifferentComponents = a
forall a. HasCallStack => a
undefined


-- | Splits a given edge of a planar subdivision by inserting a new vertex on the edges.
--   Increases #vertices and #edges by 1.
unSplitEdge
  :: (Show v, Show e, Show f, Show r)
  => VertexId' s
  -> ((e, e) -> e)
  -> PlanarSubdivision s v e f r
  -> PlanarSubdivision s v e f r

unSplitEdge :: VertexId' s
-> ((e, e) -> e)
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
unSplitEdge VertexId' s
b (e, e) -> e
f PlanarSubdivision s v e f r
d =
  let [VertexId' s
a, VertexId' s
c] = String -> [VertexId' s] -> [VertexId' s]
forall a. Show a => String -> a -> a
tr String
"[a, c]" ([VertexId' s] -> [VertexId' s]) -> [VertexId' s] -> [VertexId' s]
forall a b. (a -> b) -> a -> b
$ Vector (VertexId' s) -> [VertexId' s]
forall a. Vector a -> [a]
toList (Vector (VertexId' s) -> [VertexId' s])
-> Vector (VertexId' s) -> [VertexId' s]
forall a b. (a -> b) -> a -> b
$ VertexId' s -> PlanarSubdivision s v e f r -> Vector (VertexId' s)
forall k (s :: k) v e f r.
VertexId' s -> PlanarSubdivision s v e f r -> Vector (VertexId' s)
neighboursOf VertexId' s
b PlanarSubdivision s v e f r
d
      (ComponentId s
_, VertexId' (Wrap s)
la, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV VertexId' s
a PlanarSubdivision s v e f r
d
      (ComponentId s
_, VertexId' (Wrap s)
lb, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV VertexId' s
b PlanarSubdivision s v e f r
d
      (ComponentId s
_, VertexId' (Wrap s)
lc, PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
_) = VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s),
    PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r.
VertexId' s
-> PlanarSubdivision s v e f r
-> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV VertexId' s
c PlanarSubdivision s v e f r
d
      [Dart s
dab] = (Dart s -> Bool) -> [Dart s] -> [Dart s]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Dart s
e -> Dart s -> PlanarSubdivision s v e f r -> VertexId' s
forall k (s :: k) v e f r.
Dart s -> PlanarSubdivision s v e f r -> VertexId' s
tailOf Dart s
e PlanarSubdivision s v e f r
d VertexId' s -> VertexId' s -> Bool
forall a. Eq a => a -> a -> Bool
== VertexId' s
a) ([Dart s] -> [Dart s]) -> [Dart s] -> [Dart s]
forall a b. (a -> b) -> a -> b
$ PlanarSubdivision s v e f r
-> VertexId' s -> VertexId' s -> [Dart s]
forall k (s :: k) a b v e f r.
(Incident s a (Dart s), Incident s b (Dart s)) =>
PlanarSubdivision s v e f r -> a -> b -> [Dart s]
commonDarts PlanarSubdivision s v e f r
d VertexId' s
a VertexId' s
b
      [Dart s
dcb] = (Dart s -> Bool) -> [Dart s] -> [Dart s]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Dart s
e -> Dart s -> PlanarSubdivision s v e f r -> VertexId' s
forall k (s :: k) v e f r.
Dart s -> PlanarSubdivision s v e f r -> VertexId' s
tailOf Dart s
e PlanarSubdivision s v e f r
d VertexId' s -> VertexId' s -> Bool
forall a. Eq a => a -> a -> Bool
== VertexId' s
c) ([Dart s] -> [Dart s]) -> [Dart s] -> [Dart s]
forall a b. (a -> b) -> a -> b
$ PlanarSubdivision s v e f r
-> VertexId' s -> VertexId' s -> [Dart s]
forall k (s :: k) a b v e f r.
(Incident s a (Dart s), Incident s b (Dart s)) =>
PlanarSubdivision s v e f r -> a -> b -> [Dart s]
commonDarts PlanarSubdivision s v e f r
d VertexId' s
b VertexId' s
c
      f' :: ((Dart s, e), (Dart s, e)) -> (Dart s, e)
f' ((Dart s
di, e
ei), (Dart s
dj, e
ej)) | Dart s
di Dart s -> Dart s -> Bool
forall a. Eq a => a -> a -> Bool
== Dart s
dab = (     Dart s
dab, (e, e) -> e
f (e
ei, e
ej))
                              | Dart s
di Dart s -> Dart s -> Bool
forall a. Eq a => a -> a -> Bool
== Dart s
dcb = (Dart s -> Dart s
forall k (s :: k). Dart s -> Dart s
twin Dart s
dab, (e, e) -> e
f (e
ei, e
ej))
                              | Bool
otherwise = String -> (Dart s, e)
forall a. HasCallStack => String -> a
error String
"you shouldn't call f' on any other dart"
      -- no longer used: vertex id b and dart id dcb
  in  String
-> PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r
forall a. Show a => String -> a -> a
tr String
"unSplitEdge" (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r
forall a b. (a -> b) -> a -> b
$ PlanarSubdivision s v e f r
d PlanarSubdivision s v e f r
-> (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r
forall a b. a -> (a -> b) -> b
& (Vector (Component' s v e f r)
 -> Identity (Vector (Component' s v e f r)))
-> PlanarSubdivision s v e f r
-> Identity (PlanarSubdivision s v e f r)
forall k v e f r (s :: k).
(Show v, Show e, Show f, Show r) =>
Lens' (PlanarSubdivision s v e f r) (Vector (Component' s v e f r))
components' ((Vector (Component' s v e f r)
  -> Identity (Vector (Component' s v e f r)))
 -> PlanarSubdivision s v e f r
 -> Identity (PlanarSubdivision s v e f r))
-> (Vector (Component' s v e f r) -> Vector (Component' s v e f r))
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Component' s v e f r -> Component' s v e f r)
-> Vector (Component' s v e f r) -> Vector (Component' s v e f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VertexId' (Wrap s)
-> VertexId' (Wrap s)
-> VertexId' (Wrap s)
-> (((Dart s, e), (Dart s, e)) -> (Dart s, e))
-> Component' s v e f r
-> Component' s v e f r
forall k v e f r (s :: k).
(Show v, Show e, Show f, Show r) =>
VertexId' s
-> VertexId' s
-> VertexId' s
-> ((e, e) -> e)
-> PlaneGraph s v e f r
-> PlaneGraph s v e f r
unSplitEdgeInPlaneGraph VertexId' (Wrap s)
la VertexId' (Wrap s)
lb VertexId' (Wrap s)
lc ((Dart s, e), (Dart s, e)) -> (Dart s, e)
f')
-- globally, need to restore VertexId and DartIds ???





-- nodig:

freeVertexId :: PlanarSubdivision s v e f r -> VertexId' s
freeDart :: PlanarSubdivision s v e f r -> Dart s
freeFaceId :: PlanarSubdivision s v e f r -> FaceId' s

freeVertexId :: PlanarSubdivision s v e f r -> VertexId' s
freeVertexId = Int -> VertexId' s
forall k (s :: k) (w :: World). Int -> VertexId s w
VertexId (Int -> VertexId' s)
-> (PlanarSubdivision s v e f r -> Int)
-> PlanarSubdivision s v e f r
-> VertexId' s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlanarSubdivision s v e f r -> Int
forall k (s :: k) v e f r. PlanarSubdivision s v e f r -> Int
numVertices
freeDart :: PlanarSubdivision s v e f r -> Dart s
freeDart     = (Arc s -> Direction -> Dart s) -> Direction -> Arc s -> Dart s
forall a b c. (a -> b -> c) -> b -> a -> c
flip Arc s -> Direction -> Dart s
forall k (s :: k). Arc s -> Direction -> Dart s
Dart Direction
Positive (Arc s -> Dart s)
-> (PlanarSubdivision s v e f r -> Arc s)
-> PlanarSubdivision s v e f r
-> Dart s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Arc s
forall k (s :: k). Int -> Arc s
Arc (Int -> Arc s)
-> (PlanarSubdivision s v e f r -> Int)
-> PlanarSubdivision s v e f r
-> Arc s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlanarSubdivision s v e f r -> Int
forall k (s :: k) v e f r. PlanarSubdivision s v e f r -> Int
numEdges
freeFaceId :: PlanarSubdivision s v e f r -> FaceId' s
freeFaceId   = VertexId s 'Dual -> FaceId' s
forall k (s :: k) (w :: World). VertexId s (DualOf w) -> FaceId s w
FaceId (VertexId s 'Dual -> FaceId' s)
-> (PlanarSubdivision s v e f r -> VertexId s 'Dual)
-> PlanarSubdivision s v e f r
-> FaceId' s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VertexId s 'Dual
forall k (s :: k) (w :: World). Int -> VertexId s w
VertexId (Int -> VertexId s 'Dual)
-> (PlanarSubdivision s v e f r -> Int)
-> PlanarSubdivision s v e f r
-> VertexId s 'Dual
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlanarSubdivision s v e f r -> Int
forall k (s :: k) v e f r. PlanarSubdivision s v e f r -> Int
numFaces

components' :: (Show v, Show e, Show f, Show r) => Lens' (PlanarSubdivision s v e f r) (Vector (Component' s v e f r))
type Component' s v e f r = PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s, f) r
components' :: Lens' (PlanarSubdivision s v e f r) (Vector (Component' s v e f r))
components' = (PlanarSubdivision s v e f r -> Vector (Component' s v e f r))
-> (PlanarSubdivision s v e f r
    -> Vector (Component' s v e f r) -> PlanarSubdivision s v e f r)
-> Lens'
     (PlanarSubdivision s v e f r) (Vector (Component' s v e f r))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PlanarSubdivision s v e f r -> Vector (Component' s v e f r)
forall k (s :: k) v e f r.
PlanarSubdivision s v e f r -> Vector (Component' s v e f r)
getComponents' PlanarSubdivision s v e f r
-> Vector (Component' s v e f r) -> PlanarSubdivision s v e f r
forall k v e f r (s :: k).
(Show v, Show e, Show f, Show r) =>
PlanarSubdivision s v e f r
-> Vector (Component' s v e f r) -> PlanarSubdivision s v e f r
setComponents'

getComponents' :: PlanarSubdivision s v e f r -> Vector (Component' s v e f r)
getComponents' :: PlanarSubdivision s v e f r -> Vector (Component' s v e f r)
getComponents' PlanarSubdivision s v e f r
p = (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
 -> Component' s v e f r)
-> Vector
     (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
-> Vector (Component' s v e f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PlanarSubdivision s v e f r
-> PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r
-> Component' s v e f r
forall k (s :: k) v e f r.
PlanarSubdivision s v e f r
-> Component s r -> Component' s v e f r
addExtraData PlanarSubdivision s v e f r
p) (Vector (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
 -> Vector (Component' s v e f r))
-> Vector
     (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
-> Vector (Component' s v e f r)
forall a b. (a -> b) -> a -> b
$ PlanarSubdivision s v e f r
p PlanarSubdivision s v e f r
-> Getting
     (Vector (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r))
     (PlanarSubdivision s v e f r)
     (Vector (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r))
-> Vector
     (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r)
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r))
  (PlanarSubdivision s v e f r)
  (Vector (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s) r))
forall k (s :: k) v e f r1 r2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v e f r2)
  (Vector (Component s r1))
  (Vector (Component s r2))
components

addExtraData :: PlanarSubdivision s v e f r -> Component s r -> Component' s v e f r
addExtraData :: PlanarSubdivision s v e f r
-> Component s r -> Component' s v e f r
addExtraData PlanarSubdivision s v e f r
p Component s r
c = Component s r
c Component s r
-> (Component s r
    -> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r)
-> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r
forall a b. a -> (a -> b) -> b
& (Vector (VertexId' s) -> Identity (Vector (VertexId' s, v)))
-> Component s r
-> Identity
     (PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r)
forall k (s :: k) v e f r v'.
Lens
  (PlaneGraph s v e f r)
  (PlaneGraph s v' e f r)
  (Vector v)
  (Vector v')
PG.vertexData  ((Vector (VertexId' s) -> Identity (Vector (VertexId' s, v)))
 -> Component s r
 -> Identity
      (PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r))
-> ((VertexId' s -> Identity (VertexId' s, v))
    -> Vector (VertexId' s) -> Identity (Vector (VertexId' s, v)))
-> (VertexId' s -> Identity (VertexId' s, v))
-> Component s r
-> Identity
     (PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VertexId' s -> Identity (VertexId' s, v))
-> Vector (VertexId' s) -> Identity (Vector (VertexId' s, v))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((VertexId' s -> Identity (VertexId' s, v))
 -> Component s r
 -> Identity
      (PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r))
-> (VertexId' s -> (VertexId' s, v))
-> Component s r
-> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\VertexId' s
i -> (VertexId' s
i, PlanarSubdivision s v e f r
p PlanarSubdivision s v e f r
-> Getting v (PlanarSubdivision s v e f r) v -> v
forall s a. s -> Getting a s a -> a
^. VertexId' s
-> Lens'
     (PlanarSubdivision s v e f r)
     (DataOf (PlanarSubdivision s v e f r) (VertexId' s))
forall g i. HasDataOf g i => i -> Lens' g (DataOf g i)
dataOf VertexId' s
i))
                     PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r
-> (PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r
    -> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r)
-> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r
forall a b. a -> (a -> b) -> b
& (Vector (Dart s) -> Identity (Vector (Dart s, e)))
-> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r
-> Identity
     (PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r)
forall k (s :: k) v e f r e'.
Lens
  (PlaneGraph s v e f r)
  (PlaneGraph s v e' f r)
  (Vector e)
  (Vector e')
PG.rawDartData ((Vector (Dart s) -> Identity (Vector (Dart s, e)))
 -> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r
 -> Identity
      (PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r))
-> ((Dart s -> Identity (Dart s, e))
    -> Vector (Dart s) -> Identity (Vector (Dart s, e)))
-> (Dart s -> Identity (Dart s, e))
-> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r
-> Identity
     (PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dart s -> Identity (Dart s, e))
-> Vector (Dart s) -> Identity (Vector (Dart s, e))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Dart s -> Identity (Dart s, e))
 -> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r
 -> Identity
      (PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r))
-> (Dart s -> (Dart s, e))
-> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s) (FaceId' s) r
-> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Dart s
i -> (Dart s
i, PlanarSubdivision s v e f r
p PlanarSubdivision s v e f r
-> Getting e (PlanarSubdivision s v e f r) e -> e
forall s a. s -> Getting a s a -> a
^. Dart s
-> Lens'
     (PlanarSubdivision s v e f r)
     (DataOf (PlanarSubdivision s v e f r) (Dart s))
forall g i. HasDataOf g i => i -> Lens' g (DataOf g i)
dataOf Dart s
i))
                     PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r
-> (PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r
    -> Component' s v e f r)
-> Component' s v e f r
forall a b. a -> (a -> b) -> b
& (Vector (FaceId' s) -> Identity (Vector (FaceId' s, f)))
-> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r
-> Identity (Component' s v e f r)
forall k (s :: k) v e f r f'.
Lens
  (PlaneGraph s v e f r)
  (PlaneGraph s v e f' r)
  (Vector f)
  (Vector f')
PG.faceData    ((Vector (FaceId' s) -> Identity (Vector (FaceId' s, f)))
 -> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r
 -> Identity (Component' s v e f r))
-> ((FaceId' s -> Identity (FaceId' s, f))
    -> Vector (FaceId' s) -> Identity (Vector (FaceId' s, f)))
-> (FaceId' s -> Identity (FaceId' s, f))
-> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r
-> Identity (Component' s v e f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FaceId' s -> Identity (FaceId' s, f))
-> Vector (FaceId' s) -> Identity (Vector (FaceId' s, f))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((FaceId' s -> Identity (FaceId' s, f))
 -> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r
 -> Identity (Component' s v e f r))
-> (FaceId' s -> (FaceId' s, f))
-> PlaneGraph (Wrap s) (VertexId' s, v) (Dart s, e) (FaceId' s) r
-> Component' s v e f r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\FaceId' s
i -> (FaceId' s
i, PlanarSubdivision s v e f r
p PlanarSubdivision s v e f r
-> Getting f (PlanarSubdivision s v e f r) f -> f
forall s a. s -> Getting a s a -> a
^. FaceId' s
-> Lens'
     (PlanarSubdivision s v e f r)
     (DataOf (PlanarSubdivision s v e f r) (FaceId' s))
forall g i. HasDataOf g i => i -> Lens' g (DataOf g i)
dataOf FaceId' s
i))

setComponents' :: (Show v, Show e, Show f, Show r) => PlanarSubdivision s v e f r -> Vector (Component' s v e f r) -> PlanarSubdivision s v e f r
setComponents' :: PlanarSubdivision s v e f r
-> Vector (Component' s v e f r) -> PlanarSubdivision s v e f r
setComponents' PlanarSubdivision s v e f r
p Vector (Component' s v e f r)
cs = PlanarSubdivision s v e f r
p PlanarSubdivision s v e f r
-> (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r
forall a b. a -> (a -> b) -> b
& (Vector (Component s r) -> Identity (Vector (Component s r)))
-> PlanarSubdivision s v e f r
-> Identity (PlanarSubdivision s v e f r)
forall k (s :: k) v e f r1 r2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v e f r2)
  (Vector (Component s r1))
  (Vector (Component s r2))
components ((Vector (Component s r) -> Identity (Vector (Component s r)))
 -> PlanarSubdivision s v e f r
 -> Identity (PlanarSubdivision s v e f r))
-> Vector (Component s r)
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Component' s v e f r -> Component s r)
-> Vector (Component' s v e f r) -> Vector (Component s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Component' s v e f r -> Component s r
forall k (s :: k) v e f r. Component' s v e f r -> Component s r
remExtraData Vector (Component' s v e f r)
cs
                        PlanarSubdivision s v e f r
-> (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r
forall a b. a -> (a -> b) -> b
& (Vector (Raw s (VertexId' (Wrap s)) v)
 -> Identity (Vector (Raw s (VertexId' (Wrap s)) v)))
-> PlanarSubdivision s v e f r
-> Identity (PlanarSubdivision s v e f r)
forall k (s :: k) v e f r1 v2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v2 e f r1)
  (Vector (Raw s (VertexId' (Wrap s)) v))
  (Vector (Raw s (VertexId' (Wrap s)) v2))
rawVertexData ((Vector (Raw s (VertexId' (Wrap s)) v)
  -> Identity (Vector (Raw s (VertexId' (Wrap s)) v)))
 -> PlanarSubdivision s v e f r
 -> Identity (PlanarSubdivision s v e f r))
-> Vector (Raw s (VertexId' (Wrap s)) v)
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String
-> Vector (Raw s (VertexId' (Wrap s)) v)
-> Vector (Raw s (VertexId' (Wrap s)) v)
forall a. Show a => String -> a -> a
tr String
"rawVertexData" (Vector (Raw s (VertexId' (Wrap s)) v)
 -> Vector (Raw s (VertexId' (Wrap s)) v))
-> ([(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
    -> Vector (Raw s (VertexId' (Wrap s)) v))
-> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
-> Vector (Raw s (VertexId' (Wrap s)) v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
-> Vector (Raw s (VertexId' (Wrap s)) v)
forall i a. (Enum i, Show i) => [(i, a)] -> Vector a
vectorise ([(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
 -> Vector (Raw s (VertexId' (Wrap s)) v))
-> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
-> Vector (Raw s (VertexId' (Wrap s)) v)
forall a b. (a -> b) -> a -> b
$ Vector (Component' s v e f r)
-> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
forall k (s :: k) v e f r.
Vector (Component' s v e f r)
-> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
getRawVertexData Vector (Component' s v e f r)
cs)
                        PlanarSubdivision s v e f r
-> (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r
forall a b. a -> (a -> b) -> b
& (Vector (Raw s (Dart (Wrap s)) e)
 -> Identity (Vector (Raw s (Dart (Wrap s)) e)))
-> PlanarSubdivision s v e f r
-> Identity (PlanarSubdivision s v e f r)
forall k (s :: k) v e f r1 e2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v e2 f r1)
  (Vector (Raw s (Dart (Wrap s)) e))
  (Vector (Raw s (Dart (Wrap s)) e2))
rawDartData   ((Vector (Raw s (Dart (Wrap s)) e)
  -> Identity (Vector (Raw s (Dart (Wrap s)) e)))
 -> PlanarSubdivision s v e f r
 -> Identity (PlanarSubdivision s v e f r))
-> Vector (Raw s (Dart (Wrap s)) e)
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String
-> Vector (Raw s (Dart (Wrap s)) e)
-> Vector (Raw s (Dart (Wrap s)) e)
forall a. Show a => String -> a -> a
tr String
"rawDartData"   (Vector (Raw s (Dart (Wrap s)) e)
 -> Vector (Raw s (Dart (Wrap s)) e))
-> ([(Dart s, Raw s (Dart (Wrap s)) e)]
    -> Vector (Raw s (Dart (Wrap s)) e))
-> [(Dart s, Raw s (Dart (Wrap s)) e)]
-> Vector (Raw s (Dart (Wrap s)) e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Dart s, Raw s (Dart (Wrap s)) e)]
-> Vector (Raw s (Dart (Wrap s)) e)
forall i a. (Enum i, Show i) => [(i, a)] -> Vector a
vectorise ([(Dart s, Raw s (Dart (Wrap s)) e)]
 -> Vector (Raw s (Dart (Wrap s)) e))
-> [(Dart s, Raw s (Dart (Wrap s)) e)]
-> Vector (Raw s (Dart (Wrap s)) e)
forall a b. (a -> b) -> a -> b
$ Vector (Component' s v e f r)
-> [(Dart s, Raw s (Dart (Wrap s)) e)]
forall k (s :: k) v e f r.
Vector (Component' s v e f r)
-> [(Dart s, Raw s (Dart (Wrap s)) e)]
getRawEdgeData Vector (Component' s v e f r)
cs)
                        PlanarSubdivision s v e f r
-> (PlanarSubdivision s v e f r -> PlanarSubdivision s v e f r)
-> PlanarSubdivision s v e f r
forall a b. a -> (a -> b) -> b
& (Vector (RawFace s f) -> Identity (Vector (RawFace s f)))
-> PlanarSubdivision s v e f r
-> Identity (PlanarSubdivision s v e f r)
forall k (s :: k) v e f r1 f2.
Lens
  (PlanarSubdivision s v e f r1)
  (PlanarSubdivision s v e f2 r1)
  (Vector (RawFace s f))
  (Vector (RawFace s f2))
rawFaceData   ((Vector (RawFace s f) -> Identity (Vector (RawFace s f)))
 -> PlanarSubdivision s v e f r
 -> Identity (PlanarSubdivision s v e f r))
-> Vector (RawFace s f)
-> PlanarSubdivision s v e f r
-> PlanarSubdivision s v e f r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String -> Vector (RawFace s f) -> Vector (RawFace s f)
forall a. Show a => String -> a -> a
tr String
"rawFaceData"   (Vector (RawFace s f) -> Vector (RawFace s f))
-> ([(FaceId' s, RawFace s f)] -> Vector (RawFace s f))
-> [(FaceId' s, RawFace s f)]
-> Vector (RawFace s f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FaceId' s, RawFace s f)] -> Vector (RawFace s f)
forall i a. (Enum i, Show i) => [(i, a)] -> Vector a
vectorise ([(FaceId' s, RawFace s f)] -> Vector (RawFace s f))
-> [(FaceId' s, RawFace s f)] -> Vector (RawFace s f)
forall a b. (a -> b) -> a -> b
$ Vector (Component' s v e f r) -> [(FaceId' s, RawFace s f)]
forall k (s :: k) v e f r.
Vector (Component' s v e f r) -> [(FaceId' s, RawFace s f)]
getRawFaceData Vector (Component' s v e f r)
cs)

getRawVertexData :: Vector (Component' s v e f r)
                 -> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
getRawVertexData :: Vector (Component' s v e f r)
-> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
getRawVertexData = [[(VertexId' s, Raw s (VertexId' (Wrap s)) v)]]
-> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(VertexId' s, Raw s (VertexId' (Wrap s)) v)]]
 -> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)])
-> (Vector (Component' s v e f r)
    -> [[(VertexId' s, Raw s (VertexId' (Wrap s)) v)]])
-> Vector (Component' s v e f r)
-> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
 -> Component' s v e f r
 -> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)])
-> [Component' s v e f r]
-> [[(VertexId' s, Raw s (VertexId' (Wrap s)) v)]]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\Int
ci Component' s v e f r
g -> ((VertexId' (Wrap s), VertexData r (VertexId' s, v))
 -> (VertexId' s, Raw s (VertexId' (Wrap s)) v))
-> [(VertexId' (Wrap s), VertexData r (VertexId' s, v))]
-> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
forall a b. (a -> b) -> [a] -> [b]
map (\(VertexId' (Wrap s)
li, VertexData Point 2 r
_ (VertexId' s
gi, v
v)) -> (VertexId' s
gi, ComponentId s
-> VertexId' (Wrap s) -> v -> Raw s (VertexId' (Wrap s)) v
forall k (s :: k) ia a. ComponentId s -> ia -> a -> Raw s ia a
Raw (Int -> ComponentId s
forall a. Enum a => Int -> a
toEnum Int
ci) VertexId' (Wrap s)
li v
v)) ([(VertexId' (Wrap s), VertexData r (VertexId' s, v))]
 -> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)])
-> [(VertexId' (Wrap s), VertexData r (VertexId' s, v))]
-> [(VertexId' s, Raw s (VertexId' (Wrap s)) v)]
forall a b. (a -> b) -> a -> b
$ Vector (VertexId' (Wrap s), VertexData r (VertexId' s, v))
-> [(VertexId' (Wrap s), VertexData r (VertexId' s, v))]
forall a. Vector a -> [a]
toList (Vector (VertexId' (Wrap s), VertexData r (VertexId' s, v))
 -> [(VertexId' (Wrap s), VertexData r (VertexId' s, v))])
-> Vector (VertexId' (Wrap s), VertexData r (VertexId' s, v))
-> [(VertexId' (Wrap s), VertexData r (VertexId' s, v))]
forall a b. (a -> b) -> a -> b
$ Component' s v e f r
-> Vector (VertexId' (Wrap s), VertexData r (VertexId' s, v))
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Vector (VertexId' s, VertexData r v)
PG.vertices Component' s v e f r
g) ([Component' s v e f r]
 -> [[(VertexId' s, Raw s (VertexId' (Wrap s)) v)]])
-> (Vector (Component' s v e f r) -> [Component' s v e f r])
-> Vector (Component' s v e f r)
-> [[(VertexId' s, Raw s (VertexId' (Wrap s)) v)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Component' s v e f r) -> [Component' s v e f r]
forall a. Vector a -> [a]
toList

--getEdgeData :: Vector (Component' s v e f r) -> [(Dart s, (Dart s, e))]
--getEdgeData = map (\(a, b) -> (a, (a, b))) . concatMap (toList . (^. PG.rawDartData)) . toList

getRawEdgeData :: Vector (Component' s v e f r)
               -> [(Dart s, Raw s (Dart (Wrap s)) e)]
getRawEdgeData :: Vector (Component' s v e f r)
-> [(Dart s, Raw s (Dart (Wrap s)) e)]
getRawEdgeData = [[(Dart s, Raw s (Dart (Wrap s)) e)]]
-> [(Dart s, Raw s (Dart (Wrap s)) e)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Dart s, Raw s (Dart (Wrap s)) e)]]
 -> [(Dart s, Raw s (Dart (Wrap s)) e)])
-> (Vector (Component' s v e f r)
    -> [[(Dart s, Raw s (Dart (Wrap s)) e)]])
-> Vector (Component' s v e f r)
-> [(Dart s, Raw s (Dart (Wrap s)) e)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
 -> Component' s v e f r -> [(Dart s, Raw s (Dart (Wrap s)) e)])
-> [Component' s v e f r] -> [[(Dart s, Raw s (Dart (Wrap s)) e)]]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\Int
ci Component' s v e f r
g -> ((Dart (Wrap s), (Dart s, e)) -> (Dart s, Raw s (Dart (Wrap s)) e))
-> [(Dart (Wrap s), (Dart s, e))]
-> [(Dart s, Raw s (Dart (Wrap s)) e)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Dart (Wrap s)
li, (Dart s
gi, e
e)) -> (Dart s
gi, ComponentId s -> Dart (Wrap s) -> e -> Raw s (Dart (Wrap s)) e
forall k (s :: k) ia a. ComponentId s -> ia -> a -> Raw s ia a
Raw (Int -> ComponentId s
forall a. Enum a => Int -> a
toEnum Int
ci) Dart (Wrap s)
li e
e)) ([(Dart (Wrap s), (Dart s, e))]
 -> [(Dart s, Raw s (Dart (Wrap s)) e)])
-> [(Dart (Wrap s), (Dart s, e))]
-> [(Dart s, Raw s (Dart (Wrap s)) e)]
forall a b. (a -> b) -> a -> b
$ Vector (Dart (Wrap s), (Dart s, e))
-> [(Dart (Wrap s), (Dart s, e))]
forall a. Vector a -> [a]
toList (Vector (Dart (Wrap s), (Dart s, e))
 -> [(Dart (Wrap s), (Dart s, e))])
-> Vector (Dart (Wrap s), (Dart s, e))
-> [(Dart (Wrap s), (Dart s, e))]
forall a b. (a -> b) -> a -> b
$ Component' s v e f r -> Vector (Dart (Wrap s), (Dart s, e))
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Vector (Dart s, e)
PG.darts Component' s v e f r
g) ([Component' s v e f r] -> [[(Dart s, Raw s (Dart (Wrap s)) e)]])
-> (Vector (Component' s v e f r) -> [Component' s v e f r])
-> Vector (Component' s v e f r)
-> [[(Dart s, Raw s (Dart (Wrap s)) e)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Component' s v e f r) -> [Component' s v e f r]
forall a. Vector a -> [a]
toList


--getFaceData :: Vector (Component' s v e f r) -> [(FaceId' s, f)]
--getFaceData = concatMap (toList . (^. PG.faceData)) . toList


-- data RawFace	s f
-- _faceIdx :: !(Maybe (ComponentId s, FaceId' (Wrap s)))
-- _faceDataVal :: !(FaceData (Dart s) f)

-- | Something in this implementation is not right. It makes asLocalF produce an error.
getRawFaceData :: Vector (Component' s v e f r)
               -> [(FaceId' s, RawFace s f)]
getRawFaceData :: Vector (Component' s v e f r) -> [(FaceId' s, RawFace s f)]
getRawFaceData = [[(FaceId' s, RawFace s f)]] -> [(FaceId' s, RawFace s f)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(FaceId' s, RawFace s f)]] -> [(FaceId' s, RawFace s f)])
-> (Vector (Component' s v e f r) -> [[(FaceId' s, RawFace s f)]])
-> Vector (Component' s v e f r)
-> [(FaceId' s, RawFace s f)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Component' s v e f r -> [(FaceId' s, RawFace s f)])
-> [Component' s v e f r] -> [[(FaceId' s, RawFace s f)]]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\Int
ci Component' s v e f r
g -> ((FaceId' (Wrap s), (FaceId' s, f)) -> (FaceId' s, RawFace s f))
-> [(FaceId' (Wrap s), (FaceId' s, f))]
-> [(FaceId' s, RawFace s f)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
-> (FaceId' (Wrap s), (FaceId' s, f)) -> (FaceId' s, RawFace s f)
forall k k (s :: k) (s :: k) f.
Int
-> (FaceId' (Wrap s), (FaceId' s, f)) -> (FaceId' s, RawFace s f)
bla Int
ci) ([(FaceId' (Wrap s), (FaceId' s, f))]
 -> [(FaceId' s, RawFace s f)])
-> [(FaceId' (Wrap s), (FaceId' s, f))]
-> [(FaceId' s, RawFace s f)]
forall a b. (a -> b) -> a -> b
$ Vector (FaceId' (Wrap s), (FaceId' s, f))
-> [(FaceId' (Wrap s), (FaceId' s, f))]
forall a. Vector a -> [a]
toList (Vector (FaceId' (Wrap s), (FaceId' s, f))
 -> [(FaceId' (Wrap s), (FaceId' s, f))])
-> Vector (FaceId' (Wrap s), (FaceId' s, f))
-> [(FaceId' (Wrap s), (FaceId' s, f))]
forall a b. (a -> b) -> a -> b
$ Component' s v e f r -> Vector (FaceId' (Wrap s), (FaceId' s, f))
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Vector (FaceId' s, f)
PG.faces Component' s v e f r
g) ([Component' s v e f r] -> [[(FaceId' s, RawFace s f)]])
-> (Vector (Component' s v e f r) -> [Component' s v e f r])
-> Vector (Component' s v e f r)
-> [[(FaceId' s, RawFace s f)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Component' s v e f r) -> [Component' s v e f r]
forall a. Vector a -> [a]
toList
  where
    bla :: Int
-> (FaceId' (Wrap s), (FaceId' s, f)) -> (FaceId' s, RawFace s f)
bla Int
ci (FaceId' (Wrap s)
li, (FaceId' s
gi, f
f)) | FaceId' s -> Bool
forall k (s :: k). FaceId' s -> Bool
isOuterFace FaceId' s
gi = (FaceId' s
gi, Maybe (ComponentId s, FaceId' (Wrap s))
-> FaceData (Dart s) f -> RawFace s f
forall k (s :: k) f.
Maybe (ComponentId s, FaceId' (Wrap s))
-> FaceData (Dart s) f -> RawFace s f
RawFace Maybe (ComponentId s, FaceId' (Wrap s))
forall a. Maybe a
Nothing (Seq (Dart s) -> f -> FaceData (Dart s) f
forall h f. Seq h -> f -> FaceData h f
FaceData Seq (Dart s)
forall s. AsEmpty s => s
Empty f
f))
                         | Bool
otherwise      = (FaceId' s
gi, Maybe (ComponentId s, FaceId' (Wrap s))
-> FaceData (Dart s) f -> RawFace s f
forall k (s :: k) f.
Maybe (ComponentId s, FaceId' (Wrap s))
-> FaceData (Dart s) f -> RawFace s f
RawFace ((ComponentId s, FaceId' (Wrap s))
-> Maybe (ComponentId s, FaceId' (Wrap s))
forall a. a -> Maybe a
Just (Int -> ComponentId s
forall a. Enum a => Int -> a
toEnum Int
ci, FaceId' (Wrap s)
li)) (Seq (Dart s) -> f -> FaceData (Dart s) f
forall h f. Seq h -> f -> FaceData h f
FaceData Seq (Dart s)
forall s. AsEmpty s => s
Empty f
f))
-- holes are always empty! (where to get them from?)

isOuterFace :: FaceId' s -> Bool
isOuterFace :: FaceId' s -> Bool
isOuterFace FaceId' s
i = FaceId' s -> Int
forall a. Enum a => a -> Int
fromEnum FaceId' s
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

remExtraData :: Component' s v e f r -> Component s r
remExtraData :: Component' s v e f r -> Component s r
remExtraData Component' s v e f r
c = Component' s v e f r
c Component' s v e f r
-> (Component' s v e f r
    -> PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r)
-> PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r
forall a b. a -> (a -> b) -> b
& (Vector (VertexId' s, v) -> Identity (Vector (VertexId' s)))
-> Component' s v e f r
-> Identity
     (PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r)
forall k (s :: k) v e f r v'.
Lens
  (PlaneGraph s v e f r)
  (PlaneGraph s v' e f r)
  (Vector v)
  (Vector v')
PG.vertexData  ((Vector (VertexId' s, v) -> Identity (Vector (VertexId' s)))
 -> Component' s v e f r
 -> Identity
      (PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r))
-> (((VertexId' s, v) -> Identity (VertexId' s))
    -> Vector (VertexId' s, v) -> Identity (Vector (VertexId' s)))
-> ((VertexId' s, v) -> Identity (VertexId' s))
-> Component' s v e f r
-> Identity
     (PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VertexId' s, v) -> Identity (VertexId' s))
-> Vector (VertexId' s, v) -> Identity (Vector (VertexId' s))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((VertexId' s, v) -> Identity (VertexId' s))
 -> Component' s v e f r
 -> Identity
      (PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r))
-> ((VertexId' s, v) -> VertexId' s)
-> Component' s v e f r
-> PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (VertexId' s, v) -> VertexId' s
forall a b. (a, b) -> a
fst
                   PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r
-> (PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r
    -> PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r)
-> PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r
forall a b. a -> (a -> b) -> b
& (Vector (Dart s, e) -> Identity (Vector (Dart s)))
-> PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r
-> Identity
     (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r)
forall k (s :: k) v e f r e'.
Lens
  (PlaneGraph s v e f r)
  (PlaneGraph s v e' f r)
  (Vector e)
  (Vector e')
PG.rawDartData ((Vector (Dart s, e) -> Identity (Vector (Dart s)))
 -> PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r
 -> Identity
      (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r))
-> (((Dart s, e) -> Identity (Dart s))
    -> Vector (Dart s, e) -> Identity (Vector (Dart s)))
-> ((Dart s, e) -> Identity (Dart s))
-> PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r
-> Identity
     (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Dart s, e) -> Identity (Dart s))
-> Vector (Dart s, e) -> Identity (Vector (Dart s))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((Dart s, e) -> Identity (Dart s))
 -> PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r
 -> Identity
      (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r))
-> ((Dart s, e) -> Dart s)
-> PlaneGraph (Wrap s) (VertexId' s) (Dart s, e) (FaceId' s, f) r
-> PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Dart s, e) -> Dart s
forall a b. (a, b) -> a
fst
                   PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r
-> (PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r
    -> Component s r)
-> Component s r
forall a b. a -> (a -> b) -> b
& (Vector (FaceId' s, f) -> Identity (Vector (FaceId' s)))
-> PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r
-> Identity (Component s r)
forall k (s :: k) v e f r f'.
Lens
  (PlaneGraph s v e f r)
  (PlaneGraph s v e f' r)
  (Vector f)
  (Vector f')
PG.faceData    ((Vector (FaceId' s, f) -> Identity (Vector (FaceId' s)))
 -> PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r
 -> Identity (Component s r))
-> (((FaceId' s, f) -> Identity (FaceId' s))
    -> Vector (FaceId' s, f) -> Identity (Vector (FaceId' s)))
-> ((FaceId' s, f) -> Identity (FaceId' s))
-> PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r
-> Identity (Component s r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FaceId' s, f) -> Identity (FaceId' s))
-> Vector (FaceId' s, f) -> Identity (Vector (FaceId' s))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((FaceId' s, f) -> Identity (FaceId' s))
 -> PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r
 -> Identity (Component s r))
-> ((FaceId' s, f) -> FaceId' s)
-> PlaneGraph (Wrap s) (VertexId' s) (Dart s) (FaceId' s, f) r
-> Component s r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (FaceId' s, f) -> FaceId' s
forall a b. (a, b) -> a
fst


vectorise :: (Enum i, Show i) => [(i, a)] -> Vector a
vectorise :: [(i, a)] -> Vector a
vectorise [(i, a)]
vs = Int -> a -> Vector a
forall a. Int -> a -> Vector a
V.replicate ([(i, a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(i, a)]
vs) a
forall a. HasCallStack => a
undefined Vector a -> [(Int, a)] -> Vector a
forall a. Vector a -> [(Int, a)] -> Vector a
// ((i, a) -> (Int, a)) -> [(i, a)] -> [(Int, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(i
i, a
a) -> (i -> Int
forall a. Enum a => a -> Int
fromEnum i
i, a
a)) [(i, a)]
vs




------------------
-- PLANE GRAPHS --
------------------


-- INSERTIONS --


splitEdgeInPlaneGraph
  :: (Show v, Show e, Show f, Show r)
  => VertexId' s
  -> VertexId' s
  -> Point 2 r
  -> v
  -> (e -> (e, e))
  -> PlaneGraph s v e f r
  -> PlaneGraph s v e f r
-- LET OP! TEST OF a EN b WEL VOORKOMEN!
splitEdgeInPlaneGraph :: VertexId' s
-> VertexId' s
-> Point 2 r
-> v
-> (e -> (e, e))
-> PlaneGraph s v e f r
-> PlaneGraph s v e f r
splitEdgeInPlaneGraph VertexId' s
a VertexId' s
b Point 2 r
p v
v e -> (e, e)
f
  = String -> PlaneGraph s v e f r -> PlaneGraph s v e f r
forall a. Show a => String -> a -> a
tr String
"splitEdgeInPlaneGraph"
  (PlaneGraph s v e f r -> PlaneGraph s v e f r)
-> (PlaneGraph s v e f r -> PlaneGraph s v e f r)
-> PlaneGraph s v e f r
-> PlaneGraph s v e f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r
forall k (s :: k) v e f r.
Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r
PG.fromAdjRep
  (Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r)
-> (PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f))
-> PlaneGraph s v e f r
-> PlaneGraph s v e f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Int
-> Point 2 r
-> v
-> (e -> (e, e))
-> Gr (Vtx v e r) (Face f)
-> Gr (Vtx v e r) (Face f)
forall v e f r.
(Show v, Show e, Show f, Show r) =>
Int
-> Int
-> Point 2 r
-> v
-> (e -> (e, e))
-> Gr (Vtx v e r) (Face f)
-> Gr (Vtx v e r) (Face f)
splitEdgeInAdjRep (VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum VertexId' s
a) (VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum VertexId' s
b) Point 2 r
p v
v e -> (e, e)
f
  (Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f))
-> (PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f))
-> PlaneGraph s v e f r
-> Gr (Vtx v e r) (Face f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f)
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f)
PG.toAdjRep

sproutIntoFaceInPlaneGraph
  :: (Show v, Show e, Show f, Show r)
  => VertexId' s
  -> VertexId' s
  -> Point 2 r
  -> v
  -> (e, e)
  -> PlaneGraph s v e f r
  -> PlaneGraph s v e f r
sproutIntoFaceInPlaneGraph :: VertexId' s
-> VertexId' s
-> Point 2 r
-> v
-> (e, e)
-> PlaneGraph s v e f r
-> PlaneGraph s v e f r
sproutIntoFaceInPlaneGraph VertexId' s
a VertexId' s
c Point 2 r
p v
v (e, e)
e PlaneGraph s v e f r
g =
  let ai :: Int
ai = VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum VertexId' s
a
      ci :: Int
ci = VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum VertexId' s
c
  in String -> PlaneGraph s v e f r -> PlaneGraph s v e f r
forall a. Show a => String -> a -> a
tr String
"splitEdgeInPlaneGraph"
   (PlaneGraph s v e f r -> PlaneGraph s v e f r)
-> PlaneGraph s v e f r -> PlaneGraph s v e f r
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r
forall k (s :: k) v e f r.
Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r
PG.fromAdjRep
   (Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r)
-> Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Point 2 r
-> v
-> (e, e)
-> Gr (Vtx v e r) (Face f)
-> Gr (Vtx v e r) (Face f)
forall v e f r.
(Show v, Show e, Show f, Show r) =>
Int
-> Int
-> Point 2 r
-> v
-> (e, e)
-> Gr (Vtx v e r) (Face f)
-> Gr (Vtx v e r) (Face f)
sproutInAdjRep Int
ai Int
ci Point 2 r
p v
v (e, e)
e
   (Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f))
-> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a b. (a -> b) -> a -> b
$ PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f)
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f)
PG.toAdjRep PlaneGraph s v e f r
g


-- PG.toAdjRep :: PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f)
-- PG.fromAdjRep :: proxy s -> Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r


splitFaceInPlaneGraph
  :: (Show v, Show e, Show f, Show r)
  => VertexId' s             -- index van vertex a
  -> VertexId' s             -- index van vertex b
  -> VertexId' s             -- index van vertex c
  -> VertexId' s             -- index van vertex d
  -> FaceId' s               -- index van te splitsen face
  -> (e, e)                  -- extra data voor nieuwe edge ab
  -> (f -> (f, f))           -- functie om face data in twee stukken te knippen
  -> PlaneGraph s v e f r -- input graaf
  -> PlaneGraph s v e f r -- output graaf

splitFaceInPlaneGraph :: VertexId' s
-> VertexId' s
-> VertexId' s
-> VertexId' s
-> FaceId' s
-> (e, e)
-> (f -> (f, f))
-> PlaneGraph s v e f r
-> PlaneGraph s v e f r
splitFaceInPlaneGraph VertexId' s
a VertexId' s
b VertexId' s
c VertexId' s
d FaceId' s
f (e, e)
e f -> (f, f)
h PlaneGraph s v e f r
g =
  let ai :: Int
ai = VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum VertexId' s
a
      bi :: Int
bi = VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum VertexId' s
b
      ci :: Int
ci = VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum VertexId' s
c
      di :: Int
di = VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum VertexId' s
d
      fi :: Int
fi = VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum (VertexId' s -> Int) -> VertexId' s -> Int
forall a b. (a -> b) -> a -> b
$ String -> VertexId' s -> VertexId' s
forall a. Show a => String -> a -> a
tr String
"fi" (VertexId' s -> VertexId' s) -> VertexId' s -> VertexId' s
forall a b. (a -> b) -> a -> b
$ f -> VertexId' s -> VertexId' s
forall a b. Show a => a -> b -> b
traceShow (PlaneGraph s v e f r
g PlaneGraph s v e f r -> Getting f (PlaneGraph s v e f r) f -> f
forall s a. s -> Getting a s a -> a
^. FaceId' s
-> Lens'
     (PlaneGraph s v e f r) (DataOf (PlaneGraph s v e f r) (FaceId' s))
forall g i. HasDataOf g i => i -> Lens' g (DataOf g i)
dataOf FaceId' s
f) (VertexId' s -> VertexId' s) -> VertexId' s -> VertexId' s
forall a b. (a -> b) -> a -> b
$ Dart s -> PlaneGraph s v e f r -> VertexId' s
forall k (s :: k) v e f r.
Dart s -> PlaneGraph s v e f r -> VertexId' s
PG.tailOf (FaceId' s -> PlaneGraph s v e f r -> Dart s
forall k (s :: k) v e f r.
FaceId' s -> PlaneGraph s v e f r -> Dart s
PG.boundaryDart FaceId' s
f PlaneGraph s v e f r
g) PlaneGraph s v e f r
g
      fj :: Int
fj = VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum (VertexId' s -> Int) -> VertexId' s -> Int
forall a b. (a -> b) -> a -> b
$ String -> VertexId' s -> VertexId' s
forall a. Show a => String -> a -> a
tr String
"fj" (VertexId' s -> VertexId' s) -> VertexId' s -> VertexId' s
forall a b. (a -> b) -> a -> b
$ Dart s -> PlaneGraph s v e f r -> VertexId' s
forall k (s :: k) v e f r.
Dart s -> PlaneGraph s v e f r -> VertexId' s
PG.headOf (FaceId' s -> PlaneGraph s v e f r -> Dart s
forall k (s :: k) v e f r.
FaceId' s -> PlaneGraph s v e f r -> Dart s
PG.boundaryDart FaceId' s
f PlaneGraph s v e f r
g) PlaneGraph s v e f r
g
      -- ^ boundaryDart seems not working either
  in String -> PlaneGraph s v e f r -> PlaneGraph s v e f r
forall a. Show a => String -> a -> a
tr String
"splitFaceInPlaneGraph"
   (PlaneGraph s v e f r -> PlaneGraph s v e f r)
-> PlaneGraph s v e f r -> PlaneGraph s v e f r
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r
forall k (s :: k) v e f r.
Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r
PG.fromAdjRep
   (Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r)
-> Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> (e, e)
-> (f -> (f, f))
-> Gr (Vtx v e r) (Face f)
-> Gr (Vtx v e r) (Face f)
forall v e f r.
(Show v, Show e, Show f, Show r) =>
Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> (e, e)
-> (f -> (f, f))
-> Gr (Vtx v e r) (Face f)
-> Gr (Vtx v e r) (Face f)
splitFaceInAdjRep Int
ai Int
bi Int
ci Int
di Int
fi Int
fj (e, e)
e f -> (f, f)
h
   (Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f))
-> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a b. (a -> b) -> a -> b
$ PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f)
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f)
PG.toAdjRep PlaneGraph s v e f r
g


-- DELETIONS --


unSplitEdgeInPlaneGraph
  :: (Show v, Show e, Show f, Show r)
  => VertexId' s
  -> VertexId' s
  -> VertexId' s
  -> ((e, e) -> e)
  -> PlaneGraph s v e f r
  -> PlaneGraph s v e f r

unSplitEdgeInPlaneGraph :: VertexId' s
-> VertexId' s
-> VertexId' s
-> ((e, e) -> e)
-> PlaneGraph s v e f r
-> PlaneGraph s v e f r
unSplitEdgeInPlaneGraph VertexId' s
a VertexId' s
b VertexId' s
c (e, e) -> e
f
  = String -> PlaneGraph s v e f r -> PlaneGraph s v e f r
forall a. Show a => String -> a -> a
tr String
"unSplitEdgeInPlaneGraph"
  (PlaneGraph s v e f r -> PlaneGraph s v e f r)
-> (PlaneGraph s v e f r -> PlaneGraph s v e f r)
-> PlaneGraph s v e f r
-> PlaneGraph s v e f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r
forall k (s :: k) v e f r.
Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r
PG.fromAdjRep
  (Gr (Vtx v e r) (Face f) -> PlaneGraph s v e f r)
-> (PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f))
-> PlaneGraph s v e f r
-> PlaneGraph s v e f r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Int
-> Int
-> ((e, e) -> e)
-> Gr (Vtx v e r) (Face f)
-> Gr (Vtx v e r) (Face f)
forall v e f r.
(Show v, Show e, Show f, Show r) =>
Int
-> Int
-> Int
-> ((e, e) -> e)
-> Gr (Vtx v e r) (Face f)
-> Gr (Vtx v e r) (Face f)
unSplitEdgeInAdjRep (VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum VertexId' s
a) (VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum VertexId' s
b) (VertexId' s -> Int
forall a. Enum a => a -> Int
fromEnum VertexId' s
c) (e, e) -> e
f
  (Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f))
-> (PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f))
-> PlaneGraph s v e f r
-> Gr (Vtx v e r) (Face f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f)
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Gr (Vtx v e r) (Face f)
PG.toAdjRep


-------------
-- ADJREPS --
-------------

-- Gr
-- adjacencies :: [v]
-- faces :: [f]

-- Vtx
-- id :: Int
-- loc :: Point 2 r
-- adj :: [(Int, e)]
-- vData :: v

-- Face
-- incidentEdge :: (Int, Int)
-- fData :: f

--deriving instance (Show v, Show f) => Show (Gr v f)
--deriving instance (Show v, Show e, Show r) => Show (Vtx v e r)
--deriving instance Show f => Show (Face f)


-- instance {-# OVERLAPS #-} Show (VertexId s Primal) where show i = 'v' : show (fromEnum i)
-- instance {-# OVERLAPS #-} Show (FaceId   s Primal) where show i = 'f' : show (fromEnum i)
-- instance {-# OVERLAPS #-} Show (Dart s, v) where
--   show (Dart (Arc s) Positive, _) = 'd' : show (fromEnum s) ++ "+"
--   show (Dart (Arc s) Negative, _) = 'd' : show (fromEnum s) ++ "-"

-- instance Show f => Show (Face f) where show f = (show $ AR.fData f) ++ "~>" ++ (show $ incidentEdge f)
-- instance (Show e, Show r) => Show (Vtx v e r) where show v = (show $ AR.id v) ++ "~>" ++ (show $ adj v)
-- instance (Show v, Show f) => Show (Gr v f) where show g = "Gr " ++ (show $ adjacencies g) ++ " " ++ (show $ AR.faces g)

-- ik heb:
splitEdgeInAdjRep
  :: (Show v, Show e, Show f, Show r)
  => Int                     -- index van vertex a
  -> Int                     -- index van vertex b
  -> Point 2 r               -- locatie voor nieuwe vertex c
  -> v                       -- extra data voor vertex c
  -> (e -> (e, e))           -- functie om edge data in twee stukken te knippen
  -> Gr (Vtx v e r) (Face f) -- input graaf
  -> Gr (Vtx v e r) (Face f) -- output graaf

splitEdgeInAdjRep :: Int
-> Int
-> Point 2 r
-> v
-> (e -> (e, e))
-> Gr (Vtx v e r) (Face f)
-> Gr (Vtx v e r) (Face f)
splitEdgeInAdjRep Int
a Int
b Point 2 r
p v
v e -> (e, e)
f Gr (Vtx v e r) (Face f)
g =
  let n :: Int
n  = [Vtx v e r] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Vtx v e r] -> Int) -> [Vtx v e r] -> Int
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      -- first find vertices a and b
      oa :: Vtx v e r
oa = String -> [Vtx v e r] -> Vtx v e r
forall a. String -> [a] -> a
headTrace String
"splitEdgeInAdjRep oa" ([Vtx v e r] -> Vtx v e r) -> [Vtx v e r] -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ (Vtx v e r -> Bool) -> [Vtx v e r] -> [Vtx v e r]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
a) (Int -> Bool) -> (Vtx v e r -> Int) -> Vtx v e r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      ob :: Vtx v e r
ob = String -> [Vtx v e r] -> Vtx v e r
forall a. String -> [a] -> a
headTrace String
"splitEdgeInAdjRep ob" ([Vtx v e r] -> Vtx v e r) -> [Vtx v e r] -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ (Vtx v e r -> Bool) -> [Vtx v e r] -> [Vtx v e r]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b) (Int -> Bool) -> (Vtx v e r -> Int) -> Vtx v e r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      os :: [Vtx v e r]
os = (Vtx v e r -> Bool) -> [Vtx v e r] -> [Vtx v e r]
forall a. (a -> Bool) -> [a] -> [a]
filter (((Bool -> Bool -> Bool)
-> (Int -> Bool) -> (Int -> Bool) -> Int -> Bool
forall a b c d. (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c
lift Bool -> Bool -> Bool
(&&) (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
a) (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
b)) (Int -> Bool) -> (Vtx v e r -> Int) -> Vtx v e r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      -- find edge data
      e1 :: e
e1 = (Int, e) -> e
forall a b. (a, b) -> b
snd ((Int, e) -> e) -> (Int, e) -> e
forall a b. (a -> b) -> a -> b
$ String -> [(Int, e)] -> (Int, e)
forall a. String -> [a] -> a
headTrace String
"splitEdgeInAdjRep e1" ([(Int, e)] -> (Int, e)) -> [(Int, e)] -> (Int, e)
forall a b. (a -> b) -> a -> b
$ ((Int, e) -> Bool) -> [(Int, e)] -> [(Int, e)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [(Int, e)]
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
oa
      e2 :: e
e2 = (Int, e) -> e
forall a b. (a, b) -> b
snd ((Int, e) -> e) -> (Int, e) -> e
forall a b. (a -> b) -> a -> b
$ String -> [(Int, e)] -> (Int, e)
forall a. String -> [a] -> a
headTrace String
"splitEdgeInAdjRep e2" ([(Int, e)] -> (Int, e)) -> [(Int, e)] -> (Int, e)
forall a b. (a -> b) -> a -> b
$ ((Int, e) -> Bool) -> [(Int, e)] -> [(Int, e)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
a) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [(Int, e)]
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
ob
      -- create new adjacencies to c in a and b
      na :: Vtx v e r
na = Vtx v e r
oa {adj :: [(Int, e)]
adj = ((Int, e) -> Bool)
-> ((Int, e) -> (Int, e)) -> [(Int, e)] -> [(Int, e)]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
replace ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ((Int, e) -> (Int, e) -> (Int, e)
forall a b. a -> b -> a
const (Int
n, (e, e) -> e
forall a b. (a, b) -> a
fst ((e, e) -> e) -> (e, e) -> e
forall a b. (a -> b) -> a -> b
$ e -> (e, e)
f e
e1)) ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [(Int, e)]
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
oa}
      nb :: Vtx v e r
nb = Vtx v e r
ob {adj :: [(Int, e)]
adj = ((Int, e) -> Bool)
-> ((Int, e) -> (Int, e)) -> [(Int, e)] -> [(Int, e)]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
replace ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
a) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ((Int, e) -> (Int, e) -> (Int, e)
forall a b. a -> b -> a
const (Int
n, (e, e) -> e
forall a b. (a, b) -> a
fst ((e, e) -> e) -> (e, e) -> e
forall a b. (a -> b) -> a -> b
$ e -> (e, e)
f e
e2)) ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [(Int, e)]
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
ob}
      -- create new vertex c
      nc :: Vtx v e r
nc = Vtx :: forall v e r. Int -> Point 2 r -> [(Int, e)] -> v -> Vtx v e r
Vtx {id :: Int
AR.id = Int
n, loc :: Point 2 r
loc = Point 2 r
p, adj :: [(Int, e)]
adj = [(Int
a, (e, e) -> e
forall a b. (a, b) -> b
snd ((e, e) -> e) -> (e, e) -> e
forall a b. (a -> b) -> a -> b
$ e -> (e, e)
f e
e2), (Int
b, (e, e) -> e
forall a b. (a, b) -> b
snd ((e, e) -> e) -> (e, e) -> e
forall a b. (a -> b) -> a -> b
$ e -> (e, e)
f e
e1)], vData :: v
AR.vData = v
v}
      -- update faces (only if incidentEdge happens to point to ab)
      nf :: [Face f]
nf = (Face f -> Bool) -> (Face f -> Face f) -> [Face f] -> [Face f]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
replace (((Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
a, Int
b)) ((Int, Int) -> Bool) -> (Face f -> (Int, Int)) -> Face f -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Face f -> (Int, Int)
forall f. Face f -> (Int, Int)
incidentEdge) (\Face f
f -> Face f
f {incidentEdge :: (Int, Int)
incidentEdge = (Int
a, Int
n)})
         ([Face f] -> [Face f]) -> [Face f] -> [Face f]
forall a b. (a -> b) -> a -> b
$ (Face f -> Bool) -> (Face f -> Face f) -> [Face f] -> [Face f]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
replace (((Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
b, Int
a)) ((Int, Int) -> Bool) -> (Face f -> (Int, Int)) -> Face f -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Face f -> (Int, Int)
forall f. Face f -> (Int, Int)
incidentEdge) (\Face f
f -> Face f
f {incidentEdge :: (Int, Int)
incidentEdge = (Int
b, Int
n)})
         ([Face f] -> [Face f]) -> [Face f] -> [Face f]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Face f]
forall v f. Gr v f -> [f]
AR.faces Gr (Vtx v e r) (Face f)
g
  in String -> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a. Show a => String -> a -> a
tr String
"splitEdgeInAdjRep" (Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f))
-> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a b. (a -> b) -> a -> b
$ (String -> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a. Show a => String -> a -> a
tr String
"original" Gr (Vtx v e r) (Face f)
g) {adjacencies :: [Vtx v e r]
adjacencies = (Vtx v e r -> Int) -> [Vtx v e r] -> [Vtx v e r]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Vtx v e r
na Vtx v e r -> [Vtx v e r] -> [Vtx v e r]
forall a. a -> [a] -> [a]
: Vtx v e r
nb Vtx v e r -> [Vtx v e r] -> [Vtx v e r]
forall a. a -> [a] -> [a]
: Vtx v e r
nc Vtx v e r -> [Vtx v e r] -> [Vtx v e r]
forall a. a -> [a] -> [a]
: [Vtx v e r]
os, faces :: [Face f]
AR.faces = [Face f]
nf}


sproutInAdjRep
  :: (Show v, Show e, Show f, Show r)
  => Int                     -- index van vertex a
  -> Int                     -- index van vertex c (andere kant van edge a)
  -> Point 2 r               -- locatie voor nieuwe vertex c
  -> v                       -- extra data voor vertex c
  -> (e, e)                  -- extra data voor nieuwe edge
  -> Gr (Vtx v e r) (Face f) -- input graaf
  -> Gr (Vtx v e r) (Face f) -- output graaf

sproutInAdjRep :: Int
-> Int
-> Point 2 r
-> v
-> (e, e)
-> Gr (Vtx v e r) (Face f)
-> Gr (Vtx v e r) (Face f)
sproutInAdjRep Int
a Int
c Point 2 r
p v
v (e, e)
e Gr (Vtx v e r) (Face f)
g =
  let n :: Int
n  = [Vtx v e r] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Vtx v e r] -> Int) -> [Vtx v e r] -> Int
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      -- first find vertex a
      oa :: Vtx v e r
oa = String -> Vtx v e r -> Vtx v e r
forall a. Show a => String -> a -> a
tr String
"oa" (Vtx v e r -> Vtx v e r) -> Vtx v e r -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ String -> [Vtx v e r] -> Vtx v e r
forall a. String -> [a] -> a
headTrace String
"sproutInAdjRep oa" ([Vtx v e r] -> Vtx v e r) -> [Vtx v e r] -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ (Vtx v e r -> Bool) -> [Vtx v e r] -> [Vtx v e r]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
a) (Int -> Bool) -> (Vtx v e r -> Int) -> Vtx v e r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      os :: [Vtx v e r]
os = String -> [Vtx v e r] -> [Vtx v e r]
forall a. Show a => String -> a -> a
tr String
"os" ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ (Vtx v e r -> Bool) -> [Vtx v e r] -> [Vtx v e r]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
a) (Int -> Bool) -> (Vtx v e r -> Int) -> Vtx v e r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      -- need to find index of c
      fj :: Maybe p -> p
fj (Just p
x) = p
x
      fj Maybe p
Nothing  = String -> p
forall a. HasCallStack => String -> a
error String
"splitFaceInAdjRep got Nothing"
      ci :: Int
ci = String -> Int -> Int
forall a. Show a => String -> a -> a
tr String
"ci" (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int
forall p. Maybe p -> p
fj (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, e) -> Bool) -> [(Int, e)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ([(Int, e)] -> Maybe Int) -> [(Int, e)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
oa
      -- create new adjacency to new vertex z in a
      na :: Vtx v e r
na = String -> Vtx v e r -> Vtx v e r
forall a. Show a => String -> a -> a
tr String
"na" (Vtx v e r -> Vtx v e r) -> Vtx v e r -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ Vtx v e r
oa {adj :: [(Int, e)]
adj = Int -> [(Int, e)] -> [(Int, e)]
forall a. Int -> [a] -> [a]
take Int
ci (Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
oa) [(Int, e)] -> [(Int, e)] -> [(Int, e)]
forall a. [a] -> [a] -> [a]
++ (Int
n, (e, e) -> e
forall a b. (a, b) -> a
fst (e, e)
e) (Int, e) -> [(Int, e)] -> [(Int, e)]
forall a. a -> [a] -> [a]
: Int -> [(Int, e)] -> [(Int, e)]
forall a. Int -> [a] -> [a]
drop Int
ci (Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
oa)}
      -- create new vertex z
      nz :: Vtx v e r
nz = Vtx :: forall v e r. Int -> Point 2 r -> [(Int, e)] -> v -> Vtx v e r
Vtx {id :: Int
AR.id = Int
n, loc :: Point 2 r
loc = Point 2 r
p, adj :: [(Int, e)]
adj = [(Int
a, (e, e) -> e
forall a b. (a, b) -> b
snd (e, e)
e)], vData :: v
AR.vData = v
v}
  in String -> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a. Show a => String -> a -> a
tr String
"splitFaceInAdjRep" (Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f))
-> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a b. (a -> b) -> a -> b
$ (String -> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a. Show a => String -> a -> a
tr String
"original" Gr (Vtx v e r) (Face f)
g) {adjacencies :: [Vtx v e r]
adjacencies = (Vtx v e r -> Int) -> [Vtx v e r] -> [Vtx v e r]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Vtx v e r
na Vtx v e r -> [Vtx v e r] -> [Vtx v e r]
forall a. a -> [a] -> [a]
: Vtx v e r
nz Vtx v e r -> [Vtx v e r] -> [Vtx v e r]
forall a. a -> [a] -> [a]
: [Vtx v e r]
os}

splitFaceInAdjRep
  :: (Show v, Show e, Show f, Show r)
  => Int                     -- index van vertex a
  -> Int                     -- index van vertex b
  -> Int                     -- index van vertex c (andere kant van edge a)
  -> Int                     -- index van vertex d (andere kant van edge b)
  -> Int                     -- index van face edge start
  -> Int                     -- index van face edge eind
  -> (e, e)                  -- extra data voor nieuwe edge ab
  -> (f -> (f, f))           -- functie om face data in twee stukken te knippen
  -> Gr (Vtx v e r) (Face f) -- input graaf
  -> Gr (Vtx v e r) (Face f) -- output graaf

-- is it easier to split a vertex than a face?

splitFaceInAdjRep :: Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> (e, e)
-> (f -> (f, f))
-> Gr (Vtx v e r) (Face f)
-> Gr (Vtx v e r) (Face f)
splitFaceInAdjRep Int
a Int
b Int
c Int
d Int
u Int
v (e, e)
e f -> (f, f)
f Gr (Vtx v e r) (Face f)
g =
  let
      -- first find vertices a and b
      oa :: Vtx v e r
oa = String -> Vtx v e r -> Vtx v e r
forall a. Show a => String -> a -> a
tr String
"oa" (Vtx v e r -> Vtx v e r) -> Vtx v e r -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ String -> [Vtx v e r] -> Vtx v e r
forall a. String -> [a] -> a
headTrace String
"splitFaceInAdjRep oa" ([Vtx v e r] -> Vtx v e r) -> [Vtx v e r] -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ (Vtx v e r -> Bool) -> [Vtx v e r] -> [Vtx v e r]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
a) (Int -> Bool) -> (Vtx v e r -> Int) -> Vtx v e r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      ob :: Vtx v e r
ob = String -> Vtx v e r -> Vtx v e r
forall a. Show a => String -> a -> a
tr String
"ob" (Vtx v e r -> Vtx v e r) -> Vtx v e r -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ String -> [Vtx v e r] -> Vtx v e r
forall a. String -> [a] -> a
headTrace String
"splitFaceInAdjRep ob" ([Vtx v e r] -> Vtx v e r) -> [Vtx v e r] -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ (Vtx v e r -> Bool) -> [Vtx v e r] -> [Vtx v e r]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b) (Int -> Bool) -> (Vtx v e r -> Int) -> Vtx v e r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      os :: [Vtx v e r]
os = String -> [Vtx v e r] -> [Vtx v e r]
forall a. Show a => String -> a -> a
tr String
"os" ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ (Vtx v e r -> Bool) -> [Vtx v e r] -> [Vtx v e r]
forall a. (a -> Bool) -> [a] -> [a]
filter (((Bool -> Bool -> Bool)
-> (Int -> Bool) -> (Int -> Bool) -> Int -> Bool
forall a b c d. (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c
lift Bool -> Bool -> Bool
(&&) (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
a) (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
b)) (Int -> Bool) -> (Vtx v e r -> Int) -> Vtx v e r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      -- insert new adjacency between a and b
      fj :: Maybe p -> p
fj (Just p
x) = p
x
      fj Maybe p
Nothing  = String -> p
forall a. HasCallStack => String -> a
error String
"splitFaceInAdjRep got Nothing"
      -- need to find indices c and d!
      ci :: Int
ci = String -> Int -> Int
forall a. Show a => String -> a -> a
tr String
"ci" (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int
forall p. Maybe p -> p
fj (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, e) -> Bool) -> [(Int, e)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ([(Int, e)] -> Maybe Int) -> [(Int, e)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
oa
      di :: Int
di = String -> Int -> Int
forall a. Show a => String -> a -> a
tr String
"di" (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int
forall p. Maybe p -> p
fj (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, e) -> Bool) -> [(Int, e)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
d) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ([(Int, e)] -> Maybe Int) -> [(Int, e)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
ob
      -- insert new adjacencies to each other in a and b
      na :: Vtx v e r
na = String -> Vtx v e r -> Vtx v e r
forall a. Show a => String -> a -> a
tr String
"na" (Vtx v e r -> Vtx v e r) -> Vtx v e r -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ Vtx v e r
oa {adj :: [(Int, e)]
adj = Int -> [(Int, e)] -> [(Int, e)]
forall a. Int -> [a] -> [a]
take Int
ci (Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
oa) [(Int, e)] -> [(Int, e)] -> [(Int, e)]
forall a. [a] -> [a] -> [a]
++ (Int
b, (e, e) -> e
forall a b. (a, b) -> a
fst (e, e)
e) (Int, e) -> [(Int, e)] -> [(Int, e)]
forall a. a -> [a] -> [a]
: Int -> [(Int, e)] -> [(Int, e)]
forall a. Int -> [a] -> [a]
drop Int
ci (Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
oa)}
      nb :: Vtx v e r
nb = String -> Vtx v e r -> Vtx v e r
forall a. Show a => String -> a -> a
tr String
"nb" (Vtx v e r -> Vtx v e r) -> Vtx v e r -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ Vtx v e r
ob {adj :: [(Int, e)]
adj = Int -> [(Int, e)] -> [(Int, e)]
forall a. Int -> [a] -> [a]
take Int
di (Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
ob) [(Int, e)] -> [(Int, e)] -> [(Int, e)]
forall a. [a] -> [a] -> [a]
++ (Int
a, (e, e) -> e
forall a b. (a, b) -> b
snd (e, e)
e) (Int, e) -> [(Int, e)] -> [(Int, e)]
forall a. a -> [a] -> [a]
: Int -> [(Int, e)] -> [(Int, e)]
forall a. Int -> [a] -> [a]
drop Int
di (Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
ob)}
      -- find the face that is incident to both a and b
      i :: Int
i  = String -> Int -> Int
forall a. Show a => String -> a -> a
tr String
"i"  (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int
forall p. Maybe p -> p
fj (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Face f -> Bool) -> [Face f] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (((Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
u, Int
v)) ((Int, Int) -> Bool) -> (Face f -> (Int, Int)) -> Face f -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Face f -> (Int, Int)
forall f. Face f -> (Int, Int)
incidentEdge) ([Face f] -> Maybe Int) -> [Face f] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Face f]
forall v f. Gr v f -> [f]
AR.faces Gr (Vtx v e r) (Face f)
g
      fd :: f
fd = String -> f -> f
forall a. Show a => String -> a -> a
tr String
"fd" (f -> f) -> f -> f
forall a b. (a -> b) -> a -> b
$ Face f -> f
forall f. Face f -> f
AR.fData (Face f -> f) -> Face f -> f
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Face f]
forall v f. Gr v f -> [f]
AR.faces Gr (Vtx v e r) (Face f)
g [Face f] -> Int -> Face f
forall a. [a] -> Int -> a
!! Int
i
      ef :: [Face f]
ef = String -> [Face f] -> [Face f]
forall a. Show a => String -> a -> a
tr String
"ef" ([Face f] -> [Face f]) -> [Face f] -> [Face f]
forall a b. (a -> b) -> a -> b
$ Int -> [Face f] -> [Face f]
forall a. Int -> [a] -> [a]
take Int
i (Gr (Vtx v e r) (Face f) -> [Face f]
forall v f. Gr v f -> [f]
AR.faces Gr (Vtx v e r) (Face f)
g) [Face f] -> [Face f] -> [Face f]
forall a. [a] -> [a] -> [a]
++ Int -> [Face f] -> [Face f]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Gr (Vtx v e r) (Face f) -> [Face f]
forall v f. Gr v f -> [f]
AR.faces Gr (Vtx v e r) (Face f)
g)
      f1 :: Face f
f1 = String -> Face f -> Face f
forall a. Show a => String -> a -> a
tr String
"f1" (Face f -> Face f) -> Face f -> Face f
forall a b. (a -> b) -> a -> b
$ Face :: forall f. (Int, Int) -> f -> Face f
AR.Face {incidentEdge :: (Int, Int)
incidentEdge = (Int
a, Int
b), fData :: f
AR.fData = (f, f) -> f
forall a b. (a, b) -> a
fst ((f, f) -> f) -> (f, f) -> f
forall a b. (a -> b) -> a -> b
$ f -> (f, f)
f f
fd}
      f2 :: Face f
f2 = String -> Face f -> Face f
forall a. Show a => String -> a -> a
tr String
"f2" (Face f -> Face f) -> Face f -> Face f
forall a b. (a -> b) -> a -> b
$ Face :: forall f. (Int, Int) -> f -> Face f
AR.Face {incidentEdge :: (Int, Int)
incidentEdge = (Int
b, Int
a), fData :: f
AR.fData = (f, f) -> f
forall a b. (a, b) -> b
snd ((f, f) -> f) -> (f, f) -> f
forall a b. (a -> b) -> a -> b
$ f -> (f, f)
f f
fd}
  in String -> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a. Show a => String -> a -> a
tr String
"splitFaceInAdjRep" (Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f))
-> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a b. (a -> b) -> a -> b
$ (String -> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a. Show a => String -> a -> a
tr String
"original" Gr (Vtx v e r) (Face f)
g) {adjacencies :: [Vtx v e r]
adjacencies = (Vtx v e r -> Int) -> [Vtx v e r] -> [Vtx v e r]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Vtx v e r
na Vtx v e r -> [Vtx v e r] -> [Vtx v e r]
forall a. a -> [a] -> [a]
: Vtx v e r
nb Vtx v e r -> [Vtx v e r] -> [Vtx v e r]
forall a. a -> [a] -> [a]
: [Vtx v e r]
os, faces :: [Face f]
AR.faces = [Face f]
ef [Face f] -> [Face f] -> [Face f]
forall a. [a] -> [a] -> [a]
++ [Face f
f1, Face f
f2]}





unSplitEdgeInAdjRep
  :: (Show v, Show e, Show f, Show r)
  => Int                     -- index van vertex a
  -> Int                     -- index van vertex b (te verwijderen)
  -> Int                     -- index van vertex c
  -> ((e, e) -> e)           -- functie om edge data te mergen
  -> Gr (Vtx v e r) (Face f) -- input graaf
  -> Gr (Vtx v e r) (Face f) -- output graaf

unSplitEdgeInAdjRep :: Int
-> Int
-> Int
-> ((e, e) -> e)
-> Gr (Vtx v e r) (Face f)
-> Gr (Vtx v e r) (Face f)
unSplitEdgeInAdjRep Int
a Int
b Int
c (e, e) -> e
f Gr (Vtx v e r) (Face f)
g =
  let n :: Int
n  = [Vtx v e r] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Vtx v e r] -> Int) -> [Vtx v e r] -> Int
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      -- first find vertices a, b and c
      oa :: Vtx v e r
oa = [Vtx v e r] -> Vtx v e r
forall a. [a] -> a
head ([Vtx v e r] -> Vtx v e r) -> [Vtx v e r] -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ (Vtx v e r -> Bool) -> [Vtx v e r] -> [Vtx v e r]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
a) (Int -> Bool) -> (Vtx v e r -> Int) -> Vtx v e r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      ob :: Vtx v e r
ob = [Vtx v e r] -> Vtx v e r
forall a. [a] -> a
head ([Vtx v e r] -> Vtx v e r) -> [Vtx v e r] -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ (Vtx v e r -> Bool) -> [Vtx v e r] -> [Vtx v e r]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b) (Int -> Bool) -> (Vtx v e r -> Int) -> Vtx v e r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      oc :: Vtx v e r
oc = [Vtx v e r] -> Vtx v e r
forall a. [a] -> a
head ([Vtx v e r] -> Vtx v e r) -> [Vtx v e r] -> Vtx v e r
forall a b. (a -> b) -> a -> b
$ (Vtx v e r -> Bool) -> [Vtx v e r] -> [Vtx v e r]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c) (Int -> Bool) -> (Vtx v e r -> Int) -> Vtx v e r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      os :: [Vtx v e r]
os = (Vtx v e r -> Bool) -> [Vtx v e r] -> [Vtx v e r]
forall a. (a -> Bool) -> [a] -> [a]
filter ((\Int
i -> Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
a Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
b Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
c) (Int -> Bool) -> (Vtx v e r -> Int) -> Vtx v e r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
      -- find edge data
      eab :: e
eab = (Int, e) -> e
forall a b. (a, b) -> b
snd ((Int, e) -> e) -> (Int, e) -> e
forall a b. (a -> b) -> a -> b
$ [(Int, e)] -> (Int, e)
forall a. [a] -> a
head ([(Int, e)] -> (Int, e)) -> [(Int, e)] -> (Int, e)
forall a b. (a -> b) -> a -> b
$ ((Int, e) -> Bool) -> [(Int, e)] -> [(Int, e)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [(Int, e)]
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
oa
      eba :: e
eba = (Int, e) -> e
forall a b. (a, b) -> b
snd ((Int, e) -> e) -> (Int, e) -> e
forall a b. (a -> b) -> a -> b
$ [(Int, e)] -> (Int, e)
forall a. [a] -> a
head ([(Int, e)] -> (Int, e)) -> [(Int, e)] -> (Int, e)
forall a b. (a -> b) -> a -> b
$ ((Int, e) -> Bool) -> [(Int, e)] -> [(Int, e)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
a) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [(Int, e)]
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
ob
      ebc :: e
ebc = (Int, e) -> e
forall a b. (a, b) -> b
snd ((Int, e) -> e) -> (Int, e) -> e
forall a b. (a -> b) -> a -> b
$ [(Int, e)] -> (Int, e)
forall a. [a] -> a
head ([(Int, e)] -> (Int, e)) -> [(Int, e)] -> (Int, e)
forall a b. (a -> b) -> a -> b
$ ((Int, e) -> Bool) -> [(Int, e)] -> [(Int, e)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [(Int, e)]
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
ob
      ecb :: e
ecb = (Int, e) -> e
forall a b. (a, b) -> b
snd ((Int, e) -> e) -> (Int, e) -> e
forall a b. (a -> b) -> a -> b
$ [(Int, e)] -> (Int, e)
forall a. [a] -> a
head ([(Int, e)] -> (Int, e)) -> [(Int, e)] -> (Int, e)
forall a b. (a -> b) -> a -> b
$ ((Int, e) -> Bool) -> [(Int, e)] -> [(Int, e)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [(Int, e)]
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
oc
      -- create new adjacencies between a and c
      na :: Vtx v e r
na = Vtx v e r
oa {adj :: [(Int, e)]
adj = ((Int, e) -> Bool)
-> ((Int, e) -> (Int, e)) -> [(Int, e)] -> [(Int, e)]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
replace ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ((Int, e) -> (Int, e) -> (Int, e)
forall a b. a -> b -> a
const (Int
c, (e, e) -> e
f (e
eab, e
ebc))) ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [(Int, e)]
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
oa}
      nc :: Vtx v e r
nc = Vtx v e r
oc {adj :: [(Int, e)]
adj = ((Int, e) -> Bool)
-> ((Int, e) -> (Int, e)) -> [(Int, e)] -> [(Int, e)]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
replace ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) ((Int, e) -> (Int, e) -> (Int, e)
forall a b. a -> b -> a
const (Int
a, (e, e) -> e
f (e
ecb, e
eba))) ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [(Int, e)]
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
oc}
      nv :: [Vtx v e r]
nv = (Vtx v e r -> Int) -> [Vtx v e r] -> [Vtx v e r]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Vtx v e r
na Vtx v e r -> [Vtx v e r] -> [Vtx v e r]
forall a. a -> [a] -> [a]
: Vtx v e r
nc Vtx v e r -> [Vtx v e r] -> [Vtx v e r]
forall a. a -> [a] -> [a]
: [Vtx v e r]
os
      -- update faces (only if incidentEdge happens to point to ab or bc)
      nf :: [Face f]
nf = (Face f -> Bool) -> (Face f -> Face f) -> [Face f] -> [Face f]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
replace (((Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
a, Int
b)) ((Int, Int) -> Bool) -> (Face f -> (Int, Int)) -> Face f -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Face f -> (Int, Int)
forall f. Face f -> (Int, Int)
incidentEdge) (\Face f
f -> Face f
f {incidentEdge :: (Int, Int)
incidentEdge = (Int
a, Int
c)})
         ([Face f] -> [Face f]) -> [Face f] -> [Face f]
forall a b. (a -> b) -> a -> b
$ (Face f -> Bool) -> (Face f -> Face f) -> [Face f] -> [Face f]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
replace (((Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
b, Int
a)) ((Int, Int) -> Bool) -> (Face f -> (Int, Int)) -> Face f -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Face f -> (Int, Int)
forall f. Face f -> (Int, Int)
incidentEdge) (\Face f
f -> Face f
f {incidentEdge :: (Int, Int)
incidentEdge = (Int
c, Int
a)})
         ([Face f] -> [Face f]) -> [Face f] -> [Face f]
forall a b. (a -> b) -> a -> b
$ (Face f -> Bool) -> (Face f -> Face f) -> [Face f] -> [Face f]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
replace (((Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
b, Int
c)) ((Int, Int) -> Bool) -> (Face f -> (Int, Int)) -> Face f -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Face f -> (Int, Int)
forall f. Face f -> (Int, Int)
incidentEdge) (\Face f
f -> Face f
f {incidentEdge :: (Int, Int)
incidentEdge = (Int
a, Int
c)})
         ([Face f] -> [Face f]) -> [Face f] -> [Face f]
forall a b. (a -> b) -> a -> b
$ (Face f -> Bool) -> (Face f -> Face f) -> [Face f] -> [Face f]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
replace (((Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
c, Int
b)) ((Int, Int) -> Bool) -> (Face f -> (Int, Int)) -> Face f -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Face f -> (Int, Int)
forall f. Face f -> (Int, Int)
incidentEdge) (\Face f
f -> Face f
f {incidentEdge :: (Int, Int)
incidentEdge = (Int
c, Int
a)})
         ([Face f] -> [Face f]) -> [Face f] -> [Face f]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Face f]
forall v f. Gr v f -> [f]
AR.faces Gr (Vtx v e r) (Face f)
g
      -- restore consecutive numbering: replace vertex n-1 by b
      ng :: Gr (Vtx v e r) (Face f)
ng = Int -> Int -> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall v e r f.
Int -> Int -> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
replaceIndex (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
b (Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f))
-> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a b. (a -> b) -> a -> b
$ (String -> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a. Show a => String -> a -> a
tr String
"original" Gr (Vtx v e r) (Face f)
g) {adjacencies :: [Vtx v e r]
adjacencies = [Vtx v e r]
nv, faces :: [Face f]
AR.faces = [Face f]
nf}
  in String -> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a. Show a => String -> a -> a
tr String
"unSplitEdgeInAdjRep" (Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f))
-> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f)
ng

-- Gr
-- adjacencies :: [v]
-- faces :: [f]

-- Vtx
-- id :: Int
-- loc :: Point 2 r
-- adj :: [(Int, e)]
-- vData :: v

-- Face
-- incidentEdge :: (Int, Int)
-- fData :: f

replaceIndex :: Int -> Int -> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
replaceIndex :: Int -> Int -> Gr (Vtx v e r) (Face f) -> Gr (Vtx v e r) (Face f)
replaceIndex Int
i Int
j Gr (Vtx v e r) (Face f)
g = Gr (Vtx v e r) (Face f)
g { adjacencies :: [Vtx v e r]
adjacencies = (Vtx v e r -> Vtx v e r) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Vtx v e r -> Vtx v e r
forall v e r. Int -> Int -> Vtx v e r -> Vtx v e r
replaceIndexAdjacency Int
i Int
j) ([Vtx v e r] -> [Vtx v e r]) -> [Vtx v e r] -> [Vtx v e r]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Vtx v e r]
forall v f. Gr v f -> [v]
adjacencies Gr (Vtx v e r) (Face f)
g
                       , faces :: [Face f]
AR.faces    = (Face f -> Face f) -> [Face f] -> [Face f]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Face f -> Face f
forall f. Int -> Int -> Face f -> Face f
replaceIndexFace      Int
i Int
j) ([Face f] -> [Face f]) -> [Face f] -> [Face f]
forall a b. (a -> b) -> a -> b
$ Gr (Vtx v e r) (Face f) -> [Face f]
forall v f. Gr v f -> [f]
AR.faces    Gr (Vtx v e r) (Face f)
g
                       }

replaceIndexAdjacency :: Int -> Int -> Vtx v e r -> Vtx v e r
replaceIndexAdjacency :: Int -> Int -> Vtx v e r -> Vtx v e r
replaceIndexAdjacency Int
i Int
j Vtx v e r
v = Vtx v e r
v { id :: Int
AR.id = if Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id Vtx v e r
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i then Int
j else Vtx v e r -> Int
forall v e r. Vtx v e r -> Int
AR.id Vtx v e r
v
                                , adj :: [(Int, e)]
adj   = ((Int, e) -> Bool)
-> ((Int, e) -> (Int, e)) -> [(Int, e)] -> [(Int, e)]
forall a. (a -> Bool) -> (a -> a) -> [a] -> [a]
replace ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i) (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) (ASetter (Int, e) (Int, e) Int Int -> Int -> (Int, e) -> (Int, e)
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Int, e) (Int, e) Int Int
forall s t a b. Field1 s t a b => Lens s t a b
_1 Int
j) ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [(Int, e)]
forall a b. (a -> b) -> a -> b
$ Vtx v e r -> [(Int, e)]
forall v e r. Vtx v e r -> [(Int, e)]
adj Vtx v e r
v
                                }

replaceIndexFace :: Int -> Int -> Face f -> Face f
replaceIndexFace :: Int -> Int -> Face f -> Face f
replaceIndexFace Int
i Int
j Face f
f | (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Face f -> (Int, Int)
forall f. Face f -> (Int, Int)
incidentEdge Face f
f) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i = Face f
f {incidentEdge :: (Int, Int)
incidentEdge = Face f -> (Int, Int)
forall f. Face f -> (Int, Int)
incidentEdge Face f
f (Int, Int) -> ((Int, Int) -> (Int, Int)) -> (Int, Int)
forall a b. a -> (a -> b) -> b
& ASetter (Int, Int) (Int, Int) Int Int
-> Int -> (Int, Int) -> (Int, Int)
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Int, Int) (Int, Int) Int Int
forall s t a b. Field1 s t a b => Lens s t a b
_1 Int
j}
                       | (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Face f -> (Int, Int)
forall f. Face f -> (Int, Int)
incidentEdge Face f
f) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i = Face f
f {incidentEdge :: (Int, Int)
incidentEdge = Face f -> (Int, Int)
forall f. Face f -> (Int, Int)
incidentEdge Face f
f (Int, Int) -> ((Int, Int) -> (Int, Int)) -> (Int, Int)
forall a b. a -> (a -> b) -> b
& ASetter (Int, Int) (Int, Int) Int Int
-> Int -> (Int, Int) -> (Int, Int)
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Int, Int) (Int, Int) Int Int
forall s t a b. Field2 s t a b => Lens s t a b
_2 Int
j}
                       | Bool
otherwise = Face f
f


-------------
-- HELPERS --
-------------

replace :: (a -> Bool) -> (a -> a) -> [a] -> [a]
replace :: (a -> Bool) -> (a -> a) -> [a] -> [a]
replace a -> Bool
f a -> a
g = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> a) -> [a] -> [a]) -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> (a -> a) -> a -> a
forall a. (a -> Bool) -> (a -> a) -> a -> a
replace' a -> Bool
f a -> a
g

replace' :: (a -> Bool) -> (a -> a) -> a -> a
replace' :: (a -> Bool) -> (a -> a) -> a -> a
replace' a -> Bool
f a -> a
g a
x | a -> Bool
f a
x = a -> a
g a
x
               | Bool
otherwise = a
x

lift :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c
lift :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c
lift a -> b -> c
f d -> a
g d -> b
h d
x = a -> b -> c
f (d -> a
g d
x) (d -> b
h d
x)



headTrace :: String -> [a] -> a
headTrace :: String -> [a] -> a
headTrace String
s [a]
xs | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs   = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": head of empty list"
               | Bool
otherwise = [a] -> a
forall a. [a] -> a
head [a]
xs