Merge pull request #74 from poissonconsulting/b-censorplot

NAMESPACE

@@ -68,6 +68,7 @@ export(rgompertz)
 export(rlgumbel)
 export(scale_color_ssd)
 export(scale_colour_ssd)
+export(ssd_censor_data)
 export(ssd_data)
 export(ssd_dists)
 export(ssd_dists_all)

R/censor.R

@@ -12,6 +12,32 @@
 #    See the License for the specific language governing permissions and
 #    limitations under the License.
 
+
+#' Censor Data
+#'
+#' @inheritParams params
+#'
+#' @return A tibble of the censored data.
+#' @export
+#'
+#' @examples
+#' ssd_censor_data(ssddata::ccme_boron, censoring = c(2.5, Inf))
+ssd_censor_data <- function(data, left = "Conc", ..., right = left, censoring = c(0, Inf)) {
+  .chk_data(data, left, right)
+  chk_unused(...)
+
+  if(left == right) {
+    right <- "right"
+    data$right <- data[[left]]
+  }
+
+  processed <- process_data(data, left, right)
+  censored <- censor_data(processed, censoring)
+  data[[left]] <- censored$left
+  data[[right]] <- censored$right
+  data
+}
+
 .is_censored <- function(x) {
   !identical(x, c(0, Inf))
 }
@@ -31,58 +57,43 @@ censoring_text <- function(x) {
   censoring
 }
 
-#' Is Censored
-#' `r lifecycle::badge('deprecated')`
-#'
-#' Deprecated for [`ssd_is_censored()`].
-#'
-#' @param x A fitdists object.
-#'
-#' @return A flag indicating if the data is censored.
-#' @export
-#' @seealso [`ssd_is_censored()`]
-#'
-#' @examples
-#' fits <- ssd_fit_dists(ssddata::ccme_boron)
-#' is_censored(fits)
-is_censored <- function(x) {
-  lifecycle::deprecate_warn("0.3.7", "is_censored()", "ssd_is_censored()")
-  chk_s3_class(x, "fitdists")
-  ssd_is_censored(x)
-}
-
 censor_data <- function(data, censoring) {
   if (!.is_censored(censoring)) {
     return(data)
   }
   chk_not_any_na(censoring)
-
+
+  data$right[data$left < censoring[1]] <- censoring[1]
   data$left[data$left < censoring[1]] <- 0
+  data$left[data$right > censoring[2]] <- censoring[2]
   data$right[data$right > censoring[2]] <- Inf
   data
 }
 
 censoring <- function(data) {
   censoring <- c(0, Inf)
-  data <- data[data$left != data$right, ]
+
+  censored <- data[data$left != data$right, ]
+  data <- data[data$left == data$right, ]
 
-  if (!nrow(data)) {
+  if (!nrow(censored)) {
     return(censoring)
   }
 
-  left <- data$left == 0
-  right <- is.infinite(data$right)
-
-  if (any(!left & !right)) {
+  if (any(censored$left != 0 & !is.infinite(censored$right))) {
     return(c(NA_real_, NA_real_))
   }
 
-  censoring[1] <- max(0, data$right[data$left == 0])
-  censoring[2] <- min(Inf, censoring[2], data$left[is.infinite(data$right)])
+  censoring[1] <- max(0, censored$right[censored$left == 0])
+  censoring[2] <- min(Inf, censored$left[is.infinite(censored$right)])
 
   if (censoring[1] >= censoring[2]) {
     return(c(NA_real_, NA_real_))
   }
+
+  if(any(data$right < censoring[1]) || any(data$left > censoring[2])) {
+    return(c(NA_real_, NA_real_))
+  }
 
   censoring
 }

R/censored.R

@@ -54,3 +54,23 @@ ssd_is_censored.fitdists <- function(x, ...) {
   chk_unused(...)
   .is_censored(.censoring_fitdists(x))
 }
+
+#' Is Censored
+#' `r lifecycle::badge('deprecated')`
+#'
+#' Deprecated for [`ssd_is_censored()`].
+#'
+#' @param x A fitdists object.
+#'
+#' @return A flag indicating if the data is censored.
+#' @export
+#' @seealso [`ssd_is_censored()`]
+#'
+#' @examples
+#' fits <- ssd_fit_dists(ssddata::ccme_boron)
+#' is_censored(fits)
+is_censored <- function(x) {
+  lifecycle::deprecate_warn("0.3.7", "is_censored()", "ssd_is_censored()")
+  chk_s3_class(x, "fitdists")
+  ssd_is_censored(x)
+}

R/data.R

@@ -42,7 +42,7 @@
 #' }
 #' @family dists
 #' @examples
-#' dist
+#' dist_data
 "dist_data"
 
 #' Pearson 1000 Data

R/params.R

@@ -26,6 +26,7 @@
 #' relative to the extremes for non-missing values.
 #' @param chk A flag specifying whether to check the arguments.
 #' @param ci A flag specifying whether to estimate confidence intervals (by bootstrapping).
+#' @param censoring A numeric vector of the left and right censoring values.
 #' @param color A string of the column in data for the color aesthetic.
 #' @param computable A flag specifying whether to only return fits with numerically computable standard errors.
 #' @param conc A numeric vector of concentrations to calculate the hazard proportions for.

_pkgdown.yml

@@ -42,6 +42,12 @@ reference:
   contents:
   - ssd_hp
   - ssd_hp_bcanz
+- title: Manipulate Data
+  desc: Functions that manipulate data
+  contents:
+  - ssd_censor_data
+  - ssd_data
+  - ssd_sort_data
 - title: Manipulate Fits
   desc: Functions that manipulate fits of distributions
   contents:
@@ -84,15 +90,12 @@ reference:
   - is.fitdists
   - ssd_licensing_md
   - npars
-  - ssd_data
   - ssd_ecd
   - ssd_ecd_data
   - ssd_exposure
-  - ssd_fit_dists
   - ssd_is_censored
   - ssd_match_moments
   - ssd_min_pmix
-  - ssd_sort_data
   - pearson1000
 - title: Deprecated
   desc: Deprecated functions which will become defunct in future versions

tests/testthat/_snaps/censor/boron_10.csv

@@ -0,0 +1,29 @@
+Chemical,Species,Conc,Group,Units,right
+Boron,Oncorhynchus mykiss,2.1,Fish,mg/L,2.1
+Boron,Ictalurus punctatus,2.4,Fish,mg/L,2.4
+Boron,Micropterus salmoides,4.1,Fish,mg/L,4.1
+Boron,Brachydanio rerio,10,Fish,mg/L,10
+Boron,Carassius auratus,10,Fish,mg/L,Inf
+Boron,Pimephales promelas,10,Fish,mg/L,Inf
+Boron,Daphnia magna,6,Invertebrate,mg/L,6
+Boron,Opercularia bimarginata,10,Invertebrate,mg/L,10
+Boron,Ceriodaphnia dubia,10,Invertebrate,mg/L,Inf
+Boron,Entosiphon sulcatum,10,Invertebrate,mg/L,Inf
+Boron,Chironomus decorus,10,Invertebrate,mg/L,Inf
+Boron,Paramecium caudatum,10,Invertebrate,mg/L,Inf
+Boron,Rana pipiens,10,Amphibian,mg/L,Inf
+Boron,Bufo fowleri,10,Amphibian,mg/L,Inf
+Boron,Bufo americanus,10,Amphibian,mg/L,Inf
+Boron,Ambystoma jeffersonianum,10,Amphibian,mg/L,Inf
+Boron,Ambystoma maculatum,10,Amphibian,mg/L,Inf
+Boron,Rana sylvatica,10,Amphibian,mg/L,Inf
+Boron,Elodea canadensis,1,Plant,mg/L,1
+Boron,Spirodella polyrrhiza,1.8,Plant,mg/L,1.8
+Boron,Chlorella pyrenoidosa,2,Plant,mg/L,2
+Boron,Phragmites australis,4,Plant,mg/L,4
+Boron,Chlorella vulgaris,5.2,Plant,mg/L,5.2
+Boron,Selenastrum capricornutum,10,Plant,mg/L,Inf
+Boron,Scenedesmus subspicatus,10,Plant,mg/L,Inf
+Boron,Myriophyllum spicatum,10,Plant,mg/L,Inf
+Boron,Anacystis nidulans,10,Plant,mg/L,Inf
+Boron,Lemna minor,10,Plant,mg/L,Inf

tests/testthat/_snaps/censor/boron_25.csv

@@ -0,0 +1,29 @@
+Chemical,Species,Conc,Group,Units,right
+Boron,Oncorhynchus mykiss,0,Fish,mg/L,2.5
+Boron,Ictalurus punctatus,0,Fish,mg/L,2.5
+Boron,Micropterus salmoides,4.1,Fish,mg/L,4.1
+Boron,Brachydanio rerio,10,Fish,mg/L,10
+Boron,Carassius auratus,15.6,Fish,mg/L,15.6
+Boron,Pimephales promelas,18.3,Fish,mg/L,18.3
+Boron,Daphnia magna,6,Invertebrate,mg/L,6
+Boron,Opercularia bimarginata,10,Invertebrate,mg/L,10
+Boron,Ceriodaphnia dubia,13.4,Invertebrate,mg/L,13.4
+Boron,Entosiphon sulcatum,15,Invertebrate,mg/L,15
+Boron,Chironomus decorus,20,Invertebrate,mg/L,20
+Boron,Paramecium caudatum,20,Invertebrate,mg/L,20
+Boron,Rana pipiens,20.4,Amphibian,mg/L,20.4
+Boron,Bufo fowleri,48.6,Amphibian,mg/L,48.6
+Boron,Bufo americanus,50,Amphibian,mg/L,50
+Boron,Ambystoma jeffersonianum,70.7,Amphibian,mg/L,70.7
+Boron,Ambystoma maculatum,70.7,Amphibian,mg/L,70.7
+Boron,Rana sylvatica,70.7,Amphibian,mg/L,70.7
+Boron,Elodea canadensis,0,Plant,mg/L,2.5
+Boron,Spirodella polyrrhiza,0,Plant,mg/L,2.5
+Boron,Chlorella pyrenoidosa,0,Plant,mg/L,2.5
+Boron,Phragmites australis,4,Plant,mg/L,4
+Boron,Chlorella vulgaris,5.2,Plant,mg/L,5.2
+Boron,Selenastrum capricornutum,12.3,Plant,mg/L,12.3
+Boron,Scenedesmus subspicatus,30,Plant,mg/L,30
+Boron,Myriophyllum spicatum,34.2,Plant,mg/L,34.2
+Boron,Anacystis nidulans,50,Plant,mg/L,50
+Boron,Lemna minor,60,Plant,mg/L,60

tests/testthat/_snaps/censor/boron_2510.csv

@@ -0,0 +1,29 @@
+Chemical,Species,Conc,Group,Units,right
+Boron,Oncorhynchus mykiss,0,Fish,mg/L,2.5
+Boron,Ictalurus punctatus,0,Fish,mg/L,2.5
+Boron,Micropterus salmoides,4.1,Fish,mg/L,4.1
+Boron,Brachydanio rerio,10,Fish,mg/L,10
+Boron,Carassius auratus,10,Fish,mg/L,Inf
+Boron,Pimephales promelas,10,Fish,mg/L,Inf
+Boron,Daphnia magna,6,Invertebrate,mg/L,6
+Boron,Opercularia bimarginata,10,Invertebrate,mg/L,10
+Boron,Ceriodaphnia dubia,10,Invertebrate,mg/L,Inf
+Boron,Entosiphon sulcatum,10,Invertebrate,mg/L,Inf
+Boron,Chironomus decorus,10,Invertebrate,mg/L,Inf
+Boron,Paramecium caudatum,10,Invertebrate,mg/L,Inf
+Boron,Rana pipiens,10,Amphibian,mg/L,Inf
+Boron,Bufo fowleri,10,Amphibian,mg/L,Inf
+Boron,Bufo americanus,10,Amphibian,mg/L,Inf
+Boron,Ambystoma jeffersonianum,10,Amphibian,mg/L,Inf
+Boron,Ambystoma maculatum,10,Amphibian,mg/L,Inf
+Boron,Rana sylvatica,10,Amphibian,mg/L,Inf
+Boron,Elodea canadensis,0,Plant,mg/L,2.5
+Boron,Spirodella polyrrhiza,0,Plant,mg/L,2.5
+Boron,Chlorella pyrenoidosa,0,Plant,mg/L,2.5
+Boron,Phragmites australis,4,Plant,mg/L,4
+Boron,Chlorella vulgaris,5.2,Plant,mg/L,5.2
+Boron,Selenastrum capricornutum,10,Plant,mg/L,Inf
+Boron,Scenedesmus subspicatus,10,Plant,mg/L,Inf
+Boron,Myriophyllum spicatum,10,Plant,mg/L,Inf
+Boron,Anacystis nidulans,10,Plant,mg/L,Inf
+Boron,Lemna minor,10,Plant,mg/L,Inf

tests/testthat/_snaps/hc/fullyleft.csv

@@ -0,0 +1,2 @@
+dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples
+average,0.05,0.0276016,0,0.0457802,0.0457802,1,parametric,10,1,numeric(0)

tests/testthat/_snaps/hc/partialeft.csv

@@ -0,0 +1,2 @@
+dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples
+lnorm,0.05,1.31771,NA,NA,NA,1,parametric,0,NA,numeric(0)

tests/testthat/_snaps/hc/partialeftfull.csv

@@ -0,0 +1,2 @@
+dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples
+lnorm,0.05,1.83148,0.798458,0.945173,3.2476,1,parametric,10,1,numeric(0)

tests/testthat/_snaps/hc/partialeftnonpara.csv

@@ -0,0 +1,2 @@
+dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples
+lnorm,0.05,1.31771,0.360883,0.716321,1.81154,1,non-parametric,10,1,numeric(0)

tests/testthat/_snaps/print.md

@@ -19,7 +19,7 @@
       meanlog 0.623899
       sdlog 1.31089
 
-    Parameters estimated from 28 rows of left (2.4) censored, unequally weighted and rescaled (8.408) data.
+    Parameters estimated from 28 rows of inconsistently censored, unequally weighted and rescaled (8.408) data.
 
 # summary fitdists with inconsistently censored data
 

tests/testthat/test-censor.R

@@ -12,17 +12,39 @@
 #    See the License for the specific language governing permissions and
 #    limitations under the License.
 
-test_that("censor", {
-  rlang::local_options(lifecycle_verbosity = "quiet")
+test_that("ssd_censor only add right by default", {
+  data <- ssddata::ccme_boron
+  data$right <- data$Conc
+  expect_identical(ssd_censor_data(ssddata::ccme_boron), data)
+})
 
-  fits <- ssd_fit_dists(ssddata::ccme_boron, dists = "lnorm")
+test_that("ssd_censor use existing right", {
+  data <- ssddata::ccme_boron
+  data$right2 <- data$Conc
+  expect_identical(ssd_censor_data(data, right = "right2"), data)
+})
 
-  expect_false(is_censored(fits))
+test_that("ssd_censor use existing right and left", {
+  data <- ssddata::ccme_boron
+  data$right2 <- data$Conc
+  data$left3 <- data$Conc
+  expect_identical(ssd_censor_data(data, left = "left3", right = "right2"), data)
+})
 
-  # need to have example censored data
+test_that("ssd_censor no rows", {
   data <- ssddata::ccme_boron
-  data$Right <- data$Conc
-  data$Conc <- 0
-  fits <- ssd_fit_dists(data, right = "Right", dists = c("gamma", "llogis", "lnorm"))
-  expect_true(is_censored(fits))
+  data$right <- data$Conc
+  expect_identical(ssd_censor_data(ssddata::ccme_boron[0,]), data[0,])
+})
+
+test_that("ssd_censor c(2.5, Inf)", {
+  expect_snapshot_data(ssd_censor_data(ssddata::ccme_boron, censoring = c(2.5, Inf)), "boron_25")
+})
+
+test_that("ssd_censor c(0, 10)", {
+  expect_snapshot_data(ssd_censor_data(ssddata::ccme_boron, censoring = c(0, 10)), "boron_10")
+})
+
+test_that("ssd_censor c(2.5, 10)", {
+  expect_snapshot_data(ssd_censor_data(ssddata::ccme_boron, censoring = c(2.5, 10)), "boron_2510")
 })