ref: a7bb3ba3b42eaed8425699bbff9a45510ec895af
dir: /test/ast/rpasses-out.lsp/
'(r-expressions (<- Sys.time (lambda () (let () (r-block (r-call structure (r-call .Internal (r-call Sys.time)) (*named* class (r-call c "POSIXt" "POSIXct"))))))) (<- Sys.timezone (lambda () (let () (r-block (r-call as.vector (r-call Sys.getenv "TZ")))))) (<- as.POSIXlt (lambda (x tz) (let ((x ()) (tzone ()) (fromchar ()) (tz ())) (r-block (when (missing tz) (<- tz "")) (<- fromchar (lambda (x) (let ((res ()) (f ()) (j ()) (xx ())) (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-block (<- res (r-call attr<- res "tzone" tz)) 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 (lambda (x tz) (let ((tz ())) (r-block (when (missing tz) (<- tz "")) (r-call UseMethod "as.POSIXct"))))) (<- as.POSIXct.Date (lambda (x ...) (let () (r-block (r-call structure (r-call * (r-call unclass x) 86400) (*named* class (r-call c "POSIXt" "POSIXct"))))))) (<- as.POSIXct.date (lambda (x ...) (let ((x ())) (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 (lambda (x ...) (let ((x ()) (z ())) (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 (lambda (x tz) (let ((tzone ()) (tz ())) (r-block (when (missing tz) (<- tz "")) (<- 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 (lambda (x tz) (let ((tz ())) (r-block (when (missing tz) (<- tz "")) (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 (lambda (x) (let () (r-block (r-call as.POSIXct x))))) (<- format.POSIXlt (lambda (x format usetz ...) (let ((np ()) (secs ()) (times ()) (usetz ()) (format ())) (r-block (when (missing format) (<- format "")) (when (missing usetz) (<- usetz *r-false*)) (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 (r-call r-aref x (index-in-strlist sec (r-call attr x #0="names")))) (<- 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))) 9.9999999999999995e-07)) (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 (lambda (x format tz) (let ((tz ())) (r-block (when (missing tz) (<- tz "")) (r-call .Internal (r-call strptime (r-call as.character x) format tz)))))) (<- format.POSIXct (lambda (x format tz usetz ...) (let ((tzone ()) (usetz ()) (tz ()) (format ())) (r-block (when (missing format) (<- format "")) (when (missing tz) (<- tz "")) (when (missing usetz) (<- usetz *r-false*)) (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 (lambda (x ...) (let () (r-block (r-call print (r-call format x (*named* usetz *r-true*) r-dotdotdot) r-dotdotdot) (r-call invisible x))))) (<- print.POSIXlt (lambda (x ...) (let () (r-block (r-call print (r-call format x (*named* usetz *r-true*)) r-dotdotdot) (r-call invisible x))))) (<- summary.POSIXct (lambda (object digits ...) (let ((x ()) (digits ())) (r-block (when (missing digits) (<- digits 15)) (<- x (r-call r-index (r-call summary.default (r-call unclass object) (*named* digits digits) r-dotdotdot) (r-call : 1 6))) (r-block (ref= %r:1 (r-call oldClass object)) (<- x (r-call class<- x %r:1)) %r:1) (r-block (ref= %r:2 (r-call attr object "tzone")) (<- x (r-call attr<- x "tzone" %r:2)) %r:2) x)))) (<- summary.POSIXlt (lambda (object digits ...) (let ((digits ())) (r-block (when (missing digits) (<- digits 15)) (r-call summary (r-call as.POSIXct object) (*named* digits digits) r-dotdotdot))))) (<- "+.POSIXt" (lambda (e1 e2) (let ((e2 ()) (e1 ()) (coerceTimeUnit ())) (r-block (<- coerceTimeUnit (lambda (x) (let () (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" (lambda (e1 e2) (let ((e2 ()) (coerceTimeUnit ())) (r-block (<- coerceTimeUnit (lambda (x) (let () (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 (lambda (e1 e2) (let ((e2 ()) (e1 ()) (boolean ())) (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 (lambda (x ...) (let () (r-block (r-call stop .Generic " not defined for POSIXt objects"))))) (<- check_tzones (lambda (...) (let ((tzs ())) (r-block (<- tzs (r-call unique (r-call sapply (r-call list r-dotdotdot) (lambda (x) (let ((y ())) (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 (lambda (... na.rm) (let ((val ()) (tz ()) (args ()) (ok ())) (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-block (ref= %r:3 (r-call oldClass (r-call r-aref args 1))) (<- val (r-call class<- val %r:3)) %r:3) (r-block (<- val (r-call attr<- val "tzone" tz)) tz) val)))) (<- Summary.POSIXlt (lambda (... na.rm) (let ((val ()) (tz ()) (args ()) (ok ())) (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" (lambda (x ... drop) (let ((val ()) (x ()) (cl ()) (drop ())) (r-block (when (missing drop) (<- drop *r-true*)) (<- cl (r-call oldClass x)) (r-block (<- x (r-call class<- x ())) ()) (<- val (r-call NextMethod "[")) (r-block (<- val (r-call class<- val cl)) cl) (r-block (ref= %r:4 (r-call attr x "tzone")) (<- val (r-call attr<- val "tzone" %r:4)) %r:4) val)))) (<- "[[.POSIXct" (lambda (x ... drop) (let ((val ()) (x ()) (cl ()) (drop ())) (r-block (when (missing drop) (<- drop *r-true*)) (<- cl (r-call oldClass x)) (r-block (<- x (r-call class<- x ())) ()) (<- val (r-call NextMethod "[[")) (r-block (<- val (r-call class<- val cl)) cl) (r-block (ref= %r:5 (r-call attr x "tzone")) (<- val (r-call attr<- val "tzone" %r:5)) %r:5) val)))) (<- "[<-.POSIXct" (lambda (x ... value) (let ((x ()) (tz ()) (cl ()) (value ())) (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-block (ref= %r:6 (r-block (<- value (r-call class<- value ())) ())) (<- x (r-call class<- x %r:6)) %r:6) (<- x (r-call NextMethod .Generic)) (r-block (<- x (r-call class<- x cl)) cl) (r-block (<- x (r-call attr<- x "tzone" tz)) tz) x)))) (<- as.character.POSIXt (lambda (x ...) (let () (r-block (r-call format x r-dotdotdot))))) (<- as.data.frame.POSIXct as.data.frame.vector) (<- is.na.POSIXlt (lambda (x) (let () (r-block (r-call is.na (r-call as.POSIXct x)))))) (<- c.POSIXct (lambda (... recursive) (let ((recursive ())) (r-block (when (missing recursive) (<- 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 (lambda (... recursive) (let ((recursive ())) (r-block (when (missing recursive) (<- 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 (lambda (target current ... scale) (let ((scale ())) (r-block (when (missing scale) (<- scale 1)) (r-call check_tzones target current) (r-call NextMethod "all.equal"))))) (<- ISOdatetime (lambda (year month day hour min sec tz) (let ((x ()) (tz ())) (r-block (when (missing tz) (<- tz "")) (<- 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 (lambda (year month day hour min sec tz) (let ((tz ()) (sec ()) (min ()) (hour ())) (r-block (when (missing hour) (<- hour 12)) (when (missing min) (<- min 0)) (when (missing sec) (<- sec 0)) (when (missing tz) (<- tz "GMT")) (r-call ISOdatetime year month day hour min sec tz))))) (<- as.matrix.POSIXlt (lambda (x ...) (let () (r-block (r-call as.matrix (r-call as.data.frame (r-call unclass x)) r-dotdotdot))))) (<- mean.POSIXct (lambda (x ...) (let () (r-block (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 (lambda (x ...) (let () (r-block (r-call as.POSIXlt (r-call mean (r-call as.POSIXct x) r-dotdotdot)))))) (<- difftime (lambda (time1 time2 tz units) (let ((zz ()) (z ()) (time2 ()) (time1 ()) (units ()) (tz ())) (r-block (when (missing tz) (<- tz "")) (when (missing units) (<- units (r-call c "auto" "secs" "mins" "hours" "days" "weeks"))) (<- 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 (lambda (tim format units) (let ((units ()) (format ())) (r-block (when (missing format) (<- format "%X")) (when (missing units) (<- units "auto")) (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 (lambda (x) (let () (r-block (r-call UseMethod "units"))))) (<- "units<-" (lambda (x value) (let () (r-block (r-call UseMethod "units<-"))))) (<- units.difftime (lambda (x) (let () (r-block (r-call attr x "units"))))) (<- "units<-.difftime" (lambda (x value) (let ((newx ()) (sc ()) (from ())) (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 (lambda (x units ...) (let ((x ()) (units ())) (r-block (when (missing units) (<- units "auto")) (if (r-call != units "auto") (r-block (<- x (r-call units<- x units)) units)) (r-call as.double (r-call as.vector x)))))) (<- as.data.frame.difftime as.data.frame.vector) (<- format.difftime (lambda (x ...) (let () (r-block (r-call paste (r-call format (r-call unclass x) r-dotdotdot) (r-call units x)))))) (<- print.difftime (lambda (x digits ...) (let ((y ()) (digits ())) (r-block (when (missing digits) (<- digits (r-call getOption "digits"))) (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-block (<- y (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 (lambda (x digits ...) (let ((units ()) (digits ())) (r-block (when (missing digits) (<- digits 0)) (<- units (r-call attr x "units")) (r-call structure (r-call NextMethod) (*named* units units) (*named* class "difftime")))))) (<- "[.difftime" (lambda (x ... drop) (let ((val ()) (x ()) (cl ()) (drop ())) (r-block (when (missing drop) (<- drop *r-true*)) (<- cl (r-call oldClass x)) (r-block (<- x (r-call class<- x ())) ()) (<- val (r-call NextMethod "[")) (r-block (<- val (r-call class<- val cl)) cl) (r-block (ref= %r:7 (r-call attr x "units")) (<- val (r-call attr<- val "units" %r:7)) %r:7) val)))) (<- Ops.difftime (lambda (e1 e2) (let ((u1 ()) (e2 ()) (boolean ()) (e1 ()) (coerceTimeUnit ())) (r-block (<- coerceTimeUnit (lambda (x) (let () (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-block (ref= %r:8 (r-call - (r-call unclass e1))) (<- e1 (r-call r-index<- e1 *r-missing* %r:8)) %r:8))) (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" (lambda (e1 e2) (let ((e2 ()) (e1 ()) (tmp ())) (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" (lambda (e1 e2) (let () (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 (lambda (x ...) (let () (r-block (r-call stop .Generic "not defined for \"difftime\" objects"))))) (<- mean.difftime (lambda (x ... na.rm) (let ((args ()) (coerceTimeUnit ()) (na.rm ())) (r-block (when (missing na.rm) (<- na.rm *r-false*)) (<- coerceTimeUnit (lambda (x) (let () (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 (lambda (... na.rm) (let ((args ()) (ok ()) (coerceTimeUnit ())) (r-block (<- coerceTimeUnit (lambda (x) (let () (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 (lambda (from to by length.out along.with ...) (let ((mon ()) (yr ()) (r1 ()) (by2 ()) (by ()) (valid ()) (res ()) (to ()) (from ()) (status ()) (tz ()) (cfrom ()) (along.with ()) (length.out ())) (r-block (when (missing length.out) (<- length.out ())) (when (missing along.with) (<- along.with ())) (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 (r-call r-aref r1 (index-in-strlist year (r-call attr r1 #0#))) (*named* by by) (*named* length length.out)))) (r-block (<- to (r-call as.POSIXlt to)) (<- yr (r-call seq.int (r-call r-aref r1 (index-in-strlist year (r-call attr r1 #0#))) (r-call r-aref to (index-in-strlist year (r-call attr to #0#))) by)))) (r-block (<- r1 (r-call r-aref<- r1 (index-in-strlist year (r-call attr r1 #0#)) yr)) yr) (r-block (ref= %r:9 (r-call - 1)) (<- r1 (r-call r-aref<- r1 (index-in-strlist isdst (r-call attr r1 #0#)) %r:9)) %r:9) (<- res (r-call as.POSIXct r1))) (if (r-call == valid 6) (r-block (if (missing to) (r-block (<- mon (r-call seq.int (r-call r-aref r1 (index-in-strlist mon (r-call attr r1 #0#))) (*named* by by) (*named* length length.out)))) (r-block (<- to (r-call as.POSIXlt to)) (<- mon (r-call seq.int (r-call r-aref r1 (index-in-strlist mon (r-call attr r1 #0#))) (r-call + (r-call * 12 (r-call - (r-call r-aref to (index-in-strlist year (r-call attr to #0#))) (r-call r-aref r1 (index-in-strlist year (r-call attr r1 #0#))))) (r-call r-aref to (index-in-strlist mon (r-call attr to #0#)))) by)))) (r-block (<- r1 (r-call r-aref<- r1 (index-in-strlist mon (r-call attr r1 #0#)) mon)) mon) (r-block (ref= %r:10 (r-call - 1)) (<- r1 (r-call r-aref<- r1 (index-in-strlist isdst (r-call attr r1 #0#)) %r:10)) %r:10) (<- 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)))))) (r-block (ref= %r:11 (r-call seq.int (r-call r-aref r1 (index-in-strlist mday (r-call attr r1 #0#))) (*named* by by) (*named* length length.out))) (<- r1 (r-call r-aref<- r1 (index-in-strlist mday (r-call attr r1 #0#)) %r:11)) %r:11) (r-block (ref= %r:12 (r-call - 1)) (<- r1 (r-call r-aref<- r1 (index-in-strlist isdst (r-call attr r1 #0#)) %r:12)) %r:12) (<- 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 (lambda (x breaks labels start.on.monday right ...) (let ((res ()) (maxx ()) (incr ()) (start ()) (valid ()) (by2 ()) (breaks ()) (x ()) (right ()) (start.on.monday ()) (labels ())) (r-block (when (missing labels) (<- labels ())) (when (missing start.on.monday) (<- start.on.monday *r-true*)) (when (missing right) (<- right *r-false*)) (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 (r-block (<- start (r-call r-aref<- start (index-in-strlist sec (r-call attr start #0#)) 0)) 0) (<- incr 59.990000000000002))) (if (r-call > valid 2) (r-block (r-block (<- start (r-call r-aref<- start (index-in-strlist min (r-call attr start #0#)) 0)) 0) (<- incr (r-call - 3600 1)))) (if (r-call > valid 3) (r-block (r-block (<- start (r-call r-aref<- start (index-in-strlist hour (r-call attr start #0#)) 0)) 0) (<- incr (r-call - 86400 1)))) (if (r-call == valid 5) (r-block (r-block (ref= %r:13 (r-call - (r-call r-aref start (index-in-strlist mday (r-call attr start #0#))) (r-call r-aref start (index-in-strlist wday (r-call attr start #0#))))) (<- start (r-call r-aref<- start (index-in-strlist mday (r-call attr start #0#)) %r:13)) %r:13) (if start.on.monday (r-block (ref= %r:14 (r-call + (r-call r-aref start (index-in-strlist mday (r-call attr start #0#))) (r-call ifelse (r-call > (r-call r-aref start (index-in-strlist wday (r-call attr start #0#))) 0) 1 (r-call - 6)))) (<- start (r-call r-aref<- start (index-in-strlist mday (r-call attr start #0#)) %r:14)) %r:14)) (<- incr (r-call * 7 86400)))) (if (r-call == valid 6) (r-block (r-block (<- start (r-call r-aref<- start (index-in-strlist mday (r-call attr start #0#)) 1)) 1) (<- incr (r-call * 31 86400)))) (if (r-call == valid 7) (r-block (r-block (<- start (r-call r-aref<- start (index-in-strlist mon (r-call attr start #0#)) 0)) 0) (r-block (<- start (r-call r-aref<- start (index-in-strlist mday (r-call attr start #0#)) 1)) 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-block (ref= %r:15 (r-call as.character (r-call r-index breaks (r-call - (r-call length breaks))))) (<- res (r-call levels<- res %r:15)) %r:15)) res)))) (<- julian (lambda (x ...) (let () (r-block (r-call UseMethod "julian"))))) (<- julian.POSIXt (lambda (x origin ...) (let ((res ()) (origin ())) (r-block (when (missing origin) (<- origin (r-call as.POSIXct "1970-01-01" (*named* tz "GMT")))) (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 (lambda (x abbreviate) (let () (r-block (r-call UseMethod "weekdays"))))) (<- weekdays.POSIXt (lambda (x abbreviate) (let ((abbreviate ())) (r-block (when (missing abbreviate) (<- abbreviate *r-false*)) (r-call format x (r-call ifelse abbreviate "%a" "%A")))))) (<- months (lambda (x abbreviate) (let () (r-block (r-call UseMethod "months"))))) (<- months.POSIXt (lambda (x abbreviate) (let ((abbreviate ())) (r-block (when (missing abbreviate) (<- abbreviate *r-false*)) (r-call format x (r-call ifelse abbreviate "%b" "%B")))))) (<- quarters (lambda (x abbreviate) (let () (r-block (r-call UseMethod "quarters"))))) (<- quarters.POSIXt (lambda (x ...) (let ((x ())) (r-block (<- x (r-call %/% (r-block (ref= %r:0 (r-call as.POSIXlt x)) (r-call r-aref %r:0 (index-in-strlist mon (r-call attr %r:0 #0#)))) 3)) (r-call paste "Q" (r-call + x 1) (*named* sep "")))))) (<- trunc.POSIXt (lambda (x units) (let ((x ()) (units ())) (r-block (when (missing units) (<- units (r-call c "secs" "mins" "hours" "days"))) (<- units (r-call match.arg units)) (<- x (r-call as.POSIXlt x)) (if (r-call > (r-call length (r-call r-aref x (index-in-strlist sec (r-call attr x #0#)))) 0) (switch units (*named* secs (r-block (r-block (ref= %r:16 (r-call trunc (r-call r-aref x (index-in-strlist sec (r-call attr x #0#))))) (<- x (r-call r-aref<- x (index-in-strlist sec (r-call attr x #0#)) %r:16)) %r:16))) (*named* mins (r-block (r-block (<- x (r-call r-aref<- x (index-in-strlist sec (r-call attr x #0#)) 0)) 0))) (*named* hours (r-block (r-block (<- x (r-call r-aref<- x (index-in-strlist sec (r-call attr x #0#)) 0)) 0) (r-block (<- x (r-call r-aref<- x (index-in-strlist min (r-call attr x #0#)) 0)) 0))) (*named* days (r-block (r-block (<- x (r-call r-aref<- x (index-in-strlist sec (r-call attr x #0#)) 0)) 0) (r-block (<- x (r-call r-aref<- x (index-in-strlist min (r-call attr x #0#)) 0)) 0) (r-block (<- x (r-call r-aref<- x (index-in-strlist hour (r-call attr x #0#)) 0)) 0) (r-block (ref= %r:17 (r-call - 1)) (<- x (r-call r-aref<- x (index-in-strlist isdst (r-call attr x #0#)) %r:17)) %r:17))))) x)))) (<- round.POSIXt (lambda (x units) (let ((x ()) (units ())) (r-block (when (missing units) (<- units (r-call c "secs" "mins" "hours" "days"))) (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" (lambda (x ... drop) (let ((val ()) (drop ())) (r-block (when (missing drop) (<- drop *r-true*)) (<- val (r-call lapply x "[" r-dotdotdot (*named* drop drop))) (r-block (ref= %r:18 (r-call attributes x)) (<- val (r-call attributes<- val %r:18)) %r:18) val)))) (<- "[<-.POSIXlt" (lambda (x i value) (let ((x ()) (cl ()) (value ())) (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-block (ref= %r:19 (r-block (<- value (r-call class<- value ())) ())) (<- x (r-call class<- x %r:19)) %r:19) (for n (r-call names x) (r-block (ref= %r:20 (r-call r-aref value n)) (r-block (ref= %r:21 (r-call r-index<- (r-call r-aref x n) i %r:20)) (<- x (r-call r-aref<- x n %r:21)) %r:21) %r:20)) (r-block (<- x (r-call class<- x cl)) cl) x)))) (<- as.data.frame.POSIXlt (lambda (x row.names optional ...) (let ((value ()) (optional ()) (row.names ())) (r-block (when (missing row.names) (<- row.names ())) (when (missing optional) (<- optional *r-false*)) (<- value (r-call as.data.frame.POSIXct (r-call as.POSIXct x) row.names optional r-dotdotdot)) (if (r-call ! optional) (r-block (ref= %r:22 (r-call r-aref (r-call deparse (substitute x)) 1)) (<- value (r-call names<- value %r:22)) %r:22)) value)))) (<- rep.POSIXct (lambda (x ...) (let ((y ())) (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 (lambda (x ...) (let ((y ())) (r-block (<- y (r-call lapply x rep r-dotdotdot)) (r-block (ref= %r:23 (r-call attributes x)) (<- y (r-call attributes<- y %r:23)) %r:23) y)))) (<- diff.POSIXt (lambda (x lag differences ...) (let ((i1 ()) (xlen ()) (r ()) (ismat ()) (differences ()) (lag ())) (r-block (when (missing lag) (<- lag 1)) (when (missing differences) (<- differences 1)) (<- 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 (lambda (x incomparables ...) (let ((x ()) (incomparables ())) (r-block (when (missing incomparables) (<- incomparables *r-false*)) (<- x (r-call as.POSIXct x)) (r-call NextMethod "duplicated" x))))) (<- unique.POSIXlt (lambda (x incomparables ...) (let ((incomparables ())) (r-block (when (missing incomparables) (<- incomparables *r-false*)) (r-call r-index x (r-call ! (r-call duplicated x incomparables r-dotdotdot))))))) (<- sort.POSIXlt (lambda (x decreasing na.last ...) (let ((na.last ()) (decreasing ())) (r-block (when (missing decreasing) (<- decreasing *r-false*)) (when (missing na.last) (<- na.last NA)) (r-call r-index x (r-call order (r-call as.POSIXct x) (*named* na.last na.last) (*named* decreasing decreasing))))))))