Skip to content

Commit 49457eb

Browse files
arcaldwell49arcaldwell49
committed
Fixing tests
1 parent 74c23c9 commit 49457eb

File tree

10 files changed

+55
-39
lines changed

10 files changed

+55
-39
lines changed

‎R/powerTOSTone.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@
88
#' @param alpha alpha used for the test (e.g., 0.05)
99
#' @param statistical_power desired power (e.g., 0.8)
1010
#' @param N sample size (e.g., 108)
11+
#' @param sd standard deviation.
1112
#' @param low_eqbound_d lower equivalence bounds (e.g., -0.5) expressed in standardized mean difference (Cohen's d)
1213
#' @param high_eqbound_d upper equivalence bounds (e.g., 0.5) expressed in standardized mean difference (Cohen's d)
1314
#' @param low_eqbound lower equivalence bounds (e.g., -0.5) expressed in raw scores

‎R/power_cor_funcs.R‎

Lines changed: 30 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,9 @@
1-
pow_corr = function (n = NULL, r = NULL, power = NULL, null = 0,
1+
pow_corr = function (n = NULL, rho = NULL, power = NULL, null = 0,
22
alpha = NULL, alternative = c("two.sided", "less", "greater"))
33
{
44

5-
if (sum(sapply(list(n, r, power, alpha), is.null)) != 1)
6-
stop("exactly one of n, r, power, and alpha must be NULL")
5+
if (sum(sapply(list(n, rho, power, alpha), is.null)) != 1)
6+
stop("exactly one of n, rho, power, and alpha must be NULL")
77
if (!is.null(alpha) && !is.numeric(alpha) || any(0 > alpha |
88
alpha > 1))
99
stop(sQuote("alpha"), " must be numeric in [0, 1]")
@@ -15,45 +15,45 @@ pow_corr = function (n = NULL, r = NULL, power = NULL, null = 0,
1515
p=0
1616
alternative <- match.arg(alternative)
1717
tside <- switch(alternative, less = 1, two.sided = 2, greater = 3)
18-
if (tside == 2 && !is.null(r))
19-
r <- abs(r)
18+
if (tside == 2 && !is.null(rho))
19+
rho <- abs(rho)
2020
if (tside == 3) {
2121
p.body <- quote({
22-
delta <- sqrt(n - 3 - p) * (log((1 + r)/(1 - r))/2 +
23-
r/(n - 1 - p)/2 * (1 + (5 + r^2)/(n - 1 - p)/4 +
24-
(11 + 2 * r^2 + 3 * r^4)/(n - 1 - p)^2/8) -
22+
delta <- sqrt(n - 3 - p) * (log((1 + rho)/(1 - rho))/2 +
23+
rho/(n - 1 - p)/2 * (1 + (5 + rho^2)/(n - 1 - p)/4 +
24+
(11 + 2 * rho^2 + 3 * rho^4)/(n - 1 - p)^2/8) -
2525
log((1 + null)/(1 - null))/2 - null/(n - 1 -
2626
p)/2)
27-
v <- (n - 3 - p)/(n - 1 - p) * (1 + (4 - r^2)/(n -
28-
1 - p)/2 + (22 - 6 * r^2 - 3 * r^4)/(n - 1 -
27+
v <- (n - 3 - p)/(n - 1 - p) * (1 + (4 - rho^2)/(n -
28+
1 - p)/2 + (22 - 6 * rho^2 - 3 * rho^4)/(n - 1 -
2929
p)^2/6)
3030
zalpha <- qnorm(1 - alpha)
3131
pnorm((delta - zalpha)/sqrt(v))
3232
})
3333
}
3434
if (tside == 1) {
3535
p.body <- quote({
36-
delta <- sqrt(n - 3 - p) * (log((1 + r)/(1 - r))/2 +
37-
r/(n - 1 - p)/2 * (1 + (5 + r^2)/(n - 1 - p)/4 +
38-
(11 + 2 * r^2 + 3 * r^4)/(n - 1 - p)^2/8) -
36+
delta <- sqrt(n - 3 - p) * (log((1 + rho)/(1 - rho))/2 +
37+
rho/(n - 1 - p)/2 * (1 + (5 + rho^2)/(n - 1 - p)/4 +
38+
(11 + 2 * rho^2 + 3 * rho^4)/(n - 1 - p)^2/8) -
3939
log((1 + null)/(1 - null))/2 - null/(n - 1 -
4040
p)/2)
41-
v <- (n - 3 - p)/(n - 1 - p) * (1 + (4 - r^2)/(n -
42-
1 - p)/2 + (22 - 6 * r^2 - 3 * r^4)/(n - 1 -
41+
v <- (n - 3 - p)/(n - 1 - p) * (1 + (4 - rho^2)/(n -
42+
1 - p)/2 + (22 - 6 * rho^2 - 3 * rho^4)/(n - 1 -
4343
p)^2/6)
4444
zalpha <- qnorm(1 - alpha)
4545
pnorm((-delta - zalpha)/sqrt(v))
4646
})
4747
}
4848
if (tside == 2) {
4949
p.body <- quote({
50-
delta <- sqrt(n - 3 - p) * (log((1 + r)/(1 - r))/2 +
51-
r/(n - 1 - p)/2 * (1 + (5 + r^2)/(n - 1 - p)/4 +
52-
(11 + 2 * r^2 + 3 * r^4)/(n - 1 - p)^2/8) -
50+
delta <- sqrt(n - 3 - p) * (log((1 + rho)/(1 - rho))/2 +
51+
rho/(n - 1 - p)/2 * (1 + (5 + rho^2)/(n - 1 - p)/4 +
52+
(11 + 2 * rho^2 + 3 * rho^4)/(n - 1 - p)^2/8) -
5353
log((1 + null)/(1 - null))/2 - null/(n - 1 -
5454
p)/2)
55-
v <- (n - 3 - p)/(n - 1 - p) * (1 + (4 - r^2)/(n -
56-
1 - p)/2 + (22 - 6 * r^2 - 3 * r^4)/(n - 1 -
55+
v <- (n - 3 - p)/(n - 1 - p) * (1 + (4 - rho^2)/(n -
56+
1 - p)/2 + (22 - 6 * rho^2 - 3 * rho^4)/(n - 1 -
5757
p)^2/6)
5858
zalpha <- qnorm(1 - alpha/2)
5959
pnorm((delta - zalpha)/sqrt(v)) + pnorm((-delta -
@@ -65,13 +65,13 @@ pow_corr = function (n = NULL, r = NULL, power = NULL, null = 0,
6565
else if (is.null(n))
6666
n <- uniroot(function(n) eval(p.body) - power, c(4 +
6767
p + 1e-10, 1e+07))$root
68-
else if (is.null(r)) {
68+
else if (is.null(rho)) {
6969
if (tside == 2) {
70-
r <- uniroot(function(r) eval(p.body) - power, c(1e-10,
70+
rho <- uniroot(function(rho) eval(p.body) - power, c(1e-10,
7171
1 - 1e-10))$root
7272
}
7373
else {
74-
r <- uniroot(function(r) eval(p.body) - power, c(-1 +
74+
rho <- uniroot(function(rho) eval(p.body) - power, c(-1 +
7575
1e-10, 1 - 1e-10))$root
7676
}
7777
}
@@ -81,21 +81,21 @@ pow_corr = function (n = NULL, r = NULL, power = NULL, null = 0,
8181
else stop("internal error")
8282
METHOD <- "Approximate Power for Pearson Product-Moment Correlation (z-test)"
8383

84-
structure(list(n = n, rho = r,
84+
structure(list(n = n, rho = rho,
8585
alpha = alpha, beta = 1-power, power = power,
8686
null = null, alternative = alternative,
8787
method = METHOD),
8888
class = "power.htest")
8989
}
9090

91-
pow_corr_tost = function (n = NULL, r = 0, power = NULL, null = NULL,
91+
pow_corr_tost = function (n = NULL, rho = 0, power = NULL, null = NULL,
9292
alpha = NULL)
9393
{
9494

95-
if (sum(sapply(list(n, r, power, alpha), is.null)) != 1)
96-
stop("exactly one of n, r, power, and alpha must be NULL")
97-
if(is.null(r)){
98-
stop("r cannot be set to NULL at this time.")
95+
if (sum(sapply(list(n, rho, power, alpha), is.null)) != 1)
96+
stop("exactly one of n, rho, power, and alpha must be NULL")
97+
if(is.null(rho)){
98+
stop("rho cannot be set to NULL at this time.")
9999
}
100100
if (!is.null(alpha) && !is.numeric(alpha) || any(0 > alpha |
101101
alpha > 1))
@@ -127,7 +127,7 @@ pow_corr_tost = function (n = NULL, r = 0, power = NULL, null = NULL,
127127
else stop("internal error")
128128
METHOD <- "Approximate Power for Pearson Product-Moment Correlation (z-test)"
129129

130-
structure(list(n = n, rho = r,
130+
structure(list(n = n, rho = rho,
131131
alpha = alpha, beta = 1-power, power = power,
132132
null = null, alternative = alternative,
133133
method = METHOD),

‎R/power_correlations.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -63,10 +63,10 @@ power_z_cor = function(n = NULL,
6363
null = c(null,-1 * null)
6464

6565
}
66-
pow_corr_tost(n = n, r = rho, power = power, null = null,
66+
pow_corr_tost(n = n, rho = rho, power = power, null = null,
6767
alpha = alpha)
6868
} else{
69-
pow_corr(n = null, r = r, power = power, null = null,
69+
pow_corr(n = null, rho = rho, power = power, null = null,
7070
alpha = alpha, alternative = alternative)
7171
}
7272
}

‎R/two_proportions.R‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@
1717
#' The hypothesis test for differences in proportions can be made on the raw proportions scale, the odds ratio, or the risk ratio (details below).
1818
#' This function uses the large sample size asymptotic approximations for both the p-value and confidence interval calculations.
1919
#' There should be a good deal of caution when sample sizes are small.
20+
#' The p-values for the differences in proportions will differ from base [prop.test] due to the use of the unpooled standard error (see below).
2021
#'
2122
#' ## Differences in Proportions
2223
#'
@@ -367,7 +368,7 @@ test_odds_ratio = function(p1, p2, n1, n2,
367368

368369
NVAL = null
369370
names(NVAL) = rep("Odds Ratio", length(null))
370-
METHOD = "Odds Ratio z-test"
371+
METHOD = "approximate Odds Ratio z-test"
371372
list(STATISTIC = STATISTIC,
372373
PVAL = PVAL,
373374
NVAL = NVAL,
@@ -478,7 +479,7 @@ test_risk_ratio = function(p1, p2, n1, n2,
478479
NVAL = null
479480
names(NVAL) = rep("Risk Ratio", length(null))
480481

481-
METHOD = "Risk Ratio z-test"
482+
METHOD = "approximate Risk Ratio z-test"
482483

483484
list(STATISTIC = STATISTIC,
484485
PVAL = PVAL,

‎_pkgdown.yml‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -49,6 +49,10 @@ reference:
4949
- equ_anova
5050
- equ_ftest
5151

52+
- subtitle: "Proportions"
53+
contents:
54+
- twoprop_test
55+
5256
- subtitle: "Methods"
5357
desc: >
5458
Functions/methods to aid analyses
@@ -100,6 +104,7 @@ reference:
100104
- power_t_TOST
101105
- power_eq_f
102106
- power_z_cor
107+
- power_twoprop
103108

104109
- title: "Data"
105110
contents:

‎man/powerTOSTone.Rd‎

Lines changed: 2 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/twoprop_test.Rd‎

Lines changed: 1 addition & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-old_errors.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,8 @@ test_that("Errors for TOSTtwo functions",{
99

1010
hush(suppressMessages( {
1111

12-
withr::local_options(lifecycle_verbosity = "quiet")
12+
#withr::local_options(lifecycle_verbosity = "quiet")
13+
1314
expect_warning(TOSTtwo.raw(m1 = 5.25, m2 = 5.22,
1415
sd1 = 0.95, sd2 = 0.83,
1516
n1 = 95, n2 = 89,

‎tests/testthat/test-power_consistent.R‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9,9 +9,9 @@ test_that("power functions are internally consistent", {
99
sink()
1010
return(tmp)
1111
}
12-
withr::local_options(lifecycle_verbosity = "quiet")
12+
#withr::local_options(lifecycle_verbosity = "quiet")
1313

14-
suppressMessages(hush({
14+
suppressWarnings({ suppressMessages(hush({
1515
## tests for one-sample t-test
1616
pow_n <-powerTOSTone(alpha=0.05, statistical_power=0.9,
1717
low_eqbound_d=-0.3, high_eqbound_d=0.3)
@@ -149,5 +149,6 @@ test_that("power functions are internally consistent", {
149149
low_eqbound_dz = -0.3, high_eqbound_dz = 0.3))
150150
#
151151
}))
152+
})
152153
})
153154

‎tests/testthat/test-twoprop.R‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -144,6 +144,9 @@ test_that("Random tests against prop_test",{
144144

145145
expect_equal(abs(ptest_base$p.value - ptest_prop$p.value),0,tolerance=.001)
146146

147+
expect_equal(abs(ptest_base$conf.int[1] - ptest_base$conf.int[1]),0,tolerance=.001)
148+
expect_equal(abs(ptest_base$conf.int[2] - ptest_base$conf.int[2]),0,tolerance=.001)
149+
147150
smokers <- c(129, 70)
148151
patients <- c(136, 82)
149152
ptest_base = suppressWarnings( prop.test(smokers, patients,
@@ -153,8 +156,9 @@ test_that("Random tests against prop_test",{
153156
patients[1],
154157
patients[2])
155158

156-
expect_equal(abs(ptest_base$p.value - ptest_prop$p.value),0,tolerance=.001)
157-
159+
expect_equal(abs(ptest_base$conf.int[1] - ptest_base$conf.int[1]),0,tolerance=.001)
160+
expect_equal(abs(ptest_base$conf.int[2] - ptest_base$conf.int[2]),0,tolerance=.001)
161+
set.seed(16281940)
158162
for(i in 1:200){
159163
#print(i)
160164
p1 = runif(1,.05,.95)

0 commit comments

Comments
 (0)