Commit 55c65ee3 authored by Conor Anderson's avatar Conor Anderson

Start crop improvements

parent 3aa7095c
On this page you can crop the GCM data from a single model. You can choose to upload an ESRI shapefile (with the necessary auxilary files) in a single ZIP archive, or you can manually choose a single point, or two corners of a rectangle object.
Click on the map to choose coordinates. You can verify or modify the coordinates in the "Manual Coordinates" panel.
Some notes:
You should _not_ provide both a Shapefile _and_ manual input. However, if in doubt, keep the following guidelines in mind:
- Uploading a Shapefile will reset the manual input to the default (invalid) coordinates. The Shapefile will be used.
- If you set coordiantes manually _after_ uploading a Shapefile, we will remove the Shapefile and prefer the manual input.
- If you change your mind again, re-upload the Shapefile, and it will again clear the manual input.
......@@ -9,6 +9,7 @@ library("shiny")
library("broom")
library("doParallel")
library("dplyr")
library("gdalUtils")
library("ggplot2")
library("googleway")
library("htmlwidgets")
......@@ -23,6 +24,7 @@ library("purrr")
library("raster")
library("RColorBrewer")
library("readr")
library("rgdal")
library("storr")
library("stringr")
library("tibble")
......@@ -477,38 +479,81 @@ shinyServer(function(input, output, session) {
)
### Resample Data (WIP)
crop_model_in <- callModule(singleModelSelect, "crop_model_in",
choices = reactive({get_choices(file_dir, input$var_filter_crop, lim = TRUE)}),
coords = NULL,
projection = reactive({input$crop_year_in[1]:input$crop_year_in[2]}))
output$resample_map <- renderLeaflet({
leaflet() %>%
addProviderTiles("CartoDB.Positron")%>%
setView(lng = 0, lat = 0, zoom = 3)
})
# Show Shapefile on map
observeEvent(input$shapefile, {
# Clear the manual inputs
updateNumericInput(session, "Lat1", value = -999)
updateNumericInput(session, "Lat2", value = -999)
updateNumericInput(session, "Lon1", value = -999)
updateNumericInput(session, "Lon2", value = -999)
print(sprintf("The Shapefile is %s", input$shapefile$datapath))
zip_dir <- tempdir()
print(sprintf("Unzipping to %s", zip_dir))
unzip(input$shapefile$datapath, exdir = zip_dir)
shp <- readOGR(zip_dir)
ext <- extent(shp)
proxy <- leafletProxy("resample_map")
proxy %>% clearMarkers() %>% clearShapes()
proxy %>% addPolygons(data = shp) %>%
flyToBounds(attr(ext, "xmin"), attr(ext, "ymin"),
attr(ext, "xmax"), attr(ext, "ymax"))
})
# output$resample_map <- renderLeaflet({
# leaflet() %>%
# addProviderTiles("CartoDB.Positron")%>%
# setView(lng = -4, lat= 52.54, zoom = 7)
# })
#
# #Show popup on click
# observeEvent(input$resample_map_click, {
# click <- input$resample_map_click
# proxy <- leafletProxy("resample_map")
# if (input$Lat1 == -999 && input$Lon1 == -999) {
# print("First Step")
# updateNumericInput(session, "Lat1", "Lat1", value = click$lat); updateNumericInput(session, "Lon1", "Lon1", value = click$lng)
# print("Gets here")
# text <- paste("Lattitude ", click$lat, "Longtitude ", click$lng)
# proxy %>% addMarkers(click$lng, click$lat, text)
# }
# else if(input$Lat1 != -999 && input$Lon1 != -999 && (input$Lat2 == -999 || input$Lon2 == -999)) {
# updateNumericInput(session, "Lat2", value = click$lat)
# updateNumericInput(session, "Lon2", value = click$lng)
# text <- paste("Lattitude ", click$lat, "Longtitude ", click$lng)
# proxy %>% addMarkers(click$lng, click$lat, text) %>% addRectangles(click$lng, click$lat, input$Lon1, input$Lat1)
# }
# else {
# updateNumericInput(session, "Lat1", value = -999)
# updateNumericInput(session, "Lat2", value = -999)
# updateNumericInput(session, "Lon1", value = -999)
# updateNumericInput(session, "Lon2", value = -999)
# proxy %>% clearMarkers() %>% clearShapes()
# }
# })
#Show popup on click
observeEvent(input$resample_map_click, {
click <- input$resample_map_click
proxy <- leafletProxy("resample_map")
if (input$Lat1 == -999 && input$Lon1 == -999) {
print("First Step")
updateNumericInput(session, "Lat1", "Lat1", value = click$lat); updateNumericInput(session, "Lon1", "Lon1", value = click$lng)
print("Gets here")
text <- paste("Lattitude ", click$lat, "Longtitude ", click$lng)
proxy %>% clearMarkers() %>% clearShapes()
proxy %>% addMarkers(click$lng, click$lat, text)
}
else if(input$Lat1 != -999 && input$Lon1 != -999 && (input$Lat2 == -999 || input$Lon2 == -999)) {
updateNumericInput(session, "Lat2", value = click$lat)
updateNumericInput(session, "Lon2", value = click$lng)
ext <- list(xmin = min(click$lng, input$Lon1),
xmax = max(click$lng, input$Lon1),
ymin = min(click$lat, input$Lat1),
ymax = max(click$lat, input$Lat1))
text <- paste("Lattitude ", click$lat, "Longtitude ", click$lng)
proxy %>% addMarkers(click$lng, click$lat, text) %>%
addRectangles(click$lng, click$lat, input$Lon1, input$Lat1) %>%
flyToBounds(ext$xmin, ext$ymin, ext$xmax, ext$ymax)
}
else {
updateNumericInput(session, "Lat1", value = -999)
updateNumericInput(session, "Lat2", value = -999)
updateNumericInput(session, "Lon1", value = -999)
updateNumericInput(session, "Lon2", value = -999)
proxy %>% clearMarkers() %>% clearShapes()
}
})
output$crop_action <- renderUI({
validate(
need(crop_model_in(), "Choose a model to crop.")
)
actionButton("crop_go",
"Process!")
#need(!(any(c(input$Lon1, input$Lon2) %in% -999)) || input$shapefile, "We need some lat/lon data.")
})
output$source <- renderUI({
desc <- system("git log devel -n 20 --format='%cd %s' --date=short", intern = TRUE)
......
......@@ -16,7 +16,7 @@ dashboardPage(
menuItem("GCM Plots", tabName = "plot", icon = icon("line-chart")),
menuItem("GCM Anomalies", tabName = "anomalies", icon = icon("thermometer-three-quarters")),
menuItem("Overlay Map", tabName = "map", icon = icon("globe")),
#menuItem("Resample", tabName = "resample", icon = icon("edit"))
menuItem("Crop Data", tabName = "crop", icon = icon("crop")),
menuItem("Source Code", tabName = "source", icon = icon("git"))
)
),
......@@ -41,7 +41,7 @@ dashboardPage(
fluidRow(
box(
title = "Input",
width = 4,
width = 3,
selectInput("var_filter_plot", "Select Variables", c("tas", "tasmax", "tasmin", "pr")),
singleModelSelectInput("plot_model_in", "Select Model"),
sliderInput("year_in", label = "Projection Period", min = 2006,
......@@ -54,7 +54,7 @@ dashboardPage(
box(
title = "Output",
width = 8,
width = 9,
plotlyOutput("distPlot"),
checkboxGroupInput("types_in", "Plot Types", list("point", "loess", "line", "bar"), inline = TRUE),
conditionalPanel("output.distPlot", downloadButton("download_ts", "Download time series"))
......@@ -150,33 +150,61 @@ dashboardPage(
)
), # End tab 3
# # Tab 4
# tabItem(tabName = "resample",
# fluidRow(
# box(
# width = 12,
# leafletOutput("resample_map")
# )
# ),
# fluidRow(
# box(
# width = 12,
# title = "Manual Coordinates",
# collapsible = TRUE,
# collapsed = TRUE,
# column(
# width = 6,
# numericInput("Lat1", "Latitide Bound 1", value = -999, width = -999),
# numericInput("Lon1", "Longitude Bound 1", value = -999, width = -999)
# ),
# column(
# width = 6,
# numericInput("Lat2", "Latitude Bount 2", value = -999, width = -999),
# numericInput("Lon2", "Longitude Bound 2", value = -999, width = -999)
# )
# )
# )
# ), # End tab 4
# Tab 4
tabItem(tabName = "crop",
fluidRow(
box(width = 10,
includeMarkdown("include/crop.md")
),
box(width = 2,
uiOutput("crop_action")
)
),
fluidRow(
box(
width = 3,
selectInput("var_filter_crop", "Select Variables", c("tas", "tasmax", "tasmin", "pr")),
singleModelSelectInput("crop_model_in", "Select Model"),
sliderInput("crop_year_in", label = "Years to Include", min = 2006,
max = 2100, value = c(2011, 2100), step = 1,
round = FALSE, sep = "", ticks = FALSE)
),
box(
width = 9,
leafletOutput("resample_map")
)
),
fluidRow(
box(
width = 12,
title = "Upload a Shapefile",
collapsible = TRUE,
collapsed = FALSE,
fileInput("shapefile", "Choose a zip file containing .shp and other files",
multiple = FALSE,
accept = ".zip")
)
),
fluidRow(
box(
width = 12,
title = "Manual Coordinates",
collapsible = TRUE,
collapsed = FALSE,
column(
width = 6,
numericInput("Lat1", "Latitide Bound 1", value = -999, width = -999),
numericInput("Lon1", "Longitude Bound 1", value = -999, width = -999)
),
column(
width = 6,
numericInput("Lat2", "Latitude Bount 2", value = -999, width = -999),
numericInput("Lon2", "Longitude Bound 2", value = -999, width = -999)
)
)
)
), # End tab 4
# Tab 5
tabItem(tabName = "source",
......
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