another quick experiment adding to these interactive javascript views of R partykit / rpart recursive partitioning / clustering.
For a couple other experiments see:
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8"/>
<script src="//www.sveido.com/mermaid/dist/mermaid.full.min.js"></script>
</head>
<body>
<div>Model formula: hp ~ cyl + disp + mpg + drat + wt + qsec + vs + am + gear + carb</div>
<div id="mermaidChart" class="mermaid">graph LR;A[ root]-->B[ cyl < 7];
A[ root]-->I[ cyl >= 7];
B[ cyl < 7]-->C[ mpg >= 21.45];
B[ cyl < 7]-->F[ mpg < 21.45];
C[ mpg >= 21.45]-->D[ disp < 87.05: 62.250 n = 4, err = 140.8];
C[ mpg >= 21.45]-->E[ disp >= 87.05: 91.833 n = 6, err = 1376.8];
F[ mpg < 21.45]-->G[ qsec >= 15.98: 112.857 n = 7, err = 306.9];
F[ mpg < 21.45]-->H[ qsec < 15.98: 175.000 n = 1, err = 0.0];
I[ cyl >= 7]-->J[ drat < 3.18];
I[ cyl >= 7]-->M[ drat >= 3.18];
J[ drat < 3.18]-->K[ mpg >= 12.8: 170.000 n = 7, err = 1150.0];
J[ drat < 3.18]-->L[ mpg < 12.8: 210.000 n = 2, err = 50.0];
M[ drat >= 3.18]-->N[ carb < 6: 246.000 n = 4, err = 582.0];
M[ drat >= 3.18]-->O[ carb >= 6: 335.000 n = 1, err = 0.0];</div>
<script></script>
</body>
</html># use mermaid.js to explain R rpart and other clustering
# mermaid.js is a markdown-like language for flowcharts
# http://github.com/knsv/mermaid
library(htmltools)
library(pipeR)
library(rpart)
library(partykit)
# first we'll do the simple example offered in the Readme.md
# note: this is an exact copy/paste of example
tagList(
tags$div( id = "mermaidChart", class = "mermaid"
,"graph LR;
A[Hard edge]-->|Link text|B(Round edge);
B-->C{Decision};
C-->|One|D[Result one];
C-->|Two|E[Result two];
"
)
,tags$script(
)
) %>>%
attachDependencies(
htmlDependency(
name = "mermaid"
,version = "0.2.1"
,src = c("href"="http://www.sveido.com/mermaid/dist/")
,script = "mermaid.full.min.js"
)
) %>>%
html_print
# now let's see if we can integrate with rpart/partykit
#set up a little rpart as an example
rpk <- rpart(
hp ~ cyl + disp + mpg + drat + wt + qsec + vs + am + gear + carb,
method = "anova",
data = mtcars,
control = rpart.control(minsplit = 4)
) %>>% as.party
# get partykit in source/target
rpNet <- function(n){
l = unclass(n)$kids
list.map(l, .$id)
}
nodeapply(
rpk
,1:length(rpk)
,rpNet
) %>>%
list.search(!is.null(.)) %>>%
(
lapply(
names(.),
function(node){
data.frame(
"source" = node
,"target" = unlist(.[[node]])
)
}
)
) %>>%
list.stack -> rpk_sourcetarget
# get descriptions for nodes
rpk_text <- capture.output( print(rpk) ) %>>%
( .[grep( x = ., pattern = "(\\[)([0-9]*)(\\])")] ) %>>%
strsplit( "[\\[\\|\\]]" , perl = T) %>>%
list.map(
tail(.,2) %>>%
(
data.frame(
"id" = as.numeric(.[1])
, description = .[2]
, stringsAsFactors = F )
)
) %>>% list.stack
# will have to strip characters mermaid does not like
# do separately to determine the secret reserved list
rpk_text %>>%
gsub( x= .[,"description"], pattern = "[()]",replacement = "") -> rpk_text[,"description"]
tagList(
tags$div(
capture.output(print(rpk))[2:3] %>>% HTML
)
,tags$div( id = "mermaidChart", class = "mermaid"
,paste0(
"graph LR;"
,paste0(
apply(rpk_sourcetarget,MARGIN=1,function(node){
sprintf(
"%s[%s]-->%s[%s];"
,LETTERS[node[["source"]]%>>%as.numeric]
,rpk_text[node[["source"]]%>>%as.numeric,"description"]
,LETTERS[node[["target"]]%>>%as.numeric]
,rpk_text[node[["target"]]%>>%as.numeric,"description"]
)
})
,collapse="\n"
)
) %>>% HTML
)
,tags$script(
)
) %>>%
attachDependencies(
htmlDependency(
name = "mermaid"
,version = "0.2.1"
,src = c("href"="http://www.sveido.com/mermaid/dist/")
,script = "mermaid.full.min.js"
)
) %>>%
html_print