80 lines
35 KiB
Common Lisp
80 lines
35 KiB
Common Lisp
'(r-expressions
|
|
(<- Sys.time (function () (r-call structure (r-call .Internal (r-call Sys.time)) (*named* class (r-call c "POSIXt" "POSIXct"))) ()))
|
|
(<- Sys.timezone (function () (r-call as.vector (r-call Sys.getenv "TZ")) ()))
|
|
(<- as.POSIXlt (function ((*named* x *r-missing*) (*named* tz "")) (r-block (<- fromchar (function ((*named* x *r-missing*)) (r-block (<- xx (r-call r-index x 1)) (if (r-call is.na xx) (r-block (<- j 1) (while (&& (r-call is.na xx) (r-call <= (<- j (r-call + j 1)) (r-call length x))) (<- xx (r-call r-index x j))) (if (r-call is.na xx) (<- f "%Y-%m-%d")))) (if (\|\| (\|\| (\|\| (\|\| (\|\| (\|\| (r-call is.na xx) (r-call ! (r-call is.na (r-call strptime xx (<- f "%Y-%m-%d %H:%M:%OS"))))) (r-call ! (r-call is.na (r-call strptime xx (<- f "%Y/%m/%d %H:%M:%OS"))))) (r-call ! (r-call is.na (r-call strptime xx (<- f "%Y-%m-%d %H:%M"))))) (r-call ! (r-call is.na (r-call strptime xx (<- f "%Y/%m/%d %H:%M"))))) (r-call ! (r-call is.na (r-call strptime xx (<- f "%Y-%m-%d"))))) (r-call ! (r-call is.na (r-call strptime xx (<- f "%Y/%m/%d"))))) (r-block (<- res (r-call strptime x f)) (if (r-call nchar tz) (<- (r-call attr res "tzone") tz)) (return res))) (r-call stop "character string is not in a standard unambiguous format")) ())) (if (r-call inherits x "POSIXlt") (return x)) (if (r-call inherits x "Date") (return (r-call .Internal (r-call Date2POSIXlt x)))) (<- tzone (r-call attr x "tzone")) (if (\|\| (r-call inherits x "date") (r-call inherits x "dates")) (<- x (r-call as.POSIXct x))) (if (r-call is.character x) (return (r-call fromchar (r-call unclass x)))) (if (r-call is.factor x) (return (r-call fromchar (r-call as.character x)))) (if (&& (r-call is.logical x) (r-call all (r-call is.na x))) (<- x (r-call as.POSIXct.default x))) (if (r-call ! (r-call inherits x "POSIXct")) (r-call stop (r-call gettextf "do not know how to convert '%s' to class \"POSIXlt\"" (r-call deparse (substitute x))))) (if (&& (missing tz) (r-call ! (r-call is.null tzone))) (<- tz (r-call r-index tzone 1))) (r-call .Internal (r-call as.POSIXlt x tz))) ()))
|
|
(<- as.POSIXct (function ((*named* x *r-missing*) (*named* tz "")) (r-call UseMethod "as.POSIXct") ()))
|
|
(<- as.POSIXct.Date (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-call structure (r-call * (r-call unclass x) 86400) (*named* class (r-call c "POSIXt" "POSIXct"))) ()))
|
|
(<- as.POSIXct.date (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-block (if (r-call inherits x "date") (r-block (<- x (r-call * (r-call - x 3653) 86400)) (return (r-call structure x (*named* class (r-call c "POSIXt" "POSIXct"))))) (r-call stop (r-call gettextf "'%s' is not a \"date\" object" (r-call deparse (substitute x)))))) ()))
|
|
(<- as.POSIXct.dates (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-block (if (r-call inherits x "dates") (r-block (<- z (r-call attr x "origin")) (<- x (r-call * (r-call as.numeric x) 86400)) (if (&& (r-call == (r-call length z) 3) (r-call is.numeric z)) (<- x (r-call + x (r-call as.numeric (r-call ISOdate (r-call r-index z 3) (r-call r-index z 1) (r-call r-index z 2) 0))))) (return (r-call structure x (*named* class (r-call c "POSIXt" "POSIXct"))))) (r-call stop (r-call gettextf "'%s' is not a \"dates\" object" (r-call deparse (substitute x)))))) ()))
|
|
(<- as.POSIXct.POSIXlt (function ((*named* x *r-missing*) (*named* tz "")) (r-block (<- tzone (r-call attr x "tzone")) (if (&& (missing tz) (r-call ! (r-call is.null tzone))) (<- tz (r-call r-index tzone 1))) (r-call structure (r-call .Internal (r-call as.POSIXct x tz)) (*named* class (r-call c "POSIXt" "POSIXct")) (*named* tzone tz))) ()))
|
|
(<- as.POSIXct.default (function ((*named* x *r-missing*) (*named* tz "")) (r-block (if (r-call inherits x "POSIXct") (return x)) (if (\|\| (r-call is.character x) (r-call is.factor x)) (return (r-call as.POSIXct (r-call as.POSIXlt x) tz))) (if (&& (r-call is.logical x) (r-call all (r-call is.na x))) (return (r-call structure (r-call as.numeric x) (*named* class (r-call c "POSIXt" "POSIXct"))))) (r-call stop (r-call gettextf "do not know how to convert '%s' to class \"POSIXlt\"" (r-call deparse (substitute x))))) ()))
|
|
(<- as.numeric.POSIXlt (function ((*named* x *r-missing*)) (r-call as.POSIXct x) ()))
|
|
(<- format.POSIXlt (function ((*named* x *r-missing*) (*named* format "") (*named* usetz *r-false*) (*named* ... *r-missing*)) (r-block (if (r-call ! (r-call inherits x "POSIXlt")) (r-call stop "wrong class")) (if (r-call == format "") (r-block (<- times (r-call unlist (r-call r-index (r-call unclass x) (r-call : 1 3)))) (<- secs ($ x sec)) (<- secs (r-call r-index secs (r-call ! (r-call is.na secs)))) (<- np (r-call getOption "digits.secs")) (if (r-call is.null np) (<- np 0) (<- np (r-call min 6 np))) (if (r-call >= np 1) (r-block (for i (r-call - (r-call : 1 np) 1) (if (r-call all (r-call < (r-call abs (r-call - secs (r-call round secs i))) 1e-06)) (r-block (<- np i) (break)))))) (<- format (if (r-call all (r-call == (r-call r-index times (r-call ! (r-call is.na times))) 0)) "%Y-%m-%d" (if (r-call == np 0) "%Y-%m-%d %H:%M:%S" (r-call paste "%Y-%m-%d %H:%M:%OS" np (*named* sep ""))))))) (r-call .Internal (r-call format.POSIXlt x format usetz))) ()))
|
|
(<- strftime format.POSIXlt)
|
|
(<- strptime (function ((*named* x *r-missing*) (*named* format *r-missing*) (*named* tz "")) (r-call .Internal (r-call strptime (r-call as.character x) format tz)) ()))
|
|
(<- format.POSIXct (function ((*named* x *r-missing*) (*named* format "") (*named* tz "") (*named* usetz *r-false*) (*named* ... *r-missing*)) (r-block (if (r-call ! (r-call inherits x "POSIXct")) (r-call stop "wrong class")) (if (&& (missing tz) (r-call ! (r-call is.null (<- tzone (r-call attr x "tzone"))))) (<- tz tzone)) (r-call structure (r-call format.POSIXlt (r-call as.POSIXlt x tz) format usetz r-dotdotdot) (*named* names (r-call names x)))) ()))
|
|
(<- print.POSIXct (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-block (r-call print (r-call format x (*named* usetz *r-true*) r-dotdotdot) r-dotdotdot) (r-call invisible x)) ()))
|
|
(<- print.POSIXlt (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-block (r-call print (r-call format x (*named* usetz *r-true*)) r-dotdotdot) (r-call invisible x)) ()))
|
|
(<- summary.POSIXct (function ((*named* object *r-missing*) (*named* digits 15) (*named* ... *r-missing*)) (r-block (<- x (r-call r-index (r-call summary.default (r-call unclass object) (*named* digits digits) r-dotdotdot) (r-call : 1 6))) (<- (r-call class x) (r-call oldClass object)) (<- (r-call attr x "tzone") (r-call attr object "tzone")) x) ()))
|
|
(<- summary.POSIXlt (function ((*named* object *r-missing*) (*named* digits 15) (*named* ... *r-missing*)) (r-call summary (r-call as.POSIXct object) (*named* digits digits) r-dotdotdot) ()))
|
|
(<- "+.POSIXt" (function ((*named* e1 *r-missing*) (*named* e2 *r-missing*)) (r-block (<- coerceTimeUnit (function ((*named* x *r-missing*)) (r-block (switch (r-call attr x "units") (*named* secs x) (*named* mins (r-call * 60 x)) (*named* hours (r-call * (r-call * 60 60) x)) (*named* days (r-call * (r-call * (r-call * 60 60) 24) x)) (*named* weeks (r-call * (r-call * (r-call * (r-call * 60 60) 24) 7) x)))) ())) (if (r-call == (r-call nargs) 1) (return e1)) (if (&& (r-call inherits e1 "POSIXt") (r-call inherits e2 "POSIXt")) (r-call stop "binary + is not defined for \"POSIXt\" objects")) (if (r-call inherits e1 "POSIXlt") (<- e1 (r-call as.POSIXct e1))) (if (r-call inherits e2 "POSIXlt") (<- e2 (r-call as.POSIXct e2))) (if (r-call inherits e1 "difftime") (<- e1 (r-call coerceTimeUnit e1))) (if (r-call inherits e2 "difftime") (<- e2 (r-call coerceTimeUnit e2))) (r-call structure (r-call + (r-call unclass e1) (r-call unclass e2)) (*named* class (r-call c "POSIXt" "POSIXct")) (*named* tzone (r-call check_tzones e1 e2)))) ()))
|
|
(<- "-.POSIXt" (function ((*named* e1 *r-missing*) (*named* e2 *r-missing*)) (r-block (<- coerceTimeUnit (function ((*named* x *r-missing*)) (r-block (switch (r-call attr x "units") (*named* secs x) (*named* mins (r-call * 60 x)) (*named* hours (r-call * (r-call * 60 60) x)) (*named* days (r-call * (r-call * (r-call * 60 60) 24) x)) (*named* weeks (r-call * (r-call * (r-call * (r-call * 60 60) 24) 7) x)))) ())) (if (r-call ! (r-call inherits e1 "POSIXt")) (r-call stop "Can only subtract from POSIXt objects")) (if (r-call == (r-call nargs) 1) (r-call stop "unary - is not defined for \"POSIXt\" objects")) (if (r-call inherits e2 "POSIXt") (return (r-call difftime e1 e2))) (if (r-call inherits e2 "difftime") (<- e2 (r-call unclass (r-call coerceTimeUnit e2)))) (if (r-call ! (r-call is.null (r-call attr e2 "class"))) (r-call stop "can only subtract numbers from POSIXt objects")) (r-call structure (r-call - (r-call unclass (r-call as.POSIXct e1)) e2) (*named* class (r-call c "POSIXt" "POSIXct")))) ()))
|
|
(<- Ops.POSIXt (function ((*named* e1 *r-missing*) (*named* e2 *r-missing*)) (r-block (if (r-call == (r-call nargs) 1) (r-call stop "unary" .Generic " not defined for \"POSIXt\" objects")) (<- boolean (switch .Generic (*named* < *r-missing*) (*named* > *r-missing*) (*named* == *r-missing*) (*named* != *r-missing*) (*named* <= *r-missing*) (*named* >= *r-true*) *r-false*)) (if (r-call ! boolean) (r-call stop .Generic " not defined for \"POSIXt\" objects")) (if (\|\| (r-call inherits e1 "POSIXlt") (r-call is.character e1)) (<- e1 (r-call as.POSIXct e1))) (if (\|\| (r-call inherits e2 "POSIXlt") (r-call is.character e1)) (<- e2 (r-call as.POSIXct e2))) (r-call check_tzones e1 e2) (r-call NextMethod .Generic)) ()))
|
|
(<- Math.POSIXt (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-block (r-call stop .Generic " not defined for POSIXt objects")) ()))
|
|
(<- check_tzones (function ((*named* ... *r-missing*)) (r-block (<- tzs (r-call unique (r-call sapply (r-call list r-dotdotdot) (function ((*named* x *r-missing*)) (r-block (<- y (r-call attr x "tzone")) (if (r-call is.null y) "" y)) ())))) (<- tzs (r-call r-index tzs (r-call != tzs ""))) (if (r-call > (r-call length tzs) 1) (r-call warning "'tzone' attributes are inconsistent")) (if (r-call length tzs) (r-call r-index tzs 1) ())) ()))
|
|
(<- Summary.POSIXct (function ((*named* ... *r-missing*) (*named* na.rm *r-missing*)) (r-block (<- ok (switch .Generic (*named* max *r-missing*) (*named* min *r-missing*) (*named* range *r-true*) *r-false*)) (if (r-call ! ok) (r-call stop .Generic " not defined for \"POSIXct\" objects")) (<- args (r-call list r-dotdotdot)) (<- tz (r-call do.call "check_tzones" args)) (<- val (r-call NextMethod .Generic)) (<- (r-call class val) (r-call oldClass (r-call r-aref args 1))) (<- (r-call attr val "tzone") tz) val) ()))
|
|
(<- Summary.POSIXlt (function ((*named* ... *r-missing*) (*named* na.rm *r-missing*)) (r-block (<- ok (switch .Generic (*named* max *r-missing*) (*named* min *r-missing*) (*named* range *r-true*) *r-false*)) (if (r-call ! ok) (r-call stop .Generic " not defined for \"POSIXlt\" objects")) (<- args (r-call list r-dotdotdot)) (<- tz (r-call do.call "check_tzones" args)) (<- args (r-call lapply args as.POSIXct)) (<- val (r-call do.call .Generic (r-call c args (*named* na.rm na.rm)))) (r-call as.POSIXlt (r-call structure val (*named* class (r-call c "POSIXt" "POSIXct")) (*named* tzone tz)))) ()))
|
|
(<- "[.POSIXct" (function ((*named* x *r-missing*) (*named* ... *r-missing*) (*named* drop *r-true*)) (r-block (<- cl (r-call oldClass x)) (<- (r-call class x) ()) (<- val (r-call NextMethod "[")) (<- (r-call class val) cl) (<- (r-call attr val "tzone") (r-call attr x "tzone")) val) ()))
|
|
(<- "[[.POSIXct" (function ((*named* x *r-missing*) (*named* ... *r-missing*) (*named* drop *r-true*)) (r-block (<- cl (r-call oldClass x)) (<- (r-call class x) ()) (<- val (r-call NextMethod "[[")) (<- (r-call class val) cl) (<- (r-call attr val "tzone") (r-call attr x "tzone")) val) ()))
|
|
(<- "[<-.POSIXct" (function ((*named* x *r-missing*) (*named* ... *r-missing*) (*named* value *r-missing*)) (r-block (if (r-call ! (r-call as.logical (r-call length value))) (return x)) (<- value (r-call as.POSIXct value)) (<- cl (r-call oldClass x)) (<- tz (r-call attr x "tzone")) (<- (r-call class x) (<- (r-call class value) ())) (<- x (r-call NextMethod .Generic)) (<- (r-call class x) cl) (<- (r-call attr x "tzone") tz) x) ()))
|
|
(<- as.character.POSIXt (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-call format x r-dotdotdot) ()))
|
|
(<- as.data.frame.POSIXct as.data.frame.vector)
|
|
(<- is.na.POSIXlt (function ((*named* x *r-missing*)) (r-call is.na (r-call as.POSIXct x)) ()))
|
|
(<- c.POSIXct (function ((*named* ... *r-missing*) (*named* recursive *r-false*)) (r-call structure (r-call c (r-call unlist (r-call lapply (r-call list r-dotdotdot) unclass))) (*named* class (r-call c "POSIXt" "POSIXct"))) ()))
|
|
(<- c.POSIXlt (function ((*named* ... *r-missing*) (*named* recursive *r-false*)) (r-call as.POSIXlt (r-call do.call "c" (r-call lapply (r-call list r-dotdotdot) as.POSIXct))) ()))
|
|
(<- all.equal.POSIXct (function ((*named* target *r-missing*) (*named* current *r-missing*) (*named* ... *r-missing*) (*named* scale 1)) (r-block (r-call check_tzones target current) (r-call NextMethod "all.equal")) ()))
|
|
(<- ISOdatetime (function ((*named* year *r-missing*) (*named* month *r-missing*) (*named* day *r-missing*) (*named* hour *r-missing*) (*named* min *r-missing*) (*named* sec *r-missing*) (*named* tz "")) (r-block (<- x (r-call paste year month day hour min sec (*named* sep "-"))) (r-call as.POSIXct (r-call strptime x "%Y-%m-%d-%H-%M-%OS" (*named* tz tz)) (*named* tz tz))) ()))
|
|
(<- ISOdate (function ((*named* year *r-missing*) (*named* month *r-missing*) (*named* day *r-missing*) (*named* hour 12) (*named* min 0) (*named* sec 0) (*named* tz "GMT")) (r-call ISOdatetime year month day hour min sec tz) ()))
|
|
(<- as.matrix.POSIXlt (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-block (r-call as.matrix (r-call as.data.frame (r-call unclass x)) r-dotdotdot)) ()))
|
|
(<- mean.POSIXct (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-call structure (r-call mean (r-call unclass x) r-dotdotdot) (*named* class (r-call c "POSIXt" "POSIXct")) (*named* tzone (r-call attr x "tzone"))) ()))
|
|
(<- mean.POSIXlt (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-call as.POSIXlt (r-call mean (r-call as.POSIXct x) r-dotdotdot)) ()))
|
|
(<- difftime (function ((*named* time1 *r-missing*) (*named* time2 *r-missing*) (*named* tz "") (*named* units (r-call c "auto" "secs" "mins" "hours" "days" "weeks"))) (r-block (<- time1 (r-call as.POSIXct time1 (*named* tz tz))) (<- time2 (r-call as.POSIXct time2 (*named* tz tz))) (<- z (r-call - (r-call unclass time1) (r-call unclass time2))) (<- units (r-call match.arg units)) (if (r-call == units "auto") (r-block (if (r-call all (r-call is.na z)) (<- units "secs") (r-block (<- zz (r-call min (r-call abs z) (*named* na.rm *r-true*))) (if (\|\| (r-call is.na zz) (r-call < zz 60)) (<- units "secs") (if (r-call < zz 3600) (<- units "mins") (if (r-call < zz 86400) (<- units "hours") (<- units "days")))))))) (switch units (*named* secs (r-call structure z (*named* units "secs") (*named* class "difftime"))) (*named* mins (r-call structure (r-call / z 60) (*named* units "mins") (*named* class "difftime"))) (*named* hours (r-call structure (r-call / z 3600) (*named* units "hours") (*named* class "difftime"))) (*named* days (r-call structure (r-call / z 86400) (*named* units "days") (*named* class "difftime"))) (*named* weeks (r-call structure (r-call / z (r-call * 7 86400)) (*named* units "weeks") (*named* class "difftime"))))) ()))
|
|
(<- as.difftime (function ((*named* tim *r-missing*) (*named* format "%X") (*named* units "auto")) (r-block (if (r-call inherits tim "difftime") (return tim)) (if (r-call is.character tim) (r-block (r-call difftime (r-call strptime tim (*named* format format)) (r-call strptime "0:0:0" (*named* format "%X")) (*named* units units))) (r-block (if (r-call ! (r-call is.numeric tim)) (r-call stop "'tim' is not character or numeric")) (if (r-call == units "auto") (r-call stop "need explicit units for numeric conversion")) (if (r-call ! (r-call %in% units (r-call c "secs" "mins" "hours" "days" "weeks"))) (r-call stop "invalid units specified")) (r-call structure tim (*named* units units) (*named* class "difftime"))))) ()))
|
|
(<- units (function ((*named* x *r-missing*)) (r-call UseMethod "units") ()))
|
|
(<- "units<-" (function ((*named* x *r-missing*) (*named* value *r-missing*)) (r-call UseMethod "units<-") ()))
|
|
(<- units.difftime (function ((*named* x *r-missing*)) (r-call attr x "units") ()))
|
|
(<- "units<-.difftime" (function ((*named* x *r-missing*) (*named* value *r-missing*)) (r-block (<- from (r-call units x)) (if (r-call == from value) (return x)) (if (r-call ! (r-call %in% value (r-call c "secs" "mins" "hours" "days" "weeks"))) (r-call stop "invalid units specified")) (<- sc (r-call cumprod (r-call c (*named* secs 1) (*named* mins 60) (*named* hours 60) (*named* days 24) (*named* weeks 7)))) (<- newx (r-call / (r-call * (r-call as.vector x) (r-call r-index sc from)) (r-call r-index sc value))) (r-call structure newx (*named* units value) (*named* class "difftime"))) ()))
|
|
(<- as.double.difftime (function ((*named* x *r-missing*) (*named* units "auto") (*named* ... *r-missing*)) (r-block (if (r-call != units "auto") (<- (r-call units x) units)) (r-call as.double (r-call as.vector x))) ()))
|
|
(<- as.data.frame.difftime as.data.frame.vector)
|
|
(<- format.difftime (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-call paste (r-call format (r-call unclass x) r-dotdotdot) (r-call units x)) ()))
|
|
(<- print.difftime (function ((*named* x *r-missing*) (*named* digits (r-call getOption "digits")) (*named* ... *r-missing*)) (r-block (if (\|\| (r-call is.array x) (r-call > (r-call length x) 1)) (r-block (r-call cat "Time differences in " (r-call attr x "units") "\n" (*named* sep "")) (<- y (r-call unclass x)) (<- (r-call attr y "units") ()) (r-call print y)) (r-call cat "Time difference of " (r-call format (r-call unclass x) (*named* digits digits)) " " (r-call attr x "units") "\n" (*named* sep ""))) (r-call invisible x)) ()))
|
|
(<- round.difftime (function ((*named* x *r-missing*) (*named* digits 0) (*named* ... *r-missing*)) (r-block (<- units (r-call attr x "units")) (r-call structure (r-call NextMethod) (*named* units units) (*named* class "difftime"))) ()))
|
|
(<- "[.difftime" (function ((*named* x *r-missing*) (*named* ... *r-missing*) (*named* drop *r-true*)) (r-block (<- cl (r-call oldClass x)) (<- (r-call class x) ()) (<- val (r-call NextMethod "[")) (<- (r-call class val) cl) (<- (r-call attr val "units") (r-call attr x "units")) val) ()))
|
|
(<- Ops.difftime (function ((*named* e1 *r-missing*) (*named* e2 *r-missing*)) (r-block (<- coerceTimeUnit (function ((*named* x *r-missing*)) (r-block (switch (r-call attr x "units") (*named* secs x) (*named* mins (r-call * 60 x)) (*named* hours (r-call * (r-call * 60 60) x)) (*named* days (r-call * (r-call * (r-call * 60 60) 24) x)) (*named* weeks (r-call * (r-call * (r-call * (r-call * 60 60) 24) 7) x)))) ())) (if (r-call == (r-call nargs) 1) (r-block (switch .Generic (*named* + (r-block)) (*named* - (r-block (<- (r-call r-index e1 *r-missing*) (r-call - (r-call unclass e1))))) (r-call stop "unary" .Generic " not defined for \"difftime\" objects")) (return e1))) (<- boolean (switch .Generic (*named* < *r-missing*) (*named* > *r-missing*) (*named* == *r-missing*) (*named* != *r-missing*) (*named* <= *r-missing*) (*named* >= *r-true*) *r-false*)) (if boolean (r-block (if (&& (r-call inherits e1 "difftime") (r-call inherits e2 "difftime")) (r-block (<- e1 (r-call coerceTimeUnit e1)) (<- e2 (r-call coerceTimeUnit e2)))) (r-call NextMethod .Generic)) (if (\|\| (r-call == .Generic "+") (r-call == .Generic "-")) (r-block (if (&& (r-call inherits e1 "difftime") (r-call ! (r-call inherits e2 "difftime"))) (return (r-call structure (r-call NextMethod .Generic) (*named* units (r-call attr e1 "units")) (*named* class "difftime")))) (if (&& (r-call ! (r-call inherits e1 "difftime")) (r-call inherits e2 "difftime")) (return (r-call structure (r-call NextMethod .Generic) (*named* units (r-call attr e2 "units")) (*named* class "difftime")))) (<- u1 (r-call attr e1 "units")) (if (r-call == (r-call attr e2 "units") u1) (r-block (r-call structure (r-call NextMethod .Generic) (*named* units u1) (*named* class "difftime"))) (r-block (<- e1 (r-call coerceTimeUnit e1)) (<- e2 (r-call coerceTimeUnit e2)) (r-call structure (r-call NextMethod .Generic) (*named* units "secs") (*named* class "difftime"))))) (r-block (r-call stop .Generic "not defined for \"difftime\" objects"))))) ()))
|
|
(<- "*.difftime" (function ((*named* e1 *r-missing*) (*named* e2 *r-missing*)) (r-block (if (&& (r-call inherits e1 "difftime") (r-call inherits e2 "difftime")) (r-call stop "both arguments of * cannot be \"difftime\" objects")) (if (r-call inherits e2 "difftime") (r-block (<- tmp e1) (<- e1 e2) (<- e2 tmp))) (r-call structure (r-call * e2 (r-call unclass e1)) (*named* units (r-call attr e1 "units")) (*named* class "difftime"))) ()))
|
|
(<- "/.difftime" (function ((*named* e1 *r-missing*) (*named* e2 *r-missing*)) (r-block (if (r-call inherits e2 "difftime") (r-call stop "second argument of / cannot be a \"difftime\" object")) (r-call structure (r-call / (r-call unclass e1) e2) (*named* units (r-call attr e1 "units")) (*named* class "difftime"))) ()))
|
|
(<- Math.difftime (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-block (r-call stop .Generic "not defined for \"difftime\" objects")) ()))
|
|
(<- mean.difftime (function ((*named* x *r-missing*) (*named* ... *r-missing*) (*named* na.rm *r-false*)) (r-block (<- coerceTimeUnit (function ((*named* x *r-missing*)) (r-block (r-call as.vector (switch (r-call attr x "units") (*named* secs x) (*named* mins (r-call * 60 x)) (*named* hours (r-call * (r-call * 60 60) x)) (*named* days (r-call * (r-call * (r-call * 60 60) 24) x)) (*named* weeks (r-call * (r-call * (r-call * (r-call * 60 60) 24) 7) x))))) ())) (if (r-call length (r-call list r-dotdotdot)) (r-block (<- args (r-call c (r-call lapply (r-call list x r-dotdotdot) coerceTimeUnit) (*named* na.rm na.rm))) (r-call structure (r-call do.call "mean" args) (*named* units "secs") (*named* class "difftime"))) (r-block (r-call structure (r-call mean (r-call as.vector x) (*named* na.rm na.rm)) (*named* units (r-call attr x "units")) (*named* class "difftime"))))) ()))
|
|
(<- Summary.difftime (function ((*named* ... *r-missing*) (*named* na.rm *r-missing*)) (r-block (<- coerceTimeUnit (function ((*named* x *r-missing*)) (r-block (r-call as.vector (switch (r-call attr x "units") (*named* secs x) (*named* mins (r-call * 60 x)) (*named* hours (r-call * (r-call * 60 60) x)) (*named* days (r-call * (r-call * (r-call * 60 60) 24) x)) (*named* weeks (r-call * (r-call * (r-call * (r-call * 60 60) 24) 7) x))))) ())) (<- ok (switch .Generic (*named* max *r-missing*) (*named* min *r-missing*) (*named* range *r-true*) *r-false*)) (if (r-call ! ok) (r-call stop .Generic " not defined for \"difftime\" objects")) (<- args (r-call c (r-call lapply (r-call list r-dotdotdot) coerceTimeUnit) (*named* na.rm na.rm))) (r-call structure (r-call do.call .Generic args) (*named* units "secs") (*named* class "difftime"))) ()))
|
|
(<- seq.POSIXt (function ((*named* from *r-missing*) (*named* to *r-missing*) (*named* by *r-missing*) (*named* length.out ()) (*named* along.with ()) (*named* ... *r-missing*)) (r-block (if (missing from) (r-call stop "'from' must be specified")) (if (r-call ! (r-call inherits from "POSIXt")) (r-call stop "'from' must be a POSIXt object")) (<- cfrom (r-call as.POSIXct from)) (if (r-call != (r-call length cfrom) 1) (r-call stop "'from' must be of length 1")) (<- tz (r-call attr cfrom "tzone")) (if (r-call ! (missing to)) (r-block (if (r-call ! (r-call inherits to "POSIXt")) (r-call stop "'to' must be a POSIXt object")) (if (r-call != (r-call length (r-call as.POSIXct to)) 1) (r-call stop "'to' must be of length 1")))) (if (r-call ! (missing along.with)) (r-block (<- length.out (r-call length along.with))) (if (r-call ! (r-call is.null length.out)) (r-block (if (r-call != (r-call length length.out) 1) (r-call stop "'length.out' must be of length 1")) (<- length.out (r-call ceiling length.out))))) (<- status (r-call c (r-call ! (missing to)) (r-call ! (missing by)) (r-call ! (r-call is.null length.out)))) (if (r-call != (r-call sum status) 2) (r-call stop "exactly two of 'to', 'by' and 'length.out' / 'along.with' must be specified")) (if (missing by) (r-block (<- from (r-call unclass cfrom)) (<- to (r-call unclass (r-call as.POSIXct to))) (<- res (r-call seq.int from to (*named* length.out length.out))) (return (r-call structure res (*named* class (r-call c "POSIXt" "POSIXct")) (*named* tzone tz))))) (if (r-call != (r-call length by) 1) (r-call stop "'by' must be of length 1")) (<- valid 0) (if (r-call inherits by "difftime") (r-block (<- by (r-call * (switch (r-call attr by "units") (*named* secs 1) (*named* mins 60) (*named* hours 3600) (*named* days 86400) (*named* weeks (r-call * 7 86400))) (r-call unclass by)))) (if (r-call is.character by) (r-block (<- by2 (r-call r-aref (r-call strsplit by " " (*named* fixed *r-true*)) 1)) (if (\|\| (r-call > (r-call length by2) 2) (r-call < (r-call length by2) 1)) (r-call stop "invalid 'by' string")) (<- valid (r-call pmatch (r-call r-index by2 (r-call length by2)) (r-call c "secs" "mins" "hours" "days" "weeks" "months" "years" "DSTdays"))) (if (r-call is.na valid) (r-call stop "invalid string for 'by'")) (if (r-call <= valid 5) (r-block (<- by (r-call r-index (r-call c 1 60 3600 86400 (r-call * 7 86400)) valid)) (if (r-call == (r-call length by2) 2) (<- by (r-call * by (r-call as.integer (r-call r-index by2 1)))))) (<- by (if (r-call == (r-call length by2) 2) (r-call as.integer (r-call r-index by2 1)) 1)))) (if (r-call ! (r-call is.numeric by)) (r-call stop "invalid mode for 'by'")))) (if (r-call is.na by) (r-call stop "'by' is NA")) (if (r-call <= valid 5) (r-block (<- from (r-call unclass (r-call as.POSIXct from))) (if (r-call ! (r-call is.null length.out)) (<- res (r-call seq.int from (*named* by by) (*named* length.out length.out))) (r-block (<- to (r-call unclass (r-call as.POSIXct to))) (<- res (r-call + (r-call seq.int 0 (r-call - to from) by) from)))) (return (r-call structure res (*named* class (r-call c "POSIXt" "POSIXct")) (*named* tzone tz)))) (r-block (<- r1 (r-call as.POSIXlt from)) (if (r-call == valid 7) (r-block (if (missing to) (r-block (<- yr (r-call seq.int ($ r1 year) (*named* by by) (*named* length length.out)))) (r-block (<- to (r-call as.POSIXlt to)) (<- yr (r-call seq.int ($ r1 year) ($ to year) by)))) (<- ($ r1 year) yr) (<- ($ r1 isdst) (r-call - 1)) (<- res (r-call as.POSIXct r1))) (if (r-call == valid 6) (r-block (if (missing to) (r-block (<- mon (r-call seq.int ($ r1 mon) (*named* by by) (*named* length length.out)))) (r-block (<- to (r-call as.POSIXlt to)) (<- mon (r-call seq.int ($ r1 mon) (r-call + (r-call * 12 (r-call - ($ to year) ($ r1 year))) ($ to mon)) by)))) (<- ($ r1 mon) mon) (<- ($ r1 isdst) (r-call - 1)) (<- res (r-call as.POSIXct r1))) (if (r-call == valid 8) (r-block (if (r-call ! (missing to)) (r-block (<- length.out (r-call + 2 (r-call floor (r-call / (r-call - (r-call unclass (r-call as.POSIXct to)) (r-call unclass (r-call as.POSIXct from))) 86400)))))) (<- ($ r1 mday) (r-call seq.int ($ r1 mday) (*named* by by) (*named* length length.out))) (<- ($ r1 isdst) (r-call - 1)) (<- res (r-call as.POSIXct r1)) (if (r-call ! (missing to)) (<- res (r-call r-index res (r-call <= res (r-call as.POSIXct to))))))))) (return res)))) ()))
|
|
(<- cut.POSIXt (function ((*named* x *r-missing*) (*named* breaks *r-missing*) (*named* labels ()) (*named* start.on.monday *r-true*) (*named* right *r-false*) (*named* ... *r-missing*)) (r-block (if (r-call ! (r-call inherits x "POSIXt")) (r-call stop "'x' must be a date-time object")) (<- x (r-call as.POSIXct x)) (if (r-call inherits breaks "POSIXt") (r-block (<- breaks (r-call as.POSIXct breaks))) (if (&& (r-call is.numeric breaks) (r-call == (r-call length breaks) 1)) (r-block) (if (&& (r-call is.character breaks) (r-call == (r-call length breaks) 1)) (r-block (<- by2 (r-call r-aref (r-call strsplit breaks " " (*named* fixed *r-true*)) 1)) (if (\|\| (r-call > (r-call length by2) 2) (r-call < (r-call length by2) 1)) (r-call stop "invalid specification of 'breaks'")) (<- valid (r-call pmatch (r-call r-index by2 (r-call length by2)) (r-call c "secs" "mins" "hours" "days" "weeks" "months" "years" "DSTdays"))) (if (r-call is.na valid) (r-call stop "invalid specification of 'breaks'")) (<- start (r-call as.POSIXlt (r-call min x (*named* na.rm *r-true*)))) (<- incr 1) (if (r-call > valid 1) (r-block (<- ($ start sec) 0) (<- incr 59.99))) (if (r-call > valid 2) (r-block (<- ($ start min) 0) (<- incr (r-call - 3600 1)))) (if (r-call > valid 3) (r-block (<- ($ start hour) 0) (<- incr (r-call - 86400 1)))) (if (r-call == valid 5) (r-block (<- ($ start mday) (r-call - ($ start mday) ($ start wday))) (if start.on.monday (<- ($ start mday) (r-call + ($ start mday) (r-call ifelse (r-call > ($ start wday) 0) 1 (r-call - 6))))) (<- incr (r-call * 7 86400)))) (if (r-call == valid 6) (r-block (<- ($ start mday) 1) (<- incr (r-call * 31 86400)))) (if (r-call == valid 7) (r-block (<- ($ start mon) 0) (<- ($ start mday) 1) (<- incr (r-call * 366 86400)))) (if (r-call == valid 8) (<- incr (r-call * 25 3600))) (if (r-call == (r-call length by2) 2) (<- incr (r-call * incr (r-call as.integer (r-call r-index by2 1))))) (<- maxx (r-call max x (*named* na.rm *r-true*))) (<- breaks (r-call seq.int start (r-call + maxx incr) breaks)) (<- breaks (r-call r-index breaks (r-call : 1 (r-call + 1 (r-call max (r-call which (r-call < breaks maxx)))))))) (r-call stop "invalid specification of 'breaks'")))) (<- res (r-call cut (r-call unclass x) (r-call unclass breaks) (*named* labels labels) (*named* right right) r-dotdotdot)) (if (r-call is.null labels) (<- (r-call levels res) (r-call as.character (r-call r-index breaks (r-call - (r-call length breaks)))))) res) ()))
|
|
(<- julian (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-call UseMethod "julian") ()))
|
|
(<- julian.POSIXt (function ((*named* x *r-missing*) (*named* origin (r-call as.POSIXct "1970-01-01" (*named* tz "GMT"))) (*named* ... *r-missing*)) (r-block (if (r-call != (r-call length origin) 1) (r-call stop "'origin' must be of length one")) (<- res (r-call difftime (r-call as.POSIXct x) origin (*named* units "days"))) (r-call structure res (*named* origin origin))) ()))
|
|
(<- weekdays (function ((*named* x *r-missing*) (*named* abbreviate *r-missing*)) (r-call UseMethod "weekdays") ()))
|
|
(<- weekdays.POSIXt (function ((*named* x *r-missing*) (*named* abbreviate *r-false*)) (r-block (r-call format x (r-call ifelse abbreviate "%a" "%A"))) ()))
|
|
(<- months (function ((*named* x *r-missing*) (*named* abbreviate *r-missing*)) (r-call UseMethod "months") ()))
|
|
(<- months.POSIXt (function ((*named* x *r-missing*) (*named* abbreviate *r-false*)) (r-block (r-call format x (r-call ifelse abbreviate "%b" "%B"))) ()))
|
|
(<- quarters (function ((*named* x *r-missing*) (*named* abbreviate *r-missing*)) (r-call UseMethod "quarters") ()))
|
|
(<- quarters.POSIXt (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-block (<- x (r-call %/% ($ (r-call as.POSIXlt x) mon) 3)) (r-call paste "Q" (r-call + x 1) (*named* sep ""))) ()))
|
|
(<- trunc.POSIXt (function ((*named* x *r-missing*) (*named* units (r-call c "secs" "mins" "hours" "days"))) (r-block (<- units (r-call match.arg units)) (<- x (r-call as.POSIXlt x)) (if (r-call > (r-call length ($ x sec)) 0) (switch units (*named* secs (r-block (<- ($ x sec) (r-call trunc ($ x sec))))) (*named* mins (r-block (<- ($ x sec) 0))) (*named* hours (r-block (<- ($ x sec) 0) (<- ($ x min) 0))) (*named* days (r-block (<- ($ x sec) 0) (<- ($ x min) 0) (<- ($ x hour) 0) (<- ($ x isdst) (r-call - 1)))))) x) ()))
|
|
(<- round.POSIXt (function ((*named* x *r-missing*) (*named* units (r-call c "secs" "mins" "hours" "days"))) (r-block (if (&& (r-call is.numeric units) (r-call == units 0)) (<- units "secs")) (<- units (r-call match.arg units)) (<- x (r-call as.POSIXct x)) (<- x (r-call + x (switch units (*named* secs 0.5) (*named* mins 30) (*named* hours 1800) (*named* days 43200)))) (r-call trunc.POSIXt x (*named* units units))) ()))
|
|
(<- "[.POSIXlt" (function ((*named* x *r-missing*) (*named* ... *r-missing*) (*named* drop *r-true*)) (r-block (<- val (r-call lapply x "[" r-dotdotdot (*named* drop drop))) (<- (r-call attributes val) (r-call attributes x)) val) ()))
|
|
(<- "[<-.POSIXlt" (function ((*named* x *r-missing*) (*named* i *r-missing*) (*named* value *r-missing*)) (r-block (if (r-call ! (r-call as.logical (r-call length value))) (return x)) (<- value (r-call as.POSIXlt value)) (<- cl (r-call oldClass x)) (<- (r-call class x) (<- (r-call class value) ())) (for n (r-call names x) (<- (r-call r-index (r-call r-aref x n) i) (r-call r-aref value n))) (<- (r-call class x) cl) x) ()))
|
|
(<- as.data.frame.POSIXlt (function ((*named* x *r-missing*) (*named* row.names ()) (*named* optional *r-false*) (*named* ... *r-missing*)) (r-block (<- value (r-call as.data.frame.POSIXct (r-call as.POSIXct x) row.names optional r-dotdotdot)) (if (r-call ! optional) (<- (r-call names value) (r-call r-aref (r-call deparse (substitute x)) 1))) value) ()))
|
|
(<- rep.POSIXct (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-block (<- y (r-call NextMethod)) (r-call structure y (*named* class (r-call c "POSIXt" "POSIXct")) (*named* tzone (r-call attr x "tzone")))) ()))
|
|
(<- rep.POSIXlt (function ((*named* x *r-missing*) (*named* ... *r-missing*)) (r-block (<- y (r-call lapply x rep r-dotdotdot)) (<- (r-call attributes y) (r-call attributes x)) y) ()))
|
|
(<- diff.POSIXt (function ((*named* x *r-missing*) (*named* lag 1) (*named* differences 1) (*named* ... *r-missing*)) (r-block (<- ismat (r-call is.matrix x)) (<- r (if (r-call inherits x "POSIXlt") (r-call as.POSIXct x) x)) (<- xlen (if ismat (r-call r-index (r-call dim x) 1) (r-call length r))) (if (\|\| (\|\| (\|\| (r-call > (r-call length lag) 1) (r-call > (r-call length differences) 1)) (r-call < lag 1)) (r-call < differences 1)) (r-call stop "'lag' and 'differences' must be integers >= 1")) (if (r-call >= (r-call * lag differences) xlen) (return (r-call structure (r-call numeric 0) (*named* class "difftime") (*named* units "secs")))) (<- i1 (r-call : (r-call - 1) (r-call - lag))) (if ismat (for i (r-call : 1 differences) (<- r (r-call - (r-call r-index r i1 *r-missing* (*named* drop *r-false*)) (r-call r-index r (r-call : (r-call - (r-call nrow r)) (r-call - (r-call + (r-call - (r-call nrow r) lag) 1))) *r-missing* (*named* drop *r-false*))))) (for i (r-call : 1 differences) (<- r (r-call - (r-call r-index r i1) (r-call r-index r (r-call : (r-call - (r-call length r)) (r-call - (r-call + (r-call - (r-call length r) lag) 1)))))))) r) ()))
|
|
(<- duplicated.POSIXlt (function ((*named* x *r-missing*) (*named* incomparables *r-false*) (*named* ... *r-missing*)) (r-block (<- x (r-call as.POSIXct x)) (r-call NextMethod "duplicated" x)) ()))
|
|
(<- unique.POSIXlt (function ((*named* x *r-missing*) (*named* incomparables *r-false*) (*named* ... *r-missing*)) (r-call r-index x (r-call ! (r-call duplicated x incomparables r-dotdotdot))) ()))
|
|
(<- sort.POSIXlt (function ((*named* x *r-missing*) (*named* decreasing *r-false*) (*named* na.last NA) (*named* ... *r-missing*)) (r-call r-index x (r-call order (r-call as.POSIXct x) (*named* na.last na.last) (*named* decreasing decreasing))) ())))
|