ref: 32172cdf6a00026675dee9be5c0fa3aef5fdff9d
dir: femtolisp/tests/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))))))))