Fixing problem with IPCweights() when survival time is not numeric (f…

…ixes #54)

R/survival.R

@@ -53,10 +53,10 @@ IPCweights <- function(x, maxweight = 5) {
     if (!extends(class(x), "Surv"))
         stop(sQuote("x"), " is not a Surv object")
 
-    event <- x[,"status"]
-    x[,"status"] <- 1 - event
+    event <- x[,2]
+    x[,2] <- 1 - event
     km <- survfit(x ~ 1)
-    Ghat <- getsurv(km, times = x[,"time"])
+    Ghat <- getsurv(km, times = x[,1]) ## see github issue #54
     Ghat[event == 0] <- 1
     w <- event / Ghat
     w[w > maxweight] <- maxweight

inst/NEWS.Rd

@@ -14,6 +14,8 @@
   }
   \subsection{Bug-fixes}{
      \itemize{
+      \item Solve potential problem with \code{IPCweights()}. Fixes
+      \href{https://github.com/boost-R/mboost/issues/54}{#54}.
        \item Drop unobserved factor levels from \code{bols()}. Fixes
       \href{https://github.com/boost-R/mboost/issues/47}{#47}.
       }

tests/bugfixes.R

@@ -516,3 +516,21 @@ mod <- mboost(vol ~ bbs(x1, df = 3, knots = 10)%O%
 mod <- mboost(vol ~ bbs(x1, df = 3, knots = 3) %O%
                 bbs(x2, df = 3, knots = 3),
               control = boost_control(nu = 0.25))
+
+
+### IPCweights problem, see github issue #54
+
+if (require("survival")){
+  x1 <- rnorm(100)
+  x2 <- x1 + rnorm(100)
+  X <- cbind(x1, x2)
+  beta <- c(1, 0.5)
+  survtime <- exp(X%*%beta)
+  event <- rep(c(TRUE, FALSE), 50)
+
+  ipcw1 <- IPCweights(Surv(survtime, event))
+  ipcw2 <- IPCweights(Surv(as.numeric(survtime), event))
+  summary(cbind(ipcw1, ipcw2))
+
+  stopifnot(identical(ipcw1, ipcw2))
+}