hgeometry-combinatorial 0.13 → 0.14

raw patch · 11 files changed

+103/−67 lines, 11 filesdep ~vector-circularPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: vector-circular

API changes (from Hackage documentation)

Files

• changelog +10/−0
• changelog.org +10/−0
• hgeometry-combinatorial.cabal +6/−5
• src/Algorithms/BinarySearch.hs +3/−3
• src/Data/DynamicOrd.hs +2/−1
• src/Data/PlanarGraph/IO.hs +34/−9
• src/Data/Range.hs +27/−43
• test/Algorithms/Graph/DFSSpec.hs +1/−1
• test/Algorithms/LogarithmicMethodSpec.hs +4/−4
• test/Data/EdgeOracleSpec.hs +1/−1
• test/Data/RangeSpec.hs +5/−0

@@ -2,6 +2,16 @@  * Changelog +** 0.14++- Got rid of proxies to build planar graphs, use TypeApplication+  instead. Also slightly changed some of the types to better reflect+  what they need; in particular 'buildGraph' now takes only the+  adjacency lists (no face information). And 'fromAdjRep' which+  computes a PlanarGraph from its adjacencylists (including vertex and+  edge info.)+- Cleaning up the public API by hiding several internal modules.+ ** 0.13  - Moved 'intersects' from the HasIntersectionWith class into a new

@@ -2,6 +2,16 @@  * Changelog +** 0.14++- Got rid of proxies to build planar graphs, use TypeApplication+  instead. Also slightly changed some of the types to better reflect+  what they need; in particular 'buildGraph' now takes only the+  adjacency lists (no face information). And 'fromAdjRep' which+  computes a PlanarGraph from its adjacencylists (including vertex and+  edge info.)+- Cleaning up the public API by hiding several internal modules.+ ** 0.13  - Moved 'intersects' from the HasIntersectionWith class into a new

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                hgeometry-combinatorial-version:             0.13+version:             0.14 synopsis:            Data structures, and Data types. description:     The Non-geometric data types and algorithms used in HGeometry.@@ -110,10 +110,8 @@                     Data.PlanarGraph.Immutable                     Data.PlanarGraph.AdjRep                     Data.PlanarGraph.IO-                    Data.PlanarGraph.Dart-                    Data.PlanarGraph.Core-                    Data.PlanarGraph.Dual                     Data.PlanarGraph.EdgeOracle+                    Data.PlanarGraph.Dart                      -- * Other                     System.Random.Shuffle@@ -125,7 +123,10 @@                     Data.Yaml.Util    other-modules:    Data.PlanarGraph.Internal+                    Data.PlanarGraph.Core+                    Data.PlanarGraph.Dual +   -- other-extensions:   build-depends:                 base                    >= 4.11      &&     < 5@@ -154,7 +155,7 @@                , vector                  >= 0.11               , data-clist              >= 0.1.2.3-              , vector-circular         >= 0.1.2+              , vector-circular         >= 0.1.4               , nonempty-vector         >= 0.2.0.0               , vector-builder          >= 0.3.7               , unordered-containers

@@ -9,12 +9,12 @@ module Algorithms.BinarySearch where  import           Control.Applicative ((<|>))+import           Data.Kind import           Data.Sequence (Seq, ViewL(..),ViewR(..)) import qualified Data.Sequence as Seq import           Data.Set (Set) import qualified Data.Set.Internal as Set import qualified Data.Vector.Generic as V- --------------------------------------------------------------------------------  -- | Given a monotonic predicate p, a lower bound l, and an upper bound u, with:@@ -69,8 +69,8 @@   class BinarySearch v where-  type Index v :: *-  type Elem  v :: *+  type Index v :: Type+  type Elem  v :: Type    -- | Given a monotonic predicate p and a data structure v, find the   -- element v[h] such that that

@@ -8,6 +8,7 @@ -------------------------------------------------------------------------------- module Data.DynamicOrd where +import Data.Kind import Data.Proxy import Data.Reflection import Unsafe.Coerce@@ -18,7 +19,7 @@ -- https://www.schoolofhaskell.com/user/thoughtpolice/using-reflection  -- | Values of type '@a@' in our dynamically constructed 'Ord' instance-newtype O (s :: *) (a :: *) = O { runO :: a } deriving (Show)+newtype O (s :: Type) (a :: Type) = O { runO :: a } deriving (Show)  -- | An Ord Dictionary newtype OrdDict a = OrdDict { compare_ :: a -> a -> Ordering }

@@ -25,7 +25,6 @@ import           Data.PlanarGraph.Dart import           Data.PlanarGraph.Dual import           Data.PlanarGraph.EdgeOracle-import           Data.Proxy import qualified Data.Vector                 as V import qualified Data.Vector.Mutable         as MV @@ -36,7 +35,7 @@   toJSON     = toJSON     . toAdjRep  instance (FromJSON v, FromJSON e, FromJSON f) => FromJSON (PlanarGraph s Primal v e f) where-  parseJSON v = fromAdjRep (Proxy :: Proxy s) <$> parseJSON v+  parseJSON v = fromAdjRep @s <$> parseJSON v  -------------------------------------------------------------------------------- @@ -71,13 +70,13 @@ -- should be in counter clockwise order. -- -- running time: \(O(n)\)-fromAdjRep                  :: proxy s -> Gr (Vtx v e) (Face f) -> PlanarGraph s Primal v e f-fromAdjRep px gr@(Gr as fs) = g&vertexData .~ reorder vs' _unVertexId-                               &dartData   .~ ds-                               &faceData   .~ reorder fs' (_unVertexId._unFaceId)+fromAdjRep            :: forall s v e f. Gr (Vtx v e) (Face f) -> PlanarGraph s Primal v e f+fromAdjRep (Gr as fs) = g&vertexData .~ reorder vs' _unVertexId+                         &dartData   .~ ds+                         &faceData   .~ reorder fs' (_unVertexId._unFaceId)   where     -- build the actual graph using the adjacencies-    g = buildGraph px gr+    g = buildGraph as     -- build an edge oracle so that we can quickly lookup the dart corresponding to a     -- pair of vertices.     oracle = edgeOracle g@@ -95,13 +94,39 @@    -- TODO: Properly handle graphs with self-loops +-- | Read a planar graph, given by its adjacencylists in counter clockwise order.+--+-- pre: no self-loops and no multiedges+--+-- running time: \(O(n)\)+fromAdjRep'    :: forall s v e. [Vtx v e] -> PlanarGraph s Primal v e ()+fromAdjRep' as = g&vertexData .~ reorder vs' _unVertexId+                  &dartData   .~ ds+  where+    -- build the actual graph using the adjacencies+    g = buildGraph as+    -- build an edge oracle so that we can quickly lookup the dart corresponding to a+    -- pair of vertices.+    oracle = edgeOracle g+    -- function to lookup a given dart+    findEdge' u v = fromJust $ findDart u v oracle++    vs' = V.fromList [ VertexId vi :+ v     | Vtx vi _ v <- as ]+    ds = V.fromList $ concatMap (\(Vtx vi us _) ->+                                   [(findEdge' (VertexId vi) (VertexId ui), x) | (ui,x) <- us]+                                ) as++  -- TODO: Properly handle graphs with self-loops++ -- | Builds the graph from the adjacency lists (but ignores all associated data)-buildGraph              :: proxy s -> Gr (Vtx v e) (Face f) -> PlanarGraph s Primal () () ()-buildGraph _ (Gr as' _) = fromAdjacencyLists as+buildGraph     :: forall s v e. [Vtx v e] -> PlanarGraph s Primal () () ()+buildGraph as' = fromAdjacencyLists as   where     as = [ (VertexId vi, V.fromList [VertexId ui | (ui,_) <- us])          | Vtx vi us _ <- as'          ]+  -- make sure we order the data values appropriately reorder     :: V.Vector (i :+ a) -> (i -> Int) -> V.Vector a

@@ -23,6 +23,7 @@                  , shiftLeft, shiftRight                  ) where +import Control.Monad((<=<)) import Control.DeepSeq import Control.Lens import Control.Applicative@@ -215,8 +216,9 @@    -- The intersection is empty, if after clipping, the order of the end points is inverted   -- or if the endpoints are the same, but both are open.-  (Range l u) `intersect` s = let i = clipLower' l . clipUpper' u $ s-                              in if isValidRange i then coRec i else coRec NoIntersection+  (Range l u) `intersect` s = case (clipLower l <=< clipUpper u $ s) of+                                Nothing -> coRec NoIntersection+                                Just i  -> coRec i  -- | Get the width of the interval --@@ -258,63 +260,45 @@ -- | Clip the interval from below. I.e. intersect with the interval {l,infty), -- where { is either open, (, orr closed, [. clipLower     :: Ord a => EndPoint a -> Range a -> Maybe (Range a)-clipLower l r = let r' = clipLower' l r in if isValidRange r' then Just r' else Nothing+clipLower p rr@(Range l r) = case (p^.unEndPoint) `compare` (r^.unEndPoint) of+                               GT                        -> Nothing+                               EQ | isOpen r || isOpen p -> Nothing+                               _                         -> Just $+                                 case (p^.unEndPoint) `compare` (l^.unEndPoint) of+                                   LT -> rr+                                   EQ -> if isOpen p then Range p r else rr+                                   GT -> Range p r  -- | Clip the interval from above. I.e. intersect with (-\infty, u}, where } is -- either open, ), or closed, ], clipUpper     :: Ord a => EndPoint a -> Range a -> Maybe (Range a)-clipUpper u r = let r' = clipUpper' u r in if isValidRange r' then Just r' else Nothing+clipUpper p (Range l r) = case (p^.unEndPoint) `compare` (l^.unEndPoint) of+                            LT                        -> Nothing+                            EQ | isOpen l || isOpen p -> Nothing+                            _                         -> Just $ Range l (p `min` r) + -- | Wether or not the first range completely covers the second one covers       :: forall a. Ord a => Range a -> Range a -> Bool x `covers` y = (== Just y) . asA @(Range a) $ x `intersect` y - -- | Check if the range is valid and nonEmpty, i.e. if the lower endpoint is -- indeed smaller than the right endpoint. Note that we treat empty open-ranges -- as invalid as well.+--+-- >>> isValidRange $ Range (Open 4) (Closed 4)+-- False+-- >>> isValidRange $ Range (Open 5) (Closed 4)+-- False+-- >>> isValidRange $ Range (Open 4) (Closed 5)+-- True+-- >>> isValidRange $ Range (Closed 5) (Closed 40)+-- True isValidRange             :: Ord a => Range a -> Bool isValidRange (Range l u) = case _unEndPoint l `compare` _unEndPoint u of                              LT                            -> True-                             EQ | isClosed l || isClosed u -> True+                             EQ | isClosed l && isClosed u -> True                              _                             -> False---- operation is unsafe, as it may produce an invalid range (where l > u)-clipLower'                  :: Ord a => EndPoint a -> Range a -> Range a-clipLower' l' r@(Range l u) = case l' `cmpLower` l of-                                GT -> Range l' u-                                _  -> r--- operation is unsafe, as it may produce an invalid range (where l > u)-clipUpper'                  :: Ord a => EndPoint a -> Range a -> Range a-clipUpper' u' r@(Range l u) = case u' `cmpUpper` u of-                                LT -> Range l u'-                                _  -> r---- | Compare end points, Closed < Open-cmpLower     :: Ord a => EndPoint a -> EndPoint a -> Ordering-cmpLower a b = case _unEndPoint a `compare` _unEndPoint b of-                 LT -> LT-                 GT -> GT-                 EQ -> case (a,b) of-                         (Open _,   Open _)   -> EQ  -- if both are same type, report EQ-                         (Closed _, Closed _) -> EQ-                         (Open _,  _)         -> GT  -- otherwise, choose the Closed one-                         (Closed _,_)         -> LT  -- is the *smallest*----- | Compare the end points, Open < Closed-cmpUpper     :: Ord a => EndPoint a -> EndPoint a -> Ordering-cmpUpper a b = case _unEndPoint a `compare` _unEndPoint b of-                 LT -> LT-                 GT -> GT-                 EQ -> case (a,b) of-                         (Open _,   Open _)   -> EQ  -- if both are same type, report EQ-                         (Closed _, Closed _) -> EQ-                         (Open _,  _)         -> LT  -- otherwise, choose the Closed one-                         (Closed _,_)         -> GT  -- is the *largest*---  -------------------------------------------------------------------------------- 

@@ -5,7 +5,7 @@ import           Control.DeepSeq       (NFData (rnf)) import           Control.Exception     (evaluate) import qualified Data.Foldable         as F-import           Data.PlanarGraph.Core (VertexId (VertexId), World (Primal))+import           Data.PlanarGraph (VertexId (VertexId), World (Primal)) import qualified Data.Set              as S import           Data.Tree             (Tree (rootLabel, subForest)) import           Test.Hspec            (Spec, anyErrorCall, describe, it, shouldBe, shouldThrow)

@@ -33,13 +33,13 @@ instance Ord a => LogarithmicMethodDS DummySucc a where   build = Dummy . NonEmpty.sort -successor'              :: Ord a => a -> DummySucc a -> Option (Min a)+successor'              :: Ord a => a -> DummySucc a -> Maybe (Min a) successor' q (Dummy xs) = case NonEmpty.dropWhile (< q) xs of-                            []    -> Option Nothing-                            (s:_) -> Option (Just (Min s))+                            []    -> Nothing+                            (s:_) -> Just (Min s)  successor   :: Ord a => a -> InsertionOnly DummySucc a -> Maybe a-successor q = fmap getMin . getOption . queryWith (successor' q)+successor q = fmap getMin . queryWith (successor' q)  fromList :: Ord a => [a] -> InsertionOnly DummySucc a fromList = foldr insert empty

@@ -3,7 +3,7 @@ import           Control.Arrow import           Data.Ext import           Data.PlanarGraph.EdgeOracle-import           Data.PlanarGraph.Core+import           Data.PlanarGraph import           Data.Semigroup import qualified Data.Set as S import           Test.Hspec

@@ -18,6 +18,11 @@     it "closed cap open, disjoint" $ do       ((ClosedRange (1::Int) 10) `intersect` (OpenRange 50 (60 :: Int)))       `shouldBe` (coRec NoIntersection)+    it "endpoints overlap but open/closed" $ do+      let r1, r2 :: Range Int+          r1 = ClosedRange 3 6+          r2 = Range (Open 1) (Open 3)+        in (r1 `intersects` r2) `shouldBe` False     -- it "closed intersect open" $     --   ((OpenRange 1 (10 :: Int)) `intersect` (ClosedRange 10 (12 :: Int)))     --   `shouldBe` (coRec NoIntersection)