hgeometry-combinatorial 0.9.0.0 → 0.10.0.0

raw patch · 12 files changed

+193/−40 lines, 12 filesdep ~singletonsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: singletons

API changes (from Hackage documentation)

Files

• hgeometry-combinatorial.cabal +5/−4
• src/Algorithms/DivideAndConquer.hs +71/−0
• src/Data/BinaryTree.hs +3/−10
• src/Data/LSeq.hs +6/−1
• src/Data/PlanarGraph/AdjRep.hs +11/−5
• src/Data/PlanarGraph/Core.hs +2/−0
• src/Data/PlanarGraph/IO.hs +3/−3
• src/Data/UnBounded.hs +24/−2
• src/Data/Util.hs +11/−0
• src/Data/Yaml/Util.hs +12/−1
• test/Algorithms/DivideAndConquerSpec.hs +31/−0
• test/Data/PlanarGraph/myGraph.yaml +14/−14

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                hgeometry-combinatorial-version:             0.9.0.0+version:             0.10.0.0 synopsis:            Data structures, and Data types. description:     The Non-geometric data types and algorithms used in HGeometry.@@ -40,6 +40,9 @@   ghc-options: -O2 -Wall -fno-warn-unticked-promoted-constructors -fno-warn-type-defaults    exposed-modules:+                    -- * Algorithmic Strategies+                    Algorithms.DivideAndConquer+                     -- * Graph Algorithms                     Algorithms.Graph.DFS                     Algorithms.Graph.MST@@ -96,7 +99,6 @@               , contravariant           >= 1.5               , semigroupoids           >= 5               , semigroups              >= 0.18-              , singletons              >= 2.0               , vinyl                   >= 0.10               , deepseq                 >= 1.1               , fingertree              >= 0.1@@ -146,9 +148,7 @@                     , DeriveFoldable                     , DeriveTraversable                     , DeriveGeneric-                    , AutoDeriveTypeable -                     , FlexibleInstances                     , FlexibleContexts                     , MultiParamTypeClasses@@ -175,6 +175,7 @@   build-tool-depends: hspec-discover:hspec-discover    other-modules: Algorithms.StringSearch.KMPSpec+                 Algorithms.DivideAndConquerSpec                  Data.RangeSpec                  Data.EdgeOracleSpec                  Data.PlanarGraphSpec

@@ -0,0 +1,71 @@+module Algorithms.DivideAndConquer( divideAndConquer+                                  , divideAndConquer1+                                  , divideAndConquer1With++                                  , mergeSorted, mergeSortedLists+                                  , mergeSortedBy+                                  , mergeSortedListsBy+                                  ) where++import           Data.List.NonEmpty (NonEmpty(..),(<|))+import qualified Data.List.NonEmpty as NonEmpty+++-- | Divide and conquer strategy+--+-- the running time is: O(n*L) + T(n) = 2T(n/2) + M(n)+--+-- where M(n) is the time corresponding to the semigroup operation of s+--+divideAndConquer1 :: Semigroup s => (a -> s) -> NonEmpty a -> s+divideAndConquer1 = divideAndConquer1With (<>)+++-- | Divide and conquer for+divideAndConquer   :: Monoid s => (a -> s) -> [a] -> s+divideAndConquer g = maybe mempty (divideAndConquer1 g) . NonEmpty.nonEmpty++-- | Divide and conquer strategy+--+-- the running time is: O(n*L) + T(n) = 2T(n/2) + M(n)+--+-- where M(n) is the time corresponding to the merge operation s+--+divideAndConquer1With         :: (s -> s -> s) -> (a -> s) -> NonEmpty a -> s+divideAndConquer1With (<.>) g = repeatedly merge . fmap g+  where+    repeatedly _ (t :| []) = t+    repeatedly f ts        = repeatedly f $ f ts++    merge ts@(_ :| [])  = ts+    merge (l :| r : []) = l <.> r :| []+    merge (l :| r : ts) = l <.> r <| (merge $ NonEmpty.fromList ts)+++--------------------------------------------------------------------------------+-- * Merging NonEmpties/Sorted lists++mergeSorted :: Ord a => NonEmpty a -> NonEmpty a -> NonEmpty a+mergeSorted = mergeSortedBy compare++mergeSortedLists :: Ord a => [a] -> [a] -> [a]+mergeSortedLists = mergeSortedListsBy compare++-- | Given an ordering and two nonempty sequences ordered according to that+-- ordering, merge them+mergeSortedBy           :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a -> NonEmpty a+mergeSortedBy cmp ls rs = NonEmpty.fromList+                        $ mergeSortedListsBy cmp (NonEmpty.toList ls) (NonEmpty.toList rs)+++-- | Given an ordering and two nonempty sequences ordered according to that+-- ordering, merge them+mergeSortedListsBy     :: (a -> a -> Ordering) -> [a] -> [a] -> [a]+mergeSortedListsBy cmp = go+  where+    go []         ys     = ys+    go xs         []     = xs+    go xs@(x:xs') ys@(y:ys') = case x `cmp` y of+                                 LT -> x : go xs' ys+                                 EQ -> x : go xs' ys+                                 GT -> y : go xs  ys'

@@ -12,10 +12,10 @@ -------------------------------------------------------------------------------- module Data.BinaryTree where +import           Algorithms.DivideAndConquer import           Control.DeepSeq import           Data.Bifunctor.Apply-import           Data.List.NonEmpty (NonEmpty(..),(<|))-import qualified Data.List.NonEmpty as NonEmpty+import           Data.List.NonEmpty (NonEmpty) import           Data.Maybe (mapMaybe) import           Data.Semigroup.Foldable import qualified Data.Tree as Tree@@ -76,14 +76,7 @@ -- -- \(O(n)\) time. asBalancedBinLeafTree :: NonEmpty a -> BinLeafTree Size (Elem a)-asBalancedBinLeafTree = repeatedly merge . fmap (Leaf . Elem)-  where-    repeatedly _ (t :| []) = t-    repeatedly f ts        = repeatedly f $ f ts--    merge ts@(_ :| [])  = ts-    merge (l :| r : []) = node l r :| []-    merge (l :| r : ts) = node l r <| (merge $ NonEmpty.fromList ts)+asBalancedBinLeafTree = divideAndConquer1 (Leaf . Elem) -- -- the implementation below produces slightly less high trees, but runs in -- -- \(O(n \log n)\) time, as on every level it traverses the list passed down. -- asBalancedBinLeafTree ys = asBLT (length ys') ys' where ys' = toList ys

@@ -48,6 +48,7 @@ import           Control.DeepSeq import           Control.Lens ((%~), (&), (<&>), (^?), bimap) import           Control.Lens.At (Ixed(..), Index, IxValue)+import           Data.Aeson import qualified Data.Foldable as F import qualified Data.List.NonEmpty as NonEmpty import           Data.Maybe (fromJust)@@ -58,7 +59,7 @@ import           GHC.Generics (Generic) import           GHC.TypeLits import           Prelude hiding (drop,take,head,last)-import           Test.QuickCheck(Arbitrary(..),vector)+import           Test.QuickCheck (Arbitrary(..),vector)  -------------------------------------------------------------------------------- @@ -88,6 +89,10 @@   arbitrary = (\s s' -> promise . fromList $ s <> s')             <$> vector (fromInteger . natVal $ (Proxy :: Proxy n))             <*> arbitrary++instance ToJSON a => ToJSON (LSeq n a) where+    toEncoding = genericToEncoding defaultOptions+instance FromJSON a => FromJSON (LSeq n a)   type instance Index   (LSeq n a) = Int

@@ -18,8 +18,8 @@ --------------------------------------------------------------------------------  -- | Data type representing the graph in its JSON/Yaml format-data Gr v f = Gr { ajacencies :: [v]-                 , faces      :: [f]+data Gr v f = Gr { adjacencies :: [v]+                 , faces       :: [f]                  } deriving (Generic)  instance Bifunctor Gr where@@ -33,9 +33,15 @@  -- | A vertex, represented by an id, its adjacencies, and its data. data Vtx v e = Vtx { id    :: Int-                   , adj   :: [(Int,e)] -- ^ adjacent vertices + data on the-                                        -- edge. Adjacencies are given in-                                        -- arbitrary order+                   , adj   :: [(Int,e)] -- ^ adjacent vertices + data+                                        -- on the edge. Some+                                        -- functions, like+                                        -- 'fromAdjRep' may assume+                                        -- that the adjacencies are+                                        -- given in counterclockwise+                                        -- order around the+                                        -- vertices. This is not (yet)+                                        -- enforced by the data type.                    , vData :: v                    } deriving (Generic) 

@@ -424,6 +424,8 @@  -- | All edges incident to vertex v, in counterclockwise order around v. --+--+-- -- running time: \(O(k)\), where \(k\) is the output size incidentEdges                :: VertexId s w -> PlanarGraph s w v e f                              -> V.Vector (Dart s)

@@ -42,9 +42,9 @@ --------------------------------------------------------------------------------  --- | Transforms the planar graph into a format taht can be easily converted+-- | Transforms the planar graph into a format that can be easily converted -- into JSON format. For every vertex, the adjacent vertices are given in--- counter clockwise order.+-- counter-clockwise order. -- -- See 'toAdjacencyLists' for notes on how we handle self-loops. --@@ -115,7 +115,7 @@ --------------------------------------------------------------------------------  -- | Construct a planar graph from a adjacency matrix. For every vertex, all--- vertices should be given in counter clockwise order.+-- vertices should be given in counter-clockwise order. -- -- pre: No self-loops, and no multi-edges --

@@ -1,12 +1,15 @@ {-# LANGUAGE TemplateHaskell   #-} module Data.UnBounded( Top, topToMaybe                      , pattern ValT, pattern Top+                     , _ValT, _Top                       , Bottom, bottomToMaybe                      , pattern Bottom, pattern ValB+                     , _ValB, _Bottom                       , UnBounded(..)                      , unUnBounded+                     , _MinInfinity, _Val, _MaxInfinity                      , unBoundedToMaybe                      ) where @@ -47,6 +50,12 @@   show Top       = "Top"   show ~(ValT x) = "ValT " ++ show x +_ValT :: Prism (Top a) (Top b) a b+_ValT = prism ValT (\ta -> case ta of Top -> Left Top ; ValT x -> Right x)++_Top :: Prism' (Top a) ()+_Top = prism' (const Top) (\ta -> case ta of Top -> Just () ; ValT _ -> Nothing)+ --------------------------------------------------------------------------------  -- | `Bottom a` represents the type a, together with a 'Bottom' element,@@ -69,6 +78,12 @@   show Bottom    = "Bottom"   show ~(ValB x) = "ValB " ++ show x +_ValB :: Prism (Bottom a) (Bottom b) a b+_ValB = prism ValB (\ba -> case ba of Bottom -> Left Bottom ; ValB x -> Right x)++_Bottom :: Prism' (Bottom a) ()+_Bottom = prism' (const Bottom) (\ba -> case ba of Bottom -> Just () ; ValB _ -> Nothing)+ --------------------------------------------------------------------------------  -- | `UnBounded a` represents the type a, together with an element@@ -76,8 +91,8 @@ -- smaller than any other element. data UnBounded a = MinInfinity | Val { _unUnBounded :: a }  | MaxInfinity                  deriving (Eq,Ord,Functor,F.Foldable,T.Traversable)- makeLenses ''UnBounded+makePrisms ''UnBounded  instance Show a => Show (UnBounded a) where   show MinInfinity = "MinInfinity"@@ -121,7 +136,14 @@    fromRational = Val . fromRational -+-- | Test if an Unbounded is actually bounded.+--+-- >>> unBoundedToMaybe (Val 5)+-- Just 5+-- >>> unBoundedToMaybe MinInfinity+-- Nothing+-- >>> unBoundedToMaybe MaxInfinity+-- Nothing unBoundedToMaybe         :: UnBounded a -> Maybe a unBoundedToMaybe (Val x) = Just x unBoundedToMaybe _       = Nothing

@@ -47,6 +47,9 @@ uniqueTriplets xs = [ STR x y z | (x:ys) <- nonEmptyTails xs, SP y z <- uniquePairs ys]  +++ -------------------------------------------------------------------------------- -- * Strict Pairs @@ -88,6 +91,14 @@ -- uniquePairs    :: [a] -> [Two a] uniquePairs xs = [ Two x y | (x:ys) <- nonEmptyTails xs, y <- ys ]++--------------------------------------------------------------------------------+-- | Strict Triple with all items the same+type Three a = STR a a a++pattern Three :: a -> a -> a -> Three a+pattern Three a b c = STR a b c+{-# COMPLETE Three #-}  -------------------------------------------------------------------------------- 

@@ -31,7 +31,7 @@  -- | Write the output to yaml encodeYaml :: ToJSON a => a -> ByteString-encodeYaml = YamlP.encodePretty YamlP.defConfig+encodeYaml = YamlP.encodePretty encoderConfig  -- | Prints the yaml printYaml :: ToJSON a => a -> IO ()@@ -48,6 +48,17 @@ -- | Encode a yaml file encodeYamlFile    :: ToJSON a => FilePath -> a -> IO () encodeYamlFile fp = B.writeFile fp . encodeYaml++++--------------------------------------------------------------------------------++-- | Encoder Configuration that we want to use.+encoderConfig :: YamlP.Config+encoderConfig = YamlP.setConfCompare compare YamlP.defConfig+                -- sort fields alphabetically++--------------------------------------------------------------------------------   -- | Data type for things that have a version

@@ -0,0 +1,31 @@+module Algorithms.DivideAndConquerSpec where++import Algorithms.DivideAndConquer++import           Test.Hspec+import           Test.QuickCheck+import qualified Data.List as List++spec = describe "divide and conquer strategy tests" $ do+         it "mergeSort" $ property $+           \(xs :: [Int]) -> List.sort xs == mergeSort xs+++newtype MergeSort a = MergeSort [a]++instance Ord a => Semigroup (MergeSort a) where+  (MergeSort l) <> (MergeSort r) = MergeSort $ merge l r+    where+      merge [] ys = ys+      merge xs [] = xs+      merge a@(x:xs) b@(y:ys) = case x `compare` y of+                              LT -> x : merge xs b+                              EQ -> x : y : merge xs ys+                              GT -> y : merge a ys++instance Ord a => Monoid (MergeSort a) where+  mempty = MergeSort []+++mergeSort :: Ord a => [a] -> [a]+mergeSort = (\(MergeSort xs) -> xs) . divideAndConquer (\x -> MergeSort [x])

@@ -1,17 +1,4 @@-faces:-- incidentEdge:-  - 0-  - 1-  fData: []-- incidentEdge:-  - 1-  - 4-  fData: []-- incidentEdge:-  - 2-  - 4-  fData: []-ajacencies:+adjacencies: - adj:   - - 1     - []@@ -58,3 +45,16 @@     - []   id: 5   vData: []+faces:+- fData: []+  incidentEdge:+  - 0+  - 1+- fData: []+  incidentEdge:+  - 1+  - 4+- fData: []+  incidentEdge:+  - 2+  - 4