3.18-20

alexanderrobitzsch · May 29, 2024 · 565d554 · 565d554
1 parent eba4fbc
commit 565d554
Show file tree

Hide file tree

Showing 160 changed files with 11,927 additions and 19,403 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: miceadds
 Type: Package
 Title: Some Additional Multiple Imputation Functions, Especially for 'mice'
-Version: 3.18-2
-Date: 2024-01-10 09:23:28
+Version: 3.18-20
+Date: 2024-05-29 10:31:28
 Author: 
     Alexander Robitzsch [aut,cre] (<https://orcid.org/0000-0002-8226-3132>),
     Simon Grund [aut] (<https://orcid.org/0000-0002-1290-8986>),

diff --git a/R/ANSI_create_table.R b/R/ANSI_create_table.R
@@ -1,5 +1,5 @@
 ## File Name: ANSI_create_table.R
-## File Version: 0.574
+## File Version: 0.580
 
 
 #*** create table with results
@@ -32,14 +32,14 @@ ANSI_create_table <- function (dat, criterion,
     #--- horizontal variables
     NH <- length(horiz_vars)
     if ( is.null(horiz_vals) ){
-        horiz_vals <- as.list(1:NH)
+        horiz_vals <- as.list(1L:NH)
         names(horiz_vals) <- horiz_vars
-        for (nn in 1:NH){
+        for (nn in 1L:NH){
             horiz_vals[[nn]] <- sort( unique( x[, horiz_vars[nn]] ) )
         }
     }
     if ( ! is.null(horiz_vals) ){
-        horiz_vals1 <- as.list(1:NH)
+        horiz_vals1 <- as.list(1L:NH)
         names(horiz_vals1) <- horiz_vars
         if ( ! is.null( names(horiz_vals) ) ){
             for (nn in horiz_vars)
@@ -49,9 +49,9 @@ ANSI_create_table <- function (dat, criterion,
             }
             horiz_vals <- horiz_vals1
     }
-    h2 <- as.list( 1:NH)
+    h2 <- as.list( 1L:NH)
     names(h2) <- horiz_vars[ seq(NH,1,-1) ]
-    for (nn in 1:NH){
+    for (nn in 1L:NH){
         h2[[NH-nn+1]] <- horiz_vals[[nn]]
     }
     horiz_table <- expand.grid( h2 )[, seq(NH,1,-1),drop=FALSE]
@@ -61,14 +61,14 @@ ANSI_create_table <- function (dat, criterion,
     #--- vertical variables
     NH <- length(vert_vars)
     if ( is.null(vert_vals) ){
-        vert_vals <- as.list( 1:NH)
+        vert_vals <- as.list( 1L:NH)
         names(vert_vals) <- vert_vars
-        for (nn in 1:NH){
+        for (nn in 1L:NH){
             vert_vals[[nn]] <- sort( unique( x[, vert_vars[nn]] ) )
         }
     }
     if ( ! is.null(vert_vals) ){
-        vert_vals1 <- as.list(1:NH)
+        vert_vals1 <- as.list(1L:NH)
         names(vert_vals1) <- vert_vars
         if ( ! is.null( names(vert_vals) ) ){
             for (nn in vert_vars)
@@ -78,9 +78,9 @@ ANSI_create_table <- function (dat, criterion,
         }
         vert_vals <- vert_vals1
     }
-    h2 <- as.list( 1:NH)
+    h2 <- as.list( 1L:NH)
     names(h2) <- vert_vars[ seq(NH,1,-1) ]
-    for (nn in 1:NH){
+    for (nn in 1L:NH){
         h2[[NH-nn+1]] <- vert_vals[[nn]]
     }
     vert_table <- expand.grid(h2)[, seq(NH,1,-1),drop=FALSE]
@@ -90,14 +90,14 @@ ANSI_create_table <- function (dat, criterion,
     #--- create complete table
     dfr <- matrix( NA, nrow=horiz_NR, ncol=vert_NR)
     NN <- nrow(x)
-    for (hr in 1:horiz_NR){
-        for (vr in 1:vert_NR){
-            ind <- 1:NN
-            for (nn in 1:horiz_NC){
+    for (hr in 1L:horiz_NR){
+        for (vr in 1L:vert_NR){
+            ind <- 1L:NN
+            for (nn in 1L:horiz_NC){
                 ind0 <- which(  paste(x[, horiz_vars[nn] ])==paste(horiz_table[hr,nn]) )
                 ind <- intersect( ind, ind0 )
             }
-            for (nn in 1:vert_NC){
+            for (nn in 1L:vert_NC){
                 ind0 <- which( paste(x[, vert_vars[nn] ])==paste(vert_table[vr,nn]) )
                 ind <- intersect( ind, ind0 )
             }
@@ -113,22 +113,21 @@ ANSI_create_table <- function (dat, criterion,
         }
     }
 
-    #****
-    # labels horizontal variables
+    #*** labels horizontal variables
     nn <- 1
     cn <- paste0( horiz_vars[nn], "=", horiz_table[,nn] )
     if (horiz_NC>1){
-        for (nn in 2:horiz_NC){
+        for (nn in 2L:horiz_NC){
             cn <- paste0( cn, " # ", horiz_vars[nn], "=", horiz_table[,nn] )
         }
     }
     rownames(dfr) <- cn
-    #****
-    # labels vertical variables
+
+    #*** labels vertical variables
     nn <- 1
     cn <- paste0( vert_vars[nn], "=", vert_table[,nn] )
     if (vert_NC>1){
-        for (nn in 2:vert_NC){
+        for (nn in 2L:vert_NC){
             cn <- paste0( cn, " # ", vert_vars[nn], "=", vert_table[,nn] )
         }
     }
@@ -138,7 +137,7 @@ ANSI_create_table <- function (dat, criterion,
         if ( length(digits)!=V){
             digits <- rep(digits[1],V)
         }
-        for (vv in 1:V){
+        for (vv in 1L:V){
             # num1 <- round( as.numeric( paste(dfr[,vv])), digits )
             # g1 <- sprintf( paste0("%.",digits[vv], "f"), num1 )
             num1 <- as.numeric(paste(dfr[,vv]))

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

diff --git a/R/VariableNames2String.R b/R/VariableNames2String.R
@@ -1,5 +1,5 @@
 ## File Name: VariableNames2String.R
-## File Version: 0.12
+## File Version: 0.131
 
 
 VariableNames2String <- function( vars, breaks=80, sep=" ")
@@ -8,7 +8,7 @@ VariableNames2String <- function( vars, breaks=80, sep=" ")
     # define breaks
     NS <- length(sep)
     V <- length(vars)
-    dfr <- data.frame( index=1:V, variable=vars, nchar=nchar(vars), nsep=NS )
+    dfr <- data.frame( index=1L:V, variable=vars, nchar=nchar(vars), nsep=NS )
     dfr$sum1 <- dfr$nchar + dfr$nsep
     dfr$sum2 <- cumsum(dfr$sum1)
     dfr$sum3 <- 0
@@ -18,12 +18,12 @@ VariableNames2String <- function( vars, breaks=80, sep=" ")
     cum_index <- dfr$sum2[ii]
     line_ii <- dfr$line[ii]
     vars2 <- paste0( vars[ii], sep )
-    for (ii in 2:V){
+    for (ii in 2L:V){
         cum_index <- cum_index + dfr$sum1[ii]
         if ( cum_index > breaks){
             line_ii <- line_ii + 1
             cum_index <- dfr$sum1[ii]
-            vars2 <- paste0( vars2, "\n" )
+            vars2 <- paste0( vars2, '\n' )
         }
         dfr$line[ii] <- line_ii
         dfr$sum3[ii] <- cum_index

diff --git a/R/adj_groupmean.R b/R/adj_groupmean.R
@@ -0,0 +1,11 @@
+## File Name: adj_groupmean.R
+## File Version: 0.01
+
+
+adj_groupmean <- function( variable, cluster )
+{
+    a1 <- stats::aggregate( variable, list(cluster), mean  )
+    a2 <- stats::aggregate( 1+0*variable, list(cluster), sum  )
+    ind <- match( cluster, a1[,1] )
+    ( a2[ind,2] * a1[ ind, 2] - variable ) / a2[ ind, 2]
+}
diff --git a/R/complete.miceadds.R b/R/complete.miceadds.R
@@ -1,15 +1,15 @@
 ## File Name: complete.miceadds.R
-## File Version: 0.124
+## File Version: 0.125
 
 #*** complete function for nested multiple imputation
 complete.mids.nmi <- function( data, action=c(1,1), ... )
 {
     x <- data
-    if ( x$type=="mice" ){
+    if ( x$type=='mice' ){
         x1 <- x$imp
         data <- mice::complete( data=x1[[ action[1] ]], action=action[2], ... )
     }
-    if ( x$type=="mice.1chain" ){
+    if ( x$type=='mice.1chain' ){
         data <- complete.mids.1chain( x$imp[[ action[1] ]], action=action[2], ...)
     }
     return(data)

diff --git a/R/covTest.R b/R/covTest.R
@@ -1,14 +1,14 @@
 ## File Name: covTest.R
-## File Version: 0.08
+## File Version: 0.091
 
-############################################
-# function for testing the covariance
-covTest <- function( x, y, conf.level=.95 ){
+
+#-- function for testing the covariance
+covTest <- function( x, y, conf.level=.95 )
+{
     #*** exclude missings
     ind <- ( ! is.na(x) ) & ( ! is.na(y) )
     x <- x[ind]
     y <- y[ind]
-    #***
     N <- length(x)
     est <- stats::cov(x=x,y=y)
     mx <- mean(x)
@@ -27,7 +27,6 @@ covTest <- function( x, y, conf.level=.95 ){
     # confidence interval
     quant <- stats::qnorm( 1 - (1-conf.level)/2 )
     inter <- est + quant * se * c(-1,1)
-    res <- list("est"=est, "se"=se, "lower"=inter[1], "upper"=inter[2] )
+    res <- list(est=est, se=se, lower=inter[1], upper=inter[2] )
     return(res)
 }
-##############################################
diff --git a/R/crlrem.R b/R/crlrem.R
@@ -1,16 +1,16 @@
 ## File Name: crlrem.R
-## File Version: 1.06
+## File Version: 1.071
 
 # remove line endings
 crlrem <- function( filename1, filename2 )
 {
     filename <- filename1
-    con <- file(filename, "rb")
+    con <- file(filename, 'rb')
     bin <- readBin(con, raw(), 100000)
-    bin <- bin[ which(bin !="0d") ]
+    bin <- bin[ which(bin !='0d') ]
     close(con)
     Sys.sleep(1)
-    con <- file(filename2, "wb")
+    con <- file(filename2, 'wb')
     writeBin(bin, con)
     close(con)
 }
diff --git a/R/cronbach_alpha.R b/R/cronbach_alpha.R
@@ -1,12 +1,12 @@
 ## File Name: cronbach_alpha.R
-## File Version: 0.01
+## File Version: 0.02
 
 
 # unstandardized estimate of Cronbach's alpha
 cronbach_alpha <- function( dat.scale )
 {
     I <- ncol( dat.scale )
-    var.scale <- stats::var( dat.scale, use="pairwise.complete.obs" )
+    var.scale <- stats::var( dat.scale, use='pairwise.complete.obs' )
     v.bar <- mean( diag( var.scale )  )
     c.bar <- mean( var.scale[ upper.tri( var.scale ) ] )
     alpha <- ( I * c.bar ) / ( v.bar + (I-1) * c.bar )

diff --git a/R/cxxfunction.copy.R b/R/cxxfunction.copy.R
@@ -1,17 +1,17 @@
 ## File Name: cxxfunction.copy.R
-## File Version: 1.06
+## File Version: 1.071
 
 
 cxxfunction.copy <- function( cppfct, name )
 {
-    require_namespace("inline")
+    require_namespace('inline')
     g1 <- inline::getDynLib(cppfct)
-    cppname <- gsub( "\\.dll", "\\.cpp",  g1[["path"]] )
+    cppname <- gsub( '\\.dll', '\\.cpp',  g1[['path']] )
     h1 <- readLines( cppname )
-    tempname <- g1[["name"]]
+    tempname <- g1[['name']]
     h1 <- gsub( tempname, name, h1 )
-    h1 <- c( paste0( "//  Code created: ", Sys.time() ), "", h1 )
-    name1 <- paste0( tolower(name), ".cpp" )
+    h1 <- c( paste0( '//  Code created: ', Sys.time() ), '', h1 )
+    name1 <- paste0( tolower(name), '.cpp' )
     writeLines( h1, name1 )
     crlrem( filename1=name1, filename2=name1 )
 }