Commit 18ddc0c4 authored by luroth's avatar luroth
Browse files

Flight height dependency graph changed to show depth of view dependency on...

Flight height dependency graph changed to show depth of view dependency on flight height / ground sampling distance
parent 4617525d
......@@ -25,6 +25,10 @@ calc_flight_height <- function(ifov, size, sensor_recorded_pixels, focal_length)
return(ifov / (size/sensor_recorded_pixels) *focal_length)
}
calc_flight_height_mm <- function(ifov_mm, size, sensor_recorded_pixels, focal_length) {
return((ifov_mm/1000) / (size/sensor_recorded_pixels) *focal_length)
}
calc_hyperfocal_distance <- function(focal_length, aperture, circle_of_confusion) {
return((focal_length^2)/(aperture*circle_of_confusion) + focal_length)
}
......@@ -47,8 +51,7 @@ calc_depth_of_field_near <- function(focal_length, aperture, circle_of_confusion
calc_depth_of_field_far <- function(focal_length, aperture, circle_of_confusion, object_distance) {
hyperfocal_distance <- calc_hyperfocal_distance(focal_length, aperture, circle_of_confusion)
if(object_distance <= hyperfocal_distance) {return(object_distance / ( (focal_length - object_distance) / (hyperfocal_distance - focal_length) + 1))}
else {return(Inf)}
return(ifelse(object_distance <= hyperfocal_distance, (object_distance / ( (focal_length - object_distance) / (hyperfocal_distance - focal_length) + 1)), Inf))
}
calc_exposure_value <- function(aperture, shutter_speed, iso=100) {
......
......@@ -262,7 +262,7 @@ server_ <- function(input, output, session) {
observe({
req(reactive_values$circle_of_confusion)
output_html <- paste0("<b>Pixel size / circle of confusion: </b>", round(reactive_values$circle_of_confusion *1000, 4), " mm"
output_html <- paste0("<b>Distance between pixel centers / circle of confusion: </b>", round(reactive_values$circle_of_confusion *1000, 4), " mm"
)
output$pixel_size <- renderUI(HTML(output_html))
})
......@@ -275,45 +275,77 @@ server_ <- function(input, output, session) {
"<h4>Dependant parameters</h4>",
"<b>Ground field of view:</b><br/>horizontally: ", round(reactive_values$field_of_view_x_true,1), " m<br/>vertically: ", round(reactive_values$field_of_view_y_true,1), " m<br/>",
"<b>Focus distance:</b><br/>", round(reactive_values$focus_distance,1), " m<br />",
"<b>Depth of field:</b><br/>near: ", round(reactive_values$depth_of_field_near,1), " m<br/>far: ", round(reactive_values$depth_of_field_far, 1), " m<br />"
"<b>Depth of field in relation to ground:</b><br/>near: ", round(reactive_values$flight_height- reactive_values$depth_of_field_near,1), " m<br/>far: ", round(reactive_values$flight_height - reactive_values$depth_of_field_far, 1), " m<br />"
)
output$lens_angle_of_view <- renderUI(HTML(lens_angle_of_view))
})
observe({
req(reactive_values$flight_height, reactive_values$ground_resolution_nadir, reactive_values$aperture, reactive_values$hyperfocal_distance, reactive_values$depth_of_field_near, reactive_values$hyperfocal_distance, reactive_values$depth_of_field_far)
optics_legend <- paste0(
"<b>Legend</b><br />",
"Camera position: triangle<br/>",
"Selected flight height: black dashed horizontal line<br/>",
"Flight height: black solid line<br/>",
"Focus distance: dark red dashed/dotted horizontal line<br/>",
"Selected flight height: black dashed horizontal line<br/>",
"Resulting ground sampling distance: black dashed vertical line<br/>",
"Depth of field: grey box")
"Depth of field: grey lines")
output$optics_legend <- renderUI(HTML(optics_legend))
})
output$flight_height_v_IFOV <- renderPlot({
ifov_plot <- reactive({
req(reactive_values$size_x, reactive_values$recorded_pixels_x, reactive_values$focal_length, reactive_values$depth_of_field_near, reactive_values$depth_of_field_far,
reactive_values$focus_distance, reactive_values$depth_of_field_near, reactive_values$depth_of_field_far)
args <- list(size = reactive_values$size_x, sensor_recorded_pixels=reactive_values$recorded_pixels_x, focal_length=reactive_values$focal_length)
plot <- ggplot(data.frame(x = c(0, 100)), aes(x)) +
annotate("rect", xmin= reactive_values$flight_height - reactive_values$depth_of_field_near, xmax= 0, ymin=-Inf, ymax=Inf, fill="lightgrey") +
stat_function(fun=calc_IFOV_mm, args = args) +
scale_x_continuous("Flight height (m)", expand = c(0,0), breaks = seq(-0, 100, 10)) +
scale_y_continuous("Ground sampling distance (mm)", labels=label_digits(2), limits=c(0, calc_IFOV_mm(150, size = reactive_values$size_x, sensor_recorded_pixels=reactive_values$recorded_pixels_x, focal_length=reactive_values$focal_length)), expand = c(0,0)) +
plot <- ggplot(data.frame(y = c(0, 100)), aes(y)) +
stat_function(fun=calc_flight_height_mm, args = args) +
annotate("rect", xmin=0, xmax=Inf, ymin=-Inf, ymax=0, fill="lightgrey") +
scale_y_continuous("Distance to ground (m)", expand = c(0,0), limits=c(-20,100), breaks = seq(-0, 100, 10), sec.axis = sec_axis(~reactive_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(0, calc_IFOV_mm(102, size = reactive_values$size_x, sensor_recorded_pixels=reactive_values$recorded_pixels_x, focal_length=reactive_values$focal_length)), expand = c(0,0)) +
ggtheme
plot <- plot + geom_vline(xintercept = reactive_values$flight_height- reactive_values$focus_distance, color="darkred", linetype=10)
plot <- plot + geom_vline(xintercept = 0, color="darkgreen")
plot <- plot + geom_hline(yintercept = reactive_values$ground_resolution_nadir*1000, linetype=2)
plot <- plot + geom_vline(xintercept = reactive_values$flight_height, linetype=2)
plot <- plot + annotate("point", x=reactive_values$flight_height-3, y=reactive_values$ground_resolution_nadir*1000, shape=24, size=10)
plot <- plot + geom_vline(xintercept = reactive_values$ground_resolution_nadir*1000, linetype=2)
plot <- plot + geom_hline(yintercept = reactive_values$flight_height, linetype=2)
plot <- plot + annotate("point", y=reactive_values$flight_height, x=reactive_values$ground_resolution_nadir*1000, shape=17, size=8)
args <- list(focal_length = reactive_values$focal_length, aperture=reactive_values$aperture, circle_of_confusion=reactive_values$circle_of_confusion, size =reactive_values$size_x, sensor_recorded_pixels = reactive_values$recorded_pixels_x)
calc_focus_distance_ <- function(ifov_mm, focal_length, aperture, circle_of_confusion, size, sensor_recorded_pixels) {
flight_height <- calc_flight_height_mm(ifov_mm, size, sensor_recorded_pixels, focal_length)
return(flight_height- calc_focal_dist(focal_length, aperture, circle_of_confusion, flight_height))
}
plot <- plot + stat_function(fun=calc_focus_distance_, args = args, color="darkred", linetype=10)
args <- list(focal_length = reactive_values$focal_length, aperture=reactive_values$aperture, circle_of_confusion=reactive_values$circle_of_confusion, size =reactive_values$size_x, sensor_recorded_pixels = reactive_values$recorded_pixels_x)
calc_depth_of_field_near_ <- function(ifov_mm, focal_length, aperture, circle_of_confusion, size, sensor_recorded_pixels) {
flight_height <- calc_flight_height_mm(ifov_mm, size, sensor_recorded_pixels, focal_length)
return(flight_height- calc_depth_of_field_near(focal_length, aperture, circle_of_confusion, calc_focal_dist(focal_length, aperture, circle_of_confusion, flight_height)))
}
plot <- plot + stat_function(fun=calc_depth_of_field_near_, args = args, color="darkgrey", linetype=1, size=1)
calc_depth_of_field_far_ <- function(ifov_mm, focal_length, aperture, circle_of_confusion, size, sensor_recorded_pixels) {
flight_height <- calc_flight_height_mm(ifov_mm, size, sensor_recorded_pixels, focal_length)
return(flight_height- calc_depth_of_field_far(focal_length, aperture, circle_of_confusion, calc_focal_dist(focal_length, aperture, circle_of_confusion, flight_height)))
}
plot <- plot + stat_function(fun=calc_depth_of_field_far_, args = args, color="darkgrey", linetype=1, size=1)
plot + coord_flip()
plot <- plot + geom_hline(yintercept = 0, color="darkgreen", size=1.5)
plot
})
output$flight_height_v_IFOV <- renderPlot({
ifov_plot()
})
output$download_photo_props <- downloadHandler(
filename = function() { paste(input$dataset, '.pdf', sep='') },
content = function(file) {
ggsave(file, plot = ifov_plot(), device = "pdf")
}
)
#####################
......
......@@ -167,7 +167,7 @@ ui_ = fluidPage(
tabsetPanel(id="results",
tabPanel("Photographic properties",
fluidRow(
column(8, h4("Flight height dependency"), plotOutput("flight_height_v_IFOV", height = "600px"), htmlOutput("optics_legend")),
column(8, h4("Flight height dependency"), plotOutput("flight_height_v_IFOV", height = "600px"), downloadButton("download_photo_props"), htmlOutput("optics_legend")),
column(4, htmlOutput("lens_angle_of_view"))
)
......
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