diff --git a/R/support.R b/R/support.R index d0c3d8fb..a0cfe6dc 100644 --- a/R/support.R +++ b/R/support.R @@ -4,7 +4,7 @@ #' @param limits A list of value limits for the distribution. #' @param closed A list of logical(2L) indicating whether the limits are closed. #' -new_support_region <- function(x, limits = NULL, closed = list(c(TRUE, TRUE))) { +new_support_region <- function(x = numeric(), limits = list(), closed = list()) { vctrs::new_rcrd(list(x = x, lim = limits, closed = closed), class = "support_region") } @@ -28,12 +28,13 @@ format.support_region <- function(x, digits = 3, ...) { br2 <- brackets[[2]][closed[2] + 1L] fz <- sapply(z, function(x) format(x, digits = digits)) fz <- gsub("3.14", "pi", fz, fixed = TRUE) - if(any(is.na(z)) || all(is.infinite(z))) type - else if (type == "Z" && identical(z[2], Inf)) { - if(z[1] == 0L) "N0" else if (z[1] == 1L) "N+" else paste0(br1, z[1], ",", z[1]+1L, ",...,", z[2], br2) + if (any(is.na(z)) || all(is.infinite(z))) type + else if (type == "Z") { + if (identical(z, c(0L, Inf))) "N0" + else if (identical(z, c(1L, Inf))) "N+" + else paste0("{", z[1], ",", z[1]+1L, ",...,", z[2], "}") } else if (type == "R") paste0(br1, fz[1], ",", fz[2], br2) - else if (type == "Z") paste0(br1, z[1], ",", z[1]+1L, ",...,", z[2], br2) else type }, type, field(x, "lim"), field(x, "closed")) } diff --git a/R/transformed.R b/R/transformed.R index d25e7577..c052d08b 100755 --- a/R/transformed.R +++ b/R/transformed.R @@ -41,7 +41,7 @@ format.dist_transformed <- function(x, ...){ support.dist_transformed <- function(x, ...) { support <- support(x[["dist"]]) lim <- field(support, "lim")[[1]] - lim <- SW(x[['transform']](lim)) + lim <- suppressWarnings(x[['transform']](lim)) if (all(!is.na(lim))) { lim <- sort(lim) } @@ -51,22 +51,22 @@ support.dist_transformed <- function(x, ...) { #' @export density.dist_transformed <- function(x, at, ...){ - inv <- function(v) SW(x[["inverse"]](v)) + inv <- function(v) suppressWarnings(x[["inverse"]](v)) jacobian <- vapply(at, numDeriv::jacobian, numeric(1L), func = inv) d <- density(x[["dist"]], inv(at)) * abs(jacobian) limits <- field(support(x), "lim")[[1]] closed <- field(support(x), "closed")[[1]] if (!any(is.na(limits))) { - `%op1%` <- if (closed[1]) `<` else `<=` - `%op2%` <- if (closed[2]) `>` else `>=` - d[which(at %op1% limits[1] | at %op2% limits[2])] <- 0 + `%less_than%` <- if (closed[1]) `<` else `<=` + `%greater_than%` <- if (closed[2]) `>` else `>=` + d[which(at %less_than% limits[1] | at %greater_than% limits[2])] <- 0 } d } #' @export cdf.dist_transformed <- function(x, q, ...){ - inv <- function(v) SW(x[["inverse"]](v)) + inv <- function(v) suppressWarnings(x[["inverse"]](v)) p <- cdf(x[["dist"]], inv(q), ...) limits <- field(support(x), "lim")[[1]] if (!any(is.na(limits))) { diff --git a/R/utils.R b/R/utils.R index e5040fd0..9117e186 100644 --- a/R/utils.R +++ b/R/utils.R @@ -153,7 +153,3 @@ near <- function(x, y) { tol <- .Machine$double.eps^0.5 abs(x - y) < tol } - -SW <- function(x) { - suppressWarnings(x) -}