rtsVis: Raster Time Series Visualization

Documented in ts_flow_frames

#' Create a series of charts of a raster time series
#'
#' @param r_list list of rasters, as generated by \code{\link{ts_raster}}. 
#' @param positions (Optional) object containing the coordinates. One of \itemize{
##'  \item{A two-column \code{matrix} of coordinates where the first column corresponds to the longitude and the second column corresponds to the latitude.}
##'  \item{A \code{SpatialPolygonsDataFrame} }
##'  \item{A \code{SpatialPointsDataFrame} }
##'  \item{An sf object containing \code{POINTS},\code{POLYGONS} or \code{MULTIPOLYGONS}}
##' }If no positions are specified, one position is assumed to be the entire extent of the rasters.
#' @param position_names (Optional) character, names of the positions to be added in legend or text. By default, will create placeholder names by combining the object type and Id (Example: "Polygon 3")
#' @param val_min (Optional) numeric, minimum value of the y-axis. By default chooses a rounded minimum value of the rasters contained within \code{r_list}.
#' @param val_max (Optional) numeric, maximum value of the y-axis. By default chooses a rounded maximum value of the rasters contained within \code{r_list}.
#' @param val_by (Optional) numeric, interval value of the y-axis. Default is \code{0.1}.
#' @param band_names (Optional) character, names of the bands to be added in legend, if \code{band_legend}. By default, will create placeholder names by band index (Example: "Band 3").
#' @param band_colors (Optional) character, colors which represent the bands in the plot. Must be in matching order to \code{band_names}. If \code{r_list} is discrete, the colors will be mapped to the different levels.  By default will use ggplot colors.
#' @param position_legend (Optional) logical. If \code{TRUE}: Add a legend for the positions. Only recommended if \code{aes_by_pos} is also  \code{TRUE}.
#' @param legend_position  (Optional) character, position of the legend. Use \code{"none"} to disable all legends. Default is \code{"right"}.
#' @param band_legend (Optional) logical. If \code{TRUE}: Add a legend for the bands. Default is \code{TRUE}.
#' @param band_legend_title (Optional) character, title of the band legend. Default is \code{"Bands"}.
#' @param position_legend_title (Optional) character, title of the band legend. Default is \code{"Positions"}.
#' @param pbuffer  (Optional) numeric. The radius of a buffer around each object which will be applied before extraction. By default, no buffer is used.
#' @param plot_function (Optional) character or function, type of the plots to produce. Currently supported are \code{'line'}, \code{'line2'}, \code{'vio'}, \code{'dens'}, \code{'dens2'}, \code{'bar_stack'}, \code{'bar_fill'}, \code{'pie'}.One of \itemize{
##'  \item{\code{'line'} A line chart, suited for comparing trends between bands}
##'  \item{\code{'line2'} A line chart, suited for comparing trends between positions}
##'  \item{\code{'vio'} A density chart, suited for comparing of distributions across bands and positions}
##'  \item{\code{'dens'}  A density chart, suited for comparing of distributions across positions}
##'  \item{\code{'dens2'}  A density chart, suited for comparing of distributions across bands}
##'  \item{\code{'bar_stack'} A horizontal bar chart, suited for visualizing counts and proportions among discrete data.}
##'  \item{\code{'bar_fill'} A horizontal bar chart, suited for visualizing proportions among discrete data.}
##'  \item{\code{'pie'} A pie chart, suited for visualizing rough proportions among discrete data with few categories.}
##' } Alternatively, a custom function with similar structure and arguments can be passed to create other types of plots. Default is \code{"line"}. 
#' @param aes_by_pos (Optional) logical. If \code{TRUE}: vary the linetype aesthetic to be different for each position? If  \code{FALSE}, this also disables the \code{position_legend}, as no notable classes will be plotted. Ignored by some plot types which inherently map position to facets. Default is \code{TRUE}.
#' @param FUN (Optional) function to summarize the values (e.g. mean) during the extraction. See \link[raster]{extract} for more details. Default is \code{"NULL"}. Summarizing in this way is not sensible for many plot types which visualize distribution or count. Note that usually, summarize statistics will be calculated in an appropriate way by the \code{plot_function} rather than during the extraction.
#' @param plot_size (Optional) numeric, size for the ggplot objects. Default is \code{1}.
#' @param return_df (Optional) logical. Return a dataframe with the extracted values instead of a plot? This can be useful for experimenting with plot creation. Default is \code{FALSE}.
#' @param ... (Optional) additional arguments for \code{plot_function}.
#' @details Values are extracted using \link[raster]{extract} and plotted on a \link[ggplot2]{ggplot}.
#'  The type of the ggplot is specified by \code{plot_function}. Currently supported are \code{"line"} and \code{"violin"} as well as custom functions which accept similar inputs.
#'  The function may fail for large polygons and long time series. Be aware that if \code{\link{ts_raster}} is used with \code{fade}, interpolation may be used to generate raster values. 
#' @author Johannes Mast
#' @import sp ggplot2
#' @importFrom raster getValues
#' @importFrom grDevices hcl.colors
#' @importFrom graphics frame
#' @importFrom dplyr left_join group_size group_by
#' @importFrom forcats as_factor
#' @importFrom stats density filter
#' @importFrom magrittr %>%
#' @importFrom tidyr drop_na
#' @return A list of ggplots, one for each element of \code{r_list}.
#' @seealso \code{\link{ts_raster}}
#' @export
#' @examples 
#' #' #Setup
#' library(rtsVis)
#' # Load example dataset at a greatly increased interval
#' x_list <- MODIS_SI_ds[seq(1,length(MODIS_SI_ds),30)]
#' x_dates <- do.call(c, lapply(MODIS_SI_ds,attr,"time") )[seq(1,length(MODIS_SI_ds),30)]
#' 
#' #Fill NAs
#' x_list_filled <- ts_fill_na(x_list)
#' 
#' #Make a sequence of output dates, double the length of input dates
#' out_dates <-seq.POSIXt(from = x_dates[1],
#'                        to = x_dates[length(x_dates)],length.out = length(x_dates)*2 )
#' 
#' #For each output date, interpolate a raster image from the input files
#' r_list_out <- ts_raster(r_list = x_list_filled,
#'                         r_times = x_dates,
#'                         out_times = out_dates,
#'                         fade_raster = TRUE)
#' #Create the frames 
#' # as from the desired layers
#' r_frames <- ts_makeframes(x_list = r_list_out,samplesize = 10,
#'                           l_indices = c(1,4,3))
#' 
#' # Create a line plot from the data extracted over points
#' points <- SI_positions$points #Polygons of Slovenian municipalities covered by the raster
#' flow_frames_point_line <- rtsVis::ts_flow_frames(r_list = r_list_out,
#'  position_names = c("Ljubljana","Ivancna Gorica","Dolenjske Toplice","Loski Potok"),
#'  band_names = c("620 - 670","841 - 876","459 - 479","545 - 565"),
#'  positions = points,
#'  band_colors = c("firebrick3","darkorchid3","dodgerblue3","olivedrab3"),
#'            band_legend_title = "Wavelength [nm]",
#'            position_legend_title = "Obcina",
#'            legend_position = "bottom",
#'            position_legend = FALSE,
#'            band_legend=TRUE,aes_by_pos = TRUE)
#' 
#' #Check one of the frames
#' flow_frames_point_line[[5]]
#' 
#' 
#' # Create a violin plot from the data extracted over polygons
#' # polygons <- SI_positions$polygons
#' #flow_frames_poly_vio <-
#' #rtsVis::ts_flow_frames(r_list = r_list_out,
#' #           position_names = c("Radece","Ljubljana","Kocevje"),
#' #           band_names = c("620 - 670","841 - 876","459 - 479","545 - 565"),
#' #           positions = polygons,
#' #           band_colors = c("firebrick3","darkorchid3","dodgerblue3","olivedrab3"),
#' #           band_legend_title = "Wavelength [nm]",
#' #           position_legend_title = "Obcina",
#' #           position_legend = FALSE,
#' #          legend_position = "left",
#' #           band_legend=TRUE,aes_by_pos = FALSE,
#' #          plot_function = "vio")
#' #Check one of the frames
#' # flow_frames_poly_vio[[5]]
#' 
ts_flow_frames <- function(r_list,positions=NULL,position_names=NULL,band_names=NULL,band_colors=NULL,val_min=NULL,val_max=NULL,val_by=NULL,plot_size=1,position_legend=NULL,legend_position="right",band_legend=NULL,band_legend_title=NULL,position_legend_title=NULL,pbuffer=NULL,plot_function="line",aes_by_pos=TRUE,FUN=NULL,return_df=FALSE,...){
  
  if(class(r_list)!="list"){
    stop(
      "r_list must be a list of raster objects with associated timestamps."
    )
  }
  
  if (is.null(plot_function)) {
    stop(
      "Please provide a plot_function. plot_function must be 'line', 'violin' or an equivalent custom function."
    )
  } else{
    if (class(plot_function) == "character") {
      if(plot_function == "line") {
        print(paste0("Creating: ", length(r_list), " frames of line plots, colored by bands"))
        plot_function <- .ts_gg_line
      } else if(plot_function == "line2") {
        print(paste0("Creating: ", length(r_list), " frames of line plots, colored by position"))
        plot_function <- .ts_gg_line2
      } else if(plot_function == "vio") {
        print(paste0("Creating: ", length(r_list), " frames of violin plots"))
        plot_function <- .ts_gg_vio
      } else if(plot_function == "violin") {
        print(paste0("Creating: ", length(r_list), " frames of violin plots"))
        plot_function <- .ts_gg_vio
      } else if(plot_function == "dens") {
        print(paste0("Creating: ", length(r_list), " frames of density plots, colored by position"))
        plot_function <- .ts_gg_dens
      } else if(plot_function == "dens2"){
        print(paste0("Creating: ", length(r_list), " frames of density plots, colored by band"))
        plot_function <- .ts_gg_dens2
      }else if(plot_function == "bar_stack"){
        print(paste0("Creating: ", length(r_list), " frames of stacked bar plots"))
        plot_function <- .ts_gg_bar_stack
      }else if(plot_function == "bar_fill"){
        print(paste0("Creating: ", length(r_list), " frames of filled bar plots"))
        plot_function <- .ts_gg_bar_fill
      }else if (plot_function == "pie") {
        print(paste0("Creating: ", length(r_list), " frames of pie plots"))
        plot_function <- .ts_gg_pie
      }
    } else if (!class(plot_function) == "function") {
      stop("plot_function must be on of 'line', 'line2', 'vio', 'dens', 'dens2', 'bar_stack', 'bar_fill', 'pie', or an equivalent custom function.")
    }
  }
  if(is.null(plot_function)){
    stop("No suitable plot function found")
  }
  
  #Ensure nice colors
  if(is.null(band_colors)){
    band_colors <-  hcl.colors((nlayers(r_list[[1]])))
  }
  #Ensure nice df names
  if(is.null(band_names)){
    band_names <- paste0("Band",1:(nlayers(r_list[[1]])))  #make artificial bandnames if necessary
  }
  
  
  #Should legends be plotted? By Default no.
  if(is.null(band_legend)){
    if(is.null(band_legend_title)){
      band_legend=FALSE
    }else{
      band_legend=TRUE
    }
  }
  if(is.null(position_legend)){
    if(is.null(position_legend_title)){
      position_legend=FALSE
    }else{
      position_legend=TRUE
    }
  }
  
  
  # Make Default legend titles
  if(is.null(band_legend_title)){
    band_legend_title <- "Band"
  }
  if(is.null(position_legend_title)){
    position_legend_title <- "Positions"
  }
  
  
  
  # extract the values of the raster into a long dataframe
  extract_df <- .ts_extract_from_frames(r_list_extract = r_list,
                                        positions = positions,
                                        position_names = position_names,
                                        band_names = band_names,
                                        pbuffer= pbuffer,
                                        FUN = FUN)
  
  #For most plots we need the data in long format
  if(TRUE){
    extract_df$position_name <- forcats::as_factor(extract_df$position_name)
    extract_df <-  tidyr::pivot_longer(data = extract_df, cols =  band_names,names_to="band") 
  }
  #Make a df to match colors to band names
  color_matching_table <- cbind(band_names,band_colors)
  extract_df <- dplyr::left_join(extract_df,color_matching_table,by = c("band" = "band_names"),copy=TRUE)
  
  ## create value sequence
  if(is.null(val_min)) val_min <- floor_dec(min(sapply(r_list, function(x){min(getValues(x),na.rm = TRUE)})),level = 2)
  if(is.null(val_max)) val_max <- ceiling_dec(max(sapply(r_list, function(x){max(getValues(x),na.rm=TRUE)})),level = 2)
  
  if(is.null(val_by)){
    #If there are no given vals, just make four
    val_seq <- seq(val_min, val_max, length.out = 4)
  }else{
    #Else make the sequence by the given vals
    val_seq <- seq(val_min, val_max, by = val_by)
  }
  
  
  if(return_df){
    return(extract_df)
  }
  
  # flow_frames <- .lapply(1:max(extract_df$frame), function(i){
  #   plot_function(i=i,
  #                 edf = extract_df,
  #                 bl = band_legend,
  #                 pl = position_legend,
  #                 lp = legend_position,
  #                 blt = band_legend_title,
  #                 plt = position_legend_title,
  #                 ps = plot_size,
  #                 vs = val_seq,
  #                 abp = aes_by_pos,...)
  # })
  
  flow_frames <-  plot_function(
    edf = extract_df,
    bl = band_legend,
    pl = position_legend,
    lp = legend_position,
    blt = band_legend_title,
    plt = position_legend_title,
    ps = plot_size,
    vs = val_seq,
    abp = aes_by_pos,
    ...)
  
  
  
  return(flow_frames)
}