refactor

R/hcp.R

@@ -129,28 +129,6 @@ ci_hcp <- function(cis, estimates, value, dist, est, rescale, nboot, hc) {
            hc = hc)
 }
 
-.ssd_hcp_multi <- function(x, value, ci, level, nboot, min_pboot,
-                           data, rescale, weighted, censoring, min_pmix,
-                           range_shape1, range_shape2, parametric, control, 
-                           save_to, samples, fix_weights, hc) {
-  estimates <- estimates(x, multi = TRUE)
-  dist <- "multi"
-  fun <- fits_dists
-  pars <- pars_fitdists(x)
-
-  hcp <- .ssd_hcp(x, dist = dist, estimates = estimates, 
-                  fun = fun, pars = pars,
-                  value = value, ci = ci, level = level, nboot = nboot,
-                  min_pboot = min_pboot,
-                  data = data, rescale = rescale, weighted = weighted, censoring = censoring,
-                  min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2,
-                  parametric = parametric, control = control, save_to = save_to,
-                  samples = samples,
-                  hc = hc, fix_weights = fix_weights)
-  hcp$dist <- "average"
-  hcp
-}
-
 hcp_ind <- function(hcp, weight, method) {
   hcp <- mapply(
     function(x, y) {
@@ -220,7 +198,7 @@ hcp_weighted <- function(hcp, weight, value, method, nboot) {
                          data, rescale, 
                          weighted, censoring, min_pmix, range_shape1, 
                          range_shape2, parametric, fix_weights, 
-                         average, control, hc, save_to, samples, fun, method) {
+                         average, control, hc, save_to, samples, fun) {
   weight <- purrr::map_dbl(estimates, function(x) x$weight)
   hcp <- purrr::map2(x, weight, .ssd_hcp_tmbfit, 
                      value = value, ci = ci, level = level, nboot = nboot,
@@ -229,9 +207,37 @@ hcp_weighted <- function(hcp, weight, value, method, nboot) {
                      min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2,
                      parametric = parametric, fix_weights = fix_weights, average = average, control = control,
                      hc = hc, save_to = save_to, samples = samples, fun = fun)
+  method <- if (parametric) "parametric" else "non-parametric"
+
   hcp_ind(hcp, weight, method)
 }
 
+
+.ssd_hcp_multi <- function(x, value, ci, level, nboot, min_pboot,
+                           data, rescale, weighted, censoring, min_pmix,
+                           range_shape1, range_shape2, parametric, control, 
+                           save_to, samples, fix_weights, hc) {
+  estimates <- estimates(x, multi = TRUE)
+  dist <- "multi"
+  fun <- fits_dists
+  pars <- pars_fitdists(x)
+
+  hcp <- .ssd_hcp(x, dist = dist, estimates = estimates, 
+                  fun = fun, pars = pars,
+                  value = value, ci = ci, level = level, nboot = nboot,
+                  min_pboot = min_pboot,
+                  data = data, rescale = rescale, weighted = weighted, censoring = censoring,
+                  min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2,
+                  parametric = parametric, control = control, save_to = save_to,
+                  samples = samples,
+                  hc = hc, fix_weights = fix_weights)
+  hcp$dist <- "average"
+  method <- if (parametric) "parametric" else "non-parametric"
+  hcp$method <- method
+  hcp <- hcp[c("dist", "value", "est", "se", "lcl", "ucl", "wt", "method", "nboot", "pboot", "samples")]
+  hcp
+}
+
 .ssd_hcp_fitdists <- function(
     x, 
     value, 
@@ -285,14 +291,14 @@ hcp_weighted <- function(hcp, weight, value, method, nboot) {
   method <- if (parametric) "parametric" else "non-parametric"
 
   if(!average) {
-    hcp_ind <- .ssd_hcp_ind(
+    hcp <- .ssd_hcp_ind(
       x, value = value, ci = ci, level = level, nboot = nboot,
       min_pboot = min_pboot, estimates = estimates,
       data = data, rescale = rescale, weighted = weighted, censoring = censoring,
       min_pmix = min_pmix, range_shape1 = range_shape1, range_shape2 = range_shape2,
       parametric = parametric, fix_weights = fix_weights, average = average, control = control,
-      hc = hc, save_to = save_to, samples = samples, fun = fun, method = method)
-    return(hcp_ind)
+      hc = hc, save_to = save_to, samples = samples, fun = fun)
+    return(hcp)
   }
 
   if(!multi) {
@@ -319,8 +325,6 @@ hcp_weighted <- function(hcp, weight, value, method, nboot) {
     parametric = parametric, control = control, save_to = save_to, samples = samples,
     fix_weights = fix_weights, hc = hc)
 
-  hcp$method <- method
-  hcp <- hcp[c("dist", "value", "est", "se", "lcl", "ucl", "wt", "method", "nboot", "pboot", "samples")]
   hcp
 }