rtsVis: Raster Time Series Visualization

Documented in ts_add_positions_to_frames

#' NULL declaration to suppres R CMD CHECK warning related to tidyverse syntax
#' @keywords internal
#' @noRd
crs <-  NULL

#' Add points, coordinates, or polygons to a list of spatial plots
#'
#' @param r_frame_list list of ggplots, as generated by \code{\link{ts_makeframes}}.
#' @param positions 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} from which \link[sp]{coordinates} can be extracted.}
##'  \item{A \code{SpatialPointsDataFrame} from which \link[sp]{coordinates} can be extracted.}
##'  \item{An sf object containing \code{POINTS},\code{POLYGONS} or \code{MULTIPOLYGONS}}
##' }
#' @param position_names (Optional) character, names of the positions to be added in legend or text (If \code{add_text}). By default, will create placeholder names by combining the object type and Id (Example: *"Polygon 3"*)
#' @param pcol (Optional) character, color of the spatial objects. Default is \code{"red"}.
#' @param psize  (Optional) numeric, plot size of the spatial objects. Default is \code{2}.
#' @param position_legend_title  (Optional) character, title of the legend. Default is \code{"Position"}.
#' @param legend_position  (Optional) character, position of the legend. Use \code{"none"} to disable the legend. Default is \code{"right"}
#' @param aes_by_pos (Optional) logical. If \code{TRUE}: vary some aesthetic (linetype for polygons, shape for points) to be different for each position? If  \code{FALSE}, this also disables the legend, as no notable classes will be plotted. Default is \code{FALSE}. 
#' @param col_by_pos (Optional) logical. If \code{TRUE}: vary the color to be different for each position? If  \code{TRUE}, overrides \code{aes_by_pos} and {pcol}. Default is \code{FALSE}. 
#' @param tcol (Optional) character, if \code{add_text}: The color of the text. Default is \code{"red"}.
#' @param tsize (Optional) numeric, if \code{add_text}: The size of the text. Default is \code{7}.
#' @param ttype (Optional) character, if \code{add_text}: The type of the text. Either \code{"label"} or \code{"text"}. Default is \code{"text"}.
#' @param t_hjust (Optional) numeric, if \code{add_text}: Horizontal offset of the text in map units. Default is \code{0}.
#' @param t_vjust (Optional) numeric, if \code{add_text}: Vertical offset of the text in map units. Default is \code{0}.
#' @param add_text (Optional) logical.  If \code{TRUE}: add a text to each position using \link[moveVis]{add_text}.  Default is \code{"False"}.
#'
#' @details The function takes a \code{positions} object, which can be a spatial object or a matrix of coordinates, and adds them to each of the elements of \code{r_frame_list}. Optionally it also adds text at their respective positions using\link[moveVis]{add_text}.
#' 
#' - \code{ts_add_positions_to_frames} is intended to be an easy way to add multiple objects to the spatial frames at fixed positions. 
#' For adding individual positions or text, potentially at varying positions, it is recommended to all \link[moveVis]{add_gg} and \link[moveVis]{add_text} directly.
#' @seealso \link[moveVis]{add_text} \link[moveVis]{add_gg}
#' @importFrom moveVis add_text add_gg add_labels
#' @importFrom sp coordinates
#' @importFrom sf st_centroid st_coordinates st_geometry   
#' @importFrom ggplot2 geom_sf CoordSf geom_point
#' @import ggplot2  
#' @author Johannes Mast
#' @return A list of ggplots with added positions.
#' @export
#' @examples 
#' #Setup
#'  library(rtsVis)
#'  library(ggplot2)
#'  # 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))
#' 
#' #optional: Use moveVis functions to add additional elements to our frames
#'#library(magrittr)
#'# r_frames <- r_frames %>%
#'#   moveVis::add_labels(x = "Longitude", y = "Latitude")%>% 
#'#   moveVis::add_northarrow(colour = "white", position = "bottomright") %>% 
#'#   moveVis::add_timestamps(type = "label") %>% 
#'#   moveVis::add_progress()
#' 
#' 
#' #### Add the polygons
#' # Add polygons to the frames
#' polygons <- SI_positions$polygons #Polygons of Slovenian municipalities covered by the raster
#' r_frames_style_poly <-
#'   ts_add_positions_to_frames(
#'     r_frame_list = r_frames,
#'     positions = polygons,
#'     psize = 1,
#'     pcol = "red",
#'     position_names = c("Radece", "Ljubljana", "Kocevje"),
#'     position_legend_title = "Obcina",
#'     legend_position = "left",
#'     aes_by_pos = FALSE
#'   )
#' #Look at one of the new frames
#' r_frames_style_poly[5]
#' 
#' #Alternatively add points
#' points <- SI_positions$points #Points in Slovenia
#' r_frames_style_point <- rtsVis::ts_add_positions_to_frames(r_frame_list = r_frames,
#'                                                            positions = points,
#'                                                            psize = 4,
#'                                                            pcol = "orange",
#'                                                            position_names = c("Ljubljana",
#'                                                                               "Ivancna Gorica",
#'                                                                               "Dolenjske Toplice",
#'                                                                               "Loski Potok"),
#'                                                            position_legend_title = "Obcina",
#'                                                            legend_position = "right",
#'                                                            aes_by_pos = TRUE,
#'                                                            add_text = TRUE,
#'                                                            ttype = "label",
#'                                                            tsize = 3,
#'                                                            t_hjust = -3000,
#'                                                            t_vjust = 1000)
#' #Look at one of the new frames
#' # r_frames_style_point[5]
#' 
#' 
#' #Alternatively add points
#' # points_mat <- SI_positions$points_matrix #Points in Slovenia
#' # r_frames_style_point_mat <- ts_add_positions_to_frames(r_frame_list = r_frames,
#' #                                                       positions = points_mat,
#' #                                                       psize = 4,
#' #                                                       pcol = "orange",
#' #                                                       position_names = c("A",
#' #                                                                          "B" ),
#' #                                                      position_legend_title = "Point",
#' #                                                       legend_position = "right",
#' #                                                       aes_by_pos = TRUE,
#' #                                                       add_text = TRUE,
#' #                                                       ttype = "label",
#' #                                                       tsize = 3,
#' #                                                       t_hjust = -3000,
#' #                                                       t_vjust = 1000)
#' #Look at one of the new frames
#' # r_frames_style_point_mat[5]
ts_add_positions_to_frames <- function(r_frame_list,positions,position_names=NULL,pcol="red",tcol="red",psize=2,tsize=7,ttype="text",t_hjust=0,t_vjust=0,position_legend_title = "Position",legend_position="right",aes_by_pos=FALSE,col_by_pos=FALSE,add_text=FALSE){
  
  if(col_by_pos){
    print("Coloring positions. Ignoring aes_by_pos and pcol arguments.")
    
  }
  
  if(!col_by_pos){
    ### Not colored by position ####
    if(inherits(positions,"sf")){
      if(all(sf::st_geometry_type(positions)=="POINT")){
        data <- positions; data$id <- as.factor(1:nrow(positions))
        if(is.null(position_names)){
          position_names <- paste("Point" ,(1:nrow(positions)))
        }else{
          position_names <- as.factor(position_names)
        }
        levels(data$id) <- position_names
        
        if(aes_by_pos){
          outlist <- .ts_add_gg(r_frame_list, gg = expr(
            list(
              #ggplot2::geom_point(aes(x = long, y = lat,group=group,shape=group), data = data,colour = pcol,size=psize),
              ggplot2::geom_sf(data = data,mapping = aes( shape=id),color=pcol,size=psize),
              
              scale_shape_discrete(name = position_legend_title),
              theme(legend.position = legend_position),
              guides(color=FALSE),
              coord_sf(datum=crs)#necessary because geom_sf defaults to latlong otherwise
            )
          ),data = data,pcol=pcol,psize=psize,position_legend_title=position_legend_title,legend_position=legend_position,crs=st_crs(positions))     
        }else{
          outlist <-  .ts_add_gg(r_frame_list, gg = expr(
            list(
              #ggplot2::geom_point(aes(x = long, y = lat,group=group), data = data,colour = pcol,size=psize)
              ggplot2::geom_sf(data = data,mapping = aes( ),color=pcol,size=psize),
              guides(color=FALSE),
              coord_sf(datum=crs)#necessary because geom_sf defaults to latlong otherwise
              
            )
          ),data = data,pcol=pcol,psize=psize,crs=st_crs(positions))
        }
      }else if(all(st_geometry_type(positions) %in% c("MULTIPOLYGON", "POLYGON") )){
        data <- positions; data$id <- as.factor(1:nrow(positions))
        if(is.null(position_names)){
          position_names <- paste("Polygon" ,(1:nrow(positions)))
        }else{
          position_names <- as.factor(position_names)
        }
        levels(data$id) <- position_names
        
        if(aes_by_pos){
          outlist <-  .ts_add_gg(r_frame_list, gg = expr(
            list(
              ggplot2::geom_sf(data = data,mapping = aes(linetype=id),color=pcol,size=psize,fill=NA),
              scale_linetype_discrete(name = position_legend_title),
              guides(size=FALSE,color=FALSE),
              theme(legend.position = legend_position),
              coord_sf(datum=crs)#necessary because geom_sf defaults to latlong otherwise
            )
          ), data = data,pcol=pcol,psize=psize,position_legend_title=position_legend_title,legend_position=legend_position,crs=st_crs(positions))
        }else{
          outlist <-  .ts_add_gg(r_frame_list, gg = expr(
            list(
              ggplot2::geom_sf(data = data,mapping = aes(),color=pcol,fill=NA,size=psize),
              guides(size=FALSE,color=FALSE),
              coord_sf(datum=crs)#necessary because geom_sf defaults to latlong otherwise
            )
          ), data = data,pcol=pcol,psize=psize,crs=st_crs(positions))
        }
      }
    }else if(inherits(positions,"SpatialPolygonsDataFrame")){
      data <-  fortify(positions);data$id <- as.factor(data$id)
      if(is.null(position_names)){
        position_names <- paste("Polygon" ,(1:nrow(positions)))
      }else{
        position_names <- as.factor(position_names)
      }
      levels(data$id) <- position_names
      
      if(aes_by_pos){
        outlist <-  .ts_add_gg(r_frame_list, gg = expr(
          list(
            geom_path(aes(x = long, y = lat,group=group,linetype=id), data = data,colour = pcol,size=psize),
            scale_linetype_discrete(name = position_legend_title),
            theme(legend.position = legend_position)
          )
        ), data = data,pcol=pcol,psize=psize,position_legend_title=position_legend_title,legend_position=legend_position)
      }else{
        outlist <-  .ts_add_gg(r_frame_list, gg = expr(
          list(
            geom_path(aes(x = long, y = lat,group=group), data = data,colour = pcol,size=psize)
          )
        ), data = data,pcol=pcol,psize=psize)
      }
      
    }else if(inherits(positions,"SpatialPointsDataFrame")){
      data <-  data.frame(long=positions@coords[,1],lat=positions@coords[,2],group=as.factor(seq(1,nrow(positions))))
      if(is.null(position_names)){
        position_names <- paste("Point" ,(1:nrow(positions)))
      }else{
        position_names <- as.factor(position_names)
      }
      levels(data$group) <- position_names
      
      if(aes_by_pos){
        outlist <-  .ts_add_gg(r_frame_list, gg = expr(
          list(
            ggplot2::geom_point(aes(x = long, y = lat,group=group,shape=group), data = data,colour = pcol,size=psize),
            scale_shape_discrete(name = position_legend_title),
            theme(legend.position = legend_position)
          )
        ),data = data,pcol=pcol,psize=psize,position_legend_title=position_legend_title,legend_position=legend_position)     
      }else{
        outlist <-  .ts_add_gg(r_frame_list, gg = expr(
          list(
            ggplot2::geom_point(aes(x = long, y = lat,group=group), data = data,colour = pcol,size=psize)
          )
        ),data = data,pcol=pcol,psize=psize)
      }
      
    }else if(inherits(positions,c("matrix","array"))){
      data <- data.frame(long=positions[,1],lat=positions[,2],group=as.factor(seq(1,nrow(positions))))
      if(is.null(position_names)){
        position_names <- paste("Point" ,(1:nrow(positions)))
      }else{
        position_names <- as.factor(position_names)
      }
      levels(data$group) <- position_names
      if(aes_by_pos){
        outlist  <-  .ts_add_gg(r_frame_list, gg = expr(
          list(
            ggplot2::geom_point(aes(x = long, y = lat,group=group,shape=group), data = data,colour = pcol,size=psize),
            scale_shape_discrete(name = position_legend_title),
            theme(legend.position = legend_position)
          )
        ), data = data,pcol=pcol,psize=psize,position_legend_title=position_legend_title,legend_position=legend_position)
      }else{
        outlist  <-  .ts_add_gg(r_frame_list, gg = expr(
          list(
            ggplot2::geom_point(aes(x = long, y = lat,group=group), data = data,colour = pcol,size=psize),
            scale_shape_discrete(name = position_legend_title),
            theme(legend.position = legend_position)
          )
        ), data = data,pcol=pcol,psize=psize)
      }
    }else{
      print("positions must be an object of sf, sp, or a matrix.")
    }
    
    
    #Optionally add text of position names in a loop
    if(add_text){
      for(i in 1:length(position_names)){
        if(inherits(positions,c("matrix","array"))){
          xcord <- (positions[i,])[1]+t_vjust
          ycord <- (positions[i,])[2]+t_hjust
        }else if(inherits(positions,"SpatialPolygonsDataFrame")|inherits(positions,"SpatialPointsDataFrame")){
          xcord <- coordinates(positions[i,])[1]+t_vjust
          ycord <- coordinates(positions[i,])[2]+t_hjust
        }else if(inherits(positions,"sf")){
          xcord <- st_coordinates(st_centroid(st_geometry(positions)))[i,][1]+t_vjust
          ycord <- st_coordinates(st_centroid(st_geometry(positions)))[i,][2]+t_hjust
        }
        outlist <- moveVis::add_text(outlist, as.character(position_names[i]), x =xcord, y = ycord,
                                     colour = tcol, size = tsize,type = ttype)
      }
    }
    
    outlist <- .ts_set_frametimes(outlist,.ts_get_frametimes(r_frame_list))
    
    
    return(outlist)
    
  
    }else{
      
      ### colored by position ####
      if(inherits(positions,"sf")){
        if(all(sf::st_geometry_type(positions)=="POINT")){
          data <- positions; data$id <- as.factor(1:nrow(positions))
          if(is.null(position_names)){
            position_names <- paste("Point" ,(1:nrow(positions)))
          }else{
            position_names <- as.factor(position_names)
          }
          levels(data$id) <- position_names
          
          if(FALSE){
            outlist <- .ts_add_gg(r_frame_list, gg = expr(
              list(
                #ggplot2::geom_point(aes(x = long, y = lat,group=group,shape=group), data = data,colour = pcol,size=psize),
                ggplot2::geom_sf(data = data,mapping = aes( color=pcol,shape=id),size=psize),
                
                scale_shape_discrete(name = position_legend_title),
                theme(legend.position = legend_position),
                guides(color=FALSE),
                coord_sf(datum=crs)#necessary because geom_sf defaults to latlong otherwise
              )
            ),data = data,pcol=pcol,psize=psize,position_legend_title=position_legend_title,legend_position=legend_position,crs=st_crs(positions))     
          }else{
            outlist <-  .ts_add_gg(r_frame_list, gg = expr(
              list(
                #ggplot2::geom_point(aes(x = long, y = lat,group=group), data = data,colour = pcol,size=psize)
                ggplot2::geom_sf(data = data,mapping = aes( color=id),size=psize),
                guides(color=FALSE),
                coord_sf(datum=crs)#necessary because geom_sf defaults to latlong otherwise
                
              )
            ),data = data,pcol=pcol,psize=psize,crs=st_crs(positions))
          }
        }else if(all(st_geometry_type(positions) %in% c("MULTIPOLYGON", "POLYGON") )){
          data <- positions; data$id <- as.factor(1:nrow(positions))
          if(is.null(position_names)){
            position_names <- paste("Polygon" ,(1:nrow(positions)))
          }else{
            position_names <- as.factor(position_names)
          }
          levels(data$id) <- position_names
          
          if(FALSE){
            outlist <-  .ts_add_gg(r_frame_list, gg = expr(
              list(
                ggplot2::geom_sf(data = data,mapping = aes( color=pcol,linetype=id),size=psize,fill=NA),
                scale_linetype_discrete(name = position_legend_title),
                guides(size=FALSE,color=FALSE),
                theme(legend.position = legend_position),
                coord_sf(datum=crs)#necessary because geom_sf defaults to latlong otherwise
              )
            ), data = data,pcol=pcol,psize=psize,position_legend_title=position_legend_title,legend_position=legend_position,crs=st_crs(positions))
          }else{
            outlist <-  .ts_add_gg(r_frame_list, gg = expr(
              list(
                ggplot2::geom_sf(data = data,mapping = aes( color=id),fill=NA,size=psize),
                guides(size=FALSE,color=FALSE),
                coord_sf(datum=crs)#necessary because geom_sf defaults to latlong otherwise
              )
            ), data = data,pcol=pcol,psize=psize,crs=st_crs(positions))
          }
        }
      }else if(inherits(positions,"SpatialPolygonsDataFrame")){
        data <-  fortify(positions);data$id <- as.factor(data$id)
        if(is.null(position_names)){
          position_names <- paste("Polygon" ,(1:nrow(positions)))
        }else{
          position_names <- as.factor(position_names)
        }
        levels(data$id) <- position_names
        
        if(FALSE){
          outlist <-  .ts_add_gg(r_frame_list, gg = expr(
            list(
              geom_path(aes(x = long, y = lat,group=group,linetype=id), data = data,colour = pcol,size=psize),
              scale_linetype_discrete(name = position_legend_title),
              theme(legend.position = legend_position)
            )
          ), data = data,pcol=pcol,psize=psize,position_legend_title=position_legend_title,legend_position=legend_position)
        }else{
          outlist <-  .ts_add_gg(r_frame_list, gg = expr(
            list(
              geom_path(aes(x = long, y = lat,group=group,color=id), data = data,size=psize)
            )
          ), data = data,pcol=pcol,psize=psize)
        }
        
      }else if(inherits(positions,"SpatialPointsDataFrame")){
        data <-  data.frame(long=positions@coords[,1],lat=positions@coords[,2],group=as.factor(seq(1,nrow(positions))))
        if(is.null(position_names)){
          position_names <- paste("Point" ,(1:nrow(positions)))
        }else{
          position_names <- as.factor(position_names)
        }
        levels(data$group) <- position_names
        
        if(FALSE){
          outlist <-  .ts_add_gg(r_frame_list, gg = expr(
            list(
              ggplot2::geom_point(aes(x = long, y = lat,group=group,shape=group), data = data,colour = pcol,size=psize),
              scale_shape_discrete(name = position_legend_title),
              theme(legend.position = legend_position)
            )
          ),data = data,pcol=pcol,psize=psize,position_legend_title=position_legend_title,legend_position=legend_position)     
        }else{
          outlist <-  .ts_add_gg(r_frame_list, gg = expr(
            list(
              ggplot2::geom_point(aes(x = long, y = lat,group=group,color=id), data = data,size=psize)
            )
          ),data = data,pcol=pcol,psize=psize)
        }
        
      }else if(inherits(positions,c("matrix","array"))){
        data <- data.frame(long=positions[,1],lat=positions[,2],group=as.factor(seq(1,nrow(positions))))
        if(is.null(position_names)){
          position_names <- paste("Point" ,(1:nrow(positions)))
        }else{
          position_names <- as.factor(position_names)
        }
        levels(data$group) <- position_names
        if(FALSE){
          outlist  <-  .ts_add_gg(r_frame_list, gg = expr(
            list(
              ggplot2::geom_point(aes(x = long, y = lat,group=group,shape=group), data = data,colour = pcol,size=psize),
              scale_shape_discrete(name = position_legend_title),
              theme(legend.position = legend_position)
            )
          ), data = data,pcol=pcol,psize=psize,position_legend_title=position_legend_title,legend_position=legend_position)
        }else{
          outlist  <-  .ts_add_gg(r_frame_list, gg = expr(
            list(
              ggplot2::geom_point(aes(x = long, y = lat,color=id,group=group), data = data,size=psize),
              scale_shape_discrete(name = position_legend_title),
              theme(legend.position = legend_position)
            )
          ), data = data,pcol=pcol,psize=psize)
        }
      }else{
        print("positions must be an object of sf, sp, or a matrix.")
      }
      
      
      #Optionally add text of position names in a loop
      if(add_text){
        for(i in 1:length(position_names)){
          if(inherits(positions,c("matrix","array"))){
            xcord <- (positions[i,])[1]+t_vjust
            ycord <- (positions[i,])[2]+t_hjust
          }else if(inherits(positions,"SpatialPolygonsDataFrame")|inherits(positions,"SpatialPointsDataFrame")){
            xcord <- coordinates(positions[i,])[1]+t_vjust
            ycord <- coordinates(positions[i,])[2]+t_hjust
          }else if(inherits(positions,"sf")){
            xcord <- st_coordinates(st_centroid(st_geometry(positions)))[i,][1]+t_vjust
            ycord <- st_coordinates(st_centroid(st_geometry(positions)))[i,][2]+t_hjust
          }
          outlist <- moveVis::add_text(outlist, as.character(position_names[i]), x =xcord, y = ycord,
                                       colour = tcol, size = tsize,type = ttype)
        }
      }
      
      outlist <- .ts_set_frametimes(outlist,.ts_get_frametimes(r_frame_list))
      
      
      return(outlist)
      
      
  }

  
  
}