From 7c5449994a1aadd1e78d03e63a7f4de703cd24cc Mon Sep 17 00:00:00 2001 From: Gaurav Chaudhary Date: Fri, 17 Jul 2026 17:23:31 +0530 Subject: [PATCH 1/2] Improve homepage dataset summary and preview Signed-off-by: Gaurav Chaudhary --- .github/workflows/quarto-publish.yml | 1 + DESCRIPTION | 1 + R/homepage-data.R | 73 +++++++++++++++++++++++++ _quarto.yml | 1 + index.qmd | 80 +++++++++++++++++++--------- inst/styles/homepage.css | 29 ++++++++++ tests/testthat/test-homepage-data.R | 76 ++++++++++++++++++++++++++ 7 files changed, 235 insertions(+), 26 deletions(-) create mode 100644 R/homepage-data.R create mode 100644 inst/styles/homepage.css create mode 100644 tests/testthat/test-homepage-data.R diff --git a/.github/workflows/quarto-publish.yml b/.github/workflows/quarto-publish.yml index ab11d85..2f644c4 100644 --- a/.github/workflows/quarto-publish.yml +++ b/.github/workflows/quarto-publish.yml @@ -29,6 +29,7 @@ jobs: with: extra-packages: | local::. + any::DT any::dplyr any::ggplot2 any::knitr diff --git a/DESCRIPTION b/DESCRIPTION index b93bd23..20597ad 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,6 +17,7 @@ BugReports: https://github.com/PecanProject/betydata/issues Depends: R (>= 4.1.0) Suggests: + DT, dplyr (>= 1.1.0), ggplot2, jsonlite, diff --git a/R/homepage-data.R b/R/homepage-data.R new file mode 100644 index 0000000..9b8e18a --- /dev/null +++ b/R/homepage-data.R @@ -0,0 +1,73 @@ +# Homepage summary helpers used by the Quarto site. + +homepage_non_blank <- function(x) { + !is.na(x) & (!is.character(x) | nzchar(trimws(x))) +} + +homepage_metrics <- function(data) { + data.frame( + metric = c( + "Observations", + "Measured variables", + "Represented species", + "Contributing sites", + "Data sources" + ), + value = c( + nrow(data), + length(unique(data$trait[homepage_non_blank(data$trait)])), + length(unique(data$species_id[!is.na(data$species_id)])), + length(unique(data$site_id[!is.na(data$site_id)])), + length(unique(data$citation_id[!is.na(data$citation_id)])) + ), + definition = c( + "Trait and yield records in the primary dataset", + "Distinct variables with recorded observations", + "Distinct species linked to observation records", + "Distinct research sites linked to observation records", + "Distinct cited sources linked to observation records" + ), + stringsAsFactors = FALSE + ) +} + +homepage_top_traits <- function(data, n = 10L) { + traits <- data$trait[homepage_non_blank(data$trait)] + counts <- as.data.frame(table(traits), stringsAsFactors = FALSE) + names(counts) <- c("trait", "observations") + counts$observations <- as.integer(counts$observations) + counts <- counts[order(-counts$observations, counts$trait), , drop = FALSE] + utils::head(counts, n) +} + +homepage_top_species <- function(data, n = 10L) { + valid_species <- !is.na(data$species_id) & homepage_non_blank(data$scientificname) + data <- data[valid_species, c("species_id", "scientificname"), drop = FALSE] + data$scientificname <- trimws(data$scientificname) + data$scientificname[!homepage_non_blank(data$scientificname)] <- NA_character_ + + species_ids <- unique(data$species_id) + summary <- lapply(species_ids, function(species_id) { + rows <- data[data$species_id == species_id, , drop = FALSE] + names <- unique(rows$scientificname[!is.na(rows$scientificname)]) + + if (length(names) > 1L) { + stop( + "Each species_id must have at most one non-blank scientificname.", + call. = FALSE + ) + } + + data.frame( + species_id = species_id, + species = if (length(names) == 1L) names else NA_character_, + observations = nrow(rows), + stringsAsFactors = FALSE + ) + }) + + summary <- do.call(rbind, summary) + summary <- summary[order(-summary$observations, summary$species, summary$species_id), , drop = FALSE] + rownames(summary) <- NULL + utils::head(summary, n) +} diff --git a/_quarto.yml b/_quarto.yml index 9c9ad44..1192269 100644 --- a/_quarto.yml +++ b/_quarto.yml @@ -35,6 +35,7 @@ website: format: html: theme: cosmo + css: inst/styles/homepage.css toc: true self-contained: false df-print: paged diff --git a/index.qmd b/index.qmd index ca255e2..bc00053 100644 --- a/index.qmd +++ b/index.qmd @@ -6,7 +6,7 @@ subtitle: "Public Data from the BETYdb Database" ```{r} #| echo: false library(betydata) -library(dplyr) +source("R/homepage-data.R", local = TRUE) ``` **betydata** is an R data package providing offline access to public data from [BETYdb](https://betydb.org) (Biofuel Ecophysiological Traits and Yields database). It enables reproducible analyses of plant traits, crop yields, and supporting metadata without requiring database connectivity. @@ -15,22 +15,18 @@ library(dplyr) ```{r} #| echo: false -#| label: tbl-overview -#| tbl-cap: "Dataset summary" -tibble::tibble( - Metric = c( - "Total observations", "Unique traits", "Plant species", - "Research sites", "Literature citations", "Tables" - ), - Value = c( - format(nrow(traitsview), big.mark = ","), - n_distinct(traitsview$trait), - format(nrow(species), big.mark = ","), - nrow(sites), - nrow(citations), - 16 - ) -) |> knitr::kable() +#| results: asis +metrics <- homepage_metrics(traitsview) + +cat("::: {.homepage-metrics}\n") +for (i in seq_len(nrow(metrics))) { + cat("::: {.homepage-metric-card}\n") + cat(sprintf("### %s\n\n", metrics$metric[[i]])) + cat(sprintf("%s\n\n", format(metrics$value[[i]], big.mark = ","))) + cat(sprintf("%s\n", metrics$definition[[i]])) + cat(":::\n") +} +cat(":::\n") ``` ## Installation @@ -43,17 +39,49 @@ remotes::install_github("PecanProject/betydata") ## Quick Start ```{r} -library(betydata) -library(dplyr) +#| echo: false +if (!requireNamespace("DT", quietly = TRUE)) { + stop("Package 'DT' is required to render the searchable homepage preview.", call. = FALSE) +} + +preview <- traitsview[, c( + "trait", "mean", "units", "scientificname", "sitename", + "author", "citation_year", "year" +)] +names(preview) <- c( + "Trait", "Value", "Units", "Species", "Site", + "Data-source author", "Citation year", "Observation year" +) + +DT::datatable( + preview, + caption = "Searchable preview of trait and yield observations", + rownames = FALSE, + options = list( + deferRender = TRUE, + pageLength = 25, + lengthMenu = c(10, 25, 50, 100), + scrollX = TRUE + ) +) +``` -# The primary table -- key columns first, IDs last -traitsview +## Dataset Diversity -# Bioenergy crop observations -bioenergy_genera <- c("Miscanthus", "Panicum", "Populus", "Salix", "Saccharum") -traitsview |> - filter(genus %in% bioenergy_genera) |> - count(genus, sort = TRUE) +```{r} +#| echo: false +#| label: tbl-top-traits +#| tbl-cap: "Variables with the most observation records" +homepage_top_traits(traitsview) |> + knitr::kable(col.names = c("Trait", "Observations"), row.names = FALSE) +``` + +```{r} +#| echo: false +#| label: tbl-top-species +#| tbl-cap: "Species with the most observation records" +homepage_top_species(traitsview)[, c("species", "observations")] |> + knitr::kable(col.names = c("Species", "Observations"), row.names = FALSE) ``` ## Guides diff --git a/inst/styles/homepage.css b/inst/styles/homepage.css new file mode 100644 index 0000000..14e73e2 --- /dev/null +++ b/inst/styles/homepage.css @@ -0,0 +1,29 @@ +.homepage-metrics { + display: grid; + gap: 1rem; + grid-template-columns: repeat(auto-fit, minmax(12rem, 1fr)); + margin: 1.5rem 0 2rem; +} + +.homepage-metric-card { + border: 1px solid var(--bs-border-color, #dee2e6); + border-radius: 0.375rem; + padding: 1rem; +} + +.homepage-metric-card h3 { + font-size: 1rem; + margin: 0; +} + +.homepage-metric-value { + display: block; + font-size: 2rem; + font-weight: 700; + line-height: 1.2; + margin: 0.5rem 0; +} + +.homepage-metric-card p { + margin: 0; +} diff --git a/tests/testthat/test-homepage-data.R b/tests/testthat/test-homepage-data.R new file mode 100644 index 0000000..e5522f6 --- /dev/null +++ b/tests/testthat/test-homepage-data.R @@ -0,0 +1,76 @@ +homepage_fixture <- function() { + data.frame( + trait = c("SLA", "SLA", " ", NA, "Vcmax"), + species_id = c(1, 1, 2, NA, 3), + site_id = c(10, 10, 11, NA, 20), + citation_id = c(100, 100, 101, NA, 200), + scientificname = c("Alpha plant", "Alpha plant", "Beta plant", NA, "Gamma plant"), + stringsAsFactors = FALSE + ) +} + +test_that("homepage metrics count observations and linked entities", { + metrics <- betydata:::homepage_metrics(homepage_fixture()) + + expect_equal(metrics$value, c(5, 2, 3, 3, 3)) +}) + +test_that("duplicating an observation affects only the observation total", { + data <- homepage_fixture() + duplicated_data <- rbind(data, data[1, ]) + + original <- betydata:::homepage_metrics(data)$value + duplicated <- betydata:::homepage_metrics(duplicated_data)$value + + expect_equal(duplicated, original + c(1, 0, 0, 0, 0)) +}) + +test_that("display fields do not change homepage metrics", { + data <- homepage_fixture() + original <- betydata:::homepage_metrics(data)$value + + data$scientificname <- paste("renamed", seq_len(nrow(data))) + expect_equal(betydata:::homepage_metrics(data)$value, original) +}) + +test_that("top traits exclude blank values and sort ties deterministically", { + top_traits <- betydata:::homepage_top_traits(homepage_fixture()) + + expect_equal(top_traits$trait, c("SLA", "Vcmax")) + expect_equal(top_traits$observations, c(2L, 1L)) +}) + +test_that("top species use species IDs and a single scientific name per ID", { + top_species <- betydata:::homepage_top_species(homepage_fixture()) + + expect_equal(top_species$species_id, c(1, 2, 3)) + expect_equal(top_species$species, c("Alpha plant", "Beta plant", "Gamma plant")) + expect_equal(top_species$observations, c(2L, 1L, 1L)) + expect_false(any(is.na(top_species$species))) + expect_false(any(trimws(top_species$species) == "")) +}) + +test_that("top species reject conflicting names for one species ID", { + data <- homepage_fixture() + data$scientificname[2] <- "Different alpha plant" + + expect_error( + betydata:::homepage_top_species(data), + "at most one non-blank scientificname" + ) +}) + +test_that("homepage helpers agree with direct traitsview calculations", { + data("traitsview", package = "betydata") + metrics <- betydata:::homepage_metrics(traitsview) + non_blank <- function(x) !is.na(x) & (!is.character(x) | nzchar(trimws(x))) + + expect_equal(metrics$value, c( + nrow(traitsview), + length(unique(traitsview$trait[non_blank(traitsview$trait)])), + length(unique(traitsview$species_id[!is.na(traitsview$species_id)])), + length(unique(traitsview$site_id[!is.na(traitsview$site_id)])), + length(unique(traitsview$citation_id[!is.na(traitsview$citation_id)])) + )) + expect_false(any(is.na(betydata:::homepage_top_species(traitsview)$species_id))) +}) From 2d9d9c25e7ccf3dc9c8a65043521e900a3ad3f42 Mon Sep 17 00:00:00 2001 From: Gaurav Chaudhary Date: Tue, 15 Sep 2026 11:12:50 +0530 Subject: [PATCH 2/2] Address homepage review feedback --- CITATION.cff | 3 + DESCRIPTION | 11 ++- NEWS.md | 4 + R/homepage-data.R | 102 +++++++++++++-------- index.qmd | 34 ++++--- tests/testthat/test-homepage-data.R | 134 +++++++++++++++++++++++++--- 6 files changed, 224 insertions(+), 64 deletions(-) diff --git a/CITATION.cff b/CITATION.cff index 5698797..2f9641e 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -33,6 +33,9 @@ authors: family-names: BV email: www.divinehome12@gmail.com affiliation: CMR Institute of Technology, Bengaluru + - given-names: Gaurav + family-names: Chaudhary + email: chaudharygaurav2004@gmail.com preferred-citation: type: article title: >- diff --git a/DESCRIPTION b/DESCRIPTION index 20597ad..a68a258 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -4,7 +4,13 @@ Title: Public Data from the BETYdb Database Version: 0.1.0 Authors@R: c( person("David", "LeBauer", email = "dlebauer@arizona.edu", role = c("aut", "cre")), - person("Akash B V", email = "www.divinehome12@gmail.com", role = "aut") + person("Akash B V", email = "www.divinehome12@gmail.com", role = "aut"), + person( + "Gaurav", + "Chaudhary", + email = "chaudharygaurav2004@gmail.com", + role = "ctb" + ) ) Description: An R data package providing offline access to public data from the BETYdb database (betydb.org). Includes plant traits, crop yields, @@ -25,7 +31,8 @@ Suggests: maps, quarto, rmarkdown, - testthat (>= 3.0.0) + testthat (>= 3.0.0), + tibble VignetteBuilder: quarto SystemRequirements: Quarto command line tool (https://github.com/quarto-dev/quarto-cli) Encoding: UTF-8 diff --git a/NEWS.md b/NEWS.md index 9bcb1ff..dcc22c5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # betydata (development version) +* Improved the website homepage with observation-backed summary metrics, a + searchable observation preview, and summaries of the most represented + variables and species (#26). + # betydata 0.1.0 ## Initial Release diff --git a/R/homepage-data.R b/R/homepage-data.R index 9b8e18a..2489f39 100644 --- a/R/homepage-data.R +++ b/R/homepage-data.R @@ -4,8 +4,23 @@ homepage_non_blank <- function(x) { !is.na(x) & (!is.character(x) | nzchar(trimws(x))) } +homepage_labels <- function(x) { + values <- trimws(as.character(x)) + sort(unique(values[homepage_non_blank(values)])) +} + +homepage_collapse_labels <- function(x) { + values <- homepage_labels(x) + + if (length(values) == 0L) { + return(NA_character_) + } + + paste(values, collapse = "; ") +} + homepage_metrics <- function(data) { - data.frame( + tibble::tibble( metric = c( "Observations", "Measured variables", @@ -26,48 +41,61 @@ homepage_metrics <- function(data) { "Distinct species linked to observation records", "Distinct research sites linked to observation records", "Distinct cited sources linked to observation records" - ), - stringsAsFactors = FALSE + ) ) } homepage_top_traits <- function(data, n = 10L) { - traits <- data$trait[homepage_non_blank(data$trait)] - counts <- as.data.frame(table(traits), stringsAsFactors = FALSE) - names(counts) <- c("trait", "observations") - counts$observations <- as.integer(counts$observations) - counts <- counts[order(-counts$observations, counts$trait), , drop = FALSE] - utils::head(counts, n) + data <- dplyr::filter(data, homepage_non_blank(data[["trait"]])) + + summary <- dplyr::summarise( + data, + description = homepage_collapse_labels( + dplyr::pick("trait_description")[[1L]] + ), + observations = dplyr::n(), + .by = "trait" + ) + + summary <- dplyr::arrange( + summary, + dplyr::desc(summary[["observations"]]), + summary[["trait"]] + ) + + dplyr::slice_head(summary, n = n) } homepage_top_species <- function(data, n = 10L) { - valid_species <- !is.na(data$species_id) & homepage_non_blank(data$scientificname) - data <- data[valid_species, c("species_id", "scientificname"), drop = FALSE] - data$scientificname <- trimws(data$scientificname) - data$scientificname[!homepage_non_blank(data$scientificname)] <- NA_character_ - - species_ids <- unique(data$species_id) - summary <- lapply(species_ids, function(species_id) { - rows <- data[data$species_id == species_id, , drop = FALSE] - names <- unique(rows$scientificname[!is.na(rows$scientificname)]) - - if (length(names) > 1L) { - stop( - "Each species_id must have at most one non-blank scientificname.", - call. = FALSE - ) - } - - data.frame( - species_id = species_id, - species = if (length(names) == 1L) names else NA_character_, - observations = nrow(rows), - stringsAsFactors = FALSE - ) - }) + data <- dplyr::filter(data, !is.na(data[["species_id"]])) + + summary <- dplyr::summarise( + data, + scientific_name = { + names <- homepage_labels(dplyr::pick("scientificname")[[1L]]) + + if (length(names) > 1L) { + stop( + "Each species_id must have at most one non-blank scientific name.", + call. = FALSE + ) + } + + if (length(names) == 0L) NA_character_ else names + }, + common_name = homepage_collapse_labels( + dplyr::pick("commonname")[[1L]] + ), + observations = dplyr::n(), + .by = "species_id" + ) + + summary <- dplyr::arrange( + summary, + dplyr::desc(summary[["observations"]]), + summary[["scientific_name"]], + summary[["species_id"]] + ) - summary <- do.call(rbind, summary) - summary <- summary[order(-summary$observations, summary$species, summary$species_id), , drop = FALSE] - rownames(summary) <- NULL - utils::head(summary, n) + dplyr::slice_head(summary, n = n) } diff --git a/index.qmd b/index.qmd index bc00053..3dd99cb 100644 --- a/index.qmd +++ b/index.qmd @@ -11,6 +11,15 @@ source("R/homepage-data.R", local = TRUE) **betydata** is an R data package providing offline access to public data from [BETYdb](https://betydb.org) (Biofuel Ecophysiological Traits and Yields database). It enables reproducible analyses of plant traits, crop yields, and supporting metadata without requiring database connectivity. +## Guides + +| Guide | Description | +|-------|-------------| +| [Getting Started](vignettes/getting_started.qmd) | Package overview, data model, and key concepts | +| [Common Analyses](vignettes/common_analyses.qmd) | Practical analysis patterns with dplyr | +| [PFTs & Priors](vignettes/pfts-priors.qmd) | Plant Functional Types and Bayesian prior distributions | +| [Manuscript Reproduction](vignettes/manuscript.qmd) | Reproduce key analyses from LeBauer et al. (2018) | + ## At a Glance ```{r} @@ -66,33 +75,32 @@ DT::datatable( ) ``` -## Dataset Diversity +## Most Represented Variables and Species ```{r} #| echo: false #| label: tbl-top-traits #| tbl-cap: "Variables with the most observation records" homepage_top_traits(traitsview) |> - knitr::kable(col.names = c("Trait", "Observations"), row.names = FALSE) + knitr::kable( + col.names = c("Variable", "Description", "Observations"), + row.names = FALSE + ) ``` ```{r} #| echo: false #| label: tbl-top-species #| tbl-cap: "Species with the most observation records" -homepage_top_species(traitsview)[, c("species", "observations")] |> - knitr::kable(col.names = c("Species", "Observations"), row.names = FALSE) +homepage_top_species(traitsview)[ + , c("scientific_name", "common_name", "observations") +] |> + knitr::kable( + col.names = c("Scientific name", "Common name", "Observations"), + row.names = FALSE + ) ``` -## Guides - -| Guide | Description | -|-------|-------------| -| [Getting Started](vignettes/getting_started.qmd) | Package overview, data model, and key concepts | -| [Common Analyses](vignettes/common_analyses.qmd) | Practical analysis patterns with dplyr | -| [PFTs & Priors](vignettes/pfts-priors.qmd) | Plant Functional Types and Bayesian prior distributions | -| [Manuscript Reproduction](vignettes/manuscript.qmd) | Reproduce key analyses from LeBauer et al. (2018) | - ## Data License Data: [ODC-By-1.0](https://opendatacommons.org/licenses/by/1-0/) diff --git a/tests/testthat/test-homepage-data.R b/tests/testthat/test-homepage-data.R index e5522f6..2ad047c 100644 --- a/tests/testthat/test-homepage-data.R +++ b/tests/testthat/test-homepage-data.R @@ -1,23 +1,43 @@ homepage_fixture <- function() { - data.frame( + tibble::tibble( trait = c("SLA", "SLA", " ", NA, "Vcmax"), + trait_description = c( + "Specific leaf area", + "Specific leaf area", + "Ignored blank trait", + "Ignored missing trait", + "Maximum carboxylation rate" + ), species_id = c(1, 1, 2, NA, 3), site_id = c(10, 10, 11, NA, 20), citation_id = c(100, 100, 101, NA, 200), - scientificname = c("Alpha plant", "Alpha plant", "Beta plant", NA, "Gamma plant"), - stringsAsFactors = FALSE + scientificname = c( + "Alpha plant", + "Alpha plant", + "Beta plant", + NA, + "Gamma plant" + ), + commonname = c( + "Alpha common", + "Alpha common", + NA, + NA, + "Gamma common" + ) ) } test_that("homepage metrics count observations and linked entities", { metrics <- betydata:::homepage_metrics(homepage_fixture()) + expect_s3_class(metrics, "tbl_df") expect_equal(metrics$value, c(5, 2, 3, 3, 3)) }) test_that("duplicating an observation affects only the observation total", { data <- homepage_fixture() - duplicated_data <- rbind(data, data[1, ]) + duplicated_data <- dplyr::bind_rows(data, data[1, ]) original <- betydata:::homepage_metrics(data)$value duplicated <- betydata:::homepage_metrics(duplicated_data)$value @@ -33,30 +53,90 @@ test_that("display fields do not change homepage metrics", { expect_equal(betydata:::homepage_metrics(data)$value, original) }) -test_that("top traits exclude blank values and sort ties deterministically", { +test_that("top traits include descriptions and sort ties deterministically", { top_traits <- betydata:::homepage_top_traits(homepage_fixture()) + expect_named(top_traits, c("trait", "description", "observations")) expect_equal(top_traits$trait, c("SLA", "Vcmax")) + expect_equal( + top_traits$description, + c("Specific leaf area", "Maximum carboxylation rate") + ) expect_equal(top_traits$observations, c(2L, 1L)) }) -test_that("top species use species IDs and a single scientific name per ID", { +test_that("top traits retain missing descriptions and combine aliases", { + data <- tibble::tibble( + trait = c("c2n_stem", "c2n_stem", "c2n_stem", "unknown"), + trait_description = c( + " C:N ratio in stems ", + "C:N ratio in stem", + "C:N ratio in stem", + " " + ) + ) + + top_traits <- betydata:::homepage_top_traits(data) + + expect_equal( + top_traits$description[top_traits$trait == "c2n_stem"], + "C:N ratio in stem; C:N ratio in stems" + ) + expect_true(is.na(top_traits$description[top_traits$trait == "unknown"])) +}) + +test_that("top species use species IDs and retain missing common names", { top_species <- betydata:::homepage_top_species(homepage_fixture()) + expect_named( + top_species, + c("species_id", "scientific_name", "common_name", "observations") + ) expect_equal(top_species$species_id, c(1, 2, 3)) - expect_equal(top_species$species, c("Alpha plant", "Beta plant", "Gamma plant")) + expect_equal( + top_species$scientific_name, + c("Alpha plant", "Beta plant", "Gamma plant") + ) + expect_equal(top_species$common_name, c("Alpha common", NA, "Gamma common")) expect_equal(top_species$observations, c(2L, 1L, 1L)) - expect_false(any(is.na(top_species$species))) - expect_false(any(trimws(top_species$species) == "")) }) -test_that("top species reject conflicting names for one species ID", { +test_that("top species retain missing scientific names", { + data <- tibble::tibble( + species_id = c(1, 1), + scientificname = c(NA, " "), + commonname = c("Unnamed plant", "Unnamed plant") + ) + + top_species <- betydata:::homepage_top_species(data) + + expect_equal(top_species$species_id, 1) + expect_true(is.na(top_species$scientific_name)) + expect_equal(top_species$common_name, "Unnamed plant") + expect_equal(top_species$observations, 2L) +}) + +test_that("top species normalize names and combine common-name aliases", { + data <- tibble::tibble( + species_id = c(1, 1, 1), + scientificname = c("Alpha plant", " Alpha plant ", "Alpha plant"), + commonname = c("Zulu name", " Alpha name ", " ") + ) + + top_species <- betydata:::homepage_top_species(data) + + expect_equal(top_species$scientific_name, "Alpha plant") + expect_equal(top_species$common_name, "Alpha name; Zulu name") + expect_equal(top_species$observations, 3L) +}) + +test_that("top species reject conflicting scientific names for one ID", { data <- homepage_fixture() data$scientificname[2] <- "Different alpha plant" expect_error( betydata:::homepage_top_species(data), - "at most one non-blank scientificname" + "at most one non-blank scientific name" ) }) @@ -72,5 +152,35 @@ test_that("homepage helpers agree with direct traitsview calculations", { length(unique(traitsview$site_id[!is.na(traitsview$site_id)])), length(unique(traitsview$citation_id[!is.na(traitsview$citation_id)])) )) - expect_false(any(is.na(betydata:::homepage_top_species(traitsview)$species_id))) + + expected_traits <- traitsview |> + dplyr::filter(non_blank(trait)) |> + dplyr::count(trait, name = "observations") |> + dplyr::arrange(dplyr::desc(observations), trait) + actual_traits <- betydata:::homepage_top_traits( + traitsview, + n = nrow(expected_traits) + ) + + expect_equal( + actual_traits[c("trait", "observations")], + expected_traits[c("trait", "observations")] + ) + + expected_species <- traitsview |> + dplyr::filter(!is.na(species_id)) |> + dplyr::count(species_id, name = "observations") |> + dplyr::arrange(dplyr::desc(observations), species_id) + actual_species <- betydata:::homepage_top_species( + traitsview, + n = nrow(expected_species) + ) + + expect_equal( + dplyr::arrange( + actual_species[c("species_id", "observations")], + species_id + ), + dplyr::arrange(expected_species, species_id) + ) })