3.10-67

alexanderrobitzsch · Sep 5, 2020 · bb7d13a · bb7d13a
1 parent a9f866e
commit bb7d13a
Show file tree

Hide file tree

Showing 22 changed files with 135 additions and 76 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: sirt
 Type: Package
 Title: Supplementary Item Response Theory Models
-Version: 3.10-64
-Date: 2020-08-29 14:27:25
+Version: 3.10-67
+Date: 2020-09-05 17:32:52
 Author: Alexander Robitzsch [aut,cre] (<https://orcid.org/0000-0002-8226-3132>)
 Maintainer: Alexander Robitzsch <[email protected]>
 Description: 

diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -1,5 +1,5 @@
 ## File Name: RcppExports.R
-## File Version: 3.010064
+## File Version: 3.010067
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 

diff --git a/R/ccov.np.R b/R/ccov.np.R
@@ -1,11 +1,11 @@
 ## File Name: ccov.np.R
-## File Version: 1.208
+## File Version: 1.216
 
 
 #---- nonparametric estimation of conditional covariance
 ccov.np <- function( data, score, bwscale=1.1, thetagrid=seq( -3,3,len=200),
         progress=TRUE, scale_score=TRUE, adjust_thetagrid=TRUE, smooth=TRUE,
-        use_sum_score=FALSE)
+        use_sum_score=FALSE, bias_corr=TRUE)
 {
     # number of Items I
     I <- ncol(data)
@@ -94,7 +94,11 @@ ccov.np <- function( data, score, bwscale=1.1, thetagrid=seq( -3,3,len=200),
         if (use_sum_score){
             res1 <- ccov_np_compute_ccov_sum_score(score=score.ff, data=data.ff)
             score_ff2 <- score.ff - data.ff[,1] - data.ff[,2]
-            res2 <- ccov_np_compute_ccov_sum_score(score=score_ff2, data=data.ff)
+            if (bias_corr){
+                res2 <- ccov_np_compute_ccov_sum_score(score=score_ff2, data=data.ff)
+            } else {
+                res2 <- res1
+            }
             ccov_sum_score[ff] <- ( res1$ccov_aggr + res2$ccov_aggr ) / 2
         }
 
@@ -116,7 +120,8 @@ ccov.np <- function( data, score, bwscale=1.1, thetagrid=seq( -3,3,len=200),
     #--- output
     res <- list( ccov.table=ccov.table, ccov.matrix=ccov.matrix,
                     data=data, score=score, icc.items=icc_items,
-                    wgt.thetagrid=wgt_thetagrid)
+                    wgt.thetagrid=wgt_thetagrid, use_sum_score=use_sum_score,
+                    bias_corr=bias_corr, scale_score=scale_score)
     return(res)
 }
 
diff --git a/R/ccov_np_compute_ccov_sum_score.R b/R/ccov_np_compute_ccov_sum_score.R
@@ -1,5 +1,5 @@
 ## File Name: ccov_np_compute_ccov_sum_score.R
-## File Version: 0.10
+## File Version: 0.15
 
 ccov_np_compute_ccov_sum_score <- function(score, data, use_rcpp=TRUE)
 {
@@ -13,6 +13,7 @@ ccov_np_compute_ccov_sum_score <- function(score, data, use_rcpp=TRUE)
             s1 <- stats::cov.wt(x=data[i1,], method="ML")
             ccov_ff[ss] <- s1$cov[1,2]
         }
+        ccov_ff[is.na(ccov_ff)] <- 0
     } else {
         index <- match(score, scores)-1
         ccov_ff <- sirt_rcpp_ccov_np_compute_ccov_sum_score( index=index,

diff --git a/R/conf.detect.R b/R/conf.detect.R
@@ -1,10 +1,11 @@
 ## File Name: conf.detect.R
-## File Version: 1.198
+## File Version: 1.206
 
 
 # Confirmatory DETECT analysis
 conf.detect <- function( data, score, itemcluster, bwscale=1.1, progress=TRUE,
-                thetagrid=seq( -3,3,len=200), smooth=TRUE, use_sum_score=FALSE)
+                thetagrid=seq( -3,3,len=200), smooth=TRUE, use_sum_score=FALSE,
+                bias_corr=TRUE)
 {
     CALL <- match.call()
     cat("-----------------------------------------------------------\n" )
@@ -23,24 +24,25 @@ conf.detect <- function( data, score, itemcluster, bwscale=1.1, progress=TRUE,
     }
     cat(paste("Bandwidth Scale:", bwscale, "\n" ) )
     utils::flush.console()
-    if ( ! h1 ){
-        scale_score <- TRUE
-        if (!smooth){
-            scale_score <- FALSE
-        }
-        ccovtable <- ccov.np( data=data, score=score, bwscale=bwscale,
+    scale_score <- TRUE
+    if (!smooth){
+        scale_score <- FALSE
+    }
+    args_ccov_np <- list( data=data, score=score, bwscale=bwscale,
                             progress=progress, thetagrid=thetagrid, smooth=smooth,
-                            scale_score=scale_score, use_sum_score=use_sum_score)
+                            scale_score=scale_score, use_sum_score=use_sum_score,
+                            bias_corr=bias_corr)
+    if ( ! h1 ){
+        ccovtable <- do.call( what=ccov.np, args=args_ccov_np)
         res <- detect.index( ccovtable=ccovtable, itemcluster=itemcluster )
     } else {
         ccovtable.list <- list()
+        args_ccov_np$progress <- FALSE
         for (pp in 1:PP){
             cat( paste( "DETECT Calculation Score ", pp, "\n", sep="") ) ;
             utils::flush.console()
-            ccovtable.list[[pp]] <- ccov.np( data=data, score=score[,pp],
-                                    bwscale=bwscale, smooth=smooth, progress=FALSE,
-                                    scale_score=scale_score, thetagrid=thetagrid,
-                                    use_sum_score=use_sum_score)
+            args_ccov_np$score <- score[,pp]
+            ccovtable.list[[pp]] <- do.call( what=ccov.np, args=args_ccov_np)
         }
         detect.list <- lapply( ccovtable.list, FUN=function(ccovtable){
                     detect.index( ccovtable, itemcluster=itemcluster ) } )

diff --git a/R/create.ccov.R b/R/create.ccov.R
@@ -1,5 +1,5 @@
 ## File Name: create.ccov.R
-## File Version: 1.07
+## File Version: 1.08
 
 
 #**** auxiliary function for creating a covariance matrix
@@ -15,7 +15,7 @@ create.ccov <- function( cc, data )
         ccov.matrix[ ccc$item2ID[ll], ccc$item1ID[ll] ] <-
                         ccov.matrix[ ccc$item1ID[ll], ccc$item2ID[ll] ]
     }
-    return( ccov.matrix)
+    return(ccov.matrix)
 }
 
 

diff --git a/R/expl.detect.R b/R/expl.detect.R
@@ -1,41 +1,47 @@
 ## File Name: expl.detect.R
-## File Version: 1.24
+## File Version: 1.308
 
 
 #**** Exploratory DETECT analysis
 expl.detect <- function( data, score, nclusters, N.est=NULL, seed=NULL,
-        bwscale=1.1, use_sum_score=FALSE )
+        bwscale=1.1, smooth=TRUE, use_sum_score=FALSE, hclust_method="ward.D",
+        estsample=NULL)
 {
     if ( ! is.null(seed) ){
         set.seed(seed)
     }
-    smooth <- TRUE
     # number of items
     I <- ncol(data)
     if (use_sum_score){
         smooth <- FALSE
         score <- rowSums(data)
     }
+    if (!smooth){
+        scale_score <- FALSE
+    }
     # sample for estimation
     N <- nrow(data)
     if ( is.null( N.est ) ){
         N.est <- floor(N/2)
     }
-    estsample <- sort( sample( 1:N, floor( N.est ) ) )
+    if (is.null(estsample)){
+        estsample <- sort( sample( 1:N, floor( N.est ) ) )
+    }
     # validation sample
     valsample <- setdiff( 1:N, estsample )
-    #**********************************
-    # Maximizing DETECT index
-    #**********************************
+
+    #--- Maximizing DETECT index
     # nonparametric estimation of conditional covariance
-    cc <- ccov.np( data=data[ estsample,], score=score[estsample], bwscale=bwscale,
-                smooth=smooth, use_sum_score=use_sum_score)
+    ccov_np_args <- list( data=data[ estsample,], score=score[estsample],
+                        bwscale=bwscale, smooth=smooth, use_sum_score=use_sum_score,
+                        scale_score=scale_score)
+    cc_est <- cc <- do.call( what=ccov.np, args=ccov_np_args)
     ccov.matrix <- create.ccov( cc=cc, data=data[ estsample,]  )
     # create distance matrix
     cc1 <- max(ccov.matrix) - ccov.matrix
     # Ward Hierarchical Clustering
     d <- stats::as.dist(cc1)
-    fit <- stats::hclust(d, method="ward.D")         # hierarchical cluster analysis
+    fit <- stats::hclust(d, method=hclust_method)         # hierarchical cluster analysis
     clusterfit <- fit
     itemcluster <- data.frame( matrix( 0, I, nclusters ) )
     itemcluster[,1] <- colnames(data)
@@ -59,12 +65,12 @@ expl.detect <- function( data, score, nclusters, N.est=NULL, seed=NULL,
                         } )
     detu <- data.frame( dfr1, detect.unweighted )
     detw <- data.frame( dfr1, detect.weighted )
-    #************************************
-    # Validating DETECT index
-    #************************************
+
+    #--- Validating DETECT index
     if ( length(valsample) > 0 ){
-        cc <- ccov.np( data=data[ valsample,], score=score[valsample],
-                    bwscale=bwscale, smooth=smooth, use_sum_score=use_sum_score )
+        ccov_np_args$data=data[ valsample,]
+        ccov_np_args$score=score[valsample]
+        cc <- do.call( what=ccov.np, args=ccov_np_args)
         detect.unweighted <- detect.weighted <- NULL
         for (k in 2:nclusters){
             h1 <- detect.index( ccovtable=cc, itemcluster=itemcluster[,k] )

diff --git a/README.md b/README.md
@@ -22,9 +22,9 @@ The CRAN version can be installed from within R using:
 utils::install.packages("sirt")
 ```
 
-#### GitHub version `sirt` 3.10-64 (2020-08-29)
+#### GitHub version `sirt` 3.10-67 (2020-09-05)
 
-[![](https://img.shields.io/badge/github%20version-3.10--64-orange.svg)](https://github.com/alexanderrobitzsch/sirt)&#160;&#160;
+[![](https://img.shields.io/badge/github%20version-3.10--67-orange.svg)](https://github.com/alexanderrobitzsch/sirt)&#160;&#160;
 
 The version hosted [here](https://github.com/alexanderrobitzsch/sirt) is the development version of `sirt`. 
 The GitHub version can be installed using `devtools` as:

diff --git a/docs/404.html b/docs/404.html
diff --git a/docs/authors.html b/docs/authors.html
diff --git a/docs/index.html b/docs/index.html
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -2,5 +2,5 @@ pandoc: 1.13.1
 pkgdown: 1.5.1
 pkgdown_sha: ~
 articles: []
-last_built: 2020-08-29T12:54Z
+last_built: 2020-09-05T15:54Z
 
diff --git a/docs/reference/ccov.np.html b/docs/reference/ccov.np.html
diff --git a/docs/reference/conf.detect.html b/docs/reference/conf.detect.html
diff --git a/docs/reference/expl.detect.html b/docs/reference/expl.detect.html