Question

整个上午我一直在制动我的头脑怎么做。所以我们说这是我的数据集

set.seed(1)
temp <- as.data.frame(cbind(Key = letters[1:5], sapply(1:12,  function(x) sample(c(0, 1), 5, replace = T))))
names(temp)[2:13] <- month.abb
temp

#   Key Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
# 1   a   0   1   0   0   1   0   0   1   1   1   0   0
# 2   b   0   1   0   1   0   0   1   1   1   0   1   0
# 3   c   1   1   1   1   1   0   0   0   1   0   0   1
# 4   d   1   1   0   0   0   1   0   1   1   1   0   1
# 5   e   0   0   1   1   0   0   1   0   1   1   0   0

我要做的是连续两个月计算出现次数（1s）。

例如，c和d出现在Jan。两者都出现在Feb中，因此本月的输出将为1。在Feb中，a-d出现了c，但Mar中只有.25，因此该月的输出将为data.frame(Month = month.abb[1:11], OverlapPercent = c(1, 1/4, 1, 1/3, 0, 0, 1/2, 1, 3/5, 0, 0)) # Month OverlapPercent # 1 Jan 1.0000000 # 2 Feb 0.2500000 # 3 Mar 1.0000000 # 4 Apr 0.3333333 # 5 May 0.0000000 # 6 Jun 0.0000000 # 7 Jul 0.5000000 # 8 Aug 1.0000000 # 9 Sep 0.6000000 # 10 Oct 0.0000000 # 11 Nov 0.0000000，等等。 / p>

该迷你示例的所需输出：

rle

正在考虑一些如何使用{{1}}，但不确定如何强制它每次停止两次出现

Answer 1

除非我遗漏了某些内容，否则以下内容有效：

#just to remove 'factor's from "temp"
tmp = do.call(cbind.data.frame, c(temp[1], lapply(temp[-1], function(x) as.numeric(as.character(x)))))

sapply(head(seq_len(ncol(tmp))[-1], -1), 
       function(i) sum(tmp[[i]] & tmp[[i+1]]) / sum(tmp[[i]]))
#[1] 1.0000000 0.2500000 1.0000000 0.3333333 0.0000000 0.0000000 0.5000000 1.0000000 0.6000000 0.0000000 0.0000000

修改出于好奇，我检查了@Bathsheba＆＃34;按位AND＆＃34;速度似乎比＆＃34;逻辑AND＆＃34;：

更快
#identical results sapply(head(seq_len(ncol(tmp))[-1], -1), function(i) sum(bitwAnd(tmp[[i]], tmp[[i+1]])) / sum(tmp[[i]])) #[1] 1.0000000 0.2500000 1.0000000 0.3333333 0.0000000 0.0000000 0.5000000 1.0000000 0.6000000 0.0000000 0.0000000 #twice as fast x1 = sample(0:1, 1e6, T); x2 = sample(0:1, 1e6, T) identical(sum(x1 & x2) / sum(x1), sum(bitwAnd(x1, x2)) / sum(x1)) #[1] TRUE microbenchmark(sum(x1 & x2) / sum(x1), sum(bitwAnd(x1, x2)) / sum(x1), times = 50) #Unit: milliseconds # expr min lq median uq max neval # sum(x1 & x2)/sum(x1) 23.95648 25.32448 25.78471 26.56232 49.18491 50 # sum(bitwAnd(x1, x2))/sum(x1) 10.97982 11.07309 11.20237 13.00450 35.67963 50

Answer 2

在伪代码中，将每列表示为二进制数。

E.g。 Jan = 0b00110和Feb = 0b11110。

您的Jan公式是

Bitcount(Jan AND Feb) / Bitcount(Jan)

其中AND是按位AND运算符，Bitcount计算数字中的1位数。（如果需要，我可以提供一种计数方式）。当然，其他月份的公式是一个微不足道的概括。

显然，你需要一个分支，因为分母为零：在你的问题中没有明确定义。

Answer 3

首先修复temp，使0/1列为数字而不是因子。然后将overlap应用于每对列：

temp[-1] <- lapply(temp[-1], function(x) as.numeric(as.character(x)))

overlap <- function(x, y) mean(y[x == 1])
data.frame(Month = month.abb[-12], 
           Overlap = sapply(2:12, function(i) overlap(temp[,i], temp[,i+1])))

以上是优选的，因为它保持溶液的独立部分分开;但是，作为替代方案，我们可以省略上面的第一行（这会修复因素），而是将其合并到overlap中，如下所示：

overlap <- function(x, y) mean(as.numeric(as.character(y))[x == 1]

请注意，重叠是分数（根据问题中显示的输出），而不是问题中的标题所示的百分比。

Answer 4

length(which(!xor(data["Feb"],data["Mar"]) & data["Feb"]==1)) / length(which(data["Feb"]==1))

!xor是否定的独占或。

length(which(...))给出逻辑向量中的真值数。

计算双月重叠分数

4 个答案: