Implement chi-square gof

Author: ismayc

R/calculate.R

@@ -78,8 +78,8 @@ calculate <- function(x, stat, order = NULL, ...) {
     }
   }
 
-  if (stat %in% c("diff in means", "diff in medians", "diff in props") |
-      attr(x, "theory_type") %in% c("Two sample props z", "Two sample t")) {
+  if ( stat %in% c("diff in means", "diff in medians", "diff in props")  ||
+      attr(x, "theory_type") %in% c("Two sample props z", "Two sample t") ) {
     if (length(unique(x[[as.character(attr(x, "explanatory"))]])) != 2){
       stop(paste("Statistic is based on a difference; the explanatory variable",
                  "should have two levels."))

R/set_params.R

@@ -4,6 +4,10 @@ set_params <- function(x){
 
   attr(x, "theory_type") <- NULL
 
+  if(!is.null(attr(x, "response"))){
+    num_response_levels <- length(levels(x[[as.character(attr(x, "response"))]]))
+  }
+  
   # One variable
   if (!is.null(attr(x, "response")) & is.null(attr(x, "explanatory")) & 
       !is.null(attr(x, "response_type")) & is.null(attr(x, "explanatory_type"))){
@@ -17,9 +21,12 @@ set_params <- function(x){
     }
 
     # One prop
-    if(attr(x, "response_type") == "factor"){
-      attr(x, "theory_type") <- "One sample prop z"
+    if(attr(x, "response_type") == "factor" & (num_response_levels == 2)){
       # No parameters since standard normal
+      attr(x, "theory_type") <- "One sample prop z"
+    } else {
+      attr(x, "theory_type") <- "Chi-square Goodness of Fit"
+      attr(x, "distr_param") <- num_response_levels - 1
     }
 
   }
@@ -81,5 +88,9 @@ set_params <- function(x){
     # TO DO: Determine parameters
     }
   }
+  
+#  if(is.null(attr(x, "theory_type")))
+#     warning("Theoretical type not yet implemented")
+  
   x
 }

R/visualize.R

@@ -53,7 +53,7 @@
 #'     calculate(stat = "t", order = c("1", "0")) %>%
 #'     visualize(method = "both")
 
-visualize <- function(data, bins = 30, method = "randomization", 
+visualize <- function(data, bins = 15, method = "randomization", 
                       dens_color = "black",
                       obs_stat = NULL, 
                       obs_stat_color = "#00BFC4",
@@ -125,7 +125,8 @@ visualize <- function(data, bins = 30, method = "randomization",
     infer_plot <- theory_z_plot(statistic_text = "z")
   }
 
-  else if(attr(data, "theory_type") == "Chi-square test of indep"){    
+  else if(attr(data, "theory_type") %in% 
+          c("Chi-square test of indep", "Chi-square Goodness of Fit")){    
     infer_plot <- theory_chisq_plot(deg_freedom = attr(data, "distr_param"),
                                 statistic_text = "Chi-Square",
                                 dens_color = dens_color)
@@ -170,7 +171,9 @@ visualize <- function(data, bins = 30, method = "randomization",
                               obs_stat = obs_stat) 
   }
 
-  else if(attr(data, "theory_type") == "Chi-square test of indep"){
+  else if(
+    attr(data, "theory_type") %in% 
+      c("Chi-square test of indep", "Chi-square Goodness of Fit")){
     infer_plot <- both_chisq_plot(data = data, 
                                   deg_freedom = attr(data, "distr_param"),
                                   statistic_text = "Chi-Square", 
@@ -218,7 +221,7 @@ theory_t_plot <- function(deg_freedom, statistic_text = "t",
 both_t_plot <- function(data, deg_freedom, statistic_text = "t",
                         dens_color = "black",
                         obs_stat = NULL,
-                        direction = NULL, bins = 30,...){
+                        direction = NULL, bins = 15,...){
   #  infer_t_plot <- ggplot(data = data, mapping = aes(x = stat))
 
   infer_t_plot <- shade_density_check(data = data, #gg_plot = infer_t_plot,
@@ -252,7 +255,7 @@ both_anova_plot <- function(data, deg_freedom_top,
                             deg_freedom_bottom, statistic_text = "F",
                             dens_color = "black",
                             obs_stat = NULL,
-                            direction = NULL, bins = 30,....){
+                            direction = NULL, bins = 15,....){
 
   infer_anova_plot <- shade_density_check(data = data, 
                                           obs_stat = obs_stat,
@@ -280,7 +283,7 @@ theory_z_plot <- function(statistic_text = "z", dens_color = "black", ...){
 both_z_plot <- function(data, statistic_text = "z",
                         dens_color = "black",
                         obs_stat = NULL,
-                        direction = NULL, bins = 30,...){
+                        direction = NULL, bins = 15,...){
   infer_z_plot <- shade_density_check(data = data, 
                                       obs_stat = obs_stat,
                                       direction = direction,
@@ -309,7 +312,7 @@ theory_chisq_plot <- function(deg_freedom, statistic_text = "Chi-Square",
 both_chisq_plot <- function(data, deg_freedom, statistic_text = "Chi-Square",
                         dens_color = "black",
                         obs_stat = NULL,
-                        direction = "greater", bins = 30,...){
+                        direction = "greater", bins = 15,...){
 
   infer_chisq_plot <- shade_density_check(data = data,
                                       obs_stat = obs_stat,

implement_new_methods.md

@@ -11,4 +11,5 @@ chunks of `*both_methods.Rmd` file there up to "Implemented"
   - Add undefined global functions or variables to `infer.R` `globalVariables`
   - Run `devtools::check()` again until 0 errors | 0 warnings | 0 notes
 1. Run `pkgdown::build_site()`
-1. Commit files to GitHub and continue
+1. Commit files to GitHub and continue
+

man/visualize.Rd

@@ -175,6 +175,23 @@ test_that("chi-square matches chisq.test value", {
     dplyr::do(broom::tidy(stats::chisq.test(table(.$Species)))) %>%
     dplyr::select(replicate, stat = statistic)
   expect_equal(infer_way, trad_way)
+  
+  gen_iris9a <- iris %>%
+    specify(Species ~ NULL) %>%
+    hypothesize(null = "point",
+                p = c("setosa" = 0.8,
+                      "versicolor" = 0.1,
+                      "virginica" = 0.1)) %>%
+    generate(reps = 10, type = "simulate")
+  infer_way <- calculate(gen_iris9a, stat = "Chisq")
+  #chisq.test way
+  trad_way <- gen_iris9a %>%
+    dplyr::group_by(replicate) %>%
+    dplyr::do(broom::tidy(stats::chisq.test(table(.$Species),
+                                            p = c(0.8, 0.1, 0.1)))) %>%
+    dplyr::select(replicate, stat = statistic)
+  expect_equal(infer_way, trad_way)
+  
 })
 
 test_that("`order` is working", {