functions.R 6.13 KB
Newer Older
luroth's avatar
luroth committed
1
2
calc_angle_of_view <- function(d_sensor, f) {
  angle_of_view <- 2 * atan(d_sensor / (2 * f))
luroth's avatar
luroth committed
3
4
5
  return(angle_of_view)
}

luroth's avatar
luroth committed
6
7
calc_ground_sampling_distance <- function(flight_height, d_sensor, n_pix, f) {
  return((d_sensor/n_pix) * flight_height / f)
luroth's avatar
luroth committed
8
9
}

luroth's avatar
luroth committed
10
11
calc_ground_sampling_distance_mm <- function(flight_height, d_sensor, n_pix, f) {
  return(1000 *calc_ground_sampling_distance(flight_height, d_sensor, n_pix, f))
luroth's avatar
luroth committed
12
13
}

luroth's avatar
luroth committed
14
15
calc_ground_field_of_view <- function(flight_height, d_sensor, f) {
  return((d_sensor) * flight_height / f)
luroth's avatar
luroth committed
16
17
}

luroth's avatar
luroth committed
18
19
calc_flight_height <- function(ground_sampling_distance, d_sensor, n_pix, f) {
  return(ground_sampling_distance / (d_sensor/n_pix) *f)
luroth's avatar
luroth committed
20
21
}

luroth's avatar
luroth committed
22
23
calc_flight_height_mm <- function(ground_sampling_distance_mm, d_sensor, n_pix, f) {
  return((ground_sampling_distance_mm/1000) / (d_sensor/n_pix) *f)
24
25
}

luroth's avatar
luroth committed
26
27
calc_hyperfocal_distance <- function(f, aperture, circle_of_confusion) {
  return((f^2)/(aperture*circle_of_confusion) + f)
luroth's avatar
luroth committed
28
29
}

luroth's avatar
luroth committed
30
31
calc_focus_distance <- function(f, aperture, circle_of_confusion, flight_height) {
  hyperfocal_distance <- calc_hyperfocal_distance(f, aperture, circle_of_confusion)
luroth's avatar
luroth committed
32
33
34
35
36
37
38
39
40
  
  focus_dist <- (hyperfocal_distance * sqrt(flight_height))/(sqrt(hyperfocal_distance + flight_height))
  
  focus_dist <- (-hyperfocal_distance^2 + sqrt(hyperfocal_distance^4 + 4 * hyperfocal_distance^2 * flight_height^2))/(2 * flight_height)
  
  focus_dist <- ifelse(focus_dist > hyperfocal_distance, hyperfocal_distance, focus_dist)
  return(focus_dist)
}

luroth's avatar
luroth committed
41
42
43
calc_depth_of_field_near <- function(f, aperture, circle_of_confusion, focus_distance) {
  hyperfocal_distance <- calc_hyperfocal_distance(f, aperture, circle_of_confusion)
  return(focus_distance / ( (focus_distance - f) / (hyperfocal_distance - f) + 1))
luroth's avatar
luroth committed
44
45
}

luroth's avatar
luroth committed
46
47
48
calc_depth_of_field_far <- function(f, aperture, circle_of_confusion, focus_distance) {
  hyperfocal_distance <- calc_hyperfocal_distance(f, aperture, circle_of_confusion)
  return(ifelse(focus_distance <= hyperfocal_distance, (focus_distance / ( (f - focus_distance) / (hyperfocal_distance - f) + 1)), Inf))
luroth's avatar
luroth committed
49
50
51
52
53
54
55
}

calc_shutter_speed <- function(exposure_value, aperture, iso=100) {
  return(1/((25 * aperture^2 * 2^(2-exposure_value))/(iso)))
}

calc_iso <- function(exposure_value, aperture, shutter_speed) {
luroth's avatar
luroth committed
56
57
  
  return(25.0 * as.numeric(aperture)^2.0 * 2.0^(2.0-as.numeric(exposure_value))/(1.0/as.numeric(shutter_speed)))
luroth's avatar
luroth committed
58
59
}

luroth's avatar
luroth committed
60
61
calc_spacing_exposure_station <- function(end_lap, ground_field_of_view_x) {
  return(ground_field_of_view_x - ((end_lap/100) * ground_field_of_view_x))
luroth's avatar
luroth committed
62
63
}

luroth's avatar
luroth committed
64
65
calc_spacing_flight_lines <- function(side_lap, ground_field_of_view_y) {
  return(ground_field_of_view_y - (side_lap/100) * ground_field_of_view_y)
luroth's avatar
luroth committed
66
67
}

luroth's avatar
luroth committed
68
69
calc_end_lap <- function(spacing_exposure_station, ground_field_of_view_x) {
  return(100 - (spacing_exposure_station/ ground_field_of_view_x)*100)
luroth's avatar
luroth committed
70
71
}

luroth's avatar
luroth committed
72
73
calc_side_lap <- function(spacing_flight_lines, ground_field_of_view_y) {
  return(100 - (spacing_flight_lines/ ground_field_of_view_y)*100)
luroth's avatar
luroth committed
74
75
}

luroth's avatar
luroth committed
76
77
calc_flight_speed <- function(ground_sampling_distance, motion_blur, shutter_speed) {
  return(((ground_sampling_distance)*motion_blur) / (1/shutter_speed))
luroth's avatar
luroth committed
78
79
}

luroth's avatar
luroth committed
80
81
calc_image_recording_speed <- function(flight_speed, spacing_exposure_station) {
  return(flight_speed / spacing_exposure_station)
luroth's avatar
luroth committed
82
83
}

luroth's avatar
luroth committed
84
85
calc_flight_duration <- function(distance_area_x, ground_field_of_view_x, distance_area_y, ground_field_of_view_y, spacing_flight_lines, flight_speed) {
  distance <- 1 * (distance_area_x + ceiling(ground_field_of_view_x / (2 * spacing_flight_lines))) * 2 * spacing_flight_lines + (distance_area_x/spacing_flight_lines) * (distance_area_y + ground_field_of_view_y)
luroth's avatar
luroth committed
86
87
88
89
  duration <- (distance / flight_speed) / 60
  return(duration)
}

luroth's avatar
luroth committed
90
calc_pixel_freq <- function(plot_size, spacing, no_of_lanes, position_precision_sd, n_pix, ground_sampling_distance, use_uniform=FALSE) {
luroth's avatar
luroth committed
91
  
luroth's avatar
luroth committed
92
93
  # Initialize sensor axis
  pixels <- 1:n_pix
luroth's avatar
luroth committed
94
  # Positions of plots, pixel position as index, TRUE as value if plot present, else FALSE
luroth's avatar
luroth committed
95
  plot_positions <- ifelse(seq(1, n_pix + no_of_lanes*spacing/ground_sampling_distance) %% round(plot_size/ground_sampling_distance) + round(plot_size/(ground_sampling_distance*2))  == round(plot_size/(ground_sampling_distance)), TRUE, FALSE)
luroth's avatar
luroth committed
96
97
  
  # Get camera views on plots
luroth's avatar
luroth committed
98
  sensor_views <- rollapply(data=plot_positions, width=n_pix, by=round(spacing/ground_sampling_distance), FUN = function(x) x)
luroth's avatar
luroth committed
99
100
101
102
103
104
105
106
  
  # Calculate frequency of plots at specific sensor position
  sensor_position_freq <- apply(sensor_views, MARGIN=c(2), sum)
  # Normalize
  sensor_position_freq <- sensor_position_freq / sum(sensor_position_freq)
  
  # Normal distribution for each sensor pixel
  if(!use_uniform) {
luroth's avatar
luroth committed
107
    pixel_distribution <- mapply(pixels, FUN=function(z) {dnorm(x=pixels, sd=position_precision_sd/ground_sampling_distance, mean=z)})
luroth's avatar
luroth committed
108
  } else {
luroth's avatar
luroth committed
109
    pixel_distribution <- mapply(pixels, FUN=function(z) {dunif(x=pixels, min=z-(position_precision_sd/ground_sampling_distance), max=z+(position_precision_sd/ground_sampling_distance))})
luroth's avatar
luroth committed
110
111
112
113
114
115
116
117
  }
  # Sweep over columns and multiply with occurance frequency of sensor at this position
  pixel_distribution_sens <- sweep(pixel_distribution, MARGIN=2, sensor_position_freq, '*')
  # Sum up result
  pixel_frequency <- rowSums(pixel_distribution_sens)
  # Normalize
  pixel_frequency <- pixel_frequency / sum(pixel_frequency)

luroth's avatar
luroth committed
118
  pixel_frequency_data <- data.frame(x=1:n_pix, freq=pixel_frequency)
luroth's avatar
luroth committed
119
120
121
122
  
  return(pixel_frequency_data)
}

luroth's avatar
luroth committed
123
calc_pixel_freq_xy <- function(plot_size_x, plot_size_y, spacing_x, spacing_y, no_of_lanes_x, no_of_lanes_y, n_pix_x, n_pix_y, position_precision_sd, ground_sampling_distance) {
luroth's avatar
luroth committed
124
  
luroth's avatar
luroth committed
125
126
  pixel_frequency_data_x <- calc_pixel_freq(plot_size_x, spacing_x, no_of_lanes_x, position_precision_sd, n_pix_x, ground_sampling_distance)
  pixel_frequency_data_y <- calc_pixel_freq(plot_size_y, spacing_y, no_of_lanes_y, position_precision_sd, n_pix_y, ground_sampling_distance, use_uniform = TRUE)
luroth's avatar
luroth committed
127
128
129
130
131
132
133
134
135
136
  
  pixel_frequency_data_xy <- unlist(pixel_frequency_data_y[,'freq']) %o% unlist(pixel_frequency_data_x[,'freq'])
  pixel_frequency_data_xy <- (pixel_frequency_data_xy / max(pixel_frequency_data_xy))
  return(list(pixel_frequency_data_xy, pixel_frequency_data_x, pixel_frequency_data_y))
}


long2UTM <- function(long) {
  (floor((long + 180)/6) %% 60) + 1
}