Catégories
R

Where and when (not) to eat in France ?

Results of sanitary controls in France can be found on data.gouv.fr however, only the running year is available… Thanks to @cquest@amicale.net we can access the archives since 2017.

First a global view of the dataset :

About 800 controls per week, except during the lock-down in 2020, and a slightly lower control pressure in 2021 and 2022.

Poor results (To be improved or To be corrected urgently) are stable at around 6 %, except a recent spike in 2023?

It seems that poor results increase during the year, from June to November.

This surprising periodic phenomenon is also visible by day :

So for the « when », it is : not in summer or autumn.

What about the « where »? It seems you also could be careful in some départements

Not good in Guadeloupe, Guyane, Réunion and the southern lower Seine valley, west of Paris.

Can we see more in details ? Using a 30 km kernel smoothing :

It confirms some hot-spots west of Paris, in Alsace, in Indre, Cher, Alpes-Maritimes and between Gironde and Landes. You are safer in Paris and Bretagne

Has it changed ?

No real trend…

Download the supporting data and R scripts :

Catégories
R

Cherry blossom

It’s cherry blossom time… A nice dataset going back to the year 812 in Japan can be found here. It describes the phenological data for full flowering date of cherry tree (Prunus jamasakura) in Kyoto, showing springtime climate changes.

Let’s draw…

# params ------------------------------------------------------------------

url_kyoto <- "http://atmenv.envi.osakafu-u.ac.jp/aono/kyophenotemp4/"
file_kyoto <- "kyoto.rds"   # cache data
icon_sakura <- "sakura.png" # cache icon


# config ------------------------------------------------------------------

library(tidyverse)
library(fs)
library(janitor)
library(httr)
library(rvest)
library(glue)
library(ggimage)

Sys.setlocale("LC_TIME", "en_GB.UTF-8")


# data --------------------------------------------------------------------

# icon
if (!file_exists(icon_sakura)) {
  GET("https://www.flaticon.com/download/icon/7096433?icon_id=7096433&author=232&team=232&keyword=Sakura&pack=packs%2Fsakura-festival-59&style=522&format=png&color=&colored=2&size=512&selection=1&premium=0&type=standard&search=cherry+blossom",
      write_disk(icon_sakura))
}

# blossom dates, scraped from the web page (more up to date than the xls files)
if (!file_exists(file_kyoto)) {
  GET(url_kyoto) |> 
    content() |> 
    html_element("pre") |>
    html_text2() |>  
    str_replace_all("\xc2\xa0", " ") |> # bad encoding needs correction
    read_fwf(fwf_cols("ad"   = c(7, 10), 
                      "fifd" = c(17, 20), 
                      "fufd" = c(22, 25), 
                      "work" = c(27, 30),
                      "type" = c(32, 35), 
                      "ref"  = c(37, Inf)),
             skip = 26,
             na = c("", "NA", "-")) |> 
    remove_empty() |>  
    mutate(full_flowering_date = ymd(glue("{str_pad(ad, 4, 'left', '0')}{fufd}")),
           full_flowering_date_doy = yday(full_flowering_date)) |> 
    write_rds(file_kyoto)
}


# plot --------------------------------------------------------------------

read_rds(file_kyoto) |> 
  mutate(random_size = sample(c(0.015, 0.02, 0.025, 0.03), length(ad), replace = TRUE)) |> 
  ggplot(aes(ad, parse_date_time(full_flowering_date_doy, orders = "j"))) +
  geom_smooth(color = NA, fill = "chocolate4", alpha = 0.5) +
  geom_image(aes(size = I(random_size)), image = icon_sakura) +
  geom_smooth(color = "chocolate3", se = FALSE, alpha = 0.5) +
  scale_y_datetime(labels = scales::date_format("%b %d"),
                   breaks = "weeks", minor_breaks = "days") +
  labs(title = "Cherry blossom",
       subtitle = "Kyoto",
       x = "year",
       y = "date",
       caption = glue("http://r.iresmi.net/ {Sys.Date()}
                      data: {url_kyoto}
                      icon by Vitaly Gorbachev")) +
  theme_minimal() +
  theme(plot.background = element_rect(fill = "cornflowerblue"),
        panel.grid = element_line(color = "dodgerblue"),
        text = element_text(color = "pink", family = "Ubuntu"),
        plot.title = element_text(size = 20),
        plot.caption = element_text(size = 7),
        axis.text = element_text(color = "pink"))

ggsave("cherry_blossom.png", width = 25, height = 18, units = "cm", dpi = 300)
Catégories
R

Map your Strava activities

Use the Strava API to map your outings with R using the {rStrava} package.

library(tidyverse)
library(leaflet)
library(rStrava)
library(sf)

# Get your credentials from https://www.strava.com/settings/api
app_name <- "*******"
client_id <- "*******"
client_secret <- "*******"

#' Convert Google polylines from Strava activities to {sf} polylines
#'
#' @param gp string : encoded polyline
#'
#' @return {sf} polyline
gp2sf <- function(gp) {
  gp |> 
    googlePolylines::decode() |> 
    map_dfr(
      function(df) {
        df |> 
          st_as_sf(coords = c("lon", "lat")) |> 
          st_combine() |> 
          st_cast("LINESTRING") |> 
          st_sf() 
      }) |> 
    pull(1)
}

# Get activities
activities <- httr::config(
  token = strava_oauth(
    app_name,
    client_id,
    client_secret,
    app_scope = "activity:read_all",
    cache = TRUE)) |> 
  get_activity_list() |> 
  compile_activities() 

# Map 
activities |> 
  mutate(geom = gp2sf(map.summary_polyline)) |> 
  st_sf(crs = "EPSG:4326") |> 
  leaflet() |> 
  addTiles() |> 
  addPolylines()
Catégories
R

Minimal

Day 16 of 30DayMapChallenge : « minimal » (previously).

Bare Réunion…

# devtools::install_github("tylermorganwall/rayshader")
library(rayshader)
library(raster)
library(tidyverse)
library(fs)

# ftp://BD_ALTI_ext:docoazeecoosh1Ai@ftp3.ign.fr/BDALTIV2_2-0_25M_ASC_RGR92UTM40S-REUN89_D974_2016-03-11.7z
# We get a bunch of ASCII files : open and merge, convert to matrix used by rayshader
elmat <- dir_ls("~/BDALTIV2_2-0_25M_ASC_RGR92UTM40S-REUN89_D974_2016-03-11/BDALTIV2/1_DONNEES_LIVRAISON_2020-06-00408/BDALTIV2_MNT_25M_ASC_RGR92UTM40S_REUN89_D974/") %>% 
  map(raster) %>% 
  reduce(merge)%>% 
  raster_to_matrix()

elmat %>%
  sphere_shade(texture = "desert") %>%
  add_shadow(ray_shade(elmat, zscale = 3), 0.5) %>%
  add_shadow(ambient_shade(elmat), 0) %>%
  plot_3d(elmat, zscale = 10, fov = 0, theta = 135, zoom = 0.75, phi = 45, windowsize = c(1000, 800))

render_snapshot("~/reunion_3d.jpeg")
Bare Réunion
Catégories
R

Food

Day 15 of 30DayMapChallenge : « food » (previously).

Results of State food controls in restaurants in La Réunion.

library(dplyr)
library(sf)
library(janitor)
library(mapsf)
library(glue)
library(lubridate)

# https://geoservices.ign.fr/adminexpress 
# COG
dep <- read_sf("~/ADE-COG_2-1_SHP_WGS84G_FRA/DEPARTEMENT.shp") %>% 
  filter(INSEE_DEP == "974")

# https://dgal.opendatasoft.com/explore/dataset/export_alimconfiance/download/?format=shp
alim <- read_sf("~/../Downloads/export_alimconfiance.shp") %>% 
  clean_names() %>% 
  filter(str_sub(code_postal, 1, 3) == "974") %>% 
  mutate(date_inspec = ymd_hms(date_inspec),
         synthese_ev = factor(synthese_ev, levels = c("A corriger de manière urgente",               
                                                      "A améliorer",
                                                      "Satisfaisant",
                                                      "Très satisfaisant")))
alim %>% 
  ggplot() +
  geom_sf(data = dep,  fill = "grey90", color = "lightblue3") +
  geom_sf(aes(color = synthese_ev)) +
  scale_color_manual(values = c(
    "A corriger de manière urgente" = "red",               
    "A améliorer" = "orange",
    "Satisfaisant" = "blue",
    "Très satisfaisant" = "green")) +
  labs(title = "Food quality control",
       subtitle = "La Réunion",
       color = "Control result",
       caption = glue("data: alim-confiance.gouv.fr
                      {min(alim$date_inspec)} - {max(alim$date_inspec)}
                  r.iresmi.net - {Sys.Date()}")) +
  theme_minimal() +
  theme(panel.background = element_rect(fill = "lightblue1"),
        plot.caption = element_text(size = 7))


ggsave("food.png", width = 20, height = 20, units = "cm", scale = 1.1)
Food controls
Catégories
R

Sugar

Day 13 of 30DayMapChallenge : « 5 minutes map » (previously).

Sugar cane fields in La Réunion

library(tidyverse)
library(sf)

# RPG région La Réunion édition 2021 
# https://wxs.ign.fr/0zf5kvnyfgyss0dk5dvvq9n7/telechargement/prepackage/RPG_REGION_PACK_DIFF_2021-01-01$RPG_2-0__SHP_RGR92UTM40S_R04_2021-01-01/file/RPG_2-0__SHP_RGR92UTM40S_R04_2021-01-01.7z
parc <- read_sf("~/PARCELLES_GRAPHIQUES.shp")

# https://geoservices.ign.fr/adminexpress 
# COG
dep <- read_sf("~/DEPARTEMENT.shp") %>% 
  filter(INSEE_DEP == "974")

parc %>% 
  ggplot() +
  geom_sf(data = dep, fill = "white", color = "blue") +
  geom_sf(aes(fill = CODE_CULTU %in% c(
              "CSA",
              "CSF",
              "CSI",
              "CSP",
              "CSR")), color = NA) +
  scale_fill_manual(values = list("TRUE" = "goldenrod",
                                  "FALSE" = "lightgrey"),
                    labels = list("TRUE" = "Cane",
                                  "FALSE" = "Other")) +
  labs(title = "Sugar cane fields",
       subtitle = "La Réunion",
       fill = "Crop") +
  theme_minimal() +
  theme(plot.background = element_rect(fill = "lightblue1"))

ggsave("reunion.png", width = 20, height = 20, units = "cm", scale = 1.1)
Cane
Catégories
R

Scales

Day 12 of 30DayMapChallenge : « scales » (previously).

French « départements » at the same size but tidily ordered by area.

library(tidyverse)
library(sf)
library(units)
library(tmap)

# data from https://geoservices.ign.fr/adminexpress
fr <- read_sf("~/adminexpress.gpkg", 
              layer = "departement")

png("scales.png", width = 20, height = 12.36, units = "cm", res = 300)
fr %>%  
  mutate(surf_km2 =  set_units(st_area(geom), km^2), 
         rank = dense_rank(surf_km2), 
         nom_dep = fct_rev(fct_reorder(as_factor(nom_dep), rank))) %>% 
  tm_shape() +
  tm_polygons(fill = "lightgrey") +
  tm_facets(by = "nom_dep", free.scales = TRUE)
dev.off()  
Départements
Catégories
R

Sentinel

Day 11 of 30DayMapChallenge : « red » (previously).

Today no cartography in R but in QGIS. However the satellite image processing has been made with the {sen2R} package.

We emulate infrared photography with a combination of the 8, 4 and 3 bands from the Sentinel-2 satellites, aimed at Termignon in the Vanoise National Park.

Glaciers (and clouds) in white, grasslands in light red, forest in dark red, sparsely vegetated areas in brown reds and rocks in grey.

Infrared satellite image from Termignon
Catégories
R

Get lost

Day 10 of 30DayMapChallenge : « bad map » (previously).

Just resampling…

library(tidyverse)
library(sf)
library(glue)
library(ggspatial)
library(ggrepel)

pref <- read_sf("~/adminexpress/adminexpress_simpl.gpkg", layer = "commune") %>% 
  filter(insee_reg > "06", 
         str_detect(statut, "Préfecture de région|Capitale")) %>% 
  mutate(nom = sample(nom)) %>% 
  st_point_on_surface()

fr <- read_sf("~/adminexpress/adminexpress_simpl.gpkg", layer = "departement") %>% 
  filter(insee_reg > "06")

# map
fr %>% 
  ggplot() +
  geom_sf(color = "grey", fill = "lightgrey") + 
  geom_sf(data = pref, color = "black", size = 1) +
  geom_text_repel(data = pref, aes(label = nom, geometry = geom), stat = "sf_coordinates", size = 3,
                  bg.color = "#ffffff66",
                  bg.r = 0.2 ) +
  coord_sf(crs = "EPSG:2154") +
  labs(title = "France métropolitaine",
       subtitle = "Get lost",
       caption = glue("data : based on IGN Adminexpress
                      r.iresmi.net - {Sys.Date()}")) +
  theme(plot.background = element_rect(fill = "grey10", color = NA),
        panel.background = element_blank(),
        panel.grid = element_line(color = "grey20"),
        plot.title = element_text(color = "grey90", family = "Waree"),
        plot.subtitle = element_text(color = "grey90"),
        plot.caption = element_text(color = "grey90", size = 6))

ggsave("bad.png", width = 20, height = 12.36, units = "cm", scale = 1.1)
Get lost
Catégories
R

Use data from Wikipedia

Day 9 of 30DayMapChallenge : « space » (previously).

Scrape and geolocate data from Wikipedia. We will map the active space launch sites.

library(tidyverse)
library(lubridate)
library(janitor)
library(sf)
library(glue)
library(rvest)
library(rnaturalearth)
library(showtext)

font_add_google(name = "Orbitron", family = "orbitron", regular.wt = 600)
showtext_auto()

url_data <- "https://en.wikipedia.org/wiki/List_of_rocket_launch_sites"

# read all tables from the page
# keep only those containing a country column
# clean and merge
launch <- read_html(url_data) %>% 
  html_table() %>% 
  keep(~ names(.x)[[1]] == "Country") %>% 
  map(~ mutate(.x, across(everything(), as.character))) %>% 
  reduce(bind_rows) %>% 
  clean_names() 

# keep only active sites : roughly "YYYY-"
# and extract coordinates
active <- launch %>% 
  filter(str_detect(operational_date, "\\d{4}s?–(\\[.*\\])?$")) %>% 
  mutate(x = str_extract(coordinates, "(?<=;\\s)\\-?\\d*\\.\\d*"),
         y = str_extract(coordinates, "\\-?\\d*\\.\\d*(?=;)")) %>% 
  select(country, location, coordinates, x, y) %>% 
  drop_na(x, y) %>% 
  st_as_sf(coords = c("x", "y"), crs = "EPSG:4326")

# map
ne_countries(scale = "small", type = "countries", returnclass = "sf") %>% 
  ggplot() +
  geom_sf(color = "darkblue", fill = "darkblue") + 
  geom_sf(data = active, color = "yellow", size = 1) +
  coord_sf(crs = "+proj=eqearth") +
  labs(title = "Active space launch sites",
       subtitle = year(Sys.Date()),
       caption = glue("data : {url_data}
                      r.iresmi.net - {Sys.Date()}")) +
  theme(text = element_text(family = "orbitron",  color = "yellow", size = 20),
        plot.background = element_rect(fill = "grey10", color = NA),
        panel.background = element_blank(),
        panel.grid = element_line(color = "grey20"),
        plot.caption = element_text(size = 12, color = "grey40"))

ggsave("space.png", width = 20, height = 12.36, units = "cm", dpi = 150, scale = 1.1)
Active space launch sites