├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── R ├── calcFunctions.R ├── getMoonIllumination.R ├── getMoonPosition.R ├── getMoonTimes.R ├── getSunlightPosition.R ├── getSunlightTimes.R ├── suncalc.R └── utils.R ├── README.md ├── inst └── dev_tests.R └── man ├── getMoonIllumination.Rd ├── getMoonPosition.Rd ├── getMoonTimes.Rd ├── getSunlightPosition.Rd └── getSunlightTimes.Rd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | ^.*\.Rproj$ 6 | ^\.Rproj\.user$ 7 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: suncalc 2 | Version: 0.5.2 3 | Title: Compute Sun Position, Sunlight Phases, Moon Position and Lunar Phase 4 | Authors@R: c( 5 | person("Benoit", "Thieurmel", role = c("aut", "cre"), 6 | comment = "R interface", email = "bthieurmel@gmail.com"), 7 | person("Achraf", "Elmarhraoui", role = c("aut"), 8 | comment = "R interface", email = "achraf.elmar@gmail.com") 9 | ) 10 | Description: Get sun position, sunlight phases (times for sunrise, sunset, dusk, etc.), 11 | moon position and lunar phase for the given location and time. Most calculations are based on the 12 | formulas given in Astronomy Answers articles about position of the sun and the planets : 13 | . 14 | Imports: 15 | data.table, 16 | lubridate, 17 | magrittr 18 | License: GPL-2 | file LICENSE 19 | URL: https://github.com/datastorm-open/suncalc 20 | NeedsCompilation: no 21 | RoxygenNote: 7.2.1 22 | Encoding: UTF-8 23 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2017 2 | COPYRIGHT HOLDER: Benoit Thieurmel -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(getMoonIllumination) 4 | export(getMoonPosition) 5 | export(getMoonTimes) 6 | export(getSunlightPosition) 7 | export(getSunlightTimes) 8 | import(data.table, except = hour) 9 | import(magrittr) 10 | importFrom(lubridate,as_datetime) 11 | importFrom(lubridate,hour) 12 | importFrom(lubridate,hours) 13 | importFrom(lubridate,seconds) 14 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # suncalc 0.5.2 (2023-11-02) 2 | 3 | * Fix getMoonTimes not keeping "rise" and "set" 4 | * Dates with times before a certain time return times for previous/newt day (#2) 5 | 6 | # suncalc 0.5.1 (2022-09-28) 7 | 8 | * Update maintener 9 | 10 | # suncalc 0.5 (2019-04-02) 11 | 12 | ## Major changes 13 | * Full R implementation of all functions 14 | 15 | ## Bugfixes 16 | * getSunlightTimes & getMoonTimes always return Date (rather than Date + 12:00:00...) 17 | 18 | # suncalc 0.4 (2018-02-22) 19 | 20 | ## Bugfixes 21 | * Dates with times before a certain time return times for previous day. See https://github.com/mourner/suncalc/issues/11 22 | 23 | # suncalc 0.3 (2017-10-04) 24 | 25 | ## Bugfixes 26 | * Dates with times before a certain time return times for previous day. See https://github.com/mourner/suncalc/issues/11 27 | 28 | # suncalc 0.2 (2017-09-08) 29 | 30 | ## Bugfixes 31 | * Keeping only one variable in all functions 32 | -------------------------------------------------------------------------------- /R/calcFunctions.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | .toJulian <- function(date, tz = "UTC") { 4 | dayS <- 60 * 60 * 24 5 | J1970 <- 2440588 6 | nb_ms_from_J1970 <- as.numeric(as.POSIXct(date, tz = tz)) 7 | return((nb_ms_from_J1970 / dayS) - 0.5 + J1970) 8 | } 9 | 10 | .fromJulian <- function(j, tz = "UTC") { 11 | dayS <- 60 * 60 * 24 12 | J1970 <- 2440588 13 | date <- as.POSIXct((j + 0.5 - J1970) * dayS , as.POSIXct('1970-01-01', tz = tz), tz = tz) 14 | return(lubridate::floor_date(date)) 15 | } 16 | 17 | .toDays <- function(date, tz = "UTC") { 18 | J2000 <- 2451545 19 | return(.toJulian(date, tz = tz) - J2000) 20 | } 21 | 22 | 23 | .rightAscension <- function(l, b) { 24 | e <- (pi / 180) * 23.4397 25 | return(atan2(sin(l) * cos(e) - tan(b) * sin(e), cos(l))) 26 | } 27 | 28 | 29 | .declination <- function(l, b) { 30 | e <- (pi / 180) * 23.4397 31 | return(asin(sin(b) * cos(e) + cos(b) * sin(e) * sin(l))) 32 | } 33 | 34 | 35 | .azimuth <- function(hm, phi, dec) { 36 | return(atan2(sin(hm), cos(hm) * sin(phi) - tan(dec) * cos(phi))) 37 | } 38 | 39 | 40 | .altitude <- function(hm, phi, dec) { 41 | return(asin(sin(phi) * sin(dec) + cos(phi) * cos(dec) * cos(hm))) 42 | } 43 | 44 | 45 | .siderealTime <- function(d, lw) { 46 | return((pi / 180) * (280.16 + 360.9856235 * d) - lw) 47 | } 48 | 49 | 50 | .astroRefraction <- function(h) { 51 | # the following formula works for positive .altitudes only. 52 | # if h = -0.08901179 a div/0 would occur. 53 | # if (h < 0) h <- 0 54 | h <- ifelse(h < 0, 0, h) 55 | # formula 16.4 of "Astronomical Algorithms" 2nd edition by Jean meeus (Willmann-Bell, Richmond) 1998. 56 | # 1.02 / tan(h + 10.26 / (h + 5.10)) h in degrees, result in arc minutes -> converted to (pi / 180): 57 | return(0.0002967 / tan(h + 0.00312536 / (h + 0.08901179))) 58 | } 59 | 60 | 61 | .solarMeanAnomaly <- function(d) { 62 | return((pi / 180) * (357.5291 + 0.98560028 * d)) 63 | } 64 | 65 | 66 | .eclipticLongitude <- function(m) { 67 | 68 | C <- (pi / 180) * (1.9148 * sin(m) + 0.02 * sin(2 * m) + 0.0003 * sin(3 * m)) # equation of center 69 | P <- (pi / 180) * 102.9372 # perihelion of the Earth 70 | 71 | return(m + C + P + pi) 72 | } 73 | 74 | .sunCoords <- function(d) { 75 | 76 | m <- .solarMeanAnomaly(d) 77 | l <- .eclipticLongitude(m) 78 | 79 | return(list(dec = .declination(l, 0), 80 | ra = .rightAscension(l, 0))) 81 | 82 | } 83 | 84 | 85 | # calculates sun position for a given date and latitude/longitude 86 | .getPosition <- function(date, lat, lng) { 87 | 88 | lw <- (pi / 180) * -lng 89 | phi <- (pi / 180) * lat 90 | d <- .toDays(date) 91 | 92 | c <- .sunCoords(d) 93 | hm <- .siderealTime(d, lw) - c$ra 94 | 95 | return(list(altitude = .altitude(hm, phi, c$dec), 96 | azimuth = .azimuth(hm, phi, c$dec))) 97 | } 98 | 99 | 100 | # calculations for sun times 101 | .julianCycle <- function(d, lw) { 102 | return(round(d - 0.0009 - lw / (2 * pi))) 103 | } 104 | 105 | .approxTransit <- function(ht, lw, n) { 106 | return(0.0009 + (ht + lw) / (2 * pi) + n) 107 | } 108 | 109 | .solarTransitJ <- function(ds, m, l) { 110 | J2000 <- 2451545 111 | return(J2000 + ds + 0.0053 * sin(m) - 0.0069 * sin(2 * l)) 112 | } 113 | 114 | .hourAngle <- function(h, phi, d) { 115 | return(suppressWarnings(acos((sin(h) - sin(phi) * sin(d)) / (cos(phi) * cos(d))))) 116 | } 117 | 118 | # returns set time for the given sun .altitude 119 | .getSetJ <- function(h, lw, phi, dec, n, m, l) { 120 | w <- .hourAngle(h, phi, dec) 121 | a <- .approxTransit(w, lw, n) 122 | return(.solarTransitJ(a, m, l)) 123 | } 124 | 125 | # calculates sun times for a given date and latitude/longitude 126 | .getTimes <- function(date, lat, lng, tz = "UTC") { 127 | 128 | rad <- (pi / 180) 129 | lw <- rad * -lng 130 | phi <- rad * lat 131 | 132 | d <- .toDays(date, tz = tz) 133 | n <- .julianCycle(d, lw) 134 | ds <- .approxTransit(0, lw, n) 135 | 136 | M <- .solarMeanAnomaly(ds) 137 | L <- .eclipticLongitude(M) 138 | dec <- .declination(L, 0) 139 | 140 | Jnoon <- .solarTransitJ(ds, M, L) 141 | 142 | available_var <- c("solarNoon", "nadir", "sunrise", "sunset", "sunriseEnd", "sunsetStart", 143 | "dawn", "dusk", "nauticalDawn", "nauticalDusk", "nightEnd", "night", 144 | "goldenHourEnd", "goldenHour") 145 | 146 | result <- list(solarNoon = .fromJulian(Jnoon, tz = tz), 147 | nadir = .fromJulian(Jnoon - 0.5, tz = tz), 148 | sunrise = .fromJulian(Jnoon - (.getSetJ(-0.833 * rad, lw, phi, dec, n, M, L) - Jnoon), tz = tz), 149 | sunset = .fromJulian(.getSetJ(-0.833 * rad, lw, phi, dec, n, M, L), tz = tz), 150 | sunriseEnd = .fromJulian(Jnoon - (.getSetJ(-0.3 * rad, lw, phi, dec, n, M, L) - Jnoon), tz = tz), 151 | sunsetStart = .fromJulian(.getSetJ(-0.3 * rad, lw, phi, dec, n, M, L), tz = tz), 152 | dawn = .fromJulian(Jnoon - (.getSetJ(-6 * rad, lw, phi, dec, n, M, L) - Jnoon), tz = tz), 153 | dusk = .fromJulian(.getSetJ(-6 * rad, lw, phi, dec, n, M, L), tz = tz), 154 | nauticalDawn = .fromJulian(Jnoon - (.getSetJ(-12 * rad, lw, phi, dec, n, M, L) - Jnoon), tz = tz), 155 | nauticalDusk = .fromJulian(.getSetJ(-12 * rad, lw, phi, dec, n, M, L), tz = tz), 156 | nightEnd = .fromJulian(Jnoon - (.getSetJ(-18 * rad, lw, phi, dec, n, M, L) - Jnoon), tz = tz), 157 | night = .fromJulian(.getSetJ(-18 * rad, lw, phi, dec, n, M, L), tz = tz), 158 | goldenHourEnd = .fromJulian(Jnoon - (.getSetJ(6 * rad, lw, phi, dec, n, M, L) - Jnoon), tz = tz), 159 | goldenHour = .fromJulian(.getSetJ(6 * rad, lw, phi, dec, n, M, L), tz = tz) 160 | ) 161 | 162 | return(result) 163 | } 164 | 165 | 166 | 167 | 168 | # moon calculations, based on http:#aa.quae.nl/en/reken/hemelpositie.html formulas 169 | .moonCoords <- function(d) { # geocentric ecliptic coordinates of the moon 170 | 171 | l <- (pi / 180) * (218.316 + 13.176396 * d) # ecliptic longitude 172 | m <- (pi / 180) * (134.963 + 13.064993 * d) # mean anomaly 173 | f <- (pi / 180) * (93.272 + 13.229350 * d) # mean distance 174 | 175 | l <- l + (pi / 180) * 6.289 * sin(m) # longitude 176 | b <- (pi / 180) * 5.128 * sin(f) # latitude 177 | dt <- 385001 - 20905 * cos(m) # distance to the moon in km 178 | 179 | return(list(ra = .rightAscension(l, b), 180 | dec = .declination(l, b), 181 | dist = dt)) 182 | } 183 | 184 | 185 | .getMoonPosition <- function(date, lat, lng) { 186 | 187 | lw <- (pi / 180) * -lng 188 | phi <- (pi / 180) * lat 189 | d <- .toDays(date) 190 | 191 | c <- .moonCoords(d) 192 | hm <- .siderealTime(d, lw) - c$ra 193 | h <- .altitude(hm, phi, c$dec) 194 | # formula 14.1 of "Astronomical Algorithms" 2nd edition by Jean meeus (Willmann-Bell, Richmond) 1998. 195 | pa <- atan2(sin(hm), tan(phi) * cos(c$dec) - sin(c$dec) * cos(hm)) 196 | 197 | h <- h + .astroRefraction(h) # .altitude correction for refraction 198 | 199 | return(list(altitude = h, 200 | azimuth = .azimuth(hm, phi, c$dec), 201 | distance = c$dist, 202 | parallacticAngle = pa)) 203 | } 204 | 205 | 206 | # calculations for illumination parameters of the moon, 207 | # based on http:#idlastro.gsfc.nasa.gov/ftp/pro/astro/mphase.pro formulas and 208 | # Chapter 48 of "Astronomical Algorithms" 2nd edition by Jean meeus (Willmann-Bell, Richmond) 1998. 209 | .getMoonIllumination <- function(date) { 210 | 211 | d <- .toDays(date) 212 | s <- .sunCoords(d) 213 | m <- .moonCoords(d) 214 | 215 | sdist <- 149598000 # distance from Earth to Sun in km 216 | 217 | phi <- acos(sin(s$dec) * sin(m$dec) + cos(s$dec) * cos(m$dec) * cos(s$ra - m$ra)) 218 | inc <- atan2(sdist * sin(phi), m$dist - sdist * cos(phi)) 219 | angle <- atan2(cos(s$dec) * sin(s$ra - m$ra), sin(s$dec) * cos(m$dec) - 220 | cos(s$dec) * sin(m$dec) * cos(s$ra - m$ra)) 221 | 222 | 223 | return(list(fraction = ((1 + cos(inc)) / 2), 224 | phase = (0.5 + 0.5 * inc * ifelse(angle < 0, -1, 1) / pi), 225 | angle = angle)) 226 | } 227 | 228 | 229 | .hourslater <- function(date, h) { 230 | #return(date + lubridate::hours(h)) 231 | return(lubridate::floor_date(date + as.numeric(lubridate::milliseconds(h*3600*(10**3))))) 232 | } 233 | 234 | .getMoonTimes <- function(date, lat, lng) { 235 | 236 | # if (inUTC) { 237 | # t <- as.POSIXct(as.character(date), tz = 'UTC') 238 | # } else { 239 | # t <- as.POSIXct(date, tz = Sys.timezone()) 240 | # } 241 | 242 | t <- date 243 | 244 | lubridate::hour(t) <- 0 245 | 246 | hc <- 0.133 * (pi / 180) 247 | 248 | if (length(date) > 1) { 249 | # go in 2-hour chunks, each time seeing if a 3-point quadratic curve crosses zero (which means rise or set) 250 | h_shift <- seq(1L, 23L, 2L) 251 | h1 <- sapply(h_shift, function(i) .getMoonPosition(.hourslater(t, i), lat, lng)$altitude - hc) 252 | h2 <- sapply(h_shift, function(i) .getMoonPosition(.hourslater(t, i + 1), lat, lng)$altitude - hc) 253 | h0 <- matrix(NA, nrow(h1), ncol(h1)) 254 | h0[, 1] <- .getMoonPosition(t, lat, lng)$altitude - hc 255 | h0[, 2:ncol(h0)] <- h2[, 1:(ncol(h2) - 1)] 256 | 257 | a <- (h0 + h2)/2 - h1 258 | b <- (h2 - h0)/2 259 | xe <- -b/(2 * a) 260 | ye <- (a * xe + b) * xe + h1 261 | 262 | suppressWarnings(x1 <- (-b / (2 * a)) - (sqrt(b * b - 4 * a * h1) / (2 * abs(a)))) 263 | suppressWarnings(x2 <- (-b / (2 * a)) + (sqrt(b * b - 4 * a * h1) / (2 * abs(a)))) 264 | 265 | idx <- which(abs(x1) <= 1, arr.ind = TRUE) 266 | roots <- matrix(0L, nrow(h0), ncol(h0)) 267 | roots[idx] <- roots[idx] + 1L 268 | 269 | idx <- which(abs(x2) <= 1, arr.ind = TRUE) 270 | roots[idx] <- roots[idx] + 1L 271 | 272 | idx <- which(x1 < -1, arr.ind = TRUE) 273 | x1[idx] <- x2[idx] 274 | 275 | # roots_idx <- apply(roots, 1, function(x) which(x > 0)[1]) 276 | 277 | rise <- matrix(NA_real_, nrow(h0), ncol(h0)) 278 | set <- matrix(NA_real_, nrow(h0), ncol(h0)) 279 | 280 | idx <- which(roots == 1 & h0 < 0, arr.ind = T) 281 | rise[idx] <- (x1 + h_shift[col(x1)])[idx] 282 | idx <- which(roots == 1 & h0 >= 0, arr.ind = T) 283 | set[idx] <- (x1 + h_shift[col(x1)])[idx] 284 | 285 | idx <- which(roots == 2 & ye < 0, arr.ind = T) 286 | rise[idx] <- (x2 + h_shift[col(x1)])[idx] 287 | set[idx] <- (x1 + h_shift[col(x1)])[idx] 288 | 289 | idx <- which(roots == 2 & ye >= 0, arr.ind = T) 290 | rise[idx] <- (x1 + h_shift[col(x1)])[idx] 291 | set[idx] <- (x2 + h_shift[col(x1)])[idx] 292 | 293 | ind_full_idx <- sapply(1:nrow(rise), function(i) which(!is.na(rise[i, ]) & !is.na(set[i, ]))[1]) 294 | ind_full_idx_nona <- which(!is.na(ind_full_idx)) 295 | 296 | rise_idx <- apply(rise, 1, function(i) which(!is.na(i))[1]) 297 | set_idx <- apply(set, 1, function(i) which(!is.na(i))[1]) 298 | 299 | if(length(ind_full_idx_nona) > 0){ 300 | rise_idx[ind_full_idx_nona] <- ind_full_idx[ind_full_idx_nona] 301 | set_idx[ind_full_idx_nona] <- ind_full_idx[ind_full_idx_nona] 302 | } 303 | rise <- rise[cbind(1:length(t), rise_idx)] 304 | set <- set[cbind(1:length(t), set_idx)] 305 | 306 | ye <- ye[, ncol(ye)] 307 | 308 | } else { 309 | h0 <- .getMoonPosition(t, lat, lng)$altitude - hc 310 | rise <- NULL 311 | set <- NULL 312 | 313 | # go in 2-hour chunks, each time seeing if a 3-point quadratic curve crosses zero (which means rise or set) 314 | for (i in seq(1,23,2)) { 315 | 316 | h1 <- .getMoonPosition(.hourslater(t, i), lat, lng)$altitude - hc 317 | h2 <- .getMoonPosition(.hourslater(t, i + 1), lat, lng)$altitude - hc 318 | 319 | a <- (h0 + h2)/2 - h1 320 | b <- (h2 - h0)/2 321 | xe <- -b/(2 * a) 322 | ye <- (a * xe + b) * xe + h1 323 | d <- b * b - 4 * a * h1 324 | roots <- 0 325 | 326 | if (d >= 0) { 327 | dx <- sqrt(d) / (abs(a) * 2) 328 | 329 | x1 <- xe - dx 330 | x2 <- xe + dx 331 | if (abs(x1) <= 1) roots <- roots + 1 332 | if (abs(x2) <= 1) roots <- roots + 1 333 | if (x1 < -1) x1 <- x2 334 | } 335 | 336 | if (roots == 1) { 337 | if (h0 < 0) rise <- i + x1 338 | else set <- i + x1 339 | 340 | } else if (roots == 2) { 341 | rise <- i + ifelse(ye < 0, x2, x1) 342 | set <- i + ifelse(ye < 0, x1, x2) 343 | } 344 | 345 | if (!is.null(rise) && !is.null(set)) break 346 | h0 <- h2 347 | } 348 | 349 | rise <- ifelse(is.null(rise), NA, rise) 350 | set <- ifelse(is.null(set), NA, set) 351 | } 352 | 353 | return(list(rise = .hourslater(t, rise), 354 | set = .hourslater(t, set), 355 | alwaysUp = ifelse(is.na(rise) & is.na(set) & ye > 0, TRUE, FALSE), 356 | alwaysDown = ifelse(is.na(rise) & is.na(set) & ye <= 0, TRUE, FALSE) 357 | ) 358 | ) 359 | } 360 | -------------------------------------------------------------------------------- /R/getMoonIllumination.R: -------------------------------------------------------------------------------- 1 | #' Get Moon illumination 2 | #' 3 | #' @param date : Single or multiple DateTime. Can be a \code{Date} (YYYY-MM-DD), 4 | #' a \code{character} in UTC (YYYY-MM-DD HH:mm:ss) or a \code{POSIXct} 5 | #' @param keep : \code{character}. Vector of variables to keep. See \code{Details} 6 | #' 7 | #' @return \code{data.frame} 8 | #' 9 | #' @details 10 | #' 11 | #' Returns an object with the following properties: 12 | #' 13 | #' \itemize{ 14 | #' \item{"fraction"}{ : illuminated fraction of the moon; varies from 0.0 (new moon) to 1.0 (full moon)} 15 | #' \item{"phase"}{ : moon phase; varies from 0.0 to 1.0, described below} 16 | #' \item{"angle"}{ : midpoint angle in radians of the illuminated limb of the moon reckoned eastward from 17 | #' the north point of the disk; the moon is waxing if the angle is negative, and waning if positive} 18 | #' } 19 | #' 20 | #' Moon phase value should be interpreted like this: 21 | #' \itemize{ 22 | #' \item{0}{ : New Moon} 23 | #' \item{}{Waxing Crescent} 24 | #' \item{0.25}{ : First Quarter} 25 | #' \item{}{ : Waxing Gibbous} 26 | #' \item{0.5}{Full Moon} 27 | #' \item{}{ : Waning Gibbous} 28 | #' \item{0.75}{Last Quarter} 29 | #' \item{}{ : Waning Crescent} 30 | #'} 31 | #' 32 | #' By subtracting the parallacticAngle from the angle one can get the zenith angle of the moons bright limb (anticlockwise). The zenith angle can be used do draw the moon shape from the observers perspective (e.g. moon lying on its back). 33 | #' 34 | #' @examples 35 | #' 36 | #' # one date 37 | #' getMoonIllumination(date = Sys.Date()) 38 | #' 39 | #' # in character 40 | #' getMoonIllumination(date = c("2017-05-12", "2017-05-12 00:00:00"), 41 | #' keep = c("fraction", "phase")) 42 | #' 43 | #' # in POSIXct 44 | #' getMoonIllumination(date = as.POSIXct("2017-05-12 00:00:00", tz = "UTC")) 45 | #' getMoonIllumination(date = as.POSIXct("2017-05-12 02:00:00", tz = "CET")) 46 | #' 47 | #' date <- seq(ISOdate(2009,1,1), ISOdate(2010,1,1), "hours") 48 | #' date_cet <- date 49 | #' attr(date_cet, "tzone") <- "CET" 50 | #' res <- getMoonIllumination(date = date_cet) 51 | #' 52 | #' @rawNamespace import(data.table, except = hour) 53 | #' @import magrittr 54 | #' @importFrom lubridate as_datetime 55 | #' @importFrom lubridate hours 56 | #' @importFrom lubridate seconds 57 | #' @importFrom lubridate hour 58 | #' 59 | #' @export 60 | #' 61 | #' @seealso \link{getSunlightTimes}, \link{getMoonTimes}, \link{getMoonIllumination}, 62 | #' \link{getMoonPosition},\link{getSunlightPosition} 63 | #' 64 | getMoonIllumination <- function(date = Sys.Date(), 65 | keep = c("fraction", "phase", "angle")){ 66 | 67 | # variable control 68 | available_var <- c("fraction", "phase", "angle") 69 | stopifnot(all(keep %in% available_var)) 70 | 71 | # tz and date control 72 | requestDate <- .buildRequestDate(date) 73 | data <- data.table(date = date, requestDate = requestDate) 74 | 75 | data <- data %>% 76 | .[, (available_var) := .getMoonIllumination(date = requestDate)] %>% 77 | .[, c("date", keep), with = FALSE] %>% 78 | as.data.frame() 79 | 80 | return(data) 81 | } 82 | -------------------------------------------------------------------------------- /R/getMoonPosition.R: -------------------------------------------------------------------------------- 1 | #' Get Moon position 2 | #' 3 | #' @param date : Single or multiple DateTime. Can be a \code{Date} (YYYY-MM-DD), 4 | #' a \code{character} in UTC (YYYY-MM-DD HH:mm:ss) or a \code{POSIXct} 5 | #' @param lat : \code{numeric}. Single latitude 6 | #' @param lon : \code{numeric}. Single longitude 7 | #' @param data : \code{data.frame}. Alternative to use \code{date}, \code{lat}, \code{lon} for passing multiple coordinates 8 | #' @param keep : \code{character}. Vector of variables to keep. See \code{Details} 9 | #' 10 | #' @return \code{data.frame} 11 | #' 12 | #' @details 13 | #' 14 | #' Returns an object with the following properties: 15 | #' 16 | #' \itemize{ 17 | #' \item{"altitude"}{ : moon altitude above the horizon in radians} 18 | #' \item{"azimuth"}{ : moon azimuth in radians} 19 | #' \item{"distance"}{ : distance to moon in kilometers} 20 | #' \item{"parallacticAngle"}{ : parallactic angle of the moon in radians} 21 | #' } 22 | #' 23 | #' @examples 24 | #' 25 | #' # one date 26 | #' getMoonPosition(date = Sys.Date(), lat = 50.1, lon = 1.83) 27 | #' 28 | #' # in character 29 | #' getMoonPosition(date = c("2017-05-12", "2017-05-12 00:00:00"), 30 | #' lat = 50.1, lon = 1.83) 31 | #' 32 | #' # in POSIXct 33 | #' getMoonPosition(date = as.POSIXct("2017-05-12 00:00:00", tz = "UTC"), 34 | #' lat = 50.1, lon = 1.83) 35 | #' getMoonPosition(date = as.POSIXct("2017-05-12 02:00:00", tz = "CET"), 36 | #' lat = 50.1, lon = 1.83) 37 | #' 38 | #' # multiple date + subset 39 | #' getMoonPosition(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 40 | #' keep = c("altitude", "azimuth"), 41 | #' lat = 50.1, lon = 1.83) 42 | #' 43 | #' # multiple coordinates 44 | #' data <- data.frame(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 45 | #' lat = c(rep(50.1, 10), rep(49, 10)), 46 | #' lon = c(rep(1.83, 10), rep(2, 10))) 47 | #' 48 | #' getMoonPosition(data = data, 49 | #' keep = c("altitude", "azimuth")) 50 | #' 51 | #' 52 | #' @rawNamespace import(data.table, except = hour) 53 | #' @import magrittr 54 | #' @importFrom lubridate as_datetime 55 | #' @importFrom lubridate hours 56 | #' @importFrom lubridate seconds 57 | #' @importFrom lubridate hour 58 | #' 59 | #' @export 60 | #' 61 | #' @seealso \link{getSunlightTimes}, \link{getMoonTimes}, \link{getMoonIllumination}, 62 | #' \link{getMoonPosition},\link{getSunlightPosition} 63 | #' 64 | getMoonPosition <- function(date = NULL, lat = NULL, lon = NULL, data = NULL, 65 | keep = c("altitude", "azimuth", "distance", "parallacticAngle")){ 66 | 67 | # data control 68 | data <- .buildData(date = date, lat = lat, lon = lon, data = data) 69 | 70 | # variable control 71 | available_var <- c("altitude", "azimuth", "distance", "parallacticAngle") 72 | stopifnot(all(keep %in% available_var)) 73 | 74 | # tz and date control 75 | data$requestDate <- .buildRequestDate(data$date) 76 | 77 | data <- data %>% 78 | .[, (available_var) := .getMoonPosition(date = requestDate, lat = lat, lng = lon)] %>% 79 | .[, c("date", "lat", "lon", keep), with = FALSE] %>% 80 | as.data.frame() 81 | 82 | return(data) 83 | } 84 | -------------------------------------------------------------------------------- /R/getMoonTimes.R: -------------------------------------------------------------------------------- 1 | #' Get Moon times 2 | #' 3 | #' @param date : \code{Date}. Single or multiple Date. YYYY-MM-DD 4 | #' @param lat : \code{numeric}. Single latitude 5 | #' @param lon : \code{numeric}. Single longitude 6 | #' @param data : \code{data.frame}. Alternative to use \code{date}, \code{lat}, \code{lon} for passing multiple coordinates 7 | #' @param keep : \code{character}. Vector of variables to keep. See \code{Details} 8 | #' @param tz : \code{character}. Timezone of results 9 | #' @param ... :Not used. (Maintenance only) 10 | #' 11 | #' @return \code{data.frame} 12 | #' 13 | #' @details 14 | #' 15 | #' Available variables are : 16 | #' 17 | #' \itemize{ 18 | #' \item{"rise"}{ : \code{Date}. moonrise time} 19 | #' \item{"set"}{ : \code{Date}. moonset time} 20 | #' \item{"alwaysUp"}{ : \code{Logical}. TRUE if the moon never rises or sets and is always above the horizon during the day} 21 | #' \item{"alwaysDown"}{ : \code{Logical}. TRUE if the moon is always below the horizon} 22 | #' } 23 | #' 24 | #' @examples 25 | #' 26 | #' # one date 27 | #' getMoonTimes(date = Sys.Date(), lat = 47.21, lon = -1.557, tz = "CET") 28 | #' 29 | #' # multiple date + subset 30 | #' getMoonTimes(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 31 | #' keep = c("rise", "set", "alwaysUp"), 32 | #' lat = 47.21, lon = -1.557, tz = "CET") 33 | #' 34 | #' # multiple coordinates 35 | #' data <- data.frame(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 36 | #' lat = c(rep(50.1, 10), rep(49, 10)), 37 | #' lon = c(rep(1.83, 10), rep(2, 10))) 38 | #' 39 | #' getMoonTimes(data = data, tz = "CET") 40 | #' 41 | #' @rawNamespace import(data.table, except = hour) 42 | #' @import magrittr 43 | #' @importFrom lubridate as_datetime 44 | #' @importFrom lubridate hours 45 | #' @importFrom lubridate seconds 46 | #' @importFrom lubridate hour 47 | #' 48 | #' @export 49 | #' 50 | #' @seealso \link{getSunlightTimes}, \link{getMoonTimes}, \link{getMoonIllumination}, 51 | #' \link{getMoonPosition},\link{getSunlightPosition} 52 | #' 53 | getMoonTimes <- function(date = NULL, lat = NULL, lon = NULL, data = NULL, 54 | keep = c("rise", "set", "alwaysUp", "alwaysDown"), 55 | tz = "UTC", ...){ 56 | 57 | 58 | if("inUTC" %in% names(list(...))){ 59 | warning("inUTC is deprecated since suncalc >= 0.5.2") 60 | } 61 | 62 | # data control 63 | data <- .buildData(date = date, lat = lat, lon = lon, data = data) 64 | 65 | if (!"Date" %in% class(data$date)) { 66 | stop("date must to be a Date object (class Date)") 67 | } 68 | 69 | # variable control 70 | available_var <- c("rise", "set", "alwaysUp", "alwaysDown") 71 | stopifnot(all(keep %in% available_var)) 72 | 73 | data <- data %>% 74 | # .[, date := lubridate::as_datetime(date, tz = "UTC") + lubridate::hours(12)] %>% 75 | .[, date := lubridate::force_tz(lubridate::as_datetime(date) + lubridate::hours(12), "UTC")] %>% 76 | .[, (available_var) := .getMoonTimes(date = date, lat = lat, lng = lon)] %>% 77 | .[, c("date", "lat", "lon", keep), with = FALSE] %>% 78 | .[, date := as.Date(date)] 79 | 80 | if (!is.null(tz)) { 81 | invisible(lapply(c("rise", "set"), 82 | function(x) if(x %in% names(data)) attr(data[[x]], "tzone") <<- tz) 83 | ) 84 | } 85 | 86 | if(any(c("rise", "set") %in% colnames(data))){ 87 | # browser() 88 | # check value with datetime before date in TZ 89 | mat <- as.matrix(data[, intersect(colnames(data), c("rise", "set")), with = FALSE]) 90 | is_inf <- which(is.na(mat) | mat < as.character(lubridate::force_tz(lubridate::as_datetime(data$date) + lubridate::hours(0), tz)), arr.ind = T) 91 | 92 | if(nrow(is_inf) > 0){ 93 | 94 | is_inf <- as.data.table(is_inf) 95 | 96 | unique_inf_row <- data.frame(row = sort(unique(is_inf$row))) 97 | unique_inf_row$id_row <- 1:nrow(unique_inf_row) 98 | 99 | is_inf[, id_row := unique_inf_row$id_row[match(row, unique_inf_row$row)]] 100 | 101 | data_inf <- data[unique_inf_row$row, c("date", "lat", "lon"), with = FALSE] 102 | 103 | data_inf <- data_inf %>% 104 | .[, date := lubridate::force_tz(lubridate::as_datetime(date + 1) + lubridate::hours(12), "UTC")] %>% 105 | .[, (available_var) := .getMoonTimes(date = date, lat = lat, lng = lon)] %>% 106 | .[, c("date", "lat", "lon", keep), with = FALSE] %>% 107 | .[, date := as.Date(date)] 108 | 109 | if (!is.null(tz)) { 110 | invisible(lapply(c("rise", "set"), 111 | function(x) if(x %in% names(data_inf)) attr(data_inf[[x]], "tzone") <<- tz) 112 | ) 113 | } 114 | 115 | invisible({ 116 | lapply( 117 | unique(is_inf$col), 118 | function(x){ 119 | col_names <- intersect(colnames(data), c("rise", "set"))[x] 120 | data[is_inf[col == x, row], c(col_names) := data_inf[is_inf[col == x, id_row], get(col_names)]] 121 | data[is_inf[col == x, row] & as.Date(get(col_names), tz = tz) != date, c(col_names) := NA] 122 | } 123 | ) 124 | }) 125 | } 126 | 127 | # check value with datetime after date in TZ 128 | mat <- as.matrix(data[, intersect(colnames(data), c("rise", "set")), with = FALSE]) 129 | is_sup <- which(is.na(mat) | mat >= as.character(lubridate::force_tz(lubridate::as_datetime(data$date + 1) + lubridate::hours(0), tz)), arr.ind = T) 130 | if(nrow(is_sup) > 0){ 131 | 132 | is_sup <- as.data.table(is_sup) 133 | 134 | unique_sup_row <- data.frame(row = sort(unique(is_sup$row))) 135 | unique_sup_row$id_row <- 1:nrow(unique_sup_row) 136 | 137 | is_sup[, id_row := unique_sup_row$id_row[match(row, unique_sup_row$row)]] 138 | 139 | data_sup <- data[unique_sup_row$row, c("date", "lat", "lon"), with = FALSE] 140 | 141 | data_sup <- data_sup %>% 142 | .[, date := lubridate::force_tz(lubridate::as_datetime(date - 1) + lubridate::hours(12), "UTC")] %>% 143 | .[, (available_var) := .getMoonTimes(date = date, lat = lat, lng = lon)] %>% 144 | .[, c("date", "lat", "lon", keep), with = FALSE] %>% 145 | .[, date := as.Date(date)] 146 | 147 | if (!is.null(tz)) { 148 | invisible(lapply(c("rise", "set"), 149 | function(x) if(x %in% names(data_sup)) attr(data_sup[[x]], "tzone") <<- tz) 150 | ) 151 | } 152 | 153 | invisible({ 154 | lapply( 155 | unique(is_sup$col), 156 | function(x){ 157 | col_names <- intersect(colnames(data), c("rise", "set"))[x] 158 | data[is_sup[col == x, row], c(col_names) := data_sup[is_sup[col == x, id_row], get(col_names)]] 159 | data[is_sup[col == x, row] & as.Date(get(col_names), tz = tz) != date, c(col_names) := NA] 160 | } 161 | ) 162 | }) 163 | } 164 | } 165 | 166 | return(as.data.frame(data)) 167 | 168 | } 169 | -------------------------------------------------------------------------------- /R/getSunlightPosition.R: -------------------------------------------------------------------------------- 1 | #' Get Sunlight position 2 | #' 3 | #' @param date : Single or multiple DateTime. Can be a \code{Date} (YYYY-MM-DD), 4 | #' a \code{character} in UTC (YYYY-MM-DD HH:mm:ss) or a \code{POSIXct} 5 | #' @param lat : \code{numeric}. Single latitude 6 | #' @param lon : \code{numeric}. Single longitude 7 | #' @param data : \code{data.frame}. Alternative to use \code{date}, \code{lat}, \code{lon} for passing multiple coordinates 8 | #' @param keep : \code{character}. Vector of variables to keep. See \code{Details} 9 | #' 10 | #' @return \code{data.frame} 11 | #' 12 | #' @details 13 | #' 14 | #' Returns an object with the following properties: 15 | #' 16 | #' \itemize{ 17 | #' \item{"altitude"}{ : sun altitude above the horizon in radians, e.g. 0 at the horizon and PI/2 at the zenith (straight over your head)} 18 | #' \item{"azimuth"}{ : sun azimuth in radians (direction along the horizon, measured from south to west), e.g. 0 is south and Math.PI * 3/4 is northwest} 19 | #' } 20 | #' 21 | #' @examples 22 | #' 23 | #' # one date 24 | #' getSunlightPosition(date = Sys.Date(), lat = 50.1, lon = 1.83) 25 | #' 26 | #' # in character 27 | #' getSunlightPosition(date = c("2017-05-12", "2017-05-12 00:00:00"), 28 | #' lat = 50.1, lon = 1.83) 29 | #' 30 | #' # in POSIXct 31 | #' getSunlightPosition(date = as.POSIXct("2017-05-12 00:00:00", tz = "UTC"), 32 | #' lat = 50.1, lon = 1.83) 33 | #' getSunlightPosition(date = as.POSIXct("2017-05-12 02:00:00", tz = "CET"), 34 | #' lat = 50.1, lon = 1.83) 35 | #' 36 | #' # multiple date + subset 37 | #' getSunlightPosition(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 38 | #' keep = c("altitude"), 39 | #' lat = 50.1, lon = 1.83) 40 | #' 41 | #' # multiple coordinates 42 | #' data <- data.frame(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 43 | #' lat = c(rep(50.1, 10), rep(49, 10)), 44 | #' lon = c(rep(1.83, 10), rep(2, 10))) 45 | #' 46 | #' getSunlightPosition(data = data, 47 | #' keep = c("altitude", "azimuth")) 48 | #' 49 | #' 50 | #' @rawNamespace import(data.table, except = hour) 51 | #' @import magrittr 52 | #' @importFrom lubridate as_datetime 53 | #' @importFrom lubridate hours 54 | #' @importFrom lubridate seconds 55 | #' @importFrom lubridate hour 56 | #' 57 | #' @export 58 | #' 59 | #' @seealso \link{getSunlightTimes}, \link{getMoonTimes}, \link{getMoonIllumination}, 60 | #' \link{getMoonPosition},\link{getSunlightPosition} 61 | #' 62 | getSunlightPosition <- function(date = NULL, lat = NULL, lon = NULL, data = NULL, 63 | keep = c("altitude", "azimuth")) { 64 | 65 | # data control 66 | data <- .buildData(date = date, lat = lat, lon = lon, data = data) 67 | 68 | 69 | # variable control 70 | available_var <- c("altitude", "azimuth") 71 | stopifnot(all(keep %in% available_var)) 72 | 73 | # tz and date control 74 | data$requestDate <- .buildRequestDate(data$date) 75 | 76 | data <- data %>% 77 | .[, (available_var) := .getPosition(date = requestDate, lat = lat, lng = lon)] %>% 78 | .[, c("date", "lat", "lon", keep), with = FALSE] %>% 79 | as.data.frame() 80 | 81 | return(data) 82 | } 83 | -------------------------------------------------------------------------------- /R/getSunlightTimes.R: -------------------------------------------------------------------------------- 1 | #' Get Sunlight times 2 | #' 3 | #' @param date : \code{Date}. Single or multiple Date. YYYY-MM-DD 4 | #' @param lat : \code{numeric}. Single latitude 5 | #' @param lon : \code{numeric}. Single longitude 6 | #' @param data : \code{data.frame}. Alternative to use \code{date}, \code{lat}, \code{lon} for passing multiple coordinates 7 | #' @param keep : \code{character}. Vector of variables to keep. See \code{Details} 8 | #' @param tz : \code{character}. Timezone of results 9 | #' 10 | #' @return \code{data.frame} 11 | #' 12 | #' @details 13 | #' 14 | #' Available variables are : 15 | #' 16 | #' \itemize{ 17 | #' \item{"sunrise"}{ : sunrise (top edge of the sun appears on the horizon)} 18 | #' \item{"sunriseEnd"}{ : sunrise ends (bottom edge of the sun touches the horizon)} 19 | #' \item{"goldenHourEnd"}{ : morning golden hour (soft light, best time for photography) ends} 20 | #' \item{"solarNoon"}{ : solar noon (sun is in the highest position)} 21 | #' \item{"goldenHour"}{ : evening golden hour starts} 22 | #' \item{"sunsetStart"}{ : sunset starts (bottom edge of the sun touches the horizon)} 23 | #' \item{"sunset"}{ : sunset (sun disappears below the horizon, evening civil twilight starts)} 24 | #' \item{"dusk"}{ : dusk (evening nautical twilight starts)} 25 | #' \item{"nauticalDusk"}{ : nautical dusk (evening astronomical twilight starts)} 26 | #' \item{"night"}{ : night starts (dark enough for astronomical observations)} 27 | #' \item{"nadir"}{ : nadir (darkest moment of the night, sun is in the lowest position)} 28 | #' \item{"nightEnd"}{ : night ends (morning astronomical twilight starts)} 29 | #' \item{"nauticalDawn"}{ : nautical dawn (morning nautical twilight starts)} 30 | #' \item{"dawn"}{ : dawn (morning nautical twilight ends, morning civil twilight starts)} 31 | #' } 32 | #' 33 | #' @examples 34 | #' 35 | #' # one date 36 | #' getSunlightTimes(date = Sys.Date(), lat = 50.1, lon = 1.83, tz = "CET") 37 | #' 38 | #' # multiple date + subset 39 | #' getSunlightTimes(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 40 | #' keep = c("sunrise", "sunriseEnd", "sunset", "sunsetStart"), 41 | #' lat = 50.1, lon = 1.83, tz = "CET") 42 | #' 43 | #' # multiple coordinates 44 | #' data <- data.frame(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 45 | #' lat = c(rep(50.1, 10), rep(49, 10)), 46 | #' lon = c(rep(1.83, 10), rep(2, 10))) 47 | #' 48 | #' getSunlightTimes(data = data, 49 | #' keep = c("sunrise", "sunriseEnd", "sunset", "sunsetStart"), tz = "CET") 50 | #' 51 | #' @rawNamespace import(data.table, except = hour) 52 | #' @import magrittr 53 | #' @importFrom lubridate as_datetime 54 | #' @importFrom lubridate hours 55 | #' @importFrom lubridate seconds 56 | #' @importFrom lubridate hour 57 | #' 58 | #' @export 59 | #' 60 | #' @seealso \link{getSunlightTimes}, \link{getMoonTimes}, \link{getMoonIllumination}, 61 | #' \link{getMoonPosition},\link{getSunlightPosition} 62 | #' 63 | getSunlightTimes <- function(date = NULL, lat = NULL, lon = NULL, data = NULL, 64 | keep = c("solarNoon", "nadir", "sunrise", "sunset", "sunriseEnd", "sunsetStart", 65 | "dawn", "dusk", "nauticalDawn", "nauticalDusk", "nightEnd", "night", 66 | "goldenHourEnd", "goldenHour"), 67 | tz = "UTC"){ 68 | 69 | 70 | # data control 71 | data <- .buildData(date = date, lat = lat, lon = lon, data = data) 72 | 73 | if (!"Date" %in% class(data$date)) { 74 | stop("date must to be a Date object (class Date)") 75 | } 76 | 77 | # variable control 78 | available_var <- c("solarNoon", "nadir", "sunrise", "sunset", "sunriseEnd", "sunsetStart", 79 | "dawn", "dusk", "nauticalDawn", "nauticalDusk", "nightEnd", "night", 80 | "goldenHourEnd", "goldenHour") 81 | stopifnot(all(keep %in% available_var)) 82 | 83 | # date := lubridate::force_tz(lubridate::as_datetime(Sys.Date()) + lubridate::hours(12), Sys.timezone()) 84 | data <- data %>% 85 | .[, date := lubridate::force_tz(lubridate::as_datetime(date) + lubridate::hours(12), "UTC")] %>% 86 | .[, (available_var) := .getTimes(date = date, lat = lat, lng = lon, tz = "UTC")] %>% 87 | .[, c("date", "lat", "lon", keep), with = FALSE] %>% 88 | .[, date := as.Date(date)] 89 | 90 | invisible({ 91 | lapply( 92 | setdiff(colnames(data), c("date", "lat", "lon")), 93 | function(x) attr(data[[x]], "tzone") <<- tz 94 | ) 95 | }) 96 | 97 | # check value with datetime before date in TZ 98 | mat <- as.matrix(data[, setdiff(colnames(data), c("date", "lat", "lon")), with = FALSE]) 99 | is_inf <- which(is.na(mat) | mat < as.character(lubridate::force_tz(lubridate::as_datetime(data$date) + lubridate::hours(0), tz)), arr.ind = T) 100 | if(nrow(is_inf) > 0){ 101 | 102 | is_inf <- as.data.table(is_inf) 103 | 104 | unique_inf_row <- data.frame(row = sort(unique(is_inf$row))) 105 | unique_inf_row$id_row <- 1:nrow(unique_inf_row) 106 | 107 | is_inf[, id_row := unique_inf_row$id_row[match(row, unique_inf_row$row)]] 108 | 109 | data_inf <- data[unique_inf_row$row, c("date", "lat", "lon"), with = FALSE] 110 | 111 | data_inf <- data_inf %>% 112 | .[, date := lubridate::force_tz(lubridate::as_datetime(date + 1) + lubridate::hours(12), "UTC")] %>% 113 | .[, (available_var) := .getTimes(date = date, lat = lat, lng = lon, tz = "UTC")] %>% 114 | .[, c("date", "lat", "lon", keep), with = FALSE] %>% 115 | .[, date := as.Date(date)] 116 | 117 | invisible({ 118 | lapply( 119 | setdiff(colnames(data_inf), c("date", "lat", "lon")), 120 | function(x) attr(data_inf[[x]], "tzone") <<- tz 121 | ) 122 | }) 123 | 124 | invisible({ 125 | lapply( 126 | unique(is_inf$col), 127 | function(x){ 128 | col_names <- setdiff(colnames(data), c("date", "lat", "lon"))[x] 129 | data[is_inf[col == x, row], c(col_names) := data_inf[is_inf[col == x, id_row], get(col_names)]] 130 | } 131 | ) 132 | }) 133 | } 134 | 135 | # check value with datetime after date in TZ 136 | mat <- as.matrix(data[, setdiff(colnames(data), c("date", "lat", "lon")), with = FALSE]) 137 | is_sup <- which(is.na(mat) | mat >= as.character(lubridate::force_tz(lubridate::as_datetime(data$date + 1) + lubridate::hours(0), tz)), arr.ind = T) 138 | if(nrow(is_sup) > 0){ 139 | 140 | is_sup <- as.data.table(is_sup) 141 | 142 | unique_sup_row <- data.frame(row = sort(unique(is_sup$row))) 143 | unique_sup_row$id_row <- 1:nrow(unique_sup_row) 144 | 145 | is_sup[, id_row := unique_sup_row$id_row[match(row, unique_sup_row$row)]] 146 | 147 | data_sup <- data[unique_sup_row$row, c("date", "lat", "lon"), with = FALSE] 148 | 149 | data_sup <- data_sup %>% 150 | .[, date := lubridate::force_tz(lubridate::as_datetime(date - 1) + lubridate::hours(12), "UTC")] %>% 151 | .[, (available_var) := .getTimes(date = date, lat = lat, lng = lon, tz = "UTC")] %>% 152 | .[, c("date", "lat", "lon", keep), with = FALSE] %>% 153 | .[, date := as.Date(date)] 154 | 155 | invisible({ 156 | lapply( 157 | setdiff(colnames(data_sup), c("date", "lat", "lon")), 158 | function(x) attr(data_sup[[x]], "tzone") <<- tz 159 | ) 160 | }) 161 | 162 | invisible({ 163 | lapply( 164 | unique(is_sup$col), 165 | function(x){ 166 | col_names <- setdiff(colnames(data), c("date", "lat", "lon"))[x] 167 | data[is_sup[col == x, row], c(col_names) := data_sup[is_sup[col == x, id_row], get(col_names)]] 168 | } 169 | ) 170 | }) 171 | } 172 | 173 | return(as.data.frame(data)) 174 | } 175 | -------------------------------------------------------------------------------- /R/suncalc.R: -------------------------------------------------------------------------------- 1 | ## quiets concerns of R CMD check re: the .'s that appear in pipelines 2 | if(getRversion() >= "2.15.1") utils::globalVariables(c(".", "requestDate")) -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | .buildData <- function(date = NULL, lat = NULL, lon = NULL, data = NULL){ 2 | # data control 3 | if(!is.null(data)) { 4 | if(!is.null(date) | !is.null(lat) | !is.null(lon)){ 5 | stop("Must use only 'data' argument, or 'date', 'lat', and 'lon' together. See examples") 6 | } 7 | 8 | if(!inherits(data, "data.table")) { 9 | data <- data.table(data) 10 | } 11 | 12 | } else { 13 | if(is.null(date) | is.null(lat) | is.null(lon)){ 14 | stop("Must use only 'data' argument, or 'date', 'lat', and 'lon' together. See examples") 15 | } 16 | 17 | if(length(lat) > 1) { 18 | stop("'lat' must be a unique element. Use 'data' for multiple 'lat'") 19 | } 20 | if(length(lon) > 1) { 21 | stop("'lon' must be a unique element. Use 'data' for multiple 'lon'") 22 | } 23 | data <- data.table(date = date, lat = lat, lon = lon, stringsAsFactors = FALSE) 24 | } 25 | 26 | stopifnot(all(c("date", "lat", "lon") %in% colnames(data))) 27 | 28 | return(data) 29 | } 30 | 31 | .buildRequestDate <- function(date){ 32 | if(!any(c("Date", "POSIXct", "character") %in% class(date))){ 33 | stop("date must to be a Date object (class Date) or POSIXct or character") 34 | } 35 | request_date <- date 36 | if("POSIXct" %in% class(date)){ 37 | if(is.null(attr(date, "tzone"))){ 38 | attr(request_date, "tzone") <- "UTC" 39 | warning("No tzone present in 'date', so 'date' is convert to 'UTC' for request using 'attr(date, 'tzone') <- 'UTC'") 40 | } else if(attr(date, "tzone") != "UTC"){ 41 | attr(request_date, "tzone") <- "UTC" 42 | # warning("'date' is convert to 'UTC' for request using 'attr(date, 'tzone') <- 'UTC'") 43 | } 44 | } 45 | request_date 46 | } 47 | 48 | utils::globalVariables(c("id_row")) 49 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![CRAN Status Badge](http://www.r-pkg.org/badges/version/suncalc)](https://cran.r-project.org/package=suncalc) 2 | [![CRAN Downloads Badge](https://cranlogs.r-pkg.org/badges/suncalc)](https://cran.r-project.org/package=suncalc) 3 | 4 | # suncalc 5 | 6 | ### R implementation for calculating sun position, sunlight phases (times for sunrise, sunset, dusk, etc.), moon position and lunar phase for the given location and time. Most calculations are based on the formulas given in Astronomy Answers articles about position of the sun and the planets : 7 | 8 | # News 9 | 10 | ## ``0.5.0`` dev version 11 | 12 | * fully recode in R rather than call suncalc.js, so up to 500x faster...! 13 | 14 | # Installation 15 | 16 | ```` 17 | # from cran 18 | install.packages("suncalc") 19 | devtools::install_github("datastorm-open/suncalc") for developpement version 20 | ```` 21 | 22 | # Use 23 | 24 | ```` 25 | require(suncalc) 26 | ?getSunlightTimes 27 | getSunlightTimes(date = Sys.Date(), lat = 50.1, lon = 1.83, tz = "CET") 28 | ```` 29 | 30 | # About suncalc 31 | 32 | Most calculations are based on the formulas given in the excellent Astronomy Answers articles 33 | about [position of the sun](https://www.aa.quae.nl/en/reken/zonpositie.html) 34 | and [the planets](https://www.aa.quae.nl/en/reken/hemelpositie.html). 35 | You can read about different twilight phases calculated by SunCalc 36 | in the [Twilight article on Wikipedia](https://en.wikipedia.org/wiki/Twilight). 37 | 38 | 39 | ## Reference 40 | 41 | ### Sunlight times 42 | 43 | 44 | Returns an object with the following properties (each is a `Date` object): 45 | 46 | | Property | Description | 47 | | --------------- | ------------------------------------------------------------------------ | 48 | | `sunrise` | sunrise (top edge of the sun appears on the horizon) | 49 | | `sunriseEnd` | sunrise ends (bottom edge of the sun touches the horizon) | 50 | | `goldenHourEnd` | morning golden hour (soft light, best time for photography) ends | 51 | | `solarNoon` | solar noon (sun is in the highest position) | 52 | | `goldenHour` | evening golden hour starts | 53 | | `sunsetStart` | sunset starts (bottom edge of the sun touches the horizon) | 54 | | `sunset` | sunset (sun disappears below the horizon, evening civil twilight starts) | 55 | | `dusk` | dusk (evening nautical twilight starts) | 56 | | `nauticalDusk` | nautical dusk (evening astronomical twilight starts) | 57 | | `night` | night starts (dark enough for astronomical observations) | 58 | | `nadir` | nadir (darkest moment of the night, sun is in the lowest position) | 59 | | `nightEnd` | night ends (morning astronomical twilight starts) | 60 | | `nauticalDawn` | nautical dawn (morning nautical twilight starts) | 61 | | `dawn` | dawn (morning nautical twilight ends, morning civil twilight starts) | 62 | 63 | 64 | ### Sun position 65 | 66 | Returns an object with the following properties: 67 | 68 | * `altitude`: sun altitude above the horizon in radians, 69 | e.g. `0` at the horizon and `PI/2` at the zenith (straight over your head) 70 | * `azimuth`: sun azimuth in radians (direction along the horizon, measured from south to west), 71 | e.g. `0` is south and `Math.PI * 3/4` is northwest 72 | 73 | 74 | ### Moon position 75 | 76 | 77 | 78 | Returns an object with the following properties: 79 | 80 | * `altitude`: moon altitude above the horizon in radians 81 | * `azimuth`: moon azimuth in radians 82 | * `distance`: distance to moon in kilometers 83 | * `parallacticAngle`: parallactic angle of the moon in radians 84 | 85 | 86 | ### Moon illumination 87 | 88 | Returns an object with the following properties: 89 | 90 | * `fraction`: illuminated fraction of the moon; varies from `0.0` (new moon) to `1.0` (full moon) 91 | * `phase`: moon phase; varies from `0.0` to `1.0`, described below 92 | * `angle`: midpoint angle in radians of the illuminated limb of the moon reckoned eastward from the north point of the disk; 93 | the moon is waxing if the angle is negative, and waning if positive 94 | 95 | Moon phase value should be interpreted like this: 96 | 97 | | Phase | Name | 98 | | -----:| --------------- | 99 | | 0 | New Moon | 100 | | | Waxing Crescent | 101 | | 0.25 | First Quarter | 102 | | | Waxing Gibbous | 103 | | 0.5 | Full Moon | 104 | | | Waning Gibbous | 105 | | 0.75 | Last Quarter | 106 | | | Waning Crescent | 107 | 108 | By subtracting the `parallacticAngle` from the `angle` one can get the zenith angle of the moons bright limb (anticlockwise). 109 | The zenith angle can be used do draw the moon shape from the observers perspective (e.g. moon lying on its back). 110 | 111 | ### Moon rise and set times 112 | 113 | Returns an object with the following properties: 114 | 115 | * `rise`: moonrise time as `Date` 116 | * `set`: moonset time as `Date` 117 | * `alwaysUp`: `true` if the moon never rises/sets and is always _above_ the horizon during the day 118 | * `alwaysDown`: `true` if the moon is always _below_ the horizon 119 | 120 | By default, it will search for moon rise and set during local user's day (frou 0 to 24 hours). 121 | If `inUTC` is set to true, it will instead search the specified date from 0 to 24 UTC hours. 122 | -------------------------------------------------------------------------------- /inst/dev_tests.R: -------------------------------------------------------------------------------- 1 | ## Install packages for testing 2 | 3 | # # Optimized version (V0.5) 4 | # remotes::install_github(repo = "AchrafElmar/suncalc", ref = "fullr_optimized", upgrade = F) 5 | # # V0.4 6 | # remotes::install_github(repo = "datastorm-open/suncalc", ref = "suncalc_js", upgrade = F) 7 | 8 | ## getSunlightTimes function ---- 9 | 10 | # one date 11 | new <- suncalc::getSunlightTimes(date = Sys.Date(), lat = 50.1, lon = 1.83, tz = "CET") 12 | old <- suncalcjs::getSunlightTimes(date = Sys.Date(), lat = 50.1, lon = 1.83, tz = "CET") 13 | stopifnot(all.equal(old[, -1], new[, -1], check.attributes = F)) 14 | 15 | new <- suncalc::getSunlightTimes(date = Sys.Date(), lat = 50.1, lon = 1.83, tz = "UTC") 16 | old <- suncalcjs::getSunlightTimes(date = Sys.Date(), lat = 50.1, lon = 1.83, tz = "UTC") 17 | stopifnot(all.equal(old[, -1], new[, -1], check.attributes = F)) 18 | 19 | 20 | # multiple date + subset 21 | new <- suncalc::getSunlightTimes(date = seq.Date(Sys.Date() - 9, Sys.Date(), by = 1), 22 | keep = c("sunrise", "sunriseEnd", "sunset", "sunsetStart"), 23 | lat = 50.1, lon = 1.83, tz = "CET") 24 | old <- suncalcjs::getSunlightTimes(date = seq.Date(Sys.Date() - 9, Sys.Date(), by = 1), 25 | keep = c("sunrise", "sunriseEnd", "sunset", "sunsetStart"), 26 | lat = 50.1, lon = 1.83, tz = "CET") 27 | stopifnot(all.equal(old[, -1], new[, -1], check.attributes = F)) 28 | 29 | # multiple coordinates 30 | data <- data.frame(date = seq.Date(Sys.Date() - 9, Sys.Date(), by = 1), 31 | lat = c(rep(50.1, 10), rep(49, 10)), 32 | lon = c(rep(1.83, 10), rep(2, 10))) 33 | 34 | new <- suncalc::getSunlightTimes(data = data, keep = c("sunrise", "sunriseEnd", "sunset", "sunsetStart"), 35 | tz = "CET") 36 | old <- suncalcjs::getSunlightTimes(data = data, keep = c("sunrise", "sunriseEnd", "sunset", "sunsetStart"), 37 | tz = "CET") 38 | stopifnot(all.equal(old[, -1], new[, -1], check.attributes = F)) 39 | 40 | new <- suncalc::getSunlightTimes(data = data, keep = c("sunrise", "sunriseEnd", "sunset", "sunsetStart"), 41 | tz = "UTC") 42 | old <- suncalcjs::getSunlightTimes(data = data, keep = c("sunrise", "sunriseEnd", "sunset", "sunsetStart"), 43 | tz = "UTC") 44 | stopifnot(all.equal(old[, -1], new[, -1], check.attributes = F)) 45 | 46 | 47 | # Perf 48 | data <- data.frame(date = rep(seq.Date(Sys.Date() - 4999, Sys.Date(), by = 1), 2), 49 | lat = c(rep(50.1, 5000), rep(49, 5000)), 50 | lon = c(rep(1.83, 5000), rep(2, 5000))) 51 | 52 | system.time(new <- suncalc::getSunlightTimes(data = data, keep = c("sunrise", "sunriseEnd", "sunset", "sunsetStart"), 53 | tz = "CET")) 54 | system.time(old <- suncalcjs::getSunlightTimes(data = data, keep = c("sunrise", "sunriseEnd", "sunset", "sunsetStart"), 55 | tz = "CET")) 56 | stopifnot(all.equal(old[, -1], new[, -1], check.attributes = F)) 57 | 58 | # grid lat lon tz 59 | grid <- expand.grid( 60 | date = seq.Date(Sys.Date() - 365, Sys.Date(), by = 20), 61 | lat = seq(-90, 90, by = 10), 62 | lon = seq(-180, 180, by = 10) 63 | ) 64 | 65 | v_tz <- c("UTC", "CET", "Australia/Perth", "Africa/Johannesburg", "America/Bahia", "Asia/Bahrain", "Europe/Moscow") 66 | 67 | # a creuser ici.... 68 | tz <- "UTC" 69 | ctrl <- lapply(v_tz, function(tz){ 70 | print(tz) 71 | system.time(new <- suncalc::getSunlightTimes(data = grid, tz = tz)) 72 | system.time(old <- suncalcjs::getSunlightTimes(data = grid, tz = tz)) 73 | old$date <- as.Date(old$date) 74 | stopifnot(all.equal(old, new)) 75 | 76 | # 77 | # # pour verifier la difference numerique 78 | # lapply(colnames(old)[-c(1:3)], function(x){ 79 | # print(x) 80 | # stopifnot( all(as.character(old[[x]]) == as.character(new[[x]]))) 81 | # }) 82 | # 83 | # x <- "solarNoon" 84 | # 85 | # ind_diff <- which(as.character(old[[x]]) != as.character(new[[x]])) 86 | # 87 | # View(new[ind_diff, ]) 88 | # View(old[ind_diff, ]) 89 | # 90 | # ind_diff 91 | # 92 | # old[old$lat == -70 & old$lon == -160,] 93 | # new[new$lat == -70 & new$lon == -160,] 94 | # 95 | # View(new[new$date != as.Date(new$solarNoon), ]) 96 | # View(old[old$date != as.Date(old$solarNoon), ]) 97 | # head(old[as.character(old[[x]]) != as.character(new[[x]]),]) 98 | # head(new[as.character(old[[x]]) != as.character(new[[x]]),]) 99 | }) 100 | 101 | 102 | ## getSunlightPosition function ---- 103 | 104 | 105 | # one date 106 | new <- suncalc::getSunlightPosition(date = Sys.Date(), lat = 50.1, lon = 1.83) 107 | old <- suncalcjs::getSunlightPosition(date = Sys.Date(), lat = 50.1, lon = 1.83) 108 | stopifnot(all.equal(old, new)) 109 | 110 | # in character 111 | new <- suncalc::getSunlightPosition(date = c("2017-05-12", "2017-05-12 00:00:00"), 112 | lat = 50.1, lon = 1.83) 113 | old <- suncalcjs::getSunlightPosition(date = c("2017-05-12", "2017-05-12 00:00:00"), 114 | lat = 50.1, lon = 1.83) 115 | stopifnot(all.equal(old, new)) 116 | 117 | 118 | # in POSIXct 119 | new <- suncalc::getSunlightPosition(date = as.POSIXct("2017-05-12 00:00:00", tz = "UTC"), 120 | lat = 50.1, lon = 1.83) 121 | old <- suncalcjs::getSunlightPosition(date = as.POSIXct("2017-05-12 00:00:00", tz = "UTC"), 122 | lat = 50.1, lon = 1.83) 123 | stopifnot(all.equal(old, new)) 124 | 125 | new <- suncalc::getSunlightPosition(date = as.POSIXct("2017-05-12 02:00:00", tz = "CET"), 126 | lat = 50.1, lon = 1.83) 127 | old <- suncalcjs::getSunlightPosition(date = as.POSIXct("2017-05-12 02:00:00", tz = "CET"), 128 | lat = 50.1, lon = 1.83) 129 | stopifnot(all.equal(old, new)) 130 | 131 | # multiple date + subset 132 | new <- suncalc::getSunlightPosition(date = seq.Date(Sys.Date() - 9, Sys.Date(), by = 1), 133 | keep = c("altitude"), 134 | lat = 50.1, lon = 1.83) 135 | old <- suncalcjs::getSunlightPosition(date = seq.Date(Sys.Date() - 9, Sys.Date(), by = 1), 136 | keep = c("altitude"), 137 | lat = 50.1, lon = 1.83) 138 | stopifnot(all.equal(old, new)) 139 | 140 | # multiple coordinates 141 | data <- data.frame(date = seq.Date(Sys.Date() - 9, Sys.Date(), by = 1), 142 | lat = c(rep(50.1, 10), rep(49, 10)), 143 | lon = c(rep(1.83, 10), rep(2, 10))) 144 | new <- suncalc::getSunlightPosition(data = data, 145 | keep = c("altitude", "azimuth")) 146 | old <- suncalcjs::getSunlightPosition(data = data, 147 | keep = c("altitude", "azimuth")) 148 | stopifnot(all.equal(old, new)) 149 | 150 | # Perf 151 | data <- data.frame(date = rep(seq.Date(Sys.Date() - 4999, Sys.Date(), by = 1), 2), 152 | lat = c(rep(50.1, 5000), rep(49, 5000)), 153 | lon = c(rep(1.83, 5000), rep(2, 5000))) 154 | system.time(new <- suncalc::getSunlightPosition(data = data, 155 | keep = c("altitude", "azimuth"))) 156 | system.time(old <- suncalcjs::getSunlightPosition(data = data, 157 | keep = c("altitude", "azimuth"))) 158 | stopifnot(all.equal(old, new)) 159 | 160 | # grid lat lon 161 | grid <- expand.grid( 162 | date = seq.Date(Sys.Date() - 365, Sys.Date(), by = 10), 163 | lat = seq(-90, 90, by = 10), 164 | lon = seq(-180, 180, by = 10) 165 | ) 166 | 167 | system.time(new <- suncalc::getSunlightPosition(data = grid)) 168 | system.time(old <- suncalcjs::getSunlightPosition(data = grid)) 169 | stopifnot(all.equal(old, new)) 170 | 171 | 172 | ## getMoonTimes function ---- 173 | 174 | 175 | # one date 176 | new <- suncalc::getMoonTimes(date = Sys.Date() - 1, lat = 47.21, lon = -1.557, tz = "CET") 177 | old <- suncalcjs::getMoonTimes(date = Sys.Date() - 1, lat = 47.21, lon = -1.557, tz = "CET") 178 | stopifnot(all.equal(old[, -1], new[, -1])) 179 | 180 | # one date 181 | new <- suncalc::getMoonTimes(date = Sys.Date() - 1, lat = 47.21, lon = -1.557, tz = "UTC") 182 | old <- suncalcjs::getMoonTimes(date = Sys.Date() - 1, lat = 47.21, lon = -1.557, tz = "UTC") 183 | stopifnot(all.equal(old[, -1], new[, -1])) 184 | 185 | # multiple date + subset 186 | new <- suncalc::getMoonTimes(date = seq.Date(Sys.Date() - 9, Sys.Date(), by = 1), 187 | keep = c("rise", "set", "alwaysUp"), 188 | lat = 47.21, lon = -1.557, tz = "CET") 189 | old <- suncalcjs::getMoonTimes(date = seq.Date(Sys.Date() - 9, Sys.Date(), by = 1), 190 | keep = c("rise", "set", "alwaysUp"), 191 | lat = 47.21, lon = -1.557, tz = "CET") 192 | stopifnot(all.equal(old[, -1], new[, -1])) 193 | 194 | new <- suncalc::getMoonTimes(date = seq.Date(Sys.Date() - 9, Sys.Date() - 1, by = 1), 195 | keep = c("rise", "set", "alwaysUp"), 196 | lat = 47.21, lon = -1.557, tz = "UTC") 197 | old <- suncalcjs::getMoonTimes(date = seq.Date(Sys.Date() - 9, Sys.Date() - 1, by = 1), 198 | keep = c("rise", "set", "alwaysUp"), 199 | lat = 47.21, lon = -1.557, tz = "UTC") 200 | stopifnot(all.equal(old[, -1], new[, -1])) 201 | 202 | 203 | # multiple coordinates 204 | data <- data.frame(date = seq.Date(Sys.Date() - 10, Sys.Date() - 1, by = 1), 205 | lat = c(rep(50.1, 10), rep(49, 10)), 206 | lon = c(rep(1.83, 10), rep(2, 10))) 207 | 208 | new <- suncalc::getMoonTimes(data = data, tz = "CET") 209 | old <- suncalcjs::getMoonTimes(data = data, tz = "CET") 210 | stopifnot(all.equal(old[, -1], new[, -1])) 211 | 212 | # Q set as NA ? 213 | 214 | # Perf 215 | data <- data.frame(date = rep(Sys.Date() , 20000), 216 | lat = c(rep(50.1, 10000), rep(49, 10000)), 217 | lon = c(rep(1.83, 10000), rep(2, 10000))) 218 | 219 | system.time(new <- suncalc::getMoonTimes(data = data, tz = "UTC")) 220 | system.time(old <- suncalcjs::getMoonTimes(data = data, tz = "UTC")) 221 | stopifnot(all.equal(old[, -1], new[, -1])) 222 | 223 | 224 | # grid lat lon tz 225 | grid <- expand.grid( 226 | date = seq.Date(Sys.Date() - 365, Sys.Date(), by = 15), 227 | lat = seq(-90, 90, by = 10), 228 | lon = seq(-180, 180, by = 10) 229 | ) 230 | 231 | v_tz <- c("UTC", "CET", "Australia/Perth", "Africa/Johannesburg", "America/Bahia", "Asia/Bahrain", "Europe/Moscow") 232 | 233 | ctrl <- lapply(v_tz, function(tz){ 234 | print(tz) 235 | system.time(new <- suncalc::getMoonTimes(data = grid, tz = tz)) 236 | system.time(old <- suncalcjs::getMoonTimes(data = grid, tz = tz)) 237 | old$date <- as.Date(old$date) 238 | stopifnot(all.equal(old, new)) 239 | 240 | 241 | # x <- "rise" 242 | # x <- "set" 243 | # ind_diff <- which(as.character(old[[x]]) != as.character(new[[x]])) 244 | # 245 | # View(new[ind_diff, ]) 246 | # View(old[ind_diff, ]) 247 | # 248 | # View(new[new$date != as.Date(new$rise), ]) 249 | # View(old[old$date != as.Date(old$rise), ]) 250 | # head(old[as.character(old[[x]]) != as.character(new[[x]]),]) 251 | # head(new[as.character(old[[x]]) != as.character(new[[x]]),]) 252 | }) 253 | 254 | ## getMoonPosition function ---- 255 | 256 | # one date 257 | new <- suncalc::getMoonPosition(date = Sys.Date(), lat = 50.1, lon = 1.83) 258 | old <- suncalcjs::getMoonPosition(date = Sys.Date(), lat = 50.1, lon = 1.83) 259 | stopifnot(all.equal(old, new)) 260 | 261 | # in character 262 | new <- suncalc::getMoonPosition(date = c("2017-05-12", "2017-05-12 00:00:00"), 263 | lat = 50.1, lon = 1.83) 264 | old <- suncalcjs::getMoonPosition(date = c("2017-05-12", "2017-05-12 00:00:00"), 265 | lat = 50.1, lon = 1.83) 266 | stopifnot(all.equal(old, new)) 267 | 268 | 269 | # in POSIXct 270 | new <- suncalc::getMoonPosition(date = as.POSIXct("2017-05-12 00:00:00", tz = "UTC"), 271 | lat = 50.1, lon = 1.83) 272 | old <- suncalcjs::getMoonPosition(date = as.POSIXct("2017-05-12 00:00:00", tz = "UTC"), 273 | lat = 50.1, lon = 1.83) 274 | stopifnot(all.equal(old, new)) 275 | 276 | new <- suncalc::getMoonPosition(date = as.POSIXct("2017-05-12 02:00:00", tz = "CET"), 277 | lat = 50.1, lon = 1.83) 278 | old <- suncalcjs::getMoonPosition(date = as.POSIXct("2017-05-12 02:00:00", tz = "CET"), 279 | lat = 50.1, lon = 1.83) 280 | stopifnot(all.equal(old, new)) 281 | 282 | # multiple date + subset 283 | new <- suncalc::getMoonPosition(date = seq.Date(Sys.Date() - 9, Sys.Date(), by = 1), 284 | keep = c("altitude", "azimuth"), 285 | lat = 50.1, lon = 1.83) 286 | old <- suncalcjs::getMoonPosition(date = seq.Date(Sys.Date() - 9, Sys.Date(), by = 1), 287 | keep = c("altitude", "azimuth"), 288 | lat = 50.1, lon = 1.83) 289 | stopifnot(all.equal(old, new)) 290 | 291 | # multiple coordinates 292 | data <- data.frame(date = seq.Date(Sys.Date() - 9, Sys.Date(), by = 1), 293 | lat = c(rep(50.1, 10), rep(49, 10)), 294 | lon = c(rep(1.83, 10), rep(2, 10))) 295 | 296 | 297 | new <- suncalc::getMoonPosition(data = data, keep = c("altitude", "azimuth")) 298 | old <- suncalcjs::getMoonPosition(data = data, keep = c("altitude", "azimuth")) 299 | stopifnot(all.equal(old, new)) 300 | 301 | # Perf 302 | data <- data.frame(date = rep(Sys.Date(), 10000), 303 | lat = c(rep(50.1, 5000), rep(49, 5000)), 304 | lon = c(rep(1.83, 5000), rep(2, 5000))) 305 | 306 | system.time(new <- suncalc::getMoonPosition(data = data, keep = c("altitude", "azimuth"))) 307 | system.time(old <- suncalcjs::getMoonPosition(data = data, keep = c("altitude", "azimuth"))) 308 | stopifnot(all.equal(old, new)) 309 | 310 | 311 | grid <- expand.grid( 312 | date = seq.Date(Sys.Date() - 365, Sys.Date(), by = 10), 313 | lat = seq(-90, 90, by = 10), 314 | lon = seq(-180, 180, by = 10) 315 | ) 316 | 317 | system.time(new <- suncalc::getMoonPosition(data = grid)) 318 | system.time(old <- suncalcjs::getMoonPosition(data = grid)) 319 | stopifnot(all.equal(old, new)) 320 | 321 | 322 | ## getMoonIllumination function ---- 323 | 324 | # one date 325 | new <- suncalc::getMoonIllumination(date = Sys.Date()) 326 | old <- suncalcjs::getMoonIllumination(date = Sys.Date()) 327 | stopifnot(all.equal(old, new)) 328 | 329 | # in character 330 | new <- suncalc::getMoonIllumination(date = c("2017-05-12", "2017-05-12 00:00:00"), 331 | keep = c("fraction", "phase")) 332 | old <- suncalcjs::getMoonIllumination(date = c("2017-05-12", "2017-05-12 00:00:00"), 333 | keep = c("fraction", "phase")) 334 | stopifnot(all.equal(old, new)) 335 | 336 | # in POSIXct 337 | new <- suncalc::getMoonIllumination(date = as.POSIXct("2017-05-12 00:00:00", tz = "UTC")) 338 | old <- suncalcjs::getMoonIllumination(date = as.POSIXct("2017-05-12 00:00:00", tz = "UTC")) 339 | stopifnot(all.equal(old, new)) 340 | 341 | new <- suncalc::getMoonIllumination(date = as.POSIXct("2017-05-12 02:00:00", tz = "CET")) 342 | old <- suncalcjs::getMoonIllumination(date = as.POSIXct("2017-05-12 02:00:00", tz = "CET")) 343 | stopifnot(all.equal(old, new)) 344 | 345 | # Perf 346 | date <- seq(ISOdate(2009,1,1), ISOdate(2010,1,1), "hours") 347 | date_cet <- date 348 | attr(date_cet, "tzone") <- "CET" 349 | system.time(new <- suncalc::getMoonIllumination(date = date_cet)) 350 | system.time(old <- suncalcjs::getMoonIllumination(date = date_cet)) 351 | stopifnot(all.equal(old, new)) 352 | 353 | date_utc <- date 354 | attr(date_utc, "tzone") <- "UTC" 355 | 356 | system.time(new <- suncalc::getMoonIllumination(date = date_utc)) 357 | system.time(old <- suncalcjs::getMoonIllumination(date = date_utc)) 358 | stopifnot(all.equal(old, new)) 359 | -------------------------------------------------------------------------------- /man/getMoonIllumination.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getMoonIllumination.R 3 | \name{getMoonIllumination} 4 | \alias{getMoonIllumination} 5 | \title{Get Moon illumination} 6 | \usage{ 7 | getMoonIllumination(date = Sys.Date(), keep = c("fraction", "phase", "angle")) 8 | } 9 | \arguments{ 10 | \item{date}{: Single or multiple DateTime. Can be a \code{Date} (YYYY-MM-DD), 11 | a \code{character} in UTC (YYYY-MM-DD HH:mm:ss) or a \code{POSIXct}} 12 | 13 | \item{keep}{: \code{character}. Vector of variables to keep. See \code{Details}} 14 | } 15 | \value{ 16 | \code{data.frame} 17 | } 18 | \description{ 19 | Get Moon illumination 20 | } 21 | \details{ 22 | Returns an object with the following properties: 23 | 24 | \itemize{ 25 | \item{"fraction"}{ : illuminated fraction of the moon; varies from 0.0 (new moon) to 1.0 (full moon)} 26 | \item{"phase"}{ : moon phase; varies from 0.0 to 1.0, described below} 27 | \item{"angle"}{ : midpoint angle in radians of the illuminated limb of the moon reckoned eastward from 28 | the north point of the disk; the moon is waxing if the angle is negative, and waning if positive} 29 | } 30 | 31 | Moon phase value should be interpreted like this: 32 | \itemize{ 33 | \item{0}{ : New Moon} 34 | \item{}{Waxing Crescent} 35 | \item{0.25}{ : First Quarter} 36 | \item{}{ : Waxing Gibbous} 37 | \item{0.5}{Full Moon} 38 | \item{}{ : Waning Gibbous} 39 | \item{0.75}{Last Quarter} 40 | \item{}{ : Waning Crescent} 41 | } 42 | 43 | By subtracting the parallacticAngle from the angle one can get the zenith angle of the moons bright limb (anticlockwise). The zenith angle can be used do draw the moon shape from the observers perspective (e.g. moon lying on its back). 44 | } 45 | \examples{ 46 | 47 | # one date 48 | getMoonIllumination(date = Sys.Date()) 49 | 50 | # in character 51 | getMoonIllumination(date = c("2017-05-12", "2017-05-12 00:00:00"), 52 | keep = c("fraction", "phase")) 53 | 54 | # in POSIXct 55 | getMoonIllumination(date = as.POSIXct("2017-05-12 00:00:00", tz = "UTC")) 56 | getMoonIllumination(date = as.POSIXct("2017-05-12 02:00:00", tz = "CET")) 57 | 58 | date <- seq(ISOdate(2009,1,1), ISOdate(2010,1,1), "hours") 59 | date_cet <- date 60 | attr(date_cet, "tzone") <- "CET" 61 | res <- getMoonIllumination(date = date_cet) 62 | 63 | } 64 | \seealso{ 65 | \link{getSunlightTimes}, \link{getMoonTimes}, \link{getMoonIllumination}, 66 | \link{getMoonPosition},\link{getSunlightPosition} 67 | } 68 | -------------------------------------------------------------------------------- /man/getMoonPosition.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getMoonPosition.R 3 | \name{getMoonPosition} 4 | \alias{getMoonPosition} 5 | \title{Get Moon position} 6 | \usage{ 7 | getMoonPosition( 8 | date = NULL, 9 | lat = NULL, 10 | lon = NULL, 11 | data = NULL, 12 | keep = c("altitude", "azimuth", "distance", "parallacticAngle") 13 | ) 14 | } 15 | \arguments{ 16 | \item{date}{: Single or multiple DateTime. Can be a \code{Date} (YYYY-MM-DD), 17 | a \code{character} in UTC (YYYY-MM-DD HH:mm:ss) or a \code{POSIXct}} 18 | 19 | \item{lat}{: \code{numeric}. Single latitude} 20 | 21 | \item{lon}{: \code{numeric}. Single longitude} 22 | 23 | \item{data}{: \code{data.frame}. Alternative to use \code{date}, \code{lat}, \code{lon} for passing multiple coordinates} 24 | 25 | \item{keep}{: \code{character}. Vector of variables to keep. See \code{Details}} 26 | } 27 | \value{ 28 | \code{data.frame} 29 | } 30 | \description{ 31 | Get Moon position 32 | } 33 | \details{ 34 | Returns an object with the following properties: 35 | 36 | \itemize{ 37 | \item{"altitude"}{ : moon altitude above the horizon in radians} 38 | \item{"azimuth"}{ : moon azimuth in radians} 39 | \item{"distance"}{ : distance to moon in kilometers} 40 | \item{"parallacticAngle"}{ : parallactic angle of the moon in radians} 41 | } 42 | } 43 | \examples{ 44 | 45 | # one date 46 | getMoonPosition(date = Sys.Date(), lat = 50.1, lon = 1.83) 47 | 48 | # in character 49 | getMoonPosition(date = c("2017-05-12", "2017-05-12 00:00:00"), 50 | lat = 50.1, lon = 1.83) 51 | 52 | # in POSIXct 53 | getMoonPosition(date = as.POSIXct("2017-05-12 00:00:00", tz = "UTC"), 54 | lat = 50.1, lon = 1.83) 55 | getMoonPosition(date = as.POSIXct("2017-05-12 02:00:00", tz = "CET"), 56 | lat = 50.1, lon = 1.83) 57 | 58 | # multiple date + subset 59 | getMoonPosition(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 60 | keep = c("altitude", "azimuth"), 61 | lat = 50.1, lon = 1.83) 62 | 63 | # multiple coordinates 64 | data <- data.frame(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 65 | lat = c(rep(50.1, 10), rep(49, 10)), 66 | lon = c(rep(1.83, 10), rep(2, 10))) 67 | 68 | getMoonPosition(data = data, 69 | keep = c("altitude", "azimuth")) 70 | 71 | 72 | } 73 | \seealso{ 74 | \link{getSunlightTimes}, \link{getMoonTimes}, \link{getMoonIllumination}, 75 | \link{getMoonPosition},\link{getSunlightPosition} 76 | } 77 | -------------------------------------------------------------------------------- /man/getMoonTimes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getMoonTimes.R 3 | \name{getMoonTimes} 4 | \alias{getMoonTimes} 5 | \title{Get Moon times} 6 | \usage{ 7 | getMoonTimes( 8 | date = NULL, 9 | lat = NULL, 10 | lon = NULL, 11 | data = NULL, 12 | keep = c("rise", "set", "alwaysUp", "alwaysDown"), 13 | tz = "UTC", 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{date}{: \code{Date}. Single or multiple Date. YYYY-MM-DD} 19 | 20 | \item{lat}{: \code{numeric}. Single latitude} 21 | 22 | \item{lon}{: \code{numeric}. Single longitude} 23 | 24 | \item{data}{: \code{data.frame}. Alternative to use \code{date}, \code{lat}, \code{lon} for passing multiple coordinates} 25 | 26 | \item{keep}{: \code{character}. Vector of variables to keep. See \code{Details}} 27 | 28 | \item{tz}{: \code{character}. Timezone of results} 29 | 30 | \item{...}{:Not used. (Maintenance only)} 31 | } 32 | \value{ 33 | \code{data.frame} 34 | } 35 | \description{ 36 | Get Moon times 37 | } 38 | \details{ 39 | Available variables are : 40 | 41 | \itemize{ 42 | \item{"rise"}{ : \code{Date}. moonrise time} 43 | \item{"set"}{ : \code{Date}. moonset time} 44 | \item{"alwaysUp"}{ : \code{Logical}. TRUE if the moon never rises or sets and is always above the horizon during the day} 45 | \item{"alwaysDown"}{ : \code{Logical}. TRUE if the moon is always below the horizon} 46 | } 47 | } 48 | \examples{ 49 | 50 | # one date 51 | getMoonTimes(date = Sys.Date(), lat = 47.21, lon = -1.557, tz = "CET") 52 | 53 | # multiple date + subset 54 | getMoonTimes(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 55 | keep = c("rise", "set", "alwaysUp"), 56 | lat = 47.21, lon = -1.557, tz = "CET") 57 | 58 | # multiple coordinates 59 | data <- data.frame(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 60 | lat = c(rep(50.1, 10), rep(49, 10)), 61 | lon = c(rep(1.83, 10), rep(2, 10))) 62 | 63 | getMoonTimes(data = data, tz = "CET") 64 | 65 | } 66 | \seealso{ 67 | \link{getSunlightTimes}, \link{getMoonTimes}, \link{getMoonIllumination}, 68 | \link{getMoonPosition},\link{getSunlightPosition} 69 | } 70 | -------------------------------------------------------------------------------- /man/getSunlightPosition.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getSunlightPosition.R 3 | \name{getSunlightPosition} 4 | \alias{getSunlightPosition} 5 | \title{Get Sunlight position} 6 | \usage{ 7 | getSunlightPosition( 8 | date = NULL, 9 | lat = NULL, 10 | lon = NULL, 11 | data = NULL, 12 | keep = c("altitude", "azimuth") 13 | ) 14 | } 15 | \arguments{ 16 | \item{date}{: Single or multiple DateTime. Can be a \code{Date} (YYYY-MM-DD), 17 | a \code{character} in UTC (YYYY-MM-DD HH:mm:ss) or a \code{POSIXct}} 18 | 19 | \item{lat}{: \code{numeric}. Single latitude} 20 | 21 | \item{lon}{: \code{numeric}. Single longitude} 22 | 23 | \item{data}{: \code{data.frame}. Alternative to use \code{date}, \code{lat}, \code{lon} for passing multiple coordinates} 24 | 25 | \item{keep}{: \code{character}. Vector of variables to keep. See \code{Details}} 26 | } 27 | \value{ 28 | \code{data.frame} 29 | } 30 | \description{ 31 | Get Sunlight position 32 | } 33 | \details{ 34 | Returns an object with the following properties: 35 | 36 | \itemize{ 37 | \item{"altitude"}{ : sun altitude above the horizon in radians, e.g. 0 at the horizon and PI/2 at the zenith (straight over your head)} 38 | \item{"azimuth"}{ : sun azimuth in radians (direction along the horizon, measured from south to west), e.g. 0 is south and Math.PI * 3/4 is northwest} 39 | } 40 | } 41 | \examples{ 42 | 43 | # one date 44 | getSunlightPosition(date = Sys.Date(), lat = 50.1, lon = 1.83) 45 | 46 | # in character 47 | getSunlightPosition(date = c("2017-05-12", "2017-05-12 00:00:00"), 48 | lat = 50.1, lon = 1.83) 49 | 50 | # in POSIXct 51 | getSunlightPosition(date = as.POSIXct("2017-05-12 00:00:00", tz = "UTC"), 52 | lat = 50.1, lon = 1.83) 53 | getSunlightPosition(date = as.POSIXct("2017-05-12 02:00:00", tz = "CET"), 54 | lat = 50.1, lon = 1.83) 55 | 56 | # multiple date + subset 57 | getSunlightPosition(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 58 | keep = c("altitude"), 59 | lat = 50.1, lon = 1.83) 60 | 61 | # multiple coordinates 62 | data <- data.frame(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 63 | lat = c(rep(50.1, 10), rep(49, 10)), 64 | lon = c(rep(1.83, 10), rep(2, 10))) 65 | 66 | getSunlightPosition(data = data, 67 | keep = c("altitude", "azimuth")) 68 | 69 | 70 | } 71 | \seealso{ 72 | \link{getSunlightTimes}, \link{getMoonTimes}, \link{getMoonIllumination}, 73 | \link{getMoonPosition},\link{getSunlightPosition} 74 | } 75 | -------------------------------------------------------------------------------- /man/getSunlightTimes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getSunlightTimes.R 3 | \name{getSunlightTimes} 4 | \alias{getSunlightTimes} 5 | \title{Get Sunlight times} 6 | \usage{ 7 | getSunlightTimes( 8 | date = NULL, 9 | lat = NULL, 10 | lon = NULL, 11 | data = NULL, 12 | keep = c("solarNoon", "nadir", "sunrise", "sunset", "sunriseEnd", "sunsetStart", 13 | "dawn", "dusk", "nauticalDawn", "nauticalDusk", "nightEnd", "night", "goldenHourEnd", 14 | "goldenHour"), 15 | tz = "UTC" 16 | ) 17 | } 18 | \arguments{ 19 | \item{date}{: \code{Date}. Single or multiple Date. YYYY-MM-DD} 20 | 21 | \item{lat}{: \code{numeric}. Single latitude} 22 | 23 | \item{lon}{: \code{numeric}. Single longitude} 24 | 25 | \item{data}{: \code{data.frame}. Alternative to use \code{date}, \code{lat}, \code{lon} for passing multiple coordinates} 26 | 27 | \item{keep}{: \code{character}. Vector of variables to keep. See \code{Details}} 28 | 29 | \item{tz}{: \code{character}. Timezone of results} 30 | } 31 | \value{ 32 | \code{data.frame} 33 | } 34 | \description{ 35 | Get Sunlight times 36 | } 37 | \details{ 38 | Available variables are : 39 | 40 | \itemize{ 41 | \item{"sunrise"}{ : sunrise (top edge of the sun appears on the horizon)} 42 | \item{"sunriseEnd"}{ : sunrise ends (bottom edge of the sun touches the horizon)} 43 | \item{"goldenHourEnd"}{ : morning golden hour (soft light, best time for photography) ends} 44 | \item{"solarNoon"}{ : solar noon (sun is in the highest position)} 45 | \item{"goldenHour"}{ : evening golden hour starts} 46 | \item{"sunsetStart"}{ : sunset starts (bottom edge of the sun touches the horizon)} 47 | \item{"sunset"}{ : sunset (sun disappears below the horizon, evening civil twilight starts)} 48 | \item{"dusk"}{ : dusk (evening nautical twilight starts)} 49 | \item{"nauticalDusk"}{ : nautical dusk (evening astronomical twilight starts)} 50 | \item{"night"}{ : night starts (dark enough for astronomical observations)} 51 | \item{"nadir"}{ : nadir (darkest moment of the night, sun is in the lowest position)} 52 | \item{"nightEnd"}{ : night ends (morning astronomical twilight starts)} 53 | \item{"nauticalDawn"}{ : nautical dawn (morning nautical twilight starts)} 54 | \item{"dawn"}{ : dawn (morning nautical twilight ends, morning civil twilight starts)} 55 | } 56 | } 57 | \examples{ 58 | 59 | # one date 60 | getSunlightTimes(date = Sys.Date(), lat = 50.1, lon = 1.83, tz = "CET") 61 | 62 | # multiple date + subset 63 | getSunlightTimes(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 64 | keep = c("sunrise", "sunriseEnd", "sunset", "sunsetStart"), 65 | lat = 50.1, lon = 1.83, tz = "CET") 66 | 67 | # multiple coordinates 68 | data <- data.frame(date = seq.Date(Sys.Date()-9, Sys.Date(), by = 1), 69 | lat = c(rep(50.1, 10), rep(49, 10)), 70 | lon = c(rep(1.83, 10), rep(2, 10))) 71 | 72 | getSunlightTimes(data = data, 73 | keep = c("sunrise", "sunriseEnd", "sunset", "sunsetStart"), tz = "CET") 74 | 75 | } 76 | \seealso{ 77 | \link{getSunlightTimes}, \link{getMoonTimes}, \link{getMoonIllumination}, 78 | \link{getMoonPosition},\link{getSunlightPosition} 79 | } 80 | --------------------------------------------------------------------------------