---
title: "DiBello Models"
author: "Russell Almond"
date: "June 4, 2021"
output:
  ioslides_presentation: default
  html_document:
    df_print: paged
  slidy_presentation: default
  pdf_document: default
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(arm)
```

## Parameterized Bayesian Networks

* In a discrete Bayesian Network, the _parameters_ are the _conditional probability tables_ (CPTs).

* Size of CPT grows exponentially with number of parents.

* In educational models, CPTs should be monotonic:  higher skill states should imply higher probability of success.

* When learning CPTs from data, if skill variables are correlated certain combinations will be rare in data:
    + Skill 1 is high and Skill 2 is low
    + Skill 2 is low and Skill 1 is high
    + This makes for low effective sample size (high standard errors) when estimating CPTs from data.

# Conditional Probability Tables

## Lets Make a some Simple CPTs

Load PNetica (which loads Peanut and CPTtools), and start session.
Build a blank Network.
```{r launch PNetica}
library(PNetica)
sess <- NeticaSession()
startSession(sess)
tNet <- CreateNetwork("tNet",sess)
```
The following packages are loaded.

* `CPTtools` -- Tools for building Conditional Probability Tables.
* `RNetica` -- Interface to Netica
* `Peanut` -- Object-oriented parameterized network protocol.
* `PNetica` -- Peanut implementation for Netica

## Create a Simple Network.


Create two parent nodes:  Skill1 and Skill2, and a child node, CRItem.

```{r create nodes}
Skills <- NewDiscreteNode(tNet,paste("Skill",1:2,sep=""),c("H","M","L"))
CRItem <- NewDiscreteNode(tNet,"CRItem",c("FullCredit","PartialCredit","NoCredit"))
NodeParents(CRItem) <- Skills
NodeParents(Skills[[2]]) <- Skills[1]
```
## The Shape of CPTs

Skill1 has no parents, so unconditional CPT.
```{r Skill1}
Skills[[1]][]
```
Node that in RNetica the `[]` operator can be used to access the CPT of a node.

## Conditional Probability Table
Skill2 has one parent, so conditional CPT.
```{r Skill2}
Skills[[2]][]
```

## Multiple Parents

CRItem has two parents, for total of nine (3x3) rows.
```{r CRItem}
CRItem[]
```

## The [<- operator for NeticaNodes

RNetica maps the assignment operator for `[]` (`[<-`) to provide a wide variety of behaviors.

Both `[` and `[<-` allow the user to specify a specific row or cell, or group of rows and cells.  This is similar, but not quite the same as the `[` operator behavior for matrixes and data frames.

Single Row:
```{r Single Row}
CRItem[Skill1="H",Skill2="H"] <- c(.7,.2,.1)
CRItem["H","H"]
```

## Conditional Tables

Multiple Rows:
```{r Multiple Row}
CRItem[Skill2="M"] <- c(.25,.5,.25)
CRItem["M",c("H","M")] <-c(.25,.5,.25)
CRItem[,"M"]
CRItem["M",]
```
## Fill out a conjunctive model.

```{r df selection}
CRItem["L",] <- c(.1,.2,.7)
CRItem[,"L"] <- c(.1,.2,.7)
CRItem[]
```

## Conditional Probability Frames and Conditional Proability Arrays

When there are two or more parent variables, there are two possible views of the CPT:

* _Conditional Probability Frame_ (CPF) which is a data frame where rows represent configurations of parent variables.

    + First $p$ columns represent parent configuration

    + Last $|States|$ columns represent child states.

    + Numeric part is the conditional probability table

        - Note:  `calcXXXFrame()` and `calcXXXTable()` methods in CPTtools

    + CPFs can be used on the RHS of `[<-` operator for NeticaNodes, to set the CPT.

## Array view

* _Conditional Probability Array_ (CPA) which is $p+1$ dimenional array.

The functions `as.CPF` and `as.CPA` convert back and forth between the two views:
```{r CPA}
as.CPA(CRItem[])
```

## Graphing a conditional probability table.

The function `barchart.CPF` (which extends the lattice function `barchart`) will build a visualization of the CPF.

The `baseCol` argument can be any R color specification, it is then used as the base color for the graph.

## Barchart

```{r barchart}
barchart.CPF(CRItem[],baseCol="chocolate")
```

## How far have we come?

* The `[]` function for NeticaNodes is a very convenient way for accessing and manipulating CPTs

* It uses a data-frame representation, the _CPF_

* If we can make a CPF, we can set the table for a node.

* The package `CPTtools` is all about making CPFs!

# The DiBello Models

## A Short History

* When building CPT for Biomass, Lou DiBello had an idea.
* Map each row of the CPT onto an _effective Theta_
* Then use IRT model (Samejima's Graded Response) to calculate CPTs for each row.
* For multivariate parents, use a _structure function_ or _combination rule_ to combine indivitual effective thetas for each parent into a single effective theta.
    + _Compensatory_:  (weighted) average of parents
    + _Conjunctive_: minimum of parents
    + _Disjunctive_: maximum of parents

## The DiBello procedure:  Effective Thetas

1  Map the states of the parent variables onto the standard normal
(theta) scale. 
 
```{r effectiveThetas}
effectiveThetas(2)
effectiveThetas(3)
effectiveThetas(4)
```
## Setting Effective Thetas

The function `PnodeStateValues()` sets the effective Thetas for a
node.

The function `ParentNodeTVals()` fetches the effective Thetas for the

```{r set effective Thetas, eval=FALSE}
PnodeStateValues(Skills[[1]]) <- effectiveThetas(PnodeNumStates(Skills[[1]]))
```


## DiBello Procedure:  Combination Rules

2  Combine the parent variables using a _combination rule_ to create a single effective theta for each row.

    + The combination rule generally has slope (discrimination)
	parameters ($\alpha$'s or $a$'s)
	
    + The combination rule generally has difficulty (demand, -intercept)
	parameters ($\beta$'s or $b$'s)
	
    + Some rules (e.g., `Compensatory`) have multiple-a's, some (e.g.,
	`OffsetConjuctive`) have multiple-b's
	
    + Some link functions allow (or even require) different b's for
	each state of the child variable (step difficulties).
	
    + The partial credit link function allows different a's as well.

## DiBello Procedure 3:

3 Convert the effective thetas to conditional probabilities using a
_link function_ (IRT-like models)

    + `gradedResponse` -- Lou's original suggestion
    + `partialCredit` -- More flexible alternative
    + `normalLink` -- Regression-like model for proficiency variables.
        - Requires a _link scale parameters_

The function `calcDPCFrame` in the CPTtools package does the work.
(DPC = Discrete Partial Credit) 

## Mapping Parent States onto the Theta Scale

* Effective theta scale is a logit scale corresponds to mean 0 SD 1 in a “standard” population.

* Want the effective theta values to be equally spaced on this scale

* Want the marginal distribution implied by the effective thetas to be uniform (unit of the combination operator)

*What the effective theta transformation to be effectively invertible
(this is reason to add the 1.7 to the IRT equation). 

## Equally spaced points in Normal Measure

* Assume variable has $M$ states:  $0, \ldots, M-1$
* Region $m$ will have lower bound $m/M$ quantile and upper bound at $(m+1)/M$ quantile.
* Midpoint will be at $(m+\frac{1}{2})/M$ quantile

```{r normal quantiles, echo=FALSE}
states <- c("Low","Medium","High")
M <- length(states)
c <- qnorm((1L:(M-1L))/M,0,1)
theta <- qnorm((1L:M -.5)/M,0,1)
curve(dnorm(x),xlim=c(-3,3),xaxt="n",yaxt="n",ylim=c(0,.5),col="red",
      ylab="",xlab="Effective Theta")
segments(c,-.1,c,.6)
segments(theta,-.1,theta,dnorm(theta))
text(theta,.45,states)
axis(1,theta, do.call(expression,
                      lapply(1:M, function (m)
                        substitute(tilde(theta)[m],list(m=m)))))
```

## Setting up effective Thetas

The function `effectiveThetas` calculates this.
```{r effective Theta}
effectiveThetas
effectiveThetas(3)
## We will need this for building CPTs later.
PnodeStateValues(Skills[[1]]) <- effectiveThetas(PnodeNumStates(Skills[[1]]))
PnodeStateValues(Skills[[2]]) <- effectiveThetas(PnodeNumStates(Skills[[2]]))

```
## Combination Rules

* `Compensatory` – more of one skill compensates for lack of another
* `Conjunctive` – weakest skill dominates relationship
* `Disjunctive` – strongest skill dominates relationship
* Inhibitor – minimum threshold of Skill 1 needed, then Skill 2 takes over (special case of conjuctive)
Multi-b rules:
* `OffsetConjunctive` – like conjunctive model, but with separate $b$’s for each parent instead of separate $a$’s
* `Offset Disjunctive` – like disjunctive rule, but with separate $b$’s for each parent instead of separate $a$’s.

## Compensatory Rule

* Weighted average of inputs
* One $\alpha$ (slope) for each parent variable ($k$) and state ($s$):  $\alpha_{k,s}$
* One $\beta$ (difficulty) for each state of the child variable (except the last):  $\beta_s$

$$ \tilde\theta = \frac{1}{\sqrt{K}} \sum_k \alpha_{k,s}\tilde\theta_{k,m_k} - \beta_s$$
* Factor $1/\sqrt{K}$ is a variance stabilization term.  (Make variance independent of number of parents.)

## Conjunctive and Disjunctive Rules (Multi-a)

* Replace sum (and square root of K) with `min` or `max`
* Conjunctive:  All skills needed; weakest skill dominates

$$ \tilde\theta = \min_k \alpha_{k,s}\tilde\theta_{k,m_k} - \beta_s$$

* Disjunctive:  Any skills needed; strongest skill dominates

$$ \tilde\theta = \max_k \alpha_{k,s}\tilde\theta_{k,m_k} - \beta_s$$

*  Not sure what the different slopes mean in this context

## Conjunctive and Disjunctive Rules (Multi-b)

* Different skills may have different demands in a task
    + Skill 1 must be high, but Skill 2 only medium
* Model this with different difficulties ($b$'s) for each parent skill.
* OffsetConjunctive:  All skills needed; weakest skill dominates

$$ \tilde\theta =  \alpha_{s}\min_k\left(\tilde\theta_{k,m_k} - \beta_{k,s} \right)$$


* Disjunctive:  Any skills needed; strongest skill dominates

$$ \tilde\theta =  \alpha_{s}\max_k\left(\tilde\theta_{k,m_k} - \beta_{k,s} \right)$$



## Implementation in CPTtools

* `Compensatory`, `Conjunctive`, `Disjunctive`, `OffsetConjunctive` and `OffsetDisjunctive` are implemented as functions in CPTtools

    +  This set is expandable by adding new functions with the same signature

* The function `eThetaFrame` demonstrates how this works.
* Note:  Uses $\log(\alpha)$ rather than $\alpha$ as slope parameter.

```{r compensatory eTheta, echo=TRUE}
eThetaFrame(ParentStates(CRItem),log(c(Skill1=1.0,Skill2=.8)),.5,
            Compensatory)
```
Try changing the slopes and intercepts

## Offset Style Rules:

Almost the same, except now we expect beta to be a vector instead of alpha.
```{r conjunctive eTheta, echo=TRUE}
eThetaFrame(ParentStates(CRItem),log(1),c(Skill1=.5,Skill2=-.75),
            OffsetConjunctive)
```
Try changing the slopes and intercepts, and changing the rule for
`OffSetDisjunctive` 

## Link Functions

* Graded Response Model
* Normal (Regression) Model
* Partial Credit Model
* 2PL (Special case of graded response or partial credit)


## Graded Response model

+ Models $\Pr(X \ge s)$
+ Probabilities are differences between curves
+ To keep the curves from crossing, discrimination parameters must be
  the same for all $s$ 

```{r GR link, eval=FALSE}
anode <- NewDiscreteNode(tNet,"anode")
PnodeLink(anode) <- "gradedResponse"
```

## Normal (Regression) model

+ Effective theta is mean predictor
+ Add a residual variance (link scale parameter)
+ Calculate probabilities that value falls into certain regions

```{r normal link, eval=FALSE}
PnodeLink(anode) <- "normalLink"
PnodeLinkScale(anode) <- 1
```


## Generalized partial credit model
+ Models state transitions:  $\Pr(X \ge s | X \ge s-1)$
+ Does not need the discrimination parameters to be the same
+ Does not even need the combination rules to be the same

```{r GR, eval=FALSE}
PnodeLink(anode) <- "partialCredit"
anode <- Pnode(anode) ## Partial credit is the default.
```


## Graded Response (DiBello--Samejima models)

Samejima's (1969) psychometric model for graded responses

$$\Pr(X_{i,j} \ge k|\theta_i) = {\rm logit}^{-1}(1.7(a_j\theta_i - b_{j,k}))$$

$$\Pr(X_{i,j}=k|\theta_i) = \Pr(X_{i,j} \ge k|\theta_i) - \Pr(X_{i,j} \ge k+1|\theta_i)$$

```{r Samejima curves, echo=FALSE}
a <- 1
b <- c(-1,+1)
thetas <- seq(-4,4,.025)
P1 <- invlogit(a*thetas-b[1])
P2 <- invlogit(a*thetas-b[2])
layout(matrix(1:2),2,1)
plot(thetas,P1,ylab="Probability",col="firebrick",type="l")
lines(thetas,P2,col="steelblue")
p0 = 1 - P1
p1 = P1 - P2
p2 = P2
plot(thetas,p0,ylab="Probability",col="firebrick",type="l")
lines(thetas,p1,col="steelblue")
lines(thetas,p2,col="seagreen")
```


## Continuous -> Discrete

Evaluate Samejima's graded response model at the effective theta values.

```{r Samejima link function, echo=FALSE}
a <- 1
b <- c(-1,+1)
thetas <- seq(-4,4,.025)

P1 <- invlogit(a*thetas-b[1])
P2 <- invlogit(a*thetas-b[2])
p0 = 1 - P1
p1 = P1 - P2
p2 = P2

plot(thetas,p0,ylab="Probability",col="firebrick",type="l")
lines(thetas,p1,col="steelblue")
lines(thetas,p2,col="seagreen")
ethetas <- c(Low=-1.8, Med=-.4, High=1)
P1e <- invlogit(a*ethetas-b[1])
P2e <- invlogit(a*ethetas-b[2])
p0e = 1 - P1e
p1e = P1e - P2e
p2e = P2e
abline(v=ethetas)
points(ethetas,p0e,col="firebrick")
points(ethetas,p1e,col="steelblue")
points(ethetas,p2e,col="seagreen")
data.frame(Theta=ethetas,
           State2=round(p2e,3),State1=round(p1e,3),
           State0=round(p0e,3))

```

## Representing Graded Response Models in Peanut

* Peanut is a framework that allows us to attach the parameters to nodes in the graph.
    + PNetica implements this for NeticaNode objects
* `PnodeLink(node)` accesses the link function
    + Should have value "gradedResponse" for graded response models.
* `PnodeRules(node)` accesses the rules.
    + For now, stick to multiple-a types:  `Compensatory`, `Conjunctive` and `Disjunctive`.

## Setting the parameters

* `PnodeLnAlphas(node)` or `PnodeAlphas(node)` gives the slope parameters.
    + This should be a vector which components corresponding to the parents.
    + In general, vectors are used to represent multiple parents.
* `PnodeBetas(node)` gives the difficulty parameters.
    + This should be a _list_ with one fewer elements than there are states (the last state is used for normalization).
    + In general, lists are used to represent multiple states.

## Building the Table

* `BuildTable(node)` builds the table.
    + `NodeLevels` of parents need to be set.
    + `NodePriorWeight` (used in learning algorithm) needs to be set.

```{r graded response Peanut, echo=TRUE}

CRItem <- Pnode(CRItem) ## Force into Pnode protocol.
PnodeLink(CRItem) <- "gradedResponse"
PnodeRules(CRItem) <- "Compensatory"
PnodeAlphas(CRItem) <- c(1.2,.8)
PnodeBetas(CRItem) <- list(.25, -.25)
PnodePriorWeight(CRItem) <- 10 ## Used for learning
calcDPCFrame(ParentStates(CRItem),PnodeStates(CRItem),
             PnodeLnAlphas(CRItem),PnodeBetas(CRItem),
             PnodeRules(CRItem),PnodeLink(CRItem))
BuildTable(CRItem)
```
```{r Compensatory gadget, eval=FALSE}
CRItem <- CompensatoryGadget(CRItem)
CRItem[]

```

## Don't Cross the curves!

> **Egon Spengler**: There's something very important I forgot to tell you.

> **Peter Venkman**: What?

> **Egon**: Don't cross the streams.

> **Venkman**: Why?

> **Egon**: It would be bad.

> **Venkman**: I'm fuzzy on the whole good/bad thing. What do you mean,  "bad"?

> **Egon**: Try to imagine all life as you know it stopping instantaneously, and every molecule in your body exploding at the speed of light.

> **Ray Stantz**: [shocked gasp] Total protonic reversal.

> **Venkman**: Right. That's bad. Okay. All right. Important safety tip.  Thanks, Egon.

>  _Ghostbusters_

## Graded Response when the curves cross

Actually, not as bad as crossing the proton beams, can produce negative probabilities.

CPTtools corrects, but still puts restrictions on parameters.

In particular, must have a common discrimination for all states of the
child variable to ensure curves don't cross. 

## Downslide of Graded Response Model

* Need to keep curves from crossing restricts discrimination parameter

    + In _Physics Playground (v. 1)_ for some levels difference
      between **Silver** trophy and **Gold** trophy had more evidence
      (higher discrimination) than difference between **Silver** and
      **none** 

    + All steps must have the same parent variables and the same
      combination rule. 

* Models probability of achieving certain level of performance, not step
  between levels. 

* Generalized Partial Credit (GPC) model does not have these downsides.

* Note Graded Response and GPC are the same when child variable has
  only two states. 

## Normal (Regression) Model

* As with effective theta transformation, start by dividing theta region up into equally spaced intervals
* Calculate offset curve:
    + mean is effective theta
    + SD, $s$, is _link scale parameter_
*Conditional probabilities:
    +  area under curve between cut points

```{r normal offset, echo=FALSE}
states <- c("Low","Medium","High")
M <- length(states)
c <- qnorm((1L:(M-1L))/M,0,1)
thetas <- qnorm((1L:M -.5)/M,0,1)
curve(dnorm(x),xlim=c(-3,3),xaxt="n",yaxt="n",ylim=c(0,.5),col="red",
      ylab="",xlab="Effective Theta")
segments(c,-.1,c,.6)
text(thetas,.45,states)
axis(1,c, do.call(expression,
                      lapply(1:(M-1), function (m)
                        substitute(c[m],list(m=m)))))
theta <- .5
sig <- .8
curve(dnorm(x,theta,sig),col="sienna",add=TRUE)
cc <- seq(c[1],c[2],.025)
polygon(c(c[1],cc,c[2]),c(0,dnorm(cc,theta,sig),0),angle=45,col="sienna2")
cplus <- c(-Inf,c,Inf)
pvals <- diff(pnorm(cplus,theta,sig))
names(pvals) <- states
pvals
```

0
## Normal Link (Regression Model) features

* Link function is inverse of the mapping from states to effective thetas
    + Rounding error, but no scale distortion
    + Good for proficiency variables
* Can be used for no parent case.
* Often better to use intercept (negative difficulty) rather than difficulty.
* Can use $R^2$ instead of the link scale parameter, $\sigma$

$$ R^2 = \frac{1/K \sum_k \alpha_{k,s}^2}
{1/K \sum_k \alpha_{k,s}^2 +\sigma^2} $$

* Note:  Latent (tetrachoric) correlations, not observed score correlations
* Can use factor analysis output to get model structure and parameters (Almond, 2010)

## Normal Link:  No Parent case

* `PnodeLink(node)` is now "normalLink"
* Now need `PnodeLinkScale(node)`, residual standard deviation ($\sigma$)
* Rule doesn't matter, use `PnodeRules(node)="Compensatory"`
* Should be only one `PnodeBeta(node)`

```{r normal link, no parents}

Skill1 <- Pnode(Skills[[1]]) ## Force into Pnode protocol.
PnodeLink(Skill1) <- "normalLink"
PnodeLinkScale(Skill1) <- .8
PnodeRules(Skill1) <- "Compensatory"
PnodeAlphas(Skill1) <- numeric()
PnodeBetas(Skill1) <- list(.25)
PnodePriorWeight(Skill1) <- 10 ## Used for learning
BuildTable(Skill1)
calcDPCFrame(ParentStates(Skill1),PnodeStates(Skill1),
             PnodeLnAlphas(Skill1),PnodeBetas(Skill1),
             PnodeRules(Skill1),PnodeLink(Skill1),
             PnodeLinkScale(Skill1))
```
## Regression Gadget, no parents

```{r Regression Gadget, eval=FALSE}
Skill1 <- RegressionGadget(Skill1)
Skill1[]
```
## Normal Link:  One Parent case

* `PnodeLink(node)` is now "normalLink"
* Now need `PnodeLinkScale(node)`, residual standard deviation ($\sigma$)
* Works best with `PnodeRules(node)="Compensatory"`
* Should be only one `PnodeBeta(node)`

```{r normal link, one parent}

Skill2 <- Pnode(Skills[[2]]) ## Force into Pnode protocol.
PnodeLink(Skill2) <- "normalLink"
PnodeLinkScale(Skill2) <- .6
PnodeRules(Skill2) <- "Compensatory"
PnodeAlphas(Skill2) <- c(.8)
PnodeBetas(Skill2) <- list(-.25)
PnodePriorWeight(Skill2) <- 10 ## Used for learning
BuildTable(Skill2)
calcDPCFrame(ParentStates(Skill2),PnodeStates(Skill2),
             PnodeLnAlphas(Skill2),PnodeBetas(Skill2),
             PnodeRules(Skill2),PnodeLink(Skill2),
             PnodeLinkScale(Skill2))
```
## Regression Gadget, multiple parents

```{r Regression Gadget 2,eval=FALSE}
Skill2 <- RegressionGadget(Skill2)
Skill2[]
```


## Partial Credit Models

* Observable variable takes on states $0, \ldots, S$
* Model transition probabilities:

$$P_{s|s-1}(\tilde{\bf \theta}) = \Pr(X \ge s | X \ge s-1, \tilde{\bf \theta}) =
{\rm logit}^{-1} 1.7 Z_s(\tilde{\bf \theta})  $$ 

* Define $Z_0()=0$.
* $Z_s()$ can vary will $s$:
    + Different parameters
    + Different functional forms
    + Can easily switch between multi-a and multi-b combination rules
    + Can use only a subset of the parents!
* Need to define combination rule and parameters for each state (except state 0).
* `PnodeLnAlphas`,`PnodeBetas` and `PnodeRules` are now lists (one element per state)

## Partial Credit Link:

* Probability of $X$ being in state $s$ is:

$$\Pr(X = s | \tilde{\bf\theta}) = \frac{\prod_{r=0}^s P_{r|r-1}(\tilde{\bf\theta})}{C}, $$

where $C$ is a normalization constant.

* Can convert the products to sums

$$\Pr(X = s | \tilde{\bf\theta}) = \frac{\exp\left(1.7\sum_{r=0}^s Z_r(\tilde{\bf\theta})\right)}{\sum_{R=0}^S \exp\left(1.7\sum_{r=0}^R Z_r(\tilde{\bf\theta})\right)}$$

## Simple Case 1:  Multiple-A rules

* These look a lot like graded response
* `PnodeLink(pnode) = "partialCredit"`
* `PnodeRules(pnode)` is a single value
    + "Compensatory", "Conjunctive", "Disjunctive"
* `PnodeLnAlphas(pnode)` is a _vector_ corresponding to parents
* `PnodeBetas(pnode)` is a _list_ corresponding to states.
    + $Z_s()$ has the same functional form and the same parameters except for $b$'s
* Use `CompensatoryGadget` to edit this style table.

## Simple Case: Example

```{r partial credit Compensatory, echo=TRUE}

CRItem <- Pnode(CRItem) ## Force into Pnode protocol.
PnodeLink(CRItem) <- "partialCredit"
PnodeRules(CRItem) <- "Compensatory"
PnodeAlphas(CRItem) <- c(1.2,.8)
PnodeBetas(CRItem) <- list(.25, -.25)
PnodePriorWeight(CRItem) <- 10 ## Used for learning
BuildTable(CRItem)
calcDPCFrame(ParentStates(CRItem),PnodeStates(CRItem),
             PnodeLnAlphas(CRItem),PnodeBetas(CRItem),
             PnodeRules(CRItem),PnodeLink(CRItem))
```
## Compensator Gadget
```{r compensatory gadget, eval=FALSE}
CRItem <- CompensatoryGadget(CRItem)
CRItem[]
```

## Simple Case 2:  Multiple-B rules

* These look a lot like multiple-a rules.
* `PnodeLink(pnode) = "partialCredit"`
* `PnodeRules(pnode)` is a single value
    + "OffsetConjunctive", "OffsetDisjunctive"
* `PnodeLnAlphas(pnode)` is a _list_ corresponding to states
* `PnodeBetas(pnode)` is a _vector_ corresponding to parent.
    + $Z_s()$ has the same functional form and the same parameters except for $b$'s
* Use `OffsetGadget` to edit this style table.

## Case 2 example

```{r partial credit Conjunctive, echo=TRUE}

CRItem <- Pnode(CRItem) ## Force into Pnode protocol.
PnodeLink(CRItem) <- "partialCredit"
PnodeRules(CRItem) <- "OffsetDisjunctive"
PnodeAlphas(CRItem) <- list(1.2,.8)
PnodeBetas(CRItem) <- c(.25, -.25)
PnodePriorWeight(CRItem) <- 10 ## Used for learning
BuildTable(CRItem)
calcDPCFrame(ParentStates(CRItem),PnodeStates(CRItem),
             PnodeLnAlphas(CRItem),PnodeBetas(CRItem),
             PnodeRules(CRItem),PnodeLink(CRItem))
```
## Offset Gadget

```{r offsetGadget, eval=FALSE}
CRItem <- OffsetGadget(CRItem)
CRItem[]

```
## Discrete Partial Credit model unleased

* `PnodeRules(pnode)` is now a _list_

    + different rule for each state

* `PnodeLnAlphas(node)` is also a _list_

    + elements correspond to states

    + will be a vector or scalar according to corresponding rule.

* `PnodeBetas(node)` is also a _list_

    + elements correspond to states

    + will be a vector or scalar according to corresponding rule.

## Peanut convention:  Lists versus Vectors

* A _list_ corresponds to states of child variable (except last)

    + If a vector or scalar shows up where a list is expected, the same value is used for all states.

* A _vector_ (within a list) corresponds to parents

* Could eliminate some parents (0 alpha, or infinite beta)
    + Or use _inner_ (node specific) $Q$-matrix

## Example:  Math Word Problem

* Based on unpublished analysis by Cocke and Guo (personal
  communication 2011-07-11) 

* Next Generation Sunshine State Standards Benchmark, MA.6.A.5.1, “Use
  equivalent forms of fractions, decimals, and percents to solve
  problems" (NGSSS, 2013) 

* Sample problem:

> John scored 75% on a test and Mary has 8 out of 12 correct on the same test. Each test item is worth the same amount of points. Who has the better score?

## Scoring Rubric

State      | Description            | Skills
-----------|------------------------|------------------
No Credit  | Null response          | N/A
-----------|------------------------|------------------
Partial    | Recognizes 75% and     | Mathematical
Credit 1   | 8/12 as key elements   | Language
-----------|------------------------|------------------
Partial    | Converts two fractions | Convert
Credit 2   | to a common form       | Fractions
-----------|------------------------|------------------
Full       | Makes the correct      | Compare Fractions
Credit     | comparison             | & Math Lang.
-----------|------------------------|------------------

## Model Refinement

* Collapse "Partial Credit 2" and  "Full Credit"
    + Few "Partial Credit 2"'s in practice
* Skill1 = Mathematical Language
* Skill2 = Convert Fractions and Compare Fractions
    + Fraction Manipulation
* Need two combination rules
    + No Credit -> Partial Credit.  Only one skill relevant.
        - Can use any rule ("Compensatory" is default choice)
    + Partial Credit -> Full Credit.
        - Conjunctive model:  both skills needed.
        - Less of Skill1 than of Skill2

## Inner Q-matrix

* Q-matrix inside node:
    + Rows are state transitions
    + Columns are skills (parent variables)

         | Skill1 | Skill2 | Rule
---------|--------|--------|--------------
Partial  |   1    |   0    | Compensatory
---------|--------|--------|--------------
Full     |   1    |   1    | Conjunctive
---------|--------|--------|--------------

* The function `PnodeQ(node)` allows setting the node level Q-matrix.
* `PnodeQ(node) = TRUE` implies all 1's in Q-matrix.

## Complex Example

* Now use function `DPCGadget()` to edit with full model.
```{r DPC example, echo=TRUE}
CRItem <- Pnode(CRItem) ## Force into Pnode protocol.
PnodeLink(CRItem) <- "partialCredit"
PnodeRules(CRItem) <- list("Compensatory","OffsetDisjunctive")
PnodeAlphas(CRItem) <- list(c(Skill1=1),1)
PnodeBetas(CRItem) <- list(-1,c(Skill1=-1,Skill2=1))
PnodeQ(CRItem) <- matrix(as.logical(c(1,0,1,1)),2,2,byrow = TRUE)
PnodePriorWeight(CRItem) <- 10 ## Used for learning
calcDPCFrame(ParentStates(CRItem),PnodeStates(CRItem),
             PnodeLnAlphas(CRItem),PnodeBetas(CRItem),
             PnodeRules(CRItem),PnodeLink(CRItem),Q=PnodeQ(CRItem))
BuildTable(CRItem)
```
## The DPCGadget

```{r DPCgadget, eval=FALSE}
CRItem <- DPCGadget(CRItem)
CRItem[]
PnodeQ(CRItem)
```
## Peanut Functions Summary

* `Pnode()` -- converts a Netica node into a Peanut node
* `PnodeStateValues(node) <- effectiveThetas(PnodeNumStates(node))` -- Sets up parent states.
* `PnodeLink(node)` -- Link Function
* `PnodeRules(node)` -- (list of) Combination Rules
* `PnodeLnAlphas(node)`, `PnodeAlphas(node)` -- (list of) (vectors of) discriminations
* `PnodeBetas(node)` -- (list of) (vectors of) difficulties
* `PnodeLinkScale(node)` -- link scale parameter (for "normalLink")
* `PnodeQ(node)` -- Inner Q-matrix (TRUE = all 1's)
* `PnodePriorWeight(node)` -- prior strength for GEM algorithm learning
* `BuildTable(node)` -- builds the table.

## Peanut Node Gadgets

* CompensatoryGadget -- For simple Multiple-A models
* OffsetGadget -- For simple Multiple-B models
* RegressionGadget -- For normal link function models (no parent case)
* DPCGadget -- For complex models
    + inner Q-matrix
    + different rules per row







