faster get_distances

Author: Schuch666

R/extract_serie.R

@@ -7,13 +7,13 @@
 #' @param variable variable name
 #' @param field dimension of the variable, '4d' (default), '2dz', '2dz', '2d' or 'xyzt', 'xyz', 'xyz', and 'xy' see notes
 #' \tabular{lll}{
-#'   \strong{Field}\tab \strong{Dimensions}\tab \strong{Notes} \cr
+#'   \strong{Field}\tab \strong{Dimensions}\tab \strong{Example} \cr
 #'   3dt  \tab xyzt \tab WRF dimensions for 3D array with multiple times\cr
 #'   2dt  \tab xyt  \tab WRF dimensions for 2D array with multiple times \cr
 #'   2dz  \tab xyz  \tab WRF dimensions for 3D array with single time\cr
 #'   2d   \tab xy   \tab WRF dimensions for 2D array with single time\cr
 #' }
-#' @param level model level to be extracted
+#' @param level model level (index) to be extracted
 #' @param prefix to output file, default is serie
 #' @param new TRUE, FALSE of 'check' see notes
 #' @param return.nearest return the data.frame of nearest points instead of extract the serie
@@ -26,7 +26,7 @@
 #'
 #' @return No return value
 #'
-#' @note The field argument '4d' or '2dz' is used to read a 4d/3d variable droping the 3rd dimension (z), this is based on WRF outputs format and the array order from ncdf4.
+#' @note The field argument '4d' or '2dz' is used to read a 4d/3d variable droping the 3rd dimension (z), this should be based how ncdf4 R-package reads the model output.
 #'
 #' @note new = TRUE create a new file, new = FALSE append the data in a old file, and new = 'check' check if the file exist and append if the file exist and create if the file doesnt exist
 #'

R/get_distances.R

@@ -12,16 +12,12 @@
 #'
 #' @export
 #'
-get_distances <- function(lat1, long1, lat2, long2,R = 6371) {
-  deg2rad <- function(deg) {
-    return(deg * (pi/180))
-  }
-  d_lat <- deg2rad(lat2 - lat1)
-  d_long <- deg2rad(long2 - long1)
-  a <- sin(d_lat/2) * sin(d_lat/2) +
-       cos(deg2rad(lat1)) * cos(deg2rad(lat2)) *
-       sin(d_long/2) * sin(d_long/2)
-  c1 <- 2 * atan2(sqrt(a), sqrt(1-a))
-  d <- R * c1; # Distance in km
+get_distances <- function(lat1, long1, lat2, long2, R = 6371) {
+  lat1   <- lat1 * pi/180
+  lat2   <- lat2 * pi/180
+  d_lat  <- lat2 - lat1
+  d_long <- (long2 - long1) * pi/180
+  a      <- sin(d_lat/2)^2 + cos(lat1) * cos(lat2) * sin(d_long/2)^2
+  d      <- R * 2 * atan2(sqrt(a), sqrt(1 - a))
   return(d)
 }