Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Prepare for cran (mainly linting) #33

Merged
merged 14 commits into from
Aug 15, 2024
1 change: 1 addition & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
Expand Up @@ -7,3 +7,4 @@
^docs$
^pkgdown$
^\.github$
^\.lintr$
34 changes: 34 additions & 0 deletions .github/workflows/lint.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,34 @@
# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
on:
push:
branches: [main, master]
pull_request:
branches: [main, master]

name: lint

permissions: read-all

jobs:
lint:
runs-on: ubuntu-latest
env:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
steps:
- uses: actions/checkout@v4

- uses: r-lib/actions/setup-r@v2
with:
use-public-rspm: true

- uses: r-lib/actions/setup-r-dependencies@v2
with:
extra-packages: any::lintr, local::.
needs: lint

- name: Lint
run: lintr::lint_package()
shell: Rscript {0}
env:
LINTR_ERROR_ON_LINT: true
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -5,3 +5,4 @@ inst/doc
docs

*.Rproj
/dev
5 changes: 5 additions & 0 deletions .lintr
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
linters: linters_with_defaults(
line_length_linter = line_length_linter(120L),
commented_code_linter = NULL,
object_name_linter = NULL
)
50 changes: 27 additions & 23 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,33 +1,37 @@
Package: distfromq
Title: Reconstruct a Distribution from a Collection of Quantiles
Version: 1.0.4
Authors@R:
c(person("Evan", "Ray", , "[email protected]", role = c("aut", "cre")),
person("Aaron", "Gerding", , "[email protected]", role = c("aut")),
person("Li", "Shandross", , "[email protected]", role = c("ctb")),
person("Nick", "Reich", , "[email protected]", role = c("ctb")))
Description: Given a set of predictive quantiles from a distribution, estimate
the distribution and create `d`, `p`, `q`, and `r` functions to evaluate its
density function, distribution function, and quantile function, and generate
random samples. On the interior of the provided quantiles, an interpolation
method such as a monotonic cubic spline is used; the tails are approximated
by a location-scale family.
Authors@R: c(
person("Evan", "Ray", , "[email protected]", role = c("aut", "cre")),
person("Aaron", "Gerding", , "[email protected]", role = "aut"),
person("Li", "Shandross", , "[email protected]", role = "ctb"),
person("Nick", "Reich", , "[email protected]", role = "ctb")
)
Description: Given a set of predictive quantiles from a distribution,
estimate the distribution and create `d`, `p`, `q`, and `r` functions
to evaluate its density function, distribution function, and quantile
function, and generate random samples. On the interior of the provided
quantiles, an interpolation method such as a monotonic cubic spline is
used; the tails are approximated by a location-scale family.
License: GPL (>= 3)
Encoding: UTF-8
LazyData: true
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.2.3
Suggests:
knitr,
rmarkdown,
dplyr,
ggplot2,
testthat (>= 3.0.0)
URL: http://reichlab.io/distfromq/
Imports:
checkmate,
purrr,
splines,
stats,
utils,
zeallot
VignetteBuilder: knitr
Suggests:
dplyr,
ggplot2,
knitr,
rmarkdown,
testthat (>= 3.0.0)
VignetteBuilder:
knitr
Config/testthat/edition: 3
URL: http://reichlab.io/distfromq/
Encoding: UTF-8
LazyData: true
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.1
112 changes: 57 additions & 55 deletions R/ext.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
a <- b <- NULL

#' Calculate location and scale parameters for a specified distribution so that
#' it matches two specified quantiles
#'
Expand All @@ -14,18 +16,18 @@
#' @return named list with entries `"a"`, the location parameter, and `"b"`, the
#' scale parameter
calc_loc_scale_params <- function(ps, qs, dist) {
if (dist == "lnorm") {
if (any(qs <= 0.0)) {
stop("For dist = 'lnorm', all qs must be positive")
}
qs <- log(qs)
qdst <- qnorm
} else {
qdst <- get(paste0("q", dist))
if (dist == "lnorm") {
if (any(qs <= 0.0)) {
stop("For dist = 'lnorm', all qs must be positive")
}
b <- suppressWarnings((qs[2] - qs[1]) / (qdst(ps[2]) - qdst(ps[1])))
a <- suppressWarnings(qs[1] - b * qdst(ps[1]))
return(list(a = a, b = b))
qs <- log(qs)
qdst <- qnorm
} else {
qdst <- get(paste0("q", dist))
}
b <- suppressWarnings((qs[2] - qs[1]) / (qdst(ps[2]) - qdst(ps[1])))
a <- suppressWarnings(qs[1] - b * qdst(ps[1]))
return(list(a = a, b = b))
}


Expand All @@ -47,25 +49,25 @@ calc_loc_scale_params <- function(ps, qs, dist) {
#' specified location-scale family that has quantiles matching those in `ps`
#' and `qs`
d_ext_factory <- function(ps, qs, dist) {
c(a, b) %<-% calc_loc_scale_params(ps, qs, dist)
c(a, b) %<-% calc_loc_scale_params(ps, qs, dist)

if (dist == "lnorm") {
d_ext <- function(x, log = FALSE) {
return(dlnorm(x, meanlog = a, sdlog = b, log = log))
}
} else {
ddst <- get(paste0("d", dist))
d_ext <- function(x, log = FALSE) {
result <- ddst((x - a) / b, log = TRUE) - log(b)
if (log) {
return(result)
} else {
return(exp(result))
}
}
if (dist == "lnorm") {
d_ext <- function(x, log = FALSE) {
return(dlnorm(x, meanlog = a, sdlog = b, log = log))
}
} else {
ddst <- get(paste0("d", dist))
d_ext <- function(x, log = FALSE) {
result <- ddst((x - a) / b, log = TRUE) - log(b)
if (log) {
return(result)
} else {
return(exp(result))
}
}
}

return(d_ext)
return(d_ext)
}


Expand All @@ -87,21 +89,21 @@ d_ext_factory <- function(ps, qs, dist) {
#' distribution in the specified location-scale family that has quantiles
#' matching those in `ps` and `qs`
p_ext_factory <- function(ps, qs, dist) {
c(a, b) %<-% calc_loc_scale_params(ps, qs, dist)
c(a, b) %<-% calc_loc_scale_params(ps, qs, dist)

if (dist == "lnorm") {
p_ext <- function(q, log.p = FALSE) {
return(plnorm(q, meanlog = a, sdlog = b, log.p = log.p))
}
} else {
pdst <- get(paste0("p", dist))
if (dist == "lnorm") {
p_ext <- function(q, log.p = FALSE) {
return(plnorm(q, meanlog = a, sdlog = b, log.p = log.p))
}
} else {
pdst <- get(paste0("p", dist))

p_ext <- function(q, log.p = FALSE) {
return(pdst((q - a) / b, log.p = log.p))
}
p_ext <- function(q, log.p = FALSE) {
return(pdst((q - a) / b, log.p = log.p))
}
}

return(p_ext)
return(p_ext)
}


Expand All @@ -122,25 +124,25 @@ p_ext_factory <- function(ps, qs, dist) {
#' quantile function of the distribution in the specified location-scale
#' family that has quantiles matching those in `ps` and `qs`
q_ext_factory <- function(ps, qs, dist) {
c(a, b) %<-% calc_loc_scale_params(ps, qs, dist)
c(a, b) %<-% calc_loc_scale_params(ps, qs, dist)

if (dist == "lnorm") {
q_ext <- function(p) {
return(qlnorm(p, meanlog = a, sdlog = b))
}
} else {
qdst <- get(paste0("q", dist))
if (dist == "lnorm") {
q_ext <- function(p) {
return(qlnorm(p, meanlog = a, sdlog = b))
}
} else {
qdst <- get(paste0("q", dist))

if (b == 0) {
q_ext <- function(p) {
rep(a, length(p))
}
} else {
q_ext <- function(p) {
return(a + b * qdst(p))
}
}
if (b == 0) {
q_ext <- function(p) {
rep(a, length(p))
}
} else {
q_ext <- function(p) {
return(a + b * qdst(p))
}
}
}

return(q_ext)
return(q_ext)
}
Loading
Loading