Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Revert "API changes" #14

Merged
merged 1 commit into from
Jan 31, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -11,12 +11,11 @@ Depends:
License: MIT + file LICENSE
URL: https://rsquaredacademy.github.io/inferr/, https://github.com/rsquaredacademy/inferr
BugReports: https://github.com/rsquaredacademy/inferr/issues
Imports:
Imports:
dplyr,
magrittr,
purrr,
Rcpp,
rlang,
shiny,
tibble,
tidyr
Expand Down
9 changes: 0 additions & 9 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -76,24 +76,15 @@ export(var_test)
export(var_test_shiny)
importFrom(Rcpp,sourceCpp)
importFrom(dplyr,funs)
importFrom(dplyr,group_by)
importFrom(dplyr,group_by_)
importFrom(dplyr,mutate)
importFrom(dplyr,pull)
importFrom(dplyr,select)
importFrom(dplyr,select_)
importFrom(dplyr,summarise_all)
importFrom(magrittr,"%>%")
importFrom(magrittr,subtract)
importFrom(magrittr,use_series)
importFrom(purrr,map)
importFrom(purrr,map_dbl)
importFrom(purrr,map_df)
importFrom(purrr,map_int)
importFrom(rlang,"!!!")
importFrom(rlang,"!!")
importFrom(rlang,enquo)
importFrom(rlang,quos)
importFrom(shiny,runApp)
importFrom(stats,anova)
importFrom(stats,as.formula)
Expand Down
4 changes: 2 additions & 2 deletions R/RcppExports.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}

44 changes: 23 additions & 21 deletions R/infer-anova.R
Original file line number Diff line number Diff line change
@@ -1,10 +1,9 @@
#' @importFrom stats as.formula lm pf
#' @importFrom rlang enquo !!
#' @title One Way ANOVA
#' @description One way analysis of variance
#' @param data a \code{data.frame} or a \code{tibble}
#' @param x numeric; column in \code{data}
#' @param y factor; column in \code{data}
#' @param data a data frame
#' @param x character vector; name of a continuous variable from \code{data}
#' @param y character vector; name of a categorical variable from \code{data}
#' @param ... additional arguments passed to or from other methods
#' @return \code{owanova} returns an object of class \code{"owanova"}.
#' An object of class \code{"owanova"} is a list containing the
Expand Down Expand Up @@ -32,34 +31,37 @@
#'
#' @seealso \code{\link[stats]{anova}}
#' @examples
#' infer_oneway_anova(mtcars, mpg, cyl)
#' infer_oneway_anova(hsb, write, prog)
#' infer_oneway_anova(mtcars, 'mpg', 'cyl')
#' infer_oneway_anova(hsb, 'write', 'prog')
#' @export
#'
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)
if (!is.data.frame(data)) {
stop('data must be a data frame')
}

fdata <-
data %>%
select(!! x1, !! y1)
if (!x %in% colnames(data)) {
stop('x must be a column in data')
}

sample_mean <- anova_avg(fdata, !! x1)
sample_stats <- anova_split(fdata, !! x1, !! y1, sample_mean)
k <- anova_calc(fdata, sample_stats, !! x1, !! y1)
if (!y %in% colnames(data)) {
stop('y must be a column in data')
}

sample_mean <- anova_avg(data, x)
sample_stats <- anova_split(data, x, y, sample_mean)
k <- anova_calc(data, sample_stats, x, y)

result <- list(between = k$sstr, within = k$ssee, total = k$total,
df_btw = k$df_sstr, df_within = k$df_sse,
df_total = k$df_sst, ms_btw = k$mstr, ms_within = k$mse,
f = k$f, p = k$sig, r2 = round(k$reg$r.squared, 4),
ar2 = round(k$reg$adj.r.squared, 4),
sigma = round(k$reg$sigma, 4), obs = k$obs,
tab = sample_stats[, c(1, 2, 3, 5)])

result <- list( between = k$sstr, within = k$ssee, total = k$total, df_btw = k$df_sstr,
df_within = k$df_sse, df_total = k$df_sst, ms_btw = k$mstr,
ms_within = k$mse, f = k$f, p = k$sig, r2 = round(k$reg$r.squared, 4),
ar2 = round(k$reg$adj.r.squared, 4), sigma = round(k$reg$sigma, 4),
obs = k$obs, tab = round(sample_stats[, c(1, 2, 3, 5)], 3))

class(result) <- 'infer_oneway_anova'
return(result)
Expand Down
25 changes: 9 additions & 16 deletions R/infer-binom-test.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,8 +5,7 @@
#' @param n number of observations
#' @param success number of successes
#' @param prob assumed probability of success on a trial
#' @param data a \code{data.frame} or a \code{tibble}
#' @param variable factor; column in \code{data}
#' @param data binary/dichotomous factor
#' @param ... additional arguments passed to or from other methods
#' @return \code{binom_test} returns an object of class \code{"binom_test"}.
#' An object of class \code{"binom_test"} is a list containing the
Expand All @@ -31,7 +30,7 @@
#' infer_binom_calc(32, 13, prob = 0.5)
#'
#' # using data set
#' infer_binom_test(hsb, female, prob = 0.5)
#' infer_binom_test(as.factor(hsb$female), prob = 0.5)
#' @export
#'
infer_binom_calc <- function(n, success, prob = 0.5, ...) UseMethod('infer_binom_calc')
Expand Down Expand Up @@ -82,19 +81,13 @@ print.infer_binom_calc <- function(x, ...) {

#' @export
#' @rdname infer_binom_calc
infer_binom_test <- function(data, variable, prob = 0.5) {
infer_binom_test <- function(data, prob = 0.5) {

varyable <- enquo(variable)

fdata <-
data %>%
pull(!! varyable)

if (!is.factor(fdata)) {
stop('variable must be of type factor', call. = FALSE)
if (!is.factor(data)) {
stop('data must be of type factor', call. = FALSE)
}

if (nlevels(fdata) > 2) {
if (nlevels(data) > 2) {
stop('Binomial test is applicable only to binary data i.e. categorical data with 2 levels.', call. = FALSE)
}

Expand All @@ -106,8 +99,8 @@ infer_binom_test <- function(data, variable, prob = 0.5) {
stop('prob must be between 0 and 1', call. = FALSE)
}

n <- length(fdata)
k <- table(fdata)[[2]]
n <- length(data)
k <- table(data)[[2]]
infer_binom_calc.default(n, k, prob)
}

Expand All @@ -118,6 +111,6 @@ infer_binom_test <- function(data, variable, prob = 0.5) {
binom_test <- function(data, prob = 0.5) {

.Deprecated("infer_binom_test()")

infer_binom_test(data, prob = 0.5)

}
39 changes: 13 additions & 26 deletions R/infer-chisq-assoc-test.R
Original file line number Diff line number Diff line change
@@ -1,11 +1,9 @@
#' @importFrom stats pchisq
#' @importFrom dplyr pull
#' @title Chi Square Test of Association
#' @description Chi Square test of association to examine if there is a
#' relationship between two categorical variables.
#' @param data a \code{data.frame} or \code{tibble}
#' @param x factor; column in \code{data}
#' @param y factor; column in \code{data}
#' @param x a categorical variable
#' @param y a categorical variable
#' @return \code{infer_chisq_assoc_test} returns an object of class
#' \code{"infer_chisq_assoc_test"}. An object of class
#' \code{"infer_chisq_assoc_test"} is a list containing the
Expand All @@ -32,37 +30,26 @@
#' @references Sheskin, D. J. 2007. Handbook of Parametric and Nonparametric
#' Statistical Procedures, 4th edition. : Chapman & Hall/CRC.
#' @examples
#' infer_chisq_assoc_test(hsb, female, schtyp)
#' infer_chisq_assoc_test(as.factor(hsb$female), as.factor(hsb$schtyp))
#'
#' infer_chisq_assoc_test(hsb, female, ses)
#' infer_chisq_assoc_test(as.factor(hsb$female), as.factor(hsb$ses))
#' @export
#'
infer_chisq_assoc_test <- function(data, x, y) UseMethod('infer_chisq_assoc_test')
infer_chisq_assoc_test <- function(x, y) UseMethod('infer_chisq_assoc_test')

#' @export
infer_chisq_assoc_test.default <- function(data, x, y) {
infer_chisq_assoc_test.default <- function(x, y) {

x1 <- enquo(x)
y1 <- enquo(y)

xone <-
data %>%
pull(!! x1)

yone <-
data %>%
pull(!! y1)

if (!is.factor(xone)) {
if (!is.factor(x)) {
stop('x must be a categorical variable')
}

if (!is.factor(yone)) {
if (!is.factor(y)) {
stop('y must be a categorical variable')
}

# dimensions
k <- table(xone, yone)
k <- table(x, y)
dk <- dim(k)
ds <- prod(dk)
nr <- dk[1]
Expand All @@ -71,7 +58,7 @@ infer_chisq_assoc_test.default <- function(data, x, y) {

if (ds == 4) {

twoway <- matrix(table(xone, yone), nrow = 2)
twoway <- matrix(table(x, y), nrow = 2)
df <- df_chi(twoway)
ef <- efmat(twoway)
k <- pear_chsq(twoway, df, ef)
Expand All @@ -81,15 +68,15 @@ infer_chisq_assoc_test.default <- function(data, x, y) {

} else {

twoway <- matrix(table(xone, yone), nrow = dk[1])
twoway <- matrix(table(x, y), nrow = dk[1])
ef <- efm(twoway, dk)
df <- df_chi(twoway)
k <- pear_chi(twoway, df, ef)
m <- lr_chsq2(twoway, df, ef, ds)

}

j <- chigf(xone, yone, k$chi)
j <- chigf(x, y, k$chi)

result <- if (ds == 4) {
list(chi = k$chi, chilr = m$chilr, chimh = p$chimh, chiy = n$chi_y,
Expand All @@ -112,7 +99,7 @@ infer_chisq_assoc_test.default <- function(data, x, y) {
chisq_test <- function(x, y) {

.Deprecated("infer_chisq_assoc_test()")

infer_chisq_assoc_test(x, y)

}

Expand Down
52 changes: 16 additions & 36 deletions R/infer-chisq-gof-test.R
Original file line number Diff line number Diff line change
@@ -1,8 +1,7 @@
#' @title Chi Square Goodness of Fit Test
#' @description Test whether the observed proportions for a categorical variable
#' differ from hypothesized proportions
#' @param data a \code{data.frame} or \code{tibble}
#' @param x factor; column in \code{data}
#' @param x categorical variable
#' @param y expected proportions
#' @param correct logical; if TRUE continuity correction is applied
#' @return \code{infer_chisq_gof_test} returns an object of class
Expand All @@ -28,35 +27,18 @@
#' @references Sheskin, D. J. 2007. Handbook of Parametric and Nonparametric
#' Statistical Procedures, 4th edition. : Chapman & Hall/CRC.
#' @examples
#' infer_chisq_gof_test(hsb, race, c(20, 20, 20, 140))
#' infer_chisq_gof_test(as.factor(hsb$race), c(20, 20, 20, 140))
#'
#' # apply continuity correction
#' infer_chisq_gof_test(hsb, race, c(20, 20, 20, 140), correct = TRUE)
#' infer_chisq_gof_test(as.factor(hsb$race), c(20, 20, 20, 140), correct = TRUE)
#' @export
#'
infer_chisq_gof_test <- function(data, x, y, correct = FALSE) UseMethod('infer_chisq_gof_test')
infer_chisq_gof_test <- function(x, y, correct = FALSE) UseMethod('infer_chisq_gof_test')

#' @export
infer_chisq_gof_test.default <- function(data, x, y, correct = FALSE) {
infer_chisq_gof_test.default <- function(x, y, correct = FALSE) {

x1 <- enquo(x)

xcheck <-
data %>%
pull(!! x1)

xlen <-
data %>%
pull(!! x1) %>%
length

xone <-
data %>%
pull(!! x1) %>%
table %>%
as.vector

if (!is.factor(xcheck)) {
if (!is.factor(x)) {
stop('x must be an object of class factor')
}

Expand All @@ -68,13 +50,10 @@ infer_chisq_gof_test.default <- function(data, x, y, correct = FALSE) {
stop('correct must be either TRUE or FALSE')
}


varname <-
data %>%
select(!! x1) %>%
names

n <- length(xone)
x1 <- x
varname <- l(deparse(substitute(x)))
x <- as.vector(table(x))
n <- length(x)

if (length(y) != n) {
stop('Length of y must be equal to the number of categories in x')
Expand All @@ -83,19 +62,19 @@ infer_chisq_gof_test.default <- function(data, x, y, correct = FALSE) {
df <- n - 1

if (sum(y) == 1) {
y <- xlen * y
y <- length(x1) * y
}

if ((df == 1) || (correct == TRUE)) {
k <- chi_cort(xone, y)
k <- chi_cort(x, y)
} else {
k <- chigof(xone, y)
k <- chigof(x, y)
}

sig <- round(pchisq(k$chi, df, lower.tail = FALSE), 4)

result <- list(chisquare = k$chi, pvalue = sig, df = df, ssize = length(xcheck),
names = levels(xcheck), level = nlevels(xcheck), obs = xone, exp = y,
result <- list(chisquare = k$chi, pvalue = sig, df = df, ssize = length(x1),
names = levels(x1), level = nlevels(x1), obs = x, exp = y,
deviation = format(k$dev, nsmall = 2), std = format(k$std, nsmall = 2),
varname = varname)

Expand All @@ -110,6 +89,7 @@ infer_chisq_gof_test.default <- function(data, x, y, correct = FALSE) {
chisq_gof <- function(x, y, correct = FALSE) {

.Deprecated("infer_chisq_gof_test()")
infer_chisq_gof_test(x, y, correct = FALSE)

}

Expand Down
Loading