### R code from vignette source 'testis-types.rnw' ################################################### ### code chunk number 1: testis-types.rnw:2-8 ################################################### options(width = 90, prompt = " ", continue = " ", SweaveHooks = list(fig = function() par(mar = c(3,3,1,1), mgp = c(3,1,0)/1.6, bty="n", las=1))) library(Epi) library(tidyverse) ################################################### ### code chunk number 2: testis-types.rnw:23-29 ################################################### th <- read.table("../data/testis-hist.txt", header = TRUE) th <- rename(th, "A" = "age", "P" = "diag", "D" = "d", "Y" = "y") names(th) ################################################### ### code chunk number 3: testis-types.rnw:33-39 ################################################### th <- subset(th, hist != 3 & A > 15 & A < 65) table(th$hist) th <- transform(th, hist = factor(hist, labels = c("Seminoma", "non-Semi"))) str(th) head(th) ################################################### ### code chunk number 4: testis-types.rnw:44-47 ################################################### ftable(xtabs(cbind(D, Y) ~ Agr + hist, data = transform(th, Agr = cut(A, seq(15, 65, 5), right = FALSE))), row.vars = 1) ################################################### ### code chunk number 5: rr-def ################################################### rr <- function(one, two) cbind(one[,1], ci.ratio(one[,-1], two[,-1])) ################################################### ### code chunk number 6: APC-rr ################################################### sem.1945 <- apc.fit( subset(th, hist=="Seminoma"), ref.c=1945, npar=c(8,5,15), scale=10^5 ) n.s.1945 <- apc.fit( subset(th, hist=="non-Semi"), ref.c=1945, npar=c(8,5,15), scale=10^5 ) sem.1920 <- apc.fit( subset(th, hist=="Seminoma"), ref.c=1920, npar=c(8,5,15), scale=10^5 ) n.s.1920 <- apc.fit( subset(th, hist=="non-Semi"), ref.c=1920, npar=c(8,5,15), scale=10^5 ) ################################################### ### code chunk number 7: testis-types.rnw:87-93 ################################################### rrA.1945 <- rr( sem.1945$Age, n.s.1945$Age ) rrA.1920 <- rr( sem.1920$Age, n.s.1920$Age ) rrP.1945 <- rr( sem.1945$Per, n.s.1945$Per ) rrP.1920 <- rr( sem.1920$Per, n.s.1920$Per ) rrC.1945 <- rr( sem.1945$Coh, n.s.1945$Coh ) rrC.1920 <- rr( sem.1920$Coh, n.s.1920$Coh ) ################################################### ### code chunk number 8: APC-hist ################################################### par(mar=c(3, 4, 0.5, 2)) apc.frame(r.lab = c(c( 10)/100, c(2, 5, 10)/10, c(2, 5, 10, 15)), r.tic = c(c(1:10)/10, c(2:10)), rr.ref = 1, a.lab = seq(10, 70, 20), a.tic = 1:7*10, cp.lab = seq(1880, 2000, 20), cp.tic = 188:200*10, gap = 5 ) apc.lines(sem.1945, col = "blue", lwd = 2) apc.lines(n.s.1945, col = "red" , lwd = 2) apc.lines(sem.1920, col = "blue", lty = "21", lend = "butt", lwd = 3) apc.lines(n.s.1920, col = "red" , lty = "21", lend = "butt", lwd = 3) ################################################### ### code chunk number 9: APC-rr ################################################### par(mar=c(3, 4, 0.5, 2)) apc.frame(r.lab = c(c( 10)/100, c(2, 5, 10)/10, c(2, 5, 10, 15)), r.tic = c(c(1:10)/10, c(2:10)), rr.ref = 1, a.lab = seq(10, 70, 20), a.tic = 1:7*10, cp.lab = seq(1880, 2000, 20), cp.tic = 188:200*10, gap = 5 ) lines( rrA.1945[,1], rrA.1945[,2], lwd=2 ) lines( rrA.1920[,1], rrA.1920[,2], lwd=2, lty="22" ) pc.lines( rrP.1945[,1], rrP.1945[,2], lwd=2, col=gray(0.5) ) pc.lines( rrP.1920[,1], rrP.1920[,2], lwd=2, col=gray(0.5), lty="22" ) pc.lines( rrC.1945[,1], rrC.1945[,2], lwd=2 ) pc.lines( rrC.1920[,1], rrC.1920[,2], lwd=2, lty="22" ) abline(h=1) ################################################### ### code chunk number 10: testis-types.rnw:173-179 ################################################### sem.dr <- apc.fit(subset(th, hist == "Seminoma"), parm = "AdCP", ref.c = 1930, npar = c(8, 5, 15), scale = 10^5 ) n.s.dr <- apc.fit(subset(th, hist == "non-Semi"), parm = "AdCP", ref.c = 1930, npar = c(8, 5, 15), scale = 10^5 ) ################################################### ### code chunk number 11: testis-types.rnw:189-190 ################################################### str(sem.dr$Drift) ################################################### ### code chunk number 12: testis-types.rnw:194-196 ################################################### round( rbind(sem.dr$Drift, n.s.dr$Drift), 4) round((rbind(sem.dr$Drift, n.s.dr$Drift) - 1) * 100, 2) ################################################### ### code chunk number 13: testis-types.rnw:206-206 ################################################### ################################################### ### code chunk number 14: APC-rr-flat ################################################### rrA <- rr(sem.dr$Age, n.s.dr$Age) rrP <- rr(sem.dr$Per, n.s.dr$Per) rrC <- rr(sem.dr$Coh, n.s.dr$Coh) apc.frame(r.lab=c(c( 5,10)/100, c(2,5,10)/10, c(2,5,10,15)), r.tic=c(c(5:10)/100, c(2:10)/10, c(2:10)), rr.ref=1, a.lab=seq(20,60,20), a.tic=1:7*10, cp.lab=seq(1880,2000,20), cp.tic=188:200*10, r.txt="Seminoma vs. non-Seminoma RR", gap=5 ) matshade(rrA[,1], rrA[,-1], lwd=3, lty=1) pc.matshade(rrP[,1], rrP[,-1], lwd=3, lty=1) pc.matshade(rrC[,1], rrC[,-1], lwd=3, lty="21", lend = "butt") abline(h=1) pc.points(1930, 1, pch = 16, cex = 1.5, col = "white") pc.points(1930, 1, pch = 1, lwd = 3, cex = 1.5)