lubridate/0000755000175100001440000000000012765757370012266 5ustar hornikuserslubridate/po/0000755000175100001440000000000012747740626012700 5ustar hornikuserslubridate/po/R-lubridate.pot0000644000175100001440000001021312747740626015573 0ustar hornikusersmsgid "" msgstr "" "Project-Id-Version: R 2.15.1\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2013-03-29 14:39\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" msgid "estimate only: convert periods to intervals for accuracy" msgstr "" msgid "estimate only: convert difftimes to intervals for accuracy" msgstr "" msgid "estimate only: convert durations to intervals for accuracy" msgstr "" msgid "cannot map durations to months" msgstr "" msgid "coercing interval to duration" msgstr "" msgid "date(s) not in POSIXt or Date format" msgstr "" msgid "Unknown formats supplied:" msgstr "" msgid "," msgstr "" msgid "by is not a recognized timespan object" msgstr "" msgid "an interval cannot be shifted by another interval. \n\t\tConvert second interval to a period or duration." msgstr "" msgid "Union includes intervening time between intervals." msgstr "" msgid "Cases" msgstr "" msgid "result in discontinuous intervals." msgstr "" msgid "Argument 1 is not a recognized date-time" msgstr "" msgid "unrecognized date format" msgstr "" msgid "+ undefined for Interval class:\n manipulate with int_start(), int_end() and int_shift()\n or change class with as.duration()" msgstr "" msgid "Incompatible timespan classes:\n change class with as.duration() or as.period()" msgstr "" msgid "+ undefined for Interval class:\nConsider intersect(), union(), or setdiff()\nor change class with as.period() or as.duration()" msgstr "" msgid "+ undefined for Interval class:\n manipulate with int_start(), int_end() and int_shift()\n or change class with as.period()" msgstr "" msgid "+ undefined for Interval class:\n manipulate with int_start(), int_end() and int_shift()\n or change class with as.duration() or as.period()" msgstr "" msgid "Remainder cannot be expressed as fraction of a period.\n Performing %/%." msgstr "" msgid "estimate only: convert to intervals for accuracy" msgstr "" msgid "Incompatible timespan classes:\n change class with as.duration() or put interval in numerator." msgstr "" msgid "interval / interval not defined" msgstr "" msgid "Incompatible timespan classes:\n change class with as.period() or put interval in numerator." msgstr "" msgid "Cannot divide numeric by duration" msgstr "" msgid "Cannot divide numeric by interval" msgstr "" msgid "Cannot divide numeric by period" msgstr "" msgid "%% not defined for Interval class\nConsider setdiff()" msgstr "" msgid "%m+% only handles Period objects with month or year units" msgstr "" msgid "%m-% only handles Period objects with month or year units" msgstr "" msgid "%m+% only handles month and years. Add other periods separately with '+'" msgstr "" msgid "cannot multiply time span by time span" msgstr "" msgid "interval does not align: coercing to duration" msgstr "" msgid "- undefined for Interval class:\nConsider intersect(), union(), or setdiff()\nor change class with as.period() or as.duration()" msgstr "" msgid "- undefined for Interval class:\n manipulate with int_start(), int_end() and int_shift()\n or change class with as.duration() or as.period()" msgstr "" msgid "No formats could be infered from the training set." msgstr "" msgid "failed to parse." msgstr "" msgid "parsed with" msgstr "" msgid "^@|@$" msgstr "" msgid "Internal function parse_date has been removed from lubridate package. Plese use parse_date_time instead." msgstr "" msgid "arguments must have same length" msgstr "" msgid "cannot compare Period to Duration:\ncoerce with as.duration" msgstr "" msgid "cannot compare Period to numeric:\ncoerce with as.numeric" msgstr "" msgid "Couldn't guess formats of:" msgstr "" msgid "Multiple formats matched:" msgstr "" msgid "\"" msgstr "" msgid "\"(" msgstr "" msgid ")" msgstr "" msgid "Using: \"" msgstr "" msgid "conflicting days input" msgstr "" msgid "longer object length is not a multiple of shorter object length" msgstr "" msgid "Invalid unit name:" msgstr "" msgid "Invalid difftime name:" msgstr "" msgid "Invalid period name:" msgstr "" lubridate/po/R-it.po0000644000175100001440000001273512747740626014063 0ustar hornikusersmsgid "" msgstr "" "Project-Id-Version: R 2.15.1\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2013-03-29 14:39\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: dmedri@gmail.com \n" "Language-Team: Italian \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=utf-8\n" "Content-Transfer-Encoding: 8bit\n" msgid "estimate only: convert periods to intervals for accuracy" msgstr "stima solamente: converte i periodi in intervalli per accuratezza" msgid "estimate only: convert difftimes to intervals for accuracy" msgstr "stima solamente: converte le differente di tempo in intervalli per accuratezza" msgid "estimate only: convert durations to intervals for accuracy" msgstr "stima solamente: converte le durate in intervalli per accuratezza" msgid "cannot map durations to months" msgstr "non è possibile mappare la durata in mesi" msgid "coercing interval to duration" msgstr "conversione degli intervalli in durate" msgid "date(s) not in POSIXt or Date format" msgstr "date in formato differente da POSIXt o Date" msgid "Unknown formats supplied:" msgstr "Indicati formati sconosciuti:" msgid "," msgstr "," msgid "by is not a recognized timespan object" msgstr "" msgid "an interval cannot be shifted by another interval. \n\t\tConvert second interval to a period or duration." msgstr "" msgid "Union includes intervening time between intervals." msgstr "" msgid "Cases" msgstr "Casi" msgid "result in discontinuous intervals." msgstr "risultato in intervalli discontinui." msgid "Argument 1 is not a recognized date-time" msgstr "L'argomento 1 non è riconosciuto come date-time" msgid "unrecognized date format" msgstr "formato data non riconosciuto" msgid "+ undefined for Interval class:\n manipulate with int_start(), int_end() and int_shift()\n or change class with as.duration()" msgstr "" msgid "Incompatible timespan classes:\n change class with as.duration() or as.period()" msgstr "" msgid "+ undefined for Interval class:\nConsider intersect(), union(), or setdiff()\nor change class with as.period() or as.duration()" msgstr "" msgid "+ undefined for Interval class:\n manipulate with int_start(), int_end() and int_shift()\n or change class with as.period()" msgstr "" msgid "+ undefined for Interval class:\n manipulate with int_start(), int_end() and int_shift()\n or change class with as.duration() or as.period()" msgstr "" msgid "Remainder cannot be expressed as fraction of a period.\n Performing %/%." msgstr "" msgid "estimate only: convert to intervals for accuracy" msgstr "stima solamente: converte in intervalli per accuratezza" msgid "Incompatible timespan classes:\n change class with as.duration() or put interval in numerator." msgstr "" msgid "interval / interval not defined" msgstr "intervallo / intervallo non definito" msgid "Incompatible timespan classes:\n change class with as.period() or put interval in numerator." msgstr "" msgid "Cannot divide numeric by duration" msgstr "Non è possibile dividere un tipo numeric per uno duration" msgid "Cannot divide numeric by interval" msgstr "Non è possibile dividere un tipo numeric per uno interval" msgid "Cannot divide numeric by period" msgstr "Non è possibile dividere un tipo numeric per uno period" msgid "%% not defined for Interval class\nConsider setdiff()" msgstr "" msgid "%m+% only handles Period objects with month or year units" msgstr "" msgid "%m-% only handles Period objects with month or year units" msgstr "" msgid "%m+% only handles month and years. Add other periods separately with '+'" msgstr "" msgid "cannot multiply time span by time span" msgstr "" msgid "interval does not align: coercing to duration" msgstr "" msgid "- undefined for Interval class:\nConsider intersect(), union(), or setdiff()\nor change class with as.period() or as.duration()" msgstr "" msgid "- undefined for Interval class:\n manipulate with int_start(), int_end() and int_shift()\n or change class with as.duration() or as.period()" msgstr "" msgid "No formats could be infered from the training set." msgstr "Nessun formato può essere identificato dal training set." msgid "failed to parse." msgstr "analisi non possibile." msgid "parsed with" msgstr "analizzato con" msgid "^@|@$" msgstr "^@|@" msgid "Internal function parse_date has been removed from lubridate package. Plese use parse_date_time instead." msgstr "La funzione interna parse_date è stata rimossa dal pacchetto lubridate. Per piacere, usa parse_date_time al suo posto." msgid "arguments must have same length" msgstr "gli argomenti devono avere la stessa lunghezza" msgid "cannot compare Period to Duration:\ncoerce with as.duration" msgstr "non è possibile comparare i periodi con valori di durata:\nconverti con as.duration" msgid "cannot compare Period to numeric:\ncoerce with as.numeric" msgstr "non è possibile comparare i periodi con valori numerici:\nconverti with as.numeric" msgid "Couldn't guess formats of:" msgstr "Non è possibile rilevare il formato di:" msgid "Multiple formats matched:" msgstr "Confronto formati multipli:" msgid "\"" msgstr "\"" msgid "\"(" msgstr "\"(" msgid ")" msgstr ")" msgid "Using: \"" msgstr "Utilizzo: \"" msgid "conflicting days input" msgstr "inseriti giorni in conflitto" msgid "longer object length is not a multiple of shorter object length" msgstr "" msgid "Invalid unit name:" msgstr "Nome unità non valido:" msgid "Invalid difftime name:" msgstr "Nome difftime non valido:" msgid "Invalid period name:" msgstr "Nome periodo non valido:" lubridate/po/R-ko.po0000644000175100001440000002202712747740626014053 0ustar hornikusers# Korean translation for R lubridate package # /po/R-ko.po # This file is distributed under the same license as the R lubridate package. # R Development Translation Team - Korean # Chel Hee Lee , 2013. # Chel Hee Lee , 2013. # msgid "" msgstr "" "Project-Id-Version: lubridate 1.2.1\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2013-03-29 14:35\n" "PO-Revision-Date: 2013-04-01 16:55+0900\n" "Last-Translator: Eugene Jung \n" "Language-Team: R Development Translation Teams (Korean) \n" "Language: ko\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=1; plural=0;\n" "X-Poedit-SourceCharset: utf-8\n" "X-Generator: Poedit 1.5.5\n" msgid "estimate only: convert periods to intervals for accuracy" msgstr "추정만: 정확성을 위해 기간(periods)을 간격(intervals)으로 변환" msgid "estimate only: convert difftimes to intervals for accuracy" msgstr "추정만: 정확성을 위해 difftimes를 간격(intervals)으로 변환" msgid "estimate only: convert durations to intervals for accuracy" msgstr "추정만: 정확성을 위해 듀레이션(durations)를 간격(intervals)로 변환함" msgid "cannot map durations to months" msgstr "듀레이션(durations)을 월(months)로 나타낼 수 없습니다." msgid "coercing interval to duration" msgstr "간격(interval)을 듀레이션(duration)으로 강제변환" msgid "date(s) not in POSIXt or Date format" msgstr "날짜가 POSIXt 또는 Date 형태(format)와 일치하지 않습니다." msgid "Unknown formats supplied:" msgstr "알 수 없는 형태(formats)가 입력되었습니다." msgid "," msgstr "," msgid "by is not a recognized timespan object" msgstr "알려진 timespan 객체에 의한 것이 아닙니다." msgid "" "an interval cannot be shifted by another interval. \n" "\t\tConvert second interval to a period or duration." msgstr "" "특정 간격(interval)이 다른 간격(interval)으로 전환될 수 없습니다. \n" "\t\t두 번째 간격(interval)을 일정 기간(period)이나 듀레이션(duration)으로 변" "환합니다." msgid "Union includes intervening time between intervals." msgstr "유니온(union)은 간격간 변환시간을 포함합니다." msgid "Cases" msgstr "사례(cases)" msgid "result in discontinuous intervals." msgstr "이산기간의 결과" msgid "Argument 1 is not a recognized date-time" msgstr "인수 1은 date-time으로 인식되지 않습니다." msgid "unrecognized date format" msgstr "인식되지 않는 날짜 형식" msgid "" "+ undefined for Interval class:\n" " manipulate with int_start(), int_end() and int_shift()\n" " or change class with as.duration()" msgstr "" "+ 정의되지 않은 간격 클래스(interval class)\"\n" " int_start(), int_end(), 그리고 int_shift()로 조정하십시오.\n" " 또는 as.duration()으로 클래스(class)를 변경하십시오." msgid "" "Incompatible timespan classes:\n" " change class with as.duration() or as.period()" msgstr "" "호환되지 않는 기간 클래스(timespan class):\n" " as.duration()이나 as.period()로 클래스를 변경하십시오." msgid "" "+ undefined for Interval class:\n" "Consider intersect(), union(), or setdiff()\n" "or change class with as.period() or as.duration()" msgstr "" "+ 간격 클래스(interval class)가 정의되지 않음:\n" "intersect(), union() 또는 setfiff()를 고려해 보십시오\n" "또는 as.period()나 as.duration()으로 클래스를 변경하십시오." msgid "" "+ undefined for Interval class:\n" " manipulate with int_start(), int_end() and int_shift()\n" " or change class with as.period()" msgstr "" "+ 간격 클래스(interval class)가 정의되지 않음:\n" "int_start(), int_end(), 그리고 int_shift()로 조정하십시오\n" "또는 as.period()로 클래스를 변경하십시오." msgid "" "+ undefined for Interval class:\n" " manipulate with int_start(), int_end() and int_shift()\n" " or change class with as.duration() or as.period()" msgstr "" "간격 클래스(interval class)가 정의되지 않음:\n" "int_start(), int_end(), 그리고 int_shift()로 조정하십시오.\n" "또는 as.duration()이나 as.period()으로 클래스를 변경하십시오." msgid "" "Remainder cannot be expressed as fraction of a period.\n" " Performing %/%." msgstr "" "나머지는 기간의 일부로 표현될 수 없습니다.\n" "진행률 %/%" msgid "estimate only: convert to intervals for accuracy" msgstr "추정만: 정확성을 위해 간격(intervals)로 변환" msgid "" "Incompatible timespan classes:\n" " change class with as.duration() or put interval in numerator." msgstr "" "호환되지 않는 기간 클래스(timespan class):\n" "as.duration()으로 클래스를 변경하거나 분자에 간격 삽입하십시오." msgid "interval / interval not defined" msgstr "간격/정의되지 않은 간격" msgid "" "Incompatible timespan classes:\n" " change class with as.period() or put interval in numerator." msgstr "" "호환되지 않는 기간 클래스(timespan class):\n" "as.period()로 클래스를 변경하거나 분자에 간격을 삽입하십시오." msgid "Cannot divide numeric by duration" msgstr "듀레이션에 의해 숫자로 나누어지지 않습니다." msgid "Cannot divide numeric by interval" msgstr "간격에 의해 숫자로 나누어지지 않습니다." msgid "Cannot divide numeric by period" msgstr "간격에 의해 숫자로 나누어지지 않습니다." msgid "" "%% not defined for Interval class\n" "Consider setdiff()" msgstr "" "%% 간격 클래스(interval class)로 정의되지 않음\n" "setdiff()를 고려하십시오." msgid "%m+% only handles Period objects with month or year units" msgstr "" "%m+%만 오로지 월(month) 또는 년(year) 단위로 기간 객체(period objects)를 다룹" "니다." msgid "%m-% only handles Period objects with month or year units" msgstr "" "%m-%만 오로지 월(month) 또는 년(year) 단위로 기간 객체(period objects)를 다룹" "니다." msgid "" "%m+% only handles month and years. Add other periods separately with '+'" msgstr "" "%m+%만 오로지 월(month) 또는 년(year)을 다룹니다. 다른 기간은 별도로 \"+\"에 " "의해 추가하십시오." msgid "cannot multiply time span by time span" msgstr "기간을 기간으로 곱할 수 없습니다." msgid "interval does not align: coercing to duration" msgstr "간격이 정렬되지 않습니다: 듀레이션으로 강제변환합니다." msgid "" "- undefined for Interval class:\n" "Consider intersect(), union(), or setdiff()\n" "or change class with as.period() or as.duration()" msgstr "" "정의되지 않은 간격 클래스(interval class):\n" "intersect(), union(), 또는 setdiff()를 고려해 보십시오\n" "또는 as.period()나 as.duration()으로 클래스를 변경하십시오." msgid "" "- undefined for Interval class:\n" " manipulate with int_start(), int_end() and int_shift()\n" " or change class with as.duration() or as.period()" msgstr "" "정의되지 않은 간격 클래스(interval class):\n" "int_start(), int_end() 그리고 int_shift()로 조정해 보십시오\n" "또는 as.duration()이나 as.period()로 클래스를 변경하십시오." msgid "No formats could be infered from the training set." msgstr "실험집단(traininig set)으로 부터 추정할 수 없는 형식(format)" msgid "failed to parse." msgstr "parse 실패" msgid "parsed with" msgstr "다음으로 parse" msgid "^@|@$" msgstr "^@|@$" msgid "" "Internal function parse_date has been removed from lubridate package. Plese " "use parse_date_time instead." msgstr "" "내부 함수 parse_date가 lubridate 패키지에서 제거되었습니다. 대신에 " "parse_date_time을 사용해 주십시오." msgid "arguments must have same length" msgstr "인수(arguments)는 같은 길이를 가져야 합니다." msgid "" "cannot compare Period to Duration:\n" "coerce with as.duration" msgstr "" "기간(period)과 듀레이션(duration)을 비교할 수 없습니다.:\n" "as.duration으로 강제변환합니다." msgid "" "cannot compare Period to numeric:\n" "coerce with as.numeric" msgstr "" "기간(period)과 숫자(numeric)을 비교할 수 없습니다.:\n" "as.numeric으로 강제변환합니다." msgid "Couldn't guess formats of:" msgstr "Quess 할 수 없는 형식(format)입니다." msgid "Multiple formats matched:" msgstr "여러 개의 형식(formats)이 대응되었습니다." msgid "\"" msgstr "\"" msgid "\"(" msgstr "\"(" msgid ")" msgstr ")" msgid "Using: \"" msgstr "\"을 사용하십시오." msgid "conflicting days input" msgstr "날짜 입력이 충돌합니다." msgid "longer object length is not a multiple of shorter object length" msgstr "보다 긴 객체 길이가 보다 짧은 객체 길이의 배수는 아닙니다." msgid "Invalid unit name:" msgstr "유효하지 않은 단위(unit) 이름입니다:" msgid "Invalid difftime name:" msgstr "유효하지 않은 difftime 이름입니다:" msgid "Invalid period name:" msgstr "유효하지 않은 기간(period) 이름입니다:" lubridate/inst/0000755000175100001440000000000012765562217013235 5ustar hornikuserslubridate/inst/CITATION0000644000175100001440000000126012704211672014356 0ustar hornikuserscitHeader("To cite lubridate in publications use:") citEntry(entry = "Article", title = "Dates and Times Made Easy with {lubridate}", author = personList(as.person("Garrett Grolemund"), as.person("Hadley Wickham")), journal = "Journal of Statistical Software", year = "2011", volume = "40", number = "3", pages = "1--25", url = "http://www.jstatsoft.org/v40/i03/", textVersion = paste("Garrett Grolemund, Hadley Wickham (2011).", "Dates and Times Made Easy with lubridate.", "Journal of Statistical Software, 40(3), 1-25.", "URL http://www.jstatsoft.org/v40/i03/.") ) lubridate/inst/doc/0000755000175100001440000000000012765562217014002 5ustar hornikuserslubridate/inst/doc/lubridate.Rmd0000644000175100001440000002017312765562217016424 0ustar hornikusers # Do more with dates and times in R with lubridate 1.3.0 _note: This vignette is an updated version of the blog post first published at [r-statistics](http://www.r-statistics.com/2012/03/do-more-with-dates-and-times-in-r-with-lubridate-1-1-0/)_ Lubridate is an R package that makes it easier to work with dates and times. Below is a concise tour of some of the things lubridate can do for you. Lubridate was created by Garrett Grolemund and Hadley Wickham. ## Parsing dates and times Getting R to agree that your data contains the dates and times you think it does can be tricky. Lubridate simplifies that. Identify the order in which the year, month, and day appears in your dates. Now arrange "y", "m", and "d" in the same order. This is the name of the function in lubridate that will parse your dates. For example, ```{r} library(lubridate) ymd("20110604") mdy("06-04-2011") dmy("04/06/2011") ``` Lubridate's parse functions handle a wide variety of formats and separators, which simplifies the parsing process. If your date includes time information, add h, m, and/or s to the name of the function. `ymd_hms` is probably the most common date time format. To read the dates in with a certain time zone, supply the official name of that time zone in the `tz` argument. ```{r} arrive <- ymd_hms("2011-06-04 12:00:00", tz = "Pacific/Auckland") arrive leave <- ymd_hms("2011-08-10 14:00:00", tz = "Pacific/Auckland") leave ``` ## Setting and Extracting information Extract information from date times with the functions `second`, `minute`, `hour`, `day`, `wday`, `yday`, `week`, `month`, `year`, and `tz`. You can also use each of these to set (i.e, change) the given information. Notice that this will alter the date time. `wday` and `month` have an optional `label` argument, which replaces their numeric output with the name of the weekday or month. ```{r} second(arrive) second(arrive) <- 25 arrive second(arrive) <- 0 wday(arrive) wday(arrive, label = TRUE) ``` ## Time Zones There are two very useful things to do with dates and time zones. First, display the same moment in a different time zone. Second, create a new moment by combining an existing clock time with a new time zone. These are accomplished by `with_tz` and `force_tz`. For example, a while ago I was in Auckland, New Zealand. I arranged to meet the co-author of lubridate, Hadley, over skype at 9:00 in the morning Auckland time. What time was that for Hadley who was back in Houston, TX? ```{r} meeting <- ymd_hms("2011-07-01 09:00:00", tz = "Pacific/Auckland") with_tz(meeting, "America/Chicago") ``` So the meetings occurred at 4:00 Hadley's time (and the day before no less). Of course, this was the same actual moment of time as 9:00 in New Zealand. It just appears to be a different day due to the curvature of the Earth. What if Hadley made a mistake and signed on at 9:00 his time? What time would it then be my time? ```{r} mistake <- force_tz(meeting, "America/Chicago") with_tz(mistake, "Pacific/Auckland") ``` His call would arrive at 2:00 am my time! Luckily he never did that. ## Time Intervals You can save an interval of time as an Interval class object with lubridate. This is quite useful! For example, my stay in Auckland lasted from June 4, 2011 to August 10, 2011 (which we've already saved as arrive and leave). We can create this interval in one of two ways: ```{r} auckland <- interval(arrive, leave) auckland auckland <- arrive %--% leave auckland ``` My mentor at the University of Auckland, Chris, traveled to various conferences that year including the Joint Statistical Meetings (JSM). This took him out of the country from July 20 until the end of August. ```{r} jsm <- interval(ymd(20110720, tz = "Pacific/Auckland"), ymd(20110831, tz = "Pacific/Auckland")) jsm ``` Will my visit overlap with and his travels? Yes. ```{r} int_overlaps(jsm, auckland) ``` Then I better make hay while the sun shines! For what part of my visit will Chris be there? ```{r} setdiff(auckland, jsm) ``` Other functions that work with intervals include `int_start`, `int_end`, `int_flip`, `int_shift`, `int_aligns`, `union`, `intersect`, `setdiff`, and `%within%`. ## Arithmetic with date times Intervals are specific time spans (because they are tied to specific dates), but lubridate also supplies two general time span classes: Durations and Periods. Helper functions for creating periods are named after the units of time (plural). Helper functions for creating durations follow the same format but begin with a "d" (for duration) or, if you prefer, and "e" (for exact). ```{r} minutes(2) ## period dminutes(2) ## duration ``` Why two classes? Because the timeline is not as reliable as the number line. The Duration class will always supply mathematically precise results. A duration year will always equal 365 days. Periods, on the other hand, fluctuate the same way the timeline does to give intuitive results. This makes them useful for modeling clock times. For example, durations will be honest in the face of a leap year, but periods may return what you want: ```{r} leap_year(2011) ## regular year ymd(20110101) + dyears(1) ymd(20110101) + years(1) leap_year(2012) ## leap year ymd(20120101) + dyears(1) ymd(20120101) + years(1) ``` You can use periods and durations to do basic arithmetic with date times. For example, if I wanted to set up a reoccuring weekly skype meeting with Hadley, it would occur on: ```{r} meetings <- meeting + weeks(0:5) ``` Hadley travelled to conferences at the same time as Chris. Which of these meetings would be affected? The last two. ```{r} meetings %within% jsm ``` How long was my stay in Auckland? ```{r} auckland / ddays(1) auckland / ddays(2) auckland / dminutes(1) ``` And so on. Alternatively, we can do modulo and integer division. Sometimes this is more sensible than division - it is not obvious how to express a remainder as a fraction of a month because the length of a month constantly changes. ```{r} auckland %/% months(1) auckland %% months(1) ``` Modulo with an timespan returns the remainder as a new (smaller) interval. You can turn this or any interval into a generalized time span with `as.period`. ```{r} as.period(auckland %% months(1)) as.period(auckland) ``` ### If anyone drove a time machine, they would crash The length of months and years change so often that doing arithmetic with them can be unintuitive. Consider a simple operation, `January 31st + one month`. Should the answer be 1. `February 31st` (which doesn't exist) 2. `March 4th` (31 days after January 31), or 3. `February 28th` (assuming its not a leap year) A basic property of arithmetic is that `a + b - b = a`. Only solution 1 obeys this property, but it is an invalid date. I've tried to make lubridate as consistent as possible by invoking the following rule *if adding or subtracting a month or a year creates an invalid date, lubridate will return an NA*. This is new with version 1.3.0, so if you're an old hand with lubridate be sure to remember this! If you thought solution 2 or 3 was more useful, no problem. You can still get those results with clever arithmetic, or by using the special `%m+%` and `%m-%` operators. `%m+%` and `%m-%` automatically roll dates back to the last day of the month, should that be necessary. ```{r} jan31 <- ymd("2013-01-31") jan31 + months(0:11) floor_date(jan31, "month") + months(0:11) + days(31) jan31 %m+% months(0:11) ``` Notice that this will only affect arithmetic with months (and arithmetic with years if your start date it Feb 29). ## Vectorization The code in lubridate is vectorized and ready to be used in both interactive settings and within functions. As an example, I offer a function for advancing a date to the last day of the month ```{r} last_day <- function(date) { ceiling_date(date, "month") - days(1) } ``` ## Further Resources To learn more about lubridate, including the specifics of periods and durations, please read the [original lubridate paper](http://www.jstatsoft.org/v40/i03/). Questions about lubridate can be addressed to the lubridate google group. Bugs and feature requests should be submitted to the [lubridate development page](http://github.com/hadley/lubridate) on github. lubridate/inst/doc/lubridate.R0000644000175100001440000000527612765562217016112 0ustar hornikusers## ------------------------------------------------------------------------ library(lubridate) ymd("20110604") mdy("06-04-2011") dmy("04/06/2011") ## ------------------------------------------------------------------------ arrive <- ymd_hms("2011-06-04 12:00:00", tz = "Pacific/Auckland") arrive leave <- ymd_hms("2011-08-10 14:00:00", tz = "Pacific/Auckland") leave ## ------------------------------------------------------------------------ second(arrive) second(arrive) <- 25 arrive second(arrive) <- 0 wday(arrive) wday(arrive, label = TRUE) ## ------------------------------------------------------------------------ meeting <- ymd_hms("2011-07-01 09:00:00", tz = "Pacific/Auckland") with_tz(meeting, "America/Chicago") ## ------------------------------------------------------------------------ mistake <- force_tz(meeting, "America/Chicago") with_tz(mistake, "Pacific/Auckland") ## ------------------------------------------------------------------------ auckland <- interval(arrive, leave) auckland auckland <- arrive %--% leave auckland ## ------------------------------------------------------------------------ jsm <- interval(ymd(20110720, tz = "Pacific/Auckland"), ymd(20110831, tz = "Pacific/Auckland")) jsm ## ------------------------------------------------------------------------ int_overlaps(jsm, auckland) ## ------------------------------------------------------------------------ setdiff(auckland, jsm) ## ------------------------------------------------------------------------ minutes(2) ## period dminutes(2) ## duration ## ------------------------------------------------------------------------ leap_year(2011) ## regular year ymd(20110101) + dyears(1) ymd(20110101) + years(1) leap_year(2012) ## leap year ymd(20120101) + dyears(1) ymd(20120101) + years(1) ## ------------------------------------------------------------------------ meetings <- meeting + weeks(0:5) ## ------------------------------------------------------------------------ meetings %within% jsm ## ------------------------------------------------------------------------ auckland / ddays(1) auckland / ddays(2) auckland / dminutes(1) ## ------------------------------------------------------------------------ auckland %/% months(1) auckland %% months(1) ## ------------------------------------------------------------------------ as.period(auckland %% months(1)) as.period(auckland) ## ------------------------------------------------------------------------ jan31 <- ymd("2013-01-31") jan31 + months(0:11) floor_date(jan31, "month") + months(0:11) + days(31) jan31 %m+% months(0:11) ## ------------------------------------------------------------------------ last_day <- function(date) { ceiling_date(date, "month") - days(1) } lubridate/inst/doc/lubridate.html0000644000175100001440000006462212765562217016655 0ustar hornikusers Do more with dates and times in R with lubridate 1.3.0

Do more with dates and times in R with lubridate 1.3.0

note: This vignette is an updated version of the blog post first published at r-statistics

Lubridate is an R package that makes it easier to work with dates and times. Below is a concise tour of some of the things lubridate can do for you.

Lubridate was created by Garrett Grolemund and Hadley Wickham.

Parsing dates and times

Getting R to agree that your data contains the dates and times you think it does can be tricky. Lubridate simplifies that. Identify the order in which the year, month, and day appears in your dates. Now arrange “y”, “m”, and “d” in the same order. This is the name of the function in lubridate that will parse your dates. For example,

library(lubridate)

## 
## Attaching package: 'lubridate'

## The following object is masked from 'package:base':
## 
##     date

ymd("20110604")

## [1] "2011-06-04"

mdy("06-04-2011")

## [1] "2011-06-04"

dmy("04/06/2011")

## [1] "2011-06-04"

Lubridate's parse functions handle a wide variety of formats and separators, which simplifies the parsing process.

If your date includes time information, add h, m, and/or s to the name of the function. ymd_hms is probably the most common date time format. To read the dates in with a certain time zone, supply the official name of that time zone in the tz argument.

arrive <- ymd_hms("2011-06-04 12:00:00", tz = "Pacific/Auckland")
arrive

## [1] "2011-06-04 12:00:00 NZST"

leave <- ymd_hms("2011-08-10 14:00:00", tz = "Pacific/Auckland")
leave

## [1] "2011-08-10 14:00:00 NZST"

Setting and Extracting information

Extract information from date times with the functions second, minute, hour, day, wday, yday, week, month, year, and tz. You can also use each of these to set (i.e, change) the given information. Notice that this will alter the date time. wday and month have an optional label argument, which replaces their numeric output with the name of the weekday or month.

second(arrive)

## [1] 0

second(arrive) <- 25
arrive

## [1] "2011-06-04 12:00:25 NZST"

second(arrive) <- 0

wday(arrive)

## [1] 7

wday(arrive, label = TRUE)

## [1] Sat
## Levels: Sun < Mon < Tues < Wed < Thurs < Fri < Sat

Time Zones

There are two very useful things to do with dates and time zones. First, display the same moment in a different time zone. Second, create a new moment by combining an existing clock time with a new time zone. These are accomplished by with_tz and force_tz.

For example, a while ago I was in Auckland, New Zealand. I arranged to meet the co-author of lubridate, Hadley, over skype at 9:00 in the morning Auckland time. What time was that for Hadley who was back in Houston, TX?

meeting <- ymd_hms("2011-07-01 09:00:00", tz = "Pacific/Auckland")
with_tz(meeting, "America/Chicago")

## [1] "2011-06-30 16:00:00 CDT"

So the meetings occurred at 4:00 Hadley's time (and the day before no less). Of course, this was the same actual moment of time as 9:00 in New Zealand. It just appears to be a different day due to the curvature of the Earth.

What if Hadley made a mistake and signed on at 9:00 his time? What time would it then be my time?

mistake <- force_tz(meeting, "America/Chicago")
with_tz(mistake, "Pacific/Auckland")

## [1] "2011-07-02 02:00:00 NZST"

His call would arrive at 2:00 am my time! Luckily he never did that.

Time Intervals

You can save an interval of time as an Interval class object with lubridate. This is quite useful! For example, my stay in Auckland lasted from June 4, 2011 to August 10, 2011 (which we've already saved as arrive and leave). We can create this interval in one of two ways:

auckland <- interval(arrive, leave) 
auckland

## [1] 2011-06-04 12:00:00 NZST--2011-08-10 14:00:00 NZST

auckland <- arrive %--% leave
auckland

## [1] 2011-06-04 12:00:00 NZST--2011-08-10 14:00:00 NZST

My mentor at the University of Auckland, Chris, traveled to various conferences that year including the Joint Statistical Meetings (JSM). This took him out of the country from July 20 until the end of August.

jsm <- interval(ymd(20110720, tz = "Pacific/Auckland"), ymd(20110831, tz = "Pacific/Auckland"))
jsm

## [1] 2011-07-20 NZST--2011-08-31 NZST

Will my visit overlap with and his travels? Yes.

int_overlaps(jsm, auckland)

## [1] TRUE

Then I better make hay while the sun shines! For what part of my visit will Chris be there?

setdiff(auckland, jsm)

## [1] 2011-06-04 12:00:00 NZST--2011-07-20 NZST

Other functions that work with intervals include int_start, int_end, int_flip, int_shift, int_aligns, union, intersect, setdiff, and %within%.

Arithmetic with date times

Intervals are specific time spans (because they are tied to specific dates), but lubridate also supplies two general time span classes: Durations and Periods. Helper functions for creating periods are named after the units of time (plural). Helper functions for creating durations follow the same format but begin with a “d” (for duration) or, if you prefer, and “e” (for exact).

minutes(2) ## period

## [1] "2M 0S"

dminutes(2) ## duration

## [1] "120s (~2 minutes)"

Why two classes? Because the timeline is not as reliable as the number line. The Duration class will always supply mathematically precise results. A duration year will always equal 365 days. Periods, on the other hand, fluctuate the same way the timeline does to give intuitive results. This makes them useful for modeling clock times. For example, durations will be honest in the face of a leap year, but periods may return what you want:

leap_year(2011) ## regular year

## [1] FALSE

ymd(20110101) + dyears(1)

## [1] "2012-01-01"

ymd(20110101) + years(1)

## [1] "2012-01-01"

leap_year(2012) ## leap year

## [1] TRUE

ymd(20120101) + dyears(1)

## [1] "2012-12-31"

ymd(20120101) + years(1)

## [1] "2013-01-01"

You can use periods and durations to do basic arithmetic with date times. For example, if I wanted to set up a reoccuring weekly skype meeting with Hadley, it would occur on:

meetings <- meeting + weeks(0:5)

Hadley travelled to conferences at the same time as Chris. Which of these meetings would be affected? The last two.

meetings %within% jsm

## [1] FALSE FALSE FALSE  TRUE  TRUE  TRUE

How long was my stay in Auckland?

auckland / ddays(1)

## [1] 67.08333

auckland / ddays(2)

## [1] 33.54167

auckland / dminutes(1)

## [1] 96600

And so on. Alternatively, we can do modulo and integer division. Sometimes this is more sensible than division - it is not obvious how to express a remainder as a fraction of a month because the length of a month constantly changes.

auckland %/% months(1)

## Note: method with signature 'Timespan#Timespan' chosen for function '%/%',
##  target signature 'Interval#Period'.
##  "Interval#ANY", "ANY#Period" would also be valid

## [1] 2

auckland %% months(1)

## [1] 2011-08-04 12:00:00 NZST--2011-08-10 14:00:00 NZST

Modulo with an timespan returns the remainder as a new (smaller) interval. You can turn this or any interval into a generalized time span with as.period.

as.period(auckland %% months(1))

## [1] "6d 2H 0M 0S"

as.period(auckland)

## [1] "2m 6d 2H 0M 0S"

If anyone drove a time machine, they would crash

The length of months and years change so often that doing arithmetic with them can be unintuitive. Consider a simple operation, January 31st + one month. Should the answer be

  1. February 31st (which doesn't exist)
  2. March 4th (31 days after January 31), or
  3. February 28th (assuming its not a leap year)

A basic property of arithmetic is that a + b - b = a. Only solution 1 obeys this property, but it is an invalid date. I've tried to make lubridate as consistent as possible by invoking the following rule if adding or subtracting a month or a year creates an invalid date, lubridate will return an NA. This is new with version 1.3.0, so if you're an old hand with lubridate be sure to remember this!

If you thought solution 2 or 3 was more useful, no problem. You can still get those results with clever arithmetic, or by using the special %m+% and %m-% operators. %m+% and %m-% automatically roll dates back to the last day of the month, should that be necessary.

jan31 <- ymd("2013-01-31")
jan31 + months(0:11)

##  [1] "2013-01-31" NA           "2013-03-31" NA           "2013-05-31"
##  [6] NA           "2013-07-31" "2013-08-31" NA           "2013-10-31"
## [11] NA           "2013-12-31"

floor_date(jan31, "month") + months(0:11) + days(31)

##  [1] "2013-02-01" "2013-03-04" "2013-04-01" "2013-05-02" "2013-06-01"
##  [6] "2013-07-02" "2013-08-01" "2013-09-01" "2013-10-02" "2013-11-01"
## [11] "2013-12-02" "2014-01-01"

jan31 %m+% months(0:11)

##  [1] "2013-01-31" "2013-02-28" "2013-03-31" "2013-04-30" "2013-05-31"
##  [6] "2013-06-30" "2013-07-31" "2013-08-31" "2013-09-30" "2013-10-31"
## [11] "2013-11-30" "2013-12-31"

Notice that this will only affect arithmetic with months (and arithmetic with years if your start date it Feb 29).

Vectorization

The code in lubridate is vectorized and ready to be used in both interactive settings and within functions. As an example, I offer a function for advancing a date to the last day of the month

last_day <- function(date) {
  ceiling_date(date, "month") - days(1)
}

Further Resources

To learn more about lubridate, including the specifics of periods and durations, please read the original lubridate paper. Questions about lubridate can be addressed to the lubridate google group. Bugs and feature requests should be submitted to the lubridate development page on github.

lubridate/tests/0000755000175100001440000000000012705366146013417 5ustar hornikuserslubridate/tests/testthat.R0000644000175100001440000000014212705366146015377 0ustar hornikusersif (packageVersion("testthat") >= "0.7.1.99") { library(testthat) test_check("lubridate") } lubridate/tests/testthat/0000755000175100001440000000000012765757370015270 5ustar hornikuserslubridate/tests/testthat/test-ops-integer-division.R0000644000175100001440000000466012705366146022443 0ustar hornikuserscontext("integer division operations") test_that("integer division works for interval numerator",{ int1 <- ymd("2010-01-01") %--% ymd("2011-01-01") expect_error(int1 %/% int2) expect_equal(int1 %/% months(1), 12) expect_error(months(12) %/% int1) expect_equal(int1 %/% ddays(1), 365) expect_error(ddays(365) %/% int1) }) test_that("integer division works for interval numerator with vectors",{ int1 <- ymd("2010-01-01") %--% ymd("2011-01-01") int2 <- ymd("2009-01-01") %--% ymd("2011-01-01") int3 <- ymd("2009-01-01") %--% ymd("2010-01-01") expect_error(int2 %/% c(int1, int3)) expect_error(c(int1, int2) %/% int3) expect_equal(int1 %/% months(1:2), c(12, 6)) expect_error(months(c(6, 12)) %/% int1) expect_equal(int1 %/% ddays(1:2), c(365, 182)) expect_equal(c(int1, int2) %/% ddays(2), c(182, 365)) }) test_that("integer division works for period numerator",{ int1 <- ymd("2010-01-01") %--% ymd("2010-12-31") expect_error(years(2) %/% int1) expect_equal(years(1) %/% days(1), 365) expect_equal(months(13) %/% years(1), 1) expect_error(months(1) %/% ddays(1)) }) test_that("integer division works for period numerator with vectors",{ int1 <- ymd("2010-01-01") %--% ymd("2011-01-01") int2 <- ymd("2009-01-01") %--% ymd("2011-01-01") expect_error(years(2) %/% c(int1, int2)) expect_error(years(1:2) %/% int1) expect_equal(years(1) %/% months(1:2), c(12, 6)) expect_equal(months(c(6, 12)) %/% years(1), c(0, 1)) expect_error(years(1) %/% ddays(1:2)) expect_error(years(1:2) %/% ddays(2)) }) test_that("integer division works for duration numerator",{ int1 <- ymd("2010-01-01") %--% ymd("2011-01-01") expect_error(dyears(2) %/% int1) expect_error(dyears(1) %/% months(1)) expect_equal(dyears(1) %/% ddays(1), 365) }) test_that("integer division works for duration numerator with vectors",{ int1 <- ymd("2010-01-01") %--% ymd("2011-01-01") int2 <- ymd("2009-01-01") %--% ymd("2011-01-01") expect_error(dyears(2) %/% c(int1, int2)) expect_error(dyears(1:2) %/% int1) expect_error(dyears(1) %/% months(1:2)) expect_error(dyears(1:2) %/% years(1)) expect_equal(dyears(1) %/% ddays(1:2), c(365, 182)) expect_equal(dyears(1:2) %/% ddays(2), c(182, 365)) }) test_that("integer division works with Period denominator (#235)", { a <- interval(ymd(20140331), ymd(20140519)) expect_equal(a %/% months(1), 1) a <- interval(ymd(20140331), ymd(20140419)) expect_equal(a %/% months(1), 0) }) lubridate/tests/testthat/test-utilities.R0000644000175100001440000000201212705366146020365 0ustar hornikuserscontext("Utilities") test_that("leap_year correctly identifies leap years",{ x <- as.POSIXct("2009-08-03 12:01:59", tz = "UTC") y <- as.POSIXct("2008-08-03 12:01:59", tz = "UTC") expect_that(leap_year(x), is_false()) expect_that(leap_year(y), is_true()) }) test_that("leap_year handles vectors",{ x <- as.POSIXct(c("2008-08-03 12:01:59", "2009-08-03 12:01:59"), tz = "UTC") expect_that(leap_year(x)[1], is_true()) expect_that(leap_year(x)[2], is_false()) expect_that(leap_year(as.Date(x))[1], is_true()) expect_that(leap_year(as.Date(x))[2], is_false()) }) test_that("leap_year handles various classes of date-time object",{ x <- as.POSIXct(c("2008-08-03 12:01:59", "2009-08-03 12:01:59"), tz = "UTC") expect_that(leap_year(x)[1], is_true()) expect_that(leap_year(x)[2], is_false()) expect_that(leap_year(as.Date(x))[1], is_true()) expect_that(leap_year(as.Date(x))[2], is_false()) expect_that(leap_year(as.POSIXlt(x))[1], is_true()) expect_that(leap_year(as.POSIXlt(x))[2], is_false()) }) lubridate/tests/testthat/test-ops-addition.R0000644000175100001440000002442112750350632020745 0ustar hornikuserscontext("addition operations") test_that("addition handles daylight savings time", { x <- as.POSIXct("2010-03-14 00:00:00", tz = "America/New_York") y <- as.POSIXct("2010-03-15 01:00:00", tz = "America/New_York") expect_that(x + days(1), equals(as.POSIXct( "2010-03-15 00:00:00", tz = "America/New_York"))) expect_that(x + ddays(1), equals(y)) }) test_that("subtraction handles daylight savings time", { x <- as.POSIXct("2010-03-15 00:00:00", tz = "America/New_York") y <- as.POSIXct("2010-03-13 23:00:00", tz = "America/New_York") expect_that(x - days(1), equals(as.POSIXct( "2010-03-14 00:00:00", tz = "America/New_York"))) expect_that(x - ddays(1), equals(y)) }) test_that("addition works as expected for instants",{ x <- as.POSIXct("2008-01-01 00:00:00", tz = "UTC") y <- as.POSIXlt("2008-01-01 00:00:00", tz = "UTC") z <- as.Date("2008-01-01") expect_equal(x + years(1), as.POSIXct("2009-01-01 00:00:00", tz = "UTC")) expect_equal(y + years(1), as.POSIXlt("2009-01-01 00:00:00", tz = "UTC")) expect_equal(z + years(1), as.Date("2009-01-01")) expect_that(x + dyears(1), equals(as.POSIXct("2008-12-31 00:00:00", tz = "UTC"))) expect_that(y + dyears(1), equals(as.POSIXlt("2008-12-31 00:00:00", tz = "UTC"))) expect_that(z + dyears(1), equals(as.Date("2008-12-31"))) time1 <- as.POSIXct("2008-08-02 13:01:59", tz = "UTC") time2 <- as.POSIXct("2009-08-03 13:01:59", tz = "UTC") int <- interval(time1, time2) num <- as.numeric(time2) - as.numeric(time1) expect_error(x + int) expect_error(y + int) expect_error(z + int) }) test_that("addition with instants returns correct class",{ x <- as.POSIXct("2008-01-02 00:00:00", tz = "UTC") y <- as.POSIXlt("2008-01-02 00:00:00", tz = "UTC") z <- as.Date("2008-01-01") expect_is(x + years(1), "POSIXct") expect_is(y + years(1), "POSIXlt") expect_is(z + years(1), "Date") expect_that(x + dyears(1), is_a("POSIXct")) expect_that(y + dyears(1), is_a("POSIXlt")) expect_that(z + dyears(1), is_a("Date")) }) test_that("addition works as expected for periods",{ time1 <- as.POSIXct("2008-01-02 00:00:00", tz = "UTC") time2 <- as.POSIXct("2009-08-03 00:00:00", tz = "UTC") int <- interval(time1, time2) expect_that(years(1) + 1, equals(period(seconds = 1, years = 1))) expect_that(years(1) + as.POSIXct("2008-01-01 00:00:00", tz = "UTC"), equals(as.POSIXct("2009-01-01 00:00:00", tz = "UTC"))) expect_that(years(1) + as.POSIXlt("2008-01-01 00:00:00", tz = "UTC"), equals(as.POSIXlt("2009-01-01 00:00:00", tz = "UTC"))) expect_that(years(1) + minutes(3),equals(period(minutes = 3, years = 1))) expect_error(years(1) + dyears(1)) expect_error(years(1) + int) }) test_that("addition with periods returns correct class",{ expect_is(years(1) + 1, "Period") expect_is(years(1) + as.POSIXct( "2008-01-01 00:00:00", tz = "UTC"), "POSIXt") expect_is(years(1) + as.POSIXlt( "2008-01-01 00:00:00", tz = "UTC"),"POSIXlt") expect_is(years(1) + minutes(3), "Period") }) test_that("addition works as expected for durations",{ x <- as.POSIXct("2008-01-01 00:00:00", tz = "UTC") y <- as.POSIXct("2008-12-31 00:00:00", tz = "UTC") time1 <- as.POSIXct("2008-01-02 00:00:00", tz = "UTC") time2 <- as.POSIXct("2009-08-03 00:00:00", tz = "UTC") int <- interval(time1, time2) expect_equal(dyears(1) + 1, duration(31536001)) expect_equal(dyears(1) + x, y) expect_equal(dyears(1) + dyears(1), dyears(2)) expect_error(dyears(1) + minutes(3)) expect_error(dyears(1) + int) }) test_that("addition with durations returns correct class",{ ct <- as.POSIXct("2008-01-01 00:00:00", tz = "UTC") lt <- as.POSIXlt("2008-01-01 00:00:00", tz = "UTC") expect_that(dyears(1) + 1, is_a("Duration")) expect_that(dyears(1) + ct, is_a("POSIXct")) expect_that(dyears(1) + lt, is_a("POSIXlt")) expect_that(dyears(1) + dyears(1), is_a("Duration")) }) test_that("addition works as expected for intervals",{ time1 <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") time2 <- as.POSIXct("2009-08-03 13:01:59", tz = "UTC") time3 <- as.POSIXct("2008-01-01 00:00:00", tz = "UTC") diff <- difftime(time2, time1) int <- interval(time1, time2) expect_error(int + time3) expect_error(int + time1) expect_error(int + 1) expect_error(int + minutes(3)) expect_error(int + dyears(1)) time5 <- as.POSIXct("2010-08-03 00:00:00", tz = "UTC") int3 <- interval(time2, time5) expect_error(int + int3) }) #### Vectors test_that("adding vectors works as expected for instants",{ x <- as.POSIXct(c("2008-01-01 00:00:00", "2009-01-01 00:00:00"), tz = "UTC") y <- as.POSIXlt(c("2008-01-01 00:00:00", "2009-01-01 00:00:00"), tz = "UTC") z <- c(as.Date("2008-01-01"), as.Date("2008-01-10")) expect_that(x + years(1), equals(as.POSIXct(c( "2009-01-01 00:00:00","2010-01-01 00:00:00"), tz = "UTC"))) expect_that(y + years(1), equals(as.POSIXlt(c( "2009-01-01 00:00:00", "2010-01-01 00:00:00"), tz = "UTC"))) expect_that(z + years(1), equals(as.Date(c("2009-01-01", "2009-01-10")))) expect_that(x + dyears(1), equals(as.POSIXct(c( "2008-12-31 00:00:00", "2010-01-01 00:00:00"), tz = "UTC"))) expect_that(y + dyears(1), equals(as.POSIXlt(c( "2008-12-31 00:00:00", "2010-01-01 00:00:00"), tz = "UTC"))) expect_that(z + dyears(1), equals(as.Date(c("2008-12-31", "2009-01-09")))) time1 <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") time2 <- as.POSIXct("2009-08-03 13:01:59", tz = "UTC") int <- interval(time1, time2) num <- as.numeric(time2) - as.numeric(time1) expect_error(x + int) expect_error(y + int) expect_error(z + int) }) test_that("adding vectors works as expected for periods",{ expect_that(years(1:2) + 1, equals(period(seconds = 1, years = c(1,2)))) expect_that(years(1:2) + as.POSIXct("2008-01-01 00:00:00", tz = "UTC"), equals(as.POSIXct(c("2009-01-01 00:00:00", "2010-01-01 00:00:00"), tz = "UTC"))) expect_that(years(1:2) + as.POSIXlt("2008-01-01 00:00:00", tz = "UTC"), equals(as.POSIXlt(c("2009-01-01 00:00:00", "2010-01-01 00:00:00"), tz = "UTC"))) expect_that(years(1:2) + minutes(3), equals(period( minutes = 3, years = c(1, 2)))) expect_error(years(1:2) + dyears(1)) time1 <- as.POSIXct("2008-01-02 00:00:00", tz = "UTC") time2 <- as.POSIXct("2009-08-03 00:00:00", tz = "UTC") int <- interval(time1, time2) expect_error(years(1:2) + int) }) test_that("adding vectors works as expected for durations",{ w <- as.POSIXct("2007-01-01 00:00:00", tz = "UTC") x <- as.POSIXct("2008-01-01 00:00:00", tz = "UTC") y <- as.POSIXct(c("2008-01-01 00:00:00", "2008-12-31 00:00:00"), tz = "UTC") dur <- dminutes(1:2) + 1 expect_equal(dur@.Data, c(61, 121)) expect_equal(dyears(1:2) + w, y) expect_that(dyears(1:2) + as.POSIXlt(w), equals(as.POSIXlt(y))) expect_error(dyears(1:2) + minutes(3)) expect_that(dyears(1:2) + dyears(1), equals(dyears(2:3))) time1 <- as.POSIXct("2008-01-02 00:00:00", tz = "UTC") time2 <- as.POSIXct("2009-08-03 00:00:00", tz = "UTC") int <- interval(time1, time2) expect_error(dyears(1:2) + int) }) test_that("adding vectors works as expected for intervals",{ time1 <- as.POSIXct("2008-08-03 00:00:00", tz = "UTC") time2 <- as.POSIXct("2009-08-03 00:00:00", tz = "UTC") time3 <- as.POSIXct("2010-08-03 00:00:00", tz = "UTC") int <- interval(c(time1, time2), time3) int2 <- interval(time1, time2) expect_error(int + time4) expect_error(int + 1) expect_error(int + minutes(3)) expect_error(int + dyears(1)) expect_error(int + int2) }) test_that("%m+% correctly adds months without rollover",{ jan <- ymd_hms("2010-01-31 03:04:05") ends <- ymd_hms(c("2010-02-28 03:04:05", "2010-03-31 03:04:05", "2010-04-30 03:04:05")) expect_equal(jan %m+% months(1:3), ends) }) test_that("%m+% correctly adds years without rollover",{ leap <- ymd("2012-02-29") next1 <- ymd("2013-02-28") next2 <- ymd("2013-03-29") expect_equal(leap %m+% years(1), next1) expect_equal(leap %m+% period(years = 1, months = 1), next2) }) test_that("%m+% correctly adds years, months, days and HMS (#286)",{ date <- ymd("2012-02-29") per_all <- period(years = 1, months = 1, days = 2, hours = 1, minutes = 20, seconds = 30) per_major <- period(years = 1, months = 1) per_minor <- period(days = 2, hours = 1, minutes = 20, seconds = 30) expect_equal(date %m+% per_all, date %m+% per_major + per_minor) date <- ymd("2012-03-31") per_all <- period(months = 3, days = 30, hours = 1, minutes = 20, seconds = 30) per_major <- period(months = 3) per_minor <- period(days = 30, hours = 1, minutes = 20, seconds = 30) expect_equal(date %m+% per_all, date %m+% per_major + per_minor) }) test_that("%m+% correctly adds negative months without rollover",{ may <- ymd_hms("2010-05-31 03:04:05") ends <- ymd_hms(c("2010-04-30 03:04:05", "2010-03-31 03:04:05", "2010-02-28 03:04:05")) expect_equal(may %m+% -months(1:3), ends) }) test_that("%m+% correctly adds negative years without rollover",{ leap <- ymd("2012-02-29") next1 <- ymd("2011-02-28") next2 <- ymd("2011-01-29") next3 <- ymd("2011-03-29") expect_equal(leap %m+% years(-1), next1) expect_equal(leap %m+% period(years = -1, months = -1), next2) expect_equal(leap %m+% period(years = -1, months = 1), next3) }) test_that("addition with period months and years returns NA when appropriate", { jan <- ymd("2013-01-31", tz = "America/Chicago") feb <- ymd("2013-02-28", tz = "America/Chicago") mar <- ymd("2013-03-28", tz = "America/Chicago") leap <- ymd("2012-02-29", tz = "America/Chicago") mos <- ymd(c("2013-01-31", NA, "2013-03-31", NA, "2013-05-31", NA, "2013-07-31", "2013-08-31", NA, "2013-10-31", NA, "2013-12-31"), tz = "America/Chicago") yrs <- ymd(c("2012-02-29", NA, NA, NA,"2016-02-29"), tz = "America/Chicago") mos2 <- ymd(c("2013-01-31", "2012-12-31", NA, "2012-10-31", NA, "2012-08-31", "2012-07-31", NA, "2012-05-31", NA, "2012-03-31", NA), tz = "America/Chicago") yrs2 <- ymd(c("2012-02-29", NA, NA, NA,"2008-02-29"), tz = "America/Chicago") expect_equal(jan + months(0:11), mos) expect_equal(feb + months(1), mar) expect_equal(leap + years(0:4), yrs) expect_equal(jan - months(0:11), mos2) expect_equal(mar - months(1), feb) expect_equal(leap - years(0:4), yrs2) }) lubridate/tests/testthat/test-ops-subtraction.R0000644000175100001440000001060712705366146021517 0ustar hornikuserscontext("subtraction operations") ###### subtraction for everything test_that("subtraction works as expected for instants",{ x <- as.POSIXct("2008-01-01 00:00:02", tz = "UTC") y <- as.POSIXlt("2008-01-01 00:00:02", tz = "UTC") z <- as.Date("2008-01-03") expect_equal(x - years(1), as.POSIXct("2007-01-01 00:00:02", tz = "UTC")) expect_equal(y - years(1), as.POSIXlt("2007-01-01 00:00:02", tz = "UTC")) expect_equal(z - years(1), as.Date("2007-01-03")) expect_equal(x - dyears(1), as.POSIXct("2007-01-01 00:00:02", tz = "UTC")) expect_equal(y - dyears(1), as.POSIXlt("2007-01-01 00:00:02", tz = "UTC")) expect_equal(z - dyears(1), as.Date("2007-01-03")) time1 <- as.POSIXct("2007-08-03 13:01:59", tz = "UTC") time2 <- as.POSIXct("2008-01-01 00:00:59", tz = "UTC") int <- interval(time1, time2) num <- as.numeric(time2) - as.numeric(time1) expect_error(x - int) expect_error(y - int) expect_error(z - int) }) test_that("subtraction with instants returns correct class",{ x <- as.POSIXct("2008-01-01 12:00:00", tz = "UTC") y <- as.POSIXlt("2008-01-01 12:00:00", tz = "UTC") z <- as.Date("2008-01-01") expect_that(x - years(1), is_a("POSIXct")) expect_that(y - years(1), is_a("POSIXlt")) expect_that(z - years(1), is_a("Date")) expect_that(x - dyears(1), is_a("POSIXct")) expect_that(y - dyears(1), is_a("POSIXlt")) expect_that(z - dyears(1), is_a("Date")) }) test_that("subtraction works as expected for periods",{ time1 <- as.POSIXct("2008-01-02 00:00:00", tz = "UTC") time2 <- as.POSIXct("2009-02-02 00:00:00", tz = "UTC") int <- interval(time1, time2) expect_equal(years(1) - 1, period(seconds = -1, years = 1)) expect_error(years(1) - as.POSIXct("2008-01-01 00:00:00", tz = "UTC")) expect_error(years(1) - as.POSIXct("2008-01-01 00:00:00", tz = "UTC")) expect_equal(years(1) - minutes(3), period(minutes = -3, years = 1)) expect_error(years(1) - dyears(1)) expect_error(years(1) - int) }) test_that("subtraction with periods returns correct class",{ expect_that(years(1) - 1, is_a("Period")) expect_that(years(1) - minutes(3), is_a("Period")) }) test_that("subtraction works as expected for durations",{ time1 <- as.POSIXct("2008-01-02 00:00:00", tz = "UTC") time2 <- as.POSIXct("2009-08-03 00:00:00", tz = "UTC") int <- interval(time1, time2) expect_equal(dyears(1) - 1, duration(31535999)) expect_error(dyears(1) - as.POSIXct("2008-01-01 00:00:00", tz = "UTC")) expect_error(dyears(1) - minutes(3)) expect_equal(dyears(2) - dyears(1), dyears(1)) expect_error(dyears(1) - int) }) test_that("subtraction with durations returns correct class",{ expect_that(dyears(1) - 1, is_a("Duration")) expect_that(dyears(1) - dyears(1), is_a("Duration")) }) test_that("subtraction works as expected for intervals",{ time1 <- as.POSIXct("2008-08-03 00:00:00", tz = "UTC") time2 <- as.POSIXct("2009-08-03 00:00:00", tz = "UTC") time3 <- as.POSIXct("2008-11-02 00:00:00", tz = "UTC") int <- interval(time1, time2) int2 <- interval(time3, time2) expect_error(time2 - int) expect_error(int - 1) expect_error(int - time1) expect_error(int - minutes(3)) expect_error(int - dminutes(3)) expect_error(int - int2) }) test_that("%m-% correctly subtracts months without rollover",{ may <- ymd_hms("2010-05-31 03:04:05") ends <- ymd_hms(c("2010-04-30 03:04:05", "2010-03-31 03:04:05", "2010-02-28 03:04:05")) expect_equal(may %m-% months(1:3), ends) }) test_that("%m-% correctly subtracts years without rollover",{ leap <- ymd("2012-02-29") next1 <- ymd("2011-02-28") next2 <- ymd("2011-01-29") next3 <- ymd("2011-03-29") expect_equal(leap %m-% years(1), next1) expect_equal(leap %m-% period(years = 1, months = 1), next2) expect_equal(leap %m-% period(years = 1, months = -1), next3) }) test_that("%m-% correctly subtract negative months without rollover",{ jan <- ymd_hms("2010-01-31 03:04:05") ends <- ymd_hms(c("2010-02-28 03:04:05", "2010-03-31 03:04:05", "2010-04-30 03:04:05")) expect_equal(jan %m-% -months(1:3), ends) }) test_that("%m-% correctly subtracts negative years without rollover",{ leap <- ymd("2012-02-29") next1 <- ymd("2013-02-28") next2 <- ymd("2013-03-29") next3 <- ymd("2013-01-29") expect_equal(leap %m-% years(-1), next1) expect_equal(leap %m-% period(years = -1, months = -1), next2) expect_equal(leap %m-% period(years = -1, months = 1), next3) }) lubridate/tests/testthat/test-daylight-savings.R0000644000175100001440000002046512705366146021643 0ustar hornikuserscontext("Daylight savings times") test_that("force_tz returns NA for a time that falls in the spring gap",{ x <- structure(1268532305, class = c("POSIXct", "POSIXt"), tzone = "UTC") y <- structure(1268618705, class = c("POSIXct", "POSIXt"), tzone = "UTC") z <- structure(1268633105, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") result <- is.na(force_tz(x, "America/New_York")) expect_true(result) expect_equal(force_tz(c(y, x), "America/New_York"), c(z, NA)) }) test_that("force_tz behaves consistently for the fall overlap",{ y <- structure(1289111405, tzone = "America/New_York", class = c("POSIXct", "POSIXt")) y2 <- structure(1289115005, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") y3 <- structure(1289104205, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") z <- structure(1289197805, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") z2 <- structure(1289201405, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") z3 <- structure(1289194205, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") cdst <- structure(1352012400, tzone = "America/Chicago", class = c("POSIXct", "POSIXt")) edst <- structure(1352008800, tzone = "America/New_York", class = c("POSIXct", "POSIXt")) expect_equal(y + hours(1), y2) expect_equal(c(y, z) + hours(1), c(y2, z2)) expect_equal(y - hours(1), y3) expect_equal(c(y, z) - hours(1), c(y3, z3)) expect_equal(force_tz(cdst, "America/New_York"), edst) }) test_that("addition handles daylight savings time for spring gap", { x <- structure(1268542800, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") px <- structure(1268625600, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") px2 <- structure(1268712000, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") ex <- structure(1268629200, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") ex2 <- structure(1268715600, tzone = "America/New_York", class = c("POSIXct", "POSIXt")) expect_equal(x + days(1), px) expect_equal(c(x, px) + days(1), c(px, px2)) expect_equal(x + ddays(1), ex) expect_equal(c(x, ex) + ddays(1), c(ex, ex2)) }) test_that("subtraction handles daylight savings time for spring gap", { x <- structure(1268625600, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") px <- structure(1268542800, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") px2 <- structure(1268456400, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") ex <- structure(1268539200, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") ex2 <- structure(1268452800, tzone = "America/New_York", class = c("POSIXct", "POSIXt")) expect_equal(x - days(1), px) expect_equal(c(x, px) - days(1), c(px, px2)) expect_equal(x - ddays(1), ex) expect_equal(c(x, ex) - ddays(1), c(ex, ex2)) }) test_that("addition handles daylight savings time for fall overlap", { x <- structure(1289102400, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") px <- structure(1289192400, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") px2 <- structure(1289278800, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") ex <- structure(1289188800, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") ex2 <- structure(1289275200, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") expect_equal(x + days(1), px) expect_equal(c(x, px) + days(1), c(px, px2)) expect_equal(x + ddays(1), ex) expect_equal(c(x, ex) + ddays(1), c(ex, ex2)) }) test_that("subtraction handles daylight savings time for fall overlap", { x <- structure(1289192400, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") px <- structure(1289102400, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") px2 <- structure(1289016000, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") ex <- structure(1289106000, tzone = "America/New_York", class = c("POSIXct", "POSIXt")) ex2 <- structure(1289019600, tzone = "America/New_York", class = c("POSIXct", "POSIXt")) expect_equal(x - days(1), px) expect_equal(c(x, px) - days(1), c(px, px2)) expect_equal(x - ddays(1), ex) expect_equal(c(x, ex) - ddays(1), c(ex, ex2)) }) test_that("update returns NA for date-times in the spring dst gap",{ poslt <- structure(list(sec = 59, min = 59L, hour = 1L, mday = 14L, mon = 2L, year = 110L, wday = 0L, yday = 72L, isdst = 0L), .Names = c("sec", "min", "hour", "mday", "mon", "year", "wday", "yday", "isdst"), class = c("POSIXlt", "POSIXt"), tzone = c("America/New_York", "EST", "EDT")) x <- structure(list(sec = 59, min = 59L, hour = 1L, mday = 15L, mon = 2L, year = 110L, wday = 1L, yday = 73L, isdst = 1L), .Names = c("sec", "min", "hour", "mday", "mon", "year", "wday", "yday", "isdst"), class = c("POSIXlt", "POSIXt"), tzone = c("America/New_York", "EST", "EDT")) x2 <- structure(list(sec = 59, min = 59L, hour = 2L, mday = 15L, mon = 2L, year = 110L, wday = 1L, yday = 73L, isdst = 1L), .Names = c("sec", "min", "hour", "mday", "mon", "year", "wday", "yday", "isdst"), class = c("POSIXlt", "POSIXt"), tzone = c("America/New_York", "EST", "EDT")) xu <- structure(list(sec = 59, min = 59L, hour = 2L, mday = 15L, mon = 2L, year = 110L, wday = 1L, yday = 73L, isdst = 1L), .Names = c("sec", "min", "hour", "mday", "mon", "year", "wday", "yday", "isdst"), class = c("POSIXlt", "POSIXt"), tzone = "UTC") expect_true(is.na(update(poslt, seconds = 61))) expect_true(is.na(update(poslt, minutes = 61))) expect_true(is.na(update(poslt, hours = 2))) expect_equal(update(c(x, poslt), hours = 2), c(x2, NA)) poslt <- structure(list(sec = 59, min = 59L, hour = 2L, mday = 13L, mon = 2L, year = 110L, wday = 6L, yday = 71L, isdst = 0L), .Names = c("sec", "min", "hour", "mday", "mon", "year", "wday", "yday", "isdst"), class = c("POSIXlt", "POSIXt"), tzone = c("America/New_York", "EST", "EDT")) expect_true(is.na(update(poslt, mday = 14))) expect_true(is.na(update(poslt, wday = 8))) expect_true(is.na(update(poslt, yday = 73))) poslt <- structure(list(sec = 59, min = 59L, hour = 2L, mday = 14L, mon = 1L, year = 110L, wday = 0L, yday = 44L, isdst = 0L), .Names = c("sec", "min", "hour", "mday", "mon", "year", "wday", "yday", "isdst"), class = c("POSIXlt", "POSIXt"), tzone = c("America/New_York", "EST", "EDT")) expect_true(is.na(update(poslt, months = 3))) poslt <- structure(list(sec = 59, min = 59L, hour = 2L, mday = 14L, mon = 2L, year = 109L, wday = 6L, yday = 72L, isdst = 0L), .Names = c("sec", "min", "hour", "mday", "mon", "year", "wday", "yday", "isdst"), class = c("POSIXlt", "POSIXt"), tzone = c("America/New_York", "EST", "EDT")) expect_true(is.na(update(poslt, years = 2010))) poslt <- structure(list(sec = 59, min = 59L, hour = 2L, mday = 14L, mon = 2L, year = 110L, wday = 0L, yday = 72L, isdst = 0L), .Names = c("sec", "min", "hour", "mday", "mon", "year", "wday", "yday", "isdst"), class = c("POSIXlt", "POSIXt"), tzone = "UTC") expect_true(is.na(update(poslt, tz = "America/New_York"))) expect_equal(update(c(xu, poslt), tz = "America/New_York"), c(x2, NA)) }) test_that("update rollovers perform correctly across the fall overlap",{ timest <- structure(1289113199, tzone = "America/New_York", class = c("POSIXct", "POSIXt")) posct <- structure(1289109659, tzone = "America/New_York", class = c("POSIXct", "POSIXt")) timest2 <- structure(1289116919, class = c("POSIXct", "POSIXt"), tzone = "America/New_York") timest3 <- structure(1289124119, tzone = "America/New_York", class = c("POSIXct", "POSIXt")) timest0 <- structure(1289116859, tzone = "America/New_York", class = c("POSIXct", "POSIXt")) expect_equal(update(timest, minutes = 121), timest2) expect_equal(update(c(timest, timest2), minutes = 121), c(timest2, timest3)) expect_equal(update(timest, minutes = 0), posct) expect_equal(update(c(timest, timest2), minutes = 0), c(posct, timest0)) }) test_that("arithmetic handles fall gap in timespan appropriate way", { cdst <- structure(1352012400, tzone = "America/Chicago", class = c("POSIXct", "POSIXt")) expect_equal(cdst - seconds(1), cdst - 3601) expect_equal(cdst - dseconds(1), cdst - 1) }) lubridate/tests/testthat/test-instants.R0000644000175100001440000000420312712650273020214 0ustar hornikuserscontext("instants") test_that("is.instant/is.timepoint works as expected",{ expect_that(is.instant(234), is_false()) expect_that(is.instant(as.POSIXct("2008-08-03 13:01:59", tz = "UTC")), is_true()) expect_that(is.instant(as.POSIXlt("2008-08-03 13:01:59", tz = "UTC")), is_true()) expect_that(is.instant(Sys.Date()), is_true()) expect_that(is.instant(minutes(1)), is_false()) expect_that(is.timespan(interval( as.POSIXct("2008-08-03 13:01:59", tz = "UTC"), as.POSIXct("2009-08-03 13:01:59", tz = "UTC") )), is_true()) }) test_that("is.instant/is.timepoint handle vectors",{ expect_that(is.instant(minutes(1:2)), is_false()) expect_that(is.instant(as.POSIXct(c("2008-08-03 13:01:59", "2008-08-03 13:01:59"), tz = "UTC")), is_true()) }) test_that("now() handles time zone input correctly",{ expect_identical(floor_date(now("UTC"), "minute"), floor_date(as.POSIXct(format( as.POSIXct(Sys.time()), tz = "UTC"), tz = "UTC"), "minute")) }) test_that("today() works correctly",{ expect_identical(today(), Sys.Date()) }) test_that("make_datetime returns same values as ISOdatetime", { set.seed(1000) N <- 1e4 y <- as.integer(runif(N, 1800, 2200)) m <- as.integer(runif(N, 1, 12)) d <- as.integer(runif(N, 1, 28)) H <- as.integer(runif(N, 0, 23)) M <- as.integer(runif(N, 0, 59)) S <- runif(N, 0, 59) out1 <- ISOdatetime(y, m, d, H, M, S, tz = "UTC") out2 <- make_datetime(y, m, d, H, M, S) expect_equal(out1, out2) S <- as.integer(runif(N, 0, 59)) out1 <- ISOdatetime(y, m, d, H, M, S, tz = "UTC") out2 <- make_datetime(y, m, d, H, M, S) expect_equal(out1, out2) out3 <- make_date(y, m, d) expect_equal(as.Date(out1), out3) }) test_that("make_datetime replicates as expected", { expect_equal(make_datetime(year = 1999, month = c(11, 12), day = 22, sec = c(10, 11)), as.POSIXct(c("1999-11-22 00:00:10 UTC", "1999-12-22 00:00:11 UTC"), tz = "UTC")) }) test_that("make_datetime propagates NAs as expected", { expect_equal(make_datetime(year = 1999, month = c(11, NA), day = 22, sec = c(10, 11, NA)), as.POSIXct(c("1999-11-22 00:00:10 UTC", NA, NA), tz = "UTC")) }) lubridate/tests/testthat/test-Dates.R0000644000175100001440000000225112705366146017417 0ustar hornikuserscontext("Dates") test_that("is.Date works as expected",{ expect_that(is.Date(234), is_false()) expect_that(is.Date(as.POSIXct("2008-08-03 13:01:59", tz = "UTC")), is_false()) expect_that(is.Date(as.POSIXlt("2008-08-03 13:01:59", tz = "UTC")), is_false()) expect_that(is.Date(Sys.Date()), is_true()) expect_that(is.Date(minutes(1)), is_false()) expect_that(is.Date(dminutes(1)), is_false()) expect_that(is.Date(interval( as.POSIXct("2008-08-03 13:01:59", tz = "UTC"), as.POSIXct("2009-08-03 13:01:59", tz = "UTC") )), is_false()) }) test_that("is.Date handles vectors",{ expect_that(is.Date(c(Sys.Date(), as.Date("2009-10-31"))), is_true()) }) test_that("as_date works", { dt1 <- as.POSIXct("2010-08-03 00:59:59.23") dt2 <- as.POSIXct("2010-08-03 00:59:59.23", tz="Europe/London") dt3 <- as.POSIXct("2010-11-03 00:59:59.23") dt4 <- as.POSIXct("2010-11-03 00:59:59.23", tz="Europe/London") expect_equal(as_date(dt1), as.Date("2010-08-03")) expect_equal(as_date(dt2), as.Date("2010-08-03")) expect_equal(as_date(dt3), as.Date("2010-11-03")) expect_equal(as_date(dt4), as.Date("2010-11-03")) expect_equal(as_date(10), ymd("1970-01-11")) }) lubridate/tests/testthat/test-ops-division.R0000644000175100001440000001254312755035722021005 0ustar hornikuserscontext("Division operators") test_that("division operations work for interval numerator",{ int <- ymd("2009-02-03") %--% ymd("2010-01-01") smaller_int <- ymd("2009-12-01") %--% ymd("2010-01-01") bigger_int <- ymd("2009-01-01") %--% ymd("2010-02-01") smaller_dur <- ddays(20) + dhours(4) bigger_dur <- dyears(1) + dseconds(2) smaller_diff <- make_difftime(days = 100) bigger_diff <- make_difftime(days = 400) expect_error(int/smaller_int) expect_error(int/bigger_int) expect_equal(int_start(int) + days(int/days(1)), int_end(int)) expect_equal(int_start(int) + ddays(int/ddays(1)), int_end(int)) expect_equal(int/smaller_diff, 28684800/8640000) expect_equal(int/bigger_diff, 28684800/34560000) }) test_that("division works for interval numerator with vectors",{ int1 <- ymd("2010-01-01") %--% ymd("2011-01-01") int2 <- ymd("2009-01-01") %--% ymd("2011-01-01") int3 <- ymd("2009-01-01") %--% ymd("2010-01-01") smaller_diff <- make_difftime(days = 365) expect_error(c(int1, int2) / int1) expect_error(int1/c(int1, int2)) expect_equal(c(int1, int2) / years(1), c(1,2)) expect_equal(c(int1, int2) / dyears(1), c(1,2)) expect_equal(int1/years(1:2), c(1, 0.5)) expect_equal(int1/dyears(1:2), c(1, 0.5)) expect_equal(c(int1, int2) / smaller_diff, c(1,2)) expect_equal(int2/c(1, 2), c(int2, int3)) expect_equal(c(int2, int2) / 2, c(int3, int3)) }) test_that("division works for interval numerator with period denominator",{ int1 <- ymd("2010-01-01") %--% ymd("2011-01-01") int2 <- ymd("2009-01-01") %--% ymd("2011-01-01") int3 <- ymd("2009-01-01") %--% ymd("2010-01-01") expect_equal(c(int1, int2) / days(1), time_length(c(int1, int2), "days")) expect_equal(c(int1, int2) / minutes(1), time_length(c(int1, int2), "mins")) expect_equal(c(int1, int2) / months(1), c(12, 24)) expect_equal(c(int1, int2) / months(6), c(2, 4)) expect_equal(c(int1, int2) / years(1), c(1, 2)) expect_equal(c(int1, int2) / years(2), c(.5, 1)) }) test_that("dividision works for interval vector with NAs",{ int1 <- ymd("2010-01-01") %--% ymd("2011-01-01") int2 <- ymd("2009-01-01") %--% ymd("2011-01-01") int3 <- ymd(NA, quiet = TRUE) %--% ymd(NA, quiet = TRUE) ints <- c(int1, int2, int3) nas <- as.numeric(c(NA,NA,NA)) expect_equal(suppressMessages(ints / years(1)), c(1,2,NA)) expect_equal(suppressMessages(ints / dyears(1)), c(1,2,NA)) expect_equal(suppressMessages(ints / years(NA)), nas) expect_equal(suppressMessages(ints / dyears(NA)), nas) }) test_that("division operations work for period numerator",{ int1 <- ymd("2009-01-01") %--% ymd("2010-01-01") expect_error(years(2) / int1) expect_equal(days(2) / hours(12), 4) expect_equal(years(1) / months(1), 12) expect_error(days(2) / dhours(12)) expect_error(days(1) / make_difftime(days = 1)) expect_equal(days(2) / 2, days(1)) }) test_that("division works for period numerator with vectors",{ int1 <- ymd("2010-01-01") %--% ymd("2011-01-01") int2 <- ymd("2009-01-01") %--% ymd("2011-01-01") expect_error(years(1:2) / int2) expect_error(years(1) / c(int1, int2)) expect_equal(days(1:2) / hours(12), c(2,4)) expect_equal(days(1) / hours(c(12, 24)), c(2,1)) expect_error(days(1:2) / dhours(12)) expect_error(days(1) / dhours(c(12, 24))) expect_error(days(1:2) / make_difftime(days = 1)) expect_equal(days(2) / c(1,2), c(days(2), days(1))) expect_equal(days(c(2,4)) / c(2), c(days(1), days(2))) }) test_that("division operations work for duration numerator",{ int <- ymd("2009-12-01") %--% ymd("2010-01-01") expect_error(ddays(31)/int) expect_error(ddays(20)/ days(20)) expect_equal(ddays(20)/ ddays(1), 20) expect_equal(ddays(20)/ make_difftime(days = 1), 20) }) test_that("division works for duration numerator with vectors",{ int1 <- ymd("2010-01-01") %--% ymd("2011-01-01") int2 <- ymd("2009-01-01") %--% ymd("2011-01-01") expect_error(ddays(365*c(1:2)) / int2) expect_error(ddays(365) / c(int1, int2)) expect_equal(ddays(1:2) / dhours(12), c(2,4)) expect_equal(ddays(1) / dhours(c(12, 24)), c(2,1)) expect_error(ddays(1:2) / hours(12)) expect_error(ddays(1) / hours(c(12, 24))) expect_equal(ddays(1:2) / make_difftime(days = 1), c(1,2)) expect_equal(ddays(2) / c(1,2), c(ddays(2), ddays(1))) expect_equal(ddays(c(2,4)) / c(2), c(ddays(1), ddays(2))) }) test_that("division operations work for difftime numerator",{ diff <- make_difftime(days = 365) int <- ymd("2010-01-01") %--% ymd("2011-01-01") expect_error(diff/int) expect_error(diff/days(1)) expect_equal(diff/ddays(365), 1) }) test_that("division works as expected for periods",{ expect_that(3/months(1), throws_error()) expect_that(months(1)/3, throws_error()) expect_that(months(9)/3, equals(months(3))) expect_that(months(9)/3, is_a("Period")) }) test_that("dividing vectors works for periods",{ expect_that(c(2,3)/months(1), throws_error()) expect_that(months(1)/c(2,3), throws_error()) expect_that(months(9)/c(3,1), equals(months(c(3,9)))) expect_that(months(9)/c(3,1), is_a("Period")) }) test_that("division works as expected for durations",{ expect_that(3/dhours(1), throws_error()) expect_that(dhours(9)/3, equals(dhours(3))) expect_that(dhours(9)/3, is_a("Duration")) }) test_that("dividing vectors works for durations",{ expect_that(c(2,3)/dhours(1), throws_error()) expect_that(dhours(9)/c(3,1), equals(dhours(c(3,9)))) expect_that(dhours(9)/c(3,1), is_a("Duration")) }) lubridate/tests/testthat/test-round.R0000644000175100001440000004627512765536372017532 0ustar hornikuserscontext("Rounding") test_that("floor_date works for each time element",{ x <- as.POSIXct("2009-08-03 12:01:59.23", tz = "UTC") expect_identical(floor_date(x, "second"), as.POSIXct( "2009-08-03 12:01:59", tz = "UTC")) expect_identical(floor_date(x, "minute"), as.POSIXct( "2009-08-03 12:01:00", tz = "UTC")) expect_identical(floor_date(x, "hour"), as.POSIXct( "2009-08-03 12:00:00", tz = "UTC")) expect_identical(floor_date(x, "day"), as.POSIXct( "2009-08-03 00:00:00", tz = "UTC")) expect_identical(floor_date(x, "week"), as.POSIXct( "2009-08-02 00:00:00", tz = "UTC")) expect_identical(floor_date(x, "month"), as.POSIXct( "2009-08-01 00:00:00", tz = "UTC")) expect_identical(floor_date(x, "bimonth"), as.POSIXct( "2009-07-01 00:00:00", tz = "UTC")) expect_identical(floor_date(x, "quarter"), as.POSIXct("2009-07-01 00:00:00", tz = "UTC")) expect_identical(floor_date(x, "halfyear"), as.POSIXct( "2009-07-01 00:00:00", tz = "UTC")) expect_identical(floor_date(x, "year"), as.POSIXct( "2009-01-01 00:00:00", tz = "UTC")) }) test_that("ceiling_date works with multi-units",{ x <- as.POSIXct("2009-08-03 12:01:59.23", tz = "UTC") }) test_that("floor_date works for multi-units",{ x <- as.POSIXct("2009-08-03 12:01:59.23", tz = "UTC") expect_identical(floor_date(x, "2 secs"), as.POSIXct("2009-08-03 12:01:58", tz = "UTC")) expect_identical(floor_date(x, "2s"), as.POSIXct("2009-08-03 12:01:58", tz = "UTC")) expect_identical(floor_date(x, "2 mins"), as.POSIXct("2009-08-03 12:00:00", tz = "UTC")) expect_identical(floor_date(x, "2M"), as.POSIXct("2009-08-03 12:00:00", tz = "UTC")) expect_identical(floor_date(x, "2 hours"), as.POSIXct("2009-08-03 12:00:00", tz = "UTC")) expect_identical(floor_date(x, "2h"), as.POSIXct("2009-08-03 12:00:00", tz = "UTC")) expect_identical(floor_date(x, "2 days"), as.POSIXct("2009-08-03 00:00:00", tz = "UTC")) expect_identical(floor_date(x, "3 days"), as.POSIXct("2009-08-01 00:00:00", tz = "UTC")) expect_identical(floor_date(x, "10 days"), as.POSIXct("2009-08-01 00:00:00", tz = "UTC")) expect_identical(floor_date(x, "10d"), as.POSIXct("2009-08-01 00:00:00", tz = "UTC")) ## expect_identical(floor_date(x, "2 week"), as.POSIXct("2009-08-xx 00:00:00", tz = "UTC")) expect_identical(floor_date(x, "2 month"), as.POSIXct("2009-07-01 00:00:00", tz = "UTC")) expect_identical(floor_date(x, "2m"), as.POSIXct("2009-07-01 00:00:00", tz = "UTC")) expect_identical(floor_date(x, "2 bimonth"), floor_date(x, "4 months")) expect_identical(floor_date(x, "2 quarter"), floor_date(x, "6 months")) expect_identical(floor_date(x, "2 halfyear"), floor_date(x, "year")) expect_identical(floor_date(x, "2 year"), as.POSIXct("2008-01-01 00:00:00", tz = "UTC")) }) test_that("multi-unit rounding works the same for POSIX and Date objects", { px <- ymd("2009-08-01", tz = "UTC") dt <- ymd("2009-08-01") expect_identical(floor_date(px, "5 mins"), floor_date(dt, "5 mins")) expect_identical(floor_date(px, "5 mins"), floor_date(dt, "5 mins")) expect_identical(ceiling_date(px + 0.0001, "5 mins"), ceiling_date(dt, "5 mins")) expect_identical(ceiling_date(px, "5 mins", change_on_boundary = T), ceiling_date(dt, "5 mins", change_on_boundary = T)) expect_identical(ceiling_date(px + 0.001, "5 hours"), ceiling_date(dt, "5 hours")) expect_identical(ceiling_date(px + 0.0001, "5 hours", change_on_boundary = T), ceiling_date(dt, "5 hours", change_on_boundary = T)) expect_identical(ceiling_date(px + 0.001, "2 hours"), ceiling_date(dt, "2 hours")) expect_identical(as_date(floor_date(px, "2 days")), floor_date(dt, "2 days")) expect_identical(as_date(ceiling_date(px + 0.001, "2 days")), ceiling_date(dt, "2 days")) expect_identical(as_date(floor_date(px, "5 days")), floor_date(dt, "5 days")) expect_identical(as_date(ceiling_date(px + 0.001, "5 days")), ceiling_date(dt, "5 days")) expect_identical(as_date(floor_date(px, "2 months")), floor_date(dt, "2 months")) expect_identical(as_date(ceiling_date(px, "2 months")), ceiling_date(dt, "2 months")) expect_identical(as_date(floor_date(px, "5 months")), floor_date(dt, "5 months")) expect_identical(as_date(ceiling_date(px, "5 months")), ceiling_date(dt, "5 months")) }) test_that("ceiling_date works for multi-units",{ x <- as.POSIXct("2009-08-03 12:01:59.23", tz = "UTC") y <- as.POSIXct("2009-08-03 12:01:30.23", tz = "UTC") z <- as.POSIXct("2009-08-24 12:01:30.23", tz = "UTC") expect_identical(ceiling_date(x, "2 secs"), as.POSIXct("2009-08-03 12:02:00", tz = "UTC")) expect_identical(ceiling_date(x, "3 secs"), as.POSIXct("2009-08-03 12:02:00", tz = "UTC")) expect_identical(ceiling_date(x, "5 secs"), as.POSIXct("2009-08-03 12:02:00", tz = "UTC")) expect_identical(ceiling_date(y, "2 secs"), as.POSIXct("2009-08-03 12:01:32", tz = "UTC")) expect_identical(ceiling_date(y, "3 secs"), as.POSIXct("2009-08-03 12:01:33", tz = "UTC")) expect_identical(ceiling_date(y, "5 secs"), as.POSIXct("2009-08-03 12:01:35", tz = "UTC")) expect_identical(ceiling_date(x, "2 mins"), as.POSIXct("2009-08-03 12:02:00", tz = "UTC")) expect_identical(ceiling_date(x, "3 mins"), as.POSIXct("2009-08-03 12:03:00", tz = "UTC")) expect_identical(ceiling_date(x, "5 mins"), as.POSIXct("2009-08-03 12:05:00", tz = "UTC")) expect_identical(ceiling_date(x, "2 hours"), as.POSIXct("2009-08-03 14:00:00", tz = "UTC")) expect_identical(ceiling_date(x, "3 hours"), as.POSIXct("2009-08-03 15:00:00", tz = "UTC")) expect_identical(ceiling_date(x, "2 days"), as.POSIXct("2009-08-05 00:00:00", tz = "UTC")) expect_identical(ceiling_date(x, "3 days"), as.POSIXct("2009-08-04 00:00:00", tz = "UTC")) expect_identical(ceiling_date(x, "10 days"), as.POSIXct("2009-08-11 00:00:00", tz = "UTC")) expect_identical(ceiling_date(z, "5 days"), as.POSIXct("2009-08-26 00:00:00", tz = "UTC")) expect_identical(ceiling_date(z, "10 days"), as.POSIXct("2009-08-31 00:00:00", tz = "UTC")) expect_identical(ceiling_date(x, "2 month"), as.POSIXct("2009-09-01 00:00:00", tz = "UTC")) expect_identical(ceiling_date(x, "2 bimonth"), ceiling_date(x, "4 months")) expect_identical(ceiling_date(x, "2 quarter"), ceiling_date(x, "6 months")) expect_identical(ceiling_date(x, "2 halfyear"), ceiling_date(x, "year")) expect_identical(ceiling_date(x, "2 year"), as.POSIXct("2010-01-01 00:00:00", tz = "UTC")) }) test_that("round_date works for each time element",{ x <- as.POSIXct("2009-08-03 12:01:59.23", tz = "UTC") expect_equal(round_date(x, "second"), as.POSIXct("2009-08-03 12:01:59", tz = "UTC")) expect_equal(round_date(x, "minute"), as.POSIXct("2009-08-03 12:02:00", tz = "UTC")) expect_equal(round_date(x, "hour"), as.POSIXct("2009-08-03 12:00:00", tz = "UTC")) expect_equal(round_date(x, "day"), as.POSIXct("2009-08-04 00:00:00", tz = "UTC")) expect_equal(round_date(x, "week"), as.POSIXct("2009-08-02 00:00:00", tz = "UTC")) expect_equal(round_date(x, "month"), as.POSIXct("2009-08-01 00:00:00", tz = "UTC")) expect_equal(round_date(x, "bimonth"), as.POSIXct("2009-09-01 00:00:00", tz = "UTC")) expect_equal(round_date(x, "quarter"), as.POSIXct("2009-07-01 00:00:00", tz = "UTC")) expect_equal(round_date(x, "halfyear"), as.POSIXct("2009-07-01 00:00:00", tz = "UTC")) expect_equal(round_date(x, "year"), as.POSIXct("2010-01-01 00:00:00", tz = "UTC")) }) test_that("round_date works for multi-units",{ x <- as.POSIXct("2009-08-03 12:01:59.23", tz = "UTC") expect_equal(round_date(x, "2 second"), as.POSIXct("2009-08-03 12:02:00", tz = "UTC")) expect_equal(round_date(x, "2 minute"), as.POSIXct("2009-08-03 12:02:00", tz = "UTC")) expect_equal(round_date(x, "3 mins"), as.POSIXct("2009-08-03 12:03:00", tz = "UTC")) expect_equal(round_date(x, "5 mins"), as.POSIXct("2009-08-03 12:00:00", tz = "UTC")) expect_equal(round_date(x, "2 hour"), as.POSIXct("2009-08-03 12:00:00", tz = "UTC")) expect_equal(round_date(x, "5 hour"), as.POSIXct("2009-08-03 10:00:00", tz = "UTC")) expect_equal(round_date(x, "2 days"), as.POSIXct("2009-08-03 00:00:00", tz = "UTC")) expect_equal(round_date(x, "2 months"), as.POSIXct("2009-09-01 00:00:00", tz = "UTC")) expect_equal(round_date(x, "bimonth"), round_date(x, "2 months")) expect_equal(round_date(x, "bimonth"), round_date(x, "4 months")) expect_equal(round_date(x, "quarter"), round_date(x, "3 months")) expect_equal(round_date(x, "halfyear"), round_date(x, "6 months")) expect_equal(round_date(x, "3 years"), as.POSIXct("2010-01-01 00:00:00", tz = "UTC")) expect_equal(round_date(x, "4 years"), as.POSIXct("2008-01-01 00:00:00", tz = "UTC")) }) test_that("floor_date handles vectors",{ x <- as.POSIXct(c("2009-08-03 12:01:59.23", "2010-08-03 12:01:59.23"), tz = "UTC") expect_identical(floor_date(x, "second"), as.POSIXct(c("2009-08-03 12:01:59", "2010-08-03 12:01:59"), tz = "UTC")) expect_identical(floor_date(x, "minute"), as.POSIXct(c("2009-08-03 12:01:00", "2010-08-03 12:01:00"), tz = "UTC")) expect_identical(floor_date(x, "hour"), as.POSIXct(c("2009-08-03 12:00:00", "2010-08-03 12:00:00"), tz = "UTC")) expect_identical(floor_date(x, "day"), as.POSIXct(c("2009-08-03 00:00:00", "2010-08-03 00:00:00"), tz = "UTC")) expect_identical(floor_date(x, "week"), as.POSIXct(c("2009-08-02 00:00:00", "2010-08-01 00:00:00"), tz = "UTC")) expect_identical(floor_date(x, "month"), as.POSIXct(c("2009-08-01 00:00:00", "2010-08-01 00:00:00"), tz = "UTC")) expect_identical(floor_date(x, "year"), as.POSIXct(c("2009-01-01 00:00:00", "2010-01-01 00:00:00"), tz = "UTC")) }) test_that("ceiling_date handles vectors",{ x <- as.POSIXct(c("2009-08-03 12:01:59.23", "2010-08-03 12:01:59.23"), tz = "UTC") expect_identical(ceiling_date(x, "second"), as.POSIXct(c("2009-08-03 12:02:00", "2010-08-03 12:02:00"), tz = "UTC")) expect_identical(ceiling_date(x, "minute"), as.POSIXct(c( "2009-08-03 12:02:00", "2010-08-03 12:02:00"), tz = "UTC")) expect_identical(ceiling_date(x, "hour"), as.POSIXct(c("2009-08-03 13:00:00", "2010-08-03 13:00:00"), tz = "UTC")) expect_identical(ceiling_date(x, "day"), as.POSIXct(c( "2009-08-04 00:00:00", "2010-08-04 00:00:00"), tz = "UTC")) expect_identical(ceiling_date(x, "week"), as.POSIXct(c("2009-08-09 00:00:00", "2010-08-08 00:00:00"), tz = "UTC")) expect_identical(ceiling_date(x, "month"), as.POSIXct(c("2009-09-01 00:00:00", "2010-09-01 00:00:00"), tz = "UTC")) expect_identical(ceiling_date(x, "year"), as.POSIXct(c("2010-01-01 00:00:00", "2011-01-01 00:00:00"), tz = "UTC")) }) test_that("round_date handles vectors",{ x <- as.POSIXct(c("2009-08-03 12:01:59.23", "2010-08-03 12:01:59.23"), tz = "UTC") expect_identical(round_date(x, "second"), as.POSIXct(c("2009-08-03 12:01:59", "2010-08-03 12:01:59"), tz = "UTC")) expect_identical(round_date(x, "minute"), as.POSIXct(c("2009-08-03 12:02:00", "2010-08-03 12:02:00"), tz = "UTC")) expect_identical(round_date(x, "hour"), as.POSIXct(c("2009-08-03 12:00:00", "2010-08-03 12:00:00"), tz = "UTC")) expect_identical(round_date(x, "day"), as.POSIXct(c("2009-08-04 00:00:00", "2010-08-04 00:00:00"), tz = "UTC")) expect_identical(round_date(x, "week"), as.POSIXct(c("2009-08-02 00:00:00", "2010-08-01 00:00:00"), tz = "UTC")) expect_identical(round_date(x, "month"), as.POSIXct(c("2009-08-01 00:00:00", "2010-08-01 00:00:00"), tz = "UTC")) expect_identical(round_date(x, "year"), as.POSIXct(c("2010-01-01 00:00:00", "2011-01-01 00:00:00"), tz = "UTC")) }) test_that("floor_date works for a variety of formats",{ x <- as.POSIXct("2009-08-03 12:01:59", tz = "UTC") expect_equal(floor_date(x, "minute"), as.POSIXct("2009-08-03 12:01:00", tz = "UTC")) expect_equal(floor_date(as.Date(x), "month"), as.Date("2009-08-01")) expect_equal(floor_date(as.Date(x), "bimonth"), ymd("2009-07-01")) expect_equal(floor_date(as.Date(x), "quarter"), ymd("2009-07-01")) expect_equal(floor_date(as.Date(x), "halfyear"), ymd("2009-07-01")) expect_equal(floor_date(as.POSIXlt(x), "minute"), as.POSIXlt(as.POSIXct("2009-08-03 12:01:00", tz = "UTC"))) }) test_that("ceiling_date works for a variety of formats",{ x <- as.POSIXct("2009-08-03 12:01:59", tz = "UTC") expect_equal(ceiling_date(x, "minute"), as.POSIXct("2009-08-03 12:02:00", tz = "UTC")) expect_equal(ceiling_date(as.Date(x), "month"), as.Date("2009-09-01")) expect_equal(ceiling_date(as.Date(x), "bimonth"), ymd("2009-09-01")) expect_equal(ceiling_date(as.Date(x), "quarter"), ymd("2009-10-01")) expect_equal(ceiling_date(as.Date(x), "halfyear"), ymd("2010-01-01")) expect_equal(ceiling_date(as.POSIXlt(x), "minute"), as.POSIXlt(as.POSIXct("2009-08-03 12:02:00", tz = "UTC"))) }) test_that("round_date works for a variety of formats",{ x <- as.POSIXct("2009-08-03 12:01:59", tz = "UTC") expect_equal(round_date(x, "minute"), as.POSIXct("2009-08-03 12:02:00", tz = "UTC")) expect_equal(round_date(as.Date(x), "month"), as.Date("2009-08-01")) expect_equal(round_date(as.POSIXlt(x), "minute"), as.POSIXlt(as.POSIXct("2009-08-03 12:02:00", tz = "UTC"))) }) test_that("rounding works across DST",{ ## https://github.com/hadley/lubridate/issues/399 tt <- ymd("2016-03-27", tz="Europe/Helsinki"); expect_equal(ceiling_date(tt, 'month'), as.POSIXct("2016-04-01", tz = "Europe/Helsinki")) expect_equal(ceiling_date(tt, 'day'), as.POSIXct("2016-03-27", tz = "Europe/Helsinki")) tt <- ymd("2016-03-28", tz="Europe/Helsinki"); expect_equal(floor_date(tt, 'month'), as.POSIXct("2016-03-01", tz = "Europe/Helsinki")) tt <- ymd_hms("2016-03-27 05:00:00", tz="Europe/Helsinki"); expect_equal(floor_date(tt, 'day'), as.POSIXct("2016-03-27", tz = "Europe/Helsinki")) }) test_that("Ceiling for partials (Date) rounds up on boundary", { expect_identical(ceiling_date(as.Date("2012-09-27"), 'day'), ymd("2012-09-28")) expect_identical(ceiling_date(as.Date("2012-09-01"), 'day'), ymd("2012-09-02")) expect_identical(ceiling_date(as.Date("2012-09-01"), '2 days'), ymd("2012-09-03")) }) test_that("ceiling_date does not round up dates that are already on a boundary",{ expect_equal(ceiling_date(ymd_hms("2012-09-01 00:00:00"), 'month'), as.POSIXct("2012-09-01", tz = "UTC")) expect_equal(ceiling_date(ymd_hms("2012-01-01 00:00:00"), 'year'), as.POSIXct("2012-01-01", tz = "UTC")) expect_equal(ceiling_date(ymd_hms("2012-01-01 00:00:00"), '2 year'), as.POSIXct("2012-01-01", tz = "UTC")) expect_equal(ceiling_date(ymd_hms("2012-01-01 00:00:00"), '3 year'), as.POSIXct("2013-01-01", tz = "UTC")) expect_equal(ceiling_date(ymd_hms("2012-01-01 00:00:00"), '5 year'), as.POSIXct("2015-01-01", tz = "UTC")) expect_equal(ceiling_date(ymd_hms("2012-01-01 01:00:00"), 'second'), ymd_hms("2012-01-01 01:00:00")) expect_equal(ceiling_date(ymd_hms("2012-01-01 01:00:00"), '2 second'), ymd_hms("2012-01-01 01:00:00")) expect_equal(ceiling_date(ymd_hms("2012-01-01 01:00:00"), '2 second', change_on_boundary = T), ymd_hms("2012-01-01 01:00:02")) expect_equal(ceiling_date(ymd_hms("2012-01-01 01:00:00"), '5 second'), ymd_hms("2012-01-01 01:00:00")) expect_equal(ceiling_date(ymd_hms("2012-01-01 00:00:00"), 'bimonth'), ymd_hms("2012-01-01 00:00:00")) }) test_that("ceiling_date does round up dates on a boundary with change_on_boundary=TRUE",{ expect_equal(ceiling_date(as.Date("2012-09-27"), 'day', TRUE), as.Date("2012-09-28")) expect_equal(ceiling_date(as.Date("2012-09-01"), 'month', TRUE), as.Date("2012-10-01")) expect_equal(ceiling_date(ymd_hms("2012-09-01 00:00:00"), 'month', TRUE), ymd("2012-10-01", tz = "UTC")) expect_equal(ceiling_date(ymd_hms("2012-09-01 00:00:00"), 'bimonth', TRUE), ymd("2012-11-01", tz = "UTC")) expect_equal(ceiling_date(ymd_hms("2012-01-01 00:00:00"), 'year', TRUE), as.POSIXct("2013-01-01", tz = "UTC")) expect_equal(ceiling_date(ymd_hms("2012-01-01 01:00:00"), 'hour', TRUE), ymd_hms("2012-01-01 02:00:00")) expect_equal(ceiling_date(ymd_hms("2012-01-01 00:00:00"), 'day', TRUE), ymd("2012-01-02", tz = "UTC")) expect_equal(ceiling_date(ymd_hms("2012-01-01 01:00:00"), 'second', TRUE), ymd_hms("2012-01-01 01:00:01")) }) test_that("floor_date does not round down dates that are already on a boundary",{ expect_equal(floor_date(as.Date("2012-09-27"), 'day'), as.Date("2012-09-27")) }) test_that("round_date does not round dates that are already on a boundary",{ expect_equal(round_date(as.Date("2012-09-27"), 'day'), as.Date("2012-09-27")) }) test_that("ceiling_date returns input of length zero when given input of length zero",{ x <- structure(vector(mode = "numeric"), class = c("POSIXct", "POSIXt")) expect_equal(ceiling_date(x), x) }) test_that("floor_date returns input of length zero when given input of length zero",{ x <- structure(vector(mode = "numeric"), class = c("POSIXct", "POSIXt")) expect_equal(floor_date(x), x) }) test_that("round_date returns input of length zero when given input of length zero",{ x <- structure(vector(mode = "numeric"), class = c("POSIXct", "POSIXt")) expect_equal(round_date(x), x) }) test_that("round_date behaves correctly on 60th second", { ## (bug #217) x <- ymd_hms('2013-12-01 23:59:59.9999') expect_equal(round_date(x, unit = "second"), ymd("2013-12-02", tz = "UTC")) second(x) <- 60 expect_equal(x, ymd("2013-12-02", tz = "UTC")) }) test_that("round_date and ceiling_date skip day time gap", { ## (#240) tz <- "Europe/Amsterdam" times <- ymd_hms("2013-03-31 01:00:00 CET", "2013-03-31 01:15:00 CEST", "2013-03-31 01:30:00 CEST", "2013-03-31 01:45:00 CEST", "2013-03-31 03:00:00 CEST", "2013-03-31 03:15:00 CEST", tz = tz) round <- ymd_hms("2013-03-31 01:00:00 CET", "2013-03-31 01:00:00 CEST", "2013-03-31 03:00:00 CEST", "2013-03-31 03:00:00 CEST", "2013-03-31 03:00:00 CEST", "2013-03-31 03:00:00 CEST", tz = tz) expect_equal(round_date(times, "hour"), round) ceiling <- ymd_hms("2013-03-31 01:00:00 CET", "2013-03-31 03:00:00 CEST", "2013-03-31 03:00:00 CEST", "2013-03-31 03:00:00 CEST", "2013-03-31 03:00:00 CEST", "2013-03-31 04:00:00 CEST", tz = tz) expect_equal(ceiling_date(times, "hour"), ceiling) tz <- "America/Chicago" x <- ymd_hms(c("2014-03-09 00:00:00", "2014-03-09 00:29:59", "2014-03-09 00:30:00", "2014-03-09 00:59:59", "2014-03-09 01:35:00", "2014-03-09 03:15:00", "2014-11-02 00:30:00", "2014-11-02 00:59:59", "2014-11-02 01:35:00", "2014-11-02 02:15:00", "2014-11-02 02:45:00"), tz = tz) y <- as.POSIXct(c("2014-03-09 00:00:00", "2014-03-09 00:00:00", "2014-03-09 01:00:00", "2014-03-09 01:00:00", "2014-03-09 03:00:00", "2014-03-09 03:00:00", "2014-11-02 01:00:00", "2014-11-02 01:00:00", "2014-11-02 02:00:00", "2014-11-02 02:00:00", "2014-11-02 03:00:00"), tz = tz) expect_equal(round_date(x, "hour"), y) }) lubridate/tests/testthat/test-settors.R0000644000175100001440000007546612705366146020104 0ustar hornikuserscontext("Settors") test_that("seconds settor correctly performs simple updates",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) second(poslt) <- 10 second(posct) <- 10 second(date) <- 10 expect_that(second(poslt), equals(10)) expect_that(second(posct), equals(10)) expect_that(second(date), equals(10)) }) test_that("seconds settor rolls over as expected",{ poslt <- as.POSIXlt("2010-12-31 23:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) second(poslt) <- 69 second(posct) <- 69 second(date) <- 69 expect_that(second(poslt), equals(9)) expect_that(minute(poslt), equals(0)) expect_that(hour(poslt), equals(0)) expect_that(mday(poslt), equals(1)) expect_that(wday(poslt), equals(7)) expect_that(yday(poslt), equals(1)) expect_that(month(poslt), equals(1)) expect_that(year(poslt), equals(2011)) expect_that(tz(poslt), equals("UTC")) expect_that(second(posct), equals(9)) expect_that(minute(posct), equals(0)) expect_that(hour(posct), equals(0)) expect_that(mday(posct), equals(1)) expect_that(wday(posct), equals(7)) expect_that(yday(posct), equals(1)) expect_that(month(posct), equals(1)) expect_that(year(posct), equals(2011)) expect_that(tz(posct), equals("UTC")) expect_that(second(date), equals(9)) expect_that(minute(date), equals(1)) expect_that(hour(date), equals(0)) expect_that(mday(date), equals(31)) expect_that(wday(date), equals(6)) expect_that(yday(date), equals(365)) expect_that(month(date), equals(12)) expect_that(year(date), equals(2010)) expect_that(tz(date), equals("UTC")) }) test_that("seconds settor does not change time zone",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) second(poslt) <- 1 second(posct) <- 1 second(date) <- 1 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) second(poslt) <- 69 second(posct) <- 69 second(date) <- 69 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) }) test_that("seconds settor returns NA for spring dst gap",{ poslt <- as.POSIXlt("2010-03-14 01:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") posxct <- as.POSIXct(poslt) second(poslt) <- 69 second(posxct) <- 69 expect_true(is.na(poslt)) expect_true(is.na(posxct)) }) test_that("seconds settor retains object class",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) second(poslt) <- 10 second(posct) <- 10 day(date) <- 10 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) second(poslt) <- 70 second(posct) <- 70 day(date) <- 32 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) }) test_that("minutes settor correctly performs simple updates",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) minute(poslt) <- 10 minute(posct) <- 10 minute(date) <- 10 expect_that(minute(poslt), equals(10)) expect_that(minute(posct), equals(10)) expect_that(minute(date), equals(10)) }) test_that("minutes settor rolls over as expected",{ poslt <- as.POSIXlt("2010-12-31 23:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) minute(poslt) <- 69 minute(posct) <- 69 minute(date) <- 69 expect_that(second(poslt), equals(59)) expect_that(minute(poslt), equals(9)) expect_that(hour(poslt), equals(0)) expect_that(mday(poslt), equals(1)) expect_that(wday(poslt), equals(7)) expect_that(yday(poslt), equals(1)) expect_that(month(poslt), equals(1)) expect_that(year(poslt), equals(2011)) expect_that(tz(poslt), equals("UTC")) expect_that(second(posct), equals(59)) expect_that(minute(posct), equals(9)) expect_that(hour(posct), equals(0)) expect_that(mday(posct), equals(1)) expect_that(wday(posct), equals(7)) expect_that(yday(posct), equals(1)) expect_that(month(posct), equals(1)) expect_that(year(posct), equals(2011)) expect_that(tz(posct), equals("UTC")) expect_that(second(date), equals(0)) expect_that(minute(date), equals(9)) expect_that(hour(date), equals(1)) expect_that(mday(date), equals(31)) expect_that(wday(date), equals(6)) expect_that(yday(date), equals(365)) expect_that(month(date), equals(12)) expect_that(year(date), equals(2010)) expect_that(tz(date), equals("UTC")) }) test_that("minutes settor does not change time zone",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) minute(poslt) <- 1 minute(posct) <- 1 minute(date) <- 1 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) minute(poslt) <- 70 minute(posct) <- 70 minute(date) <- 70 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) }) test_that("minutes settor returns NA for spring dst gap",{ poslt <- as.POSIXlt("2010-03-14 01:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") posct <- as.POSIXct(poslt) minute(poslt) <- 70 minute(posct) <- 70 expect_that(is.na(poslt), is_true()) expect_that(is.na(posct), is_true()) }) test_that("minutes settor retains object class",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) minute(poslt) <- 1 minute(posct) <- 1 minute(date) <- 1 expect_that("minute<-"(poslt, 1), is_a("POSIXlt")) expect_that("minute<-"(posct, 1), is_a("POSIXct")) expect_that("minute<-"(date, 1), is_a("POSIXlt")) minute(poslt) <- 70 minute(posct) <- 70 minute(date) <- 70 expect_that("minute<-"(poslt, 70), is_a("POSIXlt")) expect_that("minute<-"(posct, 70), is_a("POSIXct")) expect_that("minute<-"(date, 70), is_a("POSIXlt")) }) test_that("hours settor correctly performs simple updates",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) hour(poslt) <- 10 hour(posct) <- 10 hour(date) <- 10 expect_that(hour(poslt), equals(10)) expect_that(hour(posct), equals(10)) expect_that(hour(date), equals(10)) }) test_that("hours settor rolls over as expected",{ poslt <- as.POSIXlt("2010-12-31 23:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) hour(poslt) <- 25 hour(posct) <- 25 hour(date) <- 25 expect_that(second(poslt), equals(59)) expect_that(minute(poslt), equals(59)) expect_that(hour(poslt), equals(1)) expect_that(mday(poslt), equals(1)) expect_that(wday(poslt), equals(7)) expect_that(yday(poslt), equals(1)) expect_that(month(poslt), equals(1)) expect_that(year(poslt), equals(2011)) expect_that(tz(poslt), equals("UTC")) expect_that(second(posct), equals(59)) expect_that(minute(posct), equals(59)) expect_that(hour(posct), equals(1)) expect_that(mday(posct), equals(1)) expect_that(wday(posct), equals(7)) expect_that(yday(posct), equals(1)) expect_that(month(posct), equals(1)) expect_that(year(posct), equals(2011)) expect_that(tz(posct), equals("UTC")) expect_that(second(date), equals(0)) expect_that(minute(date), equals(0)) expect_that(hour(date), equals(1)) expect_that(mday(date), equals(1)) expect_that(wday(date), equals(7)) expect_that(yday(date), equals(1)) expect_that(month(date), equals(01)) expect_that(year(date), equals(2011)) expect_that(tz(date), equals("UTC")) }) test_that("hours settor does not change time zone",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) hour(poslt) <- 1 hour(posct) <- 1 hour(date) <- 1 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) hour(poslt) <- 70 hour(posct) <- 70 hour(date) <- 70 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) }) test_that("hours settor returns NA for spring dst gap",{ poslt <- as.POSIXlt("2010-03-14 01:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") posct <- as.POSIXct(poslt) hour(poslt) <- 2 hour(posct) <- 2 expect_that(is.na(poslt), is_true()) expect_that(is.na(posct), is_true()) }) test_that("hours settor retains object class",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) hour(poslt) <- 2 hour(posct) <- 2 hour(date) <- 2 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("POSIXlt")) hour(poslt) <- 25 hour(posct) <- 25 hour(date) <- 25 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("POSIXlt")) }) test_that("mdays settor correctly performs simple updates",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) mday(poslt) <- 10 mday(posct) <- 10 mday(date) <- 10 expect_that(mday(poslt), equals(10)) expect_that(mday(posct), equals(10)) expect_that(mday(date), equals(10)) expect_that(yday(poslt), equals(41)) expect_that(yday(posct), equals(41)) expect_that(yday(date), equals(41)) expect_that(wday(poslt), equals(4)) expect_that(wday(posct), equals(4)) expect_that(wday(date), equals(4)) }) test_that("mdays settor rolls over as expected",{ poslt <- as.POSIXlt("2010-12-31 23:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) mday(poslt) <- 32 mday(posct) <- 32 mday(date) <- 32 expect_that(second(poslt), equals(59)) expect_that(minute(poslt), equals(59)) expect_that(hour(poslt), equals(23)) expect_that(mday(poslt), equals(1)) expect_that(wday(poslt), equals(7)) expect_that(yday(poslt), equals(1)) expect_that(month(poslt), equals(1)) expect_that(year(poslt), equals(2011)) expect_that(tz(poslt), equals("UTC")) expect_that(second(posct), equals(59)) expect_that(minute(posct), equals(59)) expect_that(hour(posct), equals(23)) expect_that(mday(posct), equals(1)) expect_that(wday(posct), equals(7)) expect_that(yday(posct), equals(1)) expect_that(month(posct), equals(1)) expect_that(year(posct), equals(2011)) expect_that(tz(posct), equals("UTC")) expect_that(second(date), equals(0)) expect_that(minute(date), equals(0)) expect_that(hour(date), equals(0)) expect_that(mday(date), equals(1)) expect_that(wday(date), equals(7)) expect_that(yday(date), equals(1)) expect_that(month(date), equals(1)) expect_that(year(date), equals(2011)) expect_that(tz(date), equals("UTC")) }) test_that("mdays settor does not change time zone",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) mday(poslt) <- 1 mday(posct) <- 1 mday(date) <- 1 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) mday(poslt) <- 32 mday(posct) <- 32 mday(date) <- 32 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) }) test_that("mdays settor returns NA for spring dst gap",{ poslt <- as.POSIXlt("2010-03-13 02:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") posct <- as.POSIXct(poslt) mday(poslt) <- 14 mday(posct) <- 14 expect_that(is.na(poslt), is_true()) expect_that(is.na(posct), is_true()) }) test_that("mdays settor retains object class",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) mday(poslt) <- 3 mday(posct) <- 3 mday(date) <- 3 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) mday(poslt) <- 32 mday(posct) <- 32 mday(date) <- 32 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) }) test_that("ydays settor correctly performs simple updates",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) yday(poslt) <- 41 yday(posct) <- 41 yday(date) <- 41 expect_that(yday(poslt), equals(41)) expect_that(yday(posct), equals(41)) expect_that(yday(date), equals(41)) expect_that(mday(poslt), equals(10)) expect_that(mday(posct), equals(10)) expect_that(mday(date), equals(10)) expect_that(wday(poslt), equals(4)) expect_that(wday(posct), equals(4)) expect_that(wday(date), equals(4)) }) test_that("ydays settor rolls over as expected",{ poslt <- as.POSIXlt("2010-12-31 23:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) yday(poslt) <- 366 yday(posct) <- 366 yday(date) <- 366 expect_that(second(poslt), equals(59)) expect_that(minute(poslt), equals(59)) expect_that(hour(poslt), equals(23)) expect_that(mday(poslt), equals(1)) expect_that(wday(poslt), equals(7)) expect_that(yday(poslt), equals(1)) expect_that(month(poslt), equals(1)) expect_that(year(poslt), equals(2011)) expect_that(tz(poslt), equals("UTC")) expect_that(second(posct), equals(59)) expect_that(minute(posct), equals(59)) expect_that(hour(posct), equals(23)) expect_that(mday(posct), equals(1)) expect_that(wday(posct), equals(7)) expect_that(yday(posct), equals(1)) expect_that(month(posct), equals(1)) expect_that(year(posct), equals(2011)) expect_that(tz(posct), equals("UTC")) expect_that(second(date), equals(0)) expect_that(minute(date), equals(0)) expect_that(hour(date), equals(0)) expect_that(mday(date), equals(1)) expect_that(wday(date), equals(7)) expect_that(yday(date), equals(1)) expect_that(month(date), equals(1)) expect_that(year(date), equals(2011)) expect_that(tz(date), equals("UTC")) }) test_that("ydays settor does not change time zone",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) yday(poslt) <- 1 yday(posct) <- 1 yday(date) <- 1 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) yday(poslt) <- 366 yday(posct) <- 366 yday(date) <- 366 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) }) test_that("ydays settor returns NA for spring dst gap",{ poslt <- as.POSIXlt("2010-03-13 02:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") posct <- as.POSIXct(poslt) yday(poslt) <- 73 yday(posct) <- 73 expect_that(is.na(poslt), is_true()) expect_that(is.na(posct), is_true()) }) test_that("ydays settor retains object class",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) yday(poslt) <- 3 yday(posct) <- 3 yday(date) <- 3 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) yday(poslt) <- 366 yday(posct) <- 366 yday(date) <- 366 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) }) test_that("wdays settor correctly performs simple updates",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) wday(poslt) <- 5 wday(posct) <- 5 wday(date) <- 5 expect_that(wday(poslt), equals(5)) expect_that(wday(posct), equals(5)) expect_that(wday(date), equals(5)) expect_that(mday(poslt), equals(4)) expect_that(mday(posct), equals(4)) expect_that(mday(date), equals(4)) expect_that(mday(poslt), equals(4)) expect_that(mday(posct), equals(4)) expect_that(mday(date), equals(4)) }) test_that("wdays settor rolls over as expected",{ poslt <- as.POSIXlt("2010-12-31 23:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) wday(poslt) <- 8 wday(posct) <- 8 wday(date) <- 8 expect_that(second(poslt), equals(59)) expect_that(minute(poslt), equals(59)) expect_that(hour(poslt), equals(23)) expect_that(mday(poslt), equals(2)) expect_that(wday(poslt), equals(1)) expect_that(yday(poslt), equals(2)) expect_that(month(poslt), equals(1)) expect_that(year(poslt), equals(2011)) expect_that(tz(poslt), equals("UTC")) expect_that(second(posct), equals(59)) expect_that(minute(posct), equals(59)) expect_that(hour(posct), equals(23)) expect_that(mday(posct), equals(2)) expect_that(wday(posct), equals(1)) expect_that(yday(posct), equals(2)) expect_that(month(posct), equals(1)) expect_that(year(posct), equals(2011)) expect_that(tz(posct), equals("UTC")) expect_that(second(date), equals(0)) expect_that(minute(date), equals(0)) expect_that(hour(date), equals(0)) expect_that(mday(date), equals(2)) expect_that(wday(date), equals(1)) expect_that(yday(date), equals(2)) expect_that(month(date), equals(1)) expect_that(year(date), equals(2011)) expect_that(tz(date), equals("UTC")) }) test_that("wdays settor does not change time zone",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) wday(poslt) <- 2 wday(posct) <- 2 wday(date) <- 2 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) wday(poslt) <- 8 wday(posct) <- 8 wday(date) <- 8 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) }) test_that("wdays settor returns NA for spring dst gap",{ poslt <- as.POSIXlt("2010-03-13 02:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") posct <- as.POSIXct(poslt) wday(poslt) <- 8 wday(posct) <- 8 expect_that(is.na(poslt), is_true()) expect_that(is.na(posct), is_true()) }) test_that("wdays settor retains object class",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) wday(poslt) <- 3 wday(posct) <- 3 wday(date) <- 3 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) wday(poslt) <- 8 wday(posct) <- 8 wday(date) <- 8 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) }) test_that("months settor correctly performs simple updates",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) month(poslt) <- 5 month(posct) <- 5 month(date) <- 5 expect_that(month(poslt), equals(5)) expect_that(month(posct), equals(5)) expect_that(month(date), equals(5)) }) test_that("months settor rolls over as expected",{ poslt <- as.POSIXlt("2010-12-31 23:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) month(poslt) <- 13 month(posct) <- 13 month(date) <- 13 expect_that(second(poslt), equals(59)) expect_that(minute(poslt), equals(59)) expect_that(hour(poslt), equals(23)) expect_that(mday(poslt), equals(31)) expect_that(wday(poslt), equals(2)) expect_that(yday(poslt), equals(31)) expect_that(month(poslt), equals(1)) expect_that(year(poslt), equals(2011)) expect_that(tz(poslt), equals("UTC")) expect_that(second(posct), equals(59)) expect_that(minute(posct), equals(59)) expect_that(hour(posct), equals(23)) expect_that(mday(posct), equals(31)) expect_that(wday(posct), equals(2)) expect_that(yday(posct), equals(31)) expect_that(month(posct), equals(1)) expect_that(year(posct), equals(2011)) expect_that(tz(posct), equals("UTC")) expect_that(second(date), equals(0)) expect_that(minute(date), equals(0)) expect_that(hour(date), equals(0)) expect_that(mday(date), equals(31)) expect_that(wday(date), equals(2)) expect_that(yday(date), equals(31)) expect_that(month(date), equals(1)) expect_that(year(date), equals(2011)) expect_that(tz(date), equals("UTC")) }) test_that("months settor does not change time zone",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) month(poslt) <- 1 month(posct) <- 1 month(date) <- 1 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) month(poslt) <- 13 month(posct) <- 13 month(date) <- 13 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) }) test_that("months settor returns NA for spring dst gap",{ poslt <- as.POSIXlt("2010-02-14 02:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") posct <- as.POSIXct(poslt) month(poslt) <- 3 month(posct) <- 3 expect_that(is.na(poslt), is_true()) expect_that(is.na(posct), is_true()) }) test_that("months settor retains object class",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) month(poslt) <- 1 month(posct) <- 1 month(date) <- 1 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) month(poslt) <- 13 month(posct) <- 13 month(date) <- 13 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) }) test_that("years settor correctly performs simple updates",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) year(poslt) <- 2000 year(posct) <- 2000 year(date) <- 2000 expect_that(year(poslt), equals(2000)) expect_that(year(posct), equals(2000)) expect_that(year(date), equals(2000)) }) test_that("years settor does not change time zone",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) year(poslt) <- 2000 year(posct) <- 2000 year(date) <- 2000 expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) }) test_that("years settor returns NA for spring dst gap",{ poslt <- as.POSIXlt("2009-03-14 02:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") posct <- as.POSIXct(poslt) year(poslt) <- 2010 year(posct) <- 2010 expect_that(is.na(poslt), is_true()) expect_that(is.na(posct), is_true()) }) test_that("years settor retains object class",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) year(poslt) <- 2000 year(posct) <- 2000 year(date) <- 2000 expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) }) test_that("dates settor correctly performs simple updates",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) date(poslt) <- as.Date("2000-01-01") date(posct) <- as.Date("2000-01-01") date(date) <- as.Date("2000-01-01") expect_that(date(poslt), equals(as.Date("2000-01-01"))) expect_that(date(posct), equals(as.Date("2000-01-01"))) expect_that(date(date), equals(as.Date("2000-01-01"))) }) test_that("dates settor does not change time zone",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) date(poslt) <- as.Date("2000-01-01") date(posct) <- as.Date("2000-01-01") date(date) <- as.Date("2000-01-01") expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) }) test_that("dates settor returns NA for spring dst gap",{ poslt <- as.POSIXlt("2009-03-14 02:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") posct <- as.POSIXct(poslt) date(poslt) <- as.Date("2010-03-14") date(posct) <- as.Date("2010-03-14") expect_that(is.na(poslt), is_true()) expect_that(is.na(posct), is_true()) }) test_that("dates settor retains object class",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) date(poslt) <- as.Date("2000-01-01") date(posct) <- as.Date("2000-01-01") date(date) <- as.Date("2000-01-01") expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) }) test_that("time zone settor correctly performs simple updates",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) tz(poslt) <- "GMT" tz(posct) <- "GMT" tz(date) <- "GMT" # dates do not have a tz attribute expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("UTC")) }) test_that("time zone settor returns NA for spring dst gap",{ poslt <- as.POSIXlt("2010-03-14 02:30:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) tz(poslt) <- "America/New_York" tz(posct) <- "America/New_York" expect_that(is.na(poslt), is_true()) expect_that(is.na(posct), is_true()) }) test_that("time zone settor retains object class",{ poslt <- as.POSIXlt("2010-02-14 01:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) tz(poslt) <- "GMT" tz(posct) <- "GMT" tz(date) <- "GMT" expect_that(poslt, is_a("POSIXlt")) expect_that(posct, is_a("POSIXct")) expect_that(date, is_a("Date")) }) test_that("settors handle vectors",{ poslt <- as.POSIXlt(c("2010-02-14 01:59:59", "2010-02-15 01:59:59", "2010-02-16 01:59:59"), tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) second(poslt) <- 1 second(posct) <- 1 second(date) <- 1 expect_that(second(poslt), equals(c(1,1,1))) expect_that(second(posct), equals(c(1,1,1))) expect_that(second(date), equals(c(1,1,1))) minute(poslt) <- 1 minute(posct) <- 1 minute(date) <- 1 expect_that(minute(poslt), equals(c(1,1,1))) expect_that(minute(posct), equals(c(1,1,1))) expect_that(minute(date), equals(c(1,1,1))) hour(poslt) <- 1 hour(posct) <- 1 hour(date) <- 1 expect_that(hour(poslt), equals(c(1,1,1))) expect_that(hour(posct), equals(c(1,1,1))) expect_that(hour(date), equals(c(1,1,1))) mday(poslt) <- 1 mday(posct) <- 1 mday(date) <- 1 expect_that(mday(poslt), equals(c(1,1,1))) expect_that(mday(posct), equals(c(1,1,1))) expect_that(mday(date), equals(c(1,1,1))) wday(poslt) <- 1 wday(posct) <- 1 wday(date) <- 1 expect_that(wday(poslt), equals(c(1,1,1))) expect_that(wday(posct), equals(c(1,1,1))) expect_that(wday(date), equals(c(1,1,1))) yday(poslt) <- 1 yday(posct) <- 1 yday(date) <- 1 expect_that(yday(poslt), equals(c(1,1,1))) expect_that(yday(posct), equals(c(1,1,1))) expect_that(yday(date), equals(c(1,1,1))) week(poslt) <- 2 week(posct) <- 2 week(date) <- 2 expect_that(week(poslt), equals(c(2,2,2))) expect_that(week(posct), equals(c(2,2,2))) expect_that(week(date), equals(c(2,2,2))) month(poslt) <- 10 month(posct) <- 10 month(date) <- 10 expect_that(month(poslt), equals(c(10,10,10))) expect_that(month(posct), equals(c(10,10,10))) expect_that(month(date), equals(c(10,10,10))) year(poslt) <- 2001 year(posct) <- 2001 year(date) <- 2001 expect_that(year(poslt), equals(c(2001,2001,2001))) expect_that(year(posct), equals(c(2001,2001,2001))) expect_that(year(date), equals(c(2001,2001,2001))) date(poslt) <- as.Date("2001-01-01") date(posct) <- as.Date("2001-01-01") date(date) <- as.Date("2001-01-01") expect_that(date(poslt), equals(as.Date(c("2001-01-01","2001-01-01","2001-01-01")))) expect_that(date(posct), equals(as.Date(c("2001-01-01","2001-01-01","2001-01-01")))) expect_that(date(date), equals(as.Date(c("2001-01-01","2001-01-01","2001-01-01")))) tz(poslt) <- "GMT" tz(posct) <- "GMT" tz(date) <- "GMT" # date has been made POSIXlt with sec, etc expect_that(tz(poslt), matches("GMT")) expect_that(tz(posct), matches("GMT")) expect_that(tz(date), matches("GMT")) }) test_that("qdays settors correctly performs simple updates and rolls over as expected", { poslt <- as.POSIXlt(c("2010-02-14 01:59:59", "2010-04-15 01:59:59", "2010-10-16 01:59:59"), tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) qday(poslt) <- 2 qday(posct) <- 2 qday(date) <- 2 expect_equal(month(poslt), c(1,4,10)) expect_equal(month(posct), c(1,4,10)) expect_equal(month(date), c(1,4,10)) expect_equal(mday(poslt), c(2,2,2)) expect_equal(mday(posct), c(2,2,2)) expect_equal(mday(date), c(2,2,2)) qday(poslt) <- 95 qday(posct) <- 95 qday(date) <- 95 expect_equal(month(poslt), c(4,7,1)) expect_equal(month(posct), c(4,7,1)) expect_equal(month(date), c(4,7,1)) expect_equal(mday(poslt), c(5,4,3)) expect_equal(mday(posct), c(5,4,3)) expect_equal(mday(date), c(5,4,3)) expect_equal(year(poslt), c(2010,2010,2011)) expect_equal(year(posct), c(2010,2010,2011)) expect_equal(year(date), c(2010,2010,2011)) }) lubridate/tests/testthat/test-ops-modulo.R0000644000175100001440000000473612705366146020467 0ustar hornikuserscontext("modulo operations") test_that("modulo operations return correct class",{ int <- ymd("2010-01-01") %--% ymd("2011-01-01") expect_error(int %% int) expect_is(int %% months(1), "Interval") expect_is(int %% ddays(10), "Interval") expect_error(months(3) %% int) expect_is(days(3) %% hours(2), "Period") expect_error(days(5) %% dminutes(300)) expect_error(dyears(3) %% int) expect_error(ddays(2) %% weeks(1)) expect_is(ddays(3) %% ddays(1), "Duration") }) test_that("modulo operations synchronize with integer division",{ int <- ymd("2010-01-01") %--% ymd("2011-01-01") int2 <- interval(int_start(int) + int %/% years(2) * years(2), int_end(int)) int3 <- interval(int_start(int) + int %/% dweeks(20) * dweeks(20), int_end(int)) expect_error(int %% int) expect_equal(int %% years(2), int2) expect_equal(int %% dweeks(20), int3) expect_error(years(2) %% int) expect_equal(years(2) %% months(5) + years(2) %/% months(5) * months(5), years(2)) expect_error(years(2) %% dweeks(20)) expect_error(dweeks(20) %% int) expect_error(dweeks(20) %% years(2)) expect_equal(dweeks(20) %% ddays(20) + dweeks(20) %/% ddays(20) * ddays(20), dweeks(20)) }) test_that("modulo operations work for vectors",{ int <- ymd("2010-01-01") %--% ymd("2011-01-01") int2 <- ymd("2009-01-01") %--% ymd("2011-01-01") int3 <- interval(int_start(int) + int %/% years(2) * years(2), int_end(int)) int4 <- interval(int_start(int) + int %/% dweeks(20) * dweeks(20), int_end(int)) expect_error(c(int, int) %% int2) expect_equal(c(int, int) %% years(2), c(int3, int3)) expect_equal(c(int, int) %% dweeks(20), c(int4, int4)) expect_error(int %% c(int2, int2)) expect_equal(int %% years(c(2,2)), c(int3, int3)) expect_equal(int %% dweeks(c(20,20)), c(int4, int4)) expect_error(years(2:3) %% int) expect_equal(years(2:3) %% months(5) + years(2:3) %/% months(5) * months(5), years(2:3)) expect_error(years(2:3) %% dweeks(20)) expect_error(years(2) %% c(int, int)) expect_equal(years(2) %% months(5:6) + years(2) %/% months(5:6) * months(5:6), years(c(2,2))) expect_error(years(2) %% dweeks(20:21)) expect_error(dweeks(20:21) %% int) expect_error(dweeks(20:21) %% years(2)) expect_equal(dweeks(20:21) %% ddays(20) + dweeks(20:21) %/% ddays(20) * ddays(20), dweeks(20:21)) expect_error(dweeks(20) %% c(int, int)) expect_error(dweeks(20) %% years(2:3)) expect_equal(dweeks(20) %% ddays(20:21) + dweeks(20) %/% ddays(20:21) * ddays(20:21), c(dweeks(20), dweeks(20))) }) lubridate/tests/testthat/test-ops-multiplication.R0000644000175100001440000000271112705366146022214 0ustar hornikuserscontext("multiplication operations") # multiplication for everything test_that("multiplication throws error for instants",{ x <- as.POSIXct("2010-03-15 00:00:00", tz = "UTC") expect_that(3 * x, throws_error()) }) test_that("multiplication throws error for intervals",{ time1 <- as.POSIXct("2008-08-03 00:00:00", tz = "UTC") time2 <- as.POSIXct("2009-08-03 00:00:00", tz = "UTC") int <- interval(time1, time2) diff <- difftime(time2, time1) int2 <- interval(time1, time1 + 2 *diff) expect_that(2 * int, equals(int2)) }) test_that("multiplication works as expected for periods",{ expect_that(3*months(1), equals(months(3))) expect_that(3*months(1), is_a("Period")) }) test_that("multiplying vectors works for periods",{ expect_that(c(2,3)*months(1), equals(months(2:3))) expect_that(c(2,3)*months(1), is_a("Period")) }) test_that("multiplication works as expected for durations",{ expect_that(3*dhours(1), equals(dhours(3))) expect_that(3*dhours(1), is_a("Duration")) }) test_that("multiplying vectors works for durations",{ expect_that(c(2,3)*dhours(1), equals(dhours(2:3))) expect_that(c(2,3)*dhours(1), is_a("Duration")) }) test_that("make_difftime makes a correct difftime object",{ x <- as.POSIXct("2008-01-01 12:00:00", tz = "UTC") y <- difftime(x + 3600, x) attr(y, "tzone") <- NULL expect_that(make_difftime(3600), equals(y)) expect_that(make_difftime(3600), is_a("difftime")) }) lubridate/tests/testthat/test-timezones.R0000644000175100001440000000535112705366146020400 0ustar hornikuserscontext("Time zones") test_that("with_tz works as expected", { x <- as.POSIXct("2008-08-03 10:01:59", tz = "America/New_York") y <- as.POSIXlt(x) expect_that(with_tz(x, "UTC"), equals(as.POSIXct(format( as.POSIXct(x), tz = "UTC"), tz = "UTC"))) expect_that(with_tz(y, "UTC"), equals(as.POSIXlt(format( as.POSIXct(x), tz = "UTC"), tz = "UTC"))) }) test_that("with_tz handles vectors", { x <- as.POSIXct(c("2008-08-03 13:01:59", "2009-08-03 10:01:59"), tz = "America/New_York") y <- as.POSIXlt(x) expect_that(with_tz(x, "UTC"), equals(as.POSIXct(format( as.POSIXct(x), tz = "UTC"), tz = "UTC"))) expect_that(with_tz(y, "UTC"), equals(as.POSIXlt(format( as.POSIXct(x), tz = "UTC"), tz = "UTC"))) }) test_that("with_tz handles various date-time classes", { x <- as.POSIXct("2008-08-03 13:01:59", tz = "America/New_York") expect_equal(with_tz(as.POSIXlt(x), "UTC"), as.POSIXlt(format(as.POSIXct(x), tz = "UTC"), tz = "UTC")) }) test_that("with_tz handles data.frames", { x <- as.POSIXct("2008-08-03 10:01:59", tz = "America/New_York") df <- data.frame(x = x, y = as.POSIXlt(x), z = "blabla") df <- with_tz(df, "UTC") x_out <- as.POSIXct(format(as.POSIXct(x), tz = "UTC"), tz = "UTC") expect_that(df$x, equals(x_out)) expect_that(df$y, equals(x_out)) }) test_that("force_tz works as expected", { x <- as.POSIXct("2008-08-03 10:01:59", tz = "America/New_York") expect_that(force_tz(x, "UTC"), equals(as.POSIXct(format(as.POSIXct(x)), tz = "UTC"))) }) test_that("force_tz handles vectors", { x <- as.POSIXct(c("2008-08-03 13:01:59", "2009-08-03 10:01:59"), tz = "America/New_York") expect_that(force_tz(x, "UTC"), equals(as.POSIXct(format(as.POSIXct(x)), tz = "UTC"))) }) test_that("force_tz handles various date-time classes", { x <- as.POSIXct("2008-12-03 13:01:59", tz = "America/New_York") expect_equal(force_tz(as.POSIXlt(x), "UTC"), as.POSIXlt(format(x), tz = "UTC")) }) test_that("force_tz handles data.frames", { x <- as.POSIXct("2008-08-03 10:01:59", tz = "America/New_York") x_out <- as.POSIXct(format(as.POSIXct(x)), tz = "UTC") df <- data.frame(x = x, y = as.POSIXlt(x), z = "blabla") df <- force_tz(df, "UTC") expect_that(df$x, equals(x_out)) expect_that(df$y, equals(x_out)) }) test_that("force_tz doesn't return NA just because new time zone uses DST", { poslt <- as.POSIXlt("2009-03-14 02:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt2 <- force_tz(poslt, tz = "America/New_York") expect_true(!is.na(poslt2)) }) test_that("olson_time_zones returns a non-trivial character vector", { tz_olson <- olson_time_zones() expect_true(length(tz_olson) > 0) expect_is(tz_olson, "character") }) lubridate/tests/testthat/test-accessors.R0000644000175100001440000002057612705366146020356 0ustar hornikuserscontext("Accessors") test_that("seconds accessor extracts correct second",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(second(poslt), equals(59)) expect_that(second(posct), equals(59)) expect_that(second(date), equals(0)) }) test_that("minutes accessor extracts correct minute",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(minute(poslt), equals(45)) expect_that(minute(posct), equals(45)) expect_that(minute(date), equals(0)) }) test_that("hours accessor extracts correct hour",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(hour(poslt), equals(13)) expect_that(hour(posct), equals(13)) expect_that(hour(date), equals(0)) }) test_that("days accessors extract correct days",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(day(poslt), equals(3)) expect_that(day(posct), equals(3)) expect_that(day(date), equals(3)) expect_that(mday(poslt), equals(3)) expect_that(mday(posct), equals(3)) expect_that(mday(date), equals(3)) expect_that(yday(poslt), equals(34)) expect_that(yday(posct), equals(34)) expect_that(yday(date), equals(34)) expect_that(wday(poslt), equals(4)) expect_that(wday(posct), equals(4)) expect_that(wday(date), equals(4)) expect_that(qday(poslt), equals(34)) expect_that(qday(poslt), equals(34)) expect_that(qday(poslt), equals(34)) }) test_that("weeks accessor extracts correct week",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(week(poslt), equals(5)) expect_that(week(posct), equals(5)) expect_that(week(date), equals(5)) }) test_that("isoweek accessor extracts correct ISO8601 week",{ poslt <- as.POSIXlt("2010-01-01 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(isoweek(poslt), equals(53)) expect_that(isoweek(posct), equals(53)) expect_that(isoweek(date), equals(53)) }) test_that("isoweek returns correct value for non-UTC time zone (#311)", { cest <- ymd_hms("2015-04-14 16:45:00", tz="Europe/Copenhagen") utc <- ymd_hms("2015-04-14 16:45:00", tz="UTC") expect_equal(isoweek(cest), 16L) expect_equal(isoweek(utc), 16L) }) test_that("months accessor extracts correct month",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(month(poslt), equals(2)) expect_that(month(posct), equals(2)) expect_that(month(date), equals(2)) }) test_that("years accessor extracts correct year",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(year(poslt), equals(2010)) expect_that(year(posct), equals(2010)) expect_that(year(date), equals(2010)) }) test_that("isoyear accessor extracts correct ISO8601 year",{ poslt <- c(as.POSIXlt("2014-12-28 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S"), as.POSIXlt("2014-12-29 01:12:08", tz = "UTC", format = "%Y-%m-%d %H:%M:%S")) posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(isoyear(poslt), equals(c(2014,2015))) expect_that(isoyear(posct), equals(c(2014,2015))) expect_that(isoyear(date), equals(c(2014,2015))) }) test_that("date accessor extracts correct date",{ poslt <- as.POSIXlt("2010-02-03 23:45:59", tz = "Etc/GMT+8", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(date(poslt), equals(as.Date("2010-02-03"))) expect_that(date(posct), equals(as.Date("2010-02-03"))) expect_that(date(date), equals(as.Date("2010-02-03"))) }) test_that("timezone accessor extracts correct timezone",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(tz(poslt), matches("UTC")) expect_that(tz(posct), matches("UTC")) expect_that(tz(date), matches("UTC")) }) test_that("accessors handle vectors",{ poslt <- as.POSIXlt(c("2001-01-01 01:01:01", "2002-02-02 02:02:02", "2003-03-03 03:03:03"), tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(second(poslt), equals(c(1,2,3))) expect_that(second(posct), equals(c(1,2,3))) expect_that(second(date), equals(c(0,0,0))) expect_that(minute(poslt), equals(c(1,2,3))) expect_that(minute(posct), equals(c(1,2,3))) expect_that(minute(date), equals(c(0,0,0))) expect_that(hour(poslt), equals(c(1,2,3))) expect_that(hour(posct), equals(c(1,2,3))) expect_that(hour(date), equals(c(0,0,0))) expect_that(mday(poslt), equals(c(1,2,3))) expect_that(mday(posct), equals(c(1,2,3))) expect_that(mday(date), equals(c(1,2,3))) expect_that(wday(poslt), equals(c(2,7,2))) expect_that(wday(posct), equals(c(2,7,2))) expect_that(wday(date), equals(c(2,7,2))) expect_that(yday(poslt), equals(c(1,33,62))) expect_that(yday(posct), equals(c(1,33,62))) expect_that(yday(date), equals(c(1,33,62))) expect_that(week(poslt), equals(c(1,5,9))) expect_that(week(posct), equals(c(1,5,9))) expect_that(week(date), equals(c(1,5,9))) expect_that(isoweek(poslt), equals(c(1,5,10))) expect_that(isoweek(posct), equals(c(1,5,10))) expect_that(isoweek(date), equals(c(1,5,10))) expect_that(month(poslt), equals(c(1,2,3))) expect_that(month(posct), equals(c(1,2,3))) expect_that(month(date), equals(c(1,2,3))) expect_that(year(poslt), equals(c(2001,2002,2003))) expect_that(year(posct), equals(c(2001,2002,2003))) expect_that(year(date), equals(c(2001,2002,2003))) expect_that(date(poslt), equals(as.Date(c("2001-01-01","2002-02-02","2003-03-03")))) expect_that(date(posct), equals(as.Date(c("2001-01-01","2002-02-02","2003-03-03")))) expect_that(date(date), equals(as.Date(c("2001-01-01","2002-02-02","2003-03-03")))) expect_that(tz(poslt), matches("UTC")) expect_that(tz(posct), matches("UTC")) expect_that(tz(date), matches("UTC")) }) test_that("accessors handle Period objects",{ per <- period(seconds = 1, minutes = 2, hours = 3, days = 4, months = 5, years = 6) pers <- c(per, per) expect_equal(second(per), 1) expect_equal(minute(per), 2) expect_equal(hour(per), 3) expect_equal(day(per), 4) expect_equal(month(per), 5) expect_equal(year(per), 6) expect_error(date(per), "date is undefined for Period objects") expect_equal(second(pers), c(1, 1)) expect_equal(minute(pers), c(2, 2)) expect_equal(hour(pers), c(3, 3)) expect_equal(day(pers), c(4, 4)) expect_equal(month(pers), c(5, 5)) expect_equal(year(pers), c(6, 6)) expect_error(date(pers), "date is undefined for Period objects") second(per) <- 2 minute(per) <- 3 hour(per) <- 4 day(per) <- 5 month(per) <- 6 year(per) <- 7 expect_equal(per@.Data, 2) expect_equal(per@minute, 3) expect_equal(per@hour, 4) expect_equal(per@day, 5) expect_equal(per@month, 6) expect_equal(per@year, 7) second(pers) <- c(2, 3) minute(pers) <- c(3, 4) hour(pers) <- c(4, 5) day(pers) <- c(5, 6) month(pers) <- c(6, 7) year(pers) <- c(7, 8) expect_equal(pers@.Data, c(2, 3)) expect_equal(pers@minute, c(3, 4)) expect_equal(pers@hour, c(4, 5)) expect_equal(pers@day, c(5, 6)) expect_equal(pers@month, c(6, 7)) expect_equal(pers@year, c(7, 8)) }) context("test days_in_month") test_that( "days in month works for non leap years", { x <- seq(ymd("2011-01-01"), ymd("2011-12-01"), "1 month") expected <- c( Jan = 31L, Feb = 28L, Mar = 31L, Apr = 30L, May = 31L, Jun = 30L, Jul = 31L, Aug = 31L, Sep = 30L, Oct = 31L, Nov = 30L, Dec = 31L ) expect_that(days_in_month(x), equals(expected)) } ) test_that( "days in month works for leap years", { x <- seq(ymd("2012-01-01"), ymd("2012-12-01"), "1 month") expected <- c( Jan = 31L, Feb = 29L, Mar = 31L, Apr = 30L, May = 31L, Jun = 30L, Jul = 31L, Aug = 31L, Sep = 30L, Oct = 31L, Nov = 30L, Dec = 31L ) expect_that(days_in_month(x), equals(expected)) } ) lubridate/tests/testthat/test-durations.R0000644000175100001440000001626212765535024020375 0ustar hornikuserscontext("Durations") test_that("duration constructor doesn't accept non-numeric or non-character inputs", { expect_error(duration(interval(ymd("2014-01-01"), ymd("2015-01-01")))) }) test_that("new_difftime works as expected",{ x <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") y <- difftime(x + 5 + 30*60 + 60*60 + 14*24*60*60, x, tz = "UTC") attr(y, "tzone") <- NULL diff <- new_difftime(seconds = 5, minutes = 30, days = 0, hour = 1, weeks = 2) expect_that(diff, equals(y)) }) test_that("parsing works as expected", { expect_equal(duration("1min 2sec 2secs 1H 2M 1d"), duration(seconds = 4, minutes = 3, hours = 1, days = 1)) expect_equal(duration("day day"), duration(days = 2)) expect_equal(duration("S M H d w"), duration(seconds = 1, minutes = 1, hours = 1, days = 1, weeks = 1)) expect_equal(duration("1S 2M 3H 4d 5w"), duration(seconds = 1, minutes = 2, hours = 3, days = 4, weeks = 5)) }) test_that("character comparison with durrations works as expected", { expect_true("day" == duration(days = 1)) expect_true("2 days, 2 secs" == duration(days = 2, seconds = 2)) expect_true(duration("day 1s") > duration(days = 1)) expect_true("day 1s" > duration(days = 1)) expect_true("day 1S 2H" == duration(days = 1, seconds = 1, hours = 2)) expect_false("day 1S 2H" < duration(days = 1, hours = 2)) }) test_that("new_difftime handles vectors",{ x <- as.POSIXct(c("2008-08-03 13:01:59", "2008-08-03 13:01:59"), tz = "UTC") y <- difftime(x + c(5 + 30*60 + 60*60 + 14*24*60*60, 1 + 3*24*60*60 + 60*60), x, tz = "UTC") attr(y, "tzone") <- NULL z <- difftime(x + c(5 + 30*60 + 60*60 + 14*24*60*60, 5 + 30*60 + 60*60 + 14*24*60*60 + 3*24*60*60), x, tz = "UTC") attr(z, "tzone") <- NULL expect_that(new_difftime(seconds = c(5, 1), minutes = c(30, 0), days = c(0, 3), hour = c(1,1), weeks = c(2, 0)), equals(y)) expect_that(new_difftime(seconds = 5, minutes = 30, days = c(0, 3), hour = 1, weeks = 2), equals(z)) }) test_that("new_duration works as expected",{ dur <- new_duration(seconds = 5, minutes = 30, days = 0, hour = 1, weeks = 2) expect_equal(dur@.Data, 1215005) expect_is(dur, "Duration") }) test_that("new_duration handles vectors",{ dur1 <- new_duration(seconds = c(5, 1), minutes = c(30, 0), days = c(0, 3), hour = c(1,1), weeks = c(2, 0)) dur2 <- new_duration(seconds = 5, minutes = 30, days = c(0, 3), hour = 1, weeks = 2) expect_equal(dur1@.Data, c(1215005, 262801)) expect_equal(dur2@.Data, c(1215005, 1474205)) expect_is(dur1, "Duration") expect_is(dur2, "Duration") }) test_that("as.duration handles vectors",{ expect_that(as.duration(minutes(1:3)), equals(dminutes(1:3))) }) test_that("as.duration handles periods",{ expect_that(as.duration(seconds(1)), equals(dseconds(1))) expect_that(as.duration(minutes(2)), equals(dminutes(2))) expect_that(as.duration(hours(3)), equals(dhours(3))) expect_that(as.duration(days(4)), equals(ddays(4))) expect_that(as.duration(weeks(5)), equals(dweeks(5))) expect_that(as.duration(months(1)), equals(dseconds(60*60*24*365.25/12))) expect_that(as.duration(years(1)), equals(dseconds(60*60*24*365.25))) expect_that(as.duration(seconds(1) + minutes(4)), equals(dseconds(1) + dminutes(4))) }) test_that("as.duration handles intervals",{ time1 <- as.POSIXct("2009-01-02 12:24:03", tz = "UTC") time2 <- as.POSIXct("2010-02-03 14:31:42", tz = "UTC") dur <- as.duration(interval(time1, time2)) y <- as.numeric(time2 - time1, units = "secs") expect_equal(dur@.Data, y) expect_is(dur, "Duration") }) test_that("as.duration handles difftimes",{ x <- difftime(as.POSIXct("2010-02-03 14:31:42", tz = "UTC"), as.POSIXct("2009-01-02 12:24:03", tz = "UTC")) dur <- as.duration(x) y <- as.numeric(x, units = "secs") expect_equal(dur@.Data, y) expect_is(dur, "Duration") }) test_that("eobjects handle vectors",{ dur <- dseconds(c(1,3,4)) expect_equal(dur@.Data, c(1, 3, 4)) expect_is(dur, "Duration") }) test_that("is.duration works as expected",{ ct_time <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") lt_time <- as.POSIXlt("2009-08-03 13:01:59", tz = "UTC") expect_that(is.duration(234), is_false()) expect_that(is.duration(ct_time), is_false()) expect_that(is.duration(lt_time), is_false()) expect_that(is.duration(Sys.Date()), is_false()) expect_that(is.duration(minutes(1)), is_false()) expect_that(is.duration(dminutes(1)), is_true()) expect_that(is.duration(new_difftime(1000)), is_false()) expect_that(is.duration(interval(lt_time, ct_time)), is_false()) }) test_that("is.duration handle vectors",{ expect_that(is.duration(dminutes(1:3)), is_true()) }) test_that("format.Duration correctly displays intervals of length 0", { dur <- new_duration(seconds = 5) expect_output(print(dur[FALSE]), "Duration\\(0)") }) test_that("format.Duration correctly displays durations with an NA", { dur <- new_duration(seconds = c(5, NA)) expect_equivalent(format(dur), c("5s", NA)) }) test_that("summary.Duration creates useful summary", { dur <- dminutes(5) text <- c(rep("300s (~5 minutes)", 6), 1) names(text) <- c("Min.", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max.", "NA's") expect_equal(summary(c(dur, NA)), text) }) test_that("format.Duration works with NA values", { expect_equal(format(duration(c(NA, 1, 100, 10000, 100000, 100000000))), c(NA, "1s", "100s (~1.67 minutes)", "10000s (~2.78 hours)", "100000s (~1.16 days)", "100000000s (~3.17 years)")) }) test_that("as.duration handles NA interval objects", { one_missing_date <- as.POSIXct(NA_real_, origin = origin) one_missing_interval <- interval(one_missing_date, one_missing_date) several_missing_dates <- rep(as.POSIXct(NA_real_, origin = origin), 2) several_missing_intervals <- interval(several_missing_dates, several_missing_dates) start_missing_intervals <- interval(several_missing_dates, origin) end_missing_intervals <- interval(origin, several_missing_dates) na.dur <- dseconds(NA) expect_equal(as.duration(one_missing_interval), na.dur) expect_equal(as.duration(several_missing_intervals), c(na.dur, na.dur)) expect_equal(as.duration(start_missing_intervals), c(na.dur, na.dur)) expect_equal(as.duration(end_missing_intervals), c(na.dur, na.dur)) }) test_that("as.duration handles NA period objects", { na.dur <- dseconds(NA) expect_equal(suppressMessages(as.duration(years(NA))), na.dur) expect_equal(suppressMessages(as.duration(years(c(NA, NA)))), c(na.dur, na.dur)) expect_equal(suppressMessages(as.duration(years(c(1, NA)))), c(dyears(1) + ddays(.25), na.dur)) }) test_that("as.duration handles NA objects", { na.dur <- dseconds(NA) expect_equal(as.duration(NA), na.dur) }) test_that("Comparison operators work duration and difftime objects (#323)", { t1 <- now() t2 <- t1 + dhours(1) t3 <- t1 + dseconds(1) expect_true((t2 - t1) > dseconds(60)) expect_false((t2 - t1) > dseconds(3600)) expect_true((t2 - t1) < dseconds(3601)) expect_true(dhours(1) > dminutes(59)) expect_true(dhours(1) == dseconds(3600)) expect_error(dhours(1) == 3600) expect_error(dhours(1) == 1) }) lubridate/tests/testthat/test-POSIXt.R0000644000175100001440000000244112747740626017453 0ustar hornikuserscontext("POSIXt") test_that("is.POSIXt works as expected",{ expect_that(is.POSIXt(234), is_false()) expect_that(is.POSIXt(as.POSIXct("2008-08-03 13:01:59", tz = "UTC")), is_true()) expect_that(is.POSIXt(as.POSIXlt("2008-08-03 13:01:59", tz = "UTC")), is_true()) expect_that(is.POSIXt(Sys.Date()), is_false()) expect_that(is.POSIXt(minutes(1)), is_false()) expect_that(is.POSIXt(dminutes(1)), is_false()) expect_that(is.POSIXt(interval( as.POSIXct("2008-08-03 13:01:59", tz = "UTC"), as.POSIXct("2009-08-03 13:01:59", tz = "UTC") )), is_false()) }) test_that("is.POSIXt handles vectors",{ expect_that(is.POSIXt(c( as.POSIXct("2008-08-03 13:01:59", tz = "UTC"), as.POSIXct("2009-08-03 13:01:59", tz = "UTC") )), is_true()) }) # as_datetime ------------------------------------------------------------- test_that("converts numeric", { dt <- as_datetime(0) expect_s3_class(dt, "POSIXct") expect_equal(tz(dt), "UTC") expect_equal(unclass(dt)[[1]], 0) }) test_that("converts date", { dt <- as_datetime(as.Date("1970-01-01")) expect_s3_class(dt, "POSIXct") expect_equal(tz(dt), "UTC") expect_equal(unclass(dt)[[1]], 0) }) test_that("changes timezone of POSIXct", { dt <- as_datetime(make_datetime(tz = "America/Chicago")) expect_equal(tz(dt), "UTC") }) lubridate/tests/testthat/test-decimal-date.R0000644000175100001440000000373612750354063020674 0ustar hornikuserscontext("Decimal_date") test_that("decimal_date works as expected",{ x <- ymd_hms("2008-08-03 10:01:59") date_decimal(decimal_date(x)) }) test_that("decimal_date handles vectors",{ x <- as.POSIXct(c("2008-08-03 13:01:59", "2009-08-03 10:01:59"), tz = "UTC") expect_that(round(decimal_date(x), 3), equals(c(2008.589, 2009.587))) }) test_that("decimal_date handles first second of year without returning NaN",{ expect_equal(decimal_date(ymd("2012-01-01")), 2012) }) test_that("date_decimal works as expected",{ y <- 2008.58846 expect_equal(as.numeric(date_decimal(y)), 1217754118) }) test_that("date_decimal handles vectors",{ y <- c(2008.589, 2009.587) expect_equal(as.numeric(date_decimal(y)), c(1217771194, 1249279632)) }) test_that("date_decimal reverses decimal_date",{ date <- ymd("2012-03-01", tz = "UTC") decimal <- decimal_date(date) expect_equal(date_decimal(decimal), date) date2 <- ymd("2012-03-01") decimal2 <- decimal_date(date2) expect_equal(as.Date(date_decimal(decimal2)), date2) ## before day light shift date3 <- ymd_hms("2008-02-03 10:01:59", tz = "America/New_York") decimal3 <- decimal_date(date3) date_decimal(decimal3, tz = "America/New_York") expect_equal(date_decimal(decimal3, tz = "America/New_York"), date3) ## after date <- ymd_hms("2008-05-03 10:01:59", tz = "America/New_York") decimal <- decimal_date(date) date_decimal(decimal, tz = "America/New_York") expect_equal(date_decimal(decimal, tz = "America/New_York"), date) }) test_that("decimal_date returns NA on NA date input", { expect_equal(decimal_date(as.Date(NA)), as.numeric(NA)) }) test_that("decimal_date correctly handles daylight savings time", { date4 <- ymd_hms("2016-03-13 01:00:00", tz = 'America/New_York') date4 <- date4 + dhours(-1:1) decimal4 <- decimal_date(date4) diff.decimal <- diff(decimal4) expect_equal(diff.decimal[1], diff.decimal[2]) expect_equal(decimal4, decimal_date(with_tz(date4, 'UTC'))) }) lubridate/tests/testthat/test-stamp.R0000644000175100001440000001501112705366146017501 0ustar hornikuserscontext("Stamp") test_that("stamp selects the correct format",{ test_dates <- read.table(header = T, stringsAsFactors=F, textConnection(" date expected 'February 20th 1973' 'August 13th 2012' 'february 14, 2004' 'August 13, 2012' 'Sunday, May 1, 2000' 'Monday, Aug 13, 2012' 'Sunday, May 1, 2000' 'Monday, Aug 13, 2012' 'february 14, 04' 'August 13, 12' 'Feb 20th 73' 'Aug 13th 12' 'January 5 1999 at 7pm' 'August 13 2012 at 11AM' 'jan 3 2010' 'Aug 13 2012' 'Jan 1, 1999' 'Aug 13, 2012' 'jan 3 10' 'Aug 13 12' '01 3 2010' '08 13 2012' '1 3 10' '08 13 12' '1 13 89' '08 13 12' '5/27/1979' '08/13/2012' '12/31/99' '08/13/12' 'DOB:12/11/00' 'DOB:08/13/12' 'Thu, 1 July 2004 22:30:00' 'Mon, 13 August 2012 11:37:53' 'Thu, 1st of July 2004 at 22:30:00' 'Mon, 13st of August 2012 at 11:37:53' 'Thu, 1July 2004 at 22:30:00' 'Mon, 13August 2012 at 11:37:53' 'Thu, 1July2004 22:30:00' 'Mon, 13August2012 11:37:53' '21 Aug 2011, 11:15:34 pm' '13 Aug 2012, 11:37:53 AM' '1979-05-27 05:00:59' '2012-08-13 11:37:53' '1979-05-27' '2012-08-13' '3 jan 2000' '13 Aug 2012' '17 april 85' '13 August 12' '27/5/1979' '13/08/2012' '20 01 89' '13 08 12' '00/13/10' '12/13/08' '14 12 00' '13 08 12' '03:23:22 pm' '11:37:53 AM' '2001-12-31T04:05:06Z' '2012-08-13T11:37:53Z' ")) D <- as.POSIXct("2012-08-13 11:37:53", tz = "UTC") for( i in seq_along(test_dates$date) ) test_that(stamp(test_dates[[i, "date"]])(D), equals(test_dates[[i, "expected"]])) }) test_that(".format_offset works as expected", { df_winter <- data.frame( tz=c("America/Chicago", "UTC", "Europe/Paris"), Oo=c("-06", "+00", "+01"), Oz=c("-0600", "+0000", "+0100"), OO=c("-06:00", "+00:00", "+01:00"), stringsAsFactors=FALSE ) with(df_winter, for (i in 1:nrow(df_winter)){ expect_equal(.format_offset(ymd("2013-01-01", tz=tz[i]), "%Oo"), Oo[i]) expect_equal(.format_offset(ymd("2013-01-01", tz=tz[i]), "%Oz"), Oz[i]) expect_equal(.format_offset(ymd("2013-01-01", tz=tz[i]), "%OO"), OO[i]) }) df_summer <- data.frame( tz=c("America/Chicago", "UTC", "Europe/Paris"), Oo=c("-05", "+00", "+02"), Oz=c("-0500", "+0000", "+0200"), OO=c("-05:00", "+00:00", "+02:00"), stringsAsFactors=FALSE ) with(df_summer, for (i in 1:nrow(df_summer)){ expect_equal(.format_offset(ymd("2013-07-01", tz=tz[i]), "%Oo"), Oo[i]) expect_equal(.format_offset(ymd("2013-07-01", tz=tz[i]), "%Oz"), Oz[i]) expect_equal(.format_offset(ymd("2013-07-01", tz=tz[i]), "%OO"), OO[i]) }) ## half-hour timezone expect_warning(.format_offset(ymd("2013-07-01", tz="Asia/Kolkata"), "%Oo")) expect_equal(suppressWarnings(.format_offset(ymd("2013-07-01", tz="Asia/Kolkata"), "%Oo")), "+0530") expect_equal(.format_offset(ymd("2013-07-01", tz="Asia/Kolkata"), "%Oz"), "+0530") expect_equal(.format_offset(ymd("2013-07-01", tz="Asia/Kolkata"), "%OO"), "+05:30") }) test_that("stamp works with ISO-8601 formats", { stamp_Ou <- stamp("2013-01-01T06:00:00Z") stamp_Oo <- stamp("2013-01-01T00:00:00-06") stamp_Oz <- stamp("2013-01-01T00:00:00-0600") stamp_OO <- stamp("2013-01-01T00:00:00-06:00") tz <- c("America/Chicago", "UTC", "Europe/Paris") Ou <- c("2013-01-01T06:00:00Z", "2013-01-01T00:00:00Z", "2012-12-31T23:00:00Z") Oo <- c("2013-01-01T00:00:00-06", "2013-01-01T00:00:00+00", "2013-01-01T00:00:00+01") Oz <- c("2013-01-01T00:00:00-0600", "2013-01-01T00:00:00+0000", "2013-01-01T00:00:00+0100") OO <- c("2013-01-01T00:00:00-06:00", "2013-01-01T00:00:00+00:00", "2013-01-01T00:00:00+01:00") ## cbind(tz, Ou, Oo, Oz, OO) # if you want to see them for (i in seq_along(tz)){ expect_equal(stamp_Ou(ymd("2013-01-01", tz=tz[i])), Ou[i]) expect_equal(stamp_Oo(ymd("2013-01-01", tz=tz[i])), Oo[i]) expect_equal(stamp_Oz(ymd("2013-01-01", tz=tz[i])), Oz[i]) expect_equal(stamp_OO(ymd("2013-01-01", tz=tz[i])), OO[i]) } ## half-hour timezone expect_equal(suppressWarnings(stamp_Ou(ymd("2013-01-01", tz="Asia/Kolkata"))), "2012-12-31T18:30:00Z") expect_warning(stamp_Oo(ymd("2013-01-01", tz="Asia/Kolkata"))) expect_equal(suppressWarnings(stamp_Oo(ymd("2013-01-01", tz="Asia/Kolkata"))), "2013-01-01T00:00:00+0530") expect_equal(stamp_Oz(ymd("2013-01-01", tz="Asia/Kolkata")), "2013-01-01T00:00:00+0530") expect_equal(stamp_OO(ymd("2013-01-01", tz="Asia/Kolkata")), "2013-01-01T00:00:00+05:30") ## vectorization expect_equal(stamp_OO(ymd(c("2013-01-01", "2010-01-01"), tz="Asia/Kolkata")), c("2013-01-01T00:00:00+05:30", "2010-01-01T00:00:00+05:30")) ## format not at end of template (fails on windows 7, %z output format is ## completely screwed there) ## stamp_OO_strange <- stamp("2013-01-01T00:00:00-06:00 KK") ## expect_equal(stamp_OO_strange(ymd("2013-01-01", tz="Asia/Kolkata")), ## "2012-12-31T18:30:00+0000 KK") }) ## ## Don't delete this. We need it for interactive testing ## y <- c('February 20th 1973', ## "february 14, 2004", ## "Sunday, May 1, 2000", ## "Sunday, May012000", ## "february 14, 04", ## 'Feb 20th 73', ## "January 5 1999 at 7pm", ## "jan 3 2010", ## "Jan 1, 1999", ## "jan 3 10", ## "01 3 2010", ## "1 3 10", ## '1 13 89', ## "5/27/1979", ## "12/31/99", ## "DOB:12/11/00", ## 'Thu, 1 July 2004 22:30:00', ## 'Thu, 1st of July 2004 at 22:30:00', ## 'Thu, 1July 2004 at 22:30:00', ## 'Thu, 1July2004 22:30:00', ## "21 Aug 2011, 11:15:34 pm", ## "1979-05-27 05:00:59", ## "1979-05-27", ## "3 jan 2000", ## "17 april 85", ## "27/5/1979", ## '20 01 89', ## '00/13/10', ## "14 12 00", ## "03:23:22 pm") ## cbind(y, unlist(lapply(y, function(x) stamp(x)(D)))) lubridate/tests/testthat/test-timespans.R0000644000175100001440000001234012705366146020362 0ustar hornikuserscontext("timespans") test_that("is.timespan works as expected",{ expect_that(is.timespan(234), is_false()) expect_that(is.timespan(as.POSIXct("2008-08-03 13:01:59", tz = "UTC")), is_false()) expect_that(is.timespan(as.POSIXlt("2008-08-03 13:01:59", tz = "UTC")), is_false()) expect_that(is.timespan(Sys.Date()), is_false()) expect_that(is.timespan(minutes(1)), is_true()) expect_that(is.timespan(dminutes(1)), is_true()) expect_that(is.timespan(interval( as.POSIXct("2008-08-03 13:01:59", tz = "UTC"), as.POSIXct("2009-08-03 13:01:59", tz = "UTC") )), is_true()) }) test_that("is.timespan handles vectors",{ expect_that(is.timespan(minutes(1:3)), is_true()) }) test_that("time_length works as expected",{ expect_that(time_length(period(1, "day")), # period equals(86400)) expect_that(time_length(ymd('2014-12-15')-ymd('2014-11-30'), "day"), # difftime equals(15)) expect_that(time_length(ymd('2014-12-15')-ymd('2014-11-30'), "week"), equals(15/7)) expect_that(time_length(duration(3, "months"), "month"), # duration equals(3)) expect_that(time_length(interval(ymd('2014-11-30'), ymd('2014-12-15')), "weeks"), # interval equals(15/7)) expect_that(time_length(interval(ymd('1900-01-01'), ymd('1999-12-31')), "years"), is_less_than(100)) expect_that(time_length(as.duration(interval(ymd('1900-01-01'), ymd('1999-12-31'))), "years"), is_more_than(100)) expect_that(-time_length(interval(ymd('1900-01-01'), ymd('2000-01-01')), "days"), equals(time_length(int_flip(interval(ymd('1900-01-01'), ymd('2000-01-01'))), "days"))) }) test_that("time_length works with missing intervals", { expect_equal(time_length(interval(NA,ymd("2016-01-01")), unit = "year"), NA_real_) }) test_that("time_length works with birth date 29 Feb ", { expect_that(round(time_length(interval(ymd('1992-02-29'), ymd('1999-02-28')), "years"), 4), equals(6.9973)) expect_that(round(time_length(interval(ymd('1992-02-29'), ymd('1999-03-31')), "years"), 4), equals(7.0822)) expect_that(time_length(interval(ymd('1992-02-29'), ymd('1999-03-01')), "years"), equals(7)) expect_that(round(time_length(interval(ymd('1992-02-29'), ymd('2000-03-01')), "years"), 4), equals(8.0027)) expect_that(time_length(interval(ymd('1992-02-29'), ymd('2000-02-29')), "years"), equals(8)) expect_that(time_length(interval(ymd_hms('1992-02-29 12:00:00'), ymd_hms('1999-03-01 05:00:00')), "years"), is_more_than(7)) }) test_that("time_length works with negative interals", { expect_that(-time_length(interval(ymd('1992-02-28'), ymd('2000-01-01')), "days"), equals(time_length(int_flip(interval(ymd('1992-02-28'), ymd('2000-01-01'))), "days"))) expect_that(-time_length(interval(ymd('1992-02-28'), ymd('2000-03-01')), "days"), equals(time_length(int_flip(interval(ymd('1992-02-28'), ymd('2000-03-01'))), "days"))) ## If both ends include leap years Febs, the lenths are not identical int <- interval(ymd('1992-02-28'), ymd('2000-03-01')) expect_equal(-time_length(int, "years"), time_length(int_flip(int), "years")) ## or if both ends don't include leap years Febs, the lenths are identical int <- interval(ymd('1994-02-28'), ymd('2002-03-01')) expect_equal(-time_length(int, "years"), time_length(int_flip(int), "years")) ## ... otherwise not int <- interval(ymd('1992-02-28'), ymd('2002-01-01')) expect_gt(-time_length(int, "years"), time_length(int_flip(int), "years")) }) test_that("time_length handles vectors",{ expect_that(time_length(days(1:3), unit="days"), equals(1:3)) expect_that(time_length(as.interval(days(1:3), start=today()), unit="days"), equals(1:3)) expect_that(time_length(as.interval(days(c(1:3,NA)), start=today()), unit="days"), equals(c(1:3,NA))) ints <- new("Interval" , .Data = c(6363040, 1646253613, 159312603, -510371200, -381983229, 1369742727, -190254638, -1118394043, -2091814107) , start = structure(c(64156663, 326788049, 462064351, 909110414, 778538359, 395846311, 1415640365, 1697694335, 2193040469) , class = c("POSIXct", "POSIXt"), tzone = "UTC") , tzone = "UTC") expect_equal(round(time_length(ints, "years"), 5), c(0.20122, 52.16674, 5.04903, -16.17281, -12.10439, 43.40412, -6.03011, -35.44092, -66.28715)) expect_equal(round(time_length(ints[ints > 0], "years"), 5), c(0.20122, 52.16674, 5.04903, 43.40412)) expect_equal(round(time_length(ints[ints < 0], "years"), 5), c(-16.17281, -12.10439, -6.03011, -35.44092, -66.28715)) expect_equal(round(time_length(ints, "month"), 5), c(2.4402, 625.99552, 60.57729, -194.06691, -145.2291, 520.81679, -72.35552, -425.27918, -795.43557)) }) test_that("time_length handles 0 length intervals", { date <- ymd_hms("2014-12-30 20:35:13") int <- interval(c(date, date), c(date, date)) expect_equal(time_length(int), c(0, 0)) expect_equal(time_length(int, "years"), c(0, 0)) expect_equal(time_length(int, "months"), c(0, 0)) }) lubridate/tests/testthat/test-rollback.R0000644000175100001440000000132612763544540020152 0ustar hornikuserscontext("rollback") test_that("rollback returns correct results",{ expect_equal(rollback(ymd_hms("2010-03-03 12:44:22")), ymd_hms("2010-02-28 12:44:22")) expect_equal(rollback(ymd_hms("2010-03-03 12:44:22"), preserve_hms = FALSE), ymd_hms("2010-02-28 00:00:00")) expect_equal(rollback(ymd_hms("2010-03-03 12:44:22"), roll_to_first = TRUE), ymd_hms("2010-03-01 12:44:22")) expect_equal(rollback(ymd_hms("2010-03-03 12:44:22"), roll_to_first = TRUE, preserve_hms = FALSE), ymd_hms("2010-03-01 00:00:00")) }) test_that("rollback works with missing numbers", { expect_equal(ymd(c("20150131", NA)) %m+% months(1) , ymd(c("201502-28", NA))) }) lubridate/tests/testthat/test-update.R0000644000175100001440000004073612705366146017653 0ustar hornikuserscontext("Updating dates") test_that("update.Date returns a date object",{ date <- as.Date("05/05/2010", "%m/%d/%Y") expect_that(update(date, days = 1), is_a("Date")) expect_that(update(date, yday = 1), is_a("Date")) expect_that(update(date, mday = 1), is_a("Date")) expect_that(update(date, wday = 1), is_a("Date")) expect_that(update(date, month = 1), is_a("Date")) expect_that(update(date, year = 2001), is_a("Date")) expect_that(update(date, tz = "UTC"), is_a("Date")) }) test_that("update.Date returns a posix object if time is manipulated",{ date <- as.Date("05/05/2010", "%m/%d/%Y") expect_that(update(date, seconds = 1), is_a("POSIXt")) expect_that(update(date, minutes = 1), is_a("POSIXt")) expect_that(update(date, hours = 1), is_a("POSIXt")) }) test_that("update.POSIXlt returns a POSIXlt object",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") expect_that(update(poslt, seconds = 1), is_a("POSIXlt")) expect_that(update(poslt, minutes = 1), is_a("POSIXlt")) expect_that(update(poslt, hours = 1), is_a("POSIXlt")) expect_that(update(poslt, days = 1), is_a("POSIXlt")) expect_that(update(poslt, yday = 1), is_a("POSIXlt")) expect_that(update(poslt, mday = 1), is_a("POSIXlt")) expect_that(update(poslt, wday = 1), is_a("POSIXlt")) expect_that(update(poslt, month = 1), is_a("POSIXlt")) expect_that(update(poslt, year = 2001), is_a("POSIXlt")) expect_that(update(poslt, tz = "UTC"), is_a("POSIXlt")) }) test_that("update.POSIXct returns a POSIXct object",{ posct <- as.POSIXct("2010-02-03 13:45:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") expect_that(update(posct, seconds = 1), is_a("POSIXct")) expect_that(update(posct, minutes = 1), is_a("POSIXct")) expect_that(update(posct, hours = 1), is_a("POSIXct")) expect_that(update(posct, days = 1), is_a("POSIXct")) expect_that(update(posct, yday = 1), is_a("POSIXct")) expect_that(update(posct, mday = 1), is_a("POSIXct")) expect_that(update(posct, wday = 1), is_a("POSIXct")) expect_that(update(posct, month = 1), is_a("POSIXct")) expect_that(update(posct, year = 2001), is_a("POSIXct")) expect_that(update(posct, tz = "UTC"), is_a("POSIXct")) }) test_that("update.Date performs simple operation as expected",{ date <- as.Date("05/05/2010", "%m/%d/%Y") expect_that(second(update(date, seconds = 1)), equals(1)) expect_that(minute(update(date, minutes = 1)), equals(1)) expect_that(hour(update(date, hours = 1)), equals(1)) expect_that(mday(update(date, mday = 1)), equals(1)) expect_that(wday(update(date, mday = 1)), equals(7)) expect_that(yday(update(date, mday = 1)), equals(121)) expect_that(yday(update(date, yday = 1)), equals(1)) expect_that(mday(update(date, yday = 1)), equals(1)) expect_that(wday(update(date, yday = 1)), equals(6)) expect_that(wday(update(date, wday = 1)), equals(1)) expect_that(yday(update(date, wday = 1)), equals(122)) expect_that(mday(update(date, wday = 1)), equals(2)) expect_that(month(update(date, months = 1)), equals(1)) expect_that(year(update(date, years = 2000)), equals(2000)) expect_that(tz(update(date, tz = "UTC")), matches("UTC")) }) test_that("update.POSIXt performs simple operation as expected",{ poslt <- as.POSIXlt("2010-02-03 13:45:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct("2010-02-03 13:45:59", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") expect_that(second(update(poslt, seconds = 1)), equals(1)) expect_that(minute(update(poslt, minutes = 1)), equals(1)) expect_that(hour(update(poslt, hours = 1)), equals(1)) expect_that(mday(update(poslt, mday = 1)), equals(1)) expect_that(wday(update(poslt, mday = 1)), equals(2)) expect_that(yday(update(poslt, mday = 1)), equals(32)) expect_that(yday(update(poslt, yday = 1)), equals(1)) expect_that(mday(update(poslt, yday = 1)), equals(1)) expect_that(wday(update(poslt, yday = 1)), equals(6)) expect_that(wday(update(poslt, wday = 1)), equals(1)) expect_that(yday(update(poslt, wday = 1)), equals(31)) expect_that(mday(update(poslt, wday = 1)), equals(31)) expect_that(month(update(poslt, months = 1)), equals(1)) expect_that(year(update(poslt, years = 2000)), equals(2000)) expect_that(tz(update(poslt, tz = "UTC")), matches("UTC")) expect_that(second(update(posct, seconds = 1)), equals(1)) expect_that(minute(update(posct, minutes = 1)), equals(1)) expect_that(hour(update(posct, hours = 1)), equals(1)) expect_that(mday(update(posct, mday = 1)), equals(1)) expect_that(wday(update(posct, mday = 1)), equals(2)) expect_that(yday(update(posct, mday = 1)), equals(32)) expect_that(yday(update(posct, yday = 1)), equals(1)) expect_that(mday(update(posct, yday = 1)), equals(1)) expect_that(wday(update(posct, yday = 1)), equals(6)) expect_that(wday(update(posct, wday = 1)), equals(1)) expect_that(yday(update(posct, wday = 1)), equals(31)) expect_that(mday(update(posct, wday = 1)), equals(31)) expect_that(month(update(posct, months = 1)), equals(1)) expect_that(year(update(posct, years = 2000)), equals(2000)) expect_that(tz(update(posct, tz = "UTC")), matches("UTC")) }) test_that("update performs roll overs correctly for Date objects",{ date <- as.Date("05/05/2010", "%m/%d/%Y") expect_that(second(update(date, seconds = 61)), equals(1)) expect_that(minute(update(date, seconds = 61)), equals(1)) expect_that(minute(update(date, minutes = 61)), equals(1)) expect_that(hour(update(date, minutes = 61)), equals(1)) expect_that(hour(update(date, hours = 25)), equals(1)) expect_that(mday(update(date, hours = 25)), equals(6)) expect_that(yday(update(date, hours = 25)), equals(126)) expect_that(wday(update(date, hours = 25)), equals(5)) expect_that(mday(update(date, mday = 32)), equals(1)) expect_that(month(update(date, mday = 32)), equals(6)) expect_that(wday(update(date, wday = 31)), equals(3)) expect_that(month(update(date, wday = 31)), equals(6)) expect_that(yday(update(date, yday = 366)), equals(1)) expect_that(month(update(date, yday = 366)), equals(1)) expect_that(month(update(date, month = 13)), equals(1)) expect_that(year(update(date, month = 13)), equals(2011)) expect_that(tz(update(date, month = 13)), matches("UTC")) }) test_that("update performs roll overs correctly for POSIXlt objects",{ poslt <- as.POSIXlt("2010-05-05 00:00:00", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") expect_that(second(update(poslt, seconds = 61)), equals(1)) expect_that(minute(update(poslt, seconds = 61)), equals(1)) expect_that(minute(update(poslt, minutes = 61)), equals(1)) expect_that(hour(update(poslt, minutes = 61)), equals(1)) expect_that(hour(update(poslt, hours = 25)), equals(1)) expect_that(mday(update(poslt, hours = 25)), equals(6)) expect_that(yday(update(poslt, hours = 25)), equals(126)) expect_that(wday(update(poslt, hours = 25)), equals(5)) expect_that(mday(update(poslt, mday = 32)), equals(1)) expect_that(month(update(poslt, mday = 32)), equals(6)) expect_that(wday(update(poslt, wday = 31)), equals(3)) expect_that(month(update(poslt, wday = 31)), equals(6)) expect_that(yday(update(poslt, yday = 366)), equals(1)) expect_that(month(update(poslt, yday = 366)), equals(1)) expect_that(month(update(poslt, month = 13)), equals(1)) expect_that(year(update(poslt, month = 13)), equals(2011)) expect_that(tz(update(poslt, month = 13)), matches("GMT")) }) test_that("update performs roll overs correctly for POSIXct objects",{ posct <- as.POSIXct("2010-05-05 00:00:00", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") expect_that(second(update(posct, seconds = 61)), equals(1)) expect_that(minute(update(posct, seconds = 61)), equals(1)) expect_that(minute(update(posct, minutes = 61)), equals(1)) expect_that(hour(update(posct, minutes = 61)), equals(1)) expect_that(hour(update(posct, hours = 25)), equals(1)) expect_that(mday(update(posct, hours = 25)), equals(6)) expect_that(yday(update(posct, hours = 25)), equals(126)) expect_that(wday(update(posct, hours = 25)), equals(5)) expect_that(mday(update(posct, mday = 32)), equals(1)) expect_that(month(update(posct, mday = 32)), equals(6)) expect_that(wday(update(posct, wday = 31)), equals(3)) expect_that(month(update(posct, wday = 31)), equals(6)) expect_that(yday(update(posct, yday = 366)), equals(1)) expect_that(month(update(posct, yday = 366)), equals(1)) expect_that(month(update(posct, month = 13)), equals(1)) expect_that(year(update(posct, month = 13)), equals(2011)) expect_that(tz(update(posct, month = 13)), matches("GMT")) }) test_that("update performs consecutive roll overs correctly for Date objects regardless of order",{ date <- update(as.Date("11/01/2010", "%m/%d/%Y"), months = 13, days = 32, hours = 25, minutes = 61, seconds = 61) expect_that(second(date), equals(1)) expect_that(minute(date), equals(2)) expect_that(hour(date), equals(2)) expect_that(mday(date), equals(2)) expect_that(wday(date), equals(4)) expect_that(yday(date), equals(33)) expect_that(month(date), equals(2)) expect_that(year(date), equals(2011)) expect_that(tz(date), matches("UTC")) date2 <- update(as.Date("11/01/2010", "%m/%d/%Y"), seconds = 61, minutes = 61, hours = 25, days = 32, months = 13) expect_that(second(date2), equals(1)) expect_that(minute(date2), equals(2)) expect_that(hour(date2), equals(2)) expect_that(mday(date2), equals(2)) expect_that(wday(date2), equals(4)) expect_that(yday(date2), equals(33)) expect_that(month(date2), equals(2)) expect_that(year(date2), equals(2011)) expect_that(tz(date2), matches("UTC")) }) test_that("update performs consecutive roll overs correctly for POSIXlt objects",{ posl <- as.POSIXlt("2010-11-01 00:00:00", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") poslt <- update(posl, months = 13, days = 32, hours = 25, minutes = 61, seconds = 61) expect_that(second(poslt), equals(1)) expect_that(minute(poslt), equals(2)) expect_that(hour(poslt), equals(2)) expect_that(mday(poslt), equals(2)) expect_that(wday(poslt), equals(4)) expect_that(yday(poslt), equals(33)) expect_that(month(poslt), equals(2)) expect_that(year(poslt), equals(2011)) expect_that(tz(poslt), matches("GMT")) poslt2 <- update(posl, seconds = 61, minutes = 61, hours = 25, days = 32, months = 13) expect_that(second(poslt2), equals(1)) expect_that(minute(poslt2), equals(2)) expect_that(hour(poslt2), equals(2)) expect_that(mday(poslt2), equals(2)) expect_that(wday(poslt2), equals(4)) expect_that(yday(poslt2), equals(33)) expect_that(month(poslt2), equals(2)) expect_that(year(poslt2), equals(2011)) expect_that(tz(poslt2), matches("GMT")) }) test_that("update performs consecutive roll overs correctly for POSIXct objects",{ posc <- as.POSIXct("2010-11-01 00:00:00", tz = "GMT", format = "%Y-%m-%d %H:%M:%S") posct <- update(posc, months = 13, days = 32, hours = 25, minutes = 61, seconds = 61) expect_that(second(posct), equals(1)) expect_that(minute(posct), equals(2)) expect_that(hour(posct), equals(2)) expect_that(mday(posct), equals(2)) expect_that(wday(posct), equals(4)) expect_that(yday(posct), equals(33)) expect_that(month(posct), equals(2)) expect_that(year(posct), equals(2011)) expect_that(tz(posct), matches("GMT")) posct2 <- update(posc, seconds = 61, minutes = 61, hours = 25, days = 32, months = 13) expect_that(second(posct2), equals(1)) expect_that(minute(posct2), equals(2)) expect_that(hour(posct2), equals(2)) expect_that(mday(posct2), equals(2)) expect_that(wday(posct2), equals(4)) expect_that(yday(posct2), equals(33)) expect_that(month(posct2), equals(2)) expect_that(year(posct2), equals(2011)) expect_that(tz(posct2), matches("GMT")) }) test_that("update returns NA for date-times in the spring dst gap",{ poslt <- as.POSIXlt("2010-03-14 01:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") expect_that(is.na(update(poslt, seconds = 61)), is_true()) expect_that(is.na(update(poslt, minutes = 61)), is_true()) expect_that(is.na(update(poslt, hours = 2)), is_true()) poslt <- as.POSIXlt("2010-03-13 02:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") expect_that(is.na(update(poslt, mday = 14)), is_true()) expect_that(is.na(update(poslt, wday = 8)), is_true()) expect_that(is.na(update(poslt, yday = 73)), is_true()) poslt <- as.POSIXlt("2010-02-14 02:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") expect_that(is.na(update(poslt, months = 3)), is_true()) poslt <- as.POSIXlt("2009-03-14 02:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") poslt <- force_tz(poslt, tz = "America/New_York") expect_that(is.na(update(poslt, years = 2010)), is_true()) poslt <- as.POSIXlt("2010-03-14 02:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") expect_that(is.na(update(poslt, tz = "America/New_York")), is_true()) }) test_that("update handles vectors of dates",{ poslt <- as.POSIXlt(c("2010-02-14 01:59:59", "2010-02-15 01:59:59", "2010-02-16 01:59:59"), tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(second(update(poslt, seconds = 1)), equals(c(1,1,1))) expect_that(second(update(posct, seconds = 1)), equals(c(1,1,1))) expect_that(day(update(date, days = 1)), equals(c(1,1,1))) }) test_that("update handles vectors of dates and conformable vector of inputs",{ poslt <- as.POSIXlt(c("2010-02-14 01:59:59", "2010-02-15 01:59:59", "2010-02-16 01:59:59"), tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(second(update(poslt, seconds = c(1, 2, 3))), equals(c(1,2,3))) expect_that(second(update(posct, seconds = c(1, 2, 3))), equals(c(1,2,3))) expect_that(day(update(date, days = c(1, 2, 3))), equals(c(1,2,3))) }) test_that("update handles single vector of inputs",{ poslt <- as.POSIXlt("2010-03-14 01:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(second(update(poslt, seconds = c(1, 2, 3))), equals(c(1,2,3))) expect_that(second(update(posct, seconds = c(1, 2, 3))), equals(c(1,2,3))) expect_that(day(update(date, days = c(1, 2, 3))), equals(c(1,2,3))) }) test_that("update handles conformable vectors of inputs",{ poslt <- as.POSIXlt("2010-03-10 01:59:59", tz = "UTC", format = "%Y-%m-%d %H:%M:%S") posct <- as.POSIXct(poslt) date <- as.Date(poslt) expect_that(second(update(poslt, seconds = c(1,2), minutes = c(1,2,3,4))), equals(c(1,2,1,2))) expect_that(second(update(posct, seconds = c(1,2), minutes = c(1,2,3,4))), equals(c(1,2,1,2))) expect_that(day(update(date, days = c(1,2), months = c(1,2,3,4))), equals(c(1,2,1,2))) }) test_that("update.POSIXct returns input of length zero when given input of length zero",{ x <- structure(vector(mode = "numeric"), class = c("POSIXct", "POSIXt")) expect_equal(update(x, days = 1), x) }) test_that("update.POSIXlt returns input of length zero when given input of length zero",{ x <- as.POSIXlt(structure(vector(mode = "numeric"), class = c("POSIXct", "POSIXt"))) expect_equal(update(x, days = 1), x) }) test_that("update correctly handles 60 seconds on 59 minute (bug #313)", { expect_equal(ymd_hms("2015-01-01 00:59:00") + seconds(60), ymd_hms("2015-01-01 01:00:00")) expect_equal(ymd_hms("2015-01-01 01:59:00") + seconds(60), ymd_hms("2015-01-01 02:00:00")) expect_equal(ymd_hms("2015-01-01 23:59:00") + seconds(60), ymd_hms("2015-01-02 00:00:00")) expect_equal(ymd_hms("2015-01-01 00:59:05") + seconds(55), ymd_hms("2015-01-01 01:00:00")) expect_equal(ymd_hms("2015-01-01 00:59:59") + seconds(1), ymd_hms("2015-01-01 01:00:00")) }) ## ## bug #319 ## x <- structure(list(sec = 0, min = 0, hour = 0, mday = -212, mon = 7L, ## year = 108L, wday = NA_integer_, yday = NA_integer_, isdst = 0L, ## zone = "EST", gmtoff = -18000L), ## .Names = c("sec", "min", ## "hour", "mday", "mon", "year", "wday", "yday", "isdst", "zone", ## "gmtoff"), ## tzone = c("America/New_York", "EST", "EDT"), ## class = c("POSIXlt", "POSIXt")) ## update(x, year = year(x) + 1) lubridate/tests/testthat/test-pretty.R0000644000175100001440000000163312705366146017711 0ustar hornikuserscontext("Pretty formatting of dates") test_that("pretty_dates works for years", { ## https://github.com/hadley/lubridate/issues/227 expect_equal(pretty_dates(c(as.Date("1993-12-05"), as.Date("2007-12-01")), 7), ymd(c("1993-01-01 UTC", "1995-01-01 UTC", "1997-01-01 UTC", "1999-01-01 UTC", "2001-01-01 UTC", "2003-01-01 UTC", "2005-01-01 UTC", "2007-01-01 UTC"), tz = "UTC")) ## https://github.com/hadley/lubridate/issues/248 expect_equal( pretty_dates(ymd_hms("2014-02-05 22:45:46 GMT", "2014-03-03 14:28:20"), 10), ymd(c("2014-02-05 UTC", "2014-02-07 UTC", "2014-02-09 UTC", "2014-02-11 UTC", "2014-02-13 UTC", "2014-02-15 UTC", "2014-02-17 UTC", "2014-02-19 UTC", "2014-02-21 UTC", "2014-02-23 UTC", "2014-02-25 UTC", "2014-02-27 UTC", "2014-03-01 UTC", "2014-03-03 UTC"), tz = "UTC")) }) lubridate/tests/testthat/test-intervals.R0000644000175100001440000005625112705366146020377 0ustar hornikuserscontext("Intervals") test_that("is.interval works as expected",{ expect_that(is.interval(234), is_false()) expect_that(is.interval(as.POSIXct("2008-08-03 13:01:59", tz = "UTC")), is_false()) expect_that(is.interval(as.POSIXlt("2008-08-03 13:01:59", tz = "UTC")), is_false()) expect_that(is.interval(Sys.Date()), is_false()) expect_that(is.interval(minutes(1)), is_false()) expect_that(is.interval(dminutes(1)), is_false()) expect_that(is.interval(interval( as.POSIXct("2008-08-03 13:01:59", tz = "UTC"), as.POSIXct("2009-08-03 13:01:59", tz = "UTC") )), is_true()) }) test_that("is.interval handles vectors",{ expect_that(is.interval(interval( as.POSIXct(c("2008-08-03 13:01:59", "2009-08-03 13:01:59"), tz = "UTC"), as.POSIXct("2010-08-03 13:01:59", tz = "UTC"))), is_true()) }) test_that("interval works as expected", { time1 <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") time2 <- as.POSIXct("2009-08-03 13:01:59", tz = "UTC") int <- interval(time1, time2) num <- as.numeric(time2) - as.numeric(time1) expect_equal(int@.Data, num) expect_equal(int@start, time1) expect_is(int, "Interval") }) test_that("interval handles vector input", { time1 <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") time2 <- as.POSIXct("2009-08-03 13:01:59", tz = "UTC") time3 <- as.POSIXct("2009-08-04 13:01:59", tz = "UTC") int <- interval(c(time1,time2), time3) num <- as.numeric(time3) - as.numeric(c(time1, time2)) expect_equal(int@.Data, num) expect_equal(int@start, c(time1, time2)) expect_is(int, "Interval") int2 <- interval(time1, c(time3, time2)) num2 <- as.numeric(c(time3, time2)) - as.numeric(time1) starts <- structure(c(time1, time1), "tzone" = "UTC") expect_equal(int2@.Data, num2) expect_equal(int2@start, starts) expect_is(int2, "Interval") }) test_that("format.Interval works as expected", { time1 <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") time2 <- as.POSIXct("2009-08-03 13:01:59", tz = "UTC") int <- interval(time1, time2) expect_match(format(int), "2008-08-03 13:01:59 UTC--2009-08-03 13:01:59 UTC") }) test_that("interval handles character inputs", { t1 <- c("2007-01-01") t2 <- c("2007-08-01") expect_equal(interval(t1, t2), new("Interval", 18316800, start = as.POSIXct("2007-01-01", tz = "UTC"), tzone = "UTC")) t1 <- c("2007-01-01") t2 <- c("2007-08-01 00:01:02") expect_equal(interval(t1, t2), new("Interval", 18316862, start = as.POSIXct("2007-01-01", tz = "UTC"), tzone = "UTC")) }) test_that("interval handles POSIXlt inputs", { t1 <- as.POSIXlt("2007-01-01") t2 <- as.POSIXlt("2007-08-01") expect_equal(interval(t1, t2), new("Interval", 18316800, start = as.POSIXct("2007-01-01", tz = "UTC"), tzone = "UTC")) t1 <- as.POSIXlt("2007-01-01") t2 <- as.POSIXlt("2007-08-01 00:01:02") expect_equal(interval(t1, t2), new("Interval", 18316862, start = as.POSIXct("2007-01-01", tz = "UTC"), tzone = "UTC")) }) test_that("as.interval works as expected", { a <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") pint <- interval(a, a + days(1)) dint <- interval(a, a + ddays(1)) expect_equal(pint, as.interval(days(1), a)) expect_equal(dint, as.interval(ddays(1), a)) }) test_that("as.interval handles vector input", { a <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") b <- as.POSIXct("2009-08-03 13:01:59", tz = "UTC") pint <- interval(a, a + days(1:2)) dint <- interval(a, a + ddays(1:2)) pint1 <- interval(c(a,b), c(a,b) + days(1:2)) dint1 <- interval(c(a,b), c(a,b) + ddays(1:2)) pint2 <- interval(c(a,b), c(a,b) + days(1)) dint2 <- interval(c(a,b), c(a,b) + ddays(1)) expect_equal(pint, as.interval(days(1:2), a)) expect_equal(dint, as.interval(ddays(1:2), a)) expect_equal(pint1, as.interval(days(1:2), c(a,b))) expect_equal(dint1, as.interval(days(1:2), c(a,b))) expect_equal(pint2, as.interval(days(1), c(a,b))) expect_equal(dint2, as.interval(days(1), c(a,b))) }) test_that("[<- can subset intervals", { ints <- data.frame(spans = c(interval(ymd(20090201), ymd(20090101)), interval(ymd(20090201), ymd(20090101)))) my_int <- interval(ymd(18800101), ymd(18810101)) ints[1,1] <- 31536000 ints[2,1] <- my_int int2 <- interval(ymd(20090201), ymd(20100201)) expect_equal(ints[1,1], int2) expect_equal(ints[2,1], my_int) }) test_that("format.Interval correctly displays intervals of length 0", { int <- interval(ymd(18800101), ymd(18810101)) expect_output(print(int[FALSE]), "Interval\\(0)") }) test_that("interval handles correctly time zones of Date objects", { expect_equal(interval(as.Date('2011-01-01'), as.Date('2013-01-01')), interval(ymd('2011-01-01'), ymd('2013-01-01'))) }) test_that("summary.Interval creates useful summary", { int <- interval(ymd(20090201), ymd(20090101)) text <- c(3, "2009-01-01", "2009-02-01", "UTC", 1) names(text) <- c("Intervals", "Earliest endpoint", "Latest endpoint", "Time zone", "NA's") expect_equal(summary(c(int, int, int, as.interval(NA))), text) }) test_that("as.interval handles NAs", { expect_equal(as.interval(NA), interval(NA, NA)) }) test_that("c.interval works as expected", { time1 <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") time2 <- as.POSIXct("2009-08-03 15:03:39", tz = "UTC") int <- interval(time1, time2) ints <- interval(c(time1, time1), c(time2, time2)) nants <- interval(c(time1, NA), c(time2, NA)) expect_equal(c(int, int), ints) expect_equal(c(int, NA), nants) }) test_that("%--% works as expected", { time1 <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") time2 <- as.POSIXct("2009-08-03 15:03:39", tz = "UTC") int <- interval(time1, time2) attempt <- time1 %--% time2 expect_equal(attempt, int) }) test_that("int_start and int_end work as expected", { time1 <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") time2 <- as.POSIXct("2009-08-03 15:03:39", tz = "UTC") int1 <- interval(time1, time2) int2 <- interval(time2, time1) expect_equal(int_start(int1), time1) expect_equal(int_start(int2), time2) expect_equal(int_start(c(int1, int2)), c(time1, time2)) expect_equal(int_end(int1), time2) expect_equal(int_end(int2), time1) expect_equal(int_end(c(int2, int1)), c(time1, time2)) }) test_that("int_length works as expected", { time1 <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") time2 <- time1 + 1111 time3 <- time1 - 5555 int <- interval(time1, time2) int2 <- interval(time1, time3) expect_equal(int_length(int), 1111) expect_equal(int_length(int2), -5555) expect_equal(int_length(c(int, int2)), c(1111, -5555)) }) test_that("int_shift works as expected", { time1 <- as.POSIXct("2001-01-01", tz = "UTC") time2 <- as.POSIXct("2002-01-01", tz = "UTC") int <- interval(time1, time2) int2 <- interval(time2, time1) dur <- new_duration(seconds = 11*24*60*60) dur2 <- new_duration(seconds = -3600) dint <- interval(time1 + 11*24*60*60, time2 + 11*24*60*60) dint2 <- interval(time2 + 11*24*60*60, time1 + 11*24*60*60) nint <- interval(time1 - 3600, time2 - 3600) nint2 <- interval(time2 - 3600, time1 - 3600) expect_equal(int_shift(int, dur), dint) expect_equal(int_shift(int, dur2), nint) expect_equal(int_shift(int, c(dur, dur2)), c(dint, nint)) expect_equal(int_shift(int2, dur), dint2) expect_equal(int_shift(int2, dur2), nint2) expect_equal(int_shift(int2, c(dur, dur2)), c(dint2, nint2)) expect_equal(int_shift(c(int, int2), dur), c(dint, dint2)) expect_equal(int_shift(c(int, int2), dur2), c(nint, nint2)) expect_equal(int_shift(c(int, int2), c(dur, dur2)), c(dint, nint2)) expect_equal(int_shift(c(int, int2), c(dur2, dur)), c(nint, dint2)) }) test_that("int_overlaps works as expected", { time1 <- as.POSIXct("2001-01-01", tz = "UTC") time2 <- as.POSIXct("2002-01-01", tz = "UTC") time21 <- as.POSIXct("2001-06-01", tz = "UTC") time22 <- as.POSIXct("2002-06-01", tz = "UTC") time31 <- as.POSIXct("2003-01-01", tz = "UTC") time32 <- as.POSIXct("2004-01-01", tz = "UTC") int1 <- interval(time1, time2) int2 <- interval(time21, time22) int3 <- interval(time31, time32) nint1 <- interval(time2, time1) nint2 <- interval(time22, time21) nint3 <- interval(time32, time31) expect_true(int_overlaps(int1, int2)) expect_false(int_overlaps(int1, int3)) expect_equal(int_overlaps(int1, c(int2, int3)), c(TRUE, FALSE)) expect_equal(int_overlaps(c(int1, int3), int2), c(TRUE, FALSE)) expect_true(int_overlaps(nint1, nint2)) expect_false(int_overlaps(nint1, nint3)) expect_equal(int_overlaps(nint1, c(nint2, nint3)), c(TRUE, FALSE)) expect_equal(int_overlaps(c(nint1, nint3), nint2), c(TRUE, FALSE)) expect_true(int_overlaps(int1, nint2)) expect_true(int_overlaps(nint1, int2)) expect_false(int_overlaps(int1, nint3)) expect_false(int_overlaps(nint1, int3)) expect_equal(int_overlaps(int1, c(int2, nint3)), c(TRUE, FALSE)) expect_equal(int_overlaps(c(int1, nint3), nint2), c(TRUE, FALSE)) }) test_that("int_aligns works as expected", { time1 <- as.POSIXct("2001-01-01", tz = "UTC") time2 <- as.POSIXct("2002-01-01", tz = "UTC") time21 <- as.POSIXct("2001-06-01", tz = "UTC") time22 <- as.POSIXct("2002-01-01", tz = "UTC") time31 <- as.POSIXct("2003-01-01", tz = "UTC") time32 <- as.POSIXct("2004-01-01", tz = "UTC") int1 <- interval(time1, time2) int2 <- interval(time21, time22) int3 <- interval(time31, time32) nint1 <- interval(time2, time1) nint2 <- interval(time22, time21) nint3 <- interval(time32, time31) expect_true(int_aligns(int1, int2)) expect_false(int_aligns(int1, int3)) expect_equal(int_aligns(int1, c(int2, int3)), c(TRUE, FALSE)) expect_equal(int_aligns(c(int1, int3), int2), c(TRUE, FALSE)) expect_true(int_aligns(nint1, nint2)) expect_false(int_aligns(nint1, nint3)) expect_equal(int_aligns(nint1, c(nint2, nint3)), c(TRUE, FALSE)) expect_equal(int_aligns(c(nint1, nint3), nint2), c(TRUE, FALSE)) expect_true(int_aligns(int1, nint2)) expect_true(int_aligns(nint1, int2)) expect_false(int_aligns(int1, nint3)) expect_false(int_aligns(nint1, int3)) expect_equal(int_aligns(int1, c(int2, nint3)), c(TRUE, FALSE)) expect_equal(int_aligns(c(int1, nint3), nint2), c(TRUE, FALSE)) }) test_that("int_diff works as expected", { time1 <- as.POSIXct("2001-01-01", tz = "UTC") time2 <- as.POSIXct("2002-01-01", tz = "UTC") time3 <- as.POSIXct("2003-06-01", tz = "UTC") time4 <- as.POSIXct("2002-01-01", tz = "UTC") time5 <- as.POSIXct("2003-01-01", tz = "UTC") time6 <- as.POSIXct("2004-01-01", tz = "UTC") times <- c(time1, time2, time3, time4, time5, time6) int1 <- interval(time1, time2) int2 <- interval(time2, time3) int3 <- interval(time3, time4) int4 <- interval(time4, time5) int5 <- interval(time5, time6) ints <- c(int1, int2, int3, int4, int5) expect_equal(int_diff(times), ints) }) test_that("int_standardize works as expected", { int <- interval(ymd(20100101), ymd(20090101)) standard <- interval(ymd(20090101), ymd(20100101)) ints <- c(int, int) ints2 <- c(int, standard) standards <- c(standard, standard) expect_equal(int_standardize(int), standard) expect_equal(int_standardize(standard), standard) expect_equal(int_standardize(ints), standards) expect_equal(int_standardize(ints2), standards) expect_equal(int_standardize(standards), standards) }) test_that("int_flip works as expected", { int <- interval(ymd(20100101), ymd(20090101)) flip <- interval(ymd(20090101), ymd(20100101)) ints <- c(int, int) ints2 <- c(int, flip) flips <- c(flip, flip) flips2 <- c(flip, int) expect_equal(int_flip(int), flip) expect_equal(int_flip(ints), flips) expect_equal(int_flip(ints2), flips2) expect_equal(int_flip(flip), int) expect_equal(int_flip(flips), ints) expect_equal(int_flip(flips2), ints2) }) test_that("intersect.Interval works as expected", { time1 <- as.POSIXct("2001-01-01", tz = "UTC") time2 <- as.POSIXct("2002-01-01", tz = "UTC") time21 <- as.POSIXct("2001-06-01", tz = "UTC") time22 <- as.POSIXct("2002-06-01", tz = "UTC") time31 <- as.POSIXct("2003-01-01", tz = "UTC") time32 <- as.POSIXct("2004-01-01", tz = "UTC") int1 <- interval(time1, time2) int2 <- interval(time21, time22) int3 <- interval(time31, time32) nint1 <- interval(time2, time1) nint2 <- interval(time22, time21) nint3 <- interval(time32, time31) expect_equal(intersect(int1, int2), interval(time21, time2)) expect_equal(intersect(int1, int3), interval(NA, NA, tz = "UTC")) expect_equal(intersect(int1, c(int2, int3)), interval(c(time21, NA), c(time2, NA))) expect_equal(intersect(c(int1, int3), int2), interval(c(time21, NA), c(time2, NA))) expect_equal(intersect(c(int1, int3), c(int2, int2)), interval(c(time21, NA), c(time2, NA))) expect_equal(intersect(nint1, nint2), interval(time2, time21)) expect_equal(intersect(nint1, nint3), interval(NA, NA, tz = "UTC")) expect_equal(intersect(nint1, c(nint2, nint3)), interval(c(time2, NA), c(time21, NA))) expect_equal(intersect(c(nint1, nint3), nint2), interval(c(time2, NA), c(time21, NA))) expect_equal(intersect(c(nint1, nint3), c(nint2, nint2)), interval(c(time2, NA), c(time21, NA))) expect_equal(intersect(int1, nint2), interval(time21, time2)) expect_equal(intersect(nint1, nint2), interval(time2, time21)) expect_equal(intersect(int1, nint3), interval(NA, NA, tz = "UTC")) expect_equal(intersect(nint1, int3), interval(NA, NA, tz = "UTC")) expect_equal(intersect(int1, c(nint2, int3)), interval(c(time21, NA), c(time2, NA))) expect_equal(intersect(nint1, c(int2, int3)), interval(c(time2, NA), c(time21, NA))) expect_equal(intersect(c(int1, nint3), nint2), interval(c(time21, NA), c(time2, NA))) expect_equal(intersect(c(nint1, int3), nint2), interval(c(time2, NA), c(time21, NA))) expect_equal(intersect(c(int1, nint3), int2), interval(c(time21, NA), c(time2, NA))) expect_equal(intersect(c(nint1, int3), int2), interval(c(time2, NA), c(time21, NA))) expect_equal(intersect(c(int1, nint3), c(nint2, int2)), interval(c(time21, NA), c(time2, NA))) expect_equal(intersect(c(nint1, int3), c(int2, nint2)), interval(c(time2, NA), c(time21, NA))) }) test_that("union.Interval works as expected", { time1 <- as.POSIXct("2001-01-01", tz = "UTC") time2 <- as.POSIXct("2002-01-01", tz = "UTC") time21 <- as.POSIXct("2001-06-01", tz = "UTC") time22 <- as.POSIXct("2002-06-01", tz = "UTC") time31 <- as.POSIXct("2003-01-01", tz = "UTC") time32 <- as.POSIXct("2004-01-01", tz = "UTC") int1 <- interval(time1, time2) int2 <- interval(time21, time22) int3 <- interval(time31, time32) nint1 <- interval(time2, time1) nint2 <- interval(time22, time21) nint3 <- interval(time32, time31) expect_equal(suppressMessages(union(int1, int2)), interval(time1, time22)) expect_equal(suppressMessages(union(int1, int3)), interval(time1, time32)) expect_equal(suppressMessages(union(int3, int1)), interval(time1, time32)) expect_equal(suppressMessages(union(int1, c(int2, int3))), interval(c(time1, time1), c(time22, time32))) expect_equal(suppressMessages(union(c(int1, int3), int2)), interval(c(time1, time21), c(time22, time32))) expect_equal(suppressMessages(union(c(int1, int3), c(int2, int1))), interval(c(time1, time1), c(time22, time32))) expect_equal(suppressMessages(union(nint1, nint2)), interval(time22, time1)) expect_equal(suppressMessages(union(nint1, nint3)), interval(time32, time1)) expect_equal(suppressMessages(union(nint3, nint1)), interval(time32, time1)) expect_equal(suppressMessages(union(nint1, c(nint2, nint3))), interval(c(time22, time32), c(time1, time1))) expect_equal(suppressMessages(union(c(nint1, nint3), nint2)), interval(c(time22, time32), c(time1, time21))) expect_equal(suppressMessages(union(c(nint1, nint3), c(nint2, nint1))), interval(c(time22, time32), c(time1, time1))) expect_equal(suppressMessages(union(int1, nint2)), interval(time1, time22)) expect_equal(suppressMessages(union(nint1, int2)), interval(time22, time1)) expect_equal(suppressMessages(union(int1, nint3)), interval(time1, time32)) expect_equal(suppressMessages(union(nint1, int3)), interval(time32, time1)) expect_equal(suppressMessages(union(int3, nint1)), interval(time1, time32)) expect_equal(suppressMessages(union(nint3, int1)), interval(time32, time1)) expect_equal(suppressMessages(union(int1, c(nint2, nint3))), interval(c(time1, time1), c(time22, time32))) expect_equal(suppressMessages(union(nint1, c(int2, int3))), interval(c(time22, time32), c(time1, time1))) expect_equal(suppressMessages(union(nint1, c(int2, nint3))), interval(c(time22, time32), c(time1, time1))) expect_equal(suppressMessages(union(c(int1, int3), nint2)), interval(c(time1, time21), c(time22, time32))) expect_equal(suppressMessages(union(c(nint1, nint3), int2)), interval(c(time22, time32), c(time1, time21))) expect_equal(suppressMessages(union(c(int1, nint3), nint2)), interval(c(time1, time32), c(time22, time21))) expect_equal(suppressMessages(union(c(int1, int3), c(nint2, nint1))), interval(c(time1, time1), c(time22, time32))) expect_equal(suppressMessages(union(c(nint1, nint3), c(int2, int1))), interval(c(time22, time32), c(time1, time1))) expect_equal(suppressMessages(union(c(int1, nint3), c(nint2, int1))), interval(c(time1, time32), c(time22, time1))) }) test_that("setdiff.Interval works as expected", { time1 <- as.POSIXct("2001-01-01", tz = "UTC") time2 <- as.POSIXct("2002-01-01", tz = "UTC") time21 <- as.POSIXct("2001-06-01", tz = "UTC") time22 <- as.POSIXct("2002-06-01", tz = "UTC") time31 <- as.POSIXct("2003-01-01", tz = "UTC") time32 <- as.POSIXct("2004-01-01", tz = "UTC") int1 <- interval(time1, time2) int2 <- interval(time21, time22) int3 <- interval(time31, time32) nint1 <- interval(time2, time1) nint2 <- interval(time22, time21) nint3 <- interval(time32, time31) arrive <- ymd_hms("2011-06-04 12:00:00", tz = "Pacific/Auckland") leave <- ymd_hms("2011-08-10 14:00:00", tz = "Pacific/Auckland") auckland <- interval(arrive, leave) jsm2 <- interval(ymd(20110720, tz = "Pacific/Auckland"), ymd(20110731, tz = "Pacific/Auckland")) expect_equal(setdiff(int1, int2), interval(time1, time21)) expect_equal(setdiff(int1, int3), int1) expect_equal(setdiff(int1, c(int2, int3)), c(interval(time1, time21), int1)) expect_equal(setdiff(c(int1, int3), int2), c(interval(time1, time21), int3)) expect_equal(setdiff(c(int1, int3), c(int2, int2)), c(interval(time1, time21), int3)) expect_equal(setdiff(nint1, nint2), interval(time21, time1)) expect_equal(setdiff(nint1, nint3), nint1) expect_equal(setdiff(nint1, c(nint2, nint3)), c(interval(time21, time1), nint1)) expect_equal(setdiff(c(nint1, nint3), nint2), c(interval(time21, time1), nint3)) expect_equal(setdiff(c(nint1, nint3), c(nint2, nint2)), c(interval(time21, time1), nint3)) expect_equal(setdiff(int1, nint2), interval(time1, time21)) expect_equal(setdiff(nint1, int2), interval(time21, time1)) expect_equal(setdiff(int1, nint3), int1) expect_equal(setdiff(nint1, int3), nint1) expect_equal(setdiff(int1, c(nint2, nint3)), c(interval(time1, time21), int1)) expect_equal(setdiff(nint1, c(int2, int3)), c(interval(time21, time1), nint1)) expect_equal(setdiff(int1, c(nint2, int3)), c(interval(time1, time21), int1)) expect_equal(setdiff(nint1, c(int2, nint3)), c(interval(time21, time1), nint1)) expect_equal(setdiff(c(int1, int3), nint2), c(interval(time1, time21), int3)) expect_equal(setdiff(c(nint1, nint3), int2), c(interval(time21, time1), nint3)) expect_equal(setdiff(c(nint1, int3), nint2), c(interval(time21, time1), int3)) expect_equal(setdiff(c(int1, int3), c(nint2, nint2)), c(interval(time1, time21), int3)) expect_equal(setdiff(c(nint1, nint3), c(int2, int2)), c(interval(time21, time1), nint3)) expect_equal(setdiff(c(int1, nint3), c(nint2, int2)), c(interval(time1, time21), nint3)) expect_error(setdiff(auckland, jsm2), "Cases 1 result in discontinuous intervals.") }) test_that("%within% works as expected", { time1 <- as.POSIXct("2001-01-01", tz = "UTC") time2 <- as.POSIXct("2003-01-01", tz = "UTC") time3 <- as.POSIXct("2001-06-01", tz = "UTC") time4 <- as.POSIXct("2002-06-01", tz = "UTC") time5 <- as.POSIXct("2003-01-01", tz = "UTC") time6 <- as.POSIXct("2004-01-01", tz = "UTC") time7 <- as.POSIXct("2003-01-02", tz = "UTC") base <- interval(time1, time2) ins <- interval(time3, time4) bord <- interval(time5, time6) olap <- interval(time4, time6) outs <- interval(time7, time6) nbase <- interval(time2, time1) nins <- interval(time4, time3) nbord <- interval(time6, time5) nolap <- interval(time6, time4) nouts <- interval(time6, time7) expect_true(ins %within% base) expect_false(outs %within% base) expect_false(bord %within% base) expect_false(olap %within% base) expect_true(nins %within% nbase) expect_false(nouts %within% nbase) expect_false(nbord %within% nbase) expect_false(nolap %within% nbase) expect_true(ins %within% nbase) expect_false(outs %within% nbase) expect_false(bord %within% nbase) expect_false(olap %within% nbase) expect_true(nins %within% base) expect_false(nouts %within% base) expect_false(nbord %within% base) expect_false(nolap %within% base) }) test_that("summary.Interval creates useful summary", { time1 <- as.POSIXct("2001-01-01", tz = "UTC") time2 <- as.POSIXct("2003-01-01", tz = "UTC") int <- interval(time1, time2) text <- structure(c("1", "2001-01-01", "2003-01-01", "UTC", "1"), .Names = c("Intervals", "Earliest endpoint", "Latest endpoint", "Time zone", "NA's")) expect_equal(summary(c(int, NA)), text) }) test_that("intersect on intervals propagates NAs (#226)", { expect_equal(intersect(c(interval("2014-01-15", "2014-01-16"), interval("2014-01-15", "2014-01-16")), c(interval(NA,NA),interval(NA,NA))), c(interval(NA,NA),interval(NA,NA))) expect_equal(intersect(c(interval("2014-01-15", "2014-01-16"), interval("2014-01-15", "2014-01-16"), interval("2014-01-01", "2014-01-30")), c(interval(NA,NA), interval(NA,NA), interval("2014-01-15", "2014-02-16"))), c(interval(NA,NA),interval(NA,NA), interval("2014-01-15", "2014-01-30"))) }) test_that("Reduce works with intervals (#348)", { ints <- c( interval(ymd("2001-01-01"), ymd("2002-01-01")), interval(ymd("2001-01-01"), ymd("2004-01-01")), interval(ymd("2001-02-01"), ymd("2002-01-01")) ) expect_equal(Reduce(union, ints), interval(ymd("2001-01-01"), ymd("2004-01-01"))) }) lubridate/tests/testthat/test-periods.R0000644000175100001440000003501312765536311020025 0ustar hornikuserscontext("Periods") test_that("period constructor doesn't accept non-numeric or non-character inputs", { expect_error(period(interval(ymd("2014-01-01"), ymd("2015-01-01")))) }) test_that("parsing works as expected", { expect_equal(period("1min 2sec 2secs 1H 2M 1d"), period(seconds = 4, minutes = 3, hours = 1, days = 1)) expect_equal(period("day day"), period(days = 2)) expect_equal(period("S M H d m y"), period(seconds = 1, minutes = 1, hours = 1, days = 1, months = 1, years = 1)) expect_equal(period("2S 3M 4H 5d 6w 7m 8y"), period(seconds = 2, minutes = 3, hours = 4, days = 5, weeks = 6, months = 7, years = 8)) }) test_that("character comparison with periods works as expected", { expect_true("day" == period(days = 1)) expect_true("2 days, 2 secs" == period(days = 2, seconds = 2)) expect_true(period("day 1s") > period(days = 1)) expect_true("day 1s" > period(days = 1)) expect_true("day 1S 2H" == period(days = 1, seconds = 1, hours = 2)) expect_false("day 1S 2H" < period(days = 1, hours = 2)) expect_true("day 1S 2H 3m 2y" > period(days = 1, months = 3, years = 2, hours = 2)) }) test_that("is.period works as expected",{ expect_that(is.period(234), is_false()) expect_that(is.period(as.POSIXct("2008-08-03 13:01:59", tz = "UTC")), is_false()) expect_that(is.period(as.POSIXlt("2008-08-03 13:01:59", tz = "UTC")), is_false()) expect_that(is.period(Sys.Date()), is_false()) expect_that(is.period(minutes(1)), is_true()) expect_that(is.period(dminutes(1)), is_false()) expect_that(is.period(interval( as.POSIXct("2008-08-03 13:01:59", tz = "UTC"), as.POSIXct("2009-08-03 13:01:59", tz = "UTC") )), is_false()) }) test_that("is.period handles vectors",{ expect_that(is.period(minutes(1:3)), is_true()) }) test_that("period works as expected", { per <- period(second = 90, minute = 5) expect_is(per, "Period") expect_equal(period(hours = 25), hours(25)) expect_equal(per@year, 0) expect_equal(per@month, 0) expect_equal(per@day, 0) expect_equal(per@hour, 0) expect_equal(per@minute, 5) expect_equal(per@.Data, 90) }) test_that("period works as expected", { per <- period(c(90, 5), c("second", "minute")) expect_is(per, "Period") expect_equal(period(hours = 25), hours(25)) expect_equal(per@year, 0) expect_equal(per@month, 0) expect_equal(per@day, 0) expect_equal(per@hour, 0) expect_equal(per@minute, 5) expect_equal(per@.Data, 90) }) test_that("period handles vector input", { per <- period(second = c(90,60), minute = 5) expect_is(per, "Period") expect_equal(length(per), 2) expect_equal(per@year, c(0, 0)) expect_equal(per@month, c(0, 0)) expect_equal(per@day, c(0, 0)) expect_equal(per@hour, c(0, 0)) expect_equal(per@minute, c(5, 5)) expect_equal(per@.Data, c(90, 60)) }) test_that("period objects handle vector input", { x <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") expect_that(as.numeric(x + minutes(c(1,3,4))), equals(as.numeric(x + c(60,180,240)))) }) test_that("format.Period works as expected", { per <- period(second = 90, minute = 5) per2 <- period(days = 0) per3 <- period(years = 1, days = NA) expect_match(format(per), "5M 90S") expect_match(format(per2), "0S") expect_equivalent(format(per3), as.character(NA)) }) test_that("as.numeric and as.duration correctly handle periods", { tt <- period(24, "hours") + period(60, "minutes") expect_equal(as.numeric(tt, "hour"), 25) tt <- period(hours = 24, minutes = 6) expect_equal(as.numeric(tt, "hour"), 24.1) expect_equal(as.numeric(tt, "hour"), as.numeric(as.duration(tt), "hour")) }) test_that("as.period handles interval objects", { start <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") end <- as.POSIXct("2009-08-03 13:01:59", tz = "UTC") int <- interval(start, end) int_neg <- interval(end, start) expect_that(as.period(int), equals(years(1))) expect_that(as.period(int_neg), equals(years(-1))) }) test_that("as.period handles intervals across years correctly", { ## https://github.com/hadley/lubridate/issues/371 t1 <- ymd("1985-11-30") t2 <- ymd("1986-02-01") expect_equal(t2, t1 + as.period(interval(t1, t2))) ## negative t1 <- ymd("1986-02-01") t2 <- ymd("1985-11-30") expect_equal(t2, t1 + as.period(interval(t1, t2))) t1 <- "1985-11-01" t2 <- "2007-08-01" as.period(interval(t1, t2)) ymd(t1) + as.period(interval(t1, t2, "UTC")) ## negative t1 <- "2007-08-01" t2 <- "1985-11-01" as.period(interval(t1, t2)) ymd(t1) + as.period(interval(t1, t2, "UTC")) t1 <- ymd("1986-02-01") t2 <- ymd("1986-01-05") expect_equal(t2, t1 + as.period(interval(t1, t2))) }) test_that("as.period handles vector interval objects", { ## https://github.com/hadley/lubridate/issues/349 ints <- c(interval(ymd("2001-01-01"), ymd("2002-01-01")), interval(ymd("2001-01-01"), ymd("2004-01-01"))) expect_equal(as.period(ints), period(years = c(1, 3))) ints <- c(interval(ymd("2001-01-01"), ymd("2002-03-05")), interval(ymd("2001-01-01"), ymd_hms("2004-12-31 3:2:1"))) expect_equal(as.period(ints), period(years = c(1, 3), months = c(2, 11), days = c(4, 30), hours = c(0, 3), minutes = c(0, 2), seconds = c(0, 1))) }) test_that("as.period handles don't produce negative periods", { p2 <- as.period(interval(ymd("1985-12-31"),ymd("1986-02-01"))) expect_equal(month(p2), 1) p3 <- as.period(interval(ymd("1985-12-31"),ymd("1986-03-01"))) expect_equal(month(p3), 2) expect_equal(day(p3), 1) }) test_that("as.period handles interval objects with special start dates", { start <- ymd('1992-02-29') end <- ymd('2010-12-05') int <- interval(start, end) expect_that(as.period(int), equals(period(c(18, 9, 6), c("year", "month", "day")))) expect_that(as.period(int) + start, equals(end)) }) test_that("as.period with different units handles interval objects", { start <- ymd('1992-02-29') end <- ymd_hms('2010-12-05 01:02:03') int <- interval(start, end) expect_that(as.period(int), equals(period(c(18, 9, 6, 1, 2, 3), c("year", "month", "day", "hour", "minute", "second")))) expect_that(as.period(int) + start, equals(end)) expect_that(as.period(int, "months"), equals(period(c(225, 6, 1, 2, 3), c("month", "day", "hour", "minute", "second")))) expect_that(as.period(int, "months") + start, equals(end)) expect_that(as.period(int, "hours"), equals(period(c(164497, 2, 3), c("hour", "minute", "second")))) expect_that(as.period(int, "hours") + start, equals(end)) expect_that(as.period(int, "minute"), equals(period(c(9869822, 3), c("minute", "second")))) expect_that(as.period(int, "minute") + start, equals(end)) expect_that(as.period(int, "second"), equals(period(c(592189323), c("second")))) expect_that(as.period(int, "second") + start, equals(end)) }) test_that("as.period with different units handles negative interval objects", { end <- ymd('1992-02-29', tz = "UTC") start <- ymd_hms('2010-12-05 01:02:03') int <- interval(start, end) expect_that(as.period(int), equals(period(-c(18, 9, 5, 1, 2, 3), c("year", "month", "day", "hour", "minute", "second")))) expect_that(as.period(int) + start, equals(end)) expect_that(as.period(int, "months"), equals(period(-c(225, 5, 1, 2, 3), c("month", "day", "hour", "minute", "second")))) expect_that(as.period(int, "months") + start, equals(end)) expect_that(as.period(int, "hours"), equals(period(-c(164497, 2, 3), c("hour", "minute", "second")))) expect_that(as.period(int, "hours") + start, equals(end)) expect_that(as.period(int, "minute"), equals(period(-c(9869822, 3), c("minute", "second")))) expect_that(as.period(int, "minute") + start, equals(end)) expect_that(as.period(int, "second"), equals(period(-c(592189323), c("second")))) expect_that(as.period(int, "second") + start, equals(end)) }) test_that("as.period handles tricky intervals", { expect_equal( as.period(interval(ymd("1986-01-31"), ymd("1986-02-01"))) , period(days = 1)) expect_equal( as.period(interval(ymd("1984-01-30"), ymd("1986-02-01"))) , period(years = 2, days = 2)) expect_equal( as.period(interval(ymd("1984-01-30"), ymd("1986-03-01"))) , period(years = 2, months = 1, days = 1)) expect_equal( as.period(interval(ymd("1985-01-30"), ymd("1986-03-30"))) , period(years = 1, months = 2)) expect_equal( as.period(interval(ymd("1985-01-28"), ymd("1986-03-28"))) , period(years = 1, months = 2)) expect_equal( as.period(interval(ymd("1985-01-31"), ymd("1986-03-28"))) , period(years = 1, months = 1, days = 28)) expect_equal( as.period(interval(ymd("1984-01-28"), ymd("1984-02-28"))) , period(months = 1)) expect_equal( as.period(interval(ymd("1984-01-28"), ymd("1984-02-29"))) , period(months = 1, days = 1)) expect_equal( as.period(interval(ymd_hms("1984-01-28 5:0:0"), ymd_hms("1984-02-29 3:0:0"))) , period(months = 1, hours = 22)) expect_equal( as.period(interval(ymd("1984-01-28"), ymd("1984-03-01"))) , period(months = 1, days = 2)) expect_equal( as.period(interval(ymd_hms("1984-01-28 5:0:0"), ymd_hms("1984-03-01 3:0:0"))) , period(months = 1, days = 1, hours = 22)) }) test_that("as.period handles tricky negative intervals", { expect_equal( as.period(interval(ymd("1986-02-01"), ymd("1986-01-31"))) , period(days = -1)) expect_equal( as.period(interval(ymd("1986-02-01"), ymd("1984-01-30"))) , period(years = -2, days = -2)) expect_equal( as.period(interval(ymd("1986-03-01"), ymd("1984-01-30"))) , period(years = -2, months = -1, days = -2)) expect_equal( as.period(interval(ymd("1986-03-30"), ymd("1985-01-30"))) , period(years = -1, months = -2)) expect_equal( as.period(interval(ymd("1986-03-28"), ymd("1985-01-28"))) , period(years = -1, months = -2)) expect_equal( as.period(interval(ymd("1986-03-28"), ymd("1985-01-31"))) , period(years = -1, months = -1, days = -28)) expect_equal( as.period(interval(ymd("1986-02-01"), ymd("1985-12-31"))) , period(months = -1, days = -1)) expect_equal( as.period(interval(ymd("1984-03-01"), ymd("1984-01-31"))) , period(months = -1, days = -1)) expect_equal( as.period(interval(ymd("1984-03-01"), ymd("1984-01-30"))) , period(months = -1, days = -2)) expect_equal( as.period(interval(ymd("1984-03-01"), ymd("1984-01-29"))) , period(months = -1, days = -3)) expect_equal( as.period(interval(ymd_hms("1984-03-01 3:0:0"), ymd_hms("1984-01-28 5:0:0"))) , period(months = -1, days = -3, hours = -22)) }) test_that("as.period handles NA in interval objects", { one_missing_date <- as.POSIXct(NA_real_, origin = origin) one_missing_interval <- interval(one_missing_date, one_missing_date) several_missing_dates <- rep(as.POSIXct(NA_real_, origin = origin), 2) several_missing_intervals <- interval(several_missing_dates, several_missing_dates) start_missing_intervals <- interval(several_missing_dates, origin) end_missing_intervals <- interval(origin, several_missing_dates) na.per <- period(sec= NA, min = NA, hour = NA, day = NA, month = NA, year = NA) expect_equal(as.period(one_missing_interval, "year"), na.per) expect_equal(as.period(several_missing_intervals, "year"), c(na.per, na.per)) expect_equal(as.period(start_missing_intervals, "year"), c(na.per, na.per)) expect_equal(as.period(end_missing_intervals, "year"), c(na.per, na.per)) }) test_that("as.period handles NA duration objects", { na.per <- period(sec= NA, min = NA, hour = NA, day = NA, month = NA, year = NA) expect_equal(suppressMessages(as.period(dyears(NA))), na.per) expect_equal(suppressMessages(as.period(dyears(c(NA, NA)))), c(na.per, na.per)) expect_equal(suppressMessages(as.period(dyears(c(1, NA)))), c(years(1), na.per)) }) test_that("as.period handles NA objects", { na.per <- seconds(NA) expect_equal(as.period(NA), na.per) }) test_that("as.period handles vectors", { time1 <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") time2 <- as.POSIXct("2009-08-03 13:01:59", tz = "UTC") time3 <- as.POSIXct("2010-08-03 13:01:59", tz = "UTC") int <- interval(c(time2, time1), time3) dur <- new_duration(seconds = 5, minutes = c(30,59)) expect_that(as.period(int), equals(years(1:2))) expect_that(as.period(dur), equals(seconds(5) + minutes(c(30,59)))) }) test_that("as.period handles duration objects", { dur <- new_duration(seconds = 5, minutes = 30) expect_that(as.period(dur), equals(seconds(5) + minutes(30))) }) test_that("as.period handles period objects", { per <- minutes(1000) + seconds(50) + seconds(11) expect_that(as.period(per), equals(per)) expect_that(as.period(per, "minute"), equals(period(c(1001, 1), c("minute", "second")))) expect_that(as.period(per, "hour"), equals(period(c(16, 41, 1), c("hour", "minute", "second")))) }) test_that("[<- can subset periods with new periods", { Time <- data.frame(Time = c(hms("01:01:01"), hms("02:02:02"))) Time[1,1] <- Time[1,1] + hours(1) times <- days(1:3) times[1] <- times[1] + hours(2) expect_equal(Time[1,1], hms("02:01:01")) expect_equal(times[1], period(days = 1, hours = 2)) }) test_that("period correctly handles week units", { expect_equal(period(1, "week"), days(7)) expect_equal(period(8, "days"), days(8)) expect_equal(period(c(3,2), c("days", "week")), days(c(17))) }) test_that("format.period correctly displays negative units", { expect_match(format(days(-2)), "-2d 0H 0M 0S") expect_match(format(period(second = -1, hour = -2, day = 3)), "3d -2H 0M -1S") }) test_that("format.Period correctly displays intervals of length 0", { per <- period(seconds = 5) expect_output(print(per[FALSE]), "Period\\(0)") }) test_that("c.Period correctly handles NAs", { per <- period(seconds = 5) expect_true(is.na(c(per, NA)[2])) }) test_that("summary.Period creates useful summary", { per <- period(minutes = 5) text <- c(rep("5M 0S", 6), 1) names(text) <- c("Min.", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max.", "NA's") expect_equal(summary(c(per, NA)), text) }) test_that("idempotentcy between period_to_seconds and seconds_to_period holds", { period <- period(years = 2, months = 3, days = 4, hour = 5, minutes = 6, seconds = 7) seconds <- 71319967 expect_equal(period_to_seconds(seconds_to_period(seconds)), seconds) }) test_that("direct reation of periods works as expected", { expect_equal(new("Period", 1:4), period(seconds = 1:4)) expect_equal(new("Period", 1:4, day = 1:2), period(seconds = 1:4, days = 1:2)) }) lubridate/tests/testthat/test-difftimes.R0000644000175100001440000000122512705366146020331 0ustar hornikuserscontext("difftimes") test_that("is.difftime works as expected",{ ct_time <- as.POSIXct("2008-08-03 13:01:59", tz = "UTC") lt_time <- as.POSIXlt("2009-08-03 13:01:59", tz = "UTC") expect_true(!is.difftime(234)) expect_true(!is.difftime(ct_time)) expect_true(!is.difftime(lt_time)) expect_true(!is.difftime(Sys.Date())) expect_true(!is.difftime(minutes(1))) expect_true(!is.difftime(dminutes(1))) expect_true(!is.difftime(interval(ct_time, lt_time))) expect_true(is.difftime(new_difftime(1000))) expect_true(is.difftime(ct_time - lt_time)) }) test_that("is.difftime handle vectors",{ expect_true(is.difftime(new_difftime(1:3))) }) lubridate/tests/testthat/test-parsers.R0000644000175100001440000013217512755302724020044 0ustar hornikuserscontext("Parsing") Sys.setlocale("LC_TIME", "C") test_that("ymd functions correctly parse dates separated by -", { expect_that(ymd("2010-01-02"), equals(as.Date("2010-01-02"))) expect_that(ymd("10-01-02"), equals(as.Date("2010-01-02"))) expect_that(ydm("2010-02-01"), equals(as.Date("2010-01-02"))) expect_that(mdy("01-02-2010"), equals(as.Date("2010-01-02"))) expect_that(myd("01-2010-02"), equals(as.Date("2010-01-02"))) expect_that(dmy("02-01-2010"), equals(as.Date("2010-01-02"))) expect_that(dym("02-2010-01"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("2010-01-02","2010-01-03")), equals(as.Date(c("2010-01-02","2010-01-03")))) }) test_that("ymd functions correctly parse dates separated by /", { expect_that(ymd("2010/01/02"), equals(as.Date("2010-01-02"))) expect_that(ymd("10/01/02"), equals(as.Date("2010-01-02"))) expect_that(ydm("2010/02/01"), equals(as.Date("2010-01-02"))) expect_that(mdy("01/02/2010"), equals(as.Date("2010-01-02"))) expect_that(myd("01/2010/02"), equals(as.Date("2010-01-02"))) expect_that(dmy("02/01/2010"), equals(as.Date("2010-01-02"))) expect_that(dym("02/2010/01"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("2010/01/02","2010/01/03")) , equals(as.Date(c("2010-01-02","2010-01-03")))) }) test_that("ymd functions correctly parse dates separated by .", { expect_that(ymd("2010.01.02"), equals(as.Date("2010-01-02"))) expect_that(ymd("10.01.02"), equals(as.Date("2010-01-02"))) expect_that(ydm("2010.02.01"), equals(as.Date("2010-01-02"))) expect_that(mdy("01.02.2010"), equals(as.Date("2010-01-02"))) expect_that(myd("01.2010.02"), equals(as.Date("2010-01-02"))) expect_that(dmy("02.01.2010"), equals(as.Date("2010-01-02"))) expect_that(dym("02.2010.01"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("2010.01.02","2010.01.03")) , equals(as.Date(c("2010-01-02","2010-01-03")))) }) test_that("ymd functions correctly parse dates separated by ,", { expect_that(ymd("2010,01,02"), equals(as.Date("2010-01-02"))) expect_that(ymd("10,01,02"), equals(as.Date("2010-01-02"))) expect_that(ydm("2010,02,01"), equals(as.Date("2010-01-02"))) expect_that(mdy("01,02,2010"), equals(as.Date("2010-01-02"))) expect_that(myd("01,2010,02"), equals(as.Date("2010-01-02"))) expect_that(dmy("02,01,2010"), equals(as.Date("2010-01-02"))) expect_that(dym("02,2010,01"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("2010,01,02","2010,01,03")) , equals(as.Date(c("2010-01-02","2010-01-03")))) }) test_that("ymd functions correctly parse dates separated by :", { expect_that(ymd("2010:01:02"), equals(as.Date("2010-01-02"))) expect_that(ymd("10:01:02"), equals(as.Date("2010-01-02"))) expect_that(ydm("2010:02:01"), equals(as.Date("2010-01-02"))) expect_that(mdy("01:02:2010"), equals(as.Date("2010-01-02"))) expect_that(myd("01:2010:02"), equals(as.Date("2010-01-02"))) expect_that(dmy("02:01:2010"), equals(as.Date("2010-01-02"))) expect_that(dym("02:2010:01"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("2010:01:02","2010:01:03")) , equals(as.Date(c("2010-01-02","2010-01-03")))) }) test_that("ymd functions correctly parse dates with no separators", { expect_that(ymd("20100102"), equals(as.Date("2010-01-02"))) expect_that(ydm("20100201"), equals(as.Date("2010-01-02"))) expect_that(mdy("01022010"), equals(as.Date("2010-01-02"))) expect_that(myd("01201002"), equals(as.Date("2010-01-02"))) expect_that(dmy("02012010"), equals(as.Date("2010-01-02"))) expect_that(dym("02201001"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("20100102","20100103")) , equals(as.Date(c("2010-01-02","2010-01-03")))) expect_that(ymd("100102"), equals(as.Date("2010-01-02"))) expect_that(ymd("20100102"), equals(as.Date("2010-01-02"))) expect_that(ydm("20100201"), equals(as.Date("2010-01-02"))) expect_that(mdy("01022010"), equals(as.Date("2010-01-02"))) expect_that(myd("01201002"), equals(as.Date("2010-01-02"))) expect_that(dmy("02012010"), equals(as.Date("2010-01-02"))) expect_that(dym("02201001"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("20100102","20100103")) , equals(as.Date(c("2010-01-02","2010-01-03")))) expect_that(ymd("100102"), equals(as.Date("2010-01-02"))) }) test_that("ymd functions correctly parse dates with no separators", { expect_that(ymd("20100102"), equals(as.Date("2010-01-02"))) expect_that(ydm("20100201"), equals(as.Date("2010-01-02"))) expect_that(mdy("01022010"), equals(as.Date("2010-01-02"))) expect_that(myd("01201002"), equals(as.Date("2010-01-02"))) expect_that(dmy("02012010"), equals(as.Date("2010-01-02"))) expect_that(dym("02201001"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("20100102","20100103")) , equals(as.Date(c("2010-01-02","2010-01-03")))) expect_that(ymd("100102"), equals(as.Date("2010-01-02"))) expect_that(ymd("20100102"), equals(as.Date("2010-01-02"))) expect_that(ydm("20100201"), equals(as.Date("2010-01-02"))) expect_that(mdy("01022010"), equals(as.Date("2010-01-02"))) expect_that(myd("01201002"), equals(as.Date("2010-01-02"))) expect_that(dmy("02012010"), equals(as.Date("2010-01-02"))) expect_that(dym("02201001"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("20100102","20100103")) , equals(as.Date(c("2010-01-02","2010-01-03")))) expect_that(ymd("100102"), equals(as.Date("2010-01-02"))) }) test_that("ymd function correctly parse b and B formats",{ expect_equal(ymd("2004-Jan-15"), as.Date("2004-01-15")) expect_equal(ymd("2004-January-15"), as.Date("2004-01-15")) expect_equal(ymd("2004-Jan-15", "2004-Feb-15", "1904-Jan-15", "1904-Feb-15"), as.Date(c("2004-01-15 UTC", "2004-02-15 UTC", "1904-01-15 UTC", "1904-02-15 UTC"))) expect_equal(ymd("2004-Jan-15", "2004-Feb-15", "1904-January-15", "1904-February-15"), as.Date(c("2004-01-15 UTC", "2004-02-15 UTC", "1904-01-15 UTC", "1904-02-15 UTC"))) expect_equal(mdy("Jan-15-2004"), as.Date("2004-01-15")) expect_equal(mdy("January-15-2004"), as.Date("2004-01-15")) expect_equal(mdy("Jan-15-2004", "Feb-15-2004", "Jan-15-1904", "Feb-15-1904"), as.Date(c("2004-01-15 UTC", "2004-02-15 UTC", "1904-01-15 UTC", "1904-02-15 UTC"))) expect_equal(mdy("Jan-15-2004", "Feb-15-2004", "January-15-1904", "February-15-1904"), as.Date(c("2004-01-15 UTC", "2004-02-15 UTC", "1904-01-15 UTC", "1904-02-15 UTC"))) }) test_that("ymd function correctly parse b and B formats",{ expect_equal(ymd("2004-Jan-15"), as.Date("2004-01-15")) expect_equal(ymd("2004-January-15"), as.Date("2004-01-15")) expect_equal(ymd("2004-Jan-15", "2004-Feb-15", "1904-Jan-15", "1904-Feb-15"), as.Date(c("2004-01-15 UTC", "2004-02-15 UTC", "1904-01-15 UTC", "1904-02-15 UTC"))) expect_equal(ymd("2004-Jan-15", "2004-Feb-15", "1904-January-15", "1904-February-15"), as.Date(c("2004-01-15 UTC", "2004-02-15 UTC", "1904-01-15 UTC", "1904-02-15 UTC"))) expect_equal(mdy("Jan-15-2004"), as.Date("2004-01-15")) expect_equal(mdy("January-15-2004"), as.Date("2004-01-15")) expect_equal(mdy("Jan-15-2004", "Feb-15-2004", "Jan-15-1904", "Feb-15-1904"), as.Date(c("2004-01-15 UTC", "2004-02-15 UTC", "1904-01-15 UTC", "1904-02-15 UTC"))) expect_equal(mdy("Jan-15-2004", "Feb-15-2004", "January-15-1904", "February-15-1904"), as.Date(c("2004-01-15 UTC", "2004-02-15 UTC", "1904-01-15 UTC", "1904-02-15 UTC"))) }) test_that("ymd functions correctly parse dates with no separators and b and B formats", { expect_that(ymd("2010January02"), equals(as.Date("2010-01-02"))) expect_that(ydm("201002January"), equals(as.Date("2010-01-02"))) expect_that(mdy("January022010"), equals(as.Date("2010-01-02"))) expect_that(myd("January201002"), equals(as.Date("2010-01-02"))) expect_that(dmy("02January2010"), equals(as.Date("2010-01-02"))) expect_that(dym("022010January"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("2010January02","2010January03")) , equals(as.Date(c("2010-01-02","2010-01-03")))) expect_that(ymd("10January02"), equals(as.Date("2010-01-02"))) expect_that(ymd("2010January02"), equals(as.Date("2010-01-02"))) expect_that(ydm("201002January"), equals(as.Date("2010-01-02"))) expect_that(mdy("January022010"), equals(as.Date("2010-01-02"))) expect_that(myd("January201002"), equals(as.Date("2010-01-02"))) expect_that(dmy("02January2010"), equals(as.Date("2010-01-02"))) expect_that(dym("022010January"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("2010January02","2010January03")) , equals(as.Date(c("2010-01-02","2010-01-03")))) expect_that(ymd("10January02"), equals(as.Date("2010-01-02"))) expect_that(ymd("2010Jan02"), equals(as.Date("2010-01-02"))) expect_that(ydm("201002Jan"), equals(as.Date("2010-01-02"))) expect_that(mdy("Jan022010"), equals(as.Date("2010-01-02"))) expect_that(myd("Jan201002"), equals(as.Date("2010-01-02"))) expect_that(dmy("02Jan2010"), equals(as.Date("2010-01-02"))) expect_that(dym("022010Jan"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("2010Jan02","2010Jan03")) , equals(as.Date(c("2010-01-02","2010-01-03")))) expect_that(ymd("10Jan02"), equals(as.Date("2010-01-02"))) expect_that(ymd("2010Jan02"), equals(as.Date("2010-01-02"))) expect_that(ydm("201002Jan"), equals(as.Date("2010-01-02"))) expect_that(mdy("Jan022010"), equals(as.Date("2010-01-02"))) expect_that(myd("Jan201002"), equals(as.Date("2010-01-02"))) expect_that(dmy("02Jan2010"), equals(as.Date("2010-01-02"))) expect_that(dym("022010Jan"), equals(as.Date("2010-01-02"))) expect_that(ymd(c("2010Jan02","2010Jan03")) , equals(as.Date(c("2010-01-02","2010-01-03")))) expect_that(ymd("10Jan02"), equals(as.Date("2010-01-02"))) }) test_that("ymd functions correctly parse dates with no separators and no quotes", { expect_that(ymd(20100102), equals(as.Date("2010-01-02"))) expect_that(ydm(20100201), equals(as.Date("2010-01-02"))) expect_that(mdy(01022010), equals(as.Date("2010-01-02"))) expect_that(myd(01201002), equals(as.Date("2010-01-02"))) expect_that(dmy(02012010), equals(as.Date("2010-01-02"))) expect_that(dym(02201001), equals(as.Date("2010-01-02"))) expect_that(ymd(c(20100102, 20100103)) , equals(as.Date(c("2010-01-02","2010-01-03")))) expect_that(ymd(100102), equals(as.Date("2010-01-02"))) expect_that(ymd_hms(20100102235959), equals(as.POSIXct("2010-01-02 23:59:59", tz = "UTC"))) }) test_that("all numbers are correctly converted into character for parsing", { # Conversion to character of numbers with 000000 at the end with as.character() # may outputs scientific notation depending on the value of the 'scipen' option. # .num_to_date() uses format() to avoid that. Check that it does indeed work expect_that(ymd_hms(20100102000000), equals(as.POSIXct("2010-01-02 00:00:00", tz = "UTC"))) expect_that(.num_to_date(20100102000000), equals("20100102000000")) }) test_that("ymd functions parse absurd formats as NA's", { ## should not through errors, just as as.POSIX and strptime pna <- as.Date(NA) expect_that(ymd(201001023, quiet = TRUE), equals(pna)) expect_that(ydm(20103201, quiet = TRUE), equals(pna)) expect_that(mdy(13022010, quiet = TRUE), equals(pna)) expect_that(myd(01201033, quiet = TRUE), equals(pna)) expect_that(dmy(02222010, quiet = TRUE), equals(pna)) expect_that(dym(022010013, quiet = TRUE), equals(pna)) pna <- with_tz(as.POSIXct(NA), "UTC") expect_that(ymd_hms("2010-01-023 23:59:59", quiet = TRUE), equals(pna)) expect_that(ymd_hms("2010-01-023 23:59:59.34", quiet = TRUE), equals(pna)) expect_that(ymd_hms("201001023235959.34", quiet = TRUE), equals(pna)) expect_that(ymd(c(201001024, 20100103), quiet = TRUE), equals(as.Date(c(NA, "2010-01-03")))) }) test_that("ymd functions give warning when parsing absurd formats", { ## should not through errors, just as as.POSIX and strptime expect_warning(ymd(201001023)) expect_warning(ydm(20103201)) expect_warning(mdy(13022010)) expect_warning(myd(01201033)) expect_warning(dmy(02222010)) expect_warning(dym(022010013)) expect_warning(ymd_hms("2010-01-023 23:59:59")) expect_warning(ymd_hms("2010-01-023 23:59:59.34")) expect_warning(ymd_hms("201001023235959.34")) expect_warning(ymd(c(201001024, 20100103))) }) test_that("0 month and 0 day in date produces NA", { expect_equal(ymd(c("2013-1-1", "2013-0-1"), quiet = TRUE), as.Date(c("2013-01-01", NA))) expect_equal(ymd(c("2013-1-1", "2013-1-0"), quiet = TRUE), as.Date(c("2013-01-01", NA))) expect_equal(ymd("2013-1-0", quiet = TRUE), as.Date(as.character(NA))) }) test_that("ymd_hms correctly handles a variety of formats", { expect_that(ymd_hms("2010-01-02 23:59:59"), equals(as.POSIXct( "2010-01-02 23:59:59", tz = "UTC"))) expect_that(ymd_hms("2010,01,02 23.59.59"), equals(as.POSIXct("2010-01-02 23:59:59", tz = "UTC"))) expect_that(ymd_hms("2010,01,02 23.59.59.9"), equals(as.POSIXct("2010-01-02 23:59:59.9 UTC", tz = "UTC"))) expect_that(ymd_hms("2010/01/02 23/59/59"), equals(as.POSIXct("2010-01-02 23:59:59", tz = "UTC"))) expect_that(ymd_hms("2010:01:02-23:59:59"), equals(as.POSIXct("2010-01-02 23:59:59", tz = "UTC"))) ## VS: Next doesn't parse on my machine. It's OS specific. ## expect_that(ymd_hms("2010-01-02 23:59:61"), equals(as.POSIXct( ## "2010-01-03 00:00:01", tz = "UTC"))) ## expect_that(ymd_hms(c("2010-01-02 23:59:61", ## "2010-01-02 00:00:00")), equals(as.POSIXct( ## c("2010-01-03 00:00:01", "2010-01-02 00:00:00"), tz = ## "UTC"))) expect_that(ymd_hms("10-01-02 23:59:59"), equals(as.POSIXct("2010-01-02 23:59:59", tz = "UTC"))) }) test_that("C parser correctly handles month formats", { expect_equal(ymd_hms("2010-Jan-02 23:59:59"), as.POSIXct( "2010-01-02 23:59:59", tz = "UTC")) expect_equal(ymd_hms("2010-January-02 23:59:59"), as.POSIXct( "2010-01-02 23:59:59", tz = "UTC")) expect_equal(ymd_hms("2010-Dec-02 23:59:59"), as.POSIXct( "2010-12-02 23:59:59", tz = "UTC")) expect_equal(ymd_hms("2010-Dec-02 23:59:59"), parse_date_time2("2010-Dec-02 23:59:59", "YOmdHMS")) expect_equal(ymd_hms("2010-Dec-02 23:59:59"), parse_date_time2("2010-Dec-02 23:59:59", "YbdHMS")) expect_equal(ymd_hms("2010-Dec-02 03:59:59 PM"), parse_date_time2("2010-Dec-02 15:59:59", "YbdHMS")) expect_equal(ymd_hms("2010-Dec-02 03:59:59 PM"), parse_date_time2("2010-Dec-02 03:59:59 PM", "YOmdHMSOp")) expect_equal(ymd_hms("2010-Dec-02 23:59:59"), parse_date_time2("2010-December-02 23:59:59", "YBdHMS")) yy <- c("10-Feb-28 23:59:59", "10-May-28 23:59:59", "10-September-28 23:59:59") zz <- c("2010-Feb-28 23:59:59", "2010-May-28 23:59:59", "2010-September-28 23:59:59") tt <- c("2010-02-28 23:59:59", "2010-05-28 23:59:59", "2010-09-28 23:59:59") expect_equal(parse_date_time2(yy, "ybdHMS"), as.POSIXct(tt, tz = "UTC")) expect_equal(parse_date_time2(zz, "YbdHMS"), as.POSIXct(tt, tz = "UTC")) expect_equal(parse_date_time2(yy, "ybdHMS"), as.POSIXct(tt, tz = "UTC")) expect_equal(parse_date_time2(yy, "ymdHMS"), as.POSIXct(tt, tz = "UTC")) expect_equal(parse_date_time2(zz, "YOmdHMS"), as.POSIXct(tt, tz = "UTC")) expect_equal(ymd_hms(c(yy, zz)), as.POSIXct(c(tt, tt), tz = "UTC")) }) test_that("hms functions correctly handle : separators", { expect_that(hms("3:3:3"), equals(hours(3) + minutes(3) + seconds(3))) expect_that(hms("03:03:03"), equals(hours(3) + minutes(3) + seconds(3))) expect_that(ms("03:03"), equals(minutes(3) + seconds(3))) expect_that(hm("03:03"), equals(hours(3) + minutes(3))) expect_that(hm("03:3"), equals(hours(3) + minutes(3))) }) test_that("hms functions correctly handle . separators", { expect_that(hms("3.3.3"), equals(hours(3) + minutes(3) + seconds(3))) expect_that(hms("03.03.03"), equals(hours(3) + minutes(3) + seconds(3))) expect_that(ms("03.03"), equals(minutes(3) + seconds(3))) expect_that(hm("03.03"), equals(hours(3) + minutes(3))) expect_that(hm("03.3"), equals(hours(3) + minutes(3))) }) test_that("hms functions correctly handle space separators", { expect_that(hms("3 3 3"), equals(hours(3) + minutes(3) + seconds(3))) expect_that(hms("03 03 03"), equals(hours(3) + minutes(3) + seconds(3))) expect_that(ms("03 03"), equals(minutes(3) + seconds(3))) expect_that(hm("03 03"), equals(hours(3) + minutes(3))) expect_that(hm("03 3"), equals(hours(3) + minutes(3))) }) test_that("hms functions correctly handle , separators", { expect_that(hms("3,3,3"), equals(hours(3) + minutes(3) + seconds(3))) expect_that(hms("03,03,03"), equals(hours(3) + minutes(3) + seconds(3))) expect_that(ms("03,03"), equals(minutes(3) + seconds(3))) expect_that(hm("03,03"), equals(hours(3) + minutes(3))) expect_that(hm("03,3"), equals(hours(3) + minutes(3))) }) test_that("hms functions correctly handle / separators", { expect_that(hms("3/3/3"), equals(hours(3) + minutes(3) + seconds(3))) expect_that(hms("00/00/00"), equals(hours(0) + minutes(0) + seconds(0))) expect_that(ms("03/03"), equals(minutes(3) + seconds(3))) expect_that(hm("03/03"), equals(hours(3) + minutes(3))) expect_that(hm("03/3"), equals(hours(3) + minutes(3))) }) test_that("hms functions correctly roll", { expect_equal(hms("3:59:120", roll = T), period(hours = 4, minutes = 1)) expect_equal(ms("59:125", roll = T), period(hours = 1, minutes = 1, seconds = 5)) expect_equal(hm("159:125", roll = T), period(hours = 161, minutes = 5)) }) test_that("hms functions return NA on shorter inputs", { expect_that(is.na(hms("3:3:3:4", quiet = TRUE)), is_true()) expect_that(is.na(hms("03:03", quiet = TRUE)), is_true()) expect_that(is.na(ms("03:02:01", quiet = TRUE)), is_true()) expect_that(is.na(ms("03", quiet = TRUE)), is_true()) expect_that(is.na(hm("03:03:01", quiet = TRUE)), is_true()) expect_that(is.na(hm("03", quiet = TRUE)), is_true()) }) test_that("hms functions give warning on shorter inputs", { expect_warning(hms("3:3:3:4")) expect_warning(hms("03:03")) expect_warning(ms("03:02:01")) expect_warning(ms("03")) expect_warning(hm("03:03:01")) expect_warning(hm("03")) }) test_that("hms functions correctly negative components separators", { expect_that(hms("3-3-3"), equals(hours(3) - minutes(3) - seconds(3))) expect_that(hms("03-03-03"), equals(hours(3) - minutes(3) - seconds(3))) expect_that(ms("-03-03"), equals( - minutes(3) - seconds(3))) expect_that(hm("03-3"), equals(hours(3) - minutes(3))) }) test_that("AM/PM indicators are parsed correctly", { expect_equal(parse_date_time2('12/17/1996 04:00:00 PM', "mdYHMSp"), ymd_hms('1996-12-17 16:00:00')) expect_equal(parse_date_time2('12/17/1996 04:00:00 PM', "mdYHMSOp"), ymd_hms('1996-12-17 16:00:00')) expect_equal(parse_date_time2('12/17/1996 04:00:00 AM', "mdYHMSp"), ymd_hms('1996-12-17 04:00:00')) expect_equal(parse_date_time2('12/17/1996 04:00:00 PM', "mdYHMSp", tz = "CEST"), ymd_hms('1996-12-17 16:00:00', tz = "CEST")) expect_equal(parse_date_time2('12/17/1996 04:00:00 TM', "mdYHMSp"), make_datetime(NA)) expect_equal(fast_strptime('1996-05-17 04:00:00 PM', "%Y-%m-%d %H:%M:%S %Op"), ymd_hms('1996-05-17 16:00:00')) expect_equal(ymd_hms('1996-05-17 04:00:00 PM'), ymd_hms('1996-05-17 16:00:00')) expect_equal(ydm_hms('1996-17-05 04:00:00 PM'), ydm_hms('1996-17-05 16:00:00')) expect_equal(dmy_hms('17-05-1996 04:00:00 PM'), dmy_hms('17-05-1996 16:00:00')) expect_equal(parse_date_time("2010-Dec-02 03:59:59 PM", "YmdT"), parse_date_time2("2010-12-02 15:59:59", "YmdHMS")) expect_equal(parse_date_time("2010-Dec-02 03:59:59 PM", "YmdT"), parse_date_time2("2010-12-02 15:59:59", "YmdHMS")) expect_equal(parse_date_time("2010-Dec-02 03:59 PM", "YmdR"), parse_date_time2("2010-12-02 15:59:00", "YmdHMS")) expect_equal(parse_date_time("2010-Dec-02 03 PM", "Ymdr"), parse_date_time2("2010-12-02 15:00:00", "YmdHMS")) }) test_that("AM/PM is parse correctly", { raw <- c("09/17/2015 02:55:00 PM", "09/17/2015 04:22:00 PM", "09/17/2015 11:01:00 AM", "09/17/2015 08:11:00 PM", "09/17/2015 03:00:00 PM", "09/17/2015 12:43:00 AM", "09/17/2015 12:09:00 PM", "09/17/2015 04:57:00 PM", "09/17/2015 12:25:00 PM", "09/17/2015 06:52:00 AM", "09/17/2015 11:08:00 AM", "09/17/2015 10:25:00 AM", "09/17/2015 02:39:00 PM", "09/17/2015 10:28:00 AM", "09/17/2015 06:39:00 AM", "09/17/2015 09:41:00 AM", "09/17/2015 09:12:00 AM", "09/17/2015 12:40:00 AM", "09/17/2015 11:53:08 AM", "09/17/2015 04:40:30 PM", "09/17/2015 04:19:44 PM", "09/17/2015 08:26:00 AM", "09/17/2015 02:32:17 PM", "09/17/2015 06:09:00 PM", "09/17/2015 10:27:00 AM", "09/17/2015 12:59:00 PM", "09/17/2015 09:20:00 AM", "09/17/2015 07:25:00 AM", "09/17/2015 05:49:04 AM", "09/17/2015 04:58:18 PM", "09/17/2015 11:35:00 AM", "09/17/2015 10:21:48 AM", "09/17/2015 09:48:41 AM", "09/17/2015 01:11:00 PM", "09/17/2015 08:52:00 AM", "09/17/2015 05:49:00 AM", "09/17/2015 06:19:00 PM", "09/17/2015 10:17:19 AM", "09/17/2015 01:59:00 PM", "09/17/2015 11:08:00 AM", "09/17/2015 03:37:59 AM", "09/16/2015 07:00:00 AM", "09/17/2015 02:26:00 PM", "09/17/2015 10:58:00 AM", "09/17/2015 05:56:00 AM", "09/17/2015 05:01:00 PM", "09/17/2015 10:15:00 AM", "09/17/2015 10:02:00 AM", "09/17/2015 10:10:00 PM", "09/17/2015 12:56:00 PM", "09/17/2015 03:58:00 PM", "09/17/2015 05:23:00 PM", "09/17/2015 12:20:00 PM", "09/17/2015 07:48:00 PM", "09/17/2015 02:54:00 PM", "09/17/2015 10:02:00 PM", "09/17/2015 11:53:21 AM", "09/17/2015 10:15:59 AM", "09/17/2015 08:22:00 AM", "09/17/2015 04:33:00 PM", "09/17/2015 08:26:00 PM", "09/17/2015 08:01:00 AM", "09/17/2015 12:28:00 PM", "09/17/2015 11:07:00 PM", "09/17/2015 11:09:00 PM", "09/17/2015 03:08:32 PM", "09/17/2015 08:25:00 PM", "09/17/2015 01:45:00 PM", "09/17/2015 08:42:00 AM", "09/17/2015 03:25:00 PM", "09/17/2015 09:32:00 AM", "09/17/2015 10:13:13 AM", "09/17/2015 11:36:02 AM", "09/17/2015 03:23:00 PM", "09/17/2015 12:00:00 AM", "09/17/2015 07:19:19 PM", "09/17/2015 08:59:06 AM", "09/17/2015 09:14:00 PM", "09/17/2015 01:16:00 PM", "09/17/2015 08:54:35 AM", "09/17/2015 05:56:29 PM", "09/17/2015 03:56:51 PM", "09/17/2015 09:52:22 AM", "09/17/2015 03:49:28 PM", "09/17/2015 01:00:27 PM", "09/17/2015 09:52:32 PM", "09/17/2015 11:08:15 AM", "09/17/2015 05:26:26 PM", "09/17/2015 04:53:56 PM", "09/02/2015 10:33:00 AM", "09/17/2015 10:13:22 AM", "09/17/2015 12:50:00 PM", "09/17/2015 12:46:00 PM", "09/02/2015 06:44:00 PM", "09/17/2015 02:21:06 PM", "09/17/2015 01:56:00 PM", "09/17/2015 02:10:00 PM", "09/17/2015 05:43:28 AM", "09/17/2015 11:24:00 AM", "09/17/2015 10:56:00 AM") ## dput(as.character(parse_date_time2(raw, "mdYHMSp"))) utc <- c("2015-09-17 14:55:00", "2015-09-17 16:22:00", "2015-09-17 11:01:00", "2015-09-17 20:11:00", "2015-09-17 15:00:00", "2015-09-17 00:43:00", "2015-09-17 12:09:00", "2015-09-17 16:57:00", "2015-09-17 12:25:00", "2015-09-17 06:52:00", "2015-09-17 11:08:00", "2015-09-17 10:25:00", "2015-09-17 14:39:00", "2015-09-17 10:28:00", "2015-09-17 06:39:00", "2015-09-17 09:41:00", "2015-09-17 09:12:00", "2015-09-17 00:40:00", "2015-09-17 11:53:08", "2015-09-17 16:40:30", "2015-09-17 16:19:44", "2015-09-17 08:26:00", "2015-09-17 14:32:17", "2015-09-17 18:09:00", "2015-09-17 10:27:00", "2015-09-17 12:59:00", "2015-09-17 09:20:00", "2015-09-17 07:25:00", "2015-09-17 05:49:04", "2015-09-17 16:58:18", "2015-09-17 11:35:00", "2015-09-17 10:21:48", "2015-09-17 09:48:41", "2015-09-17 13:11:00", "2015-09-17 08:52:00", "2015-09-17 05:49:00", "2015-09-17 18:19:00", "2015-09-17 10:17:19", "2015-09-17 13:59:00", "2015-09-17 11:08:00", "2015-09-17 03:37:59", "2015-09-16 07:00:00", "2015-09-17 14:26:00", "2015-09-17 10:58:00", "2015-09-17 05:56:00", "2015-09-17 17:01:00", "2015-09-17 10:15:00", "2015-09-17 10:02:00", "2015-09-17 22:10:00", "2015-09-17 12:56:00", "2015-09-17 15:58:00", "2015-09-17 17:23:00", "2015-09-17 12:20:00", "2015-09-17 19:48:00", "2015-09-17 14:54:00", "2015-09-17 22:02:00", "2015-09-17 11:53:21", "2015-09-17 10:15:59", "2015-09-17 08:22:00", "2015-09-17 16:33:00", "2015-09-17 20:26:00", "2015-09-17 08:01:00", "2015-09-17 12:28:00", "2015-09-17 23:07:00", "2015-09-17 23:09:00", "2015-09-17 15:08:32", "2015-09-17 20:25:00", "2015-09-17 13:45:00", "2015-09-17 08:42:00", "2015-09-17 15:25:00", "2015-09-17 09:32:00", "2015-09-17 10:13:13", "2015-09-17 11:36:02", "2015-09-17 15:23:00", "2015-09-17 00:00:00", "2015-09-17 19:19:19", "2015-09-17 08:59:06", "2015-09-17 21:14:00", "2015-09-17 13:16:00", "2015-09-17 08:54:35", "2015-09-17 17:56:29", "2015-09-17 15:56:51", "2015-09-17 09:52:22", "2015-09-17 15:49:28", "2015-09-17 13:00:27", "2015-09-17 21:52:32", "2015-09-17 11:08:15", "2015-09-17 17:26:26", "2015-09-17 16:53:56", "2015-09-02 10:33:00", "2015-09-17 10:13:22", "2015-09-17 12:50:00", "2015-09-17 12:46:00", "2015-09-02 18:44:00", "2015-09-17 14:21:06", "2015-09-17 13:56:00", "2015-09-17 14:10:00", "2015-09-17 05:43:28", "2015-09-17 11:24:00", "2015-09-17 10:56:00") tparse <- as.POSIXct(utc, tz = "UTC") ## DT(raw, tparse, R = parse_date_time(raw, "mdYT", locale = "C"))[, diff := R - tparse][diff != 0] %>% DF expect_equal(mdy_hms(raw), tparse) expect_equal(parse_date_time2(raw, "mdYHMSp"), tparse) expect_equal(parse_date_time2(raw, "mdYHMSp"), tparse) expect_equal(parse_date_time2(raw, "OmdYHMSOp"), tparse) ## this one ends in strptime expect_equal(parse_date_time(raw, "mdYT", locale = "C"), tparse) }) test_that("heterogeneous formats are correctly parsed", { X <- c(20090101, "2009-01-02", "2009 01 03", "2009-1-4", "2009-1, 5", "2009....1--6", "200901-07", "200901-8") Y <- c("2009-01-01", "2009-01-02", "2009-01-03", "2009-01-04", "2009-01-05", "2009-01-06", "2009-01-07", "2009-01-08") expect_that(ymd(X) ,equals( as.Date(Y))) ## cbind(ymd(X), as.POSIXct(Y, tz = "UTC")) X <- c(20100101120101 , "2009-01-02 12-01-02", "2009.01.03 12:01:03", "2009-1-4 12-1-4" , "2009-1, 5 12:1, 5", "2009....1--6 - 12::1:6", "20090107 120107" , "2009-01-08 1201-08", "2010-01-09 12:01:09", "2010-01-10 10:01:10 AM" , "2010-01-11 10:01:11 PM") Y <- c("2010-01-01 12:01:01", "2009-01-02 12:01:02", "2009-01-03 12:01:03", "2009-01-04 12:01:04", "2009-01-05 12:01:05", "2009-01-06 12:01:06", "2009-01-07 12:01:07", "2009-01-08 12:01:08", "2010-01-09 12:01:09", "2010-01-10 10:01:10", "2010-01-11 22:01:11") ## cbind(as.character(ymd_hms(X)), as.character(as.POSIXct(Y, tz = "UTC"))) expect_that(ymd_hms(X), equals(as.POSIXct(Y, tz = "UTC"))) cbind(as.character(ymd_hms(X)), as.character(as.POSIXct(Y, tz = "UTC"))) }) test_that("truncated formats are correctly parsed", { expect_that({ x <- c("2011-12-31 12:59:59", "2010-01-01 12:11", "2010-01-01 12", "2010-01-01") ymd_hms(x, truncated = 3) }, equals(as.POSIXct(c("2011-12-31 12:59:59", "2010-01-01 12:11:00", "2010-01-01 12:00:00", "2010-01-01 00:00:00"), tz = "UTC"))) }) test_that("truncation on non-dates results in NAs indeed", { expect_warning( expect_true({ tt <- c("NI PODATKA", "TUJINA", "GRAD") all(is.na(ymd_hms(tt, truncated = 3))) })) }) test_that("missing months and days are allowed", { expect_equal(parse_date_time2("2016", orders = "Y"), ymd("2016-01-01", tz = "UTC")) expect_equal(parse_date_time2("2016-02", orders = "Ym"), ymd("2016-02-01", tz = "UTC")) expect_equal(parse_date_time("2016", orders = "Y"), ymd("2016-01-01", tz = "UTC")) expect_equal(parse_date_time("2016-02", orders = "Ym"), ymd("2016-02-01", tz = "UTC")) expect_equal(parse_date_time(c("3:15:00"), c("IMS")), as.POSIXct("00-01-01 03:15:00", tz = "UTC")) expect_equal(parse_date_time(c("3:15:00"), c("HMS")), as.POSIXct("00-01-01 03:15:00", tz = "UTC")) expect_equal(parse_date_time(c("3:15:00 PM"), c("HMSp")), as.POSIXct("00-01-01 15:15:00", tz = "UTC")) expect_equal(parse_date_time(c("3:15:00 PM"), c("IMSp")), as.POSIXct("00-01-01 15:15:00", tz = "UTC")) }) test_that("fractional formats are correctly parsed", { expect_that({ x <- c("2011-12-31 12:59:59.23", "2010-01-01 12:11:10") ymd_hms(x) }, equals(as.POSIXct(c("2011-12-31 12:59:59.23 UTC", "2010-01-01 12:11:10.00 UTC"), tz = "UTC"))) expect_that(hms("3:0:3.34"), equals(hours(3) + minutes(0) + seconds(3.34))) }) test_that( "NA's are parsed as NA's", { expect_warning(ymd(NA)) expect_true(is.na(ymd(NA, quiet = TRUE))) expect_warning(ymd_hms(NA)) expect_true(is.na(ymd_hms(NA, quiet = TRUE))) expect_warning(ymd_hm(NA)) expect_true(is.na(ymd_hm(NA, quiet = TRUE))) expect_warning(hms(NA)) expect_true(is.na(hms(NA, quiet = TRUE))) expect_warning(ms(NA)) expect_true(is.na(ms(NA, quiet = TRUE))) }) test_that("Quarters are parsed correctly", { qs <- c("2016.1", "2016:2", "2016-3", "2016 4", "2016.5") out <- ymd(c("2016-01-01 UTC", "2016-04-01 UTC", "2016-07-01 UTC", "2016-10-01 UTC", NA), tz = "UTC") expect_equal(parse_date_time2(qs, orders = "Yq"), out) expect_equal(parse_date_time(qs, orders = "Yq", quiet = T), out) expect_equal(yq(qs, tz = "UTC", quiet = T), out) expect_equal(yq("16.1", "17.3", "2016.1"), ymd(c("2016-01-01", "2017-07-01", "2016-01-01"))) }) test_that( "Vectors of NA's are parsed as vectors of NA's", { mna <- as.POSIXct(as.POSIXlt(c(NA,NA,NA), tz = "UTC")) pna <- new("Period" , .Data = c(NA_real_, NA_real_, NA_real_) , year = c(0, 0, 0) , month = c(0, 0, 0) , day = c(0, 0, 0) , hour = c(NA_real_, NA_real_, NA_real_) , minute = c(NA_real_, NA_real_, NA_real_) ) pna2 <- new("Period" , .Data = c(NA_real_, NA_real_, NA_real_) , year = c(0, 0, 0) , month = c(0, 0, 0) , day = c(0, 0, 0) , hour = c(0, 0, 0) , minute = c(NA_real_, NA_real_, NA_real_) ) expect_warning(ymd(NA, NA, NA)) expect_equal(ymd(NA, NA, NA, quiet = TRUE), as.Date(mna)) expect_warning(ymd_hms(NA, NA, NA)) expect_equal(ymd_hms(NA, NA, NA, quiet = TRUE), mna) expect_warning(ymd_hm(NA, NA, NA)) expect_equal(ymd_hm(NA, NA, NA, quiet = TRUE), mna) expect_warning(hms(NA, NA, NA)) expect_equal(hms(NA, NA, NA, quiet = TRUE), pna) expect_warning(ms(NA, NA, NA)) expect_equal(ms(NA, NA, NA, quiet = TRUE), pna2) expect_warning(ymd(c(NA, NA, NA))) expect_equal(ymd(c(NA, NA, NA), quiet = TRUE), as.Date(mna)) expect_warning(ymd_hms(c(NA, NA, NA))) expect_equal(ymd_hms(c(NA, NA, NA), quiet = TRUE), mna) expect_warning(ymd_hm(c(NA, NA, NA))) expect_equal(ymd_hm(c(NA, NA, NA), quiet = TRUE), mna) expect_warning(hms(c(NA, NA, NA))) expect_equal(hms(c(NA, NA, NA), quiet = TRUE), pna) expect_warning(ms(c(NA, NA, NA))) expect_equal(ms(c(NA, NA, NA), quiet = TRUE), pna2) }) test_that("ISO8601: %z format (aka lubridate %Ou, %OO and %Oo formats) is correctly parsed",{ expect_that( parse_date_time("2012-12-04 15:06:06.95-0800", "YmdHMOSz"), equals(as.POSIXct("2012-12-04 23:06:06.95 UTC", tz = "UTC"))) expect_that( parse_date_time(c("2012-12-04 15:06:06.95-08", "2012-12-04 15:06:06.95+08:00"), "YmdHMOSz"), equals(as.POSIXct(c("2012-12-04 23:06:06.95 UTC", "2012-12-04 07:06:06.95 UTC"), tz = "UTC"))) expect_that( fast_strptime("2014-03-12T09:32:44Z", "%Y-%m-%dT%H:%M:%S%z"), equals(as.POSIXct("2014-03-12 09:32:44 UTC", tz = "UTC"))) expect_that( fast_strptime("2014-03-12T09:32:44.33Z", "%Y-%m-%dT%H:%M:%OS%z"), equals(as.POSIXct("2014-03-12 09:32:44.33 UTC", tz = "UTC"))) }) test_that("ISO8601: xxx_hms functions work correctly with z, Ou, OO and Oo formats.", { expect_that( ymd_hms(c("2013-01-24 19:39:07.880-0600", "2013-01-24 19:39:07.880", "2013-01-24 19:39:07.880-06:00", "2013-01-24 19:39:07.880-06", "2013-01-24 19:39:07.880Z")), equals(as.POSIXct(c("2013-01-25 01:39:07.88 UTC", "2013-01-24 19:39:07.88 UTC", "2013-01-25 01:39:07.88 UTC", "2013-01-25 01:39:07.88 UTC", "2013-01-24 19:39:07.88 UTC"), tz = "UTC"))) }) test_that("ymd_hms treats time zones correctly", { expect_that(ymd_hms("2012-03-03 23:06:07", tz="America/Chicago"), equals(as.POSIXct("2012-03-03 23:06:07", tz = "America/Chicago"))) }) test_that("ymd_hms parses Ou format correctly ",{ ## Correct usage expect_that(ymd_hms("2012-03-04T05:06:07Z"), equals(ymd_hms("2012-03-04 05:06:07", tz="UTC"))) expect_that(ymd_hms("2012-03-04T05:06:07Z", tz="America/Chicago"), equals(ymd_hms("2012-03-03 23:06:07", tz="America/Chicago"))) ## check for message expect_that(ymd_hms("2012-03-04T05:06:07Z", tz="America/Chicago"), shows_message("Date in ISO8601 format")) }) test_that("ymd_hms parses OO and Oo formats correctly", { ## +00:00 expect_that(ymd_hms("2012-03-04T05:06:07+00:00"), equals(ymd_hms("2012-03-04 05:06:07", tz="UTC"))) ## -HH expect_that(ymd_hms("2012-03-04T05:06:07-01"), equals(ymd_hms("2012-03-04 06:06:07", tz="UTC"))) ## -HHMM expect_that(ymd_hms("2012-03-04T05:06:07-0130"), equals(ymd_hms("2012-03-04 06:36:07", tz="UTC"))) ## -HH:MM expect_that(ymd_hms("2012-03-04T05:06:07-01:30"), equals(ymd_hms("2012-03-04 06:36:07", tz="UTC"))) ## +HH expect_that(ymd_hms("2012-03-04T05:06:07+01"), equals(ymd_hms("2012-03-04 04:06:07", tz="UTC"))) ## +HHMM expect_that(ymd_hms("2012-03-04T05:06:07+0130"), equals(ymd_hms("2012-03-04 03:36:07", tz="UTC"))) ## +HH:MM expect_that(ymd_hms("2012-03-04T05:06:07+01:30"), equals(ymd_hms("2012-03-04 03:36:07", tz="UTC"))) ## vectorizes expect_that(ymd_hms(c("2012-03-04T05:06:07+01", "2012-03-04T05:06:07+01:30")), equals(ymd_hms(c("2012-03-04 04:06:07", "2012-03-04 03:36:07"), tz="UTC"))) expect_that(ymd_hms("2012-03-04T05:06:07-01:30", tz="America/Chicago", quiet = T), equals(ymd_hms("2012-03-04 00:36:07", tz="America/Chicago"))) expect_that(ymd_hms("2012-03-04T05:06:07-01:30", tz="America/Chicago"), shows_message("Date in ISO8601 format")) }) test_that("ymd parses mixed y an Y formats", { ## https://github.com/hadley/lubridate/issues/425 d3 <- c("6/25/15", "6/25/2015") expect_equal(mdy(d3), as.Date(c("2015-06-25", "2015-06-25"))) d6 <- c("25/6/15", "25/6/2015") expect_equal(dmy(d6), as.Date(c("2015-06-25", "2015-06-25"))) d9 <- c("15/6/25", "2015/6/25") expect_equal(ymd(d9), as.Date(c("2015-06-25", "2015-06-25"))) }) test_that("ymd_hms parses mixed ISO-8601/non-ISO-8601 formats",{ expect_that(ymd_hms(c("2012-03-04T05:06:07Z", "2001-02-03 04:05:06"), tz="America/Chicago"), equals(ymd_hms(c("2012-03-03 23:06:07", "2001-02-03 04:05:06"), tz="America/Chicago"))) }) test_that("parse_date_time2 and fast_strptime parse ISO8601 timezones",{ tm <- "2001-02-03 11:22:33-0630" ptm <- as.POSIXct("2001-02-03 17:52:33", tz = "UTC") expect_equal(fast_strptime(tm, "%Y-%m-%d %H:%M:%S%Oz"), ptm) expect_equal(fast_strptime(tm, "%Y-%m-%d %H:%M:%S%z"), ptm) expect_equal(fast_strptime(tm, "%Y-%m-%d %H:%M:%OS%Oz"), ptm) expect_equal(fast_strptime(tm, "%Y-%m-%d %H:%M:%OS%z"), ptm) expect_equal(parse_date_time2(tm, "YmdHMSz"), ptm) expect_equal(parse_date_time2(tm, "YmdHMSOz"), ptm) expect_equal(parse_date_time2(tm, "YmdHMOSz"), ptm) expect_equal(parse_date_time2(tm, "YmdHMOSOz"), ptm) tm <- "2001-02-03 11:22:33-06:30" expect_equal(fast_strptime(tm, "%Y-%m-%d %H:%M:%OS%OO"), ptm) expect_equal(fast_strptime(tm, "%Y-%m-%d %H:%M:%OS%z"), ptm) expect_equal(parse_date_time2(tm, "YmdHMSz"), ptm) expect_equal(parse_date_time2(tm, "YmdHMSOO"), ptm) }) test_that("parse_date_time2 and fast_strptime correctly work with timezones", { ## https://github.com/hadley/lubridate/issues/394 expect_equal(parse_date_time("12/03/16 12:00", "dmy HM", tz = "Europe/Zurich"), parse_date_time2("12/03/16 12:00", "dmy HM", tz = "Europe/Zurich")) expect_equal(as.POSIXct(strptime("12/03/16 12:00", "%d/%m/%y %H:%M", tz = "Europe/Zurich")), parse_date_time2("12/03/16 12:00", "dmy HM", tz = "Europe/Zurich")) expect_equal(strptime("12/03/16 12:00", "%d/%m/%y %H:%M", tz = "Europe/Zurich"), fast_strptime("12/03/16 12:00", "%d/%m/%y %H:%M", tz = "Europe/Zurich")) expect_equal(strptime("12/03/16 12:00", "%d/%m/%y %H:%M", tz = "America/New_York"), fast_strptime("12/03/16 12:00", "%d/%m/%y %H:%M", tz = "America/New_York")) }) test_that("parse_date_time2 and fast_strptime correctly return lt objects", { expect_is(parse_date_time2("12/03/16 12:00", "dmy HM"), "POSIXct") expect_is(parse_date_time2("12/03/16 12:00", "dmy HM", lt = TRUE), "POSIXlt") expect_is(fast_strptime("12/03/16 12:00", "%d/%m/%y %H:%M"), "POSIXlt") expect_is(fast_strptime("12/03/16 12:00", "%d/%m/%y %H:%M", lt = FALSE), "POSIXct") }) test_that("ymd_hms, parse_date_time2, fast_strptime and base:strptime give the same result", { ## random times between 1400 and 3000 set.seed(1000) X <- as.character(.POSIXct(runif(1000, -17987443200, 32503680000))) oposix <- as.POSIXct(X, tz = "UTC") opdt1 <- ymd_hms(X) opdt2 <- parse_date_time2(X, "YmdHMOS") ofstrptime <- fast_strptime(X, "%Y-%m-%d %H:%M:%OS") expect_equal(oposix, opdt1) expect_equal(oposix, opdt2) expect_equal(oposix, ofstrptime) tzs <- strptime(X, "%Y-%m-%d %H:%M:%OS", tz = "America/New_York") tzfs <- fast_strptime(X, "%Y-%m-%d %H:%M:%OS", tz = "America/New_York") expect_equal(tzs, tzfs) }) test_that("fast_strptime and parse_date_time2 parse correctly verbose formats", { expect_equal(fast_strptime("aa 2000 bbb10ccc 12 zzz", "aa %Y bbb%mccc %d zzz"), as.POSIXct("2000-10-12", tz = "UTC")) expect_equal(fast_strptime("aa 2000 5555 bbb10ccc 12 zzz", "aa %Y 5555 bbb%mccc %d zzz"), as.POSIXct("2000-10-12", tz = "UTC")) expect_equal(parse_date_time2("aa 2000 bbb10ccc 12 zzz", "Ymd"), as.POSIXct("2000-10-12", tz = "UTC")) expect_equal(parse_date_time2("aa 2000 5555 bbb10ccc 12 zzz", "Ymd"), as.POSIXct(as.POSIXlt(NA, tz = "UTC"))) }) test_that("fast_strptime and parse_date_time2 deal correctly with leap years", { expect_equal(ymd(c("2000-02-29", "2100-02-29", "2400-02-29"), quiet = T), as.Date(c("2000-02-29 UTC", NA, "2400-02-29 UTC"))) }) test_that("fast_strptime and parse_date_time2 detect excesive days", { ## https://github.com/hadley/lubridate/issues/#289 expect_equal(ymd(c("2000-01-32", "2000-02-30", "2100-03-32", "2400-12-32"), quiet = T), as.Date(c(NA, NA, NA, NA)), tz = "UTC") }) test_that("fast_strptime and parse_date_time2 aggree with strptime", { date <- "1 7 97" expect_equal(fast_strptime(date, "%d %m %y"), strptime(date, "%d %m %y", tz = "UTC")) date <- "1 1 69" expect_equal(fast_strptime(date, "%d %m %y"), strptime(date, "%d %m %y", tz = "UTC")) date <- "1 1 68" expect_equal(fast_strptime(date, "%d %m %y"), strptime(date, "%d %m %y", tz = "UTC")) expect_equal(parse_date_time2(date, "dmy"), strptime(date, "%d %m %y", tz = "UTC")) }) test_that("a and A formats are handled correctly (#254)", { dates <- c("Saturday 31 August 2013", "Sun 12 Jan 2014") expect_equal(parse_date_time(x = dates, orders = c("dby")), parse_date_time(x = dates, orders = c("adby"))) expect_equal(parse_date_time(x = dates, orders = c("dby")), parse_date_time(x = dates, orders = c("Adby"))) }) test_that("`parse_date_time` parses heterogeneous formats with `exact=TRUE`", { ## https://github.com/hadley/lubridate/issues/326 expect_equal(parse_date_time(c('12/17/1996 04:00:00','4/18/1950 0130'), c('%m/%d/%Y %I:%M:%S','%m/%d/%Y %H%M'), exact = T), as.POSIXct(c("1996-12-17 04:00:00 UTC", "1950-04-18 01:30:00 UTC"), tz = "UTC")) x <- c("09-01-01", "090102", "09-01 03", "09-01-03 12:02") expect_equal(parse_date_time(x, c("%m-%d-%y", "%m%d%y", "%m-%d-%y %H:%M"), exact = TRUE), as.POSIXct(c("2001-09-01 00:00:00 UTC", "2002-09-01 00:00:00 UTC", NA, "2003-09-01 12:02:00 UTC"), tz = "UTC")) }) ## library(microbenchmark) ## library(lubridate) ### PARSING ## options(digits.secs = 3) ## set.seed(100) ## tt <- as.character(.POSIXct(runif(1e6, -17987443200, 32503680000))) # random times between 1400 and 3000 ## microbenchmark(#POSIXct = as.POSIXct(tt, tz = "UTC"), ## ymd_hms = ymd_hms(tt), ## pdt2 = parse_date_time2(tt, "YmdHMOS"), ## fstrptime = fast_strptime(tt, "%Y-%m-%d %H:%M:%OS", lt = FALSE), ## readr = parse_datetime(tt, "%Y-%m-%d %H:%M:%OS"), ## times = 10) ### MAKE DATETIMES ## N <- 1e4 ## y <- as.integer(runif(N, 1800, 2200)) ## m <- as.integer(runif(N, 1, 12)) ## d <- as.integer(runif(N, 1, 28)) ## H <- as.integer(runif(N, 0, 23)) ## M <- as.integer(runif(N, 0, 59)) ## S <- as.double(runif(N, 0, 59)) ## ## S <- as.integer(S) ## microbenchmark(R = ISOdatetime(y, m, d, H, M, S, tz = "UTC"), ## L = make_datetime(y, m, d, H, M, S)) ## system.time(out1 <- ISOdatetime(y, m, d, H, M, S, tz = "UTC")) ## system.time(out2 <- make_datetime(y, m, d, H, M, S)) ## all.equal(out1, out2) ## table(out1 == out2) ## tt <- cbind(y, m, d, H, M, S, as.character(out1), as.character(out2), out1 == out2) ## tt <- cbind(y, m, d, H, M, S, out1, out2, out1 - out2, out1 == out2) ## head(tt, 40) ## cbind(out1, out2)[which(out1 != out2), ] ## all.equal(out, out1) ## all.equal(out, out2) ## all.equal(out, out3) ## this one is very slow ## system.time(out <- ymd_hms(tt, tz = "America/Chicago")) ## ttz <- paste(tt, "-0600", sep = "") ## system.time(out <- parse_date_time(ttz, "YmdHMOSz")) ## system.time(out <- ymd_hms(ttz)) ## head(ttz) ## head(out) ## system.time(out2 <- parse_date_time2(ttz, "YmdHMOSz")) ## system.time(out2 <- parse_date_time2(ttz, "YmdHMOSOz")) ## system.time(out3 <- fast_strptime(ttz, "%Y-%m-%d %H:%M:%OS%z")) ## all.equal(out, out2) ## all.equal(out, out3) ## fast_strptime(tm, "%Y-%m-%d %H:%M:%S%z") ## fast_strptime("2893-04-08 22:54:37+0635", "%Y-%m-%d %H:%M:%S%Oz") ## system.time(out <- ymd_hms(ttz, tz = "")) ## stamp_OO <- stamp("2013-01-01T00:00:00-06:00") ## stamp_Ou <- stamp("2013-01-01T06:00:00Z") ## stamp_Oo <- stamp("2013-01-01T00:00:00-06") ## stamp_Oz <- stamp("2013-01-01T00:00:00-0600") ## stamp_OO <- stamp("2013-01-01T00:00:00-06:00") ## stamp_simple <- stamp("2013-01-01T00:00:00") ## system.time(out_st <- stamp_simple(out)) ## system.time(out_st <- stamp_Ou(out)) ## system.time(out_st <- stamp_OO(out)) ## system.time(out_st <- stamp_OO(out)) ## system.time(out_st <- stamp_Oz(out)) ## tt <- rep(c(as.character(Sys.time()), as.character(Sys.Date())), 5e5) ## system.time(out <- as.POSIXct(tt, tz = "UTC")) ## system.time(out <- ymd_hms(tt, tz = "UTC", truncated = 3)) ## Rprof() ## system.time(out <- as.POSIXct(strptime(tt, "%Y-%m-%d %H:%M:%S", tz = "UTC"))) ## Rprof(NULL) ## Rprof() ## system.time(out <- ymd_hms(tt)) ## Rprof(NULL) ## summaryRprof() lubridate/tests/testthat/test-guess.R0000644000175100001440000000502712705366146017511 0ustar hornikusers## This is for interactive tests mainly, (test-parser.R and test-stamp.R are ussing gueesser, so it should be enough) ## x <- c('February 20th 1973', ## "february 14, 2004", ## "Sunday, May 1, 2000", ## "Sunday, May 1, 2000", ## "february 14, 04", ## 'Feb 20th 73', ## "January 5 1999 at 7 pm", ## "January 5 1999 at7pm", ## "jan 3 2010", ## "Jan 1, 1999", ## "jan 3 10", ## "01 3 2010", ## "1 3 10", ## '1 13 89', ## "5/27/1979", ## "12/31/99", ## "DOB:12/11/00", ## "-----------", ## 'Thu, 1 July 2004 22:30:00', ## 'Thu, 1st of July 2004 at 22:30:00', ## 'Thu, 1July 2004 at 22:30:00', ## 'Thu, 1July2004 22:30:00', ## "21 Aug 2011, 11:15:34 pm", ## "-----------", ## "1979-05-27 05:00:59", ## "1979-05-27", ## "-----------", ## "3 jan 2000", ## "17 april 85", ## "27/5/1979", ## '20 01 89', ## '00/13/10', ## "-------", ## "14 12 00", ## "03:23:22 pm") ## guess_formats(x, "BdY", print = T) ## guess_formats(x, "Bdy") ## guess_formats(x, "bdY") ## guess_formats(x, "bdy") ## guess_formats(x, "mdy", print = T) ## guess_formats(x, "T", print = T) ## guess_formats(x, c("mdY", "BdY", "Bdy", "bdY", "bdy")) ## guess_formats(x, c("dby", "dbY", "dBy", "dBY")) ## guess_formats(x, c("mdY", "mdy")) ## guess_formats(x, c("dmY", "dmy")) ## guess_formats(x, c("BdY H", "dBY HMS", "dbY HMS")) ## guess_formats(x, c("dBy HMS")) ## guess_formats(x, c("Ymd HMS"), print_matches=T) ## guess_formats(x, c("dmy HMS"), print_matches=T) ## guess_formats(x, c("mdY r"), print_matches=T) ## stamp(x, c("BdY", "bdY", "bd"))(Sys.time()) ## system.time(stamp(x[1], "BdY", quiet = T)) ## stamp(x, quiet = F) ## y <- rep(x, 3) ## f <- rep(c("BdY", "bdY", "bdy"), 10) ## system.time( for (i in 1:1) substitute_formats(y, f)) ## reg <- c("\\b(?[0-2]?\\d)\\D*?(?

(AM|PM))", ## "\\b(?[0-2]?\\d)\\D*?(?(DD|BB))") ## reg <- c("\\b((?(?[0-2]?\\d)\\D*?(?(AM|PM)))|(?(?[0-2]?\\d)\\D*?(?

(DD|BB))))") ## x <- c("aaa 12 DD aaa", ## "bbb 22 AM bbb", ## "ccc 14 PM ccc") ## ## gsub(reg , "####",x , ignore.case=T, perl = TRUE) ## regexpr(reg[[1]], x, perl=T) context("Guessing format") test_that(".get_train_set can find non NA dates",{ x <- suppressWarnings(suppressMessages(ymd(c(rep(NA, 199), 20130213)))) expect_equal(x, as.Date(as.POSIXct(c(rep(NA, 199), "2013-02-13"), tz = "UTC"))) }) lubridate/tests/testthat/test-ops-compare.R0000644000175100001440000000212712750360367020605 0ustar hornikuserscontext("comparisons operations") test_that("Comparison operators work with POSIX and Date objects", { expect_true(ymd_hms("2016-01-03 00:00:00", tz = "") == "2016-01-03 00:00:00") expect_true(ymd_hms("2016-01-03 00:00:01", tz = "") > "2016-01-03 00:00:00") expect_true(ymd_hms("2016-01-03 00:00:00", tz = "") == "2016-01-03") expect_true(ymd("2016-01-03") == "2016-01-03") expect_true(ymd("2016-01-03") == ymd_hms("2016-01-03 00:00:00")) expect_true(ymd("2016-01-03") < ymd_hms("2016-01-03 00:00:01")) expect_true(ymd("2016-01-03") != ymd_hms("2016-01-03 00:00:01")) expect_true(ymd("2016-01-03") > ymd_hms("2016-01-02 23:59:59")) expect_true(ymd("2016-01-03") > ymd_hms("2016-01-02 23:59:59", tz = "Europe/Paris")) expect_true(ymd("2016-01-03") < ymd_hms("2016-01-03 00:00:01", tz = "Europe/Paris")) expect_true(ymd("2016-01-03") < ymd_hms("2016-01-03 00:00:01", tz = "Europe/Paris")) expect_true(ymd("2016-01-03") < as.POSIXlt(ymd_hms("2016-01-03 00:00:01", tz = "Europe/Paris"))) expect_true(ymd("2016-01-03") < as.POSIXlt(ymd_hms("2016-01-03 00:00:01", tz = "Europe/Paris"))) }) lubridate/tests/testthat/test-am-pm.R0000644000175100001440000000200312705366146017361 0ustar hornikuserscontext("am/pm") test_that("am and pm correctly identify time of day",{ x <- as.POSIXct("2009-08-03 13:01:59", tz = "UTC") y <- as.POSIXct("2008-08-03 10:01:59", tz = "UTC") expect_that(am(x), is_false()) expect_that(am(y), is_true()) expect_that(pm(x), is_true()) expect_that(pm(y), is_false()) }) test_that("am and pm handle vectors",{ x <- as.POSIXct(c("2009-08-03 13:01:59", "2008-08-03 10:01:59"), tz = "UTC") y <- as.POSIXct(c("2009-08-03 10:01:59", "2008-08-03 13:01:59"), tz = "UTC") expect_that(pm(x)[1], is_true()) expect_that(pm(x)[2], is_false()) expect_that(am(y)[1], is_true()) expect_that(am(y)[2], is_false()) }) test_that("am and pm handle various classes of date-time object",{ x <- as.POSIXct(c("2008-08-03 13:01:59", "2009-08-03 10:01:59"), tz = "UTC") expect_that(pm(x)[1], is_true()) expect_that(pm(x)[2], is_false()) expect_that(pm(as.Date(x))[1], is_false()) expect_that(pm(as.POSIXlt(x))[1], is_true()) expect_that(pm(as.POSIXlt(x))[2], is_false()) })lubridate/src/0000755000175100001440000000000012765562217013047 5ustar hornikuserslubridate/src/constants.h0000644000175100001440000000146312765562217015240 0ustar hornikusers#ifndef LUB_CONSTANTS_H #define LUB_CONSTANTS_H #define FALSE 0 #define TRUE 1 // start of each month in seconds in a common year (1 indexed) static const int sm[] = {0, 0, 2678400, 5097600, 7776000, 10368000, 13046400, 15638400, 18316800, 20995200, 23587200, 26265600, 28857600, 31536000 }; // days in months static const int mdays[] = {0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}; // seconds in a day: 24*60*60 static const int daylen = 86400; // seconds between 2000-01-01 and 1970-01-01 static const int d30 = 946684800; // need 64 type to avoid overflow on integer multiplication // int64_t from stdint.h is a bit slower // potential problem: is long long 64 bit on all machines? static const long long yearlen = 31536000; // common year in sec: 365*24*60*60 #endif /* !defined LUB_CONSTANTS_H */ lubridate/src/utils.c0000644000175100001440000000507612765562217014363 0ustar hornikusers#include "constants.h" #include "utils.h" #include // return adjustment (in seconds) due to leap years // y: years after (positive) or before (negative) 2000-01-01 00:00:00 int adjust_leap_years(int y, int m, int is_leap){ int SECS = 0; if ( y >= 0 ){ // ordinary leap days after 2000-01-01 00:00:00 SECS += ( y / 4 ) * daylen + daylen; if( y > 99 ) SECS += (y / 400 - y / 100) * daylen; // adjust if within a leap year if ( is_leap && m < 3 ) SECS -= daylen; } else { SECS += (y / 4) * daylen; if( y < -99 ) SECS += (y / 400 - y / 100) * daylen; if ( is_leap && m > 2 ) SECS += daylen; } return SECS; } // check if y, m, d make sense int check_ymd(int y, int m, int d, int is_leap){ int succeed = 1; if ( m == 2 ){ // no check for d > 0 because we allow missing days in parsing if ( is_leap ) succeed = d < 30; else succeed = d < 29; } else { succeed = d <= mdays[m]; } return succeed; } /* parse N digit characters from **c. Return parsed non-negative integer. If failed to pass N chars, return -1.*/ int parse_int (const char **c, const int N, const int strict) { // maybe: fixme: this returns 0 if no parsing happened and strict = FALSE int tN = N, X = 0; while (DIGIT(**c) && tN > 0) { X = X * 10 + (**c - '0'); (*c)++; tN--; } if (strict && tN > 0) return -1; else return X; } // Increment **c and return index in 0..length(strings) if match was found, -1 // if not. // // - **c: pointer to a character in a C string (automatically incremented) // - *stings: pointer to an array of C strings to be matched to. // - strings_len: length of strings array. int parse_alphanum(const char **c, const char **strings, const int strings_len){ // tracking array: all valid objects are marked with 1, invalid with 0 int track[strings_len]; for (int i = 0; i < strings_len; i++){ track[i] = 1; } int j = 0, go = 1, out = -1; while (**c && !ALPHA(**c)) (*c)++; while (**c && go) { // stop when all tracks where exhausted go = 0; for (int i = 0; i < strings_len; i++){ if (track[i]){ // keep going while at least one valid track if (strings[i][j]){ if(**c == strings[i][j]){ out = i; go = 1; } else { // invalidate track i if not matching track[i] = 0; } } else { // reached to the end of string i; return it go = 0; out = i; break; } } } if(go){ (*c)++; j++; } } if (out >= 0) return out; else return -1; } lubridate/src/utils.h0000644000175100001440000000153612765562217014365 0ustar hornikusers#ifndef LUB_UTILS_H #define LUB_UTILS_H typedef struct { int val; int unit; } intUnit; // leap year every 400 years; no leap every 100 years #define IS_LEAP(y) ((y) % 4 == 0) && !((y) % 100 == 0 && (y) % 400 != 0); /* quick checkers */ #define ALPHA(X) (((X) >= 'a' && (X) <= 'z') || ((X) >= 'A' && (X) <= 'Z')) #define DIGIT(X) ((X) >= '0' && (X) <= '9') #define SDIGIT(X) (((X) == '-') || ((X) >= '0' && (X) <= '9')) /* skippers */ #define SKIP_NON_ALPHANUMS(X) while(*X && !(ALPHA(*X) || DIGIT(*X))) {(X)++;} #define SKIP_NON_DIGITS(X) while(*X && !(DIGIT(*X))) {(X)++;} int adjust_leap_years(int y, int m, int is_leap); int check_ymd(int y, int m, int d, int is_leap); int parse_alphanum(const char **c, const char **strings, const int strings_len); int parse_int (const char **c, const int N, const int strict); #endif /* !defined LUB_UTILS_H */ lubridate/src/tparse.c0000644000175100001440000003231112765562217014511 0ustar hornikusers/* * time date parser for lubridate * Author: Vitalie Spinu * Copyright (C) 2013--2016 Vitalie Spinu, Garrett Grolemund, Hadley Wickham, * * This program is free software; you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by the Free * Software Foundation; either version 2 of the License, or (at your option) * any later version. * * This program is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, a copy is available at * http://www.r-project.org/Licenses/ */ /* Comments: See the parse_date_time2 and fast_strptime in lubridate for how to use parse_dt from R code. See R function .parse_hms for how to use parse_hms. */ #define USE_RINTERNALS 1 // slight increase in speed #include #include #include "constants.h" #include "utils.h" static const char ltnames[][5] = {"sec", "min", "hour", "mday", "mon", "year"}; static const char *en_months[] = {"January", "February","March","April","May","June", "July","August","September","October","November","December"}; // increment **c and return month ix in 1..12 if parsing was successful, 0 if not. int parse_alpha_month(const char **c){ return (parse_alphanum(c, en_months, 12) + 1); } SEXP parse_dt(SEXP str, SEXP ord, SEXP formats, SEXP lt) { // STR: character vector of date-times. // ORD: formats (as in strptime) or orders (as in parse_date_time) // FORMATS: TRUE if ord is a string of formats (as in strptime) // LT: TRUE - return POSIXlt type list, FALSE - return POSIXct seconds if ( !isString(str) ) error("Date-time must be a character vector"); if ( !isString(ord) || (LENGTH(ord) > 1)) error("Format argument must be a character vector of length 1"); R_len_t n = LENGTH(str); int is_fmt = *LOGICAL(formats); int out_lt = *LOGICAL(lt); SEXP oYEAR, oMONTH, oDAY, oHOUR, oMIN, oSEC; if(out_lt){ oYEAR = PROTECT(allocVector(INTSXP, n)); oMONTH = PROTECT(allocVector(INTSXP, n)); oDAY = PROTECT(allocVector(INTSXP, n)); oHOUR = PROTECT(allocVector(INTSXP, n)); oMIN = PROTECT(allocVector(INTSXP, n)); oSEC = PROTECT(allocVector(REALSXP, n)); } else { oSEC = PROTECT(allocVector(REALSXP, n)); } const char *O = CHAR(STRING_ELT(ord, 0)); for (int i = 0; i < n; i++) { const char *c = CHAR(STRING_ELT(str, i)); const char *o = O; double secs = 0.0; // only accumulator for POSIXct case int y = 0, q = 0, m = 0, d = 0, H = 0, M = 0 , S = 0; int succeed = 1, O_format = 0, pm = 0, am = 0; // control logical // read order/format character by character while( *o && succeed ) { if( is_fmt && (*o != '%')) { // with fmt: non formatting characters should match exactly if ( *c == *o ) { c++; o++; } else succeed = 0; } else { if ( is_fmt ){ o++; // skip % } else if ( *o != 'O' && *o != 'z' && *o != 'p' && *o != 'm' && *o != 'b' && *o != 'B') { // skip non-digits // O, z, p formats are treated specially below while (*c && !DIGIT(*c)) c++; } if ( *o == 'O' ) { // Special two letter orders/formats: // Ou (Z), Oz (-0800), OO (-08:00) and Oo (-08) O_format = 1; o++; } else { O_format = 0; } if (!(DIGIT(*c) || O_format || *o == 'z' || *o == 'p' || *o == 'm' || *o == 'b' || *o == 'B')) { succeed = 0; } else { /* Rprintf("c=%c o=%c\n", *c, *o); */ switch( *o ) { case 'Y': // year in yyyy format y = parse_int(&c, 4, TRUE); if (y < 0) succeed = 0; break; case 'y': // year in yy format y = parse_int(&c, 2, FALSE); if (y <= 68) y += 2000; else y += 1900; break; case 'q': // quarter q = parse_int(&c, 2, FALSE); if (!(0 < q && q < 5)) succeed = 0; break; case 'm': // month (allowing all months formats - m, b and B) SKIP_NON_ALPHANUMS(c); m = parse_int(&c, 2, FALSE); if (m == 0) { m = parse_alpha_month(&c); if (m == 0) { SKIP_NON_DIGITS(c); m = parse_int(&c, 2, FALSE); } } if (!(0 < m && m < 13)) succeed = 0; break; case 'b': // alpha English months (both abbreviated and long versions) case 'B': /* SKIP_NON_ALPHANUMS(c); */ m = parse_alpha_month(&c); succeed = m; /* Rprintf("succ=%d c=%c\n", succeed, *c); */ break; case 'd': // day d = parse_int(&c, 2, FALSE); if (!(0 < d && d < 32)) succeed = 0; break; case 'H': // hour 24 H = parse_int(&c, 2, FALSE); if (H > 24) succeed = 0; break; case 'I': // hour 12 H = parse_int(&c, 2, FALSE); if (H > 12) succeed = 0; break; case 'M': // minute M = parse_int(&c, 2, FALSE); if (M > 59) succeed = 0; break; case 'S': // second if( O_format && !is_fmt ){ while (*c && !DIGIT(*c)) c++; if (!*c) { succeed = 0; break; } } S = parse_int(&c, 2, FALSE); if (S < 62){ // allow leap seconds secs += S; if (O_format){ // Parse milliseconds; both . and , as decimal separator are allowed if( *c == '.' || *c == ','){ double ms = 0.0, msfact = 0.1; c++; while (DIGIT(*c)) { ms = ms + (*c - '0')*msfact; msfact *= 0.1; c++; } secs += ms; } } } else succeed = 0; break; case 'p': // AM/PM Both standard 'p' and lubridate 'Op' format SKIP_NON_ALPHANUMS(c); if (O_format) { // with Op format, p is optional (for order parsimony reasons) if (!(*c == 'P' || *c == 'p' || *c == 'A' || *c == 'a')) break; } if (*c == 'P' || *c == 'p') { pm = 1; c++; } else if (*c == 'A' || *c == 'a'){ am = 1; c++; } else { succeed = 0; } if (succeed && !(*c && (*c == 'M' || *c == 'm'))){ succeed = 0; } if (succeed) c++; break; case 'u': // %Ou: "2013-04-16T04:59:59Z" if( O_format ) if( *c == 'Z' || *c == 'z') c++; else succeed = 0; else succeed = 0; break; case 'z': // for %z: "+O100" or "+O1" or "+01:00" if( !O_format ){ if( !is_fmt ) { while (*c && *c != '+' && *c != '-' && *c != 'Z') c++; // skip non + - if( !*c ) { succeed = 0; break; }; } int Z = 0, sig; if( *c == 'Z') {c++; break;} else if ( *c == '+' ) sig = -1; else if ( *c == '-') sig = 1; else { succeed = 0; break; } c++; Z = parse_int(&c, 2, FALSE); secs += sig*Z*3600; if( *c == ':' ){ c++; if ( !DIGIT(*c) ){ succeed = 0; break; } } if( DIGIT(*c) ){ Z = 0; Z = parse_int(&c, 2, FALSE); secs += sig*Z*60; } break; } // else %Oz: "+0100". Pass through. case 'O': // %OO: "+01:00" case 'o': // %Oo: "+01" if( O_format ){ while (*c && *c != '+' && *c != '-' ) c++; // skip non + - int Z = 0, sig; if ( *c == '+' ) sig = -1; else if ( *c == '-') sig = 1; else { succeed = 0; break; } c++; Z = parse_int(&c, 2, FALSE); secs += sig*Z*3600; if( *o == 'O'){ if ( *c == ':') c++; else { succeed = 0; break; } } if ( *o != 'o' ){ Z = 0; Z = parse_int(&c, 2, FALSE); secs += sig*Z*60; } } else error("Unrecognized format '%c' supplied", *o); break; default: error("Unrecognized format %c supplied", *o); } o++; } } } // skip all remaining non digits if( !is_fmt ) while (*c && !DIGIT(*c)) c++; // If at least one subparser hasn't finished it's a failure. if ( *c || *o ) succeed = 0; int is_leap; // adjust months for quarter if (q > 1) m += (q - 1) * 3 + 1; if (succeed) { // leap year every 400 years; no leap every 100 years is_leap = IS_LEAP(y); // check month if (m == 2){ // no check for d > 0 because we allow missing days in parsing if (is_leap) succeed = d < 30; else succeed = d < 29; } else { succeed = d <= mdays[m]; } } // allow missing months and days if (m == 0) m = 1; if (d == 0) d = 1; if(pm){ if(H > 12) succeed = 0; else if (H < 12) H += 12; } if (am){ if (H > 12) succeed = 0; else if (H == 12) H = 0; } if (succeed) { if(out_lt){ INTEGER(oYEAR)[i] = y - 1900; INTEGER(oMONTH)[i] = m - 1; INTEGER(oDAY)[i] = d; INTEGER(oHOUR)[i] = H; INTEGER(oMIN)[i] = M; REAL(oSEC)[i] = secs; } else { secs += sm[m]; secs += (d - 1) * 86400; secs += H * 3600; secs += M * 60; // process leap years y -= 2000; secs += y * yearlen; secs += adjust_leap_years(y, m, is_leap); REAL(oSEC)[i] = secs + d30; } } else { if(out_lt){ INTEGER(oYEAR)[i] = NA_INTEGER; INTEGER(oMONTH)[i] = NA_INTEGER; INTEGER(oDAY)[i] = NA_INTEGER; INTEGER(oHOUR)[i] = NA_INTEGER; INTEGER(oMIN)[i] = NA_INTEGER; REAL(oSEC)[i] = NA_REAL; } else { REAL(oSEC)[i] = NA_REAL; } } } if (out_lt){ SEXP names, out; PROTECT(names = allocVector(STRSXP, 6)); for(int i = 0; i < 6; i++) SET_STRING_ELT(names, i, mkChar(ltnames[i])); PROTECT(out = allocVector(VECSXP, 6)); SET_VECTOR_ELT(out, 0, oSEC); SET_VECTOR_ELT(out, 1, oMIN); SET_VECTOR_ELT(out, 2, oHOUR); SET_VECTOR_ELT(out, 3, oDAY); SET_VECTOR_ELT(out, 4, oMONTH); SET_VECTOR_ELT(out, 5, oYEAR); setAttrib(out, R_NamesSymbol, names); UNPROTECT(8); return out; } else { UNPROTECT(1); return oSEC; } } // STR: string in HxMyS format where x and y are arbitrary non-numeric separators // ORD: orders. Can be any combination of "h", "m" and "s" // RETURN: numeric vector (H1 M1 S1 H2 M2 S2 ...) SEXP parse_hms(SEXP str, SEXP ord) { if (TYPEOF(str) != STRSXP) error("HMS argument must be a character vector"); if ((TYPEOF(ord) != STRSXP) || (LENGTH(ord) > 1)) error("Orders vector must be a character vector of length 1"); int n = LENGTH(str); int len = 3*n; const char *O = CHAR(STRING_ELT(ord, 0)); SEXP res; double *data; res = allocVector(REALSXP, len); data = REAL(res); for (int i = 0; i < n; i++) { const char *c = CHAR(STRING_ELT(str, i)); const char *o = O; int H=0, M=0, j=i*3; int sign = 1; double S=0.0; while (*c && !SDIGIT(*c)) c++; if (SDIGIT(*c)) { while( *o ){ if (*c == '-'){ sign = -1; c++; } switch( *o ) { case 'H': if(!DIGIT(*c)) {data[j] = NA_REAL; break;} while (DIGIT(*c)) { H = H * 10 + (*c - '0'); c++; } data[j] = H * sign; break; case 'M': if(!DIGIT(*c)) {data[j+1] = NA_REAL; break;} while (DIGIT(*c)) { M = M * 10 + (*c - '0'); c++; } data[j+1]= M * sign; break; case 'S': if(!DIGIT(*c)) {data[j+2] = NA_REAL; break;} while (DIGIT(*c) ) { S = S * 10 + (*c - '0'); c++; } // both . and , as decimal Seconds separator are allowed if( *c == '.' || *c == ','){ double ms = 0.0, msfact = 0.1; c++; while (DIGIT(*c)) { ms = ms + (*c - '0')*msfact; msfact *= 0.1; c++; } S += ms; } data[j+2] = S * sign; break; default: error("Unrecognized format %c supplied", *o); } while (*c && !SDIGIT(*c)) c++; sign = 1; o++; } } // unfinished parsing, return NA if ( *c || *o ){ data[j] = NA_REAL; data[j+1] = NA_REAL; data[j+2] = NA_REAL; } } return res; } lubridate/src/datetime.c0000644000175100001440000001075712765562217015021 0ustar hornikusers/* * datetime constructor for lubridate * Author: Vitalie Spinu * Copyright (C) 2013--2015 Vitalie Spinu, Garrett Grolemund, Hadley Wickham, * * This program is free software; you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by the Free * Software Foundation; either version 2 of the License, or (at your option) * any later version. * * This program is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, a copy is available at * http://www.r-project.org/Licenses/ */ #define USE_RINTERNALS 1 #include #include #include "constants.h" #include "utils.h" SEXP make_dt(SEXP year, SEXP month, SEXP day, SEXP hour, SEXP minute, SEXP second) { if(!isInteger(year)) error("year must be integer"); if(!isInteger(month)) error("month must be integer"); if(!isInteger(day)) error("day must be integer"); if(!isInteger(hour)) error("hour must be integer"); if(!isInteger(minute)) error("minute must be integer"); if(!isNumeric(second)) error("second must be numeric"); R_len_t n = LENGTH(year); if(n != LENGTH(month)) error("length of 'month' vector is not the same as that of 'year'"); if(n != LENGTH(day)) error("length of 'day' vector is not the same as that of 'year'"); if(n != LENGTH(hour)) error("length of 'hour' vector is not the same as that of 'year'"); if(n != LENGTH(minute)) error("length of 'minute' vector is not the same as that of 'year'"); if(n != LENGTH(second)) error("length of 'second' vector is not the same as that of 'year'"); int* pyear = INTEGER(year); int* pmonth = INTEGER(month); int* pday = INTEGER(day); int* phour = INTEGER(hour); int* pminute = INTEGER(minute); int int_second = TYPEOF(second) == INTSXP; SEXP res = allocVector(REALSXP, n); double *data = REAL(res); for(int i = 0; i < n; i++) { // main accumulator double SECS = 0.0; int y = pyear[i]; int m = pmonth[i]; int d = pday[i]; int H = phour[i]; int M = pminute[i]; int naS; double S; if(int_second){ S = (double) INTEGER(second)[i]; naS = INTEGER(second)[i] == NA_INTEGER; } else { S = REAL(second)[i]; naS = ISNA(S); } if(naS || y == NA_INTEGER || m == NA_INTEGER || d == NA_INTEGER || H == NA_INTEGER || M == NA_INTEGER) { data[i] = NA_REAL; } else { if ( 0 < m && m < 13 ) SECS += sm[m]; else { data[i] = NA_REAL; continue; } if ( 0 < d && d < 32 ) SECS += (d - 1) * 86400; else { data[i] = NA_REAL; continue; } if( H < 25 ) SECS += H * 3600; else { data[i] = NA_REAL; continue; } if ( M < 61 ) SECS += M * 60; else{ data[i] = NA_REAL; continue; } // allow leap seconds if ( S < 62 ) { SECS += S; } else { data[i] = NA_REAL; continue; } int is_leap = IS_LEAP(y); if(check_ymd(y, m, d, is_leap)){ SECS += d30; y -= 2000; SECS += y * yearlen; SECS += adjust_leap_years(y, m, is_leap); data[i] = SECS; } else { data[i] = NA_REAL; } } } return res; } SEXP make_d(SEXP year, SEXP month, SEXP day) { if(!isInteger(year)) error("year must be integer"); if(!isInteger(month)) error("month must be integer"); if(!isInteger(day)) error("day must be integer"); R_len_t n = LENGTH(year); if(n != LENGTH(month)) error("length of 'month' vector is not the same as that of 'year'"); if(n != LENGTH(day)) error("length of 'day' vector is not the same as that of 'year'"); int* pyear = INTEGER(year); int* pmonth = INTEGER(month); int* pday = INTEGER(day); SEXP res = allocVector(REALSXP, n); double *data = REAL(res); for(int i = 0; i < n; i++) { // main accumulator double SECS = 0.0; int y = pyear[i]; int m = pmonth[i]; int d = pday[i]; if(y == NA_INTEGER || m == NA_INTEGER || d == NA_INTEGER) { data[i] = NA_REAL; } else { if ( 0 < m && m < 13 ) SECS += sm[m]; else { data[i] = NA_REAL; continue; } if ( 0 < d && d < 32 ) SECS += (d - 1) * 86400; else { data[i] = NA_REAL; continue; } int is_leap = IS_LEAP(y); if(check_ymd(y, m, d, is_leap)){ SECS += d30; y -= 2000; SECS += y * yearlen; SECS += adjust_leap_years(y, m, is_leap); data[i] = SECS; } else { data[i] = NA_REAL; } } } return res; } lubridate/src/period.c0000644000175100001440000000531212765562217014476 0ustar hornikusers/* * period and duration parser for lubridate * Author: Vitalie Spinu * Copyright (C) 2013--2016 Vitalie Spinu, Garrett Grolemund, Hadley Wickham, * * This program is free software; you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by the Free * Software Foundation; either version 2 of the License, or (at your option) * any later version. * * This program is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for * more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, a copy is available at * http://www.r-project.org/Licenses/ */ #define USE_RINTERNALS 1 // slight increase in speed #include #include #include "constants.h" #include "utils.h" static const char *en_units[] = {"SECS", "secs", "seconds", "MINS", "mins", "minutes", "HOURS", "hours", "days", "weeks", "months", "years"}; #define N_EN_UNITS 12 #define N_PERIOD_UNITS 7 intUnit parse_period_unit (const char **c) { // S=0, M=1, H=2, d=3, w=4, m=5, y=6 // why this macro doesn't work? /* SKIP_NON_ALPHANUMS(*c); */ while(**c && !(ALPHA(**c) || DIGIT(**c))) (*c)++;; intUnit out; out.unit = -1; out.val = parse_int(c, 100, FALSE); if(out.val == 0) out.val = 1; if(**c){ out.unit = parse_alphanum(c, en_units, N_EN_UNITS); if (out.unit < 0){ return out; } else { if(out.unit < 3) out.unit = 0; else if (out.unit < 6) out.unit = 1; else if (out.unit < 8) out.unit = 2; else out.unit = out.unit - 5; return out; } } else { return out; } } void parse_period_1 (const char **c, int ret[N_PERIOD_UNITS]){ while (**c) { intUnit iu = parse_period_unit(c); if (iu.unit >= 0) { ret[iu.unit] = ret[iu.unit] + iu.val; } else { ret[0] = NA_INTEGER; break; } } } SEXP c_parse_period(SEXP str) { if (TYPEOF(str) != STRSXP) error("STR argument must be a character vector"); int n = LENGTH(str); SEXP out = allocVector(INTSXP, n * N_PERIOD_UNITS); int *data = INTEGER(out); for (int i = 0; i < n; i++) { const char *c = CHAR(STRING_ELT(str, i)); int ret[N_PERIOD_UNITS] = {0}; parse_period_1(&c, ret); int j = i * N_PERIOD_UNITS; for(int k = 0; k < N_PERIOD_UNITS; k++) { data[j + k] = ret[k]; } } return out; } lubridate/NAMESPACE0000644000175100001440000001337312763546421013503 0ustar hornikusers# Generated by roxygen2: do not edit by hand S3method(as.POSIXct,fts) S3method(as.POSIXct,irts) S3method(as.POSIXct,its) S3method(as.POSIXct,timeSeries) S3method(as.POSIXct,xts) S3method(as.POSIXct,zoo) S3method(as.POSIXlt,fts) S3method(as.POSIXlt,irts) S3method(as.POSIXlt,its) S3method(as.POSIXlt,timeSeries) S3method(as.POSIXlt,tis) S3method(as.POSIXlt,xts) S3method(as.POSIXlt,zoo) S3method(as.list,Interval) S3method(c,POSIXct) S3method(date,Period) S3method(date,default) S3method(decimal_date,default) S3method(decimal_date,its) S3method(decimal_date,zoo) S3method(dst,default) S3method(format,Duration) S3method(format,Interval) S3method(format,Period) S3method(hour,Period) S3method(hour,default) S3method(mday,Period) S3method(mday,default) S3method(minute,Period) S3method(minute,default) S3method(month,Period) S3method(month,default) S3method(month,numeric) S3method(months,numeric) S3method(qday,default) S3method(reclass_date,Date) S3method(reclass_date,POSIXct) S3method(reclass_date,POSIXlt) S3method(reclass_date,chron) S3method(reclass_date,its) S3method(reclass_date,ti) S3method(reclass_date,timeDate) S3method(second,Period) S3method(second,default) S3method(summary,Duration) S3method(summary,Interval) S3method(summary,Period) S3method(tz,default) S3method(tz,irts) S3method(tz,timeSeries) S3method(tz,zoo) S3method(unique,Interval) S3method(update,Date) S3method(update,POSIXt) S3method(wday,default) S3method(wday,numeric) S3method(xtfrm,Period) S3method(yday,default) S3method(year,Period) S3method(year,default) export("%--%") export("%m+%") export("%m-%") export("%within%") export("date<-") export("day<-") export("hour<-") export("int_end<-") export("int_start<-") export("mday<-") export("minute<-") export("month<-") export("qday<-") export("second<-") export("tz<-") export("wday<-") export("week<-") export("yday<-") export("year<-") export(add_with_rollback) export(am) export(as.difftime) export(as.duration) export(as.interval) export(as.period) export(as_date) export(as_datetime) export(ceiling_date) export(date) export(date_decimal) export(day) export(days) export(days_in_month) export(ddays) export(decimal_date) export(dhours) export(dmicroseconds) export(dmilliseconds) export(dminutes) export(dmy) export(dmy_h) export(dmy_hm) export(dmy_hms) export(dnanoseconds) export(dpicoseconds) export(dseconds) export(dst) export(duration) export(dweeks) export(dyears) export(dym) export(edays) export(ehours) export(emicroseconds) export(emilliseconds) export(eminutes) export(enanoseconds) export(epicoseconds) export(eseconds) export(eweeks) export(eyears) export(fast_strptime) export(fit_to_timeline) export(floor_date) export(force_tz) export(guess_formats) export(here) export(hm) export(hms) export(hour) export(hours) export(int_aligns) export(int_diff) export(int_end) export(int_flip) export(int_length) export(int_overlaps) export(int_shift) export(int_standardize) export(int_start) export(intersect) export(interval) export(is.Date) export(is.POSIXct) export(is.POSIXlt) export(is.POSIXt) export(is.difftime) export(is.duration) export(is.instant) export(is.interval) export(is.period) export(is.timepoint) export(is.timespan) export(isoweek) export(isoyear) export(leap_year) export(make_date) export(make_datetime) export(make_difftime) export(mday) export(mdy) export(mdy_h) export(mdy_hm) export(mdy_hms) export(microseconds) export(milliseconds) export(minute) export(minutes) export(month) export(ms) export(myd) export(nanoseconds) export(new_difftime) export(new_duration) export(new_interval) export(new_period) export(now) export(olson_time_zones) export(origin) export(parse_date_time) export(parse_date_time2) export(period) export(period_to_seconds) export(picoseconds) export(pm) export(pretty_dates) export(qday) export(quarter) export(reclass_date) export(reclass_timespan) export(rollback) export(round_date) export(second) export(seconds) export(seconds_to_period) export(semester) export(setdiff) export(stamp) export(stamp_date) export(stamp_time) export(time_length) export(today) export(tz) export(union) export(wday) export(week) export(weeks) export(with_tz) export(yday) export(ydm) export(ydm_h) export(ydm_hm) export(ydm_hms) export(year) export(years) export(ymd) export(ymd_h) export(ymd_hm) export(ymd_hms) export(yq) exportClasses(Duration) exportClasses(Interval) exportClasses(Period) exportClasses(Timespan) exportMethods("$") exportMethods("$<-") exportMethods("%%") exportMethods("%/%") exportMethods("%m+%") exportMethods("%m-%") exportMethods("*") exportMethods("+") exportMethods("-") exportMethods("/") exportMethods("[") exportMethods("[<-") exportMethods("[[") exportMethods("[[<-") exportMethods("date<-") exportMethods("day<-") exportMethods("hour<-") exportMethods("minute<-") exportMethods("month<-") exportMethods("second<-") exportMethods("year<-") exportMethods(Arith) exportMethods(Compare) exportMethods(as.character) exportMethods(as.difftime) exportMethods(as.interval) exportMethods(as.numeric) exportMethods(as_date) exportMethods(as_datetime) exportMethods(c) exportMethods(intersect) exportMethods(reclass_timespan) exportMethods(rep) exportMethods(setdiff) exportMethods(show) exportMethods(union) import(stringr) importFrom(methods,"slot<-") importFrom(methods,Arith) importFrom(methods,Compare) importFrom(methods,allNames) importFrom(methods,callGeneric) importFrom(methods,is) importFrom(methods,new) importFrom(methods,setClass) importFrom(methods,setGeneric) importFrom(methods,show) importFrom(methods,slot) importFrom(methods,slotNames) importFrom(methods,validObject) importFrom(stats,na.omit) importFrom(stats,setNames) importFrom(stats,update) importFrom(utils,packageVersion) importFrom(utils,read.delim) useDynLib(lubridate,c_parse_period) useDynLib(lubridate,make_d) useDynLib(lubridate,make_dt) useDynLib(lubridate,parse_dt) useDynLib(lubridate,parse_hms) lubridate/NEWS.md0000644000175100001440000006136312765543775013377 0ustar hornikusersVersion 1.5.6.9000 (development) ============ ### NEW FEATURES * [#464](https://github.com/hadley/lubridate/issues/464) New function `semester` to extract semesters form date-time objects. * [#459](https://github.com/hadley/lubridate/issues/459) Flexible C-level parsing for periods and durations has been implemented; `period` and `duration` constructors now accept string as first argument. Same parsing rules apply to the 'unit' parameter in rounding functions. * [#459](https://github.com/hadley/lubridate/issues/459) Comparison between character vectors and periods/durations is now possible. * [#287](https://github.com/hadley/lubridate/issues/287) C-level and derivative parsers now handle English months (%b and %B formats) irrespective of the current locale. * [#327](https://github.com/hadley/lubridate/issues/327) C-level and derivative parsers now handles English AM/PM indicator irrespective of the current locale. * [#417](https://github.com/hadley/lubridate/issues/417) `hms`, `hm`, `ms` gained new argument `roll=TRUE` which rolls minutes and seconds bigger than 59 towards higher units. * [#445](https://github.com/hadley/lubridate/issues/445) Division of intervals by periods is now accurate. * [#442](https://github.com/hadley/lubridate/issues/442) `round_date`, `floor_date` and `ceiling_date` now support rounding to multiple of units. * [#422](https://github.com/hadley/lubridate/issues/422) New parsing function `yq` for parsing most common version of quarter strings. * [#422](https://github.com/hadley/lubridate/issues/422) New format `q` for parsing quarters in all lubridate parsing functions. * [#441](https://github.com/hadley/lubridate/issues/441) Comparison between POSIXt and Date objects is now possible. * [#437](https://github.com/hadley/lubridate/issues/437) New function `as_datetime` to coerce to POSIXct object. A counterpart of `as_date`. * [#412](https://github.com/hadley/lubridate/issues/412) New function `make_date` to produce Date objects. A counterpart of `make_datetime`. * [#443](https://github.com/hadley/lubridate/issues/443) Behavior of `ceiling_date` for `Date` objects was changed to what most of the users expect. Rounding up by months now produces first day of the next months even for first day of the month. * [#268](https://github.com/hadley/lubridate/issues/268) `round_date`, `ceiling_date`, and `floor_date` now accept "quarter", "bimonth", and "halfyear" as `unit` options. * [#418](https://github.com/hadley/lubridate/issues/418) C level parsing functions understand 24:00:00 in datetime strings. ### CHANGES * Low letter specs for HMS (hms,hm,ms) in `parse_date_time` and related functions are now deprecated. * [#445](https://github.com/hadley/lubridate/issues/445) No more warning on occasional imprecise period length conversions. Imprecise arithmetics with periods is extensively documented. * `pretty.*` family of functions were renamed and are no longer exported. If you need to use them, use `lubridate:::pretty_*` versions. * `change_on_boundary` argument in `ceiling_date` does not allow for global option anymore. * `as.duration`, `as.numeric` don't show "only estimate" messages on conversion from periods. The occasional approximate conversion is documented and deemed common knowledge. * `as.numeric` with `unit="month"` now works on duration objects. * [#403](https://github.com/hadley/lubridate/issues/403) Update on `Date` objects now return `POSIXct` instead of `POSIXlt`. * [#411](https://github.com/hadley/lubridate/issues/411) format `mdy` or `myd` beginning with `"January"` or `"Jan"` now parsing correctly * `here` and `olson_time_zones` were deprecated in favor of `new` and base `OlsonNames` respectively. * Internally, S4 Compare and Ops generics were cleaned and simplified. * [#456](https://github.com/hadley/lubridate/issues/456) Evaluation output in documentation examples was removed. ### BUG FIXES * [#463](https://github.com/hadley/lubridate/issues/463) Fix NA subscripting error in %m+% when rollback is involved. * [#462](https://github.com/hadley/lubridate/issues/462) Non-numeric or non-character arguments are disallowed as arguments to `period` and `duration` constructors. * [#458](https://github.com/hadley/lubridate/issues/458) When year is missing in parsing, return consistently year 0. * [#448](https://github.com/hadley/lubridate/issues/448) Correctly handle missing months and days in C parser. * [#450](https://github.com/hadley/lubridate/issues/450) Fix incorrect handling of DST gaps in `date_decimal` and `decimal_date`. * [#420](https://github.com/hadley/lubridate/issues/420) `as.numeric` correctly converts periods to (aproximate) numeric time lengths. Version 1.5.6 ============ ### NEW FEATURES * [#390](https://github.com/hadley/lubridate/issues/390) `ceiling_date` gains new argument `change_on_boundary` to allow ceiling on boundary of date-time objects. * C parser can now produce a list of date-time components suitable for POSIXlt constructors. * `parse_date_time2` and `fast_strptime` gain new `lt` argument to control type of output. * [#373](https://github.com/hadley/lubridate/issues/373) New `date` and `date<-` additions to the `year`, `month` etc family of accessors. * [#365](https://github.com/hadley/lubridate/issues/365) New very fast datetime constructor `make_datetime` (dropin replacement of `ISOdatetime`). * [#344](https://github.com/hadley/lubridate/issues/344) `force_tz` and `with_tz` can handle data.frames component-wise. * [#355](https://github.com/hadley/lubridate/issues/355) New `as_date` replacement of `as.Date` with more intuitive behavior with non-UTC timezones. * [#333](https://github.com/hadley/lubridate/issues/333) `hms` parsers now handle negative components. ### CHANGES * [#391](https://github.com/hadley/lubridate/issues/391) `ymd` family of functions return `Date` object when `tz` argument is NULL (new default) and POSIXct otherwise. * [#364](https://github.com/hadley/lubridate/issues/364) Remove epoch functions. * For consistency with `base:strptime` `fast_strptime` now returns `POSIXlt` object. That is, its `lt` argument defaults to `TRUE`. ### BUG FIXES * `interval` constructor treats timezones correctly and works with UTC whenever meaningful. * [#371](https://github.com/hadley/lubridate/issues/371) `as.period` correctly computes months with intervals spanning multiple years. * [#388](https://github.com/hadley/lubridate/issues/388) `time_length` and `add_with_rollback` now work correctly with missing intervals. * [#394](https://github.com/hadley/lubridate/issues/394) `fast_strptime` and `parse_date_time2` correctly treat non-UTC time zones. * [#399](https://github.com/hadley/lubridate/issues/399) `floor_date` and `round_date` are not preserving tz component for larger than day units Version 1.5.0 ============= ### NEW FEATURES * New `time_length` method. * Added `isoyear` function to line up with `isoweek`. * [#326](https://github.com/hadley/lubridate/issues/326) Added `exact = TRUE` option to `parse_date_time` for faster and much more flexible specification of formats. * New `simple` argument to `fit_to_timeline` and `update` methods mostly intended for internal use. * [#315](https://github.com/hadley/lubridate/issues/315) Implement `unique` method for `interval` class. * [#295](https://github.com/hadley/lubridate/issues/295) New args `preserve_hms` and `roll_to_first` in `rollback` function. * [#303](https://github.com/hadley/lubridate/issues/303) New `quarter` option in `floor_date` and friends. * [#348](https://github.com/hadley/lubridate/issues/348) New `as.list.Interval` S3 method. * [#278](https://github.com/hadley/lubridate/issues/278) Added settors and accessors for `qday` (quarter day). ### CHANGES * New maintainer Vitalie Spinu (@vspinu) * Time span constructors were re-factored; `new_interval`, `new_period`, `new_duration`, `new_difftime` were deprecated in favour of the more powerful `interval`, `period`, `duration` and `make_difftime` functions. * `eseconds`, `eminutes` etc. were deprecated in favour of `dsecons`, `dminutes` etc. * Many documentation improvements. * New testthat conventions are adopted. Tests are now in `test/testthat`. * Internally `isodate` was replaced with a much faster `parse_date_time2(paste(...))` alternative * [#325](https://github.com/hadley/lubridate/issues/325) `Lubridate`'s `trunc`, `ceiling` and `floor` functions have been optimised and now are relying on R's `trunc.POSIXct` whenever possible. * [#285](https://github.com/hadley/lubridate/issues/285) Algebraic computations with negative periods are behaving asymmetrically with respect to their positive counterparts. * Made necessary changes to accommodate new zoo-based `fst` objects. ### BUG FIXES * [#360](https://github.com/hadley/lubridate/issues/360) Fix c parser for Z (zulu) indicator. * [#322](https://github.com/hadley/lubridate/issues/322) Explicitly encode formatted string with `enc2utf8`. * [#302](https://github.com/hadley/lubridate/issues/302) Allow parsing long numbers such as 20140911000000 as date+time. * [#349](https://github.com/hadley/lubridate/issues/349) Fix broken interval -> period conversion. * [#336](https://github.com/hadley/lubridate/issues/336) Fix broken interval-> period conversion with negative diffs. * [#227](https://github.com/hadley/lubridate/issues/227) Treat "days" and "years" units specially for pretty.point. * [#286](https://github.com/hadley/lubridate/issues/286) %m+-% correctly handles dHMS period components. * [#323](https://github.com/hadley/lubridate/issues/323) Implement coercion methods for Duration class. * [#226](https://github.com/hadley/lubridate/issues/226) Propagate NAs in `int_standardize` * [#235](https://github.com/hadley/lubridate/issues/235) Fix integer division with months and years. * [#240](https://github.com/hadley/lubridate/issues/240) Make `ceiling_date` skip day light gap. * [#254](https://github.com/hadley/lubridate/issues/254) Don't preprocess a/A formats if expressly specified by the user. * [#289](https://github.com/hadley/lubridate/issues/289) Check for valid day-months combinations in C parser. * [#306](https://github.com/hadley/lubridate/issues/306) When needed double guess with `preproc_wday=T`. * [#308](https://github.com/hadley/lubridate/issues/308) Document sparce format guessing in `parse_date_time`. * [#313](https://github.com/hadley/lubridate/issues/313) Fixed and optimized `fit_to_timeline` function. * [#311](https://github.com/hadley/lubridate/issues/311) Always use UTC in `isoweek` computation * [#294](https://github.com/hadley/lubridate/issues/294) Don't use years in `seconds_to_period`. * Values on `$<-` assignment for periods are now properly recycled. * Correctly handle NA subscripting in `round_date`. Version 1.4.0 ============= ### CHANGES * [#219](//github.com/hadley/lubridate/issues/219) In `interval` use UTC when tzone is missing. * [#255](//github.com/hadley/lubridate/issues/255) Parse yy > 68 as 19yy to comply with `strptime`. ### BUG FIXES * [#266](//github.com/hadley/lubridate/issues/266) Include `time-zones.R` in `coercion.R`. * [#251](//github.com/hadley/lubridate/issues/251) Correct computation of weeks. * [#262](//github.com/hadley/lubridate/issues/262) Document that month boundary is the first second of the month. * [#270](//github.com/hadley/lubridate/issues/270) Add check for empty unit names in `standardise_lt_names`. * [#276](//github.com/hadley/lubridate/issues/276) Perform conversion in `as.period.period` if `unit != NULL`. * [#284](//github.com/hadley/lubridate/issues/284) Compute periods in `as.period.interval` without recurring to modulo arithmetic. * [#272](//github.com/hadley/lubridate/issues/272) Update examples for `hms`, `hm` and `ms` for new printing style. * [#236](//github.com/hadley/lubridate/issues/236) Don't allow zeros in month and day during parsing. * [#247](//github.com/hadley/lubridate/issues/247) Uninitialized index was mistakenly used in subseting. * [#229](//github.com/hadley/lubridate/issues/229) `guess_formats` now matches flex regexp first. * `dmilliseconds` now correctly returns a `Duration` object. * Fixed setdiff for discontinuous intervals. Version 1.3.3 ============= ### CHANGES * New low level C parser for numeric formats and two new front-end R functions parse_date_time2 and fast_strptime. The achieved speed up is 50-100x as compared to standard as.POSIXct and strptime functions. The user level parser functions of ymd_hms family drop to these C routines whenever plain numeric formats are detected. ### BUG FIXES * olson_time_zones now supports Solaris OS * infinite recursion on parsing non-existing leap times was fixed Version 1.3.2 ============= * Lubridate's s4 methods no longer use the representation argument, which has been deprecated in R 3.0.0 (see ?setClass). As a result, lubridate is no longer backwards compatible with R <3.0.0. Version 1.3.0 ============= ### CHANGES * v1.3.0. treats math with month and year Periods more consistently. If adding or subtracting n months would result in a non-existent date, lubridate will return an NA instead of a day in the following month or year. For example, `ymd("2013-01-31") + months(1)` will return `NA` instead of `2013-03-04` as in v1.2.0. `ymd("2012-02-29") + years(1)` will also return an `NA`. This rule change helps ensure that date + timespan - timespan = date (or NA). If you'd prefer that such arithmetic just returns the last day of the resulting month, see `%m+%` and `%m-%`. * update.POSIXct and update.POSIXlt have been rewritten to be 7x faster than their versions in v1.2.0. The speed gain is felt in `force_tz`, `with_tz`, `floor_date`, `ceiling_date`, `second<-`, `minute<-`, `hour<-`, `day<-`, `month<-`, `year<-`, and other functions that rely on update (such as math with Periods). * lubridate includes a Korean translation provided by http://korea.gnu.org/gnustats/ ### NEW FEATURES * lubridate parser and stamp functions now handle ISO8601 date format (e.g., 2013-01-24 19:39:07.880-06:00, 2013-01-24 19:39:07.880Z) * lubridate v1.3.0 comes with a new R vignette. see `browseVignettes("lubridate")` to view it. * The accessors `second`, `minute`, `hour`, `day`, `month`, `year` and the settors `second<-`, `minute<-`, `hour<-`, `day<-`, `month<-`, `year<-` now work on Period class objects * users can control which messages lubridate returns when parsing and estimating with the global option lubridate.verbose. Run `options(lubridate.verbose = TRUE)` to turn parsing messages on. Run `options(lubridate.verbose = FALSE)` to turn estimation and coercion messages off. * lubridate parser functions now propagate NA's just as as.POSIXct, strptime and other functions do. Previously lubridate's parse functions would only return an error. * added [[ and [[<- methods for INterval, Period and Duration class objects * added `%m+%` and `%m-%` methods for Interval and Duration class objects that throw useful errors. * `olson_time_zones` retreives a character vector is Olson-style time zone names to use in lubridate * summary methods for Interval, Period, and Duration classes * date_decimal converts a date written as a decimal of a year into a POSIXct date-time ### BUG FIXES * fixed bug in way update.POSIXct and update.POSIXlt handle dates that occur in the fall daylight savings overlap. update will choose the date-time closest to the original date time (on the timeline) when two identical clock times exist due to the DST overlap. * fixed bugs that created unintuitive results for `as.interval`, `int_overlaps`, `%within%` and the interval methods of `c`, `intersect`, `union`, `setdiff`, and `summary`. * parse functions, `as.interval`, `as.period` and `as.duration` now handlevectors of NA's without returning errors. * parsers better handle vectors of input that have more than 100 elements and many NAs * data frames that contain timespan objects with NAs in thme no longer fail toprint * `round_date`, `ceiling_date` and `update` now correctly handle input of length zero * `decimal_date` no longer returns NaN for first second of the year Version 1.2.0 ============= ### CHANGES * lubridate 1.2.0 is significantly faster than lubridate 1.1.0. This is largely thanks to a parser rewrite submitted by Vitalie Spinu. Thank you, Vitalie. Some metrics: - parser speed up - 60x faster - `with_tz` speed up - 15x faster - `force_tz` speed up - 3x faster * Development for 1.2.0 has also focused on improving the way we work with months. `rollback` rolls dates back to the last day of the previous month. provides more options for working with months. `days_in_month` finds the number of days in a date's month. And, `%m+%` and `%m-%` provide a new way to ### handle unequal month lengths while doing arithmetic. See NEW FEATURES for more details * date parsing can now parse multiple date formats within the same vector of date-times. Parsing can also recognize a greater variety of date-time formats as well as incomplete (truncated) date-times. Contributed by Vitalie Spinu. Thank you, Vitalie. * 1.2.0 introduces a new display format for periods. The display is more math and international friendly. * 1.2.0 transforms negative intervals into periods much more gracefully (e.g, - 3 days instead of -1 years, 11 months, and 27 days) * S3 update methods are now exported ### NEW FEATURES * `stamp` allows users to print dates in whatever form they like. Contributed by Vitalie Spinu. Thank you, Vitalie. * periods now handle fractional seconds. Contributed by Vitalie Spinu. Thank you, Vitalie. * date parsing can now parse multiple date formats within the same vector of date-times. Parsing can also recognize a greater variety of date-time formats as well as incomplete (truncated) date-times. Contributed by Vitalie Spinu. Thank you, Vitalie. * `sort`, `order`, `rank` and `xtfrm` now work with periods * `as.period.Interval` accepts a unit argument. `as.period` will convert intervals into periods no larger than the supplied unit. * `days_in_month` takes a date, returns the number of days in the date's month. Contributed by Richard Cotton. Thank you, Richard. * `%m+%` and `%m-%` perform addition and subtraction with months (and years) without rollover at the end of a month. These can be used in place of + and -. These can't be used with periods smaller than a month, which should be handled separately. An example of the new behavior: ymd("2010-01-31") %m+% months(1) # "2010-02-28 UTC" ymd("2010-01-31") + months(1) # "2010-03-03 UTC" ymd("2010-03-31") %m-% months(1) # "2010-02-28 UTC" ymd("2010-01-31") - months(1) # "2010-03-03 UTC" * `rollback` rolls a date back to the last day of the previous month. * `quarter` returns the fiscal quarter that a date occurs in. Like `quartes` in base R, but returns a numeric instead of a character string. ### BUG FIXES * date parsers now handle NAs * periods now handle NAs * `[<-` now correctly updates all elements of a period inside a vector, list, or data.frame * `period()` now works with unit = "weeks" * `ceiling_date` no longer rounds up if a date is already at a ceiling * the redundant (i.e, repeated) hour of fall daylight savings time now displays with the correct time zone * `update.POSIXct` and `update.POSIXlt` handle vectors that sum to zero in the days argument * the format method for periods, intervals and duration now accurately displays objects of length 0. Version 1.1.0 ============= ### CHANGES * lubridate no longer overwrites base R methods for +, - , *, /, %%, and %/%. To recreate the previous experience of subtracting two date times to create an interval, we've added the interval creation function %--%. * lubridate has moved to an S4 object system. Timespans, Intervals, Durations, and Periods have each been redefined as an S4 class with its own methods. * arithmetic operations will no longer perform implicit class changes between timespans. Users must explicitly state how and when they wish class changes to occur with as.period(), as.duration(), and as.interval(). This makes code written with lubridate more robust, as such implicit changes often did not produce consistent behavior across a variety of operations. It also allows lubridate to be less chatty with fewer console messages. lubridate does not need to explain what it is doing, because it no longer attempts to do things whose outcome would not be clear. On the other hand, arithmetic between multiple time classes will produce informative error messages. * the internal structure of lubridate R code has been reorganized at https://github.com/hadley/lubridate to make lubridate more development friendly. ### NEW FEATURES * intervals are now more useful and lubridate has more ways to manipulate them. Intervals can be created with %--%; modified with int_shift(), int_flip(), and int_standardize(); manipulated with intersect(), union(), and setdiff(); and used in logical tests with int_aligns(), int_overlaps(), and %within%. lubridate will no longer perform arithmetic between two intervals because the correct results of such operations is no more obvious than the correct result of adding two dates. Instead users are encouraged to use the new set operations or to directly modify intervals with int_start() and int_end(), which can also be used as settors. lubridate now supports negative intervals as well as positive intervals. Intervals also now display with a time zone. * Modulo methods for timespans have been changed to return a timespan. this allows modulo methods to be used with integer division in an intuitive manner, e.g. `a = a %/% b * b + a %% b` Users can still acheive a numerical result by using as.numeric() on input before performing modulo. * Periods, durations, and intervals can now all be put into a data frame. * Periods, durations, and intervals can be intuitively subset with $ and []. These operations also can be used as settors with <-. * The parsing functions and the as.period method for intervals are now slightly faster. * month<- and wday<- settors accept names as well as numbers * parsing functions now have a quiet argument to parse without messages and a tz argument to directly parse times into the desired time zone. * logical comparison methods now work for period objects. Version 0.2.6 ============= * use `test_package` to avoid incompatibility with current version of `testthat` * other minor fixes to pass `R CMD check` Version 0.2.5 ============= * added ymdThms() for parsing ISO 8061 formatted combned dates and times ### BUG FIXES * removed bug in parsing dates with "T" in them * modified as.period.interval() to display periods in positive units Version 0.2.4 ============= * Add citations to JSS article Version 0.2.3 ============= ### NEW FEATURES * ymd_hms(), hms(), and ms() functions can now parse dates that include decimal values in the seconds element. * milliseconds(), microseconds(), nanoseconds(), and picoseconds() create period objects of the specified lengths. dmilliseconds(), dmicroseconds(), dnanoseconds(), and dpicoseconds() make duration objects of the specified lengths. ### BUG FIXES * lubridate no longer overwrites months(), start(), and end() from base R. Start and end have been replaced with int_start() and int_end(). * lubridate imports plyr and stringr packages, instead of depending on them. Version 0.2.2 ============= ### NEW FEATURES * made division, modulo, and integer division operations compatible with difftimes * created c() methods for periods and durations ### BUG FIXES * fixed bug in division, modulo, and integer operations with timespans Version 0.2.1 ============= ### NEW FEATURES * created parsing functions ymd_hm ymd_h dmy_hms dmy_hm dmy_h mdy_hms mdy_hm mdy_h ydm_hms ydm_hm ydm_h, which operate in the same way as ymd_hms(). ### BUG FIXES * fixed bug in add_dates(). duration objects can now be successfully added to numeric objects. ----------- Version 0.2 =========== ### NEW FEATURES * division between timespans: each timespan class (durations, periods, intervals) can be divided by other timespans. For example, how many weeks are there between Halloween and Christmas?: (christmas - halloween) / weeks(1) * modulo operations between timespans * duration objects now have their own class and display format separate from difftimes * interval objects now use an improved data structure and have a cleaner display format * lubridate now loads its own namespace * math operations now automatically coerce interval objects to duration objects. Allows intervals to be used "right out of the box" without error messages. * created start() and end() functions for accessing and changing the boundary date-times of an interval * rep() methods for periods, intervals, and durations ### MINOR CHANGES * added a package help page with functions listed by purpose * eseconds(), eminutes(), etc. are aliased to dseconds(), dminutes(), etc. to make it easier to remember they are duration objects. * changed leap.years() to leap_years() to maintain consistent naming scheme ### BUG FIXES * rewrote as.period() to create only positive periods. * fixed rollover bug in update.POSIXct() * edited make_diff() to display in days when approporiate, not weeks lubridate/data/0000755000175100001440000000000012704211672013156 5ustar hornikuserslubridate/data/lakers.rda0000644000175100001440000041763012704211672015142 0ustar hornikusersBZh91AY&SYdSX*rؠʧjPZ}UU(h4 4i 2 p 4ѦA@4Ѧ241@4@h4@FU$4@MFzd RTx&F49.U?иE9\_G૛HU9$σeKi%Е.NN!D98W@⎭K #īU (W[#Wt]:Ge"A]_DBcg%!D2Ӓ5T*p&l⚸IA4T4Sg64eJN"Dk`JkE6(-8S,]h.}nvح"VM<(_(%8X';(l"b*6-ڊm![!FJ#hlT6RIălQJ &F6#bJDjB }}߽;s@x.n.J$UWN5*6Gu$* I'tn ު(s(S9Chs'҄tO-D}eIROq;G"xBM(G=T\)M}1)DR!ʪ'Lu '?RG$RեQ;)Iڊ\DC;&Q7S%NDS 9QMJmJ'xSA:'bڔnDR$c r0d*Z@i EuJKv0Rxv^P E9 )l޴N>= FK|_ٲ!Y V3D[#"% Х`]% 9BB./ -b)Lc4  5!*3R(ު¤qEQQK/6)Hf R 'pTD*Q,bH .JZ,FBlʩ2ZH֢%#duTԉqI Tg(*K /+bG*Q pH fIECphG`b1puA5{IOnJFˉ}:WNz=N/0,Eٱڡ $$PQX Lh۪"k*DZ2M+WdK 3J+k+z\j/X{Ƹ;j̢yvımwZ:4S b8털 Vbn˱+JzղZp`H(nbM'S!Mj[* <6G9Nld^+$jFc`1cT\WΣݭZŠu}wei9d0R8ZrQ.l(Tlmtafj f{QG϶\۲jҧI##Nz 6w!*IbLU4LTQr EV{OSSΕD2aY&&pC1ȄG>MַwQE-|umSުkEuݻ:"9=u#Z4q|,[pp%$5tJw׷5{ߓf}(W8vƗn͋t4 1QBTRp4ozz=ܹO:USXs5#r/vauܖx6#:/M9H".CMGNTlK-V.$2Jhzwv!m5u5BlARXDwd)x۬R#ifoqq]KGHkxzZJsMߛp|qO&GљCuL|3:![ŕ43-mc3%asnA{a"d++罦Z&d#D(Gj ".Yː xT 6<;:rL*'h#PٳSvtmդ'Uy5*[c3 5[PLk+bcm%A̍JkrĦI`(ISuχۮDnB),P1Q,Mɂ«RAϷéIWh;;=HD wo8^OqZR:Ք'{Mƣj/zd.CGG2Oyt95N'![5EI7XRF&42[;Dyyk\.( H%X7WkYh_yKyej3Ɵnh(goS2b륂|X#wQwѻH9:&+;2vBsڈm'wy/Gm}F5CeJr{TN.Eۨ=S ̊oRjLJchk9jAc#%0$md8!H I"3"m,pYwGk9>%<뛘ݻĝ;0ξ=ӓ[uzHhr8ltilIXsOfHGR>wGi c !V ڈy,̰1|+lvB${ᵪ&;nǷOF{Gֺ<؂2n;1.K9ƵXumc}{Eۚ'ivmLx0B(K9,SUA}egH׷\{vz}nqSnI$VDOFtU*u>F,W6O3tH(W&vlT;6 ̷  .I"cYZ)2 *A9#>(zw[ǒ6e7HQ{c;$8 9FH¦]wdirF-Y,qC]6y:DgՂ>I]7C/qeOSZemwgC^DۍCH>LEI8c@"t-c}vb8ri{vU*a.l6r2X[Q;m}CדSM\}vOY+/VI4m{wn[^YQ*n1@5HAXR]}<vZlNǶOq)ѻ.+Urrm;sv pA0q22Yo2mpȰO,XK] ABs%1cNL.YEkƭuHYS #b(1a ̱b+2m8r9/*B 8(I1L#s#u/Q;]SQo/8!k+D̛z zX]y}ϓr :KI8#HZ!XTf5[vMilȸЛnHSMy!7V9y˜mr;t[teW]Za`$&|r4r,BqZmn7lGRf>[UqB&{ۚt]rj$'7 Մ 44mݢD-Ջ6CRvj+G fB,x#Q%aZalZt ^H#EbˍA)4 έF B0dQ7!^xntf@tW`L(T'py8zk&WG2(BB4ںٗ r:չ[XqoƊ7X֊Ʃt-W[WUw^L*wd]v*Yg9#|JhL}v}DD^o\B+Y<*nI[ݲfȔ0Rۼx3-p;׸WKI (²={?6 :߲[*[Aŵ*sUScZCk."Raں3,*"1a<ŏ Eh{֡srs59$_>N֙}Ayîcظ 6(+s=0=٢uBҚ"{'y C̲v1o/E > ,vUQS* [F\>{ŸΥ (u4+V}hodKHwV!(ȣolK)a+Yc|z 8ct::V|<\nX\-֕lNOs/_ i Z^'sR8֚A{wNuVxc^Q Vmٱ*Jq@N-kKGeuoޅU;D]C^^*wLk2BYm٣\ۣ띤A"=˭G5(Y(HN轥JZ> a㸼 EmuU+ߑD)r3%qG]EE|/2aͲ9iZuWsoK0v\Ȯ]]z{_B [K{~|2IqJʤeK/@6PqmUUdZƹ !П^XƟ$7 ,ٷLT+CH!U6 4=d4d"ϡ:^ zKփ39Y$Q͍:lnSb(vmdï^NU!u0{zp=vS(OC'+ݰu"1. >=$ , )0`CQ2xYXZa fI;(j^!77΋o"w%T]ݗ:{;c0ȶ?#w2.ZuV NR7kpuOilJ+,[SЋ>.7.X^TN6UtB <}vtJ]Ș;>D#` .Јhj'W<)T oD㶅>.9Laf^z5x]r.4mNz`#pD`\Cfuh;9ÇKAQ3YD5?sܧw׹h>!%%>Zf7lP7Gxn p["ZtȺεTj.{iLW[9t~{=&W6ID k8E8ѩ}tS×$gr m[8}Q7f<5"e!{3uN9{ ?4Ba-^wl{}B30>:8mb V:P:Я #ǥR\׵gD>(m3fqlzUEQ{RTM ۆaTBv٢\{Ͳ^B@,:e{H3X|, y%ԑ' ݽw]+*Nj!;2dzxԾ03)+<0|ڻCXgV{"^q"꒖`qUu3%aߺSm1ҷ$cx >(,8΅VP昃퇷z.4S>2҃c@x2^7ڪd~7N}sF}ze9AYmbg7!^o%,J.9u(sTw2(*au>KEΜ"?fe ؉fuʱ 4}8uq˳V0rbD>ד$=1x\TR}=V 8@[ғ?agdxRiq # 81b]rW4X_p]m9 8"Fv*ħ"0(>T떶>6sdlˡuuM MOP|1e-><Ѕpr,,'ٝ5\B yuf!ȕ n/|1 sA$9սuP̫(]2q{d2ۣjSw2F$kmG,3tnqse{92v!V-8b`>[ BnӢ6YWo(2rxJ9-k)I4>Zw@Ԧ'MsʦnUU:o0tg:/@W' Cͨ8S~-֐4AO/h4Uyq9ҟ5փs?%K}Z.O]XnO6|~gû+XwyG)t#F ɽLְn}-9d4n,<e!ۋWh[gŽ BT~IKr C>Mژu)S'P0!?uu%ZVevGC$Sn fT`/hΦyבyr n_Du}[gC2⩡f=r뉣BX:!˰e*$wGއJ8}5ӹA^Ǿ8!vZAb1 )tڡ\iU~&őݨԥؙ]{Zm/||X! 6!N]Մ>n]g._ܫVG*__wj̭Cۙ[׳Ư0Rqڕ,/?e]P`CjKh0>=:D'd2:rzt>U[D%Ғ:q~÷;uDʰy)$;`RP;B;*4n,2ZmLUr|$1/T 9nd{dC !3 h zggr6;W K}n]diNڈ%ouVfai* H^SַW"\&ujqJ:V+vN&.QUeWQeš @ic3YwÊ O|>46t׮g"9D+Uc z㜢T[ymk2B>Ng1[WjXU}CNG@- Bϝ֯"^Մ>g[Z8Kv#8l( >G55eӡn^WlGHDt9Biܱ4ҋ;̯yO/xrŴ4cNy'Yyx3nz4 *[TthY,t96XdiQx4G,U^N\<4ђZgN5oyn\8d}/ <@z=(H,{K6k=DV/eKLX0ZEzM9FM6`!'v8 s<4@vY0N:'FSvk6ƚ Mߢ͚SAJ!Y)sǖ7`ޱF3.sֲQ9KbtY2-zPʪ7xPgai(lֆumZV\<7J0Ǵ9-YAuxZڡ fĹn[TV%0XIP^UZ.<lJ޻Ă>YH=DUfQdX(;fxrMxe.K铃Ʒn髳l/i #=ٚ|GuU;_Wfdᤝ扣gswrzv4)wۃlw~(98þ牛.|mR$hi=sm"p@\yTzRT>KfTj|>z|!Fk 6p֍l!T +ql#뾿PLu"襹w׬,Mf=Eb;U`41c+ǖ<BُHq[eH轔ϙFLs8L's%uEqݐiR _ucb2/]3{xvZ4Uu=5rӾz=oVD<|ffEw$^@ZU0WVOJ>0EV&bvO,9hmfӐNg4Pvc 뱆F>EVk7-FVR^JNx% %Q2`OX^1 82|(ْ`!hz4 ‰Ool! }ZGJ{9B-bӟcz;sڐ,;)se" :..,4!`?aDaTfL˲HT®NSۈrQ ύr)9,#sRrpeX! 4@auMFj `!ıZ7.HN)m6l/=wM5{:dlD/($fckcueWM.5B1@Ă^1 7bk0n708(6PQ[#Sm\pXF ZTfסF@ h6J-9`B:TDKX`b,3JiMއ9zv@i0Gגf*,>8֓w ]TO<&nU8>8X8I&an2Dp$ùTqDiy=ڼ4^ӽ}iohʼcF1[δ:Y=G[,jE27ow;h$*u=VCq<,Ǒ2tLy@TfwhY"f[`mU|sL!A *VW:qw:ΦLH] xa,`]K#Cax};y+8w8O%ل\W ; Zua z>$w0쫺h &AqwW9ˬ݂>[q ->*4{V8kX kVDCtqY\*K[I~꒲F RڤegBjG"[zL6{يL]VT\t"4R~2YT vDvޝSwc W3ت]pNlbw|aM8W,]r3$;Vm?OC< q>KwT#r+{/4X$3[}{<}&±ݩ|qAx0$8P0bgZvǢoW6;^;C%#w5@Q@xeKFÓ*3Ƃb@sS>géӡ禊~ 4P>SZjFXdY@i&Rj1 ;bS2 kE$x,[!9bMH) gy7eqƸsa#8}`|rVA84Q}XM^j:Pf-]}GNu&XpXnXJk=* C4HKAF]Cj5&cMi 0/#@)¸.$t.G].9 OMUY%Աui֯nj!ů58/TjIiv(D:UoUL ŝ],4hP5b3ϲv͸!!%E8S^/+bէݞ'lo+]5'Rj!nmԑ#oEB5t.WLrO%WgHVLR[i\ >Ш9a;wM$,r˗NI& C׮q=§:Mfə*Δ>`Y<{Xx0 nGQU`tƪXBAյ#n-Z{&]1;Ui,Lv38|'Mf]鰃CÐՐ-yh.ITe$ޔ PdKWsYG *5ĈejATq` A P)a o.@e!ֵǴE5Dl2U$'Zj2SV\*[֙TS^mޕ6DGsI7,Lw8 iLiJኃ&]zK*|h&k3]eov AР\F^Ö4;tqݼ:/C |YOHFZVZ^~&^;VYv{~@[l" ҭv*Jed{^ZjrdhCE1ŕ;!0'cg51, Gu?c6Tk,wצGA9cs}wADPlg!tB.D=Wbs d VD(>,(O]4oӭ<"? ќZdV&=KVZtL>OݬS[:Y sLmFD3+v,Rj]!bKn!P9|.fMjx>\=J$UK2G*EjmKܫB,W9mP9G.eYýwIGb*Xru,mfD7|;Fl~D+]q!jAi[یB#)kLCPKI>M 5V.Vb̗03uAb j FβE6uwF#H Yr盰ftbҒ[ CF`A{]J>>ۣꀞOgwXMW=0TN-ՔjIMlD8}*k[z%[t$X Ex&vz!2DuQҽ@y5 (g!i]h2Vws>yϰOETd38"ҷ>$$+XxF޻]1{g$s{s:+M3F:M`h7y'6:s W v*3@ؙutd~7(]qA0Z[,~즣&n})=Iy2w-}^.Ӿ\hKQiYڢvrlu(5u.lEokIx\ջe#P[ӳYD"*FĖygW!PդiT'fuo}4M筢eʉb8AD#Cs$vԭJc -ϻX yܵsܟڣH5uQ ei.XuJ`dkY4qMgP\:Cer #wu9~gFUz܃#OլJP⦼V^ъ:Y|ZEMтȽ(eRI`۰hH/Pl@RN굞r9s濲)G~|.9e!}ڄ<_-巇d0Cdh$8*֛+vw n mB:Z{/lrtg=K7[I>FYGx9:7r䎅u m[..It׻rT8ܳC!ʬB^L~KĆ|zS¬=WGgmky.+4.BP@HBo%SBzRдHfء0AW jܦ=hR=H[=w0ؚugPӴF9.Jj[oYzZdj'Ջڹ}Uaұ}!w,rb #wq{{l'/xիU"؃˦\h3~/T/ |6;~;/DJ?uL˶R%LN&Z" WŰuٽIXP_ ]Lo335(WoH]ǫ\~ƵLG!" 1DV`t蘟Uh) ,u {HB (Y x7Tj1nF.':|RO^g VfƐ=`iC) 롙S8XDmyY 4aư^=}M +Ob/y/8$FE(Ǥ4\]ݪ.;ۜF8.`= g:S| {cuerJ^+߉^pztL;x]䏤\r20ZգݽTB ŏoF2˳{oIh=MӫYLxiVOl (j\f,vRqJB(>5l]2 GU[.d[ݢo2NЭĮG).`S{ݛ;no.,ѝ8Y憧/BZqB / K3jYmTpw^Zs Y7*Tu9Dan˧O2v򽵭KrofDImAsԹQ4im]AYiʎ HC 7V7$)L  JvAUadD#5.seV>e0l쩇Ӛ8 KjʥX3 YUzy٣Ϛ7BxHq5 bW#D.v~\'^[[g̔%qkPFcR1kf woHW>װk۷czn5!%D/jTd;nӪdF Pt`t{kktf*ʈ$1k,X*r2ͱ,e*A6hQC/lXP|HX)`9C@EP2=|dlOe-6Qd{Tlq|;꠫滻;vu$Q+;>1<>r {Ƀ:;8J]YwWYYEqqWwn:κQ\QqTwTuQM-쇵Ofd ,i6bڻ8?w:t]gݝQ֕k^ڶ^|j5lil:*;λ*";;Y򲻢+*./iOjlϯQ+b|,tݕguٕG]6VmSjjjguV]GtWwDWEmn벻*"ҳʪ :(˷;.#.K2}*)9\7޼Z! 3%.Hnn@/>K<Zco4`GEٙ`ĥ̈UP dG r'0Y1lFDPpCc^ m9Z;H5bltDL UXFd{mݶηPݺ/>\`XPՉ؈JqQ]-|*Sysju|cQ6-fqkiyݎʰ|1ō#[T[ڦ K۳ns vP glvZ$o⾰稕}> :>u\DwqՖ.`. b]X&,tK!/m9e.Y\3ۂvEGeZD뼺}& m:sc+nR|:;:ݕH&P 'Zwn/l];yŒNuZCA$ՄDy q-u<7N:˃ok\(^qwkpvrzfYv排vwҷ$,άG[n.*!gZ;p:88닊bNkGq6ht#nVWaYI]n4j{hm]2;նɵVtpwZwF$Ws vl܏3쳨ZDYؤ;paV"+aq(%s* ymΝ֋ִ:K՜e["{[۫mvSyI*)FE-J.TEխJ8#[nub3 jw7(W^]m]tQ fՈ^]CٗAGVu/KYnNnwۮbun.ҭyvtqŝsz6讕w9wzGgv[H뢻i9J,Ygt]-y-m;K Wv]gERKڷ%I]772̛qeݰe[H涷uDdk)"fJfbqyՙt8y{".(+9WYntGaV9mYZMmn;v[n^F۳Su,eJݵ8nwdwv)lw]m8ڷ.˶PQ˧]$qvB<QEOl:g =:vav;9{IHqq\wSeu\$:jD=v-j H*xZhP IFܨR8;[t+ ,.{i {5kHj2ݜcj'HEwۻzcX+:dReZ{Mae;LEDT8!z3*̇=;1F+J6BHNйuff[I]Lk;gE%9g.. 'Uwunݔ{wtruëyeYtZnuhwӹjD|֒<˸g8ݝSig3Uۯ:J7KMӅJ;[d]E,Nn̬f{v屝M79lg#Եtr!f]elryٌNyrmչ[Vne$=k[1qtwLN]j;iͼ[WIYGGm m: M5:8b3*Λk9֦kۅ='Emʶ΄ K{sۉۺdpNY۱Dr;ˋa 63;:[볮˖"sVL=5mu/7wYW7Ieg[pO2G0[lqܶf"wGt',,vH{n` .{bʴ;$JHtEu4{v'uqIcq ӶPEBwGsw۔\Wnԝ펎n=#ܭtr"7m]I׶ivς:$Q[ uYmZkF[dQg]m)H;'Jq<-] PI>K$&(-)V0DuYͻv'ID]H:gQwQGV HNI&B$:g${`2:/LO5Evu8n֝'QݸCd'(Hs{[kQwVnekVۤ.|ݶΣVRO0qSYVYrUm!ul 8G(+˺ؼ%mi(;輬N2XUTfP"qp3ruw.w :ddd#I)0M/'iw՝lYgeeC;'$Q%ܯH/c)Q"эRILZ ær-.2r/mͻ(Z!9N)8''m:GzaQuC7:rsBx:/nmYS')㣹urOmvY$ ZK۲۴r^V9Yt]yۜkw2! ׶fqMˎ;Ei_24@db}Tp7fͳT9rpI'\WI!Qu9\%@W]vԭ)jMCReU-J%ZSJd'H]%p0VҚ!iVJV]QrM*&°X0YKQp:Uʫ hXLRb\C :NC$M(\St.I\B'Jd dȰSrp%:GTtWHe,(Ȳj )p\SU4*YJZGBB.%90Kp:)кDžz'*p1\ʜr.5K.NN)tI.ҬRj- Td(8TtDI8`rHꖒҘȲZM *`N8- 5SEt.RLD1-Ru, ]C8%M Ee.F0Z%hhZS"Eu+qNRuVpZFX,*W\\K)hZb 䜓]Ժ AX- YUY&rKS j-E2.\#89GTbZtMC"ıK,UVQS*Sb.r,UhY0FrIԬUVTb Wj&#Qdp]Ci- tURj5\'Ҝ1,*r%iM)8(NCĺ5FJԚȺUX.T%Ȱ5GJ+*CJU5+TеF8G(✓jL'qEt$\uG 2)i, Z*UIJEȵhXV%t%`j-QYFE')\&ZS$ҚԙN VİZuGGSu]R:KZSD-*ʫTu Q-IԮQҎ]TN:'! ҖTY I8N)ԝi u'$4Ed Ԛ#U4+Z%h1MJ1MR\'TtIt.ȵ&ȷX2L J0Z*QXBԙS ^K֪BEQH~?qJbW)W/$W(D#O檓ڭEqqtQQuwEwqT\wĐDu'wGRfk -mdȢ..;*GUTDBy螁΢'*yDU+QDODO#CDJ̈G'S.N16`6[U)M Ul0f[Q[mIڛB&6U[-m6&Fچհm-m `mFҶ! iKh[Q6+b h6͈l%Mh؍l[*6VʶmEl[FmFPlmU6j:8l6&Л b-lE[[+b6mU!m#h6mla6mFɱM%P~)JuU)ILG&J jP PVIc؁]B _ =7 @{Q@ "PHUR$ JUPpR  :@  Q@$R6Y)JٌY`#U(RLf  P'SUWYmGm}:)mOzi{:x9vbӬu cYNH@:qť{Фsbn@nXR\RE*G{ "c7v}^r3/HjB"JP h4Q"H?JjHJJRF"h4@zJoT4=F@M4 "dLH?DOSOCM4=MD ѓMS5ОCA 4ސSJ*Wl R??-F)VԾP}dƥSto!!V&"OnL(!l!x-.Y/[SL Z!f.~~qz-A^۽$͐{^,CN)W{/~{ddvTpLj/ O& *؝М%$]D5`Rݱ%n> զ82) !#2'J; 3P&IK?]WͲ"šzYϧ'i4\oUhm{l\h<}jtҍ1х1]e,'!6'RnFXyh`]+! \Q']Hٳg#֗~%݇1 LA=BMз̤R VRz4iw#VS5L+s2â4vGQ52ˣؖ춥/'YCoeեD#N7ɥh=;&[¢E<n2lD_Nj`G,/'@|n߫]xX#ɛfbqC`~z0DWGޣ+x,)zDd xۧad)Of.Z{.nX?/3{Ea(O]W I~pE1obCb%{jZf$B%"Fܸi 2*ѭWd1FHv4f#,$(3"h"fA'5 X0e2qX31RKDHbodiJ4Y#Q)HS$ iH3M`"ر32I4b, b*4ƌA$&l/2 Y d$D$XE2&FJD ,IH`"[sm#LK`ȊAGݣQ@!#|}yt9DTQ(]Ʉd tR7*bM!`LB$"ʁ'_Nf( 4DfI{D͌P$ˆB *IS"/a"i%U43%\f}K J 6 e}0F*7ޖD _dOoMkss}Hw_~fk`4EN+bP t<*C@zDO5;P +XODWC_,5ľkAbI ~:EEu/4c!{Z +Ȓ( 5|@6C%}~|D~q 0CRk&Di0YYHT&|$h}릌B,O.ɉ_rb0 zA {zV3hI"LLDBZi _!@baddId(aEI?HƈbfY4 E,"F#%3|B^pdu/3 RDa6̖)*@ M 1"F/r!H%0e$L֪ɠ2(bɀ&j(ąAdJIR\wr @D ƊB &wRS 4 F1 0\)p(]XBD"QJKO/_kʖn=0Q;2u|l%F0#:31h $Rͷ6DFbōb4U1L #6` I#dL 5$#I!AMF(أh!1$h$2 @Iy&! "6acAI2`3H@LdWwfc1$@` f# TIhDE֐121|&$Ph&Q ~ȣQ0h4 I3=]J#(E邊#Ao#F(S%1$T(S4 d#H2cD420$)AAE ,dJLQ4 (Q fC|i"6!!)JD 2@QHĉchN W٤F(""3HCL Bf2AHiHl2F I"aBhBFDFBdDJHQ& JWH`٨0%`#"H&S ɎvȊ('w@b)̠C_tM d̄l `I۲yE@$jR[TE܀L9Hħ6igzبGT-TX66 ޒ =kbV$ 7V$6cmVe&d _A_K{UPZ盵 + Mlîҗo>64K۟H<$M{xnȎwuMja fn4aM>y@'?2^>q $αAW<ާk&T'S.9b] mhxuC#V"D{"c=C3H=$(\(S`,92r<:~_D7e4\$ʣϒ;;[ײrÓW'۾1iI݊쐃4VKE=p% {~=*MTλW;GJGӈh;B4ؐ #G Eܨ@C //sHȊ=J<*W[x$𧫙SW ˢv}}^-^1aAQ02jO#>YhqDEcV+#IѨ[h#OTs$ccwRE"tUI;ߟxWM B#Έ8T#Z8#Kda4EZsH6k+B^"DkR&ե+l 8-F4…[6'9r7-oo}o}M^y6is(g'yoB-C}.}c I,`}ɋؾ"*;"dNSeZA+jrڸ![@ES$&FL1h@湥@OD*nhʞ}6cԏژ(cAdQGCzXLm{蒣Q<̷W}*"X#cY'=%qP}n5L:{Gl>v&8O6Bd +M-gzl&S-l Wnu@-(Xy g,FDST TkaᨲmdnfiFA6ҚN,g8Ѝ^zVEQ{wd5?Vwz'ukh@s1VQ-Ie 1ު 24ΌA0z_vSE[k|EU]FO8=56L4 &ՠ.ٲ@q*W>>,D0BM.;hV^,;}FLz-ce벘 yU>BETC%lM{KW[l =jBz:Ejѱ(D廹C]I6E^xX,H궥ZƓc{ϼ)=$Dry/QG{{£!Vƕs9޷]4(zގrZ9HxٳJSUpv.n-v026-6'ER9Qn L҈LTM][OZ\4̛^@ve_E/&$R#Acq]E$M&Gޕuت=_FvnG3Rf*睊'@fDWyN\<@zHEK䟐V˜&1#e ki }wy%_i"hHM&24"5hU.pGmJV֡6tB$`FtN7^3MrX.H>e4}}DB&k%^}q\mQ@56Z68 }RZ3mbYci0M\ hbeA F*=6nbTѭT+vK^]pJ8n옱 D'Ek6I1R`US~W;ݼ=WwĤvw1װg{*Y] WϷHkM~I'LCHnmBw | N9niD@% Eδ]ӝtX1H= OETIrkM&c>A\v.7(ߵ+ +L^u6ͭ( SMDIaFx~Y~i ?&_ũ-E#;ٿ^nTݸp <*{b=͗~mv67_KFGva_'sYOý&FA< i0гJG}I{;vC崢%&$| (K.>x`qA}Oy+C.Q=j.'ZڕG*58-yRMx ԆVk}hmEېYw]ZFe#D1\7\vcV7;@=VQ$X~4a![infy5g򏚨{}Is@KVr5\~V!@_Ƀv?jgO֊Gie,ЎC%?Q`м}^t/JGe,2-qurIݟ4'/ce}õ۴RKh,1hF/D?sb2=$ү؄H;K&םK~[Gzr;.mͰŬŽ5sOɾ>-=]6.tL*%٨dU>  t 5TGx5i3gNGF^tY5lM (٦֣}[it)Zpi ikMOD􅦙4~|Zb,=ELQ/Ef*"yyP8a ctwnRFQX^" :qʪVýhEL*U6^^Rg#Xt:k$mԪV!䗗'9^{[c.O{sWMur:j$0j%y66y =7Y!EyZۮ(AF{m7]#`x;O tG,e쨛[M-IEI#s1Jc%g ] V3cNRwѨFk{&@9/ ;(d'7+.XfuI/ 7X!I3uqsQڐ14/U_L"g db *30S8uޔi3l͐$8(kk٬=T9/-J!xKV  zզʦWc3u& àOD ^$2sEmDZp ꥩ)lܲB<L <ۣ- | j}$wj"CдB"kLDfIjqDش4kv{lg8_Dh9 AD1ź%Y*&zdRbA4S4fѩkC;ݖVxTmljA ZL FgȆ30={*uvs"5֫:g$'SglhRm>Cc;}KE,)6T2w_]`&{鮢3O"E<Ꜳo_֟#~6OJPd#M;=kIi7;s_ QNJ%xl.}89zeHbM:$A;8~!*!u[ ݻms:H`Cūw-zޟWMa HvfڇNPg/bRDAdLatMQ*zw4l{gaZe(,B2U9gBPcވ DND1s\ͻ4QOU#OK]r5OYaIgx`U3zof<4Q c3~av6tWv ?Fi~C5!ӂS1 1tTO 6 qrX8%K3[L0,ζW"n;;SUr$aMx@V(aܮԉ錽C)gt40HqCzyڣ.ɊEѯ0'8 X: {_w47ZL5Ծ͢[b(9i~߶,:k\ e$瓧Թ0DiiJHbAmDcD<I$ |wq9 {n;n;x["1+,vu_G7dJjt|Y#ŠN`_KOYVV5Oz21!Kf .!/%eͽLeϚ&g{y.rOn %]ׯxe#9LdAu_DVsϗ7@I`f ozz/+حJN3ЁƆ(C[=, bEޡ=1~_?!".DgMDD1aj,RgII{ɢ:ߒҁ?=_V7rgڍiĜb;y[_sHzݎ%2JkpQ3i.^ѢYlUur(Lzv;d"M8ws7ϛYIkJBi%yMǞ-/ÀF iIR+ D/3ryj`oikETǪf#w}QXFSi?|R4~uFp*#o`ۢH+?,I%ޡ E?ط;ݍ?R< ,=|ŵfY2J&_\o&D<=wOoa&1bW֡PѶƾicm+O &'/f)gOڇ&tҶ`4:<0J>KIfIr=Y:,&??<'u =An6qE5wq ~rPq؉1߹SKLfH)5]38×, 242 :dD}Jo 3ckz|Z곤nFȘ.`fM_1tԹ&H LqQ/Ou]Z0WS/q#Le90bK@ -/3=F.K'kGU] l]O;󲯿3LMSOאNczdemlUHabnwC~~.g}o ~$(cg';4cqT'|m3D"D"ɏ2 z_j(M}U1 8T NH&!cKzf2$[C~0*.*zyNWU.!DKet]ԱYsPJZvDQCS3M"EA@rSb EɏVE5z*Eʰz(U:ь9y!1 jh}oM؇btNF%&.mN)!LGVn^"0yђze F䰄QP;0d Mw7k 79 Q2VS2F)lYٜjLjG1u5ܻmEh0zZ c>mӝڱ0^4W]ø/14{4EB W Cg}F>_^{<"0 f-SrC7_ϓ-|f=5[=4;$ʈA.xdmRbs=eKƒ%̰ xEPb(v1,  Sjtf>UQ'MO π"gYAygXdCAfi!c Sį)vCn5:p쾡CW[YK_J;\$(^F&'TדN,;""1▾qT-**yA'N4/ v{.f})hȝ(F5܏_nuɏk?q:3j ?e,Vl2R)?޴;'@l̕ g@zwU'`:]DVLQeqq,n˖yĉyRR* k&04LgL't;UCIbJe[SO6'C4-~z3-KB4VZRw!>ٜطu maZh5E(*OR@\cG4}K S*/w7->[M4K \ZvLK8G[ =fE}ГF I!zr#W3ƷX>;G/,^Q6ڗ-ӿdekq\~?-Cx<&y.?xs;w!rz˚ռ޾Y|WȳUTx}ﶻ疙H_7@?mL2Y&aIHT3` 0MD$$Re`d"L4"01Q$J@ &4S hBECfA!#32R)A2C"4 HIa2Ȑ2" $F11aDMa)F4I$` HeQY,MJVad$Y4j4DDHh2L HQ$df1 2M%YD`II$bY 1Q"S,"eB2 b !EE )Z,a)2f$L`F3E؄#F(3AJeE HYK ,!Jj434D&B6f6#RhD"a4("I4iI$lF"(2)X,X" T `!" A$2AmŠք%jƵAElTlTTʹh"66+Rhձk*V6ŋ*$Mb؊,XmEFh֊b1E%Y65ō6Ml1IF4F6-lLh6ŨhX QcXmɶ[VdT(6),XhmFjcAhѢbDʈZQ@QiAUEcbẌXɵV-Fj""$Q%AcAVmQ%Qi1QhM V4QARZdTZ4cQ@[E`-EccbVQhѣ[4Z6,h+Aj* bѱF[m+b-F+ "Q6b0j,[Ab1Q (--mcF`*5I4[$QhmTkQEY6j hڋFDIɒU%FckFJ0Z#$Qj cɵQX؈B#I`T#j *KFhƱ*4hc$ѢQѨEF(Zb cbQ6f0T &DY1lPFlh5c0-5(؋RE-ѪJ؋j-cUEl&Z-5KQmE V#EX"-TThQkTmEblVVPh4ZmETF6+IhVhX61FZ1EDll[I`Fmd5Th5IQM!j4bj̶-4hLDUX5!EFcVڊRj6Ѵj4V-EVƍڣj֊Eɶ+`hQ6Eņk66MX QQl4jlQm(6i5XXU[%F6EhZ*h1QhXXѨƍhEb ԕ&-ZKъ**Qj5MEѨkQV*4[ZتcbjMf-F6EQQE&ňc%Ij Vhbj6FlcIQF65[%TIcXڍlj*6 JVm2ѐƃmFŢ+Eb b(mhAh*-F2QY(chc`hb4Z"EDXQPZFVPX,Pm-6Eb66Q`2$5FF-cF0XE20m&ڍmPj0QmEjRQXbD[bB5#`ZbƲh֠ōX"Th-664m%ATj- Ic-E6 h#i*-Ej( ̶Lb[j Fŀj XcTlhb6h[F(6بTh4hTTQkbEcR5-Fز`-bEƣbŋQQi5I" ZhV(ƱՍQEbi*ƥu|_Uo]m ͙6lI>u#qWСz%^I̞QV T'Bike/ėIvMNl6*V3P` j3B:jk_meײpK1bxУiC8aXغȘVtp*-i.ؖ:jZ):ăֿTU?RC 4̶گ[нG:ǨUI멊4DTJVeEi.)djDrަ$дU.ySCuWJHdt)UEKJWl)vKZ<0#=TG xS2`k&dK%kW{1)?쨺hΤ_!$IdTyeRI02FBjURR;)kUwGߦ23edZ A(/%+Cqum;jmls6\tva7ZκӶcjmKnIf[Z4?3_IM0g{LiCU_?;:?2u"_SoU6I]M) 7*/WȚ8;Qq'zYp Q~m6c7 zu/xw˝QDwظ.8yGzR!KG# ~)qdUWW@rFmT1AO]G؇¢^أ'N%D}2ܧJsrQYݓ)+I'tTw/d[6mTN>"=ͶMe[lkޯ|%OŚ_R.tTk_S2($,1&-L)|*$EƹCZYjX3~[nowc;:M\sRuݢeӛnxJz^ ձI5R,VllMI8/e[=ز1Ə\mWtKUTyY vx[/ރ503Guzw<mqb566G\7 t:mzzްAO@`7EC a4@Fh썱7ӣLiţMe퓨P9 uP_;){%)ΖqVĭ 6ZfW%ڇhzm((WrJg`*WBy`mNȳB_zs9{Կ{m6ْKHS) T>@>%vvBT)xI +:K'zchcj[U̗9W՗u޻cczcO=U/aTOi}.++g-"v˺k^Z&=N{Oy؇yuu'N w}hhqKS<(U|{rbWl%S__fiC"93A13VI CG)`bQk HۯD"O9&wS*/EHD'ͽvM7 @!=6 HJ1pH` bƀ״($EcXP" z@\PI>}]|[1 "{N}^0f{xaRȷXtFje$a<J{N;z$ыzORy'FL3ψ`so5|j$ 篼}v4os5m6o׻;Q @ h+^gbxf` 1]B߭]ʵ#Bw*H/7*~*m~ u#3F*-B j$Bʴ^1у(|_]J,)i({{uu ? 5|=*8zQ,Ks#Cœzj>rhVS$ʕEC~k5vLpݭd훆vtwgN!h#f/`#X7_Ï(s5#Zwonji$2k9Čy[FN[gF ڄRCm>ݨe\9\[z82Twժr+[0ȓdĔ̱߮Ӝ}hzJ_}D[Ai4RFm}wG^tJP+XCÄҔRI~nsmsnsb.ܣ{9Ovmr4I'G]zDKu]NӀCU>n$٤wWNt [Y]ݒ_l%YTv03O\P)H*SiUq^|Yaj]ղ⇹e'%ҮrC%p?r"L (5-uBzO{-44v{5^efu]< )UYk"/@Ɲ6me)-_0ZMCZPL:tM)0NqyrUS X'(]$XMNR$̫KSL-*+G\+BSHqsHP\M@K21nVH%OdS_U_)132ӷ3~'7wy;,R Lݙ4J]&ۡ&sD:!U,P)|]Jdq6eɂ(ԍ|_FyۻFLQJ4wŦ4[)̩%#JWf,46FA!F54.l'Ě*GJ|Ol͚fTwW9ld{ⶩiĺ=CU8оMmfmf#زjH9 Լ?d925; I.dsNk9˜=2rvN;*9ܥT,W4\L"Iw8Gڨ̾}uTbF|$֏Tʋ.[vZ[[q}]={73kxZJZIyFHF"nL..\zUTD8b1KO)65ImjQX֨mm[ FIE"6b(=jEG%u+֭wN"s7.ɈVy!!*NHS19[~-z2uC%UvmLXHcK+@ FޮD~tWpjG̸O=Z 2C5U}2OM7},|4扜zrPsWիybbFY1F) X(эRlЪvrIEcTQmԥcsW+owok#^FعW6Z罸R.Iʝ ]ΆJ5y GZm &R,wjFwkum lYs<xS6雦[asV-l/ˊPƆa;*wB(I'.{Mr6$Ƭbzn1${V#Z2JƒH) "5!mȲQ4Id\SMݓ=&{C!И]9KUصSW ٵìʫ .\F˨wuncNurpSRiR/YqAƥjfƇd_=G6IK U^#qPOR$H"KRH‰LW+D/4\r""L 4,].unLG,JVͲ#n{~I|>rni aM]Nr~JKFā%m[W|$w]fMlTm7LZ%666I43hVQiڲb^ZԚT, ҈Ϊs n0 K/d͍ilٵlI~_$E6ɵBUTmJ͓GPR66{/4Kh_HQ<޼<%xDI%ξ{޸{$8Ow9L5|ܮۓ.dHFɩ(F6EFK&wtI9vI];aJ˙ݒ^!th}F*4\$I<Ÿʼn}wWBLB~\CGY%Cc{;bЪhĊ ߂oc,ϯ\Ά&/|y&6aU K⟽yJsEݛ\Zq!+Oq HWwZW FLֹDMls[o*jbѭb 䓺8DiJpΩ¬_R_6fkl33+6ij/Jq_5;rth;P f+ѭ mr#RcֹKo:Wސa@Qm[XִF\Ţ|\Fj '+[(4@W.ZsW0[1h65z"mJ2Y* nQ5km^J96f4Z+U<Պc6|\Y64mnFMKȩRS@Bur/-FjrI&!5cUfܹ%ۻ\tE%E{;B@j2bьFQ\qf4%lT%m)II]:62Sns+nb;Y‹BWTίlIUG uHlA2R,F$/ߵjV/Y8*]6,` \\ĹDC!:yxA~:Ƭ6 |~%tMȶsߡo^*.1^ЃA3~"O_ᔬqh*'CܽA+}n*U[*ٻ^gŴrujWIe\.3<S_Oz  a 4lNa'ȓEI_"GHG:0xԸPlfKGLW& X r1>Q3j>?jCۙ;NDm}&yԉf,k^ī*"hud%V"a]v쓴n6fI 3 Y_U}Um^կq˭;8rᭅLWS$e t)ʒO2|h<>I0fD< y|V< \Zh3m-:=@=ZEYy!oy|D^CQ Z,oxfy^Cj1N]ī"O_wR*gV: ',W9ixw%O9\^{뗑5kΙEjT^]^FJxx*->4k[mMx]s?]R5J'r4%]*j769/>7_by_>-6ﯞ[}TQlj5jFbڱX+[Em֊jZ(TQcEm5FZ5EQ%F5mhciT[U6[JCFZVűF+cXMmlDmZضcZU"6#`6U66I!PVlKHCakc[!X.dF (I^y'Gܝ:x8Vf ѭ+}*d ';d2g vDŽ+;349.WBMYƯZm |jlk_Ncbyk̖jnFG=mq$5'p?4|> Rm34m666S'/RW}1x+CYȭUz_7RT̖ Ο#O NR^J#ʒ"b%B)wQCMZ*j#ή#Ad*RYT"gJVibE~;y2 n /oNPZUBq(|;89-\qUXi4$GGq9Dx'qzcF|;(I+x5k[#Mx"pg!!7O-d-X]QmFȦz+ܰkmLXUpjbop8D"&O>Jd~ <涛35\W*]㢽Tb.I/Du<ؽ*΃[iHLKj7jSJl^}MXUZڶ⾚/ W}:1[l5JT만G;I« 22CFD]DG@ ^$PJ*@>ڡفgH  0N: hPPrDBU"C UR=(=7,,T)(( PP)%-0J(TUDO TP*()DTUDTP*$E*OOv @U JA+͵wDgE A˷! &|0y=Klv^W{+(z;Ć ]˺(˸uQPga.m!ShӗZby*h4I@7RET tx͗tJpl-z*"%$4Di24`C FCFS#&A&RJIM24 =RRD4@ 5Qi=E?SOyShi4RTA4bi6S~L&3Q v(/J$\뙀GwbuZkC'uڂMriQ#ȔH&PIhk$3KHw۳D3*SDa4@"Zr!T4n@Pi.nn't;M˕:0-] BD3I2HU9$HF#"r($Ӫ+d'j!sYV*paBA@"*5IrQh7Z62 W"K]FjL(ET$-J*BIX n۝IfL\d(& T]UX u)]wunE ]ݓhLF8(ҹ$%]Tj3@WNnsh۹7et$+&$VgL"E H6D*ȶK.$q($r*&*#-MR RK+i4.EʜD%E!$a)DdUZpZ!DwW(p8uݎXݚErQҙHDWi̒9r P%au*\G(ܧrA20B(f Z-Ei%+"08)Q!ȊҺh\J!25+* Q& kEZHqM5NaqP3*ʢP+ M P; 8X,UdA9DdtR˖T##*KD#r1B"*#6l갻L2jbsKȪ NaAB  C8PQ'N,E k&Dr$ cF$s9YFavh If"EY]#k ir뢒E:&YEqIT*GRLHZ DS(HaA쉌\ȋTH*#,whn\hۓh $7$2t SN!$1;]\F(Q a$%1Ri,ɉ4,bɲD4I,hcP"(,bJHLIhђ52Liْ`E*( cA h b I MbHYCF1BR2ZHđ%4h&fi(1"I HJBH XL) b20ĈɌEa1bKDI4Zdi&F DR8i01G#QɎ'L3Yp$$H0!D4f#F3 " ʉ#!FH$MDљi%"hD61*HDHhFa&Q$`# X(SXHѢ@ňFdI&$QBL"2Ec$$6Q} 1 C[I09C ݝ{ X#:o?i~#ũL}p3SJtx4`Oާ]ￗ=EQ` (Gr#1=G_ԼȹLoĨL #W~qym!eoeۿcE aǹo4 E5CWhA!-?Ȅt.(HŹ TגQvA"%#wš~6J ;z xbm16+(9rm֊HG4 Vǭ5Vy8j4;4Miᜒ1if #1‡>͉e茜3Na=pƜD (epȄF887aة8ml86H!{I8ytl7HGǨj9Lf:"-t Q wQSJDҖ8g{$11Z0:EBUhMo%Mg@$pH!-b b!A& RZ2k2JHE TlDlc&@4H 0,mcX &J@DIXbDɍ4PC(32(*2$"0!lh"BJdE)"lXc%)#Ȇ0i2DDDhI4QBbhDRi i$h1(!*64)QQȦP2#F,D@) D 0b*"&e4 dd#5$DeHL1&d# Ie$fBL&#"d# (B0R&QdЈeldDDADm$)fIbTEF4TQ,l`͘flI&Q i4$ -bD$h1(XH""mF a!%(feei1(cl2 ֐,J2d(ecM$ &M0Fl!&4E&h"k F1!&4mLF2d@1Lآ1I|pRbe #@dq& H"$D |SC>T)z|ƊcQ5cb6&H@ZQF؄L) T`1lZ(14Ti-AQƈ*1"m0lF* MP@M02M)l ,lF% -#-3I4XMɣRHحALѲi5RQFTb1IFALXM&J$ FD%aVSFɢ*LRmFƣh4cEchFI+"$T1IDP24$FIA1PQ3IIbMƊbX"QF"E4@lU%BbQBV$hPTZ~NQ(E`ѢbJM2A4cF1"4RbĚhX(؊"(ddĖF&FcRRdMMlm%%QDZMcl&Q@'t'XK YJIe; [- ED?_|+zƒz@=6S0IRzݱp 1bq [kL\Rq`FN{s9_xB yM"qRmŠ,Le7^0 eMaDAk`Hӑ u߫f+m$6*Ja~֚Ș 1`"$DΐV1Ωrg>_p<\Gm+ L[bTFMڊQ_M3\ ZZ`|2KKҐY~~ snQ.# r`FK+$n.Hf,p5_qkw 0hQۢ>(?4{@:7bumٝ.qh*#PR m\-HB ~հYVz 3-lno\?k]vf#=_q/rn4aSDj)ޚ6BC][MX$C7]>3Eb=Cnf.k3P8<[KZMieϔ)?#~~4/MuݒEZ^3{ht;^Zg~ w Mpn8 |"; >y*aV `iDEdeRr +óg " !‡ݨLG6-@לKP]tz%v\'%?[LayC #%:pX[`70Nz^tyF9#ZΆ`Zi^huH, BuyDEK$C`>r{߮=]-9$Ïr}xS`=Å s/寓^<ƽpII^yi8_wO'~78xQ+yK pJƔ@i E2 ФR5N,;{rP^~T ]|Ӽ.}ߗ2Q9B=NWzI=ߐO}|8[:dLH 8Heӏ՗;:߯Uwv(QresryПSUR_}>=;zyȗv y=g*9B i  8)$H?GJ{j{BMĹzM+o]\T_wvE:yy/9s$"c -UMGfpŠRrA,1Đ E!{wG>O'?=r)YϽw|C<<=(|kwiy*^|I_"$(9x{F%JD(`"2DEeɔ\̢rHC9Nqy$, $chѱ4EA&-Jdъ#FVfTK6"֍3b"6DJ+2jƶ*"TQcllm53%D(-lFMQY6mJ,i"*K$h c%I`l U[([%߇NP+QH;tE$ Hw{!$>Wӥ|?=裞4_' rzXw<]uGsw?!wz$I2O-()A<C7eAfQWϹyGZJ "AVע<8NhL6bT5%%EEmb@Thъ(JcEF6"6m6QjKZ,Z(ڌ*(bKjHZ5ъlRm %@%j1ETZڍ5FheXF5ZZƭڴdڠ dw֑ԕAE izc53M48dƴ6 N j"G)I!pNZB%q [ E -E4-OX%01l6D)dV*uBV(ْŒp* &Y34*n7Qb`Wh\pݝz Er7AAaPQVQG/~I<};;ER͐y/G}ͯI9yeǐXQuZM}_fst.7{D?}>.\\Ru9yQA}y37ϷyY: | *9-a""ke. l7xJMuhKH\4 ˘XL .C{ 뿼^}"c~;m.^4ܘ0[_xN5qlTZZ6y^}#%Ǖ r1B#RLX:4"Yk[=q+ϥdPE1l8%ԭ*Ywl/oOf&?4ҷMJ knw{z_y}M0+v[tAUڄ t@Qg\u$.E39+%#+,q_51q/QJgt܇T=VN1W{aK!QL2\I,'bۣ-dSyD}FA˻&gpHBA PN!铄=5ڎFݍkMmGg߈Q߰zXٹ!=suuUR┞vk77Li- wv歵tfO|?A%G#"]X]F)u6r f ”4e !Q֐UY0 ;]K $J%`xTJJ*EX|fNo^7M9?lSXew;şu]KDp=GpxgԟQ_=OossxUGq VkN))L{&)Y"L8pxwM(I20ϑ^Ayujr8B!ݡj5QH?c|~)!HaI]VDi.Y:{޼|{Vr"[,}t(FӉ(A :4i=_W !@5խ(.Ӷ(dblt lPY_z>ՓY+? 8Y 5NiѬjd[l0 |oh3ԍKrdb1&Ba]w,> E8i608UJ Q(I!ӏ11P zlii+04S/muqO/2j4+ƗXuwzlG0X!d;?wc"EHi",q}nޮʇft ywLJӇN/ִtŠ~8Fs\o ZcZm2 "aL]yb24c{wȔ^L3 ʺvv:>jvw:?Sܡ+;;n[CIϓUE:~,}ӱ޴ύ_k_P'r9~yKUdk`J?1NJo3D˝:!OQ^Dyw۞])Q2pHes ezI>U!'E.Sm@@@r`AZEAy :LdL:G*HPF=:|Zy FPǍ?d d{㣜}lhW=^%MMkEΏ:+ghzڭL|h|l\N: m r-5DIfIӸFaDZfY  /MSLDQJ*fO[q)+c.%GyRC1_\BV=4,FkYZ.ӭ9fo#6u>F|"7SHD|ej6xo:pOK2 &Q{j&ެJ\8x\A)_.(vQakMT2 5޽-h&tse-ſWN% U0#/u:SycVq1)\7U %+c,@ {UzN(S[6rƛa`(ޅq:merթMY$%8Г,td}Մ`J򂹘 Qx 7珞}oE>LiWaDg"ޱs_na~ 49y"ڜ@}R/eMN].aU(}і8H`\ƢXHR>iM6iLb0Vv njKX~Ķ-)wIz$xTtw_"pChGϞ|.7קTߪHQڄ) @FđcpM69"{,$D>6#eliRC-ȑ\*_8VQe0 #qjg9j(jq**UM0$š2z&{HX46-{jFrԎbuxSu{աíj-6U|kU>]7l]D\5v1"HFEEjz]; ~wbd>GL(p-CKI&SI e4{P?g+m{9dmfDJ3OPZ*}SZ*=45o>]`m1:up3KSߓNWž.}~\PpEVN=v+E$w6;##+| 47t_%,k E؃1#pM-A^U.+9aʭG/R]1X&`W͝rփK4+ro.FPSza?aǧ˨n[d=L;Nx{uE=imfwvDXhT;Gk k, Vq$AWBi'ޖ6 RL1j44ŎA pY}9U vw/TiW >VQ־da=9:b'f]X]XO+=7T08(OR$!ȶA_4ڟ"Ϧ"2d)pӹazD -RZf=DmLqݕ5A0zgSMǰOlwhOi:GwTᵎ=Q8Χ$u ZFNN6+ZaK [R'A=]F8ZG.VzMm؊[M۲צmBQ{uNDeK6) VM??#LCoav| ,]HԢ0ӟGs:[3`n\>Umoa\g}ڋ4k&кZ):ZqBY:'㖚3OkjX_*V~~Us.5tlѦ8L(OЄ.*n1V*桤t42@yZe}lz CbG±27P(Ij $gĹK ^Ci&mpWk|v<~Fr&w4!+Q.o<[Vv 6_1<q"}R$9<'5_\?'ù=sqD*k(7=/݊"0KEmb)D$2H~[5 Q|pTqwWP(X*umS\2&I$+;;?z~f$ao/:#4S pB_6rd_Ib2 hQ S2fE!?&PSճZk(%s Q<)DHX.pA7V2tAAU"gȲ@%MgIe8~̦." ;@8k~/̷ʞLv0"ۢ/^3R8 t^R`VzQkwGsk\- ;!uep~xSɬ\-ձ* Ϸ_nB;?-3Q2A( #.D7&ah! 湏\x_b7j5Zi/n^mΞsDfuMr{>M_z.ى_ !Ij(ImcО $VQ1w2{c]]^|0,UC{j!IkfE(;7\ɉMj aF<-ySLD%UgD*%TM: N.8z:dY=< 6Z!`$N"$") ˧_o2="9zǑeoП:pPpPK̞ԥӮ>EKMl%Pg13`~e2{.&%(Ǐ(,2!4@VOk&%BլPn zqxĀ_!PϕSx[3OsVc ZFH/_cxhښiYyg4hhpVK~HS3n--q*={ڴXInMD ǼMk,֜]W3Goi:IWy-t]\jb4T;O,`a-* uY5kzuK~ iBw#lڠhk-D™)albo +,po 2Vn޴T~1Qo"Ah>4`#J â>@rp?H3W}@ %a\H*-E(^*=Xyŝ1NuOasM1hj%Q5lu0ˊ~Ӈ_58A]NƗw9Q #;!jPb_X@Ji'Zp~Rg2X/[N/-@- JDIsiRO.5FK^@/ Xj:@q31na2eo|յ=;+Sfs_r{LwbA$n{y&=T4rcR/+7.ugD3zcX)q/ diCo"w@I'*YIQ?_,1|׻v׉ '=*~sG x8[Jg5ƟݔzD4!N}ŵ!>U -@Jk}MKiҖ@AٜJrYÑeX<%?ʇAKOD82%/pu"A 6_D NFIdLS) LIJQH84Z"H$p WCZXľe!hyo|ƮWb ; I67(=U:P~DS>%8:sNB 8P$~u}a@# FMaV?fk#ddԝ}7"u;vVQޥKH^ + &܇CV'2HjG;yH8D"?>C3k?^P}0{WL99m‰HIńܮR-"{K* ٠z0lqcHDDlۋyDMVQKbFxh=5*~*DT zK9{诜r\6:[Z>;~:A}5ͱBP5R17.E.!"+9hkyy+w#s7F` 33 >F L ?;ύDIQߖ ozV $@B|>P*0Wג&$  xMddVu^(WԐ}|8MN>N"9m奰Dy.f&P1lցB9vX"L t9w i`<3+$7K'Hj`/ێ~[i0wHB2MDM5rd!y# E B=?x''zX~(~OZX`P\LE;Cd%5G*FJډu÷P{d=8K:te]azFQh!a `qnȣ/>|=fV ɂM/#ew)s\bx0={gJZ,zGCMom#TMh"It-߸?y*V9#B<pmD0G`E6͢-:Su Ef,%{nC4_KNX%^D>$_4@AMy3%umM= 50Gk $ re"޲O1;)'v숁FJNNS.Hoƾ6ԞOH*JӒED0_/ʧ #tx>_E ё,-0mOG-9aWXzud<ɐ.JA0]_ %fл %ˍd5(ڄ[a=_>D,7_sf8Nh{w RzKBKꈁF]`_B> ȑ)D t2fcLOvUɕ{ʄ$?mBʒdv0 D2_ q)Pi/"2o'tZl@_3p|;ykA MQVxv貐Im[bCY =HV'8|`qD }s*a:twmlC kk:2z[3|#"Xs/ݢ>xF!f|G"J;H|p;if0̍ɋ]Tou7m{f˸s';=kyQFxC!vHtѣJdMdҞބELoqu"2@it F0OԢ0y3vz+WjlTh)$h}S ih۲4W%@|6qv DӃtF3-h'1t48K^{Yp#{r2-?R~x@@yoQa1ꎍ-ZD9Z{JG $C8^FwA&)fF A㓅RM6~!M~DLFB&mpH 鈝ތ(b% e; A͖#%AiQa~8$[<-B~b!`pQtB8̜0:x0ety9 cCUзTfː[,l̺l, Dz|w~ &>bHLCbey9ty 3!飥m)t́E.TaAOIRu"PKzXU$":x>GqU)9AK !=pv1kXnȆ2P8q-Ktm:gNrWeA, pg({Ae-&)d|uJ0尲62=]$tvʒȍw+AbqLJcHZPnЊ-CHcTQu*dcCD(`Y ߦaضqOZP)}~}}[j֭0M`ch1`љL d( "`"J,I2 BQB2F%Y,Bc"RQ",D2L` lJ4D BT(D1B,dI&2D&РE)3!"&*I(2 IFI!Hh D&&JL$H!) # Qe4B3Jc IK$! e!,%24`4,#"A2X1 MQF$!Pc&L1)B#&dđD#`bL,BD1L DBF(2(d BQ JCK@@ LL @52M&LK%2Rc& #dQ&X HQB"Fibd(cIbHȁI3K1!a1I)BB%c$Љ(PTK4Dd1 HH@I1C#$)-hFI!LH")$HQ"$ $Q%I (Ha 6R3b"0h1((D̉M`IL$dXB2LXH02#("! dFE1,dIH5a,!"&QlM% `(4"H2E(Fh҉ iLcF0$ȅ2a&E"E! i"LB)bi AAA$B&XȈIL( &JIM &F@$J@0"Ihi(JJ2,IfB(m )4L&Q 2 4e&$d&BS,,B&$"a"1)(TfI`3 %H2"F$ "JD#(l #!&@F A%i$0dLI1c& b((B$D$h2 LH&L0`H(II%@f2HE22 H)1 aPcL)0Ac3$I0$ 3(fDRL0&d *0d0i20B%4( 4Dm&@(" 2 XĉHlD4%(LDDEFSB"ZSXD%%1" EQLHhPa(%#I"#h!$c# "Bɉ D) F)&E$ d &‘(I$؊4& 3i!$2 f!1 `Dd b$!Ję2 &E%)bL1HBm&%2HF@EK&B0LP41bH$4Ji $2 dI3"d!PSJD  1Afe4!! $Hf h$d0P4a2dF%1l!Bd#C LI HME"iFL0 "HE"APdS 2 $D$2P(1 IH`0 ,f`d,LP"d$mI!2&D EBDiL"dRa3$Ll0LC@B$JEDI2fP02&`DiH`Fb"FFH&Jf$4#E!#! Dh 6I@H&L LCQȄ̘(,ALH4  6L0 2aRLH@LM6ibƒE #$%"fID 3(M$A121FcDH"f "3 f FQ0I"l&`(")42BRa4Xi241iHDB I"b2cEMQ%("" "c!3BHҠb FZPF)b"h#0bR hIfF HfHh12I+db5dZ6VCb1m&&"eD34X‰P͊$FHh0ŢF4d D"QE# 0Q 2ɄHbID2E1db!0 $RJ&%H $3`̘))1DQHl 3bƍ5S6l4DQa-1LQR4)QbD6"Q((5@b-A2T &1$" $da,D1(ш @EEJQ QhLI@B)3L4Q2fh4,dBLQT%!b#,HȄdX RXI"FC(#,Ib3EF,& R)B$$1LIRRY4E,P $l IZE"-bbIKiJbF)#QM,4lR%hb( !Jb ĖBFhM&2X1HJ( %! I RRdR,HTL I  LHBPR*0 RCJXJf(`2B3LF3$h,#&R(i LMɒ H#%)# D1idH1f)B1bQ(dh@Q$$BZ%DfcF")bFLB4&C! ) DE &dF("A$0f %#,0@1&LMC)BJ0HH4H!i$L$4`D#L&f&1Ai ` 0(EbLXaR0EL !d2cX1d ( LBm!F"("$21Q"bdD*f#FlX%lFF(c6R,TR&dlƃQM#F&DH$4)HI(X2AcIM ),ch4R0d+3 LД1b BRQ0M53I$12bY40d2lF4QFe X5!`H4HHe4RXD0"dTI1%$ddZb6)E!Xƒ d$ bJbđ%Ж6,ca1(4bB dQDjfhiC)l@&Ph0lA)CBlb 3&4&`d(DͰD Z Y@  (cI0Q% LII!!HQ,`MaCf1"e0iIiEE(0SI1&1FI 2SJS6ňF*# -"QABBAH6BIV*(&d  4A B+)%LB,&dXBE0"I4[i4IE 4Ȑid@HD`DHF-$EBd̠0cR31#!Bbbf!J5 %)1LQcDXҁ 4RJ*4FM m1 jJ $EbA %Lh )0Abd DDF$1(LjJɊQ`1LFA1Lbc41K$(H3HcL1Dh0bA4Tb5%1!E X12kIY2LL&" i(E&؍EEf)0l%d2!J1& 2ѡ,Lh!0AI &$Q5$@`S6*( IHc$)2e6"F LR%&HF!$Y,%"M2# ȠfF*6,`"*AIffJhi1BAوb"(dEQLf̉0c1Dd 3(l 2%221HYBLI4#6ɲ`0bJ-$B c$Ld fMLV)$Qi6K%)$VbRiCQb,a6DƐbEDh C LJ (Kcd2BFhэ D LH4h(Єhьc"&dH1%C0ZS fI2% cPEHJb"6d`&dBHƄ24E @lRi ͊0c #cFBdQ$LHFBR""hȔLa "R#HfI6fdhIP %%`bLlD2ԒlD%)р)ѢBH$R؍͌FLTH d ƍ i"`BI0lfc % "ҖCI%Z E4M6Dԑ&kdQ4d#cHAAd)6(ElXcQHdJFL,hFQC &"B) 5lIElHJh4c(Ѭf&4FRREQ$,Tid Ɓ"L`$Q$EPA&D*(E$R4XR)%SdEbŴIXTj*-ZV-Y1X*1ڋF*ֱb&[j(صljFI6Ql5m6բ-DZŴVQFѫQA*PcdŨ-cEF[FMXAb ccFص+cm5EQF-Z(ڣhj*ƴdQl Z"Z#lc[QTkbFڢ*EFѱbj6VeSj%hlcVQ[bִҍDQPQa!#b"(4ёb4fZf26-cdQ !bRؤ$XĒ`b1I @I6$IcdRbkű Di)*$hآj4Ec0b(M3A!(% $Ŋ*0Ĕ hi 0%HDDjlS4%EґDdJXTQD"d!S,j4Q4` b4I1E) $dh-P4"Rc,I,aKLdъ@I0A`Z#DF2F(M$P2h#dE&RF`)`T)dm`6())!( F46 PiQ(H55)!!" *a`LjdS &Q36i1*,&(! 1h#A2lR ͒6( S dd&bLEId#&4$l `Bh1`S!V$Cd2 KAbD &fQME %4P@a22JRQH Y$lJF,! (6X)12,RBX3̒@,)$mF!I@,`@)c$$b0S$PlQTS"MF!d!F(bI3E" $dh,2lD 4HXԆ40@”!f$RAbfi0ȢIQbTDňTX$1&LdFą)AI&"Hɢ02(6"L1 l›Fh,$&Q @i$,J#bf( 1ْiL# Dd" R4X Bd@Q 1I2(B% У$ T% 3AEH dAKI0(Łc%%I0X#&&X 0j"ɍ1@b") Y1`! "dddj,Y54YHbѣX١XM$Y),l)$fF%رR*C5iJ1%c,؊( #` 1dMI 1Z-A2 `ЈILJ,H%2h$DdD)c21eIMA$`1QFƆfRTђ &,(6"lD"0D$X(,bD1MH!hĆ 4$k0 2P@Z bƢəd" %JB%F2QAѴAh&,dHl4Cdɡ5!h"5`œ$2R (%LfXɲPILe *dIDTC&$%&`)! H@L6(6eIhbB#6K,J))M,&#c)E dYHX4(b"&L( $PjaBb,$"Bb,$D(2 i)eP4!f2i$1`((!dшʒRIDAF$TL& )h)BL $FJd$LiJ4m4Fȟd!@ 0MlM1P" ,A6MFiM Rcd  &`hPD@2fF bfhL@*LH DR@щDc$AA1 %$,͢$ɌHY($%H $,aIH#ʼnJcġIAc&$! !3! 3E%3KIi,h%"(Xb@hF DheIi5"CLQ$lcA+llE4TS"C"4Qb"Z FbآX"Ɛ2lkF TF!1h0F j(XF 4Q`i!0,`4AQ hhF1X!d)E$&!JRHhH$2$P24b%QX%1F e$2%bKbPJb $dRaB!cC3 "ɈHQ%(bDPBl̀&1A4d*c f)I@i$ф LFđI4A$b(JJ( ,I) Z ""d2(YA3RF4Y0RRl 4%)00(L Xԥf3Q)fBF1hd 3LHe(BXQHA%FH%041 ɁJfT#(̳M3 $R4(dD0BHK&d`ĘdI2@IR1,bD!cdI!B E4C !ARR B2!ʂai!(L$DPL)$! 0c 4&R$(̢5)$6- ,ؔ"DD4 F MX(LD1P4A# RIa,4b2`ƌ$L)hCA$D "KbI(B"hŌ&4TL Ƃ-&!DDL (ɈM-FHJ(D3(&(dc2D2Œ2lA3 )4( 2XdhH(1" M$$"bb(R&$ $F AA%BPFD "( 4DS 3iR`hɂiHTYhPHɉ(TP@Y4%&eF (ȤdLLŢi`d& &"HQALh!LCǏ B bQ2#I3H I"H DHj03 L*Jaa) ( !LK&4JB" h CI!@JFKI‘b)* %DbHL"I$͑ID3FJ$P)&3*0TF4d(Ѣ*4BdQF3c0Y2hfJ"fm42BL&ȔF PbC!0Q#`$ !T234(K ,Y!d(fbd Qd$ST&$Lђjl4 $,CeLL a36K&QHSƣ"5TXH$ɤ 1HaPi#2D&Id4 4Fƨ-ECJ6 #&ƍ  l!*(%j V1hMj(5-ƠԒXH3!-EQC##XdM,F0 !1DRlh(D5DQ4( fh I1TT`61d*R"IM#ki *6ȑ4Qi!4h"4hJ,Z `#*" 1%MA0k)a 2D4`A!JMlc`IILAd!Y "Zc$Kb RRV1V##j,Fh(1ƍQرMETZЅcV+IAA`h6&6ѴH@X1[6(Ւ[ضѣXEƱmQb"Z(DUA‹FьXňجZ-F"ɵĚ6hY0c "UdF2j)"$cc QF&2h6KADhE2hC@&HFF+M6%bƣj+EhڋhZDQEcbI +EmFQQTkZ" 6QlZKd`-bjKbѵjj6jDQĔQV5hZbM,j5c5XF5lh5LƓdDA +%&1(` DAj5bV*1EjJTbƊUKh*4`‹m(Ԗ*4 ,QE"X4m,L,-%FjeV"(`1QbԘb+(64R[ljbcEA(5bkV-F-h5bѦk+bبF6mbF)Tmj XUQ)+#dF"("6l[EFX EEbґQ֍Edb-24Z1 ETT1QT$X61űRhjBi1AVLI3lmbэ&Ơ" [XQ5LѣPlVQEQ( bՈZ%ETU[X,[Z"MQj#QMlkfEXڍI1Rhѱ"Qj6BjM&Fh5`b RXѨ2FV+&LcQQE-Ōj5Ѫ)-*6ѱֈ*F1IZ+E4PbFJ ڍdkF2mڍ QkF4TmŃRjk4V(MQj5FQbXQMEIQQFm`[F(Zcdl1mAbm %E`m,lZAX+E#Z1QlbѨ6 5EH3"aLe4#j!Dhԓ" "!2 (&ELІQb"ض5FDX*+kH(EQlZfMF+b-Fch6ŰTj,l4l[ت6bE6XMcb"Xض-Dm5l,b-4X4&(صb1l`,V+#E`+FƍLQmlTd*Mh5chjđ4 0dY "$R EJbcXM2"LQHFLh,P4a-AD&#$ , $b($dF %%A&kh(66ƲV,cj+ F,Ql­#X[AkImj(#Z5F5bƲmQ@2jbэ$i146ŲTRb6Zƍ#&űmlcXՊ-ţcűF1(1%! 4HP͈ɄذH(6bV5Xm56,mDZ bb4j6,04d1bKhUcQI)))",m,cV61S#$&$+ ,(ĒXJ VQe$#TmI"R;UQA`p|sG#+1/{!UYz\UWۦif<h;GznbiE'0$ OͲMXe)X6o}cD(UbʯQ-:\Jy)ͨ#~s2b5W* (<봝DqU66V(BD*U&%Z(MV6Ƙ2RFbE%Qm5%IhڬZbXlإf;E<)ГԺf6m +W- KZllO{yׯfٵmpTڍjl:އ!vښikz^rM3LMZ̒!p?sܣ R.NUrUԭvkߑ6%i0\jKΑ4#SM6mi[&msA'2w޼bw/@A+p+Ot9-j(Ũa+ QP(*2U'x]x6O޿8NrX+=!nfè[x闝<8{oFiZ ' N\I@?XHxP{-FZ)]yM lnIwlZ[S1+U6$hB$ʒkEʊ4>Q$@J&39aqj"ewJ RD:5Ϟ.y|͹ rHwR̲A*Ї;VCst?pU8g"PwK$P|rA:wyzpO''VD]It;,"<=O'"SӕlB4B';w?7YEFl1+$[2Gtw=iz;r'v{޼GJ!Sm`Q!(JD Vu^farCWR懮{"WfvQpa!.,Ȭ;Wgur:nSiKߘG?#CQoy Vw Nr*4f.v);[u<{AHqn %Jr%YǓ{x^y$9Nto!'֝!'rpwS$%NPۣzA'=득i ϜQtI* Jy'qF-j畾[~|kWt REO?F`ؕJ7~ FJޫ_qV/GDW:?z!9Q:44]rG`^44XF6":'x(+4D^p_m9u#G2N&_*KK0Yw/ K8U8adYE[!.T]j* t+N(9EW GI\ Թ ͉KU;'8JSŒ)XRfg(1")6ZGUҜ(\IN)+z6 hNZ%« :%h&arGZ)b]ʩX ̶#R )2F)LKC]38Ź\~O[Ƞxyc'~O/sri EX03I9QHG!$ ւ.)%`X8C*r*Ht$ $1fi տ(|Q!@L݌qI :G$B5i0$CV*-o8'SpBwTJ'usP>(j R҉>nk7+__M}oK}ر K/vPWɿ>?uwDL(t#v]T[VM]NI"Fx~O{v#}^Kv BUX%L7*/¢q/eORDR}S§Իz'9U{}x'W>lL#4VW1Aʮd-˕~ǸHr$1QJWm8")3QV%rÚ2" TҐ/<+UƱ*ckW6ZۆT\h21[+iɪ^'/˕ 0=/JaW-WWWH+U O_s"{Pz7Y[\n6ƙU `8@>z]|HDG tU؏H>d/ht}{GNBCU}RUpNF1r95E]qlVUZ-,dd#Zeڭ{epTq}uIq)txUV>@V+Uď,mQ>1/QvojDH.r ,Xq^/U;TC;i0Ͻk{Rkyt$`W51.[.}V;/­ȕ*#ƪ&쪯Wq*-U+>GW2_)$UX$n@M8.Œ;$2fW:Aj9^)uS lUm™blSaΧjU.)qmVjLp_ý?CR+ʧHr9A&-r<m,oeIEё,t ywIqCRhZ6pUWdPN0Ua}ʩK֛O\*Z%e^tʮ^]2G #'."'#xEWK4=%I҇FGzkguIQwufRTX$EB3+#(cfJ1l5Ibōm2l26L"c@3,bLdFm6m|)uE;ITsuˢ%qϧEc ` (Î[_Gsף>{=2E$o=pLW98qg-6/= ۨ^]ݏGHS=oO> i=ODN'|Z`0"H0o] j- YxIgw e-MI>U:ARѕ #e4XN(8w<~=V=Z#Ba!f٣M%p8-$r`$^ENkfzIu OCM8,}08:FN|.kDA8Q{ؠ`#}E vH8XAݡTU~ܶ#dm iM=$YI t=;(=u^mzC^mTsٝ%s+': p.^LH83ӇZX ӇԀ1.G"`ηWuH;s٤-V}"O@BAcƄlI 慀0ΟDR:p$ +P]vI c jD]OTI=6"N1/wy@t:RA=2Sp@C]I;f{,#C8 @xs]7TNZU<~}h%>]=>]3[6͛3ֶє@/G[=z:'&"dYe"RpDoP)rH&Hd*pxʼ{;c ת.8 ӱ3!Ձ-XdحE0W1fc$h(̆djmWK/z>&HO~ˍ-9sySB]EU <׮ S  lP8S Wy.(%[8n8isZ2&0d*DݲAE)D6-3Xe35%eX2Q`˖DLh#E#&j(#D2,A@cE3RF0&fI؉#lDMQ4аb F*lT6I" h 61$ضZV"T)64 $R &4$[`ѣRA DdmAE# 5cEbDQ6#lZJ5cFiI Xɴ6 4M$E3P$DPcE( Id" &6%@ɐ40H$ %e( E &dbdC A&2iB!B ,E3(DIDi`I&JaQFdLb#E+I $cTjM` R3@#4,Ra&E,"(0%#dY$L2QΐB1cF jJ @jbNۻB* -QLThQ 1رMclFRh#EdJ2M$SrAHcAQ(dhk)<+^`vA'|У(0*~!t*x߳mFI14GꟺI+|-c[5kF٭f1Ρ"wqZ/RJм+#=U'*BVk0+[-"')U\ii^~pt}G&gI&S  &$ 'E#9xN<><w/׏3_|_!}|>OqswBb]SQҦVU'2TS-FQ*j(y./BzJh(DT͌fdaL)`K P`"IIII$̩WbT2<7c=;*R_ryQ}㫻=/v9k~"" lưٴ5GGNT?e<}xki>w; Y$E>W89w 5r>/?Hަ)L)i|{{ym*lyWpNQy%qhvP9,ta'S訾:Rd}U\K&ʫ¹zB T:9CSyg҇l16W嬣J>\A=:AGL5K֤iwGLWW^W''Omzd]ivH*m+.74F$-U:[v^s7o0| |{!J/O)__abS %F! F"&Rd-(iSad))$ "($&ljMMM2QPbH` J*,bJHFT@Q#hɤ 2 lP& * E"Ab$A*,̓!3FłDQbAA+mI%#($ALɈiFl02d dFI 4҄ H )DM& d!@ш0Hf(! "̚V2FDEfl,*JLBQ&Ekol2)z$b_m|lN]`zx{36.ƍ$rrB*IIҔxb@km[f4c6mf2݄$qOPx#L9Gz|Cn5l-+D颤]ٳiW+sbJ-u*ImIV6W5IljMMlju˔ p -qB*LRT t 9GZJԜ z֭%{[FuR#̑iyRtd,ŰEQVb5j5Xح mJ9'}eߣsW&nM Pw"ܓtrwMLh.\ n6hٶ-Ar8 N; [csζ˔Qm&1S$]W`61ܹQIlsi&Xڋ6)e˔0% FPkfb"(()qVN#8yK^UR`f(w\""n⥶$lb޵vJ RHrNU SSCΫ/I]Dul٭b&4h GmQ_ u^߭el=t.YA-Ug [fl|w,Y}'RM87&[/k[%yd6$Ic^C)!%JmSk&6/՗$>M1< Y|*e8{s{&^Bw+*o8]TBv {A'76zGy7'ϐC>uv<;vʥEͨes2#ʺЃAQWUqLY;W-tܫW7&><ޛE˔MH"sp!^Nnre'o}}yۛ#ۇ;Har" ðFRaqT+ahiW"cdR+v*-U98PN9G<;aͳFYaLj 3@mpG5]{*TNڨUiVSK/⢻&#EtF[dQMdԺA8tFMٗ Nk_ε&0 #EH$F`):Iu*RM:i )ˁv:HvJ5"4M̋ X4+j-oU"E;k1mE#45$IP6ElTF(mXŲhZ+h(X4QF֊kk^6bcHh\*Nsm%tDEZ76,g49rBҹ4JH&r9*VR$:40B}m~CI-IMdkSt!Zȸrvxc#عr@|؉siԪSաl.`3K/)9h;@&M O  `DpCm'^Ipwr~Q`}tSbb.%k*®5M'K7|K%HWK*%^U4x>:UڠENwqEO%[S$%I{,˽RǠ"oUkݶߍW>ǍI Wu' u($K>w$J 6YhG/ZOPb."$!!!wU/WtʹFA ˾w $vDr^Wd2XI 8,C"H;;** 깒t)!ÞBQAy漠6L+,eVBL6TlDjFk/]o;iC,2 922u|t\/4\E%(ѾuġIhk~]ZNp-̧ԜvT}uri}$?e<vC' Alv=s U$RYѣ)P&گ+,[5"E][[36 k*-4h#i-#ƽ_杵fmq\~4?2y^+̏I=>4P7%[P/fWp^9y䚯܂RE~?l9]?>م#BG H~R$I  `̓" 35 dM` 13dKDјJH"Q5611dE1f$`#$E $HАo:1D32)ݮASd$d(F10h؈٘ddF146N\( J(5Dh!&6b1,e"&&\Rb65 QF&*52Pƈ̲b60 ƈPfinPHTlmłf A PZ4 dht#DIFIF1hcC,3IC(#i(Ȋ!˦RM!c% &@bDm j6kBEbIP:KR:DQ\ܹ].ĢZѧuBv.]W&ᮗitӉVT PȊZEaDg1&Hh&$]rssfԉL$6Vl"6m:hS FHH9):s8t1p";;َw]dRD$ &IM%FBR!("AFIMFLD[TPLC0DAơPLوF $iaDHCBS" XcPLa R&2A$@DBĠYDRf(De$!QL !%&'w2 4 LIFD,Hlc,RI4( 1D`)&dMd0bhihFLҐFL|dIb1HFo_`!  o`a)fW]\a4haJd$,JLPBV|iq.6VäFC 7/=St=+l)F輒W(jmsF~R誾}cK{s5Ll̬Yn2wqnElXV݈JM&{u5y&/6^Л"Lє631*6j0P4hE„tunN;sndær,&w]S&K.^q!xLN}G!Տ2)%0RkSݷF )ϧ$(}vwpz.xc8l#Am4^((|=b}ȯi|2X|'{p0mo6$>]8}G2&RD]tCRS6JF5!0RCQ [%,E1dPFNy;@8*JQ~z>_bܮx^ԼQd/(&I-Sʟ#GF M[EP؎_6P&%&)3A&m;QD.EB󗒗GH\qM߈ Oh!}QOee/RUV2"$WҪ+ŽtL+ڌJd:K+T:O]WU܇U1U;Q1,Ho*‡9W)ˍlf( Զ.19AvzHrFT>`)}='<8BbJ%VF8qB>~zs92LL䂴* N JqU*+qhجld[TH[:^"#4N޾a -=ѣDGd`_ )a\۷LկZ<#qṪ?5@Kc- lIA4g1s(rodKkօR 8.:: E񉴧4aV֕P56p 4r9X|S8adP( &L)؄.]\@M41qPȖ.s@d- ,Z9 5yL i91hX@AK!XaD0% t&Qh^hk +Pc o!9ܣg,7a}zǞr{٢GeGzm͛6F IIb$Q&(6Ѭ<$zq^\YoҍQR"S$.팸Rfh^qwkHw/ltü縏t^ YaUr!55bwUQ:'r9q{HJK+湮UyQWךm.h ^C-pyP>Af9 Àz$ {prN|׶7`cM !WN(YXtRj@'ӌ{=\iym+ʋJ/ZzOvUFZ#bڌmFjf@#^FBQ/@~J=nٰ,gC#ʊ?S#xH%Oi?$$_Rs_)Qm&9<.ߦ gh , 1-62!)Dp02<:$߯n־+l?к&mqUO܁eNtrn5;Ȃw>-嚌T(׼g71bꫮ-)ƤdOP6UdXpԽ Z+ul}t@m2FilPFgj@D_99>*KNRp pl6uI#vQ @ N&MQѲK/hجԤaE4e{o,$euW`I nL-Bc>º d.ZDqޟJݯ^^ۓszS9,Hv2Hg!r0""mt6h"-حBjS5';{*Z/{9G'3ϾrtDa*x~myi6%<&9>' n\hQچ2^6U vNJ^s)HL# )7&-݃6F14k!J5$ڂS(Ft;YweJ7{[j hZM_ ?&CZX6wx[%rht~YDdiLXi8 .t*߬Kυerg;ܣ^qn#S-.Ry,kj63i(Cm]}q#\6^X$#3 tĤNg)?^[0BZ8sTCڦG}5Kָ%;zз{a8:aMfB3Æ/S&[Zn_+,w1ju"pӷ+3tL_7"8;=ftUj=.ʸZ.'jZr}7vdT\ ]:)l8*oRT_f~S)a>)¶zyT.[E76)VsnJDDEJ mXl}@YW}S54<2r\O;yT25ZЉ1IX3Bɩ1F@,pvmN]#l5 ɾkXeyvɆ{ xu TYEE;d#j-Qd9S_ $(I$$BH#.0Xc+,![/2KFXr6gaD!+=bBy{kOwKL hl%^ R"f!Myמ]t6:.2$&_L@2~葂g cלЁ${D_vwa;w?ߎԄ Ao>)}s~yQ#I';i/Rxv;? Y}t/ۿml `IK>$d&O~yp~nrGÝV~8 '3>e=}|fwyXXu,{nN<v~tלxh=Md&l~ۦF37[t;[yw[_#{.R0 &_W 3l')`tbzN&F~>񞚓kꔄm(RWl4;glE'M ߝw) Oh8unI2XO1Cĥw68vVTiihE ;Ά"$$q.go!3c1d!5۔e& $@%,QV6\ϋB>gvJϵ7s[-) nXvۘj"3c!hC!#]rɼ0R MeEn\Zc0G9e0v)M^A;D$IDF4&5r02(Y̩Ya)ey?Yk&memY<8%$`a<:604i[;k_lC)3Ah:):氁CyU嬐! 3$SP RJ` n&H'qŋk57fhMUD18"{y^y2WXq^SjL4@C%YdfOp.) IL3I¦?.[G M˜ő+/ݒ|DY7_[8 ܺwv20rcP!Pg!psiKv!00]&?rvg8"(d2D:R=hV%`M'버 Eg͖&Ͷ>R!br$~[k+ ,;`bffa{viFQqs9 i4%`ғI(tfBN)sl< %&WAb P1ˆw%%m*(Q#Du$dHffC8'ﶹMU !6w_t $o6եuA3m;hu"!okCэs4=%# d ҫR hKF\vj;e3 VD_-|\nZYզUK⼯Q>>2R?U%ae`U89U#_Zµ|g{.';x'z+p*j#ڜkW ҕR}64HdDϛglEgN*!tmV$0 sC%\mk2EMIVpGh0ſK[P^Uٷ EY򶒜U'ZO$#6rѣؖP ks%Nu`9%l\Y`+:n]d(\i[vFUlƆ]zA׍N5pN HOp`l7QCln'E+w+,#MasVդ+O^昈Tʸ?2(D/@lAIb 0}kZ@%(5wt~{wif=oo/S}GGvoR '. `mԌuM =ըGi@#PFH=;a 7tOz~j;Ƿ^na]8[rUd9:zu%` SU'giKxs|ל;zҟ9ӳKaЊտ~0r G]ޮpc@gycPJ{pL~k1AD Ũ;YL|#ޚ)Q{cclAWNβ'',T'+M,"5VXCL3x=4-8e L98r^9Ѳ!#"mz d};َ.$o'&)u|dzv+%:&elshduSxء/̲K=[4Sn0l=ڠxݑo(Tkjz<3oD.e¨wEWV-Ų1qo4('aAk,v<*iEӭFS}//8j0ܯ$\[9lLtl:V;ZZTu8[ i}`1[rNyX[E"AMòNg!-zHuN_D'e^K ෯d]Loo·&Hv^nM,/.T z[2ZP5LDT#_IBDI|(|047$L3AD|L|j4bNe4n#; si9>3TiZi^O?MV3,.!dz(kԐ"eoC6EmOμ ~2DU ZQws琧~)7R9IhZxZwwH p9q {&nl>\/y8AZ:_2/‡lo)lf7Ks=y)2@D6P827}t<ͩOCj <ۚw5DN—T2~ocӺOK`&¨5Kf.}VRt0q v.Ju{GUk)s4GKB|ڪtE˒>ٽ4S15\5t?yw]z"svLQ6ou_~ /x矟ʸR}:LPZw(AV;z+{ ەw׍V)DÕ|=FYXyc#ijƞNW֢7JDyTsTjT+D}mD'anڂfeՠAv58/v ]i@ѽ>j}hg96~D':5Ԍɷ/ԃ1εn,Ѷ>Ǘ١.4"Bw؏(N9G)tyJZdڷU+ccGz)@,:4APYZq4לՆF.,bt#صsNչ^\q[ۣ&$j;\b9'H+(8*O=*ߍ` 5gx]J!ϒ>HwYn(d}}Ö$I o%~IAަiGuHe*Md#_ 9#2>΍e!Ĉݢ&/G+σ$D$jAv]Lyt[ܔaݵt.vSS;nFu,AImXᑃcÆzY~ 7?uws3,eᴜ"kRɄ fdam7LB8vqIxãGaƸ 蕞 7\QTj8RB+CY-dGZYx[0۳_Y ]F;lƒ:gbir1ގnfGQ2'z"$E_e؎!Y|Uv2Yז֎F3x9K;o*0}/gBȽĴVI7"3u=EaZYSV (tٶd;#j rwJ[Oг]6 B3p N{W\ņ7x۽4l0lofV\4C:s]2K{&|ӳZa8۫ !=l|8i SN^$;VuёL4Ƕa9G.M,G "O`r>}д:#LrA1?}'XIԐ>f}!QD-a!y>7eՃQDžѦv#*w *tαcCFЩofpr B'wPohwKߺO|o!/  JI;^ *P?5$i M^yݎI;"$Y ES*}m|'4E^xɯT>⪐׺ąTO~cwM ~6m2<A!Ϯz 'J<_v GA{ly}Ҡ/7k5phJgMAh#J\Ocup_2_Nڷq2*8?"ɠ8 ,g"NJq2|=tѳTRhD|W-.IW *kZ8W =Ĵ4m]mG]~Vݮz?;@ךk5G~6]C+ě9~y1Dg]?7ii0gj` ` e0YQ%{>M6!OUU[mU(Ж 4$HBl@lQ h%, 4FUj4` 4V"A$Dɋ)MkHLh355V @#&M4L}Fۢ қFj1$hRF6X&bڭbRRfR Q(h0TVZLQPc*4Rb0MZ$đJ1*4I@[)ch)"Th$ADh QhōFń1m&))Lh-,h(1b4dłI $,Q,AFM3R$cQDc%`̈13,TD0B"ƦL"H 2dƍْl(1hHX (آ4cchB%6J"ƂbcPIc#FmTFLD AIE(MI$RFX dH10 "dd0 BB d2C!SF0RY(` 4D1)#C) DTd 1dH X4bD" I 4T`"FZ1`0Pd()Q"Q2lPH 4RZ) DEIDhR&i2Z*b&c%F&&@a4-b4 F1IBJ ,01 d1$ cID "3+,((4X)55!MQHa f cBZEIKcشZ#LI&5&4m(L*1!EL lDX02FDH"$42)0&ƙ6Ha$Dl Ddԙcb2` ժM&hLh ,j42,b!5 @Jѱ(LYJ61I& #E F0 b6&@X&MTI,h@,2&JJf,d(ѣ#dəRF0!L%E"# h2QA$ICTfRZLlU$Dh&b2X1&̲b((EI,cb &Pj(* MD$cL‰,hFXe0f11 &% 1ȑ DFFI@ŘL`)P12@( -$dRY6*@1 AIai R!303&d҉hF$JeB1Q&̙fF RfebSHJIC2F1&LƔ$(M$h!CbRD@0#$ ɉL$JL 1@EHSIF@ !1hP015 CI Bb+" HXь lФHD2h )Ɍ!`1B`BLI,$))Y4) Y1BHcI)1 HB ( Yfc*,Z*6jDEDdƱ2cD#`!)(F(e1%$Df1@ƍHB$R D3"dFP# 5 Ȉ @H#$D҆Ș1 ,P$a!L(C(&$dYe%$1i1&daMF- (+ I# $0I ff! A D"HY$L̐A4BI$D$m*, &Blтe JI4cFJ !#DJfaLDMD ț(!H)h*2d%&,LŘ1Dƙ6S46MF1H) %c0"@6,61I#Fb (EEM&0&2d* ԚMAI a$Q i`)lcFBb2h#@`#d$hCHc`1cM&eQ%` jJڂcci"X֢4lQlTQlVhHX+D[EأZ",VѬbԛb*F6c[@V+j+FkX6ŴQZMF6mEUAjDVQQmcQX֣jjbT[TkTZ+EdbTkFm&̤&&&E 4)I4m%I`+flA43H ̒RlFlQ&DҚMQ HMIEؑF B#`l",l!Fld#@#""a2(6 llED,CLQ) M a AI1H&1( 1$%(H4S2cQh F1H(Z13&)"&63*(HE2)#ED*j5$h&1IF1R0 Q& 0j4Rm(ƣI 0HZcd(mX0Pi$TbQ1V6fj" Ia1I) ȨLAY1I* ɨ FbDŦbؓE&hbf"i`i(1&4cdj6*(I(6XLF[dF6 4HW" bF I ѢJRT$̘"4ccd0AJ"%E%!EQ1$@)4X beRAb6Je$*!1RkAd,$Z6# iEUeEdA10!hK,XID&Ljhl2!$X "I@j!fI3P.vcFƨjWeMh"C&B$I1#F&4@PE)&-rBAbI $ h"2L$ $%2Y5hɰ4(ƂvIe!HfɌRhTDȈ] ,Z@#6 ,`]rͣM7+HQu),;F2$!3jh0,IDh4Q""R0j F,b$"R ba%$ h؊1DP M B$cB Ƃ (I X,i5#IAj*J#A2h1fbfQR[4XQ$$"Г QJH* %!1Z#FѰe!6H3"6-"X5f Y*4C1b,($h4Il[ "%*i"ad#dH4 #DLS4Iɂ)H)6)"B`$&DBFDD )ł( "X)l(%dE%Ddƃ"HXdD(&TF2DX4SK#,`$cbœlF6MlL"C3A5 (ԘK%@ZATld--j*1 f M2QHIi& (cF4H 2jebƍ %!$l QBkEFdTA$J$bѴcc%$1#ZE&@bb j1DL)4dة0F( JL!`0%1!IE#d ib1mdXB$4`2TbL&iI2"ZJ#THb4QX "+ (2l֥ 2%iЕF hLT5 cAQQ"T$cJFMEb(KHX c"l5X%2RDPDFE2m" L5PTA& QI!Lj1DQ Z,2EJ4FQAQa1ŊHђɊ2f(6 "0$ 6BD1,Ƣ6HLd!Ie6M#$f)#b*ff%&B2IH&C S(hH!1li4(ZEMf̱(hDQdѐLfD[Ɍ0đHfR bZ R%1ETQ%$`LQc$!$iƊ),S 0 icBP&M cK4i0Y6D6dȰ$be ,Bd(2f&DcJbƌBCfJ(PbTi)BQ(ѠE$("ĘbD؄#-dQ(3F$)QLiT *4DJ#$k$AXlh!bBȘ &4YIH%5i0dŌXP`%)Mlda1#PQQ`El*4 Pb5$dCh4fkdQdS,"F"j)  ,X136LTQlلFAdRF&FѨj$d`1B4$IH RB` "4db$1F* cf%DK ĕd"`iRA %FThh cBFP"HXXd&fF"SH"hْQEIe%$2*")F (Da1hTX2bɒH` QhĖDԘJ$b#$!)2 Qa)1 !(1LQ 2D &ɑI$`(i*I cYHfE!cIB Ȥ cDl1f@hFQ0!#& Jcf"dJdLH02%(P1a(I FEE2I,6LbRL A#(Mc D͒B( %2, HXԅlD&aH͡"FF D4HbR1 `XD%"`,AdQ2V,#F#hb L4,"F6 4li12cdƂ" &ЅaH H)4Rb bM$ (I30lfFHC)H(X @("Y`-&dYH"$ ĘX,dD (F"e A 1a$ # DQXج[(bR2$lDXѲ"  "I)#!M(3AdIIh1A FBDZ!B)J,Hш# DEdCFʋF A$QAQdd1bMF #DK`̨0͌Q,A AFĚDC$1ĒZ  b"52Ѣ`BX"2RRb51PXE&RI0hĦQf641Q QF4E#(4K Acd#ḍLR&$ATD@$Z1FK2 1L&V0dB1LP!KF4lD6L%֪eWن QD[& `,B[s X[tTɦG d>HWWƸn$Ė$!"b׻Ym|?nބ١UcЀ``S4 Ki$0cJ@dUcFjB!֘U), QB EV X-qH2أQLdrpOX<0BbBZP0"D-aR )#5IHĐBFI@I 2F@*E"R&L@ dIL3kXUukL `od~I%I߶B9-620F"I"KF4QI( &04b) fQ$3 3fb1fa2DbH2 )3!b#QdԚ@$c? HLj$aDDD)IHH$$7wQ5 $4$b# "f2)"41j(E@QRX!4EIP LB%d؈h4)"cRIA Dh)0`CHEXRI$%`Sb6H( DD%I`1ѢѴeFaR0JƋ%F2h4hY, h*"c1Db(Ѥ͊Ԙ*4cE!1̲F&̔l11أDQ&SD%$ `F 3Fɀɒ()60&J5DJ)3;^IA"CFKFB*-1HY i%ѳ6 B4Q+**LF#$@6(eAɤ$H}~!JB4QFU,P q@m??ҟ骪 Y5p[LrӻsjHguu61Z"h(W5s-F6ѭ\*"̴֔x/ _+77h*[D<9TdTQlA^×\E:dkUͤ%# +߫kl}ki޶|-Α &$ i $HHX34(e$!Zi2 QPB?ȇ,$PsU! eɮ-VUpUYVҼ8h8*F%檳%/nDv\s30h"$4 %J [#5mF-b(j* (5BDV)"1DBX+b)5T%P%EHFأb6Ɠ`,Z((ZH!F4PAdeER4TXj"(Ql@hd"-H mLXTIF3)(hA(@AA2D т"d1BI$X MDD020`6FL "LFR- hc2V*5(ƌcjDX؀&%$F&0H&Eh!RcHEh4LP©5EbQQQRQH eEFa6THbѩm]R{ĶhXVJ_QbI *@3Ii$:oTbb$"LhHL) (XɖYb39;%)m\;%o1Dffɒ,ӬZŴG.m!(`˙wv#ܶ-EjJ4Fc[ch֊V*U_G{mnkkUm$FmAXDQhTXHQ$4i*6lEEѭbرY5&h6ɌX-ш6-cEFIkű1JEj5&5h4F6"Ŋ*UDѭ 5FTV#hXь4 d&$EhFK TT%PZ ɨ#EchL Lʊ2h0%F5e6(J_[V|$FR1$A%$FLP(͒ $HFHBTXA660i@,U(m&h4ɄIDLȯkojtX"ţlFch15DhZDQV6cF*%d*SQb[رEC *MDm,TZfر5U_m|U_'/DɢCIDJ0&,hA4PEH$B4lL5IHhɨX1bhآHAlX5AcMj*-L,j64F-"J&$ dLdYA&% iѵ"QP22Y(m$baI400SF& l bI,f` ?o{N4EU9a\]ʖ S\+mlp[`W&ʹ)_A>Y*H6f1Z$ClQiQQk&He,ə3 `Mik+UzB4<|KUz*N*ȓ~4%ueetK,ŁhibQ24 cFB3fIPM!  Db#`i`((I(ALF$Wu4!2Y F %J Ba$(h bDJ(!l`,X0D1ŃbH`mQ``$ ѐ"b#snā1Q XLQcRT ȆFMH ""fA1&E  DQ4bƤ2(2IS * A"LQRA;ww"8íaLnuiwrf2e;Iݜ۝vq;NĆ@G&Y@$ u vwS۱`w1BDu.5!΀\w]B%BHL)$h@R ($C& E$6 LK3$D@L0a !"I4ʔd$̈ą&0Ȃ %ELf C sLfT" C $I $PM0faAHIFZ4"d0$AL&$$Ȣ Lҙ6%J3@LHGlUh.%KnB 6] r઺a\%mxByRB+}+'#d-Ԩ~k-$zVq8' ΍{zc$⌄8e ?=g[dR۟#Gs^P}묧7h41cEׂ㑨L dO0",:~ g9W|ZHaŸ t "PGMŁ@%GH-V7>ġ+DIG]%$wCaACC$HZ:8N sվe?Tn)#q>C|sBF_$:wt :9G;NNGTfQ-UdP-U.FK[_jrfwN4#. PBCrȴ{;cĽUs׍u3CKJ",ѤEP[ripCD8sD Կr.oSBt@s2Xrym#.x-&D&E[ p\_r-ƛi:ҠxV;m1#yˌ8ܕb/84-C /VHK{%_*Țu(5@s*YrLCG}IqKGg(O_lISBhdFF{EZͯsw7Ӕr[ˡEU¸>409n :ZqXWgvgEidA?t9 w:{~_fZ [z3z'b:*wC+HwzU(_D--EYD ]έ&7VHUEn΄v8)1ηz헊U Jq%# NI9pˌ; -Y6e5!8N3l.'Yߢprn13(8$*q@>\(rQ `yRǓQm'ȬEIy8Cާ\%',f\D"3K%"l f[E TȅK~9%f`v{}ջEcGȊT'H hu:˿JN#o~gSz-duNEw*Xk儡 {tr]5hg]vըVʹ*-YKi8qkNTH/E'^JϳDܜMW u=*u-#* 4IDV@m'^RoۓsݕkW֡x'Bd( 9NTS(MKIa"HHbU_(-߹儈ng@>f&B7? <&FjaOy1>"推,չWb^cKlĶzK ?SUR q$1 [}WM<8z zCc/O]fԱ1yEfinXFe&T?-PXJq;X*K*ԎGE|vd^op qNȘn.Mknm/d0I;2n&rjs(6Y Fi0;§,,!>&Fjղ?SR!1 ';W@CFuԬSfIF>Vr'y(۬{;yg=fV#H+Y$Ph~8.`gZ9G>B|&w!G/"w;䃗 3Ě%,?r-"4M<̦B/!/bӄ.܌s= *zJk[̈~RZ.\q,o w(h9ėViVǢ0{+5U"87je8ěisfe)^vhɝkpgb TU8YJoJ̆H\Z8EqGo@ThEv瓸!%Q 'Iaoh%@֠RaF#>jurU=9f*.ZD8$H/@9iLj?긑Xz/} ^=x+-2OiOZܛp5C3cb]bep'Gъū5}h#RGCXUr:[ZK}^F@Ӹh6PQV]2<r*Thе՛w .ّZ SQ r̆ς:uȉF?IEeU7H^eC̢ؖR![3Ku +"(;2)10w!ickArx\g[^쫩?843TqhFŪs#:S13M GEŝtFbiMs9~5H5R&+/%E#/+/)|Q:ED6-U9T8:޻'.7Y-~k+k #`7Ǜ75Vw=5ҒYRG,ֈ[m}DUb H|.fr22dI+<5q;$U$m;}xFO 38X臢+#]:X#ZYIdW?Fݩ"`]+Ѣr#eg[%粤K/b{,w8Tt'AME4z.6$_C$Za8dBng^m3G8qؓ Gh>sAjQ7l$2ԔEh+!IY1ܹͩݿpt >v >bqh :1[a*G~3 ⱜdGcy; r2a< K󟃪6J|b__to FjpN<ӜdkY24MaKňWJ]y'Ҳ:uXMiSzA22SZL =lCZޯCv%挠Fʩ(`,{sأyc)SY|zNZK- ڳKK< ޛ8\<ԣ X&Xu!U-޴@NGež9$x91(̱.#~j#_* լ m OyCM|j5uCRL%7|~:ů/(N@!,BɊ"W:cfuDG- NS48h_Bٺ"#:‡ CZőSm ƻZEM" ?txg,Z~Oc^'r.ءkHL7]_%{Nwg[Z""e{<>.˧xƯBdz^S$1XTq_*t#VҌfd(X:B@Y!b HfTI!Q;YBX TE=sv^vV.-^cCG ?mG5*!@<N1Bu 4|Is5|>5Ȉqh )s͹YЄ7Z_gBj, gBD gOGB#m[;|ˁ*n)sA9sh4 {x-EY;s"P&NKg HErKy^!& 1c@SH5Ћ H5&xe<<*wZ.x!6%/5C@j@5kCy34 ֮e]e394%(@)RڇMIHJ9vj,|E }#:,yǎk5^iF(.jFn=;!_NTDaeJ[D)sFE(t?)vq6trwO)\wᤩr7Dּ>'ሌI&-4tyz93^fYT)@΅)z(Cr 2;SC"I$H%z+&,tl!D2"6Bi(Iԝ~ܩZ3M d(RR=<-"-;&z#%j&m3HA {V\ LJ蘆̐hX gt,q.NOFE~ՔZXӛGA<!" B;6z)/ޥ4#`@@/we QvA׹JZ)D57[P>Y HP_/T8k?Nٽé2V1\ kZ,-ӁmJtij)`tw^*p<9}Dv~ tCb'zTcot)g9CZbʩYRHfiD_U~*5=Ĭ=| V{Ԏ8#c$Q5C| 9ȈT;ws'Q rrI.KS@M>(̴Q߮mfŝc'$P}ln90gXmÌo ;T|#"l| u2yC !4 ϣ|If#h JHI$ 01T?WwzuuV-*TPFFRSE%$kz( ?W&8Pf≪|V%P謡8&$}H9i{sI.HI!+I|%!!5'<\ M$pnY_}u-7kOH,:#*aQlycwdYnjD0hDޙW]ĽҨF6 {[L 2r$Y4 <-݁%Y=FYbUwⴂ[2{"R8SA܅3ڇc[/z,yamúp?MP мoKI*lWt<8 9Q~!C2#HshO@t7w9ɣɽ=Kam{Q8n=gK#tH77?U;':]9"b 9;iTW:pi9Y9<^]YlvA?mv>97J(!Òf3)Q4Um^W*?ONCbA$F4i;.[naP59ǭګ|6m0oO.KZ5 ~U>7h`D7s*a_br6]ܡ,$X}}>@ CઓG%RC}/TirvzTRU5R1=64Tl=xS?K>06.%Y]4 i^s <{<6x@1/Y{ d; >nꥅp@chNϵ@*ȦT`B)&ޞos$Ŧ4OΠ$ 1쌩B sh''\G]Vs4O,W[j g-B5"GN: 3Yj_y*1^xCxPH8q8W!>(=Lޭݢg L{̑MܭhSrn3ܥ(#ʠC[]ZHw;may8zuT8D!h_`M|xܮ VqoH?U[ZWuCb U4v|ycQ$݈:TrAQj!΁Q)kx#4 WZEDj+ NJ>\Xm^Qf4S:1ވCOk$K"$,@P2Ҁi)1/ !Y)t}KM/(JL9fDBJ}#(c#ir6No#Z3B zF)n?("0I_Y Ls7.7ECw 7-PkҘeןȲPAw֙@Di[lNGs#ÒIJn'/8O'k)Ւxmw|3@o! .*ړG2!#H!w&QGChWNʻ$  GZ&]S]eyrt>j7f7C[_^P2[kEػT%"ےSuL-˸?@8kJ'V8@ˡ( n@MbJXle‹L0VRŒzAΚSWTL6-r'^KɷG'y k}WMZ7f@r?;m|Af)ytFŠVؘw|- {dF}붩 )Q ڡ> HitMgeTw2nFv xg6?8C ãOqmzz%x PvsIZ@'ݩڌ巤]t6wFq􁠍\9 Jmp;TC9+O!q=ҶAG`^\ܕAȰ^Fv6!:^m@R'- mސAo$!Hf]0]V̓ފMP:yאJfN)g不Ȍ"he] SC?ܔ xa@;nFYޒ0hM˭J7#H%\,W5#5\[(Nx?3G2NAs9|3Wkk᭘cӖ(ſVB'EQEgd.OQAy_ͩĽ Xc Ms>򴶟:zc79lsaBRÑ#a#_aNF4rxjNrxCYulm=?lDXHf#膜R*qO: 8yXA+qD@;TjkC=[ϓUK}i_cH5Q;|{E"؝8 FWɝ{Yą?z Nc$aZ >JByA uvS *z?ۇV;2$j:$m#C䨡 (fj4O\XY9ju!qA%*Bw}[{CZ1 I ][Y'wND *g{8#}#3~tbOZʝ@ ~EMy'#wځP!fh}Ì_澮^j< H ji 3 >܆ ̜]=U2{4mK|<Twd-5uy(@ωI|HEᔆY,EɷU'(pdV>j'LPކKT7%IiKٝ.N͉rY!L"{g-P:Gmҡꔅiv^Ab5AȅGI05<]X&bMf-"GěS*?3en$ GׂR,"H'ZQG"1&Zfbs)u9.] 2tXq`uH"78HTU4Y+6{B5ga;\S `el tXB٪)pfTB 2 u@mj`HaaޥI * lFA<8૵6RL[':tCb& SS5@4KǢزq]V5h Ud̵PQCY[ZwACVZuorkEȴHeU2-ߪ 3LrC E 8,06z;OqDrAw"BD@Fpŕ%e6*u=U% ȲئXT@H73Ҋ %uhкi%P՞̚%ފQi9] ܰt4xNWc#):Pk̜(].tKo7Qq࣢MY7@); zjOꐷLLuԬts4bLMzoO;gfz0(e&+hT5 ^@jz3ӣEFz\J^M L - *ٚUeMz>LIO+542JGIM؆h:rS{&+0 O,'GB۽ז5޵t|e1`羏Kz:\lCiͲziHW %ih7mKiF;*Y `}ǝ8T nnUQfNCmV},ާ}LYw ٭2FњMOjS[&Tݚa"CB=wupU,fD@։3/+2SN>>:.)!~sݙ 'jfe TR1al|k*גښw!\}]ƦNY.U잩ߖE}SQGMCWȆCc'a\sT@sW{JYcEY SYtZ'W/ T$;UzyQeeCZ 뾠=H{,OѲۜ*N8h0Hi& Lș$iڂ¸svхNt'SwsiOO3-'5&ҙg:l`T0IОINˮdҥPjnr $,%I8;23C]u{I<`nlVK՝DmY֓3 +_ezUK{(A8⬲!!`JNR}$j:Bqs%Ǔ/؝򦤴C! kE2yrqHy9xfWm,,3&łL|xvEZaEOSSOFLTu'-)`#Q^Us9KОM{}kMY(Wei; ?vgϔ z 鞪eldNkT M9u?ueX%qo ' ֚TOjRO4/Hx/? `* |Q!n5?,e=Pއ:Ob4-6Zm/MI5ACJgjq 2me5GXk`~[+;%Wc&GI\U ЦM0}]+uӏ? 38f-S1tٞ͘(}Dꔪ"S6<1G}/a> RE`"o7'_],%k&ݗek^/OTg>`` s>vșs`|z7y`cn >)Ia[7`kTʝʁ>ȁwI!Ӓ &w0D?^.a]Sҥ羂ݶR^X?iz,=.Gs%^ɓ+{UIr{gbj j!!D | }t!0,hYY4o=[52z>Wוx̅jS!r\L+:ut%Zi|fP CTxϞ&χѓkFΛLCŅUSAͲ3_`Νɨ %?v 3͔* >r`/}9: 40&umw@t1~k纽~({.V ,5Ϥ3QE^v^sG*n Py XX(V)9*5Rog벃 3g{+ 0uQ<!THmedʅ*!I?&!dLM4/AEX~6sU Yzle2K%ox'Re|;T~{HRjzXuv/@RNm o]TO&s_pV<-Qbf-}Gs] )*3wvE9-QS,.SSi}ssqgꌙhkb8>l/`ٽ>.H,;hdѣيRt;GkXup KdBj).6%43uy[rz.Pɽ> CI27{9 "pK$MMw;ۓ r>l黟%ڙ既KJAM;hgmOҒaхZ9(<hIŐȁ$ bYә/&[ P0mdmVdyS2,K6E؅DO,-zuBJIn t I{fe2䔝hSšs!fOU%8!ri\K6Y E͍*tsz5DY T,RmS<ً98$uhxKÝ a3/d);F{w 2wrFДT(!+u"2earvXgժW~Y̊Urlls&VC ş,)4XY8R=݅I0z&/pKاt!Νu{_J{6gx0 tQ) YObi6KC)$広<+Bu!s ށ˚^م3̗[ٵ}(Xb+nK-$ȀoC͗0V9Ӫ%T9' x͘z.| *RLORvS0aR\aI)pgKsfu$a 3&_N'{'k̷豓ֺmAz!{/]_ ,IHd`RtX>L:ꡋ?930ߔh)9aYF6 b& +m̆NE0Y\y$2t!$:Z砹qQHmMhY "\ 5)4pXdN Jи7[?nw,Ɋ)tJ_U& 'lzؘya޵C"Oq vԅ̞>*8سzh뢯.LCJBԁ&(:&/R<4֝іdd, rhdpad`*(.ao'$4/cX]:hpb",%0tB:S:~g>k%i{O$3 {"œdS{4ȥꆻ RSu3uLVj,{86 ,S唐2VL칆~љf ;Re'?I^Iڌe*u2ʤTT, e7ha\6l;SѽP݅v [=BjusgI&]ύ֙YfL 'c bËސ(\`g(TPfT:ok՝?ʆO0d5xTi+-nP$X MnB<}v~IGiƊɪvIfpnOK{ Y83C BY'C *X~_A:u!^(nIg&J˜蹽 }?iLҳC39!@!Kӛ ->!ə唩O&Q*RmdӪ6ƥySzw] T^j=/ NIa΅60z&f/ne YhjfWf7׋$raKG1e÷=(%3Z=JEJe}d! j0=}5OēBw&Bt<Aym9!zR9B-,&Km_aԞk_J/{PY36Id,UXωuBv& ^*jk&;ɀZnVD/`Z8T<+VKk@Þ֛9P74u%.yӯuY@K$Rœ)5̑IN)a0߅X<ɑZXcY)[B콆:\/]SBjb픚],#,{Nf0ˮւ \P.#3uؘ&TYɅ!_$Cu6i$Cv,)dJiARmAo`&Dǚ%*S Y';4q߈ki4:OTM %ghʍ,82͚Cs , z2N9r\^ÒJCLkAC)؜P^69K 93'SW2Y ,>YηR,aN60IڷXPidyQdXfD&.a߿L2Us"쮌*ώkBPLd|ɞxucMo3&dPe#P΁-A̜E9+P20RpuiWL*Cm9 I)'6t2X`]SN Rhr赡Tadt3Σ 0{VZ\( }H|n8pzMX/K\TYq7(ϷȚ\hdd8W+L'qσ x5sw ;v-#M;L,S"aAHE!ep 2ʮwtU3WU$ FZɒtqu#dRN*qKW{2Wlj{dOd8~-6&cy & TdcTٺ߻]KE;2H=3i6F8ZVU2o88cf)ؘ37n{N: ȆٔF(h}jQLЄaPOJM꥾*taW1CR}7:ŶF)'w9,Ŋ<{,gluڗGߕ 6ו5&Ta+j (d@gzUf.|`˹3=/$0X,rG$Ae{R-u[.!{!ucӮrNI2'S:P-W8֔à ?M:QAEUwh#U=\fzTI§vk]3p1RM2wuM}<텾59SfnHtd'eߴ2kcp.f%ɳ5@Ȇ,&6LN5Z%WF).jʜv^RUYJ&6.LR;< Ŋ(u]љ73]Xu>ULIk&RC&cii`j2^q欬ukᗒoyB&Z&І%a$$éa;U T9Z`k!k <7sX&AafRdBL\8sUWRK'77鍶OEzd^j)N僇mΚ0€e,g==piT%s CR˓ĺLfHt4};͎,ej Z'e̘kނW3hS5a]x n*8yJg&f@[ĝ9f?Y(𾟧+j/bmaN!Jl$3ah<+7n*~|e˓fZ0Ux;*??J\_.7P~z{mpgWV`@І-r"ϩYt84.tLWvFtGׅEmҬؤdE}zOo9k.@kRv?FMHR'}5[EfЄ$"=sQPx3%b]>4fL5Z8_c#>/u T7"~E-s; @*9+40Y՞SM'g(hiȬ%UdO$6(v*3Y"~lhg."&RgWW;ׇAbF֥k]b@׽@[\u5a8caZB{87x,g0:!o*^i d+d{ C;2'ɣ)SsءI4k#~4iCk?,يo~fPY86.TGeS6mχoEʒ¥_kN__O&acݖ=*N%1 ^CeTC暆 "+9qʪݓd`jfdwT%+(ELϟgMw53#fywW?ܟUDZso4>SY%P<>ay 'ڹX]ÙSeBoBtQu-7[ *K)E=nXfV1C߃r iㅫܳ tT;-xRʧ4u -yR8-okdP}] s~eMn+v@}7 %3YUepw!|^Ty$5\gkІBgGz ?\K5B;GCYD uy#R;&%Fa8PZЇ"A pI8B`T^@/.k=+,妠*= ԋE9yʐ"=MqL—sspMd uZF$gt@h?D [0;t)@QqϿslmuY>sG,E+".FnI;P7.*0JIxdzؚ!YLhgdI³řF/=QÆ.bb8̒3{]Β &W#4i2̿LCiMn3b ]9ѽFQKِg~'?{lu0zhShHY{]܂!_U䞷wrdX:^݇9ӭ0gnչ -D}C_ݡd䜞b^~R)lY sޝ}Z.K$q]BClx$lubridate/R/0000755000175100001440000000000012765562217012461 5ustar hornikuserslubridate/R/hidden.r0000644000175100001440000000030712755025406014070 0ustar hornikusers#' Internal page for hidden aliases #' #' For S4 methods that require a documentation entry but only clutter the index. #' #' @usage NULL #' @format NULL #' @keywords internal hidden_aliases <- NULL lubridate/R/ops-addition.r0000644000175100001440000001011612755025406015226 0ustar hornikusers#' @include timespans.r #' @include durations.r #' @include intervals.r #' @include periods.r #' @include Dates.r #' @include difftimes.r #' @include numeric.r #' @include POSIXt.r NULL add_duration_to_duration <- function(dur2, dur1) new("Duration", dur1@.Data + dur2@.Data) add_duration_to_date <- function(dur, date) { if(is.Date(date)){ date <- as.POSIXct(date) ans <- with_tz(date + dur@.Data, "UTC") if (hour(ans) == 0 && minute(ans) == 0 && second(ans) == 0) return(as.Date(ans)) return(ans) } new <- date + dur@.Data attr(new, "tzone") <- tz(date) reclass_date(new, date) } add_period_to_period <- function(per2, per1){ new("Period", per1@.Data + per2@.Data, year = per1@year + per2@year, month = per1@month + per2@month, day = per1@day + per2@day, hour = per1@hour + per2@hour, minute = per1@minute + per2@minute) } add_period_to_date <- function(per, date){ lt <- as.POSIXlt(date) ## add months and years with no backwards rollover ms <- month(per) + year(per) * 12 month(per) <- 0 year(per) <- 0 lt <- add_months(lt, ms) new <- update(lt, days = mday(lt) + per@day, hours = hour(lt) + per@hour, minutes = minute(lt) + per@minute, seconds = second(lt) + per@.Data) if (is.Date(date) && sum(new$sec, new$min, new$hour, na.rm = TRUE) != 0) return(new) reclass_date(new, date) } add_months <- function(mt, mos) { mt$mon <- mt$mon + mos ndays <- as.numeric(format.POSIXlt(mt, "%d", usetz = FALSE)) mt$mon[mt$mday != ndays] <- NA mt } add_number_to_duration <- function(num, dur){ new("Duration", dur@.Data + num) } add_number_to_period <- function(num, per){ slot(per, ".Data") <- per@.Data + num per } #' @export setMethod("+", signature(e1 = "Duration", e2 = "Duration"), function(e1, e2) add_duration_to_duration(e2, e1)) #' @export setMethod("+", signature(e1 = "Duration", e2 = "Date"), function(e1, e2) add_duration_to_date(e1, e2)) #' @export setMethod("+", signature(e1 = "Duration", e2 = "difftime"), function(e1, e2) add_duration_to_duration(as.duration(e2), e1)) #' @export setMethod("+", signature(e1 = "Duration", e2 = "numeric"), function(e1, e2) add_number_to_duration(e2, e1)) #' @export setMethod("+", signature(e1 = "Duration", e2 = "POSIXct"), function(e1, e2) add_duration_to_date(e1, e2)) #' @export setMethod("+", signature(e1 = "Duration", e2 = "POSIXlt"), function(e1, e2) add_duration_to_date(e1, e2)) #' @export setMethod("+", signature(e1 = "Period", e2 = "Period"), function(e1, e2) add_period_to_period(e2, e1)) #' @export setMethod("+", signature(e1 = "Period", e2 = "Date"), function(e1, e2) add_period_to_date(e1, e2)) #' @export setMethod("+", signature(e1 = "Period", e2 = "numeric"), function(e1, e2) add_number_to_period(e2, e1)) #' @export setMethod("+", signature(e1 = "Period", e2 = "POSIXct"), function(e1, e2) add_period_to_date(e1, e2)) #' @export setMethod("+", signature(e1 = "Period", e2 = "POSIXlt"), function(e1, e2) add_period_to_date(e1, e2)) #' @export setMethod("+", signature(e1 = "Date", e2 = "Duration"), function(e1, e2) add_duration_to_date(e2, e1)) #' @export setMethod("+", signature(e1 = "Date", e2 = "Period"), function(e1, e2) add_period_to_date(e2, e1)) #' @export setMethod("+", signature(e1 = "difftime", e2 = "Duration"), function(e1, e2) as.difftime(e2, units = "secs") + e1) #' @export setMethod("+", signature(e1 = "numeric", e2 = "Duration"), function(e1, e2) add_number_to_duration(e1, e2)) #' @export setMethod("+", signature(e1 = "numeric", e2 = "Period"), function(e1, e2) add_number_to_period(e1, e2)) #' @export setMethod("+", signature(e1 = "POSIXct", e2 = "Duration"), function(e1, e2) add_duration_to_date(e2, e1)) #' @export setMethod("+", signature(e1 = "POSIXct", e2 = "Period"), function(e1, e2) add_period_to_date(e2, e1)) #' @export setMethod("+", signature(e1 = "POSIXlt", e2 = "Duration"), function(e1, e2) add_duration_to_date(e2, e1)) #' @export setMethod("+", signature(e1 = "POSIXlt", e2 = "Period"), function(e1, e2) add_period_to_date(e2, e1)) lubridate/R/ops-subtraction.r0000644000175100001440000000212512755036232015770 0ustar hornikusers#' @include timespans.r #' @include durations.r #' @include intervals.r #' @include periods.r #' @include Dates.r #' @include difftimes.r #' @include POSIXt.r NULL subtract_interval_from_date <- function(int, date){ end <- int@start + int@.Data dur <- as.duration(int) add_duration_to_date(-dur, date) } #' @export setMethod("-", signature(e1 = "Duration", e2 = "missing"), function(e1, e2) multiply_duration_by_number(e1, -1)) #' @export setMethod("-", signature(e1 = "Interval", e2 = "missing"), function(e1, e2) multiply_interval_by_number(e1, -1)) #' @export setMethod("-", signature(e1 = "Period", e2 = "missing"), function(e1, e2) multiply_period_by_number(e1, -1)) #' @export setMethod("-", signature(e1 = "ANY", e2 = "Duration"), function(e1, e2) e1 + (-e2)) #' @export setMethod("-", signature(e1 = "Duration", e2 = "ANY"), function(e1, e2) e1 + (-e2)) #' @export setMethod("-", signature(e1 = "ANY", e2 = "Period"), function(e1, e2) e1 + (-e2)) #' @export setMethod("-", signature(e1 = "Period", e2 = "ANY"), function(e1, e2) e1 + (-e2)) lubridate/R/periods.r0000644000175100001440000005607612765536003014321 0ustar hornikusers#' @include timespans.r #' @include util.r #' @include durations.r NULL check_period <- function(object){ errors <- character() if (!is.numeric(object@.Data)) { msg <- "seconds (.Data) value must be numeric." errors <- c(errors, msg) } if (!is.numeric(object@year)) { msg <- "year value must be numeric." errors <- c(errors, msg) } if (!is.numeric(object@month)) { msg <- "year value must be numeric." errors <- c(errors, msg) } if (!is.numeric(object@day)) { msg <- "year value must be numeric." errors <- c(errors, msg) } if (!is.numeric(object@hour)) { msg <- "year value must be numeric." errors <- c(errors, msg) } if (!is.numeric(object@minute)) { msg <- "year value must be numeric." errors <- c(errors, msg) } length(object@.Data) -> n lengths <- c(length(object@year), length(object@month), length(object@day), length(object@hour), length(object@minute)) if (any(lengths != n)) { msg <- paste("Inconsistent lengths: year = ", lengths[1], ", month = ", lengths[2], ", day = ", lengths[3], ", hour = ", lengths[4], ", minute = ", lengths[5], ", second = ", n, sep = "") errors <- c(errors, msg) } values <- c(object@year, object@month, object@day, object@hour, object@minute) values <- na.omit(values) if (sum(values - trunc(values))) { msg <- "periods must have integer values" errors <- c(errors, msg) } if (length(errors) == 0) TRUE else errors } #' Period class #' #' Period is an S4 class that extends the \code{\link{Timespan-class}} class. #' Periods track the change in the "clock time" between two date-times. They #' are measured in common time related units: years, months, days, hours, #' minutes, and seconds. Each unit except for seconds must be expressed in #' integer values. #' #' The exact length of a period is not defined until the period is placed at a #' specific moment of time. This is because the precise length of one year, #' month, day, etc. can change depending on when it occurs due to daylight savings, #' leap years, and other conventions. A period can be #' associated with a specific moment in time by coercing it to an #' \code{\link{Interval-class}} object with \code{\link{as.interval}} or by adding #' it to a date-time with "+". #' #' Periods provide a method for measuring generalized timespans when we wish #' to model clock times. Periods will attain intuitive results at this task #' even when leap years, leap seconds, gregorian days, daylight savings #' changes, and other events happen during the period. See #' \code{\link{Duration-class}} for an alternative way to measure timespans that #' allows precise comparisons between timespans. #' #' The logic that guides arithmetic with periods can be unintuitive. Starting #' with version 1.3.0, lubridate enforces the reversible property of arithmetic #' (e.g. a date + period - period = date) by returning an NA if you create an #' implausible date by adding periods with months or years units to a date. For #' example, adding one month to January 31st, 2013 results in February 31st, #' 2013, which is not a real date. lubridate users have argued in the past that #' February 31st, 2013 should be rolled over to March 3rd, 2013 or rolled back #' to February 28, 2013. However, each of these corrections would destroy the #' reversibility of addition (Mar 3 - one month == Feb 3 != Jan 31, Feb 28 - one #' month == Jan 28 != Jan 31). If you would like to add and subtract months in a #' way that rolls the results back to the last day of a month (when appropriate) #' use the special operators, \code{\link{\%m+\%}}, \code{\link{\%m-\%}} or a #' bit more flexible \code{\link{add_with_rollback}}. #' #' Period class objects have six slots. 1) .Data, a numeric object. The #' apparent amount of seconds to add to the period. 2) minute, a numeric object. #' The apparent amount of minutes to add to the period. 3) hour, a numeric object. #' The apparent amount of hours to add to the period.4) day, a numeric object. #' The apparent amount of days to add to the period.5) month, a numeric object. #' The apparent amount of months to add to the period. 6) year, a numeric object. #' The apparent amount of years to add to the period. #' #' @name Period-class #' @rdname Period-class #' @exportClass Period setClass("Period", contains = c("Timespan", "numeric"), slots = c(year = "numeric", month = "numeric", day = "numeric", hour = "numeric", minute = "numeric"), prototype = prototype(year = 0, month = 0, day = 0, hour = 0, minute = 0), validity = check_period) #' @name hidden_aliases #' @aliases Arith,ANY,Period-method Arith,Duration,Period-method #' Arith,Period,Duration-method Compare,Period,Duration-method #' Compare,Period,Period-method Compare,Period,character-method #' Compare,Period,numeric-method Compare,character,Period-method #' second,Period-method second<-,Period-method minute,Period-method #' minute<-,Period-method hour,Period-method hour<-,Period-method #' Arith,Period,ANY-method day,Period-method day<-,Period-method #' month,Period-method month<-,Period-method year,Period-method #' year<-,Period-method date,Period-method date<-,Period-method #' as.numeric,Period-method show,Period-method c,Period-method #' rep,Period-method [,Period-method [<-,Period,ANY,ANY,Period-method #' [[,Period-method [[<-,Period,ANY,ANY,Period-method $,Period-method #' $<-,Period-method as.difftime,Period-method as.character,Period-method #' +,Period,Duration-method +,Period,Interval-method +,Period,Period-method #' +,Period,Date-method +,Date,Period-method +,Period,difftime-method #' +,difftime,Period-method +,Period,numeric-method +,numeric,Period-method #' +,Period,POSIXct-method +,POSIXct,Period-method +,Period,POSIXlt-method #' +,POSIXlt,Period-method /,Period,Duration-method /,Period,Interval-method #' /,Period,Period-method /,Period,difftime-method /,difftime,Period-method #' /,Period,numeric-method /,numeric,Period-method *,Period,ANY-method #' *,ANY,Period-method -,Period,ANY-method -,Period,missing-method #' -,ANY,Period-method %%,Period,Duration-method %%,Period,Interval-method #' %%,Period,Period-method >,Period,Period-method >=,Period,Period-method #' ==,Period,Period-method !=,Period,Period-method <=,Period,Period-method #' <,Period,Period-method >,Period,Duration-method >=,Period,Duration-method #' ==,Period,Duration-method !=,Period,Duration-method #' <=,Period,Duration-method <,Period,Duration-method >,Duration,Period-method #' >=,Duration,Period-method ==,Duration,Period-method #' !=,Duration,Period-method <=,Duration,Period-method #' <,Duration,Period-method >,Period,numeric-method >=,Period,numeric-method #' ==,Period,numeric-method !=,Period,numeric-method <=,Period,numeric-method #' <,Period,numeric-method >,numeric,Period-method >=,numeric,Period-method #' ==,numeric,Period-method !=,numeric,Period-method <=,numeric,Period-method #' <,numeric,Period-method !=,Duration,Period !=,Period,Duration #' !=,Period,Period !=,Period,numeric !=,numeric,Period %%,Period,Duration #' %%,Period,Interval %%,Period,Period *,ANY,Period *,Period,ANY -,ANY,Period #' -,Period,Interval -,Period,missing /,numeric,Period <,Duration,Period #' <,Period,Duration <,Period,Period <,Period,numeric <,numeric,Period #' <=,Duration,Period <=,Period,Duration <=,Period,Period <=,Period,numeric #' <=,numeric,Period ==,Duration,Period ==,Period,Duration ==,Period,Period #' ==,Period,numeric ==,numeric,Period >,Duration,Period >,Period,Duration #' >,Period,Period >,Period,numeric >,numeric,Period >=,Duration,Period #' >=,Period,Duration >=,Period,Period >=,Period,numeric >=,numeric,Period NULL setMethod("initialize", "Period", function(.Object, ...){ dots <- list(...) names(dots)[!nzchar(allNames(dots))] <- ".Data" len <- max(unlist(lapply(dots, length), F, F)) for(nm in slotNames(.Object)){ slot(.Object, nm) <- if(is.null(obj <- dots[[nm]])){ rep.int(0L, len) } else { if(length(obj) < len) rep_len(obj, len) else obj } } validObject(.Object) .Object }) #' @export setMethod("show", signature(object = "Period"), function(object){ print(format(object)) }) #' @export format.Period <- function(x, ...){ if (length(x@.Data) == 0) return("Period(0)") show <- vector(mode = "character") na <- is.na(x) show <- paste(x@year, "y ", x@month, "m ", x@day, "d ", x@hour, "H ", x@minute, "M ", x@.Data, "S", sep="") start <- regexpr("[-1-9]|(0\\.)", show) show <- ifelse(start > 0, substr(show, start, nchar(show)), "0S") show[na] <- NA show } #' @export xtfrm.Period <- function(x){ xtfrm(period_to_seconds(x)) } #' @export setMethod("c", signature(x = "Period"), function(x, ...){ elements <- lapply(list(...), as.period) seconds <- c(x@.Data, unlist(lapply(elements, slot, ".Data"))) years <- c(x@year, unlist(lapply(elements, slot, "year"))) months <- c(x@month, unlist(lapply(elements, slot, "month"))) days <- c(x@day, unlist(lapply(elements, slot, "day"))) hours <- c(x@hour, unlist(lapply(elements, slot, "hour"))) minutes <- c(x@minute, unlist(lapply(elements, slot, "minute"))) new("Period", seconds, year = years, month = months, day = days, hour = hours, minute = minutes) }) #' @export setMethod("rep", signature(x = "Period"), function(x, ...){ new("Period", rep(x@.Data, ...), year = rep(x@year, ...), month = rep(x@month, ...), day = rep(x@day, ...), hour = rep(x@hour, ...), minute = rep(x@minute, ...)) }) #' @export setMethod("[", signature(x = "Period"), function(x, i, j, ..., drop = TRUE) { new("Period", x@.Data[i], year = x@year[i], month = x@month[i], day = x@day[i], hour = x@hour[i], minute = x@minute[i]) }) #' @export setMethod("[[", signature(x = "Period"), function(x, i, j, ..., exact = TRUE) { new("Period", x@.Data[i], year = x@year[i], month = x@month[i], day = x@day[i], hour = x@hour[i], minute = x@minute[i]) }) #' @export setMethod("[<-", signature(x = "Period", value = "Period"), function(x, i, j, ..., value) { x@.Data[i] <- value@.Data x@year[i] <- value@year x@month[i] <- value@month x@day[i] <- value@day x@hour[i] <- value@hour x@minute[i] <- value@minute x }) #' @export setMethod("[[<-", signature(x = "Period", value = "Period"), function(x, i, j, ..., value) { x@.Data[i] <- value@.Data x@year[i] <- value@year x@month[i] <- value@month x@day[i] <- value@day x@hour[i] <- value@hour x@minute[i] <- value@minute x }) #' @export setMethod("$", signature(x = "Period"), function(x, name) { if (name == "second") name <- ".Data" slot(x, name) }) #' @export setMethod("$<-", signature(x = "Period"), function(x, name, value) { if (name == "second") name <- ".Data" slot(x, name) <- rep_len(value, length(x)) x }) #' Create a period object. #' #' \code{period} creates a period object with the specified values. period #' provides the behaviour of \code{\link{period}} in a way that is more #' suitable for automating within a function. #' #' Within a Period object, time units do not have a fixed length (except for #' seconds) until they are added to a date-time. The length of each time unit #' will depend on the date-time to which it is added. For example, a year that #' begins on 2009-01-01 will be 365 days long. A year that begins on 2012-01-01 #' will be 366 days long. When math is performed with a period object, each unit #' is applied separately. How the length of a period is distributed among its #' units is non-trivial. For example, when leap seconds occur 1 minute is longer #' than 60 seconds. #' #' Periods track the change in the "clock time" between two date-times. They #' are measured in common time related units: years, months, days, hours, #' minutes, and seconds. Each unit except for seconds must be expressed in #' integer values. #' #' Period objects can be easily created with the helper functions #' \code{\link{years}}, \code{\link{months}}, \code{\link{weeks}}, #' \code{\link{days}}, \code{\link{hours}}, \code{\link{minutes}}, #' and \code{\link{seconds}}. These objects can be added to and subtracted #' to date-times to create a user interface similar to object oriented programming. #' #' Note: Arithmetic with periods can results in undefined behavior when #' non-existent dates are involved (such as February 29th). Please see #' \code{\link{Period-class}} for more details and \code{\link{\%m+\%}} and #' \code{\link{add_with_rollback}} for alternative operations. #' #' @param num a numeric vector that lists the number of time units to be #' included in the period. From v1.6.0 \code{num} can also be a character #' vector that specifies durations in a convenient shorthand format. All #' unambiguous name units and abbreviations are supported. One letter "m" #' stands for months, "M" stands for minutes. See examples. #' @param units a character vector that lists the type of units to be used. The #' units in units are matched to the values in num according to their #' order. When \code{num} is character, this argument is ignored. #' @param ... a list of time units to be included in the period and their #' amounts. Seconds, minutes, hours, days, weeks, months, and years are #' supported. Normally only one of \code{num} or \code{...} are present. If #' both are present, the periods are concatenated. #'@seealso \code{\link{Period-class}}, \code{\link{quick_periods}}, #' \code{\link{\%m+\%}}, \code{\link{add_with_rollback}} #' @return a period object #' @keywords chron classes #' @examples #' period(c(90, 5), c("second", "minute")) #' # "5M 90S" #' period(-1, "days") #' period(c(3, 1, 2, 13, 1), c("second", "minute", "hour", "day", "week")) #' period(c(1, -60), c("hour", "minute")) #' period(0, "second") #' period (second = 90, minute = 5) #' period(day = -1) #' period(second = 3, minute = 1, hour = 2, day = 13, week = 1) #' period(hour = 1, minute = -60) #' period(second = 0) #' period(c(1, -60), c("hour", "minute"), hour = c(1, 2), minute = c(3, 4)) #' period("2M 1sec") #' period("2hours 2minutes 1second") #' period("2d 2H 2M 2S") #' period("2days 2hours 2mins 2secs") #' # Missing numerals default to 1. Repeated units are added up. #' duration("day day") #' # Comparison with characters is supported from v1.6.0. #' duration("day 2 sec") > "day 1sec" #' @export period <- function(num = NULL, units = "second", ...) { nums <- list(...) if(is.character(num)){ parse_period(num) } else if(!is.null(num) && length(nums) > 0){ c(.period_from_num(num, units), .period_from_units(nums)) } else if(!is.null(num)){ .period_from_num(num, units) } else if(length(nums)){ .period_from_units(nums) } else { stop("No valid values have been passed to 'period' constructor") } } ##' @useDynLib lubridate c_parse_period parse_period <- function(x){ out <- matrix(.Call("c_parse_period", x), nrow = 7L) new("Period", out[1, ], minute = out[2, ], hour = out[3, ], day = out[4, ] + 7L*out[5, ], month = out[6, ], year = out[7, ]) } .period_from_num <- function(num, units){ if(!is.numeric(num)){ stop(sprintf("First argument to `period` constructor must be character or numeric. Supplied object of class '%s'", class(num))) } if(is.interval(num)) stop("Interval objects cannot be used as input to 'period' constructor. Plese use 'as.period'.") if (length(units) %% length(num) != 0) stop("Arguments `num` and `units` must have same length") num <- num + rep(0, length(units)) unit <- standardise_date_names(units) pieces <- setNames(as.list(num), unit) defaults <- list(second = 0, minute = 0, hour = 0, day = 0, week = 0, month = 0, year = 0) pieces <- c(pieces, defaults[setdiff(names(defaults), names(pieces))]) pieces$day <- pieces$day + 7 * pieces$week new("Period", pieces$second, year = pieces$year, month = pieces$month, day = pieces$day, hour = pieces$hour, minute = pieces$minute) } .period_from_units <- function(units) { pieces <- data.frame(lapply(units, as.numeric)) ## fixme: syncronize this with the initialize method names(pieces) <- standardise_date_names(names(pieces)) defaults <- data.frame( second = 0, minute = 0, hour = 0, day = 0, week = 0, month = 0, year = 0 ) pieces <- cbind(pieces, defaults[setdiff(names(defaults), names(pieces))]) ## pieces <- pieces[c("year", "month", "week", "day", "hour", "minute", "second")] pieces$day <- pieces$day + pieces$week * 7 na <- is.na(rowSums(pieces)) pieces$second[na] <- NA ## if any of supplied pieces is NA whole vector should be NA new("Period", pieces$second, year = pieces$year, month = pieces$month, day = pieces$day, hour = pieces$hour, minute = pieces$minute) } #' @rdname period #' @param x an R object #' @examples #' is.period(as.Date("2009-08-03")) # FALSE #' is.period(period(months= 1, days = 15)) # TRUE #' @export is.period <- function(x) is(x,"Period") #' Quickly create period objects. #' #' Quickly create Period objects for easy date-time manipulation. The units of #' the period created depend on the name of the function called. For Period #' objects, units do not have a fixed length until they are added to a specific #' date time, contrast this with \code{\link{duration}}. This makes periods useful #' for manipulations with clock times because units expand or contract in length #' to accomodate conventions such as leap years, leap seconds, and Daylight #' Savings Time. #' #' When paired with date-times, these functions allow date-times to be #' manipulated in a method similar to object oriented programming. Period #' objects can be added to Date, POSIXct, and POSIXlt objects to calculate new #' date-times. #' #' Note: Arithmetic with periods can results in undefined behavior when #' non-existent dates are involved (such as February 29th in non-leap #' years). Please see \code{\link{Period-class}} for more details and #' \code{\link{\%m+\%}} and \code{\link{add_with_rollback}} for alternative #' operations. #' #' @name quick_periods #' @param x numeric value of the number of units to be contained in the #' period. With the exception of seconds(), x must be an integer. #' @param abbreviate Ignored. For consistency with S3 generic in base namespace. #' @return a period object #' @seealso \code{\link{Period-class}}, \code{\link{period}}, #' \code{\link{ddays}}, \code{\link{\%m+\%}}, \code{\link{add_with_rollback}} #' @keywords chron manip #' @examples #' #' x <- as.POSIXct("2009-08-03") #' x + days(1) + hours(6) + minutes(30) #' x + days(100) - hours(8) #' #' class(as.Date("2009-08-09") + days(1)) # retains Date class #' as.Date("2009-08-09") + hours(12) #' class(as.Date("2009-08-09") + hours(12)) #' # converts to POSIXt class to accomodate time units #' #' years(1) - months(7) #' c(1:3) * hours(1) #' hours(1:3) #' #' #sequencing #' y <- ymd(090101) # "2009-01-01 CST" #' y + months(0:11) #' #' # compare DST handling to durations #' boundary <- as.POSIXct("2009-03-08 01:59:59") #' boundary + days(1) # period #' boundary + ddays(1) # duration #' # seconds later) #' @export seconds minutes hours days weeks years milliseconds microseconds microseconds nanoseconds picoseconds seconds <- function(x = 1) period(second = x) #' @rdname quick_periods minutes <- function(x = 1) period(minute = x) #' @rdname quick_periods hours <- function(x = 1) period(hour = x) #' @rdname quick_periods days <- function(x = 1) period(day = x) #' @rdname quick_periods weeks <- function(x = 1) period(week = x) #' @rdname quick_periods years <- function(x = 1) period(year = x) #' @rdname quick_periods milliseconds <- function(x = 1) seconds(x/1000) #' @rdname quick_periods microseconds <- function(x = 1) seconds(x/1000000) #' @rdname quick_periods nanoseconds <- function(x = 1) seconds(x/1e9) #' @rdname quick_periods picoseconds <- function(x = 1) seconds(x/1e12) #' @rdname quick_periods #' @export months.numeric <- function(x, abbreviate) { period(month = x) } #' Contrive a period to/from a given number of seconds. #' #' \code{period_to_seconds} approximately converts a period to seconds assuming #' there are 364.25 days in a calendar year and 365.25/12 days in a month. \cr #' \code{seconds_to_period} create a period that has the maximum number of #' non-zero elements (days, hours, minutes, seconds). This computation is exact #' because it doesn't involve years or months. #' #' @param x A numeric object. The number of seconds to coerce into a period. #' @return A number (period) that roughly equates to the period (seconds) given. #' @export period_to_seconds <- function(x) { x@.Data + 60 * x@minute + 60 * 60 * x@hour + 60 * 60 * 24 * x@day + 60 * 60 * 24 * 365.25 / 12 * x@month + 60 * 60 * 24 * 365.25 * x@year } #' @rdname period_to_seconds #' @export seconds_to_period <- function(x) { span <- as.double(x) remainder <- abs(span) newper <- period(second = rep(0, length(x))) ## slot(newper, "year") <- remainder %/% (3600 * 24 * 365.25) ## remainder <- remainder %% (3600 * 24 * 365.25) slot(newper,"day") <- remainder %/% (3600 * 24) remainder <- remainder %% (3600 * 24) slot(newper, "hour") <- remainder %/% (3600) remainder <- remainder %% (3600) slot(newper, "minute") <- remainder %/% (60) slot(newper, ".Data") <- remainder %% (60) newper * sign(span) } #' @export summary.Period <- function(object, ...) { nas <- is.na(object) object <- object[!nas] persecs <- period_to_seconds(object) qq <- stats::quantile(persecs) qq <- c(qq[1L:3L], mean(persecs), qq[4L:5L]) qq <- seconds_to_period(qq) qq <- as.character(qq) names(qq) <- c("Min.", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max.") if (any(nas)) c(qq, `NA's` = sum(nas)) else qq } #' @export setMethod("Arith", signature(e1 = "Period", e2 = "ANY"), undefined_arithmetic) #' @export setMethod("Arith", signature(e1 = "ANY", e2 = "Period"), undefined_arithmetic) ## duration is.numeric. So we need these explicits here: #' @export setMethod("Arith", signature(e1 = "Duration", e2 = "Period"), undefined_arithmetic) #' @export setMethod("Arith", signature(e1 = "Period", e2 = "Duration"), undefined_arithmetic) #' @export setMethod("Compare", signature(e1 = "character", e2 = "Period"), function(e1, e2) { callGeneric(as.period(e1), e2) }) #' @export setMethod("Compare", signature(e1 = "Period", e2 = "character"), function(e1, e2) { callGeneric(e1, as.period(e2)) }) #' @export setMethod("Compare", signature(e1 = "Period", e2 = "Period"), function(e1, e2) { callGeneric(period_to_seconds(e1), period_to_seconds(e2)) }) #' @export setMethod("Compare", signature(e1 = "Period", e2 = "Duration"), function(e1, e2) { stop("cannot compare Period to Duration:\ncoerce with 'as.duration' first.") }) #' @export setMethod("Compare", signature(e1 = "Duration", e2 = "Period"), function(e1, e2) { callGeneric(as.duration(e1), e2) }) #' @export setMethod("Compare", signature(e1 = "Period", e2 = "numeric"), function(e1, e2) { stop("cannot compare Period to Duration:\ncoerce with 'as.numeric' first.") }) lubridate/R/difftimes.r0000644000175100001440000001032712755025406014612 0ustar hornikusers#' @include timespans.r #' @include durations.r #' @include intervals.r #' @include periods.r setOldClass("difftime") #' Create a difftime object. #' #' \code{make_difftime} creates a difftime object with the specified number of #' units. Entries for different units are cumulative. difftime displays #' durations in various units, but these units are estimates given for #' convenience. The underlying object is always recorded as a fixed number of #' seconds. #' #' Conceptually, difftime objects are a type of duration. They measure the #' exact passage of time but do not always align with measurements #' made in larger units of time such as hours, months and years. #' This is because the length of larger time units can be affected #' by conventions such as leap years #' and Daylight Savings Time. lubridate provides a second class for measuring durations, the Duration class. #' @param num Optional number of seconds #' @param units a character vector that lists the type of units to use for the #' display of the return value (see examples). If \code{units} is "auto" (the #' default) the display units are computed automatically. This might create #' undesirable effects when converting \code{difftime} objects to numeric #' values in data processing. #' @param ... a list of time units to be included in the difftime and their amounts. Seconds, #' minutes, hours, days, and weeks are supported. Normally only one of \code{num} or \code{...} are present. If #' both are present, the \code{difftime} objects are concatenated. #' @return a difftime object #' @seealso \code{\link{duration}}, \code{\link{as.duration}} #' @keywords chron classes #' @export #' @examples #' make_difftime(1) #' make_difftime(60) #' make_difftime(3600) #' make_difftime(3600, units = "minute") #' # Time difference of 60 mins #' make_difftime(second = 90) #' # Time difference of 1.5 mins #' make_difftime(minute = 1.5) #' # Time difference of 1.5 mins #' make_difftime(second = 3, minute = 1.5, hour = 2, day = 6, week = 1) #' # Time difference of 13.08441 days #' make_difftime(hour = 1, minute = -60) #' # Time difference of 0 secs #' make_difftime(day = -1) #' # Time difference of -1 days #' make_difftime(120, day = -1, units = "minute") #' # Time differences in mins make_difftime <- function(num = NULL, units = "auto", ...) { pieces <- list(...) if(!is.null(num) && length(pieces) > 0){ .difftime_from_num(c(num, .difftime_from_pieces(pieces)), units) } else if(!is.null(num)){ .difftime_from_num(num, units) } else if(length(pieces)){ .difftime_from_num(.difftime_from_pieces(pieces), units) } else { stop("No valid values have been passed to 'make_difftime' constructor") } } .difftime_from_num <- function(num, units = "auto") { seconds <- abs(na.omit(num)) if(units == "auto"){ if (any(seconds < 60)) units <- "secs" else if (any(seconds < 3600)) units <- "mins" else if (any(seconds < 86400)) units <- "hours" else units <- "days" } units <- standardise_date_names(units[[1]]) switch(units, second = structure(num, units = "secs", class = "difftime"), minute = structure(num/60, units = "mins", class = "difftime"), hour = structure(num/3600, units = "hours", class = "difftime"), day = structure(num/86400, units = "days", class = "difftime"), stop(sprintf("invalid units '%s'. Only 'second', 'minute', 'hour' and 'day' are supported.", units))) } .difftime_from_pieces <- function(pieces){ names(pieces) <- standardise_difftime_names(names(pieces)) defaults <- list(secs = 0, mins = 0, hours = 0, days = 0, weeks = 0) pieces <- c(pieces, defaults[setdiff(names(defaults), names(pieces))]) x <- pieces$secs + pieces$mins * 60 + pieces$hours * 3600 + pieces$days * 86400 + pieces$weeks * 604800 x } #' Is x a difftime object? #' #' @export is.difftime #' @param x an R object #' @return TRUE if x is a difftime object, FALSE otherwise. #' @seealso \code{\link{is.instant}}, \code{\link{is.timespan}}, \code{\link{is.interval}}, #' \code{\link{is.period}}. #' @keywords logic chron #' @examples #' is.difftime(as.Date("2009-08-03")) # FALSE #' is.difftime(make_difftime(days = 12.4)) # TRUE is.difftime <- function(x) is(x, "difftime") lubridate/R/am-pm.r0000644000175100001440000000047312755025406013650 0ustar hornikusers#' Does date time occur in the am or pm? #' #' @export #' @param x a date-time object #' @return TRUE or FALSE depending on whether x occurs in the am or pm #' @keywords chron #' @examples #' x <- ymd("2012-03-26") #' am(x) #' pm(x) am <- function(x) hour(x) < 12 #' @export #' @rdname am pm <- function(x) !am(x) lubridate/R/ops-modulo.r0000644000175100001440000000216212755025406014734 0ustar hornikusers#' @include timespans.r #' @include durations.r #' @include intervals.r #' @include periods.r NULL modulo_duration_by_duration <- function(dur, dur2) dur - dur %/% dur2 * dur2 modulo_interval_by_duration <- function(int, dur) interval(int@start + int@.Data %/% dur@.Data * dur, int_end(int)) modulo_interval_by_period <- function(int, per) interval(int@start + int %/% per * per, int_end(int)) modulo_period_by_period <- function(per, per2) per - per %/% per2 * per2 #' @export setMethod("%%", signature(e1 = "Duration", e2 = "Duration"), function(e1, e2) modulo_duration_by_duration(e1, e2)) #' @export setMethod("%%", signature(e1 = "Interval", e2 = "Duration"), function(e1, e2) modulo_interval_by_duration(e1, e2)) #' @export setMethod("%%", signature(e1 = "Interval", e2 = "Interval"), function(e1, e2) stop("%% not defined for Interval class\nConsider setdiff()")) #' @export setMethod("%%", signature(e1 = "Interval", e2 = "Period"), function(e1, e2) modulo_interval_by_period(e1, e2)) #' @export setMethod("%%", signature(e1 = "Period", e2 = "Period"), function(e1, e2) modulo_period_by_period(e1, e2)) lubridate/R/accessors-month.r0000644000175100001440000000711412755025406015750 0ustar hornikusers#' @include periods.r NULL #' Get/set months component of a date-time. #' #' Date-time must be a POSIXct, POSIXlt, Date, Period, chron, yearmon, yearqtr, zoo, #' zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. #' #' @param x a date-time object #' @param label logical. TRUE will display the month as a character string such #' as "January." FALSE will display the month as a number. #' @param abbr logical. FALSE will display the month as a character string #' label, such as "January". TRUE will display an abbreviated version of the #' label, such as "Jan". abbr is disregarded if label = FALSE. #' @param value a numeric object #' @return the months element of x as a number (1-12) or character string. 1 = #' January. #' @keywords utilities manip chron methods #' @examples #' x <- ymd("2012-03-26") #' month(x) #' month(x) <- 1 #' month(x) <- 13 #' month(x) > 3 #' #' month(ymd(080101)) #' month(ymd(080101), label = TRUE) #' month(ymd(080101), label = TRUE, abbr = FALSE) #' month(ymd(080101) + months(0:11), label = TRUE) #' @export month <- function(x, label = FALSE, abbr = TRUE) UseMethod("month") #' @export month.default <- function(x, label = FALSE, abbr = TRUE) month(as.POSIXlt(x, tz = tz(x))$mon + 1, label, abbr) #' @export month.numeric <- function(x, label = FALSE, abbr = TRUE) { if (!label) return(x) if (abbr) { labels <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") } else { labels <- c("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December") } ordered(x, levels = 1:12, labels = labels) } #' @export month.Period <- function(x, label = FALSE, abbr = TRUE) slot(x, "month") #' @rdname month #' @export "month<-" <- function(x, value) { if (!is.numeric(value)) { value <- pmatch(tolower(value), c("january", "february", "march", "june", "july", "august", "september", "october", "november", "december")) } x <- x + months(value - month(x)) } setGeneric("month<-") #' @export setMethod("month<-", signature("Period"), function(x, value){ slot(x, "month") <- value x }) #' Get the number of days in the month of a date-time. #' #' Date-time must be a POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, #' zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. #' #' @export #' @param x a date-time object #' @return An integer of the number of days in the month component of the date-time object. days_in_month <- function(x) { month_x <- month(x, label = TRUE) n_days <- N_DAYS_IN_MONTHS[month_x] n_days[month_x == "Feb" & leap_year(x)] <- 29L n_days } ## fixme: integrate with above, this oen is needed internally .days_in_month <- function(m, y){ n_days <- N_DAYS_IN_MONTHS[m] n_days[m == 2L & leap_year(y)] <- 29L n_days } ## tothink: export? days_in_months_so_far <- function(month, leap){ ## if month is negative, compute from the end of the year cum_days_pos <- c(0, cumsum(N_DAYS_IN_MONTHS)[-12]) cum_days_neg <- c(0, cumsum(rev(N_DAYS_IN_MONTHS))[-12]) negative <- month < 0 positive <- month > 0 sofar <- integer(length(month)) sofar[negative] <- cum_days_neg[-month[negative]] sofar[positive] <- cum_days_pos[month[positive]] adjust <- leap & ((negative & month == -12) | (positive & month > 2)) sofar[adjust] <- sofar[adjust] + 1L sofar } ## days_in_months_so_far(c(1, 2, 3, -10, -11, -12), rep.int(T, 6)) ## [1] 0 31 60 275 306 335 ## days_in_months_so_far(c(1, 2, 3, -10, -11, -12), rep.int(F, 6)) ## [1] 0 31 59 275 306 334 lubridate/R/timespans.r0000644000175100001440000001474712755025406014655 0ustar hornikusers#' Timespan class #' #' Timespan is an S4 class with no slots. It is extended by the #' \code{\link{Interval-class}}, \code{\link{Period-class}}, and \code{\link{Duration-class}} #' classes. #' #' #' @name Timespan-class #' @rdname Timespan-class #' @exportClass Timespan #' @aliases *,Timespan,Timespan-method %/%,Timespan,Timespan-method %/%,difftime,Timespan-method setClass("Timespan") #' Is x a length of time? #' #' @export is.timespan #' @aliases is.timespan #' @param x an R object #' @return TRUE if x is a period, interval, duration, or difftime object, FALSE otherwise. #' @seealso \code{\link{is.instant}}, \code{\link{is.duration}}, \code{\link{is.difftime}}, \code{\link{is.period}}, \code{\link{is.interval}} #' @keywords logic chron #' @examples #' is.timespan(as.Date("2009-08-03")) # FALSE #' is.timespan(duration(second = 1)) # TRUE is.timespan <- function(x) is(x, "Timespan") #' Description of time span classes in lubridate. #' #' A time span can be measured in three ways: as a duration, an interval, or a #' period. #' #' Durations record the exact number of seconds in a time span. They measure the #' exact passage of time but do not always align with measurements #' made in larger units of time such as hours, months and years. #' This is because the exact length of larger time units can be affected #' by conventions such as leap years #' and Daylight Savings Time. Base R measures durations with the #' difftime class. lubridate provides an additional class, the duration class, #' to facilitate working with durations. #' #' durations display as the number of seconds that occur during a time span. If the number is large, a duration object will also display the length in a more convenient unit, but these measurements are only estimates #' given for convenience. The underlying object is always recorded as a fixed #' number of seconds. For display and creation purposes, units are converted to #' seconds using their most common lengths in seconds. Minutes = 60 seconds, #' hours = 3600 seconds, days = 86400 seconds. Units larger than #' days are not used due to their variability. #' #' duration objects can be easily created with the helper functions #' \code{\link{dweeks}}, \code{\link{ddays}}, \code{\link{dhours}}, \code{\link{dminutes}} and #' \code{\link{dseconds}}. These objects can be added to and subtracted from date- #' times to create a user interface similar to object oriented programming. #' Duration objects can be added to Date, POSIXct, and POSIXlt objects to return a #' new date-time. #' #' Periods record the change in the clock time between two date-times. They are #' measured in common time related units: years, months, days, hours, minutes, #' and seconds. Each unit except for seconds must be expressed in integer #' values. With the exception of seconds, none of these units have a fixed #' length. Leap years, leap seconds, and Daylight Savings Time can expand or #' contract a unit of time depending on when it occurs. For this reason, periods #' do not have a fixed length until they are paired with a start date. Periods #' can be used to track changes in clock time. Because periods #' have a variable length, they must be paired with a start date #' as an interval (\code{\link{as.interval}}) before they can be #' accurately converted to and from durations. #' #' Period objects can be easily created with the helper functions #' \code{\link{years}}, \code{\link{months}}, \code{\link{weeks}}, #' \code{\link{days}}, \code{\link{minutes}}, \code{\link{seconds}}. These objects #' can be added to and subtracted to date-times to create a user interface #' similar to object oriented programming. Period objects can be added to Date, #' POSIXct, and POSIXlt objects to return a new date-time. #' #' Intervals are time spans bound by two real date-times. Intervals can be #' accurately converted to periods and durations. Since an interval is anchored #' to a fixed moment of time, the exact length of all units of #' time during the interval can be calculated. To #' accurately convert between periods and durations, a period or duration should #' first be converted to an interval with \code{\link{as.interval}}. An interval displays as the start #' and end points of the time span it represents. #' #' @aliases timespan timespans #' @name timespan #' @seealso \code{\link{duration}} for creating duration objects and #' \code{\link{period}} for creating period objects, and #' \code{\link{interval}} for creating interval objects. #' @keywords classes chron #' @examples #' duration(3690, "seconds") #' period(3690, "seconds") #' period(second = 30, minute = 1, hour = 1) #' interval(ymd_hms("2009-08-09 13:01:30"), ymd_hms("2009-08-09 12:00:00")) #' #' date <- as.POSIXct("2009-03-08 01:59:59") # DST boundary #' date + days(1) #' date + ddays(1) #' #' date2 <- as.POSIXct("2000-02-29 12:00:00") #' date2 + years(1) #' # self corrects to next real day #' #' date3 <- as.POSIXct("2009-01-31 01:00:00") #' date3 + c(0:11) * months(1) #' #' span <- date2 %--% date #creates interval #' #' date <- as.POSIXct("2009-01-01 00:00:00") #' date + years(1) #' date - days(3) + hours(6) #' date + 3 * seconds(10) #' #' months(6) + days(1) NULL #' Compute the exact length of a time span. #' #' #' @param x a duration, period, difftime or interval #' @param unit a character string that specifies with time units to use #' @return the length of the interval in the specified unit. A negative number #' connotes a negative interval or duration #' #' @details When \code{x} is an \code{\link{Interval-class}} object and #' \code{unit} are years or months, \code{timespan_length} takes into account #' the fact that all months and years don't have the same number of days. #' #' When \code{x} is a \code{\link{Duration-class}}, \code{\link{Period-class}} #' or \code{\link{difftime}} object, length in months or years is based on their #' most common lengths in seconds (see \code{\link{timespan}}). #' @seealso \code{\link{timespan}} #' @keywords chron math period methods #' @examples #' int <- interval(ymd("1980-01-01"), ymd("2014-09-18")) #' time_length(int, "week") #' #' # Exact age #' time_length(int, "year") #' #' # Age at last anniversary #' trunc(time_length(int, "year")) #' #' # Example of difference between intervals and durations #' int <- interval(ymd("1900-01-01"), ymd("1999-12-31")) #' time_length(int, "year") #' time_length(as.duration(int), "year") #' @export setGeneric("time_length", useAsDefault = function(x, unit = "second") { as.duration(x) / duration(num = 1, units = unit) }) lubridate/R/accessors-date.R0000644000175100001440000000244412755025406015501 0ustar hornikusers#' @include periods.r NULL #' Get/set Date component of a date-time. #' #' Date-time must be a POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, zoo, #' zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. #' #' \code{date} does not yet support years before 0 C.E. #' Also \code{date} is not defined for Period objects. #' #' @param x a date-time object #' @param value an object for which the \code{date()} function is defined #' @return the date of x as a Date #' @keywords utilities manip chron methods #' @examples #' x <- as.POSIXct("2012-03-26 23:12:13", tz = "Etc/GMT+8") #' date(x) #' as.Date(x) # by default as.Date assumes you want to know the date in UTC #' as.Date(x, tz = "Etc/GMT+8") #' date(x) <- as.Date("2000-01-02") #' x #' @export date <- function(x) UseMethod("date") #' @export date.default <- function(x) { x <- as.POSIXlt(x, tz = tz(x)) year <- x$year + 1900 month <- x$mon + 1 day <- x$mday as.Date(make_datetime(year, month, day)) } #' @export date.Period <- function(x) stop("date is undefined for Period objects") #' @rdname date #' @export "date<-" <- function(x, value) x <- x + days(date(value) - date(x)) setGeneric("date<-") #' @export setMethod("date<-", signature("Period"), function(x, value){ stop("date<- is undefined for Period objects") }) lubridate/R/accessors-quarter.r0000644000175100001440000000200712763547007016307 0ustar hornikusers#' @include accessors-month.r NULL #' Get the fiscal quarter and semester of a date-time. #' #' Quarters divide the year into fourths. Semesters divide the year into halfs. #' #' @param x a date-time object of class POSIXct, POSIXlt, Date, chron, yearmon, #' yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, fts or #' anything else that can be converted with as.POSIXlt #' @param with_year logical indicating whether or not to include the quarter's #' year. #' @return numeric #' @examples #' x <- ymd(c("2012-03-26", "2012-05-04", "2012-09-23", "2012-12-31")) #' quarter(x) #' quarter(x, with_year = TRUE) #' semester(x) #' semester(x, with_year = TRUE) #' @export quarter <- function(x, with_year = FALSE) { m <- month(x) quarters <- rep(1:4, each = 3) q <- quarters[m] if (with_year) year(x) + q/10 else q } #' @rdname quarter #' @export semester <- function(x, with_year = FALSE){ m <- month(x) semesters <- rep(1:2, each = 6) s <- semesters[m] if (with_year) year(x) + s/10 else s } lubridate/R/ops-integer-division.r0000644000175100001440000000052712755036103016713 0ustar hornikusers#' @include timespans.r NULL integer_divide_spans <- function(e1, e2){ trunc(e1/e2) } #' @export setMethod("%/%", signature(e1 = "Timespan", e2 = "Timespan"), function(e1, e2) integer_divide_spans(e1, e2)) #' @export setMethod("%/%", signature(e1 = "difftime", e2 = "Timespan"), function(e1, e2) integer_divide_spans(e1, e2)) lubridate/R/POSIXt.r0000644000175100001440000000162512755025406013727 0ustar hornikuserssetOldClass("POSIXt") setOldClass("POSIXct") setOldClass("POSIXlt") #' Is x a POSIXct or POSIXlt object? #' #' @export #' @param x an R object #' @return TRUE if x is a POSIXct or POSIXlt object, FALSE otherwise. #' @seealso \code{\link{is.instant}}, \code{\link{is.timespan}}, \code{\link{is.Date}} #' @keywords logic chron #' @examples #' is.POSIXt(as.Date("2009-08-03")) # FALSE #' is.POSIXt(as.POSIXct("2009-08-03")) # TRUE is.POSIXt <- function(x) inherits(x, "POSIXt") #' @rdname is.POSIXt #' @export is.POSIXlt <- function(x) inherits(x, "POSIXlt") #' @rdname is.POSIXt #' @export is.POSIXct <- function(x) inherits(x, "POSIXct") #' @export c.POSIXct <- function (..., recursive = FALSE) { .POSIXct(c(unlist(lapply(list(...), unclass))), tz = tz(list(...)[[1]])) } #' @method c POSIXlt c.POSIXlt <- function (..., recursive = FALSE) { as.POSIXlt(do.call("c.POSIXct", lapply(list(...), as.POSIXct))) } lubridate/R/accessors-dst.r0000644000175100001440000000123312755025406015411 0ustar hornikusers#' Get Daylight Savings Time indicator of a date-time. #' #' Date-time must be a POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, zoo, #' zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. #' #' A date-time's daylight savings flag can not be set because it depends on the #' date-time's year, month, day, and hour values. #' #' @export #' @param x a date-time object #' @return A logical. TRUE if DST is in force, FALSE if not, NA if unknown. #' @keywords utilities chron methods #' @examples #' x <- ymd("2012-03-26") #' dst(x) dst <- function(x) UseMethod("dst") #' @export dst.default <- function(x) c(NA, FALSE, TRUE)[as.POSIXlt(x)$isdst + 2] lubridate/R/constants.r0000644000175100001440000001065012765531124014653 0ustar hornikusers### Various Constants N_DAYS_IN_MONTHS <- c( Jan = 31L, Feb = 28L, Mar = 31L, Apr = 30L, May = 31L, Jun = 30L, Jul = 31L, Aug = 31L, Sep = 30L, Oct = 31L, Nov = 30L, Dec = 31L) ## lower bound included, upper excluded N_DAYS_BETWEEN_MONTHS_LOWER <- matrix(0L, 12, 12) for (i in 1:12) for (j in 1:12){ N_DAYS_BETWEEN_MONTHS_LOWER[[i, j]] <- if (i < j) sum(N_DAYS_IN_MONTHS[i:(j - 1)]) else if (j < i) sum(N_DAYS_IN_MONTHS[-(j:(i - 1))]) else 0L } ## upper bound included, lower excluded N_DAYS_BETWEEN_MONTHS_UPPER <- matrix(0L, 12, 12) for (i in 1:12) for (j in 1:12){ N_DAYS_BETWEEN_MONTHS_UPPER[[i, j]] <- if (i < j) sum(N_DAYS_IN_MONTHS[(i + 1):j]) else if (j < i) sum(N_DAYS_IN_MONTHS[-((j + 1):i)]) else 0L } lub2base_units <- list(second = "secs", minute = "mins", hour = "hours", day = "days") ### Used in guess.R ## dput(as.POSIXct(sprintf("1970-%02d-%02d %s:00:00", 1:12, c(1, 2, 3, 5), c("01", "22")), tz = "UTC")) .date_template <- structure(c(3600, 2844000, 5274000, 8200800, 10371600, 13212000, 15814800, 18741600, 20998800, 23752800, 26442000, 29282400), class = c("POSIXct", "POSIXt"), tzone = "UTC") .primes <-c(1, 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397, 401, 409, 419, 421, 431, 433, 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503, 509, 521, 523, 541 , 547, 557, 563, 569, 571, 577, 587, 593, 599, 601, 607, 613, 617, 619, 631, 641, 643, 647, 653, 659 , 661, 673, 677, 683, 691, 701, 709, 719, 727, 733, 739, 743, 751, 757, 761, 769, 773, 787, 797, 809 , 811, 821, 823, 827, 829, 839, 853, 857, 859, 863, 877, 881, 883, 887, 907, 911, 919, 929, 937, 941 , 947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013, 1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069 , 1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151, 1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223 , 1229, 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291, 1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373 , 1381, 1399, 1409, 1423, 1427, 1429, 1433, 1439, 1447, 1451, 1453, 1459, 1471, 1481, 1483, 1487, 1489, 1493, 1499, 1511 , 1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579, 1583, 1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657 , 1663, 1667, 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733, 1741, 1747, 1753, 1759, 1777, 1783, 1787, 1789, 1801, 1811 , 1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877, 1879, 1889, 1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987 , 1993, 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053, 2063, 2069, 2081, 2083, 2087, 2089, 2099, 2111, 2113, 2129 , 2131, 2137, 2141, 2143, 2153, 2161, 2179, 2203, 2207, 2213, 2221, 2237, 2239, 2243, 2251, 2267, 2269, 2273, 2281, 2287 , 2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357, 2371, 2377, 2381, 2383, 2389, 2393, 2399, 2411, 2417, 2423 , 2437, 2441, 2447, 2459, 2467, 2473, 2477, 2503, 2521, 2531, 2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593, 2609, 2617 , 2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677, 2683, 2687, 2689, 2693, 2699, 2707, 2711, 2713, 2719, 2729, 2731, 2741 , 2749, 2753, 2767, 2777, 2789, 2791, 2797, 2801, 2803, 2819, 2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887, 2897, 2903 , 2909, 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999, 3001, 3011, 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079 , 3083, 3089, 3109, 3119, 3121, 3137, 3163, 3167, 3169, 3181, 3187, 3191, 3203, 3209, 3217, 3221, 3229, 3251, 3253, 3257 , 3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331, 3343, 3347, 3359, 3361, 3371, 3373, 3389, 3391, 3407, 3413 , 3433, 3449, 3457, 3461, 3463, 3467, 3469, 3491, 3499, 3511, 3517, 3527, 3529, 3533, 3539, 3541, 3547, 3557, 3559, 3571) lubridate/R/accessors-second.r0000644000175100001440000000165412755025406016101 0ustar hornikusers#' @include periods.r NULL #' Get/set seconds component of a date-time. #' #' Date-time must be a POSIXct, POSIXlt, Date, Period, chron, yearmon, yearqtr, zoo, #' zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. #' #' @export #' @param x a date-time object #' @return the seconds element of x as a decimal number #' @keywords utilities manip chron methods #' @examples #' x <- ymd("2012-03-26") #' second(x) #' second(x) <- 1 #' second(x) <- 61 #' second(x) > 2 second <- function(x) UseMethod("second") #' @export second.default <- function(x) as.POSIXlt(x, tz = tz(x))$sec #' @export second.Period <- function(x) slot(x, ".Data") #' @rdname second #' @param value numeric value to be assigned #' @export "second<-" <- function(x, value) x <- x + seconds(value - second(x)) setGeneric("second<-") #' @export setMethod("second<-", signature("Period"), function(x, value){ slot(x, ".Data") <- value x }) lubridate/R/ops-multiplication.r0000644000175100001440000000245312755025406016475 0ustar hornikusers#' @include timespans.r #' @include durations.r #' @include intervals.r #' @include periods.r NULL multiply_duration_by_number <- function(dur, num) new("Duration", dur@.Data * num) multiply_interval_by_number <- function(int, num){ new("Interval", int@.Data * num, start = int@start, tzone = int@tzone) } multiply_period_by_number <- function(per, num){ new("Period", per@.Data * num, year = per@year * num, month = per@month * num, day = per@day * num, hour = per@hour * num, minute = per@minute * num) } #' @export setMethod("*", signature(e1 = "Timespan", e2 = "Timespan"), function(e1, e2) stop("cannot multiply time span by time span")) #' @export setMethod("*", signature(e1 = "Duration"), function(e1, e2) multiply_duration_by_number(e1, e2)) #' @export setMethod("*", signature(e2 = "Duration"), function(e1, e2) multiply_duration_by_number(e2, e1)) #' @export setMethod("*", signature(e1 = "Interval"), function(e1, e2) multiply_interval_by_number(e1, e2)) #' @export setMethod("*", signature(e2 = "Interval"), function(e1, e2) multiply_interval_by_number(e2, e1)) #' @export setMethod("*", signature(e1 = "Period"), function(e1, e2) multiply_period_by_number(e1, e2)) #' @export setMethod("*", signature(e2 = "Period"), function(e1, e2) multiply_period_by_number(e2, e1)) lubridate/R/accessors-day.r0000644000175100001440000000715512755025406015405 0ustar hornikusers#' @include periods.r NULL #' Get/set days component of a date-time. #' #' @details \code{day} and \code{day<-} are aliases for \code{mday} and \code{mday<-} respectively. #' @param x a POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, #' jul, timeSeries, or fts object. #' @param label logical. Only available for wday. TRUE will display the day of the week as an #' ordered factor of character strings, such as "Sunday." FALSE will display the day of the week as a number. #' @param abbr logical. Only available for wday. FALSE will display the day of the week as an #' ordered factor of character strings, such as "Sunday." TRUE will display an abbreviated version of the #' label, such as "Sun". abbr is disregarded if label = FALSE. #' @param value a numeric object #' @return wday returns the day of the week as a decimal number #' (01-07, Sunday is 1) or an ordered factor (Sunday is first). #' @seealso \code{\link{yday}}, \code{\link{mday}} #' @keywords utilities manip chron methods #' @examples #' x <- as.Date("2009-09-02") #' wday(x) #4 #' #' wday(ymd(080101)) #' wday(ymd(080101), label = TRUE, abbr = FALSE) #' # Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday #' wday(ymd(080101), label = TRUE, abbr = TRUE) #' # Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday #' wday(ymd(080101) + days(-2:4), label = TRUE, abbr = TRUE) #' # Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday #' #' x <- as.Date("2009-09-02") #' yday(x) #245 #' mday(x) #2 #' yday(x) <- 1 #"2009-01-01" #' yday(x) <- 366 #"2010-01-01" #' mday(x) > 3 #' @export day mday day <- function(x) UseMethod("mday") #' @rdname day #' @export mday <- day #' @rdname day #' @export wday <- function(x, label = FALSE, abbr = TRUE) UseMethod("wday") #' @export wday.default <- function(x, label = FALSE, abbr = TRUE){ wday(as.POSIXlt(x, tz = tz(x))$wday + 1, label, abbr) } #' @export wday.numeric <- function(x, label = FALSE, abbr = TRUE) { if (!label) return(x) if (abbr) { labels <- c("Sun", "Mon", "Tues", "Wed", "Thurs", "Fri", "Sat") } else { labels <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday") } ordered(x, levels = 1:7, labels = labels) } #' @export mday.default <- function(x) as.POSIXlt(x, tz = tz(x))$mday #' @export mday.Period <- function(x) slot(x, "day") #' @rdname day #' @export qday <- function(x) UseMethod("qday") #' @export qday.default <- function(x) { as.integer(x - floor_date(x, "quarter")) + 1 } #' @rdname day #' @export yday <- function(x) UseMethod("yday") #' @export yday.default <- function(x) as.POSIXlt(x, tz = tz(x))$yday + 1 #' @rdname day #' @export `day<-` <- function(x, value) standardGeneric("day<-") #' @rdname day #' @export `mday<-` <- function(x, value){ day(x) <- value x } #' @rdname day #' @export `qday<-` <- function(x, value) standardGeneric("qday<-") #' @export setGeneric("qday<-", useAsDefault = function(x, value) x <- x + days(value - qday(x))) #' @export setGeneric("day<-", useAsDefault = function(x, value) x <- x + days(value - mday(x))) #' @export setMethod("day<-", signature("Period"), function(x, value){ slot(x, "day") <- value x }) #' @rdname day #' @export "wday<-" <- function(x, value){ if (!is.numeric(value)) { value <- pmatch(tolower(value), c("sunday", "monday", "tuesday", "wednesday", "thursday", "friday", "saturday")) } x <- x + days(value - wday(x)) } #' @rdname day #' @export "yday<-" <- function(x, value) x <- x + days(value - yday(x)) lubridate/R/accessors-hour.r0000644000175100001440000000164412755025406015602 0ustar hornikusers#' @include periods.r NULL #' Get/set hours component of a date-time. #' #' Date-time must be a POSIXct, POSIXlt, Date, Period, chron, yearmon, yearqtr, zoo, #' zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. #' #' @export #' @param x a date-time object #' @keywords utilities manip chron methods #' @return the hours element of x as a decimal number #' @examples #' x <- ymd("2012-03-26") #' hour(x) #' hour(x) <- 1 #' hour(x) <- 25 #' hour(x) > 2 hour <- function(x) UseMethod("hour") #' @export hour.default <- function(x) as.POSIXlt(x, tz = tz(x))$hour #' @export hour.Period <- function(x) slot(x, "hour") #' @export #' @param value numeric value to be assigned to \code{hour} component #' @rdname hour "hour<-" <- function(x, value) x <- x + hours(value - hour(x)) setGeneric("hour<-") #' @export setMethod("hour<-", signature("Period"), function(x, value){ slot(x, "hour") <- value x }) lubridate/R/durations.r0000644000175100001440000003217212760055114014645 0ustar hornikusers#' @include timespans.r #' @include difftimes.r check_duration <- function(object){ if (is.numeric(object@.Data)) TRUE else "Duration value is not a number. Should be numeric." } #' Duration class #' #' Duration is an S4 class that extends the \code{\link{Timespan-class}} class. #' Durations record the exact number of seconds in a time span. They measure the #' exact passage of time but do not always align with measurements #' made in larger units of time such as hours, months and years. #' This is because the exact length of larger time units can be affected #' by conventions such as leap years #' and Daylight Savings Time. #' #' Durations provide a method for measuring generalized timespans when we wish to #' treat time as a mathematical quantity that increases in a uniform, monotone manner #' along a continuous numberline. They allow exact comparisons with other durations. #' See \code{\link{Period-class}} for an alternative way to measure timespans that better #' preserves clock times. #' #' Durations class objects have one slot: .Data, a numeric object equal to the number #' of seconds in the duration. #' #' @name Duration-class #' @rdname Duration-class #' @exportClass Duration setClass("Duration", contains = c("Timespan", "numeric"), validity = check_duration) #' @name hidden_aliases #' @aliases Compare,Duration,ANY-method Compare,Duration,Duration-method #' Compare,difftime,Duration-method Compare,ANY,Duration-method #' Compare,Duration,Period-method #' Compare,character,Duration-method Compare,Duration,character-method #' as.numeric,Duration-method show,Duration-method c,Duration-method #' rep,Duration-method [,Duration-method [<-,Duration,ANY,ANY,ANY-method #' [[,Duration-method [[<-,Duration,ANY,ANY,ANY-method $,Duration-method #' $<-,Duration-method as.difftime,Duration-method #' as.character,Duration-method +,Duration,Duration-method #' +,Duration,Interval-method +,Duration,Period-method +,Duration,Date-method #' +,Date,Duration-method +,Duration,difftime-method #' +,difftime,Duration-method +,Duration,numeric-method #' +,numeric,Duration-method +,Duration,POSIXct-method #' +,POSIXct,Duration-method +,Duration,POSIXlt-method #' +,POSIXlt,Duration-method -,Duration,ANY-method /,Duration,Duration-method #' /,Duration,Interval-method /,Duration,Period-method #' /,Duration,difftime-method /,difftime,Duration-method #' /,Duration,numeric-method /,numeric,Duration-method *,Duration,ANY-method #' *,ANY,Duration-method %%,Duration,Duration-method #' %%,Duration,Interval-method %%,Duration,Period-method #' -,Duration,missing-method -,ANY,Duration-method NULL SECONDS_IN_ONE <- c( second = 1, minute = 60, hour = 3600, day = 86400, week = 604800, year = 31557600) .readable_duration <- function(x, unit){ if(unit == "second") paste0(x, "s") else { x2 <- round(x / SECONDS_IN_ONE[[unit]], 2) sprintf("%ds (~%s %ss)", x, x2, unit, "s)") } } .next_unit <- structure(as.list(c(names(SECONDS_IN_ONE[-1]), list(NULL))), names = names(SECONDS_IN_ONE)) compute_estimate <- function (secs, unit = "second") { next_unit <- .next_unit[[unit]] if(is.null(next_unit)) return(.readable_duration(secs, "year")) out <- character(length(secs)) tt <- secs < SECONDS_IN_ONE[[next_unit]] if(any(tt)) out[tt] <- .readable_duration(secs[tt], unit) wnext <- which(!tt) out[wnext] <- compute_estimate(secs[wnext], next_unit) out } #' @export setMethod("show", signature(object = "Duration"), function(object){ print(format.Duration(object), quote = TRUE) }) #' @export format.Duration <- function(x, ...) { if (length(x@.Data) == 0) return("Duration(0)") out <- vector("character", length(x@.Data)) nnas <- !is.na(x@.Data) out[nnas] <- compute_estimate(abs(x@.Data[nnas])) out[!nnas] <- NA out } #' @export setMethod("c", signature(x = "Duration"), function(x, ...){ durs <- c(x@.Data, unlist(list(...))) new("Duration", durs) }) #' @export setMethod("rep", signature(x = "Duration"), function(x, ...){ new("Duration", rep(as.numeric(x), ...)) }) #' @export setMethod("[", signature(x = "Duration"), function(x, i, j, ..., drop = TRUE) { new("Duration", x@.Data[i]) }) #' @export setMethod("[[", signature(x = "Duration"), function(x, i, j, ..., exact = TRUE) { new("Duration", x@.Data[i]) }) #' @export setMethod("[<-", signature(x = "Duration"), function(x, i, j, ..., value) { x@.Data[i] <- value new("Duration", x@.Data) }) #' @export setMethod("[[<-", signature(x = "Duration"), function(x, i, j, ..., value) { x@.Data[i] <- as.numeric(value) new("Duration", x@.Data) }) #' Create a duration object. #' #' \code{duration} creates a duration object with the specified values. Entries #' for different units are cumulative. durations display as the number of #' seconds in a time span. When this number is large, durations also display an #' estimate in larger units,; however, the underlying object is always recorded #' as a fixed number of seconds. For display and creation purposes, units are #' converted to seconds using their most common lengths in seconds. Minutes = 60 #' seconds, hours = 3600 seconds, days = 86400 seconds, weeks = 604800. Units #' larger than weeks are not used due to their variability. #' #' Durations record the exact number of seconds in a time span. They measure the #' exact passage of time but do not always align with measurements #' made in larger units of time such as hours, months and years. #' This is because the length of larger time units can be affected #' by conventions such as leap years #' and Daylight Savings Time. Base R provides a second class for measuring #' durations, the difftime class. #' #' Duration objects can be easily created with the helper functions #' \code{\link{dweeks}}, \code{\link{ddays}}, \code{\link{dminutes}}, #' \code{\link{dseconds}}. These objects can be added to and subtracted to date- #' times to create a user interface similar to object oriented programming. #' #' @param num the number of time units to include in the duration. From v1.6.0 #' \code{num} can also be a character vector that specifies durations in a #' convenient shorthand format. All unambiguous name units and abbreviations #' are supported. See examples. #' @param units a character string that specifies the type of units that num #' refers to. When \code{num} is character, this argument is ignored. #' @param ... a list of time units to be included in the duration and their #' amounts. Seconds, minutes, hours, days, and weeks are supported. #' @return a duration object #' @seealso \code{\link{as.duration}} #' @keywords chron classes #' @examples #' duration(day = -1) #' # -86400s (~-1 days) #' duration(90, "seconds") #' duration(1.5, "minutes") #' duration(-1, "days") #' # -86400s (~-1 days) #' duration(second = 90) #' duration(minute = 1.5) #' duration(mins = 1.5) #' duration(second = 3, minute = 1.5, hour = 2, day = 6, week = 1) #' duration(hour = 1, minute = -60) #' duration("2M 1sec") #' duration("2hours 2minutes 1second") #' duration("2d 2H 2M 2S") #' duration("2days 2hours 2mins 2secs") #' # Missing numerals default to 1. Repeated units are added up. #' duration("day day") #' # Comparison with characters is supported from v1.6.0. #' duration("day 2 sec") > "day 1sec" #' @export duration <- function(num = NULL, units = "seconds", ...){ nums <- list(...) if(is.character(num)){ as.duration(parse_period(num)) } else if(!is.null(num) && length(nums) > 0){ c(.duration_from_num(num, units), .duration_from_units(nums)) } else if(!is.null(num)){ .duration_from_num(num, units) } else if(length(nums)){ .duration_from_units(nums) } else { stop("No valid values have been passed to 'duration' constructor") } } .duration_from_num <- function(num, units){ if(!is.numeric(num)){ stop(sprintf("First argument to `duration` constructor must be character or numeric. Supplied object of class '%s'", class(num))) } ## qucik check for common wrongdoings: https://github.com/hadley/lubridate/issues/462 if(class(num)[[1]] %in% c("Interval", "Period")) stop("Interval or Period objects cannot be used as input to 'period' constructor. Plese use 'as.duration'.") unit <- standardise_date_names(units) mult <- c(second = 1, minute = 60, hour = 3600, mday = 86400, wday = 86400, yday =86400, day = 86400, week = 604800, month = 60 * 60 * 24 * 365 / 12, year = 60 * 60 * 24 * 365) new("Duration", num * unname(mult[unit])) } .duration_from_units <- function(pieces){ names(pieces) <- standardise_difftime_names(names(pieces)) defaults <- list(secs = 0, mins = 0, hours = 0, days = 0, weeks = 0) pieces <- c(pieces, defaults[setdiff(names(defaults), names(pieces))]) x <- pieces$secs + pieces$mins * 60 + pieces$hours * 3600 + pieces$days * 86400 + pieces$weeks * 604800 new("Duration", x) } #' Quickly create duration objects. #' #' Quickly create Duration objects for easy date-time manipulation. The units of #' the duration created depend on the name of the function called. For Duration #' objects, units are equal to their most common lengths in seconds (i.e. #' minutes = 60 seconds, hours = 3600 seconds, days = 86400 seconds, weeks = #' 604800, years = 31536000). #' #' When paired with date-times, these functions allow date-times to be #' manipulated in a method similar to object oriented programming. Duration #' objects can be added to Date, POSIXt, and Interval objects. #' #' Since version 1.4.0 the following functions are deprecated: \code{eseconds}, #' \code{eminutes}, \code{ehours}, \code{edays}, \code{eweeks}, \code{eyears}, #' \code{emilliseconds}, \code{emicroseconds}, \code{enanoseconds}, #' \code{epicoseconds} #' #' @name quick_durations #' @param x numeric value of the number of units to be contained in the duration. #' @return a duration object #' @seealso \code{\link{duration}}, \code{\link{days}} #' @keywords chron manip #' @examples #' dseconds(1) #' dminutes(3.5) #' #' x <- as.POSIXct("2009-08-03") #' x + ddays(1) + dhours(6) + dminutes(30) #' x + ddays(100) - dhours(8) #' #' class(as.Date("2009-08-09") + ddays(1)) # retains Date class #' as.Date("2009-08-09") + dhours(12) #' class(as.Date("2009-08-09") + dhours(12)) #' # converts to POSIXt class to accomodate time units #' #' dweeks(1) - ddays(7) #' c(1:3) * dhours(1) #' # #' # compare DST handling to durations #' boundary <- as.POSIXct("2009-03-08 01:59:59") #' boundary + days(1) # period #' boundary + ddays(1) # duration #' @export dseconds dminutes dhours ddays dweeks dyears dmilliseconds dmicroseconds dnanoseconds dpicoseconds dseconds <- function(x = 1) new("Duration", x) #' @rdname quick_durations dminutes <- function(x = 1) new("Duration", x * 60) #' @rdname quick_durations dhours <- function(x = 1) new("Duration", x * 3600) #' @rdname quick_durations ddays <- function(x = 1) new("Duration", x * 86400) #' @rdname quick_durations dweeks <- function(x = 1) new("Duration", x * 604800) #' @rdname quick_durations dyears <- function(x = 1) new("Duration", x * 60 * 60 * 24 * 365) #' @rdname quick_durations dmilliseconds <- function(x = 1) new("Duration", x / 1000) #' @rdname quick_durations dmicroseconds <- function(x = 1) new("Duration", x / 1000 / 1000) #' @rdname quick_durations dnanoseconds <- function(x = 1) new("Duration", x / 1000 / 1000 / 1000) #' @rdname quick_durations dpicoseconds <- function(x = 1) new("Duration", x / 1000 / 1000 / 1000 / 1000) #' @rdname duration #' @param x an R object #' @export #' @examples #' is.duration(as.Date("2009-08-03")) # FALSE #' is.duration(duration(days = 12.4)) # TRUE is.duration <- function(x) is(x, "Duration") #' @export summary.Duration <- function(object, ...) { nas <- is.na(object) object <- object[!nas] nums <- as.numeric(object) qq <- stats::quantile(nums) qq <- c(qq[1L:3L], mean(nums), qq[4L:5L]) qq <- dseconds(qq) qq <- as.character(qq) names(qq) <- c("Min.", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max.") if (any(nas)) c(qq, `NA's` = sum(nas)) else qq } #' @export setMethod("Compare", c(e1 = "Duration", e2 = "ANY"), function(e1, e2){ stop(sprintf("Incompatible duration classes (%s, %s). Please coerce with `as.duration`.", class(e1), class(e2)), call. = FALSE) }) #' @export setMethod("Compare", c(e1 = "ANY", e2 = "Duration"), function(e1, e2){ stop(sprintf("Incompatible duration classes (%s, %s). Please coerce with `as.duration`.", class(e1), class(e2)), call. = FALSE) }) #' @export setMethod("Compare", signature(e1 = "Duration", e2 = "character"), function(e1, e2) { callGeneric(e1, as.duration(e2)) }) #' @export setMethod("Compare", signature(e1 = "character", e2 = "Duration"), function(e1, e2) { callGeneric(as.duration(e1), e2) }) #' @export setMethod("Compare", c(e1 = "difftime", e2 = "Duration"), function(e1, e2){ callGeneric(as.numeric(e1, "secs"), as.numeric(e2, "secs")) }) #' @export setMethod("Compare", c(e1 = "Duration", e2 = "Duration"), function(e1, e2){ callGeneric(e1@.Data, e2@.Data) }) lubridate/R/stamp.r0000644000175100001440000001560212755063202013761 0ustar hornikusers##' Format dates and times based on human-friendly templates. ##' ##' Stamps are just like \code{\link{format}}, but based on human-frendly ##' templates like "Recorded at 10 am, September 2002" or "Meeting, Sunday May ##' 1, 2000, at 10:20 pm". ##' ##' \code{stamp} is a stamping function date-time templates mainly, though it ##' correctly handles all date and time formats as long as they are ##' unambiguous. \code{stamp_date}, and \code{stamp_time} are the specialized ##' stamps for dates and times (MHS). These function might be useful when the ##' input template is unambiguous and matches both a time and a date format. ##' ##' Lubridate tries it's best to figure our the formats, but often a given ##' format can be interpreted in several ways. One way to deal with the ##' situation is to provide unambiguous formats like 22/05/81 instead of ##' 10/05/81 if you want d/m/y format. Another option is to use a more ##' specialized stamp_date and stamp_time. The core function \code{stamp} give ##' priority to longer date-time formats. ##' ##' Another option is to proved a vector of several values as \code{x} ##' parameter. Then lubridate will choose the format which fits \code{x} the ##' best. Note that longer formats are preferred. If you have "22:23:00 PM" then ##' "HMSp" format will be given priority to shorter "HMS" order which also fits ##' the supplied string. ##' ##' Finally, you can give desired format order directly as \code{orders} ##' argument. ##' ##' @param x a character vector of templates. ##' @param orders orders are sequences of formatting characters which might be ##' used for disambiguation. For example "ymd hms", "aym" etc. See ##' \code{\link{guess_formats}} for a list of available formats. ##' @param locale locale in which \code{x} is encoded. On linux like systems use ##' \code{locale -a} in terminal to list available locales. ##' @param quiet whether to output informative messages. ##' @return a function to be applied on a vector of dates ##' @seealso \link{guess_formats}, \link{parse_date_time}, \link{strptime} ##' @export ##' @examples ##' D <- ymd("2010-04-05") - days(1:5) ##' stamp("March 1, 1999")(D) ##' sf <- stamp("Created on Sunday, Jan 1, 1999 3:34 pm") ##' sf(D) ##' stamp("Jan 01")(D) ##' stamp("Sunday, May 1, 2000", locale = "en_US")(D) ##' stamp("Sun Aug 5")(D) #=> "Sun Aug 04" "Sat Aug 04" "Fri Aug 04" "Thu Aug 04" "Wed Aug 03" ##' stamp("12/31/99")(D) #=> "06/09/11" ##' stamp("Sunday, May 1, 2000 22:10", locale = "en_US")(D) ##' stamp("2013-01-01T06:00:00Z")(D) ##' stamp("2013-01-01T00:00:00-06")(D) ##' stamp("2013-01-01T00:00:00-08:00")(force_tz(D, "America/Chicago")) stamp <- function(x, orders = lubridate_formats, locale = Sys.getlocale("LC_TIME"), quiet = FALSE){ fmts <- unique(guess_formats(x, orders, locale)) if( is.null(fmts) ) stop( "Couldn't guess formats of: ", x) if( length(fmts) == 1L ){ FMT <- fmts[[1]] }else{ trained <- .train_formats(x, fmts) formats <- .select_formats(trained) FMT <- formats[[1]] if( !quiet && length(trained) > 1 ) { message("Multiple formats matched: ", paste("\"", names(trained),"\"(", trained, ")", sep = "", collapse= ", ")) } } if( !quiet ) message("Using: \"", FMT, "\"") ## ISO8601 ## %Ou: "2013-04-16T04:59:59Z" ## %Oo: "2013-04-16T04:59:59+01" ## %Oz: "2013-04-16T04:59:59+0100" ## %OO: "2013-04-16T04:59:59+01:00" ## Is a timezone format? if( grepl("%O[oOzu]|%z", FMT) ){ ## We need to post-process x in the case of %Oo, %OO and %Oz formats ## because standard %z output format ignores timezone. ## Post-process only when at the end of the string, otherwise don't bother ## and just output with %z format after a conversion to UTC. oOz_end <- str_extract(FMT, "%O[oOz]$") if(is.na(oOz_end)){ FMT <- sub("%O[oOz]", "%z", sub("%Ou", "Z", FMT, fixed = TRUE)) eval(bquote( function(x){ ## %z ignores timezone if(tz(x[[1]]) != "UTC") x <- with_tz(x, tzone = "UTC") format(x, format = .(FMT)) })) } else { FMT <- sub("%O[oOz]$", "", FMT) eval(bquote( function(x) paste0(format(x, format = .(FMT)), .format_offset(x, fmt = .(oOz_end))))) } } else { ## most common case eval(bquote(function(x) format(x, format = .(FMT)))) } } .format_offset <- function(x, fmt="%Oz"){ ## .format_offset ## ## function to format the offset of a time from UTC ## ## This is an internal function, used in conjunction with \code{\link{stamp}}. ## There are three available formats: ## ## \itemize{ ## \item \code{\%Oo} +01 ## \item \code{\%Oz} +0100 ## \item \code{\%OO} +01:00 ## } ## ## If the \code{\%Oo} format is used for a half-hour timezone, a warning ## is issued, and the format is changed to \code{\%Oz} ## ## @param x POSIXct for which offset-string is sought ## @param fmt string describing format of offset, default: \code{\%Oz} ## ## @return string ## ## "%Oo" +01 ## "%Oz" +0100 ## "%OO" +01:00 ## calulate offset by forcing this time as utc dtm_utc <- force_tz(x, tzone = "UTC") ## the offset is the duration represented by the difference in time offset_duration = as.duration(dtm_utc - x) ## determine sign .sgn <- ifelse(offset_duration >= as.duration(0), "+", "-") ## remove sign offset_duration <- abs(offset_duration) ## determine hour .hr <- floor(offset_duration/dhours(1)) ## determine minutes .min <- floor((offset_duration-dhours(.hr))/dminutes(1)) ## warning if we need minutes, but are using format without minutes if (any(.min > 0) & fmt=="%Oo"){ warning("timezone offset-minutes are non-zero - changing format to %Oz") fmt <- "%Oz" } result <- switch( fmt, "%Oo" = sprintf("%s%02d", .sgn, .hr), "%Oz" = sprintf("%s%02d%02d", .sgn, .hr, .min), "%OO" = sprintf("%s%02d:%02d", .sgn, .hr, .min) ) return(result) } ##' @rdname stamp ##' @export stamp_date <- function(x, locale = Sys.getlocale("LC_TIME")) stamp(x, orders = c("ymd", "dmy", "mdy", "ydm", "dym", "myd", "my", "ym", "md", "dm", "m", "d", "y"), locale = locale) ##' @rdname stamp ##' @export stamp_time <- function(x, locale = Sys.getlocale("LC_TIME")) stamp(x, orders = c("hms", "hm", "ms", "h", "m", "s"), locale = locale) lubridate_formats <- local({ xxx <- c( "ymd", "ydm", "mdy", "myd", "dmy", "dym") names(xxx) <- xxx out <- character() for(D in xxx){ out[[paste(D, "_hms", sep = "")]] <- paste(xxx[[D]], "T", sep = "") out[[paste(D, "_hm", sep = "")]] <- paste(xxx[[D]], "R", sep = "") out[[paste(D, "_h", sep = "")]] <- paste(xxx[[D]], "r", sep = "") } out <- c(out, xxx, my = "my", ym = "ym", md = "md", dm = "dm", hms = "T", hm = "R", ms = "MS", h = "r", m = "m", y = "y") ## adding ISO8601 out <- c(ymd_hmsz="ymdTz", out) out }) lubridate/R/accessors-minute.r0000644000175100001440000000165512755540320016125 0ustar hornikusers#' @include periods.r NULL #' Get/set minutes component of a date-time. #' #' Date-time must be a POSIXct, POSIXlt, Date, Period, chron, yearmon, yearqtr, zoo, #' zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. #' #' @export #' @param x a date-time object #' @keywords utilities manip chron methods #' @return the minutes element of x as a decimal number #' @examples #' x <- ymd("2012-03-26") #' minute(x) #' minute(x) <- 1 #' minute(x) <- 61 #' minute(x) > 2 minute <- function(x) UseMethod("minute") #' @export minute.default <- function(x) as.POSIXlt(x, tz = tz(x))$min #' @export minute.Period <- function(x) slot(x, "minute") #' @rdname minute #' @param value numeric value to be assigned #' @export "minute<-" <- function(x, value) x <- x + minutes(value - minute(x)) setGeneric("minute<-") #' @export setMethod("minute<-", signature("Period"), function(x, value){ slot(x, "minute") <- value x }) lubridate/R/Dates.r0000644000175100001440000000061612755025406013700 0ustar hornikuserssetOldClass("Date") #' Is x a Date object? #' #' @export is.Date #' @param x an R object #' @return TRUE if x is a Date object, FALSE otherwise. #' @seealso \code{\link{is.instant}}, \code{\link{is.timespan}}, \code{\link{is.POSIXt}} #' @keywords logic chron #' @examples #' is.Date(as.Date("2009-08-03")) # TRUE #' is.Date(difftime(now() + 5, now())) # FALSE is.Date <- function(x) is(x, "Date") lubridate/R/coercion.r0000644000175100001440000005317012757714514014453 0ustar hornikusers#' @include timespans.r #' @include durations.r #' @include intervals.r #' @include periods.r #' @include Dates.r #' @include difftimes.r #' @include numeric.r #' @include POSIXt.r #' @include time-zones.r NULL #' Convert a variety of date-time classes to POSIXlt and POSIXct #' @name DateCoercion #' @keywords internal #' NULL #' @export as.POSIXct.fts <- function(x, tz = "", ...) as.POSIXct(zoo::index(x)) #' @export as.POSIXlt.fts <- function(x, tz = "", ...) as.POSIXlt(zoo::index(x)) #' @export as.POSIXlt.its <- function(x, tz = "", ...) as.POSIXlt(attr(x, "dates")) #' @export as.POSIXct.its <- function(x, tz = "", ...) as.POSIXct(attr(x, "dates")) #' @export as.POSIXlt.timeSeries <- function(x, tz = "", ...) { as.POSIXlt(timeDate::timeDate(x@positions, zone = x@FinCenter, FinCenter = x@FinCenter)) } #' @export as.POSIXct.timeSeries <- function(x, tz = "", ...) { as.POSIXct(timeDate::timeDate(x@positions, zone = x@FinCenter, FinCenter = x@FinCenter)) } #' @export as.POSIXlt.irts <- function(x, tz = "", ...) as.POSIXlt(x$time) #' @export as.POSIXct.irts <- function(x, tz = "", ...) as.POSIXct(x$time) #' @export as.POSIXlt.xts <- function(x, tz = "", ...) as.POSIXlt(zoo::index(x)) #' @export as.POSIXct.xts <- function(x, tz = "", ...) as.POSIXct(zoo::index(x)) #' @export as.POSIXlt.zoo <- function(x, tz = "", ...) as.POSIXlt(zoo::index(x)) #' @export as.POSIXct.zoo <- function(x, tz = "", ...) as.POSIXct(zoo::index(x)) #' @export as.POSIXlt.tis <- function(x, tz = "", ...) as.Date(x) #' Convenience method to reclass dates post-modification. #' @keywords internal #' #' @export reclass_date <- function(new, orig) UseMethod("reclass_date", orig) #' @export reclass_date.POSIXlt <- function(new, orig) { as.POSIXlt(new) } #' @export reclass_date.POSIXct <- function(new, orig) { as.POSIXct(new) } #' @export reclass_date.chron <- function(new, orig) { chron::as.chron(new) } #' @export reclass_date.timeDate <- function(new, orig) { timeDate::as.timeDate(new) } #' @export reclass_date.its <- function(new, orig) { its::its(new, format = "%Y-%m-%d %X") } #' @export reclass_date.ti <- function(new, orig) { tis::as.ti(new, tis::tifName(orig)) } #' @export reclass_date.Date <- function(new, orig) { as.Date(new) } period_to_difftime <- function(per){ as.difftime(per) } #' Convenience method to reclass timespans post-modification. #' @keywords internal #' #' @aliases reclass_timespan,ANY,Duration-method reclass_timespan,ANY,Interval-method #' reclass_timespan,ANY,Period-method reclass_timespan,ANY,difftime-method #' @export reclass_timespan <- function(new, orig) standardGeneric("reclass_timespan") #' @export setGeneric("reclass_timespan") #' @export setMethod("reclass_timespan", signature(orig = "difftime"), function(new, orig){ if (is.period(new)) as.difftime(new) else make_difftime(as.numeric(new)) }) #' @export setMethod("reclass_timespan", signature(orig = "Duration"), function(new, orig){ as.duration(new) }) #' @export setMethod("reclass_timespan", signature(orig = "Interval"), function(new, orig){ as.duration(new) }) #' @export setMethod("reclass_timespan", signature(orig = "Period"), function(new, orig){ as.period(new) }) #' Change an object to a duration. #' #' as.duration changes Interval, Period and numeric class objects to #' Duration objects. Numeric objects are changed to Duration objects #' with the seconds unit equal to the numeric value. #' #' Durations are exact time measurements, whereas periods are relative time #' measurements. See \code{\link{Period-class}}. The length of a period depends #' on when it occurs. Hence, a one to one mapping does not exist between #' durations and periods. When used with a period object, as.duration provides #' an inexact estimate of the length of the period; each time unit is assigned #' its most common number of seconds. A period of one month is converted to #' 2628000 seconds (approximately 30.42 days). This ensures that 12 months will #' sum to 365 days, or one normal year. For an exact transformation, first #' transform the period to an interval with \code{\link{as.interval}}. #' #' @param x Object to be coerced to a duration #' @param ... Parameters passed to other methods. Currently unused. #' @return A duration object #' @seealso \code{\link{Duration-class}}, \code{\link{duration}} #' @keywords classes manip methods chron #' @examples #' span <- interval(ymd("2009-01-01"), ymd("2009-08-01")) #interval #' as.duration(span) #' as.duration(10) # numeric #' dur <- duration(hours = 10, minutes = 6) #' as.numeric(dur, "hours") #' as.numeric(dur, "minutes") #' #' @aliases as.duration,numeric-method as.duration,logical-method #' as.duration,difftime-method as.duration,Interval-method #' as.duration,Duration-method as.duration,Period-method #' as.duration,character-method #' @export setGeneric("as.duration", function(x, ...) standardGeneric("as.duration"), useAsDefault = function(x, ...){ stop(sprintf("as.duration is not defined for class '%s'", class(x))) }) setMethod("as.duration", signature(x = "character"), function(x){ as.duration(as.period(x)) }) setMethod("as.duration", signature(x = "numeric"), function(x){ new("Duration", x) }) setMethod("as.duration", signature(x = "logical"), function(x){ new("Duration", as.numeric(x)) }) setMethod("as.duration", signature(x = "difftime"), function(x){ new("Duration", as.numeric(x, "secs")) }) setMethod("as.duration", signature(x = "Interval"), function(x){ new("Duration", x@.Data) }) setMethod("as.duration", signature(x = "Duration"), function(x){ x }) setMethod("as.duration", signature(x = "Period"), function(x){ new("Duration", period_to_seconds(x)) }) #' Change an object to an \code{interval}. #' #' as.interval changes difftime, Duration, Period and numeric class objects to #' intervals that begin at the specified date-time. Numeric objects are first #' coerced to timespans equal to the numeric value in seconds. #' #' as.interval can be used to create accurate transformations between Period #' objects, which measure time spans in variable length units, and Duration objects, #' which measure timespans as an exact number of seconds. A start date- #' time must be supplied to make the conversion. Lubridate uses #' this start date to look up how many seconds each variable #' length unit (e.g. month, year) lasted for during the time span #' described. See #' \code{\link{as.duration}}, \code{\link{as.period}}. #' #' @param x a duration, difftime, period, or numeric object that describes the length of the interval #' @param start a POSIXt or Date object that describes when the interval begins #' @param ... additional arguments to pass to as.interval #' @return an interval object #' @seealso \code{\link{interval}} #' @keywords classes manip methods chron #' @examples #' diff <- make_difftime(days = 31) #difftime #' as.interval(diff, ymd("2009-01-01")) #' as.interval(diff, ymd("2009-02-01")) #' #' dur <- duration(days = 31) #duration #' as.interval(dur, ymd("2009-01-01")) #' as.interval(dur, ymd("2009-02-01")) #' #' per <- period(months = 1) #period #' as.interval(per, ymd("2009-01-01")) #' as.interval(per, ymd("2009-02-01")) #' #' as.interval(3600, ymd("2009-01-01")) #numeric #' @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 #' @export as.interval <- function(x, start, ...) standardGeneric("as.interval") #' @export setGeneric("as.interval") setMethod("as.interval", signature(x = "numeric"), function(x, start, ...){ .number_to_interval(x, start, ...) }) setMethod("as.interval", signature(x = "difftime"), function(x, start, ...){ .number_to_interval(x, start, ...) }) setMethod("as.interval", signature(x = "Interval"), function(x, start, ...) { x }) setMethod("as.interval", signature(x = "POSIXt"), function(x, start, ...) { .number_to_interval(x, start, ...) }) #' @export setMethod("as.interval", signature("logical"), function(x, start, ...) { .number_to_interval(as.numeric(x), start, ...) }) .number_to_interval <- function(x, start, ...){ if (missing(start) & all(is.na(x))) start <- as.POSIXct(NA, origin = origin) else stopifnot(is.instant(start)) if (is.instant(x)) return(interval(x, start)) else interval(start, start + x) } #' Change an object to a period. #' #' as.period changes Interval, Duration, difftime and numeric class objects #' to Period class objects with the specified units. #' #' Users must specify which time units to measure the period in. The exact length of #' each time unit in a period will depend on when it occurs. See #' \code{\link{Period-class}} and \code{\link{period}}. #' The choice of units is not trivial; units that are #' normally equal may differ in length depending on when the time period #' occurs. For example, when a leap second occurs one minute is longer than 60 #' seconds. #' #' Because periods do not have a fixed length, they can not be accurately #' converted to and from Duration objects. Duration objects measure time spans #' in exact numbers of seconds, see \code{\link{Duration-class}}. Hence, a one to one #' mapping does not exist between durations and periods. When used with a #' Duration object, as.period provides an inexact estimate; the duration is #' broken into time units based on the most common lengths of time units, in #' seconds. Because the length of months are particularly variable, a period #' with a months unit can not be coerced from a duration object. For an exact #' transformation, first transform the duration to an interval with #' \code{\link{as.interval}}. #' #' Coercing an interval to a period may cause surprising behavior if you request #' periods with small units. A leap year is 366 days long, but one year long. Such #' an interval will convert to 366 days when unit is set to days and 1 year when #' unit is set to years. Adding 366 days to a date will often give a different #' result than adding one year. Daylight savings is the one exception where this #' does not apply. Interval lengths are calculated on the UTC timeline, which does #' not use daylight savings. Hence, periods converted with seconds or minutes will not #' reflect the actual variation in seconds and minutes that occurs due to daylight #' savings. These periods will show the "naive" change in seconds and minutes that is #' suggested by the differences in clock time. See the examples below. #' #' @param x an interval, difftime, or numeric object #' @param unit A character string that specifies which time units to build period in. #' unit is only implemented for the as.period.numeric method and the as.period.interval method. #' For as.period.interval, as.period will convert intervals to units no larger than the specified #' unit. #' @param ... additional arguments to pass to as.period #' @return a period object #' @seealso \code{\link{Period-class}}, \code{\link{period}} #' @keywords classes manip methods chron #' @examples #' span <- interval(as.POSIXct("2009-01-01"), as.POSIXct("2010-02-02 01:01:01")) #interval #' as.period(span) #' as.period(span, units = "day") #' "397d 1H 1M 1S" #' leap <- interval(ymd("2016-01-01"), ymd("2017-01-01")) #' as.period(leap, unit = "days") #' as.period(leap, unit = "years") #' dst <- interval(ymd("2016-11-06", tz = "America/Chicago"), #' ymd("2016-11-07", tz = "America/Chicago")) #' # as.period(dst, unit = "seconds") #' as.period(dst, unit = "hours") #' per <- period(hours = 10, minutes = 6) #' as.numeric(per, "hours") #' as.numeric(per, "minutes") #' #' @aliases as.period,numeric-method as.period,difftime-method #' as.period,Interval-method as.period,Duration-method as.period,Period-method #' as.period,logical-method as.period,character-method #' @export setGeneric("as.period", function(x, unit, ...) standardGeneric("as.period"), useAsDefault = function(x, unit, ...){ stop(sprintf("as.period is not defined for class '%s'", class(x))) }) setMethod("as.period", signature(x = "character"), function(x, ...){ parse_period(x) }) setMethod("as.period", signature(x = "numeric"), function(x, unit = "second", ...){ x <- as.numeric(x) if (missing(unit)) unit <- "second" unit <- standardise_date_names(unit) f <- match.fun(paste(unit, "s", sep = "")) f(x) }) setMethod("as.period", signature(x = "difftime"), function(x, unit = NULL, ...){ seconds_to_period(as.double(x, "secs")) }) setMethod("as.period", signature(x = "Interval"), function(x, unit = NULL, ...) { ## fixme: document this in the manual ## SEMANTICS: for postitive intervals all units of the period will be ## positive, and the oposite for negatve intervals. ## Periods are not symetric in the sense that as.period(int) might not be the ## same as -as.period(int_flip(int)). See ## https://github.com/hadley/lubridate/issues/285 for motivation. unit <- if (missing(unit)) "year" else standardise_period_names(unit) switch(unit, year = .int_to_period(x), month = { pers <- .int_to_period(x) month(pers) <- month(pers) + year(pers)*12L year(pers) <- 0L pers }, ## fixme: add note to the docs that unit <= days results in much faster conversion ## fixme: add week day = , hour = , minute = , second = { secs <- x@.Data negs <- secs < 0 & !is.na(secs) units <- .units_within_seconds(abs(secs), unit) pers <- do.call("new", c("Period", units)) pers[negs] <- -pers[negs] pers }, stop("Unsuported unit ", unit)) }) .int_to_period <- function(x){ ## this function is called only for conversion with units > day start <- as.POSIXlt(x@start) end <- as.POSIXlt(start + x@.Data) negs <- x@.Data < 0 & !is.na(x@.Data) per <- list() for(nm in c("sec", "min", "hour", "mday", "mon", "year")){ per[[nm]] <- ifelse(negs, start[[nm]] - end[[nm]], end[[nm]] - start[[nm]]) } names(per) <- c("second", "minute", "hour", "day", "month", "year") ## Remove negative ... ## secons nsecs <- per$second < 0L & !is.na(per$second) per$second[nsecs] <- 60L + per$second[nsecs] per$minute[nsecs] <- per$minute[nsecs] - 1L per$second[negs] <- -per$second[negs] ## minutes nmins <- per$minute < 0L & !is.na(per$minute) per$minute[nmins] <- 60L + per$minute[nmins] per$hour[nmins] <- per$hour[nmins] - 1L per$minute[negs] <- -per$minute[negs] ## hours nhous <- per$hour < 0L & !is.na(per$hour) per$hour[nhous] <- 24L + per$hour[nhous] per$hour[negs] <- -per$hour[negs] ## days ### postivie periods ndays <- !negs & per$day < 0 & !is.na(per$day) if (any(ndays)) { ## compute nr days in previous month add_months <- rep.int(-1L, sum(ndays)) pmonth <- end$mon[ndays] pmonth[pmonth == 0L] <- 1L #dec == jan == 31 days prev_month_days <- .days_in_month(pmonth, end$year[ndays]) ## difference in days: ## /need pmax to capture as.period(interval(ymd("1985-01-31"), ymd("1986-03-28")))/ per$day[ndays] <- pmax(prev_month_days - start$mday[ndays], 0) + end$mday[ndays] per$month[ndays] <- per$month[ndays] + add_months } ## negative periods ndays <- negs & per$day < 0 & !is.na(per$day) if (any(ndays)) { add_months <- rep.int(1L, sum(ndays)) this_month_days <- .days_in_month(end$mon[ndays] + 1L, end$year[ndays]) ## Compute nr of days: ## /need pmax to capture as.period(interval(ymd("1985-01-31"), ymd("1986-03-28")))/ per$day[ndays] <- pmax(this_month_days - end$mday[ndays], 0) + start$mday[ndays] per$month[ndays] <- per$month[ndays] - add_months } ## substract only after the day computation to capture intervals like: ## as.period(interval(ymd_hms("1985-12-31 5:0:0"), ymd_hms("1986-02-01 3:0:0"))) per$day[nhous] <- per$day[nhous] - 1L per$day[negs] <- -per$day[negs] ## months nmons <- per$month < 0L & !is.na(per$month) per$month[nmons] <- 12L + per$month[nmons] per$year[nmons] <- per$year[nmons] - 1L per$month[negs] <- -per$month[negs] per$year[negs] <- -per$year[negs] new("Period", per$second, year = per$year, month = per$month, day = per$day, hour = per$hour, minute = per$minute) } setMethod("as.period", signature(x = "Duration"), function(x, unit = NULL, ...) { span <- x@.Data remainder <- abs(span) newper <- period(second = rep(0, length(x))) slot(newper, "year") <- remainder %/% (3600 * 24 * 365) remainder <- remainder %% (3600 * 24 * 365) slot(newper, "day") <- remainder %/% (3600 * 24) remainder <- remainder %% (3600 * 24) slot(newper, "hour") <- remainder %/% (3600) remainder <- remainder %% (3600) slot(newper, "minute") <- remainder %/% (60) newper$second <- remainder %% (60) newper * sign(span) }) setMethod("as.period", signature("Period"), function(x, unit = NULL, ...){ if (missing(unit) || is.null(unit)) { x } else { unit <- standardise_period_names(unit) switch(unit, year = x, month = { month(x) <- month(x) + year(x)*12L year(x) <- 0L x }, day = , hour = , minute = , second = { N <- .units_within_seconds(period_to_seconds(x), unit) do.call("new", c("Period", N)) }, stop("Unsuported unit ", unit)) } }) setMethod("as.period", signature("logical"), function(x, unit = NULL, ...) { as.period(as.numeric(x), unit, ...) }) #' @export setGeneric("as.difftime") #' @export setMethod("as.difftime", signature(tim = "Interval"), function(tim, format = "%X", units = "secs"){ as.difftime(as.numeric(tim, units), format, units) }) #' @export setMethod("as.difftime", signature(tim = "Duration"), function(tim, format = "%X", units = "secs"){ as.difftime(tim@.Data, format, units) }) #' @export setMethod("as.difftime", signature(tim = "Period"), function(tim, format = "%X", units = "secs"){ as.difftime(period_to_seconds(tim), format, units) }) setGeneric("as.numeric") seconds_to_unit <- function(secs, unit = "second"){ switch(unit, second = secs, minute = secs / 60, hour = secs / 3600, day = secs / 86400, month = secs / (86400 * 365.25)/12, week = secs / (86400 * 7), year = secs / (86400 * 365.25), stop("invalid unit ", unit)) } #' @export setMethod("as.numeric", signature("Duration"), function(x, units = "secs", ...){ unit <- standardise_period_names(units) as.numeric(seconds_to_unit(x@.Data, unit), ...) }) #' @export setMethod("as.numeric", signature(x = "Interval"), function(x, units = "secs", ...){ as.numeric(as.duration(x), units, ...) }) #' @export setMethod("as.numeric", signature(x = "Period"), function(x, units = "second", ...){ unit <- standardise_period_names(units) as.numeric(seconds_to_unit(period_to_seconds(x), unit = unit), ...) }) as.POSIXt <- function(x) as.POSIXlt(x) #' @export setMethod("as.character", signature(x = "Period"), function(x, ...){ format(x) }) #' @export setMethod("as.character", signature(x = "Duration"), function(x, ...){ format(x) }) #' @export setMethod("as.character", signature(x = "Interval"), function(x, ...){ format(x) }) #' Convert an object to a date or date-time #' #' #' @section Compare to base R: #' #' These are drop in replacements for \code{as.Date} and \code{as.POSIXct}, #' with a few tweaks to make them work more intuitively. #' #' \itemize{ #' \item \code{as_date} ignores the timezone attribute, resulting in #' a more intuitive conversion (see examples) #' \item Both functions provide a default origin argument for numeric #' vectors. #' \item \code{as_datetime} defaults to using UTC. #' } #' #' @param x a vector of \code{\link{POSIXt}}, numeric or character objects #' @param origin a Date object, or something which can be coerced by #' \code{as.Date(origin, ...)} to such an object (default: the Unix epoch of #' "1970-01-01"). Note that in this instance, \code{x} is assumed to reflect #' the number of days since \code{origin} at \code{"UTC"}. #' @param tz a time zone name (default: time zone of the POSIXt object #' \code{x}). See \code{\link{OlsonNames}}. #' @param ... further arguments to be passed to specific methods (see above). #' @return a vector of \code{\link{Date}} objects corresponding to \code{x}. #' @examples #' dt_utc <- ymd_hms("2010-08-03 00:50:50") #' dt_europe <- ymd_hms("2010-08-03 00:50:50", tz="Europe/London") #' c(as_date(dt_utc), as.Date(dt_utc)) #' c(as_date(dt_europe), as.Date(dt_europe)) #' ## need not suply origin #' as_date(10) #' @export setGeneric(name = "as_date", def = function(x, ...) standardGeneric("as_date"), useAsDefault = as.Date) #' @rdname as_date #' @export setGeneric("as_datetime", function(x, ...) { standardGeneric("as_datetime") } ) #' @rdname as_date #' @export setMethod(f = "as_date", signature = "POSIXt", function (x, tz = NULL) { tz <- if (is.null(tz)) tz(x) else tz as.Date(x, tz = tz) }) #' @rdname as_date setMethod(f = "as_date", signature = "numeric", function (x, origin = lubridate::origin) { as.Date(x, origin = origin) }) #' @rdname as_date #' @export setMethod("as_datetime", "POSIXt", function(x, tz = "UTC") { with_tz(x, tz) } ) #' @rdname as_date #' @export setMethod("as_datetime", "numeric", function(x, origin = lubridate::origin, tz = "UTC") { as.POSIXct(x, origin = origin, tz = tz) } ) #' @rdname as_date #' @export setMethod("as_datetime", "ANY", function(x, tz = "UTC") { with_tz(as.POSIXct(x), tzone = tz) } ) lubridate/R/help.r0000644000175100001440000001672312755025406013576 0ustar hornikusers#' Dates and times made easy with lubridate #' #' Lubridate provides tools that make it easier to parse and #' manipulate dates. These tools are grouped below by common #' purpose. More information about each function can be found in #' its help documentation. #' #' Parsing dates #' #' Lubridate's parsing functions read strings into R as POSIXct #' date-time objects. Users should choose the function whose name #' models the order in which the year ('y'), month ('m') and day #' ('d') elements appear the string to be parsed: #' \code{\link{dmy}}, \code{\link{myd}}, \code{\link{ymd}}, #' \code{\link{ydm}}, \code{\link{dym}}, \code{\link{mdy}}, #' \code{\link{ymd_hms}}). A very flexible and user friendly parser #' is provided by \code{\link{parse_date_time}}. #' #' Lubridate can also parse partial dates from strings into #' \code{\link{Period-class}} objects with the functions #' \code{\link{hm}}, \code{\link{hms}} and \code{\link{ms}}. #' #' Lubridate has an inbuilt very fast POSIX parser, ported from #' the fasttime package by Simon Urbanek. This functionality is #' as yet optional and could be activated with #' \code{options(lubridate.fasttime = TRUE)}. Lubridate will #' automatically detect POSIX strings and use fast parser instead #' of the default \code{\link{strptime}} utility. #' #' Manipulating dates #' #' Lubridate distinguishes between moments in time (known as #' \code{\link{instants}}) and spans of time (known as time spans, see #' \code{\link{Timespan-class}}). Time spans are further separated into #' \code{\link{Duration-class}}, \code{\link{Period-class}} and #' \code{\link{Interval-class}} objects. #' #' Instants #' #' Instants are specific moments of time. Date, POSIXct, and #' POSIXlt are the three object classes Base R recognizes as #' instants. \code{\link{is.Date}} tests whether an object #' inherits from the Date class. \code{\link{is.POSIXt}} tests #' whether an object inherits from the POSIXlt or POSIXct classes. #' \code{\link{is.instant}} tests whether an object inherits from #' any of the three classes. #' #' \code{\link{now}} returns the current system time as a POSIXct #' object. \code{\link{today}} returns the current system date. #' For convenience, 1970-01-01 00:00:00 is saved to #' \code{\link{origin}}. This is the instant from which POSIXct #' times are calculated. Try unclass(now()) to see the numeric structure that #' underlies POSIXct objects. Each POSIXct object is saved as the number of seconds #' it occurred after 1970-01-01 00:00:00. #' #' Conceptually, instants are a combination of measurements on different units #' (i.e, years, months, days, etc.). The individual values for #' these units can be extracted from an instant and set with the #' accessor functions \code{\link{second}}, \code{\link{minute}}, #' \code{\link{hour}}, \code{\link{day}}, \code{\link{yday}}, #' \code{\link{mday}}, \code{\link{wday}}, \code{\link{week}}, #' \code{\link{month}}, \code{\link{year}}, \code{\link{tz}}, #' and \code{\link{dst}}. #' Note: the accessor functions are named after the singular form #' of an element. They shouldn't be confused with the period #' helper functions that have the plural form of the units as a #' name (e.g, \code{\link{seconds}}). #' #' Rounding dates #' #' Instants can be rounded to a convenient unit using the #' functions \code{\link{ceiling_date}}, \code{\link{floor_date}} #' and \code{\link{round_date}}. #' #' Time zones #' #' Lubridate provides two helper functions for working with time #' zones. \code{\link{with_tz}} changes the time zone in which an #' instant is displayed. The clock time displayed for the instant #' changes, but the moment of time described remains the same. #' \code{\link{force_tz}} changes only the time zone element of an #' instant. The clock time displayed remains the same, but the #' resulting instant describes a new moment of time. #' #' Timespans #' #' A timespan is a length of time that may or may not be connected to #' a particular instant. For example, three months is a timespan. So is an hour and #' a half. Base R uses difftime class objects to record timespans. #' However, people are not always consistent in how they expect time to behave. #' Sometimes the passage of time is a monotone progression of instants that should #' be as mathematically reliable as the number line. On other occasions time must #' follow complex conventions and rules so that the clock times we see reflect what #' we expect to observe in terms of daylight, season, and congruence with the #' atomic clock. To better navigate the nuances of time, lubridate creates three #' additional timespan classes, each with its own specific and consistent behavior: #' \code{\link{Interval-class}}, \code{\link{Period-class}} and #' \code{\link{Duration-class}}. #' #' \code{\link{is.difftime}} tests whether an object #' inherits from the difftime class. \code{\link{is.timespan}} #' tests whether an object inherits from any of the four timespan #' classes. #' #' #' Durations #' #' Durations measure the exact amount of time that occurs between two #' instants. This can create unexpected results in relation to clock times if a #' leap second, leap year, or change in daylight savings time (DST) occurs in #' the interval. #' #' Functions for working with durations include \code{\link{is.duration}}, #' \code{\link{as.duration}} and \code{\link{duration}}. \code{\link{dseconds}}, #' \code{\link{dminutes}}, \code{\link{dhours}}, \code{\link{ddays}}, #' \code{\link{dweeks}} and \code{\link{dyears}} convenient lengths. #' #' Periods #' #' Periods measure the change in clock time that occurs between two #' instants. Periods provide robust predictions of clock time in the presence of #' leap seconds, leap years, and changes in DST. #' #' Functions for working with periods include #' \code{\link{is.period}}, \code{\link{as.period}} and #' \code{\link{period}}. \code{\link{seconds}}, #' \code{\link{minutes}}, \code{\link{hours}}, \code{\link{days}}, #' \code{\link{weeks}}, \code{\link{months}} and #' \code{\link{years}} quickly create periods of convenient #' lengths. #' #' Intervals #' #' Intervals are timespans that begin at a specific instant and #' end at a specific instant. Intervals retain complete information about a #' timespan. They provide the only reliable way to convert between #' periods and durations. #' #' Functions for working with intervals include #' \code{\link{is.interval}}, \code{\link{as.interval}}, #' \code{\link{interval}}, \code{\link{int_shift}}, #' \code{\link{int_flip}}, \code{\link{int_aligns}}, #' \code{\link{int_overlaps}}, and #' \code{\link{\%within\%}}. Intervals can also be manipulated with #' intersect, union, and setdiff(). #' #' Miscellaneous #' #' \code{\link{decimal_date}} converts an instant to a decimal of #' its year. #' \code{\link{leap_year}} tests whether an instant occurs during #' a leap year. #' \code{\link{pretty_dates}} provides a method of making pretty #' breaks for date-times #' \code{\link{lakers}} is a data set that contains information #' about the Los Angeles Lakers 2008-2009 basketball season. #' #' @references Garrett Grolemund, Hadley Wickham (2011). Dates and Times Made #' Easy with lubridate. Journal of Statistical Software, 40(3), 1-25. #' \url{http://www.jstatsoft.org/v40/i03/}. #' @import stringr #' @importFrom methods setClass setGeneric new show allNames callGeneric is slot slot<- slotNames validObject Compare Arith #' @importFrom utils packageVersion read.delim #' @importFrom stats na.omit setNames update #' @docType package #' @name lubridate-package #' @aliases lubridate lubridate-package NULL lubridate/R/leap-years.r0000644000175100001440000000146012755025406014700 0ustar hornikusers#' Is a year a leap year? #' #' If x is a recognized date-time object, leap_year will return whether x #' occurs during a leap year. If x is a number, leap_year returns whether it #' would be a leap year under the Gregorian calendar. #' #' @export leap_year #' @param date a date-time object or a year #' @return TRUE if x is a leap year, FALSE otherwise #' @keywords logic chron #' @examples #' x <- as.Date("2009-08-02") #' leap_year(x) # FALSE #' leap_year(2009) # FALSE #' leap_year(2008) # TRUE #' leap_year(1900) # FALSE #' leap_year(2000) # TRUE leap_year <- function(date) { recognized <- recognize(date) if (recognized) year <- year(date) else if (all(is.numeric(date))) year <- date else stop("unrecognized date format") (year %% 4 == 0) & ((year %% 100 != 0) | (year %% 400 == 0)) } lubridate/R/time-zones.r0000644000175100001440000000557512755025406014743 0ustar hornikusers#' Get date-time in a different time zone #' #' with_tz returns a date-time as it would appear in a different time zone. #' The actual moment of time measured does not change, just the time zone it is #' measured in. with_tz defaults to the Universal Coordinated time zone (UTC) #' when an unrecognized time zone is inputted. See \code{\link{Sys.timezone}} #' for more information on how R recognizes time zones. #' #' @export with_tz #' @param time a POSIXct, POSIXlt, Date, chron date-time object or a data.frame #' object. When a data.frame all POSIXt elements of a data.frame are processed #' with \code{with_tz} and new data.frame is returned. #' @param tzone a character string containing the time zone to convert to. R #' must recognize the name contained in the string as a time zone on your #' system. #' @return a POSIXct object in the updated time zone #' @keywords chron manip #' @seealso \code{\link{force_tz}} #' @examples #' x <- as.POSIXct("2009-08-07 00:00:01", tz = "America/New_York") #' with_tz(x, "GMT") with_tz <- function (time, tzone = ""){ if(is.data.frame(time)){ for(nm in names(time)){ if(is.POSIXt(time[[nm]])){ time[[nm]] <- with_tz(time[[nm]], tzone = tzone) } } time } else { check_tz(tzone) if (is.POSIXlt(time)) new <- as.POSIXct(time) else new <- time attr(new, "tzone") <- tzone reclass_date(new, time) } } #' Replace time zone to create new date-time #' #' force_tz returns a the date-time that has the same clock time as x in the new #' time zone. #' Although the new date-time has the same clock time (e.g. the #' same values in the year, month, days, etc. elements) it is a #' different moment of time than the input date-time. force_tz defaults to the #' Universal Coordinated time zone (UTC) when an unrecognized time zone is #' inputted. See \code{\link{Sys.timezone}} for more information on how R #' recognizes time zones. #' #' @export force_tz #' #' @param time a POSIXct, POSIXlt, Date, chron date-time object, or a data.frame #' object. When a data.frame all POSIXt elements of a data.frame are processed #' with \code{force_tz} and new data.frame is returned. #' @param tzone a character string containing the time zone to convert to. R #' must recognize the name contained in the string as a time zone on your #' system. #' @return a POSIXct object in the updated time zone #' @keywords chron manip #' @seealso \code{\link{with_tz}} #' @examples #' x <- as.POSIXct("2009-08-07 00:00:01", tz = "America/New_York") #' force_tz(x, "GMT") force_tz <- function(time, tzone = ""){ if(is.data.frame(time)){ for(nm in names(time)){ if(is.POSIXt(time[[nm]])){ time[[nm]] <- force_tz(time[[nm]], tzone = tzone) } } time } else { check_tz(tzone) update(time, tz = tzone) } } check_tz <- function(tz) {} # Note: alternative method? as.POSIXlt(format(as.POSIXct(x)), tz = tzone) lubridate/R/guess.r0000644000175100001440000003605112765537170013777 0ustar hornikusers##' Guess formats from the supplied date-time character vector. ##' ##' ##' @param x input vector of date-times ##' @param orders format orders to look for. See examples. ##' @param locale locale to use, default to the current locale ##' @param preproc_wday whether to preprocess week days names. Internal ##' optimization used by ymd_hms family of functions. If true week days are ##' substituted with %a or %A accordingly, so that there is no need to supply ##' this format explicitly. ##' @param print_matches for development purpose mainly. If TRUE prints a matrix ##' of matched templates. ##' @return a vector of matched formats ##' @export ##' @examples ##' ##' x <- c('February 20th 1973', ##' "february 14, 2004", ##' "Sunday, May 1, 2000", ##' "Sunday, May 1, 2000", ##' "february 14, 04", ##' 'Feb 20th 73', ##' "January 5 1999 at 7pm", ##' "jan 3 2010", ##' "Jan 1, 1999", ##' "jan 3 10", ##' "01 3 2010", ##' "1 3 10", ##' '1 13 89', ##' "5/27/1979", ##' "12/31/99", ##' "DOB:12/11/00", ##' "-----------", ##' 'Thu, 1 July 2004 22:30:00', ##' 'Thu, 1st of July 2004 at 22:30:00', ##' 'Thu, 1July 2004 at 22:30:00', ##' 'Thu, 1July2004 22:30:00', ##' 'Thu, 1July04 22:30:00', ##' "21 Aug 2011, 11:15:34 pm", ##' "-----------", ##' "1979-05-27 05:00:59", ##' "1979-05-27", ##' "-----------", ##' "3 jan 2000", ##' "17 april 85", ##' "27/5/1979", ##' '20 01 89', ##' '00/13/10', ##' "-------", ##' "14 12 00", ##' "03:23:22 pm") ##' ##' guess_formats(x, "BdY") ##' guess_formats(x, "Bdy") ##' ## m also matches b and B; y also matches Y ##' guess_formats(x, "mdy", print_matches = TRUE) ##' ##' ## T also matches IMSp order ##' guess_formats(x, "T", print_matches = TRUE) ##' ##' ## b and B are equivalent and match, both, abreviated and full names ##' guess_formats(x, c("mdY", "BdY", "Bdy", "bdY", "bdy"), print_matches = TRUE) ##' guess_formats(x, c("dmy", "dbY", "dBy", "dBY"), print_matches = TRUE) ##' ##' ##' guess_formats(x, c("dBY HMS", "dbY HMS", "dmyHMS", "BdY H"), print_matches = TRUE) ##' ##' guess_formats(x, c("ymd HMS"), print_matches = TRUE) ##' guess_formats <- function(x, orders, locale = Sys.getlocale("LC_TIME"), preproc_wday = TRUE, print_matches = FALSE){## remove all separators orders <- gsub("[^[:alpha:]]+", "", orders) if (any(grepl("hms|hm|ms", orders))) { .deprecated("hms, hm and ms usage", ", please use HMS, HM or MS instead", "1.5.6") orders <- gsub("hms", "HMS", orders, ignore.case = TRUE) orders <- gsub("hm", "HM", orders, ignore.case = TRUE) orders <- gsub("ms", "MS", orders, ignore.case = TRUE) } ## redirect some formats to C parser if(length(wp <- grepl("[^O]p", orders))) orders <- c(sub("p", "Op", orders[wp], fixed = T), orders) if(length(wm <- grepl("[^O][mbB]", orders))) orders <- c(sub("[mbB]", "Om", orders[wm]), orders) if(length(wT <- grepl("T", orders, fixed = T))) orders <- c(sub("T", "HMSOp", orders[wT], fixed = T), orders) if(length(wR <- grepl("R", orders, fixed = T))) orders <- c(sub("R", "HMOp", orders[wR], fixed = T), orders) if(length(wr <- grepl("r", orders, fixed = T))) orders <- c(sub("r", "HOp", orders[wR], fixed = T), orders) ## We split into characterst first and then paste together formats that start ## with O. If perl style lookahead would have worked we wouldn't need this, ## but it doesn't. osplits <- strsplit(orders, "", fixed = TRUE) osplits <- lapply(osplits, function(ospt){ if( length(which_O <- which(ospt == "O")) > 0 ){ ospt[which_O + 1] <- paste("O", ospt[which_O + 1], sep = "") ospt[-which_O] }else ospt }) reg <- .get_locale_regs(locale) flex_regs <- c(reg$alpha_flex, reg$num_flex, .c_parser_reg_flex) exact_regs <- c(reg$alpha_exact, reg$num_exact, .c_parser_reg_exact) REGS <- unlist(lapply(osplits, function(fnames){ ## fnames are names of smalest valid formats, like a, A, b, z, OS, OZ ... which <- ! fnames %in% c(names(reg$alpha_flex), names(reg$num_flex), names(.c_parser_reg_exact)) if( any( which ) ) stop("Unknown formats supplied: ", paste(fnames[ which ], sep = ", ")) ## restriction: no numbers before or after ## fixme: using \\D*? because \\D+ doesn't work in flex match, why? paste("^\\D*?\\b((", paste(unlist(flex_regs[fnames]), collapse = "\\D*?"), ")|(", paste(unlist(exact_regs[fnames]), collapse = "\\D*?"), "))\\D*$", sep = "") })) ## print debugging info if (print_matches) { subs <- lapply(REGS, .substitute_formats, x, fmts_only = FALSE) names(subs) <- orders print(do.call(cbind, c(list(x), subs))) } .build_formats <- function(regs, orders, x){ out <- mapply( function(reg, name){ out <- .substitute_formats(reg, x) if( !is.null(out) ) names(out) <- rep.int(name, length(out)) out }, REGS, orders, SIMPLIFY= F, USE.NAMES= F) names(out) <- NULL unlist(out) } if (preproc_wday && !any(grepl("[aA]", orders))) { ## replace short/long weak days in current locale x2 <- gsub(reg$alpha_exact[["A"]], "%A", x, ignore.case = T, perl = T) x2 <- gsub(reg$alpha_exact[["a"]], "%a", x2, ignore.case = T, perl = T) formats <- .build_formats(REGS, orders, x2) ## In some locales abreviated day (italian "gio") is part of month name ## ("maggio"). So check if %a or %A is present and append wday-less formats. if (any(grepl("%[aA]", formats))) c(formats, .build_formats(REGS, orders, x)) else formats } else { .build_formats(REGS, orders, x) } } .substitute_formats <- function(reg, x, fmts_only = TRUE){ ## Take date X and substitute year with %Y/%y, month with %B/%b etc. ## Return the formatted string if REG matched, or null otherwise. ## REG should be with captures as build by .build_locale_regs ## Captures should start with the strptyme formats. For example Y_e, B_m_e ## Traling _e, _m_e are removed. ## fmts_only == FALSE is for debugging purpose only m <- regexpr(reg, x, ignore.case = TRUE, perl = TRUE) ## print(regs[[1]]) matched <- m > 0 if ( any(matched) ){ nms <- attr(m, "capture.names") nms <- nms[nzchar(nms)] ## e <- grepl("_e", nms, fixed = TRUE) ## nms_e <- nms[e] ## nms <- nms[!e] start <- attr(m, "capture.start")[matched, , drop = FALSE] end <- start + attr(m, "capture.length")[matched, , drop = FALSE] - 1L lout <- x[matched] for( n in rev(nms) ){ ## start from the end w <- end[, n] > 0 ## -1 if unmatched subpatern str_sub(lout[w], start[w, n], end[w, n]) <- paste("%", gsub("_.*$", "", n), sep = "") } if(fmts_only) lout else{ ## developer out <- character(length(x)) ## dev only out[matched] <- lout out } }else if (fmts_only) NULL else character(length(x)) } .enclose <- function(fmts) paste("@", fmts, "@", sep = "") .enclosed.na <- function(x) x == "@NA@" .get_train_set <- function(x){ ## the best irregular guesser I could come up with x <- x[!.enclosed.na(x)] len <- length(x) if( len < 100) x else if( len < 3571 ) x[.primes[.primes <= length(x) ] ] else x[ .primes * (length(x) %/% 3571) ] #501 primes } .train_formats <- function(x, formats, locale) { ## return a numeric vector of size length(formats), with each element giving ## the number of matched elements in X ## can return NULL if formats is NULL trials <- lapply(formats, function(fmt) .strptime(x, fmt)) successes <- unlist(lapply(trials, function(x) sum(!is.na(x))), use.names = FALSE) names(successes) <- formats successes } .best_formats <- function(x, orders, locale, .select_formats){ ## return a vector of formats that matched X at least once. ## Can be zero length vector, if none matched fmts <- unique(guess_formats(x, orders, locale = locale, preproc_wday = TRUE)) # orders as names if(length(fmts)){ trained <- .train_formats(x, fmts, locale = locale) ## print(trained) trained <- trained[ trained > 0 ] .select_formats(trained) } } .select_formats <- function(trained){ nms <- names(trained) n_fmts <- nchar(gsub("[^%]", "", nms)) + ## longer formats have priority grepl("%Y", nms)*1.5 + ## Y has priority over 0 ## C parser formats grepl("%Om", nms)*.1 + grepl("%Op", nms)*.1 + grepl("%O", nms)*.2 ## print(structure(n_fmts, names = nms)) # for debugging names(trained[which.max(n_fmts)]) } ## These are formats that are effectively matched by c parser. But we must get ## through the format guesser first for ymd_hms family. .c_parser_reg_flex <- list(Op = "(?(AM|PM))(?![[:alpha:]])", Om = "((?1[0-2]|0?[1-9](?!\\d))|(((?Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)|(?January|February|March|April|May|June|July|August|September|October|November|December))(?![[:alpha:]])))") .c_parser_reg_exact <- list(Op = "(?AM|PM)(?![[:alpha:]])", Om = "((?1[0-2]|0[1-9])|(((?Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)|(?January|February|March|April|May|June|July|August|September|October|November|December))(?![[:alpha:]])))") .locale_reg_cache <- new.env(hash = FALSE) .get_locale_regs <- function(locale = Sys.getlocale("LC_TIME")){ ## build locale specific regexps for all posible orders if (exists(locale, envir = .locale_reg_cache, inherits = FALSE)) return(get(locale, envir = .locale_reg_cache)) orig_locale <- Sys.getlocale("LC_TIME") Sys.setlocale("LC_TIME", locale) orig_opt <- options(warn = 5) on.exit({Sys.setlocale("LC_TIME", orig_locale) options(orig_opt)}) format <- "%a@%A@%b@%B@%p@" L <- enc2utf8(unique(format(.date_template, format = format))) mat <- do.call(rbind, strsplit(L, "@", fixed = TRUE)) mat[] <- gsub("([].|(){^$*+?[])", "\\\\\\1", mat) ## escaping all meta chars names <- colnames(mat) <- strsplit(format, "[%@]+")[[1]][-1L] ## Captures should be unique. Thus we build captures with the following ## rule. Capture starts with the name of strptime format (B, b, y etc) It ends ## with _e if the expression is an exact match (as oposed to flex), see below. ## It can contain _x where x is a main format in which this format ## occurs. For example is an exact capture in the strptime format B ## but that also matches b in lubridate. Try lubridate:::.get_loc_regs() ## todo: elaborate ## ALPHABETIC FORMATS alpha <- list() alpha["b"] <- sprintf("((?%s)|(?%s))(?![[:alpha:]])", paste(unique(mat[, "b"]), collapse = "|"), paste(unique(mat[, "B"]), collapse = "|")) alpha["B"] <- sprintf("(?%s)(?![[:alpha:]])", paste(unique(mat[, "B"]), collapse = "|")) alpha["a"] <- sprintf("((?%s)|(?%s))(?![[:alpha:]])", paste(unique(mat[, "a"]), collapse = "|"), paste(unique(mat[, "A"]), collapse = "|")) alpha["A"] <- sprintf("(?%s)(?![[:alpha:]])", paste(unique(mat[, "A"]), collapse = "|")) ## just match Z in ISO8601, (UTC zulu format) alpha["Ou"] <- "(?Z)(?![[:alpha:]])" p <- unique(mat[, "p"]) p <- p[nzchar(p)] alpha["p"] <- if ( length(p) == 0L ) "" else sprintf("(?

%s)(?![[:alpha:]])", paste(p, collapse = "|")) alpha <- unlist(alpha) ## NUMERIC FORMATS num <- num_flex <- num_exact <- c( d = "(?[012]?[1-9]|3[01]|[12]0)", q = "(?[0]?[1-4])", H = "(?2[0-4]|[01]?\\d)", h = "(?2[0-4]|[01]?\\d)", I = "(?1[0-2]|0?[1-9])", j = "(?[0-3]?\\d?\\d)", M = "(?[0-5]?\\d)", S = "((?[0-5]?\\d\\.\\d+)|(?[0-6]?\\d))", s = "((?[0-5]?\\d\\.\\d+)|(?[0-6]?\\d))", U = "(?[0-5]?\\d)", w = "(?[0-6])", # merge with a, A?? u = "(?[1-7])", W = "(?[0-5]?\\d)", ## x = "(?\\d{2}/[01]?\\d/[0-3]?\\d)", ## X = "(?[012]?\\d:[0-5]?\\d:[0-6]?\\d)", Y = "(?\\d{4})", y = "((?\\d{4})|(?\\d{2}))", Oz = "(?[-+]\\d{4})", ## sptrtime implements only this format (4 digits) ## F = "(?\\d{4)-\\d{2}-\\d{2})", OO = "(?[-+]\\d{2}:\\d{2})", Oo = "(?[-+]\\d{2})") ## special lubridate formats nms <- c("T", "R", "r") ## in some locales %p = "" if (length(p) == 0L) { num <- c(num, T = sprintf("(%s\\D+%s\\D+%s)", num[["H"]], num[["M"]], num[["S"]]), R = sprintf("(%s\\D+%s)", num[["H"]], num[["M"]]), r = sprintf("(%s\\D+)", num[["H"]])) }else{ num <- c(num, T = sprintf("((%s\\D+%s\\D+%s\\D*%s)|(%s\\D+%s\\D+%s))", num[["I"]], num[["M"]], num[["S"]], alpha[["p"]], num[["H"]], num[["M"]], num[["S"]]), R = sprintf("((%s\\D+%s\\D*%s)|(%s\\D+%s))", num[["I"]], num[["M"]], alpha[["p"]], num[["H"]], num[["M"]]), r = sprintf("((%s\\D*%s)|%s)", num[["I"]], alpha[["p"]], num[["H"]])) num[nms] <- sub("", "_e>", alpha, fixed = TRUE) num_exact <- num_flex <- num num_flex[] <- sprintf("%s(?!\\d)", num) num_exact[] <- gsub("(?", "_e>", num))) # append _e to avoid duplicates num_flex["m"] <- sprintf("((?1[0-2]|0?[1-9](?!\\d))|(%s))", gsub("_[bB]", "\\1_m", alpha[["b"]])) num_exact["m"] <- sprintf("((?1[0-2]|0[1-9])|(%s))", gsub("_[bB]", "\\1_m_e", alpha[["b"]])) ## canoot be in num above because gsub("+", "*") messes it up num_flex["OS"] <- "(?[0-5]\\d\\.\\d+)" num_exact["OS"] <- "(?[0-5]\\d\\.\\d+)" num_flex["z"] <- sprintf("(%s|%s|%s|%s)", alpha_flex[["Ou"]], num_flex[["Oz"]], num_flex[["OO"]], num_flex[["Oo"]]) num_exact["z"] <- sprintf("(%s|%s|%s|%s)", alpha_exact[["Ou"]], num_exact[["Oz"]], num_exact[["OO"]], num_exact[["Oo"]]) out <- list(alpha_flex = alpha_flex, num_flex = num_flex, alpha_exact = alpha_exact, num_exact = num_exact) assign(locale, out, envir = .locale_reg_cache) out } lubridate/R/update.r0000644000175100001440000001521112755025406014117 0ustar hornikusers#' Changes the components of a date object #' #' \code{update.Date} and \code{update.POSIXt} return a date with the specified #' elements updated. Elements not specified will be left unaltered. update.Date #' and update.POSIXt do not add the specified values to the existing date, they #' substitute them for the appropriate parts of the existing date. #' #' #' @name DateUpdate #' @param object a date-time object #' @param ... named arguments: years, months, ydays, wdays, mdays, days, hours, #' minutes, seconds, tzs (time zone compnent) #' @param simple logical, passed to \code{fit_to_timeline}. If TRUE a simple fit #' to time line is performed and no NA are produced for invalid dates. Invalid #' dates are converted to meaningful dates by extrapolating the timezones. #' @return a date object with the requested elements updated. The object will #' retain its original class unless an element is updated which the original #' class does not support. In this case, the date returned will be a POSIXlt #' date object. #' @keywords manip chron #' @examples #' date <- as.POSIXlt("2009-02-10") #' update(date, year = 2010, month = 1, mday = 1) #' #' update(date, year =2010, month = 13, mday = 1) #' #' update(date, minute = 10, second = 3) #' @export update.POSIXt <- function(object, ..., simple = FALSE){ if(!length(object)) return(object) date <- as.POSIXlt(object) # adjudicate units input units <- list(...) names(units) <- standardise_lt_names(names(units)) if (!is.null(new_tz <- units$tz)) { units$tz <- NULL } day.units <- c("day", "wday", "mday", "yday") wunit <- day.units %in% names(units) if (n <- sum(wunit)) { if (n > 1) stop("conflicting days input") uname <- day.units[wunit] if (uname != "mday") { ## we compute everything with mdays (operating with ydays doesn't work) if (uname != "day"){ if (uname == "yday" & !is.null(units$year)) warning("Updating on both 'year' and 'yday' can lead to wrong results. See bug #319.", call. = F) diff <- units[[uname]] - date[[uname]] - 1 units[[uname]] <- diff + date$mday } names(units)[names(units) == uname] <- "mday" } } if (!is.null(units$mon)) units$mon <- units$mon - 1 if (!is.null(units$year)) units$year <- units$year - 1900 # make new date-times date <- unclass(date) date[names(units)] <- units date[c("wday", "yday")] <- list(wday = NA, yday = NA) ## unbalanced POSIXlt often results in R crashes maxlen <- max(unlist(lapply(date, length))) if (maxlen > 1) { for (nm in names(date)) if (length(date[[nm]]) != maxlen) date[[nm]] <- rep_len(date[[nm]], maxlen) } class(date) <- c("POSIXlt", "POSIXt") if (!is.null(new_tz)) attr(date, "tzone") <- new_tz ## fit to timeline ## POSIXct format avoids negative and NA elements in POSIXlt format fit_to_timeline(date, class(object)[[1]], simple = simple) } #' @export update.Date <- function(object, ...){ lt <- as.POSIXlt(object, tz = "UTC") new <- update(lt, ...) if (sum(c(new$hour, new$min, new$sec), na.rm = TRUE)) { as.POSIXct(new) } else { as.Date(new) } } #' Fit a POSIXlt date-time to the timeline #' #' The POSIXlt format allows you to create instants that do not exist in real #' life due to daylight savings time and other conventions. fit_to_timeline #' matches POSIXlt date-times to a real times. If an instant does not exist, fit #' to timeline will replace it with an NA. If an instant does exist, but has #' been paired with an incorrect timezone/daylight savings time combination, #' fit_to_timeline returns the instant with the correct combination. #' #' #' @param lt a POSIXlt date-time object. #' @param class a character string that describes what type of object to return, #' POSIXlt or POSIXct. Defaults to POSIXct. This is an optimization to avoid #' needless conversions. #' @param simple if TRUE, \code{lubridate} makes no attempt to detect #' meaningless time-dates or to correct time zones. No NAs are produced and #' the most meaningful valid dates are returned instead. See examples. #' @return a POSIXct or POSIXlt object that contains no illusory date-times #' #' @examples #' \dontrun{ #' tricky <- structure(list(sec = c(5, 0, 0, -1), #' min = c(0L, 5L, 5L, 0L), #' hour = c(2L, 0L, 2L, 2L), #' mday = c(4L, 4L, 14L, 4L), #' mon = c(10L, 10L, 2L, 10L), #' year = c(112L, 112L, 110L, 112L), #' wday = c(0L, 0L, 0L, 0L), #' yday = c(308L, 308L, 72L, 308L), #' isdst = c(1L, 0L, 0L, 1L)), #' .Names = c("sec", "min", "hour", "mday", "mon", #' "year", "wday", "yday", "isdst"), #' class = c("POSIXlt", "POSIXt"), #' tzone = c("America/Chicago", "CST", "CDT")) #' tricky #' ## because clocks "fall back" to 1:00 CST #' #' ## CDT, not CST at this instant #' #' ##because clocks "spring forward" past this time #' ## for daylight savings #' #' ## has deceptive internal structure #' #' fit_to_timeline(tricky) #' [1] "2012-11-04 02:00:05 CST" "2012-11-04 00:05:00 CDT" #' [4] NA "2012-11-04 01:59:59 CDT" #' #' ## with correct timezone & DST combination #' #' ## with correct timezone & DST combination #' #' #' fit_to_timeline(tricky, simple = TRUE) #' ## Reduce to valid time-dates by extrapolating CDT and CST zones #' } #' @export fit_to_timeline <- function(lt, class = "POSIXct", simple = FALSE) { if (class != "POSIXlt" && class != "POSIXct") stop("class argument must be POSIXlt or POSIXct") if(simple){ if(class == "POSIXct") as.POSIXct(lt) else as.POSIXlt(as.POSIXct(lt)) } else { ## fall break - DST only changes if it has to ct <- as.POSIXct(lt) lt2 <- as.POSIXlt(ct) dstdiff <- !is.na(ct) & (lt$isdst != lt2$isdst) if (any(dstdiff)) { dlt <- lt[dstdiff] dlt2 <- lt2[dstdiff] dlt$isdst <- dlt2$isdst dlt$zone <- dlt2$zone dlt$gmtoff <- dlt2$gmtoff dct <- as.POSIXct(dlt) # should directly match if not in gap if (class == "POSIXct") ct[dstdiff] <- dct else lt2[dstdiff] <- dlt chours <- format.POSIXlt(as.POSIXlt(dct), "%H", usetz = FALSE) lhours <- format.POSIXlt(dlt, "%H", usetz = FALSE) any <- any(hdiff <- chours != lhours) if (!is.na(any) && any) { if (class == "POSIXct") ct[dstdiff][hdiff] <- NA else lt2[dstdiff][hdiff] <- NA } } if (class == "POSIXct") ct else lt2 } } lubridate/R/util.r0000644000175100001440000000662312765536135013630 0ustar hornikusersmatch_lengths <- function(x, y) { n.x <- length(x) n.y <- length(y) n.max <- max(n.x, n.y) n.min <- min(n.x, n.y) if (n.max %% n.min != 0L){ stop("longer object length is not a multiple of shorter object length") } else { if (n.x < n.y) { x <- rep(x, length.out = n.y) } else { y <- rep(y, length.out = n.x) } } list(x, y) } recognize <- function(x){ recognized <- c("POSIXt", "POSIXlt", "POSIXct", "yearmon", "yearqtr", "Date") if (all(class(x) %in% recognized)) return(TRUE) return(FALSE) } standardise_date_names <- function(x) { dates <- c("second", "minute", "hour", "mday", "wday", "yday", "day", "week", "month", "year", "tz") y <- gsub("(.)s$", "\\1", x) res <- dates[pmatch(y, dates)] if (any(is.na(res))) { stop("Invalid unit name: ", paste(x[is.na(res)], collapse = ", "), call. = FALSE) } res } standardise_difftime_names <- function(x) { dates <- c("secs", "mins", "hours", "days", "weeks") y <- gsub("(.)s$", "\\1", x) y <- substr(y, 1, 3) res <- dates[pmatch(y, dates)] if (any(is.na(res))) { stop("Invalid difftime name: ", paste(x[is.na(res)], collapse = ", "), call. = FALSE) } res } standardise_period_names <- function(x) { dates <- c("second", "minute", "hour", "day", "week", "month", "year", ## these ones are used for rounding only "bimonth", "quarter", "halfyear") y <- gsub("(.)s$", "\\1", x) y <- substr(y, 1, 3) res <- dates[pmatch(y, dates)] if (any(is.na(res))) { stop("Invalid period name: ", paste(x[is.na(res)], collapse = ", "), call. = FALSE) } res } standardise_lt_names <- function(x) { if(length(x) == 0L) stop("No unit names supplied.") dates <- c("sec", "min", "hour", "day", "mday", "wday", "yday", "mon", "year", "tz") y <- gsub("(.)s$", "\\1", x) y <- substr(y, 1, 3) res <- dates[pmatch(y, dates)] if (any(is.na(res))) { stop("Invalid unit name: ", paste(x[is.na(res)], collapse = ", "), call. = FALSE) } res } ## return list(n=nr_untis, unti="unit_name") parse_period_unit <- function(unit) { if (length(unit) > 1) { warning("Unit argument longer than 1. Taking first element.") unit <- unit[[1]] } p <- .Call("c_parse_period", as.character(unit)) if (!is.na(p[[1]])) { period_units <- c("second", "minute", "hour", "day", "week", "month", "year") wp <- which(p > 0) if(length(wp) > 1){ stop("Multi unit periods are not yet supported") } list(n = p[wp], unit = period_units[wp]) } else { ## this is for backward compatibility and allows for bimonth, halfyear and quarter m <- regexpr(" *(?[0-9.,]+)? *(?[^ \t\n]+)", unit[[1]], perl = T) if(m > 0){ ## should always match nms <- attr(m, "capture.names") nms <- nms[nzchar(nms)] start <- attr(m, "capture.start") end <- start + attr(m, "capture.length") - 1L n <- if(end[[1]] >= start[[1]]){ as.integer(str_sub(unit, start[[1]], end[[1]])) } else { 1 } unit <- str_sub(unit, start[[2]], end[[2]]) list(n = n, unit = unit) } else { stop(sprintf("Invalid unit specification '%s'", unit)) } } } undefined_arithmetic <- function(e1, e2){ msg <- sprintf("Arithmetic operators undefined for '%s' and '%s' classes: convert one to numeric or a matching time-span class.", class(e1), class(e2)) stop(msg) } lubridate/R/accessors-week.r0000644000175100001440000000236412755025406015560 0ustar hornikusers#' @include periods.r NULL #' Get/set weeks component of a date-time. #' #' \code{week} returns the number of complete seven day periods that have #' occured between the date and January 1st, plus one.\cr #' \code{isoweek} returns the week as it would appear in the ISO 8601 system, #' which uses a reoccuring leap week. #' #' @param x a date-time object. Must be a POSIXct, POSIXlt, Date, chron, #' yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, or #' fts object. #' @param value a numeric object #' @return the weeks element of x as an integer number #' @keywords utilities manip chron #' @references \url{http://en.wikipedia.org/wiki/ISO_week_date} #' @seealso \code{\link{isoyear}} #' @examples #' x <- ymd("2012-03-26") #' week(x) #' week(x) <- 1 #' week(x) <- 54 #' week(x) > 3 #' @export week <- function(x) (yday(x) - 1) %/% 7 + 1 #' @rdname week #' @export "week<-" <- function(x, value) x <- x + days((value - week(x)) * 7) #' @rdname week #' @export isoweek <- function(x){ xday <- make_datetime(year(x), month(x), day(x)) ## week day (monday first) dn <- 1 + (wday(x) + 5) %% 7 nth <- xday + ddays(4 - dn) jan1 <- make_datetime(year(nth), 1, 1) 1L + as.integer(difftime(nth, jan1, units = "days")) %/% 7L } lubridate/R/decimal-dates.r0000644000175100001440000000343512755025406015336 0ustar hornikusers#' Converts a date to a decimal of its year. #' #' @export #' @param date a POSIXt or Date object #' @return a numeric object where the date is expressed as a fraction of its year #' @keywords manip chron methods #' @examples #' date <- ymd("2009-02-10") #' decimal_date(date) # 2009.11 decimal_date <- function(date) UseMethod("decimal_date") #' @export decimal_date.default <- function(date){ if(any(!inherits(date, c("POSIXt", "POSIXct", "POSIXlt", "Date")))) stop("date(s) not in POSIXt or Date format") Y <- year(date) start <- make_datetime(Y, 1L, 1L, tz = tz(date)) end <- make_datetime(Y + 1L, 1L, 1L, tz = tz(date)) sofar <- as.numeric(difftime(date, start, units = "secs")) total <- as.numeric(difftime(end, start, units = "secs")) Y + sofar/total } #' @export decimal_date.zoo <- function(date) decimal_date(zoo::index(date)) #' @export decimal_date.its <- function(date) decimal_date.default(attr(date, "dates")) #' Converts a decimal to a date. #' #' @export #' @param decimal a numeric object #' @param tz the time zone required #' @return a POSIXct object, whose year corresponds to the integer part of #' decimal. The months, days, hours, minutes and seconds elements are picked so #' the date-time will accurately represent the fraction of the year expressed by #' decimal. #' @keywords manip chron methods #' @examples #' date <- ymd("2009-02-10") #' decimal <- decimal_date(date) # 2009.11 #' date_decimal(decimal) # "2009-02-10 UTC" date_decimal <- function(decimal, tz = "UTC") { Y <- trunc(decimal) ## parsing is much faster than updating start <- make_datetime(Y, 1L, 1L, tz = tz) end <- make_datetime(Y + 1L, 1L, 1L, tz = tz) seconds <- as.numeric(difftime(end, start, units = "secs")) frac <- decimal - Y end <- start + seconds*frac return(end) } lubridate/R/numeric.r0000644000175100001440000000002712755025406014276 0ustar hornikuserssetOldClass("numeric") lubridate/R/instants.r0000644000175100001440000001006212755025406014477 0ustar hornikusers#' Is x a date-time object? #' #' An instant is a specific moment in time. Most common date-time #' objects (e.g, POSIXct, POSIXlt, and Date objects) are instants. #' #' @aliases instant instants #' @export #' @param x an R object #' @return TRUE if x is a POSIXct, POSIXlt, or Date object, FALSE otherwise. #' @seealso \code{\link{is.timespan}}, \code{\link{is.POSIXt}}, \code{\link{is.Date}} #' @keywords logic chron #' @examples #' is.instant(as.Date("2009-08-03")) # TRUE #' is.timepoint(5) # FALSE is.instant <- function(x) inherits(x, c("POSIXt", "POSIXct", "POSIXlt", "Date")) #' @export #' @rdname is.instant is.timepoint <- is.instant #' The current time #' #' @export now #' @param tzone a character vector specifying which time zone you would like #' the current time in. tzone defaults to your computer's system timezone. #' You can retrieve the current time in the Universal Coordinated Time (UTC) #' with now("UTC"). #' @return the current date and time as a POSIXct object #' #' @seealso \code{\link{here}} #' #' @keywords chron utilities #' @examples #' now() #' now("GMT") #' now("") #' now() == now() # would be true if computer processed both at the same instant #' now() < now() # TRUE #' now() > now() # FALSE now <- function(tzone = "") with_tz(Sys.time(), tzone) #' The current date #' #' @export today #' @param tzone a character vector specifying which time zone you would like to #' find the current date of. tzone defaults to the system time zone set on your #' computer. #' @return the current date as a Date object #' #' @keywords chron utilities #' @examples #' today() #' today("GMT") #' today() == today("GMT") # not always true #' today() < as.Date("2999-01-01") # TRUE (so far) today <- function(tzone = "") { as.Date(force_tz(floor_date(now(tzone), "day"), tzone = "UTC")) } #' 1970-01-01 UTC #' #' Origin is the date-time for 1970-01-01 UTC in POSIXct format. This date-time #' is the origin for the numbering system used by POSIXct, POSIXlt, chron, and #' Date classes. #' #' @export origin #' @keywords data chron #' @examples #' origin origin <- with_tz(structure(0, class = c("POSIXct", "POSIXt")), "UTC") ##' Efficient creation of date-times from numeric representations ##' ##' \code{make_datetime} is a very fast drop-in replacement for ##' \code{base::ISOdate} and \code{base::ISOdatetime}. \code{make_date} produces ##' objects of class \code{Date}. ##' ##' Input vectors are silently recycled. All inputs except \code{sec} are ##' silently converted to integer vectors; \code{sec} can be either integer or ##' double. ##' ##' @param year numeric year ##' @param month numeric month ##' @param day numeric day ##' @param hour numeric hour ##' @param min numeric minute ##' @param sec numeric second ##' @param tz time zone. Defaults to UTC. ##' @export ##' @useDynLib lubridate make_dt ##' @examples ##' make_datetime(year = 1999, month = 12, day = 22, sec = 10) ##' make_datetime(year = 1999, month = 12, day = 22, sec = c(10, 11)) make_datetime <- function(year = 1970L, month = 1L, day = 1L, hour = 0L, min = 0L, sec = 0, tz = "UTC"){ lengths <- vapply(list(year, month, day, hour, min, sec), length, 1, USE.NAMES = FALSE) if (min(lengths) == 0L){ .POSIXct(numeric(), tz = tz) } else { N <- max(lengths) .POSIXct(.Call("make_dt", rep_len(as.integer(year), N), rep_len(as.integer(month), N), rep_len(as.integer(day), N), rep_len(as.integer(hour), N), rep_len(as.integer(min), N), rep_len(sec, N)), tz = tz) } } ##' @rdname make_datetime ##' @useDynLib lubridate make_d ##' @export make_date <- function(year = 1970L, month = 1L, day = 1L){ lengths <- vapply(list(year, month, day), length, 1, USE.NAMES = FALSE) if (min(lengths) == 0L){ as.Date(integer(), origin = origin) } else { N <- max(lengths) secs <- .Call("make_d", rep_len(as.integer(year), N), rep_len(as.integer(month), N), rep_len(as.integer(day), N)) structure(secs/86400L, class = "Date") } } lubridate/R/round.r0000644000175100001440000002426312765514464014003 0ustar hornikusers#' Round, floor and ceiling methods for date-time objects. #' #' Rounding to the nearest unit or multiple of a unit are supported. All #' meaningfull specifications in English language are supported - secs, min, #' mins, 2 minutes, 3 years etc. #' \cr #' \code{round_date} takes a date-time object and rounds it to the nearest value #' of the specified time unit. For rounding date-times which is exactly halfway #' between two consecutive units, the convention is to round up. Note that this #' is in line with the behavior of R's base \link[base]{round.POSIXt} function #' but does not follow the convention of the base \link[base]{round} function #' which "rounds to the even digit" per IEC 60559. #' \cr #' \code{floor_date} takes a date-time object and rounds it down to the nearest #' boundary of the specified time unit. #' \cr #' \code{ceiling_date} takes a date-time object and rounds it up to the nearest #' boundary of the specified time unit. #' #' In \code{lubridate} rounding of a date-time objects tries to preserve the #' class of the input object whenever it is meaningful. This is done by first #' rounding to an instant and then converting to the original class by usual R #' conventions. #' #' #' @section Rounding Up Date Objects: #' #' By default rounding up \code{Date} objects follows 3 steps: #' #' \enumerate{ #' #' \item Convert to an instant representing lower bound of the Date: #' \code{2000-01-01} --> \code{2000-01-01 00:00:00} #' #' \item Round up to the \strong{next} closest rounding unit boundary. For #' example, if the rounding unit is \code{month} then next boundary #' for \code{2000-01-01} will be \code{2000-02-01 00:00:00}. #' #' The motivation for this behavior is that \code{2000-01-01} is #' conceptually an interval \code{(2000-01-01 00:00:00 -- 2000-01-02 #' 00:00:00)} and the day hasn't started clocking yet at the exact #' boundary \code{00:00:00}. Thus, it seems wrong to round up a day to #' its lower boundary. #' #' \item If rounding unit is smaller than a day, return the instant from #' step 2 above (\code{POSIXct}), otherwise return the \code{Date} #' immediately following that instant. #' #' } #' #' The behavior on the boundary in the second step above can be changed by #' setting \code{change_on_boundary} to a non-\code{NULL} value. #' #' @rdname round_date #' @param x a vector of date-time objects #' @param unit a character string specifying the time unit or a multiple of a #' unit to be rounded to. Valid base units are second, minute, hour, day, #' week, month, bimonth, quarter, halfyear, or year. Arbitrary unique English #' abbreviations as in \code{\link{period}} constructor are also #' supported. Rounding to multiple of units (except weeks) is supported from #' \code{v1.6.0}. #' @param change_on_boundary If NULL (the default) don't change instants on the #' boundary (\code{ceiling_date(ymd_hms('2000-01-01 00:00:00'))} is #' \code{2000-01-01 00:00:00}), but round up \code{Date} objects to the next #' boundary (\code{ceiling_date(ymd("2000-01-01"), "month")} is #' \code{"2000-02-01"}). When \code{TRUE}, instants on the boundary are #' rounded up to the next boundary. When \code{FALSE}, date-time on the #' boundary are never rounded up (this was the default for \code{lubridate} #' prior to \code{v1.6.0}. See section \code{Rounding Up Date Objects} below #' for more details. #' @keywords manip chron #' @seealso \link[base]{round} #' @examples #' x <- as.POSIXct("2009-08-03 12:01:59.23") #' round_date(x, "second") #' round_date(x, "minute") #' round_date(x, "5 mins") #' round_date(x, "hour") #' round_date(x, "2 hours") #' round_date(x, "day") #' round_date(x, "week") #' round_date(x, "month") #' round_date(x, "bimonth") #' round_date(x, "quarter") == round_date(x, "3 months") #' round_date(x, "halfyear") #' round_date(x, "year") #' #' x <- as.POSIXct("2009-08-03 12:01:59.23") #' floor_date(x, "second") #' floor_date(x, "minute") #' floor_date(x, "hour") #' floor_date(x, "day") #' floor_date(x, "week") #' floor_date(x, "month") #' floor_date(x, "bimonth") #' floor_date(x, "quarter") #' floor_date(x, "halfyear") #' floor_date(x, "year") #' #' x <- as.POSIXct("2009-08-03 12:01:59.23") #' ceiling_date(x, "second") #' ceiling_date(x, "minute") #' ceiling_date(x, "5 mins") #' ceiling_date(x, "hour") #' ceiling_date(x, "day") #' ceiling_date(x, "week") #' ceiling_date(x, "month") #' ceiling_date(x, "bimonth") == ceiling_date(x, "2 months") #' ceiling_date(x, "quarter") #' ceiling_date(x, "halfyear") #' ceiling_date(x, "year") #' @export round_date <- function(x, unit = "second") { if(!length(x)) return(x) parsed_unit <- parse_period_unit(unit) n <- parsed_unit$n basic_unit <- standardise_period_names(parsed_unit$unit) new <- if(n == 1 && basic_unit %in% c("second", "minute", "hour", "day")){ ## special case for fast rounding round.POSIXt(x, units = lub2base_units[[basic_unit]]) } else { above <- unclass(as.POSIXct(ceiling_date(x, unit))) mid <- unclass(as.POSIXct(x)) below <- unclass(as.POSIXct(floor_date(x, unit))) wabove <- (above - mid) <= (mid - below) wabove <- !is.na(wabove) & wabove new <- below new[wabove] <- above[wabove] .POSIXct(new, tz = tz(x)) } reclass_date(new, x) } reclass_date_maybe <- function(new, orig, unit){ if(is.Date(orig) && !unit %in% c("day", "month", "year")) as.POSIXct(new) else reclass_date(new, orig) } #' @rdname round_date #' @export floor_date <- function(x, unit = "seconds") { if(!length(x)) return(x) parsed_unit <- parse_period_unit(unit) n <- parsed_unit$n unit <- standardise_period_names(parsed_unit$unit) if(unit %in% c("second", "minute", "hour", "day")){ out <- trunc_multi_unit(x, unit, n) reclass_date_maybe(out, x, unit) } else { if(n > 1 && unit == "week"){ ## fixme: warning("Multi-unit not supported for weeks. Ignoring.") } if(unit %in% c("bimonth", "quarter", "halfyear")){ switch(unit, bimonth = n <- 2 * n, quarter = n <- 3 * n, halfyear = n <- 6 * n) unit <- "month" } switch(unit, week = update(x, wdays = 1, hours = 0, minutes = 0, seconds = 0), month = { if(n > 1) update(x, months = floor_multi_unit1(month(x), n), mdays = 1, hours = 0, minutes = 0, seconds = 0) else update(x, mdays = 1, hours = 0, minutes = 0, seconds = 0) }, year = { ## due to bug https://github.com/hadley/lubridate/issues/319 we ## need to do it in two steps if(n > 1){ y <- update(x, ydays = 1, hours = 0, minutes = 0, seconds = 0) update(y, years = floor_multi_unit(year(y), n)) } else { update(x, ydays = 1, hours = 0, minutes = 0, seconds = 0) } }) } } #' @rdname round_date #' @export #' @examples #' x <- ymd("2000-01-01") #' ceiling_date(x, "month") #' ceiling_date(x, "month", change_on_boundary = TRUE) ceiling_date <- function(x, unit = "seconds", change_on_boundary = NULL) { if(!length(x)) return(x) parsed_unit <- parse_period_unit(unit) n <- parsed_unit$n unit <- standardise_period_names(parsed_unit$unit) if(is.null(change_on_boundary)){ change_on_boundary <- is.Date(x) } if(unit == "second"){ sec <- second(x) csec <- ceil_multi_unit(sec, n) if(!change_on_boundary){ wsec <- which(csec - n == sec) if(length(wsec)) csec[wsec] <- sec[wsec] } update(x, seconds = csec, simple = T) } else if (unit %in% c("minute", "hour", "day")){ ## cannot use this for minute/hour for Date class; local tz interferes with ## the computation new <- as_datetime(x, tz = tz(x)) delta <- switch(unit, minute = 60, hour = 3600, day = 86400) * n new <- if(change_on_boundary){ trunc_multi_unit(new, unit, n) + delta } else{ new1 <- trunc_multi_unit(new, unit, n) not_same <- new1 != new new1[not_same] <- new1[not_same] + delta new1 } reclass_date_maybe(new, x, unit) } else { if(n > 1 && unit == "week"){ warning("Multi-unit not supported for weeks. Ignoring.") } ## need this to accomodate the case when date is on a boundary new <- if(change_on_boundary) x else update(x, seconds = second(x) - 0.00001, simple = T) if(unit %in% c("bimonth", "quarter", "halfyear")){ switch(unit, bimonth = n <- 2 * n, quarter = n <- 3 * n, halfyear = n <- 6 * n) unit <- "month" } new <- switch(unit, minute = update(new, minute = ceil_multi_unit(minute(new), n), second = 0, simple = T), hour = update(new, hour = ceil_multi_unit(hour(new), n), minute = 0, second = 0, simple = T), week = update(new, wday = 8, hour = 0, minute = 0, second = 0), month = update(new, month = ceil_multi_unit1(month(new), n), mdays = 1, hours = 0, minutes = 0, seconds = 0), year = update(new, year = ceil_multi_unit(year(new), n), month = 1, mday = 1, hour = 0, minute = 0, second = 0)) reclass_date_maybe(new, x, unit) } } trunc_multi_unit <- function(x, unit, n){ y <- as.POSIXlt(x) switch(unit, second = { y$sec <- if(n == 1) trunc(y$sec) else floor_multi_unit(y$sec, n) }, minute = { y$sec[] <- 0 y$min <- floor_multi_unit(y$min, n) }, hour = { y$sec[] <- 0 y$min[] <- 0L y$hour <- floor_multi_unit(y$hour, n) }, day = { y$sec[] <- 0 y$min[] <- 0L y$hour[] <- 0L y$isdst[] <- -1L y$mday <- floor_multi_unit1(y$mday, n) }, stop("Invalid unit ", unit)) y } floor_multi_unit <- function(n, len) { (n %/% len) * len } floor_multi_unit1 <- function(n, len) { (((n - 1) %/% len) * len) + 1L } ceil_multi_unit <- function(n, len) { (n %/% len) * len + len } ceil_multi_unit1 <- function(n, len) { (((n - 1) %/% len) * len) + len + 1L } lubridate/R/ops-%m+%.r0000644000175100001440000001400612763544372014065 0ustar hornikusers#' @include timespans.r #' @include durations.r #' @include intervals.r #' @include periods.r #' @include Dates.r #' @include difftimes.r #' @include numeric.r #' @include POSIXt.r #' @include ops-addition.r NULL #' Add and subtract months to a date without exceeding the last day of the new month #' #' Adding months frustrates basic arithmetic because consecutive months have #' different lengths. With other elements, it is helpful for arithmetic to #' perform automatic roll over. For example, 12:00:00 + 61 seconds becomes #' 12:01:01. However, people often prefer that this behavior NOT occur with #' months. For example, we sometimes want January 31 + 1 month = February 28 and #' not March 3. \%m+\% performs this type of arithmetic. Date \%m+\% months(n) #' always returns a date in the nth month after Date. If the new date would #' usually spill over into the n + 1th month, \%m+\% will return the last day of #' the nth month (\code{\link{rollback}}. Date \%m-\% months(n) always returns a #' date in the nth month before Date. #' #' \%m+\% and \%m-\% handle periods with components less than a month by first #' adding/substracting months and then performing usual arithmetics with smaller #' units. #' #' \%m+\% and \%m-\% should be used with caution as they are not one-to-one #' operations and results for either will be sensitive to the order of #' operations. #' #' @rdname mplus #' @usage e1 \%m+\% e2 #' @aliases m+ %m+% m- %m-% %m+%,ANY,ANY-method %m-%,ANY,ANY-method %m+%,Period,ANY-method %m+%,ANY,Period-method %m-%,Period,ANY-method %m-%,ANY,Period-method %m+%,Duration,ANY-method %m+%,ANY,Duration-method %m-%,Duration,ANY-method %m-%,ANY,Duration-method %m+%,Interval,ANY-method %m+%,ANY,Interval-method %m-%,Interval,ANY-method %m-%,ANY,Interval-method #' @param e1 A period or a date-time object of class \code{\link{POSIXlt}}, \code{\link{POSIXct}} #' or \code{\link{Date}}. #' @param e2 A period or a date-time object of class \code{\link{POSIXlt}}, \code{\link{POSIXct}} #' or \code{\link{Date}}. Note that one of e1 and e2 must be a period and the other a #' date-time object. #' @return A date-time object of class POSIXlt, POSIXct or Date #' @examples #' jan <- ymd_hms("2010-01-31 03:04:05") #' jan + months(1:3) # Feb 31 and April 31 returned as NA #' # NA "2010-03-31 03:04:05 UTC" NA #' jan %m+% months(1:3) # No rollover #' #' leap <- ymd("2012-02-29") #' "2012-02-29 UTC" #' leap %m+% years(1) #' leap %m+% years(-1) #' leap %m-% years(1) #' @export "%m+%" <- function(e1,e2) standardGeneric("%m+%") #' @export setGeneric("%m+%") #' @export setMethod("%m+%", signature(e2 = "Period"), function(e1, e2) add_with_rollback(e1, e2)) #' @export setMethod("%m+%", signature(e1 = "Period"), function(e1, e2) add_with_rollback(e2, e1)) #' @export setMethod("%m+%", signature(e2 = "ANY"), function(e1, e2) stop("%m+% handles only Period objects as second argument")) #' @export "%m-%" <- function(e1,e2) standardGeneric("%m-%") #' @export setGeneric("%m-%") #' @export setMethod("%m-%", signature(e2 = "Period"), function(e1, e2) add_with_rollback(e1, -e2)) #' @export setMethod("%m-%", signature(e1 = "Period"), function(e1, e2) add_with_rollback(e2, -e1)) #' @export setMethod("%m-%", signature(e2 = "ANY"), function(e1, e2) stop("%m-% handles only Period objects as second argument")) #' \code{add_with_rollback} provides additional functionality to \%m+\% and #' \%m-\%. It allows rollback to first day of the month instead of the last day #' of the previous month and controls whether HMS component of the end date is #' preserved or not. #' @rdname mplus #' @param roll_to_first rollback to the first day of the month instead of the #' last day of the previous month (passed to \code{\link{rollback}}) #' @param preserve_hms retains the same hour, minute, and second information? If #' FALSE, the new date will be at 00:00:00 (passed to \code{\link{rollback}}) #' @export add_with_rollback <- function(e1, e2, roll_to_first = FALSE, preserve_hms = TRUE) { any_HMS <- any(e2@.Data != 0) || any(e2@minute != 0) || any(e2@hour != 0) || any(e2@day != 0) any_year <- any(e2@year != 0) if (!is.na(any_year) && any_year) { e2$month <- 12 * e2@year + e2@month e2$year <- 0L } new <- .quick_month_add(e1, e2@month) roll <- day(new) < day(e1) roll <- !is.na(roll) & roll new[roll] <- rollback(new[roll], roll_to_first = roll_to_first, preserve_hms = preserve_hms) if(!is.na(any_HMS) && any_HMS) { e2$month <- 0L new + e2 } else { new } } .quick_month_add <- function(object, mval) { tzs <- tz(object) utc <- as.POSIXlt(force_tz(object, tzone = "UTC")) utc$mon <- utc$mon + mval utc <- as.POSIXct(utc) new <- force_tz(utc, tzone = tzs) reclass_date(new, object) } #' Roll back date to last day of previous month #' #' rollback changes a date to the last day of the previous month or to the first #' day of the month. Optionally, the new date can retain the same hour, minute, #' and second information. #' #' @export #' @param dates A POSIXct, POSIXlt or Date class object. #' @param roll_to_first Rollback to the first day of the month instead of the #' last day of the previous month #' @param preserve_hms Retains the same hour, minute, and second information? If #' FALSE, the new date will be at 00:00:00. #' @return A date-time object of class POSIXlt, POSIXct or Date, whose day has #' been adjusted to the last day of the previous month, or to the first day of #' the month. #' @examples #' date <- ymd("2010-03-03") #' rollback(date) #' #' dates <- date + months(0:2) #' rollback(dates) #' #' date <- ymd_hms("2010-03-03 12:44:22") #' rollback(date) #' rollback(date, roll_to_first = TRUE) #' rollback(date, preserve_hms = FALSE) #' rollback(date, roll_to_first = TRUE, preserve_hms = FALSE) rollback <- function(dates, roll_to_first = FALSE, preserve_hms = TRUE) { if (length(dates) == 0) return(dates) day(dates) <- 1 if (!preserve_hms) { hour(dates) <- 0 minute(dates) <- 0 second(dates) <- 0 } if (roll_to_first) { dates } else { dates - days(1) } } lubridate/R/parse.r0000644000175100001440000010302112757675016013756 0ustar hornikusers##' Parse dates according to the order in that year, month, and day elements ##' appear in the input vector. ##' ##' Transforms dates stored in character and numeric vectors to Date or POSIXct ##' objects (see \code{tz} argument). These functions recognize arbitrary ##' non-digit separators as well as no separator. As long as the order of ##' formats is correct, these functions will parse dates correctly even when the ##' input vectors contain differently formatted dates. See examples. ##' ##' If \code{truncated} parameter is non-zero \code{ymd} functions also check for ##' truncated formats. For example \code{ymd} with \code{truncated = 2} will also ##' parse incomplete dates like \code{2012-06} and \code{2012}. ##' ##' NOTE: \code{ymd} family of functions are based on `parse_date_time` and thus ##' directly drop to internal C parser for numeric months, but use R's ##' `strptime` for alphabetic months. This implies that some of the `strptime`'s ##' limitations are inherited by lubridate's parser. For example truncated ##' formats (like \%Y-\%b) will not be parsed. Numeric truncated formats (like ##' \%Y-\%m) are handled correctly by lubridate's C parser. ##' ##' As of version 1.3.0, lubridate's parse functions no longer return a ##' message that displays which format they used to parse their input. You can ##' change this by setting the \code{lubridate.verbose} option to TRUE with ##' \code{options(lubridate.verbose = TRUE)}. ##' ##' @export ##' @param ... a character or numeric vector of suspected dates ##' @param quiet logical. When TRUE function evalueates without displaying ##' customary messages. ##' @param tz Time zone indicator. If NULL (default) a Date object is ##' returned. Otherwise a POSIXct with time zone attribute set to \code{tz}. ##' @param locale locale to be used, see \link{locales}. On linux systems you ##' can use \code{system("locale -a")} to list all the installed locales. ##' @param truncated integer. Number of formats that can be truncated. ##' @return a vector of class POSIXct if tz argument is non-NULL or Date if tz ##' is NULL (default) ##' @seealso \code{\link{parse_date_time}} for an even more flexible low level ##' mechanism. ##' @keywords chron ##' @examples ##' x <- c("09-01-01", "09-01-02", "09-01-03") ##' ymd(x) ##' x <- c("2009-01-01", "2009-01-02", "2009-01-03") ##' ymd(x) ##' ymd(090101, 90102) ##' now() > ymd(20090101) ##' ## TRUE ##' dmy(010210) ##' mdy(010210) ##' ##' ## heterogenuous formats in a single vector: ##' x <- c(20090101, "2009-01-02", "2009 01 03", "2009-1-4", ##' "2009-1, 5", "Created on 2009 1 6", "200901 !!! 07") ##' ymd(x) ##' ##' ## What lubridate might not handle: ##' ##' ## Extremely weird cases when one of the separators is "" and some of the ##' ## formats are not in double digits might not be parsed correctly: ##' \dontrun{ymd("201002-01", "201002-1", "20102-1") ##' dmy("0312-2010", "312-2010")} ymd <- function(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx(..., orders = "ymd", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd ydm <- function(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx(..., orders = "ydm", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd mdy <- function(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx(..., orders = "mdy", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd myd <- function(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx(..., orders = "myd", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd dmy <- function(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx(..., orders = "dmy", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd dym <- function(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx(..., orders = "dym", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd yq <- function(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME")) .parse_xxx(..., orders = "yq", quiet = quiet, tz = tz, locale = locale, truncated = 0) ##' Parse dates that have hours, minutes, or seconds elements. ##' ##' Transform dates stored as character or numeric vectors to POSIXct ##' objects. ymd_hms family of functions recognize all non-alphanumeric ##' separators (with the exception of "." if \code{frac = TRUE}) and correctly ##' handle heterogeneous date-time representations. For more flexibility in ##' treatment of heterogeneous formats, see low level parser ##' \code{\link{parse_date_time}}. ##' ##' ymd_hms() functions automatically assigns the Universal Coordinated Time ##' Zone (UTC) to the parsed date. This time zone can be changed with ##' \code{\link{force_tz}}. ##' ##' The most common type of irregularity in date-time data is the truncation ##' due to rounding or unavailability of the time stamp. If \code{truncated} ##' parameter is non-zero \code{ymd_hms} functions also check for truncated ##' formats. For example \code{ymd_hms} with \code{truncated = 3} will also parse ##' incomplete dates like \code{2012-06-01 12:23}, \code{2012-06-01 12} and ##' \code{2012-06-01}. NOTE: \code{ymd} family of functions are based on ##' \code{strptime} which currently fails to parse \code{\%y-\%m} formats. ##' ##' As of version 1.3.0, lubridate's parse functions no longer return a ##' message that displays which format they used to parse their input. You can ##' change this by setting the \code{lubridate.verbose} option to true with ##' \code{options(lubridate.verbose = TRUE)}. ##' ##' @export ##' @param ... a character vector of dates in year, month, day, hour, minute, ##' second format ##' @param quiet logical. When TRUE function evalueates without displaying customary messages. ##' @param tz a character string that specifies which time zone to parse the date with. The string ##' must be a time zone that is recognized by the user's OS. ##' @param locale locale to be used, see \link{locales}. On linux systems you ##' can use \code{system("locale -a")} to list all the installed locales. ##' @param truncated integer, indicating how many formats can be missing. See details. ##' @return a vector of POSIXct date-time objects ##' @seealso \code{\link{ymd}}, \code{\link{hms}}. \code{\link{parse_date_time}} ##' for underlying mechanism. ##' @keywords POSIXt parse ##' @examples ##' ##' x <- c("2010-04-14-04-35-59", "2010-04-01-12-00-00") ##' ymd_hms(x) ##' x <- c("2011-12-31 12:59:59", "2010-01-01 12:00:00") ##' ymd_hms(x) ##' ##' ##' ## ** heterogenuous formats ** ##' x <- c(20100101120101, "2009-01-02 12-01-02", "2009.01.03 12:01:03", ##' "2009-1-4 12-1-4", ##' "2009-1, 5 12:1, 5", ##' "200901-08 1201-08", ##' "2009 arbitrary 1 non-decimal 6 chars 12 in between 1 !!! 6", ##' "OR collapsed formats: 20090107 120107 (as long as prefixed with zeros)", ##' "Automatic wday, Thu, detection, 10-01-10 10:01:10 and p format: AM", ##' "Created on 10-01-11 at 10:01:11 PM") ##' ymd_hms(x) ##' ##' ## ** fractional seconds ** ##' op <- options(digits.secs=3) ##' dmy_hms("20/2/06 11:16:16.683") ##' options(op) ##' ##' ## ** different formats for ISO8601 timezone offset ** ##' ymd_hms(c("2013-01-24 19:39:07.880-0600", ##' "2013-01-24 19:39:07.880", "2013-01-24 19:39:07.880-06:00", ##' "2013-01-24 19:39:07.880-06", "2013-01-24 19:39:07.880Z")) ##' ##' ## ** internationalization ** ##' \dontrun{ ##' x_RO <- "Ma 2012 august 14 11:28:30 " ##' ymd_hms(x_RO, locale = "ro_RO.utf8") ##' } ##' ##' ## ** truncated time-dates ** ##' x <- c("2011-12-31 12:59:59", "2010-01-01 12:11", "2010-01-01 12", "2010-01-01") ##' ymd_hms(x, truncated = 3) ##' x <- c("2011-12-31 12:59", "2010-01-01 12", "2010-01-01") ##' ymd_hm(x, truncated = 2) ##' ## ** What lubridate might not handle ** ##' ## Extremely weird cases when one of the separators is "" and some of the ##' ## formats are not in double digits might not be parsed correctly: ##' \dontrun{ ##' ymd_hm("20100201 07-01", "20100201 07-1", "20100201 7-01")} ##' ymd_hms <- function(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0){ .parse_xxx_hms(..., orders = c("ymdTz", "ymdT"), quiet = quiet, tz = tz, locale = locale, truncated = truncated) } #' @export #' @rdname ymd_hms ymd_hm <- function(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx_hms(..., orders = "ymdR", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd_hms ymd_h <- function(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx_hms(..., orders = "ymdr", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd_hms dmy_hms <- function(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx_hms(..., orders = c("dmyTz", "dmyT"), quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd_hms dmy_hm <- function(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx_hms(..., orders = "dmyR", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd_hms dmy_h <- function(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx_hms(..., orders = "dmyR", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd_hms mdy_hms <- function(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx_hms(..., orders = c("mdyTz", "mdyT"), quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd_hms mdy_hm <- function(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx_hms(..., orders = "mdyR", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd_hms mdy_h <- function(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx_hms(..., orders = "mdyr", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd_hms ydm_hms <- function(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx_hms(..., orders = c("ydmTz", "ydmT"), quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd_hms ydm_hm <- function(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx_hms(..., orders = "ydmR", quiet = quiet, tz = tz, locale = locale, truncated = truncated) #' @export #' @rdname ymd_hms ydm_h <- function(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) .parse_xxx_hms(..., orders = "ydmR", quiet = quiet, tz = tz, locale = locale, truncated = truncated) ##' @rdname hms ##' @examples ##' ms(c("09:10", "09:02", "1:10")) ##' ms("7 6") ##' ms("6,5") ##' @export ms <- function(..., quiet = FALSE, roll = FALSE) { out <- .parse_hms(..., order = "MS", quiet = quiet) if(roll){ hms <- .roll_hms(min = out["M", ], sec = out["S", ]) period(hour = hms$hour, minute = hms$min, second = hms$sec) } else { period(minute = out["M", ], second = out["S", ]) } } ##' @rdname hms ##' @examples ##' hm(c("09:10", "09:02", "1:10")) ##' hm("7 6") ##' hm("6,5") ##' @export hm <- function(..., quiet = FALSE, roll = FALSE) { out <- .parse_hms(..., order = "HM", quiet = quiet) if(roll){ hms <- .roll_hms(hour = out["H", ], min = out["M", ]) period(hour = hms$hour, minute = hms$min, second = hms$sec) } else { period(hour = out["H", ], minute = out["M", ]) } } ##' Create a period with the specified hours, minutes, and seconds ##' ##' Transforms a character or numeric vector into a period object with the ##' specified number of hours, minutes, and seconds. hms() recognizes all ##' non-numeric characters except '-' as separators ('-' is used for negative ##' durations). After hours, minutes and seconds have been parsed, the ##' remaining input is ingored. ##' ##' @param ... a character vector of hour minute second triples ##' @param quiet logical. When TRUE function evalueates without displaying ##' customary messages. ##' @param roll logica. When TRUE smaller units are rolled over to higher units ##' if they exceed the conventional limit. For example \code{hms("01:59:120", ##' roll=TRUE)} produces period "2H 1M 0S". ##' @return a vector of period objects ##' @seealso \code{\link{hm}, \link{ms}} ##' @keywords period ##' @useDynLib lubridate parse_hms ##' @examples ##' ##' x <- c("09:10:01", "09:10:02", "09:10:03") ##' hms(x) ##' ##' hms("7 6 5", "3:23:::2", "2 : 23 : 33", "Finished in 9 hours, 20 min and 4 seconds") ##' @export hms <- function(..., quiet = FALSE, roll = FALSE) { out <- .parse_hms(..., order = "HMS", quiet = quiet) if(roll){ hms <- .roll_hms(out["H", ], out["M", ], out["S", ]) period(hour = hms$hour, minute = hms$min, second = hms$sec) } else { period(hour = out["H", ], minute = out["M", ], second = out["S", ]) } } .roll_hms <- function(hour = 0, min = 0, sec = 0){ min <- min + sec %/% 60 sec <- sec %% 60 hour <- hour + min %/% 60 min <- min %% 60 list(hour = hour, min = min, sec = sec) } .parse_hms <- function(..., order, quiet = FALSE){ ## wraper for C level parse_hms hms <- unlist(lapply(list(...), .num_to_date), use.names= FALSE) out <- matrix(.Call("parse_hms", hms, order), nrow = 3L, dimnames = list(c("H", "M", "S"), NULL)) if(!quiet && all(is.na(out[substr(order, ln <- nchar(order), ln), ]))) warning("Some strings failed to parse") out } ##' Parse character and numeric date-time vectors with user friendly order ##' formats. ##' ##' \code{parse_date_time} parses an input vector into POSIXct date-time ##' object. It differs from \code{\link[base]{strptime}} in two respects. First, ##' it allows specification of the order in which the formats occur without the ##' need to include separators and "\%" prefix. Such a formating argument is ##' refered to as "order". Second, it allows the user to specify several ##' format-orders to handle heterogeneous date-time character ##' representations. \cr \code{parse_date_time2} is a fast C parser of numeric ##' orders. \cr \code{fast_strptime} is a fast C parser of numeric formats only ##' that accepts explicit format arguments, just as ##' \code{\link[base]{strptime}}. ##' ##' When several format-orders are specified \code{parse_date_time} sorts the ##' supplied format-orders based on a training set and then applies them ##' recursively on the input vector. ##' ##' \code{parse_date_time}, and all derived functions, such as \code{ymd_hms}, ##' \code{ymd} etc, will drop into \code{fast_strptime} instead of ##' \code{strptime} whenever the guessed from the input data formats are all ##' numeric. ##' ##' The list below contains formats recognized by lubridate. For numeric formats ##' leading 0s are optional. As compared to base \code{strptime}, some of the ##' formats are new or have been extended for efficiency reasons. These formats ##' are marked with "*". Fast parsers, \code{parse_date_time2} and ##' \code{fast_strptime}, accept only formats marked with "!". ##' ##' ##' \describe{ \item{\code{a}}{Abbreviated weekday name in the current ##' locale. (Also matches full name)} ##' ##' \item{\code{A}}{Full weekday name in the current locale. (Also matches ##' abbreviated name). ##' ##' You need not specify \code{a} and \code{A} formats explicitly. Wday is ##' automatically handled if \code{preproc_wday = TRUE}} ##' ##' \item{\code{b}!}{Abbreviated month name in the current locale (also matches ##' full name). C parser understands English months only.} ##' ##' \item{\code{B}!}{Same as b.} ##' ##' \item{\code{d}!}{Day of the month as decimal number (01--31 or 0--31)} ##' ##' \item{\code{H}!}{Hours as decimal number (00--24 or 0--24).} ##' ##' \item{\code{I}!}{Hours as decimal number (01--12 or 1--12).} ##' ##' \item{\code{j}}{Day of year as decimal number (001--366 or 1--366).} ##' ##' \item{\code{q}!*}{Quarter (1-4). The quarter month is added to parsed month ##' if \code{m} format is present.} ##' ##' \item{\code{m}!*}{Month as decimal number (01--12 or 1--12). For ##' \code{parse_date_time}. As lubridate extension, also ##' matches abbreviated and full months names as \code{b} and ##' \code{B} formats. C parser understands only English month ##' names.} ##' ##' \item{\code{M}!}{Minute as decimal number (00--59 or 0--59).} ##' ##' \item{\code{p}!}{AM/PM indicator in the locale. Normally used in conjunction ##' with \code{I} and \bold{not} with \code{H}. But lubridate ##' C parser accepts H format as long as hour is not greater ##' than 12. C parser understands only English locale AM/PM ##' indicator.} ##' ##' \item{\code{S}!}{Second as decimal number (00--61 or 0--61), allowing for up ##' to two leap-seconds (but POSIX-compliant implementations will ignore leap ##' seconds).} ##' ##' \item{\code{OS}}{Fractional second.} ##' ##' \item{\code{U}}{Week of the year as decimal number (00--53 or 0-53) using ##' Sunday as the first day 1 of the week (and typically with the first Sunday ##' of the year as day 1 of week 1). The US convention.} ##' ##' \item{\code{w}}{Weekday as decimal number (0--6, Sunday is 0).} ##' ##' \item{\code{W}}{Week of the year as decimal number (00--53 or 0-53) using ##' Monday as the first day of week (and typically with the first Monday of the ##' year as day 1 of week 1). The UK convention.} ##' ##' \item{\code{y}!*}{Year without century (00--99 or 0--99). In ##' \code{parse_date_time} also matches year with century (Y format).} ##' ##' \item{\code{Y}!}{Year with century.} ##' ##' \item{\code{z}!*}{ISO8601 signed offset in hours and minutes from UTC. For ##' example \code{-0800}, \code{-08:00} or \code{-08}, all represent 8 hours ##' behind UTC. This format also matches the Z (Zulu) UTC indicator. Because ##' strptime doesn't fully support ISO8601 this format is implemented as an ##' union of 4 orders: Ou (Z), Oz (-0800), OO (-08:00) and Oo (-08). You can use ##' these four orders as any other but it is rarely ##' necessary. \code{parse_date_time2} and \code{fast_strptime} support all of ##' the timezone formats.} ##' ##' \item{\code{Om}!*}{Matches numeric month and English alphabetic months ##' (Both, long and abbreviated forms).} ##' ##' \item{\code{Op}!*}{Matches AM/PM English indicator.} ##' ##' \item{\code{r}*}{Matches \code{Ip} and \code{H} orders.} ##' \item{\code{R}*}{Matches \code{HM} and\code{IMp} orders.} ##' \item{\code{T}*}{Matches \code{IMSp}, \code{HMS}, and \code{HMOS} orders.} ##' } ##' ##' ##' @export ##' @param x a character or numeric vector of dates ##' @param orders a character vector of date-time formats. Each order string is ##' series of formatting characters as listed \code{\link[base]{strptime}} but ##' might not include the "\%" prefix, for example "ymd" will match all the ##' possible dates in year, month, day order. Formatting orders might include ##' arbitrary separators. These are discarded. See details for implemented ##' formats. ##' @param tz a character string that specifies the time zone with which to ##' parse the dates ##' @param truncated integer, number of formats that can be missing. The most ##' common type of irregularity in date-time data is the truncation due to ##' rounding or unavailability of the time stamp. If \code{truncated} ##' parameter is non-zero \code{parse_date_time} also checks for truncated ##' formats. For example, if the format order is "ymdHMS" and \code{truncated ##' = 3}, \code{parse_date_time} will correctly parse incomplete dates like ##' \code{2012-06-01 12:23}, \code{2012-06-01 12} and ##' \code{2012-06-01}. \bold{NOTE:} \code{ymd} family of functions are based ##' on \code{strptime} which currently fails to parse \code{\%y-\%m} formats. ##' @param quiet logical. When TRUE progress messages are not printed, and ##' "no formats found" error is surpresed and the function simply returns a ##' vector of NAs. This mirrors the behavior of base R functions ##' \code{strptime} and \code{as.POSIXct}. Default is FALSE. ##' @param locale locale to be used, see \link{locales}. On linux systems you ##' can use \code{system("locale -a")} to list all the installed locales. ##' @param select_formats A function to select actual formats for parsing from a ##' set of formats which matched a training subset of \code{x}. it receives a ##' named integer vector and returns a character vector of selected ##' formats. Names of the input vector are formats (not orders) that matched ##' the training set. Numeric values are the number of dates (in the training ##' set) that matched the corresponding format. You should use this argument ##' if the default selection method fails to select the formats in the right ##' order. By default the formats with most formating tockens (\%) are ##' selected and \%Y counts as 2.5 tockens (so that it has a priority over ##' \%y\%m). Se examples. ##' @param exact logical. If \code{TRUE}, \code{orders} parameter is interpreted ##' as an exact \code{strptime} format and no trainign or guessing are ##' performed. ##' @return a vector of POSIXct date-time objects ##' @seealso \code{strptime}, \code{\link{ymd}}, \code{\link{ymd_hms}} ##' @keywords chron ##' @note \code{parse_date_time} (and the derivatives \code{ymb}, \code{ymd_hms} ##' etc) rely on a sparse guesser that takes at most 501 elements from the ##' supplied character vector in order to identify appropriate formats from ##' the supplied orders. If you get the error \code{All formats failed to ##' parse} and you are confident that your vector contains valid dates, you ##' should either set \code{exact} argument to TRUE or use functions that ##' don't perform format guessing (\code{fast_strptime}, ##' \code{parse_date_time2} or \code{strptime} ). ##' @note For performance reasons, when timezone is not UTC, ##' \code{parse_date_time2} and \code{fast_strptime} perform no validity ##' checks for daylight savings time. Thus, if your input string contains an ##' invalid date time which falls into DST gap and \code{lt=TRUE} you will get ##' an \code{POSIXlt} object with a non-existen time. If \code{lt=FALSE} your ##' time instant will be adjusted to a valid time by adding an hour. See ##' examples. If you want to get NA for invalid date-times use ##' \code{\link{fit_to_timeline}} explicitely. ##' ##' @examples ##' ##' ## ** orders are much easier to write ** ##' x <- c("09-01-01", "09-01-02", "09-01-03") ##' parse_date_time(x, "ymd") ##' parse_date_time(x, "y m d") ##' parse_date_time(x, "%y%m%d") ##' # "2009-01-01 UTC" "2009-01-02 UTC" "2009-01-03 UTC" ##' ##' ## ** heterogenuous date-times ** ##' x <- c("09-01-01", "090102", "09-01 03", "09-01-03 12:02") ##' parse_date_time(x, c("ymd", "ymd HM")) ##' ##' ## ** different ymd orders ** ##' x <- c("2009-01-01", "02022010", "02-02-2010") ##' parse_date_time(x, c("dmY", "ymd")) ##' ## "2009-01-01 UTC" "2010-02-02 UTC" "2010-02-02 UTC" ##' ##' ## ** truncated time-dates ** ##' x <- c("2011-12-31 12:59:59", "2010-01-01 12:11", "2010-01-01 12", "2010-01-01") ##' parse_date_time(x, "Ymd HMS", truncated = 3) ##' ##' ## ** specifying exact formats and avoiding training and guessing ** ##' parse_date_time(x, c("%m-%d-%y", "%m%d%y", "%m-%d-%y %H:%M"), exact = TRUE) ##' parse_date_time(c('12/17/1996 04:00:00','4/18/1950 0130'), ##' c('%m/%d/%Y %I:%M:%S','%m/%d/%Y %H%M'), exact = TRUE) ##' ##' ## ** quarters and partial dates ** ##' parse_date_time(c("2016.2", "2016-04"), orders = "Yq") ##' parse_date_time(c("2016", "2016-04"), orders = c("Y", "Ym")) ##' ##' ## ** fast parsing ** ##' \dontrun{ ##' options(digits.secs = 3) ##' ## random times between 1400 and 3000 ##' tt <- as.character(.POSIXct(runif(1000, -17987443200, 32503680000))) ##' tt <- rep.int(tt, 1000) ##' ##' system.time(out <- as.POSIXct(tt, tz = "UTC")) ##' system.time(out1 <- ymd_hms(tt)) # constant overhead on long vectors ##' system.time(out2 <- parse_date_time2(tt, "YmdHMOS")) ##' system.time(out3 <- fast_strptime(tt, "%Y-%m-%d %H:%M:%OS")) ##' ##' all.equal(out, out1) ##' all.equal(out, out2) ##' all.equal(out, out3) ##' } ##' ##' ## ** how to use `select_formats` argument ** ##' ## By default %Y has precedence: ##' parse_date_time(c("27-09-13", "27-09-2013"), "dmy") ##' ##' ## to give priority to %y format, define your own select_format function: ##' ##' my_select <- function(trained){ ##' n_fmts <- nchar(gsub("[^%]", "", names(trained))) + grepl("%y", names(trained))*1.5 ##' names(trained[ which.max(n_fmts) ]) ##' } ##' ##' parse_date_time(c("27-09-13", "27-09-2013"), "dmy", select_formats = my_select) ##' ##' ## ** invalid times with "fast" parcing ** ##' parse_date_time("2010-03-14 02:05:06", "YmdHMS", tz = "America/New_York") ##' parse_date_time2("2010-03-14 02:05:06", "YmdHMS", tz = "America/New_York") ##' parse_date_time2("2010-03-14 02:05:06", "YmdHMS", tz = "America/New_York", lt = TRUE) parse_date_time <- function(x, orders, tz = "UTC", truncated = 0, quiet = FALSE, locale = Sys.getlocale("LC_TIME"), select_formats = .select_formats, exact = FALSE){ orig_locale <- Sys.getlocale("LC_TIME") Sys.setlocale("LC_TIME", locale) on.exit(Sys.setlocale("LC_TIME", orig_locale)) x <- as.character(.num_to_date(x)) if( truncated != 0 ) orders <- .add_truncated(orders, truncated) .local_parse <- function(x, first = FALSE){ formats <- if(exact){ orders } else { train <- .get_train_set(x) .best_formats(train, orders, locale = locale, select_formats) } if( length(formats) > 0 ){ out <- .parse_date_time(x, formats, tz = tz, quiet = quiet) new_na <- is.na(out) if( any(new_na) ){ x <- x[new_na] if(length(x) < length(out)) # don't recur if failed for all out[new_na] <- .local_parse(x) } out }else{ if ( first && !quiet) { warning("All formats failed to parse. No formats found.", call. = FALSE) warned <<- TRUE } failed <<- length(x) NA } } failed <- 0L warned <- FALSE to_parse <- !is.na(x) & nzchar(x) ## missing data might be "" ## prepare an NA vector out <- .POSIXct(rep.int(NA, length(x)), tz = tz) out[to_parse] <- .local_parse(x[to_parse], TRUE) if( failed > 0 && !quiet && !warned ) warning(" ", failed, " failed to parse.", call. = FALSE) out } ##' @rdname parse_date_time ##' @export ##' @param lt logical. If TRUE returned object is of class POSIXlt, and POSIXct ##' otherwise. For compatibility with base `strptime` function default is TRUE ##' for `fast_strptime` and FALSE for `parse_date_time2`. parse_date_time2 <- function(x, orders, tz = "UTC", exact = FALSE, lt = FALSE){ if(length(orders) > 1) warning("Multiple orders supplied. Only first order is used.") if(!exact) orders <- gsub("[^[:alpha:]]+", "", as.character(orders[[1]])) ## remove all separators if(lt){ .mklt(.Call("parse_dt", x, orders, FALSE, TRUE), tz) } else { if (tz == "UTC"){ .POSIXct(.Call("parse_dt", x, orders, FALSE, FALSE), tz = "UTC") } else { as.POSIXct(.mklt(.Call("parse_dt", x, orders, FALSE, TRUE), tz)) } } } ##' @useDynLib lubridate parse_dt ##' @rdname parse_date_time ##' @export ##' @param format a character string of formats. It should include all the ##' separators and each format must be prefixed with %, just as in the format ##' argument of \code{strptime}. fast_strptime <- function(x, format, tz = "UTC", lt = TRUE){ if(length(format) > 1) warning("Multiple formats supplied. Only first format is used.") format <- as.character(format[[1]]) if(lt){ .mklt(.Call("parse_dt", x, format, TRUE, TRUE), tz) } else{ if(tz == "UTC"){ .POSIXct(.Call("parse_dt", x, format, TRUE, FALSE), "UTC") } else { as.POSIXct(.mklt(.Call("parse_dt", x, format, TRUE, TRUE), tz)) } } } ### INTERNAL .mklt <- function(dtlist, tz){ na_fill <- rep_len(NA_integer_, length(dtlist$sec)) dtlist[["wday"]] <- na_fill dtlist[["yday"]] <- na_fill dtlist[["isdst"]] <- -1L .POSIXlt(dtlist, tz = tz) } .parse_date_time <- function(x, formats, tz, quiet){ ## print(formats) # for debugging out <- .strptime(x, formats[[1]], tz = tz, quiet = quiet) na <- is.na(out) newx <- x[na] verbose <- getOption("lubridate.verbose") if( !is.null(verbose) && verbose ) message(" ", sum(!na) , " parsed with ", gsub("^@|@$", "", formats[[1]])) ## recursive parsing if( length(formats) > 1 && length(newx) > 0 ) out[na] <- .parse_date_time(newx, formats[-1], tz = tz, quiet = quiet) ## return POSIXlt out } .strptime <- function(x, fmt, tz = "UTC", quiet = FALSE){ ## Depending on fmt we might need to preprocess x. ## ISO8601 and internal parser are the only cases so far. ## %Ou: "2013-04-16T04:59:59Z" ## %Oo: "2013-04-16T04:59:59+01" ## %Oz: "2013-04-16T04:59:59+0100" ## %OO: "2013-04-16T04:59:59+01:00" ## is_posix <- 0 < regexpr("^[^%]*%Y[^%]+%m[^%]+%d[^%]+(%H[^%](%M[^%](%S)?)?)?[^%Z]*$", fmt) c_parser <- 0 < regexpr("^[^%0-9]*(%([YymdqIHMSz]|O[SzuoOpm])[^%0-9Z]*)+$", fmt) zpos <- regexpr("%O((?z)|(?u)|(?o)|(?O))", fmt, perl = TRUE) if (c_parser) { ## C PARSER: out <- fast_strptime(x, fmt, tz = "UTC", lt = FALSE) if ( tz != "UTC" ){ out <- if( zpos > 0 ){ if( !quiet ) message("Date in ISO8601 format; converting timezone from UTC to \"", tz, "\".") with_tz(out, tzone = tz) } else { ## force_tz is very slow force_tz(out, tzone = tz) } } out } else { ## STRPTIME PARSER: if( zpos > 0 ){ ## If ISO8601 -> pre-process x and fmt capt <- attr(zpos, "capture.names")[attr(zpos, "capture.start") > 0][[2]] ## <- second subexp repl <- switch(capt, z = "%z", u ="Z", ## substitute +aa with +aa00 o = { x <- sub("([+-]\\d{2}(?=\\D+)?$)", "\\100", x, perl = TRUE) "%z"}, ## substitute +aa:bb with +aabb O = { x <- sub("([+-]\\d{2}):(?=[^:]+$)", "\\1", x, perl = TRUE) "%z"}, stop("Unrecognised capture detected; please report this bug")) str_sub(fmt, zpos, zpos + attr(zpos, "match.length") - 1) <- repl ## user has supplied tz argument -> convert to tz if( tz != "UTC" ){ if( !quiet ) message("Date in ISO8601 format; converting timezone from UTC to \"", tz, "\".") return(with_tz(strptime(.enclose(x), .enclose(fmt), "UTC"), tzone = tz)) } } strptime(.enclose(x), .enclose(fmt), tz) } } ## Expand format strings to also include truncated formats ## Get locations of letters as vector ## Choose the number at the n - truncated place in the vector ## return the substring created by 1 to tat number. .add_truncated <- function(orders, truncated){ out <- orders if ( truncated > 0 ) { trunc_one <- function(order) { alphas <- gregexpr("[a-zA-Z]", order)[[1]] start <- max(0, length(alphas) - truncated) cut_points <- alphas[start:(length(alphas)-1)] truncs <- c() for (j in seq_along(cut_points)) truncs <- c(truncs, substr(order, 1, cut_points[j])) truncs } } else { trunc_one <- function(order) { alphas <- gregexpr("[a-zA-Z]", order)[[1]][-1] end <- max(1, abs(truncated) - 1) cut_points <- alphas[1:end] truncs <- c() for (j in seq_along(cut_points)) truncs <- c(truncs, substr(order, cut_points[j], nchar(order))) truncs } } for (i in seq_along(orders)) { out <- c(out, trunc_one(orders[i])) } out } .xxx_hms_truncations <- list(T = c("R", "r", ""), R = c("r", ""), r = "") .parse_xxx_hms <- function(..., orders, truncated, quiet, tz, locale){ ## !!! NOTE: truncated operates on first element in ORDERS ! if( truncated > 0 ){ ## Take first 3 formats and append formats from .xxx_hms_truncations ## co responding to the 4th format letter in order[[1]] -- T, R or r. xxx <- substr(orders[[1]], 1, 3) ## add <- paste(xxx, .xxx_hms_truncations[[substr(orders[[1]], 4, 4)]], sep = "") rest <- length(add) - truncated if( rest < 0 ) orders <- c(orders, add, .add_truncated(xxx, abs(rest))) else orders <- c(orders, add[1:truncated]) } dates <- unlist(lapply(list(...), .num_to_date), use.names = FALSE) parse_date_time(dates, orders, tz = tz, quiet = quiet, locale = locale) } .parse_xxx <- function(..., orders, quiet, tz = NULL, locale = locale, truncated){ dates <- unlist(lapply(list(...), .num_to_date), use.names = FALSE) if(is.null(tz)){ as.Date.POSIXct(parse_date_time(dates, orders, quiet = quiet, tz = "UTC", locale = locale, truncated = truncated)) } else { parse_date_time(dates, orders, quiet = quiet, tz = tz, locale = locale, truncated = truncated) } } .num_to_date <- function(x) { if (is.numeric(x)) { out <- rep.int(as.character(NA), length(x)) nnas <- !is.na(x) x <- format(x[nnas], scientific = FALSE, trim = TRUE) x <- paste(ifelse(nchar(x) %% 2 == 1, "0", ""), x, sep = "") out[nnas] <- x out }else as.character(x) } ## parse.r ends here lubridate/R/accessors-year.r0000644000175100001440000000215612755025406015564 0ustar hornikusers#' @include periods.r NULL #' Get/set years component of a date-time. #' #' Date-time must be a POSIXct, POSIXlt, Date, Period, chron, yearmon, yearqtr, zoo, #' zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. #' #' year does not yet support years before 0 C.E. #' #' @param x a date-time object #' @param value a numeric object #' @return the years element of x as a decimal number #' @keywords utilities manip chron methods #' @examples #' x <- ymd("2012-03-26") #' year(x) #' year(x) <- 2001 #' year(x) > 1995 #' @export year <- function(x) UseMethod("year") #' @export year.default <- function(x) as.POSIXlt(x, tz = tz(x))$year + 1900 #' @export year.Period <- function(x) slot(x, "year") #' @rdname year #' @export "year<-" <- function(x, value) x <- x + years(value - year(x)) setGeneric("year<-") #' @export setMethod("year<-", signature("Period"), function(x, value){ slot(x, "year") <- value x }) #' @rdname year #' @export isoyear <- function(x) { xday <- make_datetime(year(x), month(x), day(x), tz = tz(x)) dn <- 1 + (wday(x) + 5) %% 7 nth <- xday + ddays(4 - dn) year(nth) } lubridate/R/data.r0000644000175100001440000000116412755025406013550 0ustar hornikusers#' Lakers 2008-2009 basketball data set #' #' This data set contains play by play statistics of each Los #' Angeles Lakers basketball game in the 2008-2009 season. Data #' includes the date, opponent, and type of each game (home or #' away). Each play is described by the time on the game clock #' when the play was made, the period in which the play was #' attempted, the type of play, the player and team who made the #' play, the result of the play, and the location on the court #' where each play was made. #' #' @name lakers #' @docType data #' @references \url{http://www.basketballgeek.com/data/} #' @keywords data NULL lubridate/R/ops-compare.r0000644000175100001440000000265712755025406015074 0ustar hornikusers ## #' @export ## setMethod("<", signature(e1 = "POSIXct", e2 = "Date"), ## function(e1, e2) { ## cat("here") ## callNextMethod(e1, .POSIXct(e2, tz = attr(e1, "tzone"))) ## }) ## #' @export ## setMethod("<", signature(e1 = "Date", e2 = "POSIXct"), ## function(e1, e2) { ## cat("here") ## callNextMethod(.POSIXct(e1, tz = attr(e2, "tzone")), e2) ## }) .date_to_posix <- function(date, tz){ utc <- .POSIXct(unclass(date) * 86400, tz = "UTC") ## fixme: force_tz is heavy; could be done much faster by pre-computing the ## offset of tz. if (tz == "UTC") utc else force_tz(utc, tz) } comp_posix_date <- function(e1, e2){ if (nargs() == 1) stop(gettextf("unary '%s' not defined for \"%s\" objects", .Generic, class(e1)), domain = NA) if (inherits(e1, "POSIXlt") || is.character(e1)) e1 <- as.POSIXct(e1) if (inherits(e2, "POSIXlt") || is.character(e2)) e2 <- as.POSIXct(e2) if(is.POSIXct(e1)){ if (is.Date(e2)) e2 <- .date_to_posix(e2, tz(e1)) check_tzones(e1, e2) } else if (is.Date(e1)) { if (is.POSIXt(e2)){ e1 <- .date_to_posix(e1, tz = tz(e2)) } } NextMethod(.Generic) } ## Nothing else seem to work, only this sneaky method. evalqOnLoad({ for(op in c("<", ">", "==", ">=", "<=", "!=")){ registerS3method(op, "Date", comp_posix_date) registerS3method(op, "POSIXt", comp_posix_date) } }) lubridate/R/deprecated.r0000644000175100001440000001355612755025406014747 0ustar hornikusers##' Deprecated function in \code{lubridate} package ##' @param x numeric value to be converted into duration ##' @param ... arguments to be passed to the functions ##' (obscured to enforce the usage of new functions) ##' @rdname Deprecated ##' @name Deprecated-lubridate NULL ## modified ggplot2:::gg_dep .deprecated_fun <- function(replacement, version, n_call = 1) { name <- as.character(sys.call(-(n_call))[[1]]) name <- sprintf("'%s'", name) replacement <- sprintf("; use '%s' instead", replacement) .deprecated(name, replacement, version) } .deprecated_arg <- function(arg, version, n_call = 1){ name <- as.character(sys.call(-n_call)[[1]]) mes <- sprintf("Argument '%s' of '%s'", arg, name) .deprecated(mes, "", version) } .deprecated <- function(name, replacement = NULL, version){ v <- as.package_version(version) cv <- packageVersion("lubridate") replacement <- if(is.null(replacement)) "" else replacement ## If current major number is greater than last-good major number, or if ## current minor number is more than 1 greater than last-good minor number, ## give error. if (cv[[1,1]] > v[[1,1]] || cv[[1,2]] > v[[1,2]] + 1) { stop(sprintf("%s is defunct%s. Deprecated in version '%s'.", name, replacement, version), call. = FALSE) } else if (cv[[1,2]] > v[[1,2]]) { ## If minor number differs by one, give warning warning(sprintf("%s is deprecated%s. Deprecated in version '%s'.", name, replacement, version), call. = FALSE) } else if (cv[[1,3]] >= v[[1,3]]) { ## If only subminor number is greater, give message message(sprintf("%s is deprecated%s. Deprecated in version '%s'.", name, replacement, version)) } invisible() } ##' @rdname Deprecated ##' @export new_period <- function(...) { .deprecated_fun("period", "1.5.0") period(...) } ##' @rdname Deprecated ##' @export new_interval <- function(...) { .deprecated_fun("interval", "1.5.0") interval(...) } ##' @rdname Deprecated ##' @export new_duration <- function(...) { .deprecated_fun("duration", "1.5.0") duration(...) } ##' @rdname Deprecated ##' @export new_difftime <- function(...) { .deprecated_fun("make_difftime", "1.5.0") make_difftime(...) } #' @export #' @rdname Deprecated eseconds <- function(x = 1){ .deprecated_fun("dseconds", "1.5.0") new("Duration", x) } #' @export #' @rdname Deprecated eminutes <- function(x = 1){ .deprecated_fun("dminutes", "1.5.0") new("Duration", x * 60) } #' @export #' @rdname Deprecated ehours <- function(x = 1){ .deprecated_fun("dhours", "1.5.0") new("Duration", x * 3600) } #' @export #' @rdname Deprecated edays <- function(x = 1){ .deprecated_fun("ddays", "1.5.0") new("Duration", x * 86400) } #' @export #' @rdname Deprecated eweeks <- function(x = 1){ .deprecated_fun("dweeks", "1.5.0") new("Duration", x * 604800) } #' @export #' @rdname Deprecated eyears <- function(x = 1){ .deprecated_fun("dyears", "1.5.0") new("Duration", x * 60 * 60 * 24 * 365) } #' @export #' @rdname Deprecated emilliseconds <- function(x = 1){ .deprecated_fun("dmilliseconds", "1.5.0") new("Duration", x / 1000) } #' @export #' @rdname Deprecated emicroseconds <- function(x = 1){ .deprecated_fun("dmicroseconds", "1.5.0") new("Duration", x / 1000 / 1000) } #' @export #' @rdname Deprecated enanoseconds <- function(x = 1){ .deprecated_fun("dnanoseconds", "1.5.0") new("Duration", x / 1000 / 1000 / 1000) } #' @export #' @rdname Deprecated epicoseconds <- function(x = 1){ .deprecated_fun("dpicoseconds", "1.5.0") new("Duration", x / 1000 / 1000 / 1000 / 1000) } #' @export #' @rdname Deprecated here <- function(){ .deprecated_fun("now", "1.5.8") now() } #' @export #' @param order_by Return names alphabetically (the default) or from West to #' East. #' @rdname Deprecated olson_time_zones <- function(order_by = c("name", "longitude")) { .deprecated_fun("OlsonNames", "1.5.8") order_by <- match.arg(order_by) ## compile possible locations for zoneinfo/zone.tab tzdirs <- c( R.home("share"), # Windows ## taken from OlsonNames in R3.0.3 "/usr/share", "/usr/share/lib","/usr/lib/zoneinfo", "/usr/local/etc", "/etc", "/usr/etc") tzfiles <- c(file.path(tzdirs, "zoneinfo", "zone.tab"), ## special treatment of Soloaris > 9 (versions < 8 seem not to ## have it at all) "/usr/share/lib/zoneinfo/tab/zone_sun.tab") tzfiles <- tzfiles[file.exists(tzfiles)] if ( length(tzfiles) == 0 ){ warning("zone.tab file not found in any candidate locations: ", str_join(tzdirs, collapse=" ")) } tzfile <- tzfiles[[1]] tzones <- read.delim( tzfile, row.names = NULL, header = FALSE, col.names = c("country", "coords", "name", "comments"), as.is = TRUE, fill = TRUE, comment.char = "#" ) o <- order(switch( order_by, name = tzones$name, longitude = { longitude_string <- stringr::str_match( tzones$coords, "[+-][[:digit:]]+([+-][[:digit:]]+)" )[, 2] nch <- nchar(longitude_string) sign <- ifelse( substring(longitude_string, 1, 1) == "+", 1, -1 ) nss <- function(first, last) { as.numeric(substring(longitude_string, first, last)) } sign * ifelse( nch == 5, 3600 * nss(2, 3) + 60 * nss(4, 5), ifelse( nch == 6, 3600 * nss(2, 4) + 60 * nss(6, 6), ifelse( nch == 7, 3600 * nss(2, 3) + 60 * nss(4, 5) + nss(6, 7), 3600 * nss(2, 4) + 60 * nss(6, 6) + nss(7, 8) ) ) ) } )) tzones$name[o] } lubridate/R/pretty.r0000644000175100001440000000613012755025406014164 0ustar hornikusers#' Computes attractive axis breaks for date-time data #' #' pretty.dates indentifies which unit of time the sub-intervals should be #' measured in to provide approximately n breaks. It then chooses a "pretty" #' length for the sub-intervals and sets start and endpoints that 1) span the #' entire range of the data, and 2) allow the breaks to occur on important #' date-times (i.e. on the hour, on the first of the month, etc.) #' #' @param x a vector of POSIXct, POSIXlt, Date, or chron date-time objects #' @param n integer value of the desired number of breaks #' @param ... additional arguments to pass to function #' @return a vector of date-times that can be used as axis tick marks or bin breaks #' @keywords dplot utilities chron #' @export #' @examples #' x <- seq.Date(as.Date("2009-08-02"), by = "year", length.out = 2) #' pretty_dates(x, 12) pretty_dates <- function(x, n, ...){ otz <- Sys.getenv("TZ") if (Sys.getenv("TZ") == "") otz <- "unset" Sys.setenv(TZ = tz(x[1])) on.exit(if (otz == "unset") Sys.unsetenv("TZ") else Sys.setenv(TZ = otz)) rng <- range(x) diff <- difftime(rng[2], rng[1], units = "secs") binunits <- pretty_unit(diff/n) f <- get(paste("pretty", binunits, sep = "_"), mode = "function") binlength <- f(diff, n) start <- pretty_point(min(rng), binunits, binlength) end <- pretty_point(max(rng), binunits, binlength, start = FALSE) breaks <- seq.POSIXt(start, end, paste(binlength, binunits)) breaks } pretty_unit <- function(x, ...){ if (x > 3600*24*365) return("year") if (x > 3600*24*30) return("month") if (x > 3600*24) return("day") if (x > 3600) return("hour") if (x > 60) return("min") else return("sec") } pretty_sec <- function(x, n, ...){ lengths <- c(1,2,5,10,15,30,60) fit <- abs(x - lengths*n) lengths[which.min(fit)] } pretty_min <- function(x, n, ...){ span <- x/60 lengths <- c(1,2,5,10,15,30,60) fit <- abs(span - lengths*n) lengths[which.min(fit)] } pretty_hour <- function(x, n, ...){ span <- x / 3600 lengths <- c(1,2,3,4,6,8,12,24) fit <- abs(span - lengths*n) lengths[which.min(fit)] } pretty_day <- function(x, n, ...){ span <- x / (3600 * 24) pretty(1:span, n = n)[2] } pretty_month <- function(x, n, ...){ span <- x / (3600 * 24 * 30) lengths <- c(1,2,3,4,6,12) fit <- abs(span - lengths*n) lengths[which.min(fit)] } pretty_year <- function(x, n, ...){ span <- x / (3600 * 24 * 365) pretty(1:span, n = n)[2] } pretty_point <- function(x, units, length, start = TRUE, ...){ x <- as.POSIXct(x) if(units %in% c("day", "year")){ if(start) return(floor_date(x, units)) else return(ceiling_date(x, units)) } else { floors <- c("sec", "min", "hour", "day", "month", "year") floorto <- floors[match(units, floors) + 1L] lower <- floor_date(x, floorto) upper <- ceiling_date(x, floorto) points <- seq.POSIXt(lower, upper, paste(length, units)) if (start) points <- points[points <= x] else points <- points[points >= x] fit <- as.duration(x - points) fit <- abs(as.double(fit, "secs")) points[which.min(fit)] } } lubridate/R/ops-division.r0000644000175100001440000001307212755036135015264 0ustar hornikusers#' @include timespans.r #' @include durations.r #' @include intervals.r #' @include periods.r #' @include difftimes.r #' @include numeric.r NULL divide_duration_by_duration <- function(dur1, dur2) dur1@.Data / dur2@.Data divide_duration_by_difftime <- function(dur, diff) dur@.Data / as.numeric(diff, units = "secs") divide_duration_by_number <- function(dur, num) new("Duration", dur@.Data / num) divide_interval_by_duration <- function(int, dur){ int@.Data / dur@.Data } adjust_estimate <- function(est, int, per) { start <- int_start(int) end <- int_end(int) est <- ceiling(est) up_date <- add_with_rollback(start, est * per) while(length(which <- which(up_date < end))){ up_date[which] <- add_with_rollback(up_date[which], per) est[which] <- est[which] + 1 } low_date <- add_with_rollback(up_date, -per) if(length(which <- which(low_date > end))){ low_date[which] <- add_with_rollback(low_date[which], - per) } frac <- as.numeric(difftime(up_date, end, units = "secs"))/ as.numeric(difftime(up_date, low_date, units = "secs")) est - frac } divide_interval_by_period <- function(int, per){ estimate <- int/as.duration(per) not_nas <- !is.na(estimate) if (all(not_nas)) { adjust_estimate(estimate, int, per) } else { timespans <- match_lengths(int, per) int2 <- timespans[[1]][not_nas] per2 <- timespans[[2]][not_nas] estimate[not_nas] <- adjust_estimate(estimate[not_nas], int2, per2) estimate } } divide_interval_by_difftime <- function(int, diff){ int@.Data / as.double(diff, units = "secs") } divide_interval_by_number <- function(int, num){ starts <- int@start + rep(0, length(num)) new("Interval", int@.Data / num, start = starts, tzone = int@tzone) } divisible_period <- function(per, anchor){ per@month <- per@month + 12* per@year per@year <- rep(0, length(per@year)) secs.in.months <- as.numeric(anchor + months(per@month)) - as.numeric(anchor) days.in.months <- round(secs.in.months/86400) per@day <- per@day + days.in.months per@month <- 0 per } divide_period_by_period <- function(per1, per2){ message("estimate only: convert to intervals for accuracy") period_to_seconds(per1) / period_to_seconds(per2) } divide_period_by_number <- function(per, num){ new("Period", per@.Data / num, year = per@year / num, month = per@month / num, day = per@day / num, hour = per@hour / num, minute = per@minute / num) } divide_difftime_by_duration <- function(dif, dur) as.numeric(dif, units = "secs") / dur@.Data #' @export setMethod("/", signature(e1 = "Duration", e2 = "Duration"), function(e1, e2) divide_duration_by_duration(e1, e2)) #' @export setMethod("/", signature(e1 = "Duration", e2 = "Interval"), function(e1, e2) { stop("Incompatible timespan classes:\n change class with as.duration() or put interval in numerator.") }) #' @export setMethod("/", signature(e1 = "Duration", e2 = "Period"), function(e1, e2) { stop("Incompatible timespan classes:\n change class with as.duration() or as.period()") }) #' @export setMethod("/", signature(e1 = "Duration", e2 = "difftime"), function(e1, e2) divide_duration_by_difftime(e1, e2)) #' @export setMethod("/", signature(e1 = "Duration", e2 = "numeric"), function(e1, e2) divide_duration_by_number(e1, e2)) #' @export setMethod("/", signature(e1 = "Interval", e2 = "Duration"), function(e1, e2) divide_interval_by_duration(e1, e2)) #' @export setMethod("/", signature(e1 = "Interval", e2 = "Interval"), function(e1, e2) { stop("interval / interval not defined") }) #' @export setMethod("/", signature(e1 = "Interval", e2 = "Period"), function(e1, e2)divide_interval_by_period(e1, e2)) #' @export setMethod("/", signature(e1 = "Interval", e2 = "difftime"), function(e1, e2) divide_interval_by_difftime(e1, e2)) #' @export setMethod("/", signature(e1 = "Interval", e2 = "numeric"), function(e1, e2) divide_interval_by_number(e1, e2)) #' @export setMethod("/", signature(e1 = "Period", e2 = "Duration"), function(e1, e2) { stop("Incompatible timespan classes:\n change class with as.duration() or as.period()") }) #' @export setMethod("/", signature(e1 = "Period", e2 = "Interval"), function(e1, e2) { stop("Incompatible timespan classes:\n change class with as.period() or put interval in numerator.") }) #' @export setMethod("/", signature(e1 = "Period", e2 = "Period"), function(e1, e2) divide_period_by_period(e1, e2)) #' @export setMethod("/", signature(e1 = "Period", e2 = "difftime"), function(e1, e2) { stop("Incompatible timespan classes:\n change class with as.duration() or as.period()") }) #' @export setMethod("/", signature(e1 = "Period", e2 = "numeric"), function(e1, e2) divide_period_by_number(e1, e2)) #' @export setMethod("/", signature(e1 = "difftime", e2 = "Duration"), function(e1, e2) divide_difftime_by_duration(e1, e2)) #' @export setMethod("/", signature(e1 = "difftime", e2 = "Interval"), function(e1, e2) { stop("Incompatible timespan classes:\n change class with as.duration() or put interval in numerator.") }) #' @export setMethod("/", signature(e1 = "difftime", e2 = "Period"), function(e1, e2) { stop("Incompatible timespan classes:\n change class with as.duration() or as.period()") }) #' @export setMethod("/", signature(e1 = "numeric", e2 = "Duration"), function(e1, e2) stop("Cannot divide numeric by duration")) #' @export setMethod("/", signature(e1 = "numeric", e2 = "Interval"), function(e1, e2) stop("Cannot divide numeric by interval")) #' @export setMethod("/", signature(e1 = "numeric", e2 = "Period"), function(e1, e2) stop("Cannot divide numeric by period")) lubridate/R/intervals.r0000644000175100001440000004651712755043232014656 0ustar hornikusers#' @include timespans.r #' @include util.r NULL check_interval <- function(object){ errors <- character() if (!is.numeric(object@.Data)) { msg <- "Span length must be numeric." errors <- c(errors, msg) } if (!is(object@start, "POSIXct")) { msg <- "Start date must be in POSIXct format." errors <- c(errors, msg) } if (length(object@.Data) != length(object@start)) { msg <- paste("Inconsistent lengths: spans = ", length(object@.Data), ", start dates = ", length(object@start), sep = "") errors <- c(errors, msg) } if (length(errors) == 0) TRUE else errors } .units_within_seconds <- function(secs, unit = "second"){ ## return a list suitable to pass to new("Period", ...) switch(unit, second = list(secs), minute = list(secs %% 60, minute = secs %/% 60), hour = c(.units_within_seconds(secs %% 3600, "minute"), list(hour = secs %/% 3600)), day = c(.units_within_seconds(secs %% 86400, "hour"), list(day = secs %/% 86400)), stop("Unsuported unit ", unit)) } #' Interval class #' #' Interval is an S4 class that extends the \code{\link{Timespan-class}} class. An #' Interval object records one or more spans of time. Intervals record these #' timespans as a sequence of seconds that begin at a specified date. Since #' intervals are anchored to a precise moment of time, they can accurately be #' converted to \code{\link{Period-class}} or \code{\link{Duration-class}} class objects. This #' is because we can observe the length in seconds of each period that begins on a #' specific date. Contrast this to a generalized period, which may not have a #' consistent length in seconds (e.g. the number of seconds in a year will change #' if it is a leap year). #' #' Intervals can be both negative and positive. Negative intervals progress #' backwards from the start date; positive intervals progress forwards. #' #' Interval class objects have two slots: .Data, a numeric object equal to the number #' of seconds in the interval; and start, a POSIXct object that specifies the time #' when the interval starts. #' #' #' @name Interval-class #' @rdname Interval-class #' @exportClass Interval setClass("Interval", contains = c("Timespan", "numeric"), slots = c(start = "POSIXct", tzone = "character"), validity = check_interval) #' @export setMethod("show", signature(object = "Interval"), function(object){ print(format.Interval(object), quote = F) }) #' @export format.Interval <- function(x,...){ if (length(x@.Data) == 0) return("Interval(0)") paste(format(x@start, tz = x@tzone, usetz = TRUE), "--", format(x@start + x@.Data, tz = x@tzone, usetz = TRUE), sep = "") } #' @export setMethod("c", signature(x = "Interval"), function(x, ...){ elements <- lapply(list(...), as.interval) spans <- c(x@.Data, unlist(elements@.Data)) starts <- c(x@start, lapply(elements, int_start)) new("Interval", spans, start = starts, tzone = x@tzone) }) #' @export setMethod("rep", signature(x = "Interval"), function(x, ...){ new("Interval", rep(x@.Data, ...), start = rep(x@start,...), tzone = x@tzone) }) #' @export setMethod("[", signature(x = "Interval"), function(x, i, j, ..., drop = TRUE) { new("Interval", x@.Data[i], start = x@start[i], tzone = x@tzone) } ) #' @export setMethod("[[", signature(x = "Interval"), function(x, i, j, ..., exact = TRUE) { new("Interval", x@.Data[i], start = x@start[i], tzone = x@tzone) } ) #' @export setMethod("[<-", signature(x = "Interval"), function(x, i, j, ..., value) { if (is.interval(value)){ x@.Data[i] <- value@.Data x@start[i] <- value@start new("Interval", x@.Data, start = x@start, tzone = x@tzone) } else { x@.Data[i] <- value new("Interval", x@.Data, start = x@start, tzone = x@tzone) } }) #' @export setMethod("[[<-", signature(x = "Interval"), function(x, i, j, ..., value) { if (is.interval(value)){ x@.Data[i] <- value@.Data x@start[i] <- value@start new("Interval", x@.Data, start = x@start, tzone = x@tzone) } else { x@.Data[i] <- value new("Interval", x@.Data, start = x@start, tzone = x@tzone) } }) #' @export setMethod("$", signature(x = "Interval"), function(x, name) { if(name == "span") name <- ".Data" slot(x, name) }) #' @export setMethod("$<-", signature(x = "Interval"), function(x, name, value) { if(name == "span") name <- ".Data" slot(x, name) <- value x }) #' @export unique.Interval <- function(x, ...){ df <- unique.data.frame(data.frame(data = x@.Data, start = x@start), ...) new("Interval", df$data, start = df$start, tzone = x@tzone) } #' Utilities for creation and manipulation of \code{Interval} objects. #' #' \code{interval} creates an \code{\link{Interval-class}} object with the #' specified start and end dates. If the start date occurs before the end date, #' the interval will be positive. Otherwise, it will be negative. #' #' Intervals are time spans bound by two real date-times. Intervals can be #' accurately converted to either period or duration objects using #' \code{\link{as.period}}, \code{\link{as.duration}}. Since an interval is #' anchored to a fixed history of time, both the exact number of seconds that passed #' and the number of variable length time units that occurred during the interval can be #' calculated. #' #' @export #' @param start a POSIXt or Date date-time object #' @param end a POSIXt or Date date-time object #' @param tzone a recognized timezone to display the interval in #' @param x an R object #' @return \code{interval} - \code{Interval} object. #' @seealso \code{\link{Interval-class}}, \code{\link{as.interval}}, \code{\link{\%within\%}} #' @examples #' interval(ymd(20090201), ymd(20090101)) #' #' date1 <- as.POSIXct("2009-03-08 01:59:59") #' date2 <- as.POSIXct("2000-02-29 12:00:00") #' interval(date2, date1) #' interval(date1, date2) #' span <- interval(ymd(20090101), ymd(20090201)) #' #' is.interval(period(months= 1, days = 15)) # FALSE #' is.interval(interval(ymd(20090801), ymd(20090809))) # TRUE interval <- function(start, end, tzone = attr(start, "tzone")){ if (is.null(tzone)) { tzone <- if (is.null(attr(end, "tzone"))) "UTC" else attr(end, "tzone") } if (is.Date(start)) start <- with_tz(as.POSIXct(start), "UTC") if (is.Date(end)) end <- with_tz(as.POSIXct(end), "UTC") if (!is.POSIXct(start)) start <- as.POSIXct(start, tz = tzone) if (!is.POSIXct(end)) end <- as.POSIXct(end, tz = tzone) span <- as.numeric(end) - as.numeric(start) starts <- start + rep(0, length(span)) if (tzone != tz(starts)) starts <- with_tz(starts, tzone) new("Interval", span, start = starts, tzone = tzone) } #' #' \code{\%--\%} Creates an interval that covers the range spanned by two #' dates. It replaces the original behavior of lubridate, which created an #' interval by default whenever two date-times were subtracted. #' #' @export #' @rdname interval "%--%" <- function(start, end) interval(start, end) #' @rdname interval #' @export is.interval <- function(x) is(x, c("Interval")) #' #' #' \code{int_start} and \code{int_start<-} are accessors the start date of an #' interval. Note that changing the start date of an interval will change the #' length of the interval, since the end date will remain the same. #' #' @rdname interval #' @param int an interval object #' @return \code{int_start} and \code{int_end} return a POSIXct date object when #' used as an accessor. Nothing when used as a setter. #' @examples #' int <- interval(ymd("2001-01-01"), ymd("2002-01-01")) #' int_start(int) #' int_start(int) <- ymd("2001-06-01") #' int #' #' int <- interval(ymd("2001-01-01"), ymd("2002-01-01")) #' int_end(int) #' int_end(int) <- ymd("2002-06-01") #' int #' @export int_start <- function(int) int@start #' @rdname interval #' @param value interval's start/end to be assigned to \code{int} #' @export "int_start<-" <- function(int, value){ value <- as.POSIXct(value) span <- as.numeric(int@start + int@.Data - value, "secs") equal.lengths <- data.frame(span, value) int <- new("Interval", span, start = equal.lengths$value, tzone = int@tzone) } #' @rdname interval #' @export int_end <- function(int) int@start + int@.Data #' @rdname interval #' @export "int_end<-" <- function(int, value){ value <- as.POSIXct(value) span <- as.numeric(value - int@start, "secs") int <- new("Interval", span, start = int@start, tzone = int@tzone) } #' @rdname interval #' @return \code{int_length} - numeric length of the interval in #' seconds. A negative number connotes a negative interval. #' @examples #' int <- interval(ymd("2001-01-01"), ymd("2002-01-01")) #' int_length(int) #' @export int_length <- function(int) int@.Data #' #' \code{int_flip} reverses the order of the start date and end date in an #' interval. The new interval takes place during the same timespan as the #' original interval, but has the opposite direction. #' #' @rdname interval #' @return \code{int_flip} - flipped interval object #' @examples #' int <- interval(ymd("2001-01-01"), ymd("2002-01-01")) #' int_flip(int) #' @export int_flip <- function(int){ new("Interval", -int@.Data, start = int@start + int@.Data, tzone = int@tzone) } #' #' \code{int_shift} shifts the start and end dates of an interval up or down the #' timeline by a specified amount. Note that this may change the exact length of #' the interval if the interval is shifted by a Period object. Intervals shifted #' by a Duration or difftime object will retain their exact length in seconds. #' #' @rdname interval #' @param by A period or duration object to shift by (for \code{int_shift}) #' @return \code{int_shift} - interval object #' @examples #' int <- interval(ymd("2001-01-01"), ymd("2002-01-01")) #' int_shift(int, duration(days = 11)) #' int_shift(int, duration(hours = -1)) #' @export int_shift <- function(int, by){ if(!is.timespan(by)) stop("by is not a recognized timespan object") if(is.interval(by)) stop("an interval cannot be shifted by another interval. Convert second interval to a period or duration.") interval(int@start + by, int_end(int) + by) } #' #' #' \code{int_overlaps} tests if two intervals overlap. #' #' @rdname interval #' @param int1 an Interval object (for \code{int_overlaps}, \code{int_aligns}) #' @param int2 an Interval object (for \code{int_overlaps}, \code{int_aligns}) #' @return \code{int_overlaps} logical, TRUE if int1 and int2 overlap by at #' least one second. FALSE otherwise #' @examples #' int1 <- interval(ymd("2001-01-01"), ymd("2002-01-01")) #' int2 <- interval(ymd("2001-06-01"), ymd("2002-06-01")) #' int3 <- interval(ymd("2003-01-01"), ymd("2004-01-01")) #' #' int_overlaps(int1, int2) # TRUE #' int_overlaps(int1, int3) # FALSE #' @export int_overlaps <- function(int1, int2){ stopifnot(c(is.interval(int1), is.interval(int2))) int1 <- int_standardize(int1) int2 <- int_standardize(int2) int1@start <= int2@start + int2@.Data & int2@start <= int1@start + int1@.Data } #' #' \code{int_standardize} ensures all intervals in an interval object are #' positive. If an interval is not positive, flip it so that it retains its #' endpoints but becomes positive. #' #' @rdname interval #' @examples #' int <- interval(ymd("2002-01-01"), ymd("2001-01-01")) #' int_standardize(int) #' @export int_standardize <- function(int){ negs <- !is.na(int@.Data) & int@.Data < 0 int[negs] <- int_flip(int[negs]) int } #' #' #' \code{int_aligns} tests if two intervals share an endpoint. The direction of #' each interval is ignored. int_align tests whether the earliest or latest #' moments of each interval occur at the same time. #' #' @rdname interval #' @return \code{int_align} logical, TRUE if int1 and int2 begin or end on the #' same moment. FALSE otherwise #' @examples #' int1 <- interval(ymd("2001-01-01"), ymd("2002-01-01")) #' int2 <- interval(ymd("2001-06-01"), ymd("2002-01-01")) #' int3 <- interval(ymd("2003-01-01"), ymd("2004-01-01")) #' #' int_aligns(int1, int2) # TRUE #' int_aligns(int1, int3) # FALSE #' @export int_aligns <- function(int1, int2){ int1 <- int_standardize(int1) int2 <- int_standardize(int2) int1@start == int2@start | (int1@start + int1@.Data) == (int2@start + int2@.Data) } #' #' #' \code{int_diff} returns the intervals that occur between the elements of a #' vector of date-times. \code{int_diff} is similar to the POSIXt and Date #' methods of \code{\link{diff}}, but returns an \code{Interval} object instead #' of a difftime object. #' #' @rdname interval #' @param times A vector of POSIXct, POSIXlt or Date class date-times (for #' \code{int_diff}) #' @return \code{int_diff} - interval object that contains the n-1 intervals #' between the n date-time in times #' @examples #' dates <- now() + days(1:10) #' int_diff(dates) #' @export int_diff <- function(times){ interval(times[-length(times)], times[-1]) } #' @export setGeneric("intersect") #' @export setMethod("intersect", signature(x = "Interval", y = "Interval"), function(x,y){ int1 <- int_standardize(x) int2 <- int_standardize(y) starts <- pmax(int1@start, int2@start) ends <- pmin(int1@start + int1@.Data, int2@start + int2@.Data) spans <- as.numeric(ends) - as.numeric(starts) no.int <- ends < starts spans[no.int] <- NA starts[no.int] <- NA new.int <- new("Interval", spans, start = starts, tzone = x@tzone) new.int[sign(x@.Data) == -1] <- int_flip(new.int[sign(x@.Data) == -1]) new.int }) #' @export setGeneric("union") #' @export setMethod("union", signature(x = "Interval", y = "Interval"), function(x,y){ int1 <- int_standardize(x) int2 <- int_standardize(y) starts <- pmin(int1@start, int2@start) ends <- pmax(int1@start + int1@.Data, int2@start + int2@.Data) spans <- as.numeric(ends) - as.numeric(starts) if(any(!int_overlaps(int1, int2))) message("Union includes intervening time between intervals.") tz(starts) <- x@tzone new.int <- new("Interval", spans, start = starts, tzone = x@tzone) new.int[sign(x@.Data) == -1] <- int_flip(new.int[sign(x@.Data) == -1]) new.int }) #' @export setGeneric("setdiff") # returns the part of x that is not in y #' @export setMethod("setdiff", signature(x = "Interval", y = "Interval"), function(x,y){ if (length(x) != length(y)) { xy <- match_lengths(x, y) x <- xy[[1]] y <- xy[[2]] } aligned <- int_aligns(x,y) inside <- y %within% x makes2 <- !aligned & inside if(sum(makes2)) { stop(paste("Cases", which(makes2), "result in discontinuous intervals.")) } int1 <- int_standardize(x) int2 <- int_standardize(y) first.y <- int_start(int2) last.y <- int_end(int2) starts <- int_start(int1) starts[(last.y + 1) %within% int1] <- last.y[(last.y + 1) %within% int1] ends <- int_end(int1) ends[(first.y - 1) %within% int1] <- first.y[(first.y - 1) %within% int1] spans <- as.numeric(ends) - as.numeric(starts) new.int <- new("Interval", spans, start = starts, tzone = x@tzone) new.int[sign(x@.Data) == -1] <- int_flip(new.int[sign(x@.Data) == -1]) new.int }) #' Tests whether a date or interval falls within an interval #' #' %within% returns TRUE if a falls within interval b, FALSE otherwise. #' If a is an interval, both its start and end dates must fall within b #' to return TRUE. #' #' @export #' @rdname within-interval #' @aliases %within%,Interval,Interval-method %within%,ANY,Interval-method #' @param a An interval or date-time object #' @param b An interval #' @return A logical #' @examples #' int <- interval(ymd("2001-01-01"), ymd("2002-01-01")) #' int2 <- interval(ymd("2001-06-01"), ymd("2002-01-01")) #' #' ymd("2001-05-03") %within% int # TRUE #' int2 %within% int # TRUE #' ymd("1999-01-01") %within% int # FALSE "%within%" <- function(a,b) standardGeneric("%within%") #' @export setGeneric("%within%") setMethod("%within%", signature(b = "Interval"), function(a,b){ if(!is.instant(a)) stop("Argument 1 is not a recognized date-time") a <- as.POSIXct(a) as.numeric(a) - as.numeric(b@start) <= b@.Data & as.numeric(a) - as.numeric(b@start) >= 0 }) setMethod("%within%", signature(a = "Interval", b = "Interval"), function(a,b){ a <- int_standardize(a) b <- int_standardize(b) start.in <- as.numeric(a@start) >= as.numeric(b@start) end.in <- (as.numeric(a@start) + a@.Data) <= (as.numeric(b@start) + b@.Data) start.in & end.in }) #' @export as.list.Interval <- function(x, ...){ lapply(seq_along(x), function(i) x[[i]]) } #' @export summary.Interval <- function(object, ...) { nas <-is.na(object) object <- object[!nas] n <- length(object) dates <- c(int_start(object), int_end(object)) earliest <- as.character(min(dates)) latest <- as.character(max(dates)) zone <- tz(dates) qq <- c(n, earliest, latest, zone) names(qq) <- c("Intervals", "Earliest endpoint", "Latest endpoint", "Time zone") if (any(nas)) c(qq, `NA's` = sum(nas)) else qq } #' @rdname time_length setMethod("time_length", signature("Interval"), function(x, unit = "second") { unit <- standardise_period_names(unit) if (unit %in% c("year", "month")) { periods <- as.period(x, unit = unit) int_part <- slot(periods, unit) prev_aniv <- add_with_rollback( int_start(x), (int_part * period(1, units = unit)), roll_to_first = TRUE, preserve_hms = FALSE) next_aniv <- add_with_rollback( int_start(x), ((int_part + ifelse(x@.Data < 0, -1, 1)) * period(1, units = unit)), roll_to_first = TRUE, preserve_hms = FALSE) sofar <- as.duration(int_end(x) - prev_aniv) total <- as.duration(next_aniv - prev_aniv) int_part + sign(x@.Data) * sofar / total } else { as.duration(x) / duration(num = 1, units = unit) } }) #' @export setMethod("Arith", signature(e1 = "Interval", e2 = "ANY"), undefined_arithmetic) #' @export setMethod("Arith", signature(e1 = "ANY", e2 = "Interval"), undefined_arithmetic) #' @name hidden_aliases #' @aliases Arith,Interval,ANY-method Arith,ANY,Interval-method #' intersect,Interval,Interval-method union,Interval,Interval-method #' setdiff,Interval,Interval-method as.numeric,Interval-method #' show,Interval-method c,Interval-method rep,Interval-method #' [,Interval-method [<-,Interval,ANY,ANY,ANY-method [[,Interval-method #' [[<-,Interval,ANY,ANY,ANY-method $,Interval-method $<-,Interval-method #' as.difftime,Interval-method as.character,Interval-method #' +,Interval,Duration-method +,Interval,Interval-method #' +,Interval,Period-method +,Interval,Date-method +,Date,Interval-method #' +,Interval,difftime-method +,difftime,Interval-method #' +,Interval,numeric-method +,numeric,Interval-method #' +,Interval,POSIXct-method +,POSIXct,Interval-method #' +,Interval,POSIXlt-method +,POSIXlt,Interval-method #' /,Interval,Duration-method /,Interval,Interval-method #' /,Interval,Period-method /,Interval,difftime-method #' /,difftime,Interval-method /,Interval,numeric-method #' /,numeric,Interval-method *,Interval,ANY-method *,ANY,Interval-method #' -,Interval,missing-method -,Interval,Interval-method -,Date,Interval-method #' -,POSIXct,Interval-method -,POSIXlt,Interval-method #' -,numeric,Interval-method -,Interval,Date-method -,Interval,POSIXct-method #' -,Interval,POSIXlt-method -,Interval,numeric-method #' -,Duration,Interval-method -,Period,Interval-method #' %%,Interval,Duration-method %%,Interval,Interval-method #' %%,Interval,Period-method %%,Interval,Duration %%,Interval,Interval #' %%,Interval,Period -,Date,Interval -,Duration,Interval -,Interval,Date #' -,Interval,Interval -,Interval,POSIXct -,Interval,POSIXlt #' -,Interval,numeric -,POSIXct,Interval -,POSIXlt,Interval -,numeric,Interval NULL lubridate/R/accessors-tz.r0000644000175100001440000000545612755025406015267 0ustar hornikusers#' Get/set time zone component of a date-time. #' #' Time zones are stored as character strings in an #' attribute of date-time objects. tz returns a date's time zone attribute. #' When used as a settor, it changes the time zone attribute. R does not come with #' a predefined list zone names, but relies on the user's OS to interpret time zone #' names. As a result, some names will be recognized on some computers but not others. #' Most computers, however, will recognize names in the timezone data base originally #' compiled by Arthur Olson. These names normally take the form "Country/City." A #' convenient listing of these timezones can be found at #' \url{http://en.wikipedia.org/wiki/List_of_tz_database_time_zones}. #' #' Setting tz does not update a date-time to display the same moment as measured #' at a different time zone. See \code{\link{with_tz}}. Setting a new time zone #' creates a new date-time. The numerical value of the hours element stays the #' same, only the time zone attribute is replaced. This creates a new date-time #' that occurs an integer value of hours before or after the original date-time. #' #' If x is of a class that displays all date-times in the GMT timezone, such as #' chron, then R will update the number in the hours element to display the new #' date-time in the GMT timezone. #' #' For a description of the time zone attribute, see \code{\link[base]{timezones}} #' or \code{\link[base]{DateTimeClasses}}. #' #' @export #' @param x a date-time object of class a POSIXct, POSIXlt, Date, chron, yearmon, #' yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, fts or anything else that can #' be coerced to POSIXlt with as.POSIXlt #' @return the first element of x's tzone attribute vector as a character string. If no tzone #' attribute exists, tz returns "GMT". #' @keywords utilities manip chron methods #' @examples #' x <- ymd("2012-03-26") #' tz(x) #' tz(x) <- "GMT" #' x #' \dontrun{ #' tz(x) <- "America/New_York" #' x #' tz(x) <- "America/Chicago" #' x #' tz(x) <- "America/Los_Angeles" #' x #' tz(x) <- "Pacific/Honolulu" #' x #' tz(x) <- "Pacific/Auckland" #' x #' tz(x) <- "Europe/London" #' x #' tz(x) <- "Europe/Berlin" #' x #' } #' Sys.setenv(TZ = "GMT") #' now() #' tz(now()) #' Sys.unsetenv("TZ") tz <- function (x) UseMethod("tz") #' @export tz.default <- function(x) { if (is.null(attr(x,"tzone")) && !is.POSIXt(x)) return("UTC") tzs <- attr(as.POSIXlt(x),"tzone") tzs[1] } #' @export tz.zoo <- function(x){ tzs <- attr(as.POSIXlt(zoo::index(x)), "tzone") tzs[1] } #' @export tz.timeSeries <- function(x) x@FinCenter #' @export tz.irts <- function(x) return("GMT") #' @rdname tz #' @param value timezone value to be assigned to \code{x}'s \code{tzone} attribute #' @export "tz<-" <- function(x, value){ new <- force_tz(x, value) reclass_date(new, x) } lubridate/vignettes/0000755000175100001440000000000012765562217014270 5ustar hornikuserslubridate/vignettes/lubridate.Rmd0000644000175100001440000002017312705366146016707 0ustar hornikusers # Do more with dates and times in R with lubridate 1.3.0 _note: This vignette is an updated version of the blog post first published at [r-statistics](http://www.r-statistics.com/2012/03/do-more-with-dates-and-times-in-r-with-lubridate-1-1-0/)_ Lubridate is an R package that makes it easier to work with dates and times. Below is a concise tour of some of the things lubridate can do for you. Lubridate was created by Garrett Grolemund and Hadley Wickham. ## Parsing dates and times Getting R to agree that your data contains the dates and times you think it does can be tricky. Lubridate simplifies that. Identify the order in which the year, month, and day appears in your dates. Now arrange "y", "m", and "d" in the same order. This is the name of the function in lubridate that will parse your dates. For example, ```{r} library(lubridate) ymd("20110604") mdy("06-04-2011") dmy("04/06/2011") ``` Lubridate's parse functions handle a wide variety of formats and separators, which simplifies the parsing process. If your date includes time information, add h, m, and/or s to the name of the function. `ymd_hms` is probably the most common date time format. To read the dates in with a certain time zone, supply the official name of that time zone in the `tz` argument. ```{r} arrive <- ymd_hms("2011-06-04 12:00:00", tz = "Pacific/Auckland") arrive leave <- ymd_hms("2011-08-10 14:00:00", tz = "Pacific/Auckland") leave ``` ## Setting and Extracting information Extract information from date times with the functions `second`, `minute`, `hour`, `day`, `wday`, `yday`, `week`, `month`, `year`, and `tz`. You can also use each of these to set (i.e, change) the given information. Notice that this will alter the date time. `wday` and `month` have an optional `label` argument, which replaces their numeric output with the name of the weekday or month. ```{r} second(arrive) second(arrive) <- 25 arrive second(arrive) <- 0 wday(arrive) wday(arrive, label = TRUE) ``` ## Time Zones There are two very useful things to do with dates and time zones. First, display the same moment in a different time zone. Second, create a new moment by combining an existing clock time with a new time zone. These are accomplished by `with_tz` and `force_tz`. For example, a while ago I was in Auckland, New Zealand. I arranged to meet the co-author of lubridate, Hadley, over skype at 9:00 in the morning Auckland time. What time was that for Hadley who was back in Houston, TX? ```{r} meeting <- ymd_hms("2011-07-01 09:00:00", tz = "Pacific/Auckland") with_tz(meeting, "America/Chicago") ``` So the meetings occurred at 4:00 Hadley's time (and the day before no less). Of course, this was the same actual moment of time as 9:00 in New Zealand. It just appears to be a different day due to the curvature of the Earth. What if Hadley made a mistake and signed on at 9:00 his time? What time would it then be my time? ```{r} mistake <- force_tz(meeting, "America/Chicago") with_tz(mistake, "Pacific/Auckland") ``` His call would arrive at 2:00 am my time! Luckily he never did that. ## Time Intervals You can save an interval of time as an Interval class object with lubridate. This is quite useful! For example, my stay in Auckland lasted from June 4, 2011 to August 10, 2011 (which we've already saved as arrive and leave). We can create this interval in one of two ways: ```{r} auckland <- interval(arrive, leave) auckland auckland <- arrive %--% leave auckland ``` My mentor at the University of Auckland, Chris, traveled to various conferences that year including the Joint Statistical Meetings (JSM). This took him out of the country from July 20 until the end of August. ```{r} jsm <- interval(ymd(20110720, tz = "Pacific/Auckland"), ymd(20110831, tz = "Pacific/Auckland")) jsm ``` Will my visit overlap with and his travels? Yes. ```{r} int_overlaps(jsm, auckland) ``` Then I better make hay while the sun shines! For what part of my visit will Chris be there? ```{r} setdiff(auckland, jsm) ``` Other functions that work with intervals include `int_start`, `int_end`, `int_flip`, `int_shift`, `int_aligns`, `union`, `intersect`, `setdiff`, and `%within%`. ## Arithmetic with date times Intervals are specific time spans (because they are tied to specific dates), but lubridate also supplies two general time span classes: Durations and Periods. Helper functions for creating periods are named after the units of time (plural). Helper functions for creating durations follow the same format but begin with a "d" (for duration) or, if you prefer, and "e" (for exact). ```{r} minutes(2) ## period dminutes(2) ## duration ``` Why two classes? Because the timeline is not as reliable as the number line. The Duration class will always supply mathematically precise results. A duration year will always equal 365 days. Periods, on the other hand, fluctuate the same way the timeline does to give intuitive results. This makes them useful for modeling clock times. For example, durations will be honest in the face of a leap year, but periods may return what you want: ```{r} leap_year(2011) ## regular year ymd(20110101) + dyears(1) ymd(20110101) + years(1) leap_year(2012) ## leap year ymd(20120101) + dyears(1) ymd(20120101) + years(1) ``` You can use periods and durations to do basic arithmetic with date times. For example, if I wanted to set up a reoccuring weekly skype meeting with Hadley, it would occur on: ```{r} meetings <- meeting + weeks(0:5) ``` Hadley travelled to conferences at the same time as Chris. Which of these meetings would be affected? The last two. ```{r} meetings %within% jsm ``` How long was my stay in Auckland? ```{r} auckland / ddays(1) auckland / ddays(2) auckland / dminutes(1) ``` And so on. Alternatively, we can do modulo and integer division. Sometimes this is more sensible than division - it is not obvious how to express a remainder as a fraction of a month because the length of a month constantly changes. ```{r} auckland %/% months(1) auckland %% months(1) ``` Modulo with an timespan returns the remainder as a new (smaller) interval. You can turn this or any interval into a generalized time span with `as.period`. ```{r} as.period(auckland %% months(1)) as.period(auckland) ``` ### If anyone drove a time machine, they would crash The length of months and years change so often that doing arithmetic with them can be unintuitive. Consider a simple operation, `January 31st + one month`. Should the answer be 1. `February 31st` (which doesn't exist) 2. `March 4th` (31 days after January 31), or 3. `February 28th` (assuming its not a leap year) A basic property of arithmetic is that `a + b - b = a`. Only solution 1 obeys this property, but it is an invalid date. I've tried to make lubridate as consistent as possible by invoking the following rule *if adding or subtracting a month or a year creates an invalid date, lubridate will return an NA*. This is new with version 1.3.0, so if you're an old hand with lubridate be sure to remember this! If you thought solution 2 or 3 was more useful, no problem. You can still get those results with clever arithmetic, or by using the special `%m+%` and `%m-%` operators. `%m+%` and `%m-%` automatically roll dates back to the last day of the month, should that be necessary. ```{r} jan31 <- ymd("2013-01-31") jan31 + months(0:11) floor_date(jan31, "month") + months(0:11) + days(31) jan31 %m+% months(0:11) ``` Notice that this will only affect arithmetic with months (and arithmetic with years if your start date it Feb 29). ## Vectorization The code in lubridate is vectorized and ready to be used in both interactive settings and within functions. As an example, I offer a function for advancing a date to the last day of the month ```{r} last_day <- function(date) { ceiling_date(date, "month") - days(1) } ``` ## Further Resources To learn more about lubridate, including the specifics of periods and durations, please read the [original lubridate paper](http://www.jstatsoft.org/v40/i03/). Questions about lubridate can be addressed to the lubridate google group. Bugs and feature requests should be submitted to the [lubridate development page](http://github.com/hadley/lubridate) on github. lubridate/README.md0000644000175100001440000000406412765557451013547 0ustar hornikusers[![Build Status](https://travis-ci.org/hadley/lubridate.png?branch=master)](https://travis-ci.org/hadley/lubridate) [![Coverage Status](https://img.shields.io/codecov/c/github/hadley/lubridate/master.svg)](https://codecov.io/github/hadley/lubridate?branch=master) [![CRAN RStudio mirror downloads](http://cranlogs.r-pkg.org/badges/lubridate)](https://cran.r-project.org/package=lubridate) [![Development version](https://img.shields.io/badge/devel-1.5.0.9000-orange.svg)](https://github.com/hadley/lubridate) [![CRAN version](https://www.r-pkg.org/badges/version/lubridate)](https://cran.r-project.org/package=lubridate) # lubridate Date-time data can be frustrating to work with in R. R commands for date-times are generally unintuitive and change depending on the type of date-time object being used. Moreover, the methods we use with date-times must be robust to time zones, leap days, daylight savings times, and other time related quirks, and R lacks these capabilities in some situations. Lubridate makes it easier to do the things R does with date-times and possible to do the things R does not. Specifically, lubridate provides: * a set of intuitive date-time related functions that work the same way for all common date-time classes (including those from `chron`, `timeDate`, `zoo`, `xts`, `its`, `tis`, `timeSeries`, `fts`, and `tseries`) * quick and easy parsing of date-times: `ymd()`, `dmy()`, `mdy()`, ... * simple functions to extract and modify components of a date-time, such as years, months, days, hours, minutes, and seconds: `year()`, `month()`, `day()`, ... * helper functions for handling time zones: `with_tz()`, `force_tz()` Lubridate also expands the type of mathematical operations that can be performed with date-time objects. It introduces three new time span classes borrowed from http://joda.org. * durations, which measure the exact amount of time between two points * periods, which accurately track clock times despite leap years, leap seconds, and day light savings time * intervals, a protean summary of the time information between two points lubridate/MD50000644000175100001440000002036012765757370012577 0ustar hornikusersc95b84ffc617fc0769ccb29a9a5a3374 *DESCRIPTION 9803ede4a16dd7f853432002af3cc80e *NAMESPACE 15bed62e38c31e8495a5d1368edb976b *NEWS.md 420d68fde4c8e36072bd6e610dbcc354 *R/Dates.r 1c398f7782114933e14d25b1034e7b4a *R/POSIXt.r 2ae5e03be9705b5f4b6861c279262c75 *R/accessors-date.R 14e31cf69d06996b34ab391efd51c84c *R/accessors-day.r 4905e027ef4f63983e355f8e8f5fee6e *R/accessors-dst.r 89050cc5119f52c8718f6a244427c004 *R/accessors-hour.r ee8373c20fc1c50f338a60815c8e7b16 *R/accessors-minute.r 62f7fe231268a1c6d25892e4babe88b9 *R/accessors-month.r 2e6de81b4d2f87afadcfa2662495ee8a *R/accessors-quarter.r 52c2042373bda28d13711842f00b1f1b *R/accessors-second.r 426f1e5f4a1abb125141b581978e4a60 *R/accessors-tz.r e12e061cfd94ecd711f817bc8122bc5c *R/accessors-week.r b4408f0d837796846d8e57f27df7183f *R/accessors-year.r 61df9d1deda71da55ce1a569680fc4d3 *R/am-pm.r 48cc423a54b364c9806445f9bde7234c *R/coercion.r 47083005e514ab770dcbd04592eee362 *R/constants.r 60932375757a6e8180c5a7ea6666ce7b *R/data.r d3b3c77afb95b39ca3ddac6413f35284 *R/decimal-dates.r eca591a6f04be84f3c06c7e470780b66 *R/deprecated.r 9609537311c7e280344923f6b5e7f559 *R/difftimes.r 07e238280cddba660ed4a79aac455afc *R/durations.r 309ba5481feaf6891303de9ae08fbf43 *R/guess.r ccb11d657b51a04f95ae88dfc5f93537 *R/help.r fe1b2df9042ccf14f76f1eb981938db7 *R/hidden.r f34ac73184cf5b2ff06c794605979473 *R/instants.r f67e36b1338452a1579d3a6944b7646c *R/intervals.r bc1784ed0ba16223d62dc7a707194470 *R/leap-years.r 6168a35c3e2c9b4a50045c53cbb7bec8 *R/numeric.r 06ee0d7b6dab156468132f193c105725 *R/ops-%m+%.r ee06418c456234d8fc7874f7a117905e *R/ops-addition.r 5a95b9aee576c946a6343645166a8fc3 *R/ops-compare.r 482bfe6860f2f177abd5711d2f59b83f *R/ops-division.r 66b3def352ddc6e0987cba96c1c23164 *R/ops-integer-division.r 28137244e06cabb8ddd7eec0ba53beac *R/ops-modulo.r d6808ea083a48fe27f60fdeb805c0681 *R/ops-multiplication.r ff04141266d34987dbd0464849caaa21 *R/ops-subtraction.r 51437a825e182c146d8d14b2910cb878 *R/parse.r 0bd3746709181032e890bbb2e8ded339 *R/periods.r d337fe7cebbf9803e715a5e3b9710e97 *R/pretty.r 4f1d01c72ca9aba0d50930bf5dafde52 *R/round.r cf981bd716528751b115190807e519df *R/stamp.r 156fa095c67f5fcd1015a2dda23ec2f8 *R/time-zones.r f984dcc6ec7138761e97f3c46991368f *R/timespans.r d1bb5021558f992f4191c5f7391d3593 *R/update.r 7700123170dd1cf380e04cb749e55b9a *R/util.r 45f4c5745483d1fef3f4cabaf00d1423 *README.md 13cefeb4e7b674724a0a47e7d58adc59 *build/vignette.rds a4eca0d1ebff1dc90da52f32fef3de56 *data/lakers.rda 8d4280470088183c93d3b05394f49074 *inst/CITATION 338844cc5af36a5dee9552479928b5e4 *inst/doc/lubridate.R 01d45b1160a36cf9c210bd880c083867 *inst/doc/lubridate.Rmd 851e50183eae25041a6d4f429485d8c3 *inst/doc/lubridate.html 24416f4fb01486433a1baca5a0edff14 *man/DateCoercion.Rd 9aa7de91e143212426770a02d379c1d2 *man/DateUpdate.Rd a1fafdf635560b87efd60bdf634b021b *man/Deprecated.Rd d226eb156a5a01e7868ad96dc2527737 *man/Duration-class.Rd 12f048c99937ee1ef9a917d7c528e9ac *man/Interval-class.Rd 1580a3eff5b0ef0fe59d988979673e21 *man/Period-class.Rd 3f546de6789557b72f27ed7d8c1d3f94 *man/Timespan-class.Rd 7445958d89c04ee86b852ea546121eaa *man/am.Rd 86138cd16940dee4298ede55961da2ad *man/as.duration.Rd 226154361883deedaa52d479090681fc *man/as.interval.Rd 32232e11ffd47a520376fbf7d750e03e *man/as.period.Rd 73c4e2d345b182180d7f48eba8ecf479 *man/as_date.Rd 66853c054c698eba67ed3c5ae8befdf0 *man/date.Rd 99a74cbfb3dfff0444dbe7626862688b *man/date_decimal.Rd c5f9ca60fb364d9ec1b725b80e76d3cd *man/day.Rd c3f1ef6bc8f8d54e16192de17f89ad09 *man/days_in_month.Rd 542dccabca24bf586c63f7f88bf157e2 *man/decimal_date.Rd b0ba5f652c3e11131023553cdf9d7224 *man/dst.Rd 1954788e7195a1f200c7740ef4621cce *man/duration.Rd b825f603714ada9f0e169dd2573c1d6f *man/fit_to_timeline.Rd 0b34208f19e741e15a55a40e23419d22 *man/force_tz.Rd 486f206ec7d1a1ce4046d29f8d56ba5c *man/guess_formats.Rd d60741a7b22e6792dc26b1cb97a336b8 *man/hidden_aliases.Rd 847e95f07041ea3b01be8a783967326f *man/hms.Rd a6e10d9e3f138c1bb027705d11c17f09 *man/hour.Rd d3c76562c8c5209f483cbcf565a495e0 *man/interval.Rd 1c84549e87715ee37070c867b00843d6 *man/is.Date.Rd 52aba311a0fbfd6aa3af96ab0c394518 *man/is.POSIXt.Rd dc4c892f8d4d656008c56cd56783f984 *man/is.difftime.Rd 342d965c74180927c31ced28a91ebcba *man/is.instant.Rd 3dd27b2902e4f084863a883c7e92daf3 *man/is.timespan.Rd a17e52ad1deff6f57af1dc1b8af9950c *man/lakers.Rd 1f35824314939597518a260370ad1dc7 *man/leap_year.Rd bdc0d25cb5d1ebeacc4dc074b13124fd *man/lubridate-package.Rd 5e76a194ac65b485d93b884e55b3ec78 *man/make_datetime.Rd 104ba06de66571d8dbb1f2ecd8633b47 *man/make_difftime.Rd 3bf7c6cdeda15f0b58548285d3a71e0b *man/minute.Rd 8ddaec4cbe1c882e8be97ebf9f50b22a *man/month.Rd acb3d607422f842240f155c2b3594a18 *man/mplus.Rd 00b6fc95b486acf0fe122002459fd263 *man/now.Rd d53b8f2b0afb617764044354310653a6 *man/origin.Rd 33bd1bffa6a726e5da56c30de17a83fc *man/parse_date_time.Rd c35b6e3ebe781bfe785a95f55e2bfa27 *man/period.Rd afc3caf38415897641e9066313f6d3b3 *man/period_to_seconds.Rd 63c4de4d60029761819cf8b52131a861 *man/pretty_dates.Rd 3b37d9a9eede08d490ff1c7835396418 *man/quarter.Rd 4f2cf4a9a677d765106cd8b63cc4d0df *man/quick_durations.Rd 8ce8d88780398479172b44b0ffd27eb6 *man/quick_periods.Rd 898fde1adbd50af7efaa38a8be7391e1 *man/reclass_date.Rd b8aeca063636a64aaa0841352afaa15c *man/reclass_timespan.Rd 4f5d4b346771d7d990b10a9a9bf0f607 *man/rollback.Rd 946722d2ae3e7c1737d89806b681c515 *man/round_date.Rd 5303b14af4b2eb06ba2d2095d9ba6a32 *man/second.Rd 56c0711a65e6429729a68a262d1e24c3 *man/stamp.Rd 60b789e38ca2bd09cb51fac5eeb2fc28 *man/time_length.Rd 8e4d3176007b3b932b6a30056c4f22c0 *man/timespan.Rd 2904e2bd41f99af9f4d9e89c9a9cc020 *man/today.Rd 6d5f7c4b05fbc26086880f55a3a6376a *man/tz.Rd 557eb76d2dfadd3fb623d9ea19eed5cd *man/week.Rd 366e16b60563c4a2d735272eeec881f0 *man/with_tz.Rd 44b565a8d54aacd917cbf3551a1140ff *man/within-interval.Rd 8a80549f526a1fa05f5d9547eb41406d *man/year.Rd 5a762da16def6b65d2b99e309ed550b4 *man/ymd.Rd 5638281bf95b56f20d5986d0b3c0f20d *man/ymd_hms.Rd d98ecb14ceabf6fa8a5aa0a9c7056eac *po/R-it.po 81e173ba04b6f167d6f73ef0ab07920a *po/R-ko.po 04a768e668f156d1f50982995cf05b88 *po/R-lubridate.pot d7784219361c425b5a9fe1c03223babe *src/constants.h b11e6bc766a13e427110e8d46ff18d84 *src/datetime.c 626095085abf800f4e851ec4ef14f89c *src/period.c e17c0c96d0e372950e0361265214e441 *src/tparse.c 4b783dcea9862fee6315ebc2c0748306 *src/utils.c a9e1a175c875321de1bbcac9f273375c *src/utils.h 2341ad901c9e60c8555fe5eaee09e787 *tests/testthat.R 32d5e07f1447446c876c4e1a126dbf5a *tests/testthat/test-Dates.R d6b2f7df6fad048a60defcc6a2a3d80b *tests/testthat/test-POSIXt.R d5d38b46cdcd8a342fae8ef419b6be28 *tests/testthat/test-accessors.R a9adfaf072bd11a99eecd4d6c9210048 *tests/testthat/test-am-pm.R a3d4ed9acdbb159f7ffea1530c432676 *tests/testthat/test-daylight-savings.R 26acddd46142148c19f0f1e8b45dfe11 *tests/testthat/test-decimal-date.R ac77780c96e9c63f570fadd1556e1eca *tests/testthat/test-difftimes.R a7df1d5a49fdcd2054e4d9ed28755a2c *tests/testthat/test-durations.R aec6c9423dc4c24c4d1b0879a7b260f2 *tests/testthat/test-guess.R 80af0d0f9a54f7ffe7c818187e8adcae *tests/testthat/test-instants.R 6a714e4c7f3614fe0108c85a72294aa1 *tests/testthat/test-intervals.R 330fdce9b7b697858e371053c7001bf7 *tests/testthat/test-ops-addition.R 70d12c754ee336ca941b74d599a5d132 *tests/testthat/test-ops-compare.R 87cf78628b3e6d08d368fd4ca71fb42a *tests/testthat/test-ops-division.R d3adceba84aac074b50e709c402bd41a *tests/testthat/test-ops-integer-division.R 60fc7765254ed8c96b8ffa2a6d0760e2 *tests/testthat/test-ops-modulo.R 86037008da84677d36becc75f59b7d35 *tests/testthat/test-ops-multiplication.R a08f9836f1a3357b7cb9f990e841bced *tests/testthat/test-ops-subtraction.R 52902d409037ebb3a95351cd2aab80e1 *tests/testthat/test-parsers.R 67ef7cf240c37e140864cfd0b9c70d01 *tests/testthat/test-periods.R f3f6114004a34d234155c31d6bf71c36 *tests/testthat/test-pretty.R 173f270fed77bb661836374bf8faa942 *tests/testthat/test-rollback.R 4bc8b618c4ee2d30b88e8c46dadcdf8b *tests/testthat/test-round.R 4ffae300cfc4b4c5c0f6127bff71c2fb *tests/testthat/test-settors.R 9fbc41c56d69f27a12d7194db047c611 *tests/testthat/test-stamp.R 1b6488210c11e477ad2116b52beca075 *tests/testthat/test-timespans.R 9fe0af781d586ea6f104d0138702e4e2 *tests/testthat/test-timezones.R 9e20b2f8cac45f5eca95a5cb2b657361 *tests/testthat/test-update.R f4262bbaa6428416bb6f684fed1721c8 *tests/testthat/test-utilities.R 01d45b1160a36cf9c210bd880c083867 *vignettes/lubridate.Rmd lubridate/build/0000755000175100001440000000000012765562217013357 5ustar hornikuserslubridate/build/vignette.rds0000644000175100001440000000030612765562217015715 0ustar hornikusersb```b`fba`b2 1# ')M*LI,I MAII!ter# t0X X%gwI-HK î?"5lP5,n90{C2K7(1 棸(\^Px7@btr(Q/nlubridate/DESCRIPTION0000644000175100001440000000476712765757370014012 0ustar hornikusersPackage: lubridate Maintainer: Vitalie Spinu License: GPL-2 Title: Make Dealing with Dates a Little Easier LazyData: true Type: Package Authors@R: c(person("Garrett", "Grolemund", role = "aut"), person("Vitalie", "Spinu", email = "spinuvit@gmail.com", role = c("aut","cre")), person("Hadley", "Wickham", role = "aut"), person("Ian", "Lyttle", role="ctb"), person("Imanuel", "Constigan", role = "ctb"), person("Jason", "Law", role="ctb"), person("Doug","Mitarotonda", role="ctb"), person("Joseph", "Larmarange", role="ctb"), person("Jonathan", "Boiser", role="ctb"), person("Chel Hee", "Lee", role = "ctb")) Description: Functions to work with date-times and time-spans: fast and user friendly parsing of date-time data, extraction and updating of components of a date-time (years, months, days, hours, minutes, and seconds), algebraic manipulation on date-time and time-span objects. The 'lubridate' package has a consistent and memorable syntax that makes working with dates easy and fun. Enhances: chron, timeDate, zoo, xts, its, tis, timeSeries, fts, tseries Version: 1.6.0 Depends: methods, R (>= 3.0.0) Imports: stringr Suggests: testthat, knitr, covr BugReports: https://github.com/hadley/lubridate/issues VignetteBuilder: knitr Collate: 'Dates.r' 'POSIXt.r' 'util.r' 'timespans.r' 'intervals.r' 'difftimes.r' 'durations.r' 'periods.r' 'accessors-date.R' 'accessors-day.r' 'accessors-dst.r' 'accessors-hour.r' 'accessors-minute.r' 'accessors-month.r' 'accessors-quarter.r' 'accessors-second.r' 'accessors-tz.r' 'accessors-week.r' 'accessors-year.r' 'am-pm.r' 'time-zones.r' 'numeric.r' 'coercion.r' 'constants.r' 'data.r' 'decimal-dates.r' 'deprecated.r' 'guess.r' 'help.r' 'hidden.r' 'instants.r' 'leap-years.r' 'ops-addition.r' 'ops-%m+%.r' 'ops-compare.r' 'ops-division.r' 'ops-integer-division.r' 'ops-modulo.r' 'ops-multiplication.r' 'ops-subtraction.r' 'parse.r' 'pretty.r' 'round.r' 'stamp.r' 'update.r' RoxygenNote: 5.0.1 NeedsCompilation: yes Packaged: 2016-09-12 17:23:27 UTC; vspinu Author: Garrett Grolemund [aut], Vitalie Spinu [aut, cre], Hadley Wickham [aut], Ian Lyttle [ctb], Imanuel Constigan [ctb], Jason Law [ctb], Doug Mitarotonda [ctb], Joseph Larmarange [ctb], Jonathan Boiser [ctb], Chel Hee Lee [ctb] Repository: CRAN Date/Publication: 2016-09-13 13:11:52 lubridate/man/0000755000175100001440000000000012764006123013017 5ustar hornikuserslubridate/man/dst.Rd0000644000175100001440000000127612705366146014117 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors-dst.r \name{dst} \alias{dst} \title{Get Daylight Savings Time indicator of a date-time.} \usage{ dst(x) } \arguments{ \item{x}{a date-time object} } \value{ A logical. TRUE if DST is in force, FALSE if not, NA if unknown. } \description{ Date-time must be a POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. } \details{ A date-time's daylight savings flag can not be set because it depends on the date-time's year, month, day, and hour values. } \examples{ x <- ymd("2012-03-26") dst(x) } \keyword{chron} \keyword{methods} \keyword{utilities} lubridate/man/timespan.Rd0000644000175100001440000001017312755025555015142 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/timespans.r \name{timespan} \alias{timespan} \alias{timespans} \title{Description of time span classes in lubridate.} \description{ A time span can be measured in three ways: as a duration, an interval, or a period. } \details{ Durations record the exact number of seconds in a time span. They measure the exact passage of time but do not always align with measurements made in larger units of time such as hours, months and years. This is because the exact length of larger time units can be affected by conventions such as leap years and Daylight Savings Time. Base R measures durations with the difftime class. lubridate provides an additional class, the duration class, to facilitate working with durations. durations display as the number of seconds that occur during a time span. If the number is large, a duration object will also display the length in a more convenient unit, but these measurements are only estimates given for convenience. The underlying object is always recorded as a fixed number of seconds. For display and creation purposes, units are converted to seconds using their most common lengths in seconds. Minutes = 60 seconds, hours = 3600 seconds, days = 86400 seconds. Units larger than days are not used due to their variability. duration objects can be easily created with the helper functions \code{\link{dweeks}}, \code{\link{ddays}}, \code{\link{dhours}}, \code{\link{dminutes}} and \code{\link{dseconds}}. These objects can be added to and subtracted from date- times to create a user interface similar to object oriented programming. Duration objects can be added to Date, POSIXct, and POSIXlt objects to return a new date-time. Periods record the change in the clock time between two date-times. They are measured in common time related units: years, months, days, hours, minutes, and seconds. Each unit except for seconds must be expressed in integer values. With the exception of seconds, none of these units have a fixed length. Leap years, leap seconds, and Daylight Savings Time can expand or contract a unit of time depending on when it occurs. For this reason, periods do not have a fixed length until they are paired with a start date. Periods can be used to track changes in clock time. Because periods have a variable length, they must be paired with a start date as an interval (\code{\link{as.interval}}) before they can be accurately converted to and from durations. Period objects can be easily created with the helper functions \code{\link{years}}, \code{\link{months}}, \code{\link{weeks}}, \code{\link{days}}, \code{\link{minutes}}, \code{\link{seconds}}. These objects can be added to and subtracted to date-times to create a user interface similar to object oriented programming. Period objects can be added to Date, POSIXct, and POSIXlt objects to return a new date-time. Intervals are time spans bound by two real date-times. Intervals can be accurately converted to periods and durations. Since an interval is anchored to a fixed moment of time, the exact length of all units of time during the interval can be calculated. To accurately convert between periods and durations, a period or duration should first be converted to an interval with \code{\link{as.interval}}. An interval displays as the start and end points of the time span it represents. } \examples{ duration(3690, "seconds") period(3690, "seconds") period(second = 30, minute = 1, hour = 1) interval(ymd_hms("2009-08-09 13:01:30"), ymd_hms("2009-08-09 12:00:00")) date <- as.POSIXct("2009-03-08 01:59:59") # DST boundary date + days(1) date + ddays(1) date2 <- as.POSIXct("2000-02-29 12:00:00") date2 + years(1) # self corrects to next real day date3 <- as.POSIXct("2009-01-31 01:00:00") date3 + c(0:11) * months(1) span <- date2 \%--\% date #creates interval date <- as.POSIXct("2009-01-01 00:00:00") date + years(1) date - days(3) + hours(6) date + 3 * seconds(10) months(6) + days(1) } \seealso{ \code{\link{duration}} for creating duration objects and \code{\link{period}} for creating period objects, and \code{\link{interval}} for creating interval objects. } \keyword{chron} \keyword{classes} lubridate/man/year.Rd0000644000175100001440000000134712705366146014264 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors-year.r \name{year} \alias{isoyear} \alias{year} \alias{year<-} \title{Get/set years component of a date-time.} \usage{ year(x) year(x) <- value isoyear(x) } \arguments{ \item{x}{a date-time object} \item{value}{a numeric object} } \value{ the years element of x as a decimal number } \description{ Date-time must be a POSIXct, POSIXlt, Date, Period, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. } \details{ year does not yet support years before 0 C.E. } \examples{ x <- ymd("2012-03-26") year(x) year(x) <- 2001 year(x) > 1995 } \keyword{chron} \keyword{manip} \keyword{methods} \keyword{utilities} lubridate/man/hms.Rd0000644000175100001440000000252112755045475014112 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse.r \name{ms} \alias{hm} \alias{hms} \alias{ms} \title{Create a period with the specified hours, minutes, and seconds} \usage{ ms(..., quiet = FALSE, roll = FALSE) hm(..., quiet = FALSE, roll = FALSE) hms(..., quiet = FALSE, roll = FALSE) } \arguments{ \item{...}{a character vector of hour minute second triples} \item{quiet}{logical. When TRUE function evalueates without displaying customary messages.} \item{roll}{logica. When TRUE smaller units are rolled over to higher units if they exceed the conventional limit. For example \code{hms("01:59:120", roll=TRUE)} produces period "2H 1M 0S".} } \value{ a vector of period objects } \description{ Transforms a character or numeric vector into a period object with the specified number of hours, minutes, and seconds. hms() recognizes all non-numeric characters except '-' as separators ('-' is used for negative durations). After hours, minutes and seconds have been parsed, the remaining input is ingored. } \examples{ ms(c("09:10", "09:02", "1:10")) ms("7 6") ms("6,5") hm(c("09:10", "09:02", "1:10")) hm("7 6") hm("6,5") x <- c("09:10:01", "09:10:02", "09:10:03") hms(x) hms("7 6 5", "3:23:::2", "2 : 23 : 33", "Finished in 9 hours, 20 min and 4 seconds") } \seealso{ \code{\link{hm}, \link{ms}} } \keyword{period} lubridate/man/reclass_date.Rd0000644000175100001440000000047612705366146015757 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.r \name{reclass_date} \alias{reclass_date} \title{Convenience method to reclass dates post-modification.} \usage{ reclass_date(new, orig) } \description{ Convenience method to reclass dates post-modification. } \keyword{internal} lubridate/man/guess_formats.Rd0000644000175100001440000000453612710103264016172 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/guess.r \name{guess_formats} \alias{guess_formats} \title{Guess formats from the supplied date-time character vector.} \usage{ guess_formats(x, orders, locale = Sys.getlocale("LC_TIME"), preproc_wday = TRUE, print_matches = FALSE) } \arguments{ \item{x}{input vector of date-times} \item{orders}{format orders to look for. See examples.} \item{locale}{locale to use, default to the current locale} \item{preproc_wday}{whether to preprocess week days names. Internal optimization used by ymd_hms family of functions. If true week days are substituted with %a or %A accordingly, so that there is no need to supply this format explicitly.} \item{print_matches}{for development purpose mainly. If TRUE prints a matrix of matched templates.} } \value{ a vector of matched formats } \description{ Guess formats from the supplied date-time character vector. } \examples{ x <- c('February 20th 1973', "february 14, 2004", "Sunday, May 1, 2000", "Sunday, May 1, 2000", "february 14, 04", 'Feb 20th 73', "January 5 1999 at 7pm", "jan 3 2010", "Jan 1, 1999", "jan 3 10", "01 3 2010", "1 3 10", '1 13 89', "5/27/1979", "12/31/99", "DOB:12/11/00", "-----------", 'Thu, 1 July 2004 22:30:00', 'Thu, 1st of July 2004 at 22:30:00', 'Thu, 1July 2004 at 22:30:00', 'Thu, 1July2004 22:30:00', 'Thu, 1July04 22:30:00', "21 Aug 2011, 11:15:34 pm", "-----------", "1979-05-27 05:00:59", "1979-05-27", "-----------", "3 jan 2000", "17 april 85", "27/5/1979", '20 01 89', '00/13/10', "-------", "14 12 00", "03:23:22 pm") guess_formats(x, "BdY") guess_formats(x, "Bdy") ## m also matches b and B; y also matches Y guess_formats(x, "mdy", print_matches = TRUE) ## T also matches IMSp order guess_formats(x, "T", print_matches = TRUE) ## b and B are equivalent and match, both, abreviated and full names guess_formats(x, c("mdY", "BdY", "Bdy", "bdY", "bdy"), print_matches = TRUE) guess_formats(x, c("dmy", "dbY", "dBy", "dBY"), print_matches = TRUE) guess_formats(x, c("dBY HMS", "dbY HMS", "dmyHMS", "BdY H"), print_matches = TRUE) guess_formats(x, c("ymd HMS"), print_matches = TRUE) } lubridate/man/pretty_dates.Rd0000644000175100001440000000200212755025555016021 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pretty.r \name{pretty_dates} \alias{pretty_dates} \title{Computes attractive axis breaks for date-time data} \usage{ pretty_dates(x, n, ...) } \arguments{ \item{x}{a vector of POSIXct, POSIXlt, Date, or chron date-time objects} \item{n}{integer value of the desired number of breaks} \item{...}{additional arguments to pass to function} } \value{ a vector of date-times that can be used as axis tick marks or bin breaks } \description{ pretty.dates indentifies which unit of time the sub-intervals should be measured in to provide approximately n breaks. It then chooses a "pretty" length for the sub-intervals and sets start and endpoints that 1) span the entire range of the data, and 2) allow the breaks to occur on important date-times (i.e. on the hour, on the first of the month, etc.) } \examples{ x <- seq.Date(as.Date("2009-08-02"), by = "year", length.out = 2) pretty_dates(x, 12) } \keyword{chron} \keyword{dplot} \keyword{utilities} lubridate/man/decimal_date.Rd0000644000175100001440000000101412705366146015706 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/decimal-dates.r \name{decimal_date} \alias{decimal_date} \title{Converts a date to a decimal of its year.} \usage{ decimal_date(date) } \arguments{ \item{date}{a POSIXt or Date object} } \value{ a numeric object where the date is expressed as a fraction of its year } \description{ Converts a date to a decimal of its year. } \examples{ date <- ymd("2009-02-10") decimal_date(date) # 2009.11 } \keyword{chron} \keyword{manip} \keyword{methods} lubridate/man/origin.Rd0000644000175100001440000000075612755025555014617 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/instants.r \docType{data} \name{origin} \alias{origin} \title{1970-01-01 UTC} \format{An object of class \code{POSIXct} (inherits from \code{POSIXt}) of length 1.} \usage{ origin } \description{ Origin is the date-time for 1970-01-01 UTC in POSIXct format. This date-time is the origin for the numbering system used by POSIXct, POSIXlt, chron, and Date classes. } \examples{ origin } \keyword{chron} \keyword{data} lubridate/man/round_date.Rd0000644000175100001440000001126112764012452015435 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/round.r \name{round_date} \alias{ceiling_date} \alias{floor_date} \alias{round_date} \title{Round, floor and ceiling methods for date-time objects.} \usage{ round_date(x, unit = "second") floor_date(x, unit = "seconds") ceiling_date(x, unit = "seconds", change_on_boundary = NULL) } \arguments{ \item{x}{a vector of date-time objects} \item{unit}{a character string specifying the time unit or a multiple of a unit to be rounded to. Valid base units are second, minute, hour, day, week, month, bimonth, quarter, halfyear, or year. Arbitrary unique English abbreviations as in \code{\link{period}} constructor are also supported. Rounding to multiple of units (except weeks) is supported from \code{v1.6.0}.} \item{change_on_boundary}{If NULL (the default) don't change instants on the boundary (\code{ceiling_date(ymd_hms('2000-01-01 00:00:00'))} is \code{2000-01-01 00:00:00}), but round up \code{Date} objects to the next boundary (\code{ceiling_date(ymd("2000-01-01"), "month")} is \code{"2000-02-01"}). When \code{TRUE}, instants on the boundary are rounded up to the next boundary. When \code{FALSE}, date-time on the boundary are never rounded up (this was the default for \code{lubridate} prior to \code{v1.6.0}. See section \code{Rounding Up Date Objects} below for more details.} } \description{ Rounding to the nearest unit or multiple of a unit are supported. All meaningfull specifications in English language are supported - secs, min, mins, 2 minutes, 3 years etc. \cr \code{round_date} takes a date-time object and rounds it to the nearest value of the specified time unit. For rounding date-times which is exactly halfway between two consecutive units, the convention is to round up. Note that this is in line with the behavior of R's base \link[base]{round.POSIXt} function but does not follow the convention of the base \link[base]{round} function which "rounds to the even digit" per IEC 60559. \cr \code{floor_date} takes a date-time object and rounds it down to the nearest boundary of the specified time unit. \cr \code{ceiling_date} takes a date-time object and rounds it up to the nearest boundary of the specified time unit. } \details{ In \code{lubridate} rounding of a date-time objects tries to preserve the class of the input object whenever it is meaningful. This is done by first rounding to an instant and then converting to the original class by usual R conventions. } \section{Rounding Up Date Objects}{ By default rounding up \code{Date} objects follows 3 steps: \enumerate{ \item Convert to an instant representing lower bound of the Date: \code{2000-01-01} --> \code{2000-01-01 00:00:00} \item Round up to the \strong{next} closest rounding unit boundary. For example, if the rounding unit is \code{month} then next boundary for \code{2000-01-01} will be \code{2000-02-01 00:00:00}. The motivation for this behavior is that \code{2000-01-01} is conceptually an interval \code{(2000-01-01 00:00:00 -- 2000-01-02 00:00:00)} and the day hasn't started clocking yet at the exact boundary \code{00:00:00}. Thus, it seems wrong to round up a day to its lower boundary. \item If rounding unit is smaller than a day, return the instant from step 2 above (\code{POSIXct}), otherwise return the \code{Date} immediately following that instant. } The behavior on the boundary in the second step above can be changed by setting \code{change_on_boundary} to a non-\code{NULL} value. } \examples{ x <- as.POSIXct("2009-08-03 12:01:59.23") round_date(x, "second") round_date(x, "minute") round_date(x, "5 mins") round_date(x, "hour") round_date(x, "2 hours") round_date(x, "day") round_date(x, "week") round_date(x, "month") round_date(x, "bimonth") round_date(x, "quarter") == round_date(x, "3 months") round_date(x, "halfyear") round_date(x, "year") x <- as.POSIXct("2009-08-03 12:01:59.23") floor_date(x, "second") floor_date(x, "minute") floor_date(x, "hour") floor_date(x, "day") floor_date(x, "week") floor_date(x, "month") floor_date(x, "bimonth") floor_date(x, "quarter") floor_date(x, "halfyear") floor_date(x, "year") x <- as.POSIXct("2009-08-03 12:01:59.23") ceiling_date(x, "second") ceiling_date(x, "minute") ceiling_date(x, "5 mins") ceiling_date(x, "hour") ceiling_date(x, "day") ceiling_date(x, "week") ceiling_date(x, "month") ceiling_date(x, "bimonth") == ceiling_date(x, "2 months") ceiling_date(x, "quarter") ceiling_date(x, "halfyear") ceiling_date(x, "year") x <- ymd("2000-01-01") ceiling_date(x, "month") ceiling_date(x, "month", change_on_boundary = TRUE) } \seealso{ \link[base]{round} } \keyword{chron} \keyword{manip} lubridate/man/stamp.Rd0000644000175100001440000000546412747740626014461 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stamp.r \name{stamp} \alias{stamp} \alias{stamp_date} \alias{stamp_time} \title{Format dates and times based on human-friendly templates.} \usage{ stamp(x, orders = lubridate_formats, locale = Sys.getlocale("LC_TIME"), quiet = FALSE) stamp_date(x, locale = Sys.getlocale("LC_TIME")) stamp_time(x, locale = Sys.getlocale("LC_TIME")) } \arguments{ \item{x}{a character vector of templates.} \item{orders}{orders are sequences of formatting characters which might be used for disambiguation. For example "ymd hms", "aym" etc. See \code{\link{guess_formats}} for a list of available formats.} \item{locale}{locale in which \code{x} is encoded. On linux like systems use \code{locale -a} in terminal to list available locales.} \item{quiet}{whether to output informative messages.} } \value{ a function to be applied on a vector of dates } \description{ Stamps are just like \code{\link{format}}, but based on human-frendly templates like "Recorded at 10 am, September 2002" or "Meeting, Sunday May 1, 2000, at 10:20 pm". } \details{ \code{stamp} is a stamping function date-time templates mainly, though it correctly handles all date and time formats as long as they are unambiguous. \code{stamp_date}, and \code{stamp_time} are the specialized stamps for dates and times (MHS). These function might be useful when the input template is unambiguous and matches both a time and a date format. Lubridate tries it's best to figure our the formats, but often a given format can be interpreted in several ways. One way to deal with the situation is to provide unambiguous formats like 22/05/81 instead of 10/05/81 if you want d/m/y format. Another option is to use a more specialized stamp_date and stamp_time. The core function \code{stamp} give priority to longer date-time formats. Another option is to proved a vector of several values as \code{x} parameter. Then lubridate will choose the format which fits \code{x} the best. Note that longer formats are preferred. If you have "22:23:00 PM" then "HMSp" format will be given priority to shorter "HMS" order which also fits the supplied string. Finally, you can give desired format order directly as \code{orders} argument. } \examples{ D <- ymd("2010-04-05") - days(1:5) stamp("March 1, 1999")(D) sf <- stamp("Created on Sunday, Jan 1, 1999 3:34 pm") sf(D) stamp("Jan 01")(D) stamp("Sunday, May 1, 2000", locale = "en_US")(D) stamp("Sun Aug 5")(D) #=> "Sun Aug 04" "Sat Aug 04" "Fri Aug 04" "Thu Aug 04" "Wed Aug 03" stamp("12/31/99")(D) #=> "06/09/11" stamp("Sunday, May 1, 2000 22:10", locale = "en_US")(D) stamp("2013-01-01T06:00:00Z")(D) stamp("2013-01-01T00:00:00-06")(D) stamp("2013-01-01T00:00:00-08:00")(force_tz(D, "America/Chicago")) } \seealso{ \link{guess_formats}, \link{parse_date_time}, \link{strptime} } lubridate/man/Timespan-class.Rd0000644000175100001440000000072112705366146016202 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/timespans.r \docType{class} \name{Timespan-class} \alias{*,Timespan,Timespan-method} \alias{Timespan-class} \alias{\%/\%,Timespan,Timespan-method} \alias{\%/\%,difftime,Timespan-method} \title{Timespan class} \description{ Timespan is an S4 class with no slots. It is extended by the \code{\link{Interval-class}}, \code{\link{Period-class}}, and \code{\link{Duration-class}} classes. } lubridate/man/as.period.Rd0000644000175100001440000000674612757714520015220 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.r \name{as.period} \alias{as.period} \alias{as.period,Duration-method} \alias{as.period,Interval-method} \alias{as.period,Period-method} \alias{as.period,character-method} \alias{as.period,difftime-method} \alias{as.period,logical-method} \alias{as.period,numeric-method} \title{Change an object to a period.} \usage{ as.period(x, unit, ...) } \arguments{ \item{x}{an interval, difftime, or numeric object} \item{unit}{A character string that specifies which time units to build period in. unit is only implemented for the as.period.numeric method and the as.period.interval method. For as.period.interval, as.period will convert intervals to units no larger than the specified unit.} \item{...}{additional arguments to pass to as.period} } \value{ a period object } \description{ as.period changes Interval, Duration, difftime and numeric class objects to Period class objects with the specified units. } \details{ Users must specify which time units to measure the period in. The exact length of each time unit in a period will depend on when it occurs. See \code{\link{Period-class}} and \code{\link{period}}. The choice of units is not trivial; units that are normally equal may differ in length depending on when the time period occurs. For example, when a leap second occurs one minute is longer than 60 seconds. Because periods do not have a fixed length, they can not be accurately converted to and from Duration objects. Duration objects measure time spans in exact numbers of seconds, see \code{\link{Duration-class}}. Hence, a one to one mapping does not exist between durations and periods. When used with a Duration object, as.period provides an inexact estimate; the duration is broken into time units based on the most common lengths of time units, in seconds. Because the length of months are particularly variable, a period with a months unit can not be coerced from a duration object. For an exact transformation, first transform the duration to an interval with \code{\link{as.interval}}. Coercing an interval to a period may cause surprising behavior if you request periods with small units. A leap year is 366 days long, but one year long. Such an interval will convert to 366 days when unit is set to days and 1 year when unit is set to years. Adding 366 days to a date will often give a different result than adding one year. Daylight savings is the one exception where this does not apply. Interval lengths are calculated on the UTC timeline, which does not use daylight savings. Hence, periods converted with seconds or minutes will not reflect the actual variation in seconds and minutes that occurs due to daylight savings. These periods will show the "naive" change in seconds and minutes that is suggested by the differences in clock time. See the examples below. } \examples{ span <- interval(as.POSIXct("2009-01-01"), as.POSIXct("2010-02-02 01:01:01")) #interval as.period(span) as.period(span, units = "day") "397d 1H 1M 1S" leap <- interval(ymd("2016-01-01"), ymd("2017-01-01")) as.period(leap, unit = "days") as.period(leap, unit = "years") dst <- interval(ymd("2016-11-06", tz = "America/Chicago"), ymd("2016-11-07", tz = "America/Chicago")) # as.period(dst, unit = "seconds") as.period(dst, unit = "hours") per <- period(hours = 10, minutes = 6) as.numeric(per, "hours") as.numeric(per, "minutes") } \seealso{ \code{\link{Period-class}}, \code{\link{period}} } \keyword{chron} \keyword{classes} \keyword{manip} \keyword{methods} lubridate/man/quick_durations.Rd0000644000175100001440000000401612755025555016525 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/durations.r \name{quick_durations} \alias{ddays} \alias{dhours} \alias{dmicroseconds} \alias{dmilliseconds} \alias{dminutes} \alias{dnanoseconds} \alias{dpicoseconds} \alias{dseconds} \alias{dweeks} \alias{dyears} \alias{quick_durations} \title{Quickly create duration objects.} \usage{ dseconds(x = 1) dminutes(x = 1) dhours(x = 1) ddays(x = 1) dweeks(x = 1) dyears(x = 1) dmilliseconds(x = 1) dmicroseconds(x = 1) dnanoseconds(x = 1) dpicoseconds(x = 1) } \arguments{ \item{x}{numeric value of the number of units to be contained in the duration.} } \value{ a duration object } \description{ Quickly create Duration objects for easy date-time manipulation. The units of the duration created depend on the name of the function called. For Duration objects, units are equal to their most common lengths in seconds (i.e. minutes = 60 seconds, hours = 3600 seconds, days = 86400 seconds, weeks = 604800, years = 31536000). } \details{ When paired with date-times, these functions allow date-times to be manipulated in a method similar to object oriented programming. Duration objects can be added to Date, POSIXt, and Interval objects. Since version 1.4.0 the following functions are deprecated: \code{eseconds}, \code{eminutes}, \code{ehours}, \code{edays}, \code{eweeks}, \code{eyears}, \code{emilliseconds}, \code{emicroseconds}, \code{enanoseconds}, \code{epicoseconds} } \examples{ dseconds(1) dminutes(3.5) x <- as.POSIXct("2009-08-03") x + ddays(1) + dhours(6) + dminutes(30) x + ddays(100) - dhours(8) class(as.Date("2009-08-09") + ddays(1)) # retains Date class as.Date("2009-08-09") + dhours(12) class(as.Date("2009-08-09") + dhours(12)) # converts to POSIXt class to accomodate time units dweeks(1) - ddays(7) c(1:3) * dhours(1) # # compare DST handling to durations boundary <- as.POSIXct("2009-03-08 01:59:59") boundary + days(1) # period boundary + ddays(1) # duration } \seealso{ \code{\link{duration}}, \code{\link{days}} } \keyword{chron} \keyword{manip} lubridate/man/ymd_hms.Rd0000644000175100001440000001172512755025555014766 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse.r \name{ymd_hms} \alias{dmy_h} \alias{dmy_hm} \alias{dmy_hms} \alias{mdy_h} \alias{mdy_hm} \alias{mdy_hms} \alias{ydm_h} \alias{ydm_hm} \alias{ydm_hms} \alias{ymd_h} \alias{ymd_hm} \alias{ymd_hms} \title{Parse dates that have hours, minutes, or seconds elements.} \usage{ ymd_hms(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) ymd_hm(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) ymd_h(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) dmy_hms(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) dmy_hm(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) dmy_h(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) mdy_hms(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) mdy_hm(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) mdy_h(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) ydm_hms(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) ydm_hm(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) ydm_h(..., quiet = FALSE, tz = "UTC", locale = Sys.getlocale("LC_TIME"), truncated = 0) } \arguments{ \item{...}{a character vector of dates in year, month, day, hour, minute, second format} \item{quiet}{logical. When TRUE function evalueates without displaying customary messages.} \item{tz}{a character string that specifies which time zone to parse the date with. The string must be a time zone that is recognized by the user's OS.} \item{locale}{locale to be used, see \link{locales}. On linux systems you can use \code{system("locale -a")} to list all the installed locales.} \item{truncated}{integer, indicating how many formats can be missing. See details.} } \value{ a vector of POSIXct date-time objects } \description{ Transform dates stored as character or numeric vectors to POSIXct objects. ymd_hms family of functions recognize all non-alphanumeric separators (with the exception of "." if \code{frac = TRUE}) and correctly handle heterogeneous date-time representations. For more flexibility in treatment of heterogeneous formats, see low level parser \code{\link{parse_date_time}}. } \details{ ymd_hms() functions automatically assigns the Universal Coordinated Time Zone (UTC) to the parsed date. This time zone can be changed with \code{\link{force_tz}}. The most common type of irregularity in date-time data is the truncation due to rounding or unavailability of the time stamp. If \code{truncated} parameter is non-zero \code{ymd_hms} functions also check for truncated formats. For example \code{ymd_hms} with \code{truncated = 3} will also parse incomplete dates like \code{2012-06-01 12:23}, \code{2012-06-01 12} and \code{2012-06-01}. NOTE: \code{ymd} family of functions are based on \code{strptime} which currently fails to parse \code{\%y-\%m} formats. As of version 1.3.0, lubridate's parse functions no longer return a message that displays which format they used to parse their input. You can change this by setting the \code{lubridate.verbose} option to true with \code{options(lubridate.verbose = TRUE)}. } \examples{ x <- c("2010-04-14-04-35-59", "2010-04-01-12-00-00") ymd_hms(x) x <- c("2011-12-31 12:59:59", "2010-01-01 12:00:00") ymd_hms(x) ## ** heterogenuous formats ** x <- c(20100101120101, "2009-01-02 12-01-02", "2009.01.03 12:01:03", "2009-1-4 12-1-4", "2009-1, 5 12:1, 5", "200901-08 1201-08", "2009 arbitrary 1 non-decimal 6 chars 12 in between 1 !!! 6", "OR collapsed formats: 20090107 120107 (as long as prefixed with zeros)", "Automatic wday, Thu, detection, 10-01-10 10:01:10 and p format: AM", "Created on 10-01-11 at 10:01:11 PM") ymd_hms(x) ## ** fractional seconds ** op <- options(digits.secs=3) dmy_hms("20/2/06 11:16:16.683") options(op) ## ** different formats for ISO8601 timezone offset ** ymd_hms(c("2013-01-24 19:39:07.880-0600", "2013-01-24 19:39:07.880", "2013-01-24 19:39:07.880-06:00", "2013-01-24 19:39:07.880-06", "2013-01-24 19:39:07.880Z")) ## ** internationalization ** \dontrun{ x_RO <- "Ma 2012 august 14 11:28:30 " ymd_hms(x_RO, locale = "ro_RO.utf8") } ## ** truncated time-dates ** x <- c("2011-12-31 12:59:59", "2010-01-01 12:11", "2010-01-01 12", "2010-01-01") ymd_hms(x, truncated = 3) x <- c("2011-12-31 12:59", "2010-01-01 12", "2010-01-01") ymd_hm(x, truncated = 2) ## ** What lubridate might not handle ** ## Extremely weird cases when one of the separators is "" and some of the ## formats are not in double digits might not be parsed correctly: \dontrun{ ymd_hm("20100201 07-01", "20100201 07-1", "20100201 7-01")} } \seealso{ \code{\link{ymd}}, \code{\link{hms}}. \code{\link{parse_date_time}} for underlying mechanism. } \keyword{POSIXt} \keyword{parse} lubridate/man/hidden_aliases.Rd0000644000175100001440000001764212757714361016270 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/intervals.r, R/durations.r, R/periods.r, R/hidden.r \docType{data} \name{hidden_aliases} \alias{!=,Duration,Period} \alias{!=,Duration,Period-method} \alias{!=,Period,Duration} \alias{!=,Period,Duration-method} \alias{!=,Period,Period} \alias{!=,Period,Period-method} \alias{!=,Period,numeric} \alias{!=,Period,numeric-method} \alias{!=,numeric,Period} \alias{!=,numeric,Period-method} \alias{$,Duration-method} \alias{$,Interval-method} \alias{$,Period-method} \alias{$<-,Duration-method} \alias{$<-,Interval-method} \alias{$<-,Period-method} \alias{*,ANY,Duration-method} \alias{*,ANY,Interval-method} \alias{*,ANY,Period} \alias{*,ANY,Period-method} \alias{*,Duration,ANY-method} \alias{*,Interval,ANY-method} \alias{*,Period,ANY} \alias{*,Period,ANY-method} \alias{+,Date,Duration-method} \alias{+,Date,Interval-method} \alias{+,Date,Period-method} \alias{+,Duration,Date-method} \alias{+,Duration,Duration-method} \alias{+,Duration,Interval-method} \alias{+,Duration,POSIXct-method} \alias{+,Duration,POSIXlt-method} \alias{+,Duration,Period-method} \alias{+,Duration,difftime-method} \alias{+,Duration,numeric-method} \alias{+,Interval,Date-method} \alias{+,Interval,Duration-method} \alias{+,Interval,Interval-method} \alias{+,Interval,POSIXct-method} \alias{+,Interval,POSIXlt-method} \alias{+,Interval,Period-method} \alias{+,Interval,difftime-method} \alias{+,Interval,numeric-method} \alias{+,POSIXct,Duration-method} \alias{+,POSIXct,Interval-method} \alias{+,POSIXct,Period-method} \alias{+,POSIXlt,Duration-method} \alias{+,POSIXlt,Interval-method} \alias{+,POSIXlt,Period-method} \alias{+,Period,Date-method} \alias{+,Period,Duration-method} \alias{+,Period,Interval-method} \alias{+,Period,POSIXct-method} \alias{+,Period,POSIXlt-method} \alias{+,Period,Period-method} \alias{+,Period,difftime-method} \alias{+,Period,numeric-method} \alias{+,difftime,Duration-method} \alias{+,difftime,Interval-method} \alias{+,difftime,Period-method} \alias{+,numeric,Duration-method} \alias{+,numeric,Interval-method} \alias{+,numeric,Period-method} \alias{-,ANY,Duration-method} \alias{-,ANY,Period} \alias{-,ANY,Period-method} \alias{-,Date,Interval} \alias{-,Date,Interval-method} \alias{-,Duration,ANY-method} \alias{-,Duration,Interval} \alias{-,Duration,Interval-method} \alias{-,Duration,missing-method} \alias{-,Interval,Date} \alias{-,Interval,Date-method} \alias{-,Interval,Interval} \alias{-,Interval,Interval-method} \alias{-,Interval,POSIXct} \alias{-,Interval,POSIXct-method} \alias{-,Interval,POSIXlt} \alias{-,Interval,POSIXlt-method} \alias{-,Interval,missing-method} \alias{-,Interval,numeric} \alias{-,Interval,numeric-method} \alias{-,POSIXct,Interval} \alias{-,POSIXct,Interval-method} \alias{-,POSIXlt,Interval} \alias{-,POSIXlt,Interval-method} \alias{-,Period,ANY-method} \alias{-,Period,Interval} \alias{-,Period,Interval-method} \alias{-,Period,missing} \alias{-,Period,missing-method} \alias{-,numeric,Interval} \alias{-,numeric,Interval-method} \alias{/,Duration,Duration-method} \alias{/,Duration,Interval-method} \alias{/,Duration,Period-method} \alias{/,Duration,difftime-method} \alias{/,Duration,numeric-method} \alias{/,Interval,Duration-method} \alias{/,Interval,Interval-method} \alias{/,Interval,Period-method} \alias{/,Interval,difftime-method} \alias{/,Interval,numeric-method} \alias{/,Period,Duration-method} \alias{/,Period,Interval-method} \alias{/,Period,Period-method} \alias{/,Period,difftime-method} \alias{/,Period,numeric-method} \alias{/,difftime,Duration-method} \alias{/,difftime,Interval-method} \alias{/,difftime,Period-method} \alias{/,numeric,Duration-method} \alias{/,numeric,Interval-method} \alias{/,numeric,Period} \alias{/,numeric,Period-method} \alias{<,Duration,Period} \alias{<,Duration,Period-method} \alias{<,Period,Duration} \alias{<,Period,Duration-method} \alias{<,Period,Period} \alias{<,Period,Period-method} \alias{<,Period,numeric} \alias{<,Period,numeric-method} \alias{<,numeric,Period} \alias{<,numeric,Period-method} \alias{<=,Duration,Period} \alias{<=,Duration,Period-method} \alias{<=,Period,Duration} \alias{<=,Period,Duration-method} \alias{<=,Period,Period} \alias{<=,Period,Period-method} \alias{<=,Period,numeric} \alias{<=,Period,numeric-method} \alias{<=,numeric,Period} \alias{<=,numeric,Period-method} \alias{==,Duration,Period} \alias{==,Duration,Period-method} \alias{==,Period,Duration} \alias{==,Period,Duration-method} \alias{==,Period,Period} \alias{==,Period,Period-method} \alias{==,Period,numeric} \alias{==,Period,numeric-method} \alias{==,numeric,Period} \alias{==,numeric,Period-method} \alias{>,Duration,Period} \alias{>,Duration,Period-method} \alias{>,Period,Duration} \alias{>,Period,Duration-method} \alias{>,Period,Period} \alias{>,Period,Period-method} \alias{>,Period,numeric} \alias{>,Period,numeric-method} \alias{>,numeric,Period} \alias{>,numeric,Period-method} \alias{>=,Duration,Period} \alias{>=,Duration,Period-method} \alias{>=,Period,Duration} \alias{>=,Period,Duration-method} \alias{>=,Period,Period} \alias{>=,Period,Period-method} \alias{>=,Period,numeric} \alias{>=,Period,numeric-method} \alias{>=,numeric,Period} \alias{>=,numeric,Period-method} \alias{Arith,ANY,Interval-method} \alias{Arith,ANY,Period-method} \alias{Arith,Duration,Period-method} \alias{Arith,Interval,ANY-method} \alias{Arith,Period,ANY-method} \alias{Arith,Period,Duration-method} \alias{Compare,ANY,Duration-method} \alias{Compare,Duration,ANY-method} \alias{Compare,Duration,Duration-method} \alias{Compare,Duration,Period-method} \alias{Compare,Duration,character-method} \alias{Compare,Period,Duration-method} \alias{Compare,Period,Period-method} \alias{Compare,Period,character-method} \alias{Compare,Period,numeric-method} \alias{Compare,character,Duration-method} \alias{Compare,character,Period-method} \alias{Compare,difftime,Duration-method} \alias{[,Duration-method} \alias{[,Interval-method} \alias{[,Period-method} \alias{[<-,Duration,ANY,ANY,ANY-method} \alias{[<-,Interval,ANY,ANY,ANY-method} \alias{[<-,Period,ANY,ANY,Period-method} \alias{[[,Duration-method} \alias{[[,Interval-method} \alias{[[,Period-method} \alias{[[<-,Duration,ANY,ANY,ANY-method} \alias{[[<-,Interval,ANY,ANY,ANY-method} \alias{[[<-,Period,ANY,ANY,Period-method} \alias{\%\%,Duration,Duration-method} \alias{\%\%,Duration,Interval-method} \alias{\%\%,Duration,Period-method} \alias{\%\%,Interval,Duration} \alias{\%\%,Interval,Duration-method} \alias{\%\%,Interval,Interval} \alias{\%\%,Interval,Interval-method} \alias{\%\%,Interval,Period} \alias{\%\%,Interval,Period-method} \alias{\%\%,Period,Duration} \alias{\%\%,Period,Duration-method} \alias{\%\%,Period,Interval} \alias{\%\%,Period,Interval-method} \alias{\%\%,Period,Period} \alias{\%\%,Period,Period-method} \alias{as.character,Duration-method} \alias{as.character,Interval-method} \alias{as.character,Period-method} \alias{as.difftime,Duration-method} \alias{as.difftime,Interval-method} \alias{as.difftime,Period-method} \alias{as.numeric,Duration-method} \alias{as.numeric,Interval-method} \alias{as.numeric,Period-method} \alias{c,Duration-method} \alias{c,Interval-method} \alias{c,Period-method} \alias{date,Period-method} \alias{date<-,Period-method} \alias{day,Period-method} \alias{day<-,Period-method} \alias{hidden_aliases} \alias{hour,Period-method} \alias{hour<-,Period-method} \alias{intersect,Interval,Interval-method} \alias{minute,Period-method} \alias{minute<-,Period-method} \alias{month,Period-method} \alias{month<-,Period-method} \alias{rep,Duration-method} \alias{rep,Interval-method} \alias{rep,Period-method} \alias{second,Period-method} \alias{second<-,Period-method} \alias{setdiff,Interval,Interval-method} \alias{show,Duration-method} \alias{show,Interval-method} \alias{show,Period-method} \alias{union,Interval,Interval-method} \alias{year,Period-method} \alias{year<-,Period-method} \title{Internal page for hidden aliases} \description{ For S4 methods that require a documentation entry but only clutter the index. } \keyword{internal} lubridate/man/quarter.Rd0000644000175100001440000000152312763546421015003 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors-quarter.r \name{quarter} \alias{quarter} \alias{semester} \title{Get the fiscal quarter and semester of a date-time.} \usage{ quarter(x, with_year = FALSE) semester(x, with_year = FALSE) } \arguments{ \item{x}{a date-time object of class POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, fts or anything else that can be converted with as.POSIXlt} \item{with_year}{logical indicating whether or not to include the quarter's year.} } \value{ numeric } \description{ Quarters divide the year into fourths. Semesters divide the year into halfs. } \examples{ x <- ymd(c("2012-03-26", "2012-05-04", "2012-09-23", "2012-12-31")) quarter(x) quarter(x, with_year = TRUE) semester(x) semester(x, with_year = TRUE) } lubridate/man/DateUpdate.Rd0000644000175100001440000000262012755025555015340 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/update.r \name{DateUpdate} \alias{DateUpdate} \alias{update.POSIXt} \title{Changes the components of a date object} \usage{ \method{update}{POSIXt}(object, ..., simple = FALSE) } \arguments{ \item{object}{a date-time object} \item{...}{named arguments: years, months, ydays, wdays, mdays, days, hours, minutes, seconds, tzs (time zone compnent)} \item{simple}{logical, passed to \code{fit_to_timeline}. If TRUE a simple fit to time line is performed and no NA are produced for invalid dates. Invalid dates are converted to meaningful dates by extrapolating the timezones.} } \value{ a date object with the requested elements updated. The object will retain its original class unless an element is updated which the original class does not support. In this case, the date returned will be a POSIXlt date object. } \description{ \code{update.Date} and \code{update.POSIXt} return a date with the specified elements updated. Elements not specified will be left unaltered. update.Date and update.POSIXt do not add the specified values to the existing date, they substitute them for the appropriate parts of the existing date. } \examples{ date <- as.POSIXlt("2009-02-10") update(date, year = 2010, month = 1, mday = 1) update(date, year =2010, month = 13, mday = 1) update(date, minute = 10, second = 3) } \keyword{chron} \keyword{manip} lubridate/man/second.Rd0000644000175100001440000000127612750350637014576 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors-second.r \name{second} \alias{second} \alias{second<-} \title{Get/set seconds component of a date-time.} \usage{ second(x) second(x) <- value } \arguments{ \item{x}{a date-time object} \item{value}{numeric value to be assigned} } \value{ the seconds element of x as a decimal number } \description{ Date-time must be a POSIXct, POSIXlt, Date, Period, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. } \examples{ x <- ymd("2012-03-26") second(x) second(x) <- 1 second(x) <- 61 second(x) > 2 } \keyword{chron} \keyword{manip} \keyword{methods} \keyword{utilities} lubridate/man/is.POSIXt.Rd0000644000175100001440000000116312750350637015016 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/POSIXt.r \name{is.POSIXt} \alias{is.POSIXct} \alias{is.POSIXlt} \alias{is.POSIXt} \title{Is x a POSIXct or POSIXlt object?} \usage{ is.POSIXt(x) is.POSIXlt(x) is.POSIXct(x) } \arguments{ \item{x}{an R object} } \value{ TRUE if x is a POSIXct or POSIXlt object, FALSE otherwise. } \description{ Is x a POSIXct or POSIXlt object? } \examples{ is.POSIXt(as.Date("2009-08-03")) # FALSE is.POSIXt(as.POSIXct("2009-08-03")) # TRUE } \seealso{ \code{\link{is.instant}}, \code{\link{is.timespan}}, \code{\link{is.Date}} } \keyword{chron} \keyword{logic} lubridate/man/lakers.Rd0000644000175100001440000000130412705366146014576 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.r \docType{data} \name{lakers} \alias{lakers} \title{Lakers 2008-2009 basketball data set} \description{ This data set contains play by play statistics of each Los Angeles Lakers basketball game in the 2008-2009 season. Data includes the date, opponent, and type of each game (home or away). Each play is described by the time on the game clock when the play was made, the period in which the play was attempted, the type of play, the player and team who made the play, the result of the play, and the location on the court where each play was made. } \references{ \url{http://www.basketballgeek.com/data/} } \keyword{data} lubridate/man/days_in_month.Rd0000644000175100001440000000100512705366146016146 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors-month.r \name{days_in_month} \alias{days_in_month} \title{Get the number of days in the month of a date-time.} \usage{ days_in_month(x) } \arguments{ \item{x}{a date-time object} } \value{ An integer of the number of days in the month component of the date-time object. } \description{ Date-time must be a POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. } lubridate/man/Deprecated.Rd0000644000175100001440000000216712750343035015355 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprecated.r \name{Deprecated-lubridate} \alias{Deprecated-lubridate} \alias{edays} \alias{ehours} \alias{emicroseconds} \alias{emilliseconds} \alias{eminutes} \alias{enanoseconds} \alias{epicoseconds} \alias{eseconds} \alias{eweeks} \alias{eyears} \alias{here} \alias{new_difftime} \alias{new_duration} \alias{new_interval} \alias{new_period} \alias{olson_time_zones} \title{Deprecated function in \code{lubridate} package} \usage{ new_period(...) new_interval(...) new_duration(...) new_difftime(...) eseconds(x = 1) eminutes(x = 1) ehours(x = 1) edays(x = 1) eweeks(x = 1) eyears(x = 1) emilliseconds(x = 1) emicroseconds(x = 1) enanoseconds(x = 1) epicoseconds(x = 1) here() olson_time_zones(order_by = c("name", "longitude")) } \arguments{ \item{...}{arguments to be passed to the functions (obscured to enforce the usage of new functions)} \item{x}{numeric value to be converted into duration} \item{order_by}{Return names alphabetically (the default) or from West to East.} } \description{ Deprecated function in \code{lubridate} package } lubridate/man/is.timespan.Rd0000644000175100001440000000115712705366146015555 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/timespans.r \name{is.timespan} \alias{is.timespan} \title{Is x a length of time?} \usage{ is.timespan(x) } \arguments{ \item{x}{an R object} } \value{ TRUE if x is a period, interval, duration, or difftime object, FALSE otherwise. } \description{ Is x a length of time? } \examples{ is.timespan(as.Date("2009-08-03")) # FALSE is.timespan(duration(second = 1)) # TRUE } \seealso{ \code{\link{is.instant}}, \code{\link{is.duration}}, \code{\link{is.difftime}}, \code{\link{is.period}}, \code{\link{is.interval}} } \keyword{chron} \keyword{logic} lubridate/man/make_difftime.Rd0000644000175100001440000000433312755025555016107 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/difftimes.r \name{make_difftime} \alias{make_difftime} \title{Create a difftime object.} \usage{ make_difftime(num = NULL, units = "auto", ...) } \arguments{ \item{num}{Optional number of seconds} \item{units}{a character vector that lists the type of units to use for the display of the return value (see examples). If \code{units} is "auto" (the default) the display units are computed automatically. This might create undesirable effects when converting \code{difftime} objects to numeric values in data processing.} \item{...}{a list of time units to be included in the difftime and their amounts. Seconds, minutes, hours, days, and weeks are supported. Normally only one of \code{num} or \code{...} are present. If both are present, the \code{difftime} objects are concatenated.} } \value{ a difftime object } \description{ \code{make_difftime} creates a difftime object with the specified number of units. Entries for different units are cumulative. difftime displays durations in various units, but these units are estimates given for convenience. The underlying object is always recorded as a fixed number of seconds. } \details{ Conceptually, difftime objects are a type of duration. They measure the exact passage of time but do not always align with measurements made in larger units of time such as hours, months and years. This is because the length of larger time units can be affected by conventions such as leap years and Daylight Savings Time. lubridate provides a second class for measuring durations, the Duration class. } \examples{ make_difftime(1) make_difftime(60) make_difftime(3600) make_difftime(3600, units = "minute") # Time difference of 60 mins make_difftime(second = 90) # Time difference of 1.5 mins make_difftime(minute = 1.5) # Time difference of 1.5 mins make_difftime(second = 3, minute = 1.5, hour = 2, day = 6, week = 1) # Time difference of 13.08441 days make_difftime(hour = 1, minute = -60) # Time difference of 0 secs make_difftime(day = -1) # Time difference of -1 days make_difftime(120, day = -1, units = "minute") # Time differences in mins } \seealso{ \code{\link{duration}}, \code{\link{as.duration}} } \keyword{chron} \keyword{classes} lubridate/man/interval.Rd0000644000175100001440000001321412755043417015142 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/intervals.r \name{interval} \alias{\%--\%} \alias{int_aligns} \alias{int_diff} \alias{int_end} \alias{int_end<-} \alias{int_flip} \alias{int_length} \alias{int_overlaps} \alias{int_shift} \alias{int_standardize} \alias{int_start} \alias{int_start<-} \alias{interval} \alias{is.interval} \title{Utilities for creation and manipulation of \code{Interval} objects.} \usage{ interval(start, end, tzone = attr(start, "tzone")) start \%--\% end is.interval(x) int_start(int) int_start(int) <- value int_end(int) int_end(int) <- value int_length(int) int_flip(int) int_shift(int, by) int_overlaps(int1, int2) int_standardize(int) int_aligns(int1, int2) int_diff(times) } \arguments{ \item{start}{a POSIXt or Date date-time object} \item{end}{a POSIXt or Date date-time object} \item{tzone}{a recognized timezone to display the interval in} \item{x}{an R object} \item{int}{an interval object} \item{value}{interval's start/end to be assigned to \code{int}} \item{by}{A period or duration object to shift by (for \code{int_shift})} \item{int1}{an Interval object (for \code{int_overlaps}, \code{int_aligns})} \item{int2}{an Interval object (for \code{int_overlaps}, \code{int_aligns})} \item{times}{A vector of POSIXct, POSIXlt or Date class date-times (for \code{int_diff})} } \value{ \code{interval} - \code{Interval} object. \code{int_start} and \code{int_end} return a POSIXct date object when used as an accessor. Nothing when used as a setter. \code{int_length} - numeric length of the interval in seconds. A negative number connotes a negative interval. \code{int_flip} - flipped interval object \code{int_shift} - interval object \code{int_overlaps} logical, TRUE if int1 and int2 overlap by at least one second. FALSE otherwise \code{int_align} logical, TRUE if int1 and int2 begin or end on the same moment. FALSE otherwise \code{int_diff} - interval object that contains the n-1 intervals between the n date-time in times } \description{ \code{interval} creates an \code{\link{Interval-class}} object with the specified start and end dates. If the start date occurs before the end date, the interval will be positive. Otherwise, it will be negative. \code{\%--\%} Creates an interval that covers the range spanned by two dates. It replaces the original behavior of lubridate, which created an interval by default whenever two date-times were subtracted. \code{int_start} and \code{int_start<-} are accessors the start date of an interval. Note that changing the start date of an interval will change the length of the interval, since the end date will remain the same. \code{int_flip} reverses the order of the start date and end date in an interval. The new interval takes place during the same timespan as the original interval, but has the opposite direction. \code{int_shift} shifts the start and end dates of an interval up or down the timeline by a specified amount. Note that this may change the exact length of the interval if the interval is shifted by a Period object. Intervals shifted by a Duration or difftime object will retain their exact length in seconds. \code{int_overlaps} tests if two intervals overlap. \code{int_standardize} ensures all intervals in an interval object are positive. If an interval is not positive, flip it so that it retains its endpoints but becomes positive. \code{int_aligns} tests if two intervals share an endpoint. The direction of each interval is ignored. int_align tests whether the earliest or latest moments of each interval occur at the same time. \code{int_diff} returns the intervals that occur between the elements of a vector of date-times. \code{int_diff} is similar to the POSIXt and Date methods of \code{\link{diff}}, but returns an \code{Interval} object instead of a difftime object. } \details{ Intervals are time spans bound by two real date-times. Intervals can be accurately converted to either period or duration objects using \code{\link{as.period}}, \code{\link{as.duration}}. Since an interval is anchored to a fixed history of time, both the exact number of seconds that passed and the number of variable length time units that occurred during the interval can be calculated. } \examples{ interval(ymd(20090201), ymd(20090101)) date1 <- as.POSIXct("2009-03-08 01:59:59") date2 <- as.POSIXct("2000-02-29 12:00:00") interval(date2, date1) interval(date1, date2) span <- interval(ymd(20090101), ymd(20090201)) is.interval(period(months= 1, days = 15)) # FALSE is.interval(interval(ymd(20090801), ymd(20090809))) # TRUE int <- interval(ymd("2001-01-01"), ymd("2002-01-01")) int_start(int) int_start(int) <- ymd("2001-06-01") int int <- interval(ymd("2001-01-01"), ymd("2002-01-01")) int_end(int) int_end(int) <- ymd("2002-06-01") int int <- interval(ymd("2001-01-01"), ymd("2002-01-01")) int_length(int) int <- interval(ymd("2001-01-01"), ymd("2002-01-01")) int_flip(int) int <- interval(ymd("2001-01-01"), ymd("2002-01-01")) int_shift(int, duration(days = 11)) int_shift(int, duration(hours = -1)) int1 <- interval(ymd("2001-01-01"), ymd("2002-01-01")) int2 <- interval(ymd("2001-06-01"), ymd("2002-06-01")) int3 <- interval(ymd("2003-01-01"), ymd("2004-01-01")) int_overlaps(int1, int2) # TRUE int_overlaps(int1, int3) # FALSE int <- interval(ymd("2002-01-01"), ymd("2001-01-01")) int_standardize(int) int1 <- interval(ymd("2001-01-01"), ymd("2002-01-01")) int2 <- interval(ymd("2001-06-01"), ymd("2002-01-01")) int3 <- interval(ymd("2003-01-01"), ymd("2004-01-01")) int_aligns(int1, int2) # TRUE int_aligns(int1, int3) # FALSE dates <- now() + days(1:10) int_diff(dates) } \seealso{ \code{\link{Interval-class}}, \code{\link{as.interval}}, \code{\link{\%within\%}} } lubridate/man/fit_to_timeline.Rd0000644000175100001440000000476112755025555016502 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/update.r \name{fit_to_timeline} \alias{fit_to_timeline} \title{Fit a POSIXlt date-time to the timeline} \usage{ fit_to_timeline(lt, class = "POSIXct", simple = FALSE) } \arguments{ \item{lt}{a POSIXlt date-time object.} \item{class}{a character string that describes what type of object to return, POSIXlt or POSIXct. Defaults to POSIXct. This is an optimization to avoid needless conversions.} \item{simple}{if TRUE, \code{lubridate} makes no attempt to detect meaningless time-dates or to correct time zones. No NAs are produced and the most meaningful valid dates are returned instead. See examples.} } \value{ a POSIXct or POSIXlt object that contains no illusory date-times } \description{ The POSIXlt format allows you to create instants that do not exist in real life due to daylight savings time and other conventions. fit_to_timeline matches POSIXlt date-times to a real times. If an instant does not exist, fit to timeline will replace it with an NA. If an instant does exist, but has been paired with an incorrect timezone/daylight savings time combination, fit_to_timeline returns the instant with the correct combination. } \examples{ \dontrun{ tricky <- structure(list(sec = c(5, 0, 0, -1), min = c(0L, 5L, 5L, 0L), hour = c(2L, 0L, 2L, 2L), mday = c(4L, 4L, 14L, 4L), mon = c(10L, 10L, 2L, 10L), year = c(112L, 112L, 110L, 112L), wday = c(0L, 0L, 0L, 0L), yday = c(308L, 308L, 72L, 308L), isdst = c(1L, 0L, 0L, 1L)), .Names = c("sec", "min", "hour", "mday", "mon", "year", "wday", "yday", "isdst"), class = c("POSIXlt", "POSIXt"), tzone = c("America/Chicago", "CST", "CDT")) tricky ## because clocks "fall back" to 1:00 CST ## CDT, not CST at this instant ##because clocks "spring forward" past this time ## for daylight savings ## has deceptive internal structure fit_to_timeline(tricky) [1] "2012-11-04 02:00:05 CST" "2012-11-04 00:05:00 CDT" [4] NA "2012-11-04 01:59:59 CDT" ## with correct timezone & DST combination ## with correct timezone & DST combination fit_to_timeline(tricky, simple = TRUE) ## Reduce to valid time-dates by extrapolating CDT and CST zones } } lubridate/man/is.difftime.Rd0000644000175100001440000000110012705366146015510 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/difftimes.r \name{is.difftime} \alias{is.difftime} \title{Is x a difftime object?} \usage{ is.difftime(x) } \arguments{ \item{x}{an R object} } \value{ TRUE if x is a difftime object, FALSE otherwise. } \description{ Is x a difftime object? } \examples{ is.difftime(as.Date("2009-08-03")) # FALSE is.difftime(make_difftime(days = 12.4)) # TRUE } \seealso{ \code{\link{is.instant}}, \code{\link{is.timespan}}, \code{\link{is.interval}}, \code{\link{is.period}}. } \keyword{chron} \keyword{logic} lubridate/man/week.Rd0000644000175100001440000000173712705366146014262 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors-week.r \name{week} \alias{isoweek} \alias{week} \alias{week<-} \title{Get/set weeks component of a date-time.} \usage{ week(x) week(x) <- value isoweek(x) } \arguments{ \item{x}{a date-time object. Must be a POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, or fts object.} \item{value}{a numeric object} } \value{ the weeks element of x as an integer number } \description{ \code{week} returns the number of complete seven day periods that have occured between the date and January 1st, plus one.\cr \code{isoweek} returns the week as it would appear in the ISO 8601 system, which uses a reoccuring leap week. } \examples{ x <- ymd("2012-03-26") week(x) week(x) <- 1 week(x) <- 54 week(x) > 3 } \references{ \url{http://en.wikipedia.org/wiki/ISO_week_date} } \seealso{ \code{\link{isoyear}} } \keyword{chron} \keyword{manip} \keyword{utilities} lubridate/man/tz.Rd0000644000175100001440000000457312750350637013763 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors-tz.r \name{tz} \alias{tz} \alias{tz<-} \title{Get/set time zone component of a date-time.} \usage{ tz(x) tz(x) <- value } \arguments{ \item{x}{a date-time object of class a POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, fts or anything else that can be coerced to POSIXlt with as.POSIXlt} \item{value}{timezone value to be assigned to \code{x}'s \code{tzone} attribute} } \value{ the first element of x's tzone attribute vector as a character string. If no tzone attribute exists, tz returns "GMT". } \description{ Time zones are stored as character strings in an attribute of date-time objects. tz returns a date's time zone attribute. When used as a settor, it changes the time zone attribute. R does not come with a predefined list zone names, but relies on the user's OS to interpret time zone names. As a result, some names will be recognized on some computers but not others. Most computers, however, will recognize names in the timezone data base originally compiled by Arthur Olson. These names normally take the form "Country/City." A convenient listing of these timezones can be found at \url{http://en.wikipedia.org/wiki/List_of_tz_database_time_zones}. } \details{ Setting tz does not update a date-time to display the same moment as measured at a different time zone. See \code{\link{with_tz}}. Setting a new time zone creates a new date-time. The numerical value of the hours element stays the same, only the time zone attribute is replaced. This creates a new date-time that occurs an integer value of hours before or after the original date-time. If x is of a class that displays all date-times in the GMT timezone, such as chron, then R will update the number in the hours element to display the new date-time in the GMT timezone. For a description of the time zone attribute, see \code{\link[base]{timezones}} or \code{\link[base]{DateTimeClasses}}. } \examples{ x <- ymd("2012-03-26") tz(x) tz(x) <- "GMT" x \dontrun{ tz(x) <- "America/New_York" x tz(x) <- "America/Chicago" x tz(x) <- "America/Los_Angeles" x tz(x) <- "Pacific/Honolulu" x tz(x) <- "Pacific/Auckland" x tz(x) <- "Europe/London" x tz(x) <- "Europe/Berlin" x } Sys.setenv(TZ = "GMT") now() tz(now()) Sys.unsetenv("TZ") } \keyword{chron} \keyword{manip} \keyword{methods} \keyword{utilities} lubridate/man/date_decimal.Rd0000644000175100001440000000136312750354063015710 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/decimal-dates.r \name{date_decimal} \alias{date_decimal} \title{Converts a decimal to a date.} \usage{ date_decimal(decimal, tz = "UTC") } \arguments{ \item{decimal}{a numeric object} \item{tz}{the time zone required} } \value{ a POSIXct object, whose year corresponds to the integer part of decimal. The months, days, hours, minutes and seconds elements are picked so the date-time will accurately represent the fraction of the year expressed by decimal. } \description{ Converts a decimal to a date. } \examples{ date <- ymd("2009-02-10") decimal <- decimal_date(date) # 2009.11 date_decimal(decimal) # "2009-02-10 UTC" } \keyword{chron} \keyword{manip} \keyword{methods} lubridate/man/period_to_seconds.Rd0000644000175100001440000000145312705366146017024 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/periods.r \name{period_to_seconds} \alias{period_to_seconds} \alias{seconds_to_period} \title{Contrive a period to/from a given number of seconds.} \usage{ period_to_seconds(x) seconds_to_period(x) } \arguments{ \item{x}{A numeric object. The number of seconds to coerce into a period.} } \value{ A number (period) that roughly equates to the period (seconds) given. } \description{ \code{period_to_seconds} approximately converts a period to seconds assuming there are 364.25 days in a calendar year and 365.25/12 days in a month. \cr \code{seconds_to_period} create a period that has the maximum number of non-zero elements (days, hours, minutes, seconds). This computation is exact because it doesn't involve years or months. } lubridate/man/lubridate-package.Rd0000644000175100001440000001563312750350637016671 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/help.r \docType{package} \name{lubridate-package} \alias{lubridate} \alias{lubridate-package} \title{Dates and times made easy with lubridate} \description{ Lubridate provides tools that make it easier to parse and manipulate dates. These tools are grouped below by common purpose. More information about each function can be found in its help documentation. } \details{ Parsing dates Lubridate's parsing functions read strings into R as POSIXct date-time objects. Users should choose the function whose name models the order in which the year ('y'), month ('m') and day ('d') elements appear the string to be parsed: \code{\link{dmy}}, \code{\link{myd}}, \code{\link{ymd}}, \code{\link{ydm}}, \code{\link{dym}}, \code{\link{mdy}}, \code{\link{ymd_hms}}). A very flexible and user friendly parser is provided by \code{\link{parse_date_time}}. Lubridate can also parse partial dates from strings into \code{\link{Period-class}} objects with the functions \code{\link{hm}}, \code{\link{hms}} and \code{\link{ms}}. Lubridate has an inbuilt very fast POSIX parser, ported from the fasttime package by Simon Urbanek. This functionality is as yet optional and could be activated with \code{options(lubridate.fasttime = TRUE)}. Lubridate will automatically detect POSIX strings and use fast parser instead of the default \code{\link{strptime}} utility. Manipulating dates Lubridate distinguishes between moments in time (known as \code{\link{instants}}) and spans of time (known as time spans, see \code{\link{Timespan-class}}). Time spans are further separated into \code{\link{Duration-class}}, \code{\link{Period-class}} and \code{\link{Interval-class}} objects. Instants Instants are specific moments of time. Date, POSIXct, and POSIXlt are the three object classes Base R recognizes as instants. \code{\link{is.Date}} tests whether an object inherits from the Date class. \code{\link{is.POSIXt}} tests whether an object inherits from the POSIXlt or POSIXct classes. \code{\link{is.instant}} tests whether an object inherits from any of the three classes. \code{\link{now}} returns the current system time as a POSIXct object. \code{\link{today}} returns the current system date. For convenience, 1970-01-01 00:00:00 is saved to \code{\link{origin}}. This is the instant from which POSIXct times are calculated. Try unclass(now()) to see the numeric structure that underlies POSIXct objects. Each POSIXct object is saved as the number of seconds it occurred after 1970-01-01 00:00:00. Conceptually, instants are a combination of measurements on different units (i.e, years, months, days, etc.). The individual values for these units can be extracted from an instant and set with the accessor functions \code{\link{second}}, \code{\link{minute}}, \code{\link{hour}}, \code{\link{day}}, \code{\link{yday}}, \code{\link{mday}}, \code{\link{wday}}, \code{\link{week}}, \code{\link{month}}, \code{\link{year}}, \code{\link{tz}}, and \code{\link{dst}}. Note: the accessor functions are named after the singular form of an element. They shouldn't be confused with the period helper functions that have the plural form of the units as a name (e.g, \code{\link{seconds}}). Rounding dates Instants can be rounded to a convenient unit using the functions \code{\link{ceiling_date}}, \code{\link{floor_date}} and \code{\link{round_date}}. Time zones Lubridate provides two helper functions for working with time zones. \code{\link{with_tz}} changes the time zone in which an instant is displayed. The clock time displayed for the instant changes, but the moment of time described remains the same. \code{\link{force_tz}} changes only the time zone element of an instant. The clock time displayed remains the same, but the resulting instant describes a new moment of time. Timespans A timespan is a length of time that may or may not be connected to a particular instant. For example, three months is a timespan. So is an hour and a half. Base R uses difftime class objects to record timespans. However, people are not always consistent in how they expect time to behave. Sometimes the passage of time is a monotone progression of instants that should be as mathematically reliable as the number line. On other occasions time must follow complex conventions and rules so that the clock times we see reflect what we expect to observe in terms of daylight, season, and congruence with the atomic clock. To better navigate the nuances of time, lubridate creates three additional timespan classes, each with its own specific and consistent behavior: \code{\link{Interval-class}}, \code{\link{Period-class}} and \code{\link{Duration-class}}. \code{\link{is.difftime}} tests whether an object inherits from the difftime class. \code{\link{is.timespan}} tests whether an object inherits from any of the four timespan classes. Durations Durations measure the exact amount of time that occurs between two instants. This can create unexpected results in relation to clock times if a leap second, leap year, or change in daylight savings time (DST) occurs in the interval. Functions for working with durations include \code{\link{is.duration}}, \code{\link{as.duration}} and \code{\link{duration}}. \code{\link{dseconds}}, \code{\link{dminutes}}, \code{\link{dhours}}, \code{\link{ddays}}, \code{\link{dweeks}} and \code{\link{dyears}} convenient lengths. Periods Periods measure the change in clock time that occurs between two instants. Periods provide robust predictions of clock time in the presence of leap seconds, leap years, and changes in DST. Functions for working with periods include \code{\link{is.period}}, \code{\link{as.period}} and \code{\link{period}}. \code{\link{seconds}}, \code{\link{minutes}}, \code{\link{hours}}, \code{\link{days}}, \code{\link{weeks}}, \code{\link{months}} and \code{\link{years}} quickly create periods of convenient lengths. Intervals Intervals are timespans that begin at a specific instant and end at a specific instant. Intervals retain complete information about a timespan. They provide the only reliable way to convert between periods and durations. Functions for working with intervals include \code{\link{is.interval}}, \code{\link{as.interval}}, \code{\link{interval}}, \code{\link{int_shift}}, \code{\link{int_flip}}, \code{\link{int_aligns}}, \code{\link{int_overlaps}}, and \code{\link{\%within\%}}. Intervals can also be manipulated with intersect, union, and setdiff(). Miscellaneous \code{\link{decimal_date}} converts an instant to a decimal of its year. \code{\link{leap_year}} tests whether an instant occurs during a leap year. \code{\link{pretty_dates}} provides a method of making pretty breaks for date-times \code{\link{lakers}} is a data set that contains information about the Los Angeles Lakers 2008-2009 basketball season. } \references{ Garrett Grolemund, Hadley Wickham (2011). Dates and Times Made Easy with lubridate. Journal of Statistical Software, 40(3), 1-25. \url{http://www.jstatsoft.org/v40/i03/}. } lubridate/man/Interval-class.Rd0000644000175100001440000000224212750222477016204 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/intervals.r \docType{class} \name{Interval-class} \alias{Interval-class} \title{Interval class} \description{ Interval is an S4 class that extends the \code{\link{Timespan-class}} class. An Interval object records one or more spans of time. Intervals record these timespans as a sequence of seconds that begin at a specified date. Since intervals are anchored to a precise moment of time, they can accurately be converted to \code{\link{Period-class}} or \code{\link{Duration-class}} class objects. This is because we can observe the length in seconds of each period that begins on a specific date. Contrast this to a generalized period, which may not have a consistent length in seconds (e.g. the number of seconds in a year will change if it is a leap year). } \details{ Intervals can be both negative and positive. Negative intervals progress backwards from the start date; positive intervals progress forwards. Interval class objects have two slots: .Data, a numeric object equal to the number of seconds in the interval; and start, a POSIXct object that specifies the time when the interval starts. } lubridate/man/day.Rd0000644000175100001440000000403012755025555014072 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors-day.r \name{day} \alias{day} \alias{day<-} \alias{mday} \alias{mday<-} \alias{qday} \alias{qday<-} \alias{wday} \alias{wday<-} \alias{yday} \alias{yday<-} \title{Get/set days component of a date-time.} \usage{ day(x) mday(x) wday(x, label = FALSE, abbr = TRUE) qday(x) yday(x) day(x) <- value mday(x) <- value qday(x) <- value wday(x) <- value yday(x) <- value } \arguments{ \item{x}{a POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, or fts object.} \item{label}{logical. Only available for wday. TRUE will display the day of the week as an ordered factor of character strings, such as "Sunday." FALSE will display the day of the week as a number.} \item{abbr}{logical. Only available for wday. FALSE will display the day of the week as an ordered factor of character strings, such as "Sunday." TRUE will display an abbreviated version of the label, such as "Sun". abbr is disregarded if label = FALSE.} \item{value}{a numeric object} } \value{ wday returns the day of the week as a decimal number (01-07, Sunday is 1) or an ordered factor (Sunday is first). } \description{ Get/set days component of a date-time. } \details{ \code{day} and \code{day<-} are aliases for \code{mday} and \code{mday<-} respectively. } \examples{ x <- as.Date("2009-09-02") wday(x) #4 wday(ymd(080101)) wday(ymd(080101), label = TRUE, abbr = FALSE) # Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday wday(ymd(080101), label = TRUE, abbr = TRUE) # Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday wday(ymd(080101) + days(-2:4), label = TRUE, abbr = TRUE) # Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday x <- as.Date("2009-09-02") yday(x) #245 mday(x) #2 yday(x) <- 1 #"2009-01-01" yday(x) <- 366 #"2010-01-01" mday(x) > 3 } \seealso{ \code{\link{yday}}, \code{\link{mday}} } \keyword{chron} \keyword{manip} \keyword{methods} \keyword{utilities} lubridate/man/month.Rd0000644000175100001440000000232012755025555014442 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors-month.r \name{month} \alias{month} \alias{month<-} \title{Get/set months component of a date-time.} \usage{ month(x, label = FALSE, abbr = TRUE) month(x) <- value } \arguments{ \item{x}{a date-time object} \item{label}{logical. TRUE will display the month as a character string such as "January." FALSE will display the month as a number.} \item{abbr}{logical. FALSE will display the month as a character string label, such as "January". TRUE will display an abbreviated version of the label, such as "Jan". abbr is disregarded if label = FALSE.} \item{value}{a numeric object} } \value{ the months element of x as a number (1-12) or character string. 1 = January. } \description{ Date-time must be a POSIXct, POSIXlt, Date, Period, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. } \examples{ x <- ymd("2012-03-26") month(x) month(x) <- 1 month(x) <- 13 month(x) > 3 month(ymd(080101)) month(ymd(080101), label = TRUE) month(ymd(080101), label = TRUE, abbr = FALSE) month(ymd(080101) + months(0:11), label = TRUE) } \keyword{chron} \keyword{manip} \keyword{methods} \keyword{utilities} lubridate/man/reclass_timespan.Rd0000644000175100001440000000100412705366146016646 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.r \name{reclass_timespan} \alias{reclass_timespan} \alias{reclass_timespan,ANY,Duration-method} \alias{reclass_timespan,ANY,Interval-method} \alias{reclass_timespan,ANY,Period-method} \alias{reclass_timespan,ANY,difftime-method} \title{Convenience method to reclass timespans post-modification.} \usage{ reclass_timespan(new, orig) } \description{ Convenience method to reclass timespans post-modification. } \keyword{internal} lubridate/man/is.instant.Rd0000644000175100001440000000130212750350637015403 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/instants.r \name{is.instant} \alias{instant} \alias{instants} \alias{is.instant} \alias{is.timepoint} \title{Is x a date-time object?} \usage{ is.instant(x) is.timepoint(x) } \arguments{ \item{x}{an R object} } \value{ TRUE if x is a POSIXct, POSIXlt, or Date object, FALSE otherwise. } \description{ An instant is a specific moment in time. Most common date-time objects (e.g, POSIXct, POSIXlt, and Date objects) are instants. } \examples{ is.instant(as.Date("2009-08-03")) # TRUE is.timepoint(5) # FALSE } \seealso{ \code{\link{is.timespan}}, \code{\link{is.POSIXt}}, \code{\link{is.Date}} } \keyword{chron} \keyword{logic} lubridate/man/now.Rd0000644000175100001440000000133312705366146014122 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/instants.r \name{now} \alias{now} \title{The current time} \usage{ now(tzone = "") } \arguments{ \item{tzone}{a character vector specifying which time zone you would like the current time in. tzone defaults to your computer's system timezone. You can retrieve the current time in the Universal Coordinated Time (UTC) with now("UTC").} } \value{ the current date and time as a POSIXct object } \description{ The current time } \examples{ now() now("GMT") now("") now() == now() # would be true if computer processed both at the same instant now() < now() # TRUE now() > now() # FALSE } \seealso{ \code{\link{here}} } \keyword{chron} \keyword{utilities} lubridate/man/am.Rd0000644000175100001440000000064312750350637013715 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/am-pm.r \name{am} \alias{am} \alias{pm} \title{Does date time occur in the am or pm?} \usage{ am(x) pm(x) } \arguments{ \item{x}{a date-time object} } \value{ TRUE or FALSE depending on whether x occurs in the am or pm } \description{ Does date time occur in the am or pm? } \examples{ x <- ymd("2012-03-26") am(x) pm(x) } \keyword{chron} lubridate/man/hour.Rd0000644000175100001440000000127612750350637014300 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors-hour.r \name{hour} \alias{hour} \alias{hour<-} \title{Get/set hours component of a date-time.} \usage{ hour(x) hour(x) <- value } \arguments{ \item{x}{a date-time object} \item{value}{numeric value to be assigned to \code{hour} component} } \value{ the hours element of x as a decimal number } \description{ Date-time must be a POSIXct, POSIXlt, Date, Period, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. } \examples{ x <- ymd("2012-03-26") hour(x) hour(x) <- 1 hour(x) <- 25 hour(x) > 2 } \keyword{chron} \keyword{manip} \keyword{methods} \keyword{utilities} lubridate/man/as.interval.Rd0000644000175100001440000000363512755025555015555 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.r \name{as.interval} \alias{as.interval} \alias{as.interval,Duration-method} \alias{as.interval,Interval-method} \alias{as.interval,POSIXt-method} \alias{as.interval,Period-method} \alias{as.interval,difftime-method} \alias{as.interval,logical-method} \alias{as.interval,numeric-method} \title{Change an object to an \code{interval}.} \usage{ as.interval(x, start, ...) } \arguments{ \item{x}{a duration, difftime, period, or numeric object that describes the length of the interval} \item{start}{a POSIXt or Date object that describes when the interval begins} \item{...}{additional arguments to pass to as.interval} } \value{ an interval object } \description{ as.interval changes difftime, Duration, Period and numeric class objects to intervals that begin at the specified date-time. Numeric objects are first coerced to timespans equal to the numeric value in seconds. } \details{ as.interval can be used to create accurate transformations between Period objects, which measure time spans in variable length units, and Duration objects, which measure timespans as an exact number of seconds. A start date- time must be supplied to make the conversion. Lubridate uses this start date to look up how many seconds each variable length unit (e.g. month, year) lasted for during the time span described. See \code{\link{as.duration}}, \code{\link{as.period}}. } \examples{ diff <- make_difftime(days = 31) #difftime as.interval(diff, ymd("2009-01-01")) as.interval(diff, ymd("2009-02-01")) dur <- duration(days = 31) #duration as.interval(dur, ymd("2009-01-01")) as.interval(dur, ymd("2009-02-01")) per <- period(months = 1) #period as.interval(per, ymd("2009-01-01")) as.interval(per, ymd("2009-02-01")) as.interval(3600, ymd("2009-01-01")) #numeric } \seealso{ \code{\link{interval}} } \keyword{chron} \keyword{classes} \keyword{manip} \keyword{methods} lubridate/man/today.Rd0000644000175100001440000000111312705366146014433 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/instants.r \name{today} \alias{today} \title{The current date} \usage{ today(tzone = "") } \arguments{ \item{tzone}{a character vector specifying which time zone you would like to find the current date of. tzone defaults to the system time zone set on your computer.} } \value{ the current date as a Date object } \description{ The current date } \examples{ today() today("GMT") today() == today("GMT") # not always true today() < as.Date("2999-01-01") # TRUE (so far) } \keyword{chron} \keyword{utilities} lubridate/man/is.Date.Rd0000644000175100001440000000077612705366146014620 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/Dates.r \name{is.Date} \alias{is.Date} \title{Is x a Date object?} \usage{ is.Date(x) } \arguments{ \item{x}{an R object} } \value{ TRUE if x is a Date object, FALSE otherwise. } \description{ Is x a Date object? } \examples{ is.Date(as.Date("2009-08-03")) # TRUE is.Date(difftime(now() + 5, now())) # FALSE } \seealso{ \code{\link{is.instant}}, \code{\link{is.timespan}}, \code{\link{is.POSIXt}} } \keyword{chron} \keyword{logic} lubridate/man/leap_year.Rd0000644000175100001440000000126312705366146015262 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/leap-years.r \name{leap_year} \alias{leap_year} \title{Is a year a leap year?} \usage{ leap_year(date) } \arguments{ \item{date}{a date-time object or a year} } \value{ TRUE if x is a leap year, FALSE otherwise } \description{ If x is a recognized date-time object, leap_year will return whether x occurs during a leap year. If x is a number, leap_year returns whether it would be a leap year under the Gregorian calendar. } \examples{ x <- as.Date("2009-08-02") leap_year(x) # FALSE leap_year(2009) # FALSE leap_year(2008) # TRUE leap_year(1900) # FALSE leap_year(2000) # TRUE } \keyword{chron} \keyword{logic} lubridate/man/force_tz.Rd0000644000175100001440000000237112755025555015136 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/time-zones.r \name{force_tz} \alias{force_tz} \title{Replace time zone to create new date-time} \usage{ force_tz(time, tzone = "") } \arguments{ \item{time}{a POSIXct, POSIXlt, Date, chron date-time object, or a data.frame object. When a data.frame all POSIXt elements of a data.frame are processed with \code{force_tz} and new data.frame is returned.} \item{tzone}{a character string containing the time zone to convert to. R must recognize the name contained in the string as a time zone on your system.} } \value{ a POSIXct object in the updated time zone } \description{ force_tz returns a the date-time that has the same clock time as x in the new time zone. Although the new date-time has the same clock time (e.g. the same values in the year, month, days, etc. elements) it is a different moment of time than the input date-time. force_tz defaults to the Universal Coordinated time zone (UTC) when an unrecognized time zone is inputted. See \code{\link{Sys.timezone}} for more information on how R recognizes time zones. } \examples{ x <- as.POSIXct("2009-08-07 00:00:01", tz = "America/New_York") force_tz(x, "GMT") } \seealso{ \code{\link{with_tz}} } \keyword{chron} \keyword{manip} lubridate/man/rollback.Rd0000644000175100001440000000224712755025555015116 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ops-%m+%.r \name{rollback} \alias{rollback} \title{Roll back date to last day of previous month} \usage{ rollback(dates, roll_to_first = FALSE, preserve_hms = TRUE) } \arguments{ \item{dates}{A POSIXct, POSIXlt or Date class object.} \item{roll_to_first}{Rollback to the first day of the month instead of the last day of the previous month} \item{preserve_hms}{Retains the same hour, minute, and second information? If FALSE, the new date will be at 00:00:00.} } \value{ A date-time object of class POSIXlt, POSIXct or Date, whose day has been adjusted to the last day of the previous month, or to the first day of the month. } \description{ rollback changes a date to the last day of the previous month or to the first day of the month. Optionally, the new date can retain the same hour, minute, and second information. } \examples{ date <- ymd("2010-03-03") rollback(date) dates <- date + months(0:2) rollback(dates) date <- ymd_hms("2010-03-03 12:44:22") rollback(date) rollback(date, roll_to_first = TRUE) rollback(date, preserve_hms = FALSE) rollback(date, roll_to_first = TRUE, preserve_hms = FALSE) } lubridate/man/with_tz.Rd0000644000175100001440000000221412755025555015007 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/time-zones.r \name{with_tz} \alias{with_tz} \title{Get date-time in a different time zone} \usage{ with_tz(time, tzone = "") } \arguments{ \item{time}{a POSIXct, POSIXlt, Date, chron date-time object or a data.frame object. When a data.frame all POSIXt elements of a data.frame are processed with \code{with_tz} and new data.frame is returned.} \item{tzone}{a character string containing the time zone to convert to. R must recognize the name contained in the string as a time zone on your system.} } \value{ a POSIXct object in the updated time zone } \description{ with_tz returns a date-time as it would appear in a different time zone. The actual moment of time measured does not change, just the time zone it is measured in. with_tz defaults to the Universal Coordinated time zone (UTC) when an unrecognized time zone is inputted. See \code{\link{Sys.timezone}} for more information on how R recognizes time zones. } \examples{ x <- as.POSIXct("2009-08-07 00:00:01", tz = "America/New_York") with_tz(x, "GMT") } \seealso{ \code{\link{force_tz}} } \keyword{chron} \keyword{manip} lubridate/man/Period-class.Rd0000644000175100001440000000542012757713372015651 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/periods.r \docType{class} \name{Period-class} \alias{Period-class} \title{Period class} \description{ Period is an S4 class that extends the \code{\link{Timespan-class}} class. Periods track the change in the "clock time" between two date-times. They are measured in common time related units: years, months, days, hours, minutes, and seconds. Each unit except for seconds must be expressed in integer values. } \details{ The exact length of a period is not defined until the period is placed at a specific moment of time. This is because the precise length of one year, month, day, etc. can change depending on when it occurs due to daylight savings, leap years, and other conventions. A period can be associated with a specific moment in time by coercing it to an \code{\link{Interval-class}} object with \code{\link{as.interval}} or by adding it to a date-time with "+". Periods provide a method for measuring generalized timespans when we wish to model clock times. Periods will attain intuitive results at this task even when leap years, leap seconds, gregorian days, daylight savings changes, and other events happen during the period. See \code{\link{Duration-class}} for an alternative way to measure timespans that allows precise comparisons between timespans. The logic that guides arithmetic with periods can be unintuitive. Starting with version 1.3.0, lubridate enforces the reversible property of arithmetic (e.g. a date + period - period = date) by returning an NA if you create an implausible date by adding periods with months or years units to a date. For example, adding one month to January 31st, 2013 results in February 31st, 2013, which is not a real date. lubridate users have argued in the past that February 31st, 2013 should be rolled over to March 3rd, 2013 or rolled back to February 28, 2013. However, each of these corrections would destroy the reversibility of addition (Mar 3 - one month == Feb 3 != Jan 31, Feb 28 - one month == Jan 28 != Jan 31). If you would like to add and subtract months in a way that rolls the results back to the last day of a month (when appropriate) use the special operators, \code{\link{\%m+\%}}, \code{\link{\%m-\%}} or a bit more flexible \code{\link{add_with_rollback}}. Period class objects have six slots. 1) .Data, a numeric object. The apparent amount of seconds to add to the period. 2) minute, a numeric object. The apparent amount of minutes to add to the period. 3) hour, a numeric object. The apparent amount of hours to add to the period.4) day, a numeric object. The apparent amount of days to add to the period.5) month, a numeric object. The apparent amount of months to add to the period. 6) year, a numeric object. The apparent amount of years to add to the period. } lubridate/man/duration.Rd0000644000175100001440000000553212757712257015156 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/durations.r \name{duration} \alias{duration} \alias{is.duration} \title{Create a duration object.} \usage{ duration(num = NULL, units = "seconds", ...) is.duration(x) } \arguments{ \item{num}{the number of time units to include in the duration. From v1.6.0 \code{num} can also be a character vector that specifies durations in a convenient shorthand format. All unambiguous name units and abbreviations are supported. See examples.} \item{units}{a character string that specifies the type of units that num refers to. When \code{num} is character, this argument is ignored.} \item{...}{a list of time units to be included in the duration and their amounts. Seconds, minutes, hours, days, and weeks are supported.} \item{x}{an R object} } \value{ a duration object } \description{ \code{duration} creates a duration object with the specified values. Entries for different units are cumulative. durations display as the number of seconds in a time span. When this number is large, durations also display an estimate in larger units,; however, the underlying object is always recorded as a fixed number of seconds. For display and creation purposes, units are converted to seconds using their most common lengths in seconds. Minutes = 60 seconds, hours = 3600 seconds, days = 86400 seconds, weeks = 604800. Units larger than weeks are not used due to their variability. } \details{ Durations record the exact number of seconds in a time span. They measure the exact passage of time but do not always align with measurements made in larger units of time such as hours, months and years. This is because the length of larger time units can be affected by conventions such as leap years and Daylight Savings Time. Base R provides a second class for measuring durations, the difftime class. Duration objects can be easily created with the helper functions \code{\link{dweeks}}, \code{\link{ddays}}, \code{\link{dminutes}}, \code{\link{dseconds}}. These objects can be added to and subtracted to date- times to create a user interface similar to object oriented programming. } \examples{ duration(day = -1) # -86400s (~-1 days) duration(90, "seconds") duration(1.5, "minutes") duration(-1, "days") # -86400s (~-1 days) duration(second = 90) duration(minute = 1.5) duration(mins = 1.5) duration(second = 3, minute = 1.5, hour = 2, day = 6, week = 1) duration(hour = 1, minute = -60) duration("2M 1sec") duration("2hours 2minutes 1second") duration("2d 2H 2M 2S") duration("2days 2hours 2mins 2secs") # Missing numerals default to 1. Repeated units are added up. duration("day day") # Comparison with characters is supported from v1.6.0. duration("day 2 sec") > "day 1sec" is.duration(as.Date("2009-08-03")) # FALSE is.duration(duration(days = 12.4)) # TRUE } \seealso{ \code{\link{as.duration}} } \keyword{chron} \keyword{classes} lubridate/man/as_date.Rd0000644000175100001440000000374412755025555014730 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.r \docType{methods} \name{as_date} \alias{as_date} \alias{as_date,POSIXt-method} \alias{as_date,numeric-method} \alias{as_datetime} \alias{as_datetime,ANY-method} \alias{as_datetime,POSIXt-method} \alias{as_datetime,numeric-method} \title{Convert an object to a date or date-time} \usage{ as_date(x, ...) as_datetime(x, ...) \S4method{as_date}{POSIXt}(x, tz = NULL) \S4method{as_date}{numeric}(x, origin = lubridate::origin) \S4method{as_datetime}{POSIXt}(x, tz = "UTC") \S4method{as_datetime}{numeric}(x, origin = lubridate::origin, tz = "UTC") \S4method{as_datetime}{ANY}(x, tz = "UTC") } \arguments{ \item{x}{a vector of \code{\link{POSIXt}}, numeric or character objects} \item{...}{further arguments to be passed to specific methods (see above).} \item{tz}{a time zone name (default: time zone of the POSIXt object \code{x}). See \code{\link{OlsonNames}}.} \item{origin}{a Date object, or something which can be coerced by \code{as.Date(origin, ...)} to such an object (default: the Unix epoch of "1970-01-01"). Note that in this instance, \code{x} is assumed to reflect the number of days since \code{origin} at \code{"UTC"}.} } \value{ a vector of \code{\link{Date}} objects corresponding to \code{x}. } \description{ Convert an object to a date or date-time } \section{Compare to base R}{ These are drop in replacements for \code{as.Date} and \code{as.POSIXct}, with a few tweaks to make them work more intuitively. \itemize{ \item \code{as_date} ignores the timezone attribute, resulting in a more intuitive conversion (see examples) \item Both functions provide a default origin argument for numeric vectors. \item \code{as_datetime} defaults to using UTC. } } \examples{ dt_utc <- ymd_hms("2010-08-03 00:50:50") dt_europe <- ymd_hms("2010-08-03 00:50:50", tz="Europe/London") c(as_date(dt_utc), as.Date(dt_utc)) c(as_date(dt_europe), as.Date(dt_europe)) ## need not suply origin as_date(10) } lubridate/man/mplus.Rd0000644000175100001440000000605012755025555014461 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ops-%m+%.r \name{\%m+\%} \alias{\%m+\%} \alias{\%m+\%,ANY,ANY-method} \alias{\%m+\%,ANY,Duration-method} \alias{\%m+\%,ANY,Interval-method} \alias{\%m+\%,ANY,Period-method} \alias{\%m+\%,Duration,ANY-method} \alias{\%m+\%,Interval,ANY-method} \alias{\%m+\%,Period,ANY-method} \alias{\%m-\%} \alias{\%m-\%,ANY,ANY-method} \alias{\%m-\%,ANY,Duration-method} \alias{\%m-\%,ANY,Interval-method} \alias{\%m-\%,ANY,Period-method} \alias{\%m-\%,Duration,ANY-method} \alias{\%m-\%,Interval,ANY-method} \alias{\%m-\%,Period,ANY-method} \alias{add_with_rollback} \alias{m+} \alias{m-} \title{Add and subtract months to a date without exceeding the last day of the new month} \usage{ e1 \%m+\% e2 add_with_rollback(e1, e2, roll_to_first = FALSE, preserve_hms = TRUE) } \arguments{ \item{e1}{A period or a date-time object of class \code{\link{POSIXlt}}, \code{\link{POSIXct}} or \code{\link{Date}}.} \item{e2}{A period or a date-time object of class \code{\link{POSIXlt}}, \code{\link{POSIXct}} or \code{\link{Date}}. Note that one of e1 and e2 must be a period and the other a date-time object.} \item{roll_to_first}{rollback to the first day of the month instead of the last day of the previous month (passed to \code{\link{rollback}})} \item{preserve_hms}{retains the same hour, minute, and second information? If FALSE, the new date will be at 00:00:00 (passed to \code{\link{rollback}})} } \value{ A date-time object of class POSIXlt, POSIXct or Date } \description{ Adding months frustrates basic arithmetic because consecutive months have different lengths. With other elements, it is helpful for arithmetic to perform automatic roll over. For example, 12:00:00 + 61 seconds becomes 12:01:01. However, people often prefer that this behavior NOT occur with months. For example, we sometimes want January 31 + 1 month = February 28 and not March 3. \%m+\% performs this type of arithmetic. Date \%m+\% months(n) always returns a date in the nth month after Date. If the new date would usually spill over into the n + 1th month, \%m+\% will return the last day of the nth month (\code{\link{rollback}}. Date \%m-\% months(n) always returns a date in the nth month before Date. \code{add_with_rollback} provides additional functionality to \%m+\% and \%m-\%. It allows rollback to first day of the month instead of the last day of the previous month and controls whether HMS component of the end date is preserved or not. } \details{ \%m+\% and \%m-\% handle periods with components less than a month by first adding/substracting months and then performing usual arithmetics with smaller units. \%m+\% and \%m-\% should be used with caution as they are not one-to-one operations and results for either will be sensitive to the order of operations. } \examples{ jan <- ymd_hms("2010-01-31 03:04:05") jan + months(1:3) # Feb 31 and April 31 returned as NA # NA "2010-03-31 03:04:05 UTC" NA jan \%m+\% months(1:3) # No rollover leap <- ymd("2012-02-29") "2012-02-29 UTC" leap \%m+\% years(1) leap \%m+\% years(-1) leap \%m-\% years(1) } lubridate/man/date.Rd0000644000175100001440000000163712705366146014243 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors-date.R \name{date} \alias{date} \alias{date<-} \title{Get/set Date component of a date-time.} \usage{ date(x) date(x) <- value } \arguments{ \item{x}{a date-time object} \item{value}{an object for which the \code{date()} function is defined} } \value{ the date of x as a Date } \description{ Date-time must be a POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. } \details{ \code{date} does not yet support years before 0 C.E. Also \code{date} is not defined for Period objects. } \examples{ x <- as.POSIXct("2012-03-26 23:12:13", tz = "Etc/GMT+8") date(x) as.Date(x) # by default as.Date assumes you want to know the date in UTC as.Date(x, tz = "Etc/GMT+8") date(x) <- as.Date("2000-01-02") x } \keyword{chron} \keyword{manip} \keyword{methods} \keyword{utilities} lubridate/man/minute.Rd0000644000175100001440000000127612750350637014624 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/accessors-minute.r \name{minute} \alias{minute} \alias{minute<-} \title{Get/set minutes component of a date-time.} \usage{ minute(x) minute(x) <- value } \arguments{ \item{x}{a date-time object} \item{value}{numeric value to be assigned} } \value{ the minutes element of x as a decimal number } \description{ Date-time must be a POSIXct, POSIXlt, Date, Period, chron, yearmon, yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. } \examples{ x <- ymd("2012-03-26") minute(x) minute(x) <- 1 minute(x) <- 61 minute(x) > 2 } \keyword{chron} \keyword{manip} \keyword{methods} \keyword{utilities} lubridate/man/as.duration.Rd0000644000175100001440000000343712757713373015562 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.r \name{as.duration} \alias{as.duration} \alias{as.duration,Duration-method} \alias{as.duration,Interval-method} \alias{as.duration,Period-method} \alias{as.duration,character-method} \alias{as.duration,difftime-method} \alias{as.duration,logical-method} \alias{as.duration,numeric-method} \title{Change an object to a duration.} \usage{ as.duration(x, ...) } \arguments{ \item{x}{Object to be coerced to a duration} \item{...}{Parameters passed to other methods. Currently unused.} } \value{ A duration object } \description{ as.duration changes Interval, Period and numeric class objects to Duration objects. Numeric objects are changed to Duration objects with the seconds unit equal to the numeric value. } \details{ Durations are exact time measurements, whereas periods are relative time measurements. See \code{\link{Period-class}}. The length of a period depends on when it occurs. Hence, a one to one mapping does not exist between durations and periods. When used with a period object, as.duration provides an inexact estimate of the length of the period; each time unit is assigned its most common number of seconds. A period of one month is converted to 2628000 seconds (approximately 30.42 days). This ensures that 12 months will sum to 365 days, or one normal year. For an exact transformation, first transform the period to an interval with \code{\link{as.interval}}. } \examples{ span <- interval(ymd("2009-01-01"), ymd("2009-08-01")) #interval as.duration(span) as.duration(10) # numeric dur <- duration(hours = 10, minutes = 6) as.numeric(dur, "hours") as.numeric(dur, "minutes") } \seealso{ \code{\link{Duration-class}}, \code{\link{duration}} } \keyword{chron} \keyword{classes} \keyword{manip} \keyword{methods} lubridate/man/parse_date_time.Rd0000644000175100001440000002662112755304041016442 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse.r \name{parse_date_time} \alias{fast_strptime} \alias{parse_date_time} \alias{parse_date_time2} \title{Parse character and numeric date-time vectors with user friendly order formats.} \usage{ parse_date_time(x, orders, tz = "UTC", truncated = 0, quiet = FALSE, locale = Sys.getlocale("LC_TIME"), select_formats = .select_formats, exact = FALSE) parse_date_time2(x, orders, tz = "UTC", exact = FALSE, lt = FALSE) fast_strptime(x, format, tz = "UTC", lt = TRUE) } \arguments{ \item{x}{a character or numeric vector of dates} \item{orders}{a character vector of date-time formats. Each order string is series of formatting characters as listed \code{\link[base]{strptime}} but might not include the "\%" prefix, for example "ymd" will match all the possible dates in year, month, day order. Formatting orders might include arbitrary separators. These are discarded. See details for implemented formats.} \item{tz}{a character string that specifies the time zone with which to parse the dates} \item{truncated}{integer, number of formats that can be missing. The most common type of irregularity in date-time data is the truncation due to rounding or unavailability of the time stamp. If \code{truncated} parameter is non-zero \code{parse_date_time} also checks for truncated formats. For example, if the format order is "ymdHMS" and \code{truncated = 3}, \code{parse_date_time} will correctly parse incomplete dates like \code{2012-06-01 12:23}, \code{2012-06-01 12} and \code{2012-06-01}. \bold{NOTE:} \code{ymd} family of functions are based on \code{strptime} which currently fails to parse \code{\%y-\%m} formats.} \item{quiet}{logical. When TRUE progress messages are not printed, and "no formats found" error is surpresed and the function simply returns a vector of NAs. This mirrors the behavior of base R functions \code{strptime} and \code{as.POSIXct}. Default is FALSE.} \item{locale}{locale to be used, see \link{locales}. On linux systems you can use \code{system("locale -a")} to list all the installed locales.} \item{select_formats}{A function to select actual formats for parsing from a set of formats which matched a training subset of \code{x}. it receives a named integer vector and returns a character vector of selected formats. Names of the input vector are formats (not orders) that matched the training set. Numeric values are the number of dates (in the training set) that matched the corresponding format. You should use this argument if the default selection method fails to select the formats in the right order. By default the formats with most formating tockens (\%) are selected and \%Y counts as 2.5 tockens (so that it has a priority over \%y\%m). Se examples.} \item{exact}{logical. If \code{TRUE}, \code{orders} parameter is interpreted as an exact \code{strptime} format and no trainign or guessing are performed.} \item{lt}{logical. If TRUE returned object is of class POSIXlt, and POSIXct otherwise. For compatibility with base `strptime` function default is TRUE for `fast_strptime` and FALSE for `parse_date_time2`.} \item{format}{a character string of formats. It should include all the separators and each format must be prefixed with %, just as in the format argument of \code{strptime}.} } \value{ a vector of POSIXct date-time objects } \description{ \code{parse_date_time} parses an input vector into POSIXct date-time object. It differs from \code{\link[base]{strptime}} in two respects. First, it allows specification of the order in which the formats occur without the need to include separators and "\%" prefix. Such a formating argument is refered to as "order". Second, it allows the user to specify several format-orders to handle heterogeneous date-time character representations. \cr \code{parse_date_time2} is a fast C parser of numeric orders. \cr \code{fast_strptime} is a fast C parser of numeric formats only that accepts explicit format arguments, just as \code{\link[base]{strptime}}. } \details{ When several format-orders are specified \code{parse_date_time} sorts the supplied format-orders based on a training set and then applies them recursively on the input vector. \code{parse_date_time}, and all derived functions, such as \code{ymd_hms}, \code{ymd} etc, will drop into \code{fast_strptime} instead of \code{strptime} whenever the guessed from the input data formats are all numeric. The list below contains formats recognized by lubridate. For numeric formats leading 0s are optional. As compared to base \code{strptime}, some of the formats are new or have been extended for efficiency reasons. These formats are marked with "*". Fast parsers, \code{parse_date_time2} and \code{fast_strptime}, accept only formats marked with "!". \describe{ \item{\code{a}}{Abbreviated weekday name in the current locale. (Also matches full name)} \item{\code{A}}{Full weekday name in the current locale. (Also matches abbreviated name). You need not specify \code{a} and \code{A} formats explicitly. Wday is automatically handled if \code{preproc_wday = TRUE}} \item{\code{b}!}{Abbreviated month name in the current locale (also matches full name). C parser understands English months only.} \item{\code{B}!}{Same as b.} \item{\code{d}!}{Day of the month as decimal number (01--31 or 0--31)} \item{\code{H}!}{Hours as decimal number (00--24 or 0--24).} \item{\code{I}!}{Hours as decimal number (01--12 or 1--12).} \item{\code{j}}{Day of year as decimal number (001--366 or 1--366).} \item{\code{q}!*}{Quarter (1-4). The quarter month is added to parsed month if \code{m} format is present.} \item{\code{m}!*}{Month as decimal number (01--12 or 1--12). For \code{parse_date_time}. As lubridate extension, also matches abbreviated and full months names as \code{b} and \code{B} formats. C parser understands only English month names.} \item{\code{M}!}{Minute as decimal number (00--59 or 0--59).} \item{\code{p}!}{AM/PM indicator in the locale. Normally used in conjunction with \code{I} and \bold{not} with \code{H}. But lubridate C parser accepts H format as long as hour is not greater than 12. C parser understands only English locale AM/PM indicator.} \item{\code{S}!}{Second as decimal number (00--61 or 0--61), allowing for up to two leap-seconds (but POSIX-compliant implementations will ignore leap seconds).} \item{\code{OS}}{Fractional second.} \item{\code{U}}{Week of the year as decimal number (00--53 or 0-53) using Sunday as the first day 1 of the week (and typically with the first Sunday of the year as day 1 of week 1). The US convention.} \item{\code{w}}{Weekday as decimal number (0--6, Sunday is 0).} \item{\code{W}}{Week of the year as decimal number (00--53 or 0-53) using Monday as the first day of week (and typically with the first Monday of the year as day 1 of week 1). The UK convention.} \item{\code{y}!*}{Year without century (00--99 or 0--99). In \code{parse_date_time} also matches year with century (Y format).} \item{\code{Y}!}{Year with century.} \item{\code{z}!*}{ISO8601 signed offset in hours and minutes from UTC. For example \code{-0800}, \code{-08:00} or \code{-08}, all represent 8 hours behind UTC. This format also matches the Z (Zulu) UTC indicator. Because strptime doesn't fully support ISO8601 this format is implemented as an union of 4 orders: Ou (Z), Oz (-0800), OO (-08:00) and Oo (-08). You can use these four orders as any other but it is rarely necessary. \code{parse_date_time2} and \code{fast_strptime} support all of the timezone formats.} \item{\code{Om}!*}{Matches numeric month and English alphabetic months (Both, long and abbreviated forms).} \item{\code{Op}!*}{Matches AM/PM English indicator.} \item{\code{r}*}{Matches \code{Ip} and \code{H} orders.} \item{\code{R}*}{Matches \code{HM} and\code{IMp} orders.} \item{\code{T}*}{Matches \code{IMSp}, \code{HMS}, and \code{HMOS} orders.} } } \note{ \code{parse_date_time} (and the derivatives \code{ymb}, \code{ymd_hms} etc) rely on a sparse guesser that takes at most 501 elements from the supplied character vector in order to identify appropriate formats from the supplied orders. If you get the error \code{All formats failed to parse} and you are confident that your vector contains valid dates, you should either set \code{exact} argument to TRUE or use functions that don't perform format guessing (\code{fast_strptime}, \code{parse_date_time2} or \code{strptime} ). For performance reasons, when timezone is not UTC, \code{parse_date_time2} and \code{fast_strptime} perform no validity checks for daylight savings time. Thus, if your input string contains an invalid date time which falls into DST gap and \code{lt=TRUE} you will get an \code{POSIXlt} object with a non-existen time. If \code{lt=FALSE} your time instant will be adjusted to a valid time by adding an hour. See examples. If you want to get NA for invalid date-times use \code{\link{fit_to_timeline}} explicitely. } \examples{ ## ** orders are much easier to write ** x <- c("09-01-01", "09-01-02", "09-01-03") parse_date_time(x, "ymd") parse_date_time(x, "y m d") parse_date_time(x, "\%y\%m\%d") # "2009-01-01 UTC" "2009-01-02 UTC" "2009-01-03 UTC" ## ** heterogenuous date-times ** x <- c("09-01-01", "090102", "09-01 03", "09-01-03 12:02") parse_date_time(x, c("ymd", "ymd HM")) ## ** different ymd orders ** x <- c("2009-01-01", "02022010", "02-02-2010") parse_date_time(x, c("dmY", "ymd")) ## "2009-01-01 UTC" "2010-02-02 UTC" "2010-02-02 UTC" ## ** truncated time-dates ** x <- c("2011-12-31 12:59:59", "2010-01-01 12:11", "2010-01-01 12", "2010-01-01") parse_date_time(x, "Ymd HMS", truncated = 3) ## ** specifying exact formats and avoiding training and guessing ** parse_date_time(x, c("\%m-\%d-\%y", "\%m\%d\%y", "\%m-\%d-\%y \%H:\%M"), exact = TRUE) parse_date_time(c('12/17/1996 04:00:00','4/18/1950 0130'), c('\%m/\%d/\%Y \%I:\%M:\%S','\%m/\%d/\%Y \%H\%M'), exact = TRUE) ## ** quarters and partial dates ** parse_date_time(c("2016.2", "2016-04"), orders = "Yq") parse_date_time(c("2016", "2016-04"), orders = c("Y", "Ym")) ## ** fast parsing ** \dontrun{ options(digits.secs = 3) ## random times between 1400 and 3000 tt <- as.character(.POSIXct(runif(1000, -17987443200, 32503680000))) tt <- rep.int(tt, 1000) system.time(out <- as.POSIXct(tt, tz = "UTC")) system.time(out1 <- ymd_hms(tt)) # constant overhead on long vectors system.time(out2 <- parse_date_time2(tt, "YmdHMOS")) system.time(out3 <- fast_strptime(tt, "\%Y-\%m-\%d \%H:\%M:\%OS")) all.equal(out, out1) all.equal(out, out2) all.equal(out, out3) } ## ** how to use `select_formats` argument ** ## By default \%Y has precedence: parse_date_time(c("27-09-13", "27-09-2013"), "dmy") ## to give priority to \%y format, define your own select_format function: my_select <- function(trained){ n_fmts <- nchar(gsub("[^\%]", "", names(trained))) + grepl("\%y", names(trained))*1.5 names(trained[ which.max(n_fmts) ]) } parse_date_time(c("27-09-13", "27-09-2013"), "dmy", select_formats = my_select) ## ** invalid times with "fast" parcing ** parse_date_time("2010-03-14 02:05:06", "YmdHMS", tz = "America/New_York") parse_date_time2("2010-03-14 02:05:06", "YmdHMS", tz = "America/New_York") parse_date_time2("2010-03-14 02:05:06", "YmdHMS", tz = "America/New_York", lt = TRUE) } \seealso{ \code{strptime}, \code{\link{ymd}}, \code{\link{ymd_hms}} } \keyword{chron} lubridate/man/make_datetime.Rd0000644000175100001440000000206312755025555016112 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/instants.r \name{make_datetime} \alias{make_date} \alias{make_datetime} \title{Efficient creation of date-times from numeric representations} \usage{ make_datetime(year = 1970L, month = 1L, day = 1L, hour = 0L, min = 0L, sec = 0, tz = "UTC") make_date(year = 1970L, month = 1L, day = 1L) } \arguments{ \item{year}{numeric year} \item{month}{numeric month} \item{day}{numeric day} \item{hour}{numeric hour} \item{min}{numeric minute} \item{sec}{numeric second} \item{tz}{time zone. Defaults to UTC.} } \description{ \code{make_datetime} is a very fast drop-in replacement for \code{base::ISOdate} and \code{base::ISOdatetime}. \code{make_date} produces objects of class \code{Date}. } \details{ Input vectors are silently recycled. All inputs except \code{sec} are silently converted to integer vectors; \code{sec} can be either integer or double. } \examples{ make_datetime(year = 1999, month = 12, day = 22, sec = 10) make_datetime(year = 1999, month = 12, day = 22, sec = c(10, 11)) } lubridate/man/time_length.Rd0000644000175100001440000000302212705366146015613 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/timespans.r, R/intervals.r \docType{methods} \name{time_length} \alias{time_length} \alias{time_length,Interval-method} \title{Compute the exact length of a time span.} \usage{ time_length(x, unit = "second") \S4method{time_length}{Interval}(x, unit = "second") } \arguments{ \item{x}{a duration, period, difftime or interval} \item{unit}{a character string that specifies with time units to use} } \value{ the length of the interval in the specified unit. A negative number connotes a negative interval or duration } \description{ Compute the exact length of a time span. } \details{ When \code{x} is an \code{\link{Interval-class}} object and \code{unit} are years or months, \code{timespan_length} takes into account the fact that all months and years don't have the same number of days. When \code{x} is a \code{\link{Duration-class}}, \code{\link{Period-class}} or \code{\link{difftime}} object, length in months or years is based on their most common lengths in seconds (see \code{\link{timespan}}). } \examples{ int <- interval(ymd("1980-01-01"), ymd("2014-09-18")) time_length(int, "week") # Exact age time_length(int, "year") # Age at last anniversary trunc(time_length(int, "year")) # Example of difference between intervals and durations int <- interval(ymd("1900-01-01"), ymd("1999-12-31")) time_length(int, "year") time_length(as.duration(int), "year") } \seealso{ \code{\link{timespan}} } \keyword{chron} \keyword{math} \keyword{methods} \keyword{period} lubridate/man/DateCoercion.Rd0000644000175100001440000000045212705366146015657 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.r \name{DateCoercion} \alias{DateCoercion} \title{Convert a variety of date-time classes to POSIXlt and POSIXct} \description{ Convert a variety of date-time classes to POSIXlt and POSIXct } \keyword{internal} lubridate/man/period.Rd0000644000175100001440000000716412757712257014616 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/periods.r \name{period} \alias{is.period} \alias{period} \title{Create a period object.} \usage{ period(num = NULL, units = "second", ...) is.period(x) } \arguments{ \item{num}{a numeric vector that lists the number of time units to be included in the period. From v1.6.0 \code{num} can also be a character vector that specifies durations in a convenient shorthand format. All unambiguous name units and abbreviations are supported. One letter "m" stands for months, "M" stands for minutes. See examples.} \item{units}{a character vector that lists the type of units to be used. The units in units are matched to the values in num according to their order. When \code{num} is character, this argument is ignored.} \item{...}{a list of time units to be included in the period and their amounts. Seconds, minutes, hours, days, weeks, months, and years are supported. Normally only one of \code{num} or \code{...} are present. If both are present, the periods are concatenated.} \item{x}{an R object} } \value{ a period object } \description{ \code{period} creates a period object with the specified values. period provides the behaviour of \code{\link{period}} in a way that is more suitable for automating within a function. } \details{ Within a Period object, time units do not have a fixed length (except for seconds) until they are added to a date-time. The length of each time unit will depend on the date-time to which it is added. For example, a year that begins on 2009-01-01 will be 365 days long. A year that begins on 2012-01-01 will be 366 days long. When math is performed with a period object, each unit is applied separately. How the length of a period is distributed among its units is non-trivial. For example, when leap seconds occur 1 minute is longer than 60 seconds. Periods track the change in the "clock time" between two date-times. They are measured in common time related units: years, months, days, hours, minutes, and seconds. Each unit except for seconds must be expressed in integer values. Period objects can be easily created with the helper functions \code{\link{years}}, \code{\link{months}}, \code{\link{weeks}}, \code{\link{days}}, \code{\link{hours}}, \code{\link{minutes}}, and \code{\link{seconds}}. These objects can be added to and subtracted to date-times to create a user interface similar to object oriented programming. Note: Arithmetic with periods can results in undefined behavior when non-existent dates are involved (such as February 29th). Please see \code{\link{Period-class}} for more details and \code{\link{\%m+\%}} and \code{\link{add_with_rollback}} for alternative operations. } \examples{ period(c(90, 5), c("second", "minute")) # "5M 90S" period(-1, "days") period(c(3, 1, 2, 13, 1), c("second", "minute", "hour", "day", "week")) period(c(1, -60), c("hour", "minute")) period(0, "second") period (second = 90, minute = 5) period(day = -1) period(second = 3, minute = 1, hour = 2, day = 13, week = 1) period(hour = 1, minute = -60) period(second = 0) period(c(1, -60), c("hour", "minute"), hour = c(1, 2), minute = c(3, 4)) period("2M 1sec") period("2hours 2minutes 1second") period("2d 2H 2M 2S") period("2days 2hours 2mins 2secs") # Missing numerals default to 1. Repeated units are added up. duration("day day") # Comparison with characters is supported from v1.6.0. duration("day 2 sec") > "day 1sec" is.period(as.Date("2009-08-03")) # FALSE is.period(period(months= 1, days = 15)) # TRUE } \seealso{ \code{\link{Period-class}}, \code{\link{quick_periods}}, \code{\link{\%m+\%}}, \code{\link{add_with_rollback}} } \keyword{chron} \keyword{classes} lubridate/man/quick_periods.Rd0000644000175100001440000000503712755025555016166 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/periods.r \name{quick_periods} \alias{days} \alias{hours} \alias{microseconds} \alias{milliseconds} \alias{minutes} \alias{months.numeric} \alias{nanoseconds} \alias{picoseconds} \alias{quick_periods} \alias{seconds} \alias{weeks} \alias{years} \title{Quickly create period objects.} \usage{ seconds(x = 1) minutes(x = 1) hours(x = 1) days(x = 1) weeks(x = 1) years(x = 1) milliseconds(x = 1) microseconds(x = 1) nanoseconds(x = 1) picoseconds(x = 1) \method{months}{numeric}(x, abbreviate) } \arguments{ \item{x}{numeric value of the number of units to be contained in the period. With the exception of seconds(), x must be an integer.} \item{abbreviate}{Ignored. For consistency with S3 generic in base namespace.} } \value{ a period object } \description{ Quickly create Period objects for easy date-time manipulation. The units of the period created depend on the name of the function called. For Period objects, units do not have a fixed length until they are added to a specific date time, contrast this with \code{\link{duration}}. This makes periods useful for manipulations with clock times because units expand or contract in length to accomodate conventions such as leap years, leap seconds, and Daylight Savings Time. } \details{ When paired with date-times, these functions allow date-times to be manipulated in a method similar to object oriented programming. Period objects can be added to Date, POSIXct, and POSIXlt objects to calculate new date-times. Note: Arithmetic with periods can results in undefined behavior when non-existent dates are involved (such as February 29th in non-leap years). Please see \code{\link{Period-class}} for more details and \code{\link{\%m+\%}} and \code{\link{add_with_rollback}} for alternative operations. } \examples{ x <- as.POSIXct("2009-08-03") x + days(1) + hours(6) + minutes(30) x + days(100) - hours(8) class(as.Date("2009-08-09") + days(1)) # retains Date class as.Date("2009-08-09") + hours(12) class(as.Date("2009-08-09") + hours(12)) # converts to POSIXt class to accomodate time units years(1) - months(7) c(1:3) * hours(1) hours(1:3) #sequencing y <- ymd(090101) # "2009-01-01 CST" y + months(0:11) # compare DST handling to durations boundary <- as.POSIXct("2009-03-08 01:59:59") boundary + days(1) # period boundary + ddays(1) # duration # seconds later) } \seealso{ \code{\link{Period-class}}, \code{\link{period}}, \code{\link{ddays}}, \code{\link{\%m+\%}}, \code{\link{add_with_rollback}} } \keyword{chron} \keyword{manip} lubridate/man/Duration-class.Rd0000644000175100001440000000207112750222477016205 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/durations.r \docType{class} \name{Duration-class} \alias{Duration-class} \title{Duration class} \description{ Duration is an S4 class that extends the \code{\link{Timespan-class}} class. Durations record the exact number of seconds in a time span. They measure the exact passage of time but do not always align with measurements made in larger units of time such as hours, months and years. This is because the exact length of larger time units can be affected by conventions such as leap years and Daylight Savings Time. } \details{ Durations provide a method for measuring generalized timespans when we wish to treat time as a mathematical quantity that increases in a uniform, monotone manner along a continuous numberline. They allow exact comparisons with other durations. See \code{\link{Period-class}} for an alternative way to measure timespans that better preserves clock times. Durations class objects have one slot: .Data, a numeric object equal to the number of seconds in the duration. } lubridate/man/within-interval.Rd0000644000175100001440000000144212755025555016445 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/intervals.r \name{\%within\%} \alias{\%within\%} \alias{\%within\%,ANY,Interval-method} \alias{\%within\%,Interval,Interval-method} \title{Tests whether a date or interval falls within an interval} \usage{ a \%within\% b } \arguments{ \item{a}{An interval or date-time object} \item{b}{An interval} } \value{ A logical } \description{ %within% returns TRUE if a falls within interval b, FALSE otherwise. If a is an interval, both its start and end dates must fall within b to return TRUE. } \examples{ int <- interval(ymd("2001-01-01"), ymd("2002-01-01")) int2 <- interval(ymd("2001-06-01"), ymd("2002-01-01")) ymd("2001-05-03") \%within\% int # TRUE int2 \%within\% int # TRUE ymd("1999-01-01") \%within\% int # FALSE } lubridate/man/ymd.Rd0000644000175100001440000000671112755025555014116 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse.r \name{ymd} \alias{dmy} \alias{dym} \alias{mdy} \alias{myd} \alias{ydm} \alias{ymd} \alias{yq} \title{Parse dates according to the order in that year, month, and day elements appear in the input vector.} \usage{ ymd(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME"), truncated = 0) ydm(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME"), truncated = 0) mdy(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME"), truncated = 0) myd(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME"), truncated = 0) dmy(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME"), truncated = 0) dym(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME"), truncated = 0) yq(..., quiet = FALSE, tz = NULL, locale = Sys.getlocale("LC_TIME")) } \arguments{ \item{...}{a character or numeric vector of suspected dates} \item{quiet}{logical. When TRUE function evalueates without displaying customary messages.} \item{tz}{Time zone indicator. If NULL (default) a Date object is returned. Otherwise a POSIXct with time zone attribute set to \code{tz}.} \item{locale}{locale to be used, see \link{locales}. On linux systems you can use \code{system("locale -a")} to list all the installed locales.} \item{truncated}{integer. Number of formats that can be truncated.} } \value{ a vector of class POSIXct if tz argument is non-NULL or Date if tz is NULL (default) } \description{ Transforms dates stored in character and numeric vectors to Date or POSIXct objects (see \code{tz} argument). These functions recognize arbitrary non-digit separators as well as no separator. As long as the order of formats is correct, these functions will parse dates correctly even when the input vectors contain differently formatted dates. See examples. } \details{ If \code{truncated} parameter is non-zero \code{ymd} functions also check for truncated formats. For example \code{ymd} with \code{truncated = 2} will also parse incomplete dates like \code{2012-06} and \code{2012}. NOTE: \code{ymd} family of functions are based on `parse_date_time` and thus directly drop to internal C parser for numeric months, but use R's `strptime` for alphabetic months. This implies that some of the `strptime`'s limitations are inherited by lubridate's parser. For example truncated formats (like \%Y-\%b) will not be parsed. Numeric truncated formats (like \%Y-\%m) are handled correctly by lubridate's C parser. As of version 1.3.0, lubridate's parse functions no longer return a message that displays which format they used to parse their input. You can change this by setting the \code{lubridate.verbose} option to TRUE with \code{options(lubridate.verbose = TRUE)}. } \examples{ x <- c("09-01-01", "09-01-02", "09-01-03") ymd(x) x <- c("2009-01-01", "2009-01-02", "2009-01-03") ymd(x) ymd(090101, 90102) now() > ymd(20090101) ## TRUE dmy(010210) mdy(010210) ## heterogenuous formats in a single vector: x <- c(20090101, "2009-01-02", "2009 01 03", "2009-1-4", "2009-1, 5", "Created on 2009 1 6", "200901 !!! 07") ymd(x) ## What lubridate might not handle: ## Extremely weird cases when one of the separators is "" and some of the ## formats are not in double digits might not be parsed correctly: \dontrun{ymd("201002-01", "201002-1", "20102-1") dmy("0312-2010", "312-2010")} } \seealso{ \code{\link{parse_date_time}} for an even more flexible low level mechanism. } \keyword{chron}