### R code from vignette source 'C:/Bendix/teach/NSCE/2022/pracs/std-rates-sol.rnw'

###################################################
### code chunk number 1: std-rates-sol.rnw:27-29
###################################################
std <- read.table( "std-rates.txt", header=T )
str( std )


###################################################
### code chunk number 2: std-rates-sol.rnw:34-37
###################################################
raw.colon.m  <- sum( subset( std, sex=="M" & typ=="Colon" )$D ) / 25.21177
raw.rectum.f <- sum( subset( std, sex=="F" & typ=="Rectum" )$D ) / 25.96061
c(raw.colon.m,raw.rectum.f)


###################################################
### code chunk number 3: std-rates-sol.rnw:44-46
###################################################
cum65.colon.m <- sum( subset( std, sex=="M" & typ=="Colon" & age<66 )[,"rate"] ) * 5
cum65.colon.m


###################################################
### code chunk number 4: std-rates-sol.rnw:56-59
###################################################
wt <- c(120,100,90,90,80,80,60,60,60,60,50,40,40,30,20,10,5,3,2)
wt <- wt / sum(wt )
wt


###################################################
### code chunk number 5: std-rates-sol.rnw:64-67
###################################################
std.colon.m  <- sum( subset( std, sex=="M" & typ=="Colon" )$D*wt )
std.rectum.f <- sum( subset( std, sex=="F" & typ=="Rectum" )$D*wt )
c(std.colon.m,std.rectum.f)


###################################################
### code chunk number 6: std-rates-sol.rnw:101-106
###################################################
Y <- c( 25.21177, 25.96061 )
names( Y )  <- c("M","F")
Y
D <- with( std, tapply( D, list(sex,typ), sum ) )
D


###################################################
### code chunk number 7: std-rates-sol.rnw:110-113
###################################################
Y <- Y[2:1]
Y
round( D/Y, 1 )


###################################################
### code chunk number 8: std-rates-sol.rnw:121-126
###################################################
c65 <- with( subset(std,age<65), tapply( rate, list(sex,typ), sum )*5/10^5 )
c70 <- with( subset(std,age<70), tapply( rate, list(sex,typ), sum )*5/10^5 )
c75 <- with( subset(std,age<75), tapply( rate, list(sex,typ), sum )*5/10^5 )
c80 <- with( subset(std,age<80), tapply( rate, list(sex,typ), sum )*5/10^5 )
rbind( c65, c70, c75, c80 )


###################################################
### code chunk number 9: std-rates-sol.rnw:131-132
###################################################
wst <- with( std, tapply( rate*wt, list(sex,typ), sum ) )


###################################################
### code chunk number 10: std-rates-sol.rnw:136-140
###################################################
dnam <- list( sex=c("F","M","M/F"),
              typ=c("colon","Lung","rectum"),
          measure=c("crude","wst","cum65","cum70","cum75","cum80"))
res <- array( NA, dim=c(3,3,6), dimnames=dnam )


###################################################
### code chunk number 11: std-rates-sol.rnw:145-153
###################################################
res[1:2,,"crude"] <- D/Y
res[1:2,,"wst"]   <- wst
res[1:2,,"cum65"] <- c65
res[1:2,,"cum70"] <- c70
res[1:2,,"cum75"] <- c75
res[1:2,,"cum80"] <- c80
ftable( res )
ftable( res, row.vars=3 )


###################################################
### code chunk number 12: std-rates-sol.rnw:158-160
###################################################
res["M/F",,] <- res["M",,]/res["F",,]
round( ftable( res, row.vars=3 ), 3 )


###################################################
### code chunk number 13: std-rates-sol.rnw:179-181
###################################################
round( with( subset(std,sex=="M"), tapply( rate, list(age,typ), sum ) ) /
       with( subset(std,sex=="F"), tapply( rate, list(age,typ), sum ) ), 2 )