来自序列的 R 定向网络
R directed network from sequence
（使用：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 包看起来可能有帮助，但我认为我可能遗漏了一些概念，特别是在邻接矩阵不是真正有效的情况下（由于每对节点在图中的多个邻接）。
更新 - 这是我正在寻找的输出类型的想法：
干杯并感谢您的帮助，
安迪.
您似乎是说只有开始节点和结束节点作为节点感兴趣，因此您可以将这些节点用作顶点并将中间节点显示为边标签，如以下代码和绘图所示。假设 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_g 和 df_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)
对于您的示例数据，这给出了下图所示的图表。当图被放大时，计数标签与顶点的分离更大，但您可以通过代码中的变量 h_jst 进一步调整。
我发现了一个包，它以可接受的方式巧妙地（虽然冗长）解决了这个问题，尽管从格式的角度来看完全不是我想要的.
使用 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 文件：
（使用：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 包看起来可能有帮助，但我认为我可能遗漏了一些概念，特别是在邻接矩阵不是真正有效的情况下（由于每对节点在图中的多个邻接）。
更新 - 这是我正在寻找的输出类型的想法：
干杯并感谢您的帮助，
安迪.
您似乎是说只有开始节点和结束节点作为节点感兴趣，因此您可以将这些节点用作顶点并将中间节点显示为边标签，如以下代码和绘图所示。假设 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_g 和 df_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)
对于您的示例数据，这给出了下图所示的图表。当图被放大时，计数标签与顶点的分离更大，但您可以通过代码中的变量 h_jst 进一步调整。
我发现了一个包，它以可接受的方式巧妙地（虽然冗长）解决了这个问题，尽管从格式的角度来看完全不是我想要的.
使用 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 文件：