# NOT RUN {
# }
# NOT RUN {
#####################################
## Fit response-bias or payoff ROC ##
#####################################
# Example from Broder & Schutz (2009)
# We fit the data from the 40 individuals from their Experiment 3
# We fit three different models:
# 1. Their SDT Model: br.sdt
# 2. Their 2HTM model: br.2htm
# 3. A restricted 2HTM model with Dn = Do: br.2htm.res
# 4. A 1HTM model (i.e., Dn = 0): br.1htm
data(d.broeder, package = "MPTinR")
m.2htm <- system.file("extdata", "5points.2htm.model", package = "MPTinR")
# We specify the SDT model in the code using a textConnection.
# However, textConnection is only called in the function call on the string.
m.sdt <- "
1-pnorm((cr1-mu)/ss)
pnorm((cr1-mu)/ss)
1-pnorm(cr1)
pnorm(cr1)
1-pnorm((cr2-mu)/ss)
pnorm((cr2-mu)/ss)
1-pnorm(cr2)
pnorm(cr2)
1-pnorm((cr3-mu)/ss)
pnorm((cr3-mu)/ss)
1-pnorm(cr3)
pnorm(cr3)
1-pnorm((cr4-mu)/ss)
pnorm((cr4-mu)/ss)
1-pnorm(cr4)
pnorm(cr4)
1-pnorm((cr5-mu)/ss)
pnorm((cr5-mu)/ss)
1-pnorm(cr5)
pnorm(cr5)
"
# How does the model look like?
check.mpt(textConnection(m.sdt))
# fit the SDT (unequal variance version)
br.uvsdt <- fit.model(d.broeder, textConnection(m.sdt),
lower.bound = c(rep(-Inf, 5), 0, 1), upper.bound = Inf)
# Is there any effect of studying the items?
br.uvsdt.2 <- fit.model(d.broeder, textConnection(m.sdt),
restrictions.filename = list("mu = 0", "ss = 1"),
lower.bound = -Inf, upper.bound = Inf)
(diff.g2 <- br.uvsdt.2[["goodness.of.fit"]][["sum"]][["G.Squared"]] -
br.uvsdt[["goodness.of.fit"]][["sum"]][["G.Squared"]])
(diff.df <- br.uvsdt.2[["goodness.of.fit"]][["sum"]][["df"]] -
br.uvsdt[["goodness.of.fit"]][["sum"]][["df"]])
1 - pchisq(diff.g2, diff.df)
# fit the equal variance SDT model:
br.evsdt <- fit.model(d.broeder, textConnection(m.sdt),
lower.bound = c(rep(-Inf, 5), 0), upper.bound = Inf,
restrictions.filename = list("ss = 1"))
# fit the MPTs (see also ?fit.mpt).
# In contrast to ?fit.mpt we specify the restrictions using a textConnection or a list!
br.2htm <- fit.mpt(d.broeder, m.2htm)
br.2htm.res <- fit.mpt(d.broeder, m.2htm, textConnection("Do = Dn"))
br.1htm <- fit.mpt(d.broeder, m.2htm, list("Dn = 0"))
select.mpt(list(uvsdt = br.uvsdt, evsdt = br.evsdt, two.htm = br.2htm,
two.htm.res = br.2htm.res, one.htm = br.1htm), output = "full")
# the restricted 2HTM "wins" for individual data (although evsdt does not perform too bad),
# but the 2htm and restricted 2htm restricted "win" for aggregated data.
###################################
## Fit confidence rating ROC SDT ##
###################################
#(see ?roc6 for more examples)
# We fit example data from Wickens (2002, Chapter 5)
# The example data is from Table 5.1, p. 84
# (data is entered in somewhat different order).
# Note that criteria are defined as increments to
# the first (i.e., leftmost) criterion!
# This is the only way to do it in MPTinR.
# Data
dat <- c(47, 65, 66, 92, 136, 294, 166, 161, 138, 128, 63, 43)
# UVSDT
m.uvsdt <- "
pnorm(cr1, mu, sigma)
pnorm(cr1+cr2, mu, sigma) - pnorm(cr1, mu, sigma)
pnorm(cr3+cr2+cr1, mu, sigma) - pnorm(cr2+cr1, mu, sigma)
pnorm(cr4+cr3+cr2+cr1, mu, sigma) - pnorm(cr3+cr2+cr1, mu, sigma)
pnorm(cr5+cr4+cr3+cr2+cr1, mu, sigma) - pnorm(cr4+cr3+cr2+cr1, mu, sigma)
1 - pnorm(cr5+cr4+cr3+cr2+cr1, mu, sigma)
pnorm(cr1)
pnorm(cr2+cr1) - pnorm(cr1)
pnorm(cr3+cr2+cr1) - pnorm(cr2+cr1)
pnorm(cr4+cr3+cr2+cr1) - pnorm(cr3+cr2+cr1)
pnorm(cr5+cr4+cr3+cr2+cr1) - pnorm(cr4+cr3+cr2+cr1)
1 - pnorm(cr5+cr4+cr3+cr2+cr1)
"
check.mpt(textConnection(m.uvsdt))
# Model fitting
(cr_sdt <- fit.model(dat, textConnection(m.uvsdt),
lower.bound=c(-Inf, rep(0, 5), 0.1), upper.bound=Inf))
# To obtain the criteria (which match those in Wickens (2002, p. 90)
# obtain the cumulative sum:
cumsum(cr_sdt$parameters[paste0("cr",1:5), 1, drop = FALSE])
# }
# NOT RUN {
# }
Run the code above in your browser using DataLab