adding dedrogram and phylo in hchart, closes #63, closes #64

DESCRIPTION

@@ -30,7 +30,9 @@ Imports:
     tidyr,
     htmltools,
     jsonlite,
-    igraph
+    igraph,
+    ggdendro,
+    ape
 Suggests:
     knitr,
     rmarkdown

NAMESPACE

@@ -3,13 +3,15 @@
 S3method(hchart,acf)
 S3method(hchart,character)
 S3method(hchart,default)
+S3method(hchart,dendrogram)
 S3method(hchart,dist)
 S3method(hchart,factor)
 S3method(hchart,forecast)
 S3method(hchart,histogram)
 S3method(hchart,igraph)
 S3method(hchart,mts)
 S3method(hchart,numeric)
+S3method(hchart,phylo)
 S3method(hchart,stl)
 S3method(hchart,ts)
 S3method(hchart,xts)
@@ -108,6 +110,7 @@ importFrom(dplyr,rename_)
 importFrom(dplyr,select)
 importFrom(dplyr,select_)
 importFrom(dplyr,tbl_df)
+importFrom(ggdendro,dendro_data)
 importFrom(grDevices,col2rgb)
 importFrom(grDevices,colorRampPalette)
 importFrom(graphics,hist)
@@ -118,12 +121,16 @@ importFrom(htmlwidgets,createWidget)
 importFrom(htmlwidgets,shinyRenderWidget)
 importFrom(htmlwidgets,shinyWidgetOutput)
 importFrom(htmlwidgets,sizingPolicy)
+importFrom(igraph,"V<-")
+importFrom(igraph,V)
 importFrom(igraph,get.edge.attribute)
 importFrom(igraph,get.edgelist)
 importFrom(igraph,get.vertex.attribute)
+importFrom(igraph,graph.edgelist)
 importFrom(igraph,layout_nicely)
 importFrom(jsonlite,toJSON)
 importFrom(magrittr,"%>%")
+importFrom(purrr,by_row)
 importFrom(purrr,map)
 importFrom(purrr,map2)
 importFrom(purrr,map_df)

R/hchart.R

@@ -369,6 +369,60 @@ hchart.igraph <- function(object, ..., layout = layout_nicely, digits = 2) {
 
 }
 
+# @importFrom ape as.igraph.phylo
+#' @importFrom igraph graph.edgelist V V<-
+#' @export
+hchart.phylo <- function(object, ...) {
+
+  x <- object
+  if (is.null(x$node.label))
+    x <- makeNodeLabel(x)
+  x$edge <- matrix(c(x$tip.label, x$node.label)[x$edge], ncol = 2)
+
+  object <- graph.edgelist(x$edge)
+  # object <- as.igraph.phylo(object)
+
+  V(object)$size <- ifelse(str_detect(V(object)$name, "Node\\d+"), 0, 1)
+
+  hchart(object, minSize = 0, ...)
+
+}
+
+#' @importFrom ggdendro dendro_data
+#' @importFrom purrr by_row
+#' @export
+hchart.dendrogram <- function(object, ...) {
+
+  dddata <- dendro_data(object)  
+
+  dsseg <- dddata$segments %>% 
+    mutate(x = x - 1, xend = xend - 1) %>% 
+    by_row(function(x){
+      list(list(x = x$x, y = x$y), list(x = x$xend, y = x$yend))
+    }, .to = "out") %>% 
+    .[["out"]]
+
+  hc <- highchart() %>% 
+    hc_plotOptions(
+      series = list(
+        lineWidth = 2,
+        showInLegend = FALSE,
+        marker = list(radius = 0),
+        enableMouseTracking = FALSE
+      )
+    ) %>% 
+    hc_xAxis(categories = dddata$labels$label,
+             tickmarkPlacement = "on") %>% 
+    hc_colors(list(hex_to_rgba("#606060")))
+
+  for (i in seq_along(dsseg)) {
+    hc <- hc %>% hc_add_series(data = dsseg[[i]], type = "scatter")
+  }
+
+  hc
+}
+
+
 # # @export
 # hchart.seas <- function(object, ..., outliers = TRUE, trend = FALSE) {
 # 

devscripts/test-dendro.R

@@ -3,42 +3,52 @@ library("highcharter")
 library("ggdendro")
 library("dplyr")
 
-dd <- iris[, -5] %>% dist %>% hclust %>% as.dendrogram()
-dd <- mtcars %>% dist %>% hclust %>% as.dendrogram()
-plot(dd)
 
-dddata <- dendro_data(dd)
+x <- iris[, -5] %>% dist %>% hclust %>% as.dendrogram()
+x <- mtcars %>% dist %>% hclust %>% as.dendrogram()
 
-by_row2 <- function(.d, .f, ...) {
-  purrr::by_row(.d, .f, ..., .to = "out")[["out"]]
-}
+hchart(as.dendrogram(hclust(dist(mtcars))))
 
-dsseg <- dddata$segments %>% 
-  mutate(x = x - 1, xend = xend - 1) %>% 
-  by_row2(function(x){
-    list(list(x = x$x, y = x$y), list(x = x$xend, y = x$yend))
-  }) 
-
-
-hc <- highchart() %>% 
-  hc_plotOptions(
-    series = list(
-      lineWidth = 2,
-      showInLegend = FALSE,
-      marker = list(radius = 0),
-      enableMouseTracking = FALSE
-    )
-  ) %>% 
-  hc_xAxis(categories = dddata$labels$label,
-           tickmarkPlacement = "on") %>% 
-  hc_colors(list(hex_to_rgba("#606060")))
-
-for (i in seq_along(dsseg)) {
-  hc <- hc %>% hc_add_series(data = dsseg[[i]], type = "scatter")
+attr(x, "class") <- "dendrogram"
+class(x)
+plot(x)
+hchart(x)
+highcharter:::hchart.dendrogram(x)
+hc <- hchart(x)
+#' @importFrom ggdendro dendro_data
+hchart.dendrogram <- function(x, ...) {
+  dddata <- dendro_data(x)  
+
+  by_row2 <- function(.d, .f, ...) {
+    purrr::by_row(.d, .f, ..., .to = "out")[["out"]]
+  }
+
+  dsseg <- dddata$segments %>% 
+    mutate(x = x - 1, xend = xend - 1) %>% 
+    by_row2(function(x){
+      list(list(x = x$x, y = x$y), list(x = x$xend, y = x$yend))
+    }) 
+
+  hc <- highchart() %>% 
+    hc_plotOptions(
+      series = list(
+        lineWidth = 2,
+        showInLegend = FALSE,
+        marker = list(radius = 0),
+        enableMouseTracking = FALSE
+      )
+    ) %>% 
+    hc_xAxis(categories = dddata$labels$label,
+             tickmarkPlacement = "on") %>% 
+    hc_colors(list(hex_to_rgba("#606060")))
+
+  for (i in seq_along(dsseg)) {
+    hc <- hc %>% hc_add_series(data = dsseg[[i]], type = "scatter")
+  }
+
+  hc
 }
 
-hc
-
 hc %>%
   hc_chart(type = "column")
 
@@ -50,8 +60,7 @@ hc %>% hc_chart(type = "bar") %>%
   hc_yAxis(reversed = TRUE) %>%
   hc_xAxis(opposite = TRUE, tickLength = 0)
 
-hc %>% hc_chart(polar = TRUE) %>%
-  hc_yAxis(reversed = TRUE, visible = FALSE) %>% 
-  hc_xAxis(gridLineWidth = 0,
-           lineWidth = 0)
+Shc %>% hc_chart(polar = TRUE) %>%
+  hc_yAxis(reversed = TRUE, visible = TRUE)  %>% 
+  hc_xAxis(gridLineWidth = 0, lineWidth = 0)
 

devscripts/test-igraph.R

@@ -50,6 +50,7 @@ V(net)$degree <- degree(net, mode = "all")*3
 V(net)$betweenness <- betweenness(net)
 V(net)$color <- colorize_vector(V(net)$betweenness)
 V(net)$size <- sqrt(V(net)$degree)
+V(net)$label <- seq_along(V(net)$size)
 hchart(net, minSize = 5, maxSize = 20)
 
 set.seed(10)
@@ -61,8 +62,8 @@ library("stringr")
 library("purrr")
 library("resolution")
 
-net <- #"http://media.moviegalaxies.com/gexf/316.gexf" %>% 
-  "http://media.moviegalaxies.com/gexf/92.gexf" %>% 
+net <- "http://media.moviegalaxies.com/gexf/316.gexf" %>% 
+  # "http://media.moviegalaxies.com/gexf/92.gexf" %>% 
   read_lines() %>% 
   read.gexf() %>% 
   gexf.to.igraph()

devscripts/test-phylo.R

@@ -0,0 +1,24 @@
+library("ape")
+library("igraph")
+library("highcharter")
+
+
+object <- as.phylo(hclust(dist(mtcars)))
+class(object)
+plot(object)
+hchart(object)
+
+
+hchart.phylo <- function(object, ...) {
+
+  object <- as.igraph(object)
+
+  V(object)$size <- ifelse(str_detect(V(object)$name, "Node\\d+"), 0, 1)
+
+  hchart(object, minSize = 0)
+
+}
+
+tr <- rcoal(5)
+(x <- evonet(tr, 6:7, 8:9))
+plot(x)