hms/0000755000176200001440000000000014406371372011050 5ustar liggesusershms/NAMESPACE0000644000176200001440000000257614406342760012300 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("[<-",hms) S3method("[[",hms) S3method("units<-",hms) S3method(as.POSIXct,hms) S3method(as.POSIXlt,hms) S3method(as.character,hms) S3method(as.hms,POSIXlt) S3method(as.hms,POSIXt) S3method(as.hms,default) S3method(as_hms,default) S3method(c,hms) S3method(format,hms) S3method(print,hms) S3method(unique,hms) S3method(vec_cast,hms) S3method(vec_cast.POSIXct,hms) S3method(vec_cast.POSIXlt,hms) S3method(vec_cast.character,hms) S3method(vec_cast.difftime,hms) S3method(vec_cast.double,hms) S3method(vec_cast.hms,POSIXct) S3method(vec_cast.hms,POSIXlt) S3method(vec_cast.hms,character) S3method(vec_cast.hms,default) S3method(vec_cast.hms,difftime) S3method(vec_cast.hms,double) S3method(vec_cast.hms,hms) S3method(vec_cast.hms,integer) S3method(vec_cast.integer,hms) S3method(vec_ptype2,hms) S3method(vec_ptype2.difftime,hms) S3method(vec_ptype2.hms,default) S3method(vec_ptype2.hms,difftime) S3method(vec_ptype2.hms,hms) S3method(vec_ptype_abbr,hms) S3method(vec_ptype_full,hms) export(as.hms) export(as_hms) export(hms) export(is.hms) export(is_hms) export(new_hms) export(parse_hm) export(parse_hms) export(round_hms) export(trunc_hms) export(vec_cast.hms) export(vec_ptype2.hms) import(rlang) import(vctrs) importFrom(lifecycle,deprecate_soft) importFrom(lifecycle,expect_deprecated) importFrom(methods,setOldClass) importFrom(pkgconfig,get_config) hms/LICENSE0000644000176200001440000000005114207763054012052 0ustar liggesusersYEAR: 2020 COPYRIGHT HOLDER: hms authors hms/README.md0000644000176200001440000001442114277471604012336 0ustar liggesusers# hms [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html) [![rcc](https://github.com/tidyverse/hms/workflows/rcc/badge.svg)](https://github.com/tidyverse/hms/actions) [![Codecov test coverage](https://codecov.io/gh/tidyverse/hms/branch/main/graph/badge.svg)](https://app.codecov.io/gh/tidyverse/hms?branch=main) [![CRAN\_Status\_Badge](https://www.r-pkg.org/badges/version/hms)](https://cran.r-project.org/package=hms) ## Overview The hms package provides a simple class for storing durations or time-of-day values and displaying them in the hh:mm:ss format. This class is intended to simplify data exchange with databases, spreadsheets, and other data sources: - Stores values as a numeric vector that contains the number of seconds since midnight - Supports construction from explicit hour, minute, or second values - Supports coercion to and from various data types, including `POSIXt` - Can be used as column in a data frame - Based on the `difftime` class - Values can exceed the 24-hour boundary or be negative - By default, fractional seconds up to a microsecond are displayed, regardless of the value of the `"digits.secs"` option ## Installation
# The easiest way to get hms is to install the whole tidyverse:
install.packages("tidyverse")

# Alternatively, install just hms:
install.packages("hms")

# Or the the development version from GitHub:
# install.packages("devtools")
devtools::install_github("tidyverse/hms")
## Usage The following example showcases ways of using the `hms` class standalone or as a data frame column.
library(hms)

hms(56, 34, 12)
#> 12:34:56
as_hms(Sys.time())
#> 11:55:02.553476
parse_hms("12:34:56")
#> 12:34:56
as.POSIXct(hms(1))
#> [1] "1970-01-01 00:00:01 UTC"

data.frame(hours = 1:3, hms = hms(hours = 1:3))
#>   hours      hms
#> 1     1 01:00:00
#> 2     2 02:00:00
#> 3     3 03:00:00
## Internal representation Objects of the `hms` and its underlying `difftime` classes are stored as number of seconds since `00:00:00`. Use [`as.numeric()`](https://rdrr.io/r/base/numeric.html) and [`as_hms()`](https://hms.tidyverse.org/reference/hms.html) to convert to and from numbers.
times <- parse_hms(c("00:00:00.25", "00:00:01", "00:01:30", "01:00:00"))
times
#> 00:00:00.25
#> 00:00:01.00
#> 00:01:30.00
#> 01:00:00.00
times_num <- as.numeric(times)
times_num
#> [1]    0.25    1.00   90.00 3600.00
as_hms(times_num)
#> 00:00:00.25
#> 00:00:01.00
#> 00:01:30.00
#> 01:00:00.00
------------------------------------------------------------------------ Please note that the ‘hms’ project is released with a [Contributor Code of Conduct](https://github.com/tidyverse/hms/blob/master/CODE_OF_CONDUCT.md). By contributing to this project, you agree to abide by its terms. hms/man/0000755000176200001440000000000014406342760011622 5ustar liggesusershms/man/vec_cast.hms.Rd0000644000176200001440000000113514207763054014470 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cast.R \name{vec_cast.hms} \alias{vec_cast.hms} \title{Casting} \usage{ \method{vec_cast}{hms}(x, to, ...) } \arguments{ \item{x}{Vectors to cast.} \item{to}{Type to cast to. If \code{NULL}, \code{x} will be returned as is.} \item{...}{For \code{vec_cast_common()}, vectors to cast. For \code{vec_cast()}, \code{vec_cast_default()}, and \code{vec_restore()}, these dots are only for future extensions and should be empty.} } \description{ Double dispatch methods to support \code{\link[vctrs:vec_cast]{vctrs::vec_cast()}}. } hms/man/hms-package.Rd0000644000176200001440000000166714277470617014314 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hms.R \docType{package} \name{hms-package} \alias{hms-package} \title{hms: Pretty Time of Day} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} Implements an S3 class for storing and formatting time-of-day values, based on the 'difftime' class. } \details{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} } \seealso{ Useful links: \itemize{ \item \url{https://hms.tidyverse.org/} \item \url{https://github.com/tidyverse/hms} \item Report bugs at \url{https://github.com/tidyverse/hms/issues} } } \author{ \strong{Maintainer}: Kirill Müller \email{kirill@cynkra.com} (\href{https://orcid.org/0000-0002-1416-3412}{ORCID}) Other contributors: \itemize{ \item R Consortium [funder] \item RStudio [funder] } } hms/man/hms.Rd0000644000176200001440000000427014406342760012703 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hms.R \name{hms} \alias{hms} \alias{new_hms} \alias{is_hms} \alias{as_hms} \alias{as.POSIXct.hms} \alias{as.POSIXlt.hms} \alias{as.character.hms} \alias{format.hms} \alias{print.hms} \title{A simple class for storing time-of-day values} \usage{ hms(seconds = NULL, minutes = NULL, hours = NULL, days = NULL) new_hms(x = numeric()) is_hms(x) as_hms(x, ...) \method{as.POSIXct}{hms}(x, ...) \method{as.POSIXlt}{hms}(x, ...) \method{as.character}{hms}(x, ...) \method{format}{hms}(x, ...) \method{print}{hms}(x, ...) } \arguments{ \item{seconds, minutes, hours, days}{Time since midnight. No bounds checking is performed.} \item{x}{An object.} \item{...}{additional arguments to be passed to or from methods.} } \description{ The values are stored as a \link{difftime} vector with a custom class, and always with "seconds" as unit for robust coercion to numeric. Supports construction from time values, coercion to and from various data types, and formatting. Can be used as a regular column in a data frame. \code{hms()} is a high-level constructor that accepts second, minute, hour and day components as numeric vectors. \code{new_hms()} is a low-level constructor that only checks that its input has the correct base type, \link{numeric}. \code{is_hms()} checks if an object is of class \code{hms}. \code{as_hms()} is a generic that supports conversions beyond casting. The default method forwards to \code{\link[=vec_cast]{vec_cast()}}. } \details{ For \code{hms()}, all arguments must have the same length or be \code{NULL}. Odd combinations (e.g., passing only \code{seconds} and \code{hours} but not \code{minutes}) are rejected. For arguments of type \link{POSIXct} and \link{POSIXlt}, \code{as_hms()} does not perform timezone conversion. Use \code{\link[lubridate:with_tz]{lubridate::with_tz()}} and \code{\link[lubridate:force_tz]{lubridate::force_tz()}} as necessary. } \examples{ hms(56, 34, 12) hms() new_hms(as.numeric(1:3)) # Supports numeric only! try(new_hms(1:3)) as_hms(1) as_hms("12:34:56") as_hms(Sys.time()) as.POSIXct(hms(1)) data.frame(a = hms(1)) d <- data.frame(hours = 1:3) d$hours <- hms(hours = d$hours) d } hms/man/vec_ptype2.hms.Rd0000644000176200001440000000123314277464542014767 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coerce.R \name{vec_ptype2.hms} \alias{vec_ptype2.hms} \title{Coercion} \usage{ \method{vec_ptype2}{hms}(x, y, ..., x_arg = "", y_arg = "") } \arguments{ \item{x, y}{Vector types.} \item{...}{These dots are for future extensions and must be empty.} \item{x_arg, y_arg}{Argument names for \code{x} and \code{y}. These are used in error messages to inform the user about the locations of incompatible types (see \code{\link[vctrs:stop_incompatible_type]{stop_incompatible_type()}}).} } \description{ Double dispatch methods to support \code{\link[vctrs:vec_ptype2]{vctrs::vec_ptype2()}}. } hms/man/round_hms.Rd0000644000176200001440000000166314207763054014117 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/round.R \name{round_hms} \alias{round_hms} \alias{trunc_hms} \title{Round or truncate to a multiple of seconds} \usage{ round_hms(x, secs = NULL, digits = NULL) trunc_hms(x, secs = NULL, digits = NULL) } \arguments{ \item{x}{A vector of class \link{hms}} \item{secs}{Multiple of seconds, a positive numeric. Values less than one are supported} \item{digits}{Number of digits, a whole number. Negative numbers are supported.} } \value{ The input, rounded or truncated to the nearest multiple of \code{secs} (or number of \code{digits}) } \description{ Convenience functions to round or truncate to a multiple of seconds. } \examples{ round_hms(as_hms("12:34:56"), 5) round_hms(as_hms("12:34:56"), 60) round_hms(as_hms("12:34:56.78"), 0.25) round_hms(as_hms("12:34:56.78"), digits = 1) round_hms(as_hms("12:34:56.78"), digits = -2) trunc_hms(as_hms("12:34:56"), 60) } hms/man/Deprecated.Rd0000644000176200001440000000235414207763054014157 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hms.R \name{Deprecated} \alias{Deprecated} \alias{is.hms} \alias{as.hms} \alias{as.hms.default} \alias{as.hms.POSIXt} \alias{as.hms.POSIXlt} \title{Deprecated functions} \usage{ is.hms(x) as.hms(x, ...) \method{as.hms}{default}(x, ...) \method{as.hms}{POSIXt}(x, tz = pkgconfig::get_config("hms::default_tz", ""), ...) \method{as.hms}{POSIXlt}(x, tz = pkgconfig::get_config("hms::default_tz", ""), ...) } \arguments{ \item{x}{An object.} \item{...}{Arguments passed on to further methods.} \item{tz}{The time zone in which to interpret a POSIXt time for extracting the time of day. The default is now the zone of \code{x} but was \code{"UTC"} for v0.3 and earlier. The previous behavior can be restored by calling \code{pkgconfig::set_config("hms::default_tz", "UTC")}, see \code{\link[pkgconfig:set_config]{pkgconfig::set_config()}}.} } \description{ \code{is.hms()} has been replaced by \code{\link[=is_hms]{is_hms()}}. \code{as.hms()} has been replaced by \code{\link[=as_hms]{as_hms()}}, which does not have a \code{tz} argument. Change the timezone before converting if necessary, e.g. using \code{\link[lubridate:with_tz]{lubridate::with_tz()}}. } \keyword{internal} hms/man/figures/0000755000176200001440000000000014207763054013270 5ustar liggesusershms/man/figures/lifecycle-defunct.svg0000644000176200001440000000170414207763054017400 0ustar liggesuserslifecyclelifecycledefunctdefunct hms/man/figures/lifecycle-maturing.svg0000644000176200001440000000170614207763054017600 0ustar liggesuserslifecyclelifecyclematuringmaturing hms/man/figures/logo.png0000644000176200001440000005277214207763054014753 0ustar liggesusersPNG  IHDRX?gAMA a cHRMz&u0`:pQ<bKGD pHYs!7!73XztIME  ֆxTIDATxwdgu}:I&'iFiG 4kׁ]絽kJ~7bc{_c/6x1& EfFSӹ+{ǭU~RuͿ{<'(VO@,PR@QO/!:P<(MĒ{~x(Kb؇P/s|L GmC8a rW/GipqLiJ[UԊQc@ ?mZ)Jۯq?|kO!/C o2iD+ GˈpYӔfY7GLFiMWYXp h=lU+/ (JLi:(Mq!/u/a㤣fϭᧀ_6.O_O)8\K0(>. kxŧYH:,Jׁ>(>hoiK4gXpDh䣈%X]1g|)"(Um^)ֲitŹsp]R!WnOD`)LJPJ GPa \8^DW۴"sۆ<.D;^ GhJ+3"dr"G,a'؍k|it5{Њ[w13s4>"';1, a1t9N/xiGSrVQ~X6s~Z޽N5& b5{Nx+ݠ(tX} JwbqUig#1 ?kuo.d"Bͷ;)@Ddh/=*ϟzx*Q$?W0,;-͆?>xݦp6 7˃%2kJ$ۃ_3 GcXUSd5MhYb83A'V̴j`'^`(@]C5T#lhFS:0; `əh~ K0dBly3-mV_8}Ցl,KPZݭ~1sߌxn**"DKq]X5*ىwwE)"CA P1.>nݭZ,88Nb1q,pi~!(E{V`?y!"\.**ʨo4KAxlAv+ 19wtM!PNe VwVVF22XX"KSĒ}b 4?D@%!* OOx})- smXn4pn;mQi굦'8iEp-B2hi~ʪ%!t]tv ׷r#p}=$BN|ːDW!皟8-#6GUe` Ӝ㦦}DbUD"|ŧP<'mq !ǿ 䛻*wpp.nY AR^YF4h?.R`C1{Ivϭn+J[>8 NCqQVQJiy۵+=dQiOnbnX1n~"4JJC{i2qL%S2<8avX[<%r+e_ W+."f„a|2Y>|şnV͟|桛~He)%cnyEn=u7#JV?w#?[=K]VGn2dGSJ<@*-q㌗ 1T̓knãOL{fW5@l@h܀7v*HK_Kz8i~ eռk۝kEn~R?W=O*݈qi:kώʖ){=))+O<͡'^iKO,i+|χո 2D|atn09sWM.)8s{N xGfwLL[l[iKNO r+J)p~B3 TTf3~wK)93xaVVBuwR/iQ(RQhI\}XE&mz(4M])ۿ4%#'%r+FFt?cwEYSrʫp{=2 4MSO=AF]|Py!E[rSraN 02r{\A<>7a`dBiBE+#md) yg5X4q`?*k}M2p-_xڷ}WdnlkW"Bw{[)ŕk \q]>T50;^/94ͪv{^a`nŢEW<غ "qJiɅ?VESctTd\̽ƠP c~օ e0(#= [$,W6~״/EvBJ)|~PMײqAE>lŢ6H?J{7.'`fF=\/HrBѮsߔП\H{Q sfI3X9."i&'13_%IeM^׵G2ij nT FR̅M9?VʲOZ)R+{0E°@  EFK$xQPQӎD^}Pr~/iu뱍FW\ޖyV]͟|vbea5 y) CO1WhUޚT˧hJq! #z]d2Qв ШՔ"a9]qo\NsɆbx\Y # {$E9 9\sy-Il~@.n9,_n.ttF,DI$۳x_#y#aKaȼأ YR{Ng32' ;D0OYBR%"`w/hǰҊ0)&iRa&>(F7]4eɜ-θpʹN8 x)LmHa ,S'ꋒJ~K(>keV8gbed4OBq<.JCJܺSnay̘ ƈ$ R|An@(n~h.PinoA KL*ű 'v[TxnreMWev_E=60 a TQSv[Tc*~Ba}>|%^44YC]ObI4V쳐4d,˰HFS$pNU/-JSW%Xس7Oq+K5~~6E֓0 G}͹d,3[ԶnwyаJ]i . ع\''=H;\%"^Yf!syx`ͭ6"p ䷸2rmXbKdTcqyuB!< DC.G;.(нpyu|e~!Jz=WOP˖/pX[7Tڈ) -$h?+Y{,S xn>$f>a. zT"x\Z<eL[a !OjwtldU% *XmxRPPe'cAǖX^qFc$T@+ƍot'˝-YbQ f+w_Bv?j?NΡYmKLSuu x47J\]&IY[cA4MsV"BuG6ﲣ4qW:a%g,ÚD%Gw5~Dl=yžzFfRfF , ZJǚfGe /^=ȉLI-F$RRr_=tF7gݧ6f3iEDД{|^ݍ%2nm jJ* s[B,tP46D_;/^=Y%g][LjD,58jh8=`jieSf'}u[n&oM3ϤU1nM՛i.ky j8wA v^;(<'y8˘LRi(0K,B7UoG?/&pl XA7&^8̡Sv_in-bJ"V&X4a[y\M[iu3b*aM% vǜK7(`WGzh̆҆候ȝdMkV^zo0ceqDLnARG.waU@29Bljt{nfmvB~y]>H2e[=|Zn݁+@v_m+q67cc%you ASZ^(e$M)2k'iޚmQJ)"kJqyuug1M$+ |ڤܕo';6h眚/L1a=U҆IG҈e9~/kJ#•78]]`v2G2y4X%kIU_XYKO"nَ%,< 9fH:X7w3v'ᕃG4E = ]^ކ=lÝ 8=p :hK4}YN,=#VsaOj}O \RsWC9M@݈4N%U4ރݼx GΑ4RhJ+ڽ(j$R K3<ŎVi _)/w"a$ d+JG$:g1(ރWM=5[2bzѼ漏%e'vCK$u፮c FPK|)፮p-/M1KЋ6[IȴKXEה⶚JX_\Dbyk6t.t^`޲HEOFrQ.9CjlU:Y" ׎OXZ7a,qWD0,h<i3+d(Լ=$,5^뙳Rii`۾Nl k~WbF RLe1ZK,Kd'j}-ٙ看1VwXQNA0idB0SK.P}|W9^Z'gȼ <l9¯%"XH&GkegW }E rK'_rDгy?+O&@g_ݮф>Υ%sWpy2Vs&&MO\iS1B^̆Z7c,jp/*+^9jf#U"a',zx;FF] ;m~gF9,KzvWm1T3]uCGWN9l!#Y`P+'ɔx_;7ab.fXꊯFXΑp{ ,zj_{kR/`}_<ϭp[f9Ǫp<9K;. Vz#Pp#c&7mDX!zx-qӷW2>>5&'=L3%f F85p0rB'ȦzօH)QL)N/bcx^Cko5f".7G9,,3#R u=z{]iNdlmcm}x!t/9r y>APH:Ω$Q tBl-o"џ"I.|bK,vTroÞ Cjc} g*4vz9=p@95:?V( B=MR(hJF1>wq(HI ]c_ e+YϺ:fTZxXĮ2yGݮ1/"v\c_./s>pk:քj9K

f yT(3g/M,z0RCS#8_~ypl%awaMg:ώ-.MgS_p#CQ'3 8F/x[ǾPj&!w.D;SaomCl\#\C+P̽J2Bn?#B-.Yp-!5.t2+E5BCfaX&KRDS嫇STIBW&|6As L1ﹼLguTQʦ~)fwzfhfН睑9KOf`t7~ d1lDZ{VXJQiasє°L>h5-z EJt+2tAcD%W"\?oB_o | EB)s&Mx_+"/K5ׂ9f (u9ypTo>T5 W)>&) $VZSmC9Ħ£PH3!:}E<#փ- +;pg/Ə>lWAc}kE~k NFR2ӅDU= K}T5T-63F9ǭyl݄YGiJc05۾;g߷HhJz^gd0>blVЖ1#QtF1Fq޽~ j:\USvhO_xQD,e'gsgf]RǹKc}mtzf6R+íwJ!ep4o_;`j6Eщqjb4OEyk( jj~L$+H:nrĻ"pBȽ# soq{Hm:]I8^a(&#ڕrఌqఌqఌqఌqఌqఌqఌqఌqఌq"d ͉1vXP AvWmWĬ}*;-p *m#~_'9cKHb8oc 9]'g#`e#`e#`e#`e#`e#`e@b;-pw=<]8GlC1!H&AH̺#&qEt|hJ#eI[RSFD<ۏWw# #I,̳3) !]I3M<$mePsq</BC Kpi^rsCdjq!Xsۋ> 31DMU&6FQ +B;Jaӱ bĢ6P] f.`2ʉpMŴYՕD.vo]l)o_W`H&Ag}mu/;pĢ[MiUMznΏ5_=ϗ>G,\=+HF9s0ͥqw] ?o-[ƽ=e ^ۍ"J[l̈́ȚP ;*[yd>j?CiElŚp ?=oK{#߸0\|2i3طoX5 ~gp_S |l V燿DHL 2AL~k.Mgsz_dsdqi.M?~s]ŭMn}AߗxBGJH&>F>q/eV׬ưS+GE$o'1@* @7Օ{;O|sb1156\LJ6>4*ތe?9GsSW2n;[7yoxd>~aev45Fo`8P{>.D;OM8FA{ʮ%¹=K_b.XIKֆkqi.^8Dʠ+<6Ns/pJ!TottyN৚bau |tc=ΗN?áSN]5M=W(KLz$c]^6G[mjJ-ëo>teqZ"U;jw~fX_>_84}A,+2o]UfGzϢ9+yg/:F4G1. wrt0J_&l׮q=ɣRnwooWFPJ!pz":Eq>YdG<[s23ϐ233I3i1n6@6LЕq\SzNtMiy҂П7xA[Nu^8"V >u+}T 93p=5FrooF'<:m@쥞9ʧWF+}T*dX|YN[\|/ye+mԯU(\NWϟ&Ù|.Aq;shV7;FSa.8."#p[&]5Opm *ꃕjMR=<SѪl_~sHC|̔KX9wc}}&\Ktܨx ܚ{1oǪp9fs3L( f$9sz`Ŭ,RwW;ޙUDvFzg.r>zuhxxTg0u;Va3<_8."g/0 .F;YV]iyKfK]$g\R(z0 2=uWpx\sS 28H&)oV 3UDb9Pz2ߣmv$aK H bi#2ĚRxc/kn6Pݷ⎺oqfq#9mhY Z&),yf,#odlwgaapRMcsӔƙ|W>a>uOUp7~%!s|e^-tž C/ړoz=^;h)\xc?q{ŭ59w:^8)抲J)*e IƼ,nm{n.XO޷.K|o@4Uh-[O?N}^"j|d\]ū:rm\)-(fw_ ;yM).D;/pWni͑|n} '"\-MӸn*Ccud+ ^= 7&\R*>[}hZ2چ.6t[kbGe˨5rk.~by8ږun%-kz/yxlh嫇x, #Y,x+hsi#?>]>9/~_^|. x:MihJ#K^s8k[+ᾆ}a ކ=܁?5@GY9OzNF8W"*:;i= `5Yb|+7c/ʰC'u% _YWw/~age+O:n+Mq /_=DgwC^" rsEU Œ.MƽG:Z]itz9aCnE2 _)6X]>dSdu VIR)["-x3Km_gC>Xɽ {ZW:2%ֲ/]iU(r`hŎm#i4G4+tOlhƫmonH_dǥMۂN5D(Rf#=kIe^>XBjF=u%|(0*/շ9?1,% -F#hۓ#}:ߡ/1 W.M綾d^}@6}l>@bFq 1~؈=zjwp[v"pv&zflVJx$>7Q-ek-(ԜR xA. wٳ֎xW5rp7Ur> X9:b$$~u%os:,Ea{5Yق囵f,p'ΝwfBٚu{ע}^}GC<awl/ņz6c-I [c<_2^nk|s== 7\]\QNcIQ#]rvN"^o6X0ܛI)56r;Í\\qGz=^a!oãO,WFVz\7$Zx)pܲX40x_] eq6+ԔH&k'y훻n롈 >9rcGgֳ Nx FRbuL 9 ˌ9MZ6S&Xt;Í@xo#YPlxǔ[@'Tysu>#i]uҜa*GB2"Z] ]p xR)MVD)+]}0  F@[_΅F248ɡ$b;J#c|AӔnY7G{T/:H$ci*H (>5K)E|66?q q7[)j. __+˰H%IFSXFA:(SbW4(70SVNȵ"|w;5.̏7Aʙ"uXdp`3]p3v௕DV \ӿv=5-O>%tچq@e't^$2~Q|L ݫeVi~2;֔K,7l~?I+] {=z^qXX"(H$FUJS/%R˓1]KDx?kM\ͥ++.Iة xX"\vVr-υhH d4Er(Y+!3J5'scNoTk#XJm 4y%d2 NKE0M?BH:B^@r}֗{߸OcX,!=l/ S._R.J=s7{ p[np'}-d\ `X3e4{xDj.J=!SC2 XCr%_s 5p E WGzEIdI & C?oD\VOsXWJ#ƒY>-#\ _^vZ i綽:Z:p)l*GBˮʍY`UsiJqi; # vʹIb0i[ REHϝ]1qDMݭ+ $wwBe]#;GZ#k'(uB';V@&aZ4mqۇ4N\(z?L '1P/(~Uh -NǼ89!GpUi<=YiXluwRS_Mi9"R/RDhUO{]+e\'QyEN{ T13D/緓4 SJL[TK[{.X5PD#|J:aY Z>bGwr9NFPO R`4O}^ټOv~T?n!.4]U3-Ɗ(l~Oxo_;鈷(c>J D|%\}406ͯk`k4auC4]}O5̲ލXE:̘:XD(iJ?$aɫy@DKYK'85ro ^Ix_@3Sp9|oj.w"izv=w˓^SFcA4p OQ%sV+ؿvUn2ًrv[(g#6EOi]{-sgܮeX$I%\)ş!xaᄛc^8KՁM! W֧{XWiY!*9-֖؆SOf>{G˴AA_r5Zi#*e ]a052Q~&R#=1#'׷Rd|!3ET{XFF̌gɳe x3ikjح8.J}PFo!^3 E$Zф[157Ώ_?H"Q+iEEVK"?;|x#@ճ3=N3mW[Fve'K,U4[)śNJ;}V R )k5Sx]7R&8f ?7<ⷔ[wy]+KB9rqy6`P7 *@t,jAy?ՁȔRhC09X l)0!*n,nM7kg덓IiO(œXNǒpqiR} vp_y#}gb8ǧi.[3w4̤8y<Ϟ":8Rh+K ,&KR01m|Yxڢa5Cqgnjͮs0߾)3,#6&i)[C٘%>-\r3|+BFHCQfkC_P,Y {wk3,3pu| ϟz>y 1oXFƥ-Zy-*l?+xG/.)'azM :WE SL~|C$Ձr\|v GV2kv^:sd-{[=_i~ Ų~2[>yݥiȭ<-Yo 27!?tMg[ye0CWmg;ǿA>4=w旊,wf;3GeE4Mq/Ps)lY}1졵˥-+.z}]. ۨPpvT_ڝ gb}=I),r6&2O+3bkǥʊx2^8K/$g+mq!% CL\|;f+; 2 ޾vk_.j%" /'7-|[Նt>8PP 6G6pn/wf(=i7ǘ4EU Vt[\7P<>ѯЗ_Ώ5ǣ/]=!&f,f7^Jc 8貓FP,:+h'9l"<ư L(rK6,,^)ɻ4Vz*^8Kգ8_J# r y=AJ@B6##/3FPq7Q/c(5¶&ڇr->VxQ?<OH sWPy (}. ͕UmǒK[ hM4bX)#kPڀGs؆eoq[7p{v\[_"n$I$${ㅖ't+Y6i~ #SD8]vlȕɆe"ٲz1ȈsVy8Lra*eh.rTԐ-\<)= R11f: GS0Y*ވ!m1G-[Y9{G4u;qi:/w3K49Br؎[.R7Yi~ #ih yPwDx%mPZ{r!c&iyIF2q^;řKdbtqC7r6+(ny>p< &mmXֲ|d/Z-5Xγ%Pl`xor?n~{c7?g<;ρr?Iסp2"u[,VJqOͼ}%J(bIXi~ Pvʹȵ4O`a EOb^ѫ*I)^| L,Cb i?FS*]˻*b8Or\6m񌦫߶,j6,v3 FXE]iuP 2 ^̔Ei~zղ\38.%qд\CL[J64e#y䆴)&JhO*yK=HB)mc'[菓JU'opցRH6m"-i"05 ܺ{&94ʤyq^;yX.KNs9i~ ƪ* ׸ܔ-"~y;i^i50-3y+z)$;xpX*#CY>tk,(ײF]i8[9'_ն 'c'?\jTq_ײ ^9wXa7˵JOEL2A ǀjٞ%i4WA{`YV!`qAitŹsˋ#%D'ŲB1\nM#c.-/Atp m1OL4/Q>/[Wsq?qw}KJZeҗ8ٴE,CP.ᗁ"ϴi_!gKܛ_/&XP&)MwYxm cw[ޓ'mNO+, -;/C60V?ga _+?ЭtS}js2&76.6ni~VZNh]8^ej%ܗz4?^PYZ 8^ANJޏ)_9~ O2$7 W[q?:B 0%tEXtdate:create2019-01-09T20:13:25+01:00|X%tEXtdate:modify2019-01-09T20:13:25+01:00̠IENDB`hms/man/figures/lifecycle-archived.svg0000644000176200001440000000170714207763054017540 0ustar liggesusers lifecyclelifecyclearchivedarchived hms/man/figures/lifecycle-soft-deprecated.svg0000644000176200001440000000172614207763054021025 0ustar liggesuserslifecyclelifecyclesoft-deprecatedsoft-deprecated hms/man/figures/lifecycle-questioning.svg0000644000176200001440000000171414207763054020316 0ustar liggesuserslifecyclelifecyclequestioningquestioning hms/man/figures/lifecycle-stable.svg0000644000176200001440000000167414207763054017230 0ustar liggesuserslifecyclelifecyclestablestable hms/man/figures/lifecycle-experimental.svg0000644000176200001440000000171614207763054020450 0ustar liggesuserslifecyclelifecycleexperimentalexperimental hms/man/figures/lifecycle-deprecated.svg0000644000176200001440000000171214207763054020047 0ustar liggesuserslifecyclelifecycledeprecateddeprecated hms/man/parse_hms.Rd0000644000176200001440000000121414207763054014072 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse.R \name{parse_hms} \alias{parse_hms} \alias{parse_hm} \title{Parsing hms values} \usage{ parse_hms(x) parse_hm(x) } \arguments{ \item{x}{A character vector} } \value{ An object of class \link{hms}. } \description{ These functions convert character vectors to objects of the \link{hms} class. \code{NA} values are supported. \code{parse_hms()} accepts values of the form \code{"HH:MM:SS"}, with optional fractional seconds. \code{parse_hm()} accepts values of the form \code{"HH:MM"}. } \examples{ parse_hms("12:34:56") parse_hms("12:34:56.789") parse_hm("12:34") } hms/DESCRIPTION0000644000176200001440000000222414406371372012556 0ustar liggesusersPackage: hms Title: Pretty Time of Day Date: 2023-03-21 Version: 1.1.3 Authors@R: c( person("Kirill", "Müller", role = c("aut", "cre"), email = "kirill@cynkra.com", comment = c(ORCID = "0000-0002-1416-3412")), person("R Consortium", role = "fnd"), person("RStudio", role = "fnd") ) Description: Implements an S3 class for storing and formatting time-of-day values, based on the 'difftime' class. Imports: lifecycle, methods, pkgconfig, rlang (>= 1.0.2), vctrs (>= 0.3.8) Suggests: crayon, lubridate, pillar (>= 1.1.0), testthat (>= 3.0.0) License: MIT + file LICENSE Encoding: UTF-8 URL: https://hms.tidyverse.org/, https://github.com/tidyverse/hms BugReports: https://github.com/tidyverse/hms/issues RoxygenNote: 7.2.3 Config/testthat/edition: 3 Config/autostyle/scope: line_breaks Config/autostyle/strict: false Config/Needs/website: tidyverse/tidytemplate NeedsCompilation: no Packaged: 2023-03-21 16:52:11 UTC; kirill Author: Kirill Müller [aut, cre] (), R Consortium [fnd], RStudio [fnd] Maintainer: Kirill Müller Repository: CRAN Date/Publication: 2023-03-21 18:10:02 UTC hms/tests/0000755000176200001440000000000014207763054012213 5ustar liggesusershms/tests/testthat/0000755000176200001440000000000014406371372014052 5ustar liggesusershms/tests/testthat/test-lubridate.R0000644000176200001440000000103114210206621017103 0ustar liggesuserstest_that("duration", { skip_if_not_installed("lubridate") expect_identical(lubridate::as.duration(hms(minutes = 1:3)), lubridate::duration(minutes = 1:3)) }) test_that("interval", { skip_if_not_installed("lubridate") timestamp <- Sys.time() expect_identical(lubridate::as.interval(hms(seconds = 2), timestamp), lubridate::interval(timestamp, timestamp + 2)) }) test_that("period", { skip_if_not_installed("lubridate") expect_identical(lubridate::as.period(hms(hours = -1)), lubridate::period(hours = -1)) }) hms/tests/testthat/test-construct.R0000644000176200001440000000312614210206621017163 0ustar liggesuserstest_that("constructor", { expect_identical(hms(1:3, 2:4, 3:5, 4:6), hms(seconds = 1:3 + 2:4 * 60 + 3:5 * 3600 + 4:6 * 86400)) expect_identical(hms(-1, 1), hms(59)) expect_identical(hms(3600), hms(hours = 1)) expect_equal(length(hms(1)), 1L) expect_true(is_hms(hms(1))) expect_s3_class(hms(1), "difftime") expect_identical(as.numeric(hms(1)), 1) expect_identical(as.difftime(hms(1)), hms(1)) }) test_that("casting", { expect_identical(units(as_hms(as.difftime(1, units = "mins"))), "secs") expect_identical(as_hms(hms(1)), hms(1)) expect_identical(as_hms(as.difftime(1:3, units = "secs")), hms(as.numeric(1:3))) }) test_that("zero length (#35)", { expect_equal(length(hms()), 0L) expect_true(is_hms(hms())) expect_s3_class(hms(), "difftime") expect_identical(as.numeric(hms()), numeric()) expect_identical(as.difftime(hms()), hms()) expect_identical(hms(), hms(seconds = numeric())) expect_identical(hms(), hms(minutes = numeric())) expect_identical(hms(), hms(hours = numeric())) expect_identical(hms(), hms(days = numeric())) expect_identical(hms(), as_hms(numeric())) }) test_that("bad input", { expect_error(hms(hours = 1, seconds = 3), "only") expect_error(hms(minutes = 1, days = 3), "only") expect_error(hms(minutes = 1, hours = 2:3), "same length or be NULL") expect_error(hms(seconds = 1:5, minutes = 6:10, hours = 11:17), "same length or be NULL") expect_error(hms("05:00"), "must be numeric") }) test_that("is.hms()", { expect_deprecated(expect_identical(is.hms(hms), is_hms(hms))) expect_deprecated(expect_identical(is.hms(3), is_hms(3))) }) hms/tests/testthat/helper-compare.R0000644000176200001440000000047014207763054017102 0ustar liggesusersexpect_hms_equal <- function(x, y) { expect_s3_class(x, "hms") expect_s3_class(y, "hms") expect_equal(as.numeric(x), as.numeric(y)) } expect_difftime_equal <- function(x, y) { expect_s3_class(x, "difftime") expect_s3_class(y, "difftime") expect_equal(as.numeric(as_hms(x)), as.numeric(as_hms(y))) } hms/tests/testthat/test-parse.R0000644000176200001440000000071414207763054016267 0ustar liggesuserstest_that("parse_hms", { expect_equal(parse_hms("12:34:56"), hms(56, 34, 12)) expect_equal(parse_hms("12:34:56.789"), hms(56.789, 34, 12)) expect_equal(parse_hms(NA), hms(NA)) expect_equal(parse_hms(c("12:34:56", NA)), as_hms(c(hms(56, 34, 12), hms(NA)))) }) test_that("parse_hm", { expect_equal(parse_hm("12:34"), hms(0, 34, 12)) expect_equal(parse_hm(NA), hms(NA)) expect_equal(parse_hm(c("12:34", NA)), as_hms(c(hms(0, 34, 12), hms(NA)))) }) hms/tests/testthat/test-combine.R0000644000176200001440000000143514207763054016572 0ustar liggesuserstest_that("combination keeps class and order", { expect_identical(c(hms(1), hms(2)), hms(1:2)) }) test_that("combination errs if not supported", { expect_error(c(hms(1), factor(2))) }) test_that("combination coerces to hms", { expect_identical(c(hms(1), hms(2)), hms(1:2)) if (getRversion() < "3.3") skip("Only for R >= 3.3") expect_identical(c(hms(1), new_duration(2)), hms(1:2)) expect_identical(vec_c(new_duration(1), hms(2)), hms(1:2)) }) # In R base,`c(as.difftime("20:00:00"), NA)` fails test_that("composition with NA works", { expect_identical( c(hms(1), NA), hms(c(1, NA)) ) expect_identical( vec_c(hms(1), NA), hms(vec_c(1, NA)) ) h <- hms(1) expect_equal(vec_ptype2(h, NA), vec_ptype(h)) expect_equal(vec_ptype2(NA, h), vec_ptype(h)) }) hms/tests/testthat/test-arith.R0000644000176200001440000000264014207763054016264 0ustar liggesusersempty_tz <- function(x) { attr(x, "tzone") <- "" x } test_that("arithmetics work", { expect_equal(as.Date("2016-03-31") + hms(hours = 1), as.Date("2016-03-31")) expect_equal(as.Date("2016-03-31") + hms(days = -1), as.Date("2016-03-30")) expect_equal(empty_tz(as.POSIXct("2016-03-31") + hms(1)), as.POSIXct("2016-03-31 00:00:01")) expect_equal(hms(hours = 1) + as.Date("2016-03-31"), as.Date("2016-03-31")) expect_equal(hms(days = 1) + as.Date("2016-03-31"), as.Date("2016-04-01")) expect_equal(empty_tz(hms(hours = 1) + as.POSIXct("2016-03-31")), as.POSIXct("2016-03-31 01:00:00")) expect_difftime_equal(hms(1) + hms(2), hms(3)) expect_difftime_equal(hms(1) - hms(2), hms(-1)) expect_difftime_equal(2 * hms(1), hms(2)) expect_difftime_equal(hms(hours = 1) / 2, hms(minutes = 30)) expect_difftime_equal(-hms(1), hms(-1)) }) test_that("component extraction work", { x <- as.numeric(hms(12.3, 45, 23, 1)) * TICS_PER_SECOND expect_equal(tic_of_second(x), 300000) expect_equal(second_of_minute(x), 12) expect_equal(minute_of_hour(x), 45) expect_equal(hour_of_day(x), 23) expect_equal(days(x), 1) }) test_that("component extraction work for negative times", { x <- as.numeric(-hms(12.3, 45, 23, 1)) * TICS_PER_SECOND expect_equal(tic_of_second(x), 300000) expect_equal(second_of_minute(x), 12) expect_equal(minute_of_hour(x), 45) expect_equal(hour_of_day(x), 23) expect_equal(days(x), -1) }) hms/tests/testthat/test-coercion-deprecated.R0000644000176200001440000000310114210206621021027 0ustar liggesuserstest_that("coercion in", { expect_deprecated( expect_identical(as.hms(0.5 * 86400), hms(hours = 12)) ) expect_deprecated( expect_identical(as.hms(-0.25 * 86400), hms(hours = -6)) ) expect_deprecated( expect_hms_equal(as.hms("12:34:56"), hms(56, 34, 12)) ) expect_deprecated( expect_hms_equal( as.hms(strptime("12:34:56", format = "%H:%M:%S", tz = "UTC"), tz = "UTC"), hms(56, 34, 12) ) ) expect_deprecated( expect_hms_equal( as.hms(strptime("12:34:56", format = "%H:%M:%S", tz = "Europe/Zurich"), tz = "Europe/Zurich"), hms(56, 34, 12) ) ) expect_deprecated( expect_hms_equal( as.hms(strptime("12:34:56", format = "%H:%M:%S", tz = "PST8PDT"), tz = "PST8PDT"), hms(56, 34, 12) ) ) now <- Sys.time() now_lt <- as.POSIXlt(now) expect_deprecated( expect_hms_equal(as.hms(now), hms(now_lt$sec, now_lt$min, now_lt$hour)) ) expect_deprecated( expect_hms_equal(as.hms(now_lt), as_hms(now)) ) expect_error(expect_deprecated(as.hms(FALSE))) }) test_that("coercion out", { expect_identical(as.character(hms(56, 34, 12)), "12:34:56") expect_identical(as.character(hms(NA)), NA_character_) expect_identical(as.POSIXlt(hms(hours = 6)), strptime("1970-01-01 06:00:00", format = "%Y-%m-%d %H:%M:%S", tz = "UTC")) expect_identical(as.POSIXct(hms(hours = -6)), strptime("1970-01-01 18:00:00", format = "%Y-%m-%d %H:%M:%S", tz = "UTC") - 86400) df <- data.frame(a = 1:3) df$b <- hms(hours = df$a) expect_identical(df, data.frame(a = 1:3, b = hms(hours = 1:3))) }) hms/tests/testthat/test-unique.R0000644000176200001440000000061014207763054016456 0ustar liggesuserstest_that("unique", { expect_identical(unique(new_hms(numeric(0))), new_hms(numeric(0))) expect_identical(unique(new_hms(NA_real_)), new_hms(NA_real_)) expect_identical(unique(new_hms(101)), new_hms(101)) expect_identical(unique(new_hms(c(101, 101, 99, 101))), new_hms(c(101, 99))) expect_identical(unique(new_hms(c(101, NA_real_, 101, 99, 101))), new_hms(c(101, NA_real_, 99))) }) hms/tests/testthat/test-colformat.R0000644000176200001440000000052314210206621017123 0ustar liggesuserstest_that("pillar", { expect_snapshot({ hms(c(-3600, -123.45 - 60, -1, -0.001, 0, 0.001, 1, 60, 123.45, 3600, NA)) hms(c(-3600000, -3600, -60, -1, 0, 1, 60, 3600, 3600000, NA)) hms(c(-4000.55, -3600, -60, 0, 180, 7200, 10000.23, NA)) hms(c(-60, -1, 0, 1, 60, NA)) hms(c(-60, -1, -0.001, 0, 0.001, 1, 60, NA)) }) }) hms/tests/testthat/test-coercion.R0000644000176200001440000000324214210206621016737 0ustar liggesuserstest_that("coercion in", { expect_identical(as_hms(0.5 * 86400), hms(hours = 12)) expect_identical(as_hms(-0.25 * 86400), hms(hours = -6)) expect_hms_equal(as_hms("12:34:56"), hms(56, 34, 12)) expect_hms_equal(as_hms(strptime("12:34:56", format = "%H:%M:%S", tz = "UTC")), hms(56, 34, 12)) expect_hms_equal(as_hms(strptime("12:34:56", format = "%H:%M:%S", tz = "Europe/Zurich")), hms(56, 34, 12)) expect_hms_equal(as_hms(strptime("12:34:56", format = "%H:%M:%S", tz = "PST8PDT")), hms(56, 34, 12)) expect_hms_equal(as_hms(as.POSIXct(strptime("12:34:56", format = "%H:%M:%S", tz = "UTC"))), hms(56, 34, 12)) expect_hms_equal(as_hms(as.POSIXct(strptime("12:34:56", format = "%H:%M:%S", tz = "Europe/Zurich"))), hms(56, 34, 12)) expect_hms_equal(as_hms(as.POSIXct(strptime("12:34:56", format = "%H:%M:%S", tz = "PST8PDT"))), hms(56, 34, 12)) now <- Sys.time() now_lt <- as.POSIXlt(now) expect_hms_equal(as_hms(now), hms(now_lt$sec, now_lt$min, now_lt$hour)) expect_hms_equal(as_hms(now_lt), as_hms(now)) expect_error(as_hms(FALSE)) x <- c("12:34:56", "ab:cd:ef") expect_error(hms::as_hms(x)) }) test_that("coercion out", { expect_identical(as.character(hms(56, 34, 12)), "12:34:56") expect_identical(as.character(hms(NA)), NA_character_) expect_identical(as.POSIXlt(hms(hours = 6)), strptime("1970-01-01 06:00:00", format = "%Y-%m-%d %H:%M:%S", tz = "UTC")) expect_identical(as.POSIXct(hms(hours = -6)), strptime("1970-01-01 18:00:00", format = "%Y-%m-%d %H:%M:%S", tz = "UTC") - 86400) df <- data.frame(a = 1:3) df$b <- hms(hours = df$a) expect_identical(df, data.frame(a = 1:3, b = hms(hours = 1:3))) }) hms/tests/testthat/test-update.R0000644000176200001440000000040514207763054016434 0ustar liggesuserstest_that("Can't update units", { x <- hms(minutes = 3) expect_equal(units(x), "secs") expect_warning(units(x) <- "mins", "always uses seconds") expect_equal(units(x), "secs") expect_warning(units(x) <- "secs", NA) expect_equal(units(x), "secs") }) hms/tests/testthat/_snaps/0000755000176200001440000000000014207763054015336 5ustar liggesusershms/tests/testthat/_snaps/colformat.md0000644000176200001440000000230214207763054017643 0ustar liggesusers# pillar Code hms(c(-3600, -123.45 - 60, -1, -0.001, 0, 0.001, 1, 60, 123.45, 3600, NA)) Output -01:00:00.000 -00:03:03.450 -00:00:01.000 -00:00:00.001 00:00:00.000 00:00:00.001 00:00:01.000 00:01:00.000 00:02:03.450 01:00:00.000 NA Code hms(c(-3600000, -3600, -60, -1, 0, 1, 60, 3600, 3600000, NA)) Output -1000:00:00 - 01:00:00 - 00:01:00 - 00:00:01 00:00:00 00:00:01 00:01:00 01:00:00 1000:00:00 NA Code hms(c(-4000.55, -3600, -60, 0, 180, 7200, 10000.23, NA)) Output -01:06:40.55 -01:00:00.00 -00:01:00.00 00:00:00.00 00:03:00.00 02:00:00.00 02:46:40.23 NA Code hms(c(-60, -1, 0, 1, 60, NA)) Output -00:01:00 -00:00:01 00:00:00 00:00:01 00:01:00 NA Code hms(c(-60, -1, -0.001, 0, 0.001, 1, 60, NA)) Output -00:01:00.000 -00:00:01.000 -00:00:00.001 00:00:00.000 00:00:00.001 00:00:01.000 00:01:00.000 NA hms/tests/testthat/test-round.R0000644000176200001440000000371014207763054016303 0ustar liggesuserstest_that("round_hms()", { expect_equal(round_hms(parse_hms("12:34:56"), 5), hms(55, 34, 12)) expect_equal(round_hms(parse_hms("12:34:56"), 60), hms(0, 35, 12)) expect_equal(round_hms(parse_hms("12:34:56.78"), digits = 1), hms(56.8, 34, 12)) expect_equal(round_hms(parse_hms("12:34:56.78"), digits = 0), hms(57, 34, 12)) expect_equal(round_hms(parse_hms("12:34:36"), digits = -1), hms(40, 34, 12)) expect_equal(round_hms(parse_hms("12:34:56"), digits = -2), hms(0, 35, 12)) expect_equal(round_hms(parse_hms("12:34:56"), digits = -3), hms(0, 30, 12)) expect_equal(round_hms(parse_hms("12:34:56"), digits = -4), hms(0, 0, 13)) expect_equal(round_hms(parse_hms("12:34:56"), digits = -5), hms(0, 0, 10)) expect_equal(round_hms(parse_hms("12:34:56"), digits = -6), hms(0, 0, 0)) expect_equal(round_hms(hms(0.7), 0.25), hms(0.75)) expect_equal(round_hms(hms(NA), 5), hms(NA)) expect_equal(round_hms(parse_hms(c("12:34:56", NA)), 5), as_hms(c(hms(55, 34, 12), hms(NA)))) }) test_that("trunc_hms()", { expect_equal(trunc_hms(parse_hms("12:34:56"), 5), hms(55, 34, 12)) expect_equal(trunc_hms(parse_hms("12:34:56"), 60), hms(0, 34, 12)) expect_equal(trunc_hms(parse_hms("12:34:56.78"), digits = 1), hms(56.7, 34, 12)) expect_equal(trunc_hms(parse_hms("12:34:56.78"), digits = 0), hms(56, 34, 12)) expect_equal(trunc_hms(parse_hms("12:34:36"), digits = -1), hms(30, 34, 12)) expect_equal(trunc_hms(parse_hms("12:34:56"), digits = -2), hms(0, 34, 12)) expect_equal(trunc_hms(parse_hms("12:34:56"), digits = -3), hms(0, 30, 12)) expect_equal(trunc_hms(parse_hms("12:34:56"), digits = -4), hms(0, 0, 12)) expect_equal(trunc_hms(parse_hms("12:34:56"), digits = -5), hms(0, 0, 10)) expect_equal(trunc_hms(parse_hms("12:34:56"), digits = -6), hms(0, 0, 0)) expect_equal(trunc_hms(hms(0.7), 0.25), hms(0.5)) expect_equal(trunc_hms(hms(NA), 5), hms(NA)) expect_equal(trunc_hms(parse_hms(c("12:34:56", NA)), 5), as_hms(c(hms(55, 34, 12), hms(NA)))) }) hms/tests/testthat/test-output.R0000644000176200001440000000460014210206621016475 0ustar liggesuserstest_that("output", { expect_identical(format(hms()), "hms()") expect_identical(format(hms(1:2, minutes = c(0, 0), hours = 3:4)), c("03:00:01", "04:00:02")) expect_identical(format(hms(minutes = 1:-1)), c(" 00:01:00", " 00:00:00", "-00:01:00")) expect_output( expect_identical(print(hms(minutes = 1:2, hours = 3:4)), hms(minutes = 1:2, hours = 3:4)), "03:01:00\n04:02:00", fixed = TRUE) }) test_that("abbreviation", { expect_identical(vec_ptype_abbr(hms()), "time") expect_identical(vec_ptype_full(hms()), "time") }) test_that("beyond 24 hours (#12)", { expect_identical(format(hms(hours = 23:25)), c("23:00:00", "24:00:00", "25:00:00")) expect_identical(format(hms(hours = 99:101)), c(" 99:00:00", "100:00:00", "101:00:00")) expect_identical(format(hms(hours = c(-99, 100))), c("- 99:00:00", " 100:00:00")) expect_identical(format(hms(hours = c(-100, 99))), c("-100:00:00", " 99:00:00")) }) test_that("fractional seconds (#13)", { expect_identical(format(hms(0.1)), c("00:00:00.1")) expect_identical(format(hms(c(12, 0.3))), c("00:00:12.0", "00:00:00.3")) expect_identical(format(hms(c(0.1, 0.01))), c("00:00:00.10", "00:00:00.01")) expect_identical(format(hms(c(12, 0.3), minutes = c(0, 0), hours = c(345, 6))), c("345:00:12.0", " 06:00:00.3")) expect_identical(format(hms(c(-0.1, 0.1))), c("-00:00:00.1", " 00:00:00.1")) }) test_that("picoseconds (#17)", { expect_identical(format(hms(1e-6)), c("00:00:00.000001")) expect_identical(format(hms(9e-7)), c("00:00:00.000001")) expect_identical(format(hms(4e-7)), c("00:00:00.000000")) expect_identical(format(hms(1e-10)), c("00:00:00.000000")) expect_identical(format(hms(1e-20)), c("00:00:00.000000")) expect_identical(format(hms(c(1, 1e-20))), c("00:00:01.000000", "00:00:00.000000")) }) test_that("picoseconds to the next second (#140)", { expect_identical(format(hms(1 - 1e-6)), c("00:00:00.999999")) expect_identical(format(hms(1 - 9e-7)), c("00:00:00.999999")) expect_identical(format(hms(1 - 4e-7)), c("00:00:01.000000")) expect_identical(format(hms(1 - 1e-10)), c("00:00:01.000000")) expect_identical(format(hms(1 - 1e-10)), c("00:00:01.000000")) expect_identical(format(hms(1 - c(1, 1e-10))), c("00:00:00.000000", "00:00:01.000000")) }) test_that("NA", { expect_identical(format(hms(NA)), c("NA")) }) hms/tests/testthat/test-subset.R0000644000176200001440000000132614210206621016444 0ustar liggesuserstest_that("range subsetting keeps class", { expect_identical(hms(1:3)[2], hms(2)) expect_identical(hms(1:3)[2:3], hms(2:3)) }) test_that("range updating keeps class", { skip_if(packageVersion("vctrs") <= "0.1.0") x <- hms(1:3) x[2] <- hms(4) expect_identical(x, hms(c(1, 4, 3))) x <- hms(1:4) x[2:3] <- hms(5:6) expect_identical(x, hms(c(1, 5, 6, 4))) }) test_that("range updating warns if lossy cast", { skip_if(packageVersion("vctrs") <= "0.1.0") x <- hms(1:3) expect_error(x[2] <- "a") }) test_that("index subsetting keeps class", { expect_identical(hms(1:3)[[2]], hms(2)) }) test_that("index updating keeps class", { x <- hms(1:3) x[[2]] <- 4 expect_identical(x, hms(c(1, 4, 3))) }) hms/tests/testthat.R0000644000176200001440000000006214207763054014174 0ustar liggesuserslibrary(testthat) library(hms) test_check("hms") hms/R/0000755000176200001440000000000014406342760011250 5ustar liggesusershms/R/pillar.R0000644000176200001440000000374514207763054012671 0ustar liggesusers# Dynamically exported, see zzz.R pillar_shaft.hms <- function(x, ...) { data <- rep(NA_character_, length(x)) xx <- decompose(x) has_hours <- xx$hours > 0 highlight_hours <- has_hours highlighted <- highlight_hours has_minutes <- xx$minute_of_hour > 0 highlight_minutes <- !highlighted & has_minutes highlighted <- highlighted | highlight_minutes has_seconds <- xx$second_of_minute > 0 highlight_seconds <- !highlighted & has_seconds highlighted <- highlighted | highlight_seconds has_tics <- xx$tics > 0 highlight_tics <- !highlighted & has_tics need_tics <- any(has_tics, na.rm = TRUE) need_seconds <- need_tics || any(has_seconds, na.rm = TRUE) need_hours <- any(has_hours, na.rm = TRUE) need_sign <- any(xx$sign) if (need_hours) { data_seconds <- paste0( if (need_sign) ifelse(xx$sign, "-", " ") else "", pillar::style_num(format_hours(xx$hours), xx$sign, highlight_hours), pillar::style_subtle(":"), pillar::style_num(format_two_digits(xx$minute_of_hour), xx$sign, highlight_minutes), if (need_seconds) paste0( pillar::style_subtle(":"), pillar::style_num(format_two_digits(xx$second_of_minute), xx$sign, highlight_seconds) ) ) data <- paste0( data_seconds, if (need_seconds) { pillar::style_num(format_tics(xx$tics), xx$sign, highlight_tics) } ) } else { data_seconds <- paste0( if (need_sign) ifelse(xx$sign, "-", " ") else "", pillar::style_num(format_two_digits(xx$minute_of_hour), xx$sign, highlight_minutes), pillar::style_subtle("'"), pillar::style_num(format_two_digits(xx$second_of_minute), xx$sign, highlight_seconds) ) data <- paste0( data_seconds, pillar::style_num(format_tics(xx$tics), xx$sign, highlight_tics), pillar::style_subtle('"') ) } na_indent <- crayon::col_nchar(data_seconds[1], type = "width") - 2L data[is.na(x)] <- NA pillar::new_pillar_shaft_simple(data, na_indent = na_indent) } hms/R/parse.R0000644000176200001440000000152414207763054012511 0ustar liggesusers#' Parsing hms values #' #' @description #' These functions convert character vectors to objects of the [hms] class. #' `NA` values are supported. #' #' `parse_hms()` accepts values of the form `"HH:MM:SS"`, with optional #' fractional seconds. #' @param x A character vector #' @return An object of class [hms]. #' #' @export #' @examples #' parse_hms("12:34:56") #' parse_hms("12:34:56.789") parse_hms <- function(x) { as_hms(parse_time(x, format = "%H:%M:%OS")) } #' @rdname parse_hms #' @description #' `parse_hm()` accepts values of the form `"HH:MM"`. #' @export #' @examples #' parse_hm("12:34") parse_hm <- function(x) { as_hms(parse_time(x, format = "%H:%M")) } parse_time <- function(x, format) { difftime( strptime(as.character(x), format = format), strptime("0:0:0", format = "%X"), units = "secs", tz = "UTC" ) } hms/R/zzz.R0000644000176200001440000000042714207763054012235 0ustar liggesusers# nocov start .onLoad <- function(...) { vctrs::s3_register("pillar::pillar_shaft", "hms") if (utils::packageVersion("vctrs") <= "0.1.0") { vec_default_cast <<- vec_default_cast_old } else { rm("vec_default_cast", inherits = TRUE) } invisible() } # nocov end hms/R/args.R0000644000176200001440000000134514210206621012316 0ustar liggesuserscheck_args <- function(args) { is_null <- map_lgl(args, is.null) if (all(is_null)) return() valid <- map_lgl(args[!is_null], is_numeric_or_na) if (!all(valid)) { stop("All arguments must be numeric or NA", call. = FALSE) } if (!all(diff(which(!is_null)) == 1L)) { stop("Can't pass only ", paste(names(is_null)[!is_null], collapse = ", "), " to hms().", call. = FALSE) } lengths <- map_int(args[!is_null], length) if (length(unique(lengths)) > 1L) { stop("All arguments to hms() must have the same length or be NULL. Found ", paste0("length(", names(lengths), ") = ", lengths, collapse = ", "), ".", call. = FALSE) } } is_numeric_or_na <- function(x) { is.numeric(x) || all(is.na(x)) } hms/R/round.R0000644000176200001440000000314514210206621012511 0ustar liggesusers#' Round or truncate to a multiple of seconds #' #' Convenience functions to round or truncate to a multiple of seconds. #' @param x A vector of class [hms] #' @param secs Multiple of seconds, a positive numeric. Values less than one #' are supported #' @param digits Number of digits, a whole number. #' Negative numbers are supported. #' @return The input, rounded or truncated to the nearest multiple of `secs` #' (or number of `digits`) #' @export #' @examples #' round_hms(as_hms("12:34:56"), 5) #' round_hms(as_hms("12:34:56"), 60) #' round_hms(as_hms("12:34:56.78"), 0.25) #' round_hms(as_hms("12:34:56.78"), digits = 1) #' round_hms(as_hms("12:34:56.78"), digits = -2) round_hms <- function(x, secs = NULL, digits = NULL) { secs <- digits_to_secs(secs, digits) vec_restore(round(as.numeric(x) / secs) * secs, x) } #' @rdname round_hms #' @export #' @examples #' trunc_hms(as_hms("12:34:56"), 60) trunc_hms <- function(x, secs = NULL, digits = NULL) { secs <- digits_to_secs(secs, digits) vec_restore(trunc(as.numeric(x) / secs) * secs, x) } digits_to_secs <- function(secs, digits) { if (is.null(digits)) { if (is.null(secs)) { abort("Exactly one of `secs` or `digits` is required.") } return(secs) } if (!is.null(secs)) { abort("Exactly one of `secs` or `digits` is required.") } if (!is_integerish(digits)) { abort("`digits` must be a whole number") } if (digits >= -1) { secs <- 10^-digits } else if (digits == -2) { secs <- 60 } else if (digits == -3) { secs <- 600 } else if (digits <= -4) { secs <- 3600 * (10^(-digits - 4)) } secs } hms/R/arith.R0000644000176200001440000000237114207763054012507 0ustar liggesusersSPLIT_SECOND_DIGITS <- 6L TICS_PER_SECOND <- 10^SPLIT_SECOND_DIGITS SECONDS_PER_MINUTE <- 60 MINUTES_PER_HOUR <- 60 HOURS_PER_DAY <- 24 TICS_PER_MINUTE <- SECONDS_PER_MINUTE * TICS_PER_SECOND TICS_PER_HOUR <- MINUTES_PER_HOUR * TICS_PER_MINUTE TICS_PER_DAY <- HOURS_PER_DAY * TICS_PER_HOUR days <- function(x) { trunc(x / TICS_PER_DAY) } hours <- function(x) { trunc(x / TICS_PER_HOUR) } hour_of_day <- function(x) { abs(hours(x) - days(x) * HOURS_PER_DAY) } minutes <- function(x) { trunc(x / TICS_PER_MINUTE) } minute_of_hour <- function(x) { abs(minutes(x) - hours(x) * MINUTES_PER_HOUR) } seconds <- function(x) { trunc(x / TICS_PER_SECOND) } second_of_minute <- function(x) { abs(seconds(x) - minutes(x) * SECONDS_PER_MINUTE) } tics <- function(x) { x } tic_of_second <- function(x) { abs(tics(x) - seconds(x) * TICS_PER_SECOND) } decompose <- function(x) { x <- vec_data(x) * TICS_PER_SECOND # #140 xr <- round(x) out <- list( sign = xr < 0 & !is.na(xr), hours = abs(hours(xr)), minute_of_hour = minute_of_hour(xr), second_of_minute = second_of_minute(xr), tics = tic_of_second(xr) ) # #140: Make sure zeros are printed fake_zero <- (out$tics == 0) & (xr != x) out$tics[fake_zero] <- 0.25 out } hms/R/cast.R0000644000176200001440000000557114365650370012340 0ustar liggesusers#' Casting #' #' Double dispatch methods to support [vctrs::vec_cast()]. #' #' @inheritParams vctrs::vec_cast #' #' @method vec_cast hms #' @export #' @export vec_cast.hms vec_cast.hms <- function(x, to, ...) UseMethod("vec_cast.hms") #' @method vec_cast.hms default #' @export vec_cast.hms.default <- function(x, to, ...) vec_default_cast(x, to, ...) #' @method vec_cast.hms hms #' @export vec_cast.hms.hms <- function(x, to, ...) x #' @method vec_cast.hms difftime #' @export vec_cast.hms.difftime <- function(x, to, ...) { units(x) <- "secs" new_hms(as.numeric(vec_data(x))) } #' @method vec_cast.difftime hms #' @export vec_cast.difftime.hms <- function(x, to, ...) { # as.difftime() doesn't change the class class(x) <- "difftime" vec_cast(x, to, ...) } #' @method vec_cast.hms POSIXct #' @export vec_cast.hms.POSIXct <- function(x, to, ...) { vec_cast(as.POSIXlt(x), to) } #' @method vec_cast.POSIXct hms #' @export vec_cast.POSIXct.hms <- function(x, to, ...) { structure(as.numeric(x), tzone = "UTC", class = c("POSIXct", "POSIXt")) } #' @method vec_cast.hms POSIXlt #' @export vec_cast.hms.POSIXlt <- function(x, to, ...) { hms(x$sec, x$min, x$hour) } #' @method vec_cast.POSIXlt hms #' @export vec_cast.POSIXlt.hms <- function(x, to, ...) { as.POSIXlt(vec_cast(x, new_datetime())) } #' @method vec_cast.hms double #' @export vec_cast.hms.double <- function(x, to, ...) new_hms(x) #' @method vec_cast.double hms #' @export vec_cast.double.hms <- function(x, to, ...) vec_data(x) #' @method vec_cast.hms integer #' @export vec_cast.hms.integer <- function(x, to, ...) new_hms(as.numeric(x)) #' @method vec_cast.integer hms #' @export vec_cast.integer.hms <- function(x, to, ...) as.integer(vec_data(x)) #' @method vec_cast.hms character #' @export vec_cast.hms.character <- function(x, to, ...) { ret <- parse_hms(x) lossy <- is.na(ret) & !is.na(x) abort_lossy_cast(x, to, ..., lossy = lossy) ret } #' @method vec_cast.character hms #' @export vec_cast.character.hms <- function(x, to, ...) format_hms(x) # Requires vctrs > 0.1.0 vec_default_cast <- NULL utils::globalVariables("vec_unspecified_cast") vec_default_cast_old <- function(x, to, ...) { if (is.logical(x)) { vec_unspecified_cast(x, to, ...) } else { stop_incompatible_cast(x, to, ...) } } abort_lossy_cast <- function(x, to, ..., lossy) { problems <- which(lossy) if (is_empty(problems)) return() abort( paste0("Lossy cast from to at position(s) ", commas(problems)) ) } commas <- function(problems) { MAX_BULLETS <- 6L if (length(problems) >= MAX_BULLETS) { n_more <- length(problems) - MAX_BULLETS + 1L problems[[MAX_BULLETS]] <- paste0(pre_dots("(and "), n_more, " more)") length(problems) <- MAX_BULLETS } paste0(problems, collapse = ", ") } pre_dots <- function(x) { if (length(x) > 0) { paste0("... ", x) } else { character() } } hms/R/hms.R0000644000176200001440000001463314406342760012171 0ustar liggesusers#' @details #' `r lifecycle::badge("stable")` #' @importFrom lifecycle deprecate_soft expect_deprecated #' @import vctrs #' @import rlang #' @aliases hms-package NULL "_PACKAGE" #' @importFrom methods setOldClass setOldClass(c("hms", "difftime")) #' A simple class for storing time-of-day values #' #' The values are stored as a [difftime] vector with a custom class, #' and always with "seconds" as unit for robust coercion to numeric. #' Supports construction from time values, coercion to and from #' various data types, and formatting. Can be used as a regular column in a #' data frame. #' #' @name hms #' @examples #' hms(56, 34, 12) #' hms() #' #' new_hms(as.numeric(1:3)) #' # Supports numeric only! #' try(new_hms(1:3)) #' #' as_hms(1) #' as_hms("12:34:56") #' as_hms(Sys.time()) #' as.POSIXct(hms(1)) #' data.frame(a = hms(1)) #' d <- data.frame(hours = 1:3) #' d$hours <- hms(hours = d$hours) #' d NULL # Construction ------------------------------------------------------------ #' hms() #' #' `hms()` is a high-level constructor that accepts second, minute, hour and day components #' as numeric vectors. #' #' @rdname hms #' @details For `hms()`, all arguments must have the same length or be #' `NULL`. Odd combinations (e.g., passing only `seconds` and #' `hours` but not `minutes`) are rejected. #' @param seconds,minutes,hours,days Time since midnight. No bounds checking is #' performed. #' @export hms <- function(seconds = NULL, minutes = NULL, hours = NULL, days = NULL) { args <- list(seconds = seconds, minutes = minutes, hours = hours, days = days) check_args(args) arg_secs <- map2(args, c(1, 60, 3600, 86400), `*`) secs <- reduce(arg_secs[!map_lgl(args, is.null)], `+`) if (is.null(secs)) secs <- numeric() new_hms(as.numeric(secs)) } #' new_hms() #' #' `new_hms()` is a low-level constructor that only checks that its input has the correct base type, [numeric]. #' #' @rdname hms #' @export new_hms <- function(x = numeric()) { vec_assert(x, numeric()) out <- new_duration(x, units = "secs") # no class argument? class(out) <- c("hms", class(out)) out } #' is_hms() #' #' `is_hms()` checks if an object is of class `hms`. #' #' @rdname hms #' @export is_hms <- function(x) inherits(x, "hms") #' Deprecated functions #' #' @name Deprecated NULL #' Deprecated is.hms() #' #' `is.hms()` has been replaced by [is_hms()]. #' #' @inheritParams is_hms #' @rdname Deprecated #' @export #' @keywords internal is.hms <- function(x) { deprecate_soft("0.5.0", "hms::is.hms()", "hms::is_hms()") is_hms(x) } #' @export vec_ptype_abbr.hms <- function(x, ...) { "time" } #' @export vec_ptype_full.hms <- function(x, ...) { "time" } # Coercion in ------------------------------------------------------------- #' as_hms() #' #' `as_hms()` is a generic that supports conversions beyond casting. #' The default method forwards to [vec_cast()]. #' #' For arguments of type [POSIXct] and [POSIXlt], `as_hms()` does not perform timezone #' conversion. #' Use [lubridate::with_tz()] and [lubridate::force_tz()] as necessary. #' #' @rdname hms #' @param x An object. #' @export as_hms <- function(x, ...) { check_dots_used() UseMethod("as_hms") } #' @export as_hms.default <- function(x, ...) { vec_cast(x, new_hms()) } #' Deprecated as.hms() #' #' `as.hms()` has been replaced by [as_hms()], which does not have a `tz` argument. #' Change the timezone before converting if necessary, e.g. using [lubridate::with_tz()]. #' #' @inheritParams as_hms #' @param ... Arguments passed on to further methods. #' @rdname Deprecated #' @export #' @keywords internal as.hms <- function(x, ...) { deprecate_soft("0.5.0", "hms::as.hms()", "hms::as_hms()") UseMethod("as.hms", x) } #' @rdname Deprecated #' @export as.hms.default <- function(x, ...) { as_hms(x) } #' @rdname Deprecated #' @param tz The time zone in which to interpret a POSIXt time for extracting #' the time of day. The default is now the zone of `x` but was `"UTC"` #' for v0.3 and earlier. The previous behavior can be restored by calling #' `pkgconfig::set_config("hms::default_tz", "UTC")`, see #' [pkgconfig::set_config()]. #' @export #' @importFrom pkgconfig get_config as.hms.POSIXt <- function(x, tz = pkgconfig::get_config("hms::default_tz", ""), ...) { time <- as.POSIXlt(x, tz = tz) vec_cast(time, new_hms()) } #' @rdname Deprecated #' @export as.hms.POSIXlt <- function(x, tz = pkgconfig::get_config("hms::default_tz", ""), ...) { # We need to roundtrip via as.POSIXct() to respect the time zone time <- as.POSIXlt(as.POSIXct(x), tz = tz) vec_cast(time, new_hms()) } # Coercion out ------------------------------------------------------------ #' @rdname hms #' @inheritParams base::as.data.frame #' @export as.POSIXct.hms <- function(x, ...) { vec_cast(x, new_datetime()) } #' @rdname hms #' @export as.POSIXlt.hms <- function(x, ...) { vec_cast(x, as.POSIXlt(new_datetime())) } #' @rdname hms #' @export as.character.hms <- function(x, ...) { vec_cast(x, character()) } format_hms <- function(x) { xx <- decompose(x) ifelse(is.na(x), NA_character_, paste0( ifelse(xx$sign, "-", ""), format_hours(xx$hours), ":", format_two_digits(xx$minute_of_hour), ":", format_two_digits(xx$second_of_minute), format_tics(xx$tics))) } # Subsetting -------------------------------------------------------------- #' @export `[[.hms` <- function(x, ...) { vec_restore(NextMethod(), x) } #' @export `[<-.hms` <- function(x, i, value) { if (missing(i)) { i <- TRUE } x <- vec_data(x) # Workaround for Ops.difftime() implementation for unary minus if (identical(class(value), "numeric")) { attr(value, "units") <- NULL } value <- vec_cast(value, new_hms()) x[i] <- vec_data(value) new_hms(x) } # Combination ------------------------------------------------------------- #' @export c.hms <- function(x, ...) { # Needed to override c.difftime() vec_c(x, ...) } # Updating ---------------------------------------------------------------- #' @export `units<-.hms` <- function(x, value) { if (!identical(value, "secs")) { warning("hms always uses seconds as unit.", call. = FALSE) } x } # Output ------------------------------------------------------------------ #' @rdname hms #' @export format.hms <- function(x, ...) { if (length(x) == 0L) { "hms()" } else { format(as.character(x), justify = "right") } } #' @rdname hms #' @export print.hms <- function(x, ...) { cat(format(x), sep = "\n") invisible(x) } hms/R/unique.R0000644000176200001440000000023414207763054012702 0ustar liggesusers#' @export unique.hms <- function(x, incomparables = FALSE, ...) { x <- as.numeric(x) x <- unique(x, incomparables = incomparables, ...) new_hms(x) } hms/R/coerce.R0000644000176200001440000000136214207763054012637 0ustar liggesusers#' Coercion #' #' Double dispatch methods to support [vctrs::vec_ptype2()]. #' #' @inheritParams vctrs::vec_ptype2 #' #' @method vec_ptype2 hms #' @export #' @export vec_ptype2.hms vec_ptype2.hms <- function(x, y, ..., x_arg = "", y_arg = "") UseMethod("vec_ptype2.hms", y) #' @method vec_ptype2.hms default #' @export vec_ptype2.hms.default <- function(x, y, ..., x_arg = "", y_arg = "") { vec_default_ptype2(x, y, x_arg = x_arg, y_arg = y_arg) } #' @method vec_ptype2.hms hms #' @export vec_ptype2.hms.hms <- function(x, y, ...) hms::hms() #' @method vec_ptype2.difftime hms #' @export vec_ptype2.difftime.hms <- function(x, y, ...) new_hms() #' @method vec_ptype2.hms difftime #' @export vec_ptype2.hms.difftime <- function(x, y, ...) new_hms() hms/R/compat-purrr.R0000644000176200001440000000723414207763054014036 0ustar liggesusers# nocov start - compat-purrr (last updated: rlang 0.1.9000) # This file serves as a reference for compatibility functions for # purrr. They are not drop-in replacements but allow a similar style # of programming. This is useful in cases where purrr is too heavy a # package to depend on. Please find the most recent version in rlang's # repository. map <- function(.x, .f, ...) { lapply(.x, .f, ...) } map_mold <- function(.x, .f, .mold, ...) { out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE) names(out) <- names(.x) out } map_lgl <- function(.x, .f, ...) { map_mold(.x, .f, logical(1), ...) } map_int <- function(.x, .f, ...) { map_mold(.x, .f, integer(1), ...) } map_dbl <- function(.x, .f, ...) { map_mold(.x, .f, double(1), ...) } map_chr <- function(.x, .f, ...) { map_mold(.x, .f, character(1), ...) } map_cpl <- function(.x, .f, ...) { map_mold(.x, .f, complex(1), ...) } pluck <- function(.x, .f) { map(.x, `[[`, .f) } pluck_lgl <- function(.x, .f) { map_lgl(.x, `[[`, .f) } pluck_int <- function(.x, .f) { map_int(.x, `[[`, .f) } pluck_dbl <- function(.x, .f) { map_dbl(.x, `[[`, .f) } pluck_chr <- function(.x, .f) { map_chr(.x, `[[`, .f) } pluck_cpl <- function(.x, .f) { map_cpl(.x, `[[`, .f) } map2 <- function(.x, .y, .f, ...) { Map(.f, .x, .y, ...) } map2_lgl <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "logical") } map2_int <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "integer") } map2_dbl <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "double") } map2_chr <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "character") } map2_cpl <- function(.x, .y, .f, ...) { as.vector(map2(.x, .y, .f, ...), "complex") } args_recycle <- function(args) { lengths <- map_int(args, length) n <- max(lengths) stopifnot(all(lengths == 1L | lengths == n)) to_recycle <- lengths == 1L args[to_recycle] <- map(args[to_recycle], function(x) rep.int(x, n)) args } pmap <- function(.l, .f, ...) { args <- args_recycle(.l) do.call("mapply", c( FUN = list(quote(.f)), args, MoreArgs = quote(list(...)), SIMPLIFY = FALSE, USE.NAMES = FALSE )) } probe <- function(.x, .p, ...) { if (is_logical(.p)) { stopifnot(length(.p) == length(.x)) .p } else { map_lgl(.x, .p, ...) } } keep <- function(.x, .f, ...) { .x[probe(.x, .f, ...)] } discard <- function(.x, .p, ...) { sel <- probe(.x, .p, ...) .x[is.na(sel) | !sel] } map_if <- function(.x, .p, .f, ...) { matches <- probe(.x, .p) .x[matches] <- map(.x[matches], .f, ...) .x } compact <- function(.x) { Filter(length, .x) } transpose <- function(.l) { inner_names <- names(.l[[1]]) if (is.null(inner_names)) { fields <- seq_along(.l[[1]]) } else { fields <- set_names(inner_names) } map(fields, function(i) { map(.l, .subset2, i) }) } every <- function(.x, .p, ...) { for (i in seq_along(.x)) { if (!rlang::is_true(.p(.x[[i]], ...))) return(FALSE) } TRUE } some <- function(.x, .p, ...) { for (i in seq_along(.x)) { if (rlang::is_true(.p(.x[[i]], ...))) return(TRUE) } FALSE } negate <- function(.p) { function(...) !.p(...) } reduce <- function(.x, .f, ..., .init) { f <- function(x, y) .f(x, y, ...) Reduce(f, .x, init = .init) } reduce_right <- function(.x, .f, ..., .init) { f <- function(x, y) .f(y, x, ...) Reduce(f, .x, init = .init, right = TRUE) } accumulate <- function(.x, .f, ..., .init) { f <- function(x, y) .f(x, y, ...) Reduce(f, .x, init = .init, accumulate = TRUE) } accumulate_right <- function(.x, .f, ..., .init) { f <- function(x, y) .f(y, x, ...) Reduce(f, .x, init = .init, right = TRUE, accumulate = TRUE) } # nocov end hms/R/format.R0000644000176200001440000000070714207763054012671 0ustar liggesusersformat_hours <- function(x) { format(format_two_digits(x), justify = "right") } format_two_digits <- function(x) { formatC(x, format = "f", digits = 0, width = 2, flag = "0") } format_tics <- function(x) { x <- x / TICS_PER_SECOND out <- format(x, scientific = FALSE, digits = SPLIT_SECOND_DIGITS + 1L) digits <- max(min(max(nchar(out) - 2), SPLIT_SECOND_DIGITS), 0) out <- formatC(x, format = "f", digits = digits) gsub("^0", "", out) } hms/NEWS.md0000644000176200001440000001400514406360246012144 0ustar liggesusers # hms 1.1.3 ## Bug fixes - Fix method consistency, checked by R-devel. ## Internal - Use rlang instead of ellipsis (#106). # hms 1.1.2 - Re-rendered documentation for compatibility with R-devel. # hms 1.1.1 - Avoid blanket import for lifecycle package for compatibility with upcoming rlang. - Establish compatibility with development version of testthat (#101, @lionel-). # hms 1.1.0 ## Breaking changes - `"hms"` objects no longer have a common type with `character` and `numeric`. Combining such values previously threw a warning, now throws an error (#94). - `vec_cast()` and `as_hms()` throw error instead of a warning if input can't be parsed (#68). ## Features - New `unique.hms()` method (#98, @joethorley). - `as_hms()` is a generic again (#81). ## Internal - Avoid `LazyData` in `DESCRIPTION`. - Bump required versions of ellipsis and vctrs to avoid warning during package load. - Using lifecycle package (#94). # hms 1.0.0 ## Life cycle - hms is now marked as "stable". ## Breaking changes - `"hms"` objects no longer have a common type with `character` and `numeric`. Combining such values previously threw a warning, now throws an error (#94). - `vec_cast()` and `as_hms()` now throw error instead of a warning if input can't be parsed (#68). ## Features - `as_hms()` is a generic again (#81). - `round_hms()` and `trunc_hms()` gain `digits` argument (#78, @hglanz). ## Bug fixes - `as_hms()` and `vec_cast()` now correctly treat objects of class `"difftime"` with `integer` mode (#84). ## Internal - Using lifecycle package (#94). - hms has been re-licensed as MIT (#86). # hms 0.5.3 - Use `vec_default_ptype2()`, remove `vec_ptype2.hms.unspecified()` (#80, @romainfrancois). - `vec_ptype2.hms.default()` forwards to `vec_default_ptype2()` for compatibility with vctrs 0.2.1. - Remove `as.data.frame.hms()`, handeld by vctrs. # hms 0.5.2.9000 - Internal changes only. # hms 0.5.2 - Work around parsing error that occurs on DST changeover dates (https://bugs.r-project.org/bugzilla/show_bug.cgi?id=16764). # hms 0.5.1 - Lossy casts from `character` vectors to `hms` now also trigger a warning if the cast succeeds in the first element of the vector but fails for other elements. # hms 0.5.0 ## Breaking changes - Now based on vctrs >= 0.2.0 (#61). This adds support for `vec_cast()` and `vec_ptype2()`. Some operations (such as subset assignment) are now stricter. The `new_hms()` constructor permits safe construction of `hms` objects from a numeric vector. - The new `is_hms()` deprecates the existing `is.hms()`. `as.hms()` is deprecated in favor of `vec_cast()` or the new `as_hms()` (which is just a thin wrapper around `vec_cast()`). ## Printing - Always show seconds in a pillar if they are different from zero (#54). - Values with nonzero hours, seconds and split-seconds are now displayed correctly in tibbles (#56), even with a very small distance to the full second (#64). ## Internal - Don't test colored output on CRAN. - Correct reference link on r4ds (#58, @evanhaldane). # hms 0.4.2 - Adapted tests to pillar 1.2.1. # hms 0.4.1 - Preserve `NA` when converting to `character` (#51, @jeroen). - Adapted tests to pillar 1.1.0. # hms 0.4.0 ## Breaking changes - `as.hms.POSIXt()` now defaults to the current time zone, the previous default was `"UTC"` and can be restored by calling `pkgconfig::set_config("hms::default_tz", "UTC")`. ## New features - Pillar support, will display `hms` columns in tibbles in color on terminals that support it (#43). - New `round_hms()` and `trunc_hms()` for rounding or truncating to a given multiple of seconds (#31). - New `parse_hms()` and `parse_hm()` to parse strings in "HH:MM:SS" and "HH:MM" formats (#30). - `as.hms.POSIXt()` gains `tz` argument, default `"UTC"` (#28). - `as.hms.character()` and `parse_hms()` accept fractional seconds (#33). ## Bug fixes - `hms()` now works correctly if all four components (days, hours, minutes, seconds) are passed (#49). - `hms()` creates a zero-length object of class `hms` that prints as `"hms()"`. - `hms(integer())` and `as.hms(integer())` both work and are identical to `hms()`. - Values with durations of over 10000 hours are now printed correctly (#48). - `c()` now returns a hms (#41, @qgeissmann). ## Documentation and error messages - Fix and enhance examples in `?hms`. - Documentation is in Markdown format now. - Improved error message if calling `hms()` with a character argument (#29). # hms 0.3 - Fix `lubridate` test for compatibility with 1.6.0 (#23, @vspinu). - NA values are formatted as `NA` (#22). # hms 0.2 Minor fixes and improvements. - Subsetting keeps `hms` class (#16). - `format.hms()` right-justifies the output by padding with spaces from the left, `as.character.hms()` remains unchanged. - Times larger than 24 hours or with split seconds are now formatted correctly (#12, #13). - Sub-second part is printed with up to six digits, for even smaller values trailing zeros are shown (#17). # hms 0.1 First CRAN release. - Values are stored as a numeric vector that contains the number of seconds since midnight. - Inherits from `difftime` class. - Updating units is a no-op, anything different from `"secs"` issues a warning. - Supports construction from time values, coercion to and from various data types, and formatting. - Conversion from numeric treats input as seconds. - Negative times are formatted with a leading `-`. - Can be used as a regular column in a data frame. - Full test coverage. - Test for arithmetic with `Date`, `POSIXt` and `hms` classes. - Test basic compatibility with `lubridate` package (#5). - Interface: - `hms()` (with rigorous argument checks) - `as.hms()` for `character`, `numeric`, `POSIXct` and `POSIXlt` - `as.xxx.hms()` for `character`, `numeric` (implicitly), `POSIXct` and `POSIXlt` - `is.hms()` - `as.data.frame.hms()` (forwards to `as.data.frame.difftime()`) - `format.hms()` - `print.hms()` (returns unchanged input invisibly) hms/MD50000644000176200001440000000531014406371372011357 0ustar liggesusers783a6d28fab813054cf32cfaf80438e5 *DESCRIPTION 95270f4d7dead91c4d44e63964b8ae2b *LICENSE 1f1143f0af6343f5b3d12a41533687fd *NAMESPACE 26a65376c46d39397f804a4b371d942d *NEWS.md 5de8a459c31bf1228ecd322ce30647c7 *R/args.R 35756eeba709476e300eaecf69e6b3cb *R/arith.R d7d5733aac1db7ddb371ec799ce3d37d *R/cast.R dacc78a1a6c36ffaf9cbcd3f6b3f38a9 *R/coerce.R feaa904f11d6970ddbc1057a30cf6610 *R/compat-purrr.R 364d7cd8c0547a6e667966d1e1d950e7 *R/format.R dcbe9d041ff8d117faa621e777cf388a *R/hms.R d336dd6270984e6550cb9330d1ec0d66 *R/parse.R 908ff8ac532c2bd7e0e9dfa94ee27f19 *R/pillar.R 1e7dfdfc93c9256f1173792785a820b3 *R/round.R 1340c06ea14c7a012dfaa9cdb7b55910 *R/unique.R eb3cb013a475f35265e3e2ce3ad2412e *R/zzz.R 54a607f1e357cbf704c10686e09ec6ce *README.md eea4a86bcef6bf090b45b3041e78e1b5 *man/Deprecated.Rd cb1e46f469cfbbbde29c8b5113e1d789 *man/figures/lifecycle-archived.svg c0d2e5a54f1fa4ff02bf9533079dd1f7 *man/figures/lifecycle-defunct.svg a1b8c987c676c16af790f563f96cbb1f *man/figures/lifecycle-deprecated.svg c3978703d8f40f2679795335715e98f4 *man/figures/lifecycle-experimental.svg 952b59dc07b171b97d5d982924244f61 *man/figures/lifecycle-maturing.svg 27b879bf3677ea76e3991d56ab324081 *man/figures/lifecycle-questioning.svg 6902bbfaf963fbc4ed98b86bda80caa2 *man/figures/lifecycle-soft-deprecated.svg 53b3f893324260b737b3c46ed2a0e643 *man/figures/lifecycle-stable.svg 3d561da75ad64e93abc817f5be07e6cf *man/figures/logo.png 4d613b55ebb3329a2341bee8d9a834a4 *man/hms-package.Rd f035ddbfcd616210bbacd07f0c10d7b7 *man/hms.Rd b55df4864cedf621d12c2dca628477a1 *man/parse_hms.Rd 0e11933eb922f7cb863c281a5f9a6203 *man/round_hms.Rd 69698e7bc7bded0edd8d1ab174c89878 *man/vec_cast.hms.Rd 74339870a62c003e392adc9e5e70af6d *man/vec_ptype2.hms.Rd 929afdb21c50685048246bdc5d82207d *tests/testthat.R 6584d6529943f0cc1c83c7b3d517e87a *tests/testthat/_snaps/colformat.md 08300697749ea9be5f1722184785fa81 *tests/testthat/helper-compare.R af3ba595160e6734efb68283171a7dd1 *tests/testthat/test-arith.R a2d233ab933c5f9187f215bc14c41478 *tests/testthat/test-coercion-deprecated.R e5a666be35224066f665c858bc27667b *tests/testthat/test-coercion.R d78ad837899a149c5786d17d1667ac8a *tests/testthat/test-colformat.R 251766b82ffc056304035adcfd16b92f *tests/testthat/test-combine.R 19e020b8aa98813371cb025199b42121 *tests/testthat/test-construct.R b1a783ddafde09671859f5e082e68965 *tests/testthat/test-lubridate.R f3f66106aa2bb7cafe331c659004d147 *tests/testthat/test-output.R e63a890e29b8fbe96d77b893b88e75e1 *tests/testthat/test-parse.R 48db96b9a31790a3af8a4057fdbc2792 *tests/testthat/test-round.R 81f42f8f14f3119f2bdf20853f6b810f *tests/testthat/test-subset.R 70976f60fd8284be4157ca0aa8776241 *tests/testthat/test-unique.R f574213c459919bab0007bb894221f29 *tests/testthat/test-update.R