hms/0000755000176200001440000000000014124146222011037 5ustar liggesusershms/NAMESPACE0000644000176200001440000000261714124140353012263 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(ellipsis) import(rlang) import(vctrs) importFrom(lifecycle,deprecate_soft) importFrom(lifecycle,expect_deprecated) importFrom(methods,setOldClass) importFrom(pkgconfig,get_config) hms/LICENSE0000644000176200001440000000005114124140353012037 0ustar liggesusersYEAR: 2020 COPYRIGHT HOLDER: hms authors hms/README.md0000644000176200001440000001436614124140353012327 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](https://codecov.io/gh/tidyverse/hms/branch/master/graph/badge.svg)](https://codecov.io/gh/tidyverse/hms) [![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/0000755000176200001440000000000014124140353011611 5ustar liggesusershms/man/vec_cast.hms.Rd0000644000176200001440000000113514124140353014455 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.Rd0000644000176200001440000000160114124140353014256 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: align='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{krlmlr+r@mailbox.org} Other contributors: \itemize{ \item R Consortium [funder] \item RStudio [funder] } } hms/man/hms.Rd0000644000176200001440000000426614124140353012677 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.Rd0000644000176200001440000000160114124140353014744 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}{Vector types.} \item{y}{Vector types.} \item{...}{These dots are for future extensions and must be empty.} \item{x_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:vctrs-conditions]{stop_incompatible_type()}}).} \item{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:vctrs-conditions]{stop_incompatible_type()}}).} } \description{ Double dispatch methods to support \code{\link[vctrs:vec_ptype2]{vctrs::vec_ptype2()}}. } hms/man/round_hms.Rd0000644000176200001440000000166314124140353014104 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.Rd0000644000176200001440000000235414124140353014144 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/0000755000176200001440000000000014124140353013255 5ustar liggesusershms/man/figures/lifecycle-defunct.svg0000644000176200001440000000170414124140353017365 0ustar liggesuserslifecyclelifecycledefunctdefunct hms/man/figures/lifecycle-maturing.svg0000644000176200001440000000170614124140353017565 0ustar liggesuserslifecyclelifecyclematuringmaturing hms/man/figures/logo.png0000644000176200001440000005277214124140353014740 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.svg0000644000176200001440000000170714124140353017525 0ustar liggesusers lifecyclelifecyclearchivedarchived hms/man/figures/lifecycle-soft-deprecated.svg0000644000176200001440000000172614124140353021012 0ustar liggesuserslifecyclelifecyclesoft-deprecatedsoft-deprecated hms/man/figures/lifecycle-questioning.svg0000644000176200001440000000171414124140353020303 0ustar liggesuserslifecyclelifecyclequestioningquestioning hms/man/figures/lifecycle-stable.svg0000644000176200001440000000167414124140353017215 0ustar liggesuserslifecyclelifecyclestablestable hms/man/figures/lifecycle-experimental.svg0000644000176200001440000000171614124140353020435 0ustar liggesuserslifecyclelifecycleexperimentalexperimental hms/man/figures/lifecycle-deprecated.svg0000644000176200001440000000171214124140353020034 0ustar liggesuserslifecyclelifecycledeprecateddeprecated hms/man/parse_hms.Rd0000644000176200001440000000121414124140353014057 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/DESCRIPTION0000644000176200001440000000173614124146222012554 0ustar liggesusersPackage: hms Title: Pretty Time of Day Date: 2021-09-26 Version: 1.1.1 Authors@R: c( person("Kirill", "Müller", role = c("aut", "cre"), email = "krlmlr+r@mailbox.org"), 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: ellipsis (>= 0.3.2), lifecycle, methods, pkgconfig, rlang, 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.1.2 Config/testthat/edition: 3 NeedsCompilation: no Packaged: 2021-09-26 19:14:12 UTC; kirill Author: Kirill Müller [aut, cre], R Consortium [fnd], RStudio [fnd] Maintainer: Kirill Müller Repository: CRAN Date/Publication: 2021-09-26 19:40:02 UTC hms/tests/0000755000176200001440000000000014124140353012200 5ustar liggesusershms/tests/testthat/0000755000176200001440000000000014124146222014041 5ustar liggesusershms/tests/testthat/test-lubridate.R0000644000176200001440000000111414124140353017110 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.R0000644000176200001440000000314514124140353017167 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.R0000644000176200001440000000047014124140353017067 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.R0000644000176200001440000000071414124140353016254 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.R0000644000176200001440000000143514124140353016557 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.R0000644000176200001440000000264014124140353016251 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.R0000644000176200001440000000321314124140353021036 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.R0000644000176200001440000000061014124140353016443 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.R0000644000176200001440000000052214124140353017125 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.R0000644000176200001440000000350614124140353016745 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.R0000644000176200001440000000040514124140353016421 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/0000755000176200001440000000000014124140353015323 5ustar liggesusershms/tests/testthat/_snaps/colformat.md0000644000176200001440000000230214124140353017630 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.R0000644000176200001440000000371014124140353016270 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.R0000644000176200001440000000536714124140353016513 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.R0000644000176200001440000000131714124140353016447 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.R0000644000176200001440000000006214124140353014161 0ustar liggesuserslibrary(testthat) library(hms) test_check("hms") hms/R/0000755000176200001440000000000014124140353011237 5ustar liggesusershms/R/pillar.R0000644000176200001440000000374514124140353012656 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.R0000644000176200001440000000152414124140353012476 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.R0000644000176200001440000000042714124140353012222 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.R0000644000176200001440000000135614124140353012323 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.R0000644000176200001440000000315014124140353012510 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.R0000644000176200001440000000237114124140353012474 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.R0000644000176200001440000000557114124140353012324 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.R0000644000176200001440000001464314124140353012161 0ustar liggesusers#' @details #' `r lifecycle::badge("stable")` #' @importFrom lifecycle deprecate_soft expect_deprecated #' @import vctrs #' @import rlang #' @import ellipsis #' @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.R0000644000176200001440000000023414124140353012667 0ustar liggesusers#' @export unique.hms <- function(x, incomparables = FALSE, ...) { x <- as.numeric(x) x <- unique(x, incomparables = incomparables, ...) new_hms(x) } hms/R/coerce.R0000644000176200001440000000136214124140353012624 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.R0000644000176200001440000000723414124140353014023 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.R0000644000176200001440000000070714124140353012656 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.md0000644000176200001440000001344414124143134012142 0ustar liggesusers # 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/MD50000644000176200001440000000531014124146222011346 0ustar liggesusers64f760130ce2cd91861b65c357421cfc *DESCRIPTION 95270f4d7dead91c4d44e63964b8ae2b *LICENSE b57d564940297c12bcce8f7f77b6f78a *NAMESPACE ed4df44cfea457d716feec4f4da94381 *NEWS.md 1fee82e810be4583b57360d2f66e1ee3 *R/args.R 35756eeba709476e300eaecf69e6b3cb *R/arith.R d7d5733aac1db7ddb371ec799ce3d37d *R/cast.R dacc78a1a6c36ffaf9cbcd3f6b3f38a9 *R/coerce.R feaa904f11d6970ddbc1057a30cf6610 *R/compat-purrr.R 364d7cd8c0547a6e667966d1e1d950e7 *R/format.R 73eb3c93ac3ae7332d170f86c3f42ec5 *R/hms.R d336dd6270984e6550cb9330d1ec0d66 *R/parse.R 908ff8ac532c2bd7e0e9dfa94ee27f19 *R/pillar.R 303d057f7b463ef4244850538ea467b6 *R/round.R 1340c06ea14c7a012dfaa9cdb7b55910 *R/unique.R eb3cb013a475f35265e3e2ce3ad2412e *R/zzz.R 09dff77589274d6b0c218091818e48d3 *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 019d56d56b7d775d74c64b5b474bbed7 *man/hms-package.Rd 8d6e1ce54db4b4187ad9b8dcd96e4173 *man/hms.Rd b55df4864cedf621d12c2dca628477a1 *man/parse_hms.Rd 0e11933eb922f7cb863c281a5f9a6203 *man/round_hms.Rd 69698e7bc7bded0edd8d1ab174c89878 *man/vec_cast.hms.Rd 6c83a45c91284bbf08b8e0cc3f706d55 *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 78e23f387e7f6631b1c65e9de9fab753 *tests/testthat/test-coercion-deprecated.R 8da1df515e7f2c3679e57bcead06a266 *tests/testthat/test-coercion.R 538aef12fc289990131cdc303ba1f34f *tests/testthat/test-colformat.R 251766b82ffc056304035adcfd16b92f *tests/testthat/test-combine.R 7d43eeda5f1a71e556e96d0c3968a4ca *tests/testthat/test-construct.R b685dc561ae0484a4978599a58e0f269 *tests/testthat/test-lubridate.R daf0f5b209c221563b280c6fd596d6c9 *tests/testthat/test-output.R e63a890e29b8fbe96d77b893b88e75e1 *tests/testthat/test-parse.R 48db96b9a31790a3af8a4057fdbc2792 *tests/testthat/test-round.R 31cd46bc5654df1b6f489763e7bf6326 *tests/testthat/test-subset.R 70976f60fd8284be4157ca0aa8776241 *tests/testthat/test-unique.R f574213c459919bab0007bb894221f29 *tests/testthat/test-update.R