[ad_1]
[Esteartigofoipublicadopelaprimeiravezem[Thisarticlewasfirstpublishedon r.iresmi.net, e gentilmente contribuiu para os R-blogueiros]. (Você pode relatar um problema sobre o conteúdo desta página aqui)
Deseja compartilhar seu conteúdo com R-blogueiros? clique aqui se você tiver um blog ou aqui se não tiver.
# Animation carto décès COVID 19 France # avec lissage # sources ----------------------------------------------------------------- # https://www.data.gouv.fr/fr/datasets/donnees-hospitalieres-relatives-a-lepidemie-de-covid-19/ fichier_covid % dplyr::select(geometry) %>% st_make_grid( cellsize = resolution, offset = c( plyr::round_any(zone_bbox[1] - bandwidth, resolution, f = floor), plyr::round_any(zone_bbox[2] - bandwidth, resolution, f = floor) ), what = "centers" ) %>% st_sf() %>% st_join(zone, join = st_intersects, left = FALSE) %>% st_coordinates() %>% as_tibble() %>% dplyr::select(x = X, y = Y) # kernel message("computing kernel...") kernel % cbind(., st_coordinates(.)) %>% st_set_geometry(NULL) %>% dplyr::select(x = X, y = Y, field) %>% btb::kernelSmoothing( dfObservations = ., sEPSG = out_crs, iCellSize = resolution, iBandwidth = bandwidth, vQuantiles = NULL, dfCentroids = zone_xy ) # rasterization message("nrasterizing...") raster::raster( xmn = plyr::round_any(zone_bbox[1] - bandwidth, resolution, f = floor), ymn = plyr::round_any(zone_bbox[2] - bandwidth, resolution, f = floor), xmx = plyr::round_any(zone_bbox[3] + bandwidth, resolution, f = ceiling), ymx = plyr::round_any(zone_bbox[4] + bandwidth, resolution, f = ceiling), resolution = resolution ) %>% fasterize::fasterize(kernel, ., field = field) } # téléchargement-------------------------------------------------------------- if (!dir_exists("donnees")) dir_create("donnees") if (!dir_exists("resultats")) dir_create("resultats") if (!dir_exists("resultats/animation")) dir_create("resultats/animation") if (!file_exists(fichier_covid) | file_info(fichier_covid)$modification_time % clean_names() %>% st_set_crs(2154) pop % clean_names() # prétraitement ----------------------------------------------------------- # contour métropole pour grille de référence fichier_fr % st_union() %>% st_sf() %>% write_rds(fichier_fr) } else { fr % left_join(pop, by = c("insee_dep" = "x1")) %>% left_join( covid %>% filter(jour == if_else(is.null(date), max(jour), date), sexe == 0) %>% group_by(dep) %>% summarise(deces = sum(dc, na.rm = TRUE), reanim = sum(rea, na.rm = TRUE), hospit = sum(hosp, na.rm = TRUE)), by = c("insee_dep" = "dep")) %>% st_point_on_surface() } covid_geo_pop % lissage("deces", rayon, pixel, fr) # population métropole et DOM p % lissage("x2020_p", rayon, pixel, fr) # grilles pour 100000 hab d100k % lissage("deces", rayon, pixel, fr) %>% magrittr::divide_by(p) %>% magrittr::multiply_by(100000) %>% tm_shape() + tm_raster(title = glue("décès à l'hôpital pour 100 000 hab."), style = "fixed", breaks = classes, palette = "viridis", legend.format = list(text.separator = "à moins de", digits = 0), legend.reverse = TRUE) + tm_shape(dep) + tm_borders() + tm_layout(title = glue("COVID-19 - France - cumul au {date}"), legend.position = c("left", "bottom"), frame = FALSE) + tm_credits(glue("http://r.iresmi.net/ lissage noyau bisquare {rayon / 1000} km sur grille {pixel / 1000} km classif. kmeans projections LAEA Europe données départementales Santé publique France, INSEE RP 2020, IGN Adminexpress 2020"), size = .5, position = c(.5, .025)) tmap_save(m, glue("resultats/animation/covid_fr_{date}.png"), width = 800, height = 800, scale = .4,) } unique(covid$jour) %>% walk(image_animation) animation % map(image_read) %>% image_join() %>% #image_scale("500x500") %>% image_morph(frames = 10) %>% image_animate(fps = 10, optimize = TRUE) %>% image_write(animation)
Relacionado
Se você chegou até aqui, por que não inscreva-se para atualizações do site? Escolha seu sabor: e-mail, Twitter, RSS ou facebook …
[ad_2]