Merge pull request #359 from poissonconsulting/dev

- Add `trans = "log10"` and `add_x = 0` arguments to `ssd_plot()` and `ssd_plot_data()`

R/params.R

@@ -13,6 +13,7 @@
 #    limitations under the License.
 
 #' Parameter Descriptions for ssdtools Functions
+#' @param add_x The value to add to the label x values (before multiplying by `shift_x`).
 #' @param all A flag specifying whether to also return transformed parameters.
 #' @param all_dists A flag specifying whether all the named distributions must fit successfully.
 #' @param at_boundary_ok A flag specifying whether a model with one or more
@@ -96,9 +97,10 @@
 #' @param shape	shape parameter.
 #' @param shape1 shape1 parameter.
 #' @param shape2 shape2 parameter.
-#' @param shift_x The value to multiply the label x values by.
+#' @param shift_x The value to multiply the label x values by (after adding `add_x`).
 #' @param silent A flag indicating whether fits should fail silently.
 #' @param size A number for the size of the labels.
+#' @param trans A string which transformation to use by default `"log10"`.
 #' @param weight A string of the numeric column in data with positive weights less than or equal to 1,000 or NULL.
 #' @param weighted A flag which specifies whether to use the original model weights (as opposed to re-estimating for each bootstrap sample) unless `multi_ci = FALSE` in which case it specifies
 #' whether to take bootstrap samples from each distribution proportional to 

R/plot-data.R

@@ -25,17 +25,20 @@
 ssd_plot_data <- function(data, left = "Conc", right = left,
                           label = NULL, shape = NULL, color = NULL, size = 2.5,
                           xlab = "Concentration", ylab = "Species Affected",
-                          shift_x = 3,
+                          shift_x = 3, add_x = 0,
                           bounds = c(left = 1, right = 1),
-                          xbreaks = waiver()) {
+                          trans = "log10", xbreaks = waiver()) {
   .chk_data(data, left, right, weight = NULL, missing = TRUE)
   chk_null_or(label, vld = vld_string)
   chk_null_or(shape, vld = vld_string)
   check_names(data, c(unique(c(left, right)), label, shape))
 
   chk_number(shift_x)
   chk_range(shift_x, c(1, 1000))
-
+
+  chk_number(add_x)
+  chk_range(add_x, c(-1000, 1000))
+
   .chk_bounds(bounds)
 
   data <- process_data(data, left, right, weight = NULL)
@@ -81,10 +84,11 @@ ssd_plot_data <- function(data, left = "Conc", right = left,
       ), stat = "identity")
   }
 
-  gp <- gp + plot_coord_scale(data, xlab = xlab, ylab = ylab, xbreaks = xbreaks)
+  gp <- gp + plot_coord_scale(data, xlab = xlab, ylab = ylab, 
+                              trans = trans, xbreaks = xbreaks)
 
   if (!is.null(label)) {
-    data$right <- data$right * shift_x
+    data$right <- (data$right + add_x) * shift_x
     gp <- gp + geom_text(
       data = data, aes(x = !!sym("right"), y = !!sym("y"), label = !!label),
       hjust = 0, size = size, fontface = "italic"

R/ssd-plot.R

@@ -15,16 +15,16 @@
 #' @export
 ggplot2::waiver
 
-plot_coord_scale <- function(data, xlab, ylab, xbreaks = waiver()) {
+plot_coord_scale <- function(data, xlab, ylab, trans, xbreaks = waiver()) {
   chk_string(xlab)
   chk_string(ylab)
 
-  if (is.waive(xbreaks)) {
+  if (is.waive(xbreaks) & trans == "log10") {
     xbreaks <- trans_breaks("log10", function(x) 10^x)
   }
-
+  
   list(
-    coord_trans(x = "log10"),
+    coord_trans(x = trans),
     scale_x_continuous(xlab,
       breaks = xbreaks,
       labels = comma_signif
@@ -50,9 +50,10 @@ ssd_plot <- function(data, pred, left = "Conc", right = left,
                      label = NULL, shape = NULL, color = NULL, size = 2.5,
                      linetype = NULL, linecolor = NULL,
                      xlab = "Concentration", ylab = "Species Affected",
-                     ci = TRUE, ribbon = FALSE, hc = 0.05, shift_x = 3,
+                     ci = TRUE, ribbon = FALSE, hc = 0.05, 
+                     shift_x = 3, add_x = 0,
                      bounds = c(left = 1, right = 1),
-                     xbreaks = waiver()) {
+                     trans = "log10", xbreaks = waiver()) {
   .chk_data(data, left, right, weight = NULL, missing = TRUE)
   chk_null_or(label, vld = vld_string)
   chk_null_or(shape, vld = vld_string)
@@ -68,7 +69,9 @@ ssd_plot <- function(data, pred, left = "Conc", right = left,
 
   chk_number(shift_x)
   chk_range(shift_x, c(1, 1000))
-
+  chk_number(add_x)
+  chk_range(add_x, c(-1000, 1000))
+
   chk_flag(ci)
   chk_flag(ribbon)
 
@@ -78,6 +81,7 @@ ssd_plot <- function(data, pred, left = "Conc", right = left,
     chk_subset(hc, pred$proportion)
   }
   .chk_bounds(bounds)
+  chk_string(trans)
 
   data <- process_data(data, left, right, weight = NULL)
   data <- bound_data(data, bounds)
@@ -149,10 +153,11 @@ ssd_plot <- function(data, pred, left = "Conc", right = left,
       ), stat = "identity")
   }
 
-  gp <- gp + plot_coord_scale(data, xlab = xlab, ylab = ylab, xbreaks = xbreaks)
+  gp <- gp + plot_coord_scale(data, xlab = xlab, ylab = ylab,
+                              trans = trans, xbreaks = xbreaks)
 
   if (!is.null(label)) {
-    data$right <- data$right * shift_x
+    data$right <- (data$right + add_x) * shift_x
     gp <- gp + geom_text(
       data = data, aes(x = !!sym("right"), y = !!sym("y"), label = !!label),
       hjust = 0, size = size, fontface = "italic"

tests/testthat/_snaps/zzz-unstable.md

@@ -137,3 +137,51 @@
       Error in `checkwz()`:
       ! Some elements in the working weights variable 'wz' are not finite
 
+# sgompertz cant even initialize lots of values
+
+    Code
+      set.seed(99)
+      ssdtools:::sgompertz(data.frame(left = x, right = x))
+    Condition
+      Error in `checkwz()`:
+      ! Some elements in the working weights variable 'wz' are not finite
+    Code
+      set.seed(99)
+      ssd_fit_dists(data.frame(Conc = x), dists = "gompertz")
+    Condition
+      Warning:
+      Distribution 'gompertz' failed to fit (try rescaling data): Error in checkwz(wz, M = M, trace = trace, wzepsilon = control$wzepsilon) : 
+        Some elements in the working weights variable 'wz' are not finite
+      .
+      Error:
+      ! All distributions failed to fit.
+    Code
+      set.seed(100)
+      ssdtools:::sgompertz(data.frame(left = x, right = x))
+    Output
+      $log_location
+      [1] -0.9424722
+      
+      $log_shape
+      [1] -128.6335
+      
+    Code
+      set.seed(100)
+      ssd_fit_dists(data.frame(Conc = x), dists = "gompertz")
+    Condition
+      Warning:
+      Distribution 'gompertz' failed to fit (try rescaling data): Error in optim(par, fn, gr, method = method, lower = lower, upper = upper,  : 
+        L-BFGS-B needs finite values of 'fn'
+      .
+      Error:
+      ! All distributions failed to fit.
+    Code
+      set.seed(131)
+      ssd_fit_dists(data.frame(Conc = x), dists = "gompertz")
+    Output
+      Distribution 'gompertz'
+        location 0.0256225
+        shape 3.35465e-14
+      
+      Parameters estimated from 1000 rows of data.
+

tests/testthat/_snaps/zzz-unstable/tidy_lnorm_lnorm_uni1000_3n.csv

@@ -0,0 +1,6 @@
+dist,term,est,se
+lnorm_lnorm,meanlog1,2.4389,0.00991542
+lnorm_lnorm,meanlog2,2.44216,7.12844e-4
+lnorm_lnorm,pmix,0.0353095,0.0648397
+lnorm_lnorm,sdlog1,0.0376977,0.0159742
+lnorm_lnorm,sdlog2,0.018095,0.00101426

tests/testthat/test-plot-data.R

@@ -17,5 +17,6 @@ test_that("ssd_plot_data ccme_boron", {
 })
 
 test_that("ssd_plot_data ccme_boron color", {
-  expect_snapshot_plot(ssd_plot_data(ssddata::ccme_boron, color = "Group", label = "Species"), "ccme_boron2")
+  expect_snapshot_plot(ssd_plot_data(ssddata::ccme_boron, color = "Group", label = "Species", trans = "identity",
+                                     shift_x = 1, add_x = 10), "ccme_boron2")
 })