巩固党规 [英] Consolidate party rules

问题描述

一个简单的例子

>library(partykit)
> partykit:::.list.rules.party(ctree(Petal.Length~.,data=iris))
                                                                                                     2 
                                                                                  "Petal.Width <= 0.6" 
                                                                                                     6 
                  "Petal.Width > 0.6 & Sepal.Length <= 6.2 & Petal.Width <= 1.3 & Sepal.Length <= 5.5" 
                                                                                                     7 
                   "Petal.Width > 0.6 & Sepal.Length <= 6.2 & Petal.Width <= 1.3 & Sepal.Length > 5.5" 
                                                                                                     ....

例如，在第二条规则中，Sepal.Length的两次出现可以合并为Sepal.Length<=5.5

For example, in the second rule, the two occurrences of Sepal.Length can be consolidated into Sepal.Length<=5.5

那么，有没有办法整合规则?

So, is there a way to consolidate the rules?

推荐答案

有一种更有效的方法，但是此功能可能会给您您想要的东西:

There my be a more efficient way, but this functions may give you what you want:

consolidate_rules <- function(tree){
  split.vars <- colnames(tree$node$info$criterion)
  split <- partykit:::.list.rules.party(tree)
  new.split <- c()

  for(i.split in seq_along(split)) {
   for (i.split.var in split.vars) {
    x0 <- split[i.split]
    x1 <- strsplit(x0, " & ")
    x2 <- grep(i.split.var, x1[[1]], value = TRUE)
    x3l <- strsplit(grep("<=", x2, value = TRUE), " <= ") # lower than
    x3g <- strsplit(grep(">", x2, value = TRUE), " > ")  # greater
    x3e <- strsplit(grep(" %in% ", x2, value = TRUE), "%in%")  # elements
    x4 <- c()

    if (length(x3e) != 0) {
      b <- sapply(x3e, "[[", 2)
      b1 <- gsub('"', '', b)
      b2 <- gsub("[c( )]", "", b1)
      b3 <- gsub("(NA,)|(,NA)", "", b2)
      b4 <- unique(strsplit(paste0(b3, collapse = ","), ",")[[1]])
      x4 <- paste0(i.split.var, ' %in% c("',
                   paste0(b4, collapse = '", "'),'")')
    }

    if (length(x3l) != 0) {
      x4 <- paste0(i.split.var, " <= ",
                   min(as.numeric(sapply(x3l, "[[", 2))))
    }
    if (length(x3g) != 0) {
      x4 <- paste0(x4, ifelse(length(x4) > 0 ," & ",""),
                   i.split.var, " > ",
                   max(as.numeric(sapply(x3g, "[[", 2))))
    }

    tmp <- paste0(if(!is.null(new.split[i.split]) &&
                  !is.na(new.split[i.split]) &
                  length(x4) >0) {" & "}, x4)

    new.split[i.split] <- 
      paste0(if(!is.null(new.split[i.split]) &&
            !is.na(new.split[i.split])) {new.split[i.split]},
             tmp)

    rm(x0, x1, x2, x3l, x3g, x3e, x4)
   }
 }
 names(new.split) <- names(split)
 return(new.split)
}

您可以通过以下方式调用该函数:

You can call the function with:

ct <- ctree(Petal.Length~.,data=iris)
consolidate_rules(ct)

对于节点6，结果如下:

For the node 6 the result looks like this:

6 
                           "Sepal.Length <= 5.5 & Petal.Width <= 1.3 & Petal.Width > 0.6"

由于结果只是带有规则的字符串，所以我不知道您是否可以使用与.list.rules.party对象相同的方式使用它. 但是我希望这个方法能对您有所帮助.

As the result is "just" a string with the rules, I don't know if you can use it in the same way as a .list.rules.party object. But i hope this mioght help you.

这篇关于巩固党规的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！