Skip to content

Commit 8777cda

Browse files
alexanderrobitzschalexanderrobitzsch
committed
3.4-1
1 parent 8dc6b02 commit 8777cda

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

59 files changed

+166
-185
lines changed

‎DESCRIPTION

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
Package: BIFIEsurvey
22
Type: Package
33
Title: Tools for Survey Statistics in Educational Assessment
4-
Version: 3.3-6
5-
Date: 2019-05-12 11:41:41
4+
Version: 3.4-1
5+
Date: 2019-06-12 17:17:21
66
Author: BIFIE [aut], Alexander Robitzsch [aut, cre],
77
Konrad Oberwimmer [aut]
88
Maintainer: Alexander Robitzsch <[email protected]>
@@ -32,7 +32,7 @@ Imports:
3232
Suggests:
3333
graphics, grDevices, lavaan, lavaan.survey, mitools, survey, TAM
3434
Enhances:
35-
car, Hmisc, intsvy, lme4, LSAmitR, svyPVpack
35+
Hmisc, intsvy, LSAmitR, svyPVpack
3636
LinkingTo:
3737
Rcpp, RcppArmadillo
3838
License: GPL (>= 2)

‎R/BIFIE.cdata.select.R

Lines changed: 8 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,45 +1,38 @@
11
## File Name: BIFIE.cdata.select.R
2-
## File Version: 1.11
2+
## File Version: 1.13
33

44

5-
#######################################################################
6-
# selection variables or datasets in BIFIEcdata objects
5+
#--- selection variables or datasets in BIFIEcdata objects
76
BIFIE.cdata.select <- function( bifieobj, varnames=NULL, impdata.index=NULL ){
87

98
if ( ! bifieobj$cdata ){
109
stop("Use 'BIFIE.data.select' or the general function 'BIFIEdata.select'")
11-
}
10+
}
1211

1312
# retain variable "one"
1413
varnames0 <- bifieobj$varnames
1514
if ( ! is.null(varnames) ){
1615
varnames <- union( varnames, intersect( "one", varnames0) )
17-
}
16+
}
1817

1918
#******* do some variable checking
2019
if ( ! is.null(varnames) ){
21-
# h1 <- setdiff( varnames, colnames(bifieobj$dat1) )
2220
h1 <- setdiff( varnames, bifieobj$varnames )
23-
2421
if ( length(h1) > 0 ){
2522
stop( paste0( "Following variables not in BIFIEdata object:\n ",
2623
paste0( h1, collapse=" " ) ) )
27-
}
28-
}
24+
}
25+
}
2926

3027
#******** select some imputed datasets
3128
if ( ! is.null(impdata.index ) ){
32-
# i1 <- impdata.index - 1
3329
i1 <- impdata.index
3430
bifieobj$datalistM_imputed <- bifieobj$datalistM_imputed[, i1, drop=FALSE]
35-
# h1 <- bifieobj$datalistM_imputed[,"_imp"]
36-
# bifieobj$datalistM_imputed[,"_imp"] <- match( h1, i1 ) - 1
3731
bifieobj$Nimp <- length(i1)
38-
}
32+
}
3933

4034
#********* select some variables
4135
if ( ! is.null( varnames) ){
42-
4336
dfr1 <- data.frame( "varnames"=bifieobj$varnames,
4437
"index"=seq(1,length(bifieobj$varnames) ) )
4538
dfr1$selectvars <- 1 * ( dfr1$varnames %in% varnames )
@@ -48,20 +41,14 @@ BIFIE.cdata.select <- function( bifieobj, varnames=NULL, impdata.index=NULL ){
4841
i1 <- bifieobj$datalistM_impindex[,2] %in% ( dfr1$index - 1 )
4942
bifieobj$datalistM_imputed <- bifieobj$datalistM_imputed[ i1,, drop=FALSE]
5043
bifieobj$datalistM_impindex <- bifieobj$datalistM_impindex[ i1,, drop=FALSE]
51-
5244
impindex2 <- match( bifieobj$datalistM_impindex[,2], dfr1$index - 1 ) - 1
5345
bifieobj$datalistM_impindex[,2] <- impindex2
54-
55-
# bifieobj$datalistM_imputed[,"variable"] <-
56-
# match( bifieobj$datalistM_imputed[,"variable"] + 1, dfr1$index ) - 1
5746
bifieobj$dat1 <- bifieobj$dat1[, dfr1$index, drop=FALSE]
5847
bifieobj$varnames <- bifieobj$varnames[ dfr1$index ]
59-
6048
# process variable list
6149
bifieobj$variables <- bifieobj$variables[ dfr1$index,, drop=FALSE]
6250
}
6351

6452
bifieobj$Nvars <- ncol(bifieobj$dat1)
6553
return(bifieobj)
66-
}
67-
############################################################################
54+
}

‎R/BIFIE.data.R

Lines changed: 6 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,8 @@
11
## File Name: BIFIE.data.R
2-
## File Version: 1.44
2+
## File Version: 1.471
33

4-
##################################################################
5-
# Convert a list of multiply imputed datasets into an object
6-
# of class BIFIEdata
4+
5+
# Convert a list of multiply imputed datasets into an object of class BIFIEdata
76
BIFIE.data <- function( data.list, wgt=NULL, wgtrep=NULL, fayfac=1,
87
pv_vars=NULL, pvpre=NULL, cdata=FALSE, NMI=FALSE )
98
{
@@ -19,9 +18,9 @@ BIFIE.data <- function( data.list, wgt=NULL, wgtrep=NULL, fayfac=1,
1918
}
2019
if (!is.null(pvpre)){
2120
cn_data <- colnames(data.list)
22-
pv_vars <- bifie_data_select_pv_vars(pvpre=pvpre, cn_data=cn_data)
21+
pv_vars <- BIFIE_data_select_pv_vars(pvpre=pvpre, cn_data=cn_data)
2322
}
24-
data.list <- bifie_data_pv_vars_create_datlist(pvpre=pvpre, pv_vars=pv_vars,
23+
data.list <- BIFIE_data_pv_vars_create_datlist(pvpre=pvpre, pv_vars=pv_vars,
2524
jktype=jktype, data=data.list)
2625
}
2726

@@ -96,8 +95,7 @@ BIFIE.data <- function( data.list, wgt=NULL, wgtrep=NULL, fayfac=1,
9695
res <- BIFIE.BIFIEdata2BIFIEcdata( bifieobj=res, varnames=NULL )
9796
}
9897
return(res)
99-
}
100-
########################################################################
98+
}
10199

102100
#**************** print method ***********************
103101
print.BIFIEdata <- function(x,...){
@@ -119,4 +117,3 @@ print.BIFIEdata <- function(x,...){
119117
v1 <- paste0( x$N, " cases and ", x$Nvars, " variables \n" )
120118
cat(v1)
121119
}
122-
########################################################

‎R/BIFIE.data.jack.R

Lines changed: 11 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,8 @@
11
## File Name: BIFIE.data.jack.R
2-
## File Version: 1.67
3-
###########################################################
4-
# BIFIE.data objects for designs with jackknife zones
2+
## File Version: 1.703
3+
4+
5+
#--- BIFIE.data objects for designs with jackknife zones
56
BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
67
jkzone=NULL, jkrep=NULL, jkfac=NULL, fayfac=NULL,
78
wgtrep="W_FSTR", pvpre=paste0("PV",1:5), ngr=100,
@@ -29,8 +30,8 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
2930
dataL <- data
3031
}
3132
data <- as.data.frame( data )
32-
#*********************************************************
33-
# using fixed jackknife zones
33+
34+
#*** using fixed jackknife zones
3435
if (jktype=="JK_GROUP"){
3536
N <- nrow(data)
3637
if ( is.null(wgt) ){
@@ -43,8 +44,6 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
4344
jkfac <- 0
4445
}
4546

46-
47-
#**********************************************************
4847
#*** defaults for jackknife creation: random groups
4948
if (jktype=="JK_RANDOM"){
5049
N <- nrow(data)
@@ -71,7 +70,6 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
7170
jkfac <- 0
7271
}
7372

74-
#**********************************************************
7573
#**** defaults for TIMSS
7674
if (jktype %in% c("JK_TIMSS","JK_TIMSS2") ){
7775
if ( is.null(jkrep) ){
@@ -85,7 +83,7 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
8583
}
8684
jkfac <- 2
8785
}
88-
#***********************************************************
86+
8987
#**** defaults for PISA
9088
if (jktype=="RW_PISA"){
9189
jkrep <- NULL
@@ -98,13 +96,14 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
9896
repvars <- grep( wgtrep, cn_data )
9997
RR <- length(repvars)
10098

101-
pv_vars <- bifie_data_select_pv_vars(pvpre, cn_data )
99+
pv_vars <- BIFIE_data_select_pv_vars(pvpre, cn_data )
102100
datarep <- data[, repvars ]
103101
RR <- ncol(datarep)
104102
fayfac <- 1 / RR / ( 1 - .5)^2
105103
data <- data[, - repvars ]
106104
}
107-
#******** generate replicate weights
105+
106+
#**** generate replicate weights
108107
if ( jktype %in% c("JK_TIMSS", "JK_GROUP", "JK_RANDOM", "JK_TIMSS2") ) {
109108
# redefine jackknife zones
110109
jkzones1 <- unique( data[,jkzone] )
@@ -145,7 +144,7 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
145144

146145
#--------------------------------------------------
147146
if ( ! is.null( pv_vars )){
148-
datalist <- bifie_data_pv_vars_create_datlist( pvpre=pvpre, pv_vars=pv_vars,
147+
datalist <- BIFIE_data_pv_vars_create_datlist( pvpre=pvpre, pv_vars=pv_vars,
149148
jktype=jktype, data=data )
150149
} # end pv_vars
151150
#--------------------------------------------------
@@ -160,4 +159,3 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
160159
bifiedat$CALL <- cl
161160
return(bifiedat)
162161
}
163-
###############################################################################

‎R/BIFIE.hist.R

Lines changed: 9 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
## File Name: BIFIE.hist.R
2-
## File Version: 0.283
2+
## File Version: 0.287
33

44

55
#--- Histogram
@@ -62,25 +62,21 @@ BIFIE.hist <- function( BIFIEobj, vars, breaks=NULL,
6262
res00$group -> group
6363
#@@@@***
6464

65-
#**************************************************************************#
66-
# Rcpp call
67-
res <- bifie_hist( datalistM, wgt_, wgtrep,
68-
vars_index - 1, fayfac,
69-
Nimp, group_index - 1, group_values, breaks )
65+
#--- Rcpp call
66+
res <- bifie_hist( datalist=datalistM, wgt1=wgt_, wgtrep=wgtrep,
67+
vars_index=vars_index-1, fayfac=fayfac, NI=Nimp,
68+
group_index1=group_index-1, group_values=group_values, breaks=breaks )
7069

7170
# create histogram objects
7271
GG <- length(group_values)
7372
histobj <- list(1:GG)
7473
BB <- res$BB
7574

7675
for (gg in 1:GG){
77-
h1 <- list( "breaks"=res$breaks,
78-
"counts"=res$sumwgt[ ( gg-1)*BB + 1:BB ],
79-
"density"=res$density_vec[ ( gg-1)*BB + 1:BB ],
80-
"mids"=res$mids
81-
)
76+
h1 <- list( breaks=res$breaks, counts=res$sumwgt[ ( gg-1)*BB + 1:BB ],
77+
density=res$density_vec[ ( gg-1)*BB + 1:BB ], mids=res$mids )
8278
h1$xname <- paste0( vars, "_", group, group_values[gg] )
83-
if ( stats::sd ( diff(res$mids) ) < .000001 ){ h1$equidist <- TRUE } else { h1$equidist <- FALSE }
79+
if ( stats::sd( diff(res$mids) ) < .000001 ){ h1$equidist <- TRUE } else { h1$equidist <- FALSE }
8480
class(h1) <- "histogram"
8581
histobj[[gg]] <- h1
8682
}
@@ -109,7 +105,7 @@ plot.BIFIE.hist <- function( x, ask=TRUE, ... )
109105
res <- x
110106
GG <- res$GG
111107
for (gg in 1:GG){
112-
graphics::plot( res$histobj[[gg]], ... )
108+
graphics::plot(res$histobj[[gg]], ... )
113109
graphics::par(ask=ask)
114110
}
115111
}

‎R/BIFIE.lavaan.survey.R

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
## File Name: BIFIE.lavaan.survey.R
2-
## File Version: 0.624
2+
## File Version: 0.641
33

44

55
BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
@@ -15,6 +15,7 @@ BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
1515
#* handle design
1616
is_survey_design <- FALSE
1717
NMI <- FALSE
18+
Nimp_NMI <- NULL
1819
variables <- NULL
1920
if ( class(svyrepdes)=="svyrep.design" ){
2021
svyrepdes0 <- svyrepdes
@@ -56,7 +57,10 @@ BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
5657

5758
#- fit initial lavaan model
5859
lav_fun <- BIFIE_lavaan_survey_define_lavaan_function(lavaan_fun=lavaan_fun)
59-
lavfit <- lav_fun(lavmodel, data=data0, ...)
60+
lavmodel__ <- lavmodel
61+
args <- list(x="lavmodel__", value=lavmodel, pos=1)
62+
res <- do.call(what="assign", args=args)
63+
lavfit <- lav_fun(lavmodel__, data=data0, ...)
6064
class_lav <- class(lavfit)
6165
lavfit_coef <- BIFIE_lavaan_coef(object=lavfit)
6266
npar <- length(lavfit_coef)
@@ -89,14 +93,14 @@ BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
8993
variances <- bifie_extend_list_length2(x=variances)
9094

9195
# combine fit statistics
92-
fitstat <- bifie_lavaan_survey_combine_fit_measures(fitstat=fitstat, Nimp=Nimp)
96+
fitstat <- BIFIE_lavaan_survey_combine_fit_measures(fitstat=fitstat, Nimp=Nimp)
9397

9498
if (! NMI){
9599
# inference parameters for multiply imputed datasets
96100
inf_res <- BIFIE_mitools_MIcombine(results=results, variances=variances)
97101
} else {
98102
# nested multiply imputed datasets
99-
inf_res <- bifie_lavaan_survey_NMIcombine(results=results,
103+
inf_res <- BIFIE_lavaan_survey_NMIcombine(results=results,
100104
variances=variances, Nimp_NMI=Nimp_NMI)
101105
}
102106

‎R/BIFIE.logistreg.R

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
## File Name: BIFIE.logistreg.R
2-
## File Version: 0.432
2+
## File Version: 0.434
33

44

55
#-- logistic regression
@@ -99,8 +99,8 @@ BIFIE.logistreg <- function( BIFIEobj, dep=NULL, pre=NULL,
9999
dfr <- data.frame( "parameter"=rep(p1,GG) )
100100
dfr$var <- rep(p2,GG)
101101
if (! nogroup){
102-
dfr$groupvar <- group
103-
dfr$groupval <- rep( group_values, each=ZZ )
102+
dfr$groupvar <- group
103+
dfr$groupval <- rep( group_values, each=ZZ )
104104
}
105105
dfr$Ncases <- rep( rowMeans( res$ncasesM ), each=ZZ )
106106
dfr$Nweight <- rep( rowMeans( res$sumwgtM ), each=ZZ )
@@ -129,9 +129,8 @@ BIFIE.logistreg <- function( BIFIEobj, dep=NULL, pre=NULL,
129129
class(res1) <- "BIFIE.logistreg"
130130
return(res1)
131131
}
132-
###################################################################################
133132

134-
####################################################################################
133+
135134
# summary for BIFIE.linreg function
136135
summary.BIFIE.logistreg <- function( object, digits=4, ... )
137136
{

‎R/BIFIE.survey.R

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,12 @@
11
## File Name: BIFIE.survey.R
2-
## File Version: 0.224
2+
## File Version: 0.226
33

44
BIFIE.survey <- function(svyrepdes, survey.function, ...)
55
{
66
CALL <- match.call()
77
s1 <- Sys.time()
88
NMI <- FALSE
9+
Nimp_NMI <- NULL
910
svrepdes <- svyrepdes
1011
if ( class(svyrepdes)=="BIFIEdata"){
1112
data0 <- svyrepdes$dat1
@@ -63,7 +64,7 @@ BIFIE.survey <- function(svyrepdes, survey.function, ...)
6364
stat <- BIFIE_mitools_MIcombine(results=results)
6465
} else {
6566
#*** nested multiply imputed dataset
66-
stat <- bifie_NMIcombine_results(results=results, Nimp_NMI=Nimp_NMI, package="stats")
67+
stat <- BIFIE_NMIcombine_results(results=results, Nimp_NMI=Nimp_NMI, package="stats")
6768
}
6869

6970
#-- output

0 commit comments

Comments
 (0)