grid.arrange(
qplot(rowMeans(sim2),model2$coef[1:numsubs],xlab="Person accuracy",ylab="Person ability parameter")+theme_bw(),
qplot(colMeans(sim2),itempars2,xlab="Question accuracy",ylab="Item difficulty parameter")+theme_bw(),ncol=2)
abilities <- data.frame(set1=model$coef[1:50],set2=model2$coef[1:50])
cor(abilities)
ggplot(abilities,aes(x=set1,y=set2))+geom_point() + ggtitle("Person abilities") + theme_bw()
probdifficulty <- data.frame(set1=itempars,
set2 = itempars2)
cor(probdifficulty)
ggplot(probdifficulty,aes(x=set1,y=set2)) + geom_point() + ggtitle("Question difficulty") + theme_bw()
library(ltm)
p1 <- sim1+0  #recode TF and 1/0
p2 <- sim2+0
irt1 <- rasch(p1)
irt2 <- rasch(p2)
summary(irt1)
summary(irt2)
##this is an alternative to alpha in psych package
descript(p1)
plot(itempars,irt1$coef[,1],main=
"Comparison of model Item coefficients",xlab="Logistic coefficients",ylab="IRT coefficients")
abline(0,1)
plot(itempars2,irt2$coef[,1],main=
"Comparison of model Item coefficients",xlab="Logistic coefficients",ylab="IRT coefficients")
abline(0,1)
plot(irt1)
plot(irt2)
set.seed(10010)
irt2 <- rasch(sim2+0)
sim3 <- sim2
sim3[,1:5] <- (runif(5*numsubs)<.5 )+0
irt3 <- rasch(sim3)
summary(irt2)
summary(irt3)
plot((cbind(irt1$coef[,1],irt3$coef[,1])),main="Item coefficients with bad questions",xlab="test 2",ylab="test 3")
plot((cbind(irt1$coef[,1],irt3$coef[,1])),main="Item coefficients with bad questions (zoomed)",xlab="test 2",ylab="test 3",ylim=c(-5,5))
item.fit(irt2)
item.fit(irt3)
print(person.fit(irt2))
person.fit(irt3)
dat <- read.csv("testscores.csv")
##descript(dat) ##doesn't work. Thus compute Cronbach's alpha on the data
descript(dat,chi.squared=F)
#force the discrimination parameter to be 1
model1 <- rasch(dat,constraint=cbind(length(dat) + 1, 1))
model1
#summary(model1)
#allow discrimination parameter to be estimated
model2 <- rasch(dat)
model2
#summary(model2)
par(mfrow=c(1,2))
plot(model1)
plot(model2)
anova(model1,model2)
model3 <- ltm(dat~z1)
model3
plot(model3)
#summary(model3)
item.fit(model3)
psych::alpha(dat)
person.fit(model3)
margins(model3)
table(dat[,13],dat[,37])
model4a <- ltm(dat[,1:15]~z1)
plot(model4a)
model4a
#summary(model4)
item.fit(model4a)
model4b <- ltm(dat[,1:15]~z1+z2)
model4b
anova(model4a,model4b)
#item.fit(model4b)
fs <- factor.scores(model4b)
barplot(t(fs$coef),beside=T)
plot(fs$coef[,2],fs$coef[,3])
plot(rank(coef(model4a)[,1]),rank(coef(model4b)[,1]))
plot(coef(model4a)[,2],coef(model4b)[,2])
plot(coef(model4a)[,2],coef(model4b)[,3])
model9 <- tpm(dat[,1:15],type="latent.trait",max.guessing =.5)
model9
plot(model9)
par(mfrow=c(2,2))
boxplot(dat$q5,rowMeans(dat),main="Correct on q5",names=c("Incorrect (3)","correct (18)"))
boxplot(dat$q4,rowMeans(dat),main="Correct on q4",names=c("Incorrect (1)","correct (20)"))
boxplot(dat$q10,rowMeans(dat),main="Correct on q10",names=c("Incorrect (3)","correct (18)"))
boxplot(dat$q11,rowMeans(dat),main="Correct on q11",names=c("Incorrect (13)","correct (8)"))
plot(model4a)
plot(model4a,legend=T,type="IIC",items=1:5)
plot(model4a,type="IIC",legend=T,item=c(1:15)[c(-11,-6,-10)])
model5 <- ltm(dat[,c(1,3,5,9,14)]~z1)
model5
plot(model5,legend=T,type="IIC")
model5 <- ltm(dat[,c(1,3,5,9,14)]~z1+z2)
model5
plot(model5,legend=T,type="IIC")
model5
big5 <- read.csv("bigfive.csv")
qtype <- c("E","A","C","N","O", "E","A","C","N","O",
"E","A","C","N","O", "E","A","C","N","O",
"E","A","C","N","O", "E","A","C","N","O",
"E","A","C","N","O", "E","A","C","N","O",
"O","A","C","O")
valence <- c(1,-1,1,1,1,  -1,1,-1,-1,1,
1,-1,1,1,1,  1,1,-1,1,1,
-1,1,-1,-1,1,  1,-1,1,1,1,
-1,1,1,-1,-1,  1,-1,1,1,1,
-1,1,-1,1)
##reverse code
for(i in 2:ncol(big5))
{
if(valence[i-1]==-1)
{
big5[,i] <- 6-big5[,i]
}
}
ei <- big5[,c(T,qtype=="E")]
ei <- ei[!is.na(rowSums(ei)),]
g1 <-  grm(ei[,-1], constrained = TRUE)
g1
summary(g1)
par(mfrow=c(4,2))
plot(g1,items=1)
plot(g1,items=2)
plot(g1,items=3)
plot(g1,items=4)
plot(g1,items=5)
plot(g1,items=6)
plot(g1,items=7)
plot(g1,items=8)
par(mfrow=c(4,2))
plot(g2,items=1)
plot(g2,items=2)
plot(g2,items=3)
plot(g2,items=4)
plot(g2,items=5)
plot(g2,items=6)
plot(g2,items=7)
plot(g2,items=8)
data <- read.csv("http://pages.mtu.edu/~shanem/psy5220/daily/Day10-11/crossword.csv")
qs <- read.csv("http://pages.mtu.edu/~shanem/psy5220/daily/Day10-11/answers.csv")
qs
responses <- data[,-(1:5)]
d <- descript(responses,chi.squared=F,n.print=100)
d
plot(d)
responses
m1 <- rasch(responses)
m1
m1
BIC(m1)
plot(m1)
plot(m1,type="IIC")
plot(m1,type="IIC",items=0)
m2 <- ltm(responses~z1)
coef(m2)
BIC(m2)  #The smaller the better
par(mfrow=c(1,2))
plot(coef(m1)[,1],coef(m2)[,1],main="Difficulty")
plot(coef(m1)[,1],coef(m2)[,2],main="Discriminability")
anova(m1,m2)
plot(m2)
plot(m2,type="IIC")
plot(m2,type="IIC",items=0)
BIC(m1)
BIC(m2)
anova(m1,m2)
coef(m2)
BIC(m2)  #The smaller the better
par(mfrow=c(1,2))
plot(coef(m1)[,1],coef(m2)[,1],main="Difficulty")
plot(coef(m1)[,1],coef(m2)[,2],main="Discriminability")
margins(m1)
qs <- read.csv("http://pages.mtu.edu/~shanem/psy5220/daily/Day10-11/answers.csv")
qs[c(22,36)]
qs
person.fit(m1)
View(person.fit(m1))
person.fit(m1)
str(person.fit(m1))
str(person.fit(m1)$resp.patterns)
View(person.fit(m1)$resp.patterns)
View(cbind(person.fit(m1)$resp.patterns,person.fit(m1)$p.value)
)
person.fit(m1)
item.fit(m1)
qs
coef(m1)
m3 <- ltm(responses~z1+z2)
coef(m3)
BIC(m3)
##compare intercept of m1  to model3 parameters:
par(mfrow=c(1,3))
plot(coef(m1)[,1],coef(m3)[,1])
plot(coef(m1)[,1],coef(m3)[,2])
plot(coef(m1)[,1],coef(m3)[,3])
plot(coef(m2)[,2],coef(m3)[,2])
plot(coef(m2)[,2],coef(m3)[,3])
runApp('~/Dropbox/courses/5220-s2025b/web-5220/psy5220/daily/shiny/app13.R')
install.packages("lazyeval")
runApp('~/Dropbox/courses/5220-s2025b/web-5220/psy5220/daily/shiny/app13.R')
runApp('~/Dropbox/courses/5220-s2025b/web-5220/psy5220/daily/shiny/app13.R')
runApp('~/Dropbox/courses/5220-s2025b/web-5220/psy5220/daily/shiny/app13.R')
runApp('~/Dropbox/courses/5220-s2025b/web-5220/psy5220/daily/shiny/app13.R')
install.packages("crosstalk")
runApp('~/Dropbox/courses/5220-s2025b/web-5220/psy5220/daily/shiny/app13.R')
runApp('~/Dropbox/courses/5220-s2025b/web-5220/psy5220/daily/shiny/app13.R')
runApp('~/Dropbox/courses/5220-s2025b/web-5220/psy5220/daily/shiny/app13.R')
runApp('~/Dropbox/courses/5220-s2025b/web-5220/psy5220/daily/shiny/app13.R')
runApp('~/Dropbox/courses/5220-s2025b/web-5220/psy5220/daily/shiny/app13.R')
setwd("~/Dropbox/courses/5220-s2025b/web-5220/psy5220/daily/Day09_Multinomial")
setwd("~/Dropbox/courses/5220-s2025b/homework/ps5-manovamultinom")
knitr::opts_chunk$set(echo = TRUE)
dat <- read.csv("TaskRatings.csv")
dat <- read.csv("TaskRatings.csv")
longmat <- rbind(as.matrix(dat[,3:10]),
as.matrix(dat[,11:18]),
as.matrix(dat[,19:26]),deparse.level=2)
longdat <- data.frame(task=dat$Task,
rater= as.factor(rep(1:3,each=nrow(dat))),
longmat)
longmat
longdat
library(car)
rating_matrix <- as.matrix(longdat[, 3:9])
manova_model <- lm(rating_matrix ~ rater + task, data = longdat)
summary(manova_model)
manova1 <- manova(manova_model)
summary(manova1, test = "Pillai")
summary(manova1, test = "Wilks")
summary(manova1, test = "Hotelling-Lawley")
summary(manova1, test = "Roy")
longdat
knitr::opts_chunk$set(echo = TRUE)
library(reshape2)
library(ggplot2)
library(ltm)
library(dplyr)
data <- read.csv("bntcrt.csv")
answers <- data[,2:8]
total <- rowSums(answers)
answers <- answers[order(total),]
image(t(as.matrix(answers)),ylab="Overall accuracy",col=c("white","black"),
xlab="Question")
##order by BNT score:
ord2 <- order(rowSums(answers[,1:4]))
image(t(as.matrix(answers[ord2,])),ylab="Overall accuracy",col=c("white","black"),
xlab="Question")
model0 <-rasch(answers)
summary(model0)
plot(model0)
plot(model0,items=5:7)
ord3a <- order(rowSums(answers))
ord3b <- order(model0$coefficients[,1])
image(t(as.matrix(answers[ord3a,ord3b])),ylab="Overall accuracy",col=c("white","black"),
xlab="Question")
item.fit(model0)
margins(model0)
p <- person.fit(model0,resp.patterns=answers)
p2 <- data.frame(p$resp.patterns,p$p.values)
p2[order(p2$Lz),][1:10,]
p
View(p)
p
as.matrix(p)
str(p)
model0b <- rasch(answers,constraint=cbind(8,1.14))
model1 <- rasch(answers,constraint = cbind(8, 3))
print(model1)
plot(model1)
plot(model0b)
anova(model0b,model1)
AIC(model0b,model1)
model0b <- rasch(answers,constraint=cbind(8,1.14))
model1 <- rasch(answers,constraint = cbind(8, 3))
print(model1)
plot(model1)
plot(model0b)
model1
model2
model1b
model0b
model1
anova(model0b,model1)
AIC(model0b,model1)
model2 <- ltm(answers~z1)
model2
model2 <- ltm(answers~z1)
model2
par(mfrow=c(3,1))
plot(model2)
plot(model2,items=1:4)
plot(model2,items=5:7)
summary(model2)
item.fit(model2)
margins(model2)
person.fit(model2)
par(mfrow=c(3,1))
plot(model2)
plot(model2,items=1:4)
plot(model2,items=5:7)
model2
summary(model2)
item.fit(model2)
margins(model2)
person.fit(model2)
model3 <- ltm(answers~z1+z2)
model3
summary(model3,order=T)
margins(model3)
anova(model2,model3)
#item.fit(model3)
#plot(model3)
plot(model3,type="loadings")
par(mfrow=c(2,2))
plot(model2,type="IIC")
knitr::opts_chunk$set(echo = TRUE)
library(reshape2)
library(ggplot2)
library(ltm)
library(dplyr)
data <- read.csv("bntcrt.csv")
answers <- data[,2:8]
total <- rowSums(answers)
answers <- answers[order(total),]
image(t(as.matrix(answers)),ylab="Overall accuracy",col=c("white","black"),
xlab="Question")
##order by BNT score:
ord2 <- order(rowSums(answers[,1:4]))
image(t(as.matrix(answers[ord2,])),ylab="Overall accuracy",col=c("white","black"),
xlab="Question")
model0 <-rasch(answers)
summary(model0)
plot(model0)
plot(model0,items=5:7)
ord3a <- order(rowSums(answers))
ord3b <- order(model0$coefficients[,1])
image(t(as.matrix(answers[ord3a,ord3b])),ylab="Overall accuracy",col=c("white","black"),
xlab="Question")
item.fit(model0)
margins(model0)
p <- person.fit(model0,resp.patterns=answers)
p2 <- data.frame(p$resp.patterns,p$p.values)
p2[order(p2$Lz),][1:10,]
model0b <- rasch(answers,constraint=cbind(8,1.14))
model1 <- rasch(answers,constraint = cbind(8, 3))
print(model1)
plot(model1)
plot(model0b)
anova(model0b,model1)
AIC(model0b,model1)
model2 <- ltm(answers~z1)
model2
par(mfrow=c(3,1))
plot(model2)
plot(model2,items=1:4)
plot(model2,items=5:7)
summary(model2)
item.fit(model2)
margins(model2)
person.fit(model2)
model3 <- ltm(answers~z1+z2)
model3
summary(model3,order=T)
margins(model3)
anova(model2,model3)
#item.fit(model3)
#plot(model3)
plot(model3,type="loadings")
par(mfrow=c(2,2))
plot(model2,type="IIC")
plot(model2,type="IIC",items=0)
plot(model2,type="IIC",items=1:4)
plot(model2,type="IIC",items=5:7)
information(model2,items=1:4,range=c(-10,0))
information(model2,items=1:4,range=c(0,10))
information(model2,items=5:7,range=c(-10,0))
information(model2,items=5:7,range=c(0,10))
model5 <- tpm(answers[,1:4],type="latent.trait",
constraint=cbind(1:4,1, .25))
model5b <- ltm(answers[,1:4]~z1)
summary(model5)
summary(model5b)
summary(model5)
summary(model5b)
model5
plot(model5)
plot(model5b)
anova(model5b,model5) ## cannot tell the difference here!  These have the same # of parameters since we hard-coded the guessing parameters.
AIC(model5b,model5)
plot(model5)
model5c <- tpm(answers[,1:4],type="latent.trait")
model5c
setwd("~/Dropbox/courses/5220-s2025b/web-5220/psy5220/daily/shiny")
runApp('app01.R')
runApp('app01.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app01-X.R')
runApp('app02-X.R')
runApp('app02-X.R')
runApp('app02-X.R')
runApp('app02-X.R')
runApp('app02-X.R')
library(gridExtra)
runApp('app02-X.R')
runApp('app03-X.R')
runApp('app04-X.R')
runApp('app04-X.R')
runApp('app04-X.R')
runApp('app05-X.R')
runApp('app05-X.R')
install.packages("shinypanel")
runApp('app13.R')
runApp('app13.R')
runApp('app13.R')
runApp('app13.R')
runApp('app13.R')
runApp('app13.R')
runApp('app-demo.R')
runApp('app-vbox.R')
runApp('app-vbox.R')
runApp('app-vbox.R')
runApp('app-vbox.R')
install.packages("leaflet")
install.packages("raster")
install.packages("terra")
install.packages('terra', repos='https://rspatial.r-universe.dev')
install.packages("leaflet")
install.packages("leaflet")
runApp('app-vbox.R')
install.packages("leaflet")
install.packages("leaflet")
runApp('app-vbox.R')
runApp('app-vbox.R')
library(DT)
install.packages("DT")
runApp('app-vbox.R')
runApp('app-vbox.R')
runApp('app-vbox.R')
runApp('app05-solution.R')
runApp('app06-X.R')
runApp('app06-X.R')
runApp('app06-X.R')
runApp('app06-X.R')
runApp('app07.R')
runApp('app07.R')
runApp('app07.R')
runApp('app07-X.R')
runApp('app07-X.R')
runApp('app07-X.R')
runApp('app07-solution.R')
runApp('app07-solution.R')
runApp('app08-X.R')
runApp('app08-X.R')
runApp('app08-X.R')
runApp('app08-X.R')
runApp('app08-X.R')
runApp('app08-X.R')
runApp('app09-X.R')
runApp('app09-X.R')
install.packages("plotly")
install.packages("plotly")
library(plotly)
tmp <- data.frame(a = runif(100),b=runif(100))
plot_ly(tmp,x= ~a,y= ~b,type="scatter",mode="markers")
library(plotly)
tmp <- data.frame(a = runif(100),b=runif(100))
plot_ly(tmp,x= ~a,y= ~b,type="scatter",mode="markers")
install.packages(c("bayestestR", "bit64", "bslib", "cli", "curl", "doBy", "emmeans", "faraway", "gld", "httr2", "igraph", "insight", "jsonlite", "locfit", "Matrix", "nlme", "openssl", "parameters", "performance", "ps", "purrr", "quantreg", "RcppArmadillo", "rgl", "rlang", "xfun"))
library(shiny); runApp('app10-X.R')
library(plotly)
tmp <- data.frame(a = runif(100),b=runif(100))
plot_ly(tmp,x= ~a,y= ~b,type="scatter",mode="markers")
runApp('app10-X.R')
runApp('app11-X.R')
runApp('app11-X.R')
runApp('app11-X.R')
runApp('app11-solution.R')
runApp('app12-solution.R')
runApp('app12-solution.R')
runApp('app12-solution.R')
runApp('app12-solution.R')
runApp('app12-solution.R')
runApp('app12-solution.R')
USArrests
runApp('app12-solution.R')
runApp('app12-solution.R')
runApp('app-demo.R')
runApp('app-demo.R')
runApp('app-demo.R')
library("shinypanel")
runApp('app-demo.R')
libray(bsblib)
library(bsblib)
library(bslib)
library(leaflet)
library(DT) ## for datatable
runApp('app-vbox.R')
runApp('app-vbox.R')
library(shinypanel)