Commit ce95040a authored by luroth's avatar luroth
Browse files

Automatic GCP placement extension

parent 12611ff1
......@@ -184,7 +184,13 @@ calc_gcp_positions <- function(mapping_area_x, mapping_area_y, gcp_n_in_x, gcp_n
return(gcp)
}
calc_gcp_recover_frequency <- function(mapping_area_x, mapping_area_y, gcp_n_in_x, gcp_n_in_y, gcp_arrangement_pattern, field_of_view_x, field_of_view_y, photo_positions) {
calc_gcp_recover_frequency <- function(mapping_area_x, mapping_area_y, gcp_n_in_x, gcp_n_in_y, gcp_arrangement_pattern, field_of_view_x, field_of_view_y, photo_positions, gcp_frequency_base) {
# Restrict photo positions if mapping area only
if(gcp_frequency_base=="inline") {
photo_positions <- photo_positions[photo_positions$x>=0 & photo_positions$x<=mapping_area_x & photo_positions$y>=0 & photo_positions$y <= mapping_area_y,]
}
gcp <- calc_gcp_positions(mapping_area_x, mapping_area_y, gcp_n_in_x, gcp_n_in_y, gcp_arrangement_pattern)
gcp_x_min <- gcp[,1] - field_of_view_x/2
gcp_x_max <- gcp[,1] + field_of_view_x/2
......@@ -210,26 +216,50 @@ calc_gcp_recover_frequency <- function(mapping_area_x, mapping_area_y, gcp_n_in_
hit_per_image <- rowSums(counts)
hist_ <- hist(hit_per_image, breaks=seq(from=0, to=max(hit_per_image), by = 1), plot=FALSE)
hist_ <- hist(hit_per_image, breaks=seq(from=-0.5, to=max(hit_per_image) + 0.5, by = 1), plot=TRUE, freq=FALSE, right=FALSE)
return(list(gcp, hit_per_gcp, hit_per_image, hist_))
}
opt_gcp_recover_frequency <- function(gcp_n_in_x, gcp_rec_number, gcp_rec_frequency, mapping_area_x, mapping_area_y, gcp_arrangement_pattern, field_of_view_x, field_of_view_y, photo_positions) {
opt_gcp_recover_frequency <- function(gcp_n_in_x, gcp_rec_number, gcp_rec_frequency, mapping_area_x, mapping_area_y, gcp_arrangement_pattern, field_of_view_x, field_of_view_y, photo_positions, gcp_frequency_base) {
diff_to_int <- gcp_n_in_x %% 1
gcp_n_in_x <- round(gcp_n_in_x)
gcp_n_in_y <- ceiling(mapping_area_y / (mapping_area_x / gcp_n_in_x))
gcp_n_in_y <- calc_gcp_in_y(gcp_n_in_x, mapping_area_x, mapping_area_y, gcp_arrangement_pattern)
# Penalty
penalty <- 0
# Caluclate difference to requested frequency
freq <- calc_gcp_recover_frequency(mapping_area_x, mapping_area_y, gcp_n_in_x, gcp_n_in_y, gcp_arrangement_pattern, field_of_view_x, field_of_view_y, photo_positions)
sum_dens <- do.call(sum, tail(as.list(freq[[4]]$density), -gcp_rec_number))
diff_freq <- sum_dens - (gcp_rec_frequency/100)
freq <- calc_gcp_recover_frequency(mapping_area_x, mapping_area_y, gcp_n_in_x, gcp_n_in_y, gcp_arrangement_pattern, field_of_view_x, field_of_view_y, photo_positions, gcp_frequency_base)
# Penaltize for odd numbers and too high bins
score <- abs(diff_freq) + diff_to_int/100
actual_freq <- do.call(sum, tail(as.list(freq[[4]]$density), -(gcp_rec_number)))
diff_freq <- actual_freq - (gcp_rec_frequency/100)
# Hardly henalize too low frequency (they represent a NoGo!)
if(diff_freq < 0) {
penalty <- penalty + abs(diff_freq) * 100
}
# Penaltize for too high recover frequencies
gcp_rec_number <- ifelse((gcp_rec_number +1) >= length(freq[[4]]$density), length(freq[[4]]$density)-1, gcp_rec_number)
return(score)
too_high_freq <- abs(freq[[4]]$density[[gcp_rec_number+1]] - (gcp_rec_frequency/100))
penalty <- penalty + too_high_freq
too_high_freq_bins <- do.call(sum, tail(as.list(freq[[4]]$density), -(gcp_rec_number + 1)))
too_high_freq_sqrt <- sqrt(too_high_freq_bins)
penalty <- penalty + too_high_freq_sqrt
freq_penalized <- abs(diff_freq) + penalty
return(freq_penalized)
}
calc_gcp_in_y <- function(gcp_n_in_x, mapping_area_x, mapping_area_y, gcp_arrangement_pattern) {
if(gcp_arrangement_pattern == "quad") {
gcp_n_in_y <- round(mapping_area_y / (mapping_area_x / gcp_n_in_x))
} else {
gcp_n_in_y <- round((mapping_area_y / (mapping_area_x / gcp_n_in_x))/2)
}
}
long2UTM <- function(long) {
......
import subprocess
subprocess.call("/usr/bin/Rscript --slave --no-restore -e \"shiny::runApp('/home/luroth/PycharmProjects/PhenoFlyPlanningTool/app.R',launch.browser=TRUE)\"", shell=True)
......@@ -10,7 +10,7 @@
"position_edge2_lat": 47.451,
"exposure_value": 14,
"positioning_precision": 3,
"gcp_arrangement_pattern": "quad",
"gcp_arrangement_pattern": "skip",
"position_edge2_long": 8.6821,
"side_lap": 60,
"end_lap": 80,
......
......@@ -30,6 +30,8 @@ library(raster)
library(grid)
library(dplyr)
library(NMOF)
source("./functions.R")
......@@ -592,42 +594,49 @@ server_ <- function(input, output, session) {
req(input$gcp_rec_frequency, input$gcp_rec_number)
if(input$edit_gcp_arrangement) {
req(input$gcp_n_in_x>0, input$gcp_n_in_y>0)
values <- calc_gcp_recover_frequency(input$mapping_area_x, input$mapping_area_y, input$gcp_n_in_x, input$gcp_n_in_y,
input$gcp_arrangement_pattern, derived_values$field_of_view_x, derived_values$field_of_view_y, derived_values$photo_positions)
input$gcp_arrangement_pattern, derived_values$field_of_view_x, derived_values$field_of_view_y, derived_values$photo_positions, input$gcp_frequency_base)
derived_values$gcp <- values[[1]]
derived_values$hit_per_gcp <- values[[2]]
derived_values$hit_per_image <- values[[3]]
} else {
sr <- optimize(opt_gcp_recover_frequency, 1:20,
input$gcp_rec_number, input$gcp_rec_frequency, input$mapping_area_x, input$mapping_area_y, input$gcp_arrangement_pattern,
derived_values$field_of_view_x, derived_values$field_of_view_y, derived_values$photo_positions, tol=0.05)
#sr <- optimize(opt_gcp_recover_frequency, 1:20,
# input$gcp_rec_number, input$gcp_rec_frequency, input$mapping_area_x, input$mapping_area_y, input$gcp_arrangement_pattern,
# derived_values$field_of_view_x, derived_values$field_of_view_y, derived_values$photo_positions, tol=0.01)
min_levels <- gridSearch(opt_gcp_recover_frequency, list(seq(2,20)),
input$gcp_rec_number, input$gcp_rec_frequency, input$mapping_area_x, input$mapping_area_y, input$gcp_arrangement_pattern,
derived_values$field_of_view_x, derived_values$field_of_view_y, derived_values$photo_positions, input$gcp_frequency_base)$minlevels
gcp_n_in_x <- round(sr$minimum)
gcp_n_in_y <- ceiling(input$mapping_area_y / (input$mapping_area_x / gcp_n_in_x))
gcp_n_in_x <- round(min_levels[[1]])
gcp_n_in_y <- calc_gcp_in_y(gcp_n_in_x, input$mapping_area_x, input$mapping_area_y, input$gcp_arrangement_pattern)
values <- calc_gcp_recover_frequency(input$mapping_area_x, input$mapping_area_y, gcp_n_in_x, gcp_n_in_y,
input$gcp_arrangement_pattern, derived_values$field_of_view_x, derived_values$field_of_view_y, derived_values$photo_positions)
input$gcp_arrangement_pattern, derived_values$field_of_view_x, derived_values$field_of_view_y, derived_values$photo_positions, input$gcp_frequency_base)
if(max(values[[3]] ) > 12) {
gcp_n_in_x <- 2
gcp_n_in_y <- 2
if(gcp_n_in_y > 20 | input$gcp_rec_frequency/100 > do.call(sum, tail(as.list(values[[4]]$density), -(input$gcp_rec_number))))
{
gcp_n_in_x <- 20
gcp_n_in_y <- 20
values <- calc_gcp_recover_frequency(input$mapping_area_x, input$mapping_area_y, gcp_n_in_x, gcp_n_in_y,
input$gcp_arrangement_pattern, derived_values$field_of_view_x, derived_values$field_of_view_y, derived_values$photo_positions)
input$gcp_arrangement_pattern, derived_values$field_of_view_x, derived_values$field_of_view_y, derived_values$photo_positions, input$gcp_frequency_base)
showNotification(type = "error", id="warning_gcp", "Automatic GCP placement not possible",duration = NULL)
showNotification(type = "error", id="warning_gcp", "Automatic GCP placement not possible, maximum of 20x20 GCP reached",duration = NULL)
} else {
removeNotification(id="warning_gcp")
}
updateNumericInput(session, "gcp_n_in_x", value= gcp_n_in_x)
updateNumericInput(session, "gcp_n_in_y", value= gcp_n_in_y)
derived_values$gcp <- values[[1]]
derived_values$hit_per_gcp <- values[[2]]
derived_values$hit_per_image <- values[[3]]
updateNumericInput(session, "gcp_n_in_x", value= gcp_n_in_x)
updateNumericInput(session, "gcp_n_in_y", value= gcp_n_in_y)
}
......
......@@ -50,7 +50,7 @@ default_freq_max<- NULL
default_flight_max<- NULL
default_max_number_of_wp <- 99
default_gcp_rec_frequency <- 50
default_gcp_rec_number <- 1
default_gcp_rec_number <- 2
default_position_edge1_lat <- 47.450812627526901
default_position_edge1_long <- 8.682496912397921
......@@ -186,6 +186,15 @@ ui_ <- fluidPage(
column(6, numericInput("gcp_rec_frequency", "Frequency of images (%)", width = "100%", value = default_gcp_rec_frequency, step=1)),
column(6, sliderInput("gcp_rec_number", "... with min. number of visible GCPs", width = "100%", value = default_gcp_rec_number, step=1, min=1, max=3))
),
radioButtons(inline=TRUE, "gcp_frequency_base", "Frequency based on",
choiceNames = list(
p("Mapping area", width="100px"),
p("Flight area", width="100px")),
choiceValues = list(
"inline", "complete"
),
selected="inline"),
h4("Arrangement"),
checkboxInput("edit_gcp_arrangement", "Set manually"),
fluidRow(
......@@ -198,7 +207,8 @@ ui_ <- fluidPage(
p("Crosswise", width="100px")),
choiceValues = list(
"quad", "skip"
)),
),
selected="skip"),
fluidRow(
column(4, plotOutput("gcp_arrangement_quad", height = "50px", width = "100px")),
column(4, plotOutput("gcp_arrangement_skip", height = "50px", width = "100px"))
......
Supports Markdown
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