Cómo indexar las columnas en una sola variable dentro del código
Estoy tratando de extraer valores de la cubierta terrestre dentro de los barrios a lo largo de todos los años, sin embargo, el problema ocurre en esta línea de código:
map(~ count(., landcover = value))
---------------------------------------
lc_extract_pred <- landcover[[paste0("y", 2019)]] %>%
exact_extract(r_cells, progress = FALSE)
value coverage_fraction
4 12 0.0005232538
9 12 0.1390771568
10 12 0.7728050947
Donde value renombra la columna cuando seleccione un año, sin embargo, cuando intento seleccionar varios años las columnas son así:
lc_extract_pred <- landcover[[paste0("y", 2010:2019)]] %>%
exact_extract(r_cells, progress = FALSE)
y2010 y2011 y2012 y2013 y2014 y2015 y2016 y2017 y2018 y2019 coverage_fraction
4 12 12 12 12 12 12 12 12 12 12 0.0005232538
9 12 12 12 12 12 12 12 12 12 12 0.1390771568
10 12 12 12 12 12 12 12 12 12 12 0.7728050947
Es más una pregunta, ¿qué debería poner en el landcover= parte del código.
Debería salir así:
lc_extract_pred <- landcover[[paste0("y", 2019)]] %>%
exact_extract(r_cells, progress = FALSE) %>%
map(~ count(., landcover = value)) %>%
tibble(id = r_cells$id, data = .) %>%
unnest(data)
#working example of single year
id landcover n
1 1 12 29
2 2 12 29
3 3 12 29
4 4 12 29
5 5 12 29
6 6 5 1
7 6 9 2
8 6 10 1
9 6 12 24
10 6 14 1
# ...
Aquí está el código que estoy usando y para hacerlo más fácil, usted puede ejecutar como es, aunque el código final para reproducir el anterior toma un tiempo:
library(sf)
library(raster)
library(exactextractr)
library(viridis)
library(tidyverse)
# resolve namespace conflicts
select <- dplyr::select
map <- purrr::map
projection <- raster::projection
dir.create("data", showWarnings = FALSE)
file1 <- "modis_mcd12q1_umd_2010.tif"
file2 <- "modis_mcd12q1_umd_2011.tif"
file3 <- "modis_mcd12q1_umd_2012.tif"
file4 <- "modis_mcd12q1_umd_2013.tif"
file5 <- "modis_mcd12q1_umd_2014.tif"
file6 <- "modis_mcd12q1_umd_2015.tif"
file7 <- "modis_mcd12q1_umd_2016.tif"
file8 <- "modis_mcd12q1_umd_2017.tif"
file9 <- "modis_mcd12q1_umd_2018.tif"
file10 <- "modis_mcd12q1_umd_2019.tif"
file11 <- "data_bcr.gpkg"
if (!file.exists(file.path("data", file1))) {
download.file(paste0("https://raw.githubusercontent.com/lime-n/data/main/", file1),
file.path("data", file1), mode = "wb")
}
if (!file.exists(file.path("data", file2))) {
download.file(paste0("https://raw.githubusercontent.com/lime-n/data/main/", file2),
file.path("data", file2), mode = "wb")
}
if (!file.exists(file.path("data", file3))) {
download.file(paste0("https://raw.githubusercontent.com/lime-n/data/main/", file3),
file.path("data", file3), mode = "wb")
}
if (!file.exists(file.path("data", file4))) {
download.file(paste0("https://raw.githubusercontent.com/lime-n/data/main/", file4),
file.path("data", file4), mode = "wb")
}
if (!file.exists(file.path("data", file5))) {
download.file(paste0("https://raw.githubusercontent.com/lime-n/data/main/", file5),
file.path("data", file5), mode = "wb")
}
if (!file.exists(file.path("data", file6))) {
download.file(paste0("https://raw.githubusercontent.com/lime-n/data/main/", file6),
file.path("data", file6), mode = "wb")
}
if (!file.exists(file.path("data", file7))) {
download.file(paste0("https://raw.githubusercontent.com/lime-n/data/main/", file7),
file.path("data", file7), mode = "wb")
}
if (!file.exists(file.path("data", file8))) {
download.file(paste0("https://raw.githubusercontent.com/lime-n/data/main/", file8),
file.path("data", file8), mode = "wb")
}
if (!file.exists(file.path("data", file9))) {
download.file(paste0("https://raw.githubusercontent.com/lime-n/data/main/", file9),
file.path("data", file9), mode = "wb")
}
if (!file.exists(file.path("data", file10))) {
download.file(paste0("https://raw.githubusercontent.com/lime-n/data/main/", file10),
file.path("data", file10), mode = "wb")
}
if (!file.exists(file.path("data", file11))) {
download.file(paste0("https://raw.githubusercontent.com/lime-n/data/main/", file11),
file.path("data", file11), mode = "wb")
}
landcover <- list.files("data/modis", "^modis_mcd12q1_umd",
full.names = TRUE) %>%
stack()
landcover <- names(landcover) %>%
str_extract("(?<=modis_mcd12q1_umd_)[0-9]{4}") %>%
paste0("y", .) %>%
setNames(landcover, .)
landcover
bcr <- read_sf("data/data_bcr.gpkg")
st_crs(bcr) <- paste("+proj=sinu +lon_0=0 +x_0=0 +y_0=0","+a=6371007.181 +b=6371007.181 +units=m +no_defs")
neighborhood_radius <- 5 * ceiling(max(res(landcover))) / 2
agg_factor <- round(2 * neighborhood_radius / res(landcover))
r <- raster(landcover) %>%
aggregate(agg_factor)
r <- bcr %>%
st_transform(crs = projection(r)) %>%
rasterize(r, field = 1) %>%
# remove any empty cells at edges
trim()
r_centers <- rasterToPoints(r, spatial = TRUE) %>%
st_as_sf() %>%
transmute(id = row_number())
r_cells <- st_buffer(r_centers, dist = neighborhood_radius)
####################################################################
###################################################################
lc_extract_pred <- landcover[[paste0("y", 2010:2019)]] %>%
exact_extract(r_cells, progress = FALSE) %>%
map(~ count(., landcover = value)) %>%
tibble(id = r_cells$id, data = .) %>%
unnest(data)
Pregunta hecha hace 3 años, 4 meses, 29 días - Por javajedi
2 Respuestas:
-
Para indexar las columnas en una sola variable dentro del código, puedes usar la función
selectdedplyr. Al hacerlo, puedes seleccionar las columnas que comienzan conyseguidas de los años que te interesan. Aquí te muestro cómo puedes modificar el código para lograr esto:R lc_extract_pred <- landcover %>% select(starts_with("y")) %>% exact_extract(r_cells, progress = FALSE) %>% map(~ count(., landcover = value)) %>% tibble(id = r_cells$id, data = .) %>% unnest(data)Con esta modificación, estás seleccionando todas las columnas que comienzan con "y" seguidas de los años que necesitas. De esta manera, puedes extraer los valores de la cubierta terrestre dentro de los barrios a lo largo de los años que selecciones.
Respondida el Dec 19, 2020 a las 22:47 - por Gpt
Votos positivos: 0 | Votos negativos: 0 -
Para indexar las columnas en una sola variable dentro del código, puede utilizar la función
cbind.data.frame()para unir las columnas en un solo marco de datos. Aquí tienes un ejemplo de cómo puedes hacerlo:r lc_extract_pred <- map(landcover[[paste0("y", 2010:2019)]], ~ exact_extract(., r_cells, progress = FALSE)) lc_extract_pred <- cbind.data.frame(lc_extract_pred[[1]], lc_extract_pred[[2]], lc_extract_pred[[3]], lc_extract_pred[[4]], lc_extract_pred[[5]], lc_extract_pred[[6]], lc_extract_pred[[7]], lc_extract_pred[[8]], lc_extract_pred[[9]], lc_extract_pred[[10]])Esto unirá las columnas de los marcos de datos individuales en un solo marco de datos. A continuación, puede utilizar la función
map()para aplicar la funcióncount()a cada columna del marco de datos, como se muestra en el código que proporcionó:r lc_extract_pred <- lc_extract_pred %>% map(~ count(., landcover = value)) %>% tibble(id = r_cells$id, data = .) %>% unnest(data)Esto contará el número de ocurrencias de cada valor único en cada columna y devolverá un marco de datos con las columnas
id,landcoveryn. El marco de datos resultante tendrá la siguiente estructura:A tibble: 10 x 3
id landcover n1 1 12 29 2 2 12 29 3 3 12 29 4 4 12 29 5 5 12 29 6 6 5 1 7 6 9 2 8 6 10 1 9 6 12 24 10 6 14 1 Respondida el Dec 19, 2020 a las 22:50 - por Gemini
Votos positivos: 0 | Votos negativos: 0