Skip to content

Commit dcc4d67

Browse files
audreyyeoCHgithub-actions[bot]danielinteractivedependabot-preview[bot]
committed
101 sum table (#133)
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Co-authored-by: Daniel Sabanes Bove <danielinteractive@users.noreply.github.com> Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>
1 parent 83f2409 commit dcc4d67

File tree

7 files changed

+168
-67
lines changed

7 files changed

+168
-67
lines changed

‎R/sumTable.R‎

Lines changed: 31 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -3,53 +3,59 @@
33
#' This function will calculate the summary statistics for a specific response
44
#' outcome scenario.
55
#'
6+
#' @inheritParams postprob
67
#' @inheritParams sumBetaDiff
7-
#' @typed thisResp : number
8-
#' number of responses
9-
#' @typed TotalSample : number
10-
#' sample size
11-
#' @typed YPri : numeric
12-
#' non-negative parameters of the beta prior of the treatment, default Beta(0.5,0.5)
13-
#' @typed Round : number
14-
#' Rounding of the output statistics
8+
#' @typed round : number
9+
#' Digit rounding of the output statistics
1510
#'
1611
#' @return A vector with the results.
1712
#'
1813
#' @example examples/sumTable.R
1914
#' @export
20-
sumTable <- function(thisResp, # number of responses;
21-
TotalSample, # Sample size;
22-
go_cut, # meaningful improvement: at least cut_B (say 15\%) improvement;
23-
stop_cut, # poor improvement: at most cut_W (say 5\%) improvement;
24-
parX, # Two typedeters of the beta distribution of the control (posterior);
25-
YPri = c(0.5, 0.5), # Prior of phase Ib trial, default Beta(0.5,0.5)
26-
Round = 2) {
15+
sumTable <- function(x,
16+
n,
17+
go_cut,
18+
stop_cut,
19+
parX,
20+
parY = c(0.5, 0.5),
21+
round = 2) {
22+
assert_numeric(x, lower = 0, upper = n, finite = TRUE)
23+
assert_number(n, lower = 0, finite = TRUE)
24+
assert_number(go_cut, finite = TRUE)
25+
assert_number(stop_cut, finite = TRUE)
26+
assert_numeric(parY, len = 2, lower = .Machine$double.xmin, any.missing = FALSE, finite = TRUE)
27+
assert_numeric(parX, len = 2, lower = .Machine$double.xmin, any.missing = FALSE, finite = TRUE)
28+
assert_count(round)
29+
2730
tmp <- sumBetaDiff(
2831
parX = parX,
2932
parY =
3033
c(
31-
thisResp + YPri[1],
32-
TotalSample - thisResp + YPri[2]
34+
x + parY[1],
35+
n - x + parY[2]
3336
),
3437
go_cut = go_cut,
3538
stop_cut = stop_cut
3639
)
37-
3840
summaries <- round(c(
39-
thisResp,
40-
thisResp / TotalSample * 100,
41+
x,
42+
x / n * 100,
4143
tmp$mode * 100,
4244
tmp$ci * 100,
4345
tmp$go * 100,
4446
tmp$stop * 100
45-
), Round)
47+
), round)
4648

4749
summaries <- as.data.frame(summaries)
4850

4951
rownames(summaries) <- c(
50-
"# resp", "obs ORR [%]", "mode [%]",
51-
"CI lower [%]", "CI upper [%]", "prob.go [%]", "prob.nogo [%]"
52+
"responders",
53+
"obs ORR [%]",
54+
"mode [%]",
55+
"CI lower [%]",
56+
"CI upper [%]",
57+
"prob.go [%]",
58+
"prob.nogo [%]"
5259
)
53-
54-
return(summaries)
60+
summaries
5561
}

‎R/sumbetadiff.R‎

Lines changed: 19 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,22 +1,22 @@
1-
##' Mode and Credible Interval Calculation for The Difference between Two Beta Distributions
2-
##'
3-
##' @description `r lifecycle::badge("experimental")`
4-
##'
5-
##' A function to summarize the characters of a betadiff distribution [dbetadiff()].
6-
##' May require use of random sample generator to calculate, use [set.seed()] to reproduce results.
7-
##'
8-
##' @inheritParams dbetadiff
9-
##' @inheritParams plotBetaDiff
10-
##' @typed ci_level : numeric
11-
##' level for credible interval
12-
##'
13-
##' @return List with the mode, credible interval for the difference,
14-
##' along with the `go` and `stop` probabilities.
15-
##'
16-
##' @importFrom stats optimize integrate
17-
##'
18-
##' @example examples/sumbetadiff.R
19-
##' @export
1+
#' Mode and Credible Interval Calculation for The Difference between Two Beta Distributions
2+
#'
3+
#' @description `r lifecycle::badge("experimental")`
4+
#'
5+
#' A function to summarize the characters of a betadiff distribution [dbetadiff()].
6+
#' May require use of random sample generator to calculate, use [set.seed()] to reproduce results.
7+
#'
8+
#' @inheritParams dbetadiff
9+
#' @inheritParams plotBetaDiff
10+
#' @typed ci_level : numeric
11+
#' level for credible interval
12+
#'
13+
#' @return List with the mode, credible interval for the difference,
14+
#' along with the `go` and `stop` probabilities.
15+
#'
16+
#' @importFrom stats optimize integrate
17+
#'
18+
#' @example examples/sumbetadiff.R
19+
#' @export
2020
sumBetaDiff <- function(parX, # Treatment group's parameters
2121
parY, # Control group's parameters
2222
ci_level = 0.9,

‎examples/plotDecision.R‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
# sumTable ----
22
sumTable(
3-
thisResp = 10,
4-
TotalSample = 20,
3+
x = 10,
4+
n = 20,
55
parX = c(1, 1),
66
go_cut = 0.8,
77
stop_cut = 0.4
@@ -12,7 +12,7 @@ summaries <- do.call(
1212
cbind,
1313
lapply(c(0:8),
1414
sumTable,
15-
TotalSample = 25,
15+
n = 25,
1616
parX = c(1, 52),
1717
go_cut = 0.6,
1818
stop_cut = 0.2

‎examples/sumTable.R‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,18 @@
1-
sumTable(2, 25, parX = c(1, 52), go_cut = 0.2, stop_cut = 0.05, YPri = c(1, 1))
1+
sumTable(
2+
x = 2,
3+
n = 25,
4+
parX = c(1, 52),
5+
parY = c(1, 1),
6+
go_cut = 0.2,
7+
stop_cut = 0.05
8+
)
29

310
# for multiple response scenarios (e.g. 0 to 8 responses out of 25)
411
summaries <- do.call(
512
cbind,
613
lapply(c(0:8),
714
sumTable,
8-
TotalSample = 25,
15+
n = 25,
916
parX = c(1, 52),
1017
go_cut = 0.2,
1118
stop_cut = 0.05

‎man/plotDecision.Rd‎

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

‎man/sumTable.Rd‎

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

‎tests/testthat/test-sumTable.R‎

Lines changed: 89 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,89 @@
1+
# sumTable ----
2+
test_that("sumTable works as expected", {
3+
result <- sumTable(
4+
x = 2,
5+
n = 40,
6+
parX = c(1, 52), # Control group's parameters
7+
parY = c(1, 1), # Treatment group's parameters
8+
go_cut = 0.2,
9+
stop_cut = 0.05
10+
)
11+
expected <- data.frame(
12+
list(
13+
summaries = c(
14+
2,
15+
5,
16+
3.66,
17+
-0.92,
18+
13.07,
19+
0.37,
20+
52.26
21+
)
22+
),
23+
row.names = c(
24+
"responders",
25+
"obs ORR [%]",
26+
"mode [%]",
27+
"CI lower [%]",
28+
"CI upper [%]",
29+
"prob.go [%]",
30+
"prob.nogo [%]"
31+
)
32+
)
33+
expect_identical(result, expected)
34+
})
35+
36+
test_that("sumTable gives a error when at least one beta prior parameter is 0", {
37+
expect_error(
38+
sumTable(
39+
x = 2,
40+
n = 40,
41+
parX = c(0, 10), # Control group's parameters
42+
parY = c(1, 1), # Treatment group's parameters
43+
go_cut = 0.2,
44+
stop_cut = 0.05
45+
),
46+
label = "Assertion on parX failed Element 1 is not >="
47+
)
48+
})
49+
50+
test_that("sumTable works as expected when x = 0", {
51+
result <- sumTable(
52+
x = 0,
53+
n = 40,
54+
parX = c(2, 10), # Control group's parameters
55+
parY = c(1, 1), # Treatment group's parameters
56+
go_cut = 0.2,
57+
stop_cut = 0.05
58+
)
59+
expected <- data.frame(
60+
list(
61+
summaries = c(0, 0, -8.03, -34.32, -0.44, 0, 99.53)
62+
),
63+
row.names =
64+
c(
65+
"responders",
66+
"obs ORR [%]",
67+
"mode [%]",
68+
"CI lower [%]",
69+
"CI upper [%]",
70+
"prob.go [%]",
71+
"prob.nogo [%]"
72+
)
73+
)
74+
expect_equal(result, expected)
75+
})
76+
77+
test_that("sumTable gives an error as expected when n = 0", {
78+
expect_error(
79+
sumTable(
80+
x = 5,
81+
n = 0,
82+
parX = c(2, 10), # Control group's parameters
83+
parY = c(1, 1), # Treatment group's parameters
84+
go_cut = 0.2,
85+
stop_cut = 0.05
86+
),
87+
label = "Assertion on x failed Element 1 is not <= 0"
88+
)
89+
})

0 commit comments

Comments
 (0)