fourPNO - v1.0.0

.gitignore

@@ -0,0 +1,4 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata

DESCRIPTION

@@ -0,0 +1,13 @@
+Package: fourPNO
+Type: Package
+Title: Bayesian 4 Parameter Item Response Model
+Version: 1.0
+Date: 2015-10-11
+Authors@R: c(person("Steven Andrew", "Culpepper", role = c("aut", "cph","cre"), email =
+    "[email protected]"))
+Maintainer: Steven Andrew Culpepper <[email protected]>
+Description: Estimate Lord & Barton's four parameter IRT model with lower and upper asymptotes using Bayesian formulation described by Culpepper (2015).
+License: GPL (>= 2)
+Imports: Rcpp
+LinkingTo: Rcpp, RcppArmadillo
+Depends: R (>= 3.0.1)

NAMESPACE

@@ -0,0 +1,4 @@
+useDynLib(fourPNO)
+#import(RcppArmadillo)
+importFrom("Rcpp", evalCpp)
+exportPattern("^[[:alpha:]]+")

R/RcppExports.R

@@ -0,0 +1,210 @@
+# This file was generated by Rcpp::compileAttributes
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#' @title Generate Random Multivariate Normal Distribution
+#' @description Creates a random Multivariate Normal when given number of obs, mean, and sigma. 
+#' @usage rmvnorm(n, mu, sigma)
+#' @param n An \code{int}, which gives the number of observations.  (> 0)
+#' @param mu A \code{vector} length m that represents the means of the normals.
+#' @param sigma A \code{matrix} with dimensions m x m that provides the covariance matrix. 
+#' @return A \code{matrix} that is a Multivariate Normal distribution
+#' @author James J Balamuta
+#' @examples 
+#' #Call with the following data:
+#' rmvnorm(2, c(0,0), diag(2))
+#' 
+rmvnorm <- function(n, mu, sigma) {
+    .Call('fourPNO_rmvnorm', PACKAGE = 'fourPNO', n, mu, sigma)
+}
+
+#' @title Initialize Thresholds
+#' @description Internal function for initializing item thresholds.
+#' @param Ms A \code{vector} with the number of scale values. 
+#' @return A \code{matrix} that is a Multivariate Normal distribution
+#' @seealso \code{\link{Gibbs_4PNO}}
+#' @author Steven Andrew Culpepper
+#' 
+kappa_initialize <- function(Ms) {
+    .Call('fourPNO_kappa_initialize', PACKAGE = 'fourPNO', Ms)
+}
+
+#' @title Internal Function for Updating Theta in Gibbs Sampler
+#' @description Update theta in Gibbs sampler
+#' @param N An \code{int}, which gives the number of observations.  (> 0)
+#' @param Z A \code{matrix} N by J of continuous augmented data.
+#' @param as A \code{vector} of item discrimination parameters.
+#' @param bs A \code{vector} of item threshold parameters.
+#' @param theta A \code{vector} of prior thetas.
+#' @param mu_theta The prior mean for theta.
+#' @param Sigma_theta_inv The prior inverse variance for theta.
+#' @return A \code{vector} of thetas.
+#' @seealso \code{\link{Gibbs_4PNO}}
+#' @author Steven Andrew Culpepper
+#' 
+update_theta <- function(N, Z, as, bs, theta, mu_theta, Sigma_theta_inv) {
+    .Call('fourPNO_update_theta', PACKAGE = 'fourPNO', N, Z, as, bs, theta, mu_theta, Sigma_theta_inv)
+}
+
+#' @title Update a and b Parameters of 2PNO, 3PNO, 4PNO
+#' @description Update item slope and threshold
+#' @param N An \code{int}, which gives the number of observations.  (> 0)
+#' @param J An \code{int}, which gives the number of items.  (> 0)
+#' @param Z A \code{matrix} N by J of continuous augmented data.
+#' @param as A \code{vector} of item discrimination parameters.
+#' @param bs A \code{vector} of item threshold parameters.
+#' @param theta A \code{vector} of prior thetas.
+#' @param mu_xi A two dimensional \code{vector} of prior item parameter means.
+#' @param Sigma_xi_inv A two dimensional identity \code{matrix} of prior item parameter VC matrix.
+#' @return A list of item parameters.
+#' @seealso \code{\link{Gibbs_4PNO}}
+#' @author Steven Andrew Culpepper
+#' 
+update_ab_NA <- function(N, J, Z, as, bs, theta, mu_xi, Sigma_xi_inv) {
+    .Call('fourPNO_update_ab_NA', PACKAGE = 'fourPNO', N, J, Z, as, bs, theta, mu_xi, Sigma_xi_inv)
+}
+
+#' @title Update a and b Parameters of 4pno without alpha > 0 Restriction
+#' @description Update item slope and threshold
+#' @param N An \code{int}, which gives the number of observations.  (> 0)
+#' @param J An \code{int}, which gives the number of items.  (> 0)
+#' @param Z A \code{matrix} N by J of continuous augmented data.
+#' @param as A \code{vector} of item discrimination parameters.
+#' @param bs A \code{vector} of item threshold parameters.
+#' @param theta A \code{vector} of prior thetas.
+#' @param mu_xi A two dimensional \code{vector} of prior item parameter means.
+#' @param Sigma_xi_inv A two dimensional identity \code{matrix} of prior item parameter VC matrix.
+#' @return A list of item parameters.
+#' @seealso \code{\link{Gibbs_4PNO}}
+#' @author Steven Andrew Culpepper
+#' 
+update_ab_norestriction <- function(N, J, Z, as, bs, theta, mu_xi, Sigma_xi_inv) {
+    .Call('fourPNO_update_ab_norestriction', PACKAGE = 'fourPNO', N, J, Z, as, bs, theta, mu_xi, Sigma_xi_inv)
+}
+
+#' @title Update Lower and Upper Asymptote Parameters of 4PNO
+#' @description Internal function to update item lower and upper asymptote
+#' @param Y A N by J \code{matrix} of item responses.
+#' @param Ysum A \code{vector} of item total scores.
+#' @param Z A \code{matrix} N by J of continuous augmented data.
+#' @param as A \code{vector} of item discrimination parameters.
+#' @param bs A \code{vector} of item threshold parameters.
+#' @param cs A \code{vector} of item lower asymptote parameters.
+#' @param ss A \code{vector} of item upper asymptote parameters.
+#' @param theta A \code{vector} of prior thetas.
+#' @param Kaps A \code{matrix} for item thresholds (used for internal computations).
+#' @param alpha_c The lower asymptote prior 'a' parameter.
+#' @param beta_c The lower asymptote prior 'b' parameter.
+#' @param alpha_s The upper asymptote prior 'a' parameter.
+#' @param beta_s The upper asymptote prior 'b' parameter.
+#' @param gwg_reps The number of Gibbs within Gibbs MCMC samples for marginal distribution of gamma.
+#' @return A list of item threshold parameters.
+#' @seealso \code{\link{Gibbs_4PNO}}
+#' @author Steven Andrew Culpepper
+#' 
+update_WKappaZ_NA <- function(Y, Ysum, Z, as, bs, cs, ss, theta, Kaps, alpha_c, beta_c, alpha_s, beta_s, gwg_reps) {
+    .Call('fourPNO_update_WKappaZ_NA', PACKAGE = 'fourPNO', Y, Ysum, Z, as, bs, cs, ss, theta, Kaps, alpha_c, beta_c, alpha_s, beta_s, gwg_reps)
+}
+
+#' @title Compute 4PNO Deviance
+#' @description Internal function to -2LL
+#' @param N An \code{int}, which gives the number of observations.  (> 0)
+#' @param J An \code{int}, which gives the number of items.  (> 0)
+#' @param Y A N by J \code{matrix} of item responses.
+#' @param as A \code{vector} of item discrimination parameters.
+#' @param bs A \code{vector} of item threshold parameters.
+#' @param cs A \code{vector} of item lower asymptote parameters.
+#' @param ss A \code{vector} of item upper asymptote parameters.
+#' @param theta A \code{vector} of prior thetas.
+#' @return -2LL.
+#' @seealso \code{\link{Gibbs_4PNO}}
+#' @author Steven Andrew Culpepper
+#' 
+min2LL_4pno <- function(N, J, Y, as, bs, cs, ss, theta) {
+    .Call('fourPNO_min2LL_4pno', PACKAGE = 'fourPNO', N, J, Y, as, bs, cs, ss, theta)
+}
+
+#' @title Simulate from 4PNO Model
+#' @description Generate item responses under the 4PNO
+#' @param N An \code{int}, which gives the number of observations.  (> 0)
+#' @param J An \code{int}, which gives the number of items.  (> 0)
+#' @param as A \code{vector} of item discrimination parameters.
+#' @param bs A \code{vector} of item threshold parameters.
+#' @param cs A \code{vector} of item lower asymptote parameters.
+#' @param ss A \code{vector} of item upper asymptote parameters.
+#' @param theta A \code{vector} of prior thetas.
+#' @return A N by J \code{matrix} of dichotomous item responses.
+#' @seealso \code{\link{Gibbs_4PNO}}
+#' @author Steven Andrew Culpepper
+#' 
+Y_4pno_simulate <- function(N, J, as, bs, cs, ss, theta) {
+    .Call('fourPNO_Y_4pno_simulate', PACKAGE = 'fourPNO', N, J, as, bs, cs, ss, theta)
+}
+
+#' @title Calculate Tabulated Total Scores 
+#' @description Internal function to -2LL
+#' @param N An \code{int}, which gives the number of observations.  (> 0)
+#' @param J An \code{int}, which gives the number of items.  (> 0)
+#' @param Y A N by J \code{matrix} of item responses.
+#' @return A vector of tabulated total scores.
+#' @seealso \code{\link{Gibbs_4PNO}}
+#' @author Steven Andrew Culpepper
+#' 
+Total_Tabulate <- function(N, J, Y) {
+    .Call('fourPNO_Total_Tabulate', PACKAGE = 'fourPNO', N, J, Y)
+}
+
+#' @title Gibbs Implementation of 4PNO
+#' @description Internal function to -2LL
+#' @param Y A N by J \code{matrix} of item responses.
+#' @param mu_xi A two dimensional \code{vector} of prior item parameter means.
+#' @param Sigma_xi_inv A two dimensional identity \code{matrix} of prior item parameter VC matrix.
+#' @param mu_theta The prior mean for theta.
+#' @param Sigma_theta_inv The prior inverse variance for theta.
+#' @param alpha_c The lower asymptote prior 'a' parameter.
+#' @param beta_c The lower asymptote prior 'b' parameter.
+#' @param alpha_s The upper asymptote prior 'a' parameter.
+#' @param beta_s The upper asymptote prior 'b' parameter.
+#' @param burnin The number of MCMC samples to discard.
+#' @param cTF A J dimensional \code{vector} indicating which lower asymptotes to estimate.
+#' @param sTF A J dimensional \code{vector} indicating which upper asymptotes to estimate.
+#' @param gwg_reps The number of Gibbs within Gibbs MCMC samples for marginal distribution of gamma.
+#' @param chain_length The number of MCMC samples.
+#' @return Samples from posterior.
+#' @author Steven Andrew Culpepper
+#' 
+Gibbs_4PNO <- function(Y, mu_xi, Sigma_xi_inv, mu_theta, Sigma_theta_inv, alpha_c, beta_c, alpha_s, beta_s, burnin, cTF, sTF, gwg_reps, chain_length = 10000L) {
+    .Call('fourPNO_Gibbs_4PNO', PACKAGE = 'fourPNO', Y, mu_xi, Sigma_xi_inv, mu_theta, Sigma_theta_inv, alpha_c, beta_c, alpha_s, beta_s, burnin, cTF, sTF, gwg_reps, chain_length)
+}
+
+#' @title Update 2PNO Model Parameters
+#' @description Internal function to update 2PNO parameters
+#' @param Y A N by J \code{matrix} of item responses.
+#' @param Z A \code{matrix} N by J of continuous augmented data.
+#' @param as A \code{vector} of item discrimination parameters.
+#' @param bs A \code{vector} of item threshold parameters.
+#' @param theta A \code{vector} of prior thetas.
+#' @param Kaps A \code{matrix} for item thresholds (used for internal computations).
+#' @return A list of item parameters.
+#' @seealso \code{\link{Gibbs_4PNO}}
+#' @author Steven Andrew Culpepper
+#' 
+update_2pno <- function(N, J, Y, Z, as, bs, theta, Kaps, mu_xi, Sigma_xi_inv, mu_theta, Sigma_theta_inv) {
+    .Call('fourPNO_update_2pno', PACKAGE = 'fourPNO', N, J, Y, Z, as, bs, theta, Kaps, mu_xi, Sigma_xi_inv, mu_theta, Sigma_theta_inv)
+}
+
+#' @title Gibbs Implementation of 2PNO
+#' @description Implement Gibbs 2PNO Sampler
+#' @param Y A N by J \code{matrix} of item responses.
+#' @param mu_xi A two dimensional \code{vector} of prior item parameter means.
+#' @param Sigma_xi_inv A two dimensional identity \code{matrix} of prior item parameter VC matrix.
+#' @param mu_theta The prior mean for theta.
+#' @param Sigma_theta_inv The prior inverse variance for theta.
+#' @param burnin The number of MCMC samples to discard.
+#' @param chain_length The number of MCMC samples.
+#' @return Samples from posterior.
+#' @author Steven Andrew Culpepper
+#' 
+Gibbs_2PNO <- function(Y, mu_xi, Sigma_xi_inv, mu_theta, Sigma_theta_inv, burnin, chain_length = 10000L) {
+    .Call('fourPNO_Gibbs_2PNO', PACKAGE = 'fourPNO', Y, mu_xi, Sigma_xi_inv, mu_theta, Sigma_theta_inv, burnin, chain_length)
+}
+

R/fourPNO-internal.R

@@ -0,0 +1,126 @@
+.Random.seed <-
+c(403L, 10L, -916551914L, 1672741312L, 1551819139L, 1470003105L, 
+-242550896L, 1313623150L, -395847143L, -441564501L, 731944602L, 
+-1666989476L, 1679130463L, 413471029L, -934399796L, -795239902L, 
+26596477L, -1884263049L, 1508164254L, 1963004248L, -1674377029L, 
+270505561L, 729794024L, 230146070L, -1626690671L, -23194557L, 
+-1993364654L, 1711206372L, 1982475815L, -2016762243L, 389117812L, 
+755690330L, 1913044389L, 1218607551L, -1217777082L, 1080434896L, 
+1389132531L, 598080529L, 1450773056L, 937643550L, 1762691305L, 
+-1627207141L, 988903978L, -721654452L, -1329320177L, 1027797573L, 
+1641239548L, -1832220078L, -1027934259L, -1623858809L, -446745490L, 
+-1351062456L, -1107945909L, -232969303L, 1781375736L, -1602337242L, 
+-501080255L, -2126207789L, 1217341570L, -683227468L, 659644983L, 
+1872390445L, -2028729788L, 426391402L, 1267147733L, 2071672175L, 
+1473540214L, 1870257056L, 2105228387L, 1996704001L, -578698128L, 
+-275095538L, 1105150073L, 1514569739L, -2022305478L, -1971482564L, 
+1836029823L, -773149483L, -376794900L, 1117850178L, -1029452387L, 
+-949159913L, 1630764414L, -1411374280L, -1275642853L, 954828153L, 
+-239193144L, -609927178L, 654115377L, 346305635L, -348160974L, 
+-284927612L, -232808505L, -1033088355L, 2132775444L, -1560502086L, 
+1760513285L, -1070450977L, 43531110L, -2118804752L, -1325422061L, 
+-1332853839L, 1983278688L, -1731486722L, -1944018039L, 1764508859L, 
+-907042678L, 1934238572L, -1748473617L, -1300995291L, 959393244L, 
+639941554L, -416472403L, -822044057L, -1359631986L, -1481245080L, 
+-1230632341L, 2083546121L, 48511640L, 56163782L, -1886397151L, 
+-1413952077L, 1509116194L, 1142514452L, -316736617L, 1179476877L, 
+899686052L, 160305290L, -1246144779L, 143518031L, 1370998358L, 
+1890974976L, 1963984963L, 371567585L, -1365757104L, -1131371090L, 
+-1117541543L, -131514005L, -1163958054L, -1386757732L, -1542984289L, 
+1539325941L, 1243508364L, -1414739102L, -743644355L, -958229577L, 
+906483806L, 1488197016L, -967483141L, 371219609L, -1688421080L, 
+508726230L, -884600751L, -575986941L, 1618514578L, 1998495780L, 
+-494432537L, 410837821L, -1219535948L, -1757525990L, 1506966373L, 
+-410245633L, 1757735046L, 901682192L, -348698957L, 603288913L, 
+-1343263488L, 1553102814L, 1925723177L, 2038141915L, 601098474L, 
+1855178380L, 1493187023L, -1653101179L, -698853828L, 1638841106L, 
+-1785325555L, 335981383L, 952680750L, -1773623160L, -1249792629L, 
+-204892823L, -993085640L, -1195820570L, -2006385279L, 1460318483L, 
+-734982462L, -992728716L, 1971409271L, -202325395L, 981585156L, 
+599484458L, 55584149L, -604354001L, 1009063734L, -872544416L, 
+53317027L, 384919233L, 559013552L, -823469618L, -1033212615L, 
+-1095909045L, -1848851718L, -2077076484L, 1181930559L, 1162964245L, 
+-1460447700L, -1343997182L, 800679901L, 1286853335L, -174789186L, 
+-342997000L, 1452983259L, 804339257L, -299432056L, -2011588810L, 
+-1892465295L, 496566179L, 38627058L, 842157636L, -149286649L, 
+1530783965L, -2059600428L, -202600198L, 1612474437L, 132591775L, 
+292272678L, -1960317264L, 1210094419L, 875153120L, 157857916L, 
+-2070079792L, 1409849762L, 527956008L, 1202080524L, 1799784892L, 
+-1841519822L, -1526445376L, -4658124L, -1852129592L, 1658582202L, 
+2140378768L, -103633172L, -819406252L, -108887406L, -332281568L, 
+511021516L, 845005536L, 466796738L, -2062005208L, 245438380L, 
+2147166908L, -124331022L, 1198282288L, 570658724L, -886321736L, 
+-1606887590L, -1338814320L, 577653628L, -1529732844L, 90032450L, 
+1289228544L, 1558601148L, -1653989040L, 337746210L, -1674962360L, 
+2139189260L, -1040406948L, -242611758L, -624478720L, -742202028L, 
+735620328L, 515739898L, -1767954736L, -1009128660L, 1380200692L, 
+-1452353134L, 481197408L, -1126802420L, 801815776L, -1969704350L, 
+-1766628184L, -730858420L, 674826108L, -1368352462L, -1604492688L, 
+-1837440188L, -614579240L, 1963283322L, 1070831664L, 589746108L, 
+-1013730732L, 2045521986L, -1920749920L, 1433584316L, -2143941680L, 
+771308898L, 38948584L, -162485044L, -1738923524L, 1825193458L, 
+1277977728L, -271701516L, -1085945208L, -1883120838L, 626462032L, 
+2127031404L, 636474772L, -989306798L, -424296992L, -1880845108L, 
+669859488L, 1703276930L, 779348200L, -2059941140L, -1731254980L, 
+1876422770L, 1921913456L, -1933141468L, 1637017656L, -1120810726L, 
+-59423536L, -1528166084L, -1046449260L, -639154302L, -476443712L, 
+-1461905860L, 1834746256L, -129279966L, -1930537720L, -939251572L, 
+550072092L, 2080806034L, 1625609600L, 447537172L, 133121832L, 
+-1757723078L, -364523056L, 2102753644L, 1039778740L, -1772385774L, 
+1237977056L, -1697519156L, 978385120L, 880643106L, -1732996312L, 
+52328972L, 1135514428L, -1192513550L, -654834960L, 1843681860L, 
+15318616L, 590673722L, -1358376976L, 1684251324L, 657167636L, 
+491461826L, -924271520L, 1982932348L, -473751600L, 1469444386L, 
+1577522856L, -359901300L, 2079360188L, -1379419342L, 251274816L, 
+-1743493964L, 1186534472L, 7755194L, -841025008L, -537707284L, 
+1297949012L, -2035797230L, -912298592L, 772561612L, 598678112L, 
+987082690L, 1946055464L, 847968684L, 198409532L, -118211726L, 
+-1599771344L, 1665738532L, 964502840L, 440649434L, 1227030416L, 
+-708814084L, -544597100L, -1711557566L, -668003072L, 385181756L, 
+703389008L, 1333609634L, 1936427848L, 1959591692L, -2101821732L, 
+857648978L, -915286400L, 832936020L, -1606786072L, -723850502L, 
+1555191120L, 49495852L, 1497801588L, 1446634386L, -302689696L, 
+-1968834676L, 979720032L, -688323614L, 1272880040L, -179467060L, 
+1580366332L, 1898469298L, 2070963696L, -773225020L, -61744808L, 
+-2096460422L, -570032720L, 1338549180L, -1610731436L, -1173811262L, 
+-177954784L, -866651972L, -425158064L, 1089062882L, -1420575128L, 
+-760566196L, 1179750652L, -189507598L, 823813376L, -250043532L, 
+-1386487800L, 405721530L, 695606736L, -177056788L, -1610232940L, 
+1022811090L, 1566451552L, -647954100L, -109792992L, 523825026L, 
+366069480L, -346105620L, 960034364L, 229782386L, -264735120L, 
+657056804L, 389869368L, 1774909594L, 2009525968L, -728347460L, 
+-809293164L, 329327234L, -716705600L, -1163057860L, -718325616L, 
+84176563L, -1961948716L, -655120158L, -1349979785L, 1844441281L, 
+-608891834L, 298570628L, 566887733L, -830635233L, 1863689848L, 
+-206824618L, -1441078813L, 1593079717L, 1192105538L, -1098720208L, 
+223608921L, -641962549L, -1077223876L, 807501930L, -843695457L, 
+-518355159L, -769311810L, 1302768300L, 1978546173L, 1760378695L, 
+-42450896L, -1944811186L, 1880150395L, -1622628643L, -1284120822L, 
+-267889112L, -563151215L, 1514886787L, -1812330620L, -1258324558L, 
+-1306660089L, -1153005231L, -838151978L, -382386764L, 1791367621L, 
+-148874993L, 952952712L, 867341990L, -1411283373L, -1540556875L, 
+399807762L, 441298656L, 2057892681L, 1676045691L, 1082107980L, 
+955593178L, 920259535L, -24803943L, 334863790L, 693512892L, 1315064621L, 
+-1816643369L, 1167671584L, -1347205506L, -592375733L, 1819503181L, 
+-327026566L, -669562696L, -440243615L, -929640429L, -1541210572L, 
+-631875518L, -1576871849L, 1349614497L, 712473702L, -149842844L, 
+-659312747L, 154716351L, 2085271640L, -837227402L, 2136503427L, 
+576967877L, -1438871070L, 1058396240L, 112404857L, -646926677L, 
+1895458332L, 1154486602L, -2817729L, 119596937L, 1116948382L, 
+-1804364212L, -847831011L, 31519143L, 1627092176L, 237172334L, 
+1540477211L, -1699462531L, 1635031146L, -455727864L, 1479193009L, 
+-2112207325L, 1413497636L, 908567506L, 180592679L, -1364608399L, 
+1529901238L, 330745940L, -84821787L, 396973295L, -105506776L, 
+1892953222L, 1686693555L, -1380767723L, -1050162574L, 2023659200L, 
+668560169L, 119187867L, 665562732L, 74568314L, -148384849L, -514341191L, 
+-505272114L, 387744284L, 259344781L, -544077833L, -1547531520L, 
+207434078L, -589065685L, -1142883027L, -2046172774L, 1873878872L, 
+-1018087743L, -25753229L, -535731564L, -867150046L, -771034569L, 
+325179137L, 1195593222L, 1797387332L, 1067648373L, 1042794719L, 
+342490168L, 210246678L, -1234133981L, -371667995L, 495975938L, 
+1432376432L, 1659707929L, -475427829L, -1911058692L, 1983407914L, 
+-617936545L, 1099809001L, -1861552130L, 1147681772L, 60608317L, 
+-1886924025L, -84702480L, 1314615950L, -258667333L, 1493207197L, 
+779686986L, -1890087320L, 419029585L, -1391419069L, -611313596L, 
+1186962162L, -1316986169L, 2086674577L, -500175338L, -636113804L, 
+-1255905531L, -849337009L, 353033183L)