Skip to content

Commit

Permalink
reflow comments
Browse files Browse the repository at this point in the history
  • Loading branch information
@diazrenata
diazrenata committed Nov 28, 2023
1 parent 11bf8ce commit 6b91d47
Show file tree
Hide file tree
Showing 25 changed files with 603 additions and 343 deletions.
36 changes: 25 additions & 11 deletions R/bbs_species_list_functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,8 @@
#'
#'
is_unidentified <- function(names) {
names[names == "auratus auratus x auratus cafer"] <- "auratus auratus"
names[names == "auratus auratus x auratus cafer"] <-
"auratus auratus"
grepl("sp\\.| x |\\/", names)
}

Expand All @@ -23,9 +24,12 @@ is_unidentified <- function(names) {
#' @keywords internal
find_unidentified_species <- function(species_table) {
unidentified_species_table <- species_table
unidentified_species_table$is_unid <- is_unidentified(unidentified_species_table$species)
unidentified_species_table <- unidentified_species_table[unidentified_species_table$is_unid, ]
unidentified_species_table <- unidentified_species_table[, c("AOU", "english_common_name", "genus", "species")]
unidentified_species_table$is_unid <-
is_unidentified(unidentified_species_table$species)
unidentified_species_table <-
unidentified_species_table[unidentified_species_table$is_unid,]
unidentified_species_table <-
unidentified_species_table[, c("AOU", "english_common_name", "genus", "species")]

unidentified_species_table
}
Expand All @@ -41,16 +45,26 @@ find_unidentified_species <- function(species_table) {
#' @keywords internal
find_nontarget_species <- function(species_table) {
nontarget_species_complement <- species_table
nontarget_species_complement <- nontarget_species_complement[nontarget_species_complement$AOU > 2880, ]
nontarget_species_complement <- nontarget_species_complement[nontarget_species_complement$AOU < 3650 | nontarget_species_complement$AOU > 3810, ]
nontarget_species_complement <- nontarget_species_complement[nontarget_species_complement$AOU < 3900 | nontarget_species_complement$AOU > 3910, ]
nontarget_species_complement <- nontarget_species_complement[nontarget_species_complement$AOU < 4160 | nontarget_species_complement$AOU > 4210, ]
nontarget_species_complement <- nontarget_species_complement[nontarget_species_complement$AOU != 7010, ]
nontarget_species_complement <-
nontarget_species_complement[nontarget_species_complement$AOU > 2880,]
nontarget_species_complement <-
nontarget_species_complement[nontarget_species_complement$AOU < 3650 |
nontarget_species_complement$AOU > 3810,]
nontarget_species_complement <-
nontarget_species_complement[nontarget_species_complement$AOU < 3900 |
nontarget_species_complement$AOU > 3910,]
nontarget_species_complement <-
nontarget_species_complement[nontarget_species_complement$AOU < 4160 |
nontarget_species_complement$AOU > 4210,]
nontarget_species_complement <-
nontarget_species_complement[nontarget_species_complement$AOU != 7010,]


nontarget_species_table <- species_table
nontarget_species_table <- nontarget_species_table[!(nontarget_species_table$AOU %in% nontarget_species_complement$AOU), ]
nontarget_species_table <- nontarget_species_table[, c("AOU", "english_common_name", "genus", "species")]
nontarget_species_table <-
nontarget_species_table[!(nontarget_species_table$AOU %in% nontarget_species_complement$AOU),]
nontarget_species_table <-
nontarget_species_table[, c("AOU", "english_common_name", "genus", "species")]

nontarget_species_table
}
149 changes: 91 additions & 58 deletions R/community_generate.R
View file
Original file line number Diff line number Diff line change
@@ -1,12 +1,17 @@
#' Simulate individual measurements for many populations
#'
#' For a community (i.e. a collection of populations of different species, or of the same species at different points in time or locations, etc), simulate individual-level size and metabolic rate measurements.
#' For a community (i.e. a collection of populations of different species, or of
#' the same species at different points in time or locations, etc), simulate
#' individual-level size and metabolic rate measurements.
#'
#' @param community_data_table dataframe containing at least one of `AOU`, `scientific_name`, or `mean_size` and a column for species abundances
#' @param abundance_column_name character, the name of the column with species abundances. Defaults to "speciestotal".
#' @return a dataframe one row per individual, all columns from `community_data_table`, and additional columns for species attributes.
#' @param community_data_table dataframe containing at least one of `AOU`,
#' `scientific_name`, or `mean_size` and a column for species abundances
#' @param abundance_column_name character, the name of the column with species
#' abundances. Defaults to "speciestotal".
#' @return a dataframe one row per individual, all columns from
#' `community_data_table`, and additional columns for species attributes.
#'
#' Specifically:
#' Specifically:
#'
#' * `AOU`: the AOU, if provided
#' * `sim_species_id`: the `sim_species_id` if provided
Expand All @@ -25,84 +30,112 @@
#'
#' demo_community <- community_generate(demo_route_clean)
#' head(demo_community)
community_generate <- function(community_data_table, abundance_column_name = "speciestotal") {
colnames(community_data_table) <- tolower(colnames(community_data_table))
colnames(community_data_table)[which(colnames(community_data_table) == "aou")] <- "AOU"
community_generate <-
function(community_data_table,
abundance_column_name = "speciestotal") {
colnames(community_data_table) <-
tolower(colnames(community_data_table))
colnames(community_data_table)[which(colnames(community_data_table) == "aou")] <-
"AOU"

community_vars <- colnames(community_data_table)
community_vars <- colnames(community_data_table)

# Check that the necessary variables are provided ####
# Check that the necessary variables are provided ####

contains_AOU <- "AOU" %in% community_vars
contains_scientific_name <- "scientific_name" %in% community_vars
contains_mean <- "mean_size" %in% community_vars
contains_abundance <- abundance_column_name %in% community_vars
contains_AOU <- "AOU" %in% community_vars
contains_scientific_name <- "scientific_name" %in% community_vars
contains_mean <- "mean_size" %in% community_vars
contains_abundance <- abundance_column_name %in% community_vars

if (!contains_abundance) {
stop("abundance column is required. If the name is not `speciestotal` specify using the `abundance_column_name` argument")
}
if (!contains_abundance) {
stop(
"abundance column is required. If the name is not `speciestotal` specify using the `abundance_column_name` argument"
)
}

if (!(contains_AOU | contains_mean | contains_scientific_name)) {
stop("At least one of `AOU`, `scientific_name`, or `mean_size` is required")
}
if (!(contains_AOU | contains_mean | contains_scientific_name)) {
stop("At least one of `AOU`, `scientific_name`, or `mean_size` is required")
}

# Identify ID/grouping columns and columns to pass to sim fxns. ####
# Identify ID/grouping columns and columns to pass to sim fxns. ####


community_data_table$rejoining_id <- seq_len(nrow(community_data_table))
abundance_values <- as.matrix(community_data_table[, abundance_column_name])
abundance_values <- as.vector(abundance_values[, 1])
community_data_table$abundance <- abundance_values
community_data_table$rejoining_id <-
seq_len(nrow(community_data_table))
abundance_values <-
as.matrix(community_data_table[, abundance_column_name])
abundance_values <- as.vector(abundance_values[, 1])
community_data_table$abundance <- abundance_values

community_vars_mod <- colnames(community_data_table)
community_vars_mod <- colnames(community_data_table)

possible_sim_vars <- c("abundance", "AOU", "mean_size", "sd_size", "sim_species_id", "scientific_name")
possible_sim_vars <-
c("abundance",
"AOU",
"mean_size",
"sd_size",
"sim_species_id",
"scientific_name")

id_vars <- c(community_vars_mod[which(!(community_vars_mod %in% possible_sim_vars))])
id_vars <-
c(community_vars_mod[which(!(community_vars_mod %in% possible_sim_vars))])

sim_vars <- c(community_vars_mod[which(community_vars_mod %in% possible_sim_vars)])
sim_vars <-
c(community_vars_mod[which(community_vars_mod %in% possible_sim_vars)])

# For the cols to pass in, add NA columns for any of the variables that the sim fxns can use that aren't included ####
na_vars <- possible_sim_vars[which(!(possible_sim_vars %in% community_vars_mod))]
# For the cols to pass in, add NA columns for any of the variables that the
# sim fxns can use that aren't included ####
na_vars <-
possible_sim_vars[which(!(possible_sim_vars %in% community_vars_mod))]

na_table <- matrix(nrow = nrow(community_data_table), ncol = length(na_vars))
na_table <- as.data.frame(na_table)
colnames(na_table) <- na_vars
na_table <-
matrix(nrow = nrow(community_data_table),
ncol = length(na_vars))
na_table <- as.data.frame(na_table)
colnames(na_table) <- na_vars

# Split into 2 tables, one with ID cols and one for the cols to pass in.
ids_table <- as.data.frame(community_data_table[, id_vars])
colnames(ids_table) <- id_vars
# Split into 2 tables, one with ID cols and one for the cols to pass in.
ids_table <- as.data.frame(community_data_table[, id_vars])
colnames(ids_table) <- id_vars


sim_vars_table <- community_data_table[, c(sim_vars, "rejoining_id")]
sim_vars_table <- cbind(sim_vars_table, na_table)
sim_vars_table <-
community_data_table[, c(sim_vars, "rejoining_id")]
sim_vars_table <- cbind(sim_vars_table, na_table)

pop_generate_rejoining <- function(this_id, sim_vars_table) {
this_row <- sim_vars_table[sim_vars_table$rejoining_id == this_id, ]
pop_generate_rejoining <- function(this_id, sim_vars_table) {
this_row <- sim_vars_table[sim_vars_table$rejoining_id == this_id,]

this_population <- pop_generate(
abundance = this_row$abundance[1],
AOU = this_row$AOU[1],
scientific_name = this_row$scientific_name[1],
mean_size = this_row$mean_size[1],
sd_size = this_row$sd_size[1],
sim_species_id = this_row$sim_species_id[1]
)
this_population <- pop_generate(
abundance = this_row$abundance[1],
AOU = this_row$AOU[1],
scientific_name = this_row$scientific_name[1],
mean_size = this_row$mean_size[1],
sd_size = this_row$sd_size[1],
sim_species_id = this_row$sim_species_id[1]
)


this_population$rejoining_id <- this_id
this_population$rejoining_id <- this_id

this_population
}
this_population
}

populations_list <- apply(as.matrix(sim_vars_table$rejoining_id), MARGIN = 1, FUN = pop_generate_rejoining, sim_vars_table = sim_vars_table)
populations_list <-
apply(
as.matrix(sim_vars_table$rejoining_id),
MARGIN = 1,
FUN = pop_generate_rejoining,
sim_vars_table = sim_vars_table
)

populations <- do.call("rbind", populations_list)
populations <- do.call("rbind", populations_list)


community <- merge(ids_table, populations, by = "rejoining_id")
community <- community[, -which(colnames(community) == "rejoining_id")]
community <- merge(ids_table, populations, by = "rejoining_id")
community <-
community[,-which(colnames(community) == "rejoining_id")]


return(community)
}
return(community)
}
6 changes: 4 additions & 2 deletions R/data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -200,7 +200,8 @@

#' Toy data frame of abundances and species names (for vignettes)
#'
#' This data table is a toy data frame for the vignettes. It has abundances and scientific names for 5 species to make up a hypothetical community.
#' This data table is a toy data frame for the vignettes. It has abundances and
#' scientific names for 5 species to make up a hypothetical community.
#' @format A data frame with 5 rows and 2 variables:
#' \describe{
#' \item{scientific_name}{Scientific name}
Expand All @@ -214,7 +215,8 @@

#' Toy data frame of abundances and species mean sizes (for vignettes)
#'
#' This data table is a toy data frame for the vignettes. It has abundances and mean body sizes for 5 species to make up a hypothetical community.
#' This data table is a toy data frame for the vignettes. It has abundances and
#' mean body sizes for 5 species to make up a hypothetical community.
#' @format A data frame with 5 rows and 3 variables:
#' \describe{
#' \item{mean_size}{Mean mass, in g}
Expand Down
16 changes: 11 additions & 5 deletions R/filter_bbs_survey.R
View file
Original file line number Diff line number Diff line change
@@ -1,27 +1,33 @@
#' Clean raw Breeding Bird Survey survey data
#'
#' The raw data for the Breeding Bird Survey includes unidentified species and some species that are not well-sampled by the BBS methods. This function filters a dataframe to remove those species.
#' The raw data for the Breeding Bird Survey includes unidentified species and
#' some species that are not well-sampled by the BBS methods. This function
#' filters a dataframe to remove those species.
#'
#' @param bbs_survey_data data frame with columns for species and AOU
#'
#' @return bbs_survey_data with unidentified species, nightbirds, waterbirds, non-targets removed
#' @return bbs_survey_data with unidentified species, nightbirds, waterbirds,
#' non-targets removed
#' @export
#' @importFrom utils data
#' @examples
#' head(filter_bbs_survey(demo_route_raw))

filter_bbs_survey <- function(bbs_survey_data) {
colnames(bbs_survey_data) <- tolower(colnames(bbs_survey_data))
colnames(bbs_survey_data)[which(colnames(bbs_survey_data) == "aou")] <- "AOU"
colnames(bbs_survey_data)[which(colnames(bbs_survey_data) == "aou")] <-
"AOU"


if (!("AOU" %in% colnames(bbs_survey_data))) {
stop("`AOU` column is required!")
}


bbs_survey_data <- bbs_survey_data[!(bbs_survey_data$AOU %in% unidentified_species$AOU), ]
bbs_survey_data <- bbs_survey_data[!(bbs_survey_data$AOU %in% nontarget_species$AOU), ]
bbs_survey_data <-
bbs_survey_data[!(bbs_survey_data$AOU %in% unidentified_species$AOU),]
bbs_survey_data <-
bbs_survey_data[!(bbs_survey_data$AOU %in% nontarget_species$AOU),]

bbs_survey_data
}
51 changes: 31 additions & 20 deletions R/ind_draw.R
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
#' Draw individuals to make a population.
#'
#' This is not a user-facing function; it is the random number generator under-the-hood for [pop_generate].
#' This is not a user-facing function; it is the random number generator
#' under-the-hood for [pop_generate].
#'
#' @param species_mean mean body size
#' @param species_sd standard deviation of body size
Expand All @@ -11,29 +12,39 @@
#' @importFrom truncnorm rtruncnorm
#' @importFrom stats pnorm
#' @keywords internal
ind_draw <- function(species_mean = NA_real_, species_sd = NA_real_, species_abundance = NA_integer_) {
if (is.na(species_mean)) {
stop("`species_mean` must be provided")
}
ind_draw <-
function(species_mean = NA_real_,
species_sd = NA_real_,
species_abundance = NA_integer_) {
if (is.na(species_mean)) {
stop("`species_mean` must be provided")
}

if (is.na(species_sd)) {
stop("`species_sd` must be provided")
}
if (is.na(species_sd)) {
stop("`species_sd` must be provided")
}

if (is.na(species_abundance)) {
stop("`species_abundance` must be provided")
}
if (is.na(species_abundance)) {
stop("`species_abundance` must be provided")
}

if (!is.numeric(species_abundance)) {
stop("`species_abundance` must be numeric")
}
if (!is.numeric(species_abundance)) {
stop("`species_abundance` must be numeric")
}

if (!(round(species_abundance) == species_abundance)) {
stop("`species_abundance` must be a whole number")
}
if (!(round(species_abundance) == species_abundance)) {
stop("`species_abundance` must be a whole number")
}

population <- truncnorm::rtruncnorm(n = species_abundance, a = 1, b = Inf, mean = species_mean, sd = species_sd)
population <-
truncnorm::rtruncnorm(
n = species_abundance,
a = 1,
b = Inf,
mean = species_mean,
sd = species_sd
)


population
}
population
}
9 changes: 5 additions & 4 deletions R/metabolic_rate.R
View file
Original file line number Diff line number Diff line change
@@ -1,10 +1,11 @@
#' Estimate individual-level BMR
#'
#' Given an individual's body mass (in grams), use allometric scaling (Fristoe 2015) to estimate basal metabolic rate.
#' Given an individual's body mass (in grams), use allometric scaling (Fristoe
#' 2015) to estimate basal metabolic rate.
#'
#' @references \itemize{
#' \item{Fristoe, T. S. (2015). Energy use by migrants and residents in North American breeding bird communities. Global Ecology and Biogeography, 24(4), 406–415. https://doi.org/10.1111/geb.12262}
#' }
#' @references \itemize{ \item{Fristoe, T. S. (2015). Energy use by migrants and
#' residents in North American breeding bird communities. Global Ecology and
#' Biogeography, 24(4), 406–415. https://doi.org/10.1111/geb.12262} }
#'
#' @param mass mass in grams
#' @return estimated basal metabolic rate
Expand Down
Loading

0 comments on commit 6b91d47

Please sign in to comment.