chorale-geo (empty) → 0.1.0
raw patch · 6 files changed
+204/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, binary, chorale, chorale-geo, ieee754, test-framework, test-framework-hunit, test-framework-quickcheck2
Files
- LICENSE +8/−0
- README.md +9/−0
- Setup.hs +6/−0
- chorale-geo.cabal +52/−0
- src/Chorale/Geo/Coordinates.hs +120/−0
- tests/Test.hs +9/−0
+ LICENSE view
@@ -0,0 +1,8 @@+The MIT License (MIT)+Copyright (c) 2013-2016 Franz-Benjamin Mocnik++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,9 @@+# Chorale++Chorale-Geo is a Haskell module that contains basic functions for geo applications++We are happy to receive bug reports, fixes, documentation enhancements, and other improvements. Please use the [issue tracker](https://github.com/mocnik-science/chorale-geo/issues).++# Authors++This library is written and maintained by Franz-Benjamin Mocnik, <mail@mocnik-science.net>.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ chorale-geo.cabal view
@@ -0,0 +1,52 @@+name: chorale-geo+version: 0.1.0+homepage: https://github.com/mocnik-science/chorale-geo+bug-reports: https://github.com/mocnik-science/chorale-geo/issues+synopsis: A module containing basic geo functions+description:+ Chorale-Geo is a Haskell module that contains basic functions for geo+ applications+license: MIT+license-file: LICENSE+author: Franz-Benjamin Mocnik <mail@mocnik-science.net>+maintainer: Franz-Benjamin Mocnik <mail@mocnik-science.net>+copyright: 2014-2016 Franz-Benjamin Mocnik+category: Prelude+cabal-version: >= 1.20+build-type: Simple+extra-source-files:+ README.md++source-repository head+ type: git+ location: git://github.com/mocnik-science/chorale-geo.git++library+ exposed-modules:+ Chorale.Geo.Coordinates+ hs-source-dirs: src/+ default-language: Haskell2010+ ghc-options:+ -Wall+ -O2+ build-depends:+ base >= 4.6 && < 5,+ binary >= 0.8,+ chorale >= 0.1.4++test-suite test+ type: exitcode-stdio-1.0+ main-is: Test.hs+ hs-source-dirs: tests/+ default-language: Haskell2010+ build-depends:+ base >= 4.6 && < 5,+ binary >= 0.8,+ chorale >= 0.1.4,+ chorale-geo >= 0.1.0,+ HUnit >= 1.2.5.2,+ ieee754 >= 0.7.3,+ QuickCheck >= 2.6,+ test-framework >= 0.8.0.3,+ test-framework-hunit >= 0.3.0.1,+ test-framework-quickcheck2 >= 0.3.0.2
+ src/Chorale/Geo/Coordinates.hs view
@@ -0,0 +1,120 @@+-----------------------------------------------------------------------------+-- |+-- Module : Chorale.Geo.Coordinates+-- Copyright : 2014-2016 Franz-Benjamin Mocnik+-- License : MIT+--+-- Maintainer : mail@mocnik-science.net+-- Stability : stable+-- Portability : portable+--+-----------------------------------------------------------------------------++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}++module Chorale.Geo.Coordinates (+ -- * Constants+ radiusEarth,+ -- * Geo Functions+ degreeToRad,+ radToDegree,+ -- * Coordinates+ Coordinates(..),+ CoordinatesCartesian(..),+ CoordinatesWGS84(..)) where++import Chorale.Common++import qualified Data.Binary as B+import GHC.Generics (Generic)++-- --== CONSTANTS++-- | radius of the Earth in km+radiusEarth :: Double+radiusEarth = 6371.009++-- --== GEO FUNCTIONS++-- | degree to rad+degreeToRad :: Double -> Double+degreeToRad d = d * pi / 180++-- | rad to degree+radToDegree :: Double -> Double+radToDegree r = r * 180 / pi++-- --== GEOMETRY++-- | norm of a vector+norm :: Floating a => [a] -> a+norm = sqrt . sum . uncurry (zipWith (*)) . make2++-- --== COORDINATES++-- | Coordinate class+class (Ord c, Eq c, Show c) => Coordinates c where+ toTuple :: c -> (Double, Double)+ distance :: c -> c -> Double+ azimuth :: c -> c -> Double++-- | Cartesian coordinates+newtype CoordinatesCartesian = CoordinatesCartesian (Double, Double) deriving (Ord, Eq, Show, Generic)++-- | Geographic coordinates (WGS84)+newtype CoordinatesWGS84 = CoordinatesWGS84 (Double, Double) deriving (Ord, Eq, Show, Generic)++instance B.Binary CoordinatesCartesian++instance Coordinates CoordinatesCartesian where+ toTuple (CoordinatesCartesian x) = x+ distance = curry $ norm . uncurry (zipWith (-)) . map12 (tupleToList2 . toTuple)+ azimuth (CoordinatesCartesian (x1, y1)) (CoordinatesCartesian (x2, y2)) = alpha (x2 - x1, y2 - y1) where+ alpha (x, y)+ | x == 0 && y == 0 = error "azimuth cannot be computed between two identical vectors"+ | az < 0 = az + 2 * pi+ | otherwise = az where+ az = - atan2 y x + pi / 2++instance Coordinates (Double, Double) where+ toTuple = id+ distance = curry $ uncurry distance . map12 CoordinatesCartesian+ azimuth = curry $ uncurry azimuth . map12 CoordinatesCartesian++instance B.Binary CoordinatesWGS84++instance Coordinates CoordinatesWGS84 where+ toTuple (CoordinatesWGS84 x) = x+ distance cs1 cs2 = radiusEarth * sqrt (diffAngle lat2 lat1 ** 2 + (cos ((lat2 + lat1) / 2) * diffAngle lon2 lon1)**2) where+ [lat1, lon1] = map degreeToRad . tupleToList2 . toTuple $ cs1+ [lat2, lon2] = map degreeToRad . tupleToList2 . toTuple $ cs2+ diffAngle y x+ | abs (y - x) < pi / 2 = y - x+ | otherwise = diffAngle y (x + signum (y - x) * pi)+ -- Vincenty's formulae+ azimuth (CoordinatesWGS84 (lat1', lon1')) (CoordinatesWGS84 (lat2', lon2'))+ | lat1' - lat2' == 0 && lon1' - lon2' == 0 = error "azimuth cannot be computed between two identical vectors"+ | az < 0 = az + 2 * pi+ | otherwise = az where+ az = atan2 (cos u2 * sin lambda) (cos u1 * sin u2 - sin u1 * cos u2 * cos lambda)+ lat1 = degreeToRad lat1'+ lat2 = degreeToRad lat2'+ lon1 = degreeToRad lon1'+ lon2 = degreeToRad lon2'+ f = 1 / 298.257223563+ u1 = atan ((1 - f) * tan lat1)+ u2 = atan ((1 - f) * tan lat2)+ l = lon2 - lon1+ lambda = recursiveFunction l+ recursiveFunction x+ | abs (x - x') < 10e-12 = x'+ | otherwise = recursiveFunction x' where+ sins = sqrt $ (cos u2 * sin x)**2 + (cos u1 * sin u2 - sin u1 * cos u2 * cos x)**2+ coss = sin u1 * sin u2 + cos u1 * cos u2 * cos x+ s = atan (sins / coss)+ sina = (cos u1 * cos u2 * sin x) / sins+ cos2a = 1 - sina**2+ cos2sm = sqrt cos2a - 2 * sin u1 * sin u2 / cos2a+ c = f / 16 * cos2a * (4 + f * (4 - 3 * cos2a))+ x' = l + (1 - c) * f * sina * (s + c * sins * (cos2sm + c * coss * (-1 + 2 * cos2sm**2)))
+ tests/Test.hs view
@@ -0,0 +1,9 @@+import Chorale.Geo.Test.Coordinates as ChoraleGeoTestCoordinates++import Test.Framework++main :: IO ()+main = defaultMainWithArgs testsToRun ["--maximum-generated-tests=1000"]++testsToRun :: [Test]+testsToRun = ChoraleGeoTestCoordinates.tests