如何在R中用Plotly绘制带箭头的igraph有向3D网络图？

我用igraph和plotly绘制3D网络图，代码如下：

library(igraph)
library(plotly)

g_df <- data.frame(from = c(1,1,2,2,3,4,5,5),to = c(2,4,1,4,4,4,4,2))
G <- graph_from_data_frame(g_df)

L <- layout.auto(G,dim=3)

vs <- V(G)
es <- as.data.frame(get.edgelist(G))

Nv <- length(vs)
Ne <- length(es[1]$V1)

Xn <- L[,1]
Yn <- L[,2]
Zn <- L[,3]

es$breaks <- NA

lines <- data.frame(node=as.vector(t(es)), x=NA, y=NA, z=NA)
lines[which(!is.na(lines$node)),]$x <- Xn[as.integer(lines[which(!is.na(lines$node)),]$node)]
lines[which(!is.na(lines$node)),]$y <- Yn[as.integer(lines[which(!is.na(lines$node)),]$node)]
lines[which(!is.na(lines$node)),]$z <- Zn[as.integer(lines[which(!is.na(lines$node)),]$node)]

network <- plot_ly(type = "scatter3d", x = Xn, y = Yn, z = Zn, 
               mode = "markers",# text = vs$label, hoverinfo = "text", 
               showlegend = F) %>%
add_trace(x=lines$x, y=lines$y, z=lines$z, showlegend = FALSE,
        type = 'scatter3d', mode = 'lines+markers',
        marker = list(color = '#030303'), line = list(width = 3),
        connectgaps=FALSE)
network

目前能生成图形，但无法用箭头体现有向性，且循环边显示异常，求解决方法。

解决方案 #

1. 添加箭头体现有向性 #

Plotly的scatter3d不原生支持箭头，可通过「线条缩短+标记模拟」的方式实现：

• 计算每条边的方向向量，将线条终点偏移至目标节点附近，避免与节点重合
• 在目标节点位置添加三角形标记模拟箭头

2. 修复循环边显示 #

循环边因起点和终点重合导致线条不可见，需手动生成小型闭环路径让其可视化。

完整修改代码 #

library(igraph)
library(plotly)

g_df <- data.frame(from = c(1,1,2,2,3,4,5,5),to = c(2,4,1,4,4,4,4,2))
G <- graph_from_data_frame(g_df)

L <- layout.auto(G,dim=3)
vs <- V(G)
es <- as.data.frame(get.edgelist(G))

Xn <- L[,1]
Yn <- L[,2]
Zn <- L[,3]

# 箭头与节点的距离（可调整）
arrow_offset <- 0.1
# 循环边的偏移幅度（可调整）
loop_offset <- 0.1

# 批量处理每条边的坐标
edge_coords <- lapply(1:nrow(es), function(i) {
  from_idx <- which(vs$name == es[i,1])
  to_idx <- which(vs$name == es[i,2])
  
  from_x <- Xn[from_idx]
  from_y <- Yn[from_idx]
  from_z <- Zn[from_idx]
  to_x <- Xn[to_idx]
  to_y <- Yn[to_idx]
  to_z <- Zn[to_idx]
  
  # 处理循环边
  if(from_idx == to_idx) {
    return(list(
      line_x = c(from_x, from_x + loop_offset, from_x),
      line_y = c(from_y, from_y, from_y + loop_offset),
      line_z = c(from_z, from_z, from_z),
      arrow_x = from_x + loop_offset,
      arrow_y = from_y,
      arrow_z = from_z
    ))
  }
  
  # 处理普通有向边：计算方向向量并偏移终点
  dx <- to_x - from_x
  dy <- to_y - from_y
  dz <- to_z - from_z
  norm <- sqrt(dx^2 + dy^2 + dz^2)
  
  dx_norm <- dx / norm
  dy_norm <- dy / norm
  dz_norm <- dz / norm
  
  line_end_x <- to_x - arrow_offset * dx_norm
  line_end_y <- to_y - arrow_offset * dy_norm
  line_end_z <- to_z - arrow_offset * dz_norm
  
  list(
    line_x = c(from_x, line_end_x),
    line_y = c(from_y, line_end_y),
    line_z = c(from_z, line_end_z),
    arrow_x = to_x,
    arrow_y = to_y,
    arrow_z = to_z
  )
})

# 构建边的线条数据
line_data <- do.call(rbind, lapply(seq_along(edge_coords), function(i) {
  ec <- edge_coords[[i]]
  data.frame(x = ec$line_x, y = ec$line_y, z = ec$line_z, group = i)
}))

# 构建箭头标记数据
arrow_data <- do.call(rbind, lapply(edge_coords, function(ec) {
  data.frame(x = ec$arrow_x, y = ec$arrow_y, z = ec$arrow_z)
}))

# 绘制最终3D网络图
network <- plot_ly(type = "scatter3d", x = Xn, y = Yn, z = Zn, 
                   mode = "markers", marker = list(size=10, color="#636EFA"),
                   showlegend = F) %>%
  # 添加边的线条
  add_trace(data = line_data, x = ~x, y = ~y, z = ~z, 
            type = 'scatter3d', mode = 'lines',
            line = list(width = 3, color="#030303"),
            showlegend = FALSE, split = ~group, connectgaps=FALSE) %>%
  # 添加箭头标记（用三角形模拟）
  add_trace(data = arrow_data, x = ~x, y = ~y, z = ~z,
            type = 'scatter3d', mode = 'markers',
            marker = list(size=8, color="#030303", symbol="triangle-up"),
            showlegend = FALSE)
network

自定义调整说明 #

• 箭头样式：可修改marker$symbol参数，比如换成triangle-right、diamond等
• 箭头距离：调整arrow_offset数值，控制箭头与节点的间距
• 循环边样式：修改loop_offset数值，调整循环边的大小和方向

内容的提问来源于stack exchange，提问作者pvmb