module 2

[gdauby]

@pvictor

J'explique ici l'idée générale du module 2 qu'il reste à développer pour l'appli (voir start_mod2 dans home_ui() (module-home.R). C'est un module à priori nettement plus simple que les deux autres. Il s'agit en fait d'aller chercher un jeu de données et de faire une carte interactive, que l'on peut télécharger, de la même manière que dans les deux autres modules.

Ci dessous, j'essaie de structurer le workflow pour mettre en place le module, de la manière dont je pense qu'il doit être intégré dans l'appli existante (je me trompe peut être).

Plusieurs fonctions ou modules shiny utilisés déja utilisés dans les deux autres modules sont recyclés ce qui devraient faciliter sont développement.

[gdauby]

#### creation d'un troisième module d'extract des données je suppose à intéger dans conr-server.R
country_lr <- data_3_server(id = "data_country")


###################*******######
## A inclure dans ce module (data_3_server) :
# Choix du pays (un seul possible à ce stade, maos d'autres viendront, donc cette étape nous laisse la possibilité d'en ajouter)
shinyWidgets::virtualSelectInput(
  inputId = ns("country"),
  label = "Country to explore:",
  choices = c("Gabon"),
  selected = "Gabon",
  search = TRUE,
  width = "100%"
)


# Lancer l'extract une fois le pays sélectionné

dataset_rv <- reactiveValues(value = NULL)

mydb_extract <- conn_mydb_rb(pass = "Anyuser2022", user = "common") ## fonction existante dans rainbio.R
if (input$country == "Gabon") 
  full_table <- func_try_fetch(con = mydb_extract, sql = "SELECT * FROM table_threat_taxa_gab") ## fonction existante dans rainbio.R
threat_taxa <- 
  full_table %>% filter(redlistcategory %in% c("CR", "EN", "VU"))

extract_sp <- search_species_info(species_name = unique(threat_taxa$accepetedtaxonname)) ## fonction existante dans gbif.R
keys <- extract_sp$specieskey
dataset_rv$value <- retrieve_occ_data(keys) ## fonction existante dans gbif.R


### Utilisation de fonction existante pour sélectionner les variables de manière automatique
variable_r <- data_variable_server("variable", data_r = dataset_rv$value)

observeEvent(variable_r()$data, {
  dataset_rv$value <- variable_r()$data
})

### validation automatique des occurrences
data_validated_r <- data_validation_server(
  id = "validation",
  data_r = reactive({
    # input$navs
    variable_r()$data
  })
)

observeEvent(data_validated_r(), {
  dataset_rv$value <- data_validated_r()
})

final_data_r <- eventReactive(input$go_next, {
  data_validated_r()
})



### Dés que le jeu de données est extrait, proposer un choix du type de carte avec deux possibilités
##

radioButtons("type_map", "Which kind of map",
             choices = c("Occurences" = "occ",
                         "Grid" = "grid"),
             selected = "grid")

### Si type_map$type_map == "grid
### Faire apparaite un sliderinput pour choisir la resolution
sliderInput(
  inputId = ns("resolution"),
  label = tagList(
    "Grid size:",
    btn_help(
      "Grid size"
    )
  ),
  min = 1,
  max = 30,
  value = 10,
  round = TRUE,
  step = 1,
  width = "100%"
)


### Si type_map$type_map == "grid
### Créer une carte leaflet reactive (renderleaflet) au choix de input$resolution
data_latlon <- data_validated_r() %>% dplyr::select(.__longitude, .__latitude)

data_latlon_sf <- data_latlon %>%
  dplyr::filter(!is.na(.__longitude),!is.na(.__latitude)) %>% 
  sf::st_as_sf(coords = c(".__longitude", ".__latitude"))
sf::st_crs(data_latlon_sf) <- 4326
data_latlon_sf <- 
  sf::st_transform(data_latlon_sf, 'EPSG:6933')

bbox_gab <- st_sf(1, 
                  geom = sf::st_geometry(st_polygon(list(matrix(c(8, -4, 15, -4, 15, 3, 8, 3, 8, -4), 
                                                                ncol = 2, byrow = TRUE)))))
st_crs(bbox_gab) <- 4326
bbox_gab <- st_transform(bbox_gab, 'EPSG:6933')

grid <- 
  st_make_grid(x = bbox_gab, 
               cellsize = resolution)
grid <- st_as_sf(grid) %>% 
  mutate(id_grid = 1:nrow(.))

intersect_grid <- 
  st_intersection(data_latlon_sf, grid)

sampling_cell <- 
  intersect_grid %>% 
  group_by(id_grid) %>% 
  summarise(nbe_esp = length(unique(scientificName)),
            n = length(scientificName)) %>% 
  st_set_geometry(NULL)

grid_not_null <- 
  grid %>% 
  left_join(sampling_cell) %>% 
  filter(!is.na(n))

grid_not_null <- st_transform(grid_not_null, 4326)

pal <- leaflet::colorNumeric(
  palette = "Blues",
  domain = grid_not_null$nbe_esp)

leaflet::leaflet(options = leaflet::leafletOptions(zoomControl = FALSE)) %>%
  leaflet::invokeMethod(data = NULL, method = "addZoom", list(position = "topright")) %>%
  leaflet::addProviderTiles(leaflet::providers$OpenStreetMap, group = "OSM") %>%
  leaflet::addProviderTiles(leaflet::providers$Esri.WorldImagery, group = "Esri") %>%
  leaflet::addProviderTiles(leaflet::providers$OpenTopoMap, group = "Open Topo Map") %>%
  leaflet::addLayersControl(
    baseGroups = c("OSM", "Esri", "Open Topo Map"),
    options = leaflet::layersControlOptions(collapsed = FALSE)
  ) %>%
  leaflet::addPolygons(
    data = grid_not_null,
    weight = 1,
    color = ~pal(nbe_esp),
    fill =  ~pal(nbe_esp),
    popup = paste("Region: ", grid_not_null$nbe_esp)
  )

### Exporter les données, les inputs et le grid
return(data = final_data_r,
       resolution = input$resolution,
       country = input$country,
       grid = grid_not_null,
       type_map = input$type_map)

Une fois la carte leaflet rendu, donner la possibiliter d'aller directement vers on onglet 'report' ou il est donné la possibilité de télécharger le rendu d'un Rmd.

[gdauby]

## Dans conr-server, obtenir les paramètres et données du module 
observeEvent(country_lr$data(), data_rv$y <- country_lr$data())
observeEvent(country_lr$data(), data_rv$grid <- country_lr$grid)

### choix mode maillage ou occurrences

input$resolution

### Nouveau module à créér de la même forme que 'summary_report_server'
summary_report_server2(
  id = "report2",
  data_r = reactive({
    req(data_rv$y, hasName(data_rv$y, "STATUS_CONR")) %>%
      dplyr::filter(STATUS_CONR == "IN")
  }),
  resolution = country_lr$resolution,
  country = country_lr$country,
  grid = data_rv$grid,
  type_map = country_lr$type_map
)


### Code à inclure dans le module 'summary_report_server2'

dataset_rv <- data_r()

rmarkdown::render(
  'D:/MonDossierR/conrappli_dreams/inst/reports/country_report.Rmd',
  params = list(
    country = country,
    resolution = resolution,
    data = dataset_rv
  ),
  output_file = paste0("report_conr", '.html')
)

[gdauby]

@pvictor

Je pushe le Rmd dans le dossier inst du package pour le rapport du module 2.

Il est fort probable que certains champs ne soient pas correctement nommés. En fait je transforme le jeu de données en objet sf donc j'utilise les coordonnées géographiques mais je ne suis pas certain comment ils s'appellent dans le dataset qui arrive comme paramètre du Rmd.

Je suis dispo s'il y a un souci.

[pvictor]

Hello @gdauby ,

J'a un petit souci avec cette partie du code :

library(sf)

bbox_gab <- st_sf(
  1,
  geom = st_geometry(st_polygon(list(
    matrix(
      c(8,-4, 15,-4, 15, 3, 8, 3, 8,-4),
      ncol = 2,
      byrow = TRUE
    )
  )))
)
st_crs(bbox_gab) <- 4326
bbox_gab <- st_transform(bbox_gab, "EPSG:6933")
grid <- st_make_grid(
  x = bbox_gab,
  cellsize = 10
)

# Error: cannot allocate vector of size 44.9 Gb

[gdauby]

Oui c'est parce que le cellsize est beaucoup trop petit (c'est en mètres).

Essaie avec cette valeur (20 kilomètres) c'est plus raisonable.

grid <- st_make_grid(
  x = bbox_gab,
  cellsize = 20000
)

La valeur sera choisi par l'utilisateur et sera bornée pour éviter ce genre de problème.

[pvictor]

Si type_map == "occ" on fait quel type de carte ?

[pvictor]

Je reprends la carte du Rmd que tu viens de pusher ?

[gdauby]

C'est l idée oui.
A voir si c'est pas trop lourd.