Chi-square Test

Test of goodness of fit (Raw data)

One nominal variable

Note: Input values must be separated by tabs. Copy and paste from Excel/Numbers.

Your data needs to have the header (variable names) in the first row. Missing values should be indicated by a period (.) or NA.

Contingency table

Test result

Plot

R session info

Test of goodness of fit (Tabulated data)

One nominal variable

Note: Input values must be separated by tabs. Copy and paste from Excel/Numbers.

Your data needs to have the header (variable names) in the first row. Missing values should be indicated by a period (.) or NA.

Contingency table

Test result

Plot

R session info

Test of Independence (Raw data)

Two or more than two nominal variables

Note: Input values must be separated by tabs. Copy and paste from Excel/Numbers.

Your data needs to have the header (variable names) in the first row. Missing values should be indicated by a period (.) or NA.

Contingency table

Test result

Plot

R session info

Test of Independence (Tabulated data)

Two or more than two nominal variables

Note: Input values must be separated by tabs. Copy and paste from Excel/Numbers.

Your data needs to have the header (variable names) in the first row. Missing values should be indicated by a period (.) or NA.

Contingency table

Test result

Plot

R session info

Note

This web application is developed with Shiny.

List of Packages Used
library(shiny)
library(shinyAce)
library(pwr)
library(vcd)

Code

Source code for this application is based on "The handbook of Research in Foreign Language Learning and Teaching" (Takeuchi & Mizumoto, 2012).

The code for this web application is available at GitHub.

If you want to run this code on your computer (in a local R session), run the code below:
library(shiny)
runGitHub("chi","mizumot")

I referred to js-STAR for some parts of the codes. I would like to thank the authors of js-STAR, the very fast and excellent online software.

Citation in Publications

Mizumoto, A. (2015). Langtest (Version 1.0) [Web application]. Retrieved from http://langtest.jp

Article

Mizumoto, A., & Plonsky, L. (2015). R as a lingua franca: Advantages of using R for quantitative research in applied linguistics. Applied Linguistics, Advance online publication. doi:10.1093/applin/amv025

Recommended

To learn more about R, I suggest this excellent and free e-book (pdf), A Guide to Doing Statistics in Second Language Research Using R, written by Dr. Jenifer Larson-Hall.

Also, if you are a cool Mac user and want to use R with GUI, MacR is defenitely the way to go!

Author

Atsushi MIZUMOTO, Ph.D.
Professor of Applied Linguistics
Faculty of Foreign Language Studies /
Graduate School of Foreign Language Education and Research,
Kansai University, Osaka, Japan

library(shiny) library(shinyAce) library(pwr) library(vcd) shinyServer(function(input, output) { #---------------------------------------------------- # 1. Test of goodness of fit (Raw data) #---------------------------------------------------- data1 <- reactive({ dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA",".")) x <- table(dat) n <- sum(x) x <- c(x, Sum=n) print(x) }) output$data1.out <- renderPrint({ data1() }) test1 <- reactive({ dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA",".")) x <- table(dat) chi <- chisq.test(x) print(chi) P0 <- rep(1/length(x), times = length(x)) # Expected ratio P1 <- x/sum(x) # Observed ratio w <- ES.w1(P0, P1) # Effect size ｗ (Large=0.5, Medium=0.3, Small=0.1) cat("Effect size w =", round(w, 3), "\n") cat("\n", "---", "\n", "Multiple comparisons (p-value adjusted with Bonferroni method):", "\n", "\n") itemNum <- 0 for (i in 1:length(chi$observed)) { for (j in 1:length(chi$observed)) { if (i <= j) {next} z <- (abs(chi$observed[[i]]-chi$observed[[j]])-1)/sqrt(chi$observed[[i]]+chi$observed[[j]]) p <- pnorm(z, lower.tail=FALSE)*2 p <- p.adjust(p, method = "bonferroni", n = length(x)) n <- chi$observed[[i]] + chi$observed[[j]] p00 <- c(0.5, 0.5) # 母比率同等 p11 <- c(chi$observed[[i]]/n, chi$observed[[j]]/n) # 標本比率 p0 <- p00[1] p1 <- p11[1] ESg <- p1-p0 # 効果量g cat(names(x)[j],"vs",names(x)[i],":", "z =", sprintf("%.3f",round(z,3)), ",", "p =", sprintf("%.3f",round(p,3)), ",", "Effect size g =", round(ESg,3), "\n") itemNum <- itemNum + 1 } } }) output$test1.out <- renderPrint({ test1() }) makepPlot1 <- function(){ dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA",".")) x <- table(dat) P0 <- rep(1/length(x), times = length(x)) # Expected ratio P1 <- x/sum(x) # Observed ratio par(mar=c(5,6,2,4)) z <- matrix(c(P0, P1), nc=length(x), by=1) colnames(z) <- names(x) rownames(z) <- c("Expected", "Observed") barplot(t(z), hor=1, las=1, xlab="Percentage", col=gray.colors(length(x))) legend("bottomright",legend=colnames(z), fill=gray.colors(length(x))) } output$pPlot1 <- renderPlot({ print(makepPlot1()) }) info1 <- reactive({ info1 <- paste("This analysis was conducted with ", strsplit(R.version$version.string, " \\(")[[1]][1], ".", sep = "") info2 <- paste("It was executed on ", date(), ".", sep = "") cat(sprintf(info1), "\n") cat(sprintf(info2), "\n") }) output$info1.out <- renderPrint({ info1() }) #---------------------------------------------------- # 2. Test of goodness of fit (Tabulated data) #---------------------------------------------------- data2 <- reactive({ dat <- read.csv(text=input$text2, sep="", na.strings=c("","NA",".")) n <- sum(dat) x <- data.frame(dat, Sum = n) rownames(x) <- "" print(x) }) output$data2.out <- renderPrint({ data2() }) test2 <- reactive({ dat <- read.csv(text=input$text2, sep="", na.strings=c("","NA",".")) x <- dat chi <- chisq.test(x) print(chi) P0 <- rep(1/length(x), times = length(x)) # Expected ratio P1 <- x/sum(x) # Observed ratio w <- ES.w1(P0, P1) # Effect size ｗ (Large=0.5, Medium=0.3, Small=0.1) cat("Effect size w =", round(w, 3), "\n") cat("\n", "---", "\n", "Multiple comparisons (p-value adjusted with Bonferroni method):", "\n", "\n") itemNum <- 0 for (i in 1:length(chi$observed)) { for (j in 1:length(chi$observed)) { if (i <= j) {next} z <- (abs(chi$observed[[i]]-chi$observed[[j]])-1)/sqrt(chi$observed[[i]]+chi$observed[[j]]) p <- pnorm(z, lower.tail=FALSE)*2 p <- p.adjust(p, method = "bonferroni", n = length(x)) n <- chi$observed[[i]] + chi$observed[[j]] p00 <- c(0.5, 0.5) # 母比率同等 p11 <- c(chi$observed[[i]]/n, chi$observed[[j]]/n) # 標本比率 p0 <- p00[1] p1 <- p11[1] ESg <- p1-p0 # 効果量g cat(names(x)[j],"vs",names(x)[i],":", "z =", sprintf("%.3f",round(z,3)), ",", "p =", sprintf("%.3f",round(p,3)), ",", "Effect size g =", round(ESg,3), "\n") itemNum <- itemNum + 1 } } }) output$test2.out <- renderPrint({ test2() }) makepPlot2 <- function(){ dat <- read.csv(text=input$text2, sep="", na.strings=c("","NA",".")) x <- dat P0 <- rep(1/length(x), times = length(x)) # 期待比率 P1 <- x/sum(x) # 標本比率 par(mar=c(5,6,2,4)) z <- matrix(c(P0, P1), nc=length(x), by=1) colnames(z) <- names(x) rownames(z) <- c("Expected", "Observed") barplot(t(z), hor=1, las=1, xlab="Percentage", col=gray.colors(length(x))) legend("bottomright",legend=colnames(z), fill=gray.colors(length(x))) } output$pPlot2 <- renderPlot({ print(makepPlot2()) }) info2 <- reactive({ info1 <- paste("This analysis was conducted with ", strsplit(R.version$version.string, " \\(")[[1]][1], ".", sep = "") info2 <- paste("It was executed on ", date(), ".", sep = "") cat(sprintf(info1), "\n") cat(sprintf(info2), "\n") }) output$info2.out <- renderPrint({ info2() }) #---------------------------------------------------- # 3. Test of Independence (Raw data) #---------------------------------------------------- data3 <- reactive({ dat <- read.csv(text=input$text3, sep="", na.strings=c("","NA",".")) x <- table(dat) x <- addmargins(x) print(x) }) output$data3.out <- renderPrint({ data3() }) test3 <- reactive({ dat <- read.csv(text=input$text3, sep="", na.strings=c("","NA",".")) x <- table(dat) a <- chisq.test(x, correct=F) # Pearson's Chi-squared b <- chisq.test(x) # Yates c <- assocstats(x) # Likelihood Ratio aa <- data.frame(a[4], a[1], a[2], a[3]) aa[1] <- c("Pearson's Chi-squared") row.names(aa) <- NULL bb <- data.frame(b[4], b[1], b[2], b[3]) bb[1] <- c("Yates' Continuity Correction") row.names(bb) <- NULL cc <- data.frame(c[2])[1,] cc <- data.frame(c("Log-likelihood Ratio (G)"), cc[,1], cc[,2], cc[,3]) names(cc) <- c("method", "statistic", "parameter", "p.value") # Fisher's Exact Test e <- try(fisher.test(x, workspace=3000000), silent = FALSE) # try, fisher.test if (class(e) == "try-error") { dd <- data.frame(c(""), c(""), c(""), c("data too large")) # if error dd[1] <- c("Fisher's Exact Test") names(dd) <- c("method", "statistic", "parameter", "p.value") row.names(dd) <- NULL } else { d <- fisher.test(x, workspace=3000000) # no error if (nrow(x) * ncol(x) == 4) { # Only for the 2×2 table dd <- data.frame(d[6], c(""), c(""), d[1]) } else { dd <- data.frame(d[3], c(""), c(""), d[1]) } dd[1] <- c("Fisher's Exact Test") names(dd) <- c("method", "statistic", "parameter", "p.value") row.names(dd) <- NULL } res <- rbind(aa, bb, cc, dd) res[2] <- round(as.numeric(res[,2]), 4) res[2][4,] <- "" names(res) <- c("Test", "X-squared", "df", "p-value") print(res) cat("\n") cat("\n", "------------------------------------------------------", "\n", "Effect size:", "\n") # Cramer's V [95%CI] V <- sqrt(chisq.test(x, correct=F)$statistic[[1]]/(sum(x)*(min(nrow(x),ncol(x)-1)))) fisherZ <- 0.5 * log((1 + V)/(1 - V)) fisherZ.se <- 1/sqrt(sum(x) - 3) * qnorm(1 - ((1 - 0.95)/2)) fisherZ.ci <- fisherZ + c(-fisherZ.se, fisherZ.se) ci.V <- (exp(2 * fisherZ.ci) - 1)/(1 + exp(2 * fisherZ.ci)) cat("\n", "Cramer's V [95%CI] =", V, "[", ci.V[1], ",",ci.V[2],"]", "\n") # Odds Ratio if (nrow(x) * ncol(x) == 4) { # Print odds ratio only for the 2×2 table oddsrt <- (x[1,1]/x[1,2]) / (x[2,1]/x[2,2]) oddsrt.log <- log((x[1,1]/x[1,2]) / (x[2,1]/x[2,2])) oddsrt.log.var <- 1/x[1,1] + 1/x[1,2] + 1/x[2,1] + 1/x[2,2] ci.lwrupr <- exp(oddsrt.log + qnorm(c(0.025,0.975)) * sqrt(oddsrt.log.var)) cat("\n", "Odds Ratio [95%CI] =", oddsrt, "[", ci.lwrupr[1], ",",ci.lwrupr[2],"]", "\n") } else { NULL } cat("\n", "\n", "------------------------------------------------------", "\n", "Residual analysis:", "\n") res <- chisq.test(x) # 検定結果を代入 cat("\n", "[Expected values]", "\n") print(res$expected) # 期待値 cat("\n", "[Standardized residuals]", "\n") print(res$residuals) # 標準化残差 cat("\n", "[Adjusted standardized residuals]", "\n") print(res$residuals/sqrt(outer(1-rowSums(x)/sum(x), 1-colSums(x)/sum(x)))) # 調整済み標準化残差 cat("\n", "[p-values of adjusted standardized residuals (two-tailed)]", "\n") print(round(2*(1-pnorm(abs(res$residuals/sqrt(outer(1-rowSums(x)/sum(x), 1-colSums(x)/sum(x)))))),3)) # 残差の調整後有意確率（両側確率） # 多重比較 if (nrow(x) < 3) { # Not showing if the number of row is 2 cat("\n") } else { cat("\n", "\n", "------------------------------------------------------", "\n", "Multiple comparisons (p-value adjusted with Bonferroni method):", "\n", "\n") levI <- nrow(x) levJ <- ncol(x) N <- sum(x) dosu <- as.vector(t(x)) M <- min(c(levI, levJ)) V.95CI <- function(x) { V <- sqrt(chisq.test(x, correct=F)$statistic[[1]]/(sum(x)*(min(nrow(x),ncol(x)-1)))) fisherZ <- 0.5 * log((1 + V)/(1 - V)) fisherZ.se <- 1/sqrt(sum(x) - 3) * qnorm(1 - ((1 - 0.95)/2)) fisherZ.ci <- fisherZ + c(-fisherZ.se, fisherZ.se) ci.V <- (exp(2 * fisherZ.ci) - 1)/(1 + exp(2 * fisherZ.ci)) return(ci.V) } # エラーメッセージが出る場合の例外処理 e <- try(fisher.test(x, workspace=3000000), silent = FALSE) # try でfisher.test関数を実行 if (class(e) == "try-error") { # if error, without fisher.p a <- c() stat <- c() jiyu <- c() pchi <- c() v <- c() v.lower <- c() v.upper <- c() for(i in 1:(levI-1)) { for(k in (i+1):levI) { ds <- c() for(j in 1:levJ) { ds <- c(ds, dosu[(i-1)*levJ+j]) } for(j in 1:levJ) { ds <- c(ds, dosu[(k-1)*levJ+j]) } kaik <- c() kaik <- chisq.test(matrix(ds, nr=2, by=1), correct=F) stat <- c(stat,kaik$stat) jiyu <- c(jiyu,kaik$para) pchi <- c(pchi,kaik$p.va) v <- c(v, sqrt(kaik$stat/(N*(M-1)))) ci.values <- V.95CI(matrix(ds, nr=2, by=1)) lower <- ci.values[1] upper <- ci.values[2] v.lower <- c(v.lower, lower) v.upper <- c(v.upper, upper) } } padj <- c() padj <- p.adjust(pchi, "bonferroni") kochi<-c(); aite<-c() for(i in 1:(levI-1)) { for(j in (i+1):levI) { kochi <- c(kochi, rownames(x)[i]) aite <- c(aite, rownames(x)[j]) } } a <- data.frame(Comparisons=paste(kochi, aite, sep=" vs "), "X^2"=round(stat, 4), df=round(jiyu, 4), p=round(padj, 4), Cramers.V=round(v, 4), lwr.V=round(v.lower, 4), upr.V=round(v.upper, 4)) rownames(a) <- cat("\n") print(a) } else { # with fisher.p a <- c() stat <- c() jiyu <- c() pchi <- c() fishp <- c() v <- c() v.lower <- c() v.upper <- c() for(i in 1:(levI-1)) { for(k in (i+1):levI) { ds <- c() for(j in 1:levJ) { ds <- c(ds, dosu[(i-1)*levJ+j]) } for(j in 1:levJ) { ds <- c(ds, dosu[(k-1)*levJ+j]) } kaik <- c() kaik <- chisq.test(matrix(ds, nr=2, by=1), correct=F) stat <- c(stat,kaik$stat) jiyu <- c(jiyu,kaik$para) pchi <- c(pchi,kaik$p.va) fishp <- c(fishp,fisher.test(matrix(ds, nr=2, by=1))$p.va) v <- c(v, sqrt(kaik$stat/(N*(M-1)))) ci.values <- V.95CI(matrix(ds, nr=2, by=1)) lower <- ci.values[1] upper <- ci.values[2] v.lower <- c(v.lower, lower) v.upper <- c(v.upper, upper) } } padj <- c() padj <- p.adjust(pchi, "bonferroni") fishpadj <- p.adjust(fishp, "bonferroni") kochi<-c(); aite<-c() for(i in 1:(levI-1)) { for(j in (i+1):levI) { kochi <- c(kochi, rownames(x)[i]) aite <- c(aite, rownames(x)[j]) } } a <- data.frame(Comparisons=paste(kochi, aite, sep=" vs "), "X^2"=round(stat, 4), df=round(jiyu, 4), p=round(padj, 4), Fisher.p=round(fishpadj, 4), Cramers.V=round(v, 4), lwr.V=round(v.lower, 4), upr.V=round(v.upper, 4)) rownames(a) <- cat("\n") print(a) } } }) output$test3.out <- renderPrint({ test3() }) makepPlot3 <- function(){ dat <- read.csv(text=input$text3, sep="", na.strings=c("","NA",".")) x <- table(dat) levI <- nrow(x) # 行の水準数 levJ <- ncol(x) # 列の水準数 dosu <- as.vector(t(x)) # 標本比率の計算 gokei <- c() bunbo <- c() for(i in 1:levI) # 各群の度数を集計 { ds <- c() for(j in 1:levJ) { ds <- c(ds, dosu[(i-1)*levJ+j]) } gokei <- c(gokei, sum(ds)) bunbo <- c(bunbo, rep(sum(ds), levJ)) } hyohir <- dosu/bunbo # 群別の各値の比率 zuhir <- c() for(i in levI:1) # 群ｉ→群１と逆順に並べ替える { for(j in 1:levJ) { zuhir <- c(zuhir, hyohir[(i-1)*levJ+j] ) } } zubar <- matrix(c(zuhir), nc=levJ, by=1) rownames(zubar) <- rev(rownames(x)) colnames(zubar) <- colnames(x) #zubar <- zubar[nrow(zubar):1,] # プロット par(mar=c(5,6,2,4)) barplot(t(zubar), hor=1, las=1, xlab="Percentage", col=gray.colors(ncol(x))) legend("bottomright", legend=colnames(zubar), fill=gray.colors(ncol(x))) } output$pPlot3 <- renderPlot({ print(makepPlot3()) }) makemPlot3 <- function(){ dat <- read.csv(text=input$text3, sep="", na.strings=c("","NA",".")) x <- table(dat) mosaic(x, gp = shading_max, main="Mosaic plot") } output$mPlot3 <- renderPlot({ print(makemPlot3()) }) info3 <- reactive({ info1 <- paste("This analysis was conducted with ", strsplit(R.version$version.string, " \\(")[[1]][1], ".", sep = "") info2 <- paste("It was executed on ", date(), ".", sep = "") cat(sprintf(info1), "\n") cat(sprintf(info2), "\n") }) output$info3.out <- renderPrint({ info3() }) #---------------------------------------------------- # 4. Test of Independence (Tabulated data) #---------------------------------------------------- data4 <- reactive({ dat <- read.csv(text=input$text4, sep="", na.strings=c("","NA",".")) x <- as.matrix(dat) x <- addmargins(x) print(x) }) output$data4.out <- renderPrint({ data4() }) test4 <- reactive({ dat <- read.csv(text=input$text4, sep="", na.strings=c("","NA",".")) x <- as.matrix(dat) a <- chisq.test(x, correct=F) # Pearson's Chi-squared b <- chisq.test(x) # Yates c <- assocstats(x) # Likelihood Ratio aa <- data.frame(a[4], a[1], a[2], a[3]) aa[1] <- c("Pearson's Chi-squared") row.names(aa) <- NULL bb <- data.frame(b[4], b[1], b[2], b[3]) bb[1] <- c("Yates' Continuity Correction") row.names(bb) <- NULL cc <- data.frame(c[2])[1,] cc <- data.frame(c("Log-likelihood Ratio (G)"), cc[,1], cc[,2], cc[,3]) names(cc) <- c("method", "statistic", "parameter", "p.value") # Fisher's Exact Test e <- try(fisher.test(x, workspace=3000000), silent = FALSE) # try, fisher.test if (class(e) == "try-error") { dd <- data.frame(c(""), c(""), c(""), c("data too large")) # if error dd[1] <- c("Fisher's Exact Test") names(dd) <- c("method", "statistic", "parameter", "p.value") row.names(dd) <- NULL } else { d <- fisher.test(x, workspace=3000000) # no error if (nrow(x) * ncol(x) == 4) { # Only for the 2×2 table dd <- data.frame(d[6], c(""), c(""), d[1]) } else { dd <- data.frame(d[3], c(""), c(""), d[1]) } dd[1] <- c("Fisher's Exact Test") names(dd) <- c("method", "statistic", "parameter", "p.value") row.names(dd) <- NULL } res <- rbind(aa, bb, cc, dd) res[2] <- round(as.numeric(res[,2]), 4) res[2][4,] <- "" names(res) <- c("Test", "X-squared", "df", "p-value") cat("\n") print(res) cat("\n") cat("\n", "------------------------------------------------------", "\n", "Effect size:", "\n") # Cramer's V [95%CI] V <- sqrt(chisq.test(x, correct=F)$statistic[[1]]/(sum(x)*(min(nrow(x)-1,ncol(x)-1)))) #nrow(x)"-1"追加 fisherZ <- 0.5 * log((1 + V)/(1 - V)) fisherZ.se <- 1/sqrt(sum(x) - 3) * qnorm(1 - ((1 - 0.95)/2)) fisherZ.ci <- fisherZ + c(-fisherZ.se, fisherZ.se) ci.V <- (exp(2 * fisherZ.ci) - 1)/(1 + exp(2 * fisherZ.ci)) cat("\n", "Cramer's V [95%CI] =", V, "[", ci.V[1], ",",ci.V[2],"]", "\n") # Odds Ratio if (nrow(x) * ncol(x) == 4) { # Print odds ratio only for the 2×2 table oddsrt <- (x[1,1]/x[1,2]) / (x[2,1]/x[2,2]) oddsrt.log <- log((x[1,1]/x[1,2]) / (x[2,1]/x[2,2])) oddsrt.log.var <- 1/x[1,1] + 1/x[1,2] + 1/x[2,1] + 1/x[2,2] ci.lwrupr <- exp(oddsrt.log + qnorm(c(0.025,0.975)) * sqrt(oddsrt.log.var)) cat("\n", "Odds Ratio [95%CI] =", oddsrt, "[", ci.lwrupr[1], ",",ci.lwrupr[2],"]", "\n") } else { NULL } cat("\n", "\n", "------------------------------------------------------", "\n", "Residual analysis:", "\n") res <- chisq.test(x) # 検定結果を代入 cat("\n", "[Expected values]", "\n") print(res$expected) # 期待値 cat("\n", "[Standardized residuals]", "\n") print(res$residuals) # 標準化残差 cat("\n", "[Adjusted standardized residuals]", "\n") print(res$residuals/sqrt(outer(1-rowSums(x)/sum(x), 1-colSums(x)/sum(x)))) # 調整済み標準化残差 cat("\n", "[p-values of adjusted standardized residuals (two-tailed)]", "\n") print(round(2*(1-pnorm(abs(res$residuals/sqrt(outer(1-rowSums(x)/sum(x), 1-colSums(x)/sum(x)))))),3)) # 残差の調整後有意確率（両側確率） # 多重比較 if (nrow(x) < 3) { # Not showing if the number of row is 2 cat("\n") } else { cat("\n", "\n", "------------------------------------------------------", "\n", "Multiple comparisons (p-value adjusted with Bonferroni method):", "\n", "\n") levI <- nrow(x) levJ <- ncol(x) N <- sum(x) dosu <- as.vector(t(x)) M <- min(c(levI, levJ)) V.95CI <- function(x) { V <- sqrt(chisq.test(x, correct=F)$statistic[[1]]/(sum(x)*(min(nrow(x),ncol(x)-1)))) fisherZ <- 0.5 * log((1 + V)/(1 - V)) fisherZ.se <- 1/sqrt(sum(x) - 3) * qnorm(1 - ((1 - 0.95)/2)) fisherZ.ci <- fisherZ + c(-fisherZ.se, fisherZ.se) ci.V <- (exp(2 * fisherZ.ci) - 1)/(1 + exp(2 * fisherZ.ci)) return(ci.V) } # エラーメッセージが出る場合の例外処理 e <- try(fisher.test(x, workspace=3000000), silent = FALSE) # try でfisher.test関数を実行 if (class(e) == "try-error") { # if error, without fisher.p a <- c() stat <- c() jiyu <- c() pchi <- c() v <- c() v.lower <- c() v.upper <- c() for(i in 1:(levI-1)) { for(k in (i+1):levI) { ds <- c() for(j in 1:levJ) { ds <- c(ds, dosu[(i-1)*levJ+j]) } for(j in 1:levJ) { ds <- c(ds, dosu[(k-1)*levJ+j]) } kaik <- c() kaik <- chisq.test(matrix(ds, nr=2, by=1), correct=F) stat <- c(stat,kaik$stat) jiyu <- c(jiyu,kaik$para) pchi <- c(pchi,kaik$p.va) v <- c(v, sqrt(kaik$stat/(N*(M-1)))) ci.values <- V.95CI(matrix(ds, nr=2, by=1)) lower <- ci.values[1] upper <- ci.values[2] v.lower <- c(v.lower, lower) v.upper <- c(v.upper, upper) } } padj <- c() padj <- p.adjust(pchi, "bonferroni") kochi<-c(); aite<-c() for(i in 1:(levI-1)) { for(j in (i+1):levI) { kochi <- c(kochi, rownames(x)[i]) aite <- c(aite, rownames(x)[j]) } } a <- data.frame(Comparisons=paste(kochi, aite, sep=" vs "), "X^2"=round(stat, 4), df=round(jiyu, 4), p=round(padj, 4), Cramers.V=round(v, 4), lwr.V=round(v.lower, 4), upr.V=round(v.upper, 4)) rownames(a) <- cat("\n") print(a) } else { # with fisher.p a <- c() stat <- c() jiyu <- c() pchi <- c() fishp <- c() v <- c() v.lower <- c() v.upper <- c() for(i in 1:(levI-1)) { for(k in (i+1):levI) { ds <- c() for(j in 1:levJ) { ds <- c(ds, dosu[(i-1)*levJ+j]) } for(j in 1:levJ) { ds <- c(ds, dosu[(k-1)*levJ+j]) } kaik <- c() kaik <- chisq.test(matrix(ds, nr=2, by=1), correct=F) stat <- c(stat,kaik$stat) jiyu <- c(jiyu,kaik$para) pchi <- c(pchi,kaik$p.va) fishp <- c(fishp,fisher.test(matrix(ds, nr=2, by=1))$p.va) v <- c(v, sqrt(kaik$stat/(N*(M-1)))) ci.values <- V.95CI(matrix(ds, nr=2, by=1)) lower <- ci.values[1] upper <- ci.values[2] v.lower <- c(v.lower, lower) v.upper <- c(v.upper, upper) } } padj <- c() padj <- p.adjust(pchi, "bonferroni") fishpadj <- p.adjust(fishp, "bonferroni") kochi<-c(); aite<-c() for(i in 1:(levI-1)) { for(j in (i+1):levI) { kochi <- c(kochi, rownames(x)[i]) aite <- c(aite, rownames(x)[j]) } } a <- data.frame(Comparisons=paste(kochi, aite, sep=" vs "), "X^2"=round(stat, 4), df=round(jiyu, 4), p=round(padj, 4), Fisher.p=round(fishpadj, 4), Cramers.V=round(v, 4), lwr.V=round(v.lower, 4), upr.V=round(v.upper, 4)) rownames(a) <- cat("\n") print(a) } } }) output$test4.out <- renderPrint({ test4() }) makepPlot4 <- function(){ dat <- read.csv(text=input$text4, sep="", na.strings=c("","NA",".")) x <- as.matrix(dat) levI <- nrow(x) # 行の水準数 levJ <- ncol(x) # 列の水準数 dosu <- as.vector(t(x)) # 標本比率の計算 gokei <- c() bunbo <- c() for(i in 1:levI) # 各群の度数を集計 { ds <- c() for(j in 1:levJ) { ds <- c(ds, dosu[(i-1)*levJ+j]) } gokei <- c(gokei, sum(ds)) bunbo <- c(bunbo, rep(sum(ds), levJ)) } hyohir <- dosu/bunbo # 群別の各値の比率 zuhir <- c() for(i in levI:1) # 群ｉ→群１と逆順に並べ替える { for(j in 1:levJ) { zuhir <- c(zuhir, hyohir[(i-1)*levJ+j] ) } } zubar <- matrix(c(zuhir), nc=levJ, by=1) rownames(zubar) <- rev(rownames(x)) colnames(zubar) <- colnames(x) #zubar <- zubar[nrow(zubar):1,] # プロット par(mar=c(5,6,2,4)) barplot(t(zubar), hor=1, las=1, xlab="Percentage", col=gray.colors(ncol(x))) legend("bottomright", legend=colnames(zubar), fill=gray.colors(ncol(x))) } output$pPlot4 <- renderPlot({ print(makepPlot4()) }) makemPlot4 <- function(){ dat <- read.csv(text=input$text4, sep="", na.strings=c("","NA",".")) x <- as.matrix(dat) mosaic(x, gp = shading_max, main="Mosaic plot") } output$mPlot4 <- renderPlot({ print(makemPlot4()) }) info4 <- reactive({ info1 <- paste("This analysis was conducted with ", strsplit(R.version$version.string, " \\(")[[1]][1], ".", sep = "") info2 <- paste("It was executed on ", date(), ".", sep = "") cat(sprintf(info1), "\n") cat(sprintf(info2), "\n") }) output$info4.out <- renderPrint({ info4() }) })

library(shiny) library(shinyAce) shinyUI(bootstrapPage( headerPanel("Chi-square Test"), ########## Adding loading message ######### tags$head(tags$style(type="text/css", " #loadmessage { position: fixed; top: 0px; left: 0px; width: 100%; padding: 10px 0px 10px 0px; text-align: center; font-weight: bold; font-size: 100%; color: #000000; background-color: #CCFF66; z-index: 105; } ")), conditionalPanel(condition="$('html').hasClass('shiny-busy')", tags$div("Loading...",id="loadmessage")), ########## Added up untill here ########## mainPanel( tabsetPanel(selected = "Test of Independence (Tabulated data)", tabPanel("Test of goodness of fit (Raw data)", h2("Test of goodness of fit (Raw data)"), h4("One nominal variable"), p('Note: Input values must be separated by tabs. Copy and paste from Excel/Numbers.'), p(HTML("<b><div style='background-color:#FADDF2;border:1px solid black;'>Your data needs to have the header (variable names) in the first row. Missing values should be indicated by a period (.) or NA.</div></b>")), aceEditor("text1", value="L1\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nJapanese\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nThai\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese\nChinese", mode="r", theme="cobalt"), br(), h3("Contingency table"), verbatimTextOutput("data1.out"), br(), h3("Test result"), verbatimTextOutput("test1.out"), br(), h3("Plot"), plotOutput("pPlot1"), br(), br(), strong('R session info'), verbatimTextOutput("info1.out") ), tabPanel("Test of goodness of fit (Tabulated data)", h2("Test of goodness of fit (Tabulated data)"), h4("One nominal variable"), p('Note: Input values must be separated by tabs. Copy and paste from Excel/Numbers.'), p(HTML("<b><div style='background-color:#FADDF2;border:1px solid black;'>Your data needs to have the header (variable names) in the first row. Missing values should be indicated by a period (.) or NA.</div></b>")), aceEditor("text2", value="Japanese\tThai\tChinese\n18\t24\t48", mode="r", theme="cobalt"), br(), h3("Contingency table"), verbatimTextOutput("data2.out"), br(), h3("Test result"), verbatimTextOutput("test2.out"), br(), h3("Plot"), plotOutput("pPlot2"), br(), br(), strong('R session info'), verbatimTextOutput("info2.out") ), tabPanel("Test of Independence (Raw data)", h2("Test of Independence (Raw data)"), h4("Two or more than two nominal variables"), p('Note: Input values must be separated by tabs. Copy and paste from Excel/Numbers.'), p(HTML("<b><div style='background-color:#FADDF2;border:1px solid black;'>Your data needs to have the header (variable names) in the first row. Missing values should be indicated by a period (.) or NA.</div></b>")), aceEditor("text3", value="Sex\tEffect\nM\tNo\nW\tNo\nW\tNo\nM\tNo\nM\tYes\nM\tYes\nM\tYes\nM\tNo\nW\tYes\nM\tNo\nW\tYes\nM\tNo\nM\tYes\nM\tNo\nM\tNo\nM\tYes\nW\tYes\nW\tYes\nW\tYes\nW\tYes\nW\tYes\nM\tYes\nM\tNo\nM\tNo\nM\tYes\nM\tYes\nW\tYes\nM\tNo\nM\tYes\nW\tYes\nM\tNo\nM\tNo\nW\tYes\nW\tYes\nW\tYes\nW\tYes\nM\tNo\nW\tNo\nW\tYes\nM\tYes\nW\tYes\nM\tNo\nM\tYes\nW\tYes\nM\tYes\nW\tYes\nM\tYes\nM\tNo\nM\tNo\nW\tNo\nW\tNo\nM\tYes\nW\tNo\nM\tYes\nW\tYes\nW\tYes\nM\tNo\nM\tNo\nM\tYes\nW\tYes\nM\tNo\nW\tYes\nW\tYes\nM\tYes\nW\tNo\nW\tYes\nM\tNo\nW\tYes\nW\tNo\nM\tYes",mode="r", theme="cobalt"), br(), h3("Contingency table"), verbatimTextOutput("data3.out"), br(), h3("Test result"), verbatimTextOutput("test3.out"), br(), h3("Plot"), plotOutput("pPlot3"), br(), plotOutput("mPlot3", height = "550px"), br(), br(), strong('R session info'), verbatimTextOutput("info3.out") ), tabPanel("Test of Independence (Tabulated data)", h2("Test of Independence (Tabulated data)"), h4("Two or more than two nominal variables"), p('Note: Input values must be separated by tabs. Copy and paste from Excel/Numbers.'), p(HTML("<b><div style='background-color:#FADDF2;border:1px solid black;'>Your data needs to have the header (variable names) in the first row. Missing values should be indicated by a period (.) or NA.</div></b>")), aceEditor("text4", value="\tNo\tYes\nM\t20\t18\nW\t8\t24", mode="r", theme="cobalt"), br(), h3("Contingency table"), verbatimTextOutput("data4.out"), br(), h3("Test result"), verbatimTextOutput("test4.out"), br(), h3("Plot"), plotOutput("pPlot4"), br(), plotOutput("mPlot4", height = "550px"), br(), br(), strong('R session info'), verbatimTextOutput("info4.out") ), tabPanel("About", strong('Note'), p('This web application is developed with', a("Shiny.", href="http://www.rstudio.com/shiny/", target="_blank"), ''), br(), strong('List of Packages Used'), br(), code('library(shiny)'),br(), code('library(shinyAce)'),br(), code('library(pwr)'),br(), code('library(vcd)'),br(), br(), strong('Code'), p('Source code for this application is based on', a('"The handbook of Research in Foreign Language Learning and Teaching" (Takeuchi & Mizumoto, 2012).', href='http://mizumot.com/handbook/', target="_blank")), p('The code for this web application is available at', a('GitHub.', href='https://github.com/mizumot/chi', target="_blank")), p('If you want to run this code on your computer (in a local R session), run the code below:', br(), code('library(shiny)'),br(), code('runGitHub("chi","mizumot")') ), p('I referred to', a("js-STAR", href="http://www.kisnet.or.jp/nappa/software/star/", target="_blank"), 'for some parts of the codes. I would like to thank the authors of js-STAR, the very fast and excellent online software.'), br(), strong('Citation in Publications'), p('Mizumoto, A. (2015). Langtest (Version 1.0) [Web application]. Retrieved from http://langtest.jp'), br(), strong('Article'), p('Mizumoto, A., & Plonsky, L. (2015).', a("R as a lingua franca: Advantages of using R for quantitative research in applied linguistics.", href='http://applij.oxfordjournals.org/content/early/2015/06/24/applin.amv025.abstract', target="_blank"), em('Applied Linguistics,'), 'Advance online publication. doi:10.1093/applin/amv025'), br(), strong('Recommended'), p('To learn more about R, I suggest this excellent and free e-book (pdf),', a("A Guide to Doing Statistics in Second Language Research Using R,", href="http://cw.routledge.com/textbooks/9780805861853/guide-to-R.asp", target="_blank"), 'written by Dr. Jenifer Larson-Hall.'), p('Also, if you are a cool Mac user and want to use R with GUI,', a("MacR", href="https://sites.google.com/site/casualmacr/", target="_blank"), 'is defenitely the way to go!'), br(), strong('Author'), p(a("Atsushi MIZUMOTO,", href="http://mizumot.com", target="_blank"),' Ph.D.',br(), 'Professor of Applied Linguistics',br(), 'Faculty of Foreign Language Studies /',br(), 'Graduate School of Foreign Language Education and Research,',br(), 'Kansai University, Osaka, Japan'), br(), a(img(src="http://i.creativecommons.org/p/mark/1.0/80x15.png"), target="_blank", href="http://creativecommons.org/publicdomain/mark/1.0/"), p(br()) ) ) ) ))