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/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 b93bd23..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, @@ -17,6 +23,7 @@ BugReports: https://github.com/PecanProject/betydata/issues Depends: R (>= 4.1.0) Suggests: + DT, dplyr (>= 1.1.0), ggplot2, jsonlite, @@ -24,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 a164551..d654a5d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,10 @@ # 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). * Replaced `Infinity` and `-Infinity` variable-bound placeholders with `NA`. + # betydata 0.1.0 ## Initial Release diff --git a/R/homepage-data.R b/R/homepage-data.R new file mode 100644 index 0000000..2489f39 --- /dev/null +++ b/R/homepage-data.R @@ -0,0 +1,101 @@ +# Homepage summary helpers used by the Quarto site. + +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) { + tibble::tibble( + 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" + ) + ) +} + +homepage_top_traits <- function(data, n = 10L) { + 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) { + 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"]] + ) + + dplyr::slice_head(summary, n = 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..3dd99cb 100644 --- a/index.qmd +++ b/index.qmd @@ -6,31 +6,36 @@ 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. +## 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} #| 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,27 +48,58 @@ 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 +## Most Represented Variables and Species -# 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("Variable", "Description", "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) | +```{r} +#| echo: false +#| label: tbl-top-species +#| tbl-cap: "Species with the most observation records" +homepage_top_species(traitsview)[ + , c("scientific_name", "common_name", "observations") +] |> + knitr::kable( + col.names = c("Scientific name", "Common name", "Observations"), + row.names = FALSE + ) +``` ## Data License 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..2ad047c --- /dev/null +++ b/tests/testthat/test-homepage-data.R @@ -0,0 +1,186 @@ +homepage_fixture <- function() { + 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" + ), + 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 <- dplyr::bind_rows(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 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 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$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)) +}) + +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 scientific name" + ) +}) + +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)])) + )) + + 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) + ) +})