Taxonomix keys for Rmarkdown/bookdown

[heibl]

Dear Yihui (and anybody else who is interested)

I've been following your work for quite some time. The power of these tools is so amazing! Thanks a lot!

Being originally a plant systematist, I have developed a LaTeX package (14 years ago and surely not perfect) that helped me to include taxonomic identification keys into LaTeX documents:

https://ctan.org/pkg/bracketkey?lang=de

Now with bookdown being such an inspiring tool, I felt that it would be great to have such a functionality ported to Rmarkdown. I am quite aware that something like this is only a niche product - compared to tables or figures. But, anyway, maybe you are interested and have the time to take a glimpse of the bracketkey package and offer your appraisal: would it be easy to accomplish or a waste of time or something in between? How would you go about it?

Best regards,
Christoph

[yihui]

Hi Christoph, thanks for the information! I'm afraid that I don't have enough expertise to evaluate this LaTeX package after I read the documentation and example. If you have a proof-of-concept implementation in R, I can probably understand it better. Or perhaps other people can share their insights, which I'd love to hear.

[heibl]

Dear Yihui,
thanks, your answer brought it right to my mind: it is possible to build dichotomous identification keys directly in R with kable. Only a small function key is needed. The input object x (attached as Poa.csv) is a tibble with columns Couplet, Lead, Description, and Result. Being a dichotomous key each couplet contains two leads.

key <- function(x){
  
  # darkred: #8b0000
  
  ## Which leads (rows) contain forward pointers
  x <- mutate(x, isPointer = str_detect(Result, pattern = "^[[:digit:]]*$"))
  
  ## Prepare backward pointers
  bp <- x %>% 
    group_by(Couplet) %>%
    mutate(allPointer = all(isPointer)) %>%
    ungroup() %>%
    filter(Lead == 2, allPointer) %>%
    select(Couplet, Result)
  
  ## Style for forward pointers and species names
  x <- mutate(x, Result = ifelse(
    isPointer, 
    paste0("[", Result, "]{style='float:right;font-weight:bold;color:#808080'}"), 
    paste0("[", Result, "]{style='float:right;font-weight:bold;font-style:italic'}")))
  
  ## Set backwards pointers (don't know how to do with pure dplyr)
  x <- mutate(x, bp = 0)
  for (i in 1:nrow(bp)){
    x$bp[x$Couplet == bp$Result[i] & x$Lead == 1] <- bp$Couplet[i]
  }
  x <- x %>% 
    mutate(Couplet = paste0("[", Couplet, c("", "*"), "]{style='font-weight:bold'}")) %>%
    mutate(Couplet = if_else(
      bp == 0, Couplet,
      paste0(Couplet, paste0("(", bp, ")"))))
  
  ### Prepare kable object       
  x %>% mutate(Description = paste(Description, Result)) %>%
    select(Couplet, Description) %>%
    kbl(col.names = NULL, align = "ll", escape = FALSE) %>%
    column_spec(1, color = "#808080", width_min = "8mm",
                extra_css = "vertical-align:top;") %>%
    column_spec(2, extra_css = "vertical-align:top;") %>%
    row_spec(seq.int(from = 2, to = nrow(x), by = 2), 
             extra_css = "border-bottom: 0.5px solid",
             hline_after = TRUE)
}

Then we can use it inside an Rmd-document to build an HTML-key:

---
title: "Identification keys for Rmarkdown"
output: 
  html_document
---

```{r setup, include=FALSE, message=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(readr)
library(stringr)
library(dplyr)
library(kableExtra)
source("key.R")
```

#### Key to meadow-grass (*Poa*) in the Bavarian Forest National Park

```{r key, message=FALSE, echo=FALSE}
x <- read_csv2("Poa.csv", locale = locale(decimal_mark = ","))
key(x)
```

As is easy as that. Of course, for longer keys, it would be nice to have forward and backward pointers cross-referenced, but I wasn't able to figure out that.

Poa.csv