mhesselbarth/support

:package: Various helper functions for R

suppoRt

Last updated: 2022-11-01

Overview

suppoRt is a growing collection of various support functions for R.

Installation

To install suppoRt, please use:

# install.packages("remotes")
remotes::install_github("mhesselbarth/suppoRt")

Contributing

Please note that the suppoRt package is released with a Contributor Code of Conduct. By contributing to this project, you agree to abide by its terms.

To contribute to this project, please see the Contributing guidelines.

support's Issues

as_data_table

Adapted from: https://gist.github.com/etiennebr/9515738

# implement function to convert raster to data.table
# this just creates the function in your environment
as_data_table <- function(x, na.rm = TRUE, return_df = TRUE, verbose = TRUE) {
  
  # create column names
  col_names <- paste0("layer_", 1:raster::nlayers(x))
  
  # get block size
  blcks <- raster::blockSize(x)
  
  result_temp <- lapply(1:blcks$n, function(i) {
    
    # this just prints a progress report
    if (verbose) {
      
      message("\r> Progress: ", i, " / ", blcks$n, "\t\t", appendLF = FALSE)
      
    }
    
    # get values of current chunk
    data_temp <- data.table::data.table(raster::getValuesBlock(x,
                                                               row = blcks$row[i],
                                                               nrows = blcks$nrows[i]))
    
    # get cell ids of current chunkg
    cells <- raster::cellFromRowCol(object = x,
                                    row = c(blcks$row[i], blcks$row[i] + blcks$nrows[i] - 1),
                                    col = c(1, raster::ncol(x)))
    
    # get xy coords of current chunk
    data_temp[, c("x", "y") := data.table::data.table(raster::xyFromCell(x, cell = cells[1]:cells[2]))]
    
    names(data_temp) <- c(col_names, "x", "y")
    
    # make sure coll order is in correct order
    data.table::setcolorder(data_temp, c("x", "y", col_names))
    
    # remove all rows in which all layers are NA
    if (na.rm) {
      
      data_temp <- na.omit(data_temp, cols = col_names)
      
    }
    
    return(data_temp)
  })
  
  message("\n> Combine results to one data.table")
  
  # combine list of data.table to one data.table
  result_temp <- data.table::rbindlist(result_temp)
  
  # convert to data.frame
  if (return_df) {
    
    result_temp <- as.data.frame(result_temp)
    
  }
  
  return(result_temp)
}

Remove temp files

Working on windows

#windows environmental variable %userprofile%\appdata\local\temp
pctempdir <- Sys.getenv("temp")

#detect and delete folders with pattern "rtmp"
folders <- dir(pctempdir, pattern = "Rtmp", full.names = TRUE)
unlink(folders, recursive = TRUE, force = TRUE, expand = TRUE)

Update packages

blacklist <- c("arrR", "meta.arrR")

installed <- rownames(installed.packages())

updatable <- installed[!installed %in% blacklist]
updatable <- setdiff(installed, blacklist) 

remotes::update_packages(packages = updatable)

Source: Stackoverflow

calc_cv

calc_cv <- function(x, na.rm = FALSE) {
  
  m <- mean(x, na.rm = na.rm)
  
  s <- sd(x, na.rm = na.rm)
  
  cv <- (s / m) * 100
  
  return(cv)
}

Rename gpkg

It causes issue if the .gpkg file name is changed due to the layer name. Thus reading and rewritting seems to be the easiest way

https://stackoverflow.com/questions/73042625/rename-layers-in-geopackage-in-r

Wrapper to copy files to HPC

Wrapper that check if files are on HPC and if not copy them there. The files can than be loaded in each job on the HPC, which seems to be faster

rep_rows

Function to repeat data.frame rows

dplyr::slice(rep(1:dplyr::n(), each = 5))

Dimension

Add dimension col for show_memory_us() for df, matrix list and vectors

Remove Rcpp