dtaHW4 <- read.table("C:/Users/ASUS/Desktop/data/mathPlacement.asc.txt", h=T)
head(dtaHW4)
## X1 X0 X1.1 X1.2 X0.1 X1.3 X1.4 X1.5 X0.2 X0.3 X1.6 X1.7 X1.8 X1.9 X1.10 X1.11
## 1 2 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1
## 2 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## 3 4 1 1 1 0 1 1 1 1 1 1 1 1 1 1 0
## 4 5 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0
## 5 6 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1
## 6 7 0 1 0 0 1 1 1 1 0 1 1 0 1 0 1
## X0.4 X0.5 X1.12 X1.13 X1.14 X1.15 X1.16 X1.17 X1.18 X1.19 X1.20 X0.6 X0.7
## 1 0 1 1 1 1 1 0 1 1 1 1 1 1
## 2 1 1 1 1 1 0 1 1 1 1 1 1 1
## 3 0 0 1 0 1 0 1 1 0 1 1 0 0
## 4 0 1 1 0 1 0 0 1 1 0 0 0 0
## 5 1 1 1 1 1 0 0 1 0 1 1 1 1
## 6 0 1 1 1 1 0 0 1 1 1 0 1 1
## X0.8 X1.21 X1.22 X0.9 X1.23 X1.24 X1.25
## 1 0 1 1 0 0 1 1
## 2 1 1 1 1 1 0 1
## 3 1 1 1 1 1 0 1
## 4 1 0 1 0 0 1 1
## 5 1 1 1 1 0 0 1
## 6 0 1 0 1 1 1 1
names(dtaHW4) <- c("ID", paste("Item", 1:35, sep = ""))
head(dtaHW4)
## ID Item1 Item2 Item3 Item4 Item5 Item6 Item7 Item8 Item9 Item10 Item11 Item12
## 1 2 1 1 1 1 1 1 1 1 1 1 1 1
## 2 3 1 1 1 1 1 1 1 1 1 1 1 1
## 3 4 1 1 1 0 1 1 1 1 1 1 1 1
## 4 5 1 1 1 1 1 1 1 1 1 1 1 0
## 5 6 1 1 1 1 1 1 1 1 1 0 1 1
## 6 7 0 1 0 0 1 1 1 1 0 1 1 0
## Item13 Item14 Item15 Item16 Item17 Item18 Item19 Item20 Item21 Item22 Item23
## 1 0 1 1 0 1 1 1 1 1 0 1
## 2 1 1 1 1 1 1 1 1 0 1 1
## 3 1 1 0 0 0 1 0 1 0 1 1
## 4 1 1 0 0 1 1 0 1 0 0 1
## 5 1 1 1 1 1 1 1 1 0 0 1
## 6 1 0 1 0 1 1 1 1 0 0 1
## Item24 Item25 Item26 Item27 Item28 Item29 Item30 Item31 Item32 Item33 Item34
## 1 1 1 1 1 1 0 1 1 0 0 1
## 2 1 1 1 1 1 1 1 1 1 1 0
## 3 0 1 1 0 0 1 1 1 1 1 0
## 4 1 0 0 0 0 1 0 1 0 0 1
## 5 0 1 1 1 1 1 1 1 1 0 0
## 6 1 1 0 1 1 0 1 0 1 1 1
## Item35
## 1 1
## 2 1
## 3 1
## 4 1
## 5 1
## 6 1
dta_4 <- dtaHW4[,-1]
library(ltm)
## Loading required package: MASS
## Loading required package: msm
## Loading required package: polycor
library(tidyr)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following object is masked from 'package:MASS':
##
## select
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(knitr)
dtaL <- gather(data=dtaHW4, key=Item, value=Response, Item1:Item35, factor_key=TRUE)
kable(head(arrange(dtaL, ID), 10))
| ID | Item | Response |
|---|---|---|
| 2 | Item1 | 1 |
| 2 | Item2 | 1 |
| 2 | Item3 | 1 |
| 2 | Item4 | 1 |
| 2 | Item5 | 1 |
| 2 | Item6 | 1 |
| 2 | Item7 | 1 |
| 2 | Item8 | 1 |
| 2 | Item9 | 1 |
| 2 | Item10 | 1 |
plot(descript(dta_4),
ylim=c(0,1),
type='b',
main="Item response curves")
grid()
library(dplyr)
library(ggplot2)
dtaHW4 <- dtaHW4 %>%
mutate(total = rowSums(dtaHW4[ ,2:36]))
descript: Computes descriptive statistics for dichotomous and polytomous response matrices. sperc:
a numeric matrix containing the percentages of negative and positive responses for each item.
If data contains only dichotomous manifest variables the logit of the positive responses
(i.e., second row) is also included.
knitr::kable(descript(dta_4)$perc)
| 0 | 1 | logit | |
|---|---|---|---|
| Item1 | 0.4773869 | 0.5226131 | 0.0905140 |
| Item2 | 0.4422111 | 0.5577889 | 0.2321934 |
| Item3 | 0.2261307 | 0.7738693 | 1.2302901 |
| Item4 | 0.4170854 | 0.5829146 | 0.3347496 |
| Item5 | 0.1859296 | 0.8140704 | 1.4766784 |
| Item6 | 0.2713568 | 0.7286432 | 0.9877497 |
| Item7 | 0.1457286 | 0.8542714 | 1.7685026 |
| Item8 | 0.3869347 | 0.6130653 | 0.4602156 |
| Item9 | 0.4874372 | 0.5125628 | 0.0502618 |
| Item10 | 0.2914573 | 0.7085427 | 0.8883169 |
| Item11 | 0.1859296 | 0.8140704 | 1.4766784 |
| Item12 | 0.5376884 | 0.4623116 | -0.1510403 |
| Item13 | 0.4924623 | 0.5075377 | 0.0301530 |
| Item14 | 0.4572864 | 0.5427136 | 0.1712717 |
| Item15 | 0.7085427 | 0.2914573 | -0.8883169 |
| Item16 | 0.6482412 | 0.3517588 | -0.6113172 |
| Item17 | 0.6582915 | 0.3417085 | -0.6556896 |
| Item18 | 0.5879397 | 0.4120603 | -0.3554547 |
| Item19 | 0.4773869 | 0.5226131 | 0.0905140 |
| Item20 | 0.3467337 | 0.6532663 | 0.6334279 |
| Item21 | 0.7989950 | 0.2010050 | -1.3800247 |
| Item22 | 0.6180905 | 0.3819095 | -0.4814510 |
| Item23 | 0.5979899 | 0.4020101 | -0.3970969 |
| Item24 | 0.6432161 | 0.3567839 | -0.5893504 |
| Item25 | 0.4020101 | 0.5979899 | 0.3970969 |
| Item26 | 0.6633166 | 0.3366834 | -0.6781093 |
| Item27 | 0.6130653 | 0.3869347 | -0.4602156 |
| Item28 | 0.6281407 | 0.3718593 | -0.5242486 |
| Item29 | 0.7587940 | 0.2412060 | -1.1460788 |
| Item30 | 0.4120603 | 0.5879397 | 0.3554547 |
| Item31 | 0.6884422 | 0.3115578 | -0.7928465 |
| Item32 | 0.6733668 | 0.3266332 | -0.7234525 |
| Item33 | 0.6733668 | 0.3266332 | -0.7234525 |
| Item34 | 0.8090452 | 0.1909548 | -1.4438182 |
| Item35 | 0.6231156 | 0.3768844 | -0.5027935 |
library(knitr)
library(tidyr)
library(dplyr)
Fit logit data with Rasch model
coef(rm0 <- ltm::rasch(dta_4, constraint=cbind(ncol(dta_4)+1, 1)))[,1]
## Item1 Item2 Item3 Item4 Item5 Item6
## -0.10407477 -0.26488466 -1.38968560 -0.38189823 -1.66212902 -1.11915346
## Item7 Item8 Item9 Item10 Item11 Item12
## -1.98189471 -0.52451655 -0.05803978 -1.00871959 -1.66126440 0.17107171
## Item13 Item14 Item15 Item16 Item17 Item18
## -0.03504463 -0.19579527 1.00792757 0.69473347 0.74503972 0.40428625
## Item19 Item20 Item21 Item22 Item23 Item24
## -0.10368156 -0.72044376 1.55820985 0.54790724 0.45172470 0.67020506
## Item25 Item26 Item27 Item28 Item29 Item30
## -0.45275060 0.77060216 0.52367622 0.59636615 1.29655707 -0.40544436
## Item31 Item32 Item33 Item34 Item35
## 0.90053616 0.82209517 0.82208312 1.62900136 0.57199802
summary(rm0)
##
## Call:
## ltm::rasch(data = dta_4, constraint = cbind(ncol(dta_4) + 1,
## 1))
##
## Model Summary:
## log.Lik AIC BIC
## -4184.549 8439.098 8554.364
##
## Coefficients:
## value std.err z.vals
## Dffclt.Item1 -0.1041 0.1677 -0.6206
## Dffclt.Item2 -0.2649 0.1684 -1.5730
## Dffclt.Item3 -1.3897 0.1927 -7.2131
## Dffclt.Item4 -0.3819 0.1693 -2.2555
## Dffclt.Item5 -1.6621 0.2045 -8.1294
## Dffclt.Item6 -1.1192 0.1835 -6.1003
## Dffclt.Item7 -1.9819 0.2219 -8.9295
## Dffclt.Item8 -0.5245 0.1709 -3.0690
## Dffclt.Item9 -0.0580 0.1676 -0.3463
## Dffclt.Item10 -1.0087 0.1804 -5.5927
## Dffclt.Item11 -1.6613 0.2044 -8.1268
## Dffclt.Item12 0.1711 0.1680 1.0185
## Dffclt.Item13 -0.0350 0.1676 -0.2091
## Dffclt.Item14 -0.1958 0.1680 -1.1653
## Dffclt.Item15 1.0079 0.1806 5.5814
## Dffclt.Item16 0.6947 0.1737 3.9999
## Dffclt.Item17 0.7450 0.1746 4.2668
## Dffclt.Item18 0.4043 0.1696 2.3831
## Dffclt.Item19 -0.1037 0.1677 -0.6183
## Dffclt.Item20 -0.7204 0.1740 -4.1415
## Dffclt.Item21 1.5582 0.1999 7.7952
## Dffclt.Item22 0.5479 0.1714 3.1972
## Dffclt.Item23 0.4517 0.1702 2.6547
## Dffclt.Item24 0.6702 0.1733 3.8682
## Dffclt.Item25 -0.4528 0.1700 -2.6626
## Dffclt.Item26 0.7706 0.1751 4.4007
## Dffclt.Item27 0.5237 0.1710 3.0616
## Dffclt.Item28 0.5964 0.1721 3.4657
## Dffclt.Item29 1.2966 0.1895 6.8424
## Dffclt.Item30 -0.4054 0.1695 -2.3914
## Dffclt.Item31 0.9005 0.1779 5.0617
## Dffclt.Item32 0.8221 0.1762 4.6667
## Dffclt.Item33 0.8221 0.1762 4.6666
## Dffclt.Item34 1.6290 0.2031 8.0198
## Dffclt.Item35 0.5720 0.1717 3.3311
## Dscrmn 1.0000 NA NA
##
## Integration:
## method: Gauss-Hermite
## quadrature points: 21
##
## Optimization:
## Convergence: 0
## max(|grad|): 0.036
## quasi-Newton: BFGS
p1<-rm0
plot(rm0)
rm0
##
## Call:
## ltm::rasch(data = dta_4, constraint = cbind(ncol(dta_4) + 1,
## 1))
##
## Coefficients:
## Dffclt.Item1 Dffclt.Item2 Dffclt.Item3 Dffclt.Item4 Dffclt.Item5
## -0.104 -0.265 -1.390 -0.382 -1.662
## Dffclt.Item6 Dffclt.Item7 Dffclt.Item8 Dffclt.Item9 Dffclt.Item10
## -1.119 -1.982 -0.525 -0.058 -1.009
## Dffclt.Item11 Dffclt.Item12 Dffclt.Item13 Dffclt.Item14 Dffclt.Item15
## -1.661 0.171 -0.035 -0.196 1.008
## Dffclt.Item16 Dffclt.Item17 Dffclt.Item18 Dffclt.Item19 Dffclt.Item20
## 0.695 0.745 0.404 -0.104 -0.720
## Dffclt.Item21 Dffclt.Item22 Dffclt.Item23 Dffclt.Item24 Dffclt.Item25
## 1.558 0.548 0.452 0.670 -0.453
## Dffclt.Item26 Dffclt.Item27 Dffclt.Item28 Dffclt.Item29 Dffclt.Item30
## 0.771 0.524 0.596 1.297 -0.405
## Dffclt.Item31 Dffclt.Item32 Dffclt.Item33 Dffclt.Item34 Dffclt.Item35
## 0.901 0.822 0.822 1.629 0.572
## Dscrmn
## 1.000
##
## Log.Lik: -4184.549
empirical cumulative distribution function
plot(ecdf(p1$coefficients))
dtaLp <- prop.table(with(dtaL, ftable(Item,Response)), 1)
# set the data frame
dtaLp <- as.data.frame(dtaLp)
dtaLp2 <- subset(dtaLp, Response=="1")
dta04<-dtaLp2%>% mutate(Freq=log(Freq))
plot(ecdf(dta04$Freq))