Further API changes

NAMESPACE

@@ -5,12 +5,9 @@ S3method(infer_chisq_assoc_test,default)
 S3method(infer_chisq_gof_test,default)
 S3method(infer_cochran_qtest,default)
 S3method(infer_levene_test,default)
-S3method(infer_levene_test,formula)
-S3method(infer_levene_test,lm)
 S3method(infer_mcnemar_test,default)
 S3method(infer_oneway_anova,default)
 S3method(infer_os_prop_test,default)
-S3method(infer_os_prop_test,factor)
 S3method(infer_os_t_test,default)
 S3method(infer_os_var_test,default)
 S3method(infer_runs_test,default)
@@ -75,6 +72,7 @@ export(ttest)
 export(var_test)
 export(var_test_shiny)
 importFrom(Rcpp,sourceCpp)
+importFrom(dplyr,"%>%")
 importFrom(dplyr,funs)
 importFrom(dplyr,group_by)
 importFrom(dplyr,group_by_)
@@ -93,6 +91,7 @@ importFrom(purrr,map_int)
 importFrom(rlang,"!!!")
 importFrom(rlang,"!!")
 importFrom(rlang,enquo)
+importFrom(rlang,quo_is_null)
 importFrom(rlang,quos)
 importFrom(shiny,runApp)
 importFrom(stats,anova)

R/infer-levene-test.R

@@ -1,17 +1,17 @@
 #' @importFrom stats anova model.frame formula
 #' @importFrom purrr map_int
+#' @importFrom rlang quo_is_null
 #' @title Levene's test for equality of variances
 #' @description  \code{infer_levene_test} reports 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.
-#' @param variable a numeric vector or formula or object of class \code{lm}
-#' @param group_var a grouping variable
-#' @param trim.mean trimmed mean
-#' @param data a data frame
-#' @param ... numeric vectors
+#' @param data a \code{data.frame} or \code{tibble}
+#' @param ... numeric; columns in \code{data}
+#' @param group_var factor; column in \code{data}
+#' @param trim_mean trimmed mean
 #' @return \code{infer_levene_test} returns an object of class \code{"infer_levene_test"}.
 #' An object of class \code{"infer_levene_test"} is a list containing the
 #' following components:
@@ -44,70 +44,70 @@
 #' Letters 3: 191–194.}
 #' @examples
 #' # using grouping variable
-#' infer_levene_test(hsb$read, group_var = hsb$race)
+#' infer_levene_test(hsb, read, group_var = race)
 #'
-#' # using two variables
-#' infer_levene_test(hsb$read, hsb$write, hsb$socst)
-#'
-#' # using model
-#' m <- lm(read ~ female, data = hsb)
-#' infer_levene_test(m)
-#'
-#' # using formula
-#' infer_levene_test(as.formula(paste0('read ~ schtyp')), hsb)
+#' # using  variables
+#' infer_levene_test(hsb, read, write, socst)
 #'
 #' @export
 #'
-infer_levene_test <- function(variable, ...) UseMethod('infer_levene_test')
+infer_levene_test <- function(data, ...) UseMethod('infer_levene_test')
 
 #' @export
 #' @rdname infer_levene_test
-infer_levene_test.default <- function(variable, ..., group_var = NULL,
-	trim.mean = 0.1) {
+infer_levene_test.default <- function(data, ..., group_var = NULL,
+	trim_mean = 0.1) {
 
-	varname <- deparse(substitute(variable))
 
-		if (is.null(group_var)) {
+    groupvar <- enquo(group_var)
 
-			if (is.data.frame(variable)) {
-				z <- as.list(variable)
-			} else {
-				z <- list(variable, ...)
-			}
+    varyables <- quos(...)
 
-			ln <- z %>% map_int(length)
-			ly <- seq_len(length(z))
+    fdata <-
+        data %>%
+        select(!!! varyables)
 
-		  if (length(z) < 2) {
-    		stop('Please specify at least two variables.', call. = FALSE)
-    	}
+    if (quo_is_null(groupvar)) {
 
-		        out <- gvar(ln, ly)
-		  variable  <- unlist(z)
-		  group_var <- unlist(out)
+        z <- as.list(fdata)
+        ln <- z %>% map_int(length)
+        ly <- seq_len(length(z))
 
-		} else {
+        if (length(z) < 2) {
+            stop('Please specify at least two variables.', call. = FALSE)
+        }
 
-    	if (length(variable) != length(group_var)) {
-    		stop('Length of variable and group_var do not match.', call. = FALSE)
-    	}
+        out <- gvar(ln, ly)
+        fdata  <- unlist(z)
+        groupvars <-
+            out %>%
+            unlist %>%
+            as.factor
 
-    }
+    } else {
+
+        fdata <-
+            fdata %>%
+            pull(1)
 
+        groupvars <-
+            data %>%
+            pull(!! groupvar)
 
-	if (!is.factor(group_var)) {
-		group_var <- as.factor(group_var)
-	}
+        if (length(fdata) != length(groupvars)) {
+            stop('Length of variable and group_var do not match.', call. = FALSE)
+        }
+    }
 
-	k <- lev_comp(variable, group_var, trim.mean)
+    k <- lev_comp(fdata, groupvars, trim_mean)
 
-	out <- list(bf    = k$bf, p_bf  = k$p_bf, lev = k$lev, p_lev = k$p_lev,
-              bft   = k$bft, p_bft = k$p_bft, avgs  = k$avgs, sds   = k$sds,
-              avg   = k$avg, sd = k$sd, n = k$n, levs  = k$levs, n_df  = k$n_df,
-              d_df  = k$d_df, lens  = k$lens)
+    out <- list(bf    = k$bf, p_bf  = k$p_bf, lev = k$lev, p_lev = k$p_lev,
+                bft   = k$bft, p_bft = k$p_bft, avgs  = k$avgs, sds   = k$sds,
+                avg   = k$avg, sd = k$sd, n = k$n, levs  = k$levs, n_df  = k$n_df,
+                d_df  = k$d_df, lens  = k$lens)
 
-	class(out) <- 'infer_levene_test'
-  return(out)
+    class(out) <- 'infer_levene_test'
+    return(out)
 
 }
 
@@ -119,26 +119,7 @@ levene_test <- function(variable, ..., group_var = NULL,
                         trim.mean = 0.1) {
 
     .Deprecated("infer_levene_test()")
-    infer_levene_test(variable, ..., group_var,
-                      trim.mean)
-
-}
 
-#' @export
-#' @rdname infer_levene_test
-#'
-infer_levene_test.lm <- function(variable, ...) {
-    infer_levene_test.formula(variable = formula(variable), data = model.frame(variable))
-}
-
-#' @export
-#' @rdname infer_levene_test
-#'
-infer_levene_test.formula <- function(variable, data, ...) {
-	dat       <- model.frame(variable, data)
-	variable  <- dat[, 1]
-	group_var <- dat[, 2]
-	infer_levene_test.default(variable = variable, group_var = group_var)
 }
 
 #' @export

R/infer-mcnemar-test.R

@@ -1,9 +1,11 @@
 #' @importFrom stats qnorm
+#' @importFrom magrittr %>%
 #' @title McNemar Test
 #' @description Test if the proportions of two dichotomous variables are
 #' equal in the same population.
-#' @param x 2 x 2 matrix or 2 x 2 table or numeric variable or factor variable
-#' @param y numeric or factor variable
+#' @param data a \code{data.frame} or \code{tibble}
+#' @param x factor; column in \code{data}
+#' @param y factor; column in \code{data}
 #' @return \code{infer_mcnemar_test} returns an object of class \code{"infer_mcnemar_test"}.
 #' An object of class \code{"infer_mcnemar_test"} is a list containing the
 #' following components:
@@ -31,6 +33,14 @@
 #'
 #' @seealso \code{\link[stats]{mcnemar.test}}
 #' @examples
+#' # using variables from data
+#' library(dplyr)
+#' hb <- mutate(hsb,
+#'         himath = if_else(math > 60, 1, 0),
+#'         hiread = if_else(read > 60, 1, 0)
+#'     )
+#' infer_mcnemar_test(hb, himath, hiread)
+#'
 #' # test if the proportion of students in himath and hiread group is same
 #' himath <- ifelse(hsb$math > 60, 1, 0)
 #' hiread <- ifelse(hsb$read > 60, 1, 0)
@@ -40,42 +50,38 @@
 #' infer_mcnemar_test(matrix(c(135, 18, 21, 26), nrow = 2))
 #' @export
 #'
-infer_mcnemar_test <- function(x, y = NULL) UseMethod('infer_mcnemar_test')
+infer_mcnemar_test <- function(data, x = NULL, y = NULL) UseMethod('infer_mcnemar_test')
 
 #' @export
 #'
-infer_mcnemar_test.default <- function(x, y = NULL) {
-
-	if (is.null(y)) {
-
-		dat <- mcdata(x, y)
+infer_mcnemar_test.default <- function(data, x = NULL, y = NULL) {
 
-	} else {
+    if (is.matrix(data) | is.table(data)) {
 
-		if (length(x) != length(y)) {
-			stop('x and y should be of the same length')
-		}
+        dat <- mcdata(data)
 
-		if ((!is.numeric(x) & !is.numeric(y)) &
-			 (!is.factor(x) & !is.factor(y))) {
-			 stop('x and y must be either numeric or factor')
-		}
+    } else {
 
-		dat <- table(x, y)
+        x1 <- enquo(x)
+        y1 <- enquo(y)
 
-	}
+        dat <-
+            data %>%
+            select(!! x1, !!y1) %>%
+            table
 
-  k <- mccomp(dat)
+    }
 
-	result <- list(statistic = k$statistic, df = k$df, pvalue = k$pvalue,
-		exactp = k$exactp, cstat = k$cstat, cpvalue = k$cpvalue, kappa = k$kappa,
-    std_err = k$std_err, kappa_cil = k$kappa_cil, kappa_ciu = k$kappa_ciu,
-    cases = k$cases, controls = k$controls, ratio = k$ratio,
-    odratio = k$odratio, tbl = dat)
+    k <- mccomp(dat)
 
-	class(result) <- 'infer_mcnemar_test'
-	return(result)
+    result <- list(statistic = k$statistic, df = k$df, pvalue = k$pvalue,
+                   exactp = k$exactp, cstat = k$cstat, cpvalue = k$cpvalue, kappa = k$kappa,
+                   std_err = k$std_err, kappa_cil = k$kappa_cil, kappa_ciu = k$kappa_ciu,
+                   cases = k$cases, controls = k$controls, ratio = k$ratio,
+                   odratio = k$odratio, tbl = dat)
 
+    class(result) <- 'infer_mcnemar_test'
+    return(result)
 }
 
 #' @export
@@ -85,7 +91,6 @@ infer_mcnemar_test.default <- function(x, y = NULL) {
 mcnemar_test <- function(x, y = NULL) {
 
     .Deprecated("infer_mcnemar_test()")
-    infer_mcnemar_test(x, y)
 
 }