Nothing
shinyItemplot <- function(){
ret <- list(
ui = shiny::pageWithSidebar(
# Application title
shiny::headerPanel("Item plots in mirt"),
shiny::sidebarPanel(
shiny::h5('Select an internal mirt item class, the type of plot to display, whether the plot
inputs should be the classical or modern IRT parameterizations, and whether the plot
should be unidimensional or multidimensional. See ?mirt for more details.'),
shiny::selectInput(inputId = "itemclass",
label = "Class of mirt item:",
choices = c('1-4PL' = 'dich',
'graded response' = 'graded',
'(generalized) partial credit' = 'gpcm',
'nominal response' = 'nominal',
'partially non-compenstaory' = 'partcomp',
'ideal-point' = 'ideal',
'generalized graded unfolding' = 'ggum'),
selected = 'dich'),
shiny::selectInput(inputId = "plottype",
label = "Type of plot to display:",
choices = c('trace', 'threshold', 'info', 'score', 'infocontour', 'SE', 'infoSE', 'tracecontour'),
selected = 'trace'),
shiny::numericInput("theta_lim_low", "Theta lower range:", -4,
min = -20, max = 20),
shiny::numericInput("theta_lim_high", "Theta upper range:", 4,
min = -20, max = 20),
shiny::checkboxInput(inputId = "classical",
label = "Use traditional IRT parameterization inputs? \n
Only applicable to class dich, graded, gpcm, and nominal.",
value = FALSE),
shiny::checkboxInput(inputId = "nfact",
label = "Multidimensional?",
value = FALSE),
#-------------------------------------------------------------------------
shiny::conditionalPanel(condition = "input.classical == false",
shiny::sliderInput(inputId = "a1par",
label = "a1 value:",
min = -3, max = 3, value = 1, step = 0.1),
shiny::conditionalPanel(condition = "input.nfact == true",
shiny::sliderInput(inputId = "a2par",
label = "a2 value:",
min = -3, max = 3, value = 1, step = 0.1)),
shiny::conditionalPanel(condition = "input.itemclass == 'dich'",
shiny::sliderInput(inputId = "dpar",
label = "d value:",
min = -5, max = 5, value = 0, step = 0.25),
shiny::sliderInput(inputId = "gpar",
label = "g value:",
min = 0, max = 1, value = 0, step = 0.05),
shiny::sliderInput(inputId = "upar",
label = "u value:",
min = 0, max = 1, value = 1, step = 0.05)),
shiny::conditionalPanel(condition = "input.itemclass == 'ggum'",
shiny::sliderInput(inputId = "b1par",
label = "b1 value:",
min = -5, max = 5, value = 3, step = 0.25),
shiny::sliderInput(inputId = "t1par",
label = "t1 value:",
min = -20, max = 20, value = 6, step = 0.05),
shiny::sliderInput(inputId = "t2par",
label = "t2 value:",
min = -20, max = 20, value = 4, step = 0.05),
shiny::sliderInput(inputId = "t3par",
label = "t3 value:",
min = -20, max = 20, value = 2, step = 0.05)
),
shiny::conditionalPanel(condition = "input.itemclass == 'ideal'",
shiny::sliderInput(inputId = "idpar",
label = "d value:",
min = -5, max = 5, value = 0, step = 0.25)
),
shiny::conditionalPanel(condition = "input.itemclass == 'gpcm' ||
input.itemclass == 'nominal' ||
input.itemclass == 'graded' ||
input.itemclass == 'partcomp'",
shiny::conditionalPanel(condition = "input.itemclass == 'gpcm' ||
input.itemclass == 'nominal'",
shiny::sliderInput(inputId = "d0par",
label = "d0 value (default fixed at 0):",
min = -5, max = 5, value = 0, step = 0.25)
),
shiny::conditionalPanel(condition = "input.itemclass != 'ideal'",
shiny::sliderInput(inputId = "d1par",
label = "d1 value:",
min = -5, max = 5, value = 1, step = 0.25),
shiny::sliderInput(inputId = "d2par",
label = "d2 value:",
min = -5, max = 5, value = 0, step = 0.25),
shiny::conditionalPanel(condition = "input.itemclass != 'partcomp' &&
input.itemclass != 'ggum'",
shiny::sliderInput(inputId = "d3par",
label = "d3 value:",
min = -5, max = 5, value = -1, step = 0.25)
)
)
),
shiny::conditionalPanel(condition = "input.itemclass == 'nominal'",
shiny::sliderInput(inputId = "ak0par",
label = "ak0 value (default fixed at 0):",
min = -3, max = 3, value = 0, step = 0.1),
shiny::sliderInput(inputId = "ak1par",
label = "ak0 value:",
min = -3, max = 3, value = 1, step = 0.1),
shiny::sliderInput(inputId = "ak2par",
label = "ak2 value:",
min = -3, max = 3, value = 2, step = 0.1),
shiny::sliderInput(inputId = "ak3par",
label = "ak3 value (default fixed at (ncat-1)):",
min = -3, max = 3, value = 3, step = 0.1)
)
),
shiny::conditionalPanel(condition = "input.classical == true",
shiny::conditionalPanel(condition = "input.itemclass == 'dich'",
shiny::sliderInput(inputId = "a1parc",
label = "a value:",
min = -3, max = 3, value = 1, step = 0.1),
shiny::sliderInput(inputId = "bpar",
label = "b value:",
min = -5, max = 5, value = 0, step = 0.25),
shiny::sliderInput(inputId = "gparc",
label = "g value:",
min = 0, max = 1, value = 0, step = 0.05),
shiny::sliderInput(inputId = "uparc",
label = "u value:",
min = 0, max = 1, value = 1, step = 0.05)
),
shiny::conditionalPanel(condition = "input.itemclass == 'graded'",
shiny::sliderInput(inputId = "a1pard",
label = "a value:",
min = -3, max = 3, value = 1, step = 0.1),
shiny::sliderInput(inputId = "bpar1d",
label = "b1 value:",
min = -5, max = 5, value = -1, step = 0.25),
shiny::sliderInput(inputId = "bpar2d",
label = "b2 value:",
min = -5, max = 5, value = 0, step = 0.25),
shiny::sliderInput(inputId = "bpar3d",
label = "b3 value:",
min = -5, max = 5, value = 1, step = 0.25)
),
shiny::conditionalPanel(condition = "input.itemclass == 'gpcm'",
shiny::sliderInput(inputId = "a1pare",
label = "a value:",
min = -3, max = 3, value = 1, step = 0.1),
shiny::sliderInput(inputId = "bpar1e",
label = "b1 value:",
min = -5, max = 5, value = -1, step = 0.25),
shiny::sliderInput(inputId = "bpar2e",
label = "b2 value:",
min = -5, max = 5, value = 0, step = 0.25),
shiny::sliderInput(inputId = "bpar3e",
label = "b3 value:",
min = -5, max = 5, value = 1, step = 0.25)
),
shiny::conditionalPanel(condition = "input.itemclass == 'nominal'",
shiny::sliderInput(inputId = "a1parf",
label = "a1 value:",
min = -3, max = 3, value = -1.4, step = 0.1),
shiny::sliderInput(inputId = "a2parf",
label = "a2 value:",
min = -3, max = 3, value = -0.4, step = 0.1),
shiny::sliderInput(inputId = "a3parf",
label = "a3 value:",
min = -3, max = 3, value = 0.4, step = 0.1),
shiny::sliderInput(inputId = "a4parf",
label = "a4 value:",
min = -3, max = 3, value = 1.4, step = 0.1),
shiny::sliderInput(inputId = "bpar1f",
label = "b1 value:",
min = -5, max = 5, value = -1, step = 0.25),
shiny::sliderInput(inputId = "bpar2f",
label = "b2 value:",
min = -5, max = 5, value = 0, step = 0.25),
shiny::sliderInput(inputId = "bpar3f",
label = "b3 value:",
min = -5, max = 5, value = 1, step = 0.25),
shiny::sliderInput(inputId = "bpar4f",
label = "b4 value:",
min = -5, max = 5, value = 1.5, step = 0.25)
)
)
),
shiny::mainPanel(
shiny::verbatimTextOutput("coefs"),
shiny::plotOutput(outputId = "main_plot", height = "700px", width = "700px")
)
),
server = function(input, output) {
genmod <- function(input){
set.seed(1234)
itemclass <- c(input$itemclass, input$itemclass)
itemtype <- switch(input$itemclass,
dich='2PL',
graded='graded',
gpcm='gpcm',
nominal='nominal',
nestlogit='2PLNRM',
partcomp='PC2PL',
nestlogit='2PLNRM',
ideal='ideal',
ggum='ggum')
nominal <- NULL
model <- 1
t <- NULL
K <- c(4,4)
if(input$nfact) model <- 2
if(model == 2 && input$plottype == 'infoSE')
stop('infoSE only available for single dimensional models', call.=FALSE)
a <- matrix(1,2)
d <- matrix(0,2)
if(input$itemclass %in% c('dich', 'ideal')){
K <- c(2,2)
} else if(input$itemclass == 'graded'){
d <- matrix(c(1,0,-1), 2, 3, byrow=TRUE)
} else if(input$itemclass == 'gpcm'){
d <- matrix(c(0,1,0,-1), 2, 4, byrow=TRUE)
} else if(input$itemclass == 'nominal'){
nominal <- matrix(c(0,1,2,3), 2, 4, byrow=TRUE)
d <- matrix(c(0,1,0,-1), 2, 4, byrow=TRUE)
} else if(input$itemclass == 'nestlogit'){
nominal <- matrix(c(0,1,2), 2, 3, byrow=TRUE)
d <- matrix(c(0,0,1,-1), 2, 4, byrow=TRUE)
} else if(input$itemclass == 'partcomp'){
if(model != 2) stop('partcomp models require more than 1 dimension', call.=FALSE)
if(input$plottype == 'info' || input$plottype == 'infocontour')
stop('information based plots not currently supported for partcomp items',
call.=FALSE)
a <- matrix(c(1,1), 2, 2, byrow=TRUE)
d <- matrix(c(1,1,1,NA), 2, 2, byrow=TRUE)
itemtype[2] <- '2PL'
itemclass[2] <- 'dich'
model <- mirt.model('F1 = 1,2
F2 = 1', quiet=TRUE)
K <- c(2,2)
} else if(input$itemclass == 'ggum'){
t <- matrix(rep(c(6,4,2), each=2), 2)
}
dat <- expand.grid(1:K[1], 1:K[2])
sv <- mirt(dat, model, itemtype=itemtype, pars = 'values', key=c(1, NA),
technical=list(message=FALSE, customK=K))
sv$est <- FALSE
mod <- mirt(dat, model, itemtype=itemtype, pars=sv, key=c(1, NA),
technical=list(message=FALSE, customK=K))
par <- mod@ParObjects$pars[[1]]@par
names(par) <- names(mod@ParObjects$pars[[1]]@parnum)
if(input$classical){
if(itemclass[1L] == 'dich'){
par <- c(input$a1parc, input$bpar, logit(input$gparc), logit(input$uparc))
} else if(itemclass[1L] == 'graded'){
par <- c(input$a1pard, input$bpar1d, input$bpar2d, input$bpar3d)
} else if(itemclass[1L] == 'gpcm'){
par <- c(input$a1pare, input$bpar1e, input$bpar2e, input$bpar3e)
} else if(itemclass[1L] == 'nominal'){
par <- c(input$a1parf, input$a2parf, input$a3parf, input$a4parf,
input$bpar1f, input$bpar2f, input$bpar3f, input$bpar4f)
} else {
stop('Classical parameterization not available for selected item class',
call.=FALSE)
}
par <- traditional2mirt(x=par, cls=itemclass[1L], ncat=mod@ParObjects$pars[[1]]@ncat)
} else {
par[names(par) == 'a1'] <- input$a1par
par[names(par) == 'a2'] <- input$a2par
par[names(par) == 'd'] <- input$dpar
if(input$itemclass == 'ideal')
par[names(par) == 'd'] <- input$idpar
par[names(par) == 'g'] <- logit(input$gpar)
par[names(par) == 'u'] <- logit(input$upar)
par[names(par) == 'b1'] <- input$b1par
par[names(par) == 'b2'] <- input$b2par
par[names(par) == 'd0'] <- input$d0par
par[names(par) == 'd1'] <- input$d1par
par[names(par) == 'd2'] <- input$d2par
par[names(par) == 'd3'] <- input$d3par
par[names(par) == 'ak0'] <- input$ak0par
par[names(par) == 'ak1'] <- input$ak1par
par[names(par) == 'ak2'] <- input$ak2par
par[names(par) == 'ak3'] <- input$ak3par
par[names(par) == 't1'] <- input$t1par
par[names(par) == 't2'] <- input$t2par
par[names(par) == 't3'] <- input$t3par
}
mod@ParObjects$pars[[1]]@par <- par
mod
}
output$main_plot <- shiny::renderPlot({
mod <- genmod(input)
obj <- itemplot(mod, 1, type=input$plottype, rotate = 'none',
theta_lim=c(input$theta_lim_low, input$theta_lim_high))
print(obj)
})
output$coefs <- shiny::renderPrint({
mod <- genmod(input)
cat('Item parameters: \n\n')
print(coef(mod, rotate = 'none')[[1L]])
if(mod@Model$nfact == 1L && !is(mod@ParObjects$pars[[1L]], 'nestlogit')){
cat('\n\nItem parameters (traditional IRT metric): \n\n')
print(coef(mod, IRTpars = TRUE)[[1L]])
}
})
}
)
return(ret)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.