aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

September 2017 Update

Browse source
This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
Download patch file Download diff file Expand all files Collapse all files

26
Task/Haversine-formula/Elm/haversine-formula.elm Normal file
View file

@ -0,0 +1,26 @@
haversine : ( Float, Float ) -> ( Float, Float ) -> Float
haversine ( lat1, lon1 ) ( lat2, lon2 ) =
let
r =
6372.8
dLat =
degrees (lat2 - lat1)
dLon =
degrees (lon2 - lon1)
a =
(sin (dLat / 2))
^ 2
+ (sin (dLon / 2))
^ 2
* cos (degrees lat1)
* cos (degrees lat2)
in
r * 2 * asin (sqrt a)
view =
Html.div []
[ Html.text (toString (haversine ( 36.12, -86.67 ) ( 33.94, -118.4 )))
]

47
Task/Haversine-formula/Haskell/haversine-formula.hs
View file

@ -1,28 +1,33 @@
import Text.Printf
import Control.Arrow ((***))
-- The haversine of an angle.
hsin t = let u = sin (t/2) in u*u
-- The distance between two points, given by latitude and longtitude, on a
-- circle. The points are specified in radians.
distRad radius (lat1, lng1) (lat2, lng2) =
let hlat = hsin (lat2 - lat1)
hlng = hsin (lng2 - lng1)
root = sqrt (hlat + cos lat1 * cos lat2 * hlng)
in 2 * radius * asin (min 1.0 root)
-- The distance between two points, given by latitude and longtitude, on a
-- circle. The points are specified in degrees.
distDeg radius p1 p2 = distRad radius (deg2rad p1) (deg2rad p2)
where deg2rad (t, u) = (d2r t, d2r u)
d2r t = t * pi / 180
haversine :: Float -> Float
haversine = (^ 2) . sin . (/ 2)
-- The approximate distance, in kilometers, between two points on Earth.
-- The latitude and longtitude are assumed to be in degrees.
earthDist = distDeg 6372.8
earthDist :: (Float, Float) -> (Float, Float) -> Float
earthDist = distDeg 6371
where
distDeg radius p1 p2 = distRad radius (deg2rad p1) (deg2rad p2)
distRad radius (lat1, lng1) (lat2, lng2) =
(2 * radius) *
asin
(min
1.0
(sqrt $
haversine (lat2 - lat1) +
((cos lat1 * cos lat2) * haversine (lng2 - lng1))))
deg2rad = d2r *** d2r
where
d2r = (/ 180) . (pi *)
main = do
let bna = (36.12, -86.67)
lax = (33.94, -118.40)
dst = earthDist bna lax :: Double
printf "The distance between BNA and LAX is about %0.f km.\n" dst
main :: IO ()
main =
printf
"The distance between BNA and LAX is about %0.f km.\n"
(earthDist bna lax)
where
bna = (36.12, -86.67)
lax = (33.94, -118.40)

0
Task/Haversine-formula/jq/haversine-formula.jq → Task/Haversine-formula/Jq/haversine-formula.jq
View file

4
Task/Haversine-formula/Kotlin/haversine-formula.kotlin
View file

@ -1,5 +1,3 @@
package haversine
import java.lang.Math.*
const val R = 6372.8 // in kilometers
@ -7,7 +5,7 @@ const val R = 6372.8 // in kilometers
fun haversine(lat1: Double, lon1: Double, lat2: Double, lon2: Double): Double {
val λ1 = toRadians(lat1)
val λ2 = toRadians(lat2)
val Δλ = toRadians(λ2 - λ1)
val Δλ = toRadians(lat2 - lat1)
val Δφ = toRadians(lon2 - lon1)
return 2 * R * asin(sqrt(pow(sin(Δλ / 2), 2.0) + pow(sin(Δφ / 2), 2.0) * cos(λ1) * cos(λ2)))
}

26
Task/Haversine-formula/MySQL/haversine-formula.sql Normal file
View file

@ -0,0 +1,26 @@
DELIMITER $$
CREATE FUNCTION haversine (
lat1 FLOAT, lon1 FLOAT,
lat2 FLOAT, lon2 FLOAT
) RETURNS FLOAT
NO SQL DETERMINISTIC
BEGIN
DECLARE r FLOAT unsigned DEFAULT 6372.8;
DECLARE dLat FLOAT unsigned;
DECLARE dLon FLOAT unsigned;
DECLARE a FLOAT unsigned;
DECLARE c FLOAT unsigned;
SET dLat = RADIANS(lat2 - lat1);
SET dLon = RADIANS(lon2 - lon1);
SET lat1 = RADIANS(lat1);
SET lat2 = RADIANS(lat2);
SET a = POW(SIN(dLat / 2), 2) + COS(lat1) * COS(lat2) * POW(SIN(dLon / 2), 2);
SET c = 2 * ASIN(SQRT(a));
RETURN (r * c);
END$$
DELIMITER ;

26
Task/Haversine-formula/OoRexx/haversine-formula.rexx Normal file
View file

@ -0,0 +1,26 @@
/*REXX pgm calculates distance between Nashville & Los Angles airports. */
say " Nashville: north 36º 7.2', west 86º 40.2' = 36.12º, -86.67º"
say "Los Angles: north 33º 56.4', west 118º 24.0' = 33.94º, -118.40º"
say
dist=surfaceDistance(36.12, -86.67, 33.94, -118.4)
kdist=format(dist/1 ,,2) /*show 2 digs past decimal point.*/
mdist=format(dist/1.609344,,2) /* " " " " " " */
ndist=format(mdist*5280/6076.1,,2) /* " " " " " " */
say ' distance between= ' kdist " kilometers,"
say ' or ' mdist " statute miles,"
say ' or ' ndist " nautical or air miles."
exit /*stick a fork in it, we're done.*/
/*----------------------------------SURFACEDISTANCE subroutine----------*/
surfaceDistance: arg th1,ph1,th2,ph2 /*use haversine formula for dist.*/
radius = 6372.8 /*earth's mean radius in km */
ph1 = ph1-ph2
x = cos(ph1) * cos(th1) - cos(th2)
y = sin(ph1) * cos(th1)
z = sin(th1) - sin(th2)
return radius * 2 * aSin(sqrt(x**2+y**2+z**2)/2 )
cos: Return RxCalcCos(arg(1))
sin: Return RxCalcSin(arg(1))
asin: Return RxCalcArcSin(arg(1),,'R')
sqrt: Return RxCalcSqrt(arg(1))
::requires rxMath library

13
Task/Haversine-formula/Phix/haversine-formula.phix Normal file
View file

@ -0,0 +1,13 @@
constant MER = 6371 -- mean earth radius(km)
constant DEG_TO_RAD = PI/180
function haversine(atom lat1, long1, lat2, long2)
lat1 *= DEG_TO_RAD
lat2 *= DEG_TO_RAD
long1 *= DEG_TO_RAD
long2 *= DEG_TO_RAD
return MER*arccos(sin(lat1)*sin(lat2)+cos(lat1)*cos(lat2)*cos(long2-long1))
end function
atom d = haversine(36.12,-86.67,33.94,-118.4)
printf(1,"Distance is %f km (%f miles)\n",{d,d/1.609344})

21
Task/Haversine-formula/PureBasic/haversine-formula.purebasic Normal file
View file

@ -0,0 +1,21 @@
#DIA=2*6372.8
Procedure.d Haversine(th1.d,ph1.d,th2.d,ph2.d)
Define dx.d,
dy.d,
dz.d
ph1=Radian(ph1-ph2)
th1=Radian(th1)
th2=Radian(th2)
dz=Sin(th1)-Sin(th2)
dx=Cos(ph1)*Cos(th1)-Cos(th2)
dy=Sin(ph1)*Cos(th1)
ProcedureReturn ASin(Sqr(Pow(dx,2)+Pow(dy,2)+Pow(dz,2))/2)*#DIA
EndProcedure
OpenConsole("Haversine distance")
Print("Haversine distance: ")
Print(StrD(Haversine(36.12,-86.67,33.94,-118.4),7)+" km.")
Input()

65
Task/Haversine-formula/REXX/haversine-formula-1.rexx
View file

@ -1,65 +0,0 @@
/*REXX pgm calculates distance between Nashville & Los Angles airports. */
say " Nashville: north 36º 7.2', west 86º 40.2' = 36.12º, -86.67º"
say "Los Angles: north 33º 56.4', west 118º 24.0' = 33.94º, -118.40º"
say
$.= /*set defaults for subroutines. */
dist=surfaceDistance(36.12, -86.67, 33.94, -118.4)
kdist=format(dist/1 ,,2) /*show 2 digs past decimal point.*/
mdist=format(dist/1.609344,,2) /* " " " " " " */
ndist=format(mdist*5280/6076.1,,2) /* " " " " " " */
say ' distance between= ' kdist " kilometers,"
say ' or ' mdist " statute miles,"
say ' or ' ndist " nautical or air miles."
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────SURFACEDISTANCE subroutine──────────*/
surfaceDistance: arg th1,ph1,th2,ph2 /*use haversine formula for dist.*/
numeric digits digits()*2 /*double the number of digits. */
radius = 6372.8 /*earth's mean radius in km */
ph1 = d2r(ph1-ph2) /*convert degs──►radians & reduce*/
ph2 = d2r(ph2) /* " " " " " */
th1 = d2r(th1) /* " " " " " */
th2 = d2r(th2)
x = cos(ph1) * cos(th1) - cos(th2)
y = sin(ph1) * cos(th1)
z = sin(th1) - sin(th2)
return radius * 2 * aSin(sqrt(x**2+y**2+z**2)/2 )
/*═════════════════════════════general 1-line subs══════════════════════*/
d2d: return arg(1) // 360 /*normalize degrees. */
d2r: return r2r(arg(1)*pi() / 180) /*normalize and convert deg──►rad*/
r2d: return d2d((arg(1)*180 / pi())) /*normalize and convert rad──►deg*/
r2r: return arg(1) // (2*pi()) /*normalize radians. */
p: return word(arg(1),1) /*pick the first of two words. */
pi: if $.pipi=='' then $.pipi=$pi(); return $.pipi /*return π.*/
aCos: procedure expose $.; arg x; if x<-1|x>1 then call $81r -1,1,x,"ACOS"
return .5*pi()-aSin(x) /*$81R says arg is out of range,*/
/* and it isn't included here.*/
aSin: procedure expose $.; parse arg x
if x<-1 | x>1 then call $81r -1,1,x,"ASIN"; s=x*x
if abs(x)>=.7 then return sign(x)*aCos(sqrt(1-s),'-ASIN')
z=x; o=x; p=z; do j=2 by 2; o=o*s*(j-1)/j; z=z+o/(j+1)
if z=p then leave; p=z; end; return z
cos: procedure expose $.; parse arg x; x=r2r(x); a=abs(x)
numeric fuzz min(9,digits()-9); if a=pi() then return -1
if a=pi()/2 | a=2*pi() then return 0; if a=pi()/3 then return .5
if a=2*pi()/3 then return -.5; return .sinCos(1,1,-1)
sin: procedure expose $.; parse arg x; x=r2r(x);
numeric fuzz min(5,digits()-3)
if abs(x)=pi() then return 0; return .sinCos(x,x,1)
.sinCos: parse arg z,_,i; x=x*x; p=z; do k=2 by 2; _=-_*x/(k*(k+i)); z=z+_
if z=p then leave; p=z; end; return z /*used by SIN & COS.*/
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits()
numeric digits 11; g=.sqrtGuess(); do j=0 while p>9; m.j=p; p=p%2+1; end
do k=j+5 to 0 by -1; if m.k>11 then numeric digits m.k; g=.5*(g+x/g);end
numeric digits d; return g/1
.sqrtGuess: numeric form; m.=11; p=d+d%4+2
parse value format(x,2,1,,0) 'E0' with g 'E' _ .; return g*.5'E'_%2
$pi: return ,
'3.1415926535897932384626433832795028841971693993751058209749445923078'||,
'164062862089986280348253421170679821480865132823066470938446095505822'||,
'3172535940812848111745028410270193852110555964462294895493038196'

24
Task/Haversine-formula/REXX/haversine-formula-2.rexx
View file

@ -1,24 +0,0 @@
┌───────────────────────────────────────────────────────────────────────┐
│ A note on built-in functions. REXX doesn't have a lot of mathmatical │
│ or (particularly) trigomentric functions, so REXX programmers have │
│ to write their own. Usually, this is done once, or most likely, one │
│ is borrowed from another program. Knowing this, the one that is used │
│ has a lot of boilerplate in it. Once coded and throughly debugged, I │
│ put those commonly-used subroutines into the "1-line sub" section. │
│ │
│ Programming note: the "general 1-line" subroutines are taken from │
│ other programs that I wrote, but I broke up their one line of source │
│ so it can be viewed without shifting the viewing window. │
│ │
│ The "er 81" [which won't happen here] just shows an error telling │
│ the legal range for ARCxxx functions (in this case: -1 ──► +1). │
│ │
│ Similarly, the SQRT function checks for a negative argument │
│ [which again, won't happen here]. │
│ │
│ The pi constant (as used here) is actually a much more robust function│
│ and will return up to one million digits in the real version. │
│ │
│ One bad side effect is that, like a automobile without a hood, you see│
│ all the dirty stuff going on. Also, don't visit a sausage factory. │
└───────────────────────────────────────────────────────────────────────┘

18
Task/Haversine-formula/Sidef/haversine-formula.sidef
View file

@ -1,17 +1,17 @@
class EarthPoint(lat, lon) {
const earth_radius = 6371; # mean earth radius
const radian_ratio = Math.pi/180;
const earth_radius = 6371 # mean earth radius
const radian_ratio = Num.pi/180
# accessors for radians
method latR { self.lat * radian_ratio };
method lonR { self.lon * radian_ratio };
method latR { self.lat * radian_ratio }
method lonR { self.lon * radian_ratio }
method haversine_dist(EarthPoint p) {
var arc = EarthPoint(
self.lat - p.lat,
self.lon - p.lon,
);
)
var a = Math.sum(
(arc.latR / 2).sin**2,
@ -19,11 +19,11 @@ class EarthPoint(lat, lon) {
self.latR.cos * p.latR.cos
)
earth_radius * a.sqrt.asin * 2;
earth_radius * a.sqrt.asin * 2
}
}
var BNA = EarthPoint.new(lat: 36.12, lon: -86.67);
var LAX = EarthPoint.new(lat: 33.94, lon: -118.4);
var BNA = EarthPoint.new(lat: 36.12, lon: -86.67)
var LAX = EarthPoint.new(lat: 33.94, lon: -118.4)
say BNA.haversine_dist(LAX); # => 2886.44444283798329974715782394574672
say BNA.haversine_dist(LAX) #=> 2886.444442837983299747157823945746716...

17
Task/Haversine-formula/Stata/haversine-formula-1.stata Normal file
View file

@ -0,0 +1,17 @@
program spheredist
version 15.0
syntax varlist(min=4 max=4 numeric), GENerate(namelist max=1) ///
[Radius(real 6371) ALTitude(real 0) LABel(string)]
confirm new variable `generate'
local lat1 : word 1 of `varlist'
local lon1 : word 2 of `varlist'
local lat2 : word 3 of `varlist'
local lon2 : word 4 of `varlist'
local r=2*(`radius'+`altitude'/1000)
local k=_pi/180
gen `generate'=`r'*asin(sqrt(sin((`lat2'-`lat1')*`k'/2)^2+ ///
cos(`lat1'*`k')*cos(`lat2'*`k')*sin((`lon2'-`lon1')*`k'/2)^2))
if `"`label'"' != "" {
label variable `generate' `"`label'"'
}
end

15
Task/Haversine-formula/Stata/haversine-formula-2.stata Normal file
View file

@ -0,0 +1,15 @@
import delimited airports.csv, clear
format %9.4f l*
list
+----------------------------------------------------------------------------------------------------+
| iata airport city country lat lon |
|----------------------------------------------------------------------------------------------------|
1. | AMS Amsterdam Airport Schiphol Amsterdam Netherlands 52.3086 4.7639 |
2. | BNA Nashville International Airport Nashville United States 36.1245 -86.6782 |
3. | CDG Charles de Gaulle International Airport Paris France 49.0128 2.5500 |
4. | CGN Cologne Bonn Airport Cologne Germany 50.8659 7.1427 |
5. | LAX Los Angeles International Airport Los Angeles United States 33.9425 -118.4080 |
|----------------------------------------------------------------------------------------------------|
6. | MEM Memphis International Airport Memphis United States 35.0424 -89.9767 |
+----------------------------------------------------------------------------------------------------+

32
Task/Haversine-formula/Stata/haversine-formula-3.stata Normal file
View file

@ -0,0 +1,32 @@
keep iata lat lon
rename (iata lat lon) =2
gen k=0
tempfile tmp
save "`tmp'"
rename *2 *1
joinby k using `tmp'
drop if iata1>=iata2
drop k
list
+-----------------------------------------------------------+
| iata1 lat1 lon1 iata2 lat2 lon2 |
|-----------------------------------------------------------|
1. | AMS 52.3086 4.7639 BNA 36.1245 -86.6782 |
2. | AMS 52.3086 4.7639 CGN 50.8659 7.1427 |
3. | AMS 52.3086 4.7639 LAX 33.9425 -118.4080 |
4. | AMS 52.3086 4.7639 CDG 49.0128 2.5500 |
5. | AMS 52.3086 4.7639 MEM 35.0424 -89.9767 |
|-----------------------------------------------------------|
6. | BNA 36.1245 -86.6782 CGN 50.8659 7.1427 |
7. | BNA 36.1245 -86.6782 CDG 49.0128 2.5500 |
8. | BNA 36.1245 -86.6782 LAX 33.9425 -118.4080 |
9. | BNA 36.1245 -86.6782 MEM 35.0424 -89.9767 |
10. | CDG 49.0128 2.5500 LAX 33.9425 -118.4080 |
|-----------------------------------------------------------|
11. | CDG 49.0128 2.5500 MEM 35.0424 -89.9767 |
12. | CDG 49.0128 2.5500 CGN 50.8659 7.1427 |
13. | CGN 50.8659 7.1427 LAX 33.9425 -118.4080 |
14. | CGN 50.8659 7.1427 MEM 35.0424 -89.9767 |
15. | LAX 33.9425 -118.4080 MEM 35.0424 -89.9767 |
+-----------------------------------------------------------+

26
Task/Haversine-formula/Stata/haversine-formula-4.stata Normal file
View file

@ -0,0 +1,26 @@
spheredist lat1 lon1 lat2 lon2, gen(dist) lab(Distance at sea level)
spheredist lat1 lon1 lat2 lon2, gen(fl350) alt(10680) lab(Distance at FL350 altitude)
format %9.2f dist fl350
list iata* dist fl350
+-----------------------------------+
| iata1 iata2 dist fl350 |
|-----------------------------------|
1. | AMS CGN 229.64 230.03 |
2. | AMS CDG 398.27 398.94 |
3. | AMS MEM 7295.19 7307.56 |
4. | AMS BNA 7004.61 7016.48 |
5. | AMS LAX 8955.95 8971.13 |
|-----------------------------------|
6. | BNA LAX 2886.32 2891.21 |
7. | BNA CGN 7222.75 7234.99 |
8. | BNA CDG 7018.39 7030.29 |
9. | BNA MEM 321.62 322.16 |
10. | CDG LAX 9102.51 9117.94 |
|-----------------------------------|
11. | CDG CGN 387.82 388.48 |
12. | CDG MEM 7317.82 7330.23 |
13. | CGN LAX 9185.47 9201.04 |
14. | CGN MEM 7514.96 7527.70 |
15. | LAX MEM 2599.71 2604.12 |
+-----------------------------------+

10
Task/Haversine-formula/Swift/haversine-formula.swift
View file

@ -1,10 +1,10 @@
import Foundation
func haversine(lat1:Double, lon1:Double, lat2:Double, lon2:Double) -> Double {
let lat1rad = lat1 * M_PI/180
let lon1rad = lon1 * M_PI/180
let lat2rad = lat2 * M_PI/180
let lon2rad = lon2 * M_PI/180
let lat1rad = lat1 * Double.pi/180
let lon1rad = lon1 * Double.pi/180
let lat2rad = lat2 * Double.pi/180
let lon2rad = lon2 * Double.pi/180
let dLat = lat2rad - lat1rad
let dLon = lon2rad - lon1rad
@ -15,4 +15,4 @@ func haversine(lat1:Double, lon1:Double, lat2:Double, lon2:Double) -> Double {
return R * c
}
println(haversine(36.12, -86.67, 33.94, -118.40))
print(haversine(lat1:36.12, lon1:-86.67, lat2:33.94, lon2:-118.40))

30
Task/Haversine-formula/TechBASIC/haversine-formula.techbasic Normal file
View file

@ -0,0 +1,30 @@
FUNCTION HAVERSINE
!---------------------------------------------------------------
!*** Haversine Formula - Calculate distances by LAT/LONG
!
!*** LAT/LON of the two locations and Unit of measure are GLOBAL
!*** as they are defined in the main logic of the program, so they
!*** available for use in the Function.
!*** Usage: X=HAVERSINE
Radius=6378.137
Lat1=(Lat1*MATH.PI/180)
Lon1=(Lon1*MATH.PI/180)
Lat2=(Lat2*MATH.PI/180)
Lon2=(Lon2*MATH.PI/180)
DLon=Lon1-Lon2
ANSWER=ACOS(SIN(Lat1)*SIN(Lat2)+COS(Lat1)*COS(Lat2)*COS(DLon))*Radius
DISTANCE="kilometers"
SELECT CASE UNIT
CASE "M"
HAVERSINE=ANSWER*0.621371192
Distance="miles"
CASE "N"
HAVERSINE=ANSWER*0.539956803
Distance="nautical miles"
END SELECT
END FUNCTION

14
Task/Haversine-formula/Zkl/haversine-formula.zkl Normal file
View file

@ -0,0 +1,14 @@
haversine(36.12, -86.67, 33.94, -118.40).println();
fcn haversine(Lat1, Long1, Lat2, Long2){
const R = 6372.8; // In kilometers;
Diff_Lat := (Lat2 - Lat1) .toRad();
Diff_Long := (Long2 - Long1).toRad();
NLat := Lat1.toRad();
NLong := Lat2.toRad();
A := (Diff_Lat/2) .sin().pow(2) +
(Diff_Long/2).sin().pow(2) *
NLat.cos() * NLong.cos();
C := 2.0 * A.sqrt().asin();
R*C;
}