Минимальное расстояние между двумя элементами в одном векторе (r)

У меня есть вопрос, который похож на этот - быстрое минимальное расстояние (интервал) между элементами 2 логических векторов (дубль 2), но у него есть некоторые важные различия.

Скажем, у меня есть вектор:

x <- c("A", "B", "C", "A", "D", "D", "A", "B", "A")

Что я хотел бы сделать, это:

Для каждого элемента рассчитайте минимальное расстояние между ним и следующим элементом каждого отдельного типа только в прямом направлении. Если для какого-либо элемента ни один элемент определенного типа не встречается в прямом направлении, то должен быть возвращен 0. Возвращенные данные будут выглядеть так:

Таблица желаемого выхода

N  x  A  B  C  D
1  A  3  1  2  4
2  B  2  6  1  3
3  C  1  5  0  2
4  A  3  4  0  1
5  D  2  3  0  1
6  D  1  2  0  0
7  A  2  1  0  0
8  B  1  0  0  0
9  A  0  0  0  0

Первый столбец / var просто ссылается на порядок элементов. Второй столбец / var - это элемент в этой позиции. Затем есть четыре столбца / переменные, каждая из которых является уникальным элементом в векторе.

Числа в каждом из этих четырех столбцов / переменных представляют собой минимальное расстояние от элемента этой строки до следующего элемента каждого типа только в направлении ВПЕРЕД. Если введено "0", это означает, что этот элемент не встречается после элемента этой строки в векторе.

Как этого добиться?

Моей первой мыслью было попытаться подражать некоторым аспектам вопроса выше. Для этого я использовал функцию grepl, чтобы превратить вектор в четыре отдельных логических вектора, указывающих на наличие / отсутствие каждого элемента.

xA<-grepl("A", x) #  TRUE FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE  TRUE
xB<-grepl("B", x) #  FALSE  TRUE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE
xC<-grepl("B", x) #  FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE
xD<-grepl("D", x) #  FALSE FALSE FALSE FALSE  TRUE  TRUE FALSE FALSE FALSE

Затем я попробовал функцию "Flodel" и вторую функцию, предоставленную GG, используя библиотеку (data.table).

Например, чтобы вычислить минимальные расстояния от всех "как" до "D":

flodel <- function(x, y) {
  xw <- which(x)
  yw <- which(y)
  i <- findInterval(xw, yw, all.inside = TRUE)
  pmin(abs(xw - yw[i]), abs(xw - yw[i+1L]), na.rm = TRUE)
}
flodel(xA,xD)

> [1] 4 1 1 3




#GG's data.table option
wxA <- data.table(x = which(xA))
wxD <- data.table(y = which(xD), key = "y")
wxD[wxA, abs(x - y), roll = "nearest"] 

#   y V1
#1: 1  4
#2: 4  1
#3: 7  1
#4: 9  3

Обе эти опции находят минимальное расстояние для всех А до D. Однако это ЛЮБОЕ направление, а не только направление ВПЕРЕД. Опция data.table GG на первый взгляд более привлекательна для меня, поскольку она возвращает данные, показывающие положение каждого элемента (столбец "y" выходных данных), что позволяет упростить упаковку в хорошую сводную таблицу (такую ​​как мой желаемый). выходная таблица выше).

Я попытался найти альтернативные способы использования аргумента roll в data.table, но мне, похоже, не удалось решить эту проблему.

Спасибо за любые предложения.

2 ответа

Решение

Другой способ, который кажется правильным:

levs = sort(unique(x))
do.call(rbind, 
        lapply(seq_along(x),
               function(n) 
                  match(levs, x[-seq_len(n)], 0)))
#      [,1] [,2] [,3] [,4]
# [1,]    3    1    2    4
# [2,]    2    6    1    3
# [3,]    1    5    0    2
# [4,]    3    4    0    1
# [5,]    2    3    0    1
# [6,]    1    2    0    0
# [7,]    2    1    0    0
# [8,]    1    0    0    0
# [9,]    0    0    0    0

Я не совсем уверен, насколько это эффективно, но, похоже, работает. Как насчет

x <- c("A", "B", "C", "A", "D", "D", "A", "B", "A")

#find indexes for each value
locations<-split(seq_along(x), x)

#for each index, find the distance from the next highest 
# index in the locations list
t(sapply(seq_along(x), function(i) sapply(locations, function(l) 
    if(length(z<-l[l>i])>0) z[1]-i else 0)))

Это вернется

      A B C D
 [1,] 3 1 2 4
 [2,] 2 6 1 3
 [3,] 1 5 0 2
 [4,] 3 4 0 1
 [5,] 2 3 0 1
 [6,] 1 2 0 0
 [7,] 2 1 0 0
 [8,] 1 0 0 0
 [9,] 0 0 0 0
Другие вопросы по тегам