-
Notifications
You must be signed in to change notification settings - Fork 20
/
Copy pathframes_graph.R
199 lines (177 loc) · 10.9 KB
/
frames_graph.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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
#' Create frames of movement-environment interaction graphs for animation
#'
#' \code{frames_graph} creates a list of \code{ggplot2} graphs displaying movement-environment interaction. Each object represents a single frame. Each frame can be viewed or modified individually. The returned list of frames can be animated using \code{\link{animate_frames}}.
#'
#' @inheritParams frames_spatial
#' @param return_data logical, if \code{TRUE}, instead of a list of frames, a \code{data.frame} containing the values extracted from \code{r_list} per individual, location and time is returned. This \code{data.frame} can be used to create your own multi- or monotemporal \code{ggplot2} movement-environemnt interaction graphs.
#' @param graph_type character, defines the type of multi-temporal graph that should be drawn as frames. Currently supported graphs are:
#' \itemize{
#' \item \code{"flow"}, a time flow graph with frame time on the x axis and values of the visited cell at x on the y axis per individual track
#' \item \code{"hist"}, a cumulative histogram with cell values on the x axis and time-cumulative counts of visits on the y axis per individual track.
#' }
#' @param val_min numeric, minimum value of the value axis. If undefined, the minimum is collected automatically.
#' @param val_max numeric, maximum value of the value axis. If undefined, the maximum is collected automatically.
#' @param val_by numeric, increment of the value axis sequence. Default is 0.1. If \code{graph_type = "discrete"}, this value should be an integer of 1 or greater.
#'
#' @details To later on side-by-side join spatial frames created using \code{\link{frames_spatial}} with frames created with \code{\link{frames_graph}} for animation,
#' equal inputs must have been used for both function calls for each of the arguments \code{m}, \code{r_list}, \code{r_times} and \code{fade_raster}.
#'
#' If argument \code{path_colours} is not defined (set to \code{NA}), path colours can be defined by adding a character column named \code{colour} to \code{m}, containing a colour code or name per row (e.g. \code{"red"}. This way, for example, column \code{colour} for all rows belonging to individual A can be set to \code{"green"}, while column \code{colour} for all rows belonging to individual B can be set to \code{"red"}.
#' Colours could also be arranged to change through time or by behavioral segments, geographic locations, age, environmental or health parameters etc. If a column name \code{colour} in \code{m} is missing, colours will be selected automatically. Call \code{colours()} to see all available colours in R.
#'
#' @return An object of class \code{moveVis}. If \code{return_data} is \code{TRUE}, a \code{data.frame} is returned (see \code{return_data}).
#'
#' @author Jakob Schwalb-Willmann
#'
#' @importFrom raster compareCRS nlayers minValue maxValue extract
#' @importFrom sf st_crs
#' @importFrom move n.indiv
#'
#' @examples
#' library(moveVis)
#' library(move)
#' library(ggplot2)
#'
#' data("move_data", "basemap_data")
#' # align movement
#' m <- align_move(move_data, res = 4, unit = "mins")
#'
#' r_list <- basemap_data[[1]]
#' r_times <- basemap_data[[2]]
#'
#' \dontrun{
#' # use the same inputs to create a non-spatial graph, e.g. a flow graph:
#' frames.gr <- frames_graph(m, r_list = r_list, r_times = r_times, r_type = "gradient",
#' fade_raster = TRUE, graph_type = "flow")
#' # take a look
#' frames.gr[[100]]
#'
#' # make a histogram graph:
#' frames.gr <- frames_graph(m, r_list = r_list, r_times = r_times, r_type = "gradient",
#' fade_raster = TRUE, graph_type = "hist")
#' # change the value interval:
#' frames.gr <- frames_graph(m, r_list = r_list, r_times = r_times, r_type = "gradient",
#' fade_raster = TRUE, graph_type = "hist", val_by = 0.01)
#'
#' frames.gr[[100]]
#' # manipulate the labels, since now they are very dense:
#' # just replace the current scale
#' frames.gr <- add_gg(frames.gr, expr(scale_x_continuous(breaks=seq(0,1,0.1),
#' labels=seq(0,1,0.1), expand = c(0,0))))
#' frames.gr[[100]]
#'
#' # the same can be done for discrete data, histogram will then be shown as bin plots
#'
#' # to make your own graphs, use frames_graph to return data instead of frames
#' frames.gr <- frames_graph(m, r_list = r_list, r_times = r_times, r_type = "gradient",
#' fade_raster = TRUE, return_data = TRUE)
#'
#' # then simply animate the frames using animate_frames
#' # see all add_ functions on how to customize your frames created with frames_spatial
#' # or frames_graph
#'
#' # see ?animate_frames on how to animate frames
#' }
#' @seealso \code{\link{frames_spatial}} \code{\link{join_frames}} \code{\link{animate_frames}}
#' @export
frames_graph <- function(m, r_list, r_times, r_type = "gradient", fade_raster = FALSE, crop_raster = TRUE, return_data = FALSE, graph_type = "flow", path_size = 1, path_colours = NA, path_legend = TRUE, path_legend_title = "Names",
val_min = NULL, val_max = NULL, val_by = 0.1, verbose = T){
## check input arguments
if(inherits(verbose, "logical")) options(moveVis.verbose = verbose)
if(all(!c(inherits(m, "MoveStack"), inherits(m, "Move")))) out("Argument 'm' must be of class 'Move' or 'MoveStack'.", type = 3)
## check m time conformities
.time_conform(m)
if(all(!is.list(r_list), inherits(r_list, "Raster"))) r_list <- list(r_list)
if(is.character(r_type)){
if(!any(r_type == c("gradient", "discrete"))) out("Argument 'r_type' must be either 'gradient' or 'discrete'.", type = 3)
} else{ out("Argument 'r_type' must be of type 'character'.", type = 3)}
if(!inherits(r_list[[1]], "RasterLayer")) out("Argument 'r_list' must contain single-layer 'RasterLayer' objects. Multi-layer 'RasterStack' objects are not supported by this function.", type = 3)
if(any(!sapply(r_list, compareCRS, y = m))) out("Projections of 'm' and 'r_list' differ.", type = 3)
if(length(unique(sapply(r_list, nlayers))) > 1) out("Number of layers per raster object in list 'r' differ.", type = 3)
if(!inherits(r_times, "POSIXct")) out("Argument 'r_times' must be of type 'POSIXct' if 'r_list' is defined.", type = 3)
if(!is.logical(fade_raster)) out("Argument 'fade_raster' has to be either TRUE or FALSE.", type = 3)
if(!is.numeric(path_size)) out("Argument 'path_size' must be of type 'numeric'.", type = 3)
if(is.character(path_colours)) if(length(path_colours) != n.indiv(m)) out("Argument 'path_colours' must be of same length as the number of individual tracks of 'm', if defined. Alternatively, use a column 'colour' for individual colouring per coordinate within 'm' (see details of ?frames_spatial).", type = 3)
if(!is.logical(path_legend)) out("Argument 'path_legend' must be of type 'logical'.", type = 3)
if(!is.character(path_legend_title)) out("Argument 'path_legend_title' must be of type 'character'.", type = 3)
if(!is.logical(return_data)) out("Argument 'return_data' must be of type 'logical'.", type = 3)
## check graph_type and hist arguments
if(!is.character(graph_type)){
out("Argument 'graph_type' must be of type character.", type = 3)
} else{
if(!any(graph_type == c("flow", "hist"))) out("Argument 'graph_type' must be either 'flow' or 'hist'.", type = 3)
}
if(graph_type == "hist"){
if(!is.null(val_min)) if(!is.numeric(val_min)) out("Argument 'val_min' must be of type 'numeric', if defined.", type = 3)
if(!is.null(val_max)) if(!is.numeric(val_max)) out("Argument 'val_max' must be of type 'numeric', if defined.", type = 3)
if(!is.numeric(val_by)) out("Argument 'val_by' must be of type 'numeric'.", type = 3)
}
## warnings
if(r_type == "discrete" & fade_raster == T) out("Argument 'fade_raster' is TRUE, while argument 'r_type' is set to 'discrete'. Interpolating discrete values will destroy discrete classes!", type = 2)
if(r_type == "discrete" & !val_by%%1==0) out("Argument 'val_by' is fractional, while argument 'r_type' is set to 'discrete'. You may want to set 'val_by' to 1 or another integer for discrete classes.", type = 2)
## create data.frame from m with frame time and colour
out("Processing movement data...")
m.df <- .m2df(m, path_colours = path_colours)
.stats(max(m.df$frame))
## create raster list
r_list <- .rFrames(r_list = r_list, r_times = r_times, m.df = m.df, gg.ext = .ext(m.df, st_crs(m)), fade_raster = fade_raster, crop_raster = crop_raster)
if(length(r_list) == 1){
m.df$value <- sapply(1:nrow(m.df), function(i) raster::extract(r_list[[1]], m.df[i, c("x", "y")]), USE.NAMES = F)
} else{
m.df$value <- sapply(1:nrow(m.df), function(i) raster::extract(r_list[[m.df[i,]$frame]], m.df[i, c("x", "y")]), USE.NAMES = F)
}
## create value sequence
if(is.null(val_min)) val_min <- floor(min(sapply(r_list, minValue), na.rm = T))
if(is.null(val_max)) val_max <- ceiling(max(sapply(r_list, maxValue), na.rm = T))
val_digits <- nchar(strsplit(as.character(val_by), "[.]")[[1]][2])
if(is.na(val_digits)) val_digits <- 0
val_seq <- seq(val_min, val_max, by = val_by)
if(isTRUE(return_data)){
return(m.df)
} else{
## create frames
out("Creating frames...")
# if(graph_type == "flow"){
# #frames <- .gg_flow(m.df, path_legend, path_legend_title, path_size, val_seq)
# }
hist_data <- NULL
if(graph_type == "hist"){
dummy <- do.call(rbind, lapply(unique(m.df$id), function(id){
cbind.data.frame(count = 0, value = val_seq, id = id, name = unique(m.df[m.df$id == id,]$name),
colour = unique(m.df[m.df$id == id,]$colour))
}))
## Calculating time-cumulative value histogram per individual and timestep
#out("Calculating histogram...")
hist_data <- lapply(1:max(m.df$frame), function(i, d = dummy){
x <- m.df[unlist(lapply(1:i, function(x) which(m.df$frame == x))),]
x <- do.call(rbind, lapply(unique(x$id), function(id){
y <- x[x$id == id,]
z <- table(round(y$value, digits = val_digits))
d.id <- d[d$id == id,]
d.id[match(names(z), as.character(d.id$value)), 1] <- z
#d <- cbind(d, id = unique(y$id), name = unique(y$name), colour = unique(y$colour))
return(d.id)
}))
})
## fusing histograms for plot scaling
# all.hist <- do.call(rbind, hist_data)
#frames <- .gg_hist(hist_data, all.hist, path_legend, path_legend_title, path_size, val_seq, r_type)
}
}
# create frames object
frames <- list(
move_data = m.df,
hist_data = hist_data,
type = paste0("ggplot (", graph_type, " graph)"),
graph_type = graph_type,
aesthetics = list(
path_size = path_size,
path_legend = path_legend,
path_legend_title = path_legend_title,
val_seq = val_seq,
r_type = r_type),
additions = NULL
)
attr(frames, "class") <- c("moveVis", "frames_graph")
return(frames)
}