updates

DESCRIPTION

@@ -10,7 +10,7 @@ Depends:
 License: GPL-2
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Biarch: true
 Imports:
     formula.tools,

NAMESPACE

@@ -145,6 +145,7 @@ importFrom(graphics,mtext)
 importFrom(graphics,par)
 importFrom(graphics,plot)
 importFrom(loo,loo_model_weights)
+importFrom(modelbased,zero_crossings)
 importFrom(purrr,map)
 importFrom(purrr,map_dfr)
 importFrom(rlang,.data)

R/ecx.R

@@ -143,8 +143,8 @@ ecx.bayesnecfit <- function(object, ecx_val = 10, resolution = 1000,
   x_vec <- newdata_list$x_vec
   if (grepl("horme", object$model)) {
     n <- seq_len(nrow(p_samples))
-    p_samples <- do_wrapper(n, modify_posterior, object, x_vec,
-                            p_samples, hormesis_def, fct = "rbind")
+    #p_samples <- do_wrapper(n, modify_posterior, object, x_vec,
+    #                        p_samples, hormesis_def, fct = "rbind")
   }
   ecx_fct <- get(paste0("ecx_x_", type))
   ecx_out <- apply(p_samples, 1, ecx_fct, ecx_val, x_vec)

R/expand_classes.R

@@ -57,8 +57,11 @@ expand_nec <- function(object, formula, x_range = NA, resolution = 1000,
   }
   if (mod_class == "ecx") {
     reference <- quantile(pred_posterior[, 1], sig_val)
-    grab <- apply(pred_posterior - reference, 1, min_abs)
-    ne_posterior <- pred_data$x[grab]
+    # grab <- apply(pred_posterior - reference, 1, min_abs)
+    # ne_posterior <- pred_data$x[grab]
+    ne_posterior <- apply(pred_posterior, 1, nsec_fct, 
+                          reference = reference, x_vec = pred_data$x)
+
     x_str <- grep("crf(", labels(terms(formula)), fixed = TRUE, value = TRUE)
     x_call <- str2lang(eval(parse(text = x_str)))
     if (inherits(x_call, "call")) {

R/nsec.R

@@ -118,9 +118,9 @@ nsec.bayesnecfit <- function(object, sig_val = 0.01, resolution = 1000,
   ecnsec <- quantile(ecnsecP, probs = prob_vals)
   if (grepl("horme", object$model)) {
     n <- seq_len(nrow(p_samples))
-    p_samples <- do_wrapper(n, modify_posterior, object, x_vec,
-                            p_samples, hormesis_def, fct = "rbind")
-    nec_posterior <- as_draws_df(object$fit)[["b_nec_Intercept"]]
+    #p_samples <- do_wrapper(n, modify_posterior, object, x_vec,
+    #                        p_samples, hormesis_def, fct = "rbind")
+    #nec_posterior <- as_draws_df(object$fit)[["b_nec_Intercept"]]
     if (hormesis_def == "max") {
       reference <- quantile(apply(p_samples, 2, max), probs = sig_val)
     }
@@ -218,10 +218,19 @@ nsec.bayesmanecfit <- function(object, sig_val = 0.01, resolution = 1000,
 }
 
 #' @noRd
+#' @importFrom modelbased zero_crossings
 nsec_fct <- function(y, reference, x_vec) {
-  x_vec[min_abs(y - reference)]
+    val <- min(zero_crossings(y - reference))
+    if(is.na(val)) {
+      return(max(x_vec))} else {
+        floor_x <-  x_vec[floor(val)] 
+        ceiling_x <- x_vec[ceiling(val)]
+        prop_x <- (val-floor(val))*(ceiling_x-floor_x)
+        return(floor_x + prop_x)
+      }
 }
 
+
 #' @inheritParams nsec
 #'
 #' @param object An object of class \code{\link{brmsfit}} returned by
@@ -308,9 +317,9 @@ nsec.brmsfit <- function(object, sig_val = 0.01, resolution = 1000,
 
     if (horme) {
       n <- seq_len(nrow(p_samples))
-      p_samples <- do_wrapper(n, modify_posterior, object, x_vec,
-                                         p_samples, hormesis_def, fct = "rbind")
-      nec_posterior <- as_draws_df(object$fit)[["b_nec_Intercept"]]
+      #p_samples <- do_wrapper(n, modify_posterior, object, x_vec,
+      #                                   p_samples, hormesis_def, fct = "rbind")
+      #nec_posterior <- as_draws_df(object$fit)[["b_nec_Intercept"]]
       if (hormesis_def == "max") {
         reference <- quantile(apply(p_samples, 2, max), probs = sig_val)
       }
@@ -334,8 +343,8 @@ nsec.brmsfit <- function(object, sig_val = 0.01, resolution = 1000,
       ecnsec <- quantile(ecnsecP, probs = prob_vals)      
       if (horme) {
         n <- seq_len(nrow(p_samples))
-        p_samples <- do_wrapper(n, modify_posterior, object, x_vec,
-                                           p_samples, hormesis_def, fct = "rbind")
+        #p_samples <- do_wrapper(n, modify_posterior, object, x_vec,
+        #                                   p_samples, hormesis_def, fct = "rbind")
         nec_posterior <- as_draws_df(object$fit)[["b_nec_Intercept"]]
         if (hormesis_def == "max") {
           reference <- quantile(apply(p_samples, 2, max), probs = sig_val)