Merge pull request #4 from brandmaier/master

Merge
brandmaier · Apr 21, 2020 · 2c74790 · 2c74790
2 parents b4b936a + 24a5870
commit 2c74790
Show file tree

Hide file tree

Showing 6 changed files with 41 additions and 7 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -24,7 +24,7 @@ importFrom("strucchange", "catL2BB", "maxBB", "meanL2BB", "ordL2BB", "ordwmax",
 importFrom("zoo", "zoo")
 importFrom("utils","toLatex")
 importFrom("lavaan", "lavScores", "nobs", "vcov")
-
+importFrom("stats", "as.formula", "predict")
 
 #
 # S3 methods

diff --git a/R/growTree.R b/R/growTree.R
@@ -382,6 +382,20 @@ growTree <- function(model=NULL, mydata=NULL,
     }
     ##########################################################
 
+    # build a model for missing data
+    if (control$missing == "ctree") {
+      ui_warn("Missing data treatment with ctree is not yet implemented.")
+      #temp = mydata[!is.na(mydata[,result$name.max]),]
+      #node$missing.model = party::ctree(
+      #  data = temp,
+      #  formula = as.formula(paste0(result$name.max,"~.")))
+    } else if (control$missing == "rpart") {
+      temp = mydata[!is.na(mydata[,result$name.max]),]
+      node$missing.model = rpart::rpart(
+        data = temp,
+        formula = as.formula(paste0(result$name.max,"~.")))
+    }
+
     # recursively continue splitting
     # result1 - RHS; result2 - LHS
     result2 <- growTree( model, sub2, control, invariance, meta, edgelabel=0, depth=depth+1, constraints)

diff --git a/R/semtree.control.R b/R/semtree.control.R
@@ -5,7 +5,7 @@ function(method="naive", min.N = 20, max.depth=NA, alpha=.05, alpha.invariance=N
 		 mtry=NA, report.level=0, exclude.code=NA, 
 		 score.tests = list(nominal = 'LMuo', ordinal = 'maxLMo', metric = 'CvM'),
 		 information.matrix = "info", scaled_scores = TRUE, linear = TRUE,
-		 min.bucket=10, naive.bonferroni.type=0)
+		 min.bucket=10, naive.bonferroni.type=0, missing = 'ignore')
 {
 	options <- list()
 	# verbose output during generation of SEMTree
@@ -58,6 +58,8 @@ function(method="naive", min.N = 20, max.depth=NA, alpha=.05, alpha.invariance=N
   options$report.level <- report.level
   # type of counting the number of tests (0=all splits, 1=# of variables)
   options$naive.bonferroni.type <- naive.bonferroni.type
+  # missing data treatment
+  options$missing <- missing
 
 	class(options) <- "semtree.control"
 

diff --git a/R/traverse.R b/R/traverse.R
@@ -10,7 +10,18 @@ value <- tryCatch({
  row[[tree$rule$name]]
 },error=function(cond){ message("ERROR! Incomplete dataset!"); stop(); return(NA);})
 
-if (is.na(value)) return(tree$node_id);
+if (is.na(value)) {
+
+  if (is.null(tree$missing.model)) {
+    return(tree$node_id);
+  } else {
+    #browser()
+    value = predict(tree$missing.model, newdata=row)
+  }
+
+
+
+}
 
 log.val <- NA
 

diff --git a/man/semtree.control.Rd b/man/semtree.control.Rd
@@ -15,7 +15,7 @@
    custom.stopping.rule=NA, mtry=NA, report.level=0, exclude.code=NA,
    score.tests = list(nominal = "LMuo", ordinal = "maxLMo", metric = "CvM"), 
    information.matrix = "info", scaled_scores = TRUE, linear = TRUE,
-   min.bucket = 10, naive.bonferroni.type=0)
+   min.bucket = 10, naive.bonferroni.type=0, missing = 'ignore')
 }
 % print.semtree.control(x, ...)
 %- maybe also 'usage' for other objects documented here.
@@ -83,6 +83,8 @@
   \item{min.bucket}{Minimum bucket size to continue splitting
   }
   \item{naive.bonferroni.type}{Default: 0. When set to zero, bonferroni correction for the naive test counts the number of dichotomous tests. When set to one, bonferroni correction counts the number of variables tested. }
+
+\item{missing}{Missing value treatment. Default is ignore}
 }
 \value{
   A control object containing a list of the above parameters.

diff --git a/vignettes/score-based-tests.Rmd b/vignettes/score-based-tests.Rmd
@@ -26,7 +26,12 @@ Load affect dataset from the `psychTools` package. These are data from two studi
 library(psychTools)
 data(affect)
 
-knitr::kable(head(affect))
+affect$Film <- as.ordered(affect$Film)
+
+
+tree.data <- affect[,c("state1","Film","neur","ext")] 
+
+knitr::kable(head(tree.data))
 ```
 
 ## Create simple model of state anxiety
@@ -41,7 +46,7 @@ manifestVars = manifests,
 latentVars = latents,
 mxPath(from="one",to=manifests, free=c(TRUE), value=c(1.0) , arrows=1, label=c("mu") ),
 mxPath(from=manifests,to=manifests, free=c(TRUE), value=c(1.0) , arrows=2, label=c("sigma2") ),
-mxData(affect, type = "raw")
+mxData(tree.data, type = "raw")
 );
 
 result <- mxRun(model)
@@ -55,7 +60,7 @@ Use score-based tests to create the tree.
 ```{r}
 library(semtree)
 ctrl = semtree.control(method="score")
-#tree = semtree(model=result, data=affect, control=ctrl)
+#tree = semtree(model=result, data=tree.data, control=ctrl)
 ```
 
 Plot the tree