timelyportfolio/Readme.md

## Readme.md

      
    Raw
  

              Readme.md
            
          
    another quick experiment adding to these interactive javascript views of R partykit / rpart recursive partitioning / clustering.
For a couple other experiments see:

http://bl.ocks.org/timelyportfolio/58f8fe3e167ef47145d0
http://bl.ocks.org/timelyportfolio/d4ff502dc32b5b04eae4
http://bl.ocks.org/timelyportfolio/adc2dfee7aef48ce5485

Code here
Live example

  
## code.R
# 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

## index.html
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8"/>
<script src="http://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
	<!DOCTYPE html>
	<html>
	<head>
	<meta charset="utf-8"/>
	<script src="http://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>