R/plot_transects.R

In maudqueroue/intercali: Intercalibration Des Différents Types De Suivis Aeriens

# Generated by fusen: do not edit by hand


#' Plot transect
#'
#' This function allows to plot the created transects `transect_obj` on the study area `map_obj`.`map_obj` must be a sf data.frame. If the transects are cut in multiple segments, the `ifsegs` argument allows to highlight with different colors the differents segment of the transect.
#'
#' @param transect_obj sf dataframe. Transect/segment data.
#' @param map_obj sf dataframe or Region object from dssd. Study region.
#' @param crs Numeric. Projection system
#' @param ifsegs Boolean. TRUE to highlight the different segments with colors. By default FALSE.
#'
#' @importFrom ggplot2 ggplot geom_sf aes coord_sf scale_colour_manual geom_point theme element_text theme_set theme_bw unit element_rect element_line
#' @importFrom ggspatial annotation_scale annotation_north_arrow north_arrow_fancy_orienteering
#' @importFrom sp bbox
#' @importFrom sf as_Spatial st_sf
#' @importFrom grDevices rainbow
#'
#' @return ggplot object. The transects represented on the study area.
#' @export

#' @examples
#' 
#' library(dssd)
#' library(dsims)
#' data(dataset_transects)
#' data(dataset_segs)
#' data(dataset_map)
#' 
#' 
#' # Use of the St Andrews bay map from the dssd package
#' shapefile.name <- system.file("extdata", "StAndrew.shp", package = "dssd")
#' 
#' # Creation of the object with the make.region function of the dsims package
#' region <- make.region(region.name = "St Andrews bay",
#'                       shape = shapefile.name,
#'                       units = "m")
#' 
#' # Plot transects
#' plot_transects(transect_obj = dataset_transects, 
#'                map_obj = region, 
#'                crs = 2154)
#' 
#' # Vizualize segment
#' plot_transects(transect_obj = dataset_segs, 
#'                map_obj = dataset_map, 
#'                crs = 2154,
#'                ifsegs = TRUE)
#' 
plot_transects <- function(transect_obj, map_obj, crs, ifsegs = FALSE) {
  
    # Function checks
  
  assert_that(inherits(map_obj, c("sf", "Region")))
  assert_that(inherits(transect_obj, "sf"))

  # Function
  
  # keep contour
  
  if(inherits(map_obj, "sf")){
    contour_obj <- map_obj %>%
      st_union()
  }
  
  if(inherits(map_obj, "Region")){
    contour_obj <- st_sf(map_obj@region,
                         crs = crs)
  }
  
  
  # bounding box
  xlim <- bbox(as_Spatial(contour_obj))[1, ]
  ylim <- bbox(as_Spatial(contour_obj))[2, ]
  
  theme_set(theme_bw())
  
  if(ifsegs == FALSE){
    plot <- ggplot() +
      geom_sf(data = contour_obj, aes(), color = "black", alpha = 0) +
      
      geom_sf(data = transect_obj, aes(), color = "black") +
      coord_sf(xlim = xlim, ylim = ylim) +
      annotation_scale(location = "br", width_hint = 0.5) +
      annotation_north_arrow(location = "tr",
                             which_north = "true",
                             pad_x = unit(0.2, "cm"),
                             pad_y = unit(0.1, "cm"),
                             style = north_arrow_fancy_orienteering) +
      theme(legend.position = "none",
            panel.grid = element_line(colour = "transparent"),
            plot.title = element_text(lineheight = 0.8, face = "bold"),
            axis.text = element_text(size = 6),
            strip.background = element_rect(fill = "white"),
            axis.title.x = element_blank(),
            axis.title.y = element_blank(),
            panel.background = element_rect(fill = "azure"),
            panel.border = element_rect(fill = NA))
  }
  
  # color segments
  if(ifsegs == TRUE){
    pal <- rainbow(nrow(transect_obj), s=.6, v=.9)[sample(1:nrow(transect_obj),nrow(transect_obj))]
    
    plot <-  ggplot() +
      geom_sf(data = contour_obj, aes(), color = "black", alpha = 0) +
      geom_sf(data = transect_obj, aes(colour = Sample.Label)) +
      coord_sf(xlim = xlim, ylim = ylim) +
      annotation_scale(location = "br", width_hint = 0.5) +
      annotation_north_arrow(location = "tr",
                             which_north = "true",
                             pad_x = unit(0.2, "cm"),
                             pad_y = unit(0.1, "cm"),
                             style = north_arrow_fancy_orienteering) +
      scale_colour_manual(values=pal) +
      theme(legend.position = "none",
            panel.grid = element_line(colour = "transparent"),
            plot.title = element_text(lineheight = 0.8, face = "bold"),
            axis.text = element_text(size = 6),
            strip.background = element_rect(fill = "white"),
            axis.title.x = element_blank(),
            axis.title.y = element_blank(),
            panel.background = element_rect(fill = "azure"),
            panel.border = element_rect(fill = NA))
  }
  
  return(plot)
}