使用Haskell根据经纬度计算距离

以下代码使用了半正矢公式：

$\text{haversine}(\varphi_1,\theta_1,\varphi_2,\theta_2)=2R\arctan \sqrt\frac{a}{1-a}, $

其中 $a=\sin^2\frac{\Delta\varphi}{2} +\cos\varphi_1\cos\varphi_2\sin^2\frac{\Delta \theta}{2}, \Delta \varphi=\varphi_2-\varphi_1, \Delta\theta=\theta_2-\theta_1$ ，R是地球半径，以上公式使用弧度，因此代码中进行了角度转弧度运算。

import qualified Data.List.Split as Split
import Text.Read
import Data.List
type LatLong = (Double, Double)

toRadians :: Double -> Double
toRadians degrees = degrees * pi / 180

latLongToRads :: LatLong -> (Double, Double)
latLongToRads (lat,long) = (rlat, rlong)
  where rlat = toRadians lat
        rlong = toRadians long 
        
haversine :: LatLong -> LatLong -> Double
haversine coords1 coords2 = earthRadius * c 
  where (rlat1, rlong1) = latLongToRads coords1
        (rlat2, rlong2) = latLongToRads coords2 
        dlat = rlat2 - rlat1 
        dlong = rlong2 - rlong1
        a = (sin (dlat/2))^2 + cos rlat1 * cos rlat2 * (sin (dlong/2))^2
        c = 2 * atan2 (sqrt a) (sqrt (1-a))
        earthRadius = 6367.5
        
printDistance :: Maybe Double -> IO()
printDistance Nothing = putStrLn "Error, invalid LatLong entered"
printDistance (Just distance) = putStrLn (show distance ++ " km")

contextExtract :: Applicative f => (f a1, f a2) -> f (a1, a2)
contextExtract d = pure (,) <*> fst d <*> snd d

string2LatLong :: String -> Maybe LatLong
string2LatLong s =  contextExtract (latMaybe, longMaybe)
  where arr = Split.splitOn "," s
        indexedArr = zip [1..] arr 
        lat = lookup 1 indexedArr
        long = lookup 2 indexedArr
        latMaybe = (lat >>= readMaybe)::(Maybe Double)
        longMaybe = (long >>= readMaybe)::(Maybe Double)
        
main :: IO()
main = do
  putStrLn "Enter the starting LatLong(degrees,eg: 33.82,-84.11):"
  startingInput <- getLine
  let startingLatLong = string2LatLong startingInput
  
  putStrLn "Enter the destination LatLong(degrees,eg: 33.82,-84.11):"
  destInput <- getLine
  let destLatLong = string2LatLong destInput
  
  let distance = haversine <$> startingLatLong <*> destLatLong
  printDistance distance