Извлечение и подсчет пар смежных чисел в строках

Question

Я хочу извлечь «пару чисел», то есть числа в соседних столбцах в пределах одной строки.Затем я хочу посчитать пары, чтобы определить, какие наиболее часто.

В качестве примера я создал набор данных с 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?

Answer 1

A base альтернатива.

1.Поиск и подсчет пар

Поскольку у вас есть только числовые значения, мы приводим данные в матрицу.Это сделает последующие вычисления значительно быстрее.Создайте версии запаздывания и опережения (по столбцам) данных, т.е. удалите последний столбец (m[ , -ncol(m)]) и первый столбец (m[ , -ncol(m)]) соответственно.

Приведите данные запаздывания и опережения к «от»и векторы «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,Замените значения наиболее часто встречающейся пары и установите нулевое значение покоя

Сделайте копию исходных данных.Заполните это с нуля.Возьмите значения from и to для максимальной пары.Получите индексы совпадений в данных отставания и отведения, которые соответствуют столбцам «от».rbind с индексами столбцов 'to'.В индексах замените нули на 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 различных значений.

Iсравните код выше (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))
  }

Answer 2

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)