McNemar's Test and Cochran's Q Test

McNemar's Test (Raw data)

Paired nominal data (2 × 2 contingency table)

[Within-subjects chi-squared test]

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

McNemar's Test (Tabulated data)

Paired nominal data (2 × 2 contingency table)

[Within-subjects chi-squared test]

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

Cochran's Q Test (Raw data)

Related samples (repeated measures) with nominal data

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 and the person's IDs in the first column. 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(exact2x2)
library(vcd)
library(reshape2)
library(coin)

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("rep-chi","mizumot")

I referred to this website for some parts of the codes. I would like to thank the author.

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

show with app

server.R
ui.R

library(shiny)
library(shinyAce)
library(exact2x2)
library(vcd)
library(reshape2)
library(coin)


shinyServer(function(input, output) {



#----------------------------------------------------
# 1. McNemar's Test (Raw data)
#----------------------------------------------------

    data1 <- reactive({
        
        dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
        
            x <- table(dat)
            x <- addmargins(x)
            print(x)

        })
    
        output$data1.out <- renderPrint({
            data1()
        })
    
    
    
    
    
    test1 <- reactive({
        
        dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
        
            x <- table(dat)
            res1 <- mcnemar.test(x)
            res2 <- mcnemar.exact(x)
            
            McNemarChi <- paste("McNemar's chi-squared = ", round(res1[[1]][[1]],3), ", ", "df = ", res1[[2]][[1]], sep = "")
            cat(sprintf(McNemarChi), "\n")
            print(res2)
            
       })
    
    output$test1.out <- renderPrint({
        test1()
    })
    
    
    
    
    
    makepPlot1 <- function(){
        
        dat <- read.csv(text=input$text1, 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$pPlot1 <- renderPlot({
        print(makepPlot1())
    })
    
    
    
    
    
    makemPlot1 <- function(){
       
       dat <- read.csv(text=input$text1, sep="", na.strings=c("","NA","."))
       
           x <- table(dat)
           mosaic(x, gp = shading_max, legend=FALSE, main="Mosaic plot")
       
    }
    
    output$mPlot1 <- renderPlot({
        print(makemPlot1())
    })
    
    
    
    
    
    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. McNemar's Test (Tabulated data)
#----------------------------------------------------

    data2 <- reactive({
        
        dat <- read.csv(text=input$text2, sep="", na.strings=c("","NA","."))
        
            x <- as.matrix(dat)
            x <- addmargins(x)
            print(x)

        })
    
        output$data2.out <- renderPrint({
            data2()
        })
    
    
    
    
    
    test2 <- reactive({
        
        dat <- read.csv(text=input$text2, sep="", na.strings=c("","NA","."))
        
            x <- dat
            x <- as.matrix(x)
            res1 <- mcnemar.test(x)
            res2 <- mcnemar.exact(x)
            
            McNemarChi <- paste("McNemar's chi-squared = ", round(res1[[1]][[1]],3), ", ", "df = ", res1[[2]][[1]], sep = "")
            cat(sprintf(McNemarChi), "\n")
            print(res2)
            
    })
    
    output$test2.out <- renderPrint({
        test2()
    })
    
    
    
    
    
    makepPlot2 <- function(){
        
        dat <- read.csv(text=input$text2, 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$pPlot2 <- renderPlot({
        print(makepPlot2())
    })
    
    
    
    
    
    makemPlot2 <- function(){
        
        dat <- read.csv(text=input$text2, sep="", na.strings=c("","NA","."))
        
        x <- as.matrix(dat)
        mosaic(x, gp = shading_max, legend=FALSE, main="Mosaic plot")
        
    }
    
    output$mPlot2 <- renderPlot({
        print(makemPlot2())
    })





    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. Cochran’s Q Test (Raw data)
#----------------------------------------------------

    data3 <- reactive({
        
        dat <- read.csv(text=input$text3, sep="", na.strings=c("","NA","."))
        
            dat[,1] <- factor(dat[,1])
            data.long <- melt(dat, idvars=dat[,1])
            x <- t(table(data.long$variable, data.long$value))
            x <- addmargins(x)
        
            print(x)
        })
    
        output$data3.out <- renderPrint({
            data3()
        })
    
    
    
    
    
    test3 <- reactive({
        
        dat <- read.csv(text=input$text3, sep="", na.strings=c("","NA","."))
                    
            dat[,1] <- factor(dat[,1])
            data.long <- melt(dat, idvars=dat[,1])
            q <- symmetry_test(data.long[,3] ~ factor(data.long[,2]) | factor(data.long[,1]), data=data.long, teststat="quad")
            
            CochranQChi <- paste("Cochran's Q chi-squared = ", round(q@statistic@teststatistic,3), ", ", "df = ", q@statistic@df, sep = "")
            cat(sprintf(CochranQChi), "\n")
            
            P.CochranQChi <- paste("p-value = ", pvalue(q), sep = "")
            cat(sprintf(P.CochranQChi), "\n", "\n")
            
            
            cat("Effect size for Cochran's Q test:", "\n")
            eta.squared.q <- q@statistic@teststatistic / (nrow(dat) * ((ncol(dat)-1)-1))
            ESQ <- paste("Eta-squared Q = ", round(eta.squared.q,3), sep = "")
            cat(sprintf(ESQ), "\n", "\n", "\n")
            
            cat("----------------------------------------", "\n", "Post-hoc test with McNemar's test:", "\n")
            pairMcNemar <- function(x) {
                p.val <- c()
                for (i in 1:length(x)) {
                    for (j in 1:length(x)) {
                        if (i >= j) {
                            next
                        } else {
                            
                            PairMcNemar <- table(x[,i], x[,j])
                            res1 <- mcnemar.test(PairMcNemar)
                            res2 <- mcnemar.exact(PairMcNemar)
                            p.val <- c(p.val, res2[[3]])
                            
                            cat("----------------------------------------", "\n")
                            cat("Comparison of", colnames(x)[i], "and", colnames(x)[j], ":", "\n",
                            "\n")
                            McNemarChi <- paste("McNemar's chi-squared = ", round(res1[[1]][[1]],3), ", ", "df = ", res1[[2]][[1]], sep = "")
                            cat(sprintf(McNemarChi), "\n")
                            
                            print(res2)
                            
                        }
                    }
                }
                padj <- c()
                padj <- p.adjust(p.val, "fdr")
                
                cat("----------------------------------------", "\n")
                cat("Adjusted p-value using false discovery rate [FDR]:", "\n", "\n")
                
                kochi<-c(); aite<-c()
                for(i in 1:length(x)){
                    for(j in 1:length(x)){
                        if (i >= j) {
                            next
                        } else {
                            kochi <- c(kochi, paste(colnames(x)[i], sep=""))
                            aite  <- c(aite,  paste(colnames(x)[j], sep=""))
                        }
                    }
                }
                
                a <- data.frame(Comparisons=paste(kochi, aite, sep=" & "), Adjusted.p.value=round(padj, 3))            
                print(a)
            }
            
            pairMcNemar(dat[,-1])
    
    })
    
    output$test3.out <- renderPrint({
        test3()
    })
    
    
    
    
    
    makepPlot3 <- function(){
        
        dat <- read.csv(text=input$text3, sep="", na.strings=c("","NA","."))
        
        dat[,1] <- factor(dat[,1])
        data.long <- melt(dat, idvars=dat[,1])
        x <- t(table(data.long$variable, data.long$value))
        n <- nrow(dat)
        prp <- round(((x/n)*100), 1)
        prp.rev <- apply(prp, 1, rev)
        
        par(mar=c(5,6,2,4))
        barplot(t(prp.rev), hor=1, las=1, xlab="Percentage")
        legend("bottomright", legend=rownames(x), fill=gray.colors(nrow(x)))
    }
    
    output$pPlot3 <- renderPlot({
        print(makepPlot3())
    })
    
    
    
    

    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()
    })






})

library(shiny)
library(shinyAce)



shinyUI(bootstrapPage(


    headerPanel("McNemar's Test and Cochran's Q 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 = "McNemar's Test (Tabulated data)",

        tabPanel("McNemar's Test (Raw data)",

            h2("McNemar's Test (Raw data)"),

            h4("Paired nominal data (2 × 2 contingency table)"),
            h4("[Within-subjects chi-squared test]"),

            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="Pretest\tPosttest\nPass\tPass\nPass\tPass\nPass\tPass\nPass\tPass\nPass\tPass\nPass\tPass\nPass\tFail\nFail\tPass\nFail\tPass\nFail\tPass\nFail\tPass\nFail\tPass\nFail\tPass\nFail\tPass\nFail\tPass\nFail\tFail\nFail\tFail\nFail\tFail\nFail\tFail\nFail\tFail", mode="r", theme="cobalt"),

            br(),

            h3("Contingency table"),
            verbatimTextOutput("data1.out"),

            br(),

            h3("Test result"),
            verbatimTextOutput("test1.out"),

            br(),

            h3("Plot"),

            plotOutput("pPlot1"),

            br(),

            plotOutput("mPlot1", height = "550px"),

            br(),
            br(),

            strong('R session info'),
            verbatimTextOutput("info1.out")
            ),









        tabPanel("McNemar's Test (Tabulated data)",

            h2("McNemar's Test (Tabulated data)"),

            h4("Paired nominal data (2 × 2 contingency table)"),
            h4("[Within-subjects chi-squared test]"),

            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="\tPost_Pass\tPost_Fail\nPre_Pass\t6\t1\nPre_Fail\t8\t5", mode="r", theme="cobalt"),

            br(),

            h3("Contingency table"),
            verbatimTextOutput("data2.out"),

            br(),

            h3("Test result"),
            verbatimTextOutput("test2.out"),

            br(),

            h3("Plot"),

            plotOutput("pPlot2"),

            br(),

            plotOutput("mPlot2", height = "550px"),

            br(),
            br(),

            strong('R session info'),
            verbatimTextOutput("info2.out")
            ),










        tabPanel("Cochran's Q Test (Raw data)",

            h2("Cochran's Q Test (Raw data)"),

            h4("Related samples (repeated measures) with nominal data"),

            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 and the person's IDs in the first column. Missing values should be indicated by a period (.) or NA.</div></b>")),

            aceEditor("text3", value="Participant\tPre\tPost\tDelayed\n1\t1\t0\t1\n2\t0\t0\t1\n3\t0\t1\t0\n4\t0\t1\t1\n5\t0\t0\t1\n6\t1\t1\t1\n7\t0\t0\t1\n8\t0\t1\t1\n9\t0\t1\t1\n10\t0\t1\t1",mode="r", theme="cobalt"),

            br(),

            h3("Contingency table"),
            verbatimTextOutput("data3.out"),

            br(),

            h3("Test result"),
            verbatimTextOutput("test3.out"),

            br(),

            h3("Plot"),

            plotOutput("pPlot3"),

            br(),
            br(),

            strong('R session info'),
            verbatimTextOutput("info3.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(exact2x2)'),br(),
            code('library(vcd)'),br(),
            code('library(reshape2)'),br(),
            code('library(coin)'),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/rep-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("rep-chi","mizumot")')
            ),

            p('I referred to',
            a("this website", href="http://oku.edu.mie-u.ac.jp/~okumura/stat/mcnemar.html", target="_blank"),
            'for some parts of the codes. I would like to thank the author.'),

            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())

)
)
)
))