ncme2024--Lyu.R

gistfile1.txt

bigf<-function(df) {
    df<-df[!is.na(df$rt),]
    df<-df[df$rt<60*5,]
    x<-irw::long2resp(df)
    id<-x$id
    x$id<-NULL
    m<-mirt::mirt(x,1,'Rasch')
    th<-mirt::fscores(m)
    th<-data.frame(id=id,th=th[,1])
    df<-merge(df,th)
    co<-mirt::coef(m,IRTpars=TRUE,simplify=TRUE)$items
    co<-data.frame(item=colnames(x),diff=co[,2])
    df<-merge(df,co)
    m<-by(df$rt,df$item,median,na.rm=TRUE)
    m<-data.frame(item=names(m),rt.mean=as.numeric(m))
    df<-merge(df,m)
    z<-cbind(df$th-df$diff,df$rt-df$rt.mean)
    z<-z[order(z[,1]),]
    spl<-splines::bs(z[,1])
    m<-lm(z[,2]~spl)
    cbind(z[,1],predict(m))
}

    
##
not_data<-"metadata"
dataset<-redivis::organization("datapages")$
    dataset("Item Response Warehouse",version="v5.0")
dataset_tables <- dataset$list_tables()
##
print(length(dataset_tables))
names<-sapply(dataset_tables,function(x) x$name)
ii<-grep("metadata",names)
names(dataset_tables)<-names
if (length(ii)>0) dataset_tables<-dataset_tables[-ii]   
##
f<-function(table) table$list_variables()
nms<-lapply(dataset_tables,f)

##
f<-function(x) {
    nm<-sapply(x,function(x) x$name)
    "rt" %in% nm
}
test<-sapply(nms,f)
rt_data<-dataset_tables[test]

rt_data<-rt_data[names(rt_data)!="geography"]

L<-list()
for (nm in names(rt_data)) { ##this loop will produce an error on one of the latter datasets which is i think due to some formatting issue in that data.
    print(nm)
    fn<-paste(nm,'.Rdata',sep='')
    load(fn)
    nn<-length(unique(df$id))
    jj<-length(unique(df$resp[!is.na(df$resp)]))
    mm<-length(unique(df$item))
    sp<-nrow(df)/(nn*mm)
    if (mm>5 & jj==2 & sp<=1) {
        if (nn>10000) {
            ids<-sample(unique(df$id),10000)
            df<-df[df$id %in% ids,]
        }
        ##
        items<-unique(df$item)
        items2<-paste("item",1:length(items),sep="")
        index<-match(df$item,items)
        df$item<-items2[index]
        ##
        L[[nm]]<-bigf(df)
    }
}

par(mgp=c(2,1,0))
cols<-colorRampPalette(c("blue", "red"))( length(L))
plot(NULL,xlim=c(-7,7),ylim=c(-20,10),xlab='theta-b',ylab='demeaned rt')
for (i in 1:length(L)) lines(L[[i]],col=cols[i],lwd=2)
abline(v=0,col='gray',lwd=3)