FarmDynR.R

      mutate(
        `Share of Cereals [%]` = ((SummerCere + Winterbarley + WinterWheat) / `Land [ha]`) * 100,
        `kg N per ha` = N_use * 1000 / `Land [ha]`
      ) %>%
      select(
        NUTS0, `Land [ha]`, `Share of Cereals [%]`,
        `Annual Work Units`, `kg N per ha`, `Farm Net Value Added [EUR]`, n,
        `Median FNVA [EUR]`, `FNVA per AWU`
      ) %>%
      dplyr::filter(n >= 15)
  }
  if (type == "dairy") {
    descstats <- farm_data %>%
      group_by(NUTS0) %>%
      summarise(
        nCows_mean = stats::weighted.mean(`global%nCows`, `misc%weights`, na.rm = TRUE),
        nArabLand_mean = stats::weighted.mean(`global%nArabLand`, `misc%weights`, na.rm = TRUE),
        nGrasLand_mean = stats::weighted.mean(`global%nGrasLand`, `misc%weights`, na.rm = TRUE),
        milkYield_mean = stats::weighted.mean(`global%milkYield`, `misc%weights`, na.rm = TRUE),
        `Share of Grassland [%]` = stats::weighted.mean(`global%ShareGrassLand`, `misc%weights`, na.rm = TRUE) * 100,
        # `Annual Work Units` = median(`global%Aks`, `misc%weights`, na.rm = TRUE),
        `Farm Net Value Added [EUR]` = stats::weighted.mean(`misc%net_value_added`, `misc%weights`, na.rm = TRUE),
        `Median FNVA [EUR]` = stats::median(`misc%net_value_added`, na.rm = TRUE),
        `Annual Work Units` = stats::weighted.mean(`global%Aks`, `misc%weights`, na.rm = TRUE),
        `FNVA per AWU` = `Farm Net Value Added [EUR]` / `Annual Work Units`,
        `Livestock density` = nCows_mean / (nArabLand_mean + nGrasLand_mean),
        n = sum(`misc%nFarms`)
      ) %>%
      dplyr::filter(n >= 15)
  }
  if (csv == TRUE) {
    descstats %>% utils::write.csv(file.path(dir, paste0(type, "_descstats.csv")), row.names = FALSE)
  }
  return(descstats)
}

# Is nan function
## is.nan.data.frame ----
#' `is.nan.data.frame()` checks if there are any NaNs in a dataframe (`is.nan()` does not work for dfs)
#' @param x A dataframe
#' @return A dataframe with TRUE or FALSE for each column
#' @export is.nan.data.frame
is.nan.data.frame <- function(x) do.call(cbind, lapply(x, is.nan))

# Remove aggregated farms with less than 15 farms for reporting
## rm_lown ----
#' `rm_lown()` removes aggregated farms with less than 15 farms for reporting
#' @param data A dataframe with the data to plot
#' @param farm_data A dataframe with the farm data
#' @return A dataframe with the data without the aggregated farms
#' @export rm_lown
rm_lown <- function(data, farm_data) {
  data <- data[data$farmIds %in% farm_data[!farm_data$`misc%nFarms` < 15, ]$farmIds, ]
  return(data)
}

# Find the first matching column
## first_match_col ----
#' `first_match_col()` finds the first matching column in a dataframe
#' @param x A dataframe
#' @param pattern A pattern to match
#' @param how How to match the pattern (all or any)
#' @return The name of the first matching column
#' @export first_match_col
#' @examples
#' data <- data.frame(a = c("a", "b", "c"), b = c("a", " ", "c"), c = c("a", "b", "1"))
#' first_match_col(data, "\\D", "all")
#' first_match_col(data, "\\d", "any")
first_match_col <- function(x, pattern, how = c("all", "any")) {
  found <- NULL
  for (i in seq_along(x)) {
    if (how == "all") {
      if (all(grepl(x[[i]], pattern = pattern))) {
        found <- colnames(x)[i]
        break
      }
    } else if (how == "any") {
      if (any(grepl(x[[i]], pattern = pattern))) {
        found <- colnames(x)[i]
        break
      }
    }
    if (i == length(x) && length(found) == 0) {
      rlang::abort("No matching columns found")
    }
  }
  return(found)
}

# Make a function that replaces the name of the column in first_match_col with what the user inputs
## replace_first_match_col ----
#' `replace_first_match_col()` replaces the name of the column in `first_match_col()` with what the user inputs
#' @inheritParams first_match_col
#' @param replace_with The name to replace the column name with
#' @return dataframe with the replaced column name
#' @export replace_first_match_col
#' @examples
#' data <- data.frame(a = c("a", "b", "c"), b = c("a", " ", "c"), c = c("a", "b", "1"))
#' replace_first_match_col(data, "\\D", "all", "new")
#' replace_first_match_col(data, "\\d", "any", "new")
replace_first_match_col <- function(x, pattern, how = c("all", "any"), replace_with) {
  first_match_col(x, pattern, how) -> found
  colnames(x)[colnames(x) == found] <- replace_with
  return(x)
}