1Life.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 ) 9{ 10# A function allowing any three of the arguments to be specified 11# and yet returns enty age and -time and exit age and -time. 12 13# Check if any variable is supplied with class 14if( conv <- any( inherits( entry.date, "Date" ), 15 inherits( exit.date, "Date" ), 16 inherits( birth.date, "Date" ), 17 inherits( entry.age , "difftime" ), 18 inherits( exit.age , "difftime" ), 19 inherits( risk.time, "difftime" ) ) ) 20 { 21 # Convert "Date" and "difftime" to years 22 if( inherits( entry.date, "Date" ) ) entry.date <- as.numeric( entry.date ) / 365.35 + 1970 23 if( inherits( exit.date, "Date" ) ) exit.date <- as.numeric( exit.date ) / 365.35 + 1970 24 if( inherits( birth.date, "Date" ) ) birth.date <- as.numeric( birth.date ) / 365.35 + 1970 25 if( inherits( entry.age , "difftime" ) ) entry.age <- as.numeric( entry.age ) / 365.35 26 if( inherits( exit.age , "difftime" ) ) exit.age <- as.numeric( exit.age ) / 365.35 27 if( inherits( risk.time, "difftime" ) ) risk.time <- as.numeric( risk.time ) / 365.35 28 # Convert to numeric 29 class( entry.date ) <- "numeric" 30 class( exit.date ) <- "numeric" 31 class( birth.date ) <- "numeric" 32 class( entry.age ) <- "numeric" 33 class( exit.age ) <- "numeric" 34 class( risk.time ) <- "numeric" 35 } 36 37# Find out which three items are supplied. 38# 39wh <- (1:6)[!is.na( list( entry.date, 40 entry.age, 41 exit.date, 42 exit.age, 43 birth.date, 44 risk.time ) )] 45 46# Matrix of relevant quantities. 47# 48LL <- rbind( entry.date, 49 entry.age, 50 exit.date, 51 exit.age, 52 birth.date, 53 risk.time ) 54 55# Matrix giving the three constraints among the six quantities: 56# 57M <- rbind( c( -1, 1, 0, 0, 1, 0 ), 58 c( 0, 0, -1, 1, 1, 0 ), 59 c( 0, 1, 0, -1, 0, 1 ) ) 60 61# Now in principle we have that M %*% LL = 0. 62# Partitioning M=(A1|A2), t(LL)=(t(x1),t(x2)) 63# this gives A1 %*% x1 = -A2 %*% x2 64 65# Check if there is sufficient information 66# 67if( qr( M[,-wh[1:3]] )$rank < 3 ) 68 cat( "Insufficient information to display life lines" ) 69 70# Then do the calculation 71# 72A1 <- M[, wh[1:3]] 73A2 <- M[,-wh[1:3]] 74x1 <- LL[wh[1:3],] 75 76x2 <- -solve( A2 ) %*% A1 %*% x1 77LL[-wh[1:3],] <- x2 78LL <- data.frame( t(LL) ) 79attr( LL, "Date" ) <- conv 80 81# Convert to dates and difftimes 82if( conv ) 83 { 84 LL[,c(1,3,5)] <- ( LL[,c(1,3,5)] - 1970 ) * 365.25 85 LL[,c(2,4,6)] <- LL[,c(2,4,6)] * 365.25 86 class( LL[,1] ) <- 87 class( LL[,3] ) <- 88 class( LL[,5] ) <- "Date" 89 class( LL[,2] ) <- 90 class( LL[,4] ) <- 91 class( LL[,6] ) <- "difftime" 92 } 93 94LL 95} 96