1#' @include timespans.r 2#' @include durations.r 3#' @include intervals.r 4#' @include periods.r 5#' @include Dates.r 6#' @include difftimes.r 7#' @include numeric.r 8#' @include POSIXt.r 9#' @include time-zones.r 10NULL 11 12 13#' Convert a variety of date-time classes to POSIXlt and POSIXct 14#' @name DateCoercion 15#' @keywords internal 16#' 17NULL 18 19#' @export 20as.POSIXct.fts <- function(x, tz = "", ...) as.POSIXct(zoo::index(x)) 21#' @export 22as.POSIXlt.fts <- function(x, tz = "", ...) as.POSIXlt(zoo::index(x)) 23 24## #' @export 25## as.POSIXlt.its <- function(x, tz = "", ...) as.POSIXlt(attr(x, "dates")) 26## #' @export 27## as.POSIXct.its <- function(x, tz = "", ...) as.POSIXct(attr(x, "dates")) 28 29#' @export 30as.POSIXlt.timeSeries <- function(x, tz = "", ...) { 31 as.POSIXlt(timeDate::timeDate(x@positions, 32 zone = x@FinCenter, FinCenter = x@FinCenter)) 33} 34#' @export 35as.POSIXct.timeSeries <- function(x, tz = "", ...) { 36 as.POSIXct(timeDate::timeDate(x@positions, 37 zone = x@FinCenter, FinCenter = x@FinCenter)) 38} 39 40#' @export 41as.POSIXlt.irts <- function(x, tz = "", ...) as.POSIXlt(x$time) 42#' @export 43as.POSIXct.irts <- function(x, tz = "", ...) as.POSIXct(x$time) 44 45#' @export 46as.POSIXlt.xts <- function(x, tz = "", ...) as.POSIXlt(zoo::index(x)) 47#' @export 48as.POSIXct.xts <- function(x, tz = "", ...) as.POSIXct(zoo::index(x)) 49#' @export 50as.POSIXlt.zoo <- function(x, tz = "", ...) as.POSIXlt(zoo::index(x)) 51#' @export 52as.POSIXct.zoo <- function(x, tz = "", ...) as.POSIXct(zoo::index(x)) 53 54#' @export 55as.POSIXlt.tis <- function(x, tz = "", ...) as.Date(x) 56 57#' Convenience method to reclass dates post-modification. 58#' @keywords internal 59#' 60#' @export 61reclass_date <- function(new, orig) UseMethod("reclass_date", orig) 62#' @export 63reclass_date.POSIXlt <- function(new, orig) { 64 as.POSIXlt(new) 65} 66#' @export 67reclass_date.POSIXct <- function(new, orig) { 68 as.POSIXct(new) 69} 70#' @export 71reclass_date.chron <- function(new, orig) { 72 chron::as.chron(new) 73} 74#' @export 75reclass_date.timeDate <- function(new, orig) { 76 timeDate::as.timeDate(new) 77} 78## #' @export 79## reclass_date.its <- function(new, orig) { 80## its::its(new, format = "%Y-%m-%d %X") 81## } 82#' @export 83reclass_date.ti <- function(new, orig) { 84 tis::as.ti(new, tis::tifName(orig)) 85} 86#' @export 87reclass_date.Date <- function(new, orig) { 88 as_date(new) 89} 90 91 92period_to_difftime <- function(per) { 93 as.difftime(per) 94} 95 96#' Convenience method to reclass timespans post-modification. 97#' @keywords internal 98#' 99#' @aliases reclass_timespan,ANY,Duration-method reclass_timespan,ANY,Interval-method 100#' reclass_timespan,ANY,Period-method reclass_timespan,ANY,difftime-method 101#' @export 102reclass_timespan <- function(new, orig) standardGeneric("reclass_timespan") 103 104#' @export 105setGeneric("reclass_timespan") 106 107#' @export 108setMethod("reclass_timespan", signature(orig = "difftime"), function(new, orig) { 109 if (is.period(new)) 110 as.difftime(new) 111 else 112 make_difftime(as.numeric(new)) 113}) 114 115#' @export 116setMethod("reclass_timespan", signature(orig = "Duration"), function(new, orig) { 117 as.duration(new) 118}) 119 120#' @export 121setMethod("reclass_timespan", signature(orig = "Interval"), function(new, orig) { 122 as.duration(new) 123}) 124 125#' @export 126setMethod("reclass_timespan", signature(orig = "Period"), function(new, orig) { 127 as.period(new) 128}) 129 130 131#' Change an object to a duration 132#' 133#' as.duration changes Interval, Period and numeric class objects to 134#' Duration objects. Numeric objects are changed to Duration objects 135#' with the seconds unit equal to the numeric value. 136#' 137#' Durations are exact time measurements, whereas periods are relative time 138#' measurements. See [Period-class]. The length of a period depends 139#' on when it occurs. Hence, a one to one mapping does not exist between 140#' durations and periods. When used with a period object, as.duration provides 141#' an inexact estimate of the length of the period; each time unit is assigned 142#' its most common number of seconds. A period of one month is converted to 143#' 2628000 seconds (approximately 30.42 days). This ensures that 12 months will 144#' sum to 365 days, or one normal year. For an exact transformation, first 145#' transform the period to an interval with [as.interval()]. 146#' 147#' @param x Object to be coerced to a duration 148#' @param ... Parameters passed to other methods. Currently unused. 149#' @return A duration object 150#' @seealso [Duration-class], [duration()] 151#' @keywords classes manip methods chron 152#' @examples 153#' span <- interval(ymd("2009-01-01"), ymd("2009-08-01")) #interval 154#' as.duration(span) 155#' as.duration(10) # numeric 156#' dur <- duration(hours = 10, minutes = 6) 157#' as.numeric(dur, "hours") 158#' as.numeric(dur, "minutes") 159#' 160#' @aliases as.duration,numeric-method as.duration,logical-method 161#' as.duration,difftime-method as.duration,Interval-method 162#' as.duration,Duration-method as.duration,Period-method 163#' as.duration,character-method 164#' @export 165setGeneric("as.duration", 166 function(x, ...) standardGeneric("as.duration"), 167 useAsDefault = function(x, ...) { 168 stop(sprintf("as.duration is not defined for class '%s'", class(x))) 169 }) 170 171setMethod("as.duration", signature(x = "character"), function(x) { 172 as.duration(as.period(x)) 173}) 174 175setMethod("as.duration", signature(x = "numeric"), function(x) { 176 new("Duration", x) 177}) 178 179setMethod("as.duration", signature(x = "logical"), function(x) { 180 new("Duration", as.numeric(x)) 181}) 182 183as_duration_from_difftime <- function(x) { 184 new("Duration", as.numeric(x, "secs")) 185} 186setMethod("as.duration", signature(x = "difftime"), as_duration_from_difftime) 187 188setMethod("as.duration", signature(x = "Interval"), function(x) { 189 new("Duration", x@.Data) 190}) 191 192setMethod("as.duration", signature(x = "Duration"), function(x) { 193 x 194}) 195 196setMethod("as.duration", signature(x = "Period"), function(x) { 197 new("Duration", period_to_seconds(x)) 198}) 199 200 201#' Change an object to an `interval` 202#' 203#' as.interval changes difftime, Duration, Period and numeric class objects to 204#' intervals that begin at the specified date-time. Numeric objects are first 205#' coerced to timespans equal to the numeric value in seconds. 206#' 207#' as.interval can be used to create accurate transformations between Period 208#' objects, which measure time spans in variable length units, and Duration objects, 209#' which measure timespans as an exact number of seconds. A start date- 210#' time must be supplied to make the conversion. Lubridate uses 211#' this start date to look up how many seconds each variable 212#' length unit (e.g. month, year) lasted for during the time span 213#' described. See 214#' [as.duration()], [as.period()]. 215#' 216#' @param x a duration, difftime, period, or numeric object that describes the length of the interval 217#' @param start a POSIXt or Date object that describes when the interval begins 218#' @param ... additional arguments to pass to as.interval 219#' @return an interval object 220#' @seealso [interval()] 221#' @keywords classes manip methods chron 222#' @examples 223#' diff <- make_difftime(days = 31) #difftime 224#' as.interval(diff, ymd("2009-01-01")) 225#' as.interval(diff, ymd("2009-02-01")) 226#' 227#' dur <- duration(days = 31) #duration 228#' as.interval(dur, ymd("2009-01-01")) 229#' as.interval(dur, ymd("2009-02-01")) 230#' 231#' per <- period(months = 1) #period 232#' as.interval(per, ymd("2009-01-01")) 233#' as.interval(per, ymd("2009-02-01")) 234#' 235#' as.interval(3600, ymd("2009-01-01")) #numeric 236#' @aliases as.interval,numeric-method as.interval,difftime-method as.interval,Interval-method as.interval,Duration-method as.interval,Period-method as.interval,POSIXt-method as.interval,logical-method 237#' @export 238as.interval <- function(x, start, ...) standardGeneric("as.interval") 239 240#' @export 241setGeneric("as.interval") 242 243setMethod("as.interval", signature(x = "numeric"), function(x, start, ...) { 244 .number_to_interval(x, start, ...) 245}) 246 247setMethod("as.interval", signature(x = "difftime"), function(x, start, ...) { 248 .number_to_interval(x, start, ...) 249}) 250 251setMethod("as.interval", signature(x = "Interval"), function(x, start, ...) { 252 x 253}) 254 255setMethod("as.interval", signature(x = "POSIXt"), function(x, start, ...) { 256 .number_to_interval(x, start, ...) 257}) 258 259#' @export 260setMethod("as.interval", signature("logical"), function(x, start, ...) { 261 .number_to_interval(as.numeric(x), start, ...) 262}) 263 264.number_to_interval <- function(x, start, ...) { 265 if (missing(start) & all(is.na(x))) 266 start <- .POSIXct(NA_real_, tz = "UTC") 267 else stopifnot(is.instant(start)) 268 269 if (is.instant(x)) 270 return(interval(x, start)) 271 else 272 interval(start, start + x) 273} 274 275 276#' Change an object to a period 277#' 278#' as.period changes Interval, Duration, difftime and numeric class objects 279#' to Period class objects with the specified units. 280#' 281#' Users must specify which time units to measure the period in. The exact length of 282#' each time unit in a period will depend on when it occurs. See 283#' [Period-class] and [period()]. 284#' The choice of units is not trivial; units that are 285#' normally equal may differ in length depending on when the time period 286#' occurs. For example, when a leap second occurs one minute is longer than 60 287#' seconds. 288#' 289#' Because periods do not have a fixed length, they can not be accurately 290#' converted to and from Duration objects. Duration objects measure time spans 291#' in exact numbers of seconds, see [Duration-class]. Hence, a one to one 292#' mapping does not exist between durations and periods. When used with a 293#' Duration object, as.period provides an inexact estimate; the duration is 294#' broken into time units based on the most common lengths of time units, in 295#' seconds. Because the length of months are particularly variable, a period 296#' with a months unit can not be coerced from a duration object. For an exact 297#' transformation, first transform the duration to an interval with 298#' [as.interval()]. 299#' 300#' Coercing an interval to a period may cause surprising behavior if you request 301#' periods with small units. A leap year is 366 days long, but one year long. Such 302#' an interval will convert to 366 days when unit is set to days and 1 year when 303#' unit is set to years. Adding 366 days to a date will often give a different 304#' result than adding one year. Daylight savings is the one exception where this 305#' does not apply. Interval lengths are calculated on the UTC timeline, which does 306#' not use daylight savings. Hence, periods converted with seconds or minutes will not 307#' reflect the actual variation in seconds and minutes that occurs due to daylight 308#' savings. These periods will show the "naive" change in seconds and minutes that is 309#' suggested by the differences in clock time. See the examples below. 310#' 311#' @param x an interval, difftime, or numeric object 312#' @param unit A character string that specifies which time units to build period in. 313#' unit is only implemented for the as.period.numeric method and the as.period.interval method. 314#' For as.period.interval, as.period will convert intervals to units no larger than the specified 315#' unit. 316#' @param ... additional arguments to pass to as.period 317#' @return a period object 318#' @seealso [Period-class], [period()] 319#' @keywords classes manip methods chron 320#' @examples 321#' span <- interval(ymd_hms("2009-01-01 00:00:00"), ymd_hms("2010-02-02 01:01:01")) #interval 322#' as.period(span) 323#' as.period(span, unit = "day") 324#' "397d 1H 1M 1S" 325#' leap <- interval(ymd("2016-01-01"), ymd("2017-01-01")) 326#' as.period(leap, unit = "days") 327#' as.period(leap, unit = "years") 328#' dst <- interval(ymd("2016-11-06", tz = "America/Chicago"), 329#' ymd("2016-11-07", tz = "America/Chicago")) 330#' # as.period(dst, unit = "seconds") 331#' as.period(dst, unit = "hours") 332#' per <- period(hours = 10, minutes = 6) 333#' as.numeric(per, "hours") 334#' as.numeric(per, "minutes") 335#' 336#' @aliases as.period,numeric-method as.period,difftime-method 337#' as.period,Interval-method as.period,Duration-method as.period,Period-method 338#' as.period,logical-method as.period,character-method 339#' @export 340setGeneric("as.period", 341 function(x, unit, ...) standardGeneric("as.period"), 342 useAsDefault = function(x, unit, ...) { 343 stop(sprintf("as.period is not defined for class '%s'", class(x))) 344 }) 345 346setMethod("as.period", signature(x = "character"), function(x, ...) { 347 parse_period(x) 348}) 349 350setMethod("as.period", signature(x = "numeric"), function(x, unit = "second", ...) { 351 x <- as.numeric(x) 352 if (missing(unit)) unit <- "second" 353 unit <- standardise_date_names(unit[[1]]) 354 f <- get(paste(unit, "s", sep = ""), 355 envir = asNamespace("lubridate"), 356 mode = "function", inherits = FALSE) 357 f(x) 358}) 359 360setMethod("as.period", signature(x = "difftime"), function(x, unit = NULL, ...) { 361 seconds_to_period(as.double(x, "secs")) 362}) 363 364setMethod("as.period", signature(x = "Interval"), function(x, unit = NULL, ...) { 365 ## fixme: document this in the manual 366 367 ## SEMANTICS: for postitive intervals all units of the period will be 368 ## positive, and the oposite for negatve intervals. 369 370 ## Periods are not symetric in the sense that as.period(int) might not be the 371 ## same as -as.period(int_flip(int)). See 372 ## https://github.com/tidyverse/lubridate/issues/285 for motivation. 373 374 unit <- 375 if (missing(unit)) "year" 376 else standardise_period_names(unit) 377 378 switch(unit, 379 year = .int_to_period(x), 380 month = { 381 pers <- .int_to_period(x) 382 month(pers) <- month(pers) + year(pers)*12 383 year(pers) <- 0 384 pers 385 }, 386 ## fixme: add note to the docs that unit <= days results in much faster conversion 387 ## fixme: add week 388 day = , hour = , minute = , second = { 389 secs <- x@.Data 390 negs <- secs < 0 & !is.na(secs) 391 units <- .units_within_seconds(abs(secs), unit) 392 pers <- do.call("new", c("Period", units)) 393 pers[negs] <- -pers[negs] 394 pers 395 }, 396 stop("Unsuported unit ", unit)) 397}) 398 399.int_to_period <- function(x) { 400 ## this function is called only for conversion with units > day 401 start <- as.POSIXlt(x@start) 402 end <- unclass(as.POSIXlt(start + x@.Data)) 403 start <- unclass(start) 404 405 negs <- x@.Data < 0 & !is.na(x@.Data) 406 407 per <- list() 408 409 for (nm in c("sec", "min", "hour", "mday", "mon", "year")) { 410 per[[nm]] <- ifelse(negs, start[[nm]] - end[[nm]], end[[nm]] - start[[nm]]) 411 } 412 413 names(per) <- c("second", "minute", "hour", "day", "month", "year") 414 415 ## Remove negative ... 416 417 ## seconds 418 nsecs <- per$second < 0 & !is.na(per$second) 419 per$second[nsecs] <- 60 + per$second[nsecs] 420 per$minute[nsecs] <- per$minute[nsecs] - 1 421 per$second[negs] <- -per$second[negs] 422 423 ## minutes 424 nmins <- per$minute < 0 & !is.na(per$minute) 425 per$minute[nmins] <- 60 + per$minute[nmins] 426 per$hour[nmins] <- per$hour[nmins] - 1 427 per$minute[negs] <- -per$minute[negs] 428 429 ## hours 430 nhous <- per$hour < 0 & !is.na(per$hour) 431 per$hour[nhous] <- 24 + per$hour[nhous] 432 per$hour[negs] <- -per$hour[negs] 433 434 ## days 435 436 ### postivie periods 437 ndays <- !negs & per$day < 0 & !is.na(per$day) 438 if (any(ndays)) { 439 440 ## compute nr days in previous month 441 add_months <- rep.int(-1, sum(ndays)) 442 443 pmonth <- end$mon[ndays] 444 pmonth[pmonth == 0] <- 1 # dec == jan == 31 days 445 prev_month_days <- .days_in_month(pmonth, end$year[ndays]) 446 447 ## difference in days: 448 ## /need pmax to capture as.period(interval(ymd("1985-01-31"), ymd("1986-03-28")))/ 449 per$day[ndays] <- pmax(prev_month_days - start$mday[ndays], 0) + end$mday[ndays] 450 per$month[ndays] <- per$month[ndays] + add_months 451 } 452 453 ## negative periods 454 ndays <- negs & per$day < 0 & !is.na(per$day) 455 if (any(ndays)) { 456 457 add_months <- rep.int(1, sum(ndays)) 458 this_month_days <- .days_in_month(end$mon[ndays] + 1, end$year[ndays]) 459 460 ## Compute nr of days: 461 ## /need pmax to capture as.period(interval(ymd("1985-01-31"), ymd("1986-03-28")))/ 462 per$day[ndays] <- pmax(this_month_days - end$mday[ndays], 0) + start$mday[ndays] 463 per$month[ndays] <- per$month[ndays] - add_months 464 } 465 466 ## substract only after the day computation to capture intervals like: 467 ## as.period(interval(ymd_hms("1985-12-31 5:0:0"), ymd_hms("1986-02-01 3:0:0"))) 468 per$day[nhous] <- per$day[nhous] - 1 469 per$day[negs] <- -per$day[negs] 470 471 ## months 472 nmons <- per$month < 0 & !is.na(per$month) 473 per$month[nmons] <- 12 + per$month[nmons] 474 per$year[nmons] <- per$year[nmons] - 1 475 per$month[negs] <- -per$month[negs] 476 477 per$year[negs] <- -per$year[negs] 478 479 new("Period", per$second, year = per$year, month = per$month, 480 day = per$day, hour = per$hour, minute = per$minute) 481} 482 483setMethod("as.period", signature(x = "Duration"), function(x, unit = NULL, ...) { 484 span <- x@.Data 485 remainder <- abs(span) 486 newper <- period(second = rep(0, length(x))) 487 488 slot(newper, "year") <- remainder %/% average_durations[["year"]] 489 remainder <- remainder %% average_durations[["year"]] 490 491 slot(newper, "day") <- remainder %/% (3600 * 24) 492 remainder <- remainder %% (3600 * 24) 493 494 slot(newper, "hour") <- remainder %/% (3600) 495 remainder <- remainder %% (3600) 496 497 slot(newper, "minute") <- remainder %/% (60) 498 newper$second <- remainder %% (60) 499 500 newper * sign(span) 501}) 502 503setMethod("as.period", signature("Period"), 504 function(x, unit = NULL, ...) { 505 if (missing(unit) || is.null(unit)) { 506 x 507 } else { 508 unit <- standardise_period_names(unit) 509 switch(unit, 510 year = x, 511 month = { 512 month(x) <- month(x) + year(x)*12 513 year(x) <- 0 514 x 515 }, 516 day = , hour = , minute = , second = { 517 N <- .units_within_seconds(period_to_seconds(x), unit) 518 do.call("new", c("Period", N)) 519 }, 520 stop("Unsuported unit ", unit)) 521 } 522 }) 523 524setMethod("as.period", signature("logical"), function(x, unit = NULL, ...) { 525 as.period(as.numeric(x), unit, ...) 526}) 527 528setGeneric("as.difftime") 529 530#' @export 531setMethod("as.difftime", signature(tim = "Interval"), function(tim, format = "%X", units = "secs") { 532 as.difftime(as.numeric(tim, units), format, units) 533}) 534 535as_difftime_from_duration <- function(tim, format = "%X", units = "secs") { 536 as.difftime(tim@.Data, format, units) 537} 538#' @export 539setMethod("as.difftime", signature(tim = "Duration"), as_difftime_from_duration) 540 541#' @export 542setMethod("as.difftime", signature(tim = "Period"), function(tim, format = "%X", units = "secs") { 543 as.difftime(period_to_seconds(tim), format, units) 544}) 545 546setGeneric("as.numeric") 547 548seconds_to_unit <- function(secs, unit = "second") { 549 switch(unit, 550 second = secs, 551 minute = secs / 60, 552 hour = secs / 3600, 553 day = secs / 86400, 554 month = secs / (86400 * 365.25 / 12), 555 week = secs / (86400 * 7), 556 year = secs / (86400 * 365.25), 557 stop("invalid unit ", unit)) 558} 559 560#' @export 561setMethod("as.numeric", signature("Duration"), function(x, units = "secs", ...) { 562 unit <- standardise_period_names(units) 563 as.numeric(seconds_to_unit(x@.Data, unit), ...) 564}) 565 566#' @export 567setMethod("as.numeric", signature(x = "Interval"), function(x, units = "secs", ...) { 568 as.numeric(as.duration(x), units, ...) 569}) 570 571#' @export 572setMethod("as.numeric", signature(x = "Period"), function(x, units = "second", ...) { 573 unit <- standardise_period_names(units) 574 as.numeric(seconds_to_unit(period_to_seconds(x), unit = unit), ...) 575}) 576 577as.POSIXt <- function(x) as.POSIXlt(x) 578 579#' @export 580setMethod("as.character", signature(x = "Period"), function(x, ...) { 581 format(x) 582}) 583 584#' @export 585setMethod("as.character", signature(x = "Duration"), function(x, ...) { 586 format(x) 587}) 588 589#' @export 590setMethod("as.character", signature(x = "Interval"), function(x, ...) { 591 format(x) 592}) 593 594 595#' Convert an object to a date or date-time 596#' 597#' 598#' @section Compare to base R: 599#' 600#' These are drop in replacements for [as.Date()] and [as.POSIXct()], with a few 601#' tweaks to make them work more intuitively. 602#' 603#' \itemize{ 604#' 605#' \item Called on a `POSIXct` object, `as_date()` uses the tzone attribute of 606#' the object to return the same date as indicated by the printed representation 607#' of the object. This differs from as.Date, which ignores the attribute and 608#' uses only the tz argument to `as.Date()` ("UTC" by default). 609#' 610#' \item Both functions provide a default origin argument for numeric vectors. 611#' 612#' \item Both functions will generate NAs for 613#' invalid date format. A warning message will provide a count of the elements 614#' that were not converted 615#' 616#' \item `as_datetime()` defaults to using UTC. 617#' 618#' } 619#' 620#' @param x a vector of [POSIXt], numeric or character objects 621#' @param origin a Date object, or something which can be coerced by 622#' `as.Date(origin, ...)` to such an object (default: the Unix epoch of 623#' "1970-01-01"). Note that in this instance, `x` is assumed to reflect the 624#' number of days since `origin` at `"UTC"`. 625#' @param tz a time zone name (default: time zone of the POSIXt object `x`). See 626#' [OlsonNames()]. 627#' @param format format argument for character methods. When supplied parsing is 628#' performed by [strptime()]. For this reason consider using specialized 629#' parsing functions in lubridate. 630#' @param ... further arguments to be passed to specific methods (see above). 631#' @return a vector of [Date] objects corresponding to `x`. 632#' @examples 633#' dt_utc <- ymd_hms("2010-08-03 00:50:50") 634#' dt_europe <- ymd_hms("2010-08-03 00:50:50", tz="Europe/London") 635#' c(as_date(dt_utc), as.Date(dt_utc)) 636#' c(as_date(dt_europe), as.Date(dt_europe)) 637#' ## need not supply origin 638#' as_date(10) 639#' ## Will replace invalid date format with NA 640#' dt_wrong <- c("2009-09-29", "2012-11-29", "2015-29-12") 641#' as_date(dt_wrong) 642#' @export 643setGeneric(name = "as_date", 644 def = function(x, ...) standardGeneric("as_date")) 645 646#' @rdname as_date 647#' @export 648setMethod("as_date", "ANY", 649 function(x, ...) { 650 ## From: Kurt Hornik <Kurt.Hornik@wu.ac.at> 651 ## Date: Tue, 3 Apr 2018 18:53:19 652 ## 653 ## `zoo` has its own as.Date for which it registers its yearmon 654 ## method (and base::as.Date as the default S3 method). In fact, 655 ## zoo also exports as.Date.yearmon etc, but the above 656 ## 657 ## lubridate::as_date(zoo::as.yearmon("2011-01-07")) 658 ## 659 ## does not attach the zoo exports, hence does not find 660 ## as.Date.yearmon on the search path. 661 if (inherits(x, c("yearmon", "yearqtr"))) 662 zoo::as.Date(x, ...) 663 else 664 base::as.Date(x, ...) 665 }) 666 667#' @rdname as_date 668#' @export 669setMethod(f = "as_date", signature = "POSIXt", 670 function(x, tz = NULL) { 671 tz <- if (is.null(tz)) tz(x) else tz 672 as.Date(x, tz = tz) 673 }) 674 675#' @rdname as_date 676setMethod(f = "as_date", signature = "numeric", 677 function(x, origin = lubridate::origin) { 678 as.Date(x, origin = origin) 679 }) 680 681 682#' @rdname as_date 683#' @export 684setMethod("as_date", "character", 685 function(x, tz = NULL, format = NULL) { 686 if (!is.null(tz)) { 687 warning("`tz` argument is ignored by `as_date()`", call. = FALSE) 688 } 689 690 if (is.null(format)) 691 as_date(.parse_iso_dt(x, tz = "UTC")) 692 else 693 as_date(strptime(x, format, tz = "UTC")) 694 }) 695 696#' @rdname as_date 697#' @export 698setGeneric("as_datetime", 699 function(x, ...) { 700 standardGeneric("as_datetime") 701 }) 702 703#' @rdname as_date 704#' @export 705setMethod("as_datetime", "POSIXt", 706 function(x, tz = "UTC") { 707 with_tz(x, tz) 708 }) 709 710#' @rdname as_date 711#' @export 712setMethod("as_datetime", "numeric", 713 function(x, origin = lubridate::origin, tz = "UTC") { 714 as.POSIXct(x, origin = origin, tz = tz) 715 }) 716 717 718#' @rdname as_date 719#' @export 720setMethod("as_datetime", "character", 721 function(x, tz = "UTC", format = NULL) { 722 if (is.null(format)) 723 .parse_iso_dt(x, tz) 724 else 725 as.POSIXct(strptime(x, format = format, tz = tz)) 726 }) 727 728 729#' @rdname as_date 730#' @export 731setMethod("as_datetime", "Date", 732 function(x, tz = "UTC") { 733 dt <- .POSIXct(as.numeric(x) * 86400, tz = "UTC") 734 if (is_utc(tz)) 735 return(dt) 736 else 737 force_tz(dt, tzone = tz) 738 }) 739 740 741#' @rdname as_date 742#' @export 743setMethod("as_datetime", "ANY", 744 function(x, tz = "UTC") { 745 with_tz(as.POSIXct(x, tz = tz), tzone = tz) 746 }) 747