3.4-15

alexanderrobitzsch · Feb 14, 2020 · 4896964 · 4896964
1 parent 4564b9f
commit 4896964
Show file tree

Hide file tree

Showing 98 changed files with 4,373 additions and 4,712 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,11 +1,11 @@
 Package: TAM
 Type: Package
 Title: Test Analysis Modules
-Version: 3.4-5
-Date: 2019-10-24 15:51:29
+Version: 3.4-15
+Date: 2020-02-14 17:10:51
 Author:
     Alexander Robitzsch [aut, cre], Thomas Kiefer [aut], Margaret Wu [aut]
-Maintainer: Alexander Robitzsch <robitzsch@leibniz-ipn.de>
+Maintainer: Alexander Robitzsch <robitzsch@ipn.uni-kiel.de>
 Description: 
     Includes marginal maximum likelihood estimation and joint maximum
     likelihood estimation for unidimensional and multidimensional 
@@ -36,4 +36,3 @@ URL:
     http://www.edmeasurementsurveys.com/TAM/Tutorials/, 
     https://github.com/alexanderrobitzsch/TAM,
     https://sites.google.com/site/alexanderrobitzsch2/software
-RoxygenNote: 6.1.1
diff --git a/NAMESPACE b/NAMESPACE
@@ -176,6 +176,7 @@ export(tam_cov_wt)
 export(tam_cor_wt)
 export(tam_csink)
 export(tam_difference_quotient)
+export(tam_downcode)
 export(tam_dmvnorm)
 export(tam_ginv)
 export(tam_ginv_scaled)

diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -1,159 +1,161 @@
+## File Name: RcppExports.R
+## File Version: 3.004015
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
 tam_rcpp_calc_exp <- function(NP, rprobs, A, INDEXIPNO, INDEXIPLIST2, ESTXSIINDEX, C, ITEMWT, NR, TP) {
-    .Call('_TAM_tam_rcpp_calc_exp', PACKAGE = 'TAM', NP, rprobs, A, INDEXIPNO, INDEXIPLIST2, ESTXSIINDEX, C, ITEMWT, NR, TP)
+    .Call('_TAM_tam_rcpp_calc_exp', PACKAGE='TAM', NP, rprobs, A, INDEXIPNO, INDEXIPLIST2, ESTXSIINDEX, C, ITEMWT, NR, TP)
 }
 
 tam_rcpp_calc_exp_redefine_vector_na <- function(A, val) {
-    .Call('_TAM_tam_rcpp_calc_exp_redefine_vector_na', PACKAGE = 'TAM', A, val)
+    .Call('_TAM_tam_rcpp_calc_exp_redefine_vector_na', PACKAGE='TAM', A, val)
 }
 
 tam_rcpp_calc_prob_subtract_max <- function(rr0M, NI, NK, TP) {
-    .Call('_TAM_tam_rcpp_calc_prob_subtract_max', PACKAGE = 'TAM', rr0M, NI, NK, TP)
+    .Call('_TAM_tam_rcpp_calc_prob_subtract_max', PACKAGE='TAM', rr0M, NI, NK, TP)
 }
 
 tam_rcpp_calc_prob_subtract_max_exp <- function(rr0, dim_rr) {
-    .Call('_TAM_tam_rcpp_calc_prob_subtract_max_exp', PACKAGE = 'TAM', rr0, dim_rr)
+    .Call('_TAM_tam_rcpp_calc_prob_subtract_max_exp', PACKAGE='TAM', rr0, dim_rr)
 }
 
 tam_rcpp_calc_prob <- function(A, dimA, xsi, maxcat, AXsi0, iIndex, theta, B) {
-    .Call('_TAM_tam_rcpp_calc_prob', PACKAGE = 'TAM', A, dimA, xsi, maxcat, AXsi0, iIndex, theta, B)
+    .Call('_TAM_tam_rcpp_calc_prob', PACKAGE='TAM', A, dimA, xsi, maxcat, AXsi0, iIndex, theta, B)
 }
 
 tam_rcpp_tam_mml_calc_prob_R_outer_Btheta <- function(Btheta, B_dd, theta_dd, dim_Btheta) {
-    .Call('_TAM_tam_rcpp_tam_mml_calc_prob_R_outer_Btheta', PACKAGE = 'TAM', Btheta, B_dd, theta_dd, dim_Btheta)
+    .Call('_TAM_tam_rcpp_tam_mml_calc_prob_R_outer_Btheta', PACKAGE='TAM', Btheta, B_dd, theta_dd, dim_Btheta)
 }
 
 tam_rcpp_tam_mml_calc_prob_R_normalize_rprobs <- function(rr, dim_rr) {
-    .Call('_TAM_tam_rcpp_tam_mml_calc_prob_R_normalize_rprobs', PACKAGE = 'TAM', rr, dim_rr)
+    .Call('_TAM_tam_rcpp_tam_mml_calc_prob_R_normalize_rprobs', PACKAGE='TAM', rr, dim_rr)
 }
 
 tam_rcpp_calc_suff_stat <- function(resp, resp_ind, maxK, nitems, pweights, cA) {
-    .Call('_TAM_tam_rcpp_calc_suff_stat', PACKAGE = 'TAM', resp, resp_ind, maxK, nitems, pweights, cA)
+    .Call('_TAM_tam_rcpp_calc_suff_stat', PACKAGE='TAM', resp, resp_ind, maxK, nitems, pweights, cA)
 }
 
 tam_rcpp_ctt2 <- function(TDAT, WLE, MAXK, EST_WLE, prg) {
-    .Call('_TAM_tam_rcpp_ctt2', PACKAGE = 'TAM', TDAT, WLE, MAXK, EST_WLE, prg)
+    .Call('_TAM_tam_rcpp_ctt2', PACKAGE='TAM', TDAT, WLE, MAXK, EST_WLE, prg)
 }
 
 tam_rcpp_ctt3 <- function(TDAT, WLE, MAXK, EST_WLE, prg) {
-    .Call('_TAM_tam_rcpp_ctt3', PACKAGE = 'TAM', TDAT, WLE, MAXK, EST_WLE, prg)
+    .Call('_TAM_tam_rcpp_ctt3', PACKAGE='TAM', TDAT, WLE, MAXK, EST_WLE, prg)
 }
 
 tam_rcpp_fit_simul <- function(rn1M, c_hwt, Ax, xbar, var1, Uz2, Vz2, nstud_ip, pweights) {
-    .Call('_TAM_tam_rcpp_fit_simul', PACKAGE = 'TAM', rn1M, c_hwt, Ax, xbar, var1, Uz2, Vz2, nstud_ip, pweights)
+    .Call('_TAM_tam_rcpp_fit_simul', PACKAGE='TAM', rn1M, c_hwt, Ax, xbar, var1, Uz2, Vz2, nstud_ip, pweights)
 }
 
 tam_rcpp_theta_sq <- function(theta) {
-    .Call('_TAM_tam_rcpp_theta_sq', PACKAGE = 'TAM', theta)
+    .Call('_TAM_tam_rcpp_theta_sq', PACKAGE='TAM', theta)
 }
 
 tam_rcpp_interval_index <- function(MATR, RN) {
-    .Call('_TAM_tam_rcpp_interval_index', PACKAGE = 'TAM', MATR, RN)
+    .Call('_TAM_tam_rcpp_interval_index', PACKAGE='TAM', MATR, RN)
 }
 
 tam_rcpp_irt_likelihood_cfa <- function(data, nu, psi, L, theta) {
-    .Call('_TAM_tam_rcpp_irt_likelihood_cfa', PACKAGE = 'TAM', data, nu, psi, L, theta)
+    .Call('_TAM_tam_rcpp_irt_likelihood_cfa', PACKAGE='TAM', data, nu, psi, L, theta)
 }
 
 tam_rcpp_mml_2pl_mstep_item_slopes_suffstat <- function(rprobs, items_temp, theta, dd, LIT, TP, nitems, maxcat, maxK, itemwt, xxf_, xbar_, xbar2_, irtmodel, xtemp_, items_conv) {
-    .Call('_TAM_tam_rcpp_mml_2pl_mstep_item_slopes_suffstat', PACKAGE = 'TAM', rprobs, items_temp, theta, dd, LIT, TP, nitems, maxcat, maxK, itemwt, xxf_, xbar_, xbar2_, irtmodel, xtemp_, items_conv)
+    .Call('_TAM_tam_rcpp_mml_2pl_mstep_item_slopes_suffstat', PACKAGE='TAM', rprobs, items_temp, theta, dd, LIT, TP, nitems, maxcat, maxK, itemwt, xxf_, xbar_, xbar2_, irtmodel, xtemp_, items_conv)
 }
 
 tam_rcpp_mml_3pl_calc_Fdes <- function(XDES, dimXdes) {
-    .Call('_TAM_tam_rcpp_mml_3pl_calc_Fdes', PACKAGE = 'TAM', XDES, dimXdes)
+    .Call('_TAM_tam_rcpp_mml_3pl_calc_Fdes', PACKAGE='TAM', XDES, dimXdes)
 }
 
 tam_rcpp_mml_3pl_slca_deriv <- function(XdesM, dimXdes, Xlambda, probs, nik, Nik, guess, probs0) {
-    .Call('_TAM_tam_rcpp_mml_3pl_slca_deriv', PACKAGE = 'TAM', XdesM, dimXdes, Xlambda, probs, nik, Nik, guess, probs0)
+    .Call('_TAM_tam_rcpp_mml_3pl_slca_deriv', PACKAGE='TAM', XdesM, dimXdes, Xlambda, probs, nik, Nik, guess, probs0)
 }
 
 tam_rcpp_mml_3pl_calcexp <- function(NP, rprobs, A, INDEXIPNO, INDEXIPLIST2, ESTXSIINDEX, C, ITEMWT, rprobs0, GUESS, nik, ni) {
-    .Call('_TAM_tam_rcpp_mml_3pl_calcexp', PACKAGE = 'TAM', NP, rprobs, A, INDEXIPNO, INDEXIPLIST2, ESTXSIINDEX, C, ITEMWT, rprobs0, GUESS, nik, ni)
+    .Call('_TAM_tam_rcpp_mml_3pl_calcexp', PACKAGE='TAM', NP, rprobs, A, INDEXIPNO, INDEXIPLIST2, ESTXSIINDEX, C, ITEMWT, rprobs0, GUESS, nik, ni)
 }
 
 tam_rcpp_mml_3pl_compute_B <- function(Edes, gammaslope, dimE) {
-    .Call('_TAM_tam_rcpp_mml_3pl_compute_B', PACKAGE = 'TAM', Edes, gammaslope, dimE)
+    .Call('_TAM_tam_rcpp_mml_3pl_compute_B', PACKAGE='TAM', Edes, gammaslope, dimE)
 }
 
 tam_rcpp_mml_3pl_nonzero_entries <- function(E, dimE) {
-    .Call('_TAM_tam_rcpp_mml_3pl_nonzero_entries', PACKAGE = 'TAM', E, dimE)
+    .Call('_TAM_tam_rcpp_mml_3pl_nonzero_entries', PACKAGE='TAM', E, dimE)
 }
 
 tam_rcpp_mml_mfr_gresp_extend <- function(gresp, xstep) {
-    .Call('_TAM_tam_rcpp_mml_mfr_gresp_extend', PACKAGE = 'TAM', gresp, xstep)
+    .Call('_TAM_tam_rcpp_mml_mfr_gresp_extend', PACKAGE='TAM', gresp, xstep)
 }
 
 tam_rcpp_mml_mfr_gresp_na_facets <- function(gresp, rnfacets, rnx) {
-    .Call('_TAM_tam_rcpp_mml_mfr_gresp_na_facets', PACKAGE = 'TAM', gresp, rnfacets, rnx)
+    .Call('_TAM_tam_rcpp_mml_mfr_gresp_na_facets', PACKAGE='TAM', gresp, rnfacets, rnx)
 }
 
 tam_rcpp_mml_mfr_a_matrix_cumsum <- function(index_matr, mm, SG) {
-    .Call('_TAM_tam_rcpp_mml_mfr_a_matrix_cumsum', PACKAGE = 'TAM', index_matr, mm, SG)
+    .Call('_TAM_tam_rcpp_mml_mfr_a_matrix_cumsum', PACKAGE='TAM', index_matr, mm, SG)
 }
 
 tam_rcpp_mml_mfr_colsums_gresp <- function(gresp) {
-    .Call('_TAM_tam_rcpp_mml_mfr_colsums_gresp', PACKAGE = 'TAM', gresp)
+    .Call('_TAM_tam_rcpp_mml_mfr_colsums_gresp', PACKAGE='TAM', gresp)
 }
 
 tam_rcpp_mml_maxcat <- function(A, dimA) {
-    .Call('_TAM_tam_rcpp_mml_maxcat', PACKAGE = 'TAM', A, dimA)
+    .Call('_TAM_tam_rcpp_mml_maxcat', PACKAGE='TAM', A, dimA)
 }
 
 tam_rcpp_modelfit_q3 <- function(residM, resp_bool) {
-    .Call('_TAM_tam_rcpp_modelfit_q3', PACKAGE = 'TAM', residM, resp_bool)
+    .Call('_TAM_tam_rcpp_modelfit_q3', PACKAGE='TAM', residM, resp_bool)
 }
 
 tam_rcpp_modelfit_counts <- function(resp0, resp_bool, rprobs, hwt, maxKi, maxK) {
-    .Call('_TAM_tam_rcpp_modelfit_counts', PACKAGE = 'TAM', resp0, resp_bool, rprobs, hwt, maxKi, maxK)
+    .Call('_TAM_tam_rcpp_modelfit_counts', PACKAGE='TAM', resp0, resp_bool, rprobs, hwt, maxKi, maxK)
 }
 
 tam_rcpp_modelfit_ccov <- function(counts, scorematrix, adjust) {
-    .Call('_TAM_tam_rcpp_modelfit_ccov', PACKAGE = 'TAM', counts, scorematrix, adjust)
+    .Call('_TAM_tam_rcpp_modelfit_ccov', PACKAGE='TAM', counts, scorematrix, adjust)
 }
 
 tam_rcpp_modelfit_residuals <- function(rprobs, resp, I, TP, maxK, maxKi, hwt, resp_bool) {
-    .Call('_TAM_tam_rcpp_modelfit_residuals', PACKAGE = 'TAM', rprobs, resp, I, TP, maxK, maxKi, hwt, resp_bool)
+    .Call('_TAM_tam_rcpp_modelfit_residuals', PACKAGE='TAM', rprobs, resp, I, TP, maxK, maxKi, hwt, resp_bool)
 }
 
 tam_rcpp_msq_itemfit <- function(resp, irf1, K, TP, post1, FIT, fitIndexM, resp_bool) {
-    .Call('_TAM_tam_rcpp_msq_itemfit', PACKAGE = 'TAM', resp, irf1, K, TP, post1, FIT, fitIndexM, resp_bool)
+    .Call('_TAM_tam_rcpp_msq_itemfit', PACKAGE='TAM', resp, irf1, K, TP, post1, FIT, fitIndexM, resp_bool)
 }
 
 tam_rcpp_prior_normal_density_unequal_means <- function(theta, mu, varInverse, COEFF) {
-    .Call('_TAM_tam_rcpp_prior_normal_density_unequal_means', PACKAGE = 'TAM', theta, mu, varInverse, COEFF)
+    .Call('_TAM_tam_rcpp_prior_normal_density_unequal_means', PACKAGE='TAM', theta, mu, varInverse, COEFF)
 }
 
 tam_rcpp_prior_normal_density_equal_means <- function(theta, mu, varInverse, COEFF) {
-    .Call('_TAM_tam_rcpp_prior_normal_density_equal_means', PACKAGE = 'TAM', theta, mu, varInverse, COEFF)
+    .Call('_TAM_tam_rcpp_prior_normal_density_equal_means', PACKAGE='TAM', theta, mu, varInverse, COEFF)
 }
 
 tam_rcpp_pv_mcmc_likelihood <- function(probs, resp, resp_ind_bool, maxK, nstud, nitems) {
-    .Call('_TAM_tam_rcpp_pv_mcmc_likelihood', PACKAGE = 'TAM', probs, resp, resp_ind_bool, maxK, nstud, nitems)
+    .Call('_TAM_tam_rcpp_pv_mcmc_likelihood', PACKAGE='TAM', probs, resp, resp_ind_bool, maxK, nstud, nitems)
 }
 
 tam_rcpp_pv_mcmc_calc_probs_irf_3pl <- function(theta, B, I, maxK, resp_ind, AXsi) {
-    .Call('_TAM_tam_rcpp_pv_mcmc_calc_probs_irf_3pl', PACKAGE = 'TAM', theta, B, I, maxK, resp_ind, AXsi)
+    .Call('_TAM_tam_rcpp_pv_mcmc_calc_probs_irf_3pl', PACKAGE='TAM', theta, B, I, maxK, resp_ind, AXsi)
 }
 
 tam_rcpp_pv_sample_theta_multidim <- function(post, theta) {
-    .Call('_TAM_tam_rcpp_pv_sample_theta_multidim', PACKAGE = 'TAM', post, theta)
+    .Call('_TAM_tam_rcpp_pv_sample_theta_multidim', PACKAGE='TAM', post, theta)
 }
 
 tam_rcpp_rowCumsums <- function(input) {
-    .Call('_TAM_tam_rcpp_rowCumsums', PACKAGE = 'TAM', input)
+    .Call('_TAM_tam_rcpp_rowCumsums', PACKAGE='TAM', input)
 }
 
 tam_rcpp_tam_np_posterior <- function(dat2, dat_resp, probs0, pi_k, pweights, K1) {
-    .Call('_TAM_tam_rcpp_tam_np_posterior', PACKAGE = 'TAM', dat2, dat_resp, probs0, pi_k, pweights, K1)
+    .Call('_TAM_tam_rcpp_tam_np_posterior', PACKAGE='TAM', dat2, dat_resp, probs0, pi_k, pweights, K1)
 }
 
 tam_rcpp_wle_suffstat <- function(RPROBS, CBL, CBB, CBBB, cndim, cnitems, cmaxK, cnstud, resp_ind) {
-    .Call('_TAM_tam_rcpp_wle_suffstat', PACKAGE = 'TAM', RPROBS, CBL, CBB, CBBB, cndim, cnitems, cmaxK, cnstud, resp_ind)
+    .Call('_TAM_tam_rcpp_wle_suffstat', PACKAGE='TAM', RPROBS, CBL, CBB, CBBB, cndim, cnitems, cmaxK, cnstud, resp_ind)
 }
 
 tam_rcpp_wle_errinv <- function(myERR, cndim, cnstud) {
-    .Call('_TAM_tam_rcpp_wle_errinv', PACKAGE = 'TAM', myERR, cndim, cnstud)
+    .Call('_TAM_tam_rcpp_wle_errinv', PACKAGE='TAM', myERR, cndim, cnstud)
 }
 
diff --git a/R/plot.tam.R b/R/plot.tam.R
@@ -1,13 +1,13 @@
 ## File Name: plot.tam.R
-## File Version: 9.283
+## File Version: 9.2873
 
 #--- plotting tam expected scores curves
 plot.tam <- function(x, items=1:x$nitems, type="expected",
                     low=-3, high=3, ngroups=6, groups_by_item=FALSE,
                     wle=NULL, export=TRUE, export.type="png",
                     export.args=list(), observed=TRUE, overlay=FALSE,
                     ask=FALSE, package="lattice",
-                    fix.devices=TRUE, ...)
+                    fix.devices=TRUE, nnodes=100, ...)
 {
     require_namespace_msg("grDevices")
     if ( package=="lattice"){
@@ -46,13 +46,10 @@ plot.tam <- function(x, items=1:x$nitems, type="expected",
     }
 
     nitems <- tamobj$nitems
-    nnodes <- 100
 
     if (ndim==1 ){
         theta <- matrix(seq(low, high, length=nnodes), nrow=nnodes, ncol=ndim)
     } else {
-        #    theta <- tamobj$theta
-        nnodes <- 40
         nodes <- seq(low, high, length=nnodes)
         theta <- as.matrix( expand.grid( as.data.frame( matrix( rep(nodes, ndim), ncol=ndim ) ) ) )
         nnodes <- nrow(theta)
@@ -78,6 +75,10 @@ plot.tam <- function(x, items=1:x$nitems, type="expected",
     AXsi <- res[["AXsi"]]
     cat <- 1:maxK - 1
 
+    #@@@ define initial empty objects
+    expScore <- obScore <- wle_intervals <- NULL
+    theta2 <- NULL
+
     #**** type='expected'
     if ( type=="expected" ){
         expScore <- sapply(1:nitems, function(i) colSums(cat*rprobs[i,,], na.rm=TRUE))
@@ -91,6 +92,7 @@ plot.tam <- function(x, items=1:x$nitems, type="expected",
         d2 <- res$d2
         groupnumber <- res$groupnumber
         ngroups <- res$ngroups
+        wle_intervals <- res$wle_intervals
         #-- compute observed scores
         obScore <- apply(d2,2, function(x){
                             stats::aggregate(x, list(groupnumber), mean, na.rm=TRUE)
@@ -130,6 +132,8 @@ plot.tam <- function(x, items=1:x$nitems, type="expected",
 
     #*************************************************
     # begin plot function
+    probs_plot <- as.list(1:nitems)
+    names(probs_plot) <- items
 
     for (i in (1:nitems)[items]) {
         #***********************************************************
@@ -161,8 +165,9 @@ plot.tam <- function(x, items=1:x$nitems, type="expected",
             }
         }
     #***********************************************************
-    if ( type=="items"){
 
+
+    if ( type=="items"){
       rprobs.ii <- rprobs[i,,]
       rprobs.ii <- rprobs.ii[ rowMeans( is.na(rprobs.ii) ) < 1, ]
       K <- nrow(rprobs.ii)
@@ -177,6 +182,7 @@ plot.tam <- function(x, items=1:x$nitems, type="expected",
         theta0 <- rprobs0.ii[,1,drop=FALSE]
         rprobs.ii <- t( rprobs0.ii[,-1] )
       }
+        probs_plot[[i]] <- rprobs.ii
       #**************
       for (kk in 1:K){
         dat2a <- data.frame( "Theta"=theta0[,1], "cat"=kk, "P"=rprobs.ii[kk,] )
@@ -410,7 +416,14 @@ plot.tam <- function(x, items=1:x$nitems, type="expected",
                               file.path(getwd(), "Plots")) ;
                               utils::flush.console() }
   }
-
+    # option output
+    res_exp <- list(obScore=obScore, expScore=expScore, ngroups=ngroups,
+                    wle_intervals=wle_intervals, theta=theta,
+                    wle_obs_plotted=theta2)
+    res_items <- list(items=items, nitems=nitems, obScore=obScore, theta=theta0,
+                        probs_plot=probs_plot)
+    res <- list(type_expected=res_exp, res_items=res_items)
+    invisible(res)
 }
 
 plot.tam.mml <- plot.tam

diff --git a/R/plot_tam_grouped_wle.R b/R/plot_tam_grouped_wle.R
@@ -1,5 +1,5 @@
 ## File Name: plot_tam_grouped_wle.R
-## File Version: 0.11
+## File Version: 0.123
 
 
 plot_tam_grouped_wle <- function( tamobj, tammodel, wle, ngroups, resp)
@@ -14,7 +14,8 @@ plot_tam_grouped_wle <- function( tamobj, tammodel, wle, ngroups, resp)
     }
     q1 <- 1 / ngroups
     quant <- unique( stats::quantile(wle, probs=seq(q1, 1 - q1, by=q1), na.rm=TRUE ) )
-    groupnumber <- as.numeric( cut( wle, breaks=c( -Inf, quant, Inf) ) )
+    wle_intervals <- c( -Inf, quant, Inf)
+    groupnumber <- as.numeric( cut( wle, breaks=wle_intervals ) )
     aggr <- stats::aggregate(wle, list(groupnumber), mean, na.rm=TRUE)
     theta2 <- aggr$x
     ngroups <- length(theta2)
@@ -23,6 +24,7 @@ plot_tam_grouped_wle <- function( tamobj, tammodel, wle, ngroups, resp)
     d2 <- d1[-1]
     #--- output
     res <- list(wle=wle, theta2=theta2, d=d, d1=d1, d2=d2,
-                    groupnumber=groupnumber, ngroups=ngroups)
+                    groupnumber=groupnumber, ngroups=ngroups,
+                    wle_intervals=wle_intervals)
     return(res)
 }
diff --git a/R/tam.mml.R b/R/tam.mml.R
@@ -1,5 +1,5 @@
 ## File Name: tam.mml.R
-## File Version: 9.795
+## File Version: 9.797
 
 tam.mml <- function( resp, Y=NULL, group=NULL,  irtmodel="1PL",
             formulaY=NULL, dataY=NULL,

diff --git a/R/tam_downcode.R b/R/tam_downcode.R
@@ -0,0 +1,21 @@
+## File Name: tam_downcode.R
+## File Version: 0.03
+
+tam_downcode <- function(dat)
+{
+    res <- NULL
+    dat1 <- NA*dat
+    I <- ncol(dat)
+
+    for (ii in 1L:I){
+        v1 <- dat[,ii]
+        vals_ii <- sort(unique(v1))
+        n_ii <- length(vals_ii)
+        ind_ii <- match(v1, vals_ii)
+        dat1[,ii] <- ind_ii-1
+        rec_ii <- data.frame(item=colnames(dat)[ii], orig=vals_ii, rec=0:(n_ii-1) )
+        rec <- rbind(rec, rec_ii)
+    }
+    res <- list(dat=dat1, rec=rec)
+    return(res)
+}