Thanks to visit codestin.com
Credit goes to github.com

Skip to content

Commit d3e6a4c

Browse files
kanepluspluskaneplusplus
committed
Code clean-up.
1 parent af756d8 commit d3e6a4c

File tree

3 files changed

+210
-50
lines changed

3 files changed

+210
-50
lines changed

‎R/analyze-preference-data.r‎

Lines changed: 62 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -61,27 +61,40 @@ fit_preference <- function(outcome, random, treatment, strata, alpha=0.05) {
6161

6262
for (ss in strat_split) {
6363
pds <- pd[ss , ]
64-
x1mean <- c(x1mean, mean(pds$outcome[pds$random == FALSE & pds$treatment == treatments[1]]))
65-
x1var <- c(x1var, var(pds$outcome[pds$random == FALSE & pds$treatment == treatments[1]]))
66-
m1 <- c(m1, length(pds$outcome[pds$random == FALSE & pds$treatment == treatments[1]]))
67-
x2mean <- c(x2mean, mean(pds$outcome[pds$random == FALSE & pds$treatment == treatments[2]]))
68-
x2var <- c(x2var, var(pds$outcome[pds$random == FALSE & pds$treatment == treatments[2]]))
69-
m2 <- c(m2, length(pds$outcome[pds$random == FALSE & pds$treatment == treatments[2]]))
70-
y1mean <- c(y1mean, mean(pds$outcome[pds$random == TRUE & pds$treatment == treatments[1]]))
71-
y1var <- c(y1var, var(pds$outcome[pds$random == TRUE & pds$treatment == treatments[1]]))
72-
n1 <- c(n1, length(pds$outcome[pds$random == TRUE & pds$treatment == treatments[1]]))
73-
y2mean <- c(y2mean, mean(pds$outcome[pds$random == TRUE & pds$treatment == treatments[2]]))
74-
y2var <- c(y2var, var(pds$outcome[pds$random == TRUE & pds$treatment == treatments[2]]))
75-
n2 <- c(n2, length(pds$outcome[pds$random == TRUE & pds$treatment == treatments[2]]))
64+
x1mean <- c(x1mean,
65+
mean(pds$outcome[pds$random == FALSE & pds$treatment == treatments[1]]))
66+
x1var <- c(x1var,
67+
var(pds$outcome[pds$random == FALSE & pds$treatment == treatments[1]]))
68+
m1 <- c(m1,
69+
length(pds$outcome[pds$random == FALSE & pds$treatment == treatments[1]]))
70+
x2mean <- c(x2mean,
71+
mean(pds$outcome[pds$random == FALSE & pds$treatment == treatments[2]]))
72+
x2var <- c(x2var,
73+
var(pds$outcome[pds$random == FALSE & pds$treatment == treatments[2]]))
74+
m2 <- c(m2,
75+
length(pds$outcome[pds$random == FALSE & pds$treatment == treatments[2]]))
76+
y1mean <- c(y1mean,
77+
mean(pds$outcome[pds$random == TRUE & pds$treatment == treatments[1]]))
78+
y1var <- c(y1var,
79+
var(pds$outcome[pds$random == TRUE & pds$treatment == treatments[1]]))
80+
n1 <- c(n1,
81+
length(pds$outcome[pds$random == TRUE & pds$treatment == treatments[1]]))
82+
y2mean <- c(y2mean,
83+
mean(pds$outcome[pds$random == TRUE & pds$treatment == treatments[2]]))
84+
y2var <- c(y2var,
85+
var(pds$outcome[pds$random == TRUE & pds$treatment == treatments[2]]))
86+
n2 <- c(n2,
87+
length(pds$outcome[pds$random == TRUE & pds$treatment == treatments[2]]))
7688
}
7789

7890
#calculate xi
7991
xi <- table(strata) / length(outcome)
8092
nstrata <- length(unique(strata))
8193

82-
results <- fit_preference_summary(x1mean=x1mean, x1var=x1var, m1=m1, x2mean=x2mean, x2var=x2var, m2=m2,
83-
y1mean=y1mean, y1var=y1var, n1=n1, y2mean=y2mean, y2var=y2var, n2=n2,
84-
xi=xi, nstrata=nstrata, alpha=alpha)
94+
results <- fit_preference_summary(x1mean = x1mean, x1var = x1var, m1 = m1,
95+
x2mean = x2mean, x2var = x2var, m2 = m2, y1mean = y1mean, y1var = y1var,
96+
n1 = n1, y2mean = y2mean, y2var = y2var, n2 = n2, xi = xi,
97+
nstrata = nstrata, alpha = alpha)
8598
return(results)
8699
}
87100

@@ -92,8 +105,7 @@ fit_preference <- function(outcome, random, treatment, strata, alpha=0.05) {
92105
# n1, n2: sample sizes
93106

94107
#' @importFrom stats pt
95-
t.test2 <- function(m1,m2,s1,s2,n1,n2)
96-
{
108+
t.test2 <- function(m1, m2, s1, s2, n1, n2) {
97109
se <- sqrt( (s1/n1) + (s2/n2) )
98110

99111
# Welch-satterthwaite df
@@ -269,48 +281,55 @@ fit_preference_summary <- function(x1mean, x1var, m1, x2mean, x2var, m2, y1mean,
269281

270282
# Compute unstratified test statistics
271283
unstrat_stats <- vapply(seq_len(nstrata),
272-
function(i) {
273-
unstrat_analyze_summary_data(x1mean[i], x1var[i], m1[i], x2mean[i],
274-
x2var[i], m2[i], y1mean[i], y1var[i], n1[i],
275-
y2mean[i], y2var[i], n2[i], alpha)
276-
}, data.frame(pref_effect=NA, pref_SE=NA, pref_test = NA, pref_pval = NA,
277-
pref_LB=NA, pref_UB=NA, sel_effect=NA, sel_SE=NA,
278-
sel_test = NA , sel_pval = NA, sel_LB=NA, sel_UB=NA,
279-
treat_effect=NA, treat_SE=NA, treat_test = NA,
280-
treat_pval = NA, treat_LB=NA, treat_UB=NA))
284+
function(i) {
285+
unstrat_analyze_summary_data(x1mean[i], x1var[i], m1[i], x2mean[i],
286+
x2var[i], m2[i], y1mean[i], y1var[i], n1[i],
287+
y2mean[i], y2var[i], n2[i], alpha)
288+
},
289+
data.frame(pref_effect = NA, pref_SE = NA, pref_test = NA, pref_pval = NA,
290+
pref_LB = NA, pref_UB = NA, sel_effect = NA, sel_SE = NA,
291+
sel_test = NA , sel_pval = NA, sel_LB = NA, sel_UB = NA,
292+
treat_effect = NA, treat_SE = NA, treat_test = NA,
293+
treat_pval = NA, treat_LB = NA, treat_UB = NA))
281294

282295
#Calculate the overall effect estimate
283296
overall_pref_effect <- sum(
284297
vapply(seq_len(nstrata),
285-
function(i) xi[i] * unlist(unstrat_stats[1, i]), 0.0))
298+
function(i) xi[i] * unlist(unstrat_stats[1, i]),
299+
0.0))
286300

287301
overall_sel_effect <- sum(
288302
vapply(seq_len(nstrata),
289-
function(i) xi[i] * unlist(unstrat_stats[7, i]), 0.0))
303+
function(i) xi[i] * unlist(unstrat_stats[7, i]),
304+
0.0))
290305

291306
overall_treat_effect <- sum(
292307
vapply(seq_len(nstrata),
293-
function(i) xi[i] * unlist(unstrat_stats[13, i]), 0.0))
308+
function(i) xi[i] * unlist(unstrat_stats[13, i]),
309+
0.0))
294310

295311
#Calculate the overall SE
296312
overall_pref_SE <- sqrt(sum(
297313
vapply(seq_len(nstrata),
298-
function(i) xi[i]^2 * unlist(unstrat_stats[2, i])^2, 0.0)))
314+
function(i) xi[i]^2 * unlist(unstrat_stats[2, i])^2,
315+
0.0)))
299316

300317
overall_sel_SE <- sqrt(sum(
301318
vapply(seq_len(nstrata),
302-
function(i) xi[i]^2 * unlist(unstrat_stats[8, i])^2, 0.0)))
319+
function(i) xi[i]^2 * unlist(unstrat_stats[8, i])^2,
320+
0.0)))
303321

304322
overall_treat_SE <- sqrt(sum(
305323
vapply(seq_len(nstrata),
306-
function(i) xi[i]^2 * unlist(unstrat_stats[14, i])^2, 0.0)))
324+
function(i) xi[i]^2 * unlist(unstrat_stats[14, i])^2,
325+
0.0)))
307326

308327
#Calculate overall test statistic
309-
overall_pref_test <- overall_pref_effect/overall_pref_SE
328+
overall_pref_test <- overall_pref_effect / overall_pref_SE
310329

311-
overall_sel_test <- overall_sel_effect/overall_sel_SE
330+
overall_sel_test <- overall_sel_effect / overall_sel_SE
312331

313-
overall_treat_test <- overall_treat_effect/overall_treat_SE
332+
overall_treat_test <- overall_treat_effect / overall_treat_SE
314333

315334
# Compute p-values (Assume test stats approximately normally distributed)
316335

@@ -327,17 +346,17 @@ fit_preference_summary <- function(x1mean, x1var, m1, x2mean, x2var, m2, y1mean,
327346

328347
zalpha <- qnorm(1-(alpha/2))
329348

330-
overall_pref_LB <- overall_pref_effect - zalpha*overall_pref_SE
349+
overall_pref_LB <- overall_pref_effect - zalpha * overall_pref_SE
331350

332-
overall_pref_UB <- overall_pref_effect + zalpha*overall_pref_SE
351+
overall_pref_UB <- overall_pref_effect + zalpha * overall_pref_SE
333352

334-
overall_sel_LB <- overall_sel_effect - zalpha*overall_sel_SE
353+
overall_sel_LB <- overall_sel_effect - zalpha * overall_sel_SE
335354

336-
overall_sel_UB <- overall_sel_effect + zalpha*overall_sel_SE
355+
overall_sel_UB <- overall_sel_effect + zalpha * overall_sel_SE
337356

338-
overall_treat_LB <- overall_treat_effect - zalpha*overall_treat_SE
357+
overall_treat_LB <- overall_treat_effect - zalpha * overall_treat_SE
339358

340-
overall_treat_UB <- overall_treat_effect + zalpha*overall_treat_SE
359+
overall_treat_UB <- overall_treat_effect + zalpha * overall_treat_SE
341360

342361
overall_stats<-data.frame(
343362
overall_pref_effect = overall_pref_effect,
@@ -359,8 +378,8 @@ fit_preference_summary <- function(x1mean, x1var, m1, x2mean, x2var, m2, y1mean,
359378
overall_treat_LB = overall_treat_LB,
360379
overall_treat_UB = overall_treat_UB)
361380

362-
ret <- list(alpha=alpha, unstratified_statistics=unstrat_stats,
363-
overall_statistics=overall_stats)
381+
ret <- list(alpha = alpha, unstratified_statistics = unstrat_stats,
382+
overall_statistics = overall_stats)
364383
class(ret) <- c(class(ret), "preference.fit")
365384
ret
366385
}

‎R/sample-size.r‎

Lines changed: 14 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -257,19 +257,25 @@ treatment_effect_size <- function(N, power, sigma2, alpha=0.05, theta=0.5, xi=1,
257257
#' @export
258258
optimal_proportion <- function(w_sel, w_pref, w_treat, sigma2, phi, delta_pi,
259259
delta_nu) {
260-
if(w_sel<0 | w_sel>1 | w_pref<0 | w_pref>1 | w_treat<0 | w_treat>1 |
261-
any(!is.numeric(c(w_sel,w_pref,w_treat))) | length(w_sel)!=1 |
262-
length(w_pref)!=1 | length(w_treat)!=1)
260+
if (w_sel<0 | w_sel>1 | w_pref<0 | w_pref>1 | w_treat<0 | w_treat>1 |
261+
any(!is.numeric(c(w_sel,w_pref,w_treat))) | length(w_sel)!=1 |
262+
length(w_pref)!=1 | length(w_treat)!=1) {
263+
263264
stop('Weights must be single numeric value in [0,1]')
264-
if (w_sel+w_pref+w_treat!=1)
265+
}
266+
if (w_sel + w_pref + w_treat != 1) {
265267
stop('weights do not sum to 1')
266-
if(sigma2<=0 | any(!is.numeric(sigma2)))
268+
}
269+
if(sigma2<=0 | any(!is.numeric(sigma2))) {
267270
stop('Variance estimate must be numeric value greater than 0')
268-
if(phi<0 | phi>1 | !is.numeric(phi))
271+
}
272+
if(phi<0 | phi>1 | !is.numeric(phi)) {
269273
stop('Preference rate must be numeric value in [0,1]')
274+
}
270275
if(!is.numeric(delta_pi) | !is.numeric(delta_nu) ||
271-
length(delta_pi)!=1 || length(delta_nu)!=1)
276+
length(delta_pi)!=1 || length(delta_nu)!=1) {
272277
stop('Effect size must be single numeric value')
278+
}
273279
# Based on Equation 16 in Walter paper
274280
num <- w_sel + w_pref +
275281
phi * (1-phi) *
@@ -330,6 +336,7 @@ f <- function(theta,value) {
330336
#' (\href{https://www.ncbi.nlm.nih.gov/pubmed/2727471}{PubMed})
331337
#' @export
332338
effects_from_means <- function(mu1,mu2,mu11,mu22,phi,nstrata=1,xi=NULL) {
339+
333340
# Error messages
334341
if(nstrata <= 0 | !is.numeric(nstrata) || length(nstrata) != 1) {
335342
stop('Number of strata must be numeric greater than 0')

‎man/preference-package.Rd‎

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

0 commit comments

Comments
 (0)