R 计算两个月的重叠分数

我整个上午都在绞尽脑汁想怎么做。 假设这是我的数据集

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

---

正在考虑如何使用

rle

，但不确定如何强制它在每次出现两次时停止

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

例如，一月=0b00110，二月=0b11110

那么你给简的公式是

Bitcount(Jan AND Feb) / Bitcount(Jan)

其中，

和

是按位的

和

运算符，

位计数

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

---

显然，分母为零需要一个分支：在您的问题中没有很好的定义。

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

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

例如，一月=0b00110，二月=0b11110

那么你给简的公式是

Bitcount(Jan AND Feb) / Bitcount(Jan)

其中，

和

是按位的

和

运算符，

位计数

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

显然，分母为零需要一个分支：在你的问题中没有很好的定义

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

！xor

是被否定的异或

length（它（…）

给出逻辑向量中的真值的数目

！xor

是被否定的异或

---

length（它（…）

给出了逻辑向量中的真值数。

除非我遗漏了什么，否则以下内容看起来是有效的：

#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的“按位与”速度，似乎比“逻辑与”更快：

---

除非我遗漏了什么，否则以下内容看起来是有效的：

#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的“按位与”速度，似乎比“逻辑与”更快：

---

首先修复

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])))

---

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

首先修复

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])))

---

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

hmm。。。不知道你的意思。你能提供并举例说明

r

code吗？我不使用r，所以不能这样做。我的答案哪一部分不清楚？也许我们可以通过这种方式找到一个解决方案。好的，我必须考虑你的答案，看看我是否能在

r

中实现它。它可以在几行C语言中实现，所以应该是可行的。你有点把列变成二进制数吗？我不知道C。虽然C++中的语法可以使用<代码> Rcpp < /Cord>包。也许如果你用C++写的话，我会编译成Rhmm…不知道你的意思。你能提供并举例说明

r

code吗？我不使用r，所以不能这样做。我的答案哪一部分不清楚？也许我们可以通过这种方式找到一个解决方案。好的，我必须考虑你的答案，看看我是否能在

r

中实现它。它可以在几行C语言中实现，所以应该是可行的。你有点把列变成二进制数吗？我不知道C。虽然C++中的语法可以使用<代码> Rcpp < /Cord>包。也许如果你用C++写的话，我会把它编译成R辉煌。我想知道我怎么没有想到这一点。虽然

sapply（head（seq_len（ncol（tmp））[-1]，-1），函数（i）sum（tmp[，i]&tmp[，i+1]）/sum（tmp[，i]）

对我来说更有意义。我想知道我怎么没有想到这一点。虽然

sapply（head（seq_len（ncol（tmp））[-1]，-1），函数（i）sum（tmp[，i]&tmp[，i+1]）/sum（tmp[，i]）

对meNice解决方案更有意义。谢谢你对术语的修改，我只是在脑海中自动地做了百分比=100*分数，所以我甚至没有注意到。另外，我的原始数据是数字的，我只是没有注意到模拟的例子将数字转换为因子。很好的解决方案。谢谢你对术语的修改，我只是在脑海中自动地做了百分比=100*分数，所以我甚至没有注意到。另外，我的原始数据是数字的，我只是没有注意到模拟示例将数字转换为因子。