如何使用ndtv确定R中动态网络渲染的鲁棒切片参数？

我努力制作时间戳事务的可视化动态动画，其中每个事务表示一个人对工件/文件的贡献。为此，我使用了R包

networkDynamic

、

network

和

ndtv

事务具有（与

networkDynamic

package vignette中的示例相反）“真实”时间戳。我想将渲染过程包装在一个函数中

• 在“自然时间范围”的开始处开始渲染，例如 一天或一周（很可能不是第一天的时间戳） （活动）
• 将“自然”标签呈现给玩家时间轴，而不是整数
• 根据输入数据使用“自然”切片，例如周/月/年

我想我已经成功地使用

lubridate

s

floor\u date

在第一个活动的一周开始时开始了第一个片段。我还没有研究上一个问题（标签），因为不幸的是，我很难为我的数据集确定正确的切片参数

请在下面找到RStudio的可复制示例。该示例包括三个名为

slice.par

的列表，一个有效，两个无效。我的目标不是简单地硬编码一个（仅）适用于具体示例的参数配置，首先是因为我的实际数据集要大得多（因此“摆弄”参数要花费很多时间），其次是因为我希望有一个适用于许多不同数据集的函数

if (!require("pacman")) install.packages("pacman")
library("pacman")
pacman::p_load(network, networkDynamic, ndtv, lubridate)

UtilNumericAsDate <- function(nuUnixTimestamp) {
    return(as.POSIXct(nuUnixTimestamp, origin = "1970-01-01 00:00.00 UTC", tz = "UTC"))
}

UtilDateAsNumeric <- function(oTimestamp) {
    return(as.numeric(as.POSIXct(oTimestamp)))
}

stTransac <- "
'contributorId', 'artifactId', 'weight', 'instantId'
'A', 'a1', '1', '2003-06-01 23:09:40'
'A', 'a2', '1', '2004-02-27 11:48:41'
'A', 'a1', '2', '2006-06-25 20:36:49'
'A', 'a3', '1', '2007-01-28 00:35:31'
'A', 'a3', '2', '2007-04-25 16:03:57'
'A', 'a3', '3', '2007-07-19 19:43:49'
'B', 'a1', '1', '2008-02-06 12:37:56'
'C', 'a3', '1', '2008-04-07 02:27:36'
'C', 'a2', '1', '2008-06-01 02:15:35'
'C', 'a2', '2', '2008-10-05 02:32:45'
'B', 'a1', '2', '2009-06-22 01:57:45'
'C', 'a4', '1', '2009-09-15 02:56:33'
'C', 'a5', '1', '2010-06-30 19:42:25'
'C', 'a6', '1', '2011-06-12 23:58:17'
'B', 'a3', '1', '2013-08-30 19:34:28'
'C', 'a1', '1', '2014-10-23 20:49:54'
'C', 'a1', '2', '2014-10-24 16:46:07'
'A', 'a2', '2', '2015-09-26 16:58:17'
'A', 'a7', '1', '2015-10-04 17:40:12'
'A', 'a8', '1', '2015-12-02 10:55:47'
"

dfTransac <- read.csv(text = stTransac, sep = "," , quote = '\'' , strip.white = TRUE, stringsAsFactors = FALSE)

dfEdges <- unique(dfTransac[,1:2])
veUniqueContributors   <- unique(dfEdges[[1]])
veUniqueArtifacts      <- unique(dfEdges[[2]])
nuNrUniqueContributors <- length(veUniqueContributors)
nuNrUniqueArtifacts    <- length(veUniqueArtifacts)

net <- network.initialize(0, directed = TRUE, bipartite = length(veUniqueContributors))

add.vertices.networkDynamic(net, nuNrUniqueContributors, vertex.pid = veUniqueContributors)
add.vertices.networkDynamic(net, nuNrUniqueArtifacts, vertex.pid = veUniqueArtifacts)

net %v% "vertex.names" <- c(veUniqueContributors, veUniqueArtifacts)
net %v% "vertex.type"  <- c(rep("p", length(veUniqueContributors)), rep("a", length(veUniqueArtifacts)))
net %v% "vertex.col"   <- c(rep("blue", length(veUniqueContributors)), rep("gray", length(veUniqueArtifacts)))
net %v% "vertex.sides" <- c(rep(8, length(veUniqueContributors)), rep(4, length(veUniqueArtifacts)))
net %v% "vertex.rot"   <- c(rep(0, length(veUniqueContributors)), rep(45, length(veUniqueArtifacts)))
net %v% "vertex.lwd"   <- c(rep(1, length(veUniqueContributors)), rep(0, length(veUniqueArtifacts)))
net %v% "vertex.cex"   <- c(rep(2, length(veUniqueContributors)), rep(1, length(veUniqueArtifacts)))
set.network.attribute(net,'vertex.pid','vertex.names')
set.network.attribute(net,'edge.pid','edge.names')

add.edges.networkDynamic(net,
                         tail = get.vertex.id(net, dfEdges[[1]]),
                         head = get.vertex.id(net, dfEdges[[2]]),
                         edge.pid = paste0(dfEdges[[1]], "->", dfEdges[[2]]))

activate.edges(net,
               e = get.edge.id(net, paste0(dfTransac[["contributorId"]], "->", dfTransac[["artifactId"]])),
               at = UtilDateAsNumeric(dfTransac$instantId))

activate.edge.attribute(net,
                        prefix = "weight",
                        value = dfTransac$weight,
                        e = get.edge.id(net, paste0(dfTransac[["contributorId"]], "->", dfTransac[["artifactId"]])),
                        at = UtilDateAsNumeric(dfTransac$instantId))

reconcile.vertex.activity(net = net, mode = "encompass.edges", edge.active.default = FALSE)

nuStart      <- range(get.change.times(net, ignore.inf = FALSE))[1]
nuEnd        <- range(get.change.times(net, ignore.inf = FALSE))[2]

nuWeekStart  <- UtilDateAsNumeric(floor_date(UtilNumericAsDate(nuStart), "week"))
nuWeekEnd    <- UtilDateAsNumeric(ceiling_date(UtilNumericAsDate(nuEnd), "week"))

# This doesn't work: "Monthly" slices, 5 year aggregation
# Error: Attribute 'vertex.sides' had illegal missing values for vertex.sides or was not present in plot.network.default.
slice.par <- list(start = nuWeekStart,
                          end = nuWeekEnd,
                          interval = 1*60*60*24*7*4.5,
                          aggregate.dur = 1*60*60*24*7*52*5,
                          rule = "any")

# This doesn't work either: "Bimonthly" slices, "Bimonthly" aggregation
# Error: Attribute 'weight' had illegal missing values for edge.lwd or was not present in plot.network.default.
slice.par <- list(start = nuWeekStart,
                          end = nuWeekEnd,
                          interval = 1*60*60*24*7*4.5*2,
                          aggregate.dur = 1*60*60*24*7*4.5*2,
                          rule = "any")

# This works: "Bimonthly" slices, 5 year aggregation
slice.par <- list(start = nuWeekStart,
                          end = nuWeekEnd,
                          interval = 1*60*60*24*7*4.5*2,
                          aggregate.dur = 1*60*60*24*7*52*5,
                          rule = "any")

compute.animation(net, animation.mode = "kamadakawai", slice.par = slice.par, default.dist = 10)

render.d3movie(net,
               slice.par = slice.par,
               displaylabels = TRUE,
               output.mode = "htmlWidget",
               usearrows = TRUE,
               vertex.col = 'vertex.col',
               vertex.sides = 'vertex.sides',
               vertex.cex = 'vertex.cex',
               vertex.rot = 'vertex.rot',
               edge.lwd = 'weight',
               render.par = list(tween.frames = 10, show.time = TRUE))

if（！require（“pacman”））install.packages（“pacman”）
图书馆（“吃豆人”）
pacman:：p_负载（网络、网络动态、ndtv、润滑油）
utilnumericsdate正如您已经建立的那样，
render.d3movie
函数中有一个bug。它试图查找“空”切片的值（一个不包含活动顶点的时间范围），请参见。（我实际上无法用上面的代码重现错误，但这肯定是一个bug，感谢您的报告）

如何从数据集中导出适当的切片参数，以便在不增加聚合持续时间的情况下，渲染过程不会因缺少属性或边的单个切片而阻塞

在bug修复之前（希望很快），您可以

a） 改为使用
render.animation

b） 选择切片参数以确保网络中没有活动顶点的切片。您可以使用
时间线
功能查看切片将落在何处。例如，要显示节点（蓝色）和边（紫色）以及切片箱（垂直灰色条）的活动拼写，请执行以下操作：


c） 最好的解决方案可能是调整顶点活动，以确保每个时间片中始终有一个顶点处于活动状态。在这种情况下，有些顶点被
协调.vertex.activity
分配了非常短的持续时间，因为它们只包含持续时间非常短的边。使用不同的规则可能会避免这种情况，或者将顶点设置为在它们出现时始终处于活动状态（如果这对数据有意义的话）

其他一些注意事项：

您可能还需要将
slice.par$rule
值设置为
earlime
，而不是
any
，以便在将动态
weight
属性放在边上时遇到多个可能的值时，它将知道选择哪一个

顺便说一句，我认为使用
networkDynamic
实用程序功能并传入
stTransac
，可能有一种更紧凑的方法来构建网络，而且它在加载大型数据集时可能会更快
 AFAIU，在上面的代码中，权重属性活动应该与边缘活动完全同步，因为两者都使用
at
设置为相同的多个时间戳。我希望我没有弄错。我已经找到了缺少边缘/边缘属性的问题：请注意，使用上面的
activate.edges
调用构建网络会试图在一次调用中为每个边缘设置多个属性活动法术，因此一些法术将被忽略，从而导致下游问题。
timeline(net,slice.par=slice.par,main='timeline plot of activity spells')