module Tgraph.Force
(
touchCheck
, BoundaryState(..)
, makeBoundaryState
, recoverGraph
, changeVFMap
, facesAtBV
, boundaryFaces
, Update(..)
, UpdateMap
, ForceState(..)
, UpdateGenerator
, Forcible(..)
, tryForceWith
, tryStepForceWith
, tryFSOp
, tryForce
, force
, wholeTiles
, forceWith
, tryInitFS
, initFS
, tryStepForce
, stepForce
, tryChangeBoundary
, addHalfKite
, tryAddHalfKite
, addHalfDart
, tryAddHalfDart
, tryOneStepWith
, tryOneStepF
, BoundaryChange(..)
, affectedBoundary
, tryReviseUpdates
, tryReviseFSWith
, findSafeUpdate
, tryUnsafes
, checkUnsafeUpdate
, trySafeUpdate
, tryUpdate
, recalculateBVLocs
, tryRecalibratingForce
, recalibratingForce
, defaultAllUGen
, allUGenerator
, UFinder
, UChecker
, boundaryFilter
, makeUpdate
, makeGenerator
, mustbeStar
, mustbeSun
, mustbeDeuce
, mustbeKing
, isKiteWing
, isKiteOppV
, isDartOrigin
, mustbeQueen
, kiteWingCount
, mustbeJack
, wholeTileUpdates
, incompleteHalves
, aceKiteUpdates
, nonKDarts
, queenOrKingUpdates
, kitesWingDartOrigin
, deuceDartUpdates
, kiteGaps
, jackDartUpdates
, noTouchingDart
, sunStarUpdates
, almostSunStar
, jackKiteUpdates
, jackMissingKite
, kingDartUpdates
, kingMissingThirdDart
, queenDartUpdates
, queenMissingDarts
, queenKiteUpdates
, queenMissingKite
, completeHalf
, addKiteShortE
, addDartShortE
, completeSunStar
, addKiteLongE
, addDartLongE
, tryFindThirdV
, externalAngle
) where
import Data.List ((\\), intersect, nub, find,foldl')
import qualified Data.Map as Map (Map, empty, delete, elems, insert, union, keys)
import qualified Data.IntMap.Strict as VMap (elems, filterWithKey, alter, delete, lookup, (!))
import Diagrams.Prelude (Point, V2)
import Tgraph.Prelude
touchCheck:: Point V2 Double -> VertexMap (Point V2 Double) -> Bool
touchCheck :: Point V2 Double -> VertexMap (Point V2 Double) -> Bool
touchCheck Point V2 Double
p VertexMap (Point V2 Double)
vpMap = (Point V2 Double -> Bool) -> [Point V2 Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Point V2 Double -> Point V2 Double -> Bool
touching Point V2 Double
p) (VertexMap (Point V2 Double) -> [Point V2 Double]
forall a. IntMap a -> [a]
VMap.elems VertexMap (Point V2 Double)
vpMap)
data BoundaryState
= BoundaryState
{ BoundaryState -> [(Vertex, Vertex)]
boundary:: [Dedge]
, BoundaryState -> VertexMap [TileFace]
bvFacesMap:: VertexMap [TileFace]
, BoundaryState -> VertexMap (Point V2 Double)
bvLocMap:: VertexMap (Point V2 Double)
, BoundaryState -> [TileFace]
allFaces:: [TileFace]
, BoundaryState -> Vertex
nextVertex:: Vertex
} deriving (Vertex -> BoundaryState -> ShowS
[BoundaryState] -> ShowS
BoundaryState -> String
(Vertex -> BoundaryState -> ShowS)
-> (BoundaryState -> String)
-> ([BoundaryState] -> ShowS)
-> Show BoundaryState
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Vertex -> BoundaryState -> ShowS
showsPrec :: Vertex -> BoundaryState -> ShowS
$cshow :: BoundaryState -> String
show :: BoundaryState -> String
$cshowList :: [BoundaryState] -> ShowS
showList :: [BoundaryState] -> ShowS
Show)
makeBoundaryState:: Tgraph -> BoundaryState
makeBoundaryState :: Tgraph -> BoundaryState
makeBoundaryState Tgraph
g =
let bdes :: [(Vertex, Vertex)]
bdes = Tgraph -> [(Vertex, Vertex)]
graphBoundary Tgraph
g
bvs :: [Vertex]
bvs = ((Vertex, Vertex) -> Vertex) -> [(Vertex, Vertex)] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst [(Vertex, Vertex)]
bdes
bvLocs :: VertexMap (Point V2 Double)
bvLocs = (Vertex -> Point V2 Double -> Bool)
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double)
forall a. (Vertex -> a -> Bool) -> IntMap a -> IntMap a
VMap.filterWithKey (\Vertex
k Point V2 Double
_ -> Vertex
k Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Vertex]
bvs) (VertexMap (Point V2 Double) -> VertexMap (Point V2 Double))
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double)
forall a b. (a -> b) -> a -> b
$ [TileFace] -> VertexMap (Point V2 Double)
locateVertices ([TileFace] -> VertexMap (Point V2 Double))
-> [TileFace] -> VertexMap (Point V2 Double)
forall a b. (a -> b) -> a -> b
$ Tgraph -> [TileFace]
faces Tgraph
g
in if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Vertex] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Vertex] -> Bool) -> [Vertex] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Vertex, Vertex)] -> [Vertex]
crossingVertices [(Vertex, Vertex)]
bdes then String -> BoundaryState
forall a. HasCallStack => String -> a
error (String -> BoundaryState) -> String -> BoundaryState
forall a b. (a -> b) -> a -> b
$ String
"makeBoundaryState: found crossing boundary in faces:\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++[TileFace] -> String
forall a. Show a => a -> String
show (Tgraph -> [TileFace]
faces Tgraph
g)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n"
else
BoundaryState
{ boundary :: [(Vertex, Vertex)]
boundary = [(Vertex, Vertex)]
bdes
, bvFacesMap :: VertexMap [TileFace]
bvFacesMap = [Vertex] -> [TileFace] -> VertexMap [TileFace]
vertexFacesMap [Vertex]
bvs (Tgraph -> [TileFace]
faces Tgraph
g)
, bvLocMap :: VertexMap (Point V2 Double)
bvLocMap = VertexMap (Point V2 Double)
bvLocs
, allFaces :: [TileFace]
allFaces = Tgraph -> [TileFace]
faces Tgraph
g
, nextVertex :: Vertex
nextVertex = Vertex
1Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+ Tgraph -> Vertex
maxV Tgraph
g
}
recoverGraph:: BoundaryState -> Tgraph
recoverGraph :: BoundaryState -> Tgraph
recoverGraph BoundaryState
bd = [TileFace] -> Tgraph
makeUncheckedTgraph (BoundaryState -> [TileFace]
allFaces BoundaryState
bd)
changeVFMap:: TileFace -> VertexMap [TileFace] -> VertexMap [TileFace]
changeVFMap :: TileFace -> VertexMap [TileFace] -> VertexMap [TileFace]
changeVFMap TileFace
f VertexMap [TileFace]
vfm = (VertexMap [TileFace] -> Vertex -> VertexMap [TileFace])
-> VertexMap [TileFace] -> [Vertex] -> VertexMap [TileFace]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' VertexMap [TileFace] -> Vertex -> VertexMap [TileFace]
insertf VertexMap [TileFace]
vfm (TileFace -> [Vertex]
faceVList TileFace
f) where
insertf :: VertexMap [TileFace] -> Vertex -> VertexMap [TileFace]
insertf VertexMap [TileFace]
vmap Vertex
v = (Maybe [TileFace] -> Maybe [TileFace])
-> Vertex -> VertexMap [TileFace] -> VertexMap [TileFace]
forall a. (Maybe a -> Maybe a) -> Vertex -> IntMap a -> IntMap a
VMap.alter Maybe [TileFace] -> Maybe [TileFace]
consf Vertex
v VertexMap [TileFace]
vmap
consf :: Maybe [TileFace] -> Maybe [TileFace]
consf Maybe [TileFace]
Nothing = [TileFace] -> Maybe [TileFace]
forall a. a -> Maybe a
Just [TileFace
f]
consf (Just [TileFace]
fs) = [TileFace] -> Maybe [TileFace]
forall a. a -> Maybe a
Just (TileFace
fTileFace -> [TileFace] -> [TileFace]
forall a. a -> [a] -> [a]
:[TileFace]
fs)
facesAtBV:: BoundaryState -> Vertex -> [TileFace]
facesAtBV :: BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v = case Vertex -> VertexMap [TileFace] -> Maybe [TileFace]
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup Vertex
v (BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd) of
Just [TileFace]
fcs -> [TileFace]
fcs
Maybe [TileFace]
Nothing -> String -> [TileFace]
forall a. HasCallStack => String -> a
error (String -> [TileFace]) -> String -> [TileFace]
forall a b. (a -> b) -> a -> b
$ String
"facesAtBV: Not a boundary vertex? No faces found at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
boundaryFaces :: BoundaryState -> [TileFace]
boundaryFaces :: BoundaryState -> [TileFace]
boundaryFaces BoundaryState
bd = [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a]
nub ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (Vertex -> [TileFace]) -> [Vertex] -> [TileFace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd) [Vertex]
bvs where
bvs :: [Vertex]
bvs = ((Vertex, Vertex) -> Vertex) -> [(Vertex, Vertex)] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst ([(Vertex, Vertex)] -> [Vertex]) -> [(Vertex, Vertex)] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd
data Update = SafeUpdate TileFace
| UnsafeUpdate (Vertex -> TileFace)
instance Show Update where
show :: Update -> String
show (SafeUpdate TileFace
f) = String
"SafeUpdate (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show TileFace
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
show (UnsafeUpdate Vertex -> TileFace
mf) = String
"UnsafeUpdate (\0 -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show (Vertex -> TileFace
mf Vertex
0)String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
type UpdateMap = Map.Map Dedge Update
data ForceState = ForceState
{ ForceState -> BoundaryState
boundaryState:: BoundaryState
, ForceState -> UpdateMap
updateMap:: UpdateMap
}
type UpdateGenerator = BoundaryState -> [Dedge] -> Try UpdateMap
class Forcible a where
tryFSOpWith :: UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
tryInitFSWith :: UpdateGenerator -> a -> Try ForceState
tryChangeBoundaryWith :: UpdateGenerator -> (BoundaryState -> Try BoundaryChange) -> a -> Try a
instance Forcible ForceState where
tryFSOpWith :: UpdateGenerator
-> (ForceState -> Try ForceState) -> ForceState -> Try ForceState
tryFSOpWith UpdateGenerator
_ = (ForceState -> Try ForceState) -> ForceState -> Try ForceState
forall a. a -> a
id
tryInitFSWith :: UpdateGenerator -> ForceState -> Try ForceState
tryInitFSWith UpdateGenerator
_ = ForceState -> Try ForceState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return
tryChangeBoundaryWith :: UpdateGenerator
-> (BoundaryState -> Try BoundaryChange)
-> ForceState
-> Try ForceState
tryChangeBoundaryWith UpdateGenerator
ugen BoundaryState -> Try BoundaryChange
f ForceState
fs = do
BoundaryChange
bdC <- BoundaryState -> Try BoundaryChange
f (ForceState -> BoundaryState
boundaryState ForceState
fs)
UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith UpdateGenerator
ugen BoundaryChange
bdC ForceState
fs
instance Forcible BoundaryState where
tryFSOpWith :: UpdateGenerator
-> (ForceState -> Try ForceState)
-> BoundaryState
-> Try BoundaryState
tryFSOpWith UpdateGenerator
ugen ForceState -> Try ForceState
f BoundaryState
bd = do
ForceState
fs <- UpdateGenerator -> BoundaryState -> Try ForceState
forall a. Forcible a => UpdateGenerator -> a -> Try ForceState
tryInitFSWith UpdateGenerator
ugen BoundaryState
bd
ForceState
fs' <- ForceState -> Try ForceState
f ForceState
fs
BoundaryState -> Try BoundaryState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoundaryState -> Try BoundaryState)
-> BoundaryState -> Try BoundaryState
forall a b. (a -> b) -> a -> b
$ ForceState -> BoundaryState
boundaryState ForceState
fs'
tryInitFSWith :: UpdateGenerator -> BoundaryState -> Try ForceState
tryInitFSWith UpdateGenerator
ugen BoundaryState
bd = do
UpdateMap
umap <- UpdateGenerator
ugen BoundaryState
bd (BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd)
ForceState -> Try ForceState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForceState -> Try ForceState) -> ForceState -> Try ForceState
forall a b. (a -> b) -> a -> b
$ ForceState { boundaryState :: BoundaryState
boundaryState = BoundaryState
bd , updateMap :: UpdateMap
updateMap = UpdateMap
umap }
tryChangeBoundaryWith :: UpdateGenerator
-> (BoundaryState -> Try BoundaryChange)
-> BoundaryState
-> Try BoundaryState
tryChangeBoundaryWith UpdateGenerator
_ BoundaryState -> Try BoundaryChange
f BoundaryState
bd = do
BoundaryChange
bdC <- BoundaryState -> Try BoundaryChange
f BoundaryState
bd
BoundaryState -> Try BoundaryState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoundaryState -> Try BoundaryState)
-> BoundaryState -> Try BoundaryState
forall a b. (a -> b) -> a -> b
$ BoundaryChange -> BoundaryState
newBoundaryState BoundaryChange
bdC
instance Forcible Tgraph where
tryFSOpWith :: UpdateGenerator
-> (ForceState -> Try ForceState) -> Tgraph -> Try Tgraph
tryFSOpWith UpdateGenerator
ugen ForceState -> Try ForceState
f Tgraph
g = BoundaryState -> Tgraph
recoverGraph (BoundaryState -> Tgraph) -> Try BoundaryState -> Try Tgraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateGenerator
-> (ForceState -> Try ForceState)
-> BoundaryState
-> Try BoundaryState
forall a.
Forcible a =>
UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
tryFSOpWith UpdateGenerator
ugen ForceState -> Try ForceState
f (Tgraph -> BoundaryState
makeBoundaryState Tgraph
g)
tryInitFSWith :: UpdateGenerator -> Tgraph -> Try ForceState
tryInitFSWith UpdateGenerator
ugen Tgraph
g = UpdateGenerator -> BoundaryState -> Try ForceState
forall a. Forcible a => UpdateGenerator -> a -> Try ForceState
tryInitFSWith UpdateGenerator
ugen (Tgraph -> BoundaryState
makeBoundaryState Tgraph
g)
tryChangeBoundaryWith :: UpdateGenerator
-> (BoundaryState -> Try BoundaryChange) -> Tgraph -> Try Tgraph
tryChangeBoundaryWith UpdateGenerator
ugen BoundaryState -> Try BoundaryChange
f Tgraph
g =
BoundaryState -> Tgraph
recoverGraph (BoundaryState -> Tgraph) -> Try BoundaryState -> Try Tgraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateGenerator
-> (BoundaryState -> Try BoundaryChange)
-> BoundaryState
-> Try BoundaryState
forall a.
Forcible a =>
UpdateGenerator
-> (BoundaryState -> Try BoundaryChange) -> a -> Try a
tryChangeBoundaryWith UpdateGenerator
ugen BoundaryState -> Try BoundaryChange
f (Tgraph -> BoundaryState
makeBoundaryState Tgraph
g)
tryForceWith :: Forcible a => UpdateGenerator -> a -> Try a
tryForceWith :: forall a. Forcible a => UpdateGenerator -> a -> Try a
tryForceWith UpdateGenerator
ugen = UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
forall a.
Forcible a =>
UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
tryFSOpWith UpdateGenerator
ugen (UpdateGenerator -> ForceState -> Try ForceState
tryForceStateWith UpdateGenerator
ugen) where
tryForceStateWith :: UpdateGenerator -> ForceState -> Try ForceState
tryForceStateWith UpdateGenerator
uGen = ForceState -> Try ForceState
retry where
retry :: ForceState -> Try ForceState
retry ForceState
fs = case UpdateMap -> Maybe Update
findSafeUpdate (ForceState -> UpdateMap
updateMap ForceState
fs) of
Just Update
u -> do BoundaryChange
bdChange <- BoundaryState -> Update -> Try BoundaryChange
trySafeUpdate (ForceState -> BoundaryState
boundaryState ForceState
fs) Update
u
ForceState
fs' <- UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith UpdateGenerator
uGen BoundaryChange
bdChange ForceState
fs
ForceState -> Try ForceState
retry ForceState
fs'
Maybe Update
_ -> do Maybe BoundaryChange
maybeBdC <- ForceState -> Try (Maybe BoundaryChange)
tryUnsafes ForceState
fs
case Maybe BoundaryChange
maybeBdC of
Maybe BoundaryChange
Nothing -> ForceState -> Try ForceState
forall a b. b -> Either a b
Right ForceState
fs
Just BoundaryChange
bdC -> do ForceState
fs' <- UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith UpdateGenerator
uGen BoundaryChange
bdC ForceState
fs
ForceState -> Try ForceState
retry ForceState
fs'
tryStepForceWith :: Forcible a => UpdateGenerator -> Int -> a -> Try a
tryStepForceWith :: forall a. Forcible a => UpdateGenerator -> Vertex -> a -> Try a
tryStepForceWith UpdateGenerator
ugen Vertex
n = UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
forall a.
Forcible a =>
UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
tryFSOpWith UpdateGenerator
ugen ((ForceState -> Try ForceState) -> a -> Try a)
-> (ForceState -> Try ForceState) -> a -> Try a
forall a b. (a -> b) -> a -> b
$ Vertex -> ForceState -> Try ForceState
forall {t}. (Eq t, Num t) => t -> ForceState -> Try ForceState
count Vertex
n where
count :: t -> ForceState -> Try ForceState
count t
0 ForceState
fs = ForceState -> Try ForceState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ForceState
fs
count t
m ForceState
fs = do Maybe (ForceState, BoundaryChange)
result <- UpdateGenerator
-> ForceState -> Try (Maybe (ForceState, BoundaryChange))
tryOneStepWith UpdateGenerator
ugen ForceState
fs
case Maybe (ForceState, BoundaryChange)
result of
Maybe (ForceState, BoundaryChange)
Nothing -> ForceState -> Try ForceState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ForceState
fs
Just (ForceState
fs', BoundaryChange
_) -> t -> ForceState -> Try ForceState
count (t
mt -> t -> t
forall a. Num a => a -> a -> a
-t
1) ForceState
fs'
tryFSOp :: Forcible a => (ForceState -> Try ForceState) -> a -> Try a
tryFSOp :: forall a.
Forcible a =>
(ForceState -> Try ForceState) -> a -> Try a
tryFSOp = UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
forall a.
Forcible a =>
UpdateGenerator -> (ForceState -> Try ForceState) -> a -> Try a
tryFSOpWith UpdateGenerator
defaultAllUGen
tryForce:: Forcible a => a -> Try a
tryForce :: forall a. Forcible a => a -> Try a
tryForce = UpdateGenerator -> a -> Try a
forall a. Forcible a => UpdateGenerator -> a -> Try a
tryForceWith UpdateGenerator
defaultAllUGen
force:: Forcible a => a -> a
force :: forall a. Forcible a => a -> a
force = Try a -> a
forall a. Try a -> a
runTry (Try a -> a) -> (a -> Try a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Try a
forall a. Forcible a => a -> Try a
tryForce
wholeTiles:: Forcible a => a -> a
wholeTiles :: forall a. Forcible a => a -> a
wholeTiles = UpdateGenerator -> a -> a
forall a. Forcible a => UpdateGenerator -> a -> a
forceWith UpdateGenerator
wholeTileUpdates
forceWith:: Forcible a => UpdateGenerator -> a -> a
forceWith :: forall a. Forcible a => UpdateGenerator -> a -> a
forceWith UpdateGenerator
ugen = Try a -> a
forall a. Try a -> a
runTry (Try a -> a) -> (a -> Try a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpdateGenerator -> a -> Try a
forall a. Forcible a => UpdateGenerator -> a -> Try a
tryForceWith UpdateGenerator
ugen
tryInitFS :: Forcible a => a -> Try ForceState
tryInitFS :: forall a. Forcible a => a -> Try ForceState
tryInitFS = UpdateGenerator -> a -> Try ForceState
forall a. Forcible a => UpdateGenerator -> a -> Try ForceState
tryInitFSWith UpdateGenerator
defaultAllUGen
initFS :: Forcible a => a -> ForceState
initFS :: forall a. Forcible a => a -> ForceState
initFS = Try ForceState -> ForceState
forall a. Try a -> a
runTry (Try ForceState -> ForceState)
-> (a -> Try ForceState) -> a -> ForceState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Try ForceState
forall a. Forcible a => a -> Try ForceState
tryInitFS
tryStepForce :: Forcible a => Int -> a -> Try a
tryStepForce :: forall a. Forcible a => Vertex -> a -> Try a
tryStepForce = UpdateGenerator -> Vertex -> a -> Try a
forall a. Forcible a => UpdateGenerator -> Vertex -> a -> Try a
tryStepForceWith UpdateGenerator
defaultAllUGen
stepForce :: Forcible a => Int -> a -> a
stepForce :: forall a. Forcible a => Vertex -> a -> a
stepForce Vertex
n = Try a -> a
forall a. Try a -> a
runTry (Try a -> a) -> (a -> Try a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex -> a -> Try a
forall a. Forcible a => Vertex -> a -> Try a
tryStepForce Vertex
n
tryChangeBoundary:: Forcible a => (BoundaryState -> Try BoundaryChange) -> a -> Try a
tryChangeBoundary :: forall a.
Forcible a =>
(BoundaryState -> Try BoundaryChange) -> a -> Try a
tryChangeBoundary = UpdateGenerator
-> (BoundaryState -> Try BoundaryChange) -> a -> Try a
forall a.
Forcible a =>
UpdateGenerator
-> (BoundaryState -> Try BoundaryChange) -> a -> Try a
tryChangeBoundaryWith UpdateGenerator
defaultAllUGen
addHalfKite :: Forcible a => Dedge -> a -> a
addHalfKite :: forall a. Forcible a => (Vertex, Vertex) -> a -> a
addHalfKite (Vertex, Vertex)
e = Try a -> a
forall a. Try a -> a
runTry (Try a -> a) -> (a -> Try a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex, Vertex) -> a -> Try a
forall a. Forcible a => (Vertex, Vertex) -> a -> Try a
tryAddHalfKite (Vertex, Vertex)
e
tryAddHalfKite :: Forcible a => Dedge -> a -> Try a
tryAddHalfKite :: forall a. Forcible a => (Vertex, Vertex) -> a -> Try a
tryAddHalfKite = (BoundaryState -> Try BoundaryChange) -> a -> Try a
forall a.
Forcible a =>
(BoundaryState -> Try BoundaryChange) -> a -> Try a
tryChangeBoundary ((BoundaryState -> Try BoundaryChange) -> a -> Try a)
-> ((Vertex, Vertex) -> BoundaryState -> Try BoundaryChange)
-> (Vertex, Vertex)
-> a
-> Try a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex, Vertex) -> BoundaryState -> Try BoundaryChange
tryAddHalfKiteBoundary where
tryAddHalfKiteBoundary :: (Vertex, Vertex) -> BoundaryState -> Try BoundaryChange
tryAddHalfKiteBoundary (Vertex, Vertex)
e BoundaryState
bd =
do (Vertex, Vertex)
de <- case [(Vertex, Vertex)
e, (Vertex, Vertex) -> (Vertex, Vertex)
reverseD (Vertex, Vertex)
e] [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd of
[(Vertex, Vertex)
de] -> (Vertex, Vertex) -> Either String (Vertex, Vertex)
forall a b. b -> Either a b
Right (Vertex, Vertex)
de
[(Vertex, Vertex)]
_ -> String -> Either String (Vertex, Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Vertex, Vertex))
-> String -> Either String (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryAddHalfKiteBoundary: on non-boundary edge " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex, Vertex)
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
let (TileFace
fc,EdgeType
etype) = BoundaryState -> (Vertex, Vertex) -> (TileFace, EdgeType)
inspectBDedge BoundaryState
bd (Vertex, Vertex)
de
let tryU :: Try Update
tryU | EdgeType
etype EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
Long = UChecker
addKiteLongE BoundaryState
bd TileFace
fc
| EdgeType
etype EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
Short = UChecker
addKiteShortE BoundaryState
bd TileFace
fc
| EdgeType
etype EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
Join Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc = UChecker
completeHalf BoundaryState
bd TileFace
fc
| Bool
otherwise = String -> Try Update
forall a b. a -> Either a b
Left String
"tryAddHalfKiteBoundary: applied to dart join (not possible).\n"
Update
u <- Try Update
tryU
BoundaryState -> Update -> Try BoundaryChange
tryUpdate BoundaryState
bd Update
u
addHalfDart :: Forcible a => Dedge -> a -> a
addHalfDart :: forall a. Forcible a => (Vertex, Vertex) -> a -> a
addHalfDart (Vertex, Vertex)
e = Try a -> a
forall a. Try a -> a
runTry (Try a -> a) -> (a -> Try a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex, Vertex) -> a -> Try a
forall a. Forcible a => (Vertex, Vertex) -> a -> Try a
tryAddHalfDart (Vertex, Vertex)
e
tryAddHalfDart :: Forcible a => Dedge -> a -> Try a
tryAddHalfDart :: forall a. Forcible a => (Vertex, Vertex) -> a -> Try a
tryAddHalfDart = (BoundaryState -> Try BoundaryChange) -> a -> Try a
forall a.
Forcible a =>
(BoundaryState -> Try BoundaryChange) -> a -> Try a
tryChangeBoundary ((BoundaryState -> Try BoundaryChange) -> a -> Try a)
-> ((Vertex, Vertex) -> BoundaryState -> Try BoundaryChange)
-> (Vertex, Vertex)
-> a
-> Try a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex, Vertex) -> BoundaryState -> Try BoundaryChange
tryAddHalfDartBoundary where
tryAddHalfDartBoundary :: (Vertex, Vertex) -> BoundaryState -> Try BoundaryChange
tryAddHalfDartBoundary (Vertex, Vertex)
e BoundaryState
bd =
do (Vertex, Vertex)
de <- case [(Vertex, Vertex)
e, (Vertex, Vertex) -> (Vertex, Vertex)
reverseD (Vertex, Vertex)
e] [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd of
[(Vertex, Vertex)
de] -> (Vertex, Vertex) -> Either String (Vertex, Vertex)
forall a b. b -> Either a b
Right (Vertex, Vertex)
de
[(Vertex, Vertex)]
_ -> String -> Either String (Vertex, Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Vertex, Vertex))
-> String -> Either String (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryAddHalfDartBoundary: on non-boundary edge " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex, Vertex)
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
let (TileFace
fc,EdgeType
etype) = BoundaryState -> (Vertex, Vertex) -> (TileFace, EdgeType)
inspectBDedge BoundaryState
bd (Vertex, Vertex)
de
let tryU :: Try Update
tryU | EdgeType
etype EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
Long = UChecker
addDartLongE BoundaryState
bd TileFace
fc
| EdgeType
etype EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
Short Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc = UChecker
addDartShortE BoundaryState
bd TileFace
fc
| EdgeType
etype EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
Join Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
fc = UChecker
completeHalf BoundaryState
bd TileFace
fc
| Bool
otherwise = String -> Try Update
forall a b. a -> Either a b
Left String
"tryAddHalfDartBoundary: applied to short edge of dart or to kite join (not possible).\n"
Update
u <- Try Update
tryU
BoundaryState -> Update -> Try BoundaryChange
tryUpdate BoundaryState
bd Update
u
tryOneStepWith :: UpdateGenerator -> ForceState -> Try (Maybe (ForceState,BoundaryChange))
tryOneStepWith :: UpdateGenerator
-> ForceState -> Try (Maybe (ForceState, BoundaryChange))
tryOneStepWith UpdateGenerator
uGen ForceState
fs =
case UpdateMap -> Maybe Update
findSafeUpdate (ForceState -> UpdateMap
updateMap ForceState
fs) of
Just Update
u -> do BoundaryChange
bdChange <- BoundaryState -> Update -> Try BoundaryChange
trySafeUpdate (ForceState -> BoundaryState
boundaryState ForceState
fs) Update
u
ForceState
fs' <- UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith UpdateGenerator
uGen BoundaryChange
bdChange ForceState
fs
Maybe (ForceState, BoundaryChange)
-> Try (Maybe (ForceState, BoundaryChange))
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ForceState, BoundaryChange)
-> Try (Maybe (ForceState, BoundaryChange)))
-> Maybe (ForceState, BoundaryChange)
-> Try (Maybe (ForceState, BoundaryChange))
forall a b. (a -> b) -> a -> b
$ (ForceState, BoundaryChange) -> Maybe (ForceState, BoundaryChange)
forall a. a -> Maybe a
Just (ForceState
fs',BoundaryChange
bdChange)
Maybe Update
_ -> do Maybe BoundaryChange
maybeBdC <- ForceState -> Try (Maybe BoundaryChange)
tryUnsafes ForceState
fs
case Maybe BoundaryChange
maybeBdC of
Just BoundaryChange
bdC -> do ForceState
fs' <- UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith UpdateGenerator
uGen BoundaryChange
bdC ForceState
fs
Maybe (ForceState, BoundaryChange)
-> Try (Maybe (ForceState, BoundaryChange))
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ForceState, BoundaryChange)
-> Try (Maybe (ForceState, BoundaryChange)))
-> Maybe (ForceState, BoundaryChange)
-> Try (Maybe (ForceState, BoundaryChange))
forall a b. (a -> b) -> a -> b
$ (ForceState, BoundaryChange) -> Maybe (ForceState, BoundaryChange)
forall a. a -> Maybe a
Just (ForceState
fs',BoundaryChange
bdC)
Maybe BoundaryChange
Nothing -> Maybe (ForceState, BoundaryChange)
-> Try (Maybe (ForceState, BoundaryChange))
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ForceState, BoundaryChange)
forall a. Maybe a
Nothing
tryOneStepF :: ForceState -> Try (Maybe (ForceState,BoundaryChange))
tryOneStepF :: ForceState -> Try (Maybe (ForceState, BoundaryChange))
tryOneStepF = UpdateGenerator
-> ForceState -> Try (Maybe (ForceState, BoundaryChange))
tryOneStepWith UpdateGenerator
defaultAllUGen
data BoundaryChange = BoundaryChange
{ BoundaryChange -> BoundaryState
newBoundaryState:: BoundaryState
, BoundaryChange -> [(Vertex, Vertex)]
removedEdges:: [Dedge]
, BoundaryChange -> [(Vertex, Vertex)]
revisedEdges :: [Dedge]
, BoundaryChange -> TileFace
newFace :: TileFace
} deriving (Vertex -> BoundaryChange -> ShowS
[BoundaryChange] -> ShowS
BoundaryChange -> String
(Vertex -> BoundaryChange -> ShowS)
-> (BoundaryChange -> String)
-> ([BoundaryChange] -> ShowS)
-> Show BoundaryChange
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Vertex -> BoundaryChange -> ShowS
showsPrec :: Vertex -> BoundaryChange -> ShowS
$cshow :: BoundaryChange -> String
show :: BoundaryChange -> String
$cshowList :: [BoundaryChange] -> ShowS
showList :: [BoundaryChange] -> ShowS
Show)
affectedBoundary :: BoundaryState -> [Dedge] -> [Dedge]
affectedBoundary :: BoundaryState -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
affectedBoundary BoundaryState
bd [(Vertex
a,Vertex
b)] = [(Vertex
x,Vertex
a),(Vertex
a,Vertex
b),(Vertex
b,Vertex
y)] where
bdry :: [(Vertex, Vertex)]
bdry = BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd
(Vertex
x,Vertex
_) = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> (Vertex, Vertex) -> (Vertex, Vertex)
forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
a)(Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd) [(Vertex, Vertex)]
bdry (String -> (Vertex, Vertex)
forall a. HasCallStack => String -> a
error (String -> (Vertex, Vertex)) -> String -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: boundary edge not found with snd = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
(Vertex
_,Vertex
y) = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> (Vertex, Vertex) -> (Vertex, Vertex)
forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
b)(Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst) [(Vertex, Vertex)]
bdry (String -> (Vertex, Vertex)
forall a. HasCallStack => String -> a
error (String -> (Vertex, Vertex)) -> String -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: boundary edge not found with fst = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
affectedBoundary BoundaryState
bd [(Vertex
a,Vertex
b),(Vertex
c,Vertex
d)] | Vertex
bVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
c = [(Vertex
x,Vertex
a),(Vertex
a,Vertex
b),(Vertex
c,Vertex
d),(Vertex
d,Vertex
y)] where
bdry :: [(Vertex, Vertex)]
bdry = BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd
(Vertex
x,Vertex
_) = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> (Vertex, Vertex) -> (Vertex, Vertex)
forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
a)(Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd) [(Vertex, Vertex)]
bdry (String -> (Vertex, Vertex)
forall a. HasCallStack => String -> a
error (String -> (Vertex, Vertex)) -> String -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: boundary edge not found with snd = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
(Vertex
_,Vertex
y) = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> (Vertex, Vertex) -> (Vertex, Vertex)
forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
d)(Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst) [(Vertex, Vertex)]
bdry (String -> (Vertex, Vertex)
forall a. HasCallStack => String -> a
error (String -> (Vertex, Vertex)) -> String -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: boundary edge not found with fst = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
affectedBoundary BoundaryState
bd [(Vertex
a,Vertex
b),(Vertex
c,Vertex
d)] | Vertex
aVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
d = [(Vertex
x,Vertex
c),(Vertex
c,Vertex
d),(Vertex
a,Vertex
b),(Vertex
b,Vertex
y)] where
bdry :: [(Vertex, Vertex)]
bdry = BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd
(Vertex
x,Vertex
_) = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> (Vertex, Vertex) -> (Vertex, Vertex)
forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
c)(Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd) [(Vertex, Vertex)]
bdry (String -> (Vertex, Vertex)
forall a. HasCallStack => String -> a
error (String -> (Vertex, Vertex)) -> String -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: boundary edge not found with snd = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
(Vertex
_,Vertex
y) = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> (Vertex, Vertex) -> (Vertex, Vertex)
forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
b)(Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst) [(Vertex, Vertex)]
bdry (String -> (Vertex, Vertex)
forall a. HasCallStack => String -> a
error (String -> (Vertex, Vertex)) -> String -> (Vertex, Vertex)
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: boundary edge not found with fst = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
affectedBoundary BoundaryState
_ [] = []
affectedBoundary BoundaryState
_ [(Vertex, Vertex)]
edges = String -> [(Vertex, Vertex)]
forall a. HasCallStack => String -> a
error (String -> [(Vertex, Vertex)]) -> String -> [(Vertex, Vertex)]
forall a b. (a -> b) -> a -> b
$ String
"affectedBoundary: unexpected new boundary edges " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Vertex, Vertex)] -> String
forall a. Show a => a -> String
show [(Vertex, Vertex)]
edges String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
mustFind :: Foldable t => (p -> Bool) -> t p -> p -> p
mustFind :: forall (t :: * -> *) p. Foldable t => (p -> Bool) -> t p -> p -> p
mustFind p -> Bool
p t p
ls p
err
= p -> (p -> p) -> Maybe p -> p
forall b a. b -> (a -> b) -> Maybe a -> b
maybe p
err p -> p
forall a. a -> a
id ((p -> Bool) -> t p -> Maybe p
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find p -> Bool
p t p
ls)
tryReviseUpdates:: UpdateGenerator -> BoundaryChange -> UpdateMap -> Try UpdateMap
tryReviseUpdates :: UpdateGenerator -> BoundaryChange -> UpdateMap -> Try UpdateMap
tryReviseUpdates UpdateGenerator
uGen BoundaryChange
bdChange UpdateMap
umap =
do let umap' :: UpdateMap
umap' = ((Vertex, Vertex) -> UpdateMap -> UpdateMap)
-> UpdateMap -> [(Vertex, Vertex)] -> UpdateMap
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Vertex, Vertex) -> UpdateMap -> UpdateMap
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete UpdateMap
umap (BoundaryChange -> [(Vertex, Vertex)]
removedEdges BoundaryChange
bdChange)
UpdateMap
umap'' <- UpdateGenerator
uGen (BoundaryChange -> BoundaryState
newBoundaryState BoundaryChange
bdChange) (BoundaryChange -> [(Vertex, Vertex)]
revisedEdges BoundaryChange
bdChange)
UpdateMap -> Try UpdateMap
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (UpdateMap -> UpdateMap -> UpdateMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union UpdateMap
umap'' UpdateMap
umap')
tryReviseFSWith :: UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith :: UpdateGenerator -> BoundaryChange -> ForceState -> Try ForceState
tryReviseFSWith UpdateGenerator
ugen BoundaryChange
bdC ForceState
fs =
do UpdateMap
umap <- UpdateGenerator -> BoundaryChange -> UpdateMap -> Try UpdateMap
tryReviseUpdates UpdateGenerator
ugen BoundaryChange
bdC (ForceState -> UpdateMap
updateMap ForceState
fs)
ForceState -> Try ForceState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForceState -> Try ForceState) -> ForceState -> Try ForceState
forall a b. (a -> b) -> a -> b
$ ForceState{ boundaryState :: BoundaryState
boundaryState = BoundaryChange -> BoundaryState
newBoundaryState BoundaryChange
bdC, updateMap :: UpdateMap
updateMap = UpdateMap
umap}
findSafeUpdate:: UpdateMap -> Maybe Update
findSafeUpdate :: UpdateMap -> Maybe Update
findSafeUpdate UpdateMap
umap = (Update -> Bool) -> [Update] -> Maybe Update
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Update -> Bool
isSafeUpdate (UpdateMap -> [Update]
forall k a. Map k a -> [a]
Map.elems UpdateMap
umap) where
isSafeUpdate :: Update -> Bool
isSafeUpdate (SafeUpdate TileFace
_ ) = Bool
True
isSafeUpdate (UnsafeUpdate Vertex -> TileFace
_ ) = Bool
False
tryUnsafes:: ForceState -> Try (Maybe BoundaryChange)
tryUnsafes :: ForceState -> Try (Maybe BoundaryChange)
tryUnsafes ForceState
fs = Vertex -> [Update] -> Try (Maybe BoundaryChange)
checkBlocked Vertex
0 ([Update] -> Try (Maybe BoundaryChange))
-> [Update] -> Try (Maybe BoundaryChange)
forall a b. (a -> b) -> a -> b
$ UpdateMap -> [Update]
forall k a. Map k a -> [a]
Map.elems (UpdateMap -> [Update]) -> UpdateMap -> [Update]
forall a b. (a -> b) -> a -> b
$ ForceState -> UpdateMap
updateMap ForceState
fs where
bd :: BoundaryState
bd = ForceState -> BoundaryState
boundaryState ForceState
fs
checkBlocked:: Int -> [Update] -> Try (Maybe BoundaryChange)
checkBlocked :: Vertex -> [Update] -> Try (Maybe BoundaryChange)
checkBlocked Vertex
0 [] = Maybe BoundaryChange -> Try (Maybe BoundaryChange)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BoundaryChange
forall a. Maybe a
Nothing
checkBlocked Vertex
n [] = String -> Try (Maybe BoundaryChange)
forall a b. a -> Either a b
Left (String -> Try (Maybe BoundaryChange))
-> String -> Try (Maybe BoundaryChange)
forall a b. (a -> b) -> a -> b
$ String
"tryUnsafes: There are " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
nString -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" unsafe updates but ALL unsafe updates are blocked (by touching vertices)\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"This should not happen! However it may arise when accuracy limits are reached on very large Tgraphs.\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Total number of faces is " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show ([TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ([TileFace] -> Vertex) -> [TileFace] -> Vertex
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [TileFace]
allFaces BoundaryState
bd) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
checkBlocked Vertex
n (Update
u: [Update]
more) = case BoundaryState -> Update -> Maybe BoundaryChange
checkUnsafeUpdate BoundaryState
bd Update
u of
Maybe BoundaryChange
Nothing -> Vertex -> [Update] -> Try (Maybe BoundaryChange)
checkBlocked (Vertex
nVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1) [Update]
more
Maybe BoundaryChange
other -> Maybe BoundaryChange -> Try (Maybe BoundaryChange)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BoundaryChange
other
checkUnsafeUpdate:: BoundaryState -> Update -> Maybe BoundaryChange
checkUnsafeUpdate :: BoundaryState -> Update -> Maybe BoundaryChange
checkUnsafeUpdate BoundaryState
_ (SafeUpdate TileFace
_) = String -> Maybe BoundaryChange
forall a. HasCallStack => String -> a
error String
"checkUnsafeUpdate: applied to safe update.\n"
checkUnsafeUpdate BoundaryState
bd (UnsafeUpdate Vertex -> TileFace
makeFace) =
let v :: Vertex
v = BoundaryState -> Vertex
nextVertex BoundaryState
bd
newface :: TileFace
newface = Vertex -> TileFace
makeFace Vertex
v
oldVPoints :: VertexMap (Point V2 Double)
oldVPoints = BoundaryState -> VertexMap (Point V2 Double)
bvLocMap BoundaryState
bd
newVPoints :: VertexMap (Point V2 Double)
newVPoints = TileFace
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double)
addVPoint TileFace
newface VertexMap (Point V2 Double)
oldVPoints
vPosition :: Point V2 Double
vPosition = VertexMap (Point V2 Double)
newVPoints VertexMap (Point V2 Double) -> Vertex -> Point V2 Double
forall a. IntMap a -> Vertex -> a
VMap.! Vertex
v
fDedges :: [(Vertex, Vertex)]
fDedges = TileFace -> [(Vertex, Vertex)]
faceDedges TileFace
newface
matchedDedges :: [(Vertex, Vertex)]
matchedDedges = ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Vertex
x,Vertex
y) -> Vertex
x Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex
v Bool -> Bool -> Bool
&& Vertex
y Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex
v) [(Vertex, Vertex)]
fDedges
newDedges :: [(Vertex, Vertex)]
newDedges = ((Vertex, Vertex) -> (Vertex, Vertex))
-> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> (Vertex, Vertex)
reverseD ([(Vertex, Vertex)]
fDedges [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Vertex, Vertex)]
matchedDedges)
resultBd :: BoundaryState
resultBd = BoundaryState
{ boundary :: [(Vertex, Vertex)]
boundary = [(Vertex, Vertex)]
newDedges [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. [a] -> [a] -> [a]
++ (BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Vertex, Vertex)]
matchedDedges)
, bvFacesMap :: VertexMap [TileFace]
bvFacesMap = TileFace -> VertexMap [TileFace] -> VertexMap [TileFace]
changeVFMap TileFace
newface (BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd)
, bvLocMap :: VertexMap (Point V2 Double)
bvLocMap = VertexMap (Point V2 Double)
newVPoints
, allFaces :: [TileFace]
allFaces = TileFace
newfaceTileFace -> [TileFace] -> [TileFace]
forall a. a -> [a] -> [a]
:BoundaryState -> [TileFace]
allFaces BoundaryState
bd
, nextVertex :: Vertex
nextVertex = Vertex
vVertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
+Vertex
1
}
bdChange :: BoundaryChange
bdChange = BoundaryChange
{ newBoundaryState :: BoundaryState
newBoundaryState = BoundaryState
resultBd
, removedEdges :: [(Vertex, Vertex)]
removedEdges = [(Vertex, Vertex)]
matchedDedges
, revisedEdges :: [(Vertex, Vertex)]
revisedEdges = BoundaryState -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
affectedBoundary BoundaryState
resultBd [(Vertex, Vertex)]
newDedges
, newFace :: TileFace
newFace = TileFace
newface
}
in if Point V2 Double -> VertexMap (Point V2 Double) -> Bool
touchCheck Point V2 Double
vPosition VertexMap (Point V2 Double)
oldVPoints
then Maybe BoundaryChange
forall a. Maybe a
Nothing
else BoundaryChange -> Maybe BoundaryChange
forall a. a -> Maybe a
Just BoundaryChange
bdChange
trySafeUpdate:: BoundaryState -> Update -> Try BoundaryChange
trySafeUpdate :: BoundaryState -> Update -> Try BoundaryChange
trySafeUpdate BoundaryState
_ (UnsafeUpdate Vertex -> TileFace
_) = String -> Try BoundaryChange
forall a. HasCallStack => String -> a
error String
"trySafeUpdate: applied to non-safe update.\n"
trySafeUpdate BoundaryState
bd (SafeUpdate TileFace
newface) =
let fDedges :: [(Vertex, Vertex)]
fDedges = TileFace -> [(Vertex, Vertex)]
faceDedges TileFace
newface
matchedDedges :: [(Vertex, Vertex)]
matchedDedges = [(Vertex, Vertex)]
fDedges [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd
removedBVs :: [Vertex]
removedBVs = [(Vertex, Vertex)] -> [Vertex]
commonVs [(Vertex, Vertex)]
matchedDedges
newDedges :: [(Vertex, Vertex)]
newDedges = ((Vertex, Vertex) -> (Vertex, Vertex))
-> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> (Vertex, Vertex)
reverseD ([(Vertex, Vertex)]
fDedges [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Vertex, Vertex)]
matchedDedges)
nbrFaces :: [TileFace]
nbrFaces = [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a]
nub ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (Vertex -> [TileFace]) -> [Vertex] -> [TileFace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd) [Vertex]
removedBVs
resultBd :: BoundaryState
resultBd = BoundaryState
{ boundary :: [(Vertex, Vertex)]
boundary = [(Vertex, Vertex)]
newDedges [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. [a] -> [a] -> [a]
++ (BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd [(Vertex, Vertex)] -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Vertex, Vertex)]
matchedDedges)
, bvFacesMap :: VertexMap [TileFace]
bvFacesMap = (Vertex -> VertexMap [TileFace] -> VertexMap [TileFace])
-> VertexMap [TileFace] -> [Vertex] -> VertexMap [TileFace]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Vertex -> VertexMap [TileFace] -> VertexMap [TileFace]
forall a. Vertex -> IntMap a -> IntMap a
VMap.delete (TileFace -> VertexMap [TileFace] -> VertexMap [TileFace]
changeVFMap TileFace
newface (VertexMap [TileFace] -> VertexMap [TileFace])
-> VertexMap [TileFace] -> VertexMap [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd) [Vertex]
removedBVs
, allFaces :: [TileFace]
allFaces = TileFace
newfaceTileFace -> [TileFace] -> [TileFace]
forall a. a -> [a] -> [a]
:BoundaryState -> [TileFace]
allFaces BoundaryState
bd
, bvLocMap :: VertexMap (Point V2 Double)
bvLocMap = (Vertex
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double))
-> VertexMap (Point V2 Double)
-> [Vertex]
-> VertexMap (Point V2 Double)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Vertex
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double)
forall a. Vertex -> IntMap a -> IntMap a
VMap.delete (BoundaryState -> VertexMap (Point V2 Double)
bvLocMap BoundaryState
bd) [Vertex]
removedBVs
, nextVertex :: Vertex
nextVertex = BoundaryState -> Vertex
nextVertex BoundaryState
bd
}
bdChange :: BoundaryChange
bdChange = BoundaryChange
{ newBoundaryState :: BoundaryState
newBoundaryState = BoundaryState
resultBd
, removedEdges :: [(Vertex, Vertex)]
removedEdges = [(Vertex, Vertex)]
matchedDedges
, revisedEdges :: [(Vertex, Vertex)]
revisedEdges = BoundaryState -> [(Vertex, Vertex)] -> [(Vertex, Vertex)]
affectedBoundary BoundaryState
resultBd [(Vertex, Vertex)]
newDedges
, newFace :: TileFace
newFace = TileFace
newface
}
in if TileFace -> [TileFace] -> Bool
noNewConflict TileFace
newface [TileFace]
nbrFaces
then BoundaryChange -> Try BoundaryChange
forall a b. b -> Either a b
Right BoundaryChange
bdChange
else String -> Try BoundaryChange
forall a b. a -> Either a b
Left (String -> Try BoundaryChange) -> String -> Try BoundaryChange
forall a b. (a -> b) -> a -> b
$ String
"trySafeUpdate:(incorrect tiling)\nConflicting new face "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show TileFace
newface
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nwith neighbouring faces\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TileFace] -> String
forall a. Show a => a -> String
show [TileFace]
nbrFaces
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
commonVs :: [Dedge] -> [Vertex]
commonVs :: [(Vertex, Vertex)] -> [Vertex]
commonVs [(Vertex
a,Vertex
b),(Vertex
c,Vertex
d)] | Vertex
bVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
c = [Vertex
b]
| Vertex
dVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
a = [Vertex
a]
| Bool
otherwise = String -> [Vertex]
forall a. HasCallStack => String -> a
error (String -> [Vertex]) -> String -> [Vertex]
forall a b. (a -> b) -> a -> b
$ String
"commonVs: 2 directed edges not consecutive: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Vertex, Vertex)] -> String
forall a. Show a => a -> String
show [(Vertex
a,Vertex
b),(Vertex
c,Vertex
d)] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
commonVs [(Vertex
a,Vertex
b),(Vertex
c,Vertex
d),(Vertex
e,Vertex
f)] | [Vertex] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ([Vertex] -> [Vertex]
forall a. Eq a => [a] -> [a]
nub [Vertex
a,Vertex
b,Vertex
c,Vertex
d,Vertex
e,Vertex
f]) Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
3 = [Vertex
a,Vertex
c,Vertex
e]
commonVs [(Vertex, Vertex)]
es = String -> [Vertex]
forall a. HasCallStack => String -> a
error (String -> [Vertex]) -> String -> [Vertex]
forall a b. (a -> b) -> a -> b
$ String
"commonVs: unexpected argument edges (not 2 consecutive directed edges or 3 round triangle): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Vertex, Vertex)] -> String
forall a. Show a => a -> String
show [(Vertex, Vertex)]
es String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
tryUpdate:: BoundaryState -> Update -> Try BoundaryChange
tryUpdate :: BoundaryState -> Update -> Try BoundaryChange
tryUpdate BoundaryState
bd u :: Update
u@(SafeUpdate TileFace
_) = BoundaryState -> Update -> Try BoundaryChange
trySafeUpdate BoundaryState
bd Update
u
tryUpdate BoundaryState
bd u :: Update
u@(UnsafeUpdate Vertex -> TileFace
_) =
case BoundaryState -> Update -> Maybe BoundaryChange
checkUnsafeUpdate BoundaryState
bd Update
u of
Just BoundaryChange
bdC -> BoundaryChange -> Try BoundaryChange
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return BoundaryChange
bdC
Maybe BoundaryChange
Nothing -> String -> Try BoundaryChange
forall a b. a -> Either a b
Left String
"tryUpdate: crossing boundary (touching vertices).\n"
recalculateBVLocs :: BoundaryState -> BoundaryState
recalculateBVLocs :: BoundaryState -> BoundaryState
recalculateBVLocs BoundaryState
bd = BoundaryState
bd {bvLocMap :: VertexMap (Point V2 Double)
bvLocMap = VertexMap (Point V2 Double)
newlocs} where
newlocs :: VertexMap (Point V2 Double)
newlocs = (Vertex -> Point V2 Double -> Bool)
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double)
forall a. (Vertex -> a -> Bool) -> IntMap a -> IntMap a
VMap.filterWithKey (\Vertex
k Point V2 Double
_ -> Vertex
k Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Vertex]
bvs) (VertexMap (Point V2 Double) -> VertexMap (Point V2 Double))
-> VertexMap (Point V2 Double) -> VertexMap (Point V2 Double)
forall a b. (a -> b) -> a -> b
$ [TileFace] -> VertexMap (Point V2 Double)
locateVertices ([TileFace] -> VertexMap (Point V2 Double))
-> [TileFace] -> VertexMap (Point V2 Double)
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [TileFace]
allFaces BoundaryState
bd
bvs :: [Vertex]
bvs = ((Vertex, Vertex) -> Vertex) -> [(Vertex, Vertex)] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst ([(Vertex, Vertex)] -> [Vertex]) -> [(Vertex, Vertex)] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd
tryRecalibratingForce :: Forcible c => c -> Try c
tryRecalibratingForce :: forall a. Forcible a => a -> Try a
tryRecalibratingForce = (ForceState -> Try ForceState) -> c -> Try c
forall a.
Forcible a =>
(ForceState -> Try ForceState) -> a -> Try a
tryFSOp ForceState -> Try ForceState
recalibrating where
recalibrating :: ForceState -> Try ForceState
recalibrating ForceState
fs = do
ForceState
fs' <- Vertex -> ForceState -> Try ForceState
forall a. Forcible a => Vertex -> a -> Try a
tryStepForce Vertex
20000 ForceState
fs
if UpdateMap -> Bool
forall a. Map (Vertex, Vertex) a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (UpdateMap -> Bool) -> UpdateMap -> Bool
forall a b. (a -> b) -> a -> b
$ ForceState -> UpdateMap
updateMap ForceState
fs'
then ForceState -> Try ForceState
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ForceState
fs'
else ForceState -> Try ForceState
recalibrating (ForceState -> Try ForceState) -> ForceState -> Try ForceState
forall a b. (a -> b) -> a -> b
$ ForceState
fs' {boundaryState :: BoundaryState
boundaryState = BoundaryState -> BoundaryState
recalculateBVLocs (BoundaryState -> BoundaryState) -> BoundaryState -> BoundaryState
forall a b. (a -> b) -> a -> b
$ ForceState -> BoundaryState
boundaryState ForceState
fs'}
recalibratingForce :: Forcible c => c -> c
recalibratingForce :: forall a. Forcible a => a -> a
recalibratingForce = Try c -> c
forall a. Try a -> a
runTry (Try c -> c) -> (c -> Try c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Try c
forall a. Forcible a => a -> Try a
tryRecalibratingForce
allUGenerator :: UpdateGenerator
allUGenerator :: UpdateGenerator
allUGenerator BoundaryState
bd [(Vertex, Vertex)]
focus =
do ([(Vertex, Vertex)]
_ , UpdateMap
umap) <- (Either String ([(Vertex, Vertex)], UpdateMap)
-> UpdateGenerator
-> Either String ([(Vertex, Vertex)], UpdateMap))
-> Either String ([(Vertex, Vertex)], UpdateMap)
-> [UpdateGenerator]
-> Either String ([(Vertex, Vertex)], UpdateMap)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Either String ([(Vertex, Vertex)], UpdateMap)
-> UpdateGenerator -> Either String ([(Vertex, Vertex)], UpdateMap)
forall {k} {a} {a}.
Ord k =>
Either a ([k], Map k a)
-> (BoundaryState -> [k] -> Either a (Map k a))
-> Either a ([k], Map k a)
addGen (([(Vertex, Vertex)], UpdateMap)
-> Either String ([(Vertex, Vertex)], UpdateMap)
forall a b. b -> Either a b
Right ([(Vertex, Vertex)]
focus,UpdateMap
forall k a. Map k a
Map.empty)) [UpdateGenerator]
generators
UpdateMap -> Try UpdateMap
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return UpdateMap
umap
where
addGen :: Either a ([k], Map k a)
-> (BoundaryState -> [k] -> Either a (Map k a))
-> Either a ([k], Map k a)
addGen (Right ([k]
es,Map k a
umap)) BoundaryState -> [k] -> Either a (Map k a)
gen = do Map k a
umap' <- BoundaryState -> [k] -> Either a (Map k a)
gen BoundaryState
bd [k]
es
let es' :: [k]
es' = [k]
es [k] -> [k] -> [k]
forall a. Eq a => [a] -> [a] -> [a]
\\ Map k a -> [k]
forall k a. Map k a -> [k]
Map.keys Map k a
umap'
([k], Map k a) -> Either a ([k], Map k a)
forall a. a -> Either a a
forall (m :: * -> *) a. Monad m => a -> m a
return ([k]
es',Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map k a
umap' Map k a
umap)
addGen Either a ([k], Map k a)
other BoundaryState -> [k] -> Either a (Map k a)
_ = Either a ([k], Map k a)
other
generators :: [UpdateGenerator]
generators = [ UpdateGenerator
wholeTileUpdates
, UpdateGenerator
aceKiteUpdates
, UpdateGenerator
queenOrKingUpdates
, UpdateGenerator
deuceDartUpdates
, UpdateGenerator
jackDartUpdates
, UpdateGenerator
sunStarUpdates
, UpdateGenerator
jackKiteUpdates
, UpdateGenerator
kingDartUpdates
, UpdateGenerator
queenDartUpdates
, UpdateGenerator
queenKiteUpdates
]
type UFinder = BoundaryState -> [Dedge] -> [(Dedge,TileFace)]
type UChecker = BoundaryState -> TileFace -> Try Update
boundaryFilter:: (BoundaryState -> Dedge -> TileFace -> Bool) -> UFinder
boundaryFilter :: (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predF BoundaryState
bd [(Vertex, Vertex)]
focus =
[ ((Vertex, Vertex)
e,TileFace
fc) | (Vertex, Vertex)
e <- [(Vertex, Vertex)]
focus
, TileFace
fc <- BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd ((Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst (Vertex, Vertex)
e)
, TileFace
fc TileFace -> [TileFace] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd ((Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd (Vertex, Vertex)
e)
, BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predF BoundaryState
bd (Vertex, Vertex)
e TileFace
fc
]
makeUpdate:: (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate :: (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
f (Just Vertex
v) = TileFace -> Update
SafeUpdate (Vertex -> TileFace
f Vertex
v)
makeUpdate Vertex -> TileFace
f Maybe Vertex
Nothing = (Vertex -> TileFace) -> Update
UnsafeUpdate Vertex -> TileFace
f
mustbeStar:: BoundaryState -> Vertex -> Bool
mustbeStar :: BoundaryState -> Vertex -> Bool
mustbeStar BoundaryState
bd Vertex
v = [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
v) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
originV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v) Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>= Vertex
7
mustbeSun:: BoundaryState -> Vertex -> Bool
mustbeSun :: BoundaryState -> Vertex -> Bool
mustbeSun BoundaryState
bd Vertex
v = [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
v) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
originV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v) Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>= Vertex
5
mustbeDeuce:: BoundaryState -> Vertex -> Bool
mustbeDeuce :: BoundaryState -> Vertex -> Bool
mustbeDeuce BoundaryState
bd Vertex
v = BoundaryState -> Vertex -> Bool
isKiteOppV BoundaryState
bd Vertex
v Bool -> Bool -> Bool
&&
[(Vertex, Vertex)] -> Bool
hasAnyMatchingE ((TileFace -> (Vertex, Vertex)) -> [TileFace] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> (Vertex, Vertex)
shortE ([TileFace] -> [(Vertex, Vertex)])
-> [TileFace] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v)
mustbeKing:: BoundaryState -> Vertex -> Bool
mustbeKing :: BoundaryState -> Vertex -> Bool
mustbeKing BoundaryState
bd Vertex
v = BoundaryState -> Vertex -> Bool
isKiteWing BoundaryState
bd Vertex
v Bool -> Bool -> Bool
&& [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [TileFace]
dartOrigins Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
4
where dartOrigins :: [TileFace]
dartOrigins = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
v) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
originV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v
isKiteWing:: BoundaryState -> Vertex -> Bool
isKiteWing :: BoundaryState -> Vertex -> Bool
isKiteWing BoundaryState
bd Vertex
v = Vertex
v Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Vertex
wingV ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v))
isKiteOppV:: BoundaryState -> Vertex -> Bool
isKiteOppV :: BoundaryState -> Vertex -> Bool
isKiteOppV BoundaryState
bd Vertex
v = Vertex
v Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Vertex
oppV ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v))
isDartOrigin:: BoundaryState -> Vertex -> Bool
isDartOrigin :: BoundaryState -> Vertex -> Bool
isDartOrigin BoundaryState
bd Vertex
v = Vertex
v Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Vertex
originV ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v))
mustbeQueen:: BoundaryState -> Vertex -> Bool
mustbeQueen :: BoundaryState -> Vertex -> Bool
mustbeQueen BoundaryState
bd Vertex
v = BoundaryState -> Vertex -> Vertex
kiteWingCount BoundaryState
bd Vertex
v Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>Vertex
2
kiteWingCount:: BoundaryState -> Vertex -> Int
kiteWingCount :: BoundaryState -> Vertex -> Vertex
kiteWingCount BoundaryState
bd Vertex
v = [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ([TileFace] -> Vertex) -> [TileFace] -> Vertex
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
v) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
wingV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v)
mustbeJack :: BoundaryState -> Vertex -> Bool
mustbeJack :: BoundaryState -> Vertex -> Bool
mustbeJack BoundaryState
bd Vertex
v =
([TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [TileFace]
dWings Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
2 Bool -> Bool -> Bool
&& Bool -> Bool
not ([(Vertex, Vertex)] -> Bool
hasAnyMatchingE ((TileFace -> (Vertex, Vertex)) -> [TileFace] -> [(Vertex, Vertex)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> (Vertex, Vertex)
longE [TileFace]
dWings))) Bool -> Bool -> Bool
||
([TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [TileFace]
dWings Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
1 Bool -> Bool -> Bool
&& Bool
isKiteOrigin)
where fcs :: [TileFace]
fcs = BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v
dWings :: [TileFace]
dWings = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
v) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
wingV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart [TileFace]
fcs
isKiteOrigin :: Bool
isKiteOrigin = Vertex
v Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Vertex
originV ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite [TileFace]
fcs)
hasAnyMatchingE :: [Dedge] -> Bool
hasAnyMatchingE :: [(Vertex, Vertex)] -> Bool
hasAnyMatchingE ((Vertex
x,Vertex
y):[(Vertex, Vertex)]
more) = (Vertex
y,Vertex
x) (Vertex, Vertex) -> [(Vertex, Vertex)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Vertex, Vertex)]
more Bool -> Bool -> Bool
|| [(Vertex, Vertex)] -> Bool
hasAnyMatchingE [(Vertex, Vertex)]
more
hasAnyMatchingE [] = Bool
False
makeGenerator :: UChecker -> UFinder -> UpdateGenerator
makeGenerator :: UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
checker UFinder
finder = UpdateGenerator
gen where
gen :: UpdateGenerator
gen BoundaryState
bd [(Vertex, Vertex)]
edges = (((Vertex, Vertex), TileFace) -> Try UpdateMap -> Try UpdateMap)
-> Try UpdateMap -> [((Vertex, Vertex), TileFace)] -> Try UpdateMap
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Vertex, Vertex), TileFace) -> Try UpdateMap -> Try UpdateMap
forall {k}.
Ord k =>
(k, TileFace)
-> Either String (Map k Update) -> Either String (Map k Update)
addU (UpdateMap -> Try UpdateMap
forall a b. b -> Either a b
Right UpdateMap
forall k a. Map k a
Map.empty) (UFinder
finder BoundaryState
bd [(Vertex, Vertex)]
edges) where
addU :: (k, TileFace)
-> Either String (Map k Update) -> Either String (Map k Update)
addU (k, TileFace)
_ (Left String
x) = String -> Either String (Map k Update)
forall a b. a -> Either a b
Left String
x
addU (k
e,TileFace
fc) (Right Map k Update
ump) = do Update
u <- UChecker
checker BoundaryState
bd TileFace
fc
Map k Update -> Either String (Map k Update)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (k -> Update -> Map k Update -> Map k Update
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
e Update
u Map k Update
ump)
wholeTileUpdates:: UpdateGenerator
wholeTileUpdates :: UpdateGenerator
wholeTileUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
completeHalf UFinder
incompleteHalves
incompleteHalves :: UFinder
incompleteHalves :: UFinder
incompleteHalves = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
forall {p}. p -> (Vertex, Vertex) -> TileFace -> Bool
boundaryJoin where
boundaryJoin :: p -> (Vertex, Vertex) -> TileFace -> Bool
boundaryJoin p
_ (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
joinE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a)
aceKiteUpdates :: UpdateGenerator
aceKiteUpdates :: UpdateGenerator
aceKiteUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addKiteShortE UFinder
nonKDarts
nonKDarts :: UFinder
nonKDarts :: UFinder
nonKDarts = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
forall {p}. p -> (Vertex, Vertex) -> TileFace -> Bool
bShortDarts where
bShortDarts :: p -> (Vertex, Vertex) -> TileFace -> Bool
bShortDarts p
_ (Vertex
a,Vertex
b) TileFace
fc = TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
fc Bool -> Bool -> Bool
&& TileFace -> (Vertex, Vertex)
shortE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a)
queenOrKingUpdates :: UpdateGenerator
queenOrKingUpdates :: UpdateGenerator
queenOrKingUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addKiteShortE UFinder
kitesWingDartOrigin
kitesWingDartOrigin :: UFinder
kitesWingDartOrigin :: UFinder
kitesWingDartOrigin = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
kiteWDO where
kiteWDO :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
kiteWDO BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
shortE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a)
Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
isDartOrigin BoundaryState
bd (TileFace -> Vertex
wingV TileFace
fc)
deuceDartUpdates :: UpdateGenerator
deuceDartUpdates :: UpdateGenerator
deuceDartUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addDartShortE UFinder
kiteGaps
kiteGaps :: UFinder
kiteGaps :: UFinder
kiteGaps = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
kiteGap where
kiteGap :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
kiteGap BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
shortE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a)
Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
mustbeDeuce BoundaryState
bd (TileFace -> Vertex
oppV TileFace
fc)
jackDartUpdates :: UpdateGenerator
jackDartUpdates :: UpdateGenerator
jackDartUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addDartShortE UFinder
noTouchingDart
noTouchingDart :: UFinder
noTouchingDart :: UFinder
noTouchingDart = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
farKOfDarts where
farKOfDarts :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
farKOfDarts BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
shortE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a)
Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
mustbeJack BoundaryState
bd (TileFace -> Vertex
oppV TileFace
fc)
sunStarUpdates :: UpdateGenerator
sunStarUpdates :: UpdateGenerator
sunStarUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
completeSunStar UFinder
almostSunStar
almostSunStar :: UFinder
almostSunStar :: UFinder
almostSunStar = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
multiples57 where
multiples57 :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
multiples57 BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
longE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a) Bool -> Bool -> Bool
&&
((TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
mustbeStar BoundaryState
bd (TileFace -> Vertex
originV TileFace
fc)) Bool -> Bool -> Bool
||
(TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
mustbeSun BoundaryState
bd (TileFace -> Vertex
originV TileFace
fc))
)
jackKiteUpdates :: UpdateGenerator
jackKiteUpdates :: UpdateGenerator
jackKiteUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addKiteLongE UFinder
jackMissingKite
jackMissingKite :: UFinder
jackMissingKite :: UFinder
jackMissingKite = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
dartsWingDB where
dartsWingDB :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
dartsWingDB BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
longE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a) Bool -> Bool -> Bool
&&
TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
mustbeJack BoundaryState
bd (TileFace -> Vertex
wingV TileFace
fc)
kingDartUpdates :: UpdateGenerator
kingDartUpdates :: UpdateGenerator
kingDartUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addDartLongE UFinder
kingMissingThirdDart
kingMissingThirdDart :: UFinder
kingMissingThirdDart :: UFinder
kingMissingThirdDart = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predicate where
predicate :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predicate BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc = TileFace -> (Vertex, Vertex)
longE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a) Bool -> Bool -> Bool
&&
TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
fc Bool -> Bool -> Bool
&& BoundaryState -> Vertex -> Bool
mustbeKing BoundaryState
bd (TileFace -> Vertex
originV TileFace
fc)
queenDartUpdates :: UpdateGenerator
queenDartUpdates :: UpdateGenerator
queenDartUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addDartLongE UFinder
queenMissingDarts
queenMissingDarts :: UFinder
queenMissingDarts :: UFinder
queenMissingDarts = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predicate where
predicate :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predicate BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc =
TileFace -> (Vertex, Vertex)
longE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a) Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc Bool -> Bool -> Bool
&& [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [TileFace]
kiteWings Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>Vertex
2
where fcWing :: Vertex
fcWing = TileFace -> Vertex
wingV TileFace
fc
kiteWings :: [TileFace]
kiteWings = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
fcWing) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
wingV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$
(TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
fcWing
queenKiteUpdates :: UpdateGenerator
queenKiteUpdates :: UpdateGenerator
queenKiteUpdates = UChecker -> UFinder -> UpdateGenerator
makeGenerator UChecker
addKiteShortE UFinder
queenMissingKite
queenMissingKite :: UFinder
queenMissingKite :: UFinder
queenMissingKite = (BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool) -> UFinder
boundaryFilter BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predicate where
predicate :: BoundaryState -> (Vertex, Vertex) -> TileFace -> Bool
predicate BoundaryState
bd (Vertex
a,Vertex
b) TileFace
fc =
TileFace -> (Vertex, Vertex)
shortE TileFace
fc (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
forall a. Eq a => a -> a -> Bool
== (Vertex
b,Vertex
a) Bool -> Bool -> Bool
&& TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc Bool -> Bool -> Bool
&& [TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length [TileFace]
kiteWings Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>Vertex
2
where fcWing :: Vertex
fcWing = TileFace -> Vertex
wingV TileFace
fc
kiteWings :: [TileFace]
kiteWings = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
fcWing) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
wingV) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite (BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
fcWing)
completeHalf :: UChecker
completeHalf :: UChecker
completeHalf BoundaryState
bd (LD(Vertex
a,Vertex
b,Vertex
_)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {b}. b -> HalfTile (Vertex, b, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: b -> HalfTile (Vertex, b, Vertex)
makeFace b
v = (Vertex, b, Vertex) -> HalfTile (Vertex, b, Vertex)
forall rep. rep -> HalfTile rep
RD(Vertex
a,b
v,Vertex
b)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
b,Vertex
a) (Vertex
3,Vertex
1)
completeHalf BoundaryState
bd (RD(Vertex
a,Vertex
_,Vertex
b)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {c}. c -> HalfTile (Vertex, Vertex, c)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: c -> HalfTile (Vertex, Vertex, c)
makeFace c
v = (Vertex, Vertex, c) -> HalfTile (Vertex, Vertex, c)
forall rep. rep -> HalfTile rep
LD(Vertex
a,Vertex
b,c
v)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
b) (Vertex
1,Vertex
3)
completeHalf BoundaryState
bd (LK(Vertex
a,Vertex
_,Vertex
b)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {c}. c -> HalfTile (Vertex, Vertex, c)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: c -> HalfTile (Vertex, Vertex, c)
makeFace c
v = (Vertex, Vertex, c) -> HalfTile (Vertex, Vertex, c)
forall rep. rep -> HalfTile rep
RK(Vertex
a,Vertex
b,c
v)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
b) (Vertex
1,Vertex
2)
completeHalf BoundaryState
bd (RK(Vertex
a,Vertex
b,Vertex
_)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {b}. b -> HalfTile (Vertex, b, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: b -> HalfTile (Vertex, b, Vertex)
makeFace b
v = (Vertex, b, Vertex) -> HalfTile (Vertex, b, Vertex)
forall rep. rep -> HalfTile rep
LK(Vertex
a,b
v,Vertex
b)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
b,Vertex
a) (Vertex
2,Vertex
1)
addKiteShortE :: UChecker
addKiteShortE :: UChecker
addKiteShortE BoundaryState
bd (RD(Vertex
_,Vertex
b,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {a}. a -> HalfTile (a, Vertex, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: a -> HalfTile (a, Vertex, Vertex)
makeFace a
v = (a, Vertex, Vertex) -> HalfTile (a, Vertex, Vertex)
forall rep. rep -> HalfTile rep
LK(a
v,Vertex
c,Vertex
b)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
c,Vertex
b) (Vertex
2,Vertex
2)
addKiteShortE BoundaryState
bd (LD(Vertex
_,Vertex
b,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {a}. a -> HalfTile (a, Vertex, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: a -> HalfTile (a, Vertex, Vertex)
makeFace a
v = (a, Vertex, Vertex) -> HalfTile (a, Vertex, Vertex)
forall rep. rep -> HalfTile rep
RK(a
v,Vertex
c,Vertex
b)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
c,Vertex
b) (Vertex
2,Vertex
2)
addKiteShortE BoundaryState
bd (LK(Vertex
_,Vertex
b,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {a}. a -> HalfTile (a, Vertex, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: a -> HalfTile (a, Vertex, Vertex)
makeFace a
v = (a, Vertex, Vertex) -> HalfTile (a, Vertex, Vertex)
forall rep. rep -> HalfTile rep
RK(a
v,Vertex
c,Vertex
b)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
c,Vertex
b) (Vertex
2,Vertex
2)
addKiteShortE BoundaryState
bd (RK(Vertex
_,Vertex
b,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {a}. a -> HalfTile (a, Vertex, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: a -> HalfTile (a, Vertex, Vertex)
makeFace a
v = (a, Vertex, Vertex) -> HalfTile (a, Vertex, Vertex)
forall rep. rep -> HalfTile rep
LK(a
v,Vertex
c,Vertex
b)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
c,Vertex
b) (Vertex
2,Vertex
2)
addDartShortE :: UChecker
addDartShortE :: UChecker
addDartShortE BoundaryState
bd (RK(Vertex
_,Vertex
b,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {a}. a -> HalfTile (a, Vertex, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: a -> HalfTile (a, Vertex, Vertex)
makeFace a
v = (a, Vertex, Vertex) -> HalfTile (a, Vertex, Vertex)
forall rep. rep -> HalfTile rep
LD(a
v,Vertex
c,Vertex
b)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
c,Vertex
b) (Vertex
3,Vertex
1)
addDartShortE BoundaryState
bd (LK(Vertex
_,Vertex
b,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {a}. a -> HalfTile (a, Vertex, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: a -> HalfTile (a, Vertex, Vertex)
makeFace a
v = (a, Vertex, Vertex) -> HalfTile (a, Vertex, Vertex)
forall rep. rep -> HalfTile rep
RD(a
v,Vertex
c,Vertex
b)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
c,Vertex
b) (Vertex
1,Vertex
3)
addDartShortE BoundaryState
_ TileFace
_ = String -> Try Update
forall a. HasCallStack => String -> a
error String
"addDartShortE applied to non-kite face\n"
completeSunStar :: UChecker
completeSunStar :: UChecker
completeSunStar BoundaryState
bd TileFace
fc = if TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite TileFace
fc
then UChecker
addKiteLongE BoundaryState
bd TileFace
fc
else UChecker
addDartLongE BoundaryState
bd TileFace
fc
addKiteLongE :: UChecker
addKiteLongE :: UChecker
addKiteLongE BoundaryState
bd (LD(Vertex
a,Vertex
_,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {b}. b -> HalfTile (Vertex, b, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: b -> HalfTile (Vertex, b, Vertex)
makeFace b
v = (Vertex, b, Vertex) -> HalfTile (Vertex, b, Vertex)
forall rep. rep -> HalfTile rep
RK(Vertex
c,b
v,Vertex
a)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
c) (Vertex
2,Vertex
1)
addKiteLongE BoundaryState
bd (RD(Vertex
a,Vertex
b,Vertex
_)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {c}. c -> HalfTile (Vertex, Vertex, c)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: c -> HalfTile (Vertex, Vertex, c)
makeFace c
v = (Vertex, Vertex, c) -> HalfTile (Vertex, Vertex, c)
forall rep. rep -> HalfTile rep
LK(Vertex
b,Vertex
a,c
v)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
b,Vertex
a) (Vertex
1,Vertex
2)
addKiteLongE BoundaryState
bd (RK(Vertex
a,Vertex
_,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {c}. c -> HalfTile (Vertex, Vertex, c)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: c -> HalfTile (Vertex, Vertex, c)
makeFace c
v = (Vertex, Vertex, c) -> HalfTile (Vertex, Vertex, c)
forall rep. rep -> HalfTile rep
LK(Vertex
a,Vertex
c,c
v)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
c) (Vertex
1,Vertex
2)
addKiteLongE BoundaryState
bd (LK(Vertex
a,Vertex
b,Vertex
_)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {b}. b -> HalfTile (Vertex, b, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: b -> HalfTile (Vertex, b, Vertex)
makeFace b
v = (Vertex, b, Vertex) -> HalfTile (Vertex, b, Vertex)
forall rep. rep -> HalfTile rep
RK(Vertex
a,b
v,Vertex
b)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
b,Vertex
a) (Vertex
2,Vertex
1)
addDartLongE :: UChecker
addDartLongE :: UChecker
addDartLongE BoundaryState
bd (LD(Vertex
a,Vertex
_,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {c}. c -> HalfTile (Vertex, Vertex, c)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: c -> HalfTile (Vertex, Vertex, c)
makeFace c
v = (Vertex, Vertex, c) -> HalfTile (Vertex, Vertex, c)
forall rep. rep -> HalfTile rep
RD(Vertex
a,Vertex
c,c
v)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
c) (Vertex
1,Vertex
1)
addDartLongE BoundaryState
bd (RD(Vertex
a,Vertex
b,Vertex
_)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {b}. b -> HalfTile (Vertex, b, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: b -> HalfTile (Vertex, b, Vertex)
makeFace b
v = (Vertex, b, Vertex) -> HalfTile (Vertex, b, Vertex)
forall rep. rep -> HalfTile rep
LD(Vertex
a,b
v,Vertex
b)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
b,Vertex
a) (Vertex
1,Vertex
1)
addDartLongE BoundaryState
bd (LK(Vertex
a,Vertex
b,Vertex
_)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {c}. c -> HalfTile (Vertex, Vertex, c)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: c -> HalfTile (Vertex, Vertex, c)
makeFace c
v = (Vertex, Vertex, c) -> HalfTile (Vertex, Vertex, c)
forall rep. rep -> HalfTile rep
RD(Vertex
b,Vertex
a,c
v)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
b,Vertex
a) (Vertex
1,Vertex
1)
addDartLongE BoundaryState
bd (RK(Vertex
a,Vertex
_,Vertex
c)) = (Vertex -> TileFace) -> Maybe Vertex -> Update
makeUpdate Vertex -> TileFace
forall {b}. b -> HalfTile (Vertex, b, Vertex)
makeFace (Maybe Vertex -> Update)
-> Either String (Maybe Vertex) -> Try Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Maybe Vertex)
x where
makeFace :: b -> HalfTile (Vertex, b, Vertex)
makeFace b
v = (Vertex, b, Vertex) -> HalfTile (Vertex, b, Vertex)
forall rep. rep -> HalfTile rep
LD(Vertex
c,b
v,Vertex
a)
x :: Either String (Maybe Vertex)
x = BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
c) (Vertex
1,Vertex
1)
defaultAllUGen :: UpdateGenerator
defaultAllUGen :: UpdateGenerator
defaultAllUGen BoundaryState
bd [(Vertex, Vertex)]
es = [Try UpdateMap] -> Try UpdateMap
combine ([Try UpdateMap] -> Try UpdateMap)
-> [Try UpdateMap] -> Try UpdateMap
forall a b. (a -> b) -> a -> b
$ ((Vertex, Vertex) -> Try UpdateMap)
-> [(Vertex, Vertex)] -> [Try UpdateMap]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vertex, Vertex) -> Try UpdateMap
decide [(Vertex, Vertex)]
es where
decide :: (Vertex, Vertex) -> Try UpdateMap
decide (Vertex, Vertex)
e = ((Vertex, Vertex), TileFace, EdgeType) -> Try UpdateMap
forall {k}.
Ord k =>
(k, TileFace, EdgeType) -> Either String (Map k Update)
decider ((Vertex, Vertex)
e,TileFace
f,EdgeType
etype) where (TileFace
f,EdgeType
etype) = BoundaryState -> (Vertex, Vertex) -> (TileFace, EdgeType)
inspectBDedge BoundaryState
bd (Vertex, Vertex)
e
decider :: (k, TileFace, EdgeType) -> Either String (Map k Update)
decider (k
e,TileFace
f,EdgeType
Join) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
completeHalf BoundaryState
bd TileFace
f)
decider (k
e,TileFace
f,EdgeType
Short)
| TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
f = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
addKiteShortE BoundaryState
bd TileFace
f)
| Bool
otherwise = k -> TileFace -> Either String (Map k Update)
forall {k}. Ord k => k -> TileFace -> Either String (Map k Update)
kiteShortDecider k
e TileFace
f
decider (k
e,TileFace
f,EdgeType
Long)
| TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
f = k -> TileFace -> Either String (Map k Update)
forall {k}. Ord k => k -> TileFace -> Either String (Map k Update)
dartLongDecider k
e TileFace
f
| Bool
otherwise = k -> TileFace -> Either String (Map k Update)
forall {k}. Ord k => k -> TileFace -> Either String (Map k Update)
kiteLongDecider k
e TileFace
f
dartLongDecider :: k -> TileFace -> Either String (Map k Update)
dartLongDecider k
e TileFace
f
| BoundaryState -> Vertex -> Bool
mustbeStar BoundaryState
bd (TileFace -> Vertex
originV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
completeSunStar BoundaryState
bd TileFace
f)
| BoundaryState -> Vertex -> Bool
mustbeKing BoundaryState
bd (TileFace -> Vertex
originV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
addDartLongE BoundaryState
bd TileFace
f)
| BoundaryState -> Vertex -> Bool
mustbeJack BoundaryState
bd (TileFace -> Vertex
wingV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
addKiteLongE BoundaryState
bd TileFace
f)
| Bool
otherwise = Map k Update -> Either String (Map k Update)
forall a b. b -> Either a b
Right Map k Update
forall k a. Map k a
Map.empty
kiteLongDecider :: k -> TileFace -> Either String (Map k Update)
kiteLongDecider k
e TileFace
f
| BoundaryState -> Vertex -> Bool
mustbeSun BoundaryState
bd (TileFace -> Vertex
originV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
completeSunStar BoundaryState
bd TileFace
f)
| BoundaryState -> Vertex -> Bool
mustbeQueen BoundaryState
bd (TileFace -> Vertex
wingV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
addDartLongE BoundaryState
bd TileFace
f)
| Bool
otherwise = Map k Update -> Either String (Map k Update)
forall a b. b -> Either a b
Right Map k Update
forall k a. Map k a
Map.empty
kiteShortDecider :: k -> TileFace -> Either String (Map k Update)
kiteShortDecider k
e TileFace
f
| BoundaryState -> Vertex -> Bool
mustbeDeuce BoundaryState
bd (TileFace -> Vertex
oppV TileFace
f) Bool -> Bool -> Bool
|| BoundaryState -> Vertex -> Bool
mustbeJack BoundaryState
bd (TileFace -> Vertex
oppV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
addDartShortE BoundaryState
bd TileFace
f)
| BoundaryState -> Vertex -> Bool
mustbeQueen BoundaryState
bd (TileFace -> Vertex
wingV TileFace
f) Bool -> Bool -> Bool
|| BoundaryState -> Vertex -> Bool
isDartOrigin BoundaryState
bd (TileFace -> Vertex
wingV TileFace
f) = k -> Try Update -> Either String (Map k Update)
forall {f :: * -> *} {k} {a}.
(Functor f, Ord k) =>
k -> f a -> f (Map k a)
mapItem k
e (UChecker
addKiteShortE BoundaryState
bd TileFace
f)
| Bool
otherwise = Map k Update -> Either String (Map k Update)
forall a b. b -> Either a b
Right Map k Update
forall k a. Map k a
Map.empty
mapItem :: k -> f a -> f (Map k a)
mapItem k
e = (a -> Map k a) -> f a -> f (Map k a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
u -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
e a
u Map k a
forall k a. Map k a
Map.empty)
combine :: [Try UpdateMap] -> Try UpdateMap
combine = ([UpdateMap] -> UpdateMap)
-> Either String [UpdateMap] -> Try UpdateMap
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [UpdateMap] -> UpdateMap
forall a. Monoid a => [a] -> a
mconcat (Either String [UpdateMap] -> Try UpdateMap)
-> ([Try UpdateMap] -> Either String [UpdateMap])
-> [Try UpdateMap]
-> Try UpdateMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Try UpdateMap] -> Either String [UpdateMap]
forall a. [Try a] -> Try [a]
concatFails
inspectBDedge:: BoundaryState -> Dedge -> (TileFace, EdgeType)
inspectBDedge :: BoundaryState -> (Vertex, Vertex) -> (TileFace, EdgeType)
inspectBDedge BoundaryState
bd (Vertex, Vertex)
e = (TileFace
face,(Vertex, Vertex) -> TileFace -> EdgeType
edgeType ((Vertex, Vertex) -> (Vertex, Vertex)
reverseD (Vertex, Vertex)
e) TileFace
face) where
face :: TileFace
face = case BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd ((Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst (Vertex, Vertex)
e) [TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd ((Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd (Vertex, Vertex)
e) of
[TileFace
f] -> TileFace
f
[TileFace]
_ -> String -> TileFace
forall a. HasCallStack => String -> a
error (String -> TileFace) -> String -> TileFace
forall a b. (a -> b) -> a -> b
$ String
"inspectBDedge: Not a boundary directed edge " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex, Vertex)
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
tryFindThirdV:: BoundaryState -> Dedge -> (Int,Int) -> Try (Maybe Vertex)
tryFindThirdV :: BoundaryState
-> (Vertex, Vertex)
-> (Vertex, Vertex)
-> Either String (Maybe Vertex)
tryFindThirdV BoundaryState
bd (Vertex
a,Vertex
b) (Vertex
n,Vertex
m) = Either String (Maybe Vertex)
maybeV where
aAngle :: Vertex
aAngle = BoundaryState -> Vertex -> Vertex
externalAngle BoundaryState
bd Vertex
a
bAngle :: Vertex
bAngle = BoundaryState -> Vertex -> Vertex
externalAngle BoundaryState
bd Vertex
b
maybeV :: Either String (Maybe Vertex)
maybeV | Vertex
aAngle Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
<Vertex
1 Bool -> Bool -> Bool
|| Vertex
aAngle Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>Vertex
9
= String -> Either String (Maybe Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Vertex))
-> String -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryFindThirdV: vertex: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has (tt) external angle " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
aAngle
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nwhen adding to boundary directed edge: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
a,Vertex
b)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nwith faces at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TileFace] -> String
forall a. Show a => a -> String
show (BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd VertexMap [TileFace] -> Vertex -> [TileFace]
forall a. IntMap a -> Vertex -> a
VMap.! Vertex
a)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nand faces at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TileFace] -> String
forall a. Show a => a -> String
show (BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd VertexMap [TileFace] -> Vertex -> [TileFace]
forall a. IntMap a -> Vertex -> a
VMap.! Vertex
b)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nand a total of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show ([TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ([TileFace] -> Vertex) -> [TileFace] -> Vertex
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [TileFace]
allFaces BoundaryState
bd) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" faces.\n"
| Vertex
bAngle Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
<Vertex
1 Bool -> Bool -> Bool
|| Vertex
bAngle Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
>Vertex
9
= String -> Either String (Maybe Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Vertex))
-> String -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryFindThirdV: vertex: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has (tt) external angle " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
bAngle
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nwhen adding to boundary directed edge: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
a,Vertex
b)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nwith faces at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TileFace] -> String
forall a. Show a => a -> String
show (BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd VertexMap [TileFace] -> Vertex -> [TileFace]
forall a. IntMap a -> Vertex -> a
VMap.! Vertex
a)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nand faces at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TileFace] -> String
forall a. Show a => a -> String
show (BoundaryState -> VertexMap [TileFace]
bvFacesMap BoundaryState
bd VertexMap [TileFace] -> Vertex -> [TileFace]
forall a. IntMap a -> Vertex -> a
VMap.! Vertex
b)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nand a total of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show ([TileFace] -> Vertex
forall a. [a] -> Vertex
forall (t :: * -> *) a. Foldable t => t a -> Vertex
length ([TileFace] -> Vertex) -> [TileFace] -> Vertex
forall a b. (a -> b) -> a -> b
$ BoundaryState -> [TileFace]
allFaces BoundaryState
bd) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" faces.\n"
| Vertex
aAngle Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
< Vertex
n
= String -> Either String (Maybe Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Vertex))
-> String -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryFindThirdV: Found incorrect graph (stuck tiling)\nConflict at edge: "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
a,Vertex
b) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
| Vertex
bAngle Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
< Vertex
m
= String -> Either String (Maybe Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Vertex))
-> String -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryFindThirdV: Found incorrect graph (stuck tiling)\nConflict at edge: "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
a,Vertex
b) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
| Vertex
aAngle Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
n = case ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> Maybe (Vertex, Vertex)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
a) (Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd) (BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd) of
Just (Vertex, Vertex)
pr -> Maybe Vertex -> Either String (Maybe Vertex)
forall a b. b -> Either a b
Right (Maybe Vertex -> Either String (Maybe Vertex))
-> Maybe Vertex -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ Vertex -> Maybe Vertex
forall a. a -> Maybe a
Just ((Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst (Vertex, Vertex)
pr)
Maybe (Vertex, Vertex)
Nothing -> String -> Either String (Maybe Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Vertex))
-> String -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryFindThirdV: Impossible boundary. No predecessor/successor Dedge for Dedge "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
a,Vertex
b) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
| Vertex
bAngle Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
m = case ((Vertex, Vertex) -> Bool)
-> [(Vertex, Vertex)] -> Maybe (Vertex, Vertex)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
b) (Vertex -> Bool)
-> ((Vertex, Vertex) -> Vertex) -> (Vertex, Vertex) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex, Vertex) -> Vertex
forall a b. (a, b) -> a
fst) (BoundaryState -> [(Vertex, Vertex)]
boundary BoundaryState
bd) of
Just (Vertex, Vertex)
pr -> Maybe Vertex -> Either String (Maybe Vertex)
forall a b. b -> Either a b
Right (Maybe Vertex -> Either String (Maybe Vertex))
-> Maybe Vertex -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ Vertex -> Maybe Vertex
forall a. a -> Maybe a
Just ((Vertex, Vertex) -> Vertex
forall a b. (a, b) -> b
snd (Vertex, Vertex)
pr)
Maybe (Vertex, Vertex)
Nothing -> String -> Either String (Maybe Vertex)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Vertex))
-> String -> Either String (Maybe Vertex)
forall a b. (a -> b) -> a -> b
$ String
"tryFindThirdV: Impossible boundary. No predecessor/successor Dedge for Dedge "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex, Vertex) -> String
forall a. Show a => a -> String
show (Vertex
a,Vertex
b) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
| Bool
otherwise = Maybe Vertex -> Either String (Maybe Vertex)
forall a b. b -> Either a b
Right Maybe Vertex
forall a. Maybe a
Nothing
externalAngle:: BoundaryState -> Vertex -> Int
externalAngle :: BoundaryState -> Vertex -> Vertex
externalAngle BoundaryState
bd Vertex
v = Vertex
10 Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
- [Vertex] -> Vertex
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map (Vertex -> TileFace -> Vertex
intAngleAt Vertex
v) ([TileFace] -> [Vertex]) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ BoundaryState -> Vertex -> [TileFace]
facesAtBV BoundaryState
bd Vertex
v)
intAngleAt :: Vertex -> TileFace -> Int
intAngleAt :: Vertex -> TileFace -> Vertex
intAngleAt Vertex
v TileFace
fc = TileFace -> [Vertex]
faceIntAngles TileFace
fc [Vertex] -> Vertex -> Vertex
forall a. HasCallStack => [a] -> Vertex -> a
!! Vertex -> TileFace -> Vertex
indexV Vertex
v TileFace
fc
faceIntAngles :: TileFace -> [Int]
faceIntAngles :: TileFace -> [Vertex]
faceIntAngles (LD (Vertex, Vertex, Vertex)
_) = [Vertex
1,Vertex
3,Vertex
1]
faceIntAngles (RD (Vertex, Vertex, Vertex)
_) = [Vertex
1,Vertex
1,Vertex
3]
faceIntAngles TileFace
_ = [Vertex
1,Vertex
2,Vertex
2]