Fix style with styler:::style_active_pkg()

R/add_colourscale.R

@@ -14,75 +14,80 @@
 #' @author Jakob Schwalb-Willmann
 #'
 #' @importFrom ggplot2 scale_fill_gradientn scale_fill_manual expr
-#' 
+#'
 #' @examples
 #' library(moveVis)
 #' library(move)
-#' 
+#'
 #' data("move_data", "basemap_data")
 #' # align movement
 #' m <- align_move(move_data, res = 4, unit = "mins")
-#' 
+#'
 #' # create spatial frames with frames_spatial:
 #' r_list <- basemap_data[[1]]
 #' r_times <- basemap_data[[2]]
-#' 
+#'
 #' \dontrun{
-#' frames <- frames_spatial(m, r_list = r_list, r_times = r_times, r_type = "gradient",
-#'                          fade_raster = TRUE)
+#' frames <- frames_spatial(m,
+#'   r_list = r_list, r_times = r_times, r_type = "gradient",
+#'   fade_raster = TRUE
+#' )
 #' frames[[100]] # take a look at one of the frames
-#' 
+#'
 #' # default blue is boring, let's change the colour scale of all frames
-#' frames <- add_colourscale(frames, type = "gradient", colours = c("orange", "white", "darkgreen"),
-#'                           legend_title = "NDVI")
+#' frames <- add_colourscale(frames,
+#'   type = "gradient", colours = c("orange", "white", "darkgreen"),
+#'   legend_title = "NDVI"
+#' )
 #' frames[[100]]
-#' 
-#' 
+#'
+#'
 #' # let's make up some classification data with 10 classes
-#' r_list <- lapply(r_list, function(x){
-#'   y <- raster::setValues(x, round(raster::getValues(x)*10))
+#' r_list <- lapply(r_list, function(x) {
+#'   y <- raster::setValues(x, round(raster::getValues(x) * 10))
 #'   return(y)
 #' })
 #' # turn fade_raster to FALSE, since it makes no sense to temporally interpolate discrete classes
-#' frames <- frames_spatial(m, r_list = r_list, r_times = r_times, r_type = "discrete",
-#'                          fade_raster = FALSE)
+#' frames <- frames_spatial(m,
+#'   r_list = r_list, r_times = r_times, r_type = "discrete",
+#'   fade_raster = FALSE
+#' )
 #' frames[[100]]
-#' 
+#'
 #' # now, let's assign a colour per class value to frames
 #' colFUN <- colorRampPalette(c("orange", "lightgreen", "darkgreen"))
 #' cols <- colFUN(10)
 #' frames <- add_colourscale(frames, type = "discrete", colours = cols, legend_title = "Classes")
 #' frames[[100]]
 #' }
-#' 
+#'
 #' @seealso \code{\link{frames_spatial}} \code{\link{frames_graph}} \code{\link{animate_frames}}
 #' @export
 
-add_colourscale <- function(frames, type, colours, labels = waiver(), na.colour = "grey50", na.show = TRUE, legend_title = NULL, verbose = TRUE){
-
+add_colourscale <- function(frames, type, colours, labels = waiver(), na.colour = "grey50", na.show = TRUE, legend_title = NULL, verbose = TRUE) {
   ## checks
-  if(inherits(verbose, "logical")) options(moveVis.verbose = verbose)
-  if(!inherits(frames, "moveVis")) out("Argument 'frames' needs to be of class 'moveVis'. See frames_spatial()).", type = 3)
-  
-  if(!inherits(type, "character")) out("Argument 'type' must be of type 'character'.", type = 3)
-  if(!any(c("gradient", "discrete") %in% type)) out("Argument 'type' must either be 'gradient' or 'discrete'.", type = 3)
-  if(!inherits(colours, "character")) out("Argument 'colours' must be of type 'character'.", type = 3)
-  if(all(type == "discrete", !inherits(labels, "waiver"))){
-    if(!inherits(labels, "character")) out("Argument 'labels' must be of type 'character'.", type = 3)
-    if(length(labels) != length(colours)) out("Arguments 'colours' and 'labels' must have equal lengths.", type = 3)
+  if (inherits(verbose, "logical")) options(moveVis.verbose = verbose)
+  if (!inherits(frames, "moveVis")) out("Argument 'frames' needs to be of class 'moveVis'. See frames_spatial()).", type = 3)
+
+  if (!inherits(type, "character")) out("Argument 'type' must be of type 'character'.", type = 3)
+  if (!any(c("gradient", "discrete") %in% type)) out("Argument 'type' must either be 'gradient' or 'discrete'.", type = 3)
+  if (!inherits(colours, "character")) out("Argument 'colours' must be of type 'character'.", type = 3)
+  if (all(type == "discrete", !inherits(labels, "waiver"))) {
+    if (!inherits(labels, "character")) out("Argument 'labels' must be of type 'character'.", type = 3)
+    if (length(labels) != length(colours)) out("Arguments 'colours' and 'labels' must have equal lengths.", type = 3)
   }
-  if(!inherits(na.colour, "character")) out("Argument 'na.colour' must be of type 'character'.", type = 3)
-  
-  if(type == "gradient"){
-    if(!is.null(names(colours))) limits <- range(as.numeric(names(colours))) else limits <- NULL
+  if (!inherits(na.colour, "character")) out("Argument 'na.colour' must be of type 'character'.", type = 3)
+
+  if (type == "gradient") {
+    if (!is.null(names(colours))) limits <- range(as.numeric(names(colours))) else limits <- NULL
   }
-  if(type == "discrete"){
-    if(!is.null(names(colours))) limits <- names(colours) else limits <- NULL
-    if(!inherits(na.show, "logical")) out("Argument 'na.show' must be of type 'logical'.", type = 3)
+  if (type == "discrete") {
+    if (!is.null(names(colours))) limits <- names(colours) else limits <- NULL
+    if (!inherits(na.show, "logical")) out("Argument 'na.show' must be of type 'logical'.", type = 3)
   }
-  
-  if(type == "gradient") gg.scale <- expr(scale_fill_gradientn(name = legend_title, colours = colours, limits = limits, na.value = na.colour))
-  if(type == "discrete") gg.scale <- expr(scale_fill_manual(name = legend_title, values = colours, labels = labels, limits = limits, na.translate = na.show, na.value = na.colour))
-  
+
+  if (type == "gradient") gg.scale <- expr(scale_fill_gradientn(name = legend_title, colours = colours, limits = limits, na.value = na.colour))
+  if (type == "discrete") gg.scale <- expr(scale_fill_manual(name = legend_title, values = colours, labels = labels, limits = limits, na.translate = na.show, na.value = na.colour))
+
   add_gg(frames, gg.scale, colours = colours, legend_title = legend_title, limits = limits, na.colour = na.colour, na.show = na.show)
 }

R/add_gg.R

@@ -15,114 +15,131 @@
 #' }
 #' @param ... additional (non-iterated) objects that should be visible to \code{gg}.
 #'
-#' @details 
+#' @details
 #' Agrument \code{gg} expects \code{ggplot2} functions handed over as expressions (see \code{\link{expr}}) to avoid their evaluation
-#' before thex are called for the correct frame. Simply wrap your \code{ggplot2} function into \code{expr()} and supply it to 
-#' \code{gg}. To add multiple \code{ggplot2} functions to be applied on every frame, supply an expression containing a list of 
-#' \code{ggplot2} functions (e.g. \code{expr(list(geom_label(...), geom_text(...)))}). This expression would be added to all frames. 
+#' before thex are called for the correct frame. Simply wrap your \code{ggplot2} function into \code{expr()} and supply it to
+#' \code{gg}. To add multiple \code{ggplot2} functions to be applied on every frame, supply an expression containing a list of
+#' \code{ggplot2} functions (e.g. \code{expr(list(geom_label(...), geom_text(...)))}). This expression would be added to all frames.
 #' To add specific \code{ggplot2} functions per frame, supply a list of expressions of the same length as frames. Each expression may
 #' contain a list of \code{ggplot2} functions, if you want to add multiple functions per frame.
-#' 
-#' If \code{data} is used, the \code{ggplot2} expressions supplied with \code{gg} can use the object by the name \code{data} for plotting. 
+#'
+#' If \code{data} is used, the \code{ggplot2} expressions supplied with \code{gg} can use the object by the name \code{data} for plotting.
 #' If \code{data} is a list, it must be of the same length as \code{frames}. The list will be iterated, so that functions in \code{gg}
 #' will have access to the individual objects within the list by the name \code{data} per each frame. If the data you want to display
 #' is does not change with frames and may only be a character vector or similiar, you may not need \code{data}, as you can supply
 #' the needed values within the expression supplied through \code{gg}.
-#' 
+#'
 #' If you supply \code{gg} as a list of expressions for each frame and \code{data} as a list of objects (e.g. data.frames) for each frame,
-#' each frame will be manipulated with the corresponding \code{ggplot2} function and the corresponding data. 
+#' each frame will be manipulated with the corresponding \code{ggplot2} function and the corresponding data.
 #'
 #' @return A frames object of class \code{moveVis}.
 #' @author Jakob Schwalb-Willmann
-#' 
+#'
 #' @examples
 #' library(moveVis)
 #' library(move)
 #' library(ggplot2)
-#' 
+#'
 #' data("move_data", "basemap_data")
 #' # align movement
 #' m <- align_move(move_data, res = 4, unit = "mins")
-#' 
+#'
 #' \dontrun{
 #' frames <- frames_spatial(m, map_service = "osm", map_type = "watercolor")
 #' frames[[100]] # take a look at one of the frames
-#' 
+#'
 #' # let's draw a polygon on frames:
-#' data <- data.frame(x = c(8.917, 8.924, 8.924, 8.916, 8.917),
-#'                    y = c(47.7678, 47.7675, 47.764, 47.7646, 47.7678))
-#'                    
-#' frames = add_gg(frames, gg = expr(geom_path(aes(x = x, y = y), data = data,
-#'                                             colour = "red", linetype = "dashed")), data = data)
-#'                         
+#' data <- data.frame(
+#'   x = c(8.917, 8.924, 8.924, 8.916, 8.917),
+#'   y = c(47.7678, 47.7675, 47.764, 47.7646, 47.7678)
+#' )
+#'
+#' frames <- add_gg(frames, gg = expr(geom_path(aes(x = x, y = y),
+#'   data = data,
+#'   colour = "red", linetype = "dashed"
+#' )), data = data)
+#'
 #' # add some text
-#' frames <- add_text(frames, "Static feature", x = 8.9205, y = 47.7633,
-#'                     colour = "black", size = 3)
+#' frames <- add_text(frames, "Static feature",
+#'   x = 8.9205, y = 47.7633,
+#'   colour = "black", size = 3
+#' )
 #' frames[[100]]
-#' 
+#'
 #' # add_gg can also be used iteratively to manipulate each frame differently.
 #' # Let's create unique polygons per frame:
-#' 
+#'
 #' # create data.frame containing corner coordinates
-#' data <- data.frame(x = c(8.96, 8.955, 8.959, 8.963, 8.968, 8.963, 8.96),
-#'                    y = c(47.725, 47.728, 47.729, 47.728, 47.725, 47.723, 47.725))
+#' data <- data.frame(
+#'   x = c(8.96, 8.955, 8.959, 8.963, 8.968, 8.963, 8.96),
+#'   y = c(47.725, 47.728, 47.729, 47.728, 47.725, 47.723, 47.725)
+#' )
 #' # make a list from it by replicating it by the length of frames
 #' data <- rep(list(data), length.out = length(frames))
-#' 
+#'
 #' # now alter the coordinates to make them shift
-#' data <- lapply(data, function(x){
-#'   y <- rnorm(nrow(x)-1, mean = 0.00001, sd = 0.0001) 
+#' data <- lapply(data, function(x) {
+#'   y <- rnorm(nrow(x) - 1, mean = 0.00001, sd = 0.0001)
 #'   x + c(y, y[1])
 #' })
-#' 
+#'
 #' # draw each individual polygon to each frame
-#' frames = add_gg(frames, gg = expr(geom_path(aes(x = x, y = y), data = data,
-#'                                             colour = "black")), data = data)
-#'                                             
+#' frames <- add_gg(frames, gg = expr(geom_path(aes(x = x, y = y),
+#'   data = data,
+#'   colour = "black"
+#' )), data = data)
+#'
 #' # add a text label
-#' frames <- add_text(frames, "Dynamic feature", x = 8.959, y = 47.7305,
-#'                    colour = "black", size = 3)
+#' frames <- add_text(frames, "Dynamic feature",
+#'   x = 8.959, y = 47.7305,
+#'   colour = "black", size = 3
+#' )
 #' frames[[100]]
-#' 
+#'
 #' # animate frames to see how the polygons "flip"
 #' animate_frames(frames, out_file = tempfile(fileext = ".mov"))
-#' 
+#'
 #' # you can use add_gg on any list of ggplot2 objects,
 #' # also on frames made using frames_gr
 #' r_list <- basemap_data[[1]]
 #' r_times <- basemap_data[[2]]
-#' 
-#' 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]]                         
+#'
+#' 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 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 <- 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]]
 #' }
-#' 
+#'
 #' @seealso \code{\link{frames_spatial}} \code{\link{frames_graph}} \code{\link{animate_frames}}
 #' @export
 
-add_gg <- function(frames, gg, data = NULL, ..., verbose = T){
-
+add_gg <- function(frames, gg, data = NULL, ..., verbose = T) {
   ## check data and replicate if necessary
-  if(inherits(data, "list")){
-    if(length(data) != length(frames)) out("Argument 'data' is a list und thus must be of same length as 'frames'.", type = 3)
-  } else{
-    if(!is.null(data)) data <- rep(list(data), length(frames))
+  if (inherits(data, "list")) {
+    if (length(data) != length(frames)) out("Argument 'data' is a list und thus must be of same length as 'frames'.", type = 3)
+  } else {
+    if (!is.null(data)) data <- rep(list(data), length(frames))
   }
-  
+
   ## gg is not a list, make it one
-  if(inherits(gg, "list")){
-    if(length(gg) != length(frames)) out("Argument 'gg' is a list und thus must be of same length as 'frames'.", type = 3)
-  } else{
-    if(length(gg) != length(frames)) gg <- rep(list(gg), length(frames))
+  if (inherits(gg, "list")) {
+    if (length(gg) != length(frames)) out("Argument 'gg' is a list und thus must be of same length as 'frames'.", type = 3)
+  } else {
+    if (length(gg) != length(frames)) gg <- rep(list(gg), length(frames))
   }
-  if(!is.call(gg[[1]])) out("Argument 'gg' must be an expression or a list of expressions (see ?moveVis::add_gg and ?ggplot2::expr).", type = 3)
-
-  if(is.null(frames$additions)) frames$additions <- list(list(expr = gg, data = data, arg = list(...))) else{
+  if (!is.call(gg[[1]])) out("Argument 'gg' must be an expression or a list of expressions (see ?moveVis::add_gg and ?ggplot2::expr).", type = 3)
+
+  if (is.null(frames$additions)) {
+    frames$additions <- list(list(expr = gg, data = data, arg = list(...)))
+  } else {
     frames$additions <- c(frames$additions, list(list(expr = gg, data = data, arg = list(...))))
   }
   return(frames)

R/add_labels.R

@@ -17,48 +17,52 @@
 #'
 #' @importFrom ggplot2 labs waiver theme element_text expr
 #'
-#' @examples 
+#' @examples
 #' library(moveVis)
 #' library(move)
-#' 
+#'
 #' data("move_data", "basemap_data")
 #' m <- align_move(move_data, res = 4, unit = "mins")
-#' 
+#'
 #' # create spatial frames using a custom NDVI base layer
 #' r_list <- basemap_data[[1]]
 #' r_times <- basemap_data[[2]]
-#' 
+#'
 #' \dontrun{
-#' frames <- frames_spatial(m, r_list = r_list, r_times = r_times, r_type = "gradient",
-#'                          fade_raster = TRUE)
-#' 
+#' frames <- frames_spatial(m,
+#'   r_list = r_list, r_times = r_times, r_type = "gradient",
+#'   fade_raster = TRUE
+#' )
+#'
 #' # add labels to frames:
-#' frames <- add_labels(frames, title = "Example animation using moveVis::add_labels()", 
-#'                      subtitle = "Adding a subtitle to frames created using frames_spatial()",
-#'                      caption = "Projection: Geographical, WGS84. Sources: moveVis examples.",
-#'                      x = "Longitude", y = "Latitude")
+#' frames <- add_labels(frames,
+#'   title = "Example animation using moveVis::add_labels()",
+#'   subtitle = "Adding a subtitle to frames created using frames_spatial()",
+#'   caption = "Projection: Geographical, WGS84. Sources: moveVis examples.",
+#'   x = "Longitude", y = "Latitude"
+#' )
 #' # have a look at one frame
 #' frames[[100]]
 #' }
-#' 
+#'
 #' @seealso \code{\link{frames_spatial}} \code{\link{frames_graph}} \code{\link{animate_frames}}
 #' @export
 
 add_labels <- function(frames, title = waiver(), subtitle = waiver(), caption = waiver(), tag = waiver(),
-                       x = waiver(), y = waiver(), verbose = TRUE){
-
+                       x = waiver(), y = waiver(), verbose = TRUE) {
   ## checks
-  if(inherits(verbose, "logical")) options(moveVis.verbose = verbose)
-  if(!inherits(frames, "moveVis")) out("Argument 'frames' needs to be of class 'moveVis'. See frames_spatial()).", type = 3)
-  
+  if (inherits(verbose, "logical")) options(moveVis.verbose = verbose)
+  if (!inherits(frames, "moveVis")) out("Argument 'frames' needs to be of class 'moveVis'. See frames_spatial()).", type = 3)
+
   waiver.args <- list(title = title, subtitle = subtitle, caption = caption, tag = tag, x = x, y = y)
   waiver.which <- sapply(waiver.args, function(x) inherits(x, "waiver"))
-  if(all(waiver.which)) out("At least one label argument has to be defined.", type = 3)
-  if(any(!sapply(waiver.args[!waiver.which], function(x) any(is.character(x), is.null(x))))) out("Label arguments must be of type character, NULL to remove a label or waiver() to keep an already set label.", type = 3)
-  
+  if (all(waiver.which)) out("At least one label argument has to be defined.", type = 3)
+  if (any(!sapply(waiver.args[!waiver.which], function(x) any(is.character(x), is.null(x))))) out("Label arguments must be of type character, NULL to remove a label or waiver() to keep an already set label.", type = 3)
+
   add_gg(frames, gg = expr(
-    list(labs(title = title, subtitle = subtitle, caption = caption, tag = tag, x = x, y = y),
-         theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust = 0.5), plot.caption = element_text(hjust = 0.5))
+    list(
+      labs(title = title, subtitle = subtitle, caption = caption, tag = tag, x = x, y = y),
+      theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust = 0.5), plot.caption = element_text(hjust = 0.5))
     )
-  ),title = title, subtitle = subtitle, caption = caption, tag = tag, x = x, y = y)
+  ), title = title, subtitle = subtitle, caption = caption, tag = tag, x = x, y = y)
 }