server.R 49.4 KB
Newer Older
luroth's avatar
luroth committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
library(ggplot2)
library(plotly)
library(scales)
library(gridExtra)
library(RJSONIO)
library(rlist)
library(rgdal) 
library(sp)
library(readr)
library(zoo)
library(data.table)
library(raster)
library(grid)

source("./functions.R")

luroth's avatar
luroth committed
17
18
19
# ggplot settings
# Default theme: No grid lines, no borders, no background
ggtheme_default <- theme(
luroth's avatar
luroth committed
20
21
22
23
24
25
  text = element_text(size = 15),
  axis.line = element_line(colour = "black"),
  panel.grid.major = element_blank(),
  panel.grid.minor = element_blank(),
  panel.border = element_blank(),
  panel.background = element_blank())
luroth's avatar
luroth committed
26
27
28
29
30
31
32
33
34
# "Box" theme: No grid lines, but panel border
ggtheme_box <- theme(
  text = element_text(size = 15),
  axis.line = element_line(colour = "black"),
  panel.grid.major = element_blank(),
  panel.grid.minor = element_blank(),
  panel.border = element_rect(colour = "black", fill=NA, size=1),
  panel.background = element_blank())
# "Blank" theme: Absolutely no grid lines, axis, etc.
luroth's avatar
luroth committed
35
36
37
38
39
40
41
42
ggtheme_blank <- theme(
  text =  element_blank(),
  axis.line =  element_blank(),
  axis.ticks = element_blank(),
  panel.grid.major = element_blank(),
  panel.grid.minor = element_blank(),
  panel.border = element_blank(),
  panel.background = element_blank())
luroth's avatar
luroth committed
43
# Format axis label with leading zeros to have always the same axis width
luroth's avatar
luroth committed
44
45
46
47
label_digits <- function(digits=0){
  function(x) formatC(x, width = digits, format = "d", flag = "0")
}

luroth's avatar
luroth committed
48
49
#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)
luroth's avatar
luroth committed
50
51

# Debouncing factor
luroth's avatar
luroth committed
52
default_debounce <- 500
luroth's avatar
luroth committed
53

luroth's avatar
luroth committed
54
# Main server function
luroth's avatar
luroth committed
55
56
server_ <- function(input, output, session) {
  
luroth's avatar
luroth committed
57
58
59
60
  # Object to store reactive values in (e.g. GUI values that needed conversion before using in formulas)
  derived_values <- reactiveValues(
    sensor_selection_enabled = TRUE # Set sensor values to editable on startup
  ) 
luroth's avatar
luroth committed
61
  
luroth's avatar
luroth committed
62
63
  ############################################################
  ### Input tabs
luroth's avatar
luroth committed
64
65
  
  ###################
luroth's avatar
luroth committed
66
  ### Sensor / Lens
luroth's avatar
luroth committed
67
68
  ###################

luroth's avatar
luroth committed
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
  # Read preconfigured sensor / lens combination from JSON file
  preconfigured_sensors_and_lens <- fromJSON("sensors.json")
  # Update selection field
  updateSelectInput(session, "sensor_and_lens_select", selected = list.select(preconfigured_sensors_and_lens, name)[[1]], choices = c("Custom", lapply(list.select(preconfigured_sensors_and_lens, name), "[[", 1)))
  # Hide other tabs on startup
  hideTab(inputId = "config_tab", target = "Imaging")
  hideTab(inputId = "config_tab", target = "Mapping")
  hideTab(inputId = "config_tab", target = "Location")
  hideTab(inputId = "config_tab", target = "GCPs")
  hideTab(inputId = "results", target = "Photographic properties")
  hideTab(inputId = "results", target = "Mapping properties")
  hideTab(inputId = "results", target = "Viewing geometry")
  hideTab(inputId = "results", target = "Mission briefing")
  
  # Observe sensor edit event
  observeEvent({input$sensor_and_lens_edit}, {
    if(derived_values$sensor_selection_enabled) {
      # Values were edited, save them in reactive values
      derived_values$d_sensor_x <- input$d_sensor_x / 1000
      derived_values$d_sensor_y <- input$d_sensor_y / 1000
      # Display result tabs and other input tabs
      showTab(inputId = "config_tab", target = "Imaging")
      showTab(inputId = "config_tab", target = "Mapping")
      showTab(inputId = "config_tab", target = "Location")
      showTab(inputId = "config_tab", target = "GCPs")
      showTab(inputId = "results", target = "Photographic properties")
      showTab(inputId = "results", target = "Mapping properties")
      showTab(inputId = "results", target = "Viewing geometry")
      showTab(inputId = "results", target = "Mission briefing")
      # Set input elements to readonly
      shinyjs::toggleState("d_sensor_x", FALSE)
      shinyjs::toggleState("d_sensor_y", FALSE)
      shinyjs::toggleState("n_pix_x", FALSE)
      shinyjs::toggleState("n_pix_y", FALSE)
      shinyjs::toggleState("t_max", FALSE)
      shinyjs::toggleState("ISO_max", FALSE)
105
106
      shinyjs::toggleState("freq_max", FALSE)
      shinyjs::toggleState("flight_max", FALSE)
luroth's avatar
luroth committed
107
108
109
110
      # Update text on edit button
      updateActionButton(session, "sensor_and_lens_edit", label="Edit settings")
      # Set sensor selection readonly
      shinyjs::toggleState("sensor_and_lens_select", FALSE)
luroth's avatar
luroth committed
111
    } else {
luroth's avatar
luroth committed
112
113
114
      # User is going to edit values, change text on edit button
      updateActionButton(session, "sensor_and_lens_edit", label="Save settings")
      # Hide result tab and other input tabs
luroth's avatar
luroth committed
115
116
117
118
119
120
121
122
      hideTab(inputId = "config_tab", target = "Imaging")
      hideTab(inputId = "config_tab", target = "Mapping")
      hideTab(inputId = "config_tab", target = "Location")
      hideTab(inputId = "config_tab", target = "GCPs")
      hideTab(inputId = "results", target = "Photographic properties")
      hideTab(inputId = "results", target = "Mapping properties")
      hideTab(inputId = "results", target = "Viewing geometry")
      hideTab(inputId = "results", target = "Mission briefing")
luroth's avatar
luroth committed
123
124
      # Set sensor selection writeable
      shinyjs::toggleState("sensor_and_lens_select", TRUE)
luroth's avatar
luroth committed
125
    }
luroth's avatar
luroth committed
126
    # update shutter speed values 
127
    updateSelectInput(session, "shutter_speed", choices = shutter_speed_values[as.numeric(shutter_speed_values)<=input$t_max], selected = 8000 )
luroth's avatar
luroth committed
128
    derived_values$sensor_selection_enabled <- !derived_values$sensor_selection_enabled
luroth's avatar
luroth committed
129
  })
luroth's avatar
luroth committed
130
131
132
133
134
135
  
  # Observe sensor selection 
  observeEvent(input$sensor_and_lens_select, {
    if(input$sensor_and_lens_select == "Custom") {
      # If Custom, enable editing of sensor values in GUI
      fields_editable <- TRUE
luroth's avatar
luroth committed
136
    } else {
luroth's avatar
luroth committed
137
138
139
140
141
142
143
144
145
146
147
148
      # If not custom, get corresponding values for sensor and set fields readonly
      configs <- list.first(preconfigured_sensors_and_lens, name == input$sensor_and_lens_select) 
      configs <- configs$sensor_values
      # Update GUI
      updateNumericInput(session, "d_sensor_x", value = configs[['d_sensor_x']])
      updateNumericInput(session, "d_sensor_y", value = configs[['d_sensor_y']])
      updateNumericInput(session, "n_pix_x", value = configs[['n_pix_x']])
      updateNumericInput(session, "n_pix_y", value = configs[['n_pix_y']])
      updateNumericInput(session, "f", value = configs[['focal_lenght']])
      updateNumericInput(session, "aperture", value = configs[['default_lens_aperture']])
      updateNumericInput(session, "t_max", value = configs[['t_max']])
      updateNumericInput(session, "ISO_max", value = configs[['ISO_max']])
149
150
      updateNumericInput(session, "freq_max", value = configs[['freq_max']])
      updateNumericInput(session, "flight_max", value = configs[['flight_max']])
luroth's avatar
luroth committed
151
      fields_editable <- FALSE
luroth's avatar
luroth committed
152
    }
luroth's avatar
luroth committed
153
154
155
156
157
158
    shinyjs::toggleState("d_sensor_x", fields_editable)
    shinyjs::toggleState("d_sensor_y", fields_editable)
    shinyjs::toggleState("n_pix_x", fields_editable)
    shinyjs::toggleState("n_pix_y", fields_editable)
    shinyjs::toggleState("t_max", fields_editable)
    shinyjs::toggleState("ISO_max", fields_editable)
159
160
    shinyjs::toggleState("freq_max", fields_editable)
    shinyjs::toggleState("flight_max", fields_editable)
luroth's avatar
luroth committed
161
162
  })
  
luroth's avatar
luroth committed
163
  # Inputs and conversions (all in px and m)
luroth's avatar
luroth committed
164
  
luroth's avatar
luroth committed
165
166
167
  # Focal lenght (debounced)
  direct_f <- reactive({as.numeric(input$f) / 1000})
  debounced_f <- direct_f %>% debounce(default_debounce)
luroth's avatar
luroth committed
168
  observe({
luroth's avatar
luroth committed
169
    derived_values$f <- debounced_f()
luroth's avatar
luroth committed
170
  })
luroth's avatar
luroth committed
171
  # Aperture (convert from string to numeric)
luroth's avatar
luroth committed
172
  observe({
luroth's avatar
luroth committed
173
    derived_values$aperture <- as.numeric(input$aperture)
luroth's avatar
luroth committed
174
175
  })

luroth's avatar
luroth committed
176
  # Calculation
luroth's avatar
luroth committed
177
  
luroth's avatar
luroth committed
178
  #Circle of confusion
luroth's avatar
luroth committed
179
  observe({
luroth's avatar
luroth committed
180
181
182
183
184
185
186
187
188
    if(isTruthy(c(derived_values$d_sensor_x, derived_values$d_sensor_y, input$n_pix_x, input$n_pix_y))) {
      # If x and y axis differ: take minimum
      CoC_x <- derived_values$d_sensor_x/ input$n_pix_x
      CoC_y <- derived_values$d_sensor_y/ input$n_pix_y
      
      derived_values$circle_of_confusion <- ifelse(CoC_x < CoC_y, CoC_x, CoC_y)
    } else {
      derived_values$circle_of_confusion <- NA
    }
luroth's avatar
luroth committed
189
190
  })
  
luroth's avatar
luroth committed
191
192
193
194
195
196
197
198
  # Circle of confusion output in input tab
  output$d_pix_output <- renderUI({
    if(derived_values$sensor_selection_enabled) {
      output_html <- paste0("<b style='color:red'>Save settings to continue</b>")
    } else {
      output_html <- paste0("<b>Distance between pixel centers / circle of confusion: </b>", round(derived_values$circle_of_confusion *1000, 4), " mm")
    }
  HTML(output_html)
luroth's avatar
luroth committed
199
  })
200
  
luroth's avatar
luroth committed
201
  # Angle of view
luroth's avatar
luroth committed
202
  observe({
luroth's avatar
luroth committed
203
204
205
206
207
208
    if(isTruthy(c(derived_values$d_sensor_x, derived_values$d_sensor_y, derived_values$f))) {
      derived_values$angle_of_view_x <- calc_angle_of_view(derived_values$d_sensor_x, derived_values$f)
      derived_values$angle_of_view_y <- calc_angle_of_view(derived_values$d_sensor_y, derived_values$f)
    } else {
      derived_values$angle_of_view_x <- NA
      derived_values$angle_of_view_y <- NA
209
210
211
    }
  })
  
luroth's avatar
luroth committed
212
  # Hyperfocal distance
luroth's avatar
luroth committed
213
  observe({
luroth's avatar
luroth committed
214
215
216
217
218
    if(isTruthy(c(derived_values$f, derived_values$aperture, derived_values$circle_of_confusion))) {
      derived_values$hyperfocal_distance <- calc_hyperfocal_distance(derived_values$f, derived_values$aperture, derived_values$circle_of_confusion)
    } else {
      derived_values$hyperfocal_distance <- NA
    }
luroth's avatar
luroth committed
219
  })
luroth's avatar
luroth committed
220
221
222
223
    
  ###################
  ### Imaging
  ###################
luroth's avatar
luroth committed
224
  
luroth's avatar
luroth committed
225
226
227
228
229
230
231
  # Toggle whether flight height or ground samplind distance is editable
  # Default:
  shinyjs::toggleState("flight_height")
  # Dynamic:
  observeEvent({input$edit_ground_sampling_distance}, {
    shinyjs::toggleState("flight_height")
    shinyjs::toggleState("ground_sampling_distance")
luroth's avatar
luroth committed
232
233
  })
  
luroth's avatar
luroth committed
234
  # Flight height calculation
luroth's avatar
luroth committed
235
  observe({
luroth's avatar
luroth committed
236
237
238
239
240
241
242
    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))
      derived_values$flight_height <- flight_height
      updateTextInput(session, "flight_height", value = derived_values$flight_height)
    } else {
      derived_values$flight_height <- input$flight_height
    }
luroth's avatar
luroth committed
243
  })
luroth's avatar
luroth committed
244
  # Ground sampling distance calculation
luroth's avatar
luroth committed
245
  observe({
luroth's avatar
luroth committed
246
247
248
249
250
251
252
    if(input$edit_ground_sampling_distance) {
      derived_values$ground_sampling_distance <- as.numeric(input$ground_sampling_distance)/1000
    } else {
      ground_sampling_distance <- round(calc_ground_sampling_distance(derived_values$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)
      }
luroth's avatar
luroth committed
253
254
  })
  
luroth's avatar
luroth committed
255
  # Depth of field calculation
luroth's avatar
luroth committed
256
  observe({
luroth's avatar
luroth committed
257
258
259
    req(derived_values$f, derived_values$aperture, derived_values$circle_of_confusion, derived_values$focus_distance)
    derived_values$depth_of_field_near <- calc_depth_of_field_near(derived_values$f, derived_values$aperture, derived_values$circle_of_confusion, derived_values$focus_distance)
    derived_values$depth_of_field_far <- calc_depth_of_field_far(derived_values$f, derived_values$aperture, derived_values$circle_of_confusion, derived_values$focus_distance)
luroth's avatar
luroth committed
260
261
  })

luroth's avatar
luroth committed
262
263
264
265
  # Focus distance calculation
  observe({
    req(derived_values$f, derived_values$aperture, derived_values$circle_of_confusion, derived_values$flight_height)
    derived_values$focus_distance <- calc_focus_distance(derived_values$f, derived_values$aperture, derived_values$circle_of_confusion,  derived_values$flight_height)
luroth's avatar
luroth committed
266
267
  })
  
luroth's avatar
luroth committed
268
269
  # Shutter speed and ISO
  shinyjs::toggleState("iso")
luroth's avatar
luroth committed
270
  
luroth's avatar
luroth committed
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
  observe({
    req(input$exposure_value, derived_values$aperture, input$shutter_speed, input$ISO_max)
    shutter_speed <- as.numeric(input$shutter_speed)
    # calc ISO
    iso <- signif(calc_iso(input$exposure_value, derived_values$aperture, shutter_speed), 4)
    if(iso >= input$ISO_max) {
      showModal(modalDialog(title = "Warning", paste("The calculated ISO value (", iso, ") is higher than the maximum allowed ISO value (", input$ISO_max, "). The shutter speed was recalculated."), footer = modalButton("OK")))
      iso <- input$ISO_max
      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/as.numeric(shutter_speed_values) - 1/shutter_speed))])
      if(shutter_speed_real > shutter_speed) {
        shutter_speed_real <- as.numeric(shutter_speed_values[which.min(abs(1/as.numeric(shutter_speed_values) - 1/shutter_speed)) - 1])
      }
      updateTextInput(session, "shutter_speed", value = shutter_speed_real)
      updateTextInput(session, "iso", value = iso)
      derived_values$shutter_speed <- shutter_speed
    } else {
      derived_values$iso <- iso
      derived_values$shutter_speed <- shutter_speed
      updateTextInput(session, "iso", value = iso)
luroth's avatar
luroth committed
291
292
293
    }
  })
  
luroth's avatar
luroth committed
294
295
296
  #####################
  ### Mapping
  #####################
luroth's avatar
luroth committed
297
  
luroth's avatar
luroth committed
298
299
300
301
302
303
304
305
306
307
  # End and side laps calculation
  # Default
  shinyjs::toggleState("end_lap")
  shinyjs::toggleState("side_lap")
  # Dynamic:
  observeEvent({input$edit_spacing}, {
    shinyjs::toggleState("end_lap")
    shinyjs::toggleState("side_lap")
    shinyjs::toggleState("spacing_between_flight_lines")
    shinyjs::toggleState("spacing_between_exposures")
luroth's avatar
luroth committed
308
309
  })
  
luroth's avatar
luroth committed
310
  # Spacing between flight lines calculation
luroth's avatar
luroth committed
311
  observe({
luroth's avatar
luroth committed
312
313
314
315
316
317
318
    if(input$edit_spacing) {
      derived_values$spacing_between_flight_lines <- input$spacing_between_flight_lines
    } else {
      req(derived_values$side_lap, derived_values$field_of_view_x)
      derived_values$spacing_between_flight_lines <- round(calc_spacing_flight_lines(derived_values$side_lap, derived_values$field_of_view_x), 2)
      updateTextInput(session, "spacing_between_flight_lines", value = derived_values$spacing_between_flight_lines)
    }
luroth's avatar
luroth committed
319
  })
luroth's avatar
luroth committed
320
  # Spacing between exposures calculation
luroth's avatar
luroth committed
321
  observe({
luroth's avatar
luroth committed
322
323
324
325
326
327
328
    if(input$edit_spacing) {
      derived_values$spacing_between_exposures <- input$spacing_between_exposures
    } else {
      req(derived_values$end_lap, derived_values$field_of_view_y)
      derived_values$spacing_between_exposures <- round(calc_spacing_exposure_station(derived_values$end_lap, derived_values$field_of_view_y), 2)
      updateTextInput(session, "spacing_between_exposures", value = derived_values$spacing_between_exposures)
    }
luroth's avatar
luroth committed
329
  })
luroth's avatar
luroth committed
330
  # Side lap calculation
luroth's avatar
luroth committed
331
  observe({
luroth's avatar
luroth committed
332
333
334
335
336
337
338
339
340
    if(input$edit_spacing) {
      req(derived_values$spacing_between_flight_lines, derived_values$field_of_view_x)
      derived_values$side_lap <- round(calc_side_lap(derived_values$spacing_between_flight_lines, derived_values$field_of_view_x), 2)
      updateTextInput(session, "side_lap", value = derived_values$side_lap)
    } else {
      derived_values$side_lap <- input$side_lap
    }
  })  
  # End lap calculation
luroth's avatar
luroth committed
341
  observe({
luroth's avatar
luroth committed
342
343
344
345
346
347
348
    if(input$edit_spacing) {
      req(derived_values$spacing_between_exposures, derived_values$field_of_view_y)
      derived_values$end_lap <- round(calc_end_lap(derived_values$spacing_between_exposures, derived_values$field_of_view_y), 2)
      updateTextInput(session, "end_lap", value = derived_values$end_lap)
    } else {
      derived_values$end_lap <- input$end_lap
    }
luroth's avatar
luroth committed
349
  })
luroth's avatar
luroth committed
350
351

  # Field of view sensor calculation
luroth's avatar
luroth committed
352
  observe({
luroth's avatar
luroth committed
353
354
    req(derived_values$flight_height, derived_values$d_sensor_x, derived_values$f)
    derived_values$field_of_view_x_sensor <- calc_ground_field_of_view(derived_values$flight_height, derived_values$d_sensor_x, derived_values$f)
luroth's avatar
luroth committed
355
356
  })
  observe({
luroth's avatar
luroth committed
357
358
    req(derived_values$flight_height, derived_values$d_sensor_y, derived_values$f)
    derived_values$field_of_view_y_sensor <- calc_ground_field_of_view(derived_values$flight_height, derived_values$d_sensor_y, derived_values$f)
luroth's avatar
luroth committed
359
  })
luroth's avatar
luroth committed
360
  # Field of view flight calculation
luroth's avatar
luroth committed
361
362
  observe({
    if(input$flip_camera) {
luroth's avatar
luroth committed
363
364
      derived_values$field_of_view_x <- derived_values$field_of_view_y_sensor
      derived_values$field_of_view_y <- derived_values$field_of_view_x_sensor
luroth's avatar
luroth committed
365
    } else {
luroth's avatar
luroth committed
366
367
      derived_values$field_of_view_x <- derived_values$field_of_view_x_sensor
      derived_values$field_of_view_y <- derived_values$field_of_view_y_sensor    
luroth's avatar
luroth committed
368
369
370
    }
  })
  
luroth's avatar
luroth committed
371
  # Flight speed calculation
luroth's avatar
luroth committed
372
  observe({
373
374
    req(derived_values$ground_sampling_distance, input$motion_blur, derived_values$shutter_speed, derived_values$spacing_between_exposures,
        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)
luroth's avatar
luroth committed
375
    
376
377
378
379
380
381
382
383
384
385
386
387
388
    req_flight_speed <- calc_flight_speed(derived_values$ground_sampling_distance, input$motion_blur, derived_values$shutter_speed)
    req_image_recording_speed <- round(calc_image_recording_speed(req_flight_speed, derived_values$spacing_between_exposures),2)
    req_flight_duration <- round(calc_flight_duration(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, req_flight_speed))
    
    actual_motion_blur <- isolate(input$motion_blur)
    
    max_flight_speed <- input$freq_max * derived_values$spacing_between_exposures
    max_motion_blur <- round(calc_motion_blur(derived_values$ground_sampling_distance, max_flight_speed , derived_values$shutter_speed),2)
    
    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)
luroth's avatar
luroth committed
389
    
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
    updateSliderInput(session, "motion_blur", min=min_motion_blur, max=max_motion_blur)
    
    if(max_motion_blur <= min_motion_blur) {
      showModal(modalDialog(title = "Warning", paste0("No solution for motion blur found. Reduce overlaps or  mapping area"), footer = modalButton("OK")))
    } else if(actual_motion_blur > max_motion_blur) {
      showModal(modalDialog(title = "Warning", 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), footer = modalButton("OK"))) 
      updateSliderInput(session, "motion_blur", value=max_motion_blur)
      
    } else if(actual_motion_blur < min_motion_blur) {
      showModal(modalDialog(title = "Warning", 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), footer = modalButton("OK"))) 
      updateSliderInput(session, "motion_blur", value=min_motion_blur)
    }

    derived_values$flight_speed <-req_flight_speed
    derived_values$image_recording_speed <- req_image_recording_speed
    derived_values$flight_duration <- req_flight_duration

  
luroth's avatar
luroth committed
408
  })
409
 
luroth's avatar
luroth committed
410
  
luroth's avatar
luroth committed
411
  # Number of photos and positions calculation
luroth's avatar
luroth committed
412
  observe({
413
414
415
    req(input$mapping_area_x, input$mapping_area_y, derived_values$side_lap, derived_values$spacing_between_exposures, derived_values$spacing_between_flight_lines,
        derived_values$field_of_view_y, derived_values$field_of_view_x)
    req(derived_values$spacing_between_exposures>0)
luroth's avatar
luroth committed
416
    # Photo positions on x axis
luroth's avatar
luroth committed
417
    
luroth's avatar
luroth committed
418
419
    overlap_lines = ceiling(derived_values$field_of_view_x / (2 * derived_values$spacing_between_flight_lines) )
    overlap_meters = derived_values$field_of_view_y / 2.0
luroth's avatar
luroth committed
420
    
luroth's avatar
luroth committed
421
422
423
424
425
426
427
428
429
430
431
432
433
434
    shoot_x_axis <- seq(
      from=0-( ceiling(derived_values$field_of_view_x/(derived_values$spacing_between_flight_lines * 2)) * derived_values$spacing_between_flight_lines ), 
      to=input$mapping_area_x + (ceiling(derived_values$field_of_view_x/(derived_values$spacing_between_flight_lines * 2)) * derived_values$spacing_between_flight_lines ), 
      by = derived_values$spacing_between_flight_lines)
    # Photo position on y axis
    shoot_y_axis_forward <- seq(from=0-(derived_values$field_of_view_y/2), to=input$mapping_area_y+(derived_values$field_of_view_y/2), by = derived_values$spacing_between_exposures)
    shoot_y_axis_backward <- rev(shoot_y_axis_forward)
    # Photo positions, all
    shoot_x <- rep(shoot_x_axis, each=length(shoot_y_axis_forward))
    shoot_y <- rep(c(shoot_y_axis_forward, shoot_y_axis_backward), length.out=length(shoot_x_axis)*length(shoot_y_axis_forward))
    # Save positions
    derived_values$photo_positions <- data.frame(x=shoot_x, y=shoot_y)
    # Save number of photos
    derived_values$number_of_photos <- nrow(derived_values$photo_positions)
luroth's avatar
luroth committed
435
436
437
438
439
440
  })
  
  #########################
  ### GCP
  #########################
  
luroth's avatar
luroth committed
441
442
  # Small plots as "buttons" for GCP arrangement
  output$gcp_arrangement_quad <- renderPlot({
luroth's avatar
luroth committed
443
    ggplot(data=data.frame(x=c(1,1,1,2,2,2,3,3,3), y=c(1,2,3,1,2,3,1,2,3)), aes(x=x, y=y)) +
luroth's avatar
luroth committed
444
      coord_fixed() +
luroth's avatar
luroth committed
445
446
      scale_x_continuous(limits = c(0.5,3.5), expand = c(0,0)) +
      scale_y_continuous(limits = c(0.5,3.5), expand = c(0,0)) +
luroth's avatar
luroth committed
447
448
      geom_point(size=3) +
      ggtheme_blank
luroth's avatar
luroth committed
449
  })
luroth's avatar
luroth committed
450
  output$gcp_arrangement_skip <- renderPlot({
luroth's avatar
luroth committed
451
452
453
454
455
456
457
458
    ggplot(data=data.frame(x=c(1,1,1,2,2,3,3,3), y=c(1,2,3,1.5,2.5,1,2,3)), aes(x=x, y=y)) +
      geom_point(size=3) +
      scale_x_continuous(limits = c(0.5,3.5), expand = c(0,0)) +
      scale_y_continuous(limits = c(0.5,3.5), expand = c(0,0)) +
      coord_fixed() +
      ggtheme_blank
  })
  
luroth's avatar
luroth committed
459
  # GCP location
luroth's avatar
luroth committed
460
  observe({
luroth's avatar
luroth committed
461
462
463
464
465
466
467
    req(input$gcp_n_in_x, input$gcp_n_in_y, input$mapping_area_x, input$mapping_area_y, input$gcp_arrangement_pattern)
    # Positions along axis
    gcp_x <- rep(seq(from=0, to=input$mapping_area_x, length.out= input$gcp_n_in_x), each=input$gcp_n_in_y)
    gcp_y <- rep(seq(from=0, to=input$mapping_area_y, length.out= input$gcp_n_in_y), input$gcp_n_in_x)
    # Crossproduct according to pattern
    if(input$gcp_arrangement_pattern == "quad") {
      derived_values$gcp <- data.frame(x=gcp_x, y=gcp_y)
luroth's avatar
luroth committed
468
    } else {
luroth's avatar
luroth committed
469
      gcp_y <- ifelse(rep(seq(from=1, to=input$gcp_n_in_x, by = 1), each=input$gcp_n_in_y) %% 2 != 0, gcp_y, gcp_y + (input$mapping_area_y/((input$gcp_n_in_y-1)*2)))
luroth's avatar
luroth committed
470
      gcp <- data.frame(x=gcp_x, y=gcp_y)
luroth's avatar
luroth committed
471
      derived_values$gcp <- gcp %>% filter(y <= input$mapping_area_y)
luroth's avatar
luroth committed
472
    }
luroth's avatar
luroth committed
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
    # Also save number of GCP
    derived_values$number_of_gcp <- nrow(derived_values$gcp)
  })
  
  # Calculate GCP recovery frequency
  observe({
    req(derived_values$field_of_view_x, derived_values$field_of_view_y, derived_values$gcp, derived_values$photo_positions)
    # Set ground field of view for all GCP
    gcp_x_min <- derived_values$gcp[,1] - derived_values$field_of_view_x/2
    gcp_x_max <- derived_values$gcp[,1] + derived_values$field_of_view_x/2
    gcp_y_min <- derived_values$gcp[,2] - derived_values$field_of_view_y/2
    gcp_y_max <- derived_values$gcp[,2] + derived_values$field_of_view_y/2
    # Get exposure stations
    photos_x <- derived_values$photo_positions[,1]
    photos_y <- derived_values$photo_positions[,2]
    
    # Template for the vector we excpect to get returned
    return_template <- rep(TRUE, length(photos_x))
    # Test if exposure station is in ground field of view
    counts <- vapply(gcp_x_min, FUN =  function(x){x < photos_x}, return_template) &
      vapply(gcp_x_max, FUN =  function(x){x > photos_x}, return_template) & 
      vapply(gcp_y_min, FUN =  function(x){x < photos_y}, return_template) & 
      vapply(gcp_y_max, FUN =  function(x){x > photos_y}, return_template)
    
    # Count hits
    derived_values$hit_per_gcp <- colSums(counts)
    derived_values$hit_per_image <- rowSums(counts)
  })
  

  ############################################################
  ### Results tabs
  
  ###########################
  ### Photographic properties
  ###########################
  
  # Wrapper functions to calculate distance to ground instead of distance to sensor
  calc_focus_distance_ <- function(ground_sampling_distance_mm, f, N, circle_of_confusion, d_sensor, n_pix) {
    flight_height <- calc_flight_height_mm(ground_sampling_distance_mm, d_sensor, n_pix, f)
    return(flight_height- calc_focus_distance(f, N, circle_of_confusion, flight_height))
  }
  calc_depth_of_field_near_ <- function(ground_sampling_distance_mm, f, N, circle_of_confusion, d_sensor, n_pix) {
    flight_height <- calc_flight_height_mm(ground_sampling_distance_mm, d_sensor, n_pix, f)
    return(flight_height- calc_depth_of_field_near(f, N, circle_of_confusion, calc_focus_distance(f, N, circle_of_confusion, flight_height)))
  }
  calc_depth_of_field_far_ <- function(ground_sampling_distance_mm, f, N, circle_of_confusion, d_sensor, n_pix) {
    flight_height <- calc_flight_height_mm(ground_sampling_distance_mm, d_sensor, n_pix, f)
    return(flight_height- calc_depth_of_field_far(f, N, circle_of_confusion, calc_focus_distance(f, N, circle_of_confusion, flight_height)))
  }
  
  # Plot
  photographic_properties_plot <- reactive({
    req(derived_values$d_sensor_x, input$n_pix_x, derived_values$f, derived_values$aperture, derived_values$depth_of_field_near,
        derived_values$focus_distance, derived_values$depth_of_field_far, derived_values$circle_of_confusion, derived_values$flight_height,
        derived_values$ground_sampling_distance)
    
    # Args for plotted functions
    args_flight_height_function <- list(d_sensor = derived_values$d_sensor_x, n_pix=input$n_pix_x, f=derived_values$f)
    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)
    
    
    plot <- ggplot(data.frame(y = c(2, 100)), 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)) +
      # 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
      annotate("rect", xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=0, fill="lightgrey") + 
      # Depth of field as grey lines
      stat_function(fun=calc_depth_of_field_far_, args = args_depth_of_field_function, aes(color="Depth of field"), linetype=1, size=1, na.rm=TRUE) +
      stat_function(fun=calc_depth_of_field_near_, args = args_depth_of_field_function, aes(color="Depth of field"), linetype=1, size=1, na.rm=TRUE) +
      # Green line for ground surface
      stat_function(fun=function(x) {0}, aes(color="Ground"), linetype=1, size=1, na.rm=TRUE) +
      # Focus distance in red
      stat_function(fun=calc_focus_distance_, args = args_focus_distance_function, aes(color="Focus distance"), linetype=10, na.rm=TRUE) + 
      # UAV as back triangle
      annotate("point", y=derived_values$flight_height, x=derived_values$ground_sampling_distance*1000, shape=17, size=8) +
      # Cross for selected height / ground sampling distance
      geom_vline(xintercept = derived_values$ground_sampling_distance*1000, linetype=2) +
      geom_hline(yintercept = derived_values$flight_height, linetype=2) + 
      scale_color_manual("", values = c("Flight height"="black", "Focus distance"="darkred", "Depth of field"="darkgrey", "Ground"="darkgreen")) +
      # Theme 
      ggtheme_default +
      theme(legend.position = "bottom")
luroth's avatar
luroth committed
560
    
luroth's avatar
luroth committed
561
    plot
luroth's avatar
luroth committed
562
563
  })
  
luroth's avatar
luroth committed
564
565
566
  # Render plot in GUI
  output$photographic_properties_plot <- renderPlot({
    photographic_properties_plot()
luroth's avatar
luroth committed
567
568
  })
  
luroth's avatar
luroth committed
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
  # Download handler for photographic properties plot
  output$download_photographic_properties_plot <- downloadHandler(
    filename = function() { paste(input$dataset, '.pdf', sep='') },
    content = function(file) {
      ggsave(file, plot = photographic_properties_plot(), device = "pdf")
    }
  )
  
  # Summary text
  output$photographic_properties_summary <- renderUI({
    req(derived_values$angle_of_view_x, derived_values$angle_of_view_y, 
        derived_values$hyperfocal_distance, derived_values$field_of_view_x_sensor, derived_values$field_of_view_y_sensor,
        derived_values$focus_distance, derived_values$flight_height, derived_values$depth_of_field_near, derived_values$depth_of_field_far)
    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 />",
                                 "<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 />",
                                 "<b>Depth of field in relation to ground:</b><br/>near: ", round(derived_values$flight_height- derived_values$depth_of_field_near,1), " m<br/>far: ", round(derived_values$flight_height - derived_values$depth_of_field_far, 1), " m<br />"
    )
    HTML(lens_angle_of_view)
luroth's avatar
luroth committed
591
592
593
    
  })
  
luroth's avatar
luroth committed
594
595
596
  ###########################
  ### Mapping properties
  ###########################
luroth's avatar
luroth committed
597
  
luroth's avatar
luroth committed
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
  # Output
  output$mapping_summary <- renderUI({
    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 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/>",
      "<b>Number of photos:</b> ", derived_values$number_of_photos, "<br/>",
      "<b>Number of GCP:</b> ",derived_values$number_of_gcp)
    HTML(mapping_summary)
  })
  
  # DF with plot shapes
  field_plots_data_frame <- reactive({
    req(input$mapping_area_x, input$plot_size_x, input$mapping_area_y, input$plot_size_y)
    data.frame(xmin=rep(seq(0, input$mapping_area_x-input$plot_size_x, input$plot_size_x), floor(input$mapping_area_y/input$plot_size_y)),
               xmax=rep(seq(input$plot_size_x, input$mapping_area_x, input$plot_size_x), floor(input$mapping_area_y/input$plot_size_y)),
               ymin=rep(seq(0, input$mapping_area_y-input$plot_size_y, input$plot_size_y), each=floor(input$mapping_area_x/input$plot_size_x)),
               ymax=rep(seq(input$plot_size_y, input$mapping_area_y, input$plot_size_y), each=floor(input$mapping_area_x/input$plot_size_x)))
  })

  # Mapping area plot
  plot_mapping_area <- reactive({
    
    req(input$mapping_area_x, input$mapping_area_y,
        derived_values$photo_positions, derived_values$field_of_view_x, derived_values$field_of_view_y,
        field_plots_data_frame())
    
    plot <- ggplot() +
      # Mapping area
      geom_rect(data=data.frame(xmin=0, ymin=0, xmax=input$mapping_area_x, ymax=input$mapping_area_y), aes(xmin=xmin, ymin=ymin, xmax=xmax, ymax=ymax, color="Mapping area"), fill="khaki3") +
      # Plot pattern
      geom_rect(data=field_plots_data_frame(), aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax), color="khaki2", fill=NA) +
      # Flight lanes
      geom_path(data=derived_values$photo_positions, aes(x=x, y=y, color="Flight lanes")) + 
      # Exposure stations
      geom_point(data=derived_values$photo_positions, aes(color="Flight lanes", x=x, y=y), size=3, shape=3) +
      # Ground field of view
      geom_rect(fill=NA, size=1.5, data=data.frame(xmin = 0.5*input$mapping_area_x-derived_values$field_of_view_x/2, xmax = 0.5*input$mapping_area_x+derived_values$field_of_view_x/2, ymin = 0.5*input$mapping_area_y-derived_values$field_of_view_y/2, ymax = 0.5*input$mapping_area_y+derived_values$field_of_view_y/2),
                aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, color="Ground field of view" )) +
      scale_color_manual("", values = c("Flight lanes"="black", "Mapping area"="khaki3", "GCP"="darkblue", "Ground field of view"="darkgreen", "Plot"="white")) +
      scale_shape("") +
      scale_x_continuous("width (m)") +
      scale_y_continuous("depth (m)") +
      coord_fixed(xlim = c(0-input$mapping_area_x*0.3, 1.3*input$mapping_area_x),
                  ylim = c(0-input$mapping_area_y*0.3, 1.3*input$mapping_area_y)) +
      # GCP position
      geom_point(data=derived_values$gcp, aes(color="GCP", x=x, y=y), size=5, shape=19) +
luroth's avatar
luroth committed
648
649
      ggtheme_box
    
luroth's avatar
luroth committed
650
    plot
luroth's avatar
luroth committed
651
652
  })
  
luroth's avatar
luroth committed
653
654
655
  # Render plot in GUI
  output$plot_mapping_area <- renderPlot({
    plot_mapping_area()
luroth's avatar
luroth committed
656
657
  })
  
658
659
660
661
662
663
664
665
  # Download handler for mapping area plot
  output$download_mapping_area_plot <- downloadHandler(
    filename = function() { paste(input$dataset, '.pdf', sep='') },
    content = function(file) {
      ggsave(file, plot = plot_mapping_area(), device = "pdf")
    }
  )
  
luroth's avatar
luroth committed
666
667
  # Calculate waypoints
  waypoints <- reactive({
luroth's avatar
luroth committed
668
669
670
671
    req(input$position_edge1_long, input$position_edge1_lat, input$position_edge2_long, input$position_edge1_lat,
        derived_values$field_of_view_x, derived_values$field_of_view_y, derived_values$side_lap, derived_values$spacing_between_flight_lines,
        input$position_start_lat, input$position_start_long, input$mapping_area_x, input$mapping_area_y, derived_values$flight_speed)

luroth's avatar
luroth committed
672
    # Convert to cartesian system
luroth's avatar
luroth committed
673
    UTM_zone <- long2UTM(input$position_edge1_long)
luroth's avatar
luroth committed
674
    
luroth's avatar
luroth committed
675
    xy <- data.frame(X = c(input$position_edge1_long, input$position_edge2_long), Y = c(input$position_edge1_lat, input$position_edge2_lat))
luroth's avatar
luroth committed
676
677
678
    coordinates(xy) <- c("X", "Y")
    proj4string(xy) <- CRS("+proj=longlat +datum=WGS84")
    start_line <- as.data.frame(spTransform(xy, CRS(paste0("+proj=utm +zone=", UTM_zone, " +ellps=WGS84"))))
luroth's avatar
luroth committed
679
680
    
    # calculate orientation
681
    theta = atan2((start_line$Y[2] - start_line$Y[1]), ( start_line$X[2] - start_line$X[1] )) - pi
luroth's avatar
luroth committed
682
683
684
685
686
687
688
689
690
691
692
    
    # roation matrix
    rotation_matrix <- matrix(c(cos(theta), sin(theta), -sin(theta), cos(theta)), ncol=2)
    rotation_matrix_invers <- matrix(c(cos(-theta), sin(-theta), -sin(-theta), cos(-theta)), ncol=2)
    
    # Rotate to a north orientation
    start_line <- data.matrix(start_line)
    start_line_rot <- start_line  %*% rotation_matrix
    
    # Calculate number of waypoints needed for the lines
    # Overlapp
luroth's avatar
luroth committed
693
694
    overlap_lines = ceiling(derived_values$field_of_view_x / (2 * derived_values$spacing_between_flight_lines) )
    overlap_meters = derived_values$field_of_view_y / 2.0
luroth's avatar
luroth committed
695
    
luroth's avatar
luroth committed
696
    number_of_lines = ceiling(input$mapping_area_x / derived_values$spacing_between_flight_lines) + 2 * overlap_lines + 1
luroth's avatar
luroth committed
697
698
699
    intermediate_points <- floor((98 - (number_of_lines*2)) / number_of_lines)
    
    # Lists for waypoint coordinates
luroth's avatar
luroth committed
700
701
    waypoints = data.frame(Y=input$position_start_lat, X=input$position_start_long)
    
luroth's avatar
luroth committed
702
703
704
705
706
707
708
709
    # Parametrize waypoint lines
    reverse = TRUE
    for(x in seq(number_of_lines)) {
      if(reverse) {
        iter <- seq(intermediate_points + 2)
      } else {
        iter <- seq(intermediate_points + 2, 1)
      }
luroth's avatar
luroth committed
710
      
luroth's avatar
luroth committed
711
      for(point in iter) {
luroth's avatar
luroth committed
712
        waypoint_x <- start_line_rot[1, 2] + (x- 1 - overlap_lines) * derived_values$spacing_between_flight_lines
luroth's avatar
luroth committed
713
        if(point==intermediate_points + 2) {
luroth's avatar
luroth committed
714
          waypoint_y <- start_line_rot[1, 1] - input$mapping_area_y - overlap_meters 
luroth's avatar
luroth committed
715
716
717
        } else if(point==1) {
          waypoint_y <- start_line_rot[1, 1] + overlap_meters    
        } else {
luroth's avatar
luroth committed
718
          waypoint_y <- start_line_rot[1, 1]  + overlap_meters - ((input$mapping_area_y + 2*overlap_meters) / (intermediate_points + 1) * (point-1))
luroth's avatar
luroth committed
719
        }
luroth's avatar
luroth committed
720
        
luroth's avatar
luroth committed
721
722
723
724
725
726
727
        # rotate back to original orientation
        waypoints_ <- (data.matrix(data.frame(X=waypoint_y, Y= waypoint_x)) %*% rotation_matrix_invers)
        waypoints_ <- data.frame(X=waypoints_[1], Y=waypoints_[2])
        # convert back 
        coordinates(waypoints_) <- c("X", "Y")
        proj4string(waypoints_) <- CRS(paste0("+proj=utm +zone=", UTM_zone, " +ellps=WGS84"))
        waypoints_ <- as.data.frame(spTransform(waypoints_, CRS("+proj=longlat +datum=WGS84")))
luroth's avatar
luroth committed
728
        
luroth's avatar
luroth committed
729
730
731
732
733
734
        waypoints <- rbind(waypoints, data.frame(X=waypoints_[2], Y=waypoints_[1]))
        
      }
      reverse = !reverse
    }
    
luroth's avatar
luroth committed
735
736
    derived_values$heading <- 180- ((theta+pi) * 180) / (pi)
    derived_values$number_of_lines <- number_of_lines
luroth's avatar
luroth committed
737
    if(number_of_lines %% 2 == 0) {
luroth's avatar
luroth committed
738
      derived_values$waypoint_edges <- c(2, 3 + intermediate_points, nrow(waypoints)-intermediate_points -1, nrow(waypoints))
luroth's avatar
luroth committed
739
    } else {
luroth's avatar
luroth committed
740
      derived_values$waypoint_edges <- c(2, 3 + intermediate_points,  nrow(waypoints), nrow(waypoints)-intermediate_points -1)
luroth's avatar
luroth committed
741
742
743
744
    }
    
    waypoints_df = data.frame(
      latitude = waypoints$Y, longitude =waypoints$X, 
luroth's avatar
luroth committed
745
      "altitude(m)"=derived_values$flight_height,
luroth's avatar
luroth committed
746
      "heading(deg)"=180- ((theta+pi) * 180) / (pi),
luroth's avatar
luroth committed
747
      'curvesize(m)'= ifelse(derived_values$spacing_between_flight_lines > 2, 1, derived_values$spacing_between_flight_lines/2),
luroth's avatar
luroth committed
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
      "rotationdir" = 0,
      "gimbalmode" = 2,
      "gimbalpitchangle" = -90,
      'actiontype1'= -1, 'actionparam1'= 0,
      'actiontype2'= -1, 'actionparam2'= 0,
      'actiontype3'= -1, 'actionparam3'= 0,
      'actiontype4'= -1, 'actionparam4'= 0,
      'actiontype5'= -1, 'actionparam5'= 0,
      'actiontype6'= -1, 'actionparam6'= 0,
      'actiontype7'= -1, 'actionparam7'= 0,
      'actiontype8'= -1, 'actionparam8'= 0,
      'actiontype9'= -1, 'actionparam9'= 0,
      'actiontype10'= -1, 'actionparam10'= 0,
      'actiontype11'= -1, 'actionparam11'= 0,
      'actiontype12'= -1, 'actionparam12'= 0,
      'actiontype13'= -1, 'actionparam13'= 0,
      'actiontype14'= -1, 'actionparam14'= 0,
      'actiontype15'= -1, 'actionparam15'= 0,
      'altitudemode'= 1,
luroth's avatar
luroth committed
767
768
      'speed(m/s)'= derived_values$flight_speed)
    
luroth's avatar
luroth committed
769
770
771
    return(waypoints_df)
  })
  
772
  debounced_f
luroth's avatar
luroth committed
773
  
774

luroth's avatar
luroth committed
775
776
  # Create waypoint leaflet
  output$waypoint_map <- renderLeaflet({
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
    isolate({
    req(waypoints())
    req(input$position_edge1_lat, input$position_edge2_lat, input$position_start_lat, input$position_edge1_long, input$position_edge2_long, input$position_start_long)
    
    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"))
    map = leaflet(data= waypoint_edges) %>%
        addMarkers(data= waypoint_edges[1,], layerId= 1, ~long, ~lat, popup = ~as.character(desc), label = ~as.character(desc), options = markerOptions(draggable = TRUE)) %>%
        addMarkers(data= waypoint_edges[2,], layerId= 2, ~long, ~lat, popup = ~as.character(desc), label = ~as.character(desc), options = markerOptions(draggable = TRUE)) %>%
        addMarkers(data= waypoint_edges[3,], layerId= 3, ~long, ~lat, popup = ~as.character(desc), label = ~as.character(desc), options = markerOptions(draggable = TRUE)) %>%
        addPolylines(layerId = 4, data=waypoints(), lat = ~latitude, lng=~longitude) 
    })
    
    providers <- c("OpenStreetMap.Mapnik",  "Esri.WorldImagery")
    for(i in 1:length(providers)){
      map = map %>% addProviderTiles(providers[i], group = providers[i])
    }
    map = map %>% addLayersControl(
      baseGroups = providers,
      options = layersControlOptions(collapsed = FALSE))
    map
  })
luroth's avatar
luroth committed
800

801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
  observeEvent(input$waypoint_map_marker_mouseout, {
    event <- input$waypoint_map_marker_mouseout
    if(event$id == 1) {
      updateNumericInput(session, "position_edge1_lat", value=event$lat)
      updateNumericInput(session, "position_edge1_long", value=event$lng)
    } else if(event$id == 2) {
      updateNumericInput(session, "position_edge2_lat", value=event$lat)
      updateNumericInput(session, "position_edge2_long", value=event$lng)      
    } else if(event$id == 3) {
      updateNumericInput(session, "position_start_lat", value=event$lat)
      updateNumericInput(session, "position_start_long", value=event$lng)       
    }
  })
  
  observeEvent(waypoints(), {
    req(waypoints())
    
    leafletProxy("waypoint_map", session) %>%
      clearShapes() %>%
      addPolylines(layerId = 4, data=waypoints(), lat = ~latitude, lng=~longitude) 
luroth's avatar
luroth committed
821
822
  })
  
luroth's avatar
luroth committed
823
824
  # Legend to waypoint leaflet
  output$waypoint_settings <- renderUI({
luroth's avatar
luroth committed
825
826
827
    req(waypoints())
    waypoint_settings <- paste0(
      "<b>Number of waypoints:</b> ", nrow(waypoints()))
luroth's avatar
luroth committed
828
    HTML(waypoint_settings)
luroth's avatar
luroth committed
829
830
  })
  
luroth's avatar
luroth committed
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
  # GCP recovery frequency
  output$plot_hits_gcp <- renderPlot({
    req(derived_values$hit_per_image)
    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("Visible GCP on image", breaks= seq(0,max(derived_values$hit_per_image),1)) +
      scale_y_continuous("Frequency of images", limits = c(0,1), expand=c(0,0)) +
      ggtheme_default
  })
  
  #########################
  ### Viewing geometry
  #########################

  pixel_frequency <- reactive({
    req(input$mapping_area_x, input$mapping_area_y, derived_values$field_of_view_x, derived_values$field_of_view_y,
        derived_values$spacing_between_flight_lines, derived_values$spacing_between_exposures,
        input$plot_size_x, input$plot_size_y,
luroth's avatar
luroth committed
849
850
        input$n_pix_x, input$n_pix_y, input$positioning_precision, derived_values$ground_sampling_distance,
        input$flip_camera)
luroth's avatar
luroth committed
851
852
853
854
855
    withProgress(message = 'Calculating pixel frequency', {
      incProgress(0.0)
      # Init parameters
      no_of_lanes_x <- ceiling((input$mapping_area_x + derived_values$field_of_view_x)  / derived_values$spacing_between_flight_lines)
      no_of_lanes_y <- ceiling((input$mapping_area_y + derived_values$field_of_view_y)  / derived_values$spacing_between_exposures)
luroth's avatar
luroth committed
856
857
858
      n_pix_x <- ifelse(input$flip_camera, input$n_pix_y, input$n_pix_x)
      n_pix_y <- ifelse(input$flip_camera, input$n_pix_x, input$n_pix_y)
      
luroth's avatar
luroth committed
859
860
861
862
      incProgress(0.3)
      
      # Calculate frequencies
      ret_list <- calc_pixel_freq_xy(input$plot_size_x, input$plot_size_y, derived_values$spacing_between_flight_lines, derived_values$spacing_between_exposures, 
luroth's avatar
luroth committed
863
                                     no_of_lanes_x, no_of_lanes_y, n_pix_x, n_pix_y, input$positioning_precision, derived_values$ground_sampling_distance)
luroth's avatar
luroth committed
864
865
866
867
868
      incProgress(1)
      
      return(ret_list)
    })
  })  
luroth's avatar
luroth committed
869
  
luroth's avatar
luroth committed
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
  output$plot_viewing_geometry_x <- renderPlot({
    req(pixel_frequency())
    
    ret_list <- pixel_frequency()
    pixel_frequency_data_x <- ret_list[[2]]
    
    plot_x <- ggplot(pixel_frequency_data_x) + 
      geom_line(aes(x=x, y=freq), fill="lightgrey") +
      scale_y_continuous("Frequency", expand=c(0,0)) +
      scale_x_continuous("X position (px)") +
      ggtheme_default 
    plot_x
  })
  
  output$plot_viewing_geometry_y <- renderPlot({
    req(pixel_frequency())
    
    ret_list <- pixel_frequency()
    pixel_frequency_data_y <- ret_list[[3]]
    
    plot_y <- ggplot(pixel_frequency_data_y) + 
      geom_line(aes(x=x, y=freq), fill="lightgrey") +
      scale_y_continuous("Frequency", expand=c(0,0)) +
      scale_x_continuous("Y position (px)") +
      ggtheme_default 
    plot_y
  })
  
  output$plot_recovery_frequency <- renderPlot({
    req(pixel_frequency())
    
    ret_list <- pixel_frequency()
    pixel_frequency_data_xy <- ret_list[[1]]
    
    raster_g <- rasterGrob(pixel_frequency_data_xy)
    size_x <- dim(pixel_frequency_data_xy)[[2]]
    size_y <- dim(pixel_frequency_data_xy)[[1]]
    plot_recovery_frequency <- ggplot(data=data.frame(x=c(1,size_x), y=c(1,size_y), value=c(0,1)), aes(x, y, color=value)) + 
      geom_point() + 
      annotation_custom(grob = raster_g) +
      scale_x_continuous("x axis (px)",limits=c(0, size_x), expand = c(0,0)) +
      scale_y_continuous("y axis (px)", limits=c(0, size_y), expand= c(0,0)) +
      scale_color_gradient("Frequency (scaled) ", low="black", high="white") + 
      coord_fixed() +
      ggtheme_box
    plot_recovery_frequency
  })
  
  output$plot_viewing_geometry <- renderPlot({
    req(pixel_frequency(), derived_values$f, derived_values$circle_of_confusion, input$n_pix_x, input$n_pix_y)
    
    withProgress(message = 'Ploting geometry', {
      
      ret_list <- pixel_frequency()
      pixel_frequency_data_xy <- ret_list[[1]]
      incProgress(0.2)
      
      delta_x <- replicate(input$n_pix_x, seq(-input$n_pix_y/2+1, input$n_pix_y/2, 1))
      delta_y <- t(replicate(input$n_pix_y, seq(-input$n_pix_x/2+1, input$n_pix_x/2, 1)))
      incProgress(0.4)
      
      zenith_angle <- (pi/2 - atan((derived_values$f/derived_values$circle_of_confusion)/(sqrt(delta_x**2 + delta_y**2))))*180 / pi
      incProgress(0.6)
      
      dim(zenith_angle) <- NULL
      dim(pixel_frequency_data_xy) <- NULL
      
      zenith_frequencies <- data.table(zenith_angle= round(zenith_angle), freq=pixel_frequency_data_xy)
      zenith_frequencies <- zenith_frequencies[,list(freq = sum(freq)), by = 'zenith_angle']
      zenith_frequencies$freq <- zenith_frequencies$freq / sum(zenith_frequencies$freq) 
      
      incProgress(0.8)
      plot_zenith <- ggplot(zenith_frequencies) + 
        geom_bar(aes(x=zenith_angle, y=freq), fill="lightgrey", color="lightgrey", stat="identity", width=1) +
        scale_y_continuous("Frequency", expand=c(0,0)) +
        scale_x_continuous("Zenith angle (deg)") +
        ggtheme_default 
      
      incProgress(1)
      plot_zenith
    }) 
  })
luroth's avatar
luroth committed
952
953
  
  #########################
luroth's avatar
luroth committed
954
  ### Mission briefing
luroth's avatar
luroth committed
955
956
957
  #########################
  
  observe({
luroth's avatar
luroth committed
958
959
960
    req(derived_values$focus_distance, derived_values$iso, derived_values$shutter_speed, derived_values$aperture, 
        derived_values$flight_height, derived_values$image_recording_speed, derived_values$spacing_between_flight_lines, derived_values$flight_speed,
        derived_values$heading, derived_values$number_of_lines, derived_values$number_of_photos, derived_values$flight_duration)
luroth's avatar
luroth committed
961
    camera_settings <- paste0(
luroth's avatar
luroth committed
962
963
964
965
      "<b>Focus distance:</b> ", round(derived_values$focus_distance,1), " m<br />",
      "<b>Film speed (ISO):</b> ", derived_values$iso, "<br />",
      "<b>Shutter speed:</b> 1/", derived_values$shutter_speed, "<br />",
      "<b>Aperture:</b> f/", derived_values$aperture, "<br />"
luroth's avatar
luroth committed
966
967
968
969
    )
    output$camera_settings <- renderUI(HTML(camera_settings))
    
    campaign_settings <- paste0(
luroth's avatar
luroth committed
970
971
972
973
974
975
      "<b>Flight height:</b> ", derived_values$flight_height, " m<br/>",
      "<b>Image triggering intervall:</b> ", round(1/derived_values$image_recording_speed,1), " s<br/>",
      "<b>Spacing between flight lines:</b> ", derived_values$spacing_between_flight_lines, " m<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>Heading:</b> ", round(derived_values$heading), " deg<br/>",
      "<b>Number of lines:</b> ", derived_values$number_of_lines, "<br/>"
luroth's avatar
luroth committed
976
977
978
979
  )
    output$campaign_settings <- renderUI(HTML(campaign_settings))
    
    restrictions <- paste0(
luroth's avatar
luroth committed
980
981
982
      "<b>Required image recording speed:</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/>"
luroth's avatar
luroth committed
983
984
    )
    output$restrictions <- renderUI(HTML(restrictions))  
luroth's avatar
luroth committed
985
986
987
988
989
990
  })
  
  output$mission_waypoint_map <- renderLeaflet({
    req(waypoints(), input$position_edge1_lat, input$position_edge2_lat, input$position_start_lat, input$position_edge1_long, input$position_edge2_long, input$position_start_long)
    data_points <- 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),
luroth's avatar
luroth committed
991
992
                              desc = c("Edge 1", "Flight direction", "Start point"))
    data_waypoints <- waypoints()
luroth's avatar
luroth committed
993
    leaflet(data= data_points) %>% addTiles() %>%
luroth's avatar
luroth committed
994
995
996
        addMarkers(~long, ~lat, popup = ~as.character(desc), label = ~as.character(desc)) %>%
        addPolylines(data=data_waypoints, lat = ~latitude, lng=~longitude)
  })
luroth's avatar
luroth committed
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
  
  # Download handler for waypoints
  output$download_waypoints <- downloadHandler(
    filename = function() {
      return(paste('waypoints-', Sys.Date(), '.csv', sep=''))
    },
    content = function(con) {
      write_csv(waypoints(), con )
    }
  )
  
  output$download_kml <- downloadHandler(
    filename = function() {
      return(paste('waypoints-', Sys.Date(), '.kml', sep=''))
    },
    content = function(con) {
      waypoints <- waypoints()
      edges <- waypoints[derived_values$waypoint_edges,c(2,1)]
      mapping_area_ <- Polygon(edges)
      mapping_area <- SpatialPolygonsDataFrame(SpatialPolygons(list(Polygons(list(mapping_area_), ID = "a")), proj4string=CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")), data=data.frame(row.names="a", name="a"))
      writeOGR(mapping_area, dsn=con, layer="mappig_area", driver="KML")
    }
  )
  
luroth's avatar
luroth committed
1021
}
luroth's avatar
luroth committed
1022