Merge branch 'master' of github.com:fenguoerbian/LogisticFAR

fenguoerbian · Sep 4, 2024 · 171986d · 171986d
2 parents 3f6d077 + ea30306
commit 171986d
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 4 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: LogisticFAR
 Title: Logistic Functional Additive Regression with log-contrast constrain.
-Version: 0.0.0.9011
+Version: 0.0.0.9013
 Authors@R: 
     person(given = "Chao",
            family = "Cheng",

diff --git a/R/mm_path_solver.R b/R/mm_path_solver.R
@@ -778,8 +778,9 @@ Logistic_FARMM_CV_path <- function(y_vec, x_mat, h, kn, p, rand_eff_df,
         for(lam_id in 1 : lambda_length){
             delta_vec <- train_res$delta_path[lam_id, ]
             eta_stack_vec <- train_res$eta_stack_path[lam_id, ]
+
             test_pi_vec <- as.vector((x_mat_test[, 1 : h, drop = FALSE] %*% delta_vec) + (x_mat_test[, -(1 : h), drop = FALSE] %*% eta_stack_vec) * logit_weight_vec_test)
-            # test_pi_vec <- as.vector(x_mat_test %*% c(delta_vec, eta_stack_vec))
+
             loglik_test_mat[cv_id, lam_id] <- sum((y_vec_test * test_pi_vec - log(1 + exp(test_pi_vec))) * weight_vec_test)
         }
 
@@ -820,6 +821,12 @@ Logistic_FARMM_CV_path <- function(y_vec, x_mat, h, kn, p, rand_eff_df,
                 rand_eff_mat <- data.frame(subj_vec_fct = rand_eff_df_test$subj_vec_fct) %>%
                     left_join(post_est$rand_eff_est,
                               by = "subj_vec_fct") %>%
+                    dplyr::mutate(
+                        dplyr::across(
+                            tidyselect::everything(),
+                            function(invec){
+                                tidyr::replace_na(data = invec, replace = 0)
+                            })) %>%
                     select(-subj_vec_fct) %>%
                     as.matrix()
                 test_pi_vec2 <- rowSums(zmat * rand_eff_mat)
@@ -1270,7 +1277,7 @@ Logistic_FARMM_CV_path_par <- function(y_vec, x_mat, h, kn, p, rand_eff_df,
             # test_pi_vec <- as.vector(x_mat_test %*% c(delta_vec, eta_stack_vec))
             # loglik_test_mat[1, lam_id] <- sum(y_vec_test * test_pi_vec - log(1 + exp(test_pi_vec)))
             test_pi_vec <- as.vector((x_mat_test[, 1 : h, drop = FALSE] %*% delta_vec) + (x_mat_test[, -(1 : h), drop = FALSE] %*% eta_stack_vec) * logit_weight_vec_test)
-            loglik_test_mat[cv_id, lam_id] <- sum((y_vec_test * test_pi_vec - log(1 + exp(test_pi_vec))) * weight_vec_test)
+            loglik_test_mat[1, lam_id] <- sum((y_vec_test * test_pi_vec - log(1 + exp(test_pi_vec))) * weight_vec_test)
         }
 
         # test on testing set based on post-selection estimation
@@ -1304,13 +1311,19 @@ Logistic_FARMM_CV_path_par <- function(y_vec, x_mat, h, kn, p, rand_eff_df,
                 rand_eff_mat <- data.frame(subj_vec_fct = rand_eff_df_test$subj_vec_fct) %>%
                     left_join(post_est$rand_eff_est,
                               by = "subj_vec_fct") %>%
+                    dplyr::mutate(
+                        dplyr::across(
+                            tidyselect::everything(),
+                            function(invec){
+                                tidyr::replace_na(data = invec, replace = 0)
+                            })) %>%
                     select(-subj_vec_fct) %>%
                     as.matrix()
                 test_pi_vec2 <- rowSums(zmat * rand_eff_mat)
 
                 # test_pi_vec <- as.vector(x_mat_test %*% c(delta_vec, eta_stack_vec))
                 test_pi_vec <- test_pi_vec1 + test_pi_vec2
-                loglik_post_mat[cv_id, lam_id] <- sum((y_vec_test * test_pi_vec - log(1 + exp(test_pi_vec))) * weight_vec_test)
+                loglik_test_mat[2, lam_id] <- sum((y_vec_test * test_pi_vec - log(1 + exp(test_pi_vec))) * weight_vec_test)
             }
         }else{
             stop("`post_selection` must be set to `TRUE` for `Logistic_FARMM_CV_path()`!")