Merge branch 'develop' of https://github.com/traitecoevo/austraits in…

…to develop

.github/workflows/test-coverage.yml

@@ -7,6 +7,7 @@ on:
   pull_request:
     branches:
       - master
+      - develop
 
 name: test-coverage
 

R/as_wide_table.R

@@ -63,7 +63,6 @@ as_wide_table3 <- function(austraits){
   # rename taxonomic_dataset field to reflect the APC/APNI name matching process better
   austraits$taxa <- 
     austraits$taxa %>% 
-    # dplyr::rename("taxonNameValidation" = "taxonomic_dataset") %>% 
     dplyr::distinct()
 
   austraits_wide <- 
@@ -141,7 +140,6 @@ as_wide_table2 <- function(austraits){
   # rename taxonomic_dataset field to reflect the APC/APNI name matching process better
   austraits$taxa <- 
     austraits$taxa %>% 
-    dplyr::rename("taxonNameValidation" = "taxonomic_dataset") %>% 
     dplyr::distinct()
 
   austraits_wide <- 
@@ -151,7 +149,7 @@ as_wide_table2 <- function(austraits){
     dplyr::left_join(by=c("taxon_name"), austraits$taxa)
 
   # reorder the names to be more intuitive
-  austraits_wide %>% dplyr::select(dplyr::any_of(
+  austraits_wide %>% dplyr::select(dplyr::any_of(c(
 
     # The most useful (if you are filtering for just one taxon_name)
     "dataset_id", "observation_id", "trait_name", "taxon_name", "value", "unit", 
@@ -168,7 +166,7 @@ as_wide_table2 <- function(austraits){
     "latitude (deg)", "longitude (deg)", "location", "plot_id",
 
     #stuff relating to contexts and methods
-    "context", "methods", "method_id", "original_name",
+    "context", "methods", "original_name",
 
     #the citations
     "dataset_description", "source_primary_citation", "source_secondary_citation",
@@ -177,7 +175,9 @@ as_wide_table2 <- function(austraits){
     "taxonomic_status", "taxon_distribution", 
     "taxon_rank", "genus", "family"
 
-  ))
+  )
+  )
+  )
 
   austraits_wide
 }

R/join_all.R

@@ -87,7 +87,7 @@ join_methods <- function(austraits, ...) {
   # Switch for different versions
   version <- what_version(austraits)
 
-  if(what_version(austraits) %in% c("4-series", "5-series")){
+  if(what_version(austraits) == "5-series"){
     version <- "new" 
   } else
     version <- "old"

data-raw/create_data.R

@@ -2,28 +2,33 @@
 ## code to prepare an example dataset, that go public
 
 devtools::load_all()
-set.seed(109)
-austraits_all <- load_austraits(version = "3.0.2", path = "ignore/data/")
-dataset_id <- c( unique(austraits_all$traits$dataset_id) %>% sample(5), "Falster_2003", "Falster_2005_1", "Falster_2005_2" )
+path = "ignore/data/austraits"
+
+# 3.0.2
+austraits_3.0.2 <- load_austraits(version = "3.0.2", path = path)
 
-austraits_lite <- extract_dataset(austraits_all, dataset_id)
+set.seed(109)
+dataset_id <- c( unique(austraits_3.0.2$traits$dataset_id) %>% sample(5), "Falster_2003", "Falster_2005_1", "Falster_2005_2" )
 
-# updated release
-austraits_newrel <- readRDS("ignore/data/austraits_5.rds") 
-austraits_newrel$build_info$version <- "5.0.0"
-attr(austraits_newrel, "class") <- "austraits"
+austraits_3.0.2_lite <- extract_dataset(austraits_3.0.2, dataset_id)
 
+# 4.2.0
 datasets <- c("Crous_2013", "Crous_2019", "Buckton_2019", "Kooyman_2011", "Bloomfield_2018", 
               "Wright_2019", "Westoby_2014", "Vesk_2019", "Leigh_2003", "Prior_2003",
               "Prior_2016", "Choat_2006", "Choat_2012", "ABRS_1981")
 
-austraits_lite_post <- austraits_newrel %>% extract_dataset(dataset_id = c(dataset_id, datasets))
+austraits_4.2.0 <- load_austraits(version = "4.2.0", path = path)
+austraits_4.2.0_lite <- austraits_4.2.0 |>  extract_dataset(dataset_id = c(dataset_id, datasets))
+
+# 5.0.0
+austraits_5.0.0 <- load_austraits(version = "5.0.0", path = path)
 
-## code to prepare `australia_map_raster` dataset goes here
+austraits_5.0.0_lite <- austraits_5.0.0 %>% extract_dataset(dataset_id = c(dataset_id, datasets))
 
+## code to prepare `australia_map_raster` dataset
 australia_map_raster <- raster::raster("ignore/australia.tif") 
 australia_map_raster <- australia_map_raster %>% raster::as.data.frame(xy = T,na.rm=T)
 
-usethis::use_data(austraits_lite, australia_map_raster, austraits_lite_post, internal = TRUE, overwrite = TRUE)
+usethis::use_data(austraits_3.0.2_lite, austraits_4.2.0_lite, austraits_5.0.0_lite, australia_map_raster, internal = TRUE, overwrite = TRUE)
 
 

tests/testthat/test-as_wide_table.R

@@ -1,7 +1,8 @@
 library(purrr)
 
-austraits <- list(austraits_lite,
-                  austraits_lite_post)
+austraits <- list(austraits_3.0.2_lite,
+                  austraits_4.2.0_lite, 
+                  austraits_5.0.0_lite)
 
 test_widetable_success <- function(austraits){
   test_that("Function is working", {

tests/testthat/test-austraits_load_.R

@@ -1,6 +1,6 @@
 library(purrr)
 
-versions <- c("3.0.2", "4.0.0")
+versions <- c("3.0.2", "4.2.0", "5.0.0")
 path = "ignore/data/austraits"
 
 test_get_versions <- function(version, path){

tests/testthat/test-extract_.R

@@ -1,8 +1,9 @@
 library(purrr)
 library(stringr)
 
-austraits <- list(austraits_lite,
-                  austraits_lite_post)
+austraits <- list(austraits_3.0.2_lite,
+                  austraits_4.2.0_lite, 
+                  austraits_5.0.0_lite)
 
 dataset_id = "Falster_2003"
 trait_name = "leaf_area"

tests/testthat/test-join_.R

@@ -1,7 +1,8 @@
 library(purrr)
 
-austraits <- list(austraits_lite,
-                  austraits_lite_post)
+austraits <- list(austraits_3.0.2_lite,
+                  austraits_4.2.0_lite, 
+                  austraits_5.0.0_lite)
 
 test_join_success <- function(austraits){
   test_that("functions should work without warnings", {

tests/testthat/test-plot_.R

@@ -1,10 +1,10 @@
 
 test_that("Function doesn't throw error", {
-  expect_invisible(austraits_lite %>% plot_trait_distribution_beeswarm("wood_density", "dataset_id", "Westoby_2014"))
-  expect_invisible(austraits_lite_post %>% plot_trait_distribution_beeswarm("leaf_mass_per_area", "dataset_id", "Bloomfield_2018"))
+  expect_invisible(austraits_3.0.2_lite %>% plot_trait_distribution_beeswarm("wood_density", "dataset_id", "Westoby_2014"))
+  expect_invisible(austraits_5.0.0_lite %>% plot_trait_distribution_beeswarm("leaf_mass_per_area", "dataset_id", "Bloomfield_2018"))
 
   # this function is currently really slow, blokcing effective testing
-  expect_invisible((austraits_lite %>% extract_trait("wood_density") %>% join_locations())$trait %>% plot_locations())
-  expect_invisible((austraits_lite_post %>% extract_trait("wood_density") %>% join_locations())$trait %>% plot_locations())
+  expect_invisible((austraits_5.0.0_lite %>% extract_trait("wood_density") %>% join_locations())$trait %>% plot_locations())
+  expect_invisible((austraits_5.0.0_lite %>% extract_trait("wood_density") %>% join_locations())$trait %>% plot_locations())
  }) 
 

tests/testthat/test-summarise_austraits.R

@@ -1,7 +1,8 @@
 library(purrr)
 
-austraits <- list(austraits_lite,
-                 austraits_lite_post)
+austraits <- list(austraits_3.0.2_lite,
+                  austraits_4.2.0_lite, 
+                  austraits_5.0.0_lite)
 
 test_summarise <- function(austraits){
   test_that("Function works", {
@@ -29,9 +30,9 @@ map(austraits,
 
 test_summarise_output <- function(austraits){
   test_that("Output correct", {
-    family <- austraits_lite %>% summarise_austraits("family")
-    genus <- austraits_lite %>% summarise_austraits("genus")
-    trait_nm <- austraits_lite %>% summarise_austraits("trait_name")
+    family <- austraits %>% summarise_austraits("family")
+    genus <- austraits %>% summarise_austraits("genus")
+    trait_nm <- austraits %>% summarise_austraits("trait_name")
 
     expect_length(family, 5)
     expect_length(genus, 5)
@@ -41,14 +42,14 @@ test_summarise_output <- function(austraits){
     expect_named(genus, expected = c("genus", "n_records", "n_dataset", "n_taxa", "percent_total"))
     expect_named(trait_nm, expected = c("trait_name", "n_records", "n_dataset", "n_taxa", "percent_total"))
 
-    actual_family <- austraits_lite$taxa$family %>% unique() 
-    actual_genus <- austraits_lite$taxa$genus %>% unique() 
+    actual_family <- austraits$taxa$family %>% unique() 
+    actual_genus <- austraits$taxa$genus %>% unique() 
 
     expect_equal(nrow(family), actual_family[! is.na(actual_family)] %>% length())
     expect_equal(nrow(genus), actual_genus[! is.na(actual_genus)] %>% length())
-    expect_equal(nrow(trait_nm), austraits_lite$traits$trait_name %>% unique() %>% length())
+    expect_equal(nrow(trait_nm), austraits$traits$trait_name %>% unique() %>% length())
   })
 }
 
 map(austraits, 
-    ~ test_summarise_output())
+    ~ test_summarise_output(.x))

tests/testthat/test-summarise_trait_means.R

@@ -1,5 +1,4 @@
-austraits <- load_austraits(version = "3.0.2", path = "ignore/data/austraits") %>%
-  extract_dataset("Falster_2003")
+austraits <- austraits_3.0.2_lite
 
 test_that("Function output is correct", {
   target <- austraits$traits %>% 

tests/testthat/test-trait_bind_sep.R

@@ -1,5 +1,5 @@
 #Pull in data
-austraits <- austraits_lite
+austraits <- austraits_3.0.2_lite
 
 #Extract a dataset
 dataset_id <- c("Falster_2005_2")

tests/testthat/test-trait_pivot_.R

@@ -1,43 +1,38 @@
 library(purrr)
 
-austraits_lite_small <-
-  austraits_lite %>% 
-  extract_dataset(c( "Baker_2019", "Falster_2003"))
-
-
-austraits_lite_post_small <-
-  austraits_lite_post %>% 
-  extract_dataset(c( "Baker_2019", "Falster_2003"))
+# austraits_lite_small <-
+#   austraits_lite %>% 
+#   extract_dataset(c( "Baker_2019", "Falster_2003"))
+# 
+# 
+# austraits_lite_post_small <-
+#   austraits_lite_post %>% 
+#   extract_dataset(c( "Baker_2019", "Falster_2003"))
+
+austraits <- list(austraits_3.0.2_lite,
+                  austraits_4.2.0_lite, 
+                  austraits_5.0.0_lite)
 
 test_that("pivot on subset of data", {
 
   # austraits_lite tests
   expect_silent(
-    wide_data <- austraits_lite_small %>% 
+    wide_data <- austraits_3.0.2_lite %>% 
       pluck("traits") %>% 
       summarise_trait_means() %>% trait_pivot_wider()
   )
 
-#  expect_silent(
-#    wide_data_post <- austraits_lite_post_small %>% 
-#      pluck("traits") %>% 
-#      summarise_trait_means() %>% trait_pivot_wider()
-#  )
-
-
   expect_type(wide_data, "list")
   expect_named(wide_data)
-  vals <- c("dataset_id", "taxon_name", "site_name", "context_name", "observation_id", "fire_response", "regen_strategy", "fire_cued_seeding", "leaf_angle", "leaf_area", "leaf_compoundness", "original_name")
-  expect_equal(names(wide_data$value), vals)
 
   # before and after pivots match"
 
   #Checking if widened data has the same length as variables that we are spreading
   expect_equal(length(wide_data), length(c("value", "unit", "date", "value_type", "replicates"))) 
   #Checking number of columns of widened data matches the number of ID columns + number of traits
-  expect_equal(ncol(wide_data$value),  (austraits_lite_small$traits %>% dplyr::select(-c(trait_name, value, unit, date, value_type, replicates)) %>% ncol()) + (unique(austraits_lite_small$traits$trait_name) %>% length()) )
+  expect_equal(ncol(wide_data$value),  (austraits_3.0.2_lite$traits %>% dplyr::select(-c(trait_name, value, unit, date, value_type, replicates)) %>% ncol()) + (unique(austraits_3.0.2_lite$traits$trait_name) %>% length()) )
   #Checking the number of columns matches original data after pivoting wide and then back to long again
-  expect_equal(ncol(austraits_lite_small$traits), ncol(trait_pivot_longer(wide_data)) )
+  expect_equal(ncol(austraits_3.0.2_lite$traits), ncol(trait_pivot_longer(wide_data)) )
 })
 
 
@@ -51,6 +46,5 @@ test_pivot_errors <- function(austraits){
   })
 }
 
-walk(list(austraits_lite,
-         austraits_lite_post), 
+walk(austraits, 
     test_pivot_errors)