1Lexis.lines <- 2function( entry.date = NA, 3 exit.date = NA, 4 birth.date = NA, 5 entry.age = NA, 6 exit.age = NA, 7 risk.time = NA, 8 col.life = "black", 9 lwd.life = 2, 10 fail = NA, 11 cex.fail = 1, 12 pch.fail = c(NA,16), 13 col.fail = col.life, 14 data = NULL 15 ) 16{ 17 ## Get variables from data argument, if supplied, or from parent 18 ## frame if not. 19 entry.date <- eval(substitute(entry.date), data) 20 entry.age <- eval(substitute(entry.age ), data) 21 exit.date <- eval(substitute(exit.date ), data) 22 exit.age <- eval(substitute(exit.age ), data) 23 risk.time <- eval(substitute(birth.date), data) 24 birth.date <- eval(substitute(birth.date), data) 25 fail <- eval(substitute(fail ), data) 26 27# If fail is numeric make it logical 28if( is.numeric( fail ) ) fail <- ( fail > 0 ) 29 30# Complete the information on lifelines 31XX <- Life.lines( entry.date = entry.date, 32 entry.age = entry.age, 33 exit.date = exit.date, 34 exit.age = exit.age, 35 risk.time = risk.time, 36 birth.date = birth.date ) 37 38# Expand lwd.life/col.life/pch.fail/col.fail/cex.fail 39# 40Np <- nrow( XX ) 41 42if( length( col.life )==1 ) col.life <- rep( col.life, Np ) else 43if( length( col.life )!=length(fail) ) stop("col.life must have length 1 or length(fail)" ) 44 45if( length( lwd.life )==1 ) lwd.life <- rep( lwd.life, Np ) else 46if( length( lwd.life )!=length(fail) ) stop("lwd.life must have length 1 or length(fail)" ) 47 48if( length( col.fail )==1 ) col.fail <- rep( col.fail, Np ) else { 49if( length( col.fail )==2 ) col.fail <- col.fail[fail+1] } 50if( length( col.fail )!=length(fail) ) stop("col.fail must have length 1,2 or length(fail)" ) 51 52if( length( pch.fail )==1 ) pch.fail <- rep( pch.fail, Np ) else 53if( length( pch.fail )==2 ) pch.fail <- pch.fail[fail+1] 54if( length( pch.fail )!=length(fail) ) stop("pch.fail must have length 1,2 or length(fail)" ) 55 56if( length( cex.fail )==1 ) cex.fail <- rep( cex.fail, Np ) else 57if( length( cex.fail )==2 ) cex.fail <- cex.fail[fail+1] 58if( length( cex.fail )!=length(fail) ) stop("cex.fail must have length 1,2 or length(fail)" ) 59 60# Was XX returned as a Date-object? 61# If so make a numerical version i LL, otherwise just a copy. 62# 63if( attr( XX, "Date" ) ) 64 { 65 LL <- data.frame( lapply( XX, unclass ) ) 66 LL[,c(1,3,5)] <- LL[,c(1,3,5)] / 365.25 + 1970 67 LL[,c(2,4,6)] <- LL[,c(2,4,6)] / 365.25 68 } else LL <- XX 69 70# Find age and date ranges in the current plot. 71# 72date <- par( "usr" )[1:2] 73age <- par( "usr" )[3:4] 74 75# Plot the lifelines 76 segments( LL[,1], LL[,2], LL[,3], LL[,4], 77 lwd=lwd.life, col=col.life ) 78# If there are any non-NAs for pch.fail then blank out the space 79# where they go before plotting the symbols 80 if( any( !is.na(pch.fail) ) ) 81 points( LL[!is.na(pch.fail),3], LL[!is.na(pch.fail),4], 82 pch=16, 83 col="white", #par()$bg, 84 cex=cex.fail[!is.na(pch.fail)] ) 85 points( LL[,3], LL[,4], 86 pch=pch.fail, 87 col=col.fail, 88 cex=cex.fail ) 89 90# Return the untouched version of the completed dataframe 91# 92invisible( data.frame( XX, fail=fail ) ) 93} 94