R/sim2Animation.R

In luismurao/bam: Species Distribution Models in the light of the BAM theory

#' sim2Animation: Animate BAM simulation object.
#'
#' @description Animates BAM simulation object.
#' @param sdm_simul A bam object. See \code{\link[bam]{sdm_sim}}
#' @param which_steps A numeric vector indicating the simulation steps that
#' are going to be converted into raster layers.
#' @param extra_legend A legend  to add to the animation.
#' @param bg_color Color for unsuitable pixels. Default "#F6F2E5".
#' @param suit_color Color for suitable pixels. Default "#0076BE".
#' @param occupied_color Color for occupied pixels. Default "#03C33F".
#' @param ani.width Animation width unit in px.
#' @param ani.height Animation height unit in px.
#' @param ani.res Animation resolution unit in px.
#' @param ani.width Animation width unit in px
#' @param ani.height Animation height unit in px
#' @param ani.res Animation resolution unit in px
#' @param gif_vel A value that regulates the velocity of frame transitions. The bigger it is the transition will be slower
#' default 0.8
#' @param fmt Animation format. Posible values are GIF and HTML
#' @param filename File name.
#' @param png_keyword A keyword name for the png images generated by the function
#' @return A RasterStack of species' distribution at each simulation step
#' @export
#' @examples
#' \dontrun{
#' model_path <- system.file("extdata/Lepus_californicus_cont.tif",
#'                           package = "bam")
#' model <- raster::raster(model_path) >0.1

#' sparse_mod <- bam::model2sparse(model)
#' adj_mod <- bam::adj_mat(sparse_mod,ngbs=2)

#' occs_lep_cal <- data.frame(longitude = c(-115.10417,
#'                                          -104.90417),
#'                            latitude = c(29.61846,
#'                                         29.81846))

#' occs_sparse <- bam::occs2sparse(modelsparse = sparse_mod,
#'                                 occs = occs_lep_cal)
#' sdm_lep_cal <- bam::sdm_sim(set_A = sparse_mod,
#'                             set_M = adj_mod,
#'                             initial_points = occs_sparse,
#'                             nsteps = 50)
#' ani_name <- "C:/Users/l916o895/Dropbox/TeoriadeBAM/ani_test.html"
#' sdm_lep_cal_st <- bam::sim2Animation(sdm_simul = sdm_lep_cal,
#'                                      which_steps = seq(1,50,by=1),
#'                                      fmt = "HTML",ani.width = 1200,
#'                                      ani.height = 1200,
#'                                      filename = ani_name)
#' }

sim2Animation <- function(sdm_simul,which_steps,
                          fmt="GIF",filename,
                          png_keyword="sdm_sim",
                          extra_legend = NULL,
                          bg_color = "#F6F2E5",
                          suit_color = "#0076BE",
                          occupied_color = "#03C33F",
                          gif_vel =0.8,
                          ani.width = 1200,
                          ani.height = 1200,
                          ani.res=300){

  fmt <- toupper(fmt)
  if(!fmt %in% c("GIF",'HTML'))
    stop("fmt should be GIF or HTML")

  dir1 <- unlist(strsplit(filename,split = "[/]|[\\]"))
  filename <- paste0(dir1,collapse = "/")
  dir2 <- paste0(dir1[1:(length(dir1)-1)],collapse = '/')
  dir2 <- gsub("[\\]","/",dir2)

  which_steps <- c(0,which_steps)
  titles <- paste("Simulation step:",which_steps)
  if(!is.null(extra_legend)){
    titles <- paste(titles,paste(extra_legend,collapse = "; "),
                    sep="; ")
  }

  pb <- utils::txtProgressBar(min = 0,
                              max = length(which_steps),
                              style = 3)
  which_steps <- which_steps + 1
  if(fmt == "GIF"){
    animation::ani.options(ani.width = ani.width,
                           ani.height = ani.height,
                           ani.res = ani.res)



    animation::saveGIF({
      for (i in seq_along(which_steps)) {
        sdm_st <- sdm_simul@niche_model *0
        valuess <- sdm_simul@sdm_sim[[which_steps[i]]]
        no_cero <- .nonzero(valuess)
        sdm_st[sdm_simul@cellIDs] <- sdm_simul@sdm_sim[[which_steps[i]]]

        sdm_st <- sdm_simul@niche_model + sdm_st

        maxv <- raster::maxValue(sdm_st)
        minv <- raster::minValue(sdm_st)
        if(maxv ==1  && minv == 1){
          colores <- suit_color
        } else if(maxv == 2 && minv == 2){
          colores <- occupied_color
        } else if(maxv == 2 && minv != 0) {
          colores <- c(suit_color,occupied_color)
        } else if((maxv == 2 && nrow(no_cero)>2) || (maxv == 2 && minv==0) ){
          colores <- c(bg_color,suit_color,occupied_color)
        } else{
          colores <- c(bg_color,suit_color)
        }

        graphics::par(xpd = FALSE)


        raster::plot(sdm_st,main=titles[i],
                     col=colores,legend=FALSE,
                     xaxt = 'n',
                     yaxt = 'n')

        graphics::par(xpd = TRUE)
        graphics::legend(
          "bottom",
          legend = c("Unsuitable", "Suitable", "Occupied"),
          fill = c(bg_color,suit_color,occupied_color),
          horiz = TRUE,
          inset = -0.2,
          cex = 0.75,
          bty="n"
        )
        utils::setTxtProgressBar(pb, i)
      }

    },interval=gif_vel,ani.width = ani.width,
    movie.name = filename)
  }
  if(fmt == "HTML"){


    dir3 <- file.path(dir2,paste0("pngs_",png_keyword),
                      fsep = '/')
    dir3 <- gsub("[.]","_",dir3)
    animation::saveHTML({
      for (i in seq_along(which_steps)) {
        sdm_st <- sdm_simul@niche_model *0
        valuess <- sdm_simul@sdm_sim[[which_steps[i]]]
        no_cero <- .nonzero(valuess)
        sdm_st[sdm_simul@cellIDs] <- sdm_simul@sdm_sim[[which_steps[i]]]

        sdm_st <- sdm_simul@niche_model + sdm_st

        maxv <- raster::maxValue(sdm_st)
        minv <- raster::minValue(sdm_st)
        if(maxv ==1  && minv == 1){
          colores <- suit_color
        } else if(maxv == 2 && minv == 2){
          colores <- occupied_color
        } else if(maxv == 2 && minv != 0) {
          colores <- c(suit_color,occupied_color)
        } else if((maxv == 2 && nrow(no_cero)>2) || (maxv == 2 && minv==0) ){
          colores <- c(bg_color,suit_color,occupied_color)
        } else{
          colores <- c(bg_color,suit_color)
        }
        graphics::par(xpd = FALSE)


        raster::plot(sdm_st,
                     main=titles[i],
                     col=colores,legend=FALSE,
                     xaxt = 'n',
                     yaxt = 'n')

        graphics::par(xpd = TRUE)
        graphics::legend(
          "bottom",
          legend = c("Unsuitable", "Suitable", "Occupied"),
          fill = c(bg_color,suit_color,occupied_color),
          horiz = TRUE,
          inset = -0.2,
          cex = 0.75,
          bty="n"
        )
        utils::setTxtProgressBar(pb, i)
      }
    },img.name = png_keyword,
    imgdir = dir3 ,
    htmlfile = filename,
    ani.width=ani.width,
    ani.height=ani.width,interval=0.1,
    ani.dev = function(...){grDevices::png(res=ani.res,...)})
  }
  return(sdm_st)

}