Как выбрать первую и последнюю строку в переменной группировки в фрейме данных?

Как я могу выбрать первую и последнюю строку для каждого уникального id в следующем фрейме данных?

tmp <- structure(list(id = c(15L, 15L, 15L, 15L, 21L, 21L, 22L, 22L, 
22L, 23L, 23L, 23L, 24L, 24L, 24L, 24L), d = c(1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), gr = c(2L, 1L, 
1L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 1L, 1L, 2L), mm = c(3.4, 
4.9, 4.4, 5.5, 4, 3.8, 4, 4.9, 4.6, 2.7, 4, 3, 3, 2, 4, 2), area = c(1L, 
2L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 2L, 3L)), .Names = c("id", 
"d", "gr", "mm", "area"), class = "data.frame", row.names = c(NA, 
-16L))
tmp
#>    id d gr  mm area
#> 1  15 1  2 3.4    1
#> 2  15 1  1 4.9    2
#> 3  15 1  1 4.4    1
#> 4  15 1  1 5.5    2
#> 5  21 1  1 4.0    2
#> 6  21 1  2 3.8    2
#> 7  22 1  1 4.0    2
#> 8  22 1  1 4.9    2
#> 9  22 1  2 4.6    2
#> 10 23 1  1 2.7    2
#> 11 23 1  1 4.0    2
#> 12 23 1  2 3.0    2
#> 13 24 1  1 3.0    2
#> 14 24 1  1 2.0    3
#> 15 24 1  1 4.0    2
#> 16 24 1  2 2.0    3

Ответ 1

Решение plyr (tmp - ваш фрейм данных):

library("plyr")
ddply(tmp, .(id), function(x) x[c(1, nrow(x)), ])
#    id d gr  mm area
# 1  15 1  2 3.4    1
# 2  15 1  1 5.5    2
# 3  21 1  1 4.0    2
# 4  21 1  2 3.8    2
# 5  22 1  1 4.0    2
# 6  22 1  2 4.6    2
# 7  23 1  1 2.7    2
# 8  23 1  2 3.0    2
# 9  24 1  1 3.0    2
# 10 24 1  2 2.0    3

Или с dplyr (см. Также здесь):

library("dplyr")
tmp %>%
group_by(id) %>%
slice(c(1, n())) %>%
ungroup()
# # A tibble: 10 × 5
#       id     d    gr    mm  area
#    <int> <int> <int> <dbl> <int>
# 1     15     1     2   3.4     1
# 2     15     1     1   5.5     2
# 3     21     1     1   4.0     2
# 4     21     1     2   3.8     2
# 5     22     1     1   4.0     2
# 6     22     1     2   4.6     2
# 7     23     1     1   2.7     2
# 8     23     1     2   3.0     2
# 9     24     1     1   3.0     2
# 10    24     1     2   2.0     3

Ответ 2

Быстрое и короткое data.table решение:

tmp[, .SD[c(1,.N)], by=id]

где .SD представляет каждый (S) ubset of (D) ata, .N - количество строк в каждой группе, а tmp - data.table; например как предоставлено fread() по умолчанию, или путем преобразования a data.frame с помощью setDT().

Обратите внимание, что если группа содержит только одну строку, эта строка будет отображаться дважды на выходе, потому что эта строка является первой и последней строками этой группы. Чтобы избежать повторения в этом случае, благодаря @Thell:

tmp[, .SD[unique(c(1,.N))], by=id]

В качестве альтернативы, следующее делает логику явной для специального случая .N==1:

tmp[, if (.N==1) .SD else .SD[c(1,.N)], by=id]

Вам не нужно .SD[1] в первой части if, потому что в этом случае .N есть 1, поэтому .SD должна быть как раз одной строкой.

Вы можете обернуть j в {} и иметь целую страницу кода внутри {}, если хотите. До тех пор, пока последнее выражение внутри {} возвращает объект list, похожий на объект (например, простой list, data.table или data.frame).

tmp[, { ...; if (.N==1) .SD else .SD[c(1,.N)] } , by=id]

Ответ 3

Вот решение в базе R. Если есть несколько групп с тем же id, этот код возвращает первую и последнюю строку для каждой из этих отдельных групп.

EDIT: 12 января 2017 г.

Это решение может быть немного интуитивным, чем мой другой ответ дальше:

lmy.df = read.table(text = '
     id    d    gr     mm  area
     15    1     2   3.40     1
     15    1     1   4.90     2
     15    1     1   4.40     1
     15    1     1   5.50     2
     21    1     1   4.00     2
     21    1     2   3.80     2
     22    1     1   4.00     2
     23    1     1   2.70     2
     23    1     1   4.00     2
     23    1     2   3.00     2
     24    1     1   3.00     2
     24    1     1   2.00     3
     24    1     1   4.00     2
     24    1     2   2.00     3
', header = TRUE)

head <- aggregate(lmy.df, by=list(lmy.df$id), FUN = function(x) { first = head(x,1) } )
tail <- aggregate(lmy.df, by=list(lmy.df$id), FUN = function(x) {  last = tail(x,1) } )
head$order = 'first'
tail$order = 'last'

my.output <- rbind(head, tail)
my.output
#   Group.1 id d gr  mm area order
#1       15 15 1  2 3.4    1 first
#2       21 21 1  1 4.0    2 first
#3       22 22 1  1 4.0    2 first
#4       23 23 1  1 2.7    2 first
#5       24 24 1  1 3.0    2 first
#6       15 15 1  1 5.5    2  last
#7       21 21 1  2 3.8    2  last
#8       22 22 1  1 4.0    2  last
#9       23 23 1  2 3.0    2  last
#10      24 24 1  2 2.0    3  last

EDIT: 18 июня 2016 г.

После публикации моего первоначального ответа я узнал, что лучше использовать lapply, чем apply. Это связано с тем, что apply не работает, если каждая группа имеет одинаковое количество строк. См. Здесь: Ошибка при нумерации строк по группам

lmy.df = read.table(text = '
     id    d    gr     mm  area
     15    1     2   3.40     1
     15    1     1   4.90     2
     15    1     1   4.40     1
     15    1     1   5.50     2
     21    1     1   4.00     2
     21    1     2   3.80     2
     22    1     1   4.00     2
     23    1     1   2.70     2
     23    1     1   4.00     2
     23    1     2   3.00     2
     24    1     1   3.00     2
     24    1     1   2.00     3
     24    1     1   4.00     2
     24    1     2   2.00     3
', header = TRUE)


lmy.seq <- rle(lmy.df$id)$lengths
lmy.df$first <- unlist(lapply(lmy.seq, function(x) seq(1,x)))
lmy.df$last  <- unlist(lapply(lmy.seq, function(x) seq(x,1,-1)))
lmy.df

lmy.df2 <- lmy.df[lmy.df$first==1 | lmy.df$last == 1,]
lmy.df2

#   id d gr  mm area first last
#1  15 1  2 3.4    1     1    4
#4  15 1  1 5.5    2     4    1
#5  21 1  1 4.0    2     1    2
#6  21 1  2 3.8    2     2    1
#7  22 1  1 4.0    2     1    1
#8  23 1  1 2.7    2     1    3
#10 23 1  2 3.0    2     3    1
#11 24 1  1 3.0    2     1    4
#14 24 1  2 2.0    3     4    1

Вот пример, в котором каждая группа имеет две строки:

lmy.df = read.table(text = '
     id    d    gr     mm  area
     15    1     2   3.40     1
     15    1     1   4.90     2
     21    1     1   4.00     2
     21    1     2   3.80     2
     22    1     1   4.00     2
     22    1     1   6.00     2
     23    1     1   2.70     2
     23    1     2   3.00     2
     24    1     1   3.00     2
     24    1     2   2.00     3
', header = TRUE)

lmy.seq <- rle(lmy.df$id)$lengths

lmy.df$first <- unlist(lapply(lmy.seq, function(x) seq(1,x)))
lmy.df$last  <- unlist(lapply(lmy.seq, function(x) seq(x,1,-1)))
lmy.df

lmy.df2 <- lmy.df[lmy.df$first==1 | lmy.df$last == 1,]
lmy.df2

#   id d gr  mm area first last
#1  15 1  2 3.4    1     1    2
#2  15 1  1 4.9    2     2    1
#3  21 1  1 4.0    2     1    2
#4  21 1  2 3.8    2     2    1
#5  22 1  1 4.0    2     1    2
#6  22 1  1 6.0    2     2    1
#7  23 1  1 2.7    2     1    2
#8  23 1  2 3.0    2     2    1
#9  24 1  1 3.0    2     1    2
#10 24 1  2 2.0    3     2    1

Оригинальный ответ:

my.seq <- data.frame(rle(my.df$id)$lengths)

my.df$first <- unlist(apply(my.seq, 1, function(x) seq(1,x)))
my.df$last  <- unlist(apply(my.seq, 1, function(x) seq(x,1,-1)))

my.df2 <- my.df[my.df$first==1 | my.df$last == 1,]
my.df2

   id d gr  mm area first last
1  15 1  2 3.4    1     1    4
4  15 1  1 5.5    2     4    1
5  21 1  1 4.0    2     1    2
6  21 1  2 3.8    2     2    1
7  22 1  1 4.0    2     1    3
9  22 1  2 4.6    2     3    1
10 23 1  1 2.7    2     1    3
12 23 1  2 3.0    2     3    1
13 24 1  1 3.0    2     1    4
16 24 1  2 2.0    3     4    1

Ответ 4

Используя функцию grouping:

g <- grouping(tmp$id)
ge <- attr(g, "ends")
tmp[ g[pmax(0, c(ge-1, ge))], ]

   id d gr  mm area
3  15 1  1 4.4    1
5  21 1  1 4.0    2
8  22 1  1 4.9    2
11 23 1  1 4.0    2
15 24 1  1 4.0    2
4  15 1  1 5.5    2
6  21 1  2 3.8    2
9  22 1  2 4.6    2
12 23 1  2 3.0    2
16 24 1  2 2.0    3

Ответ 5

Мы также можем использовать ave в базе R. Для каждого id мы выбираем первый и последний ряд.

tmp[as.logical(with(tmp,ave(d, id, FUN = function(x) 
                    seq_along(x) %in% c(1L, length(x))))), ]

#   id d gr  mm area
#1  15 1  2 3.4    1
#4  15 1  1 5.5    2
#5  21 1  1 4.0    2
#6  21 1  2 3.8    2
#7  22 1  1 4.0    2
#9  22 1  2 4.6    2
#10 23 1  1 2.7    2
#12 23 1  2 3.0    2
#13 24 1  1 3.0    2
#16 24 1  2 2.0    3

Более короткая версия будет использовать range, range возвращает минимальное и максимальное значение из вектора

tmp[as.logical(with(tmp, ave(seq_along(d), id,FUN = function(x) x %in% range(x)))),]

Мы также можем использовать подход split + sapply с range

tmp[c(sapply(split(seq_len(nrow(tmp)), tmp$id), range)), ]

Используя dplyr, хотя я бы предпочел подход slice, показанный @rcs, но здесь есть один способ использования filter, который похож на решение ave, где мы создаем логический вектор, сравнивая row_number()

library(dplyr)
tmp %>% group_by(id) %>% filter(row_number() %in% c(1L, n()))

Во всем вышеприведенном решении мы также можем использовать match вместо %in%, поскольку %in% является просто оболочкой для match.