inst/shiny-examples/ShinyItemAnalysis/ui/IRT.R

source("ui/IRT/DIRT.R")

IRT <- navbarMenu("IRT models",
                  "Dichotomous models",
                  # * RASCH ####
                  tabPanel("Rasch",
                           h3("Rasch model"),
                           p('Item Response Theory (IRT) models are mixed-effect regression models in which
                             respondent ability (theta) is assumed to be a random effect and is estimated together with item
                             paramters. Ability (theta) is often assumed to follow normal distibution.'),
                           p('In',
                             strong('Rasch model'), '(Rasch, 1960), all items are assumed to have the same slope in inflection point, i.e., the
                             same discrimination parameter', strong('a'), 'which is fixed to value of 1. Items may differ in location of their inflection point, i.e. they may differ in difficulty parameter',
                             strong('b.')),
                           h4("Equation"),
                           ('$$\\mathrm{P}\\left(Y_{ij} = 1\\vert \\theta_{i}, b_{j} \\right) =  \\frac{e^{\\left(\\theta_{i}-b_{j}\\right) }}{1+e^{\\left(\\theta_{i}-b_{j}\\right) }} $$'),
                           h4("Item characteristic curves"),
                           plotOutput('rasch_mirt'),
                           downloadButton("DP_rasch_mirt", label = "Download figure"),
                           h4("Item information curves"),
                           plotOutput('raschiic_mirt'),
                           downloadButton("DP_raschiic_mirt", label = "Download figure"),
                           h4("Test information function"),
                           plotOutput('raschtif_mirt'),
                           downloadButton("DP_raschtif_mirt", label = "Download figure"),
                           h4("Table of parameters with item fit statistics"),
                           p('Estimates of parameters are completed by SX2 item fit statistics (Ames & Penfield, 2015).
                             SX2 is computed only when no missing data are present. In such a case consider using imputed dataset!'),
                           tableOutput('raschcoef_mirt'),
                           h4('Scatter plot of factor scores and standardized total scores'),
                           textOutput('raschFactorCor_mirt'),
                           plotOutput('raschFactor_mirt'),
                           downloadButton("DP_raschFactor_mirt", label = "Download figure"),
                           h4('Wright map'),
                           p('Wright map (Wilson, 2005; Wright & Stone, 1979), also called item-person map, is a graphical tool
                             to display person ability estimates and item parameters. The person side
                             (left) represents histogram of estimated abilities of respondents.
                             The item side (right) displays estimates of difficulty parameters of individual items. '),
                           plotOutput('raschWrightMap_mirt'),
                           downloadButton('DP_raschWM_mirt', label = "Download figure"),
                           br(),
                           h4("Selected R code"),
                           div(code(HTML("library(difNLR)<br>library(mirt)&nbsp;<br>library(ShinyItemAnalysis)<br><br>#&nbsp;loading&nbsp;data<br>data(GMAT)&nbsp;<br>data&nbsp;<-&nbsp;GMAT[,&nbsp;1:20]&nbsp;<br><br>#&nbsp;fitting&nbsp;Rasch&nbsp;model<br>fit&nbsp;<-&nbsp;mirt(data,&nbsp;model&nbsp;=&nbsp;1,&nbsp;itemtype&nbsp;=&nbsp;'Rasch',&nbsp;SE&nbsp;=&nbsp;T)&nbsp;<br><br>#&nbsp;Item&nbsp;Characteristic&nbsp;Curves&nbsp;<br>plot(fit,&nbsp;type&nbsp;=&nbsp;'trace',&nbsp;facet_items&nbsp;=&nbsp;F)&nbsp;<br>#&nbsp;Item&nbsp;Information&nbsp;Curves&nbsp;<br>plot(fit,&nbsp;type&nbsp;=&nbsp;'infotrace',&nbsp;facet_items&nbsp;=&nbsp;F)&nbsp;<br>#&nbsp;Test&nbsp;Information&nbsp;Function&nbsp;<br>plot(fit,&nbsp;type&nbsp;=&nbsp;'infoSE')&nbsp;<br><br>#&nbsp;Coefficients&nbsp;<br>coef(fit,&nbsp;simplify&nbsp;=&nbsp;TRUE)&nbsp;<br>coef(fit,&nbsp;IRTpars&nbsp;=&nbsp;TRUE,&nbsp;simplify&nbsp;=&nbsp;TRUE)&nbsp;<br><br>#&nbsp;Item&nbsp;fit&nbsp;statistics&nbsp;<br>itemfit(fit)&nbsp;<br><br>#&nbsp;Factor&nbsp;scores&nbsp;vs&nbsp;Standardized&nbsp;total&nbsp;scores&nbsp;<br>fs&nbsp;<-&nbsp;as.vector(fscores(fit))&nbsp;<br>sts&nbsp;<-&nbsp;as.vector(scale(apply(data,&nbsp;1,&nbsp;sum)))&nbsp;<br>plot(fs&nbsp;~&nbsp;sts)&nbsp;<br><br>#&nbsp;Wright&nbsp;Map&nbsp;<br>b&nbsp;<-&nbsp;sapply(1:ncol(data),&nbsp;function(i)&nbsp;coef(fit)[[i]][,&nbsp;'d'])&nbsp;<br>ggWrightMap(fs,&nbsp;b)"))),
                           br()
                           ),
                  # * 1PL ####
                  tabPanel("1PL",
                           h3("One parameter Item Response Theory model"),
                           p('Item Response Theory (IRT) models are mixed-effect regression models in which
                             respondent ability (theta) is assumed to be a random effect and is estimated together with item
                             paramters. Ability (theta) is often assumed to follow normal distibution.'),
                           p('In', strong('1PL IRT model,'), 'all items are assumed to have the same slope in inflection point, i.e., the
                             same discrimination', strong('a.'), ' Items can differ in location of their inflection point, i.e., in item difficulty parameters',
                             strong('b.')),
                           h4("Equation"),
                           ('$$\\mathrm{P}\\left(Y_{ij} = 1\\vert \\theta_{i}, a, b_{j} \\right) =  \\frac{e^{a\\left(\\theta_{i}-b_{j}\\right) }}{1+e^{a\\left(\\theta_{i}-b_{j}\\right) }} $$'),
                           h4("Item characteristic curves"),
                           plotOutput('oneparamirt_mirt'),
                           downloadButton("DP_oneparamirt_mirt", label = "Download figure"),
                           h4("Item information curves"),
                           plotOutput('oneparamirtiic_mirt'),
                           downloadButton("DP_oneparamirtiic_mirt", label = "Download figure"),
                           h4("Test information function"),
                           plotOutput('oneparamirttif_mirt'),
                           downloadButton("DP_oneparamirttif_mirt", label = "Download figure"),
                           h4("Table of parameters with item fit statistics"),
                           p('Estimates of parameters are completed by SX2 item fit statistics
                             (Ames & Penfield, 2015). SX2 is computed only when no missing data are present.
                             In such a case consider using imputed dataset!'),
                           tableOutput('oneparamirtcoef_mirt'),
                           h4('Scatter plot of factor scores and standardized total scores'),
                           textOutput('oneparamirtFactorCor_mirt'),
                           plotOutput('oneparamirtFactor_mirt'),
                           downloadButton("DP_oneparamirtFactor_mirt", label = "Download figure"),
                           h4('Wright map'),
                           p('Wright map (Wilson, 2005; Wright & Stone, 1979), also called item-person map, is a graphical tool
                             to display person ability estimates and item parameters. The person side
                             (left) represents histogram of estimated abilities of respondents.
                             The item side (right) displays estimates of difficulty parameters of individual items. '),
                           plotOutput('oneparamirtWrightMap_mirt'),
                           downloadButton('DP_oneparamirtWM_mirt', label = "Download figure"),
                           br(),
                           h4("Selected R code"),
                           div(code(HTML("library(difNLR)<br>library(mirt)&nbsp;<br>library(ShinyItemAnalysis)<br><br>#&nbsp;loading&nbsp;data<br>data(GMAT)&nbsp;<br>data&nbsp;<-&nbsp;GMAT[,&nbsp;1:20]&nbsp;<br><br>#&nbsp;fitting&nbsp;1PL&nbsp;model<br>fit&nbsp;<-&nbsp;mirt(data,&nbsp;model&nbsp;=&nbsp;1,&nbsp;itemtype&nbsp;=&nbsp;'2PL',&nbsp;constrain&nbsp;=&nbsp;list((1:ncol(data))&nbsp;+&nbsp;seq(0,&nbsp;(ncol(data)&nbsp;-&nbsp;1)*3,&nbsp;3)),&nbsp;SE&nbsp;=&nbsp;T)&nbsp;<br><br>#&nbsp;Item&nbsp;Characteristic&nbsp;Curves&nbsp;<br>plot(fit,&nbsp;type&nbsp;=&nbsp;'trace',&nbsp;facet_items&nbsp;=&nbsp;F)&nbsp;<br>#&nbsp;Item&nbsp;Information&nbsp;Curves&nbsp;<br>plot(fit,&nbsp;type&nbsp;=&nbsp;'infotrace',&nbsp;facet_items&nbsp;=&nbsp;F)&nbsp;<br>#&nbsp;Test&nbsp;Information&nbsp;Function&nbsp;<br>plot(fit,&nbsp;type&nbsp;=&nbsp;'infoSE')&nbsp;<br><br>#&nbsp;Coefficients&nbsp;<br>coef(fit,&nbsp;simplify&nbsp;=&nbsp;TRUE)&nbsp;<br>coef(fit,&nbsp;IRTpars&nbsp;=&nbsp;TRUE,&nbsp;simplify&nbsp;=&nbsp;TRUE)&nbsp;<br><br>#&nbsp;Item&nbsp;fit&nbsp;statistics&nbsp;<br>itemfit(fit)&nbsp;<br><br>#&nbsp;Factor&nbsp;scores&nbsp;vs&nbsp;Standardized&nbsp;total&nbsp;scores&nbsp;<br>fs&nbsp;<-&nbsp;as.vector(fscores(fit))&nbsp;<br>sts&nbsp;<-&nbsp;as.vector(scale(apply(data,&nbsp;1,&nbsp;sum)))&nbsp;<br>plot(fs&nbsp;~&nbsp;sts)&nbsp;<br><br>#&nbsp;Wright&nbsp;Map&nbsp;<br>b&nbsp;<-&nbsp;sapply(1:ncol(data),&nbsp;function(i)&nbsp;coef(fit)[[i]][,&nbsp;'d'])&nbsp;<br>ggWrightMap(fs,&nbsp;b)<br><br><br><br>#&nbsp;You&nbsp;can&nbsp;also&nbsp;use&nbsp;ltm&nbsp;library&nbsp;for&nbsp;IRT&nbsp;models&nbsp;<br>#&nbsp;&nbsp;fitting&nbsp;1PL&nbsp;model<br>fit&nbsp;<-&nbsp;rasch(data)&nbsp;<br>#&nbsp;for&nbsp;Rasch&nbsp;model&nbsp;use&nbsp;<br>#&nbsp;fit&nbsp;<-&nbsp;rasch(data,&nbsp;constraint&nbsp;=&nbsp;cbind(ncol(data)&nbsp;+&nbsp;1,&nbsp;1))&nbsp;<br><br>#&nbsp;Item&nbsp;Characteristic&nbsp;Curves&nbsp;<br>plot(fit)&nbsp;<br>#&nbsp;Item&nbsp;Information&nbsp;Curves&nbsp;<br>plot(fit,&nbsp;type&nbsp;=&nbsp;'IIC')&nbsp;<br>#&nbsp;Test&nbsp;Information&nbsp;Function&nbsp;<br>plot(fit,&nbsp;items&nbsp;=&nbsp;0,&nbsp;type&nbsp;=&nbsp;'IIC')&nbsp;<br><br>#&nbsp;Coefficients&nbsp;<br>coef(fit)&nbsp;<br><br>#&nbsp;Factor&nbsp;scores&nbsp;vs&nbsp;Standardized&nbsp;total&nbsp;scores&nbsp;<br>df1&nbsp;<-&nbsp;ltm::factor.scores(fit,&nbsp;return.MIvalues&nbsp;=&nbsp;T)$score.dat&nbsp;<br>FS&nbsp;<-&nbsp;as.vector(df1[,&nbsp;'z1'])&nbsp;<br>df2&nbsp;<-&nbsp;df1&nbsp;<br>df2$Obs&nbsp;<-&nbsp;df2$Exp&nbsp;<-&nbsp;df2$z1&nbsp;<-&nbsp;df2$se.z1&nbsp;<-&nbsp;NULL&nbsp;<br>STS&nbsp;<-&nbsp;as.vector(scale(apply(df2,&nbsp;1,&nbsp;sum)))&nbsp;<br>df&nbsp;<-&nbsp;data.frame(FS,&nbsp;STS)&nbsp;<br>plot(FS&nbsp;~&nbsp;STS,&nbsp;data&nbsp;=&nbsp;df,&nbsp;xlab&nbsp;=&nbsp;'Standardized&nbsp;total&nbsp;score',&nbsp;ylab&nbsp;=&nbsp;'Factor&nbsp;score')"))),
                           br()
                           ),
                  # * 2PL ####
                  tabPanel("2PL ",
                           h3("Two parameter Item Response Theory model"),
                           p('Item Response Theory (IRT) models are mixed-effect regression models in which
                             respondent ability (theta) is assumed to be a random effect and is estimated together with item
                             paramters. Ability (theta) is often assumed to follow normal distibution.'),
                           p(strong('2PL IRT model'), ' allows for different slopes in inflection point, i.e., different
                             discrimination parameters', strong('a.'), 'Items can also differ in location of their inflection point, i.e., in item difficulty parameters',
                             strong('b.')),
                           h4("Equation"),
                           ('$$\\mathrm{P}\\left(Y_{ij} = 1\\vert \\theta_{i}, a_{j}, b_{j}\\right) =  \\frac{e^{a_{j}\\left(\\theta_{i}-b_{j}\\right) }}{1+e^{a_{j}\\left(\\theta_{i}-b_{j}\\right) }} $$'),
                           h4("Item characteristic curves"),
                           plotOutput('twoparamirt_mirt'),
                           downloadButton("DP_twoparamirt_mirt", label = "Download figure"),
                           h4("Item information curves"),
                           plotOutput('twoparamirtiic_mirt'),
                           downloadButton("DP_twoparamirtiic_mirt", label = "Download figure"),
                           h4("Test information function"),
                           plotOutput('twoparamirttif_mirt'),
                           downloadButton("DP_twoparamirttif_mirt", label = "Download figure"),
                           h4("Table of parameters with item fit statistics"),
                           p('Estimates of parameters are completed by SX2 item fit statistics (Ames & Penfield, 2015).
                             SX2 is computed only when no missing data are present. In such a case consider using imputed dataset!'),
                           tableOutput('twoparamirtcoef_mirt'),
                           h4('Scatter plot of factor scores and standardized total scores'),
                           textOutput('twoparamirtFactorCor_mirt'),
                           plotOutput('twoparamirtFactor_mirt'),
                           downloadButton("DP_twoparamirtFactor_mirt", label = "Download figure"),
                           br(),
                           h4("Selected R code"),
                           div(code('library(difNLR)'),
                               br(),
                               code('library(mirt)'),
                               br(),
                               code('data(GMAT)'),
                               br(),
                               code('data <- GMAT[, 1:20]'),
                               br(),
                               br(),
                               code('# Model'),
                               br(),
                               code('fit <- mirt(data, model = 1, itemtype = "2PL", SE = T)'),
                               br(),
                               code('# Item Characteristic Curves'),
                               br(),
                               code('plot(fit, type = "trace", facet_items = F)'),
                               br(),
                               code('# Item Information Curves'),
                               br(),
                               code('plot(fit, type = "infotrace", facet_items = F)'),
                               br(),
                               code('# Test Information Function'),
                               br(),
                               code('plot(fit, type = "infoSE")'),
                               br(),
                               code('# Coefficients'),
                               br(),
                               code('coef(fit, simplify = TRUE)'),
                               br(),
                               code('coef(fit, IRTpars = TRUE, simplify = TRUE)'),
                               br(),
                               code('# Item fit statistics'),
                               br(),
                               code('itemfit(fit)'),
                               br(),
                               code('# Factor scores vs Standardized total scores'),
                               br(),
                               code('fs <- as.vector(fscores(fit))'),
                               br(),
                               code('sts <- as.vector(scale(apply(data, 1, sum)))'),
                               br(),
                               code('plot(fs ~ sts)'),
                               br(),
                               br(),
                               br(),
                               code('# You can also use ltm library for IRT models'),
                               br(),
                               code('library(difNLR)'),
                               br(),
                               code('library(ltm)'),
                               br(),
                               code('data(GMAT)'),
                               br(),
                               code('data <- GMAT[, 1:20]'),
                               br(),
                               br(),
                               code('# Model'),
                               br(),
                               code('fit <- ltm(data ~ z1, IRT.param = TRUE)'),
                               br(),
                               code('# Item Characteristic Curves'),
                               br(),
                               code('plot(fit)'),
                               br(),
                               code('# Item Information Curves'),
                               br(),
                               code('plot(fit, type = "IIC")'),
                               br(),
                               code('# Test Information Function'),
                               br(),
                               code('plot(fit, items = 0, type = "IIC")'),
                               br(),
                               code('# Coefficients'),
                               br(),
                               code('coef(fit)'),
                               br(),
                               code('# Factor scores vs Standardized total scores'),
                               br(),
                               code('df1  <- ltm::factor.scores(fit, return.MIvalues = T)$score.dat'),
                               br(),
                               code('FS   <- as.vector(df1[, "z1"])'),
                               br(),
                               code('df2  <- df1'),
                               br(),
                               code('df2$Obs <- df2$Exp <- df2$z1 <- df2$se.z1 <- NULL'),
                               br(),
                               code('STS <- as.vector(scale(apply(df2, 1, sum)))'),
                               br(),
                               code('df  <- data.frame(FS, STS)'),
                               br(),
                               code('plot(FS ~ STS, data = df,
                                    xlab = "Standardized total score",
                                    ylab = "Factor score")')),
                           br()
                           ),
                  # * 3PL ####
                  tabPanel("3PL ",
                           h3("Three parameter Item Response Theory model"),
                           p('Item Response Theory (IRT) models are mixed-effect regression models in which
                             respondent ability (theta) is assumed to be a random effect and is estimated together with item
                             paramters. Ability (theta) is often assumed to follow normal distibution.'),
                           p(strong('3PL IRT model'), ' allows for different discriminations of items', strong('a,'),
                             'different item difficulties',
                             strong('b,'), 'and allows also for nonzero left asymptote, pseudo-guessing', strong('c.')),
                           h4("Equation"),
                           ('$$\\mathrm{P}\\left(Y_{ij} = 1\\vert \\theta_{i}, a_{j}, b_{j}, c_{j} \\right) = c_{j} + \\left(1 - c_{j}\\right) \\cdot \\frac{e^{a_{j}\\left(\\theta_{i}-b_{j}\\right) }}{1+e^{a_{j}\\left(\\theta_{i}-b_{j}\\right) }} $$'),
                           uiOutput("irt_3PL_model_converged"),
                           h4("Item characteristic curves"),
                           plotOutput('threeparamirt_mirt'),
                           downloadButton("DP_threeparamirt_mirt", label = "Download figure"),
                           h4("Item information curves"),
                           plotOutput('threeparamirtiic_mirt'),
                           downloadButton("DP_threeparamirtiic_mirt", label = "Download figure"),
                           h4("Test information function"),
                           plotOutput('threeparamirttif_mirt'),
                           downloadButton("DP_threeparamirttif_mirt", label = "Download figure"),
                           h4("Table of parameters with item fit statistics"),
                           p('Estimates of parameters are completed by SX2 item fit statistics (Ames & Penfield, 2015).
                             SX2 is computed only when no missing data are present. In such a case consider using imputed dataset!'),
                           tableOutput('threeparamirtcoef_mirt'),
                           h4('Scatter plot of factor scores and standardized total scores'),
                           textOutput('threeparamirtFactorCor_mirt'),
                           plotOutput('threeparamirtFactor_mirt'),
                           downloadButton("DP_threeparamirtFactor_mirt", label = "Download figure"),
                           br(),
                           h4("Selected R code"),
                           div(code('library(difNLR)'),
                               br(),
                               code('library(mirt)'),
                               br(),
                               code('data(GMAT)'),
                               br(),
                               code('data <- GMAT[, 1:20]'),
                               br(),
                               br(),
                               code('# Model'),
                               br(),
                               code('fit <- mirt(data, model = 1, itemtype = "3PL", SE = T)'),
                               br(),
                               code('# Item Characteristic Curves'),
                               br(),
                               code('plot(fit, type = "trace", facet_items = F)'),
                               br(),
                               code('# Item Information Curves'),
                               br(),
                               code('plot(fit, type = "infotrace", facet_items = F)'),
                               br(),
                               code('# Test Information Function'),
                               br(),
                               code('plot(fit, type = "infoSE")'),
                               br(),
                               code('# Coefficients'),
                               br(),
                               code('coef(fit, simplify = TRUE)'),
                               br(),
                               code('coef(fit, IRTpars = TRUE, simplify = TRUE)'),
                               br(),
                               code('# Item fit statistics'),
                               br(),
                               code('itemfit(fit)'),
                               br(),
                               code('# Factor scores vs Standardized total scores'),
                               br(),
                               code('fs <- as.vector(fscores(fit))'),
                               br(),
                               code('sts <- as.vector(scale(apply(data, 1, sum)))'),
                               br(),
                               code('plot(fs ~ sts)'),
                               br(),
                               code('# You can also use ltm library for IRT models'),
                               br(),
                               br(),
                               br(),
                               code('library(difNLR)'),
                               br(),
                               code('library(ltm)'),
                               br(),
                               code('data(GMAT)'),
                               br(),
                               code('data <- GMAT[, 1:20]'),
                               br(),
                               br(),
                               code('# Model'),
                               br(),
                               code('fit <- tpm(data, IRT.param = TRUE)'),
                               br(),
                               code('# Item Characteristic Curves'),
                               br(),
                               code('plot(fit)'),
                               br(),
                               code('# Item Information Curves'),
                               br(),
                               code('plot(fit, type = "IIC")'),
                               br(),
                               code('# Test Information Function'),
                               br(),
                               code('plot(fit, items = 0, type = "IIC")'),
                               br(),
                               code('# Coefficients'),
                               br(),
                               code('coef(fit)'),
                               br(),
                               code('# Factor scores vs Standardized total scores'),
                               br(),
                               code('df1  <- ltm::factor.scores(fit, return.MIvalues = T)$score.dat'),
                               br(),
                               code('FS   <- as.vector(df1[, "z1"])'),
                               br(),
                               code('df2  <- df1'),
                               br(),
                               code('df2$Obs <- df2$Exp <- df2$z1 <- df2$se.z1 <- NULL'),
                               br(),
                               code('STS <- as.vector(scale(apply(df2, 1, sum)))'),
                               br(),
                               code('df  <- data.frame(FS, STS)'),
                               br(),
                               code('plot(FS ~ STS, data = df,
                                    xlab = "Standardized total score",
                                    ylab = "Factor score")')),
                           br()),
                  # * 4PL ####
                  tabPanel("4PL ",
                           h3("Four parameter Item Response Theory model"),
                           p('Item Response Theory (IRT) models are mixed-effect regression models in which
                             respondent ability (theta) is assumed to be a random effect and is estimated together with item
                             paramters. Ability (theta) is often assumed to follow normal distibution.'),
                           p(strong('4PL IRT model'), ' allows for different discriminations of items', strong('a,'),
                             'different item difficulties', strong('b,'), 'nonzero left asymptote, i.e. pseudo-guessing parameter', strong('c,'),
                             'and also for upper asymptote lower than one, i.e, inattention parameter', strong('d.')),
                           h4("Equation"),
                           ('$$\\mathrm{P}\\left(Y_{ij} = 1\\vert \\theta_{i}, a_{j}, b_{j}, c_{j}, d_{j} \\right) = c_{j} + \\left(d_{j} - c_{j}\\right) \\cdot \\frac{e^{a_{j}\\left(\\theta_{i}-b_{j}\\right) }}{1+e^{a_{j}\\left(\\theta_{i}-b_{j}\\right) }} $$'),
                           uiOutput("irt_4PL_model_converged"),
                           h4("Item characteristic curves"),
                           plotOutput('irt_4PL_icc'),
                           downloadButton("DB_irt_4PL_icc", label = "Download figure"),
                           h4("Item information curves"),
                           plotOutput('irt_4PL_iic'),
                           downloadButton("DB_irt_4PL_iic", label = "Download figure"),
                           h4("Test information function"),
                           plotOutput('irt_4PL_tif'),
                           downloadButton("DB_irt_4PL_tif", label = "Download figure"),
                           h4("Table of parameters with item fit statistics"),
                           p('Estimates of parameters are completed by SX2 item fit statistics (Ames & Penfield, 2015).
                             SX2 is computed only when no missing data are present. In such a case consider using imputed dataset!'),
                           tableOutput('irt_4PL_coef'),
                           h4('Scatter plot of factor scores and standardized total scores'),
                           textOutput('irt_4PL_factorscores_correlation'),
                           plotOutput('irt_4PL_factorscores_plot'),
                           downloadButton("DB_irt_4PL_factorscores_plot", label = "Download figure"),
                           br(),
                           h4("Selected R code"),
                           div(code('library(difNLR)'),
                               br(),
                               code('library(mirt)'),
                               br(),
                               code('data(GMAT)'),
                               br(),
                               code('data <- GMAT[, 1:20]'),
                               br(),
                               br(),
                               code('# Model'),
                               br(),
                               code('fit <- mirt(data, model = 1, itemtype = "4PL", SE = T)'),
                               br(),
                               code('# Item Characteristic Curves'),
                               br(),
                               code('plot(fit, type = "trace", facet_items = F)'),
                               br(),
                               code('# Item Information Curves'),
                               br(),
                               code('plot(fit, type = "infotrace", facet_items = F)'),
                               br(),
                               code('# Test Information Function'),
                               br(),
                               code('plot(fit, type = "infoSE")'),
                               br(),
                               code('# Coefficients'),
                               br(),
                               code('coef(fit, simplify = TRUE)'),
                               br(),
                               code('coef(fit, IRTpars = TRUE, simplify = TRUE)'),
                               br(),
                               code('# Item fit statistics'),
                               br(),
                               code('itemfit(fit)'),
                               br(),
                               code('# Factor scores vs Standardized total scores'),
                               br(),
                               code('fs <- as.vector(fscores(fit))'),
                               br(),
                               code('sts <- as.vector(scale(apply(data, 1, sum)))'),
                               br(),
                               code('plot(fs ~ sts)')),
                           br()),
                  # * MODEL COMPARISON ####
                  tabPanel("Model comparison ",
                           h3("Item Response Theory model selection"),
                           p('Item Response Theory (IRT) models are mixed-effect regression models in which
                             respondent ability (theta) is assumed to be a random effect and is estimated together with item
                             paramters. Ability (theta) is often assumed to follow normal distibution.'),
                           p('IRT models can be compared by several information criteria: '),
                           tags$ul(
                             tags$li(strong('AIC'), 'is the Akaike information criterion (Akaike, 1974), '),
                             tags$li(strong('AICc'), 'is AIC with a correction for finite sample size, '),
                             tags$li(strong('BIC'), 'is the Bayesian information criterion (Schwarz, 1978).'),
                             tags$li(strong('SABIC'), 'is the Sample-sized adjusted BIC criterion, ')
                           ),
                           p('Another approach to compare IRT models can be likelihood ratio chi-squared test.
                             Significance level is set to 0.05.'),
                           h4("Table of comparison statistics"),
                           p('Row ', strong('BEST'), 'indicates which model has the lowest value of criterion, or is the largest
                             significant model by likelihood ratio test.'),
                           tableOutput('irtcomparison'),
                           tags$style(type = "text/css", "#irtcomparison tr:last-child {font-weight:bold;}"),
                           br(),
                           h4("Selected R code"),
                             div(code(HTML("library(difNLR)&nbsp;<br>library(mirt)<br><br>#&nbsp;loading&nbsp;data<br>data(GMAT)&nbsp;<br>data&nbsp;<-&nbsp;GMAT[,&nbsp;1:20]&nbsp;<br><br>#&nbsp;1PL&nbsp;IRT&nbsp;model&nbsp;<br>s&nbsp;<-&nbsp;paste(\"F&nbsp;=&nbsp;1-\",&nbsp;ncol(data),&nbsp;\"\\n\",<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\"CONSTRAIN&nbsp;=&nbsp;(1-\",&nbsp;ncol(data),&nbsp;\",&nbsp;a1)\")<br>model&nbsp;<-&nbsp;mirt.model(s)<br>fit1PL&nbsp;<-&nbsp;mirt(data,&nbsp;model&nbsp;=&nbsp;model,&nbsp;itemtype&nbsp;=&nbsp;\"2PL\")<br>#&nbsp;2PL&nbsp;IRT&nbsp;model&nbsp;<br>fit2PL&nbsp;<-&nbsp;mirt(data,&nbsp;model&nbsp;=&nbsp;1,&nbsp;itemtype&nbsp;=&nbsp;\"2PL\")&nbsp;<br>#&nbsp;3PL&nbsp;IRT&nbsp;model&nbsp;<br>fit3PL&nbsp;<-&nbsp;mirt(data,&nbsp;model&nbsp;=&nbsp;1,&nbsp;itemtype&nbsp;=&nbsp;\"3PL\")&nbsp;<br>#&nbsp;4PL&nbsp;IRT&nbsp;model&nbsp;<br>fit4PL&nbsp;<-&nbsp;mirt(data,&nbsp;model&nbsp;=&nbsp;1,&nbsp;itemtype&nbsp;=&nbsp;\"4PL\")&nbsp;<br><br>#&nbsp;comparison&nbsp;<br>anova(fit1PL,&nbsp;fit2PL)&nbsp;<br>anova(fit2PL,&nbsp;fit3PL)&nbsp;<br>anova(fit3PL,&nbsp;fit4PL)"))),
                           br()
                           ),
                  "----",
                  "Polytomous models",
                  # * BOCK'S NOMINAL MODEL ####
                  tabPanel("Bock's nominal model",
                           h3("Bock's nominal Item Response Theory model"),
                           p('The nominal response model (NRM) was introduced by Bock (1972) as a way to model
                             responses to items with two or more nominal categories. This model is suitable for
                             multiple-choice items with no particular ordering of distractors.
                             It is also generalization of some models for ordinal data, e.g. generalized  partial credit model (GPCM)
                             or its restricted versions partial credit model (PCM) and rating scale model (RSM).'),
                           h4('Equation'),
                           withMathJax('For ', strong('K'), ' possible test choices is the probability of the choice ', strong('k'), ' for
                                       person ', strong('i'), ' with latent trait', strong('\\(\\theta\\)'), ' in item ', strong('j'),
                                       'given by the following equation: '),
                           ('$$\\mathrm{P}(Y_{ij} = k|\\theta_i, a_{j1}, al_{j(l-1)}, d_{j(l-1)}, l = 1, \\dots, K) =
                            \\frac{e^{(ak_{j(k-1)} * a_{j1} * \\theta_i + d_{j(k-1)})}}{\\sum_l e^{(al_{j(l-1)} * a_{j1} * \\theta_i + d_{j(l-1)})}}$$'),
                           br(),
                           h4("Item characteristic curves"),
                           plotOutput('bock_CC'),
                           downloadButton("DP_bock_CC", label = "Download figure"),
                           h4("Item information curves"),
                           plotOutput('bock_IIC'),
                           downloadButton("DP_bock_IIC", label = "Download figure"),
                           h4("Test information function"),
                           plotOutput('bock_TIF'),
                           downloadButton("DP_bock_TIF", label = "Download figure"),
                           h4("Table of parameters"),
                           textOutput("bock_coef_warning"),
                           tableOutput('bock_coef'),
                           h4('Scatter plot of factor scores and standardized total scores'),
                           textOutput('bockFactorCorInput_mirt'),
                           plotOutput('bock_factor'),
                           downloadButton("DP_bock_factor", label = "Download figure"),
                           br(),
                           h4("Selected R code"),
                           div(code('library(difNLR)'),
                               br(),
                               code('library(mirt)'),
                               br(),
                               code('data(GMAT)'),
                               br(),
                               code('data <- GMAT[, 1:20]'),
                               br(),
                               br(),
                               code('# Model'),
                               br(),
                               code('fit <- mirt(data, model = 1, itemtype = "nominal")'),
                               br(),
                               code('# Item Characteristic Curves'),
                               br(),
                               code('plot(fit, type = "trace", facet_items = F)'),
                               br(),
                               code('# Item Information Curves'),
                               br(),
                               code('plot(fit, type = "infotrace", facet_items = F)'),
                               br(),
                               code('# Test Information Function'),
                               br(),
                               code('plot(fit, type = "infoSE")'),
                               br(),
                               code('# Coefficients'),
                               br(),
                               code('coef(fit, simplify = TRUE)'),
                               br(),
                               code('coef(fit, IRTpars = TRUE, simplify = TRUE)'),
                               br(),
                               code('# Factor scores vs Standardized total scores'),
                               br(),
                               code('fs <- as.vector(fscores(fit))'),
                               br(),
                               code('sts <- as.vector(scale(apply(data, 1, sum)))'),
                               br(),
                               code('plot(fs ~ sts)')),
                           br()
                           ),
                  "----",
                  "Training",
                  # * TRAINING  ####
                  # ** Dichotomous models ####
                  DIRT,
                  # ** Polytomous models ####
                  tabPanel("Polytomous models",
                           tabsetPanel(
                             # *** Intro ####
                             tabPanel('Intro',
                                      h3("Polytomous models"),
                                      p('Polytomous models are used when partial score is possible, or when items are graded
                                        on Likert scale (e.g. from Totally disagree to Totally agree); some polytomous
                                        models can also be used when analyzing multiple-choice items.  In this section you
                                        can explore item response functions of some polytomous models.'),
                                      br(),
                                      p('Two main classes of polytomous IRT models are considered:'),
                                      p(strong('Difference models'), 'are defined by setting mathematical form to cumulative
                                        probabilities, while category probabilities are calculated as their difference.
                                        These models are also sometimes called', strong('cumulative logit models'), 'as they
                                        set linear form to cumulative logits.'),
                                      p('As an example, ', strong('Graded Response Model'), '(GRM; Samejima, 1970) uses 2PL
                                        IRT model to describe cumulative probabilities (probabilities to obtain score higher
                                        than 1, 2, 3, etc.). Category probabilities are then described as differences of two
                                        subsequent cumulative probabilities. '), br(),
                                      p('For', strong('divide-by-total models'), 'response category probabilities are defined
                                        as the ratio between category-related functions and their sum. '),
                                      p('In', strong('Generalized Partial Credit Model'), '(GPCM; Muraki, 1992), probability
                                        of the successful transition from one category score to the next category score is
                                        modelled by 2PL IRT model, while ', strong('Partial Credit Model'), '(PCM; Masters, 1982)
                                        uses 1PL IRT model to describe this probability. Even more restricted version, the',
                                        strong('Rating Scale Model'), '(RSM; Andrich, 1978) assumes exactly the same K response
                                        categories for each item and threshold parameters which can be split into a response-threshold
                                        parameter and an item-specific location parameter. These models are also sometimes called
                                        ', strong('adjacent-category logit models'), 'as they set linear form to adjacent logits.'),
                                      p('To model distractor properties in multiple-choice items,', strong('Nominal Response Model'),
                                        '(NRM; Bock, 1972) can be used. NRM is an IRT analogy of multinomial regression model. This
                                        model is also generalization of GPCM/PCM/RSM ordinal models. NRM is also sometimes called
                                        ', strong('baseline-category logit model'), 'as it sets linear form to log of odds of selecting given category
                                        to selecting a baseline category. Baseline can be chosen arbitrary, although usually the correct
                                        answer or the first answer is chosen.')
                                      ),
                             # *** Graded response model ####
                             tabPanel('Graded response model',
                                      h3("Graded response model"),
                                      p("Graded response model (GRM; Samejima, 1970) uses 2PL IRT model to describe cumulative probabilities
                                        (probabilities to obtain score higher than 1, 2, 3, etc.). Category probabilities are then described
                                        as differences of two subsequent cumulative probabilities. "),
                                      p("It belongs to class of difference models, which are defined by setting mathematical form to cumulative
                                        probabilities, while category probabilities are calculated as their difference. These models are also
                                        sometimes called cumulative logit models, as they set linear form to cumulative logits."),
                                      h4("Parameters"),
                                      p("Select number of responses and difficulty for cummulative probabilities", strong("b"), "and common
                                        discrimination parameter", strong("a"), ". Cummulative probability \\(P(Y \\geq 0)\\) is always equal to 1
                                        and it is not displayed, corresponding category probability \\(P(Y = 0)\\) is displayed with black color."),
                                      div(style = "display: inline-block; vertical-align: middle; width: 18%;",
                                          numericInput(inputId = "irt_training_grm_numresp",
                                                       label = "Highest score",
                                                       value = 4,
                                                       min = 2,
                                                       max = 6)),
                                      br(),
                                      div(style = "display: inline-block; vertical-align: middle; width: 18%;",
                                          sliderInput(inputId = "irt_training_grm_a",
                                                      label = "a - discrimination",
                                                      value = 1,
                                                      min = 0,
                                                      max = 4,
                                                      step = 0.01)),
                                      br(),
                                      uiOutput("irt_training_grm_sliders"),
                                      br(),
                                      h4("Equations"),
                                      ('$$\\pi_k* = \\mathrm{P}\\left(Y \\geq k \\vert \\theta, a, b_k\\right) = \\frac{e^{a\\left(\\theta-b\\right) }}{1+e^{a\\left(\\theta-b\\right) }} $$'),
                                      ('$$\\pi_k =\\mathrm{P}\\left(Y = k \\vert \\theta, a, b_k, b_{k+1}\\right) = \\pi_k* - \\pi_{k+1}* $$'),
                                      ('$$\\mathrm{E}\\left(Y \\vert \\theta, a, b_1, \\dots, b_K\\right) = \\sum_{k = 0}^K k\\pi_k$$'),
                                      h4("Plots"),
                                      splitLayout(cellWidths = c("33%", "33%", "33%"),
                                                  plotlyOutput('irt_training_grm_plot_cummulative'),
                                                  plotlyOutput('irt_training_grm_plot_category'),
                                                  plotlyOutput('irt_training_grm_plot_expected')),
                                      splitLayout(cellWidths = c("33%", "33%", "33%"),
                                                  downloadButton("DB_irt_training_grm_plot_cummulative", label = "Download figure"),
                                                  downloadButton("DB_irt_training_grm_plot_category", label = "Download figure"),
                                                  downloadButton("DB_irt_training_grm_plot_expected", label = "Download figure")),
                                      h4("Selected R code"),
                                      div(code(HTML("library(ggplot2)&nbsp;<br>library(data.table)&nbsp;<br><br>#&nbsp;setting&nbsp;parameters&nbsp;<br>a&nbsp;<-&nbsp;1&nbsp;<br>b&nbsp;<-&nbsp;c(-1.5,&nbsp;-1,&nbsp;-0.5,&nbsp;0)&nbsp;<br>theta&nbsp;<-&nbsp;seq(-4,&nbsp;4,&nbsp;0.01)&nbsp;<br><br>#&nbsp;calculating&nbsp;cummulative&nbsp;probabilities&nbsp;<br>ccirt&nbsp;<-&nbsp;function(theta,&nbsp;a,&nbsp;b){&nbsp;return(1/(1&nbsp;+&nbsp;exp(-a*(theta&nbsp;-&nbsp;b))))&nbsp;}&nbsp;<br>df1&nbsp;<-&nbsp;data.frame(sapply(1:length(b),&nbsp;function(i)&nbsp;ccirt(theta,&nbsp;a,&nbsp;b[i]))&nbsp;,&nbsp;theta)<br>df1&nbsp;<-&nbsp;melt(df1,&nbsp;id.vars&nbsp;=&nbsp;\"theta\")&nbsp;<br><br>#&nbsp;plotting&nbsp;cummulative&nbsp;probabilities&nbsp;<br>ggplot(data&nbsp;=&nbsp;df1,&nbsp;aes(x&nbsp;=&nbsp;theta,&nbsp;y&nbsp;=&nbsp;value,&nbsp;col&nbsp;=&nbsp;variable))&nbsp;+&nbsp;<br>&nbsp;&nbsp;geom_line()&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlab(\"Ability\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylab(\"Cummulative&nbsp;probability\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlim(-4,&nbsp;4)&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylim(0,&nbsp;1)&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme_bw()&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme(text&nbsp;=&nbsp;element_text(size&nbsp;=&nbsp;14),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.major&nbsp;=&nbsp;element_blank(),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.minor&nbsp;=&nbsp;element_blank())&nbsp;+&nbsp;<br>&nbsp;&nbsp;ggtitle(\"Cummulative&nbsp;probabilities\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;scale_color_manual(\"\",&nbsp;values&nbsp;=&nbsp;c(\"red\",&nbsp;\"yellow\",&nbsp;\"green\",&nbsp;\"blue\"),&nbsp;labels&nbsp;=&nbsp;paste0(\"P(Y&nbsp;>=&nbsp;\",&nbsp;1:4,&nbsp;\")\"))&nbsp;<br><br>#&nbsp;calculating&nbsp;category&nbsp;probabilities&nbsp;<br>df2&nbsp;<-&nbsp;data.frame(1,&nbsp;sapply(1:length(b),&nbsp;function(i)&nbsp;ccirt(theta,&nbsp;a,&nbsp;b[i])))&nbsp;<br>df2&nbsp;<-&nbsp;data.frame(sapply(1:length(b),&nbsp;function(i)&nbsp;df2[,&nbsp;i]&nbsp;-&nbsp;df2[,&nbsp;i+1]),&nbsp;df2[,&nbsp;ncol(df2)],&nbsp;theta)&nbsp;<br>df2&nbsp;<-&nbsp;melt(df2,&nbsp;id.vars&nbsp;=&nbsp;\"theta\")&nbsp;<br><br>#&nbsp;plotting&nbsp;category&nbsp;probabilities&nbsp;<br>ggplot(data&nbsp;=&nbsp;df2,&nbsp;aes(x&nbsp;=&nbsp;theta,&nbsp;y&nbsp;=&nbsp;value,&nbsp;col&nbsp;=&nbsp;variable))&nbsp;+&nbsp;<br>&nbsp;&nbsp;geom_line()&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlab(\"Ability\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylab(\"Category&nbsp;probability\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlim(-4,&nbsp;4)&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylim(0,&nbsp;1)&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme_bw()&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme(text&nbsp;=&nbsp;element_text(size&nbsp;=&nbsp;14),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.major&nbsp;=&nbsp;element_blank(),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.minor&nbsp;=&nbsp;element_blank())&nbsp;+&nbsp;<br>&nbsp;&nbsp;ggtitle(\"Category&nbsp;probabilities\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;scale_color_manual(\"\",&nbsp;values&nbsp;=&nbsp;c(\"black\",&nbsp;\"red\",&nbsp;\"yellow\",&nbsp;\"green\",&nbsp;\"blue\"),&nbsp;labels&nbsp;=&nbsp;paste0(\"P(Y&nbsp;>=&nbsp;\",&nbsp;0:4,&nbsp;\")\"))<br><br>#&nbsp;calculating&nbsp;expected&nbsp;item&nbsp;score<br>df3&nbsp;<-&nbsp;data.frame(1,&nbsp;sapply(1:length(b),&nbsp;function(i)&nbsp;ccirt(theta,&nbsp;a,&nbsp;b[i])))&nbsp;<br>df3&nbsp;<-&nbsp;data.frame(sapply(1:length(b),&nbsp;function(i)&nbsp;df3[,&nbsp;i]&nbsp;-&nbsp;df3[,&nbsp;i+1]),&nbsp;df3[,&nbsp;ncol(df3)])<br>df3&nbsp;<-&nbsp;data.frame(exp&nbsp;=&nbsp;as.matrix(df3)&nbsp;%*%&nbsp;0:4,&nbsp;theta)<br><br>#&nbsp;plotting&nbsp;category&nbsp;probabilities&nbsp;<br>ggplot(data&nbsp;=&nbsp;df3,&nbsp;aes(x&nbsp;=&nbsp;theta,&nbsp;y&nbsp;=&nbsp;exp))&nbsp;+&nbsp;<br>&nbsp;&nbsp;geom_line()&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlab(\"Ability\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylab(\"Expected&nbsp;item&nbsp;score\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlim(-4,&nbsp;4)&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylim(0,&nbsp;4)&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme_bw()&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme(text&nbsp;=&nbsp;element_text(size&nbsp;=&nbsp;14),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.major&nbsp;=&nbsp;element_blank(),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.minor&nbsp;=&nbsp;element_blank())&nbsp;+&nbsp;<br>&nbsp;&nbsp;ggtitle(\"Expected&nbsp;item&nbsp;score\")"))),
                                      br(),
                                      br()
                                      ),
                             # *** Generalized partial credit model ####
                             tabPanel('Generalized partial credit model',
                                      h3("Generalized partial credit model"),
                                      p("In Generalized Partial Credit Model (GPCM; Muraki, 1992), probability of the successful transition
                                        from one category score to the next category score is modelled by 2PL IRT model. The response category
                                        probabilities are then ratios between category-related functions (cumulative sums of exponentials)
                                        and their sum."),
                                      p("Two simpler models can be derived from GPCM by restricting some parameters: Partial Credit Model
                                        (PCM; Masters, 1982) uses 1PL IRT model to describe this probability, thus parameters a = 1.
                                        Even more restricted version, the Rating Scale Model (RSM; Andrich, 1978) assumes exactly the same
                                        K response categories for each item and threshold parameters which can be split into a response-threshold
                                        parameter \\(\\lambda_t\\) and an item-specific location parameter \\(\\delta_i\\). These models are
                                        also sometimes called adjacent logit models, as they set linear form to adjacent logits."),
                                      h4("Parameters"),
                                      p("Select number of responses and their threshold parameters ", strong("d"), "and common
                                        discrimination parameter", strong("a"), ". With a = 1 you get PCM. Numerator of \\(\\pi_0 = P(Y = 0)\\) is
                                        set to 1 and \\(\\pi_0\\) is displayed with black color."),
                                      div(style = "display: inline-block; vertical-align: middle; width: 18%;",
                                          numericInput(inputId = "irt_training_gpcm_numresp",
                                                       label = "Highest score",
                                                       value = 4,
                                                       min = 2,
                                                       max = 6)),
                                      br(),
                                      div(style = "display: inline-block; vertical-align: middle; width: 18%;",
                                          sliderInput(inputId = "irt_training_gpcm_a",
                                                      label = "a - discrimination",
                                                      value = 1,
                                                      min = 0,
                                                      max = 4,
                                                      step = 0.01)),
                                      br(),
                                      uiOutput("irt_training_gpcm_sliders"),
                                      br(),
                                      h4("Equations"),
                                      ('$$\\pi_k =\\mathrm{P}\\left(Y = k \\vert \\theta, \\alpha, \\delta_0, \\dots, \\delta_K\\right) = \\frac{\\exp\\sum_{t = 0}^k \\alpha(\\theta - \\delta_t)}{\\sum_{r = 0}^K\\exp\\sum_{t = 0}^r \\alpha(\\theta - \\delta_t)} $$'),
                                      ('$$\\mathrm{E}\\left(Y \\vert \\theta, \\alpha, \\delta_0, \\dots, \\delta_K\\right) = \\sum_{k = 0}^K k\\pi_k$$'),
                                      h4("Plots"),
                                      splitLayout(cellWidths = c("50%", "50%"),
                                                  plotlyOutput('irt_training_gpcm_plot'),
                                                  plotlyOutput('irt_training_gpcm_plot_expected')),
                                      splitLayout(cellWidths = c("50%", "50%"),
                                                  downloadButton('DB_irt_training_gpcm_plot', label = "Download figure"),
                                                  downloadButton('DB_irt_training_gpcm_plot_expected', label = "Download figure")),
                                      h4("Selected R code"),
                                      div(code(HTML("library(ggplot2)&nbsp;<br>library(data.table)&nbsp;<br><br>#&nbsp;setting&nbsp;parameters&nbsp;<br>a&nbsp;<-&nbsp;1&nbsp;<br>d&nbsp;<-&nbsp;c(-1.5,&nbsp;-1,&nbsp;-0.5,&nbsp;0)&nbsp;<br>theta&nbsp;<-&nbsp;seq(-4,&nbsp;4,&nbsp;0.01)&nbsp;<br><br>#&nbsp;calculating&nbsp;category&nbsp;probabilities&nbsp;<br>ccgpcm&nbsp;<-&nbsp;function(theta,&nbsp;a,&nbsp;d){&nbsp;a*(theta&nbsp;-&nbsp;d)&nbsp;}&nbsp;<br>df&nbsp;<-&nbsp;sapply(1:length(d),&nbsp;function(i)&nbsp;ccgpcm(theta,&nbsp;a,&nbsp;d[i]))&nbsp;<br>pk&nbsp;<-&nbsp;sapply(1:ncol(df),&nbsp;function(k)&nbsp;apply(as.data.frame(df[,&nbsp;1:k]),&nbsp;1,&nbsp;sum))&nbsp;<br>pk&nbsp;<-&nbsp;cbind(0,&nbsp;pk)&nbsp;<br>pk&nbsp;<-&nbsp;exp(pk)&nbsp;<br>denom&nbsp;<-&nbsp;apply(pk,&nbsp;1,&nbsp;sum)&nbsp;<br>df&nbsp;<-&nbsp;&nbsp;apply(pk,&nbsp;2,&nbsp;function(x)&nbsp;x/denom)<br>df1&nbsp;<-&nbsp;melt(data.frame(df,&nbsp;theta),&nbsp;id.vars&nbsp;=&nbsp;\"theta\")&nbsp;<br><br>#&nbsp;plotting&nbsp;category&nbsp;probabilities&nbsp;<br>ggplot(data&nbsp;=&nbsp;df1,&nbsp;aes(x&nbsp;=&nbsp;theta,&nbsp;y&nbsp;=&nbsp;value,&nbsp;col&nbsp;=&nbsp;variable))&nbsp;+&nbsp;<br>&nbsp;&nbsp;geom_line()&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlab(\"Ability\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylab(\"Category&nbsp;probability\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlim(-4,&nbsp;4)&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylim(0,&nbsp;1)&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme_bw()&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme(text&nbsp;=&nbsp;element_text(size&nbsp;=&nbsp;14),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.major&nbsp;=&nbsp;element_blank(),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.minor&nbsp;=&nbsp;element_blank())&nbsp;+&nbsp;<br>&nbsp;&nbsp;ggtitle(\"Category&nbsp;probabilities\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;scale_color_manual(\"\",&nbsp;values&nbsp;=&nbsp;c(\"black\",&nbsp;\"red\",&nbsp;\"yellow\",&nbsp;\"green\",&nbsp;\"blue\"),&nbsp;labels&nbsp;=&nbsp;paste0(\"P(Y&nbsp;=&nbsp;\",&nbsp;0:4,&nbsp;\")\"))<br><br>#&nbsp;calculating&nbsp;expected&nbsp;item&nbsp;score<br>df2&nbsp;<-&nbsp;data.frame(exp&nbsp;=&nbsp;as.matrix(df)&nbsp;%*%&nbsp;0:4,&nbsp;theta)<br>#&nbsp;plotting&nbsp;category&nbsp;probabilities&nbsp;<br>ggplot(data&nbsp;=&nbsp;df2,&nbsp;aes(x&nbsp;=&nbsp;theta,&nbsp;y&nbsp;=&nbsp;exp))&nbsp;+&nbsp;<br>&nbsp;&nbsp;geom_line()&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlab(\"Ability\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylab(\"Expected&nbsp;item&nbsp;score\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlim(-4,&nbsp;4)&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylim(0,&nbsp;4)&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme_bw()&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme(text&nbsp;=&nbsp;element_text(size&nbsp;=&nbsp;14),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.major&nbsp;=&nbsp;element_blank(),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.minor&nbsp;=&nbsp;element_blank())&nbsp;+&nbsp;<br>&nbsp;&nbsp;ggtitle(\"Expected&nbsp;item&nbsp;score\")"))),
                                      br(),
                                      br()
                                      ),
                             # *** Nominal response model ####
                             tabPanel('Nominal response model',
                                      h3("Nominal response model"),
                                      p("In Nominal Response Model (NRM; Bock, 1972), probability of selecting given category over baseline
                                        category is modelled by 2PL IRT model. This model is also sometimes called baseline-category logit
                                        model, as it sets linear form to log of odds of selecting given category to selecting a baseline category.
                                        Baseline can be chosen arbitrary, although usually the correct answer or the first answer is chosen.
                                        NRM model is generalization of GPCM model by setting item-specific and category-specific intercept and
                                        slope parameters."),
                                      h4("Parameters"),
                                      p("Select number of distractors and their threshold parameters ", strong("d"), "and discrimination parameters",
                                        strong("a"), ". Parameters of \\(\\pi_0 = P(Y = 0)\\) are set to zeros and \\(\\pi_0\\) is displayed with black color."),
                                      div(style = "display: inline-block; vertical-align: middle; width: 18%;",
                                          numericInput(inputId = "irt_training_nrm_numresp",
                                                       label = "Number of distractors",
                                                       value = 4,
                                                       min = 2,
                                                       max = 6)),
                                      br(),
                                      uiOutput("irt_training_nrm_sliders"),
                                      br(),
                                      h4("Equations"),
                                      ('$$\\pi_k =\\mathrm{P}\\left(Y = k \\vert \\theta, \\alpha_0, \\dots, \\alpha_K, \\delta_0, \\dots, \\delta_K\\right) = \\frac{\\exp(\\alpha_k\\theta + \\delta_k)}{\\sum_{r = 0}^K\\exp(\\alpha_r\\theta + \\delta_r)} $$'),
                                      h4("Plots"),
                                      plotlyOutput('irt_training_nrm_plot'),
                                      downloadButton("DB_irt_training_nrm_plot", label = "Download figure"),
                                      h4("Selected R code"),
                                      div(code(HTML("library(ggplot2)&nbsp;<br>library(data.table)&nbsp;<br><br>#&nbsp;setting&nbsp;parameters&nbsp;<br>a&nbsp;<-&nbsp;c(2.5,&nbsp;2,&nbsp;1,&nbsp;1.5)&nbsp;<br>d&nbsp;<-&nbsp;c(-1.5,&nbsp;-1,&nbsp;-0.5,&nbsp;0)&nbsp;<br>theta&nbsp;<-&nbsp;seq(-4,&nbsp;4,&nbsp;0.01)&nbsp;<br><br>#&nbsp;calculating&nbsp;category&nbsp;probabilities&nbsp;<br>ccnrm&nbsp;<-&nbsp;function(theta,&nbsp;a,&nbsp;d){&nbsp;exp(d&nbsp;+&nbsp;a*theta)&nbsp;}&nbsp;<br>df&nbsp;<-&nbsp;sapply(1:length(d),&nbsp;function(i)&nbsp;ccnrm(theta,&nbsp;a[i],&nbsp;d[i]))&nbsp;<br>df&nbsp;<-&nbsp;data.frame(1,&nbsp;df)&nbsp;<br>denom&nbsp;<-&nbsp;apply(df,&nbsp;1,&nbsp;sum)&nbsp;<br>df&nbsp;<-&nbsp;apply(df,&nbsp;2,&nbsp;function(x)&nbsp;x/denom)&nbsp;<br>df1&nbsp;<-&nbsp;melt(data.frame(df,&nbsp;theta),&nbsp;id.vars&nbsp;=&nbsp;\"theta\")&nbsp;<br><br>#&nbsp;plotting&nbsp;category&nbsp;probabilities&nbsp;<br>ggplot(data&nbsp;=&nbsp;df1,&nbsp;aes(x&nbsp;=&nbsp;theta,&nbsp;y&nbsp;=&nbsp;value,&nbsp;col&nbsp;=&nbsp;variable))&nbsp;+&nbsp;<br>&nbsp;&nbsp;geom_line()&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlab(\"Ability\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylab(\"Category&nbsp;probability\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlim(-4,&nbsp;4)&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylim(0,&nbsp;1)&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme_bw()&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme(text&nbsp;=&nbsp;element_text(size&nbsp;=&nbsp;14),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.major&nbsp;=&nbsp;element_blank(),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.minor&nbsp;=&nbsp;element_blank())&nbsp;+&nbsp;<br>&nbsp;&nbsp;ggtitle(\"Category&nbsp;probabilities\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;scale_color_manual(\"\",&nbsp;values&nbsp;=&nbsp;c(\"black\",&nbsp;\"red\",&nbsp;\"yellow\",&nbsp;\"green\",&nbsp;\"blue\"),&nbsp;labels&nbsp;=&nbsp;paste0(\"P(Y&nbsp;=&nbsp;\",&nbsp;0:4,&nbsp;\")\"))<br><br>#&nbsp;calculating&nbsp;expected&nbsp;item&nbsp;score<br>df2&nbsp;<-&nbsp;data.frame(exp&nbsp;=&nbsp;as.matrix(df)&nbsp;%*%&nbsp;0:4,&nbsp;theta)<br><br>#&nbsp;plotting&nbsp;expected&nbsp;item&nbsp;score<br>ggplot(data&nbsp;=&nbsp;df2,&nbsp;aes(x&nbsp;=&nbsp;theta,&nbsp;y&nbsp;=&nbsp;exp))&nbsp;+&nbsp;<br>&nbsp;&nbsp;geom_line()&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlab(\"Ability\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylab(\"Expected&nbsp;item&nbsp;score\")&nbsp;+&nbsp;<br>&nbsp;&nbsp;xlim(-4,&nbsp;4)&nbsp;+&nbsp;<br>&nbsp;&nbsp;ylim(0,&nbsp;4)&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme_bw()&nbsp;+&nbsp;<br>&nbsp;&nbsp;theme(text&nbsp;=&nbsp;element_text(size&nbsp;=&nbsp;14),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.major&nbsp;=&nbsp;element_blank(),&nbsp;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;panel.grid.minor&nbsp;=&nbsp;element_blank())&nbsp;+&nbsp;<br>&nbsp;&nbsp;ggtitle(\"Expected&nbsp;item&nbsp;score\")"))),
                                      br(),
                                      br()
                                      )
                             )))
kitdouble/ShinyIRT documentation built on May 3, 2019, 5:47 p.m.