---
title: "UWO-Poly2-BFI25"
author: "Larry Nelson (l.nelson@curtin.edu.au)"
date: "1 August 2018"
output: html_document
##output: word_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, comment=NA)
library(psych)
library(ltm)
this.dir <- function(directory)
setwd(file.path(getwd(),directory))
```
***
#### Module 'UWO-2': polytomous IRT analyses

This report is based on a paper by Rachael Smyth, University of Western Ontario, UWO. A copy of her paper, 'Item Response Theory for Polytomous Items', might be [available here](http://www.uwo.ca/fhs/tc/labs/12.PolytomousIRT.pdf). The paper's code was integrated into an Rmd code module assembled by Larry Nelson, Curtin University, Western Australia (l.nelson@curtin.edu.au), last updated 1 August 2018.

Data will now be read in from the BFI-25 study, and a few of the initial data records will be displayed:

```{r, include=TRUE}
data(bfi)
bfi.items <- bfi[,1:25]
head (bfi.items) 

```

The graded response model, 'GRM',  model will be fit, constraining all 25 BFI items to have the same discrimination. This will be referred to as 'fit1'.

```{r echo=FALSE}
## fit1 <- grm(bfi.items, constrained = TRUE)
## fit1
```

Then the 25 BFI items will be broken down into their five distinct scales, 'agreeableness', 'conscienciousness', 'extraversion", 'neuroticism', and 'openess'. (Each of these scales has five items.)

The GRM will be used again, creating fit1.agree, fit1.conc, fit1.extra, fit1.neuro, and fit1.open, with all items in all five scales constrained to have the same discrimination.

```{r}
fit1.agree <- grm(bfi.items[,1:5], constrained = TRUE)
fit1.consc <- grm(bfi.items[,6:10], constrained = TRUE)
fit1.extra <- grm(bfi.items[,11:15], constrained = TRUE)
fit1.neuro <- grm(bfi.items[,16:20], constrained = TRUE)
fit1.open <- grm(bfi.items[,21:25], constrained = TRUE)
```

Here are results for the fit1.agree model:

```{r}
fit1.agree
```

Next, the model will be changed so that the items are free to have their own discrimination index; results will be displayed for two scales: the unconstrained 'agreeableness"" scale, and the unconstrained 'nuerotic" scale (referred to as 'fit2' models) 

```{r}
fit2.agree <- grm(bfi.items[,1:5], constrained = FALSE)
fit2.consc <- grm(bfi.items[,6:10], constrained = FALSE)
fit2.extra <- grm(bfi.items[,11:15], constrained = FALSE)
fit2.neuro <- grm(bfi.items[,16:20], constrained = FALSE) 
fit2.open <- grm(bfi.items[,21:25], constrained = FALSE)
fit2.agree # results for unconstrained 'agreeableness' scale
fit2.neuro
```

At this point, we have two models for each scale, constrained ('fit1'), and unconstrained ('fit2'). 

We can use the 'anova' function within each scale to see if the unconstrained model fits the data better. If it does, the p value will be less than 0.05.

A reference for these fit statistics is [this Wikipedia page](https://en.wikipedia.org/wiki/Akaike_information_criterion).

```{r}
anova(fit1.agree,fit2.agree)
anova(fit1.consc,fit2.consc)
anova(fit1.extra,fit2.extra)
anova(fit1.neuro,fit2.neuro)
anova(fit1.open,fit2.open)
```

Item response characteristic curves for the five 'agreeableness' items are shown below.

```{r}
plot(fit2.agree, lwd = 2, cex = 0.8, legend = TRUE, cx = "topright",
xlab = "Agreeableness", cex.main = 1, cex.lab = 1, cex.axis = 1)
```

Next: item information curves for the five unconstrained 'agreeableness' items.

```{r}
plot(fit2.agree, type = "IIC", lwd = 2,
cex = 0.8, legend = TRUE,
cx = "topleft", xlab = "Agreeableness", cex.main = 1, cex.lab = 1, cex.axis = 1)
```

And, the test information function for the unconstrained 'agreeableness' scale (all five items are included):

```{r}
plot(fit2.agree, type = "IIC", items = 0,
lwd = 2, xlab = "Agreeableness", cex.main = 1, cex.lab = 1, cex.axis = 1)
```
***

Item response characteristic curves for the five unconstrained 'neuroticism' items are shown below.

```{r}
plot(fit2.neuro, lwd = 2, cex = 0.8, legend = TRUE, cx = "topright",
xlab = "Neuroticism", cex.main = 1, cex.lab = 1, cex.axis = 1)
```

Next: item information curves for the five unconstrained 'neuroticism' items.

```{r}
plot(fit2.neuro, type = "IIC", lwd = 2,
cex = 0.8, legend = TRUE,
cx = "topleft", xlab = "Neuroticism", cex.main = 1, cex.lab = 1, cex.axis = 1)
```

And, the test information function for the unconstrained 'neuroticism' scale (all five items are included):

```{r}
plot(fit2.neuro, type = "IIC", items = 0,
lwd = 2, xlab = "Neuroticism", cex.main = 1, cex.lab = 1, cex.axis = 1)
```

***
THE END!