This report is automatically generated with the R
package knitr
(version 1.40
)
.
## Random Sampling Function Script File ## # library(tidyverse) # functions to work with tibbles # library(lubridate) # makes working with dates easier source(paste0(rstudioapi::getActiveProject(),"/R Functions/function_predictionModels.R")) geomean = function(x, na.rm=TRUE){ exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x)) } AqSampleFishModelPairing <- function(aqData, fishModels, bylocationColumn=NULL, aqYearColumn=Year, aqOverlapYrs=5){ # FUNCTION VARIABLES # aqData - dataframe of Aq data containing columns: "locationColumn", Result, Year, Unit # fishModels - dataframe of selected Fish Std Length [Hg] Models containing columns: "locationColumn", Stdz350, Year, Unit # bylocationColumn - column of location names. LOcation must be shared between Fish & Aq to be paired # byaqYearColumn - column of years designating the year the aqueous sample was taken # aqOverlapYrs - number years prior Fish sample available to draw aq random sample # bylocationColumn <- quo(Subarea) - to test function line-wise locationColumn <- enquo(bylocationColumn) # aqYearColumn <- quo(Year) - to test function line-wise aqYearColumn <- enquo(aqYearColumn) # START PAIRING Locations <- fishModels %>% distinct(!!locationColumn) %>% pull FishAqResults <- NULL for(location in Locations){ # location <- Locations[1] # - to test function line-wise fish_loc <- fishModels %>% filter(!!locationColumn == location) Years <- fish_loc %>% distinct(Year) %>% pull tempFishAqResults <- NULL for(yr in Years){ # yr <- Years[1] # - to test function line-wise ## Gather Fish Samples ## fish_locYr <- fish_loc %>% filter(Year == yr) ## Gather Aq Samples ## aqYrSamp <- aqData %>% filter(!!locationColumn == location, !!aqYearColumn <= yr & !!aqYearColumn > yr-aqOverlapYrs) # Includes year both fish & Aq are sampled plus aqOverlapYrs-1 previous years of Aq data #data check that Aq data exists for subarea - if not go to next year if(is.null(aqYrSamp) | nrow(aqYrSamp) < 1){next} # Calc Aq Concs aqSampleYrs <- paste(aqYrSamp %>% distinct(!!aqYearColumn) %>% pull %>% sort, collapse=", ") # Collapse Aq Sample Years for storage in dataframe tempAqSamp <- tibble(aq_sampleYears = aqSampleYrs, aq_n = nrow(aqYrSamp), aq_Mean_pool = mean(aqYrSamp$Result), aq_Mean_byYear = aqYrSamp %>% group_by(!!aqYearColumn) %>% summarise(Avg= mean(Result)) %>% summarise(Mean=mean(Avg), .groups = 'drop') %>% pull(Mean), aq_Wt.Mean = aqYrSamp %>% group_by(!!aqYearColumn) %>% summarise(Avg= mean(Result), n=n()) %>% summarise(WtMean=weighted.mean(Avg, n), .groups = 'drop') %>% pull(WtMean), aq_Geomean_pool = geomean(aqYrSamp$Result), aq_Geomean_byYear = aqYrSamp %>% group_by(!!aqYearColumn) %>% summarise(GeoAvg= geomean(Result)) %>% summarise(GeoMean=geomean(GeoAvg), .groups = 'drop') %>% pull(GeoMean), aq_Median_pool = median(aqYrSamp$Result), aq_Median_byYear = aqYrSamp %>% group_by(!!aqYearColumn) %>% summarise(Medi= median(Result)) %>% summarise(Median=median(Medi), .groups = 'drop') %>% pull(Median), aq_Unit = unique(aqData$Unit)) # Store Results tempFishAqResults <- rbind(tempFishAqResults, cbind(fish_locYr, tempAqSamp)) } FishAqResults <- rbind(FishAqResults, tempFishAqResults) } return(FishAqResults) }
The R session information (including the OS info, R version and all packages used):
sessionInfo()
## R version 4.2.2 (2022-10-31 ucrt) ## Platform: x86_64-w64-mingw32/x64 (64-bit) ## Running under: Windows 10 x64 (build 22621) ## ## Matrix products: default ## ## locale: ## [1] LC_COLLATE=English_United States.utf8 LC_CTYPE=English_United States.utf8 ## [3] LC_MONETARY=English_United States.utf8 LC_NUMERIC=C ## [5] LC_TIME=English_United States.utf8 ## ## attached base packages: ## [1] stats graphics grDevices utils datasets methods base ## ## other attached packages: ## [1] mgcv_1.8-41 nlme_3.1-160 lubridate_1.8.0 plotly_4.10.0 ## [5] readxl_1.4.1 actuar_3.3-0 NADA_1.6-1.1 forcats_0.5.2 ## [9] stringr_1.4.1 dplyr_1.0.9 purrr_0.3.4 readr_2.1.2 ## [13] tidyr_1.2.0 tibble_3.1.8 ggplot2_3.3.6 tidyverse_1.3.2 ## [17] fitdistrplus_1.1-8 survival_3.4-0 MASS_7.3-58.1 ## ## loaded via a namespace (and not attached): ## [1] lattice_0.20-45 assertthat_0.2.1 digest_0.6.29 utf8_1.2.2 ## [5] R6_2.5.1 cellranger_1.1.0 backports_1.4.1 reprex_2.0.2 ## [9] evaluate_0.16 highr_0.9 httr_1.4.4 pillar_1.8.1 ## [13] rlang_1.0.5 lazyeval_0.2.2 googlesheets4_1.0.1 rstudioapi_0.14 ## [17] data.table_1.14.2 Matrix_1.5-1 splines_4.2.2 googledrive_2.0.0 ## [21] htmlwidgets_1.5.4 munsell_0.5.0 broom_1.0.1 compiler_4.2.2 ## [25] modelr_0.1.9 xfun_0.32 pkgconfig_2.0.3 htmltools_0.5.3 ## [29] tidyselect_1.1.2 fansi_1.0.3 viridisLite_0.4.1 crayon_1.5.1 ## [33] tzdb_0.3.0 dbplyr_2.2.1 withr_2.5.0 grid_4.2.2 ## [37] jsonlite_1.8.0 gtable_0.3.1 lifecycle_1.0.1 DBI_1.1.3 ## [41] magrittr_2.0.3 scales_1.2.1 cli_3.3.0 stringi_1.7.8 ## [45] fs_1.5.2 xml2_1.3.3 ellipsis_0.3.2 generics_0.1.3 ## [49] vctrs_0.4.1 expint_0.1-7 tools_4.2.2 glue_1.6.2 ## [53] hms_1.1.2 fastmap_1.1.0 colorspace_2.0-3 gargle_1.2.0 ## [57] rvest_1.0.3 knitr_1.40 haven_2.5.1
Sys.time()
## [1] "2023-12-26 08:57:35 PST"