Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Additional example #28

Open
HeidiSeibold opened this issue Apr 15, 2019 · 0 comments
Open

Additional example #28

HeidiSeibold opened this issue Apr 15, 2019 · 0 comments

Comments

@HeidiSeibold
Copy link
Collaborator

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)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant