我希望提取“一对数字”，即同一行内相邻列中的数字。然后，我要对货币对进行计数，以确定最频繁的货币对。
例如，我创建了一个具有5列4行的数据集：
var1 var2 var3 var4 var5
1 2 3 0 11
2 0 3 0 1
3 0 3 1 2
4 1 2 2 11
最频繁的连续数字对是：
1 -> 2：3次（第1行，var1-> var2；第3行，var4-> var5；第4行，var2-> var3）
3 -> 0：3次（第1行，var3-> var4；第2行，var3-> var4；第3行，var1-> var2）
0 -> 3：2次
我正在努力找出最频繁的“连续数字对”的代码？
如何将标识的连续数字对替换为2，将其他数字替换为0？
答案 0 :(得分：1)
library(zoo)
pairs <- sort(table(c(rollapply(t(DF), 2, toString))))
# all pairs with their frequency
pairs
## 0, 1 0, 11 2, 0 2, 11 2, 2 2, 3 3, 1 4, 1 0, 3 1, 2 3, 0
## 1 1 1 1 1 1 1 1 2 3 3
# same but as data.frame
data.frame(read.table(text = names(pairs), sep = ","), freq = c(pairs))
## V1 V2 freq
## 0, 1 0 1 1
## 0, 11 0 11 1
## ...
## 0, 3 0 3 2
## 1, 2 1 2 3
## 3, 0 3 0 3
# pair with highest frequency - picks one if there are several
tail(pairs, 1)
## 3, 0
## 3
# all pairs with highest frequency
pairs[pairs == max(pairs)]
## 1, 2 3, 0
## 3 3
要将所有3,0对替换为2，将其他所有替换为0：
top <- scan(text = names(tail(pairs, 1)), sep = ",", what = 0L, quiet = TRUE)
right <- rollapplyr(unname(t(DF)), 2, identical, top, fill = FALSE)
left <- rbind(right[-1, ], FALSE)
t(2 * (left | right))
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0 0 2 2 0
## [2,] 0 0 2 2 0
## [3,] 2 2 0 0 0
## [4,] 0 0 0 0 0
可重复形式的输入DF为：
Lines <- "1 2 3 0 11
2 0 3 0 1
3 0 3 1 2
4 1 2 2 11"
DF <- read.table(text = Lines)
答案 1 :(得分：0)
base的替代方案。
1。查找和计数对
因为只有数值，所以我们将数据强制转换为矩阵。这将使随后的计算速度大大加快。创建数据的滞后和超前版本（逐列），即分别删除最后一列（m[ , -ncol(m)]和第一列（m[ , -ncol(m)]）。
强制将滞后和超前数据转换为'from'和'to'向量，并计数对（table）。将表转换为矩阵。选择频率最高的第一对。
m <- as.matrix(d)
tt <- table(from = as.vector(m[ , -ncol(m)]), to = as.vector(m[ , -1]))
m2 <- cbind(from = as.integer(dimnames(tt)[[1]]),
to = rep(as.integer(dimnames(tt)[[2]]), each = dim(tt)[1]),
freq = as.vector(tt))
m3 <- m2[which.max(m2[ , "freq"]), ]
# from to freq
# 3 0 3
如果要使所有对具有最大频率，请改用m2[m2[ , "freq"] == max(m2[ , "freq"]), ]。
2。替换最频繁的货币对的值，并将rest设为零
复制原始数据。用零填充。抓住“最大对”的“从”和“到”值。在“滞后”和“领先”数据中获取匹配的索引，它们对应于“ from”列。 rbind，索引为“至”列。在索引处，将零替换为2。
m_bin <- m
m_bin[] <- 0
ix <- which(m[ , -ncol(m)] == m3["from"] &
m[ , -1] == m3["to"],
arr.ind = TRUE)
m_bin[rbind(ix, cbind(ix[ , "row"], ix[ , "col"] + 1))] <- 2
m_bin
# var1 var2 var3 var4 var5
# [1,] 0 0 2 2 0
# [2,] 0 0 2 2 0
# [3,] 2 2 0 0 0
# [4,] 0 0 0 0 0
3。基准
我使用的数据大小与OP在注释中提到的大小类似：一个具有10000行，100列并从100个不同值中采样的数据帧。
我将上面的代码（f_m()）与zoo答案（f_zoo()；下面的函数）进行比较。为了比较输出，我将dimnames添加到zoo结果中。
结果表明f_m的速度要快得多。
set.seed(1)
nr <- 10000
nc <- 100
d <- as.data.frame(matrix(sample(1:100, nr * nc, replace = TRUE),
nrow = nr, ncol = nc))
res_f_m <- f_m(d)
res_f_zoo <- f_zoo(d)
dimnames(res_f_zoo) <- dimnames(res_f_m)
all.equal(res_f_m, res_f_zoo)
# [1] TRUE
system.time(f_m(d))
# user system elapsed
# 0.12 0.01 0.14
system.time(f_zoo(d))
# user system elapsed
# 61.58 26.72 88.45
f_m <- function(d){
m <- as.matrix(d)
tt <- table(from = as.vector(m[ , -ncol(m)]),
to = as.vector(m[ , -1]))
m2 <- cbind(from = as.integer(dimnames(tt)[[1]]),
to = rep(as.integer(dimnames(tt)[[2]]),
each = dim(tt)[1]),
freq = as.vector(tt))
m3 <- m2[which.max(m2[ , "freq"]), ]
m_bin <- m
m_bin[] <- 0
ix <- which(m[ , -ncol(m)] == m3["from"] &
m[ , -1] == m3["to"],
arr.ind = TRUE)
m_bin[rbind(ix, cbind(ix[ , "row"], ix[ , "col"] + 1))] <- 2
return(m_bin)
}
f_zoo <- function(d){
pairs <- sort(table(c(rollapply(t(d), 2, toString))))
top <- scan(text = names(tail(pairs, 1)), sep = ",", what = 0L, quiet = TRUE)
right <- rollapplyr(unname(t(d)), 2, identical, top, fill = FALSE)
left <- rbind(right[-1, ], FALSE)
t(2 * (left | right))
}