Add a hack to deal with infinite upper bound confidence interval. Thi…

…s arises when `standard errors` are too high. In that case, use the `response` type and its `standard errors` instead. Need to revisit this after talking to Chris. Re #100
ITHIM · May 31, 2022 · 97b5be7 · 97b5be7
1 parent 7006e4a
commit 97b5be7
Showing 1 changed file with 8 additions and 3 deletions.
diff --git a/R/injuries_function_2.R b/R/injuries_function_2.R
@@ -42,11 +42,16 @@ injuries_function_2 <- function(true_distances,injuries_list,reg_model,constant_
                                                                  type='link', se.fit = TRUE)[1:2]),
                                          c('fit_link','se_link')))
 
+
+      pred_val <- predict(reg_model[[type]],newdata = remove_missing_levels(reg_model[[type]],injuries_list[[scen]][[type]]), type='response', se.fit = TRUE) %>% as.data.frame()
+      injuries_list[[scen]][[type]]$pred_ub_am <- pred_val$fit + (2 * pred_val$se.fit)
+
       ## create the interval and back-transform
       injuries_list[[scen]][[type]] <- mutate(injuries_list[[scen]][[type]],
-                      pred  = ilink(fit_link),
-                      pred_ub = ilink(fit_link + (2 * se_link)),
-                      pred_lb = ilink(fit_link - (2 * se_link)))
+                                              pred  = ilink(fit_link),
+                                              pred_ub = ifelse(is.infinite(ilink(fit_link + (2 * se_link))), pred_ub_am, 
+                                                               ilink(fit_link + (2 * se_link))),
+                                              pred_lb = ilink(fit_link - (2 * se_link)))
 
       if(constant_mode){
         whw_temp[[scen]][[type]] <- sapply(unique(injuries_list[[scen]][[type]]$cas_mode),function(x)