update codes

CRAN-SUBMISSION

@@ -1,3 +1,3 @@
-Version: 1.3.1
-Date: 2023-03-26 15:27:53 UTC
-SHA: 1c3f7f88b34a769563adce99a340d44246ac52b9
+Version: 1.4.0
+Date: 2023-10-10 20:58:19 UTC
+SHA: e021f13e9ded67c3f0beebaadd8b72c4b34a66aa

R/MAEQjmcs.R

@@ -72,8 +72,7 @@ MAEQjmcs <- function(seed = 100, object, landmark.time = NULL, horizon.time = NU
                       quadpoint = quadpoint, random = object$random,
                       maxiter = maxiter, 
                       survinitial = survinitial,
-                      opt = object$opt,
-                    ), silent = TRUE)
+                      opt = object$opt), silent = TRUE)
 
     if ('try-error' %in% class(fit)) {
       writeLines(paste0("Error occured in the ", t, " th training!"))

R/jmcs.R

@@ -196,6 +196,9 @@ jmcs <- function(ydata, cdata, long.formula, random = NULL, surv.formula, REML =
 
   longfmla <- long.formula
   survfmla <- surv.formula
+
+  rawydata <- ydata
+  rawcdata <- cdata
 
   getinit <- Getinit(cdata = cdata, ydata = ydata, long.formula = long.formula,
                      surv.formula = surv.formula,
@@ -457,7 +460,7 @@ jmcs <- function(ydata, cdata, long.formula, random = NULL, surv.formula, REML =
                      H02, Sig, sigma, iter, convergence, vcov, sebeta, segamma1,
                      segamma2, sealpha1, sealpha2, seSig, sesigma, getloglike, 
                      getfitted, getfittedSurv, FUNB, CompetingRisk,
-                     quadpoint, ydata, cdata, PropComp, FunCall_long,
+                     quadpoint, rawydata, rawcdata, PropComp, FunCall_long,
                      FunCall_survival, random, mycall, method, id, opt)
 
       names(result) <- c("beta", "gamma1", "gamma2", "nu1", "nu2", "H01", "H02", "Sig", 
@@ -612,7 +615,7 @@ jmcs <- function(ydata, cdata, long.formula, random = NULL, surv.formula, REML =
       result <- list(beta, gamma1, alpha1, H01, Sig, sigma, iter, convergence, 
                      vcov, sebeta, segamma1, sealpha1, seSig, sesigma, getloglike, 
                      getfitted, getfittedSurv, FUNB, CompetingRisk,
-                     quadpoint, ydata, cdata, PropComp, FunCall_long, FunCall_survival, 
+                     quadpoint, rawydata, rawcdata, PropComp, FunCall_long, FunCall_survival, 
                      random, mycall, method, id, opt)
 
       names(result) <- c("beta", "gamma1", "nu1", "H01", "Sig", "sigma",

R/survfitjmcs.R

@@ -85,8 +85,8 @@ survfitjmcs <- function(object, seed = 100, ynewdata = NULL, cnewdata = NULL,
   Ny <- nrow(ydata2)
   Nc <- nrow(cdata2)
 
-  ynewdata <- ydata2[c((Ny-ny+1):Ny), ]
-  cnewdata <- cdata2[c((Nc-nc+1):Nc), ]
+  ynewdata2 <- ydata2[c((Ny-ny+1):Ny), ]
+  cnewdata2 <- cdata2[c((Nc-nc+1):Nc), ]
 
 
   nsig <- nrow(object$Sig)
@@ -97,25 +97,25 @@ survfitjmcs <- function(object, seed = 100, ynewdata = NULL, cnewdata = NULL,
   wsmatrix <- getGH$wsmatrix
 
   if (length(bvar) > 1) bvar1 <- bvar[1:(length(bvar) - 1)]
-  yID <- unique(ynewdata[, ID])
+  yID <- unique(ynewdata2[, ID])
   N.ID <- length(yID)
-  cID <- cnewdata[, ID]
+  cID <- cnewdata2[, ID]
   if (prod(yID == cID) == 0) {
     stop("The order of subjects in ydata doesn't match with cnewdata.")
   }
 
   if (!is.null(Last.time)) {
     if (is.character(Last.time)) {
-      if (Last.time %in% colnames(cnewdata)) {
-        Last.time <- cnewdata[, Last.time]
+      if (Last.time %in% colnames(cnewdata2)) {
+        Last.time <- cnewdata2[, Last.time]
       } else {
         stop(paste(Last.time, "is not found in cnewdata."))
       }
     }
-    if (is.numeric(Last.time) && (length(Last.time) != nrow(cnewdata)))
+    if (is.numeric(Last.time) && (length(Last.time) != nrow(cnewdata2)))
       stop("The last.time vector does not match cnewdata.")
   } else {
-    Last.time <- cnewdata[, Cvar[1]]
+    Last.time <- cnewdata2[, Cvar[1]]
   }
 
   Pred <- list()
@@ -134,14 +134,14 @@ survfitjmcs <- function(object, seed = 100, ynewdata = NULL, cnewdata = NULL,
     H02 <- object$H02
     Sig <- object$Sig
 
-    Predraw1 <- matrix(0, nrow = nrow(cnewdata), ncol = length(u))
-    Predraw2 <- matrix(0, nrow = nrow(cnewdata), ncol = length(u))
+    Predraw1 <- matrix(0, nrow = nrow(cnewdata2), ncol = length(u))
+    Predraw2 <- matrix(0, nrow = nrow(cnewdata2), ncol = length(u))
     lengthu <- length(u)
 
     for (j in 1:N.ID) {
-      subNDy <- ynewdata[ynewdata[, ID] == yID[j], ]
-      subNDc <- cnewdata[cnewdata[, ID] == yID[j], ]
-      y.obs[[j]] <- data.frame(subNDy[, c(obs.time, Yvar[1])])
+      subNDy <- ynewdata2[ynewdata2[, ID] == yID[j], ]
+      subNDc <- cnewdata2[cnewdata2[, ID] == yID[j], ]
+      y.obs[[j]] <- data.frame(ynewdata[ynewdata[, ID] == yID[j], c(obs.time, Yvar[1])])
 
       s <-  as.numeric(Last.time[j])
       CH01 <- CH(H01, s)
@@ -213,9 +213,9 @@ survfitjmcs <- function(object, seed = 100, ynewdata = NULL, cnewdata = NULL,
     lengthu <- length(u)
 
     for (j in 1:N.ID) {
-      subNDy <- ynewdata[ynewdata[, ID] == yID[j], ]
-      subNDc <- cnewdata[cnewdata[, ID] == yID[j], ]
-      y.obs[[j]] <- data.frame(subNDy[, c(obs.time, Yvar[1])])
+      subNDy <- ynewdata2[ynewdata2[, ID] == yID[j], ]
+      subNDc <- cnewdata2[cnewdata2[, ID] == yID[j], ]
+      y.obs[[j]] <- data.frame(ynewdata[ynewdata[, ID] == yID[j], c(obs.time, Yvar[1])])
 
       CH0 <- CH(H01, Last.time[j])
 

src/getCov.cpp

@@ -789,9 +789,9 @@ Rcpp::List getCov(const Eigen::VectorXd & beta, const Eigen::VectorXd & gamma1,
     }
 
     /*calculate sigma*/
+    for (i=0;i<p1a;i++) bs(i,i) = FUNBS(i, j);
     if(p1a>1)
     {
-      for (i=0;i<p1a;i++) bs(i,i) = FUNBS(i, j);
       for(i=1;i<p1a;i++)
       {
         for(t=0;t<p1a-i;t++) {

src/getCovSF.cpp

@@ -433,9 +433,9 @@ Rcpp::List getCovSF(const Eigen::VectorXd & beta, const Eigen::VectorXd & gamma1
     }
 
     /*calculate sigma*/
+    for (i=0;i<p1a;i++) bs(i,i) = FUNBS(i, j);
     if(p1a>1)
     {
-      for (i=0;i<p1a;i++) bs(i,i) = FUNBS(i, j);
       for(i=1;i<p1a;i++)
       {
         for(t=0;t<p1a-i;t++) {