web-dev-qa-db-fra.com

Comment sélectionner la première et la dernière ligne d'une variable de regroupement dans un bloc de données?

Comment puis-je sélectionner la première et la dernière ligne pour chaque id unique dans la trame de données suivante?

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
35
Francesco

Une solution plyr (tmp est votre bloc de données):

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

Ou avec dplyr (voir aussi ici ):

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
29
rcs

Une solution rapide et courte data.table :

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

.SD représente chaque (S) sous-ensemble de (D) ata, .N est le nombre de lignes dans chaque groupe et tmp est un data.table; par exemple. comme fourni par fread() par défaut ou en convertissant un data.frame en utilisant setDT().

Notez que si un groupe ne contient qu'une seule ligne, cette ligne apparaîtra deux fois dans la sortie car cette ligne est à la fois la première et la dernière ligne de ce groupe. Pour éviter la répétition dans ce cas, grâce à @Thell:

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

Alternativement, ce qui suit rend la logique explicite pour le cas spécial .N==1:

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

Vous n'avez pas besoin de .SD[1] Dans la première partie du if car dans ce cas .N Est 1 Donc .SD Doit être juste une rangée de toute façon.

Vous pouvez envelopper j dans {} Et avoir une page entière de code à l'intérieur de {} Si vous le souhaitez. Tant que la dernière expression à l'intérieur de {} Renvoie un objet semblable à list à empiler (tel qu'un simple list, data.table Ou data.frame).

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

Voici une solution en base R. S'il existe plusieurs groupes avec le même id, ce code renvoie la première et la dernière ligne pour chacun de ces groupes individuels.

EDIT: 12 janvier 2017

Cette solution pourrait être un peu plus intuitive que mon autre réponse plus loin:

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 juin 2016

Depuis la publication de ma réponse d'origine, j'ai appris qu'il vaut mieux utiliser lapply que apply. En effet, apply ne fonctionne pas si chaque groupe a le même nombre de lignes. Voir ici: Erreur lors de la numérotation des lignes par groupe

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

Voici un exemple dans lequel chaque groupe a deux lignes:

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

Réponse originale:

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
6
Mark Miller

Nous pouvons également utiliser ave dans la base R. Pour chaque id, nous sélectionnons la première et la dernière ligne.

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

Une version plus courte utiliserait range, range renvoie la valeur minimale et maximale du vecteur

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

Nous pouvons également utiliser l'approche split + sapply avec range

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

Utiliser dplyr, bien que je préfère l'approche slice montrée par @rcs mais voici une façon d'utiliser filter qui est similaire à la solution ave où nous créons un vecteur logique en comparant row_number()

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

Dans toutes les solutions ci-dessus, nous pouvons également utiliser match au lieu de %in% Car %in% N'est qu'un wrapper autour de match.

0
Ronak Shah