tests/ratetable.R

options(na.action=na.exclude) # preserve missings
options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type
library(survival)

#
# Generate each of the messages from is.ratetable
#
mdy.date <- function(m, d, y) {
    y <- ifelse(y<100, y+1900, y)
    as.Date(paste(m,d,y, sep='/'), "%m/%d/%Y")
    }
temp <- runif(21*2*4)

# Good
attributes(temp) <- list(dim=c(21,2,4),
    dimnames=list(c(as.character(75:95)), c("male","female"),
                  c(as.character(2000:2003))),
    dimid=c("age","sex","year"),
    type=c(2,1,4),
    cutpoints=list(c(75:95), NULL, mdy.date(1,1,2000) +c(0:3)*366.25),
    class='ratetable')
is.ratetable(temp)

# Factor problem + cutpoints length
attributes(temp) <- list(dim=c(21,2,4),
    dimnames=list(c(as.character(75:95)), c("male","female"),
                  c(as.character(2000:2003))),
    dimid=c("age","sex","year"),
    type=c(1,1,2),
    cutpoints=list(c(75:95), NULL, mdy.date(1,1,2000) +c(0:4)*366.25),
    class='ratetable')
is.ratetable(temp, verbose=T)
 
                    
# missing dimid attribute + unsorted cutpoint
attributes(temp) <- list(dim=c(21,2,4),
    dimnames=list(c(as.character(75:95)), c("male","female"),
                  c(as.character(2000:2003))),
    type=c(2,1,3),
    cutpoints=list(c(75:95), NULL, mdy.date(1,1,2000) +c(4:1)*366.25),
    class='ratetable')
is.ratetable(temp, verbose=T)

# wrong length for dimid and type, illegal type
attributes(temp) <- list(dim=c(21,2,4),
    dimnames=list(c(as.character(75:95)), c("male","female"),
                  c(as.character(2000:2003))),
    dimid=c("age","sex","year", "zed"),
    type=c(2,1,3,6),
    cutpoints=list(c(75:95), NULL, mdy.date(1,1,2000) +c(0:3)*366.25),
    class='ratetable')
is.ratetable(temp, verbose=T)


# Print and summary
print(survexp.us[1:20,,c('1953', '1985')] )
summary(survexp.usr)

Try the survival package in your browser

Any scripts or data that you put into this service are public.

survival documentation built on Aug. 14, 2023, 9:07 a.m.