Средние соседи внутри вектора

Question

Мои данные:

data <- c(1,5,11,15,24,31,32,65)

Есть 2 соседа: 31 и 32 .Я хочу удалить их и оставить только среднее значение (например, 31,5 ), таким образом, данные будут выглядеть так:

data <- c(1,5,11,15,24,31.5,65)

Это кажется простым, но я хочу сделать это автоматическии иногда с векторами, содержащими больше соседей.Например:

data_2 <- c(1,5,11,15,24,31,32,65,99,100,101,140)

Answer 1

Это dplyr версия, также использующая в качестве переменной группировки cumsum(c(1,diff(x)!=1)):

library(dplyr)
data_2 %>% data.frame(x = .) %>% 
group_by(id = cumsum(c(1,diff(x)!=1))) %>% 
summarise(res = mean(x)) %>% 
select(res)
# A tibble: 9 x 1
    res
  <dbl>
1   1.0
2   5.0
3  11.0
4  15.0
5  24.0
6  31.5
7  65.0
8 100.0
9 140.0

Answer 2

У меня есть решение на основе data.table, то же самое можно перевести на dplyr.

library(data.table)
df <- data.table(data2 = c(1,5,11,15,24,31,32,65,99,100,101,140))
df[,neighbours := ifelse(c(0,diff(data_2)) == 1,1,0)]
df[,neighbours := c(neighbours[1:(.N-1)],1),by = rleid(neighbours)]
df[,neigh_seq := rleid(neighbours)]

unique(df[,ifelse(neighbours == 1,mean(data2),data2),by = neigh_seq])

   neigh_seq    V1
1:         1   1.0
2:         1   5.0
3:         1  11.0
4:         1  15.0
5:         1  24.0
6:         2  31.5
7:         3  65.0
8:         4 100.0
9:         5 140.0

Что он делает: первая строка устанавливает neigbours равным 1, если разница со следующим числом равна 1

 1:     1          0
 2:     5          0
 3:    11          0
 4:    15          0
 5:    24          0
 6:    31          0
 7:    32          1
 8:    65          0
 9:    99          0
10:   100          1
11:   101          1
12:   140          0

Я хочу сгруппировать, чтобы переменная neighbour была равна 1 для всех соседей.Мне нужно добавить 1 к каждому концу каждой группы:

df[,neighbours := c(neighbours[1:(.N-1)],1),by = rleid(neighbours)]
    data2 neighbours
 1:     1          0
 2:     5          0
 3:    11          0
 4:    15          0
 5:    24          0
 6:    31          1
 7:    32          1
 8:    65          0
 9:    99          1
10:   100          1
11:   101          1
12:   140          0

Затем, после того как я просто сделаю группировку при изменении значения neighbour, и установите значение, означающее, что они являются соседними

df[,ifelse(neighbours == 1,mean(data2),data2),by = rleid(neighbours)]
    rleid    V1
 1:     1   1.0
 2:     1   5.0
 3:     1  11.0
 4:     1  15.0
 5:     1  24.0
 6:     2  31.5
 7:     2  31.5
 8:     3  65.0
 9:     4 100.0
10:     4 100.0
11:     4 100.0
12:     5 140.0

и принять уникальные значения.И вуаля.

Answer 3

Вот еще одна идея, которая создает идентификатор через cumsum(c(TRUE, diff(a) > 1)), где 1 показывает порог пробела, т.е.

#our group variable
grp <- cumsum(c(TRUE, diff(a) > 1))

#keep only groups with length 1 (i.e. with no neighbor)
i1 <- a[!!!ave(a, grp, FUN = function(i) length(i) > 1)] 

#Find the mean of the groups with more than 1 rows,
i2 <- unname(tapply(a, grp, function(i)mean(i[length(i) > 1])))

#Concatenate the above 2 (eliminating NAs from i2) to get final result
c(i1, i2[!is.na(i2)])
#[1]  1.0  5.0 11.0 15.0 24.0 65.0 31.5

Вы также можете заключить его в функцию.Я оставил пробел в качестве параметра, чтобы вы могли настроить

get_vec <- function(x, gap) {
    grp <- cumsum(c(TRUE, diff(x) > gap))
    i1 <- x[!!!ave(x, grp, FUN = function(i) length(i) > 1)]
    i2 <- unname(tapply(x, grp, function(i) mean(i[length(i) > 1])))
    return(c(i1, i2[!is.na(i2)]))
}

get_vec(a, 1)
#[1]  1.0  5.0 11.0 15.0 24.0 65.0 31.5

get_vec(a_2, 1)
#[1]   1.0   5.0  11.0  15.0  24.0  65.0 140.0  31.5 100.0

ДАННЫЕ:

a <- c(1,5,11,15,24,31,32,65)
a_2 <- c(1, 5, 11, 15, 24, 31, 32, 65, 99, 100, 101, 140)

Answer 4

Вот мое решение, в котором для определения групп используется кодирование по длине прогона:

foo <- function(x) {
  y <- x - seq_along(x) #normalize to zero differences in groups
  ind <- rle(y) #run-length encoding
  ind$values <- ind$lengths != 1 #to find groups
  ind$values[ind$values] <- cumsum(ind$values[ind$values]) #group ids
  ind <- inverse.rle(ind)
  xnew <- x
  xnew[ind != 0] <- ave(x, ind, FUN = mean)[ind != 0] #calculate means
  xnew[!(duplicated(ind) & ind != 0)] #remove duplicates from groups
}

foo(data)
#[1]  1.0  5.0 11.0 15.0 24.0 31.5 65.0
foo(data_2)
#[1]   1.0   5.0  11.0  15.0  24.0  31.5  65.0 100.0 140.0
data_3 <- c(1, 2, 4, 1, 2)
foo(data_3)
#[1] 1.5 4.0 1.5

Я предполагаю, что вам не нужно чрезвычайно эффективное решение.Если вы это сделаете, я бы порекомендовал простой цикл C ++ for в Rcpp.