可折叠的R语言树形图

10

我被这篇关于R中可折叠树的文章所激励。

http://bl.ocks.org/mbostock/4339083

我正在尝试使用一个类似于这个玩具数据集的例子来复制相同的示例。

ID      Car Bus Train   Feedback_Car    Feedback_Bus    Feedback_Train
23433   Yes Yes Yes     Toyota          GreyHound       Amtrak

可以表示为可折叠树,如下所示:

enter image description here

我想知道是否有人能够帮助我使用上面的玩具数据集来重现该概念(可折叠树),这个例子将帮助我了解不同组件的工作方式,例如在 R 中格式化 JSON 数据等,并作为起点。提前感谢您的帮助。


上面提到的数据集是什么?这是一个CSV文件吗? - Cyril Cherian
@ Cyril,是的,那是正确的。 - Ezra Polson
看一下这个例子。D3.js完成了大部分工作,但它是在一个shiny应用程序中。 - jeremycg
请提供好的答案。请勿在未来提出“为我编写此代码”的问题。 - rawr
7个回答

5

这个可折叠的树看起来非常酷。我的方法是首先使用igraph创建一个图形。我希望已经有一个将igraph转换为json的函数,但看起来这是github上尚未实现的问题。因此,这里有一个简单的函数来实现这个功能。然后,您只需要将结果数据插入到链接源中,就可以得到一个可折叠的树。

## Read your data
dat <- read.table(text="ID      Car Bus Train   Feedback_Car    Feedback_Bus    Feedback_Train
23433   Yes Yes Yes     Toyota          GreyHound       Amtrak", header=TRUE)

## Make an edgelist from your data
edges <- rbind(cbind(dat$ID, names(dat)[2:4]),
               cbind(names(dat)[2:4], as.vector(t(dat[5:7]))))

## Convert to a graph data structure
library(igraph)
g <- graph_from_edgelist(edges)

## This is the non-interactive version
plot(g, layout=layout.reingold.tilford(g, root='23433'))

enter image description here

## Recursive function to make a list of nodes to be parsed by toJSON
## call it with 'node' as the root node (here '23433')
f <- function(g, node, size=1000) {
    n <- neighbors(g, node, mode='out')
    if (length(n) == 0) return( list(name=node, size=size) )
    children <- lapply(n$name, function(x) f(g, x, size))
    list(name=node, children=children)
}

## Convert to json
library(jsonlite)
json <- toJSON(f(g, '23433'), auto_unbox = TRUE)

## I made a directory collapsible to store the index.html from the linked
## site, as well as this data
## For completeness, you should be able to run this to see the interactive results,
## But, of course, this is creating files on your box
dir.create('collapsible')
writeLines(json, 'collapsible/data.json')

## Download the index.html
download.file("https://gist.githubusercontent.com/mbostock/4339083/raw/0d003e5ea1686dd6e79562b37f8c7afca287d9a2/index.html", "collapsible/index.html", method='curl')

## Replace with the correct data
txt <- readLines('collapsible/index.html')
txt[grepl("^d3.json", txt)] <- "d3.json('data.json', function(error, flare) {"
writeLines(txt, 'collapsible/index.html')

## Open in broweser
browseURL(paste0('file://', normalizePath('collapsible/index.html')))

这些结果也可以在这里查看。


目前当函数browseURL...打开一个网页时,它是空的......这是因为在行txt[grepl("^d3.json".....的末尾有一个未关闭的{吗? - Ezra Polson
1
尽管看起来有些混乱,但那只是函数的开头。该行的目的是简单地替换传递给d3.json的数据参数。如果您查看整个文档,它将有意义。 - Rorschach
@EzraPolson 我也是 :),你做了什么,有什么错误信息?你可以点击底部的链接,以全貌查看它,附有所有必要的代码以进行复现。 - Rorschach
:) 哈哈,点击链接可以工作,但是当我将此示例复制粘贴到我的 R 中并运行代码时,我在运行 download.file.... 行时看到一个警告 Warning messages: 1: running command 'curl "https://gist.githubusercontent.com/mbostock/4339083/raw/0d003e5ea1686dd6e79562b37f8c7afca287d9a2/index.html" -o "collapsible/index.html"' had status 127 2: In download.file("https://gist.githubusercontent.com/mbostock/4339083/raw/0d003e5ea1686dd6e79562b37f8c7afca287d9a2/index.html", : download had nonzero exit status - Ezra Polson
我手动复制粘贴了那个index.html页面到可折叠文件夹中...如果太复杂也没关系。我会从这里尝试着解决的... :) - Ezra Polson
1
@EzraPolson,你只是在使用download.filecurl选项时遇到了问题。你可以尝试调整其他选项,但由于是https:,所以可能会受到一些限制。最简单的方法可能是手动将该页面复制并粘贴到index.html中。然后,其余部分应该就能正常工作了。 - Rorschach

2

我读取了csv文件,并将节点JSON结构制作如下:

d3.csv("my.csv", function(error, data) {
  var map1 = []
  data.reduce(function(map, node) {
    map1.push(node)
    return node;
  }, {});

  root = {};
  root.name = map1[0].ID;
  root.children = [];
  var car = {
    name: "Car",
    children: [{
      name: map1[0].Feedback_Car,
      children: []
    }]
  };
  root.children.push(car);
  var bus = {
    name: "Bus",
    children: [{
      name: map1[0].Feedback_Bus,
      children: []
    }]
  };
  root.children.push(bus);
  var train = {
    name: "Bus",
    children: [{
      name: map1[0].Feedback_Train,
      children: []
    }]
  };
  root.children.push(train);

});

这是可运行的代码,链接在这里

希望这对您有所帮助!


抱歉,我不懂R语言……我回答这个问题是因为它被标记在d3中。 - Cyril Cherian

1

非常抱歉我来晚了。我认为您正在寻找R语言的解决方案,而不是强制使用外部代码的解决方案。可以利用k3d3软件包。https://github.com/kaseyriver11/k3d3以下是您需要的内容:

library(k3d3)
library(RJSONIO)
library(stringr)

type <- c("Car", "Car", "Truck", "Truck", "Bus", "Bus")
name <- c("Chevy", "Ford", "Chevy", "Ford", "Greyhound", "Holiday Express")
size <- c(rep(3840,6))
data <- data.frame(type, name, size)


makeList<-function(x){
    if(ncol(x)>2){
        listSplit<-split(x[-1],x[1],drop=T)
        lapply(names(listSplit),function(y){list(name=y,children=makeList(listSplit[[y]]))})
    }else{
        lapply(seq(nrow(x[1])),function(y){list(name=x[,1][y],Percentage=x[,2][y])})
    }
}

jsonOut<-toJSON(list(name="23433",children=makeList(data)))
jsonOut2 <- str_replace_all(jsonOut, "[\r\n]" , "")

CTR(jsonOut2)

提供数据的树图片


0

这里有一个关于如何格式化数据的详细解释在这里。它们基于这个答案,讲述了如何创建带有子元素的Json。

注意:我认为您需要重新整理数据集以获取以下列:ID、车辆类型、品牌。

一旦您的Json准备好了,您可以获取您的示例的html文件,并将“flare.json”替换为我们的数据输出路径。


0

虽然价值有限,但我想分享一下我将数据从R推送到D3的方法:

<!--begin.rcode results="asis", echo=FALSE, warning=FALSE, message=FALSE
    library(RJSONIO)
    library(MASS)
    set.seed(1234)
    data <- data.frame("Sample"=rbeta(1000,10,15))
    out  <- paste("<script type='text/javascript'> var json ='",   jsonlite::serializeJSON(data), "';</script>", sep="")
end.rcode-->

这段代码块位于我的RHTML文件的正文元素开头。在编织之后,数据将被写入输出HTML文件中,并且可以通过json变量由D3访问。 下面是输出HTML文件的截图:

enter image description here

在图片底部,您可以看到只需使用JSON.parse()解析json对象,就可以将数据转换为JS格式 :)

0
在当前的networkD3开发版本(v0.4.9000 @ 2017.08.30)中,有一个新的treeNetwork()函数,它具有(交互式、可折叠的树形网络图)和许多其他内置功能。
您可以使用以下命令安装当前的开发版本...
devtools::install_github("christophergandrud/networkD3")

使用...,并绘制一个可折叠的树形网络图来展示您的数据。

library(networkD3)

df <- read.table(header = T, stringsAsFactors = F, text = "
ID      Car Bus Train   Feedback_Car    Feedback_Bus    Feedback_Train
23433   Yes Yes Yes     Toyota          GreyHound       Amtrak
")

links <- data.frame(nodeId = c(df$ID, names(df)[2:4], as.character(df[5:7])), 
                    parentId = c("", rep(df$ID, 3), sub("^Feedback_", "", names(df[5:7]))))
links$name <- links$nodeId

treeNetwork(links, type = "tidy")

仍有大量错误需要修复,因此我们将感激测试、填写问题/错误报告和/或拉取请求。https://github.com/christophergandrud/networkD3


0

您可以使用data.tree包将数据转换为JSON格式,或者使用networkD3包:

dat <- read.table(text="ID      Car Bus Train   Feedback_Car    Feedback_Bus    Feedback_Train
23433   Yes Yes Yes     Toyota          GreyHound       Amtrak", header=TRUE)

## Make an edgelist from your data
edges <- rbind(cbind(dat$ID, names(dat)[2:4]),
               cbind(names(dat)[2:4], as.vector(t(dat[5:7]))))

library(data.tree)
tree <- FromDataFrameNetwork(as.data.frame(edges))

tree

这将会打印出来:

          levelName
1 23433            
2  ¦--Car          
3  ¦   °--Toyota   
4  ¦--Bus          
5  ¦   °--GreyHound
6  °--Train        
7      °--Amtrak   

现在,使用树形结构与networkD3绘图:

lol <- ToListExplicit(tree, unname = TRUE)

library(networkD3)

diagonalNetwork(lol)

很遗憾,目前还不支持可折叠树。但是这里有一个使用Shiny实现你想要的功能的示例。为了将你的数据转换为正确的JSON格式,只需执行以下操作:

library(jsonlite)
json <- toJSON(lol)

那是非常高效的。我会尝试可折叠树的例子。 - Ezra Polson

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接