-
Notifications
You must be signed in to change notification settings - Fork 2
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
6e8fb86
commit 58b8dbf
Showing
9 changed files
with
453 additions
and
39 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,58 @@ | ||
| #' Split function to build the two daughter nodes from factor predictor | ||
| #' | ||
| #' @param X Input data | ||
| #' @param Y Outcome data | ||
| #' @param cause (Only with competing events) Number indicates the event of interest. | ||
| #' @param nodesize Minimal number of subjects required in both child nodes to split. Cannot be smaller than 1. | ||
| #' | ||
| #' @keywords internal | ||
| var_split_factor <- function(X, Y, cause = 1, nodesize = 1){ | ||
|
|
||
| X_ncol <- ncol(X$X) | ||
| split_var <- vector("list", X_ncol) | ||
| impur_var <- rep(Inf, X_ncol) | ||
| Pure <- FALSE | ||
|
|
||
| for (i in 1:X_ncol){ | ||
|
|
||
| if (length(unique(X$X[,i]))>1){ | ||
|
|
||
| L <- Fact.partitions(X$X[,i],X$id) | ||
|
|
||
| # Find best partition | ||
| split_list <- lapply(seq_along(L), FUN = function(x){ | ||
|
|
||
| split <- rep(2,length(X$id)) | ||
| split[which(X$id%in%L[[x]])] <- 1 | ||
|
|
||
| if ((length(unique(split))>1)&(all(table(split)>=nodesize))){ | ||
| # Evaluate the partition | ||
| impur <- impurity_split(Y, split, cause = cause)$impur | ||
| }else{ | ||
| impur <- Inf | ||
| } | ||
|
|
||
| return(list(split = split, impur = impur)) | ||
|
|
||
| }) | ||
|
|
||
| partition_impur <- unlist(lapply(split_list, function(x) return(x$impur))) | ||
|
|
||
| if (any(partition_impur!=Inf)){ | ||
| best_part <- which.min(partition_impur) | ||
| split_var[[i]] <- split_list[[best_part]]$split | ||
| impur_var[i] <- split_list[[best_part]]$impur | ||
| } | ||
| } | ||
| } | ||
|
|
||
| if (all(impur_var==Inf)){ | ||
| return(list(Pure=TRUE)) | ||
| } | ||
|
|
||
| var_split <- which.min(impur_var) | ||
|
|
||
| return(list(split = split_var[[var_split]], impur = min(impur_var), | ||
| variable = var_split, variable_summary = NA, threshold = NA, | ||
| Pure = Pure)) | ||
| } |
Oops, something went wrong.