From 2ae314b54f977c041533e19bd4b032016dc4a9d6 Mon Sep 17 00:00:00 2001 From: rsquaredin Date: Fri, 7 Sep 2018 20:50:55 +0530 Subject: [PATCH] cleanup code --- R/infer-anova.R | 10 +++--- R/infer-binom-test.R | 6 ++-- R/infer-chisq-assoc-test.R | 24 ++++++------- R/infer-chisq-gof-test.R | 6 ++-- R/infer-cochran-q-test.R | 4 +-- R/infer-levene-test.R | 22 ++++-------- R/infer-mcnemar-test.R | 1 + R/infer-os-prop-test.R | 17 ++++----- R/infer-os-t-test.R | 8 ++--- R/infer-os-var-test.R | 8 ++--- R/infer-runs-test.R | 29 +++++----------- R/infer-ts-ind-ttest.R | 21 ++++++------ R/infer-ts-paired-ttest.R | 9 ++--- R/infer-ts-prop-test.R | 70 ++++++++++++++++---------------------- R/infer-ts-var-test.R | 27 +++++---------- _pkgdown.yml | 9 +++++ 16 files changed, 108 insertions(+), 163 deletions(-) diff --git a/R/infer-anova.R b/R/infer-anova.R index 5f6bc55..ef51873 100644 --- a/R/infer-anova.R +++ b/R/infer-anova.R @@ -40,16 +40,14 @@ infer_oneway_anova <- function(data, x, y, ...) UseMethod("infer_oneway_anova") #' @export infer_oneway_anova.default <- function(data, x, y, ...) { + x1 <- enquo(x) y1 <- enquo(y) - fdata <- - data %>% - select(!! x1, !! y1) - - sample_mean <- anova_avg(fdata, !! x1) + fdata <- select(data, !! x1, !! y1) + sample_mean <- anova_avg(fdata, !! x1) sample_stats <- anova_split(fdata, !! x1, !! y1, sample_mean) - k <- anova_calc(fdata, sample_stats, !! x1, !! y1) + k <- anova_calc(fdata, sample_stats, !! x1, !! y1) result <- list( diff --git a/R/infer-binom-test.R b/R/infer-binom-test.R index 801facd..3a2e9b4 100644 --- a/R/infer-binom-test.R +++ b/R/infer-binom-test.R @@ -82,11 +82,9 @@ print.infer_binom_calc <- function(x, ...) { #' @export #' @rdname infer_binom_calc infer_binom_test <- function(data, variable, prob = 0.5) { + varyable <- enquo(variable) - - fdata <- - data %>% - pull(!! varyable) + fdata <- pull(data, !! varyable) if (!is.factor(fdata)) { stop("variable must be of type factor", call. = FALSE) diff --git a/R/infer-chisq-assoc-test.R b/R/infer-chisq-assoc-test.R index da7bf7f..648a24d 100644 --- a/R/infer-chisq-assoc-test.R +++ b/R/infer-chisq-assoc-test.R @@ -41,16 +41,12 @@ infer_chisq_assoc_test <- function(data, x, y) UseMethod("infer_chisq_assoc_test #' @export infer_chisq_assoc_test.default <- function(data, x, y) { + x1 <- enquo(x) y1 <- enquo(y) - xone <- - data %>% - pull(!! x1) - - yone <- - data %>% - pull(!! y1) + xone <- pull(data, !! x1) + yone <- pull(data, !! y1) if (!is.factor(xone)) { stop("x must be a categorical variable") @@ -61,7 +57,7 @@ infer_chisq_assoc_test.default <- function(data, x, y) { } # dimensions - k <- table(xone, yone) + k <- table(xone, yone) dk <- dim(k) ds <- prod(dk) nr <- dk[1] @@ -72,16 +68,16 @@ infer_chisq_assoc_test.default <- function(data, x, y) { twoway <- matrix(table(xone, yone), nrow = 2) df <- df_chi(twoway) ef <- efmat(twoway) - k <- pear_chsq(twoway, df, ef) - m <- lr_chsq(twoway, df, ef) - n <- yates_chsq(twoway) - p <- mh_chsq(twoway, n$total, n$prod_totals) + k <- pear_chsq(twoway, df, ef) + m <- lr_chsq(twoway, df, ef) + n <- yates_chsq(twoway) + p <- mh_chsq(twoway, n$total, n$prod_totals) } else { twoway <- matrix(table(xone, yone), nrow = dk[1]) ef <- efm(twoway, dk) df <- df_chi(twoway) - k <- pear_chi(twoway, df, ef) - m <- lr_chsq2(twoway, df, ef, ds) + k <- pear_chi(twoway, df, ef) + m <- lr_chsq2(twoway, df, ef, ds) } j <- chigf(xone, yone, k$chi) diff --git a/R/infer-chisq-gof-test.R b/R/infer-chisq-gof-test.R index e8e67c2..8b66566 100644 --- a/R/infer-chisq-gof-test.R +++ b/R/infer-chisq-gof-test.R @@ -38,11 +38,9 @@ infer_chisq_gof_test <- function(data, x, y, correct = FALSE) UseMethod("infer_c #' @export infer_chisq_gof_test.default <- function(data, x, y, correct = FALSE) { - x1 <- enquo(x) - xcheck <- - data %>% - pull(!! x1) + x1 <- enquo(x) + xcheck <- pull(data, !! x1) xlen <- data %>% diff --git a/R/infer-cochran-q-test.R b/R/infer-cochran-q-test.R index 5224043..c3d27ae 100644 --- a/R/infer-cochran-q-test.R +++ b/R/infer-cochran-q-test.R @@ -26,10 +26,10 @@ infer_cochran_qtest <- function(data, ...) UseMethod("infer_cochran_qtest") #' @export infer_cochran_qtest.default <- function(data, ...) { + vars <- quos(...) - fdata <- data %>% - select(!!! vars) + fdata <- select(data, !!! vars) if (ncol(fdata) < 3) { stop("Please specify at least 3 variables.") diff --git a/R/infer-levene-test.R b/R/infer-levene-test.R index e3dba9b..10f769e 100644 --- a/R/infer-levene-test.R +++ b/R/infer-levene-test.R @@ -55,16 +55,13 @@ infer_levene_test <- function(data, ...) UseMethod("infer_levene_test") #' @rdname infer_levene_test infer_levene_test.default <- function(data, ..., group_var = NULL, trim_mean = 0.1) { - groupvar <- enquo(group_var) - + + groupvar <- enquo(group_var) varyables <- quos(...) - - fdata <- - data %>% - select(!!! varyables) + fdata <- select(data, !!! varyables) if (quo_is_null(groupvar)) { - z <- as.list(fdata) + z <- as.list(fdata) ln <- z %>% map_int(length) ly <- seq_len(length(z)) @@ -72,20 +69,15 @@ infer_levene_test.default <- function(data, ..., group_var = NULL, stop("Please specify at least two variables.", call. = FALSE) } - out <- gvar(ln, ly) + out <- gvar(ln, ly) fdata <- unlist(z) groupvars <- out %>% unlist() %>% as.factor() } else { - fdata <- - fdata %>% - pull(1) - - groupvars <- - data %>% - pull(!! groupvar) + fdata <- pull(fdata, 1) + groupvars <- pull(data, !! groupvar) if (length(fdata) != length(groupvars)) { stop("Length of variable and group_var do not match.", call. = FALSE) diff --git a/R/infer-mcnemar-test.R b/R/infer-mcnemar-test.R index ab0f5cf..7b7271e 100644 --- a/R/infer-mcnemar-test.R +++ b/R/infer-mcnemar-test.R @@ -55,6 +55,7 @@ infer_mcnemar_test <- function(data, x = NULL, y = NULL) UseMethod("infer_mcnema #' @export #' infer_mcnemar_test.default <- function(data, x = NULL, y = NULL) { + if (is.matrix(data) | is.table(data)) { dat <- mcdata(data) } else { diff --git a/R/infer-os-prop-test.R b/R/infer-os-prop-test.R index 1366332..84470ee 100644 --- a/R/infer-os-prop-test.R +++ b/R/infer-os-prop-test.R @@ -46,29 +46,26 @@ infer_os_prop_test <- function(data, variable = NULL, prob = 0.5, phat = 0.5, infer_os_prop_test.default <- function(data, variable = NULL, prob = 0.5, phat = 0.5, alternative = c("both", "less", "greater", "all")) { if (is.numeric(data)) { + method <- match.arg(alternative) k <- prop_comp( data, prob = prob, phat = phat, alternative = method ) - } else { - varyables <- enquo(variable) - fdata <- - data %>% - pull(!! varyables) + } else { - n1 <- length(fdata) + varyables <- enquo(variable) + fdata <- pull(data, !! varyables) + n1 <- length(fdata) n2 <- fdata %>% table() %>% `[[`(2) - phat <- round(n2 / n1, 4) - - prob <- prob - + phat <- round(n2 / n1, 4) + prob <- prob method <- match.arg(alternative) k <- prop_comp( diff --git a/R/infer-os-t-test.R b/R/infer-os-t-test.R index 36ca488..456e9bb 100644 --- a/R/infer-os-t-test.R +++ b/R/infer-os-t-test.R @@ -57,11 +57,9 @@ infer_os_t_test <- function(data, x, mu = 0, alpha = 0.05, #' infer_os_t_test.default <- function(data, x, mu = 0, alpha = 0.05, alternative = c("both", "less", "greater", "all"), ...) { - x1 <- enquo(x) - - xone <- - data %>% - pull(!! x1) + + x1 <- enquo(x) + xone <- pull(data, !! x1) if (!is.numeric(xone)) { stop("x must be numeric") diff --git a/R/infer-os-var-test.R b/R/infer-os-var-test.R index 00863f3..28a8073 100644 --- a/R/infer-os-var-test.R +++ b/R/infer-os-var-test.R @@ -56,11 +56,9 @@ infer_os_var_test <- function(data, x, sd, confint = 0.95, #' infer_os_var_test.default <- function(data, x, sd, confint = 0.95, alternative = c("both", "less", "greater", "all"), ...) { - x1 <- enquo(x) - - xone <- - data %>% - pull(!! x1) + + x1 <- enquo(x) + xone <- pull(data, !! x1) if (!is.numeric(xone)) { stop("x must be numeric") diff --git a/R/infer-runs-test.R b/R/infer-runs-test.R index de693c3..701c2f8 100644 --- a/R/infer-runs-test.R +++ b/R/infer-runs-test.R @@ -59,16 +59,10 @@ infer_runs_test <- function(data, x, drop = FALSE, split = FALSE, mean = FALSE, infer_runs_test.default <- function(data, x, drop = FALSE, split = FALSE, mean = FALSE, threshold = NA) { - x1 <- enquo(x) - - xone <- - data %>% - pull(!! x1) - - n <- length(xone) - - # if (!(is.numeric(x) || is.integer(x))) - # stop("x must be numeric or integer") + + x1 <- enquo(x) + xone <- pull(data, !! x1) + n <- length(xone) if (is.na(threshold)) { y <- unique(xone) @@ -77,7 +71,6 @@ infer_runs_test.default <- function(data, x, drop = FALSE, } } - # compute threshold if (!(is.na(threshold))) { thresh <- threshold } else if (mean == TRUE) { @@ -86,7 +79,6 @@ infer_runs_test.default <- function(data, x, drop = FALSE, thresh <- median(xone, na.rm = TRUE) } - # drop values equal to threshold if drop == TRUE if (drop == TRUE) { xone <- xone[xone != thresh] } @@ -101,20 +93,15 @@ infer_runs_test.default <- function(data, x, drop = FALSE, unlist(use.names = FALSE) } - # compute the number of runs - n_runs <- nsignC(x_binary) - n1 <- sum(x_binary) - n0 <- length(x_binary) - n1 - - # compute expected runs and sd of runs + n_runs <- nsignC(x_binary) + n1 <- sum(x_binary) + n0 <- length(x_binary) - n1 exp_runs <- expruns(n0, n1) - sd_runs <- sdruns(n0, n1) + sd_runs <- sdruns(n0, n1) - # compute the test statistic test_stat <- (n_runs - exp_runs) / (sd_runs ^ 0.5) sig <- 2 * (1 - pnorm(abs(test_stat), lower.tail = TRUE)) - # result result <- list( n = n, threshold = thresh, n_below = n0, n_above = n1, mean = exp_runs, var = sd_runs, n_runs = n_runs, z = test_stat, diff --git a/R/infer-ts-ind-ttest.R b/R/infer-ts-ind-ttest.R index d6919d5..d52c936 100644 --- a/R/infer-ts-ind-ttest.R +++ b/R/infer-ts-ind-ttest.R @@ -87,18 +87,17 @@ infer_ts_ind_ttest.default <- function(data, x, y, confint = 0.95, stop("x must be a binary factor variable", call. = FALSE) } - method <- match.arg(alternative) - var_y <- yone - alpha <- 1 - confint - a <- alpha / 2 - - h <- indth(data, !! x1, !! y1, a) + method <- match.arg(alternative) + var_y <- yone + alpha <- 1 - confint + a <- alpha / 2 + h <- indth(data, !! x1, !! y1, a) grp_stat <- h - g_stat <- as.matrix(h) - comb <- indcomb(data, !! y1, a) - k <- indcomp(grp_stat, alpha) - j <- indsig(k$n1, k$n2, k$s1, k$s2, k$mean_diff) - m <- indpool(k$n1, k$n2, k$mean_diff, k$se_dif) + g_stat <- as.matrix(h) + comb <- indcomb(data, !! y1, a) + k <- indcomp(grp_stat, alpha) + j <- indsig(k$n1, k$n2, k$s1, k$s2, k$mean_diff) + m <- indpool(k$n1, k$n2, k$mean_diff, k$se_dif) result <- list( levels = g_stat[, 1], obs = g_stat[, 2], n = k$n, diff --git a/R/infer-ts-paired-ttest.R b/R/infer-ts-paired-ttest.R index 15d04ee..9f6916b 100644 --- a/R/infer-ts-paired-ttest.R +++ b/R/infer-ts-paired-ttest.R @@ -68,13 +68,8 @@ infer_ts_paired_ttest.default <- function(data, x, y, confint = 0.95, select(!! x1, !! y1) %>% names() - xone <- - data %>% - pull(!! x1) - - yone <- - data %>% - pull(!! y1) + xone <- pull(data, !! x1) + yone <- pull(data, !! y1) k <- paired_comp(xone, yone, confint, var_names) diff --git a/R/infer-ts-prop-test.R b/R/infer-ts-prop-test.R index 6f458b6..7de997b 100644 --- a/R/infer-ts-prop-test.R +++ b/R/infer-ts-prop-test.R @@ -58,19 +58,13 @@ infer_ts_prop_test <- function(data, var1, var2, #' infer_ts_prop_test.default <- function(data, var1, var2, alternative = c("both", "less", "greater", "all"), ...) { - var_1 <- enquo(var1) - var_2 <- enquo(var2) - - varone <- - data %>% - pull(!! var_1) - - vartwo <- - data %>% - pull(!! var_2) + var_1 <- enquo(var1) + var_2 <- enquo(var2) + varone <- pull(data, !! var_1) + vartwo <- pull(data, !! var_2) alt <- match.arg(alternative) - k <- prop_comp2(varone, vartwo, alt) + k <- prop_comp2(varone, vartwo, alt) result <- list( n1 = k$n1, n2 = k$n2, phat1 = k$phat1, phat2 = k$phat2, @@ -102,35 +96,29 @@ print.infer_ts_prop_test <- function(x, ...) { #' infer_ts_prop_grp <- function(data, var, group, alternative = c("both", "less", "greater", "all")) { - var1 <- enquo(var) - group1 <- enquo(group) - - varone <- - data %>% - pull(!! var1) - - groupone <- - data %>% - pull(!! group1) + var1 <- enquo(var) + group1 <- enquo(group) + varone <- pull(data, !! var1) + groupone <- pull(data, !! group1) if (nlevels(groupone) > 2) { stop("Grouping variable must be a binary factor variables.", call. = FALSE) } - n <- tapply(varone, groupone, length) - n1 <- n[[1]] - n2 <- n[[2]] - y <- tapply(varone, groupone, table) - y1 <- y[[1]][[2]] - y2 <- y[[2]][[2]] + n <- tapply(varone, groupone, length) + n1 <- n[[1]] + n2 <- n[[2]] + y <- tapply(varone, groupone, table) + y1 <- y[[1]][[2]] + y2 <- y[[2]][[2]] phat1 <- y1 / n1 phat2 <- y2 / n2 - phat <- sum(y1, y2) / sum(n1, n2) - num <- (phat1 - phat2) - den1 <- phat * (1 - phat) - den2 <- (1 / n1) + (1 / n2) - den <- sqrt(den1 * den2) - z <- num / den + phat <- sum(y1, y2) / sum(n1, n2) + num <- (phat1 - phat2) + den1 <- phat * (1 - phat) + den2 <- (1 / n1) + (1 / n2) + den <- sqrt(den1 * den2) + z <- num / den lt <- pnorm(z) @@ -178,16 +166,16 @@ ts_prop_grp <- function(var, group, #' infer_ts_prop_calc <- function(n1, n2, p1, p2, alternative = c("both", "less", "greater", "all"), ...) { - n1 <- n1 - n2 <- n2 + n1 <- n1 + n2 <- n2 phat1 <- p1 phat2 <- p2 - phat <- sum(n1 * p1, n2 * p2) / sum(n1, n2) - num <- (phat1 - phat2) - den1 <- phat * (1 - phat) - den2 <- (1 / n1) + (1 / n2) - den <- sqrt(den1 * den2) - z <- num / den + phat <- sum(n1 * p1, n2 * p2) / sum(n1, n2) + num <- (phat1 - phat2) + den1 <- phat * (1 - phat) + den2 <- (1 / n1) + (1 / n2) + den <- sqrt(den1 * den2) + z <- num / den lt <- pnorm(z) ut <- round(pnorm(z, lower.tail = FALSE), 4) diff --git a/R/infer-ts-var-test.R b/R/infer-ts-var-test.R index 7785660..abbe0fc 100644 --- a/R/infer-ts-var-test.R +++ b/R/infer-ts-var-test.R @@ -51,16 +51,12 @@ infer_ts_var_test <- function(data, ..., group_var = NULL, #' infer_ts_var_test.default <- function(data, ..., group_var = NULL, alternative = c("less", "greater", "all")) { - groupvar <- enquo(group_var) - + groupvar <- enquo(group_var) varyables <- quos(...) - - fdata <- - data %>% - select(!!! varyables) + fdata <- select(data, !!! varyables) if (quo_is_null(groupvar)) { - z <- as.list(fdata) + z <- as.list(fdata) ln <- z %>% map_int(length) ly <- seq_len(length(z)) @@ -68,8 +64,7 @@ infer_ts_var_test.default <- function(data, ..., group_var = NULL, stop("Please specify at least two variables.", call. = FALSE) } - out <- gvar(ln, ly) - + out <- gvar(ln, ly) fdata <- unlist(z) groupvars <- @@ -81,16 +76,12 @@ infer_ts_var_test.default <- function(data, ..., group_var = NULL, data %>% select(!!! varyables) %>% names() - } else { - fdata <- - fdata %>% - pull(1) - groupvars <- - data %>% - pull(!! groupvar) + } else { - lev <- levels(groupvars) + fdata <- pull(fdata, 1) + groupvars <- pull(data, !! groupvar) + lev <- levels(groupvars) if (length(fdata) != length(groupvars)) { stop("Length of variable and group_var do not match.", call. = FALSE) @@ -99,7 +90,7 @@ infer_ts_var_test.default <- function(data, ..., group_var = NULL, type <- match.arg(alternative) - k <- var_comp(fdata, groupvars) + k <- var_comp(fdata, groupvars) out <- list( f = k$f, lower = k$lower, upper = k$upper, vars = k$vars, diff --git a/_pkgdown.yml b/_pkgdown.yml index 264069b..4c20ead 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,6 +1,15 @@ +url: https://inferr.rsquaredacademy.com + +authors: + Aravind Hebbali: + href: https://www.aravindhebbali.com + templates: params: bootswatch: cosmo + docsearch: + api_key: + index_name: inferr navbar: title: "inferr"