0
votes

Variable de bande dans R

Pour le code suivant:

x <- data.frame(year = c(1730, 1860, 1941, 2011))

century_bands <- data.frame(min_year = c(1700, 1800, 1900, 2000),
                            max_year = c(1799, 1899, 1999, 2099),
                            century_name = c("18th", "19th", "20th", "21st"))

J'aimerais, pour chaque valeur de x , déterminer le nom du siècle century_bands elle appartient, en utilisant les informations de century_bands . Je ne peux pas imaginer que cela soit difficile à réaliser mais je ne peux pas le comprendre. Quelqu'un peut-il aider s'il vous plaît? Existe-t-il un moyen d'utiliser le package dplyr (que j'utilise beaucoup) ou peut-être une autre technique?

Ceci est juste un exemple très simple d'une situation réelle où les groupes ne sont pas par étapes de 100 ans - donc tous les raccourcis basés sur la division de l'année par 100 etc. ne fonctionneront malheureusement pas.

Merci.


0 commentaires

3 Réponses :


3
votes

Une option utilisant fuzzyjoin pourrait être:

fuzzy_left_join(x, century_bands, 
                by = c("year" = "min_year",
                       "year" = "max_year"),
                match_fun = list(`>=`, `<=`)) 

  year min_year max_year century_name
1 1730     1700     1799         18th
2 1860     1800     1899         19th
3 1941     1900     1999         20th
4 2011     2000     2099         21st


0 commentaires

2
votes

Étant donné que la colonne max_year semble être redondante, vous pouvez également faire facilement:

century_bands[colSums(sapply(x$year, function(x) `>=`(x, century_bands$min_year))), 3]
# [1] "18th" "19th" "20th" "21st"


0 commentaires

3
votes

Voici quelques approches.

1) sqldf En SQL, on peut faire une jointure sur des conditions complexes. La syntaxe utilisée between correspondances si l' year est supérieure ou égale à la limite inférieure et inférieure ou égale à la limite supérieure. Pour une année donnée, la jointure à gauche entraînera l'utilisation de NA s'il n'y a pas de correspondance (bien qu'une telle situation ne se présente pas dans l'exemple de la question).

x %>% mutate(century_name = case_when(
    year < 1700 ~ NA_character_,
    year < 1800 ~ "18th",
    year < 1900 ~ "19th",
    year < 2000 ~ "20th",
    year < 2100 ~ "21st",
    TRUE ~ NA_character_))
##   year century_name
## 1 1730         18th
## 2 1860         19th
## 3 1941         20th
## 4 2011         21st

2) findInterval Cette approche utilise uniquement la base R. Pour chaque composant de son premier argument, findInterval renvoie le nombre de valeurs de son second argument qui lui sont inférieurs ou égaux. Le deuxième argument est supposé être trié par ordre croissant. Le nombre renvoyé par findInterval peut être utilisé pour indexer dans century_name . findInterval tendance à être assez efficace.

library(dplyr)

x %>% mutate(century_name = case_when(
    year %in% 1700:1799 ~ "18th",
    year %in% 1800:1899 ~ "19th",
    year %in% 1900:1999 ~ "20th",
    year %in% 2000:2099 ~ "21st",
    TRUE ~ NA_character_))
##   year century_name
## 1 1730         18th
## 2 1860         19th
## 3 1941         20th
## 4 2011         21st

Bien que cela ne se produise pas dans la question de savoir s'il était possible que cette year soit en dehors de toutes les bandes, nous pourrions étendre cela sans changer le code en ajoutant des lignes supplémentaires à century_bands associées à un century_name de NA ou bien nous pourrions étendre findInterval liek ceci:

library(dplyr)
library(purrr)
library(tibble)
library(tidyr)

century_bands2 <- century_bands %>%
  { set_names(map2(.$min_year, .$max_year, seq), .$century_name) %>%
    as_tibble %>%
    pivot_longer(everything(), names_to = "century_name", values_to = "year")
  }

x %>% left_join(century_bands2, by = "year")
##   year century_name
## 1 1730         18th
## 2 1860         19th
## 3 1941         20th
## 4 2011         21st

Nous pourrions remplacer transform avec mutate en cas d' utilisation dplyr de toute façon; sinon, l'utilisation de transform élimine cette dépendance.

3) sapply Une autre solution de base est

century_bands2 <- with(century_bands, 
  stack(setNames(Map(seq, min_year, max_year), century_name)))
transform(x, century_name = with(century_bands2, ind[match(year, values)]))
##   year century_name
## 1 1730         18th
## 2 1860         19th
## 3 1941         20th
## 4 2011         21st

Cela devrait être suffisant si toutes les années sont comprises dans les bandes. C'est le cas dans l'exemple de la question, mais si cela ne peut pas être garanti, étendez Match comme ceci:

recodes <- with(century_bands, 
  paste(sprintf("%d:%d='%s'", min_year, max_year, century_name), collapse = ";")
)
recodes <- paste0(recodes, "; else=NA")

4) cut Cette solution de base est similaire à findInterval mais elle renvoie NA si year n'est dans aucune des bandes.

library(car)

recodes <- 
  "1700:1799='18th'; 1800:1899='19th'; 1900:1999='20th'; 2000:2099='21st'; else=NA"
transform(x, year_name = recode(year, recodes))
##   year year_name
## 1 1730      18th
## 2 1860      19th
## 3 1941      20th
## 4 2011      21st

5) car :: recode Cette fonction permet le recodage des valeurs comme suit.

transform(x, year_name = with(century_bands, century_name[
    cut(year, c(min_year, max(max_year)), label = FALSE, include.lowest = TRUE)
]))

Pour éviter coder en dur la recodes chaîne pourrait être dérivé de century_bands comme celui - ci

Match <- function(x) {
  Name <- with(century_bands, century_name[x >= min_year & x <= max_year])
  if (length(Name)) Name else NA
}

6) élargir les groupes Nous pourrions élargir les groupes en années individuelles, auquel cas nous pouvons simplement effectuer un match. les années qui ne correspondent à aucun groupe entraînent un NA dans le century_name du century_name .

Match <- function(x) with(century_bands, century_name[x >= min_year & x <= max_year])
transform(x, century_name = sapply(year, Match))
##   year century_name
## 1 1730         18th
## 2 1860         19th
## 3 1941         20th
## 4 2011         21st

6a) Une variation tidyverse qui est en grande partie dans le sens de ceci serait:

FindInterval <- function(x, vec, upper) {
  ifelse(x < vec[1] | x > upper, NA, findInterval(x, vec))
}
transform(x, year_name = 
  with(century_bands, century_name[FindInterval(year, min_year, max(max_year))]))

7) cas_lorsque . Nous pourrions coder en dur les définitions de bande dans un case_when :

transform(x, year_name = 
  with(century_bands, century_name[findInterval(year, min_year)]))
##   year year_name
## 1 1730      18th
## 2 1860      19th
## 3 1941      20th
## 4 2011      21st

7a) Une autre façon d'exprimer cela avec case_when est:

library(sqldf)
sqldf("select year, century_name from x
  left join century_bands on year between min_year and max_year")
##   year century_name
## 1 1730         18th
## 2 1860         19th
## 3 1941         20th
## 4 2011         21st


0 commentaires