Skip to content

GitLab

Commit c13bec1d authored by luroth's avatar luroth
Browse files

- better notifications with hints 

- bugfix if motion blur == 0
- mous overs added
- labels changed
parent f9e04a29
Hide whitespace changes
Inline Side-by-side
server.R
View file @ c13bec1d
......@@ -66,7 +66,7 @@ label_digits <- function(digits=0){
# Input validation for outputs
validate_inputs <- function(input) {
validate(
shiny::validate(
need(input$d_sensor_x>0, "Sensor size, width (mm) missing or invalid"),
need(input$d_sensor_x<=100, "Sensor size, width (mm) > 100"),
need(input$d_sensor_y>0, "Sensor size, height (mm) missing or invalid"),
......@@ -77,7 +77,7 @@ validate_inputs <- function(input) {
need(input$n_pix_y<=10000, "Number of recorded pixels in y (px) > 10'000"),
need(input$t_max>0, "Max. shutter speed (1/s) missing or invalid"),
need(input$ISO_max>0, "Max. film speed (ISO) missing or invalid"),
need(input$freq_max>0, "Max. recording freqency (1/s) missing or invalid"),
need(input$freq_max>0, "Max. image trigger freq. (1/s) missing or invalid"),
need(input$flight_max>0, "Max. flight time (min) missing or invalid"),
need(input$flight_max<120, "Max. flight time (min) > 120 min."),
need(input$f>0, "Focal length (mm) missing or invalid"),
......@@ -296,7 +296,11 @@ server_ <- function(input, output, session) {
shutter_speed_real <- as.numeric(shutter_speed_values[which.min(abs(1.0/as.numeric(shutter_speed_values) - shutter_speed)) - 1])
}
if(shutter_speed_old != shutter_speed_real) {
showNotification(type = "message", id = "ISO_too_high", paste0("The required ISO value (", iso, ") is higher than the maximum allowed ISO value (", input$ISO_max, "). To solve this, the shutter speed was reset from 1/", shutter_speed_old, " s to 1/", shutter_speed_real, " s"), duration = NULL)
showNotification(type = "message", id = "ISO_too_high", paste0("The required ISO value (", iso, ") is higher than the maximum allowed ISO value (", input$ISO_max, "). To solve this, the shutter speed was reset from 1/", shutter_speed_old, " s to 1/", shutter_speed_real, " s"), duration = NULL,
action = tags$div(tags$b("To allow higher shutter speed values, you may:"), tags$ul(
tags$li("Increase exposure (EV) value on ", actionLink("link_to_imaging_config", "Imaging tab")),
tags$li("Increase max. film speed (ISO) value on", actionLink("link_to_sensor_lens_config", "Sensor/Lens tab")))
))
}
updateSelectizeInput(session, "shutter_speed", selected = shutter_speed_real)
......@@ -389,7 +393,7 @@ server_ <- function(input, output, session) {
# Flight speed calculation
observe({
req(derived_values$field_of_view_x>0, derived_values$field_of_view_y>0, derived_values$f>0)
req(derived_values$ground_sampling_distance>0, input$motion_blur>0, derived_values$shutter_speed>0, derived_values$spacing_between_exposures>0,
req(derived_values$ground_sampling_distance>0, derived_values$shutter_speed>0, derived_values$spacing_between_exposures>0,
input$flight_max>0, input$freq_max>0,
input$mapping_area_x>0, derived_values$field_of_view_x>0, input$mapping_area_y>0, derived_values$field_of_view_y>0, derived_values$spacing_between_flight_lines>0)
......@@ -406,17 +410,34 @@ server_ <- function(input, output, session) {
min_flight_speed <- calc_flight_distance(input$mapping_area_x, derived_values$field_of_view_x, input$mapping_area_y, derived_values$field_of_view_y,
derived_values$spacing_between_flight_lines) / (input$flight_max* 60)
min_motion_blur <- round(calc_motion_blur(derived_values$ground_sampling_distance, min_flight_speed, derived_values$shutter_speed),2)
min_motion_blur <- ifelse(min_motion_blur > 0, min_motion_blur, 0.001)
updateSliderInput(session, "motion_blur", min=min_motion_blur, max=max_motion_blur)
if(max_motion_blur <= min_motion_blur) {
showNotification(type = "error", id="error_motion", paste0("No solution for motion blur range found. Increase maximum allowed flight time or reduce mapping area"), closeButton = TRUE, duration = NULL)
showNotification(type = "error", id="error_motion", paste0("No solution for motion blur range found."), closeButton = FALSE, duration = NULL,
action = tags$div(tags$b("To solve this:"), tags$ul(
tags$li("Reduce mapping area on ", actionLink("link_to_mapping_config", "Mapping tab"), " to reduce flight time"),
tags$li("Increase max. flight duration on ", actionLink("link_to_sensor_lens_config", "Sensor/Lens tab"), " to allow longer flight times"),
tags$li("Increase max. image trigger freq. on", actionLink("link_to_sensor_lens_config", "Sensor/Lens tab"), " to allow faster flight speed"),
tags$li("Increase flight height on ", actionLink("link_to_mapping_config", "Mapping tab"), " to allow a shorter flight"))
))
} else if(actual_motion_blur > max_motion_blur) {
showNotification(type = "message", id="warning_blur", paste0("The required image recording frequency (", req_image_recording_speed, " 1/s) is higher than the maximum allowed image recording frequency (", input$freq_max, " 1/s). To solve this, the motion blur value was reduced from ", actual_motion_blur, " to ", max_motion_blur), duration = NULL)
new_flight_speed <- calc_flight_speed(derived_values$ground_sampling_distance, max_motion_blur, derived_values$shutter_speed)
showNotification(type = "message", id="warning_blur", paste0("The required image trigger freq. (", round(req_image_recording_speed, 1), " 1/s) is higher than the maximum allowed image trigger freq. (", input$freq_max, " 1/s). To solve this, the motion blur value was reduced from ", actual_motion_blur, " to ", max_motion_blur,
" and therefore flight speed from ", round(derived_values$flight_speed,1), " m/s to ", round(new_flight_speed, 1), " m/s"), duration = NULL,
action = tags$div(tags$b("To allow higher motion blur values and therefore higher flight speed, you may:"), tags$ul(
tags$li("Increase max. image trigger freq. on", actionLink("link_to_sensor_lens_config", "Sensor/Lens tab")))
))
updateSliderInput(session, "motion_blur", value=max_motion_blur)
removeNotification(id="error_motion")
} else if(actual_motion_blur < min_motion_blur) {
showNotification(type = "message", id="warning_blur", paste0("The required flight duration (", req_flight_duration, " min) is higher than the maximum allowed flight duration (", input$flight_max, " min). To solve this, the motion blur value was increased from ", actual_motion_blur, " to ", min_motion_blur), duration = NULL)
showNotification(type = "message", id="warning_blur", paste0("The required flight duration (", req_flight_duration, " min) is higher than the maximum allowed flight duration (", input$flight_max, " min). To solve this, the motion blur value was increased from ", actual_motion_blur, " to ", min_motion_blur),
action = tags$div(tags$b("To allow lower motion blur values, you may:"), tags$ul(
tags$li("Increase shutter speed on ", actionLink("link_to_imaging_config", "Imaging tab")),
tags$li("Increase max. flight duration on", actionLink("link_to_sensor_lens_config", "Sensor/Lens tab")))
),
duration = NULL)
updateSliderInput(session, "motion_blur", value=min_motion_blur)
removeNotification(id="error_motion")
} else {
......@@ -429,6 +450,19 @@ server_ <- function(input, output, session) {
})
observeEvent(input$link_to_imaging_config, {
updateTabsetPanel(session, "config_tab", "Imaging")
})
observeEvent(input$link_to_sensor_lens_config, {
updateTabsetPanel(session, "config_tab", "Sensor/Lens")
})
observeEvent(input$link_to_mapping_config, {
updateTabsetPanel(session, "config_tab", "Mapping")
})
# Number of photos and positions calculation
......@@ -629,7 +663,7 @@ server_ <- function(input, output, session) {
req(derived_values$image_recording_speed, derived_values$flight_speed, derived_values$number_of_photos, derived_values$number_of_gcp, derived_values$flight_duration)
mapping_summary <- paste(
"<h4>Parameters</h4>",
"<b>Image recording speed:</b> ", round(derived_values$image_recording_speed,2), " images/s<br/>",
"<b>Image triggering frequency:</b> ", round(derived_values$image_recording_speed,2), " images/s<br/>",
"<b>Image triggering intervall:</b> ", round(1/derived_values$image_recording_speed,1), " s<br/>",
"<b>Flight speed:</b> ", round(derived_values$flight_speed,2), " m/s, ", round(derived_values$flight_speed * 3.6,1), " km/h<br/>",
"<b>Min. flight duration:</b> ", round(derived_values$flight_duration), " min<br/>",
......@@ -720,7 +754,7 @@ server_ <- function(input, output, session) {
number_of_lines = ceiling(input$mapping_area_x / derived_values$spacing_between_flight_lines) + 2 * overlap_lines + 1
if(number_of_lines > floor(input$max_number_of_wp / 2.0)) {
showNotification(type = "error", id="error_lines", paste0("Number of flight lines x2 exceeds maximum number of waypoints. No waypoint generation possible."), closeButton = TRUE, type = "error", duration = NULL)
showNotification(id="error_lines", paste0("Number of flight lines x2 exceeds maximum number of waypoints. No waypoint generation possible."), closeButton = FALSE, type = "error", duration = NULL)
} else {
removeNotification(id="error_lines")
}
......@@ -885,7 +919,7 @@ server_ <- function(input, output, session) {
plot1 <- ggplot(data=data.frame(gcp_counts = derived_values$hit_per_image), aes(x=gcp_counts)) +
geom_histogram(col="white", fill="lightgrey", binwidth = 1, aes(y=..count../sum(..count..))) +
scale_x_continuous("Number of visible GCPs on image", breaks= seq(0,max(derived_values$hit_per_image),1)) +
scale_y_continuous("Frequency of image class", limits = c(0,1), expand=c(0,0)) +
scale_y_continuous("Frequency of images with corresponding number of visible GCPs", limits = c(0,1), expand=c(0,0)) +
ggtheme_default
plot1
......@@ -1077,7 +1111,7 @@ server_ <- function(input, output, session) {
req(derived_values$number_of_photos, derived_values$flight_duration)
restrictions <- paste0(
"<b>Required image recording speed:</b> ", round(derived_values$image_recording_speed,2), " images/s<br/>",
"<b>Required image trigger frequency:</b> ", round(derived_values$image_recording_speed,2), " images/s<br/>",
"<b>Minimum number of photos:</b> ", derived_values$number_of_photos, "<br/>",
"<b>Estimated minimal flight duration:</b> ", round(derived_values$flight_duration), " min<br/>"
)
......@@ -1149,7 +1183,7 @@ server_ <- function(input, output, session) {
updateSelectizeInput(session, "shutter_speed", choices = shutter_speed_values[as.numeric(shutter_speed_values)<=input$t_max], selected=shutter_speed)
derived_values$shutter_speed <- shutter_speed
showNotification(type = "message", "New settings loaded")
showNotification(type = "default", "New settings loaded")
})
......
ui.R
View file @ c13bec1d
......@@ -19,6 +19,7 @@
library(shinycssloaders)
library(leaflet)
library(shinyBS)
# Default values
default_exposure_value <- 14
......@@ -90,25 +91,34 @@ ui_ <- fluidPage(
),
fluidRow(
column(6, numericInput("d_sensor_x", "Sensor size, x (mm)", width = "100%", value=default_d_sensor_x, step=0.1)),
column(6, numericInput("d_sensor_y", "Sensor size, y (mm)", width = "100%", value=default_d_sensor_y, step=0.1))
bsTooltip("d_sensor_x", "Physical size of sensor", placement = "bottom", trigger = "hover", options = NULL),
column(6, numericInput("d_sensor_y", "Sensor size, y (mm)", width = "100%", value=default_d_sensor_y, step=0.1)),
bsTooltip("d_sensor_y", "Physical size of sensor", placement = "bottom", trigger = "hover", options = NULL)
),
fluidRow(
column(6, numericInput("n_pix_x", "Number of recorded pixels, x (px)", width = "100%", value=default_n_pix_x, step=1)),
column(6, numericInput("n_pix_y", "Number of recorded pixels, y (px)", width = "100%", value=default_n_pix_y, step=1))
bsTooltip("n_pix_x", "Resolution of sensor in pixel", placement = "bottom", trigger = "hover", options = NULL),
column(6, numericInput("n_pix_y", "Number of recorded pixels, y (px)", width = "100%", value=default_n_pix_y, step=1)),
bsTooltip("n_pix_y", "Resolution of sensor in pixel", placement = "bottom", trigger = "hover", options = NULL)
),
fluidRow(
column(6, numericInput("t_max", "Max. shutter speed (1/s)", width = "100%", value=default_t_max, step=1000)),
column(6, numericInput("ISO_max", "Max. film speed (ISO)", width = "100%", value=default_ISO_max, step=1000))
bsTooltip("t_max", "Maximum shutter speed capability of the sensor (mechanical or electronic).", placement = "bottom", trigger = "hover", options = NULL),
column(6, numericInput("ISO_max", "Max. film speed (ISO)", width = "100%", value=default_ISO_max, step=1000)),
bsTooltip("ISO_max", "Maximum tolerable ISO setting of the sensor, determined by the maximum tolerable signal-to-noise ratio in the final product.", placement = "bottom", trigger = "hover", options = NULL)
),
fluidRow(
column(6, numericInput("freq_max", "Max. image trigger freq. (1/s)", width = "100%", value=default_freq_max)),
column(6, numericInput("flight_max", "Max. flight duration (min)", width = "100%", value=default_flight_max))
bsTooltip("freq_max", "Maximum number of images the sensor can capture in one second. In most cases determined by the maxium writing speed of the storage medium.", placement = "bottom", trigger = "hover", options = NULL),
column(6, numericInput("flight_max", "Max. flight duration (min)", width = "100%", value=default_flight_max)),
bsTooltip("flight_max", "Maximum flight time capability of the drone that carries the sensor.", placement = "bottom", trigger = "hover", options = NULL)
),
htmlOutput("d_pix_output"),
hr(),
h4("Lens"),
fluidRow(
column(6, numericInput("f", "Focal length (mm)", width = "100%", value=default_focal_lenght, step=1)),
bsTooltip("f", "Physical focal length (not 35 mm equivalent).", placement = "bottom", trigger = "hover", options = NULL),
column(6, selectInput("aperture", "Aperture (f-number)", width = "100%", choices = aperture_values, selected=default_lens_aperture))
)
),
......@@ -123,6 +133,7 @@ ui_ <- fluidPage(
hr(),
h4("Exposure"),
sliderInput("exposure_value", "Exposure value (EV)", min = 1, max = 21, step = 1, value = default_exposure_value),
bsTooltip("exposure_value", "Value describing the illumination condition of the scene, and/or a certain shutter speed, ISO and aperture combination", placement = "bottom", trigger = "hover", options = NULL),
hr(),
fluidRow(
column(6, selectizeInput("shutter_speed", "Shutter speed (s)", selected = default_shutter_speed, choices = default_shutter_speed, width = "100%")),
......@@ -135,26 +146,35 @@ ui_ <- fluidPage(
h4("Mapping area"),
fluidRow(
column(6, numericInput("mapping_area_x", "Mapping area, width (m)", width = "100%", value = default_mapping_area_x, step=1)),
column(6, numericInput("mapping_area_y","Mapping area, depth (m)", width = "100%", value = default_mapping_area_y, step=1))
bsTooltip("mapping_area_x", "Size of whole mapping area", placement = "bottom", trigger = "hover", options = NULL),
column(6, numericInput("mapping_area_y","Mapping area, depth (m)", width = "100%", value = default_mapping_area_y, step=1)),
bsTooltip("mapping_area_y", "Size of whole mapping area", placement = "bottom", trigger = "hover", options = NULL)
),
fluidRow(
column(6, numericInput("plot_size_x", "Plot size, width (m)", width = "100%", value = default_plot_size_x, step=0.1)),
column(6, numericInput("plot_size_y","Plot size, depth (m)", width = "100%", value = default_plot_size_y, step=0.1))
column(6, numericInput("plot_size_x", "Single plot size, width (m)", width = "100%", value = default_plot_size_x, step=0.1)),
bsTooltip("plot_size_x", "Size of individual experimental plots", placement = "bottom", trigger = "hover", options = NULL),
column(6, numericInput("plot_size_y","Single plot size, depth (m)", width = "100%", value = default_plot_size_y, step=0.1)),
bsTooltip("plot_size_y", "Size of individual experimental plots", placement = "bottom", trigger = "hover", options = NULL)
),
hr(),
h4("Flight path"),
checkboxInput("edit_spacing", "metric"),
fluidRow(
column(6, numericInput("side_lap", "Side lap (%)", width = "100%", value = default_side_lap)),
column(6, numericInput("end_lap", "End lap (%)", width = "100%", value = default_end_lap))
bsTooltip("side_lap", "Image overlap between flight lines", placement = "bottom", trigger = "hover", options = NULL),
column(6, numericInput("end_lap", "End lap (%)", width = "100%", value = default_end_lap)),
bsTooltip("end_lap", "Image overlap in flight direction", placement = "bottom", trigger = "hover", options = NULL)
),
fluidRow(
column(6, numericInput("spacing_between_flight_lines", "Side lap (m)", width = "100%", value=NA)),
column(6, numericInput("spacing_between_exposures", "End lap (m)", width = "100%", value=NA))
bsTooltip("spacing_between_flight_lines", "Image overlap between flight lines", placement = "bottom", trigger = "hover", options = NULL),
column(6, numericInput("spacing_between_exposures", "End lap (m)", width = "100%", value=NA)),
bsTooltip("spacing_between_exposures", "Image overlap in flight direction", placement = "bottom", trigger = "hover", options = NULL)
),
fluidRow(
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))
column(6, numericInput("positioning_precision", "Positioning precision (m)", width = "100%", value = default_position_precision)),
bsTooltip("positioning_precision", "Standard deviation of positioning precision of the drone for way-point flights", placement = "bottom", trigger = "hover", options = NULL)
),
sliderInput("motion_blur", "Max. motion blur (px)", min = 0.01, max = 5, step = 0.01, value = default_max_motion_blur, width = "100%"),
HTML("<b>Hint:</b> Try increasing shutter speed if the minimum motion blur value is too high.")
......@@ -194,7 +214,8 @@ ui_ <- fluidPage(
column(6, numericInput("position_start_long","Start location (Longitude)", width = "100%", value = default_starting_point_long))
),
hr(),
numericInput("max_number_of_wp", "Maximum number of waypoints", width = "100%", value = default_max_number_of_wp)
numericInput("max_number_of_wp", "Maximum number of waypoints", width = "100%", value = default_max_number_of_wp),
bsTooltip("max_number_of_wp", "Maximum number of waypoints the drone is able to handle for way-point flights (e.g. 99 for DJI systems)", placement = "bottom", trigger = "hover", options = NULL)
)
),
......
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