/
get_fire_mov.R
148 lines (124 loc) · 4.37 KB
/
get_fire_mov.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
#' Calculation of the fire movement
#'
#' This function calculates the movement of a single fire per `step` time
#' indexes. It collects hot spots per `step` time indexes, then
#' takes the mean or median of the longitude and latitude as the centre of the
#' fire.
#'
#' @param result `spotoroo` object. A result of a call to [hotspot_cluster()].
#' @param cluster Integer. The membership label of the cluster.
#' @param step Integer (>0). Step size used in the calculation of the
#' fire movement.
#' @param method Character. Either "mean" or "median",
#' method of the calculation of
#' the centre of the fire.
#' @return A data.frame. The fire movement.
#' \itemize{
#' \item \code{membership} : Membership labels.
#' \item \code{lon} : Longitude of the centre of the fire.
#' \item \code{lat} : Latitude of the centre of the fire.
#' \item \code{timeID} : Time indexes.
#' \item \code{obsTime} : Observed time (approximated).
#' \item \code{ignition} : Whether or not it is a ignition point.
#' }
#' @examples
#'
#' \donttest{
#'
#' # Time consuming functions (>5 seconds)
#'
#'
#' # Get clustering results
#' result <- hotspot_cluster(hotspots,
#' lon = "lon",
#' lat = "lat",
#' obsTime = "obsTime",
#' activeTime = 24,
#' adjDist = 3000,
#' minPts = 4,
#' minTime = 3,
#' ignitionCenter = "mean",
#' timeUnit = "h",
#' timeStep = 1)
#'
#' # Get fire movement of the first cluster
#' mov1 <- get_fire_mov(result, cluster = 1, step = 3, method = "mean")
#' mov1
#'
#' # Get fire movement of the second cluster
#' mov2 <- get_fire_mov(result, cluster = 2, step = 6, method = "median")
#' mov2
#' }
#'
#'
#' @export
get_fire_mov <- function(result, cluster, step = 1, method = "mean"){
# check class
if (!"spotoroo" %in% class(result)) {
stop('Needs a "spotoroo" object as input.')
}
# safety check
is_length_one_bundle(cluster, method, step)
check_type("numeric", cluster, step)
check_type("character", method)
step <- round(step)
is_positive(step)
# if cluster does not exist
if (cluster == -1) {
stop("Can not calculate the movement of noise.")
}
if (!cluster %in% result$hotspots$membership) {
stop(paste("Cluster", cluster, "does not exist!"))
}
# extract hot spots from this cluster
indexes <- result$hotspots$membership == cluster
all_hotspots <- result$hotspots[indexes, ]
# init vectors
indexes <- result$ignition$membership == cluster
fin_lon <- result$ignition$lon[indexes]
fin_lat <- result$ignition$lat[indexes]
fin_obsTime <- result$ignition$obsTime[indexes]
fin_timeID <- result$ignition$timeID[indexes]
fin_ignition <- TRUE
j <- 0
temp_lon <- c()
temp_lat <- c()
# for each time ID
if (min(all_hotspots$timeID) + 1 <= max(all_hotspots$timeID)) {
for (i in (min(all_hotspots$timeID) + 1):max(all_hotspots$timeID)) {
j <- j + 1
# if no hot spots in this time ID
if (sum(all_hotspots$timeID == i) == 0) next
# extract hotspots in this time ID
current_hotspots <- all_hotspots[all_hotspots$timeID == i, ]
temp_lon <- c(temp_lon, current_hotspots$lon)
temp_lat <- c(temp_lat, current_hotspots$lat)
if (j >= step) {
j <- 0
# calculate centroid lon and lat
if (method == "mean") {
fin_lon <- c(fin_lon, mean(temp_lon))
fin_lat <- c(fin_lat, mean(temp_lat))
} else {
fin_lon <- c(fin_lon, stats::median(temp_lon))
fin_lat <- c(fin_lat, stats::median(temp_lat))
}
# append obsTime and timeID
fin_obsTime <- c(fin_obsTime, max(current_hotspots$obsTime))
fin_timeID <- c(fin_timeID, i)
fin_ignition <- c(fin_ignition, FALSE)
temp_lon <- c()
temp_lat <- c()
}
}
}
# bind output
fin_data_set <- data.frame(membership = cluster,
lon = fin_lon,
lat = fin_lat,
timeID = fin_timeID,
obsTime = fin_obsTime,
ignition = fin_ignition)
# return output
fin_data_set
}