Как определить надежные параметры среза для динамического рендеринга сети в R с помощью ndtv?

Question

Я стараюсь создавать визуальную динамическую анимацию транзакций с метками времени, где каждая транзакция представляет собой вклад человека в артефакт / файл. Для этого я использую пакеты R networkDynamic, network а также ndtv,

Транзакции имеют (в отличие от примеров в networkDynamic пакет виньетка) "настоящие" метки времени. Я хочу обернуть процесс рендеринга внутри функции, которая

• начинает рендеринг в начале "естественного периода времени", такого как день или неделя (который, скорее всего, не является меткой времени первого события)
• отображает "натуральные" метки на временной шкале игроков вместо целых
• использует "естественные" срезы, такие как неделя / месяц / год на основе входных данных

Я думаю, что мне удалось запустить первый срез в начале недели первого события, используя lubridates floor_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))

Как я могу получить правильные параметры среза из набора данных, чтобы процесс рендеринга не подавлялся отдельными срезами, которые пропускают атрибуты или ребра, без простого увеличения продолжительности агрегации?

Answer 1

Как вы уже установили, в render.d3movie функция. Он пытается найти значения для "пустого" среза (временной диапазон, в котором нет активных вершин), см. Отчет об ошибке на Github. (Я не могу воспроизвести ошибку с вашим кодом выше, но это определенно ошибка, спасибо за сообщение)

Как я могу получить правильные параметры среза из набора данных, чтобы процесс рендеринга не подавлялся отдельными срезами, которые пропускают атрибуты или ребра, без простого увеличения продолжительности агрегации?

Пока ошибка не будет исправлена ​​(надеюсь, скоро), вы могли бы

а) использовать render.animation вместо

б) выберите параметры своего среза, чтобы убедиться, что нет среза, где в сети нет активных вершин. Вы можете использовать timeline функция, чтобы увидеть, где приземлится ломтики. Например, чтобы показать заклинания активности для узлов (синие) и ребер (фиолетовые) вместе с ячейками срезов (вертикальные серые полосы):

timeline(net,slice.par=slice.par,main='timeline plot of activity spells')

c) наилучшим решением может быть настройка активности вершин, чтобы убедиться, что вершина всегда активна в каждом временном интервале. В этом случае есть некоторые вершины, которым reconcile.vertex.activity потому что они охватывают только края очень короткой продолжительности. Использование другого правила может избежать этого или установить вершины всегда активными после их появления (если это имеет смысл для ваших данных).

Некоторые другие заметки:

Вам, вероятно, также необходимо установить slice.par$rule значение для earliest вместо any так что когда он встречает несколько возможных значений при weight атрибут по краям он будет знать, какой из них выбрать.

Кстати, я думаю, что может быть более компактный способ построить вашу сеть, используя networkDynamic функция полезности и передача в stTransac и, вероятно, это будет быстрее при загрузке большого набора данных.