假设我有一个组的当前成员身份,即成员的名称。此外,我还有一些新成员可能被添加到组中和/或旧成员可能已从组中删除的时间的数据。
当前的任务是在所有这些时间点重新创建组的成员身份。我环顾四周,但没有找到解决这个问题的现成办法。有人知道一种优雅的方法吗?
可复制的例子:
输入:
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"免责声明:我已经为这个问题写了一个解决方案,我将把它作为我对问题的答案。目的是记录这个问题和可能的解决办法,并提出其他巧妙的和/或现有的解决办法或改进办法。
发布于 2013-07-10 11:20:37
函数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的范围内)使用该函数memship_at生成任意时间戳的成员资格。
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]]
}https://stackoverflow.com/questions/17569309
复制相似问题