hgis 0.1.3.1 → 0.1.3.2
raw patch · 5 files changed
+46/−37 lines, 5 filesdep ~Chartdep ~Chart-cairodep ~Chart-diagrams
Dependency ranges changed: Chart, Chart-cairo, Chart-diagrams, ansi-wl-pprint, base, binary, bytestring, colour, composition, data-binary-ieee754, data-default, directory, filepath, hgis, hspec, lens, monad-loops, optparse-applicative, transformers
Files
- hgis.cabal +22/−23
- src/GIS/Exe/OptCairo.hs +2/−1
- src/GIS/Hylo.hs +6/−7
- src/GIS/Math/Spherical.hs +13/−3
- test/Spec.hs +3/−3
hgis.cabal view
@@ -1,5 +1,5 @@ name: hgis-version: 0.1.3.1+version: 0.1.3.2 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -42,23 +42,22 @@ GIS.Math.Projections build-depends: base >=4.7 && <5,- optparse-applicative >=0.13.2.0,- Chart >=1.8.2,- Chart-cairo >=1.8.2,- Chart-diagrams >=1.8.2,- lens >=4.15.1,- composition >=1.0.2.1,- ansi-wl-pprint >=0.6.7.3,- transformers >=0.5.2.0,- directory >=1.3.0.0,- colour >=2.3.3,- data-default >=0.7.1.1,- binary >=0.8.3.0,- bytestring >=0.10.8.1,- data-binary-ieee754 >=0.4.4,- filepath >=1.4.1.1,- monad-loops >=0.4.3- pkgconfig-depends: cairo >=0.13.3.1+ optparse-applicative >=0.13.2.0 && <0.14,+ Chart >=1.8.2 && <1.9,+ Chart-cairo >=1.8.2 && <1.9,+ Chart-diagrams >=1.8.2 && <1.9,+ lens >=4.15.1 && <4.16,+ composition >=1.0.2.1 && <1.1,+ ansi-wl-pprint >=0.6.7.3 && <0.7,+ transformers >=0.5.2.0 && <0.6,+ directory >=1.3.0.0 && <1.4,+ colour >=2.3.3 && <2.4,+ data-default >=0.7.1.1 && <0.8,+ binary >=0.8.3.0 && <0.9,+ bytestring >=0.10.8.1 && <0.11,+ data-binary-ieee754 >=0.4.4 && <0.5,+ filepath >=1.4.1.1 && <1.5,+ monad-loops >=0.4.3 && <0.5 default-language: Haskell2010 default-extensions: DeriveGeneric OverloadedStrings hs-source-dirs: src src/depends/readshp@@ -84,8 +83,8 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N main-is: MainPng.hs build-depends:- base >=4.9.1.0,- hgis >=0.1.3.1+ base >=4.9.1.0 && <4.10,+ hgis >=0.1.3.2 && <0.2 default-language: Haskell2010 hs-source-dirs: app @@ -93,9 +92,9 @@ type: exitcode-stdio-1.0 main-is: Spec.hs build-depends:- base >=4.9.1.0,- hgis >=0.1.3.1,- hspec >=2.4.2+ base >=4.9.1.0 && <4.10,+ hgis >=0.1.3.2 && <0.2,+ hspec >=2.4.2 && <2.5 default-language: Haskell2010 hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N
src/GIS/Exe/OptCairo.hs view
@@ -39,7 +39,8 @@ case comp of "perimeter" -> putStrLn =<< districtPerimeter <$> getDistricts infile "area" -> putStrLn =<< districtArea <$> getDistricts infile- --compactness too! + "compactness" -> putStrLn =<< districtCompactness <$> getDistricts infile+ _ -> putStrLn "computation not recognized" -- | Make maps as png files. makeFoldersPng :: [Map] -> IO ()
src/GIS/Hylo.hs view
@@ -30,6 +30,11 @@ districtPerimeter districts = concat . intercalate (pure "\n") $ map (pure . show . distP) districts where distP (District _ label perimeter _) = (label, perimeter) +-- FIXME use the other function? put compactness in +districtCompactness :: [District] -> String+districtCompactness districts = concat . intercalate (pure "\n") $ map (pure . show . distC) districts+ where distC (District _ label perimeter area) = (label, (sum area)/perimeter^2)+ -- | Given a projection and lists of districts, draw a map. districtToMapP :: Projection -> [District] -> Map districtToMapP p = projectMap p . districtToMap@@ -57,16 +62,10 @@ file <- if dbfExists then readShpWithDbf filepath else readShpFile filepath let districtLabels = fromJust $ (fmap labels) $ mapM (shpRecLabel) . shpRecs $ file -- <$> for print? let shapes = (map (getPolygon . fromJust . shpRecContents)) . shpRecs $ file- let perimeters = map (getPerimeter . getPolygon . fromJust . shpRecContents) . shpRecs $ file+ let perimeters = map (totalPerimeter . getPolygon . fromJust . shpRecContents) . shpRecs $ file let areas = map (fmap areaPolygon . getPolygon . fromJust . shpRecContents) . shpRecs $ file let tuple = zip4 shapes districtLabels perimeters areas pure $ fmap (\(a,b,c,d) -> District a b c d) tuple---- | Given a list of polygons, return the total area.-getPerimeter :: [Polygon] -> Double-getPerimeter lines = sum $ fmap segmentLength lines- where segmentLength [x1, x2] = distance x1 x2- segmentLength (x1:x2:points) = segmentLength (x2:points) + distance x1 x2 -- | Helper function for extracting from shapefiles. getPolygon :: RecContents -> [Polygon]
src/GIS/Math/Spherical.hs view
@@ -1,4 +1,4 @@--- | Utilities to compute area, perimeter, etc. on the surface of a sphere.+-- | Utilities to compute area, perimeterPolygon, etc. on the surface of a sphere. module GIS.Math.Spherical where import Control.Lens@@ -31,6 +31,9 @@ -- mandelbrot/fractal dimension? -- consider "area of largest circumscribable circle" as well. +compactness1 :: Polygon -> Double+compactness1 p = (areaPolygon p)/(perimeterPolygon p)+ -- | Compute the area of a convex polygon on the surface of a sphere. areaConvex :: Polygon -> Double areaConvex (base1:base2:pts) = (view _1) $ foldr stepArea (0,base2) pts@@ -43,10 +46,17 @@ areaPolygon = (*factor) . areaPolyRectangular . fmap (bonne . toRadians) where factor = 1717856/4.219690791828533e-2 +-- | Given a list of polygons, return the total area.+totalPerimeter :: [Polygon] -> Double+totalPerimeter lines = sum $ fmap perimeterPolygon lines++perimeterPolygon [x1, x2] = distance x1 x2+perimeterPolygon (x1:x2:points) = perimeterPolygon (x2:points) + distance x1 x2+ -- | Find the area of a polygon with rectangular coördinates given. areaPolyRectangular :: Polygon -> Double-areaPolyRectangular (pt:pts) = abs . (*0.5) . fst $ (foldl' areaPolyCalc (0,pt) pts) -- different result with foldl' and foldr? b/c pt gets stuck in different places.- where areaPolyCalc (sum,(x1,y1)) (x2, y2) = (sum + (x1 * y2 - x2 * y1),(x2,y2)) -- wrong end! should end w/ xny1-ynx1 MAXIMUM values for coordinates don't make any sense? +areaPolyRectangular (pt:pts) = abs . (*0.5) . fst $ (foldl' areaPolyCalc (0,pt) pts)+ where areaPolyCalc (sum,(x1,y1)) (x2, y2) = (sum + (x1 * y2 - x2 * y1),(x2,y2)) ((x1, y1),(xn, yn)) = (pt, last pts) -- | Distance in kilometers between two points given in degrees.
test/Spec.hs view
@@ -13,6 +13,6 @@ describe "mercatorFullPng" $ do parallel $ it "Reads a map and writes a .png with the mercator projection" $ do (mkMapPng "test/testmap.png" =<< districtToMapP bonne <$> getDistricts "test/data/worldmap/TM_WORLD_BORDERS-0.3.shp") >>= (`shouldBe` ())- describe "mercatorFullSVG" $ do- parallel $ it "Reads a map and writes a .svg with the mercator projection" $ do- (mkMapSVG "test/testmap.svg" =<< districtToMapP bonne <$> getDistricts "test/data/worldmap/TM_WORLD_BORDERS-0.3.shp") >>= (`shouldBe` ())+ --describe "mercatorFullSVG" $ do+ -- parallel $ it "Reads a map and writes a .svg with the mercator projection" $ do+ -- (mkMapSVG "test/testmap.svg" =<< districtToMapP bonne <$> getDistricts "test/data/worldmap/TM_WORLD_BORDERS-0.3.shp") >>= (`shouldBe` ())