### R code from vignette source 'mcut' ### Encoding: UTF-8 ################################################### ### code chunk number 1: splx.rnw:2-8 ################################################### options( keep.source=TRUE, width=90 ) library( Epi ) sessionInfo() load( "../data/ndm.Rda" ) lls() head( ndm ) ################################################### ### code chunk number 2: splx.rnw:11-18 ################################################### L0 <- Lexis( entry = list( age = doEnt-doBth, per = doEnt, dur = doEnt-doDM ), exit = list( per = doX ), exit.status = factor( !is.na(doDth) & abs(doDth-doX) < 1/1000, labels=c("None","Dead") ), data = ndm ) ################################################### ### code chunk number 3: splx.rnw:42-77 ################################################### LK <- cutLexis( L0, cut = L0$doK, time = "per", new.state = "K", pre = "None", split = TRUE ) summary( LK ) LKN <- cutLexis( LK, cut = LK$doN, time = "per", new.state = "N", pre = c("None","K"), split = TRUE ) summary( LKN ) LN <- cutLexis( L0, cut = L0$doN, time = "per", new.state = "N", pre = "None", split = TRUE ) summary( LN ) LNK <- cutLexis( LN, cut = LN$doK, time = "per", new.state = "K", pre = c("None","N"), split = TRUE ) summary( LNK ) summary( Relevel(LNK,c(1,3,2,4,7,6,5)) ) with( L0, table( doNL0$doK] ( idx <- c( ii[!is.na(ii)][1], jj[!is.na(jj)][1] ) ) subset( L0, lex.id %in% idx )[,c(2,4:7,12,17:20)] subset( LK, lex.id %in% idx )[,c(2,4:7,12,17:20)] subset( LN, lex.id %in% idx )[,c(2,4:7,12,17:20)] subset( LKN, lex.id %in% idx )[,c(2,4:7,12,17:20)] subset( LNK, lex.id %in% idx )[,c(2,4:7,12,17:20)] ################################################### ### code chunk number 4: splx.rnw:84-86 ################################################### S3 <- subset( L0, doK < doN & doN < doR ) summary( S3 ) ################################################### ### code chunk number 5: splx.rnw:88-109 ################################################### LR <- cutLexis( S3, cut = S3$doR, time = "per", new.state = "R", pre = "None", split = TRUE ) summary( LR ) LNR <- cutLexis( LR, cut = LR$doN, time = "per", new.state = "N", pre = "None", split = TRUE ) summary( LNR ) LKNR <- cutLexis( LNR, cut = LNR$doK, time = "per", new.state = "K", pre = "None", split = TRUE ) summary( LKNR ) table(tt <- table(LKNR$lex.id) ) idx <- names( tt[tt==4][1:2] ) subset( LKNR, lex.id %in% idx )[,c(2,4:7,12,17,19,20,18)] ################################################### ### code chunk number 6: splx.rnw:118-136 ################################################### LK <- cutLexis( S3, cut = S3$doK, time = "per", new.state = "K", pre = "None" ) summary( LK ) LKN <- cutLexis( LK, cut = LK$doN, time = "per", new.state = "K-N", pre = c("None","K") ) summary( LKN ) LKNR <- cutLexis( LKN, cut = LKN$doR, time = "per", new.state = "K-N-R", pre = c("None","K","K-N") ) summary( LKNR ) table(tt <- table(LKNR$lex.id) ) idx <- names( tt[tt==4][1:2] ) subset( LKNR, lex.id %in% idx )[,c(2,4:7,12,17,19,20,18)] ################################################### ### code chunk number 7: splx.rnw:147-154 ################################################### NAorder <- function( x ) { oo <- order( x, na.last=T ) oo[is.na(x)] <- NA paste( oo[!is.na(oo)], collapse="-" ) } ################################################### ### code chunk number 8: splx.rnw:158-163 ################################################### wh <- 18:20 ( stnam <- gsub( "do", "", names(L0)[wh] ) ) whseq <- apply( L0[,wh], 1, NAorder ) table( whseq ) unique( whseq ) ################################################### ### code chunk number 9: splx.rnw:173-176 ################################################### library( tools ) Rd2latex( "/home/bendix/stat/R/lib.src/Epi/pkg/man/mcutLexis.Rd", out="mcutLexis.tex" ) ################################################### ### code chunk number 10: splx.rnw:182-183 ################################################### source( "/home/bendix/stat/R/lib.src/Epi/pkg/R/mcutLexis.R", keep.source=TRUE ) ################################################### ### code chunk number 11: splx.rnw:185-186 ################################################### mcutLexis ################################################### ### code chunk number 12: splx.rnw:188-189 ################################################### rm( mcutLexis ) ################################################### ### code chunk number 13: splx.rnw:197-204 ################################################### Lx <- mcutLexis( L0, timescale = "per", wh = c("doR","doK","doN"), new.states = c( "R", "K", "N"), new.scales = c( "tR", "tK", "tN"), precursor.states = "None", seq.states = FALSE ) ################################################### ### code chunk number 14: splx.rnw:207-211 ################################################### levels( Lx )[c(1,2,6,9,7,3,8,4,5)] Lx <- Relevel( Lx, c(1,2,6,9,7,3,8,4,5) ) summary( L0 ) summary( Lx, t=T ) ################################################### ### code chunk number 15: bb ################################################### # pdf("bb.pdf",width=15, height=10) boxes( Lx, boxpos=list(x= c(10,36,36,36,64,64,64,92 ,50), y=c(c(50,80,50,20,80,50,20,50)+15, 5) ), show.BE=TRUE, scale.R=100, col.arr=c("black","gray")[c(1,1,1,2, 1,1,2, 1,1,2, 1,1,2, 1,2, 1,2, 1,2, 2)]) par( new=TRUE ) boxes( Lx, boxpos=list(x= c(10,36,36,36,64,64,64,92 , 5), y=c(c(50,80,50,20,80,50,20,50)+15,50) ), show.BE=TRUE, scale.R=100, subset=1:8, col.bg="white" ) # dev.off() ################################################### ### code chunk number 16: bbx ################################################### Lxx <- transform( Lx, lex.Xst = ifelse( lex.Xst=="Dead", paste( lex.Cst, as.character(lex.Xst) ), as.character(lex.Xst) ) ) table( Lxx$lex.Xst, Lx$lex.Xst ) print( table( Lxx$lex.Xst, nchar(Lxx$lex.Xst) ), zero="." ) Lxx$lex.Xst <- ifelse( nchar(Lxx$lex.Xst)%in%c(6, 9), "Dead(0-1)", Lxx$lex.Xst ) Lxx$lex.Xst <- ifelse( nchar(Lxx$lex.Xst)%in%c(8,10), "Dead(2-3)", Lxx$lex.Xst ) Lxx <- Relevel( Lxx ) summary( Lxx ) # pdf("bbx.pdf",width=15, height=10) zz <- boxes( Lxx, boxpos=list(x= seq( 6,94,,4)[c(1,2,2,2,3,3,3,4,1,4)], y=c(seq(15,95,,3)[c(2,3:1,3:1,2)],5,5) ), show.BE=TRUE, scale.R=100, col.bg=rep(c("white","gray"),c(8,2)), col.arr=c("black","gray")[c(1,1,1,2, 1,1,2, 1,1,2, 1,1,2, 1,2, 1,2, 1,2, 2)]) par( new=TRUE ) boxes( Lxx, boxpos=list(x=seq(6,94,,4)[c(1,2,2,2,3,3,3,4,1,4)], y=c(seq(15,95,,3)[c(2,3:1,3:1,2)],5,5) ), show.BE=TRUE, scale.R=100, subset=1:8, col.bg="white" ) zz # dev.off()