Commit 9af1fdd9 authored by Virgile Baudrot's avatar Virgile Baudrot
Browse files

add selection of proportion of maize fields

parent 96513f57
......@@ -37,13 +37,10 @@ app_server <- function(input, output,session) {
shinydashboard::updateTabItems(session, "tabs", newtab)
})
observe({
r$landscapeSOURCE <- sf::st_zm(sf::st_read(req(input$landscapeSOURCE)$datapath))
r$landscapeSOURCEorigin <- sf::st_zm(sf::st_read(req(input$landscapeSOURCEorigin)$datapath))
})
observe({
r$landscapeHOST <- sf::st_zm(sf::st_read(req(input$landscapeHOST)$datapath))
})
observe({
r$landscapeSQUAREFRAME <- sf::st_zm(sf::st_read(req(input$landscapeSQUAREFRAME)$datapath))
r$landscapeHOSTorigin <- sf::st_zm(sf::st_read(req(input$landscapeHOSTorigin)$datapath))
})
callModule(mod_tabItemLandscape_server, id="tabItemLandscape_ui_1", session = session, r=r)
##################
......@@ -60,6 +57,9 @@ app_server <- function(input, output,session) {
"dispersal" = "landscape")
shinydashboard::updateTabItems(session, "tabs", newtab)
})
observe({
r$landscapeSQUAREFRAME <- sf::st_zm(sf::st_read(req(input$landscapeSQUAREFRAME)$datapath))
})
callModule(mod_tabItemDispersal_server, id="tabItemDispersal_ui_1", session = session, r=r)
##################
## EMISSION
......
......@@ -51,7 +51,7 @@ mod_tabItemDispersal_ui <- function(id){
fluidRow( # width of fluidrow is 12
box(title = iconed("Kernel", "sliders-h"),
solidHeader = TRUE,
width = 6, status = "warning",
width = 8, status = "warning",
#
p("The shapefile provide previously needs to be convert into a raster.
Increasing this value can dramatically increase the computing time. So we fix maximum at 1024.
......@@ -232,16 +232,54 @@ mod_tabItemDispersal_ui <- function(id){
label = "parameter b",
value = 1)
)
)
),
box(title = iconed("Frame", "database"),
solidHeader = TRUE,
width = 4, status = "warning",
p("Once you have generated or loaded the source and host, you have to define the landscape borders:
a square surrounding both sources and hosts fields. The square shape is required for dispersal and convolution computing."),
p("Again, you can either generate a frame by providing a buffer distance, or load your own frame. Make sure the frame you upload is a square."),
tabsetPanel(id = ns("tabsetSQUAREFRAME"),
selected = "bufferSQUAREFRAME",
tabPanel(title = "Generate",
value = "bufferSQUAREFRAME",
p("Choose the size of the buffer, and click on the green button 'Valid'."),
numericInput(inputId = ns("squareFrameBuffer"),
label = "Size of the buffer",
value = 0.005),
actionButton(inputId = ns("goValidBufferSQUAREFRAME"),
label = "Valid",
icon = icon("check"),
style="color: #fff; background-color: #00a65a; border-color: #00a65a")
),
tabPanel(title = "Load",
value = "loadSQUAREFRAME",
fileInput("landscapeSQUAREFRAME",
"Choose a KML File for Square Frame"),
textOutput(ns("textEPSGsqFrame")),
selectizeInput(ns("ctrlEPSGsqFrame"),
label = "Choose EPSG",
choices = NULL),
hr(),
p("You can download and upload the following example."),
downloadButton(ns("download_LandscapeSQUAREFRAME"),
"Download Frame shapefile",
style="color: #fff; background-color: #33595f; border-color: #052327")
)
),
plotOutput(ns("plotLANDSCAPEframe")),
hr(),
actionButton(inputId = ns("goRunDispersal"),
label = "Run",
icon = icon("rocket"),
style="color: #fff; background-color: #dd4b39; border-color: #dd4b39")
),
)
),
fluidRow(
box(title = iconed("Dispersal Probability of the source fields", "cogs"),
solidHeader = TRUE,
width = 6, status = "success",
width = 12, status = "success",
p("For each source field uploaded previously in the item 'landscape',
the dispersal is computed according to the kernel which has been selected."),
p("On the left, the picture represents the 9 (or less) first source fields,
......@@ -285,10 +323,9 @@ mod_tabItemDispersal_server <- function(input, output, session, r){
output$CheckDispersal <- renderText({
CheckDispersal = list()
CheckDispersal$landscapeSOURCE= ifelse(is.null(r$landscapeSOURCE), "NO Source", "Source OK")
CheckDispersal$landscapeSQUAREFRAME= ifelse(is.null(r$landscapeSQUAREFRAME), "NO Frame", "Frame OK")
#CheckDispersal$landscapeSQUAREFRAME= ifelse(is.null(r$landscapeSQUAREFRAME), "NO Frame", "Frame OK")
return(HTML(paste0(
"1. ", CheckDispersal$landscapeSOURCE, ",\n",
"2. ", CheckDispersal$landscapeSQUAREFRAME, "."))
"1. ", CheckDispersal$landscapeSOURCE, ",\n"))
)
})
#######################################################################################
......@@ -321,6 +358,55 @@ mod_tabItemDispersal_server <- function(input, output, session, r){
html = TRUE
)
})
############################################ SQUARE FRAME
output$download_LandscapeFRAME <- downloadHandler(
filename = function() {
paste("landscapeSQUAREFRAME_", Sys.Date(), ".kml", sep = "")
},
content = function(file) {
sf::st_write(briskaRshinyApp::landscapeSQUAREFRAME, file)
}
)
observe({
ctrlEPSGsqFrame <- names(r$landscapeSQUAREFRAME)
updateSelectizeInput( session, "ctrlEPSGsqFrame", selected = "initial", choices = c("initial",rgdal::make_EPSG()$code))
})
observe({
r$tabsetSQUAREFRAME <- input$tabsetSQUAREFRAME
})
observe({
r$ctrlEPSGsqFrame <- input$ctrlEPSGsqFrame
})
observe({
r$squareFrameBuffer <- input$squareFrameBuffer
})
observeEvent(input$goValidBufferSQUAREFRAME,{
if(!is.null(r$landscapeSOURCE) || !is.null(r$landscapeHOST)){
r$landscapeSQUAREFRAME <- st_squared_geometry(list(r$landscapeSOURCE, r$landscapeHOST), buffer = r$squareFrameBuffer)
}
})
observe({
if (r$tabsetSQUAREFRAME == "loadSQUAREFRAME") {
if(!is.null(r$landscapeSQUAREFRAME)){
if(r$ctrlEPSGsqFrame != "initial"){
r$landscapeSQUAREFRAME <- sf::st_transform(r$landscapeSQUAREFRAME, crs = as.numeric(r$ctrlEPSGsqFrame))
}
}
}
})
## OUTPUT
output$textEPSGsqFrame = renderText({
paste("EPSG initial:", sf::st_crs(r$landscapeSQUAREFRAME$epsg))
})
output$plotLANDSCAPEframe <- renderPlot({
ggplot() +
theme_minimal() +
geom_sf(data = r$landscapeSQUAREFRAME, fill = NA) +
geom_sf(data = r$landscapeSOURCE, alpha = 0.5, fill = "red", color = "red") +
geom_sf(data = r$landscapeHOST, alpha = 0.5, fill = "blue", color = "blue")
})
# INFORMATION <<<
#######################################################################################
# COMPUTE DISPERSAL
......@@ -402,8 +488,8 @@ mod_tabItemDispersal_server <- function(input, output, session, r){
output$plotRunDISPERSAL <- renderPlot({
input$goRunDispersal
isolate({
if(length(stack_dispersal()@layers) >= 4){
plot(stack_dispersal()[[1:4]])
if(length(stack_dispersal()@layers) >= 9){
plot(stack_dispersal()[[1:9]])
} else{
plot(stack_dispersal()[[1:length(stack_dispersal()@layers)]])
}
......
......@@ -83,7 +83,7 @@ mod_tabItemLandscape_ui <- function(id){
value = 100, step = 1 #integer
),
hr(),
actionButton(inputId = ns("goLandscapeSOURCE"),
actionButton(inputId = ns("golandscapeSOURCEorigin"),
label = "Valid",
icon = icon("check"),
style="color: #fff; background-color: #00a65a; border-color: #00a65a")
......@@ -130,12 +130,12 @@ mod_tabItemLandscape_ui <- function(id){
solidHeader = FALSE,
width = 6, status = "warning",
column(width = 6,
fileInput("landscapeSOURCE",
fileInput("landscapeSOURCEorigin",
"Choose a KML File - SOURCE"),
# Button
hr(),
p("You can download the following example, and then upload it."),
downloadButton(ns("download_LandscapeSOURCE"),
downloadButton(ns("download_landscapeSOURCEorigin"),
"Download Source",
style="color: #fff; background-color: #33595f; border-color: #052327")
),
......@@ -160,11 +160,11 @@ mod_tabItemLandscape_ui <- function(id){
width = 6, status = "warning",
# Input: Select a file ----
column(width = 6,
fileInput("landscapeHOST",
fileInput("landscapeHOSTorigin",
"Choose a KML File - HOST"),
hr(),
p("You can download the following example, and then upload it."),
downloadButton(ns("download_LandscapeHOST"),
downloadButton(ns("download_landscapeHOSTorigin"),
"Download Host",
style="color: #fff; background-color: #33595f; border-color: #052327")
),
......@@ -189,40 +189,25 @@ mod_tabItemLandscape_ui <- function(id){
)
),
fluidRow(
box(title = iconed("Frame", "database"),
box(title = iconed("Properties of fields", "database"),
solidHeader = TRUE,
width = 4, status = "warning",
p("Once you have generated or loaded the source and host, you have to define the landscape borders:
a square surrounding both sources and hosts fields. The square shape is required for dispersal and convolution computing."),
p("Again, you can either generate a frame by providing a buffer distance, or load your own frame. Make sure the frame you upload is a square."),
tabsetPanel(id = ns("tabsetSQUAREFRAME"),
selected = "bufferSQUAREFRAME",
tabPanel(title = "Generate",
value = "bufferSQUAREFRAME",
p("Choose the size of the buffer, and click on the green button 'Valid'."),
numericInput(inputId = ns("squareFrameBuffer"),
label = "Size of the buffer",
value = 0.005),
actionButton(inputId = ns("goValidBufferSQUAREFRAME"),
label = "Valid",
icon = icon("check"),
style="color: #fff; background-color: #00a65a; border-color: #00a65a")
),
tabPanel(title = "Load",
value = "loadSQUAREFRAME",
fileInput("landscapeSQUAREFRAME",
"Choose a KML File for Square Frame"),
textOutput(ns("textEPSGsqFrame")),
selectizeInput(ns("ctrlEPSGsqFrame"),
label = "Choose EPSG",
choices = NULL),
hr(),
p("You can download and upload the following example."),
downloadButton(ns("download_LandscapeSQUAREFRAME"),
"Download Frame shapefile",
style="color: #fff; background-color: #33595f; border-color: #052327")
)
)
h5(tags$b("Properties of maize fields")),
p("Choose the proportion of maize fields that are Bt."),
sliderInput( inputId = ns("GMratio"),
label = "Proportion of Bt maize",
value = 1,
min = 0, max = 1),
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."),
checkboxInput(inputId = ns("frameHabitat"),
label = "Margins of maize fields.",
value = FALSE),
numericInput( inputId = ns("widthMargin"),
label = "Width of field margins",
value = 0.0001)
),
box(title = iconed("landscape", "object-group"),
width = 8, status = "success",
......@@ -260,32 +245,24 @@ mod_tabItemLandscape_server <- function(input, output, session, r){
r$inputLANDSCAPE = input
})
### Download Example File
output$download_LandscapeSOURCE <- downloadHandler(
output$download_landscapeSOURCEorigin <- downloadHandler(
filename = function() {
paste("landscapeSOURCE_", Sys.Date(), ".kml", sep = "")
paste("landscapeSOURCEorigin_", Sys.Date(), ".kml", sep = "")
},
content = function(file) {
sf::st_write(briskaRshinyApp::landscapeSOURCE, file)
sf::st_write(briskaRshinyApp::landscapeSOURCEorigin, file)
}
)
output$download_LandscapeHOST <- downloadHandler(
output$download_landscapeHOSTorigin <- downloadHandler(
filename = function() {
paste("landscapeHOST_", Sys.Date(), ".kml", sep = "")
paste("landscapeHOSTorigin_", Sys.Date(), ".kml", sep = "")
},
content = function(file) {
sf::st_write(briskaRshinyApp::landscapeHOST, file)
}
)
output$download_LandscapeFRAME <- downloadHandler(
filename = function() {
paste("landscapeSQUAREFRAME_", Sys.Date(), ".kml", sep = "")
},
content = function(file) {
sf::st_write(briskaRshinyApp::landscapeSQUAREFRAME, file)
sf::st_write(briskaRshinyApp::landscapeHOSTorigin, file)
}
)
### USE EXAMPLES
observeEvent(input$goLandscapeSOURCE,{
observeEvent(input$golandscapeSOURCEorigin,{
landINIT = briskaR::simulateInitialPartition(n = input$nLAND,
prop = input$propLAND,
range = input$rangeLAND,
......@@ -295,16 +272,16 @@ mod_tabItemLandscape_server <- function(input, output, session, r){
ymax = input$ymaxLAND)
land = sf::st_sf(geometry = sf::st_sfc(landINIT$geometry, crs = "+init=epsg:4326"))
land$sources = landINIT$sources
r$landscapeSOURCE = land %>% dplyr::filter(sources == 1)
r$landscapeHOST = land %>% dplyr::filter(sources == 0) #situation everywhere except on source
r$landscapeSOURCEorigin = land %>% dplyr::filter(sources == 1)
r$landscapeHOSTorigin = land %>% dplyr::filter(sources == 0) #situation everywhere except on source
})
# SOURCE
observe({
ctrlIDsource <- names(r$landscapeSOURCE)
ctrlIDsource <- names(r$landscapeSOURCEorigin)
updateSelectizeInput( session, "ctrlIDsource", selected = NULL, choices = ctrlIDsource)
})
observe({
ctrlEPSGsource <- names(r$landscapeSOURCE)
ctrlEPSGsource <- names(r$landscapeSOURCEorigin)
updateSelectizeInput( session, "ctrlEPSGsource", selected = "initial", choices = c("initial",sort(rgdal::make_EPSG()$code)))
})
## CREATE
......@@ -312,37 +289,29 @@ mod_tabItemLandscape_server <- function(input, output, session, r){
r$IDsource = input$ctrlIDsource
})
observe({
if(!is.null(r$landscapeSOURCE)){
if(!is.null(r$landscapeSOURCEorigin)){
if(is.null(r$IDsource) || r$IDsource == ""){
r$IDsource = "IDsource"
r$landscapeSOURCE = r$landscapeSOURCE %>%
r$landscapeSOURCEorigin = r$landscapeSOURCEorigin %>%
dplyr::mutate(IDsource = 1:n())
}
if(input$ctrlEPSGsource != "initial"){
r$landscapeSOURCE <- st_transform(r$landscapeSOURCE, crs = as.numeric(input$ctrlEPSGsource))
r$landscapeSOURCEorigin <- st_transform(r$landscapeSOURCEorigin, crs = as.numeric(input$ctrlEPSGsource))
}
}
})
## OUTPUT
output$tableSOURCE <- renderTable({
if(!is.null(r$landscapeSOURCE)){
r$landscapeSOURCE %>%
dplyr::select(r$IDsource) %>%
sf::st_drop_geometry() %>%
head()
}
})
output$textEPSGsource = renderText({
paste("EPSG initial:", sf::st_crs(r$landscapeSOURCE)$epsg)
paste("EPSG initial:", sf::st_crs(r$landscapeSOURCEorigin)$epsg)
})
# HOST
## OBSERVE
observe({
ctrlIDhost <- names(r$landscapeHOST)
ctrlIDhost <- names(r$landscapeHOSTorigin)
updateSelectizeInput( session, "ctrlIDhost", selected = NULL, choices = ctrlIDhost)
})
observe({
ctrlEPSGhost <- names(r$landscapeHOST)
ctrlEPSGhost <- names(r$landscapeHOSTorigin)
updateSelectizeInput( session, "ctrlEPSGhost", selected = "initial", choices = c("initial",sort(rgdal::make_EPSG()$code)))
})
## CREATE
......@@ -350,86 +319,64 @@ mod_tabItemLandscape_server <- function(input, output, session, r){
r$IDhost = input$ctrlIDhost
})
observe({
if(!is.null(r$landscapeHOST)){
if(!is.null(r$landscapeHOSTorigin)){
if(is.null(r$IDhost) || r$IDhost == ""){
r$IDhost = "IDhost"
r$landscapeHOST = r$landscapeHOST %>%
r$landscapeHOSTorigin = r$landscapeHOSTorigin %>%
dplyr::mutate(IDhost = 1:n())
}
if(input$ctrlEPSGhost != "initial"){
r$landscapeHOST <- st_transform(r$landscapeHOST, crs = as.numeric(input$ctrlEPSGhost))
r$landscapeHOSTorigin <- st_transform(r$landscapeHOSTorigin, crs = as.numeric(input$ctrlEPSGhost))
}
}
})
## OUTPUT
output$tableHOST <- renderTable({
if(!is.null(r$landscapeHOST)){
r$landscapeHOST %>%
dplyr::select(r$IDhost) %>%
sf::st_drop_geometry() %>%
head()
}
})
output$textEPSGhost = renderText({
paste("EPSG initial:", sf::st_crs(r$landscapeHOST)$epsg)
paste("EPSG initial:", sf::st_crs(r$landscapeHOSTorigin)$epsg)
})
############################################ SQUARE FRAME
########################
observe({
ctrlEPSGsqFrame <- names(r$landscapeSQUAREFRAME)
updateSelectizeInput( session, "ctrlEPSGsqFrame", selected = "initial", choices = c("initial",rgdal::make_EPSG()$code))
})
observe({
r$tabsetSQUAREFRAME <- input$tabsetSQUAREFRAME
})
observe({
r$ctrlEPSGsqFrame <- input$ctrlEPSGsqFrame
if(input$frameHabitat == TRUE){
r$landscapeHOST <- briskaR::st_multibuffer(r$landscapeSOURCEorigin,
dist = rep(input$widthMargin, nrow(r$landscapeSOURCEorigin)))
}
if(input$frameHabitat == FALSE){
r$landscapeHOST <- r$landscapeHOSTorigin
}
})
observe({
r$squareFrameBuffer <- input$squareFrameBuffer
})
observeEvent(input$goValidBufferSQUAREFRAME,{
if(!is.null(r$landscapeSOURCE) || !is.null(r$landscapeHOST)){
r$landscapeSQUAREFRAME <- st_squared_geometry(list(r$landscapeSOURCE, r$landscapeHOST), buffer = r$squareFrameBuffer)
if(!is.null(r$landscapeSOURCEorigin)){
r$landscapeSOURCE = r$landscapeSOURCEorigin[
sample(1:nrow(r$landscapeSOURCEorigin),
round(input$GMratio*nrow(r$landscapeSOURCEorigin))), ]
}
})
observe({
if (r$tabsetSQUAREFRAME == "loadSQUAREFRAME") {
if(!is.null(r$landscapeSQUAREFRAME)){
if(r$ctrlEPSGsqFrame != "initial"){
r$landscapeSQUAREFRAME <- sf::st_transform(r$landscapeSQUAREFRAME, crs = as.numeric(r$ctrlEPSGsqFrame))
}
}
}
})
## OUTPUT
output$textEPSGsqFrame = renderText({
paste("EPSG initial:", sf::st_crs(r$landscapeSQUAREFRAME$epsg))
})
########################
## PLOT
output$plotLANDSCAPE <- renderPlot({
ggplot() +
theme_minimal() +
geom_sf(data = r$landscapeSQUAREFRAME, fill = NA) +
geom_sf(data = r$landscapeSOURCEorigin, alpha = 0.5, fill = "pink", color = "pink") +
geom_sf(data = r$landscapeSOURCE, alpha = 0.5, fill = "red", color = "red") +
geom_sf(data = r$landscapeHOST, alpha = 0.5, fill = "blue", color = "blue")
})
output$mapLANDSCAPE <- renderLeaflet({
if(!is.null(r$landscapeSQUAREFRAME) &&
if(!is.null(r$landscapeSOURCEorigin) &&
!is.null(r$landscapeSOURCE) &&
!is.null(r$landscapeHOST)){
if(input$goLandscapeSOURCE){
if(input$golandscapeSOURCEorigin){
leaflet() %>%
addTiles()
} else{
leaflet() %>%
addTiles() %>%
addPolygons(data = r$landscapeSQUAREFRAME,
addPolygons(data = r$landscapeSOURCEorigin,
weight = 2,
color = "grey",
fillOpacity = 0.5) %>%
color = "pink",
fillOpacity = 0.3) %>%
addPolygons(data = r$landscapeSOURCE,
weight = 2,
color = "red",
......
......@@ -33,6 +33,7 @@ acting as an insecticide on pest such as the European Corn Borer (", em("Ostrini
While the Bt maize primarily targets pests that are detrimental to the crop, the Bt toxin is also active against some
NTOs that might be of conservation interest. As the Bt toxin is expressed in pollen which is dispersed by wind, exposure
to Bt toxin is likely to occur outside maize fields over large distances and can thus reach habitats of NTOs.
Once dispersed maize pollen gets deposited on host plants of butterfly larvae, the larvae may ingest the pollen inadvertedly by feeding on the host plant.
In order to assess the current environmental risk of Bt maize at landscape scales and how management measures
might mitigate the risk in a given agro-ecosystem, modelling tools are needed. Over the last ten years, several
models have been proposed for assessing the risk of Bt-maize on non-target Lepidoptera. Whereas there is a better
......
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