martin-borkovec / ggparty

147 stars 14 forks source link

Additional example #28

Open HeidiSeibold opened 5 years ago

HeidiSeibold commented 5 years ago

Just because I tried another example. Maybe this is helpful for testing or the vignette:

# devtools::install_github("mmostly-harmless/ggparty")

library("ggparty")
#> Loading required package: ggplot2
#> Loading required package: partykit
#> Loading required package: grid
#> Loading required package: libcoin
#> Loading required package: mvtnorm
data("PimaIndiansDiabetes", package = "mlbench")

tr <- ctree(diabetes ~ glucose + age,
            data = PimaIndiansDiabetes)
plot(tr)


add_info <- function(data, party) { 
  sid <- party$node$split$varid
  if(is.null(sid)) {
    NA
  } else {
    pval <- round(info_node(party$node)$p.value, 3)
    if(pval == 0) {
      pval <- "p < 0.001"
    } else {
      pval <- paste("p =", pval)
    }

    paste0(names(party$data[sid]), 
           " (", min(party$data[, sid]), ", ",  max(party$data[, sid]), ")\n",
           pval)
  }
}

names(pdat <- ggparty:::get_plot_data(tr))
#>  [1] "id"                    "x"                    
#>  [3] "y"                     "parent"               
#>  [5] "birth_order"           "breaks_label"         
#>  [7] "info"                  "info_list"            
#>  [9] "splitvar"              "level"                
#> [11] "kids"                  "nodesize"             
#> [13] "p.value"               "horizontal"           
#> [15] "x_parent"              "y_parent"             
#> [17] "nodedata_diabetes"     "nodedata_glucose"     
#> [19] "nodedata_age"          "nodedata_fitted_nodes"

## plot without figure
p <- ggparty(tr, add_vars = list(linfo = add_info)) + 
  geom_edge() + 
  geom_edge_label() + 
  geom_node_label(aes(label = linfo),
                  ids = "inner") + 
  geom_node_label(aes(label = paste("n =", nodesize)), 
                  nudge_y = 0.03,
                  ids = "terminal") 
p


## plot with bars
p + geom_node_plot(gglist = list(geom_bar(aes(x = "", fill = !!tr$terms[[2]]), 
                                          position = position_fill()), 
                                 theme_classic(),
                                 theme(axis.title = element_blank(), 
                                       axis.ticks.x = element_blank())))


## plot with bars of size according to n
p + geom_node_plot(gglist = list(geom_bar(aes(x = "", fill = !!tr$terms[[2]]),
                                     position = position_fill()),
                            theme_void()),
              size = "nodesize")


## plot with absolute counts
ggparty(tr, add_vars = list(linfo = add_info)) + 
  geom_edge() + 
  geom_edge_label() + 
  geom_node_label(aes(label = splitvar),
                  ids = "inner") + 
  geom_node_plot(
    shared_legend = FALSE,
    gglist = list(geom_bar(aes(x = !!tr$terms[[2]], 
                               fill = !!tr$terms[[2]])),
                  theme_minimal(),
                  theme(legend.position = "none"))
  )

Created on 2019-04-15 by the reprex package (v0.2.1)