fixed, compiles

R/guess_stnderr.R

@@ -17,10 +17,6 @@
 
 guess_stnderr <- function(pre_test=NULL, pst_test=NULL, nsamps=100, seed = 31415, force9=FALSE) 
 {
-
-	# pre_test <- alldat[,t1]; pst_test <-  alldat[,t2]; nsamps=10; seed = 31415
-	# pre_test <- alldat_dk[,t1]; pst_test <-  alldat_dk[,t2]; nsamps=10; seed = 31415
-
 	# build a df
 	df 		<- data.frame(cbind(pre_test, pst_test))
 
@@ -47,7 +43,7 @@ guess_stnderr <- function(pre_test=NULL, pst_test=NULL, nsamps=100, seed = 31415
 	# Looping through the samples; estimating based one each
 	for(i in 1:length(resamples)) {
 		print(i)
-		transmatrix_i           <- multi_transmat(resamples[[i]][,1:nitems], resamples[[i]][,(nitems+1):(2*nitems)], force9=force9)
+		transmatrix_i           <- multi_transmat(resamples[[i]][,1:nitems], resamples[[i]][,(nitems+1):(2*nitems)], force9=force9, agg=T)
 		resamps.results[[i]] 	<- guesstimate(transmatrix_i)
 		resamps.lca.eff[i,] 	<- resamps.results[[i]]$est.learning
 		resamps.agg[i,] 		<- transmatrix_i[nitems,]

R/guesstimate.R

@@ -10,7 +10,7 @@
 #' # Without DK
 #' pre_test <- data.frame(item1=c(1,0,0,1,0), item2=c(1,NA,0,1,0)) 
 #' pst_test <- pre_test + cbind(c(0,1,1,0,0), c(0,1,0,0,1))
-#' transmatrix <- transmat(pre_test_var, pst_test_var)
+#' transmatrix <- multi_transmat(pre_test, pst_test)
 #' res <- guesstimate(transmatrix)
 
 guesstimate <- function(transmatrix=NULL, nodk_priors=c(.3,.1,.1,.25), dk_priors=c(.3,.1,.2,.05,.1,.1,.05,.25)) 
@@ -22,8 +22,8 @@ guesstimate <- function(transmatrix=NULL, nodk_priors=c(.3,.1,.1,.25), dk_priors
 	est.opt <- matrix(ncol=nitems, nrow=nparams)
 
 	# priors
-	nodk_priors <- prior4
-	dk_priors   <- prior8
+	nodk_priors <- nodk_priors
+	dk_priors   <- dk_priors
 
 	# effects
 	effects	<- matrix(ncol=nitems, nrow=1)

R/p_guess.R

@@ -2,26 +2,28 @@
 #' 
 #' @description Adjusts observed 1s based on item level parameters of the LCA model. Currently only takes data with Don't Know.
 #' If NAs are observed in the data, they are treating as acknowledgments of ignorance.
-#' @param t1  t1 data frame
-#' @param t2  t2 data frame
+#' @param pre  pre data frame
+#' @param pst  pst data frame
 #' @return adjusted responses
 #' @export
 #' @examples
 #' pre_test_var <- data.frame(pre=c(1,0,0,1,"d","d",0,1,NA))
 #' pst_test_var <- data.frame(pst=c(1,NA,1,"d",1,0,1,1,"d"))
 #' p_guess(pre_test_var, pst_test_var)
 
-p_guess <- function(pre, pst)
+p_guess <- function(pre=NULL, pst=NULL)
 {
 
   n <- nrow(pre)
 
-  if ( sum(sum(is.na(pre))) | sum(sum(is.na(pst)))) {
+  if ( sum(is.na(pre)) | sum(is.na(pst)) ) {
     cat("NAs will be converted to 0. MCAR is assumed.\n")
-    pre <- as.data.frame(lapply(pre, function(x) ifelse(is.na(x), "d", x)))
-    pst <- as.data.frame(lapply(pst, function(x) ifelse(is.na(x), "d", x)))
+    pre <- as.data.frame(lapply(pre, function(x) x[is.na(x)] <- "d"))
+    pst <- as.data.frame(lapply(pst, function(x) x[is.na(x)] <- "d"))
   }
 
+  str(pre)
+
   transmatrix <- multi_transmat(pre, pst)
 
   lca_res     <- guesstimate(transmatrix)
@@ -30,11 +32,11 @@ p_guess <- function(pre, pst)
   pk1 <-  n*param_lca["lkk",]/sapply(pre, function(x) sum(x==1))
   pk2 <-  n*(param_lca["lgk",] + param_lca["lkk",] + param_lca["lck",])/sapply(pst, function(x) sum(x==1))
 
-  t1adj <- mapply(function(x, y) ifelse(x==1, y, x), t1, pk1)
-  t2adj <- mapply(function(x, y) ifelse(x==1, y, x), t2, pk2)
+  t1adj <- as.data.frame(mapply(function(x, y) ifelse(x==1, y, x), pre, pk1))
+  t2adj <- as.data.frame(mapply(function(x, y) ifelse(x==1, y, x), pst, pk2))
 
-  t1adj <-  sapply(as.data.frame(t1adj), function(x) {x <- as.character(x); as.numeric(ifelse(x=='d', 0, x))})
-  t2adj <-  sapply(as.data.frame(t2adj), function(x) {x <- as.character(x); as.numeric(ifelse(x=='d', 0, x))})
+  t1adj <-  sapply(t1adj, function(x) x[x=='d'] <- 0)
+  t2adj <-  sapply(t2adj, function(x) x[x=='d'] <- 0)
 
   return(list(pre=t1adj, pst=t2adj)) 
 }

R/transmat.R

@@ -21,15 +21,14 @@
 #' pst_test_var <- c(1,NA,1,"d",1,0,1,1,"d") 
 #' transmat(pre_test_var, pst_test_var)
 
-transmat <- function(pre_test_var, pst_test_var, subgroup=NULL, force9=FALSE) 
-{	
+transmat <- function(pre_test_var, pst_test_var, subgroup=NULL, force9=FALSE) {	
 
 	if (!is.null(subgroup))
 	{
 		pre_test_var <-subset(pre_test_var, subgroup)
 		pst_test_var <-subset(pst_test_var, subgroup)
 	}
-
+	
 	# No NAs
 	pre_test_nona <- nona(pre_test_var)
 	pst_test_nona <- nona(pst_test_var)

vignettes/using_guess.Rmd

@@ -98,7 +98,6 @@ print(transmat(pre_test_var, pst_test_var))
 pre_test_var <- c(1,0,NA,1,"d","d",0,1,0)
 pst_test_var <- c(1,0,1,"d",1,0,1,1,"d")
 print(transmat(pre_test_var, pst_test_var))
-
 ```
 
 #### Adjusting Using the Latent Class Model