R/old.R

In bmcnellis/RSFIA: FIA Tree Mortality Analysis

#' @title Old functions
#'
#' @description
#'
#' NULL
#'
#' @rdname old
ApplyColumnAggregate <- function(df, n_yr_prev = 5, type = 'rs', var_in = 'NDVI') {
  if (!(all(
    'LAT' %in% colnames(df),
    'LON' %in% colnames(df)
  ))) stop('Missing lat-lon tags')
  if (!('INVYR' %in% colnames(df))) stop('Missing INVYR tag')
  pts <- data.frame(df$LAT, df$LON, df$INVYR, stringsAsFactors = F)
  pts <- as.matrix(pts)
  cnt <- 0
  out_df <- df
  for (i in 1:nrow(df)) {
    if (i %% 100 == 0) cat('[]')
    if (i %% 1000 == 0) {
      cnt <- cnt + 1
      cat(' |', round(1000 * cnt / nrow(df) * 100, 2), '%\n')
    }
    coords <- data.frame(df[i, 'LAT'], df[i, 'LON'])
    colnames(coords) <- c('lat', 'lon')
    yr <- as.numeric(df$INVYR[i])
    yrs <- c((yr - n_yr_prev):yr)
    val <- RSFIA::AggregateByColumnMeta(coords = coords, years = yrs,
                                        type = type, 'vars' = var_in)
    val <- val[3]
    out_df[i, var_in] <- val
  }
  return(out_df)
}
#' @rdname old
AggregateByColumnMeta <- function(coords, years, vars,
                                  fun = 'mean', type = 'daymet') {
  require(RSFIA)
  if (length(coords[, 1] * coords[, 2]) != length(unique(coords[, 1] * coords[, 2]))) {
    stop('Duplicated lat/longs are present - this will mess up dplyr::left_join()')
  }
  if (type == 'daymet') {
    data('FIA_plot_daymet')
    input_df <- FIA_plot_daymet
  }
  if (type == 'rs') {
    data('FIA_plot_spectrals')
    input_df <- FIA_plot_spectrals
  }
  if (ncol(coords) > 2) stop('Coords should be just lat/los')
  if (!colnames(coords)[1] %in% c('lat', 'LAT', 'latitude', 'LATITUDE')) {
    stop('Need latitude as first column')
  }
  colnames(coords) <- c('lat', 'lon')
  input_df <- dplyr::left_join(coords, input_df, by = c('lat', 'lon'))
  coord_cols <- which(colnames(input_df) %in% c('lat', 'lon'))
  for (i in vars) {
    i_cols <- grep(i, colnames(input_df))
    j_cols <- numeric()
    for (j in years) {
      j_cols <- append(j_cols, grep(j, colnames(input_df)[i_cols]))
    }
    out_cols <- colnames(input_df)[i_cols][j_cols]
    if (fun == 'mean') {
      FUN <- function(x) mean(x, na.rm = T)
    }
    if (fun == 'sum') {
      FUN <- function(x) sum(x, na.rm = T)
    }
    new_var <- apply(input_df[, out_cols], 1, FUN = FUN)
    out_df <- data.frame(input_df$lat, input_df$lon, new_var, stringsAsFactors = F)
    year_tag <- paste(years, collapse = '_')
    new_var_name <- paste(i, year_tag, fun, sep = '_')
    colnames(out_df) <- c('lat', 'lon', new_var_name)
    coords <- dplyr::left_join(coords, out_df, by = c('lat', 'lon'))
  }
  return(coords)
}
#' @rdname old
MashYearlyDaymetSpectrals <- function(df, years = c(2000:2016),
                                      RS_vars = c('NDVI', 'RGI'),
                                      daymet_vars = c('MAT', 'MAP'),
                                      only_RS = F, only_daymet = F) {
  require(RSFIA)
  if (length(daymet_vars) < 1) {
    daymet_vars <- c(
      'MAT', 'min_temp_by_Q_val', 'min_temp_by_Q_doy',
      'max_temp_by_Q_val', 'max_temp_by_Q_doy', 'MAP', 'mean_rain_event',
      'rainy_days', 'sd_rain_event', 'dry_Q_sum', 'dry_Q_doy', 'max_dry_days',
      'mean_dry_period', 'sd_dry_period'
    )
  }

  # Spectrals:
  coords <- df[, which(colnames(df) %in% c('LAT', 'LON'))]
  if (only_daymet == F) {
    specs_in <- AggregateByColumnMeta(coords = coords, years = years, type = 'rs',
                                      vars = RS_vars)
    cols_1 <- strsplit(colnames(specs_in)[3:ncol(specs_in)], '_')
    cols_2 <- lapply(cols_1, function(x) paste(x[1], x[length(x)], sep = '_'))
    colnames(specs_in) <- c('LAT', 'LON', unlist(cols_2))
    df <- dplyr::left_join(df, specs_in, by = c('LAT', 'LON'))
  }
  if (only_RS) {
    return(df)
  }

  # Temp data:
  weather <- AggregateByColumnMeta(coords = coords, years = years,
                                   vars = daymet_vars, fun = 'mean', type = 'daymet')
  cols_1 <- strsplit(colnames(weather)[3:ncol(weather)], '_')
  num_cols <- lapply(cols_1, function(x) {
    y <- suppressWarnings(as.numeric(x))
    f_NA <- which(!is.na(y))[1]
    z0 <- paste(x[1:(f_NA - 1)], collapse = '_')
    z1 <- paste(z0, x[length(x)], sep = '_')
    return(z1)
  })
  colnames(weather) <- c('LAT', 'LON', unlist(num_cols))

  # Mash:
  df <- dplyr::left_join(df, weather, by = c('LAT', 'LON'))
  return(df)
}
#' @rdname old
CombineWeatherFiles <- function(dir = getwd(), match_sig = F,
                                file_sig = 'daymet_weather_grab') {
  # Declare/setup:
  out_dir <- getwd()
  on.exit(setwd(out_dir))
  setwd(dir)

  # Get file list:
  files <- list.files()[grep(file_sig, list.files())]
  if (match_sig) {
    file_split <- unlist(lapply(as.list(files), function(x) strsplit(x, '_')), recursive = F)
    file_sig_match <- unlist(lapply(file_split, function(x) x[5]))
    if (length(unique(file_sig_match)) > 1) stop('Lat/long signatures dont match')
    year_sig_match <- unlist(lapply(file_split, function(x) x[4]))
    if (length(unique(year_sig_match)) != length(files)) stop('Duplicated years')
  }

  # Populate first lat/long df:
  fl <- files[1]
  out_df <- read.csv(fl, stringsAsFactors = F)[, c(3, 4)]
  # Further files:
  if (length(files) > 1) {
    for (i in 1:length(files)) {
      fl <- files[i]
      fl_df <- read.csv(fl, stringsAsFactors = F)[, -c(1, 2)]
      if (length(unique(fl_df$year)) > 1) stop('Multiple years present?')
      i_coords <- fl_df[, c(1, 2)]
      out_df <- dplyr::full_join(out_df, i_coords, by = c('lat', 'lon'))
      comb_df <- RSFIA::PasteUniqueFactor(fl_df[, -c(1, 2)], 1)
      in_df <- data.frame(fl_df[, c(1, 2)], comb_df)
      out_df <- dplyr::left_join(out_df, in_df, by = c('lat', 'lon'))
    }
  } else {
    out_df <- read.csv(fl, stringsAsFactors = F)
  }
  invisible(out_df)
}