diff --git a/R/RcppExports.R b/R/RcppExports.R index 49b3de1..97c2d3a 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -2,10 +2,10 @@ # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 nsignC <- function(x) { - .Call('_inferr_nsignC', PACKAGE = 'inferr', x) + .Call(`_inferr_nsignC`, x) } gvar <- function(ln, ly) { - .Call('_inferr_gvar', PACKAGE = 'inferr', ln, ly) + .Call(`_inferr_gvar`, ln, ly) } diff --git a/README.Rmd b/README.Rmd index ee1e7fa..e74932d 100644 --- a/README.Rmd +++ b/README.Rmd @@ -18,7 +18,7 @@ inferr: Inferential statistics with R **Author:** [Aravind Hebbali](http://www.aravindhebbali.com)
**License:** [MIT](https://opensource.org/licenses/MIT) -[![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/inferr)](https://cran.r-project.org/package=inferr) [![Travis-CI Build Status](https://travis-ci.org/rsquaredacademy/inferr.svg?branch=master)](https://travis-ci.org/rsquaredacademy/inferr) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/rsquaredacademy/inferr?branch=master&svg=true)](https://ci.appveyor.com/project/rsquaredacademy/inferr) [![](https://cranlogs.r-pkg.org/badges/grand-total/inferr)](https://cran.r-project.org/package=inferr) +[![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/inferr)](https://cran.r-project.org/package=inferr) [![Travis-CI Build Status](https://travis-ci.org/rsquaredacademy/inferr.svg?branch=master)](https://travis-ci.org/rsquaredacademy/inferr) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/rsquaredacademy/inferr?branch=master&svg=true)](https://ci.appveyor.com/project/rsquaredacademy/inferr) [![](https://cranlogs.r-pkg.org/badges/grand-total/inferr)](https://cran.r-project.org/package=inferr) [![Coverage status](https://codecov.io/gh/rsquaredacademy/inferr/branch/master/graph/badge.svg)](https://codecov.io/github/rsquaredacademy/inferr?branch=master) ![](https://img.shields.io/badge/lifecycle-maturing-blue.svg) diff --git a/README.md b/README.md index d1c73fd..314cada 100644 --- a/README.md +++ b/README.md @@ -13,6 +13,9 @@ Status](https://travis-ci.org/rsquaredacademy/inferr.svg?branch=master)](https:/ [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/rsquaredacademy/inferr?branch=master&svg=true)](https://ci.appveyor.com/project/rsquaredacademy/inferr) [![](https://cranlogs.r-pkg.org/badges/grand-total/inferr)](https://cran.r-project.org/package=inferr) +[![Coverage +status](https://codecov.io/gh/rsquaredacademy/inferr/branch/master/graph/badge.svg)](https://codecov.io/github/rsquaredacademy/inferr?branch=master) +![](https://img.shields.io/badge/lifecycle-maturing-blue.svg) ## Overview diff --git a/docs/index.html b/docs/index.html index 1d602c6..7c764ea 100644 --- a/docs/index.html +++ b/docs/index.html @@ -88,7 +88,7 @@

inferr: Inferential statistics with R

Author: Aravind Hebbali
License: MIT

-

CRAN_Status_Badge Travis-CI Build Status AppVeyor Build Status

+

CRAN_Status_Badge Travis-CI Build Status AppVeyor Build Status Coverage status

diff --git a/inst/application/helper/chisq-gof-shiny.R b/inst/application/helper/chisq-gof-shiny.R deleted file mode 100644 index a14d5f5..0000000 --- a/inst/application/helper/chisq-gof-shiny.R +++ /dev/null @@ -1,125 +0,0 @@ -#' @title Chi Square Goodness of Fit Test -#' @description Test whether the observed proportions for a categorical variable -#' differ from hypothesized proportions -#' @param x categorical variable -#' @param y expected proportions -#' @param correct logical; if TRUE continuiuty correction is applied -#' @return \code{chisq_gof} returns an object of class \code{"chisq_gof"}. -#' An object of class \code{"chisq_gof"} is a list containing the -#' following components: -#' -#' \item{chisquare}{chi square statistic} -#' \item{pvalue}{p-value} -#' \item{df}{chi square degrees of freedom} -#' \item{ssize}{number of observations} -#' \item{names}{levels of \code{x}} -#' \item{level}{number of levels of \code{x}} -#' \item{obs}{observed frequency/proportion} -#' \item{exp}{expected frequency/proportion} -#' \item{deviation}{deviation of observed from frequency} -#' \item{std}{standardized residuals} -#' \item{varname}{name of categorical variable} -#' -#' @seealso \code{\link[stats]{chisq.test}} -#' @examples -#' chisq_gof(as.factor(hsb$race), c(20, 20, 20, 140)) -#' -#' # apply continuity correction -#' chisq_gof(as.factor(hsb$race), c(20, 20, 20, 140), correct = TRUE) -#' @export -#' -chisq_gof_shiny <- function(data, x, y, correct = FALSE) UseMethod('chisq_gof_shiny') - -#' @export -chisq_gof_shiny.default <- function(data, x, y, correct = FALSE) { - - - - if (!is.logical(correct)) { - stop('correct must be either TRUE or FALSE') - } - - varname <- x - x1 <- data %>% select_(x) %>% `[[`(1) - x2 <- as.vector(table(x1)) - n <- length(x2) - - if (length(y) != n) { - stop('Length of y must be equal to the number of categories in x') - } - - df <- n - 1 - if (sum(y) == 1) { - y <- length(x1) * y - } - if ((df == 1) || (correct == TRUE)) { - diff <- x2 - y - 0.5 - dif <- abs(x2 - y) - 0.5 - dif2 <- dif ^ 2 - dev <- round((diff / y) * 100, 2) - std <- round(diff / sqrt(y), 2) - chi <- round(sum(dif2 / y), 4) - } else { - dif <- x2 - y - dif2 <- dif ^ 2 - dev <- round((dif / y) * 100, 2) - std <- round(dif / sqrt(y), 2) - chi <- round(sum(dif2 / y), 4) - } - - sig <- round(pchisq(chi, df, lower.tail = FALSE), 4) - - result <- list( - chisquare = chi, - pvalue = sig, - df = df, - ssize = length(x1), - names = levels(x1), - level = nlevels(x1), - obs = x2, - exp = y, - deviation = format(dev, nsmall = 2), - std = format(std, nsmall = 2), - varname = varname - ) - - class(result) <- 'chisq_gof_shiny' - return(result) -} - -#' @export -print.chisq_gof_shiny <- function(x, ...) { - print_chisq_gof(x) -} - - -print_chisq_gof <- function(data) { - - cwidth <- max(nchar('Chi-Square'), nchar('DF'), nchar('Pr > Chi Sq'), nchar('Sample Size')) - nwidth <- max(nchar(data$chisquare), nchar(data$df), nchar(data$pvalue), nchar(data$ssize)) - w1 <- sum(cwidth, nwidth, 6) - lw <- max(nchar('Variable'), nchar(data$names)) - ow <- max(nchar('Observed'), nchar(data$obs)) - ew <- max(nchar('Expected'), nchar(data$exp)) - dw <- max(nchar('% Deviation'), nchar(data$deviation)) - rw <- max(nchar('Std. Residuals'), nchar(data$std)) - w <- sum(lw, ow, ew, dw, rw, 16) - - - cat(format("Test Statistics", width = w1, justify = "centre"), "\n") - cat(rep("-", w1), sep = "", '\n') - cat(format('Chi-Square', width = cwidth, justify = 'left'), formats(), format(data$chisquare, width = nwidth, justify = 'right'), '\n') - cat(format('DF', width = cwidth, justify = 'left'), formats(), format(data$df, width = nwidth, justify = 'right'), '\n') - cat(format('Pr > Chi Sq', width = cwidth, justify = 'left'), formats(), format(data$pvalue, width = nwidth, justify = 'right'), '\n') - cat(format('Sample Size', width = cwidth, justify = 'left'), formats(), format(data$ssize, width = nwidth, justify = 'right'), '\n\n') - cat(format(paste('Variable:', data$varname), width = w, justify = 'centre'), '\n') - cat(rep("-", w), sep = "", '\n') - cat(fg('Category', lw), fs(), fg('Observed', ow), fs(), fg('Expected', ew), fs(), fg('% Deviation', dw), fs(), fg('Std. Residuals', rw), '\n') - cat(rep("-", w), sep = "", '\n') - for (i in seq_len(data$level)) { - cat(fg(data$names[i], lw), fs(), fg(data$obs[i], ow), fs(), fg(data$exp[i], ew), fs(), - fg(data$deviation[i], dw), fs(), fg(data$std[i], rw), '\n') - } - cat(rep("-", w), sep = "", '\n') - -} diff --git a/inst/application/helper/one-samp-var-shiny.R b/inst/application/helper/one-samp-var-shiny.R deleted file mode 100644 index 14ba09f..0000000 --- a/inst/application/helper/one-samp-var-shiny.R +++ /dev/null @@ -1,245 +0,0 @@ -#' @importFrom stats qchisq -#' @title One sample variance comparison test -#' @description \code{os_vartest} performs tests on the equality of standard -#' deviations (variances).It tests that the standard deviation of \code{x} is -#' \code{sd}. -#' @param x a numeric vector -#' @param sd hypothesised standard deviation -#' @param confint confidence level -#' @param alternative a character string specifying the alternative hypothesis, -#' must be one of "both" (default), "greater", "less" or "all". You can specify -#' just the initial letter -#' @param ... additional arguments passed to or from other methods -#' @return \code{os_vartest} returns an object of class \code{"os_vartest"}. -#' An object of class \code{"os_vartest"} is a list containing the -#' following components: -#' -#' \item{n}{number of observations} -#' \item{sd}{hypothesised standard deviation of \code{x}} -#' \item{sigma}{observed standard deviation} -#' \item{se}{estimated standard error} -#' \item{chi}{chi-square statistic} -#' \item{df}{degrees of freedom} -#' \item{p_lower}{lower one-sided p-value} -#' \item{p_upper}{upper one-sided p-value} -#' \item{p_two}{two-sided p-value} -#' \item{xbar}{mean of \code{x}} -#' \item{c_lwr}{lower confidence limit of standard deviation} -#' \item{c_upr}{upper confidence limit of standard deviation} -#' \item{var_name}{name of \code{x}} -#' \item{conf}{confidence level} -#' \item{type}{alternative hypothesis} -#' -#' @references Sheskin, D. J. 2007. Handbook of Parametric and Nonparametric -#' Statistical Procedures, 4th edition. : Chapman & Hall/CRC. -#' @seealso \code{\link[stats]{var.test}} -#' @examples -#' os_vartest(mtcars$mpg, 5, alternative = 'less') -#' os_vartest(mtcars$mpg, 5, alternative = 'greater') -#' os_vartest(mtcars$mpg, 5, alternative = 'both') -#' os_vartest(mtcars$mpg, 5, alternative = 'all') -#' -#' @export -#' -os_vartest_shiny <- function(data, x, sd, confint = 0.95, - alternative = c('both', 'less', 'greater', 'all'), ...) UseMethod('os_vartest_shiny') - -#' @export -#' -os_vartest_shiny.default <- function(data, x, sd, confint = 0.95, - alternative = c('both', 'less', 'greater', 'all'), ...) { - - if (!is.numeric(sd)) { - stop('sd must be numeric') - } - - if (!is.numeric(confint)) { - stop('confint must be numeric') - } - - type <- match.arg(alternative) - varname <- x - x1 <- data %>% select_(x) %>% `[[`(1) - n <- length(x1) - df <- n - 1 - xbar <- round(mean(x1), 4) - sigma <- round(sd(x1), 4) - se <- round(sigma / sqrt(n), 4) - chi <- round((df * (sigma / sd) ^ 2), 4) - - p_lower <- pchisq(chi, df) - p_upper <- pchisq(chi, df, lower.tail = F) - if (p_lower < 0.5) { - p_two <- pchisq(chi, df) * 2 - } else { - p_two <- pchisq(chi, df, lower.tail = F) * 2 - } - - - conf <- confint - a <- (1 - conf) / 2 - al <- 1 - a - tv <- df * sigma - c_lwr <- round(tv / qchisq(al, df), 4) - c_upr <- round(tv / qchisq(a, df), 4) - - result <- list( - n = n, - sd = sd, - sigma = sigma, - se = se, - chi = chi, - df = df, - p_lower = p_lower, - p_upper = p_upper, - p_two = p_two, - xbar = xbar, - c_lwr = c_lwr, - c_upr = c_upr, - var_name = varname, - conf = conf, - type = type) - - class(result) <- 'os_vartest_shiny' - return(result) - -} - -#' @export -#' -print.os_vartest_shiny <- function(x, ...) { - print_os_vartest(x) -} - - -print_os_vartest <- function(data) { - - null_l <- paste0("Ho: sd(", data$var_name, ") >= ", as.character(data$sd)) - alt_l <- paste0(" Ha: sd(", data$var_name, ") < ", as.character(data$sd)) - null_u <- paste0("Ho: sd(", data$var_name, ") <= ", as.character(data$sd)) - alt_u <- paste0("Ha: sd(", data$var_name, ") > ", as.character(data$sd)) - null_t <- paste0("Ho: sd(", data$var_name, ") = ", as.character(data$sd)) - alt_t <- paste0("Ha: sd(", data$var_name, ") != ", as.character(data$sd)) - all_l <- paste("Ha: sd <", as.character(data$sd)) - all_u <- paste("Ha: sd >", as.character(data$sd)) - all_t <- paste("Ha: sd !=", as.character(data$sd)) - char_p_l <- format(data$p_lower, digits = 0, nsmall = 4) - char_p_u <- format(data$p_upper, digits = 0, nsmall = 4) - char_p <- format(data$p_two, digits = 0, nsmall = 4) - all_p_l <- paste("Pr(C < c) =", char_p_l) - if (data$p_lower < 0.5) { - all_p_t <- paste("2 * Pr(C < c) =", char_p) - } else { - all_p_t <- paste("2 * Pr(C > c) =", char_p) - } - all_p_u <- paste("Pr(C > c) =", char_p_u) - all_tval <- paste0(" c = ", as.character(data$chi)) - - - # formatting output - # compute the characters of each output and decide the overall width - var_width <- max(nchar('Variable'), nchar(data$var_name)) - obs_width <- max(nchar('Obs'), nchar(data$n)) - mean_width <- max(nchar('Mean'), nchar(data$xbar)) - se_width <- max(nchar('Std. Err.'), nchar(data$se)) - sd_width <- max(nchar('Std. Dev.'), nchar(data$sigma)) - conf_length <- nchar(data$c_lwr) + nchar(data$c_upr) - conf_str <- paste0('[', data$conf * 100, '% Conf. Interval]') - confint_length <- nchar(conf_str) - if (conf_length > confint_length) { - conf_width <- round(conf_length / 2) - } else { - conf_width <- round(confint_length / 2) - } - c_width <- nchar(data$chi) - df_width <- max(nchar('DF'), nchar(data$df)) - p_width <- max(nchar('2 Tailed'), nchar(round(data$p_two, 5))) - md_width <- max(nchar('Difference'), nchar(data$mean_diff)) - md_length <- nchar(data$mean_diff_l) + nchar(data$mean_diff_u) - - width_1 <- sum(var_width, obs_width, mean_width, se_width, sd_width, ceiling(conf_width * 2), 21) - width_2 <- sum(var_width, c_width, df_width, p_width, 12) - all_width <- round(width_1 / 3) - width_3 <- all_width * 3 - - cat(format("One-Sample Statistics", width = width_1, justify = "centre"), - "\n") - cat(rep("-", width_1), sep = "") - cat("\n", formatter_t("Variable", var_width), formats_t(), - formatter_t("Obs", obs_width), formats_t(), - formatter_t("Mean", mean_width), - formats_t(), formatter_t("Std. Err.", se_width), formats_t(), - formatter_t("Std. Dev.", sd_width), formats_t(), - formatter_t(conf_str, conf_width), "\n") - cat(rep("-", width_1), sep = "") - cat("\n", formatter_t(data$var_name, var_width), formats_t(), - formatter_t(data$n, obs_width), formats_t(), - formatter_t(data$xbar, mean_width), - formats_t(), formatter_t(data$se, se_width), formats_t(), - formatter_t(data$sigma, sd_width), formats_t(), - format_cil(data$c_lwr, conf_width), - format_ciu(data$c_upr, conf_width), "\n") - cat(rep("-", width_1), sep = "") - - # print result - if (data$type == "less") { - - cat("\n\n", format("Lower Tail Test", width = width_2, justify = "centre")) - cat("\n", format("---------------", width = width_2, justify = "centre")) - cat("\n", format(null_l, width = width_2, justify = "centre")) - cat("\n", format(alt_l, width = width_2, justify = "centre"), "\n\n") - cat(format('Chi-Square Test for Variance', width = width_2, justify = 'centre'), '\n') - cat(rep("-", width_2), sep = "") - cat("\n", formatter_t("Variable", var_width), formats_t(), formatter_t("c", c_width), formats_t(), formatter_t("DF", df_width), formats_t(), - formatter_t("Sig", p_width), formats_t(), "\n") - cat(rep("-", width_2), sep = "") - cat("\n", formatter_t(data$var_name, var_width), formats_t(), - formatter_t(round(data$chi, 3), c_width), formats_t(), - formatter_t(data$df, df_width), formats_t(), - formatter_t(char_p_l, p_width), "\n") - cat(rep("-", width_2), sep = "") - - } else if (data$type == "greater") { - - cat("\n\n", format("Upper Tail Test", width = width_2, justify = "centre")) - cat("\n", format("---------------", width = width_2, justify = "centre")) - cat("\n", format(null_u, width = width_2, justify = "centre")) - cat("\n", format(alt_u, width = width_2, justify = "centre"), "\n\n") - cat(format('Chi-Square Test for Variance', width = width_2, justify = 'centre'), '\n') - cat(rep("-", width_2), sep = "") - cat("\n", formatter_t("Variable", var_width), formats_t(), formatter_t("c", c_width), formats_t(), formatter_t("DF", df_width), formats_t(), - formatter_t("Sig", p_width), "\n") - cat(rep("-", width_2), sep = "") - cat("\n", formatter_t(data$var_name, var_width), formats_t(), - formatter_t(round(data$chi, 3), c_width), formats_t(), - formatter_t(data$df, df_width), formats_t(), - formatter_t(char_p_u, p_width), "\n") - cat(rep("-", width_2), sep = "") - - } else if (data$type == "both") { - - cat("\n\n", format("Two Tail Test", width = width_2, justify = "centre")) - cat("\n", format("---------------", width = width_2, justify = "centre")) - cat("\n", format(null_t, width = width_2, justify = "centre")) - cat("\n", format(alt_t, width = width_2, justify = "centre"), "\n\n") - cat(format('Chi-Square Test for Variance', width = width_2, justify = 'centre'), '\n') - cat(rep("-", width_2), sep = "") - cat("\n", formatter_t("Variable", var_width), formats_t(), formatter_t("c", c_width), formats_t(), formatter_t("DF", df_width), formats_t(), - formatter_t("Sig", p_width), "\n") - cat(rep("-", width_2), sep = "") - cat("\n", formatter_t(data$var_name, var_width), formats_t(), - formatter_t(round(data$chi, 3), c_width), formats_t(), - formatter_t(data$df, df_width), formats_t(), - formatter_t(char_p, p_width), "\n") - cat(rep("-", width_2), sep = "") - - } else { - - cat("\n\n", format(null_t, width = width_3, justify = "centre")) - cat("\n\n", format(all_l, width = all_width, justify = "centre"), format(all_t, width = all_width, justify = "centre"), format(all_u, width = all_width, justify = "centre"), "\n") - cat(format(all_tval, width = all_width, justify = 'centre'), format(all_tval, width = all_width, justify = 'centre'), format(all_tval, width = all_width, justify = 'centre')) - cat("\n", format(all_p_l, width = all_width, justify = 'centre'), format(all_p_t, width = all_width, justify = 'centre'), format(all_p_u, width = all_width, justify = 'centre')) - - } - -} diff --git a/inst/application/helper/output.R b/inst/application/helper/output.R deleted file mode 100644 index 593c148..0000000 --- a/inst/application/helper/output.R +++ /dev/null @@ -1,321 +0,0 @@ -print_stats <- function(data) { - - n <- nchar(format(data$uss, nsmall = 2)) - width1 <- 52 + (2 * n) - width2 <- as.integer(width1 / 2) - width3 <- width2 - 5 - width4 <- width2 - 2 - - col1 <- max(nchar(as.character(data$lowobs))) - col2 <- max(nchar(as.character(data$highobs))) - col3 <- max(nchar(as.character(data$lowobsi))) - col4 <- max(nchar(as.character(data$highobsi))) - v <- nchar("Value") - ol <- max(col1, col2, col3, col4, v) - gap <- width4 - (2 * ol) - - cat(formatc("Univariate Analysis", width1), "\n\n", - formatl("N"), formatr(data$obs, n), formats(), - formatl("Variance"), formatr(data$variance, n), "\n", - formatl("Missing"), formatr(data$missing, n), formats(), - formatl("Std Deviation"), formatr(data$stdev, n), "\n", - formatl("Mean"), formatr(data$avg, n), formats(), - formatl("Range"), formatr(data$range, n), "\n", - formatl("Median"), formatr(data$median, n), formats(), - formatl("Interquartile Range"), formatr(data$iqrange, n), "\n", - formatl("Mode"), formatr(data$mode, n), formats(), - formatl("Uncorrected SS"), formatr(data$uss, n), "\n", - formatl("Trimmed Mean"), formatr(data$tavg, n), formats(), - formatl("Corrected SS"), formatr(data$css, n), "\n", - formatl("Skewness"), formatr(data$skew, n), formats(), - formatl("Coeff Variation"), formatr(data$cvar, n), "\n", - formatl("Kurtosis"), formatr(data$kurtosis, n), formats(), - formatl("Std Error Mean"), formatr(data$sem, n), "\n\n", - formatc("Quantiles", width1), "\n\n", - formatc("Quantile", width2), formatc("Value", width2), "\n\n", - formatc("Max ", width2), formatnc(data$Max, width2), "\n", - formatc("99% ", width2), formatnc(data$per99, width2), "\n", - formatc("95% ", width2), formatnc(data$per95, width2), "\n", - formatc("90% ", width2), formatnc(data$per90, width2), "\n", - formatc("Q3 ", width2), formatnc(data$per75, width2), "\n", - formatc("Median ", width2), formatnc(data$median, width2), "\n", - formatc("Q1 ", width2), formatnc(data$per25, width2), "\n", - formatc("10% ", width2), formatnc(data$per10, width2), "\n", - formatc("5% ", width2), formatnc(data$per5, width2), "\n", - formatc("1% ", width2), formatnc(data$per1, width2), "\n", - formatc("Min ", width2), formatnc(data$min, width2), "\n\n", - formatc("Extreme Values", width1), "\n\n", - formatc("Low", width2), formatc("High", width2), "\n\n", - formatol("Obs", ol), format_gap(gap), formatol("Value", ol), formats(), - formatol("Obs", ol), format_gap(gap), formatol("Value", ol), "\n") - for (i in seq_len(5)) { - cat("",formatol(data$lowobsi[i], ol), format_gap(gap), formatol(data$lowobs[i], ol), formats(), - formatol(data$highobsi[i], ol), format_gap(gap), formatol(data$highobs[i], ol), "\n") - } - -} - -print_cross <- function(data) { - - p <- length(data$var2_levels) - q <- p + 2 - h <- p + 1 - r <- (h * 15) - 3 - f <- length(data$var1_levels) - g <- f + 2 - h <- p + 1 - - col_names <- c(data$varnames[1], data$var2_levels, "Row Total") - col_totals <- c("Column Total", data$column_totals, data$obs) - - cat(formatter(" Cell Contents\n"), "|---------------|\n", "|", formatter("Frequency"), - "|\n", "|", formatter("Percent"), "|\n", "|", formatter("Row Pct"), "|\n", - "|", formatter("Col Pct"), "|\n", "|---------------|\n\n", "Total Observations: ", - data$obs, "\n\n") - cat("-", rep("---------------", q), sep = "") - cat("\n") - cat("| |", format(data$varnames[2], width = r, justify = "centre"), - "|") - cat("\n") - cat("-", rep("---------------", q), sep = "") - cat("\n|") - for (i in seq_along(col_names)) { - cat(formatter(col_names[i]), "|") - } - cat("\n-", rep("---------------", q), sep = "") - cat("\n") - - for (i in seq_len(f)) { - cat("|") - for (j in seq_len(q)) { - cat(formatter(data$twowaytable[i, j]), "|") - } - cat("\n") - cat("| |") - for (j in seq_len(p)) { - cat(formatter(data$percent_table[i, j]), "|") - } - cat(" |") - cat("\n") - cat("| |") - for (j in seq_len(h)) { - cat(formatter(data$row_percent[i, j]), "|") - } - cat("\n") - cat("| |") - for (j in seq_len(p)) { - cat(formatter(data$column_percent[i, j]), "|") - } - cat(" |") - cat("\n-", rep("---------------", q), sep = "") - cat("\n") - } - cat("|") - for (i in seq_along(col_totals)) { - cat(formatter(col_totals[i]), "|") - } - cat("\n") - cat("| |") - for (i in seq_along(data$percent_column)) { - cat(formatter(data$percent_column[i]), "|") - } - cat(" |") - cat("\n-", rep("---------------", q), sep = "") - cat("\n") - -} - - -print_cross2 <- function(data) { - - # output formatting - p <- length(data$variable_levels) - q <- p + 2 - h <- p + 1 - r <- (h * 15) - 3 - f <- length(data$row_name) - g <- f + 2 - h <- p + 1 - tu <- q * 15 - - cat(format(paste(data$variable_names[1], 'vs', data$variable_names[2]), width = tu, justify = 'centre'), '\n') - cat("-", rep("---------------", q), sep = "") - cat("\n") - cat("| |", format(data$variable_names[2], width = r, justify = "centre"), "|") - cat("\n") - cat("-", rep("---------------", q), sep = "") - cat("\n|") - for (i in seq_along(data$column_names)) { - cat(formatter(data$column_names[i]), "|") - } - cat("\n-", rep("---------------", q), sep = "") - cat("\n") - - for (i in seq_len(f)) { - cat("|") - for (j in seq_len(q)) { - cat(formatter(data$twowaytable[i, j]), "|") - } - cat("\n") - cat("| |") - for (j in seq_len(p)) { - cat(formatter(data$percent_table[i, j]), "|") - } - cat(" |") - cat("\n") - cat("| |") - for (j in seq_len(h)) { - cat(formatter(data$row_percent[i, j]), "|") - } - cat("\n") - cat("| |") - for (j in seq_len(p)) { - cat(formatter(data$column_percent[i, j]), "|") - } - cat(" |") - cat("\n-", rep("---------------", q), sep = "") - cat("\n") - } - cat("|") - for (i in seq_along(data$column_totals)) { - cat(formatter(data$column_totals[i]), "|") - } - cat("\n") - cat("| |") - for (i in seq_along(data$percent_column)) { - cat(formatter(data$percent_column[i]), "|") - } - cat(" |") - cat("\n-", rep("---------------", q), sep = "") - cat("\n\n\n") -} - - -print_screen <- function(x) { - - columns <- c(' Column Name ', ' Data Type ', ' Levels ', ' Missing ', ' Missing (%) ') - len_col <- as.vector(sapply(columns, nchar)) - xlev <- lapply(x$levels, paste, collapse = " ") %>% - lapply(nchar) %>% - unlist %>% - max - lengths <- list(x$Variables, x$Types, xlev, x$Missing, x$MissingPer) - n <- length(columns) - nlist <- list() - for (i in seq_len(n)) { - nlist[[i]] <- max(len_col[i], max(sapply(lengths[[i]], nchar))) - } - clengths <- unlist(nlist) - clengths[3] <- max(10, xlev) - dash <- sum(clengths) + 6 - cat(rep("-",dash), sep = "") - cat("\n|") - for(i in seq_len(n)) { - cat(format(columns[i], width = clengths[i], justify = 'centre'), "|", sep = "") - } - cat("\n", rep("-",dash), sep = "") - cat("\n") - for (i in seq_len(x$Columns)) { - cat("|", format(x$Variables[i], width = clengths[1], justify = 'centre'), "|", - format(x$Types[i], width = clengths[2], justify = 'centre'), "|", - format(paste(x$levels[[i]], collapse = " "), width = clengths[3], justify = 'centre'), "|", - format(as.character(x$Missing[i]), width = clengths[4], justify = 'centre'), "|", - format(as.character(x$MissingPer[i]), width = clengths[5], justify = 'centre'), "|\n", sep = "" - ) - } - cat(rep("-",dash), sep = "") - cat("\n\n") - cat(' Overall Missing Values ', x$MissingTotal, "\n", 'Percentage of Missing Values ', x$MissingTotPer, "%\n", - 'Rows with Missing Values ', x$MissingRows, "\n", "Columns With Missing Values ", x$MissingCols, "\n") - -} - - -print_fcont <- function(data) { - - cat(format(paste('Variable:', data$varname), width = 77, justify = 'centre'), '\n') - cat("|---------------------------------------------------------------------------| -| Cumulative Cumulative | -| Bins | Frequency | Frequency | Percent | Percent | -|---------------------------------------------------------------------------|") - for (i in seq_len(data$bins)) { - k <- i + 1 - cat("\n|", formata(data$breaks[i], 1, 5), "-", formata(data$breaks[k], 1, 5), "|", - formata(data$frequency[i], 2, 12), "|", formata(data$cumulative[i], 2, 12), "|", - formatas(data$percent[i], 2, 12), "|", formatas(data$cum_percent[i], 2, 12), "|") - cat("\n|---------------------------------------------------------------------------|") - } - -} - - -print_ftable <- function(data) { - - nr <- nrow(data$ftable) - nc <- ncol(data$ftable) - cat(format(paste('Variable:', data$varname), width = 76, justify = 'centre'), '\n') - cat("|--------------------------------------------------------------------------| -| Cumulative Cumulative | -| Levels | Frequency | Frequency | Percent | Percent | -|--------------------------------------------------------------------------|\n") - for (i in seq_len(nr)) { - for (j in seq_len(nc)) { - cat("|", formatter_freq(data$ftable[i, j])) - } - cat("|") - cat("\n|--------------------------------------------------------------------------|\n") - } - cat('\n\n') - -} - - -print_ftable2 <- function(data) { - nr <- nrow(data$ftable) - nc <- ncol(data$ftable) - cat(format(paste('Variable:', data$varname), width = 76, justify = 'centre'), '\n') - cat("|--------------------------------------------------------------------------| -| Cumulative Cumulative | -| Levels | Frequency | Frequency | Percent | Percent | -|--------------------------------------------------------------------------|\n") - for (i in seq_len(nr)) { - for (j in seq_len(nc)) { - cat("|", formatter_freq(data$ftable[i, j])) - } - cat("|") - cat("\n|--------------------------------------------------------------------------|\n") - } - cat('\n\n') -} - - -print_group <- function(data) { - - line <- 23 - n <- 21 - n_names <- max(nchar(data$stats[2, c(-1)])) - n_uss <- max(nchar(data$stats[12, c(-1)])) - w <- max(n_names, n_uss) + 2 - cola <- ncol(data$stats) - col <- cola - 1 - ow <- 23 * cola - col - row <- nrow(data$stats) - - cat(format(paste(data$yvar, 'by', data$xvar), width = ow, justify = 'centre'), '\n') - cat(rep('-', ow), sep = '', '\n') - cat('|') - for (i in seq_len(cola)) { - cat(format(colnames(data$stats)[i], width = n, justify = 'right'), '|', sep = '') - } - cat('\n') - cat(rep('-', ow), sep = '', '\n') - for (i in seq_len(row)) { - cat('|') - for (j in seq_len(cola)) { - cat(format(data$stats[i, j], width = n, justify = 'right'), '|', sep = '') - } - cat('\n') - } - cat(rep('-', ow), sep = '', '\n') - -} diff --git a/inst/application/helper/paired-ttest-shiny.R b/inst/application/helper/paired-ttest-shiny.R deleted file mode 100644 index c025686..0000000 --- a/inst/application/helper/paired-ttest-shiny.R +++ /dev/null @@ -1,235 +0,0 @@ -#' @importFrom stats cor -#' @title Paired t test -#' @description \code{paired_ttest} tests that \code{x} and \code{y} have the -#' same mean, assuming paired data. -#' @param x a numeric vector -#' @param y a numeric vector -#' @param confint confidence level -#' @param alternative a character string specifying the alternative hypothesis, must be -#' one of "both" (default), "greater", "less" or "all". You can specify just the -#' initial letter. -#' @return \code{paired_ttest} returns an object of class \code{"paired_ttest"}. -#' An object of class \code{"paired_ttest"} is a list containing the -#' following components: -#' -#' \item{Obs}{number of observations} -#' \item{b}{mean, standard deviation and standard error of \code{x}, \code{y} -#' and their difference} -#' \item{tstat}{t statistic} -#' \item{p_lower}{lower one-sided p-value} -#' \item{p_upper}{upper one-sided p-value} -#' \item{p_two_tail}{two sided p-value} -#' \item{corr}{Correlation of \code{x} and \code{y}} -#' \item{corsig}{p-value of correlation test} -#' \item{conf_int1}{confidence interval for mean of \code{x}} -#' \item{conf_int2}{confidence interval for mean of \code{y}} -#' \item{conf_int_diff}{confidence interval for mean of difference of \code{x} -#' and \code{y}} -#' \item{df}{degrees of freedom} -#' \item{confint}{confidence level} -#' \item{alternative}{alternative hypothesis} -#' \item{var_names}{names of \code{x} and \code{y}} -#' \item{xy}{string used in printing results of the test} -#' -#' @references Sheskin, D. J. 2007. Handbook of Parametric and Nonparametric -#' Statistical Procedures, 4th edition. : Chapman & Hall/CRC. -#' @seealso \code{\link[stats]{t.test}} -#' @examples -#' paired_ttest(hsb$read, hsb$write, alternative = 'less') -#' paired_ttest(hsb$read, hsb$write, alternative = 'greater') -#' paired_ttest(hsb$read, hsb$write, alternative = 'both') -#' paired_ttest(hsb$read, hsb$write, alternative = 'all') -#' @export -#' -paired_ttest_shiny <- function(data, x, y, confint = 0.95, - alternative = c('both', 'less', 'greater', 'all')) UseMethod('paired_ttest_shiny') - -#' @export -#' -paired_ttest_shiny.default <- function(data, x, y, confint = 0.95, - alternative = c('both', 'less', 'greater', 'all')) { - - if (!is.numeric(confint)) { - stop('confint must be numeric') - } - - method <- match.arg(alternative) - var_x <- x - var_y <- y - var_names <- c(var_x, var_y) - x1 <- data %>% select_(x) %>% `[[`(1) - y1 <- data %>% select_(y) %>% `[[`(1) - n <- length(x1) - df <- (n - 1) - xy <- paste(var_names[1], '-', var_names[2]) - data_prep <- paired_data(x1, y1) - b <- paired_stats(data_prep, 'key', 'value') - corr <- round(cor(x1, y1), 4) - corsig <- cor_sig(corr, n) - alpha <- 1 - confint - confint1 <- conf_int_t(b[[1, 1]], b[[1, 2]], n, alpha = alpha) %>% round(2) - confint2 <- conf_int_t(b[[2, 1]], b[[2, 2]], n, alpha = alpha) %>% round(2) - confint3 <- conf_int_t(b[[3, 1]], b[[3, 2]], n, alpha = alpha) %>% round(2) - t <- round(b[[3, 1]] / b[[3, 3]], 4) - p_l <- pt(t, df) - p_u <- pt(t, df, lower.tail = FALSE) - p <- pt(abs(t), df, lower.tail = FALSE) * 2 - - result <- list( - Obs = n, - b = b, - conf_int1 = confint1, - conf_int2 = confint2, - conf_int_diff = confint3, - corr = round(corr, 2), - corsig = round(corsig, 2), - tstat = t, - p_lower = p_l, - p_upper = p_u, - p_two_tail = p, - var_names = var_names, - xy = xy, - df = df, - alternative = method, - confint = confint) - - class(result) <- 'paired_ttest_shiny' - return(result) -} - -#' @export -#' -print.paired_ttest_shiny <- function(x, ...) { - print_paired_ttest(x) -} - - -print_paired_ttest <- function(data) { - - char_p_u <- format(data$p_upper, digits = 0, nsmall = 3) - char_p_l <- format(data$p_lower, digits = 0, nsmall = 3) - char_p <- format(data$p_two_tail, digits = 0, nsmall = 3) - - # hypothesis heading - hyp_null <- paste0('Ho: mean(', data$var_names[1], ' - ', data$var_names[2], ') = ', '0') - hyp_lt <- paste0('Ha: mean(', data$var_names[1], ' - ', data$var_names[2], ') < ', '0') - hyp_ut <- paste0('Ha: mean(', data$var_names[1], ' - ', data$var_names[2], ') > ', '0') - hyp_2t <- paste0('Ha: mean(', data$var_names[1], ' - ', data$var_names[2], ') ~= ', '0') - conf <- data$confint * 100 - conf_char <- paste0('[', conf, '% Conf. Interval]') - - # all tests combines - all_null <- paste0('Ho: mean(', data$var_names[1], ' - ', data$var_names[2], ') = mean(diff) = ', '0') - all_p_l <- paste("P < t =", char_p_l) - all_p_t <- paste("P > |t| =", char_p) - all_p_u <- paste("P > t =", char_p_u) - all_tval <- paste0(" t = ", as.character(data$tstat)) - - # formatting output - var_width1 <- max(nchar('Variables'), nchar(data$var_names[1]), nchar(data$var_names[2]), nchar('diff')) - var_width <- max(nchar('Variables'), nchar(data$xy)) - obs_width <- max(nchar('Obs'), nchar(data$Obs)) - mean_width <- max(nchar('Mean'), nchar(format(max(data$b[['mean']]), nsmall = 2))) - se_width <- max(nchar('Std. Err.'), nchar(format(max(data$b[['se']]), nsmall = 2))) - sd_width <- max(nchar('Std. Dev.'), nchar(format(max(data$b[['sd']]), nsmall = 2))) - corr_width <- nchar('Correlation') - corsig_width <- max(nchar('Sig.'), nchar(data$corsig)) - t_width <- nchar(data$tstat) - df_width <- max(nchar('DF'), nchar(data$df)) - p_width <- max(nchar('Sig.'), nchar(format(data$corsig, nsmall = 3))) - conf_length <- max(sum(nchar(data$conf_int1)), sum(nchar(data$conf_int2))) - if (conf_length > 20) { - conf_width <- conf_length - conf_l_width <- ceiling(conf_width / 2) - conf_u_width <- ceiling(conf_width / 2) - } else { - conf_width <- 20 - conf_l_width <- 10 - conf_u_width <- 10 - } - space1 <- 20 - space2 <- 13 - space3 <- 13 - width_1 <- sum(var_width1, obs_width, mean_width, se_width, sd_width, conf_width,space1) - width_2 <- sum(var_width, obs_width, corr_width, corsig_width, space2) - width_3 <- sum(var_width, t_width, df_width, p_width, space3) - - cat(format("Paired Samples Statistics", width = width_1, justify = "centre"), "\n") - cat(rep("-", width_1), sep = "", "\n") - cat(formatter_pair("Variables", var_width1), formats_t(), formatter_pair("Obs", obs_width), formats_t(), formatter_pair("Mean", mean_width), - formats_t(), formatter_pair("Std. Err.", se_width), formats_t(), formatter_pair("Std. Dev.", sd_width), formats_t(), conf_char, "\n") - cat(rep("-", width_1), sep = "") - cat('\n', formatter_pair(data$var_names[1], var_width1), formats_t(), formatter_pair(data$Obs, obs_width), formats_t(), formatter_pair(data$b[[1, 1]], mean_width), - formats_t(), formatter_pair(data$b[[1, 3]], se_width), formats_t(), formatter_pair(data$b[[1,2]], sd_width), formats_t(), format_cil(data$conf_int1[[1]], conf_l_width), - format_ciu(data$conf_int1[[2]], conf_u_width)) - cat('\n', formatter_pair(data$var_names[2], var_width1), formats_t(), formatter_pair(data$Obs, obs_width), formats_t(), formatter_pair(data$b[[2, 1]], mean_width), formats_t(), formatter_pair(data$b[[2, 3]], se_width), - formats_t(), formatter_pair(data$b[[2, 2]], sd_width), formats_t(), format_cil(data$conf_int2[[1]], conf_l_width), - format_ciu(data$conf_int2[[2]], conf_u_width), "\n") - cat(rep("-", width_1), sep = "") - cat("\n", formatter_pair('diff', var_width1), formats_t(), formatter_pair(data$Obs, obs_width), formats_t(), formatter_pair(data$b[[3, 1]], mean_width), formats_t(), formatter_pair(data$b[[3, 3]], se_width), - formats_t(), formatter_pair(data$b[[3, 2]], sd_width), formats_t(), format_cil(data$conf_int_diff[[1]], conf_l_width), - format_ciu(data$conf_int_diff[[2]], conf_u_width), "\n") - cat(rep("-", width_1), sep = "") - cat("\n\n", format("Paired Samples Correlations", width = width_2, justify = "centre"), "\n") - cat(rep("-", width_2), sep = "") - cat("\n", formatter_pair("Variables", var_width), formats_t(), formatter_pair("Obs", obs_width), formats_t(), formatter_pair("Correlation", corr_width), - formats_t(), formatter_pair("Sig.", corsig_width)) - cat("\n", formatter_pair(paste(data$var_names[1], "&", data$var_names[2]), var_width), formats_t(), formatter_pair(data$Obs, obs_width), - formats_t(), formatter_pair(data$corr, corr_width), formats_t(), format(data$corsig, corsig_width), "\n") - cat(rep("-", width_2), sep = "", "\n\n") - - # print output - if (data$alternative == 'less') { - - cat(format("Paired Samples Test", width = width_3, justify = "centre"), "\n") - cat(format('-------------------', width = width_3, justify = "centre"), "\n") - cat(format(hyp_null, width = width_3, justify = 'centre'), "\n") - cat(format(hyp_lt, width = width_3, justify = 'centre'), "\n\n") - cat(rep("-", width_3), sep = "") - cat("\n", formatter_pair("Variables", var_width), formats_t(), formatter_pair("t", t_width), - formats_t(), formatter_pair("df", df_width), formats_t(), formatter_pair("Sig.", p_width), "\n") - cat(rep("-", width_3), sep = "") - cat("\n", formatter_pair(paste(data$var_names[1], "-", data$var_names[2]), var_width), formats_t(), formatter_pair(data$tstat, t_width), formats_t(), format(data$df, df_width), - formats_t(), formatter_pair(char_p_l, p_width), "\n") - cat(rep("-", width_3), sep = "") - - } else if (data$alternative == 'greater') { - - cat(format("Paired Samples Test", width = width_3, justify = "centre"), "\n") - cat(format('-------------------', width = width_3, justify = "centre"), "\n") - cat(format(hyp_null, width = width_3, justify = 'centre'), "\n") - cat(format(hyp_ut, width = width_3, justify = 'centre'), "\n\n") - cat(rep("-", width_3), sep = "") - cat("\n", formatter_pair("Variables", var_width), formats_t(), formatter_pair("t", t_width), - formats_t(), formatter_pair("df", df_width), formats_t(), formatter_pair("Sig.", p_width), "\n") - cat(rep("-", width_3), sep = "") - cat("\n", formatter_pair(paste(data$var_names[1], "-", data$var_names[2]), var_width), formats_t(), formatter_pair(data$tstat, t_width), formats_t(), format(data$df, df_width), - formats_t(), formatter_pair(char_p_u, p_width), "\n") - cat(rep("-", width_3), sep = "") - - } else if (data$alternative == 'both') { - - cat(format("Paired Samples Test", width = width_3, justify = "centre"), "\n") - cat(format('-------------------', width = width_3, justify = "centre"), "\n") - cat(format(hyp_null, width = width_3, justify = 'centre'), "\n") - cat(format(hyp_2t, width = width_3, justify = 'centre'), "\n\n") - cat(rep("-", width_3), sep = "") - cat("\n", formatter_pair("Variables", var_width), formats_t(), formatter_pair("t", t_width), - formats_t(), formatter_pair("df", df_width), formats_t(), formatter_pair("Sig.", p_width), "\n") - cat(rep("-", width_3), sep = "") - cat("\n", formatter_pair(paste(data$var_names[1], "-", data$var_names[2]), var_width), formats_t(), formatter_pair(data$tstat, t_width), formats_t(), format(data$df, df_width), - formats_t(), formatter_pair(char_p, p_width), "\n") - cat(rep("-", width_3), sep = "") - - } else { - - cat(format(all_null, width = 72, justify = 'centre'), "\n\n") - cat(format('Ha: mean(diff) < 0', width = 24, justify = 'centre'), format('Ha: mean(diff) ~= 0', width = 24, justify = 'centre'), - format('Ha: mean(diff) > 0', width = 24, justify = 'centre'), "\n") - cat(format(all_tval, width = 24, justify = 'centre'), format(all_tval, width = 24, justify = 'centre'), format(all_tval, width = 24, justify = 'centre'), "\n") - cat(format(all_p_l, width = 24, justify = 'centre'), format(all_p_t, width = 24, justify = 'centre'), format(all_p_u, width = 24, justify = 'centre'), "\n") - - - } - -} diff --git a/inst/application/helper/t-test-shiny.R b/inst/application/helper/t-test-shiny.R deleted file mode 100644 index 0f412bb..0000000 --- a/inst/application/helper/t-test-shiny.R +++ /dev/null @@ -1,288 +0,0 @@ -#' @title One sample t test -#' @description ttest performs t tests on the equality of means. It tests the -#' hypothesis that \code{x} has a mean of \code{mu}. -#' @param x a numeric vector -#' @param mu a number indicating the true value of the mean -#' @param alpha acceptable tolerance for type I error -#' @param type a character string specifying the alternative hypothesis, must be -#' one of "both" (default), "greater", "less" or "all". You can specify just the -#' initial letter -#' @param ... additional arguments passed to or from other methods -#' @return \code{ttest} returns an object of class \code{"ttest"}. -#' An object of class \code{"ttest"} is a list containing the -#' following components: -#' -#' \item{mu}{a number indicating the true value of the mean} -#' \item{n}{number of observations} -#' \item{df}{degrees of freedom} -#' \item{Mean}{observed mean of \code{x}} -#' \item{stddev}{standard deviation of \code{x}} -#' \item{std_err}{estimate of standard error} -#' \item{test_stat}{t statistic} -#' \item{confint}{confidence interval for the mean} -#' \item{mean_diff}{mean difference} -#' \item{mean_diff_l}{lower confidence limit for mean difference} -#' \item{mean_diff_u}{upper confidence limit for mean difference} -#' \item{p_l}{lower one-sided p-value} -#' \item{p_u}{upper one-sided p-value} -#' \item{p}{two sided p-value} -#' \item{conf}{confidence level} -#' \item{type}{alternative hypothesis} -#' \item{var_name}{name of \code{x}} -#' -#' @references Sheskin, D. J. 2007. Handbook of Parametric and Nonparametric -#' Statistical Procedures, 4th edition. : Chapman & Hall/CRC. -#' @seealso \code{\link[stats]{t.test}} -#' @examples -#' ttest(hsb$write, mu = 50, type = 'less') -#' ttest(hsb$write, mu = 50, type = 'greater') -#' ttest(hsb$write, mu = 50, type = 'both') -#' ttest(hsb$write, mu = 50, type = 'all') -#' @export -#' -ttest_shiny <- function(data, x, mu = 0, alpha = 0.05, - type = c("both", "less", "greater", "all"), ...) UseMethod('ttest_shiny') - -#' @export -#' -ttest_shiny.default <- function(data, x, mu = 0, alpha = 0.05, - type = c("both", "less", "greater", "all"), ...) { - - if (!is.data.frame(data)) { - stop('data must be a data frame') - } - - if (!x %in% colnames(data)) { - stop('x must be a column in data') - } - - if (!is.numeric(mu)) { - stop('mu must be numeric') - } - if (!is.numeric(alpha)) { - stop('alpha must be numeric') - } - - type <- match.arg(type) - var_name <- x - y <- data %>% select_(x) %>% `[[`(1) - n <- length(y) - a <- (alpha / 2) - df <- n - 1 - conf <- 1 - alpha - Mean <- round(mean(y), 4) - stddev <- round(sd(y), 4) - std_err <- round(stddev / sqrt(n), 4) - test_stat <- round((Mean - mu) / std_err, 3) - - if (type == 'less') { - cint <- c(-Inf, test_stat + qt(1 - alpha, df) ) - } else if (type == 'greater') { - cint <- c(test_stat - qt(1 - alpha, df), Inf) - } else { - cint <- qt(1 - a, df) - cint <- test_stat + c(-cint, cint) - } - - confint <- round(mu + cint * std_err, 4) - mean_diff <- round((Mean - mu), 4) - mean_diff_l <- confint[1] - mu - mean_diff_u <- confint[2] - mu - p_l <- pt(test_stat, df) - p_u <- pt(test_stat, df, lower.tail = FALSE) - - if (p_l < 0.5) { - p <- p_l * 2 - } else { - p <- p_u * 2 - } - - - result <- list( - mu = mu, - n = n, - df = df, - Mean = Mean, - stddev = stddev, - std_err = std_err, - test_stat = test_stat, - confint = confint, - mean_diff = mean_diff, - mean_diff_l = mean_diff_l, - mean_diff_u = mean_diff_u, - p_l = p_l, - p_u = p_u, - p = p, - conf = conf, - type = type, - var_name = var_name) - - class(result) <- 'ttest_shiny' - return(result) - -} - -#' @export -#' -print.ttest_shiny <- function(x, ...) { - print_ttest(x) -} - -formatter_t <- function(x, w) { - x %>% - as.character() %>% - format(width = w, justify = 'centre') -} - -format_cil <- function(x, w) { - x %>% - as.character() %>% - format(width = w, justify = 'centre')} - -format_ciu <- function(x, w) { - x %>% - as.character() %>% - format(width = w, justify = 'centre') -} - -formats_t <- function() { - rep(" ") -} - -print_ttest <- function(data) { - - null_l <- paste0("Ho: mean(", data$var_name, ") >=", as.character(data$mu)) - alt_l <- paste0(" Ha: mean(", data$var_name, ") <", as.character(data$mu)) - null_u <- paste0("Ho: mean(", data$var_name, ") <=", as.character(data$mu)) - alt_u <- paste0("Ha: mean(", data$var_name, ") >", as.character(data$mu)) - null_t <- paste0("Ho: mean(", data$var_name, ") ~=", as.character(data$mu)) - alt_t <- paste0("Ha: mean(", data$var_name, ") !=", as.character(data$mu)) - all_l <- paste("Ha: mean <", as.character(data$mu)) - all_u <- paste("Ha: mean >", as.character(data$mu)) - all_t <- paste("Ha: mean ~=", as.character(data$mu)) - char_p_l <- format(data$p_l, digits = 0, nsmall = 4) - char_p_u <- format(data$p_u, digits = 0, nsmall = 4) - char_p <- format(data$p, digits = 0, nsmall = 4) - all_p_l <- paste("P < t =", char_p_l) - all_p_t <- paste("P > |t| =", char_p) - all_p_u <- paste("P > t =", char_p_u) - all_tval <- paste0(" t = ", as.character(data$test_stat)) - - - # formatting output - # compute the characters of each output and decide the overall width - var_width <- max(nchar('Variable'), nchar(data$var_name)) - obs_width <- max(nchar('Obs'), nchar(data$n)) - mean_width <- max(nchar('Mean'), nchar(data$Mean)) - se_width <- max(nchar('Std. Err.'), nchar(data$std_err)) - sd_width <- max(nchar('Std. Dev.'), nchar(data$stddev)) - conf_length <- nchar(data$confint[1]) + nchar(data$confint[2]) - conf_str <- paste0('[', data$conf * 100, '% Conf. Interval]') - confint_length <- nchar(conf_str) - if (conf_length > confint_length) { - conf_width <- round(conf_length / 2) - } else { - conf_width <- round(confint_length / 2) - } - t_width <- nchar(data$test_stat) - df_width <- max(nchar('DF'), nchar(data$df)) - p_width <- max(nchar('2 Tailed'), nchar(round(data$p, 5))) - md_width <- max(nchar('Difference'), nchar(data$mean_diff)) - md_length <- nchar(data$mean_diff_l) + nchar(data$mean_diff_u) - if (md_length > confint_length) { - md_conf_width <- floor(md_length / 2) - } else { - md_conf_width <- floor(confint_length / 2) - } - - width_1 <- sum(var_width, obs_width, mean_width, se_width, sd_width, ceiling(conf_width * 2), 26) - width_2 <- sum(var_width, t_width, df_width, p_width, md_width, ceiling(md_conf_width * 2), 26) - all_width <- round(width_1 / 3) - - cat(format("One-Sample Statistics", width = width_1, justify = "centre"), - "\n") - cat(rep("-", width_1), sep = "") - cat("\n", formatter_t("Variable", var_width), formats_t(), - formatter_t("Obs", obs_width), formats_t(), - formatter_t("Mean", mean_width), - formats_t(), formatter_t("Std. Err.", se_width), formats_t(), - formatter_t("Std. Dev.", sd_width), formats_t(), - formatter_t(conf_str, conf_width), "\n") - cat(rep("-", width_1), sep = "") - cat("\n", formatter_t(data$var_name, var_width), formats_t(), - formatter_t(data$n, obs_width), formats_t(), - formatter_t(data$Mean, mean_width), - formats_t(), formatter_t(data$std_err, sd_width), formats_t(), - formatter_t(data$stddev, se_width), formats_t(), - format_cil(data$confint[1], conf_width), - format_ciu(data$confint[2], conf_width), "\n") - cat(rep("-", width_1), sep = "") - - # print result - if (data$type == "less") { - - cat("\n\n", format("Lower Tail Test", width = width_2, justify = "centre")) - cat("\n", format("---------------", width = width_2, justify = "centre"), "\n") - cat("\n", format(null_l, width = width_2, justify = "centre")) - cat("\n", format(alt_l, width = width_2, justify = "centre"), "\n") - cat(rep("-", width_2), sep = "") - cat("\n", formatter_t("Variable", var_width), formats_t(), formatter_t("t", t_width), formats_t(), formatter_t("DF", df_width), formats_t(), - formatter_t("Sig", p_width), formats_t(), formatter_t("Mean Diff.", md_width), formats_t(), formatter_t(conf_str, md_conf_width), "\n") - cat(rep("-", width_2), sep = "") - cat("\n", formatter_t(data$var_name, var_width), formats_t(), - formatter_t(round(data$test_stat, 3), t_width), formats_t(), - formatter_t(data$df, df_width), formats_t(), - formatter_t(round(data$p_l, 5), p_width), - formats_t(), formatter_t(data$mean_diff, md_width), formats_t(), - format_cil(round(data$mean_diff_l,4), md_conf_width), - format_ciu(round(data$mean_diff_u, 4), md_conf_width), "\n") - cat(rep("-", width_2), sep = "") - - } else if (data$type == "greater") { - - cat("\n\n", format("Upper Tail Test", width = width_2, justify = "centre")) - cat("\n", format("---------------", width = width_2, justify = "centre"), "\n") - cat("\n", format(null_u, width = width_2, justify = "centre")) - cat("\n", format(alt_u, width = width_2, justify = "centre"), "\n") - cat(rep("-", width_2), sep = "") - cat("\n", formatter_t("Variable", var_width), formats_t(), formatter_t("t", t_width), formats_t(), formatter_t("DF", df_width), formats_t(), - formatter_t("Sig", p_width), formats_t(), formatter_t("Mean Diff.", md_width), formats_t(), formatter_t(conf_str, md_conf_width), "\n") - cat(rep("-", width_2), sep = "") - cat("\n", formatter_t(data$var_name, var_width), formats_t(), - formatter_t(round(data$test_stat, 3), t_width), formats_t(), - formatter_t(data$df, df_width), formats_t(), - formatter_t(round(data$p_l, 5), p_width), - formats_t(), formatter_t(data$mean_diff, md_width), formats_t(), - format_cil(round(data$mean_diff_l,4), md_conf_width), - format_ciu(round(data$mean_diff_u, 4), md_conf_width), "\n") - cat(rep("-", width_2), sep = "") - - } else if (data$type == "both") { - - cat("\n\n", format("Two Tail Test", width = width_2, justify = "centre")) - cat("\n", format("---------------", width = width_2, justify = "centre"), "\n") - cat("\n", format(null_t, width = width_2, justify = "centre")) - cat("\n", format(alt_t, width = width_2, justify = "centre"), "\n") - cat(rep("-", width_2), sep = "") - cat("\n", formatter_t("Variable", var_width), formats_t(), formatter_t("t", t_width), formats_t(), formatter_t("DF", df_width), formats_t(), - formatter_t("Sig", p_width), formats_t(), formatter_t("Mean Diff.", md_width), formats_t(), formatter_t(conf_str, md_conf_width), "\n") - cat(rep("-", width_2), sep = "") - cat("\n", formatter_t(data$var_name, var_width), formats_t(), - formatter_t(round(data$test_stat, 3), t_width), formats_t(), - formatter_t(data$df, df_width), formats_t(), - formatter_t(round(data$p_l, 5), p_width), - formats_t(), formatter_t(data$mean_diff, md_width), formats_t(), - format_cil(round(data$mean_diff_l,4), md_conf_width), - format_ciu(round(data$mean_diff_u, 4), md_conf_width), "\n") - cat(rep("-", width_2), sep = "") - - } else { - - cat("\n\n", format(null_t, width = width_2, justify = "centre")) - cat("\n\n", format(all_l, width = all_width, justify = "centre"), format(all_t, width = all_width, justify = "centre"), format(all_u, width = all_width, justify = "centre"), "\n") - cat(format(all_tval, width = all_width, justify = 'centre'), format(all_tval, width = all_width, justify = 'centre'), format(all_tval, width = all_width, justify = 'centre')) - cat("\n", format(all_p_l, width = all_width, justify = 'centre'), format(all_p_t, width = all_width, justify = 'centre'), format(all_p_u, width = all_width, justify = 'centre')) - - } - -} diff --git a/inst/application/helper/utils.R b/inst/application/helper/utils.R deleted file mode 100644 index 04d6c35..0000000 --- a/inst/application/helper/utils.R +++ /dev/null @@ -1,382 +0,0 @@ -formatter_freq <- function(x) { - x %>% - as.character() %>% - format(width = 13, justify = "centre") -} - - -formatter <- function(x) { - x %>% - as.character() %>% - format(width = 13, justify = "right") -} - -percent <- function(x, y) { - out <- round((x / y) * 100, 2) -} - - -formata <- function(x, round, width, justify = "centre") { - x %>% - round(round) %>% - as.character() %>% - format(width = width, justify = justify) -} - -formatas <- function(x, round, width, justify = "centre") { - return(format(x, width = width, justify = justify)) -} - -bin_size <- function(data, bins) { - return((max(data, na.rm = TRUE) - min(data, na.rm = TRUE)) / bins) -} - -intervals <- function(data, bins, na.rm = TRUE) { - binsize <- bin_size(data, bins) - bin <- bins - 1 - interval <- min(data) - for (i in seq_len(bin)) { - out <- interval[i] + binsize - interval <- c(interval, out) - } - interval <- c(interval, max(data)) - return(interval) -} - -freq <- function(data, bins, inta) { - result <- c() - for (i in seq_len(bins)) { - k <- i + 1 - freq <- data >= inta[i] & data <= inta[k] - out <- length(data[freq]) - result <- c(result, out) - } - return(result) -} - -div_by <- function(x) { - 1 / x -} - -standardize <- function(x, avg, stdev, p) { - ((x - avg) / stdev) ^ p -} - - -sums <- function(x, q) { - avg <- mean(x) - stdev <- sd(x) - result <- sum(sapply(x, standardize, avg, stdev, q)) - return(result) -} - -md_helper <- function(x, y) { - abs(x - y) -} - - -std_error <- function(x) { - sd(x) / (length(x) ^ 0.5) -} - -uss <- function(x, y) { - (x - y) ^ 2 -} - -stat_uss <- function(x) { - sum(x ^ 2) -} - - -formatl <- function(x) { - x %>% - format(nsmall = 2) %>% - format(width = 20, justify = "left") -} - -formatol <- function(x, w) { - format(as.character(x), width = w, justify = "centre") -} - - -formatr <- function(x, w) { - x %>% - rounda() %>% - format(nsmall = 2, width = w, justify = "right") -} - - -formatc <- function(x, w) { - if (is.numeric(x)) { - ret <- x %>% - round(2) %>% - as.character(x) %>% - format(width = w, justify = "centre") - } else { - ret <- x %>% - as.character(x) %>% - format(width = w, justify = "centre") - } - return(ret) -} - - -formatnc <- function(x, w) { - x %>% - round(2) %>% - format(nsmall = 2) %>% - format(width = w, justify = "centre") -} - - -formats <- function() { - x <- rep(" ") -} - -format_gap <- function(w) { - x <- rep("", w) -} - -return_pos <- function(data, number) { - out <- c() - for (i in seq_len(length(data))) { - if (data[i] == number) { - out <- c(out, i) - } - } - return(out) -} - -row_pct <- function(mat, tot) { - rows <- dim(mat)[1] - l <- length(tot) - result <- c() - for (i in seq_len(rows)) { - diva <- mat[i, ] / tot[i] - result <- rbind(result, diva) - } - rownames(result) <- NULL - return(result) -} - -col_pct <- function(mat, tot) { - cols <- dim(mat)[2] - l <- length(tot) - result <- c() - for (i in seq_len(cols)) { - diva <- mat[, i] / tot[i] - result <- cbind(result, diva) - } - colnames(result) <- NULL - return(result) -} - -rounda <- function(x) { - round(x, 2) -} - -l <- function(x) { - x <- as.character(x) - k <- grep("\\$", x) - if (length(k) == 1) { - temp <- strsplit(x, "\\$") - out <- temp[[1]][2] - } else { - out <- x - } - return(out) -} - -fround <- function(x) { - format(round(x, 2), nsmall = 2) -} - -pol_chi <- function(l1, l2, df, col) { - - x <- c(l1, seq(l1, l2, 0.01), l2) - y <- c(0, dchisq(seq(l1, l2, 0.01), df), 0) - polygon(x, y, col = col) - -} - -pol_f <- function(l1, l2, num_df, den_df, col) { - - x <- c(l1, seq(l1, l2, 0.01), l2) - y <- c(0, df(seq(l1, l2, 0.01), num_df, den_df), 0) - polygon(x, y, col = col) - -} - - -pol_cord <- function(l1, l2, mean, sd, col) { - - x <- c(l1, seq(l1, l2, 0.01), l2) - y <- c(0, dnorm(seq(l1, l2, 0.01), mean, sd), 0) - polygon(x, y, col = col) - -} - - -xaxp <- function(mean, el) { - - xl <- mean - el - xu <- mean + el - x <- seq(xl, xu, 0.01) - return(x) -} - - -seqlp <- function(mean, sd, el) { - - lmin <- mean - (el * sd) - lmax <- mean + (el * sd) - l <- seq(lmin, lmax, sd) - return(l) - -} - - -xmmp <- function(mean, sd, el) { - xmin <- mean - (el * sd) - xmax <- mean + (el * sd) - out <- c(xmin, xmax) - return(out) -} - - -xax <- function(mean) { - - xl <- mean - 3 - xu <- mean + 3 - x <- seq(xl, xu, 0.01) - return(x) -} - - -seql <- function(mean, sd) { - - lmin <- mean - (5 * sd) - lmax <- mean + (5 * sd) - l <- seq(lmin, lmax, sd) - return(l) - -} - - -xmm <- function(mean, sd) { - xmin <- mean - (5 * sd) - xmax <- mean + (5 * sd) - out <- c(xmin, xmax) - return(out) -} - - -seqln <- function(mean, sd) { - - lmin <- mean - 3 * sd - lmax <- mean + 3 * sd - l <- seq(lmin, lmax, sd) - return(l) - -} - - -xmn <- function(mean, sd) { - xmin <- mean - 3 * sd - xmax <- mean + 3 * sd - out <- c(xmin, xmax) - return(out) -} - - -pol_t <- function(l1, l2, df, col) { - - x <- c(l1, seq(l1, l2, 0.01), l2) - y <- c(0, dt(seq(l1, l2, 0.01), df), 0) - polygon(x, y, col = col) - -} - - -# ss <- function(x) { -# return(x ^ 2) -# } -# -# fl <- function(x, w) { -# x <- as.character(x) -# ret <- format(x, width = w, justify = "left") -# return(ret) -# } -# -# fc <- function(x, w) { -# x <- as.character(x) -# ret <- format(x, width = w, justify = "centre") -# return(ret) -# } -# formatrc <- function(x, w) { -# x <- as.character(x) -# ret <- format(x, width = w, justify = "right") -# return(ret) -# } - - - -paired_data <- function(x, y) { - d <- tibble(x = x, y = y) %>% - mutate(z = x - y) %>% - gather() - return(d) -} - - -paired_stats <- function(data, key, value) { - d <- data %>% - group_by_(key) %>% - select_(value, key) %>% - summarise_all(funs(length, mean, sd)) %>% - as_data_frame() %>% - mutate( - se = sd / sqrt(length) - ) %>% - select(-(key:length)) %>% - round(2) - return(d) -} - -samp_err <- function(sigma, n) { - sigma / (n ^ 0.5) -} - -conf_int_t <- function(u, s, n, alpha = 0.05) { - a <- alpha / 2 - df <- n - 1 - error <- round(qt(a, df), 3) * -1 - lower <- u - (error * samp_err(s, n)) - upper <- u + (error * samp_err(s, n)) - result <- c(lower, upper) - return(result) -} - -cor_sig <- function(corr, n) { - t <- corr / ((1 - (corr ^ 2)) / (n - 2)) ^ 0.5 - df <- n - 2 - sig <- (1 - pt(t, df)) * 2 - return(round(sig, 4)) -} - -formatter_pair <- function(x, w) { - x1 <- format(x, nsmall = 2) - x2 <- as.character(x1) - ret <- format(x2, width = w, justify = "centre") - return(ret) -} - -fg <- function(x, w) { - x %>% - as.character() %>% - format(width = w, justify = 'centre') -} - -fs <- function() { - rep(" ") -} diff --git a/inst/application/logic/logic_anova.R b/inst/application/logic/logic_anova.R index e5e8827..6bbffb6 100644 --- a/inst/application/logic/logic_anova.R +++ b/inst/application/logic/logic_anova.R @@ -73,11 +73,12 @@ d_anova <- eventReactive(input$submit_anova, { data <- final_split$train[, c(input$var_anova1, input$var_anova2)] eval(parse(text = paste0("data$", names(data)[2], " <- as.numeric(as.character(data$", names(data)[2], "))"))) # data - k <- inferr::infer_oneway_anova(data, as.character(input$var_anova1), as.character(input$var_anova2)) + k <- inferr::infer_oneway_anova(data, !! sym(as.character(input$var_anova1)), + !! sym(as.character(input$var_anova2))) k }) output$anova_out <- renderPrint({ - # inferr::owanova(d_anova(), as.character(input$var_anova1), as.character(input$var_anova2)) + # inferr::owanova(d_anova(), as.character(input$var_anova1), as.character(input$var_anova2)) d_anova() }) diff --git a/inst/application/logic/logic_binomtest.R b/inst/application/logic/logic_binomtest.R index 1fbe4ba..a8ca949 100644 --- a/inst/application/logic/logic_binomtest.R +++ b/inst/application/logic/logic_binomtest.R @@ -42,7 +42,8 @@ d_binomtest <- eventReactive(input$submit_binomtest, { output$binomtest_out <- renderPrint({ # validate(need(nlevels(d_binomtest()) == 2, 'Please select a binary variable.')) - infer_binom_test(d_binomtest(), input$binomtest_prob) + infer_binom_test(final_split$train, !! sym(as.character(input$var_binomtest)), + input$binomtest_prob) }) output$binomcalc_out <- renderPrint({ diff --git a/inst/application/logic/logic_chict.R b/inst/application/logic/logic_chict.R index 1dc3d25..0735ff4 100644 --- a/inst/application/logic/logic_chict.R +++ b/inst/application/logic/logic_chict.R @@ -41,5 +41,6 @@ d_chict <- eventReactive(input$submit_chict, { }) output$chict_out <- renderPrint({ - infer_chisq_assoc_test(d_chict()[, 1], d_chict()[, 2]) + infer_chisq_assoc_test(d_chict(), !! sym(input$var_chict1), + !! sym(input$var_chict2)) }) diff --git a/inst/application/logic/logic_chigof.R b/inst/application/logic/logic_chigof.R index 0e245ef..c7ac4ba 100644 --- a/inst/application/logic/logic_chigof.R +++ b/inst/application/logic/logic_chigof.R @@ -1,5 +1,3 @@ -source('helper/chisq-gof-shiny.R') - observe({ updateSelectInput(session, 'var_chigof', choices = names(data())) }) @@ -70,7 +68,7 @@ props <- reactive({ df_chigof <- eventReactive(input$submit_chigof, { data <- final_split$train # validate(need(sum(props()) == 1, 'Expected proportion must add up to 1.')) - k <- chisq_gof_shiny(data, as.character(input$var_chigof), props(), + k <- infer_chisq_gof_test(data, !! sym(as.character(input$var_chigof)), props(), as.logical(input$chigof_cc)) k }) diff --git a/inst/application/logic/logic_cochran.R b/inst/application/logic/logic_cochran.R index 35e670e..f41e038 100644 --- a/inst/application/logic/logic_cochran.R +++ b/inst/application/logic/logic_cochran.R @@ -17,7 +17,7 @@ observeEvent(input$finalok, { } else { updateSelectInput(session, 'var_cochran', choices = names(f_data)) } - + }) observeEvent(input$submit_part_train_per, { @@ -35,7 +35,7 @@ observeEvent(input$submit_part_train_per, { } else { updateSelectInput(session, 'var_cochran', choices = names(f_data)) } - + }) d_cochran <- eventReactive(input$submit_cochran, { @@ -43,7 +43,7 @@ d_cochran <- eventReactive(input$submit_cochran, { req(input$var_cochran) data <- final_split$train[, c(input$var_cochran)] # validate(need(data %>% map(nlevels) %>% `<`(3) %>% all(), 'Only binary variables must be selected.')) - k <- infer_cochran_qtest(data) + k <- infer_cochran_qtest(data, !!! syms(input$var_cochran)) k }) diff --git a/inst/application/logic/logic_itest.R b/inst/application/logic/logic_itest.R index 489c8f9..97e2e26 100644 --- a/inst/application/logic/logic_itest.R +++ b/inst/application/logic/logic_itest.R @@ -75,8 +75,8 @@ d_itest <- eventReactive(input$submit_itest, { req(input$var_itest2) data <- final_split$train[, c(input$var_itest1, input$var_itest2)] # validate(need(nlevels(data[, 1]) == 2, 'Please select a binary variable.')) - k <- infer_ts_ind_ttest(data, as.character(input$var_itest1), - as.character(input$var_itest2), input$itest_conf, input$itest_type) + k <- infer_ts_ind_ttest(data, !! sym(as.character(input$var_itest1)), + !! sym(as.character(input$var_itest2)), input$itest_conf, input$itest_type) k }) diff --git a/inst/application/logic/logic_levene.R b/inst/application/logic/logic_levene.R index 43867c3..097d963 100644 --- a/inst/application/logic/logic_levene.R +++ b/inst/application/logic/logic_levene.R @@ -79,7 +79,7 @@ d_levtest <- eventReactive(input$submit_levtest, { req(input$var_levtest) # validate(need((input$var_levtest != ''), 'Please select variables')) data <- final_split$train[, c(input$var_levtest)] - out <- infer_levene_test(data) + out <- infer_levene_test(data, !!! syms(input$var_levtest)) out }) @@ -88,18 +88,11 @@ d_levtestg <- eventReactive(input$submit_levtestg, { req(input$var_levtestg2) # validate(need((input$var_levtestg1 != '' & input$var_levtestg2 != ''), 'Please select variables')) data <- final_split$train[, c(input$var_levtestg1, input$var_levtestg2)] - out <- infer_levene_test(data[, 1], group_var = data[, 2]) + out <- infer_levene_test(data, !! sym(input$var_levtestg1), + group_var = !! sym(input$var_levtestg2)) out }) -d_levmod <- eventReactive(input$submit_levtestf, { - req(input$levtest_fmla) - # validate(need((input$levtest_fmla != ''), 'Please specify a model')) - data <- final_split$train - k <- lm(input$levtest_fmla, data = data) - out <- infer_levene_test(k) - out -}) output$levtest_out <- renderPrint({ d_levtest() @@ -109,6 +102,3 @@ output$levtestg_out <- renderPrint({ d_levtestg() }) -output$levtestf_out <- renderPrint({ - d_levmod() -}) diff --git a/inst/application/logic/logic_osprop.R b/inst/application/logic/logic_osprop.R index 9aa46e0..a7be694 100644 --- a/inst/application/logic/logic_osprop.R +++ b/inst/application/logic/logic_osprop.R @@ -36,10 +36,12 @@ observeEvent(input$submit_part_train_per, { d_osproptest <- eventReactive(input$submit_osproptest, { req(input$var_osproptest) - data <- final_split$train[, c(input$var_osproptest)] + data <- final_split$train # validate(need(nlevels(data) == 2, 'Please select a binary variable.')) - out <- infer_os_prop_test(data, input$osproptest_prob, input$osproptest_type) - out + out <- infer_os_prop_test(data, !! sym(as.character(input$var_osproptest)), + input$osproptest_prob, + input$osproptest_type) + out }) output$osproptest_out <- renderPrint({ diff --git a/inst/application/logic/logic_osvar.R b/inst/application/logic/logic_osvar.R index acdf3f9..6f9147a 100644 --- a/inst/application/logic/logic_osvar.R +++ b/inst/application/logic/logic_osvar.R @@ -1,5 +1,3 @@ -source('helper/one-samp-var-shiny.R') - observe({ updateSelectInput(session, inputId = "var_osvartest", @@ -21,7 +19,7 @@ observeEvent(input$finalok, { choices = '', selected = '') } else { updateSelectInput(session, 'var_osvartest', choices = names(num_data)) - } + } }) observeEvent(input$submit_part_train_per, { @@ -38,18 +36,18 @@ observeEvent(input$submit_part_train_per, { choices = '', selected = '') } else { updateSelectInput(session, 'var_osvartest', choices = names(num_data)) - } + } }) d_osvartest <- eventReactive(input$submit_osvartest, { # validate(need((input$var_osvartest != ''), 'Please select a variable.')) data <- final_split$train - k <- os_vartest_shiny(data, as.character(input$var_osvartest), + k <- infer_os_var_test(data, !! sym(as.character(input$var_osvartest)), input$sd_osvartest, input$osvartest_conf, input$osvartest_type) k }) output$osvartest_out <- renderPrint({ - d_osvartest() + d_osvartest() }) diff --git a/inst/application/logic/logic_ptest.R b/inst/application/logic/logic_ptest.R index 225c847..b9507f7 100644 --- a/inst/application/logic/logic_ptest.R +++ b/inst/application/logic/logic_ptest.R @@ -1,6 +1,3 @@ -source('helper/paired-ttest-shiny.R') -source('helper/utils.R') - observe({ updateSelectInput(session, inputId = "var_ptest1", @@ -74,8 +71,9 @@ observeEvent(input$submit_part_train_per, { d_ptest <- eventReactive(input$submit_ptest, { # validate(need((input$var_ptest1 != '' & input$var_ptest2 != ''), 'Please select two variables.')) data <- final_split$train - k <- paired_ttest_shiny(data, as.character(input$var_ptest1), - as.character(input$var_ptest2), input$ptest_conf, input$ptest_type) + k <- infer_ts_paired_ttest(data, !! sym(as.character(input$var_ptest1)), + !! sym(as.character(input$var_ptest2)), input$ptest_conf, + input$ptest_type) k }) diff --git a/inst/application/logic/logic_runs.R b/inst/application/logic/logic_runs.R index 5a586c7..8410255 100644 --- a/inst/application/logic/logic_runs.R +++ b/inst/application/logic/logic_runs.R @@ -43,9 +43,12 @@ observeEvent(input$submit_part_train_per, { d_runs <- eventReactive(input$submit_runs, { req(input$var_runs) # validate(need((input$var_runs != ''), 'Please select variables.')) - data <- final_split$train[, c(input$var_runs)] - out <- infer_runs_test(data, as.logical(input$runs_drop), as.logical(input$runs_split), - as.logical(input$runs_mean), input$runs_thold) + data <- final_split$train + out <- infer_runs_test(data, !! sym(input$var_runs), + as.logical(input$runs_drop), + as.logical(input$runs_split), + as.logical(input$runs_mean), + input$runs_thold) out }) diff --git a/inst/application/logic/logic_transform2.R b/inst/application/logic/logic_transform2.R index 16914a0..ad7b3d6 100644 --- a/inst/application/logic/logic_transform2.R +++ b/inst/application/logic/logic_transform2.R @@ -18,7 +18,7 @@ library(stringr) selectInput(paste0("data_type_", i), label = '', width = '150px', choices = c('numeric', 'factor', 'Date', 'character', 'integer'), - selected = 'numeric') + selected = class(uploadata$t[[i]])) ), column(3, conditionalPanel(condition = paste(paste0("input.data_type_", i), "== 'Date'"), @@ -73,7 +73,7 @@ library(stringr) colors <- unlist(collect) colnames <- str_replace(colors, " ", "_") - }) + }) # original <- reactive({ # data() @@ -135,4 +135,4 @@ library(stringr) observeEvent(input$apply_changes, { updateNavbarPage(session, 'mainpage', selected = 'tab_trans') updateNavlistPanel(session, 'navlist_trans', 'tab_selvar') -}) \ No newline at end of file +}) diff --git a/inst/application/logic/logic_tsprop.R b/inst/application/logic/logic_tsprop.R index 80cfb48..3167917 100644 --- a/inst/application/logic/logic_tsprop.R +++ b/inst/application/logic/logic_tsprop.R @@ -52,7 +52,9 @@ d_tsproptest <- eventReactive(input$submit_tsproptest, { req(input$var_tsproptest2) # validate(need((input$var_tsproptest1 != '' & input$var_tsproptest2 != ''), 'Please select variable.')) data <- final_split$train[, c(input$var_tsproptest1, input$var_tsproptest2)] - out <- infer_ts_prop_test(data[, 1], data[, 2], input$tsproptest_type) + out <- infer_ts_prop_test(data, !! sym(as.character(input$var_tsproptest1)), + !! sym(as.character(input$var_tsproptest2)), + input$tsproptest_type) out }) @@ -61,7 +63,9 @@ d_tsproptestg <- eventReactive(input$submit_tsproptestg, { req(input$var_tsproptestg2) # validate(need((input$var_tsproptestg1 != '' & input$var_tsproptestg2 != ''), 'Please select variable.')) data <- final_split$train[, c(input$var_tsproptestg1, input$var_tsproptestg2)] - out <- infer_ts_prop_grp(data[, 1], data[, 2], input$tsproptestg_type) + out <- infer_ts_prop_grp(data, !! sym(as.character(input$var_tsproptestg1)), + !! sym(as.character(input$var_tsproptestg2)), + input$tsproptestg_type) out }) diff --git a/inst/application/logic/logic_tsvar.R b/inst/application/logic/logic_tsvar.R index 5bfaa44..9051eff 100644 --- a/inst/application/logic/logic_tsvar.R +++ b/inst/application/logic/logic_tsvar.R @@ -99,8 +99,9 @@ d_tsvartest <- eventReactive(input$submit_tsvartest, { req(input$var_tsvartest1) req(input$var_tsvartest2) data <- final_split$train[, c(input$var_tsvartest1, input$var_tsvartest2)] - k <- var_test_shiny(data, as.character(input$var_tsvartest1), as.character(input$var_tsvartest2), - alternative = input$tsvartest_type) + k <- infer_ts_var_test(data, !! sym(as.character(input$var_tsvartest1)), + !! sym(as.character(input$var_tsvartest2)), + alternative = input$tsvartest_type) k }) @@ -110,7 +111,9 @@ d_tsvartestg <- eventReactive(input$submit_tsvartestg, { req(input$var_tsvartestg2) data <- final_split$train[, c(input$var_tsvartestg1, input$var_tsvartestg2)] # validate(need(nlevels(data[, 2]) == 2, 'Please select a binary variable.')) - k <- infer_ts_var_test(data[, 1], group_var = data[, 2], alternative = input$tsvartestg_type) + k <- infer_ts_var_test(data, !! sym(as.character(input$var_tsvartestg1)), + group_var = !! sym(as.character(input$var_tsvartestg2)), + alternative = input$tsvartestg_type) k }) diff --git a/inst/application/logic/logic_ttest.R b/inst/application/logic/logic_ttest.R index 4c8f3eb..5bce2c4 100644 --- a/inst/application/logic/logic_ttest.R +++ b/inst/application/logic/logic_ttest.R @@ -1,5 +1,3 @@ -source('helper/t-test-shiny.R') - observe({ updateSelectInput(session, inputId = "var_ttest", @@ -27,7 +25,7 @@ observeEvent(input$finalok, { inputId = 'ttest_mu', value = '') } else { - updateSelectInput(session, inputId = "var_ttest", + updateSelectInput(session, inputId = "var_ttest", choices = names(num_data)) updateNumericInput(session = session, inputId = 'ttest_mu', @@ -55,7 +53,7 @@ observeEvent(input$submit_part_train_per, { inputId = 'ttest_mu', value = '') } else { - updateSelectInput(session, inputId = "var_ttest", + updateSelectInput(session, inputId = "var_ttest", choices = names(num_data)) updateNumericInput(session = session, inputId = 'ttest_mu', @@ -68,7 +66,9 @@ d_ttest <- eventReactive(input$submit_ttest, { # validate(need(input$var_ttest != '', 'Please select a variable.')) req(input$ttest_mu) data <- final_split$train - k <- ttest_shiny(data, as.character(input$var_ttest), as.numeric(input$ttest_mu), input$ttest_alpha, input$ttest_type) + k <- infer_os_t_test(data, !! sym(as.character(input$var_ttest)), + as.numeric(input$ttest_mu), input$ttest_alpha, + input$ttest_type) k }) diff --git a/inst/application/server.R b/inst/application/server.R index b51faa0..8ceb8ba 100644 --- a/inst/application/server.R +++ b/inst/application/server.R @@ -12,9 +12,10 @@ library(tools) library(lubridate) library(scales) library(stringr) +library(rlang) shinyServer(function(input, output, session) { - + source("logic/logic_dataoptions.R", local = T) source("logic/logic_upload.R", local = T) source("logic/logic_transform2.R", local = T) @@ -37,8 +38,8 @@ shinyServer(function(input, output, session) { source("logic/logic_cochran.R", local = T) source("logic/logic_runs.R", local = T) source("logic/logic_mcnemar.R", local = T) - source("logic/logic_home.R", local = T) - + source("logic/logic_home.R", local = T) + }) diff --git a/inst/application/ui/ui_levene.R b/inst/application/ui/ui_levene.R index cc555e6..7995601 100644 --- a/inst/application/ui/ui_levene.R +++ b/inst/application/ui/ui_levene.R @@ -3,10 +3,10 @@ tabPanel('Levene Test', value = 'tab_levtest', fluidRow( column(6, align = 'left', h4('Levene Test'), - p("Levene's robust test statistic for the equality of variances and the - two statistics proposed by Brown and Forsythe that replace the mean in - Levene's formula with alternative location estimators. The first alternative - replaces the mean with the median. The second alternative replaces the mean + p("Levene's robust test statistic for the equality of variances and the + two statistics proposed by Brown and Forsythe that replace the mean in + Levene's formula with alternative location estimators. The first alternative + replaces the mean with the median. The second alternative replaces the mean with the 10% trimmed mean.") ), column(6, align = 'right', @@ -75,32 +75,6 @@ tabPanel('Levene Test', value = 'tab_levtest', ) ) ) - ), - tabPanel('Using Formula', - fluidPage( - fluidRow( - column(2, align = 'right', br(), h5('Model Formula:')), - column(10, align = 'left', - textInput("levtest_fmla", label = '', width = '660px', - value = ""), - bsTooltip("levtest_fmla", "Specify a formula", - "left", options = list(container = "body"))) - ), - fluidRow( - column(12, align = 'center', - br(), - br(), - actionButton(inputId = 'submit_levtestf', label = 'Submit', width = '120px', icon = icon('check')), - bsTooltip("submit_levtestf", "Click here to view test result.", - "bottom", options = list(container = "body"))) - ), - fluidRow( - br(), - column(12, align = 'center', - verbatimTextOutput('levtestf_out') - ) - ) - ) ) ) )