Skip to content

Commit f4e5093

Browse files
committed
Removed withr dependency
1 parent 961b59a commit f4e5093

12 files changed

Lines changed: 83 additions & 48 deletions

DESCRIPTION

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -21,8 +21,7 @@ Depends:
2121
R (>= 3.5)
2222
Imports:
2323
graphics,
24-
stats,
25-
withr
24+
stats
2625
Suggests:
2726
dplyr,
2827
purrr,

NAMESPACE

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -59,5 +59,3 @@ importFrom(stats,qnorm)
5959
importFrom(stats,qt)
6060
importFrom(stats,quantile)
6161
importFrom(stats,sd)
62-
importFrom(withr,local_options)
63-
importFrom(withr,local_par)

R/ISCAM-package.R

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,5 @@
55
#' @importFrom graphics abline axis bxp grid hist legend lines mtext par points polygon stripchart text title
66
#' @importFrom stats dbinom dchisq dexp dhyper dlnorm dnorm dt median pbinom pchisq phyper pnorm pt qbeta qbinom qnorm qt quantile sd
77
#' @importFrom stats prop.test
8-
#' @importFrom withr local_par local_options
98
## usethis namespace: end
109
NULL

R/binomial.R

Lines changed: 20 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,8 @@
1414
#' @examples
1515
#' iscambinomnorm(k = 10, n = 20, prob = 0.5, direction = "two.sided")
1616
iscambinomnorm <- function(k, n, prob, direction) {
17-
withr::local_par(mar = c(5, 3, 1, 1))
17+
old <- par(mar = c(5, 3, 1, 1))
18+
on.exit(par(old), add = TRUE)
1819

1920
thisx <- 0:n
2021
phat <- thisx / n
@@ -245,8 +246,10 @@ iscambinompower <- function(LOS, n, prob1, alternative, prob2 = NULL) {
245246
)
246247
)
247248
myy1 <- dbinom(floor(n * prob1), n, prob1) / 2
248-
withr::local_par(mfrow = c(2, 1))
249-
withr::local_par(mar = c(4, 3, 2, 2))
249+
old <- par(mfrow = c(2, 1))
250+
on.exit(par(old), add = TRUE)
251+
old <- par(mar = c(4, 3, 2, 2))
252+
on.exit(par(old), add = TRUE)
250253
plot(
251254
thisx,
252255
dbinom(thisx, size = n, prob1),
@@ -413,7 +416,8 @@ iscambinompower <- function(LOS, n, prob1, alternative, prob2 = NULL) {
413416
)
414417
title(newtitle)
415418
}
416-
withr::local_par(mfrow = c(1, 1))
419+
old <- par(mfrow = c(1, 1))
420+
on.exit(par(old), add = TRUE)
417421
}
418422

419423
#' Calculate Binomial Tail Probabilities
@@ -438,7 +442,8 @@ iscambinomprob <- function(k, n, prob, lower.tail) {
438442
stop("Error: `prob` (probability) must be a numeric value between 0 and 1.")
439443
}
440444

441-
withr::local_par(mar = c(4, 3, 2, 2))
445+
old <- par(mar = c(4, 3, 2, 2))
446+
on.exit(par(old), add = TRUE)
442447
thisx <- 0:n
443448
minx <- max(0, n * prob - 4 * sqrt(prob * (1 - prob) * n))
444449
maxx <- min(n, n * prob + 4 * sqrt(prob * (1 - prob) * n))
@@ -543,7 +548,8 @@ iscambinomtest <- function(
543548
alternative,
544549
conf.level = NULL
545550
) {
546-
withr::local_par(mar = c(4, 3, 2, 2))
551+
old <- par(mar = c(4, 3, 2, 2))
552+
on.exit(par(old), add = TRUE)
547553

548554
if (observed < 1) {
549555
observed <- round(n * observed)
@@ -691,9 +697,11 @@ iscambinomtest <- function(
691697
upper1[k] <- as.numeric(CINT[3])
692698
}
693699
}
694-
withr::local_par(mar = c(4, 2, 1.5, .5), mfrow = c(3, 1))
700+
old <- par(mar = c(4, 2, 1.5, .5), mfrow = c(3, 1))
701+
on.exit(par(old), add = TRUE)
695702
if (length(conf.level) > 1) {
696-
withr::local_par(mar = c(4, 2, 1.5, .4), mfrow = c(length(conf.level), 1))
703+
old <- par(mar = c(4, 2, 1.5, .4), mfrow = c(length(conf.level), 1))
704+
on.exit(par(old), add = TRUE)
697705
}
698706

699707
if (is.null(hypothesized)) {
@@ -770,7 +778,8 @@ iscambinomtest <- function(
770778
} # end intervals loop
771779
} # end no hypothesized
772780

773-
withr::local_par(mfrow = c(1, 1))
781+
old <- par(mfrow = c(1, 1))
782+
on.exit(par(old), add = TRUE)
774783
invisible(list("pvalue" = pvalue, "lower" = lower1, "upper" = upper1))
775784
}
776785

@@ -791,7 +800,8 @@ iscambinomtest <- function(
791800
#'
792801
#' iscaminvbinom(alpha = 0.01, n = 60, prob = 0.10, lower.tail = FALSE)
793802
iscaminvbinom <- function(alpha, n, prob, lower.tail) {
794-
withr::local_par(mar = c(4, 3, 2, 2))
803+
old <- par(mar = c(4, 3, 2, 2))
804+
on.exit(par(old), add = TRUE)
795805

796806
thisx <- 0:n
797807
minx <- max(0, n * prob - 4 * sqrt(prob * (1 - prob) * n))

R/chisqprob.R

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,8 @@
1515
#' @examples
1616
#' iscamchisqprob(5, 3)
1717
iscamchisqprob <- function(xval, df) {
18-
withr::local_par(mar = c(4, 4, 2, 1))
18+
old <- par(mar = c(4, 4, 2, 1))
19+
on.exit(par(old), add = TRUE)
1920

2021
minx <- 0
2122
maxx <- max(20, xval, df)

R/hypergeometric.R

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,8 @@
1616
#' iscamhypernorm(1, 20, 5, 10, TRUE)
1717
iscamhypernorm <- function(k, total, succ, n, lower.tail) {
1818
# TODO rewrite so that it uses hyperprob and overlay normal?
19-
withr::local_par(mar = c(4, 4, 2, 1))
19+
old <- par(mar = c(4, 4, 2, 1))
20+
on.exit(par(old), add = TRUE)
2021

2122
if (k < 1) {
2223
k <- round((k * n * (total - n) + n * succ) / total)
@@ -152,7 +153,8 @@ iscamhypernorm <- function(k, total, succ, n, lower.tail) {
152153
#' @examples
153154
#' iscamhyperprob(1, 20, 5, 10, TRUE)
154155
iscamhyperprob <- function(k, total, succ, n, lower.tail) {
155-
withr::local_par(mar = c(4, 4, 2, 1))
156+
old <- par(mar = c(4, 4, 2, 1))
157+
on.exit(par(old), add = TRUE)
156158

157159
if (k < 1 & k > 0) {
158160
k <- round((k * (total - n) * n + succ * n) / total)

R/normal.R

Lines changed: 24 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,8 @@ iscamnormprob <- function(
3333
xval2 = NULL,
3434
digits = 4
3535
) {
36-
withr::local_par(mar = c(4, 3, 2, 1))
36+
old <- par(mar = c(4, 3, 2, 1))
37+
on.exit(par(old), add = TRUE)
3738

3839
if (is.null(xval2)) {
3940
xval2 <- abs(xval)
@@ -207,7 +208,8 @@ iscaminvnorm <- function(prob1, mean = 0, sd = 1, Sd = sd, direction) {
207208
if (missing(sd) && !missing(Sd)) {
208209
sd <- Sd
209210
}
210-
withr::local_par(mar = c(4, 3, 2, 2))
211+
old <- par(mar = c(4, 3, 2, 2))
212+
on.exit(par(old), add = TRUE)
211213
min <- mean - 4 * sd
212214
max <- mean + 4 * sd
213215
thisx <- seq(min, max, .001)
@@ -366,7 +368,8 @@ iscaminvnorm <- function(prob1, mean = 0, sd = 1, Sd = sd, direction) {
366368
#' iscamnormpower(0.10, n = 50, prob1 = 0.25, alternative = "less", prob2 = 0.15)
367369
#' iscamnormpower(0.05, n = 200, prob1 = 0.8, alternative = "two.sided", prob2 = 0.7)
368370
iscamnormpower <- function(LOS, n, prob1, alternative, prob2) {
369-
withr::local_par(mar = c(5, 4, 1, 1), mfrow = c(2, 1))
371+
old <- par(mar = c(5, 4, 1, 1), mfrow = c(2, 1))
372+
on.exit(par(old), add = TRUE)
370373

371374
minx <- max(
372375
0,
@@ -592,7 +595,8 @@ iscamnormpower <- function(LOS, n, prob1, alternative, prob2) {
592595
)
593596
}
594597

595-
withr::local_par(mfrow = c(1, 1))
598+
old <- par(mfrow = c(1, 1))
599+
on.exit(par(old), add = TRUE)
596600
}
597601

598602
#' One Proportion Z-Test and Interval
@@ -635,7 +639,8 @@ iscamonepropztest <- function(
635639
alternative = "two.sided",
636640
conf.level = NULL
637641
) {
638-
withr::local_par(mar = c(5, 3, 1, 1))
642+
old <- par(mar = c(5, 3, 1, 1))
643+
on.exit(par(old), add = TRUE)
639644

640645
if (observed < 1) {
641646
observed = round(n * observed)
@@ -783,9 +788,11 @@ iscamonepropztest <- function(
783788
)
784789
}
785790
}
786-
withr::local_par(mfrow = c(3, 1))
791+
old <- par(mfrow = c(3, 1))
792+
on.exit(par(old), add = TRUE)
787793
if (length(conf.level) > 1) {
788-
withr::local_par(mar = c(4, 2, 1.5, 4), mfrow = c(length(conf.level), 1))
794+
old <- par(mar = c(4, 2, 1.5, 4), mfrow = c(length(conf.level), 1))
795+
on.exit(par(old), add = TRUE)
789796
}
790797
lower = 0
791798
upper = 0
@@ -884,7 +891,8 @@ iscamonepropztest <- function(
884891
}
885892
}
886893
}
887-
withr::local_par(mfrow = c(1, 1))
894+
old <- par(mfrow = c(1, 1))
895+
on.exit(par(old), add = TRUE)
888896
invisible(list(
889897
"zvalue" = zvalue,
890898
"pvalue" = pvalue,
@@ -943,7 +951,8 @@ iscamtwopropztest <- function(
943951
conf.level = NULL,
944952
datatable = NULL
945953
) {
946-
withr::local_par(mar = c(5, 3, 1, 1))
954+
old <- par(mar = c(5, 3, 1, 1))
955+
on.exit(par(old), add = TRUE)
947956

948957
if (!is.null(datatable)) {
949958
observed1 = datatable[1]
@@ -1133,7 +1142,8 @@ iscamtwopropztest <- function(
11331142
upper = NULL
11341143
if (!is.null(conf.level)) {
11351144
if (length(conf.level) > 1) {
1136-
withr::local_par(mar = c(4, 2, 1.5, 4), mfrow = c(length(conf.level), 1))
1145+
old <- par(mar = c(4, 2, 1.5, 4), mfrow = c(length(conf.level), 1))
1146+
on.exit(par(old), add = TRUE)
11371147
}
11381148
for (k in 1:length(conf.level)) {
11391149
if (conf.level[k] > 1) {
@@ -1164,7 +1174,8 @@ iscamtwopropztest <- function(
11641174
max = statistic + 4 * sephat
11651175
CIseq = seq(min, max, .001)
11661176
if (length(conf.level) == 1) {
1167-
withr::local_par(mar = c(4, .5, 1.5, .5), mfrow = c(3, 1))
1177+
old <- par(mar = c(4, .5, 1.5, .5), mfrow = c(3, 1))
1178+
on.exit(par(old), add = TRUE)
11681179
myxlab = substitute(
11691180
paste("Normal (", mean == x1, ", ", SD == x2, ")", ),
11701181
list(x1 = signif(lower[1], 4), x2 = signif(sephat, 4))
@@ -1240,7 +1251,8 @@ iscamtwopropztest <- function(
12401251
if (!is.null(alternative)) {
12411252
cat("p-value:", pvalue, "\n")
12421253
}
1243-
withr::local_par(mfrow = c(1, 1))
1254+
old <- par(mfrow = c(1, 1))
1255+
on.exit(par(old), add = TRUE)
12441256
invisible(list(
12451257
"zvalue" = zvalue,
12461258
"pvalue" = pvalue,

R/overlayDensities.R

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -233,7 +233,8 @@ iscamaddtnorm <- function(
233233
ylab = "density",
234234
legend_pos = "topright"
235235
) {
236-
withr::local_par(mar = c(4, 3, 1, 1))
236+
old <- par(mar = c(4, 3, 1, 1))
237+
on.exit(par(old), add = TRUE)
237238
ylim_expand <- 1.05
238239
bins <- if (is.null(bins)) "Sturges" else bins
239240

R/plots.R

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -41,10 +41,12 @@ iscamboxplot <- function(
4141
xlab = "",
4242
ylab = substitute(explanatory)
4343
) {
44-
withr::local_par(mar = c(4, 4, 2, 2))
44+
old <- par(mar = c(4, 4, 2, 2))
45+
on.exit(par(old), add = TRUE)
4546

4647
if (is.null(explanatory)) {
47-
withr::local_par(mar = c(4, 3, 2, 2))
48+
old <- par(mar = c(4, 3, 2, 2))
49+
on.exit(par(old), add = TRUE)
4850
qq <- quantile(response, na.rm = TRUE)
4951
bp <- graphics::boxplot(response, plot = FALSE)
5052
bp$stats[2, 1] <- qq[2L]
@@ -100,7 +102,8 @@ iscamdotplot <- function(
100102
xlab = substitute(response),
101103
ylab = substitute(explanatory)
102104
) {
103-
withr::local_par(mar = c(5, 1, 5, 1))
105+
old <- par(mar = c(5, 1, 5, 1))
106+
on.exit(par(old), add = TRUE)
104107

105108
if (is.null(explanatory)) {
106109
stripchart(
@@ -115,7 +118,8 @@ iscamdotplot <- function(
115118
numCategories <- length(table(explanatory))
116119
ymin <- .5
117120
ymax <- numCategories + .5
118-
withr::local_par(mar = c(5, 5, 5, 1))
121+
old <- par(mar = c(5, 5, 5, 1))
122+
on.exit(par(old), add = TRUE)
119123
stripchart(
120124
response ~ explanatory,
121125
vertical = FALSE,

0 commit comments

Comments
 (0)