【问题标题】:R directed network from sequence来自序列的 R 定向网络
【发布时间】:2015-05-26 23:59:40
【问题描述】:

(使用:R 3.1.0)

嗨 - 我觉得这应该比我发现的要简单。我有一组序列,我想将它们可视化为有向网络。纯图可能是不正确的,因为每个序列可以有多个节点实例,并且重复顺序在序列中很重要。所以,例如我可能有:

Seq    Count
AB     8000
AC     5500
CB     4900
CBA    4300
ACD    4000
ACACA  3740
CA     2800
...    ...

序列结束的地方很有趣,所以对于每个最终节点,我想展示它的路径及其权重。所以在我上面的(非常小的)例子中:

  • 终点B:A->B权重8000,C->B权重4900。

    8000 A-+
           |-->B
    4900 C-+
    
  • 终点A:C->B->A权重4300,A->C->A->C->A权重3740,C->A 重量为 2800

           4300 C--->B-+
                       |
    4740 A-->C-->A-->C-+--->A
                       |
                2800 C-+
    

需要注意的是,路由 CA 不是 ACACA 的一部分,而是一个单独的路由。

原始数据实际上是按时间顺序排列的事件列表,因此从该点开始可能更容易(而不是上面的聚合视图)。像这样:

seqNo. Node  Time
1      A     0.0
1      B     2.1
2      A     0.0
2      C     3.2
3      C     0.0
3      B     8.1
4      C     0.0
4      B     1.2
4      A     2.3
...    ...   ...

我想知道哪个包(如果有)最适合用于处理这样的序列,以及如何将数据减少到定向网络视图。 iGraph 包看起来可能会有所帮助,但我认为我可能遗漏了一些概念,特别是在这种情况下,邻接矩阵不是真正有效的(由于每对节点的图中有多个邻接)。

更新 - 这是我正在寻找的输出类型的一个想法:

干杯,感谢您的帮助,

安迪。

【问题讨论】:

  • 如何从事件列表中计算计数或重量?
  • 计数实际上是该序列在数据中出现的次数。干杯,

标签: r networking graph sequence


【解决方案1】:

您似乎是在说只有开始和结束节点才作为节点感兴趣,因此您可以将这些节点用作顶点并将中间节点显示为边标签,如以下代码和绘图所示。假设 df 包含您的汇总数据。

library(igraph)
last_char <- nchar(as.character(df$Seq))
df_g <- cbind(v1=substr(df$Seq, 1,1),
              v2=substr(df$Seq, last_char, last_char), df)
g <- graph.data.frame(df_g)
plot(g, edge.label=paste(E(g)$Seq, "\n", E(g)$Count))

绘图的视觉呈现可以改进,但这显示了聚合数据可以生成定向网络视图的方式。可以想象一些替代方法来表示开始节点和结束节点之间的内部节点,但这些似乎会导致更复杂的情节。

更新 2

您的评论让事情变得更清楚了。获取图表的大部分工作是从序列数据中生成图表的边和顶点。一旦定义好,您就可以格式化并发送到绘图包进行显示。下面的代码构造了一个包含边连接和结束位置的数据框df_g,使用df_g 生成一个包含顶点数据的数据框df_v,然后将两者都传递给igraph 进行绘图。您可以通过检查 df_gdf_v 来了解代码在做什么。

  library(igraph)
  last_char <- nchar(df$Seq)
  df <- df[order(substr(df$Seq, last_char, last_char), df$Seq),]
  edges <- as.character(df$Seq)
  df_g <- data.frame(v1=NA_character_, v2=NA_character_, Seq=NA_character_, 
                     Count=NA_character_, label=NA_character_, arrow.mode = NA_character_, end = NA_character_, 
                     x1 = NA_integer_, x2 = NA_integer_, y1=NA_integer_, y2=NA_integer_,  type=NA_character_,
                     stringsAsFactors=FALSE)
  for( i in 1:nrow(df)){
 #  Make sequence edges
      edge <- edges[i]
      num_vert <- nchar(edge)
      j <- 1:(num_vert-1)
      df_g_j <- data.frame( v1=paste(edge, j,sep="_"), v2=paste(edge, j+1,sep="_"), 
                         Seq=edge, Count=df$Count[i], label=sapply(j, function(x) substr(edge, x, x)), 
                         arrow.mode = ">", end=substr(edge,num_vert,num_vert),
                         x1=j-num_vert, x2=j+1-num_vert,  y1=i, y2=i, type="seq", stringsAsFactors=FALSE) 
      df_g_j[num_vert-1, "arrow.mode"] <- "-"       # make connector vertex   
      df_g_con <- transform(df_g_j[num_vert-1,], v1=v2, v2=paste(end, "connector", sep="_"), x1=0, label=NA, type="connector")
      df_g <- rbind(df_g, df_g_j, df_g_con)    
    }
    df_g <- df_g[-1,]
    df_g[df_g$type=="connector",] <- within(df_g[df_g$type=="connector",], y2 <- tapply(y2, v2, mean)[v2])
    cn_vert <- aggregate(v2 ~ end, data=df_g[df_g$type=="connector", ], length)
    colnames(cn_vert) <- c("end","num")
    for( end in cn_vert$end){
      cn_vert_row <- which(df_g$end == end & df_g$type == "connector")[1]
      if( cn_vert$num[cn_vert$end==end] > 1 ) {
        df_g <- rbind(df_g,with(df_g[cn_vert_row,], 
                                data.frame(v1=v2, v2=end, Seq=NA_character_, Count=NA_character_, label=NA,
                                           arrow.mode = ">", end=end, x1=x2, x2= 1, y1 = y2, y2=y2, type = "common_end", 
                                          stringsAsFactors=FALSE)) ) }
      else df_g[cn_vert_row,] <- transform(df_g[cn_vert_row,], v2=end, label=NA, arrow.mode=">", x2=1,type="common_end")
  }
#  make vertices
  df_v <- with(df_g, data.frame(v=v1, label = label, x=x1, y=y1, color = "black", size = 15, stringsAsFactors=FALSE))
  df_v <- rbind(df_v, with(df_g[df_g$type == "common_end",], 
                           data.frame(v=end, label = v2, x=x2, y=y2, color="black", size=15, stringsAsFactors=FALSE)))
  df_v[is.na(df_v$label),] <- transform(df_v[is.na(df_v$label),], color = NA, size = 0)
#
#  make graph from edges and vertices
  g <- graph.data.frame(df_g, vertices=df_v)
  E(g)$label <- NA                       # assign Counts as labels to sequence start vertices
  e_start <- grep("_1",get.edgelist(g)[,1])
  E(g)[e_start]$label <- E(g)[e_start]$Count
# adjust and scale edge label positions
  h_jst <- 0            # values between 0 and .2
  edge_label_x  <- 1 - 2*(1.5 + h_jst - E(g)$x1)/diff(range(V(g)$x))
  num_color <-12                           # assign colors to Count labels; num_color is number of colors in pallette
  counts <- as.integer(E(g)$Count)
  edge_label_color <- rainbow(num_color, start=0, end=.75)[num_color- 
                                         floor((num_color-1)*(counts-min(counts,na.rm=TRUE))/diff(range(counts,na.rm=TRUE)))]
  plot(g, vertex.label.color="white", vertex.frame.color=V(g)$color, 
       edge.color="blue", edge.arrow.size=.6, edge.label.x= edge_label_x, 
       edge.label.color=edge_label_color, edge.label.font=2, edge.label.cex=1.1)

对于您的示例数据,这给出了如下所示的图表。放大图时,Count 标签与顶点的距离更大,但您可以通过代码中的变量 h_jst 进一步调整。

【讨论】:

  • 感谢@WaltS。这是一种有趣的方法,至少给了我部分答案。实际上,它可以在某些方面以非常简洁的方式展示任意两个节点之间的不同路由的数量。不幸的是,问题在于视图的呈现 - 放在客户面前可能需要一些解释,因为我在问题中显示的“链接系列”视图乍一看可能更容易理解。
  • 感谢您的更新@WaltS。这更接近,但我正在寻找图形输出(这就是为什么我认为网络或图形绘图包之一可能会这样做) - 我已经用一个更好的视觉示例更新了我的问题。更改箭头权重、节点颜色等的能力也是有益的,这是我对绘图包的期望。
  • 感谢您为获得解决方案所做的(相当大的)努力。我当然会接受这个作为答案,但它告诉我,我希望通过一个相当简单的网络绘图包实现的目标可能无法实现。真的我需要一个带有布局选项等的通用解决方案。
【解决方案2】:

我发现了一个包,它以一种可以接受的方式巧妙地(虽然冗长地)解决了这个问题,尽管从格式的角度来看,这并不是我想要的完全

使用DigrammeR 包(通过grViz 函数实现graphViz)我可以设计一个看起来像问题中我想要的输出的网络。该语言很冗长,但是一旦您发现了适当的网络路径,就很容易构造代码以通过算法提供给grViz

代码是:

library(DiagrammeR)
library(V8)
library(XML)

gph<-grViz("
  digraph {
    outputorder=edgesfirst;
    rankdir='LR';
    node [shape = circle, style='filled', fillcolor = black, fontname=Arial, fontcolor=white];

    A1 -> C1 -> D1              [color='cornflowerblue', penwidth=3];
    A2 -> C2                    [color='cornflowerblue', penwidth=3];
    C3 -> B1                    [color='cornflowerblue', penwidth=3];
    A3 -> B1                    [color='cornflowerblue', penwidth=3];
    C4 -> B2 -> A4              [color='cornflowerblue', penwidth=3];
    C5 -> A4                    [color='cornflowerblue', penwidth=3];
    A5 -> C6 -> A6 -> C7 -> A4  [color='cornflowerblue', penwidth=3];

    w1 -> A1 [dir=none, style=dotted];
    w2 -> A2 [dir=none, style=dotted];
    w3 -> C3 [dir=none, style=dotted];
    w4 -> A3 [dir=none, style=dotted];
    w5 -> C4 [dir=none, style=dotted];
    w6 -> C5 [dir=none, style=dotted];
    w7 -> A5 [dir=none, style=dotted];

    w1 [shape=box];
    w2 [shape=box];
    w3 [shape=box];
    w4 [shape=box];
    w5 [shape=box];
    w6 [shape=box];
    w7 [shape=box];

    w1 [label='4000', fillcolor='yellow3'];
    w2 [label='5500', fillcolor='pink'];
    w3 [label='4900', fillcolor='orange'];
    w4 [label='8000', fillcolor='red'];
    w5 [label='4300', fillcolor='orange'];
    w6 [label='2800', fillcolor='yellow'];
    w7 [label='3740', fillcolor='yellow3'];

    A1 [label='A'];
    A2 [label='A'];
    A3 [label='A'];
    A4 [label='A'];
    A5 [label='A'];
    A6 [label='A'];
    B1 [label='B'];
    B2 [label='B'];
    C1 [label='C'];
    C2 [label='C'];
    C3 [label='C'];
    C4 [label='C'];
    C5 [label='C'];
    C6 [label='C'];
    C7 [label='C'];
    D1 [label='D'];

  }")
graph.svg<-exportSVG(gph)
write(graph.svg, "C:/graph.svg")

这会生成一个如下所示的标准 SVG 文件:

【讨论】:

    猜你喜欢
    • 2016-10-07
    • 1970-01-01
    • 1970-01-01
    • 2013-01-21
    • 1970-01-01
    • 1970-01-01
    • 2021-07-09
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多