Commit f9e04a29 authored by luroth's avatar luroth
Browse files

- diffraction limit calculation added

- restrictions for max sensor size, number of pixels, flight height, f, etc.
- link to project page added in ui
parent fa92b87b
......@@ -121,6 +121,17 @@ calc_flight_duration <- function(distance_area_x, ground_field_of_view_x, distan
return(duration)
}
calc_diffraction_limit <- function(aperture, color) {
if(color=="R") {
wavelenght <- 700 * 10 ^(-9)
} else if (color == "G") {
wavelenght <- 530 * 10 ^(-9)
} else if (color == "B") {
wavelenght <- 470 * 10 ^(-9)
}
return(2 * 1.22 * aperture * wavelenght)
}
calc_pixel_freq <- function(plot_size, spacing, no_of_lanes, position_precision_sd, n_pix, ground_sampling_distance, use_uniform=FALSE) {
# Initialize sensor axis
......
......@@ -68,23 +68,32 @@ label_digits <- function(digits=0){
validate_inputs <- function(input) {
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"),
need(input$d_sensor_y<=100, "Sensor size, height (mm) > 100"),
need(input$n_pix_x>0, "Number of recorded pixels in x (px) missing or invalid"),
need(input$n_pix_x<=10000, "Number of recorded pixels in x (px) > 10'000"),
need(input$n_pix_y>0, "Number of recorded pixels in y (px) missing or invalid"),
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$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"),
need(input$f<=100, "Focal length (mm) > 100"),
need(input$aperture>0, "Aperture (f-number) missing or invalid"),
need(input$flight_height>0, "Flight height (m) missing or invalid"),
need(input$flight_height<=150, "Flight height (m) > 150 m"),
need(input$ground_sampling_distance>0, "Ground sampling distance nadir (mm) missing or invalid"),
need(input$shutter_speed>0, "Shutter speed (s) missing or invalid"),
need(input$iso>0, "Film speed (ISO) missing or invalid"),
need(input$mapping_area_x>0, "Mapping area width (m) missing or invalid"),
need(input$mapping_area_y>0, "Mapping area depth (m) missing or invalid"),
need(input$plot_size_x>0, "Plot size width (m) missing or invalid"),
need(input$plot_size_y>0, "Plot size depth (m) missing or invalid"),
need(input$mapping_area_x<=500, "Mapping area width (m) > 500 m"),
need(input$mapping_area_y<=500, "Mapping area depth (m) > 500g m"),
need(input$plot_size_x>0.2, "Plot size width (m) missing or invalid"),
need(input$plot_size_y>0.2, "Plot size depth (m) missing or invalid"),
need(input$side_lap>0, "Side lap (%) missing or invalid"),
need(input$end_lap>0, "End lap (%) missing or invalid"),
need(input$spacing_between_flight_lines>0, "Side lap (m) missing or invalid"),
......@@ -92,7 +101,9 @@ validate_inputs <- function(input) {
need(input$positioning_precision>0, "Positioning precision (m) missing or invalid"),
need(input$motion_blur>0, "Maximal motion blur (px) missing or invalid"),
need(input$gcp_n_in_x>0, "Number of GCP along mapping area width missing or invalid"),
need(input$gcp_n_in_x<=20, "Number of GCP along mapping area width > 20"),
need(input$gcp_n_in_y>0, "Number of GCP along mapping area depth missing or invalid"),
need(input$gcp_n_in_y<=20, "Number of GCP along mapping area depth > 20"),
need(input$position_edge1_lat, "Field edge (Latitude) missing"),
need(input$position_edge1_long, "Field edge (Longitude) missing"),
need(input$position_edge2_lat, "Flight direction (Latitude) missing"),
......@@ -133,7 +144,7 @@ server_ <- function(input, output, session) {
# Shutter speed max (update select input max value)
observe({
req(isTruthy(input$t_max))
updateSelectizeInput(session, "shutter_speed", choices = shutter_speed_values[as.numeric(shutter_speed_values)<=input$t_max], selected=1000)
updateSelectizeInput(session, "shutter_speed", choices = shutter_speed_values[as.numeric(shutter_speed_values)<=input$t_max], selected=16000)
})
# Focal lenght (debounced)
......@@ -188,6 +199,28 @@ server_ <- function(input, output, session) {
derived_values$hyperfocal_distance <- NA
}
})
# Diffraction limit
observe({
if(isTruthy(c(derived_values$aperture, derived_values$circle_of_confusion))) {
derived_values$diffraction_red <- ifelse(
calc_diffraction_limit(derived_values$aperture, "R") > derived_values$circle_of_confusion,
paste("R (700 nm):", round(calc_diffraction_limit(derived_values$aperture, "R")/derived_values$circle_of_confusion, 2), " * circle of conf."),
"R (700 nm): no")
derived_values$diffraction_green <- ifelse(
calc_diffraction_limit(derived_values$aperture, "G") > derived_values$circle_of_confusion,
paste("G (530 nm):", round(calc_diffraction_limit(derived_values$aperture, "G")/derived_values$circle_of_confusion, 2), " * circle of conf."),
"G (530 nm): no")
derived_values$diffraction_blue <- ifelse(
calc_diffraction_limit(derived_values$aperture, "B") > derived_values$circle_of_confusion,
paste("B (470 nm):", round(calc_diffraction_limit(derived_values$aperture, "B")/derived_values$circle_of_confusion, 2), " * circle of conf."),
"B (470 nm): no")
} else {
derived_values$diffraction_red <- NA
derived_values$diffraction_green <- NA
derived_values$diffraction_blue <- NA
}
})
###################
### Imaging
......@@ -206,6 +239,15 @@ server_ <- function(input, output, session) {
observe({
if(input$edit_ground_sampling_distance) {
flight_height <- round(calc_flight_height(derived_values$ground_sampling_distance, derived_values$d_sensor_x, input$n_pix_x, derived_values$f))
if(flight_height>=150){
flight_height_old <- flight_height
flight_height <- 150
ground_sampling_distance <- round(calc_ground_sampling_distance(flight_height, derived_values$d_sensor_x, input$n_pix_x, derived_values$f), 5)
derived_values$ground_sampling_distance <- ground_sampling_distance
updateTextInput(session, "ground_sampling_distance", value = ground_sampling_distance*1000)
showNotification(type = "message", id = "flight_height_max", paste0("The required flight height (", flight_height_old, " m) is higher than the maximum allowed value of 150 m. To solve this, the flight height was reset to 150 m and the ground sampling distance to ", ground_sampling_distance," m."), duration = NULL)
}
derived_values$flight_height <- flight_height
updateTextInput(session, "flight_height", value = derived_values$flight_height)
} else {
......@@ -242,16 +284,20 @@ server_ <- function(input, output, session) {
observe({
req(input$exposure_value>0, derived_values$aperture>0, input$shutter_speed>0, input$ISO_max>0)
shutter_speed <- as.numeric(input$shutter_speed)
iso_old <- input$iso
# calc ISO
iso <- signif(calc_iso(input$exposure_value, derived_values$aperture, shutter_speed), 4)
if(iso >= input$ISO_max) {
iso <- input$ISO_max
if(iso > input$ISO_max) {
#iso <- input$ISO_max
shutter_speed_old <- shutter_speed
shutter_speed <- calc_shutter_speed(input$exposure_value, derived_values$aperture, input$ISO_max)
shutter_speed_real <- as.numeric(shutter_speed_values[which.min(abs(1.0/as.numeric(shutter_speed_values) - shutter_speed))])
if((1.0/shutter_speed_real) > shutter_speed) {
shutter_speed_real <- as.numeric(shutter_speed_values[which.min(abs(1.0/as.numeric(shutter_speed_values) - shutter_speed)) - 1])
}
showNotification(paste0("The calculated ISO value (", iso, ") is higher than the maximum allowed ISO value (", input$ISO_max, "). The shutter speed was reset to ", shutter_speed_real))
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)
}
updateSelectizeInput(session, "shutter_speed", selected = shutter_speed_real)
updateTextInput(session, "iso", value = iso)
......@@ -364,13 +410,13 @@ 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. Increase maximum allowed flight time or reduce mapping area"), closeButton = TRUE, type = "error", duration = NULL)
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)
} 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))
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)
updateSliderInput(session, "motion_blur", value=max_motion_blur)
removeNotification(id="error_motion")
} else if(actual_motion_blur < min_motion_blur) {
showNotification(id="warning_blur_too_big", paste("The required flight duration is higher than the maximum allowed flight duration (", input$flight_max, "). The motion blur was value was increased from ", actual_motion_blur, " to ", 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)
updateSliderInput(session, "motion_blur", value=min_motion_blur)
removeNotification(id="error_motion")
} else {
......@@ -562,6 +608,7 @@ server_ <- function(input, output, session) {
lens_angle_of_view <- paste0("<h4>Lens intrinsic parameters</h4>",
"<b>Angle of view:</b><br/>horizontally: ", round(derived_values$angle_of_view_x *(180/pi), 1), "°<br/>vertically: ", round(derived_values$angle_of_view_y *(180/pi), 1), "°<br />",
"<b>Hyperfocal distance:</b><br/> ", round(derived_values$hyperfocal_distance,1), " m<br />",
"<b>Diffraction limited:</b><br/>", derived_values$diffraction_red, "<br/>", derived_values$diffraction_green, "<br/>", derived_values$diffraction_blue, "<br />",
"<h4>Dependant parameters</h4>",
"<b>Ground field of view:</b><br/>horizontally: ", round(derived_values$field_of_view_x_sensor,1), " m<br/>vertically: ", round(derived_values$field_of_view_y_sensor,1), " m<br/>",
"<b>Focus distance:</b><br/>", round(derived_values$focus_distance,1), " m<br />",
......@@ -673,7 +720,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(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(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)
} else {
removeNotification(id="error_lines")
}
......@@ -1077,7 +1124,7 @@ server_ <- function(input, output, session) {
output$download_params <- downloadHandler(
filename = function() {
return(paste('parameters-', Sys.Date(), '.json', sep=''))
return(paste(input$project_name, Sys.Date(), '.json', sep=''))
},
content = function(con) {
writeLines(toJSON(list(input=reactiveValuesToList(input), derived=reactiveValuesToList(derived_values))), con)
......@@ -1102,7 +1149,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("New settings loaded", type="warning")
showNotification(type = "message", "New settings loaded")
})
......
......@@ -63,11 +63,25 @@ ui_ <- fluidPage(
shinyjs::useShinyjs(),
titlePanel(windowTitle="PheonyFly Planning Tool",
title=div(img(src="CSLogo_black_40.png"), HTML("Pheno<b>Fly Planning Tool</b>"))),
title=div(
fluidRow(
column(4, img(src="CSLogo_black_40.png"), HTML("Pheno<b>Fly Planning Tool</b>"),
tags$style(".shiny-file-input-progress {display: none}")),
column(3, textInput("project_name", NULL, value= "Enter project name", width='100%')),
column(2, downloadButton("download_params", "Save project", width='100%')),
column(3, fileInput("settings", label=NULL, buttonLabel="Open project", placeholder ="None", width='600%',
multiple = FALSE,
accept = c("text/json",
".json"))),
tags$style(type='text/css', "#download_params { width:100%; margin-top: -6px;}")
))
),
sidebarLayout(
sidebarPanel(
tabsetPanel(id="config_tab",
tabPanel("Sensor/Lens",
h4("Sensor"),
......@@ -87,7 +101,7 @@ ui_ <- fluidPage(
column(6, numericInput("ISO_max", "Max. film speed (ISO)", width = "100%", value=default_ISO_max, step=1000))
),
fluidRow(
column(6, numericInput("freq_max", "Max. image trigger frequency (1/s)", width = "100%", value=default_freq_max)),
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))
),
htmlOutput("d_pix_output"),
......@@ -142,7 +156,8 @@ 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", "Max. motion blur (px)", min = 0.01, max = 5, step = 0.01, value = default_max_motion_blur, width = "100%")
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.")
),
tabPanel("GCPs",
......@@ -191,10 +206,13 @@ ui_ <- fluidPage(
tags$a("http://www.kp.ethz.ch", href="http://www.kp.ethz.ch/infrastructure/uav-phenofly.html", target="_blank"),
HTML(")"),
HTML("<br />Lukas Roth ( lukas.roth@usys.ethz.ch )<br />"),
HTML("(c) 2018 - "), tags$a("GPL-3.0", href="https://www.gnu.org/licenses", target="_blank")
HTML("(c) 2018 - "), tags$a("GPL-3.0", href="https://www.gnu.org/licenses", target="_blank"),
HTML("<br />"),
tags$a("http://phenofly.net/PhenoFlyPlanningTool", href="http://phenofly.net/PhenoFlyPlanningTool", target="_blank")
)),
mainPanel(
tabsetPanel(id="results",
tabPanel("Photography",
fluidRow(
......@@ -254,25 +272,16 @@ ui_ <- fluidPage(
),
column(7,
leafletOutput("mission_waypoint_map", height=400) )
)
),
tabPanel("Load/Save",
h4("App settings"),
div(downloadButton("download_params", "Download as JSON")),
div(fileInput("settings", label="", buttonLabel="Open from JSON",
multiple = FALSE,
accept = c("text/json",
".json"))),
hr(),
h4("Waypoints"),
div(downloadButton("download_waypoints", "Download waypoints as CSV"), HTML("(e.g. to import in Litchi)")),
p(),
div(downloadButton("download_kml", "Download mapping area as KML"), HTML("(e.g. to import in DJI GS Pro)")),
hr(),
h4("Report"),
div(downloadButton("download_report", "Download all graphs as PDF"))
)
)
),
hr(),
h4("Waypoints"),
div(downloadButton("download_waypoints", "Download waypoints as CSV"), HTML("(e.g. to import in Litchi)")),
p(),
div(downloadButton("download_kml", "Download mapping area as KML"), HTML("(e.g. to import in DJI GS Pro)")),
hr(),
h4("Report"),
div(downloadButton("download_report", "Download all graphs as PDF"))
))
)
)
)
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