Commit a5bea80a authored by Virgile Baudrot's avatar Virgile Baudrot
Browse files

Convert in meters

parent ab1bbd74
......@@ -60,9 +60,11 @@ mod_tabItemDispersal_ui <- function(id){
tabPanel(title = "Generate",
value = "bufferSQUAREFRAME",
p("Choose the size of the buffer, and click on the green button 'Valid'."),
strong("Make sure your landscape is in metric system. If you used 'Generate' the landscape is fine.
Otherwise, if you are not sure, see previous step 'landscape'."),
numericInput(inputId = ns("squareFrameBuffer"),
label = "Size of the buffer",
value = 0.005),
label = "Size of the buffer [in meter]",
value = 100),
actionButton(inputId = ns("goValidBufferSQUAREFRAME"),
label = "Valid",
icon = icon("check"),
......@@ -77,7 +79,8 @@ mod_tabItemDispersal_ui <- function(id){
label = "Choose EPSG",
choices = NULL),
hr(),
p("You can download and upload the following example."),
p("You can download and upload the following example.
When using this example,", strong("change EPSG to 2154")),
downloadButton(ns("download_LandscapeSQUAREFRAME"),
"Download Frame shapefile",
style="color: #fff; background-color: #33595f; border-color: #052327")
......@@ -106,11 +109,10 @@ mod_tabItemDispersal_ui <- function(id){
hr(),
#
strong("Kernel selection and parameterization"),
p("Default kernel is Geometric with parameter at -2.63 considering Lambert-93 (valid in mainland France), which is EPSG:2154.
If you use an other projection system (validated in previous landscape panel) and want to apply the default kernel parameterization,
tick the following box:"),
checkboxInput(ns("checkEPSGdispersal"),
label = "Lambert-93, EPSG:2154", value = TRUE),
p("Default kernel is Geometric with parameter at -2.63 considering a metric system (default is Lambert-93 valid in mainland France).
If you use an other projection system (validated in previous landscape panel), you should provide different parameterization."),
# checkboxInput(ns("checkEPSGdispersal"),
# label = "Lambert-93, EPSG:2154", value = TRUE),
actionButton(
inputId = ns("info_kernel"),
label = " - Dispersal kernel",
......@@ -421,15 +423,15 @@ mod_tabItemDispersal_server <- function(input, output, session, r){
easyClose = TRUE,
footer="...running..."))
if(input$checkEPSGdispersal == TRUE){
landscapeSOURCE_dispersal <- sf::st_transform(r$landscapeSOURCE, crs = 2154)
landscapeSQUAREFRAME_dispersal <- sf::st_transform(r$landscapeSQUAREFRAME, crs = 2154)
tolerance_square = 1 #transformation may change the square-frame so 100% tolerance
} else{
# if(input$checkEPSGdispersal == TRUE){
# landscapeSOURCE_dispersal <- sf::st_transform(r$landscapeSOURCE, crs = 2154)
# landscapeSQUAREFRAME_dispersal <- sf::st_transform(r$landscapeSQUAREFRAME, crs = 2154)
# tolerance_square = 1 #transformation may change the square-frame so 100% tolerance
# } else{
landscapeSOURCE_dispersal <- r$landscapeSOURCE
landscapeSQUAREFRAME_dispersal <- r$landscapeSQUAREFRAME
tolerance_square = 0.1
}
# }
kernelSWITCH = switch(input$tabsetDispersal,
"kernelGeometric" = "geometric",
......
......@@ -81,7 +81,7 @@ mod_tabItemEmission_ui <- function(id){
min = 0, max = 10),
numericInput(inputId = ns("pollenSCALE"),
label = "Pollen scale",
value = 1 / (2 * 10^-7)#,
value = 5*10^5#,
#in = 0, max = 1
),
br(),
......
......@@ -110,7 +110,7 @@ mod_tabItemHost_ui <- function(id){
)
),
tags$ul(
tags$li(strong("Blue area are habitas of larvae,")),
tags$li(strong("Blue area are habitats of larvae,")),
tags$li(strong("Black dots are laying sites,")),
tags$li(strong("Brown circles are drawn when larvae emerge."))
),
......
......@@ -53,7 +53,7 @@ mod_tabItemInteractiveMap_ui <- function(id){
),
hr(),
h4("Explore the Interactive Map"),
p("The final risk map is given in the item."),
p("The final hazard map is given in the item."),
tags$video(id = ns("videoInteractiveMap"),
type = "video/mp4",
src = "www/interactiveMap_capture2.mp4",
......@@ -64,7 +64,7 @@ mod_tabItemInteractiveMap_ui <- function(id){
fluidRow(
width = 12,
box(
title = iconed("Risk Map", "asterisk"),
title = iconed("Hazard Map", "asterisk"),
width = 12,
status = "success",
solidHeader = TRUE,
......@@ -83,7 +83,7 @@ mod_tabItemInteractiveMap_ui <- function(id){
plotOutput(ns("profileRISKexposure"))
),
column(width = 6,
p("Damage distribution in landscape as a function of time."),
p("Mortality distribution in landscape as a function of time."),
plotOutput(ns("profileRISKdamage"))
),
column(width = 2,
......@@ -93,7 +93,7 @@ mod_tabItemInteractiveMap_ui <- function(id){
min = 0, max = 1000,
value = 50)
),
p("Risk map at the time provided. Legend of the risk map:"),
p("Hazard map at the time provided. Legend of the hazard map:"),
tags$ul(
tags$li(strong("large rounded square"), "landscape frame - tick 'Frame' to add/remove"),
tags$li(strong("red area"), "source area - tick 'Source' to add/remove"),
......@@ -214,32 +214,58 @@ mod_tabItemInteractiveMap_server <- function(input, output, session, r){
})
######## MAP
# observe({
# landscapeSQUAREFRAME_WGS84 = sf::st_transform(r$landscapeSQUAREFRAME, crs = 4326)
# })
# observe({
# landscapeSOURCE_WGS84 = sf::st_transform(r$landscapeSOURCE, crs = 4326)
# })
# observe({
# landscapeHOST_WGS84 = sf::st_transform(r$landscapeHOST, crs = 4326)
# })
# observe({
# individualSITE_WGS84 = sf::st_transform(r$individualSITE, crs = 4326)
# })
output$mapRISK <- renderLeaflet({
req(r$landscapeSQUAREFRAME, r$landscapeSOURCE, r$landscapeHOST, r$individualSITE)
# req(landscapeSQUAREFRAME_WGS84, landscapeSOURCE_WGS84, landscapeHOST_WGS84,individualSITE_WGS84)
req(r$createLANDSCAPE, r$landscapeSQUAREFRAME, r$landscapeSOURCE, r$landscapeHOST, r$individualSITE)
landscapeSQUAREFRAME_WGS84 = sf::st_transform(r$landscapeSQUAREFRAME, crs = 4326)
landscapeSOURCE_WGS84 = sf::st_transform(r$landscapeSOURCE, crs = 4326)
landscapeHOST_WGS84 = sf::st_transform(r$landscapeHOST, crs = 4326)
individualSITE_WGS84 = sf::st_transform(r$individualSITE, crs = 4326)
pal <- colorpalDAMAGE()
leaflet() %>%
addTiles() %>%
if(r$createLANDSCAPE == "Generate"){
startLeaflet = leaflet()
} else{
startLeaflet = leaflet() %>%
addTiles()
}
startLeaflet %>%
# fitBounds(frameBox[1]*(1-zoom),frameBox[2]*(1-zoom),frameBox[3]*(1+zoom), frameBox[4]*(1+zoom)) %>% # ~min(Long), ~min(Lat), ~max(Long), ~max(Lat)
addPolygons(data = r$landscapeSQUAREFRAME,
addPolygons(data = landscapeSQUAREFRAME_WGS84,
weight = 2,
color = "grey",
fill = FALSE,
# fillOpacity = 0.5,
group = "Frame") %>%
addPolygons(data = r$landscapeSOURCE,
addPolygons(data = landscapeSOURCE_WGS84,
weight = 2,
color = "red",
fillOpacity = 0.7,
group = "Source") %>%
addPolygons(data = r$landscapeHOST,
addPolygons(data = landscapeHOST_WGS84,
weight = 2,
color = "blue",
fillOpacity = 0.7,
group = "Host") %>%
addCircles(data = r$individualSITE,
addCircles(data = individualSITE_WGS84,
radius = 50,
color = "black",
group = "Site",
......@@ -288,17 +314,18 @@ mod_tabItemInteractiveMap_server <- function(input, output, session, r){
req(DFdamageUNNEST())
colorNumeric(palette = c("green", "red"), domain = DFdamageUNNEST()$DAMAGE)
})
#--- Table
#--- PLOT
DFdamageRISK <- reactive({
if(!is.null(r$damageINDIVIDUAL)){
DFdamageRISK = r$damageINDIVIDUAL %>%
r$damageINDIVIDUAL %>%
tidyr::unnest( c(Date, DAMAGE)) %>%
dplyr::filter(Date == input$ctrlDATEMapRISK)
dplyr::filter(Date == input$ctrlDATEMapRISK) %>%
sf::st_transform(crs = 4326)
}
})
DFdamageUNNEST <- reactive({
if(!is.null(r$damageINDIVIDUAL)){
DFdamageRISK = r$damageINDIVIDUAL %>%
r$damageINDIVIDUAL %>%
tidyr::unnest( c(Date, DAMAGE))
}
})
......@@ -325,13 +352,19 @@ mod_tabItemInteractiveMap_server <- function(input, output, session, r){
) %>%
addLegend(data = DFdamageUNNEST(),
position = "bottomright",
pal = pal, values = ~DAMAGE
pal = pal, values = ~DAMAGE,
title = "Mortality rate"
)
}
})
# SUMMARY TABLE
# output$tableReport <- renderTable({
# data.frame(
# Process = c("landscape", "pollen emission", "pollen deposition", "laying site", "development", "adverse effect")
# )
# })
}
......
......@@ -96,25 +96,26 @@ mod_tabItemLandscape_ui <- function(id){
label = "Aggregation parameter",
value = 0.001)
),
h5(strong("The projection by default is Lambert93 projection (metric projection)")),
column(width = 2,
numericInput(inputId = ns("xminLAND"),
min = -180, max = 180,
label = "x-axis min WGS84",
value = 3.011885),
# min = -180, max = 180,
label = "x-axis min [meter]",
value = 0),
numericInput(inputId = ns("xmaxLAND"),
min = -180, max = 180,
label = "x-axis max WGS94",
value = 3.037837)
# min = -180, max = 180,
label = "x-axis max [meter]",
value = 2000)
),
column(width = 2,
numericInput(inputId = ns("yminLAND"),
min = -90, max = 90,
label = "y-axis min WGS84",
value = 42.03716),
# min = -90, max = 90,
label = "y-axis min [meter]",
value = 0),
numericInput(inputId = ns("ymaxLAND"),
min = -90, max = 90,
label = "y-axis max WGS94",
value = 42.06311)
# min = -90, max = 90,
label = "y-axis max [meter]",
value = 2000)
)
),
tabPanel(title = "Load",
......@@ -123,6 +124,14 @@ mod_tabItemLandscape_ui <- function(id){
one for the maize fields and one defining the habitat fields.
If applicable, define the ID column. You can also change the Geographical System of your files.
We recommend however to provide the two files in the same EPSG."),
h5(strong("IMPORTANT: Transformation to metric system")),
strong("Make sure the coordinate system you upload is in meter. If you need help, you can see here:", a(href="", "https://epsg.io/")),
p("If you upload a map in WGS84 also known as EPSG:4326, the unit is degree.
You can transform into EPSG:3857 WGS 84 / Pseudo-Mercator to optain a metric system. But,
while WGS84 is valid world, World WGS 84 / Pseudo-Mercator is
valid between 85.06°South and 85.06°North (should be fine for growing maize)."),
# Input: Select a file ----
box(
title = iconed("Maize", "database"),
......@@ -133,7 +142,8 @@ mod_tabItemLandscape_ui <- function(id){
"Choose a KML File - Maize"),
# Button
hr(),
p("You can download the following example, and then upload it."),
p("You can download the following example, and then upload it.
When using this example,", strong("change EPSG to 2154")),
downloadButton(ns("download_landscapeSOURCEorigin"),
"Download Maize fields",
style="color: #fff; background-color: #33595f; border-color: #052327")
......@@ -162,7 +172,8 @@ mod_tabItemLandscape_ui <- function(id){
fileInput("landscapeHOSTorigin",
"Choose a KML File - Habitat"),
hr(),
p("You can download the following example, and then upload it."),
p("You can download the following example, and then upload it.
When using this example,", strong("change EPSG to 2154")),
downloadButton(ns("download_landscapeHOSTorigin"),
"Download Habitat",
style="color: #fff; background-color: #33595f; border-color: #052327")
......@@ -181,6 +192,7 @@ mod_tabItemLandscape_ui <- function(id){
label = "Choose EPSG",
choices = NULL)
)
)
)
)
......@@ -199,36 +211,42 @@ mod_tabItemLandscape_ui <- function(id){
hr(),
h5(tags$b("Properties of Lepidoptera habitats")),
p("To define the habitat of Lepidoptera larvae, which are the potential laying sites,
you have to choose a type of the frame 'fields margins' or 'habitat fields', and a proportion of this frame."),
you have to choose a type of the frame 'fields margins' or 'habitat fields',
and a proportion of this frame."),
checkboxInput(inputId = ns("frameHabitat"),
label = "Margins of maize fields.",
value = FALSE),
p("Make sure your coordinate system is in meters."),
numericInput( inputId = ns("widthMargin"),
label = "Width of field margins",
value = 0.0001)
label = "Width of field margins [default is meter]",
value = 10)
),
box(title = iconed("landscape", "object-group"),
width = 8, status = "success",
solidHeader = TRUE,
p("The two plots represent your landscape. and Blue shapes are the Habitats."),
p("The plot represents your landscape:"),
tags$ul(
tags$li(strong("Pink shapes are the Maize fields")),
tags$li(strong("Red shapes are Bt-maize fields")),
tags$li(strong("Blue shapes are the Lepidoptera habitats"))
tags$li(strong("Blue shapes are the Lepidoptera habitats,"))
),
box(
width = 6, status = "success",
solidHeader = FALSE,
plotOutput(ns("plotLANDSCAPE"))
),
box(
width = 6, status = "success",
title = "Only with Load Map",
solidHeader = FALSE,
p("This graphic is optional and may not appears, but does not change the coming simulations."),
leafletOutput(ns("mapLANDSCAPE"))
),
p("Once all elements of the landscape are ready (maize and habitat) go back at the Top of the page and click 'Next'.")
p("Note: if you 'Generate' the landscape, the distance you provided are embeded in Lambert 93 coordinate system.
All along the app, Maps are always in degrees, and not in Meters."),
# box(
# width = 6, status = "success",
# solidHeader = FALSE,
plotOutput(ns("plotLANDSCAPE")),
# ),
# box(
# width = 6, status = "success",
# title = "Only with Load Map",
# solidHeader = FALSE,
# p("This graphic is optional and may not appears,
# but does not change the coming simulations."),
# leafletOutput(ns("mapLANDSCAPE"))
# ),
strong("Once all elements of the landscape are ready (maize and habitat)
go back at the Top of the page and click 'Next'.")
)
),
briskaRshinyApp::footerPage()
......@@ -273,7 +291,7 @@ mod_tabItemLandscape_server <- function(input, output, session, r){
xmax = input$xmaxLAND,
ymin = input$yminLAND,
ymax = input$ymaxLAND)
land = sf::st_sf(geometry = sf::st_sfc(landINIT$geometry, crs = "+init=epsg:4326"))
land = sf::st_sf(geometry = sf::st_sfc(landINIT$geometry, crs = "+init=epsg:2154"))
land$sources = landINIT$sources
r$landscapeSOURCEorigin = land %>% dplyr::filter(sources == 1)
r$landscapeHOSTorigin = land %>% dplyr::filter(sources == 0) #situation everywhere except on source
......@@ -298,7 +316,9 @@ mod_tabItemLandscape_server <- function(input, output, session, r){
r$landscapeSOURCEorigin = r$landscapeSOURCEorigin %>%
dplyr::mutate(IDsource = 1:n())
}
if(input$ctrlEPSGsource != "initial"){
if(input$ctrlEPSGsource != "initial" &&
!is.na(input$ctrlEPSGsource) &&
!is.null(input$ctrlEPSGsource)){
r$landscapeSOURCEorigin <- st_transform(r$landscapeSOURCEorigin, crs = as.numeric(input$ctrlEPSGsource))
}
}
......@@ -328,7 +348,9 @@ mod_tabItemLandscape_server <- function(input, output, session, r){
r$landscapeHOSTorigin = r$landscapeHOSTorigin %>%
dplyr::mutate(IDhost = 1:n())
}
if(input$ctrlEPSGhost != "initial"){
if(input$ctrlEPSGhost != "initial" &&
!is.na(input$ctrlEPSGhost) &&
!is.null(input$ctrlEPSGhost)){
r$landscapeHOSTorigin <- st_transform(r$landscapeHOSTorigin, crs = as.numeric(input$ctrlEPSGhost))
}
}
......@@ -340,8 +362,10 @@ mod_tabItemLandscape_server <- function(input, output, session, r){
########################
observe({
if(input$frameHabitat == TRUE){
r$landscapeHOST <- briskaR::st_multibuffer(r$landscapeSOURCEorigin,
dist = rep(input$widthMargin, nrow(r$landscapeSOURCEorigin)))
if(is.numeric(input$widthMargin) && !is.na(input$widthMargin)){
r$landscapeHOST <- briskaR::st_multibuffer(r$landscapeSOURCEorigin,
dist = rep(input$widthMargin, nrow(r$landscapeSOURCEorigin)))
}
}
if(input$frameHabitat == FALSE){
r$landscapeHOST <- r$landscapeHOSTorigin
......@@ -365,33 +389,42 @@ mod_tabItemLandscape_server <- function(input, output, session, r){
geom_sf(data = r$landscapeHOST, alpha = 0.5, fill = "blue", color = "blue")
})
output$mapLANDSCAPE <- renderLeaflet({
if(!is.null(r$landscapeSOURCEorigin) &&
!is.null(r$landscapeSOURCE) &&
!is.null(r$landscapeHOST)){
if(input$golandscapeSOURCEorigin){
leaflet() %>%
addTiles()
} else{
leaflet() %>%
addTiles() %>%
addPolygons(data = r$landscapeSOURCEorigin,
weight = 2,
color = "pink",
fillOpacity = 0.3) %>%
addPolygons(data = r$landscapeSOURCE,
weight = 2,
color = "red",
fillOpacity = 0.7) %>%
addPolygons(data = r$landscapeHOST,
weight = 2,
color = "blue",
fillOpacity = 0.7)
}
# FOR LAST LEAFLET PLOT
observe({
if(input$tabsetLANDSCAPE == "generateLANDSCAPE"){
r$createLANDSCAPE = "Generate"
} else{
r$createLANDSCAPE = "Load"
}
})
# output$mapLANDSCAPE <- renderLeaflet({
# if(!is.null(r$landscapeSOURCEorigin) &&
# !is.null(r$landscapeSOURCE) &&
# !is.null(r$landscapeHOST)){
#
# if(input$golandscapeSOURCEorigin){
# leaflet() %>%
# addTiles()
# } else{
# leaflet() %>%
# addTiles() %>%
# addPolygons(data = r$landscapeSOURCEorigin,
# weight = 2,
# color = "pink",
# fillOpacity = 0.3) %>%
# addPolygons(data = r$landscapeSOURCE,
# weight = 2,
# color = "red",
# fillOpacity = 0.7) %>%
# addPolygons(data = r$landscapeHOST,
# weight = 2,
# color = "blue",
# fillOpacity = 0.7)
# }
# }
# })
}
## To be copied in the UI
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment