Commit 300c0123 authored by luroth's avatar luroth
Browse files

waypoint update error fix

parent ef262f96
......@@ -84,7 +84,7 @@ validate_inputs <- function(input) {
}
#Allowed shutter speeds
shutter_speed_values <- list("1/500"=500, "1/640" = 640, "1/800" = 800, "1/1000" = 1000, "1/1600" = 1600, "1/2000" = 2000, "1/2500" = 2500, "1/4000" = 4000, "1/6400" = 6400, "1/8000" = 8000, "1/12000" = 12000, "1/16000" = 16000, "1/32000" = 32000, "1/64000" = 64000)
shutter_speed_values <- list("1/250"=250, "1/500"=500, "1/640" = 640, "1/800" = 800, "1/1000" = 1000, "1/1600" = 1600, "1/2000" = 2000, "1/2500" = 2500, "1/4000" = 4000, "1/6400" = 6400, "1/8000" = 8000, "1/12000" = 12000, "1/16000" = 16000, "1/32000" = 32000, "1/64000" = 64000)
# Debouncing factor
default_debounce <- 500
......@@ -344,7 +344,7 @@ server_ <- function(input, output, session) {
updateSliderInput(session, "motion_blur", min=min_motion_blur, max=max_motion_blur)
if(max_motion_blur <= min_motion_blur) {
showNotification(id="error_motion", paste0("No solution for motion blur range found. Reduce overlaps or mapping area"), closeButton = TRUE, type = "error", duration = NULL)
showNotification(id="error_motion", paste0("No solution for motion blur range found. Increase maximum allowed flight time or reduce mapping area"), closeButton = TRUE, type = "error", duration = NULL)
} else if(actual_motion_blur > max_motion_blur) {
showNotification(id="warning_blur_too_small", paste0("The required image recording frequency is higher than the maximum allowed image recording frequency (", input$freq_max, "). The motion blur was value was reduced from ", actual_motion_blur, " to ", max_motion_blur))
updateSliderInput(session, "motion_blur", value=max_motion_blur)
......@@ -495,11 +495,12 @@ server_ <- function(input, output, session) {
args_focus_distance_function <- list(f = derived_values$f, N=derived_values$aperture, circle_of_confusion=derived_values$circle_of_confusion, d_sensor =derived_values$d_sensor_x, n_pix = input$n_pix_x)
args_depth_of_field_function <- list(f = derived_values$f, N=derived_values$aperture, circle_of_confusion=derived_values$circle_of_confusion, d_sensor =derived_values$d_sensor_x, n_pix = input$n_pix_x)
max_height <- ifelse(derived_values$flight_height <= 50, 50, 150)
plot <- ggplot(data.frame(y = c(2, 100)), aes(y)) +
plot <- ggplot(data.frame(y = c(2, max_height)), aes(y)) +
# Scales
scale_y_continuous("Distance to ground (m)", expand = c(0,0), limits=c(-20,100), breaks = seq(-0, 100, 10), sec.axis = sec_axis(~derived_values$flight_height-., name = "Distance to sensor (m)", breaks = seq(-0, 100, 5))) +
scale_x_continuous("Ground sampling distance (mm)", labels=label_digits(2), limits=c(calc_ground_sampling_distance_mm(2, d_sensor = derived_values$d_sensor_x, n_pix=input$n_pix_x, f=derived_values$f), calc_ground_sampling_distance_mm(102, d_sensor = derived_values$d_sensor_x, n_pix=input$n_pix_x, f=derived_values$f)), expand = c(0,0)) +
scale_y_continuous("Distance to ground (m)", expand = c(0,0), limits=c(-20,max_height), breaks = seq(-0, max_height, 10), sec.axis = sec_axis(~derived_values$flight_height-., name = "Distance to sensor (m)", breaks = seq(-0, max_height, 5))) +
scale_x_continuous("Ground sampling distance (mm)", limits=c(calc_ground_sampling_distance_mm(2, d_sensor = derived_values$d_sensor_x, n_pix=input$n_pix_x, f=derived_values$f), calc_ground_sampling_distance_mm(max_height+2, d_sensor = derived_values$d_sensor_x, n_pix=input$n_pix_x, f=derived_values$f)), expand = c(0,0)) +
# Flight height line
stat_function(fun=calc_flight_height_mm, args = args_flight_height_function, na.rm=TRUE, aes(color="Flight height")) +
# Grey box for ground
......@@ -726,7 +727,6 @@ server_ <- function(input, output, session) {
})
debounced_f
# Create waypoint leaflet
waypoint_map <- reactive({
......@@ -751,18 +751,19 @@ server_ <- function(input, output, session) {
map = map %>% addLayersControl(
baseGroups = providers,
options = layersControlOptions(collapsed = FALSE))
map
})
output$waypoint_map <- renderLeaflet({
validate_inputs(input)
#validate_inputs(input)
waypoint_map()
})
observeEvent({c(
input$waypoint_map_marker_mouseout)
}, {
}, {
event <- input$waypoint_map_marker_mouseout
if(event$id == 1) {
updateNumericInput(session, "position_edge1_lat", value=event$lat)
......@@ -776,12 +777,19 @@ server_ <- function(input, output, session) {
}
})
observeEvent(waypoints(), {
observeEvent(input$recalc_waypoint_map, {
req(waypoints())
waypoint_edges <- data.frame(lat = c(input$position_edge1_lat, input$position_edge2_lat, input$position_start_lat),
long = c(input$position_edge1_long, input$position_edge2_long, input$position_start_long),
desc = c("Edge 1", "Flight direction", "Start point"))
leafletProxy("waypoint_map", session) %>%
clearShapes() %>%
addPolylines(layerId = 4, data=waypoints(), lat = ~latitude, lng=~longitude)
addPolylines(layerId = 4, data=waypoints(), lat = ~latitude, lng=~longitude) %>%
clearMarkers() %>%
addMarkers(data= waypoint_edges[1,], layerId= 1, ~long, ~lat, label = ~as.character(desc), options = markerOptions(draggable = TRUE), labelOptions= labelOptions(noHide = T)) %>%
addMarkers(data= waypoint_edges[2,], layerId= 2, ~long, ~lat, label = ~as.character(desc), options = markerOptions(draggable = TRUE), labelOptions =labelOptions(noHide = T)) %>%
addMarkers(data= waypoint_edges[3,], layerId= 3, ~long, ~lat, label = ~as.character(desc), options = markerOptions(draggable = TRUE), labelOptions = labelOptions(noHide = T))
})
# Legend to waypoint leaflet
......
......@@ -81,7 +81,7 @@ ui_ <- fluidPage(
tabPanel("Imaging",
h4("Resolution"),
sliderInput("flight_height", "Flight height (m)", width = "100%", value = default_flight_height, min=2, max=100),
sliderInput("flight_height", "Flight height (m)", width = "100%", value = default_flight_height, min=2, max=150),
fluidRow(
column(9, numericInput("ground_sampling_distance", "Ground sampling distance nadir (mm)", width = "100%", value=NA, step=0.1)),
column(3, checkboxInput("edit_ground_sampling_distance", "Edit"), style = "margin-top: 25px;")
......@@ -122,7 +122,7 @@ ui_ <- fluidPage(
column(6,radioButtons("flip_camera", "Camera heading", choiceNames=c("Narrow side in flight direction", "Wide side in flight direction"), choiceValues = c(FALSE, TRUE), selected = default_flip_camera)),
column(6, numericInput("positioning_precision", "Positioning precision (m)", width = "100%", value = default_position_precision))
),
sliderInput("motion_blur", "Maximal motion blur (px)", min = 0.01, max = 1, step = 0.01, value = default_max_motion_blur, width = "100%")
sliderInput("motion_blur", "Maximal motion blur (px)", min = 0.01, max = 5, step = 0.01, value = default_max_motion_blur, width = "100%")
),
tabPanel("GCPs",
......@@ -189,6 +189,7 @@ ui_ <- fluidPage(
),
tabPanel("Map",
leafletOutput("waypoint_map", height = "600px"),
actionButton("recalc_waypoint_map", "Recalc waypoints"),
htmlOutput("waypoint_settings")),
tabPanel("GCP recover frequency",
plotOutput("plot_hits_gcp", height = "600px"))
......
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