From fc6abc4dada9c7b28e9e664648ea5972c546d90d Mon Sep 17 00:00:00 2001 From: mikejohnson51 Date: Thu, 26 Oct 2023 13:45:04 -0600 Subject: [PATCH] add equal_population_distribution --- DESCRIPTION | 3 ++- NAMESPACE | 2 ++ R/custom_function.R | 33 +++++++++++++++++++++++----- R/package.R | 1 + man/circular_mean.Rd | 4 ++-- man/distribution.Rd | 4 ++-- man/equal_population_distribution.Rd | 21 ++++++++++++++++++ man/geometric_mean.Rd | 4 ++-- 8 files changed, 59 insertions(+), 13 deletions(-) create mode 100644 man/equal_population_distribution.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 5d148e8..64bea6d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,7 +18,8 @@ Imports: exactextractr, jsonlite, methods, - terra + terra, + ggplot2 License: MIT + file LICENSE Encoding: UTF-8 LazyData: true diff --git a/NAMESPACE b/NAMESPACE index 1821bca..f42d772 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,7 @@ export(aggregate_zones) export(circular_mean) export(distribution) export(ee_functions) +export(equal_population_distribution) export(execute_zonal) export(geometric_mean) export(prep_geom) @@ -25,6 +26,7 @@ importFrom(dplyr,left_join) importFrom(dplyr,mutate) importFrom(dplyr,select) importFrom(exactextractr,exact_extract) +importFrom(ggplot2,cut_number) importFrom(jsonlite,toJSON) importFrom(methods,formalArgs) importFrom(stats,as.formula) diff --git a/R/custom_function.R b/R/custom_function.R index 18e5e04..9e5df3b 100644 --- a/R/custom_function.R +++ b/R/custom_function.R @@ -1,5 +1,5 @@ #' Geometric Mean Summary -#' @param x vector of values +#' @param values vector of values #' @param coverage_fraction coverage fraction #' @return data.frame #' @export @@ -11,7 +11,7 @@ geometric_mean <- function(x, coverage_fraction) { } #' Geometric Mean Summary -#' @param x vector of values +#' @param values vector of values #' @param coverage_fraction coverage fraction #' @return data.frame #' @export @@ -31,7 +31,7 @@ circular_mean <- function (values, coverage_fraction) { #' Distribution Summary -#' @param x vector of values +#' @param values vector of values #' @param coverage_fraction coverage fraction #' @param breaks either a numeric vector of two or more unique cut points or a single number #' (greater than or equal to 2) giving the number of intervals into which x is to be cut. (default = 10) @@ -41,9 +41,8 @@ circular_mean <- function (values, coverage_fraction) { distribution = function(values, coverage_fraction, breaks = 10){ x1 = values*coverage_fraction - - tmp = as.data.frame(table(cut(pmax(0,x1), - breaks = breaks))) + + tmp = as.data.frame(table(cut(x1, breaks = breaks))) tmp$v = as.numeric(gsub("]", "", sub('.*,\\s*', '', tmp$Var1))) @@ -54,3 +53,25 @@ distribution = function(values, coverage_fraction, breaks = 10){ } +#' Equal Area Distribution +#' @param values vector of values +#' @param coverage_fraction coverage fraction +#' @param n number of intervals to create +#' @return data.frame +#' @export + +equal_population_distribution = function(values, coverage_fraction, n = 4){ + + x1 = values*coverage_fraction + + tmp = as.data.frame(table(cut_number(rnorm(length(x1), x1, max(x1)/10e6), n = n))) + + tmp$v = as.numeric(gsub("]", "", sub('.*,\\s*', '', tmp$Var1))) + + tmp$frequency = tmp$Freq / sum(tmp$Freq) + + as.character(toJSON(tmp[,c("v", "frequency")])) + +} + + diff --git a/R/package.R b/R/package.R index 9765cae..c556e88 100644 --- a/R/package.R +++ b/R/package.R @@ -27,4 +27,5 @@ ee_functions = function(){ #' @importFrom data.table rbindlist data.table #' @importFrom dplyr mutate filter `%>%` left_join distinct select #' @importFrom stats as.formula complete.cases +#' @importFrom ggplot2 cut_number NULL \ No newline at end of file diff --git a/man/circular_mean.Rd b/man/circular_mean.Rd index a5dfc49..0180ce4 100644 --- a/man/circular_mean.Rd +++ b/man/circular_mean.Rd @@ -7,9 +7,9 @@ circular_mean(values, coverage_fraction) } \arguments{ -\item{coverage_fraction}{coverage fraction} +\item{values}{vector of values} -\item{x}{vector of values} +\item{coverage_fraction}{coverage fraction} } \value{ data.frame diff --git a/man/distribution.Rd b/man/distribution.Rd index 1c22164..96eb557 100644 --- a/man/distribution.Rd +++ b/man/distribution.Rd @@ -7,12 +7,12 @@ distribution(values, coverage_fraction, breaks = 10) } \arguments{ +\item{values}{vector of values} + \item{coverage_fraction}{coverage fraction} \item{breaks}{either a numeric vector of two or more unique cut points or a single number (greater than or equal to 2) giving the number of intervals into which x is to be cut. (default = 10)} - -\item{x}{vector of values} } \value{ data.frame diff --git a/man/equal_population_distribution.Rd b/man/equal_population_distribution.Rd new file mode 100644 index 0000000..6d59ba4 --- /dev/null +++ b/man/equal_population_distribution.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/custom_function.R +\name{equal_population_distribution} +\alias{equal_population_distribution} +\title{Equal Area Distribution} +\usage{ +equal_population_distribution(values, coverage_fraction, n = 4) +} +\arguments{ +\item{values}{vector of values} + +\item{coverage_fraction}{coverage fraction} + +\item{n}{number of intervals to create} +} +\value{ +data.frame +} +\description{ +Equal Area Distribution +} diff --git a/man/geometric_mean.Rd b/man/geometric_mean.Rd index 1d7517c..5fcbe2c 100644 --- a/man/geometric_mean.Rd +++ b/man/geometric_mean.Rd @@ -7,9 +7,9 @@ geometric_mean(x, coverage_fraction) } \arguments{ -\item{x}{vector of values} - \item{coverage_fraction}{coverage fraction} + +\item{values}{vector of values} } \value{ data.frame