extra/rosetta-code/haversine-formula/haversine-formula.factor

   1 ! Copyright (c) 2012 Anonymous
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: arrays kernel math math.functions math.trig
   4 math.vectors sequences ;
   5 IN: rosetta-code.haversine-formula
   6
   7 ! https://rosettacode.org/wiki/Haversine_formula
   8
   9 ! The haversine formula is an equation important in navigation,
  10 ! giving great-circle distances between two points on a sphere
  11 ! from their longitudes and latitudes. It is a special case of a
  12 ! more general formula in spherical trigonometry, the law of
  13 ! haversines, relating the sides and angles of spherical
  14 ! "triangles".
  15
  16 ! Task: Implement a great-circle distance function, or use a
  17 ! library function, to show the great-circle distance between
  18 ! Nashville International Airport (BNA) in Nashville, TN, USA: N
  19 ! 36°7.2', W 86°40.2' (36.12, -86.67) and Los Angeles
  20 ! International Airport (LAX) in Los Angeles, CA, USA: N 33°56.4',
  21 ! W 118°24.0' (33.94, -118.40).
  22
  23 CONSTANT: R_earth 6372.8 ! in kilometers
  24
  25 : haversin ( x -- y ) cos 1 swap - 2 / ;
  26
  27 : haversininv ( y -- x ) 2 * 1 swap - acos ;
  28
  29 : haversineDist ( as bs -- d )
  30     [ [ deg>rad ] map ] bi@
  31     [ [ swap - haversin ] 2map ]
  32     [ [ first cos ] bi@ * 1 swap 2array ]
  33     2bi
  34     vdot
  35     haversininv R_earth * ;