【问题标题】:R: Recreate historical membership from a list of changes in membershipR:从成员更改列表中重新创建历史成员
【发布时间】:2013-07-10 11:19:08
【问题描述】:

假设我有一个组的当前成员状态,即成员的名字。此外,我有一些新成员可能已添加到群组和/或旧成员可能已从群组中删除的时间的数据。

手头的任务是在所有这些时间点重新创建组的成员身份。我环顾四周,但没有找到解决此问题的现成解决方案。有人知道这样做的优雅方法吗?

可重现的例子:

输入:

periods <- 5
indx <- paste0("t-", seq_len(periods))
[1] "t-1" "t-2" "t-3" "t-4" "t-5"

current <- letters[seq_len(10)]
[1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"

incoming <- setNames(letters[seq_len(periods) + 5], indx)
incoming[2] <- NA
t-1 t-2 t-3 t-4 t-5
"f"  NA "h" "i" "j"

outgoing <- setNames(letters[seq_len(periods) + 10], indx)
outgoing[4] <- NA
t-1 t-2 t-3 t-4 t-5
"k" "l" "m"  NA "o"

输出:

$current
 [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"

$`t-1`
 [1] "a" "b" "c" "d" "e" "g" "h" "i" "j" "k"

$`t-2`
 [1] "a" "b" "c" "d" "e" "g" "h" "i" "j" "k" "l"

$`t-3`
 [1] "a" "b" "c" "d" "e" "g" "i" "j" "k" "l" "m"

$`t-4`
 [1] "a" "b" "c" "d" "e" "g" "j" "k" "l" "m"

$`t-5`
 [1] "a" "b" "c" "d" "e" "g" "k" "l" "m" "o"

免责声明:我已经为此编写了一个解决方案,我将发布它作为我对这个问题的回答。目的是记录这个问题和可能的解决方案,并引出其他巧妙的和/或现有的解决方案或改进。

【问题讨论】:

  • 这是数据的确切形式吗?或者您是从其他格式读取它们吗?
  • 它的理想用例是什么?程序是否应该能够回答“谁在第 N 纪元组中”的查询?因为存储特定于时代的列表可能会占用大量内存,所以我会考虑在时代上存储差异列表并存储原始列表。只是稍后应用一些差异来回答问题。
  • @Thomas:这是我为测试此解决方案而生成的数据。也可以使用其他结构。
  • @Shark:用例是在金融指数中重新创建股票的成员资格。另外,请参阅此处的相关问题:stackoverflow.com/questions/17569577/…。我会考虑你在说什么。
  • 想象一个 100 个元素的长列表,它会在 1000 个 epoch 上删除 rand(100) 个元素。是保存 1000 个成员列表,还是保存一个起始成员列表和 1000 个差异,您只需按顺序将其应用于列表?此外,可以保存一个“主差异”列表,它是所有先前差异的聚合,但作为一个差异更改。这允许通过仅应用一个差异更改来了解“当前”(最新)成员列表。但是计算主差异是我现在一无所知的事情:)

标签: r set


【解决方案1】:

函数create_mem_ts(成员资格时间序列)将生成问题中发布的所需输出。

create_mem_ts <- function (ctime, added, removed, current) {

  # Create a time-series of membership of a set.

  # Inputs:

  ## ctime:     Time of changes in set.
  ##            An atomic vector of a time-series class or otherwise,
  ##
  ##            interpretable as a time-series in descending order (for e.g.
  ##            `t-1`, `t-2`, `t-3` etc.
  ##
  ##            Is an index of when the changes in membership happened in time.
  ##            Allows repeats but no NAs.

  ## added:     Member(s) added to the set.
  ##            An atomic vector or a list of the same length as ctime.
  ##
  ##            If an atomic vector, represents exactly one member added at
  ##            the corresponding ctime.
  ##
  ##            If a list, represents multiple members added at corresponding
  ##            ctime.

  ## removed:   Member(s) removed from the set.
  ##            An atomic vector or a list of the same length as ctime.
  ##
  ##            If an atomic vector, represents exactly one member removed at
  ##            the corresponding ctime.
  ##
  ##            If a list, represents multiple members removed at the
  ##            corresponding ctime.

  ## current:   Current membership of the set.
  ##            An atomic vector listing the current membership of the set.

  # Output:

  ## A list of the same length as ctime named by values in ctime (coerced to
  ## character by the appropriate method). 

  stopifnot(is.atomic(ctime),
            is.atomic(added) || is.list(added),
            is.atomic(removed) || is.list(removed))

  if (any(is.na(ctime))) stop("NAs not allowed in the ctime.")

  stopifnot(length(ctime) == length(added),
            length(added) == length(removed))

  if (any(duplicated(ctime))) {
    ctime.u <- unique(ctime)
    ctime.f <- factor(ctime, levels=as.character(ctime.u))
    added <- split(added, ctime.f)
    removed <- split(removed, ctime.f)
  } else {
    ctime.u <- ctime
  }

  out <- setNames(vector(mode="list", length=length(ctime.u) + 1),
                  c("current", as.character(ctime.u)))
  out[["current"]] <- current

  for (i in 2:length(out))
    out[[i]] <- union(setdiff(out[[i - 1]], added[[i - 1]]),
                      na.omit(removed[[i - 1]]))

  attr(out, "index") <- ctime.u

  out

}

此外,如果ctime 是上述函数中的有效时间序列类,则其输出可用于使用该函数(在 ctime 范围内)生成任何时间戳的成员资格@ 987654324@.

memship_at <- function (mem_ts, at) {

  stopifnot(inherits(at, class(attr(mem_ts, "index"))))

  just.before <- which(at > attr(mem_ts, "index"))[1]

  if (just.before > 1)
    mem_ts[[just.before - 1]]
  else
    mem_ts[[1]]

}

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2011-08-16
    • 2014-10-04
    • 2021-04-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多