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