John L. Godlee

BIOMASS::check_plot_coord() with non-corner points

2026-03-10T00:00:00+0000

In GEO-TREES we are using the BIOMASS R package to process tree inventory data to produce 50x50 m estimates of above-ground woody biomass density (AGBD). BIOMASS has a function called check_plot_coord() that takes GPS measurements of plot corners and fits a polygon to them, to estimate the area covered by the plot. GPS data are noisy and imprecise, meaning we often have some uncertainty in the location of the plot corners. check_plot_coord() allows you to use multiple repeat measurements of the plot corners to find the average the location of each corner.

However, check_plot_coord() doesn’t let you incorporate auxiliary GPS measurements taken at other known points within the plot, such as at the intersections of subplots, the plot centre, or around the perimeter of the plot. I have developed a more simple function that allows you to incorporate these auxiliary GPS measurements to estimate the true location of the plot.

As with check_plot_coord(), my function (polyFit()) lets you choose between either a procrustes analysis that trusts the plot dimensions first (i.e. maintains the plot dimensions) or an interpolation method that trusts the GPS coordinates first (i.e allows the plot shape to warp and sheer). In polyFit(), the interpolation method comes from an affine transformation of the GPS coordinates, while check_plot_coord() uses bilinear interpolation, which is fundamentally limited to use only four plot corners. This means that check_plot_coord() also cannot account for more irregular plot shapes. All plots must be rectangles in their method, while polyFit() can accommodate arbitrarily complex plots. Finally, polyFit() also allows a simple “exact” method which simply averages the locations of each plot corner individually.

Here is my function:

# @param x dataframe containing point locations
# @param method either 'exact', 'affine' or 'procrustes'
# @param proj_cols vector of length two specifying the X and Y coordinates of each point in `x`, in local UTM
# @param rel_cols vector of length two specifying the relative X and Y coordinates of each point in `x`, in metres
# @param type_col name of column in `x` specifying each point as either a plot corner or an auxiliary point. 
#
polyFit <- function(x, method, proj_cols, rel_cols, type_col) {  

  # Rename columns 
  names(x)[names(x) %in% proj_cols] <- c("x_proj", "y_proj")
  names(x)[names(x) %in% rel_cols] <- c("x_rel", "y_rel")
  names(x)[names(x) == type_col] <- "type"

  # Extract corners points only
  corners <- x[x$type == "corner", ]

  # Transformation
  if (method == "exact") { 
    # Take mean of all values per corner
    corners <- aggregate(cbind(x_proj, y_proj) ~ x_rel + y_rel, 
      data = corners, FUN = mean)
  } else if (method == "affine") {
    # Fits independent scale and shear
    fit_x <- lm(x_proj ~ x_rel + y_rel, data = x)
    fit_y <- lm(y_proj ~ x_rel + y_rel, data = x)
    
    corners$x_proj <- predict(fit_x, newdata = corners)
    corners$y_proj <- predict(fit_y, newdata = corners)
    
  } else if (method == "procrustes") {
    procrust_res <- BIOMASS::procrust(x[, c("x_proj", "y_proj")], x[, c("x_rel", "y_rel")])
    
    procrust_coord <- as.matrix(corners[, c("x_rel", "y_rel")]) %*% procrust_res$rotation
    procrust_coord <- sweep(procrust_coord, 2, procrust_res$translation, FUN = "+")
    
    corners$x_proj <- procrust_coord[, 1]
    corners$y_proj <- procrust_coord[, 2]
  } else {
    stop("method must be either 'exact', 'affine' or 'procrustes'")
  }

  # Collapse to unique corners
  corners <- corners[!duplicated(corners),]

  # Sort corners counter-clockwise 
  centroid <- colMeans(corners[,c("x_rel","y_rel")])
  angles <- base::atan2(corners[["y_rel"]] - centroid[2], corners[["x_rel"]] - centroid[1])
  corners <- corners[order(angles), ]

  # Return
  return(corners)
}

Below is a comparison of the performance of the different methods using various scenarios. The larger grey circles represent individual GPS measurements of a point. Red circles and lines represent results from BIOMASS::check_plot_coord(). Blue circles and lines are from my polyFit() function. Columns are different methods from both sets of functions. Rows are different data scenarios.

You can see that under most scenarios the methods return identical results. The big difference is in the “bad_centre” scenario where check_plot_coord() can’t handle non-corner points. ANother difference is in the “bad_corner” scenario under the affine / bilinear interpolation method, where check_plot_coord() just follows the corner measurements directly.

Reddit data on top five episodes of The Office (USA)

2026-02-14T00:00:00+0000

This thread was posted on Reddit where they asked people to rank their top five episodes of The Office (USA). I analysed the data to find the overall consensus on the top five episodes.

First, I downloaded the comments and extracted the top-level comments.

# Packages
library(dplyr)
library(tidyr)
library(jsonlite)
# devtools::install_github("dgrtwo/fuzzyjoin")
library(fuzzyjoin)
library(ggplot2)
library(scico)
library(legendry)

# Download comments from Reddit
url <- "https://old.reddit.com/r/DunderMifflin/comments/1r2br1l/.json"
dat <- fromJSON(url, simplifyDataFrame = FALSE)

# Extract comments
top_level <- dat[[2]]$data$children

comments <- do.call(rbind,
  lapply(top_level, function(x) {
    if (x$kind != "t1") {
      return(NULL)
    } else {
      data.frame(
        id = x$data$id,
        author = x$data$author,
        body = x$data$body
      )
    }
  })
)

Then I had to do some manual re-factoring of the comments to deal with differences in the way people had ranked their top five. I also removed comments where there were no recommendations. But, I kept comments which didn’t give the full five.

Then I cleaned the comments and converted to long format so each row was a recommended episode by a single commenter:

# Clean comments, convert to long-format
comments_clean <- comments %>% 
  dplyr::select(id, body_clean) %>% 
  separate_longer_delim(body_clean, ";") %>% 
  mutate(body_clean = trimws(body_clean)) %>% 
  filter(body_clean != "") %>% 
  separate_wider_delim(body_clean, delim = ".", names = c("rank", "ep")) %>% 
  mutate(
    rank = as.numeric(rank),
    ep = trimws(tolower(ep)),
    ep = case_when(
      ep == "the buyout" ~ "broke",
      ep == "the mafia" ~ "mafia",
      ep == "the beach day" ~ "beach games",
      ep == "the return" ~ "travelling salesman & the return",
      ep == "the booze cruise" ~ "booze cruise",
      ep == "the quiz" ~ "trivia",
      ep == "chilli's episode" ~ "the dundies",
      ep == "party" ~ "pool party",
      ep == "downsize" ~ "the alliance",
      TRUE ~ ep))

Then I used fuzzy-matching to line up the recommendations with specific episodes with their season and episode number:

# Read episode titles
episodes <- readLines("./episodes.txt")

# Create dataframe of episode titles 
ep_clean <- data.frame(
  episode_name = gsub(".*\\s-\\s", "", episodes),
  episode_id = gsub("\\s-\\s.*", "", episodes)) %>% 
  mutate(
    episode_name = trimws(tolower(episode_name)),
    season = as.numeric(gsub("S0", "", gsub("E.*", "", episode_id))),
    episode = as.numeric(gsub(".*E", "", gsub("-.*", "", episode_id))))

# Perform fuzzy matching of episode titles 
# Select best match
# fill in episodes that were never recommended
out <- stringdist_join(comments_clean, ep_clean, 
  by = c("ep" = "episode_name"),
  mode = "left",
  method = "jw",
  max_dist = 99, 
  distance_col = "dist") %>%
  group_by(id, rank) %>% 
  slice_min(order_by = dist, n = 1) %>% 
  ungroup() %>% 
  mutate(rank = factor(rank, levels = 1:5)) %>% 
  group_by(season, episode, rank) %>% 
  tally() %>% 
  right_join(., ep_clean[,c("season", "episode")], by = c("season", "episode")) %>% 
  mutate(n = ifelse(is.na(n), 0, n))

The top episodes by number of times the episode appeared anywhere in a top five list:

Episode	N
S04E13 – Dinner Party	47
S05E13 – Stress Relief	23
S02E12 – The Injury	17
S01E02 – Diversity Day	13
S04E18 – Goodbye, Toby	9

Then I made a stacked bar plot of the recommendations for each episode:

# Create bar plot
ggplot(out, aes(x = episode, y = n)) +
  geom_col(aes(fill = rank), position = "stack") +
  scale_fill_scico_d(name = "Rank", palette = "bamako", 
    direction = -1, drop = FALSE, na.translate = FALSE) + 
  facet_wrap(~season, scales = "free_x") + 
  scale_x_continuous(breaks = 1:max(out$episode)) + 
  labs(
    x = "Season / Episode",
    y = "Recommendations") + 
  theme_bw() +
  theme(
    legend.position = "bottom",
    axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
    panel.grid.major.x = element_blank())

I used ChatGPT to extract the ratings of each episode of The Office from IMDB. Then compared the IMDB ratings against the total number of times an episode appeared in a top five list:

# Import IMDB ratings
imdb_ratings <- read.csv("./imdb_ratings.csv")

# Combine Reddit top-5s and IMDB ratings 
out_imdb <- left_join(out, imdb_ratings, by = c("season", "episode")) %>% 
  mutate(
    n = ifelse(is.na(n), 0, n),
    season = as.factor(season))

# Plot comparison of IMDB rating and number of top-5 recommendations 
ggplot(out_imdb, aes(x = imdb_rating, y = n)) +
  geom_point(aes(colour = season), position = position_jitter(width = 0.02, height = 0), alpha = 0.5) + 
  scale_colour_scico_d(name = "Season", palette = "batlow") + 
  theme_bw() + 
  labs(
  x = "IMDB rating",
  y = "N recommendations")

Typst template

2026-01-31T00:00:00+0000

In a previous post I created a LaTeX template to keep track of my preferred configuration for typesetting notes and reports. I still use LaTeX a lot, but I’ve been getting interested in Typst , a modern document typesetting system that could be a viable replacement. Typst fixes a lot of issues that made LaTeX annoying to use:

LaTeX installations are huge, 3.5 – 5 GB.
Compilation of large documents is slow. My PhD thesis took around 5 minutes to compile from scratch.
Error messages are cryptic.
The syntax of LaTeX macros is arcane.

In order to learn how Typst works, I tried to re-create my LaTeX document template. I also experimented with a few new features.

These are the basic verbs of Typst:

set allows you to globally define the options for an existing element.
let is for defining new elements.
show allows you to customise an existing element.

I will go through the template line by line:

Firstly import external packages. * means import all functions from these packages. Compared to LaTeX, I need far fewer packages to create a nice looking document.

#import "@preview/booktabs:0.0.4": *  // booktabs style tables
#import "@preview/zero:0.6.0": *  // similar to siunitx

Define options for the template, which can be set in the document which calls the template.

// mynotes.typ
#let project(
    title: "", 
    authors: (), 
    line_numbers: false, 
    draft_mode: false, 
    anonymous: false,
    spacing: "normal",
    
    body) = {

Basic document settings, including the title, authors, page geometry and fonts. 2.54 cm margins matches the default for Microsoft Word documents. Pages are numbered, with numbers at the bottom of the page in the centre. The font is “CMU Serif”, which was designed by Donald Knuth for TeX.

  // Set document metadata
  set document(title: title, author: authors)

  // Page geometry
  set page(
    paper: "a4",
    margin: (
      top: 2.54cm, 
      bottom: 2.54cm,
      left: 2.54cm,
      right: 2.54cm
    ),
    numbering: "1", 
    number-align: center, 
  )

  // Font
  set text(
    font: "CMU Serif", 
    size: 11pt,
    lang: "en",
    region: "gb"
  )

Adjust paragraph and heading spacing. Colour hyperlinks. Bump the bibliography to a new page.

  // Heading numbering
  set heading(
    numbering: "1."
  )

  // Paragraph spacing 
  set par(
    spacing: 0.55cm
  )

  // Heading spacing
  show heading: set block(
      above: 1.5em, 
      below: 1.0em
    )

  // Heading text size
  show heading: set text(size: 1.1em)
  
  // Hyperlink colour
  show link: set text(fill: rgb("#336666"))

  // Bibliography on a new page
  show bibliography: it => {
    pagebreak()
    it
  }

Define a toggle for line numbering. If the option “line_numbers: true” when the template is called, the document will have line numbers.

  // Line number toggle
  show: it => {
    if line_numbers {
      set par.line(numbering: "1")
      it
    } else {
      it
    }
  }

This is one of the new features, a toggle which adds a “DRAFT” watermark across the page.

  // Draft mode toggle
  show: it => {
    if draft_mode {
      set page(background: rotate(45deg, text(80pt, fill: rgb("EEEEEE"))[DRAFT]))
      it
    } else {
      it
    }
  }

Another new feature to toggle the spacing of the document. Useful if I want to print and annotate a draft.

  // Spacing toggle
  show: it => {
    if spacing == "compact" {
      set par(leading: 0.5em, justify: true)
      set page(margin: 1.5cm)
      it
    } else if spacing == "wide" {
      set par(leading: 1.5em) 
      it
    } else {
      it
    }
  }

Another new feature to anonymise the authors by replacing the names with a black bar.

  // Control for potentially multiple authors
  let authors = if type(authors) == str { (authors,) } else { authors }

  // Anonymous author names toggle
  show: it => {
    if anonymous {
      for author in authors {
        show author: name => box(fill: black, radius: 1pt, hide(name))
      }
      it
    } else { it }
  }

  // Title and author formatting
  align(center)[
    #block(text(size: 2em, weight: "bold")[#title])

    #text(size: 1em)[
      #{
        let names = authors.join(", ", last: ", and ")
        if anonymous {
          // Optional redaction of author names
          box(fill: black, radius: 1pt, hide(names))
        } else {
          names
        }
      }
    ]
    #v(1em) 
  ]

Set the style for tables and figures.

  // Reset table style
  set table(
    stroke: none,
    gutter: 0pt,
    inset: 0.5em,
  )

  // Use booktabs default style
  show table: it => {
    booktabs-default-table-style(it)
  }

  // Move table captions above, but keep image captions below
  show figure.where(kind: table): set figure.caption(position: top)

  // Left-align figure captions
  show figure.caption: it => {
    block(width: 90%, align(left)[
      #it
    ])
  }

  // Add space between the caption and the table
  show figure.where(kind: table): set block(spacing: 1.5em)

  // Render content
  body
}

Define a new variable to highlight TODO items in red with a pale red background and prefixed with “TODO:”.

// Define todo function
#let todo(body) = {
  highlight(fill: red.lighten(80%))[
    #text(fill: red.darken(20%), weight: "bold")[TODO:] #body
  ]
}

Configure the zero package, which formats numbers.

// Configure {zero}
#set-group(
  size: 3, 
  separator: ",", 
  threshold: (integer: 4, fractional: calc.inf),
)

Then in the main document I can do this to call the template if the template is in the project directory:

#import "mynotes.typ": *

#show: project.with(
  title: "Testing the Typst template",
  authors: ("John L. Godlee"),
  line_numbers: false,
  draft_mode: false,
  anonymous: false,
  spacing: "normal",
)

I can also put the template here to call it from anywhere:

Library/Application Support/typst/
└── packages
    └── local
        └── mynotes
            └── 0.1.0
                ├── mynotes.typ
                └── typst.toml

The typst.toml looks like this:

[package]
name = "mynotes"
version = "0.1.0"
entrypoint = "mynotes.typ"

Then I can call it in a document like so:

#import "@local/mynotes:0.1.0": *

#show: project.with(
  title: "Testing the Typst template",
  authors: ("John L. Godlee"),
  line_numbers: false,
  draft_mode: false,
  anonymous: false,
  spacing: "normal",
)

To streamline the editing process I am using the chomosuke/typst-preview.nvim neovim plugin, which lets you compile Typst documents inside neovim, and provides a live preview of the document in a web browser. It relies on the tinymist LSP. This is the config I’m using with Lazy.nvim:

-- Typst
return { "chomosuke/typst-preview.nvim",
	ft = "typst", -- Only load when opening Typst files
	version = "1.*",

	build = function()
		require("typst-preview").update()
	end,

	config = function()
		require("typst-preview").setup({
			debug = false,
			render_on_save = false,
			follow_cursor = true,
			invert_colors = "auto",
		})
	end,
}

British Ecological Society Annual Meeting talk

2025-12-16T00:00:00+0000

I gave a talk at the British Ecological Society Annual Meeting. The talk contains preliminary results of a project which explores spatial variation in biomass stocks across tropical forests. The study looks at the roles of regional environment (climate, elevation), local environment (soils, topography), and tree community composition, and in particular how the relative importance of different functional traits (potential growth rate, potential survival rate, maximum tree size, wood density) for biomass stocks varies across forests.

Here is a link to the slides with the script .

Shiny app to interactively place ggrepel labels

2025-12-15T00:00:00+0000

I wrote an R Shiny app which allows you to interactively choose the location of labels placed using ggrepel::geom_label_repel() on a ggplot object.

The aim of the app is to streamline the process of deliberately placing labels when the automated label placement algorithm doesn’t provide an acceptable solution.

Run the app by placing the code below in a file called app.R, then run from R using shiny::runApp("./app.R").

# Shiny app to interactively place ggrepel points
# John L. Godlee (johngodlee@gmail.com)
# Last updated: 2025-12-07

# Packages
library(shiny)
library(ggplot2)
library(ggrepel)

# UI
ui <- fluidPage(
  titlePanel("Interactive ggrepel Label Positioner"),
  
  fluidRow(
    column(3,
      wellPanel(
        h4("Upload Data"),
        fileInput("csv_file", "Choose CSV File",
                  accept = c("text/csv", 
                           "text/comma-separated-values,text/plain", 
                           ".csv")),
        p("CSV must have columns: x, y, label"),
        hr(),
        h4("Instructions"),
        p("Click on a label to select it, then click where you want to move it."),
        hr(),
        h4("Plot Limits"),
        numericInput("x_min", "X Min:", value = 0, step = 0.5),
        numericInput("x_max", "X Max:", value = 10, step = 0.5),
        numericInput("y_min", "Y Min:", value = 0, step = 0.5),
        numericInput("y_max", "Y Max:", value = 10, step = 0.5)
      )
    ),
    
    column(9,
      plotOutput("ggplot", 
        width = "700px", 
        height = "500px",
        click = "plot_click"),
      hr(),
      h3("Generated R Code"),
      verbatimTextOutput("r_code"),
      p("Copy and paste this code into your R script.")
    )
  )
)

# SERVER
server <- function(input, output, session) {
  
  # Default data
  default_data <- data.frame(
    x = c(3, 6, 4.5, 7.5, 2),
    y = c(4.5, 7.5, 3, 6, 8),
    label = c("Point A", "Point B", "Point C", "Point D", "Point E"),
    stringsAsFactors = FALSE
  )
  
  # Reactive data from file upload
  uploaded_data <- reactive({
    req(input$csv_file)
    
    tryCatch({
      df <- read.csv(input$csv_file$datapath, stringsAsFactors = FALSE)
      
      # Check for required columns
      if(!all(c("x", "y", "label") %in% names(df))) {
        showNotification("CSV must contain columns: x, y, label", type = "error")
        return(default_data)
      }
      
      # Convert to proper types
      df$x <- as.numeric(df$x)
      df$y <- as.numeric(df$y)
      df$label <- as.character(df$label)
      
      # Remove rows with NA values
      df <- df[complete.cases(df[c("x", "y", "label")]), ]
      
      if(nrow(df) == 0) {
        showNotification("No valid data rows found", type = "error")
        return(default_data)
      }
      
      showNotification(paste("Loaded", nrow(df), "data points"), type = "message")
      return(df)
      
    }, error = function(e) {
      showNotification(paste("Error reading file:", e$message), type = "error")
      return(default_data)
    })
  })
  
  # Use uploaded data if available, otherwise use default
  current_data <- reactive({
    if(!is.null(input$csv_file)) {
      uploaded_data()
    } else {
      default_data
    }
  })
  
  # Reactive values
  rv <- reactiveValues(
    label_x = NULL,
    label_y = NULL,
    selected_label = NULL
  )
  
  # Initialize label positions when data changes
  observe({
    df <- current_data()
    if(is.null(rv$label_x) || length(rv$label_x) != nrow(df)) {
      rv$label_x <- df$x
      rv$label_y <- df$y
    }
  })
  
  # Auto-update axis limits when new data is loaded
  observe({
    df <- current_data()
    if(!is.null(input$csv_file)) {
      x_range <- range(df$x, na.rm = TRUE)
      y_range <- range(df$y, na.rm = TRUE)
      x_padding <- diff(x_range) * 0.1
      y_padding <- diff(y_range) * 0.1
      
      updateNumericInput(session, "x_min", value = floor(x_range[1] - x_padding))
      updateNumericInput(session, "x_max", value = ceiling(x_range[2] + x_padding))
      updateNumericInput(session, "y_min", value = floor(y_range[1] - y_padding))
      updateNumericInput(session, "y_max", value = ceiling(y_range[2] + y_padding))
    }
  })
  
  # Handle plot clicks
  observeEvent(input$plot_click, {
    click <- input$plot_click
    
    if(is.null(rv$selected_label)) {
      # Select the nearest label
      distances <- sqrt((rv$label_x - click$x)^2 + (rv$label_y - click$y)^2)
      if(min(distances) < 1.5) {
        rv$selected_label <- which.min(distances)
      }
    } else {
      # Move the selected label to click position
      rv$label_x[rv$selected_label] <- click$x
      rv$label_y[rv$selected_label] <- click$y
      rv$selected_label <- NULL
    }
  })
  
  # Render the ggplot
  output$ggplot <- renderPlot({
    df <- current_data()
    req(rv$label_x)
    
    # Create data frame for label positions
    label_df <- data.frame(
      x = rv$label_x,
      y = rv$label_y,
      label = df$label,
      selected = sapply(1:nrow(df), function(i) {
        !is.null(rv$selected_label) && i == rv$selected_label 
      })
    )
    
    # Create the plot
    p <- ggplot(df, aes(x = x, y = y)) +
      # Add connection lines from points to labels
      geom_segment(
        data = data.frame(
          x = df$x,
          y = df$y,
          xend = rv$label_x,
          yend = rv$label_y),
        aes(x = x, y = y, xend = xend, yend = yend),
        linetype = "dashed", color = "black") +
      # Add data points
      geom_point() +
      # Add labels (showing final result)
      geom_label(
        data = label_df,
        aes(x = x, y = y, label = label, fill = selected)) +
      scale_fill_manual(values = c("FALSE" = "white", "TRUE" = "#dbeafe"), 
        guide = "none") +
      # Styling
      coord_cartesian(
        xlim = c(input$x_min, input$x_max),
        ylim = c(input$y_min, input$y_max),
        clip = "off")
    
    p
  })
  
  # Generate R code
  output$r_code <- renderText({
    df <- current_data()
    req(rv$label_x)
    
    labels <- paste0('"', df$label, '"', collapse = ", ")
    x_coords <- paste0("    ", sprintf("%.2f", rv$label_x), collapse = ",\n")
    y_coords <- paste0("    ", sprintf("%.2f", rv$label_y), collapse = ",\n")
    
    sprintf('
library(ggplot2)
library(ggrepel)

# Your data
df <- data.frame(
  x = c(%s),
  y = c(%s),
  label = c(%s)
)

# Custom label positions from dragging
label_positions <- data.frame(
  x = c(
%s),
  y = c(
%s))

# Create the plot
ggplot(df, aes(x = x, y = y)) +
  geom_point() +
  geom_label_repel(
    aes(label = label),
    nudge_x = label_positions$x - df$x,
    nudge_y = label_positions$y - df$y) +
  xlim(%s, %s) +
  ylim(%s, %s)',
    paste(sprintf("%.2f", df$x), collapse = ", "),
    paste(sprintf("%.2f", df$y), collapse = ", "),
    labels,
    x_coords,
    y_coords,
    input$x_min,
    input$x_max,
    input$y_min,
    input$y_max)
  })
}

shinyApp(ui = ui, server = server)

Making the best woody biomass reference plot ever

2025-12-03T00:00:00+0000

I have been reading field data collection protocols from various networks of permanent forest tree monitoring plots to come up with recommendations and requirements for how data should be collected for use by the GEO-TREES initiative. GEO-TREES is a multi-network collaboration aiming to produce high quality biomass reference measurements across global tropical forests, to help calibrate and validate satellite biomass mapping missions.

The document we are producing is intentionally deferential to the existing protocols produced by the various networks. We don’t want to produce yet another field protocol . We only want to focus on aspects of the methodology which are essential to produce good estimates of the area-density of above-ground woody biomass.

I’ve read through protocols from:

From reading these protocols in detail, and from my own experience collecting these data in various savannas, dry forests and wet forests, I have my own ideas of how to make field data collection easier and how to reduce errors. Most of these ideas won’t make it into the GEO-TREES guidelines, because we’re trying not to be too prescriptive, so I’m going to dump them here in case anybody finds them useful. This is a very maximalist approach to tree inventory data collection. I have never followed all these recommendations perfectly.

Reading these protocols together you get a good sense of the history of this kind of field inventory work in the tropics, and you can see how recommendations have developed over the last few decades. The RAINFOR protocol references the Condit (1998) book a few times. In turn, both DryFlor and SEOSAW reference the RAINFOR protocol.

Plot location

Gain the informed consent of the landowners and land users (formal or informal use) before setting up plots. Also aim to develop an equitable partnership with a local organisation like a university, herbarium or NGO, who can be responsible for managing the plots and who have an interest in keeping the plots going. For example, if they have students who can use the data. Plots with buy-in from local partners are much more likely to be supported over the long term.

Conduct interviews and guided walks with knowledgeable local partners to get a sense of the landscape and heterogeneity of vegetation. Ask about current land use, and potential future land use. Unless the purpose is to study future perturbations, locate plots in areas with long term protection from human disturbance.

Unless the aim is to measure the effects of proximity to features such as roads, water courses, forest edges, etc, establish plots at least 200 m away from these features. If the aim is to measure proximity effects, consider using a different sampling design such as transects or many small plots.

Locate plots on homogeneous ground, in terms of vegetation structure (to the extent possible), soil type and land use history. This makes downstream interpretation of the data easier, for example when comparing plot-level values from multiple plots within a site.

Balance the accessibility of plots with secrecy. Plots near to roads and settlements are more likely to be disturbed by human activities, but being near to roads also makes it easier to conduct field work.

Take advantage of satellite data and existing maps to stratify the location of plots within a site such that the plots represent the major environmental, anthropogenic and functional dimensions of the site. Identify many potential plot locations within each stratum and load them onto a handheld GNSS unit. To avoid selection bias when locating new plots, if the prospective plot location is not suitable for whatever reason, do not manually adjust the plot location. Instead, move to the next prospective plot location within the sample stratum.

It can be valuable to establish some plots in areas with no trees. Over the long term, these plots may be especially useful to quantify the rate of vegetation type transitions.

I have developed a small R package (siteOptiSample ) which can be used with high resolution spatial raster data (e.g. structural metrics from airborne LiDAR data) to optimally locate plots within the landscape to minimise the dissimilarity between pixels and plots in terms of their vegetation structure.

Plot size and shape

Plots should normally be at least 1 ha in size. Smaller plots have a larger perimeter:area ratio, which increases the relative influence of above-ground woody biomass density (AGBD) errors arising from stems at the edge of the plot being falsely included/omitted from the census. Additionally, in smaller plots local variations in structure such as the occurrence of a rare large tree have a large effect on AGBD estimates, while larger plots provide a more representative estimate of forest AGBD.

If trees are sparse, or are very spatially clustered, plots may need to be larger than 1 ha to provide a representative estimate of AGBD.

Avoid nested plot designs, e.g. different minimum inclusion thresholds for stems within nested subplots of different sizes. Multiplying up the biomass estimates of nested subplots to the total plot area can lead to large errors in plot-level AGBD estimates. The small size of the inner-most nesting level can create huge errors in estimates of stem abundance, biodiversity, etc.

The area of plots should be measured relative to a planar projection. In other words, the distance between plot corners should be measured as a straight line as if looking down from above, not following the ground surface. While measuring plot area according to the ground surface is generally easier in the field, measuring relative to the ground surface will result in plots with a smaller planar area that may limit their use when matching with satellite data. Where dimensions of existing plots are measured relative to the ground surface, take extra care to precisely geo-reference the plot corners and all subplot corners.

Ideally orientate plots according to latitudinal north, not magnetic north. Again, this maximises potential overlap between the plot and whole pixels from satellite datasets.

Marking a plot

Setting up large plots can be time-consuming, but it is worth getting it right during plot establishment to save more work in the future. Here is a set of instructions on how to mark out a 50 m plot using tape measures:

Start by identifying the centre location of the plot.
Line 1: Using a compass, with adjustments for declination, walk from the centre point directly SW 35.35 m (sqrt(50^2 + 50^2) = 70.71 / 2 = 35.35). The SW corner is now fixed and ideally should not be moved.
Line 2: Measure from the centre point NW 35.35 m.
Line 3: Measure from the SW corner to the NW corner. This distance should be 50 m. If the distance is not 50 m, adjust the position of the NW corner so it is 50 m, ensuring that the length of the line from the centre to the NW corner remains 35.35 m.
Line 4: Measure from the centre point NE 35.35 m.
Line 5: Measure from the NW corner to the NE corner. Adjust the position of the NE corner accordingly.
Line 6: Measure from the centre point SE 35.35 m.
Line 7: Measure from the NE corner to the SE corner. Adjust the position of the SE corner accordingly.
Line 8: Measure from the SE corner to the SW corner. This distance should be 50 m. If the distance is not 50 m, make minor adjustments to positions of the other corners.

In dense forests where visibility is low you could instead sequentially mark out smaller quadrants of the plot using this method.

Add a robust and permanent marker at each plot corner. Concrete posts formed around reinforcing bar work well, buried so ~10 cm of the post is visible above the ground, with as much as possible below the ground. Bare re-inforcing bar also works, but can be harder to see and could be dangerous if somebody falls on it.

Where concrete and rebar are not allowed, for example where there is concern for the safety of animals which may fall onto the exposed rebar, consider using large metal plates which sit flush to the ground, with an anchor to stop them moving.

Consider spray painting plot markers in a conspicuous colour like fluorescent orange or green.

Add auxiliary markers at regular intervals around the perimeter of the plot, e.g. aligning with the corners of the subplots (see below). Make sure the perimeter markers look different to the corner markers so the location of the corner is not mistaken. Ideally also add auxiliary markers to the interior corners of the subplots. If possible make these different again from the perimeter auxiliary markers and the plot corners.

At some plots the risk of corner markers being removed by humans or animals means that an alternative approach is required. Metal posts or strong magnets can be buried completely and re-located using a metal detector. This is the most reliable method, provided the metal detector is of good quality and is being used by a trained operator. A differential Global Navigation Satellite System (GNSS) unit can be used to locate plot corners if multiple measurements are taken over the course of several days, removing any need for a permanent corner marker, but this limits future censuses to also using a differential GNSS unit. I do not recommend this approach. The position of plot corners can also be triangulated relative to known landmarks in the vicinity such as immovable rock outcrops or very large trees, but this strategy is risky if there is any chance that the landmarks will move, disappear, or their exact point location is ambiguous.

If using a handheld GNSS to record the locations of plot corners, collect waypoint-averaged corner locations over the course of several days or weeks, every time there is a visit to the plot, to account for systematic bias caused by satellite constellation. Even with a differential GNSS system, multiple measurements should be recorded over a long period of time. I recommend at least 15 measurements per corner. I recommend using the BIOMASS R package which has the check_plot_coord() function, which can use multiple GNSS point estimates of each plot corner with information on the nominal plot dimensions to estimate the true location of plot corners.

Survey layout

Divide the plot into a grid system. Commonly 20x20 m, sometimes 10x10 m if the vegetation is dense.

It is worth being meticulous in the layout of the subplot grid so that the corners of the subplots can be used as the origin points when mapping stems. Measuring a straight line over 10 m (maximum distance from an edge in a 20x20 m subplot) is much easier than measuring from the edge of the plot.

Ideally, record the GNSS location of all subplot corners in the same way as plot corners, with multiple measurements spread over several days or weeks. These subplot locations can also be used to refine the plot location.

Within each subplot, measure stems in a clock-wise fashion starting from the bottom left corner (normally SW) of the subplot.

Organise subplots in strips, moving up the first strip of subplots, then back down the next strip, and so on.

Stem mapping

Record the location of all measured stems within the plot.

Record the stem map coordinates of each plot corner and each subplot corner to allow the stem map to be orientated relative to the plot corners in global geographic space.

Measure stem location with a unit precision of 10 cm. Anything smaller than 10 cm is excessively laborious. Larger than 10 cm risks mixing up stems in the field during re-measurment based on the stem map.

The location of each stem should be recorded relative to the SW corner of the subplot. Using tape measures, first measure along the X axis (West -> East), then measure up to the centre of the stem following the Y axis (South -> North).

If the tree is for example in top-right corner of the subplot, you could also measure relative to the top right corner (NE). To avoid having to calculate the real XY coordinate in the field by subtracting the measurement from the subplot dimensions, I instead record these measurements as negative values, which can then be corrected en masse in Excel after the fieldwork.

When to measure

In seasonally dry biomes, it may be easier to collect diameter measurements during the dry season when the ground layer is normally less thick, but this must be traded off against the ability to identify species if they are deciduous.

Research the site before planning a field campaign. Avoid periods of flooding, fire activity, etc.

Try to time tree inventory measurements to coincide with the collection of other datasets that might be used in comparison with the tree inventory data during analysis.

To reduce errors in diameter measurements caused by variations in stem water content, it is best to measure tropical forests toward the end of the wet season. Re-measurements of seasonal forests should be done at the same time of year as the previous censuses.

What to measure

Types of plant

This depends on the goals of the research, but I advocate for a maximalist approach which measures all arborescent perennial plants, hereafter referred to as trees. This broad definition includes what many think of as orthodox trees: dicot species which form a woody trunk by secondary growth. Additionally, the definition includes many other “tree-like” plants, included either because they produce woody tissue (e.g. Bamboo, lianas) or because they form a tree-like structure with an elongated stem supporting smaller branches and foliage (e.g. Banana plants). Below is a non-exhaustive list of arborescent plants which should be considered for measurement, despite either not being “tree-like” or woody-stemmed dicots:

Palms (e.g. Cocos nucifera) – Arecaceae
Tree-like members of Strelitziaceae (e.g. Ravenala madagascariensis)
Bamboo (e.g. Phyllostachys spp., Dendrocalamus spp., Guadua spp.) – Poaceae
Cycads (e.g. Cycas circinalis) – Cycadaceae, Zamiaceae
Cacti (e.g. Pachycereus pringlei) – Cactaceae
Banana plants (e.g. Musa acuminata) – Musaceae
Papaya plants (e.g. Carica papaya) – Caricaceae
Tree-ferns (e.g. Alsophila spp., Cyathea spp., Dicksonia spp.) - Cyatheales
Lianas (e.g. Bauhinia guianensis, Saba comorensis)

Where species cannot be identified, note the growth-form of the individual if it is not an orthodox tree, e.g. one of the groups in the list above.

Minimum diameter threshold

The minimum diameter threshold defines the smallest stems that will be measured. The minimum diameter threshold should be the same for all plots in the site. Common minimum diameter thresholds are >= 5 cm and >= 10 cm. The minimum diameter threshold selected should ensure that at least 200 stems per hectare are measured. As mentioned above, if not enough stems are included within a 1 ha plot to make a representative estimate of AGBD, you may need to either increase the size of the plot, or decrease the minimum diameter threshold.

Edges

Stems should be measured if more than 50% of the base of the stem is inside the plot.

Where multi-stemmed trees straddle the edge of the plot, measure all stems on the tree, but note which stems are located outside the plot (i.e. more than 50% of the base of the stem is outside the plot).

Tagging

Nail tags into the stem 20 cm above the POM. Some other protocols recommend 30 cm. The important thing is that it’s consistent within the site, and not so close to the POM that it might cause damage to the stem where diameter is measured.

Hammer nails so that a few cm of nail is still visible, far enough that the nail penetrates the wood and is secure, but leaving as much space as possible for the tree to grow without “eating” the tag. Angle nails slightly downwards so the tag falls away from the tree. Otherwise, as the tree grows, the bark may “eat” the tag. I find that 60 mm steel nails (galvanised preferably to prevent rusting) hammered in 20-30 mm work well.

For stems < 5 cm diameter, use a loop of wire to attach the tag rather than a nail, as nails may damage the stem.

Have the diameter measurement person mark the POM with a chalk line, then the tagging person can measure the 20 cm distance above the POM to apply the tag. Some people also recommend painting the POM to aid re-measurement, but be careful that the paint does not cause damage to the stem. Some paints can cause lesions on certain trees, particularly those with thin bark.

Ideally, always place tags on one side of the stem. If a plot is near to a road, face all the tags away from the road. Having all the tags on one side of the tree makes it easy to know where to search for the tag during re-measurement.

Use a continuous number series of tags, do not use nested series’ with auxiliary numbers or letters for secondary stems. For new recruits found during re-measurement, use the next tag number in the series. Numbers and letters can easily be confused in the field, e.g. “6” and “b”, “8” and “B”. In subsequent censuses, choosing new letter and number combinations quickly becomes confusing, and increases the risk that a tag ID is accidentally duplicated.

If numbered tags can’t be bought, you can make them using thin zinc roof sheeting and a set of numbered punches. Cut the sheeting into tag sized pieces with tin snips. Poke a hole with a nail in the corner, then add the numbers using the punches.

On multi-stemmed trees, the tree ID of each stem should be recorded. This is normally the largest living stem on the tree, under the assumption that this stem is least likely to lose its tag and is most likely to survive until the next census.

If the goal is to quantify tree demographic rates and population dynamics, tags should be attached to every measured stem on multi-stemmed trees. In this case it is also useful to map each stem separately, to help identify stems in future censuses if the tags fall off, but this is not required. For estimates of plot-level AGBD change it is acceptable to tag only one stem on the tree, normally the largest living stem.

For multi-stemmed / resprouting trees, record the parent stem of each stem. E.g. if a stem emerges below the POM of a different stem, record the stem ID of that different stem. This may be different from the tree ID of the stem.

In dense stands I recommend visually marking stems once they have been measured in addition to the tag, for example with spray paint or flagging tape (make sure this is removed at the end of the census). This will make it easier for operators to check that all individuals within the plot were actually measured as expected.

Mortality

If stems are rooted in the ground they should be measured, even if they are dead.

If a stem is not rooted in the ground it can be classed as coarse woody debris and measured using a protocol designed for coarse woody debris (e.g. SEOSAW CWD protocol ).

These are the codes I recommend to indicate stem mortality status:

“a” - alive, signs of life above the DBH measurement, e.g. the canopy of the stem is alive.
“t” - topkilled, canopy of the stem is dead, but there are signs of life visible elsewhere on the stem.
“d” - dead, no sign of life anywhere on the stem.

Stem condition and damage

These are the stem condition codes I use. These codes are meant to cover the majority of common stem conditions. The letters have been picked so that they are less likely to be confused when written hastily on paper. Most of these codes have been lifted from the SEOSAW manual, but there are some additions from RAINFOR, DryFlor and ForestGEO. I have also split up some of the codes in SEOSAW. E.g. “wounded or sick” was split into “wounded” and “sick”.

“b” - broken (material above break is detached)
“c” - has climbing or strangling plants in canopy
“e” - buttressed
“f” - fallen
“g” - fluted
“h” - hollow
“j” - bark peeling or lost
“k” - stem has bracket fungi
“l” - leaning (>15deg)
“m” - on a termite mound
“n” - a new recruit
“o” - stem is a resprout from an older stem. Where possible record the stem ID of this older stem.
“p” - snapped (material above break is attached)
“q” - the stem location is unknown and was not found (contrast with “v”)
“r” - resprouting shoots are growing from the stem. Only if the shoots are smaller than the minimum diameter threshold, otherwise measure as a separate stem.
“s” - standing
“t” - stump (broken below POM)
“u” - uprooted
“v” - vanished (location of tree found but stem missing)
“w” - stem is a liana
“x” - rotten wood
“y” - wounded
“z” - sick (i.e. lost most leaves, discoloured foliage, drooping branches)

Similarly, here are the codes I use to refer to cause of damage. Obviously these reflect my experience working in fire-prone savannas with elephants.

“a” - animals (not elephants, not insects)
“e” - elephants
“f” - fire
“h” - humans (e.g. cut, ringbarked, broken or beehive)
“k” - frost. This is difficult to ascertain.
“l” - lightning
“m” - termites
“n” - neighbouring tree
“o” - other (describe in damage_cause_notes)
“q” - unknown. This should be used liberally. Only record damage cause if you are sure.
“w” - wind
“x” - climber weight
“z” - climber competition

Diameter measurement

Diameter measurements on stems >= 5 cm diameter should be done using a diameter tape measure.

For stems < 5 cm diameter use vernier calipers, ideally with two perpendicular measurements. The buckle on diameter tapes means that the diameter of small stems is generally over-estimated.

Measure and tag all stems down to 1 cm below the minimum diameter threshold. E.g. if the minimum diameter threshold is 10 cm, measure all stems down to 9 cm diameter. These measurements can be filtered out later for analysis, and it ensures that small measurement errors do not lead to the false omission of individuals from the dataset.

Stem diameter should be measured at the default POM unless this does not provide a good representation of the diameter of the stem. Where the POM is moved ensure the height of the adjusted POM is recorded. Common reasons to move the POM include:

Deformities - Stems that are deformed at the default POM, for example because of a wound, swelling, bark loss, cankers, cracks, burls, or a branch. Move the POM at least 10 cm below the base of the deformity.
Forked stems - Stems that fork into multiple stems at the default POM. Move the POM 30 cm below the bulge at the base of the fork.
Buttresses and stilt roots - Move the POM 50 cm above the top of the buttress or the highest stilt root.

Where a stem is fluted along its length, measure using the default POM.

The POM should be measured along the length of the stem, not as the vertical height above the ground.

On leaning stems, the POM should be measured along the side of the stem closest to the ground.

On slopes, the POM should be measure on the downhill side of the slope.

Small climbers, epiphytes, roots, loose bark and debris should be lifted away from the POM before measuring the stem diameter. If the POM cannot be made clean, measure the stem diameter using calipers at two or more equally spaced points around the stem.

If a stem is broken and the break is on or below the POM, move the POM 2 cm below the base of the break. If the break is above the POM, measure the stem as normal. Record the location of the break as the height above the ground along the length of the stem.

On multi-stemmed trees, all stems reaching the minimum diameter threshold of the plot at the default POM should be measured.

Height measurement

If possible, measure the height of every stem in the plot.

Measure stem height up to the tallest living part of the stem.

I recommend using laser range finders for stems over three metres tall. For stems less than five metres tall, use a measuring stick.

On multi-stemmed trees, measure the height of individual stems, not of the tree as a whole.

Often it is not possible to measure every stem. In this case, aim to measure the heights of a stratified sample of stems.

Following Sullivan et al. (2018), I recommend sampling the largest stems of at least 50 trees per hectare. Measure the ten largest diameter trees in the plot, then measure a stratified random sample of 40 of the remaining trees across diameter size classes. Exclude trees which are leaning, rotten, broken, fallen, resprouted from an older base, or where significant parts of the canopy are dead. The stratified sample should be of sufficient size that the prediction interval from the model(s) is ≤ 1 m across the range of stem diameters. For this reason, measure stem height after all the diameter measurements have been completed.

For example, in R, with a dataframe (dat) of stems (stem_id) with diameter measurements (d), stem mortality status (status), stem modes (mode) and tree IDs (tree_id) within the plot:

n_per_dclass <- 8
n_dclass <- 5
n_largest <- 10
dat_fil <- dat %>% 
  filter(
    !is.na(d),
    status == "a",
    !grepl(paste(c("b", "f", "l", "p", "t", "u", "o"), collapse = "|"), mode)) %>% 
  group_by(tree_id) %>% 
  slice_max(d, n = 1) %>% 
  ungroup() %>% 
  arrange(desc(d)) %>% 
  {
    largest <- slice_head(., n = n_largest) %>% 
      mutate(sample_group = "largest")

    remainder_strat <- slice_tail(., n = nrow(.) - n_largest) %>%
      mutate(d_class = ntile(d, n_dclass)) %>% 
      group_by(d_class) %>% 
      slice_sample(n = ceiling(n_per_dclass * n_dclass / n_dclass)) %>% 
      ungroup() %>%
      mutate(sample_group = paste0("dclass_", d_class))
    
    bind_rows(largest, remainder_strat)
  } %>%
  dplyr::select(stem_id, sample_group)

Height measurements are generally very error-prone so regardless of the measurement apparatus used, take multiple height measurements. Exclude obvious outliers and keep taking measurements until you are confident in the average height estimate.

Species identification

Unless it is absolutely unambiguous across all plots within a site, I do not recommend using acronyms or shortened versions of species names on field data sheets. I have come across many instances where shortened species names can be confused with another species, leading to widespread errors in the dataset. For example, Pterocarpus angolensis and Pericopsis angolensis could both be shortened to PA, Pang, and so on. It is not enough to assign subtley different acronyms, e.g. “PTANG” for Pterocarpus angolensis and “PEANG” for Pericopsis angolensis, because somebody will inevitably confuse them in the field. Another example I’ve come across is ABPREC, which is meant to be Abrus precatorius, but was translated as Abarema precatorius, despite Abarema spp. not occurring at all within the site.

Ideally collect a herbarium voucher from every morpho-species found in the plots within a site. Note down which individual the specimen came from by the Tree ID.

Before fieldwork begins, ensure all relevant permits are secured (e.g. nationwide collection permit, protected area permit, genetic permit, export permit).

Record botanical sources used to assign taxonomic names, e.g. regional/national flora, trained botanist.

Use a well-trained botanist whenever possible, especially during the initial census. Ask the botanist to put together a field guide for the species present in the plot, especially groups of species that are difficult to differentiate.

Photographs of all characters useful for botanical identification should be taken, and all relevant characters and observations (e.g. presence and colour of exudate; colour of flowers; bark characteristics) should be included in collection labels. Voucher collections should be dried on the day of collection in an air drier.

Stopping work while herbarium specimens are collected slows everything down. You may want to save the botanical identification work until the diameter measurements have been completed. This will also give you a full picture of how many specimens need to be collected.

Quantifying error

Measurement errors occur throughout the data collection process:

Diameter measurement
Height measurement
Stem mapping
Taxonomy
Stem mortality status

These repeat measurements should be conducted separately, after the main survey. It is recommended that the repeated measurements are conducted immediately after the main survey, and no more than six months after the main survey.

A quasi-random sample of stems can be generated by randomly selecting subplots. Measurements from the main survey should not be consulted when repeat measurements are taken. It is recommended that the same data collectors are used for the repeat measurements as for the main survey.

To minimise the influence of measurement errors on AGBD estimates, avoid using data from the first census where possible. Over subsequent censuses it is common that many errors are fixed and the dataset becomes more refined.

Re-measurement

Re-measuring plots is normally done on a 3-5 year time-scale. Long enough that stem diameter growth is larger than the error on diameter measurements.

Conduct the second census (i.e. first re-census) sooner than normal. During the second census many issues in species identity, stem mapping, and diameter measurement can be caught and retro-actively corrected. If the census interval is too long, trees will start to die and so cannot be checked in the second census.

Between censuses it might still be worth doing maintenance on the plot, particularly replacing plot corners if they become obstructed or go missing.

Tagging new recruits with the next number in the sequence of tags means that over the course of a few censuses, the tag order quickly becomes complicated. Create a “measurement order” column for your data to specify the order in which stems should be measured within the plot. Record the position of new recruits in this stem order sequence so that when new datasheets are created the order of stems on the datasheet will resemble the real-world order of stems in the field.

Generating a stem map and printing on a large sheet of A3 paper, or keeping a copy on a tablet computer can be very helpful for re-measurement, especially when re-locating subplot edges. Here is some code I use to generate pretty stem maps in 100x100 m plots:

# Packages
library(dplyr)
library(ggplot2)
library(ggrepel)

# Import data 
s <- read.csv("./stems.csv")

# Clean data 
s_clean <- s %>% 
  filter(
    plot_id == "NOC_7",
    !is.na(subplot_id),
    !is.na(x_grid),
    !is.na(y_grid)) %>% 
  group_by(subplot_id, tree_id) %>%
  summarise(
    species = first(species_name_clean),
    tag_id = paste0(unique(tag_id), collapse = ","),
    x_grid = mean(x_grid, na.rm = TRUE), 
    y_grid = mean(y_grid, na.rm = TRUE),
    diam = max(diam, na.rm = TRUE)) %>% 
  ungroup() %>% 
  mutate(
    diam = ifelse(!is.finite(diam) | is.na(diam), 5, diam),
    subplot_id = factor(subplot_id, levels = sort(unique(subplot_id))),
    tree_tags = case_when(
      grepl(",", tag_id) ~ paste0(sub(",.*", "", tag_id), "-", sub('.*,', '', tag_id)),
      TRUE ~ tag_id))

species_top10 <- sort(table(s_clean$species), decreasing = TRUE)[1:10]

s_clean_labs <- s_clean %>%
  mutate(species_top10 = ifelse(species %in% names(species_top10), species, "Other"))

# Create polygons for plot outlines
po <- data.frame(area = 1.0, x = c(0,0,100,100), y = c(0,100,100,0))

# Define colour scheme for subplots
pal <- c("#1F77B4", "#FF7F0E", "#2CA02C", "#D62728", "#9467BD", 
         "#8C564B", "#E377C2", "#BCBD22", "#17BECF", "#7F7F7F")

# If necessary, replicate colour palette to number of subplots
pal_rep <- rep(pal, length.out = length(unique(s_clean_labs$subplot_id)))

# Create plots
out <- ggplot(s_clean_labs, aes(x = x_grid, y = y_grid)) + 
    geom_polygon(data = po, aes(x = x, y = y), 
      colour = "black", fill = NA) + 
    geom_point(aes(size = diam), shape = 21, fill = "darkgrey", alpha = 0.6) + 
    scale_size(name = "Diameter (cm)", 
      range = c(1, 20), 
      breaks = c(5, 10, 20, 30, 40, 60, 80, 100)) + 
    geom_point(colour = "black", size = 0.25) + 
    geom_label_repel(aes(label = tree_tags, colour = subplot_id),
      label.padding = unit(0.08, "lines"),
      alpha = 0.7,
      max.overlaps = Inf) + 
    coord_fixed() + 
    scale_x_continuous(
      name = NULL, breaks = seq(0,100,10),
      sec.axis = dup_axis(name = NULL, breaks = seq(0,100,10))) +
    scale_y_continuous(
      name = NULL, breaks = seq(0,100,10),
      sec.axis = dup_axis(name = NULL, breaks = seq(0,100,10))) +
    scale_colour_manual(name = NULL, values = pal_rep) + 
    theme_bw() + 
    theme(legend.position = "right") + 
    ggtitle(unique(s_clean_labs$plot_id)) + 
    theme(
      plot.title = element_text(
        hjust = 0.5, vjust = -0.5, face = "bold", size = 20),
      panel.grid = element_line(
        linewidth = 1,
        colour = alpha("black", 0.5)))

# Save plots to file
ggsave(out, width = 15, height = 15, file = "stem_map.png")

R package to access the World Flora Online GraphQL API

2025-11-03T00:00:00+0000

I have been working on integrating the WorldFlora R package into SEOSAW so we can use the World Flora Online taxonomic backbone to match taxonomic names in our tree inventory data. In doing this work I have learned that: a) the WorldFlora R package has some drawbacks, namely that it requires a large download of a static version of the WFO database, which also then needs to be read into memory in R, and b) that the WFO has a GraphQL API to access their database remotely without downloading the entire thing.

I have since developed a prototype R package which uses the API to return information from the WFO database, and contains functions for matching taxonomic names.

The package can be found here: https://github.com/johngodlee/wfoAPI

The top-level function is matchNames(), which takes a vector of taxonomic names and queries the WFO database for each name. Notable features of the function are:

Leverages the fuzzy matching algorithm which is implemented server-side by WFO, and you can tweak parameters to control the behaviour of the algorithm.
When multiple possible names are matched, the user can optionally enter an interactive selection mode to pick a specific name.
When a matched name has a synonym, the function returns the accepted name as well.
Previous API calls are cached locally, to reduce the number of API calls, and to prevent entering interactive mode multiple times for the same name.

callAPI() is the base-level function which constructs the API query and uses the httr2 package to send the query and unpack the returns.

matchName() calls callAPI() and is responsible for handling a single name query. matchName() optionally uses cached data from previous API calls if it exists. If multiple candidate names are matched, the user can optionally enter an interactive selection mode, which is handled by pickName().

matchNames() calls matchName() for each name in the vector of taxonomic names, performs various quality-of-life checks like exiting gracefully if the WFO API is not reachable, and formats the results as a pretty dataframe with one row for each name in the original vector.

These are the arguments available for matchNames():

x - vector of taxonomic names
fallbackToGenus - logical, if TRUE genus-level matches will be returned if no species-level match is available
checkRank - logical, if TRUE consider matches to be ambiguous if it is possible to estimate taxonomic rank from the search string and the rank does not match that in the name record
checkHomonyms - logical, if TRUE consider matches to be ambiguous if there are other names with the same words but different author strings
fuzzyNameParts - integer value of 0 (default) or greater. The maximum Levenshtein distance used for fuzzy matching words in x
interactive - logical, if TRUE (default) user will be prompted to pick names from a list where multiple ambiguous matches are found, otherwise names with multiple ambiguous matches will be skipped
useCache - logical, if TRUE use cached values in options("wfo.api_uri") preferentially, to reduce the number of API calls
useAPI - logical, if TRUE (default) allow API calls
raw - logical, if TRUE raw a nested list is returned, otherwise a dataframe

fallbackToGenus, checkRank, checkHomonyms and fuzzyNameParts are all variables passed directly to the WFO GraphQL API.

Here is a basic example:

x <- c(
  "Burkea africana", 
  "Julbernardia paniculata", 
  "Fabaceae", 
  "Indet indet", 
  "Brachystegia",
  "Philenoptera sp.") 

matchNames(x)

The console output:

1 of 6: Brachystegia
2 of 6: Burkea africana
3 of 6: Fabaceae
4 of 6: Indet indet
No candidates, skipping: Indet indet
5 of 6: Julbernardia paniculata
6 of 6: Philenoptera sp.


--- Pick a name ---
Matching string:        Philenoptera sp.
1   wfo-4000029211      Philenoptera Hochst. ex A.Rich. accepted        Code/Plantae/Pteridobiotina/Angiosperms/Fabales/Fabaceae/Papilionoideae/Philenoptera

[ins] Enter a number to pick a row from the list, a valid WFO ID, 'N' for the next page, 'P' for the previous page, 'S' to skip this name:

The dataframe returned, formatted as a nested list for readability:

Row 1
- taxon_name_subm: Burkea africana
- method: AUTO
- fallbackToGenus: FALSE
- checkRank: FALSE
- checkHomonyms: FALSE
- fuzzyNameParts: 0
- taxon_wfo_syn: wfo-0000214110
- taxon_name_syn: Burkea africana
- taxon_auth_syn: Hook.
- taxon_stat_syn: valid
- taxon_role_syn: accepted
- taxon_rank_syn: species
- taxon_path_syn: Code/Plantae/Pteridobiotina/Angiosperms/Fabales/Fabaceae/Caesalpinioideae/Burkea/africana
- taxon_wfo_acc: wfo-0000214110
- taxon_name_acc: Burkea africana
- taxon_auth_acc: Hook.
- taxon_stat_acc: valid
- taxon_role_acc: accepted
- taxon_rank_acc: species
- taxon_path_acc: Code/Plantae/Pteridobiotina/Angiosperms/Fabales/Fabaceae/Caesalpinioideae/Burkea/africana
Row 2
- taxon_name_subm: Julbernardia paniculata
- method: AUTO
- fallbackToGenus: FALSE
- checkRank: FALSE
- checkHomonyms: FALSE
- fuzzyNameParts: 0
- taxon_wfo_syn: wfo-0000169220
- taxon_name_syn: Julbernardia paniculata
- taxon_auth_syn: (Benth.) Troupin
- taxon_stat_syn: valid
- taxon_role_syn: accepted
- taxon_rank_syn: species
- taxon_path_syn: Code/Plantae/Pteridobiotina/Angiosperms/Fabales/Fabaceae/Detarioideae/Julbernardia/paniculata
- taxon_wfo_acc: wfo-0000169220
- taxon_name_acc: Julbernardia paniculata
- taxon_auth_acc: (Benth.) Troupin
- taxon_stat_acc: valid
- taxon_role_acc: accepted
- taxon_rank_acc: species
- taxon_path_acc: Code/Plantae/Pteridobiotina/Angiosperms/Fabales/Fabaceae/Detarioideae/Julbernardia/paniculata
Row 3
- taxon_name_subm: Fabaceae
- method: AUTO
- fallbackToGenus: FALSE
- checkRank: FALSE
- checkHomonyms: FALSE
- fuzzyNameParts: 0
- taxon_wfo_syn: wfo-7000000323
- taxon_name_syn: Fabaceae
- taxon_auth_syn: Lindl.
- taxon_stat_syn: conserved
- taxon_role_syn: accepted
- taxon_rank_syn: family
- taxon_path_syn: Code/Plantae/Pteridobiotina/Angiosperms/Fabales/Fabaceae
- taxon_wfo_acc: wfo-7000000323
- taxon_name_acc: Fabaceae
- taxon_auth_acc: Lindl.
- taxon_stat_acc: conserved
- taxon_role_acc: accepted
- taxon_rank_acc: family
- taxon_path_acc: Code/Plantae/Pteridobiotina/Angiosperms/Fabales/Fabaceae

What determines which side of the bed I sleep on?

2025-10-26T00:00:00+0000

I counted up and I have lived for more than 6 months in 15 different bedrooms, each with a double bed, and mostly shared with my partner.

I wanted to know what factors determine whether I sleep on the left or the right side of the bed. The left side as I’m defining it is as if you are looking from the head end of the bed down to the foot end.

For each bed I recorded the position of the bedroom door, the position of the window (I’ve never lived in a place where there was more than one window in the bedroom), and whether the left or right side of the bed was touching a wall. In all the places I’ve lived the head end of the bed is pushed up against a wall.

 Left Right 
    8     7

It’s very nearly an even split, whether I sleep on the left or the right side of the bed.

             bed side
door position Left Right
        Left     4     4
        Right    4     3

Position of the bedroom door doesn’t seem to have much of an effect on what side of the bed I sleep on. The raw data underlying this plot is slightly more complicated. Where the door was on the wall opposite the foot of the bed, I recorded whether the door was more to the left or the right of the centre of the bed, and similarly when the door was on the same wall as the head of the bed.

               bed side
window position Left Right
          Left     5     3
          Right    3     4

Window position looks like a more important factor. When the window is on the left side I tend to sleep on the left side, and vice versa. As with door position, I made a judgement call when the window was on the wall opposite the foot or head of the bed.

                 bed side
bed touching wall Left Right
            Left     1     1
            None     6     4
            Right    1     2

Most of the time the side of the bed isn’t touching a wall, and in these cases I tend to sleep on the left side of the bed.

Here is the code I wrote to produce the plots:

# Analyse side of the bed I sleep on
# John L. Godlee (johngodlee@gmail.com)
# Last updated: 2025-10-26

# Packages
library(ggplot2)

# Import data
dat <- read.csv("./bed_position.csv")

# Filter to double beds only (not single)
dat_fil <- dat[dat$bed_type == "double",]

# Recode side of bed
dat_fil$bed_side <- factor(dat_fil$bed_side, 
  levels = c("left", "right"), 
  labels = c("Left", "Right"))

# Recode side of door and window relative to bed
side_lev <- c("left", "right", "foot-left", "foot-right", "head-left", "head-right")
side_lab = c("Left", "Right", "Foot-Left", "Foot-Right", "Head-Left", "Head-Right")

dat_fil$door_side <- factor(dat_fil$door_side,
  levels = side_lev, labels = side_lab)

dat_fil$window_side <- factor(dat_fil$window_side,
  levels = side_lev, labels = side_lab)

dat_fil$door_simpl <- gsub(".*-", "", dat_fil$door_side)
dat_fil$window_simpl <- gsub(".*-", "", dat_fil$window_side)

# Recode side of bed touching wall
bed_wall_touch_list <- strsplit(dat_fil$bed_wall_touch, ";")
dat_fil$bed_wall_touch <- unlist(lapply(bed_wall_touch_list, function(x) {
  paste(paste0(toupper(substring(x, 1, 1)), substring(x, 2)), collapse = ";")
}))
dat_fil$bed_wall_touch_simpl <- gsub("Head;?", "", dat_fil$bed_wall_touch)
dat_fil$bed_wall_touch_simpl[dat_fil$bed_wall_touch_simpl == ""] <- "None" 
dat_fil$bed_wall_touch_simpl <- factor(dat_fil$bed_wall_touch_simpl,
  levels = c("Left", "None", "Right"))

# Create a colour palette for left- and right-side of bed
bed_side_pal <- c(
  "Left" = "#5AB4AC",
  "Right" = "#D8B365")

# Tally of side of bed
bed_side_table <- table(dat_fil$bed_side)
sink("./out/bed_side_table.txt")
print(bed_side_table)
sink()

bed_side_bar <- ggplot(dat_fil, 
  aes(x = bed_side, fill = bed_side)) +
  geom_bar(colour = "black") +
  scale_fill_manual(name = "Bed side", values = bed_side_pal) + 
  labs(
    x = "Bed side", 
    y = "Count") + 
  theme_classic()
ggsave(bed_side_bar, width = 6, height = 3.5, 
  file = "./img/bed_side_bar.png")

# Compare side of bed and door side relative to bed
door_simpl_table <- table(
  "door position" = dat_fil$door_simpl, 
  "bed side" = dat_fil$bed_side)
sink("./out/door_simpl_table.txt")
print(door_simpl_table)
sink()

door_simpl_bar <- ggplot(dat_fil, 
  aes(x = door_simpl, fill = bed_side)) +
  geom_bar(position = "dodge", colour = "black") +
  scale_fill_manual(name = "Bed side", values = bed_side_pal) + 
  labs(
    x = "Door side (relative to bed)", 
    y = "Count") + 
  theme_classic()
ggsave(door_simpl_bar, width = 6, height = 3.5, 
  file = "./img/door_simpl_bar.png")

# Compare side of bed and window side relative to bed
window_simpl_table <- table(
  "window position" = dat_fil$window_simpl, 
  "bed side" = dat_fil$bed_side)
sink("./out/window_simpl_table.txt")
print(window_simpl_table)
sink()

window_simpl_bar <- ggplot(dat_fil, 
  aes(x = window_simpl, fill = bed_side)) +
  geom_bar(position = "dodge", colour = "black") +
  scale_fill_manual(name = "Bed side", values = bed_side_pal) + 
  labs(
    x = "Window side (relative to bed)", 
    y = "Count") + 
  theme_classic()
ggsave(window_simpl_bar, width = 6, height = 3.5, 
  file = "./img/window_simpl_bar.png")

# Compare side of bed and side of bed touching a wall
bed_wall_table <- table(
  "bed touching wall" = dat_fil$bed_wall_touch_simpl, 
  "bed side" = dat_fil$bed_side)
sink("./out/bed_wall_table.txt")
print(bed_wall_table)
sink()

bed_wall_bar <- ggplot(dat_fil, 
  aes(x = bed_wall_touch_simpl, fill = bed_side)) +
  geom_bar(position = "dodge", colour = "black") +
  scale_fill_manual(name = "Bed side", values = bed_side_pal) + 
  labs( 
    x = "Wall touched by bed", 
    y = "Count") +
  theme_classic()
ggsave(bed_wall_bar, width = 6, height = 3.5, 
  file = "./img/bed_wall_bar.png")

Bike tag

2025-10-19T00:00:00+0000

I have discovered a game called Bike Tag. Players photograph their bike at a mystery location and post it online. Others aim to find the spot, take a photo of their own bike as proof, then post a photo of their bike at a new mystery location to keep the game going.

I have seen this game played on regional biking subreddits, e.g. /r/BikeDC . I also found biketag.org , which aims to collect different Bike Tag games around the world and provide a common interface, but the project is still being slowly developed and has some issues. From the map on biketag.org, most of the existing games are in the USA, but this might be biased by the nature of the platform. I searched around on Google and Gemini , but couldn’t find any other general resources.

I’d be interested to play this in Edinburgh when I move back, so I set about trying to find any existing games. Edinburgh doesn’t have a dedicated cycling subreddit, and there was nothing on the main Edinburgh subreddit ; there’s not much other cycling content on there. There is a Scotland Bike Tag game on biketag.org , but it doesn’t look like anybody is playing it. I looked around on the City Cycling Edinburgh Forum but couldn’t find any evidence of an existing Bike Tag game, which surprised me, I would have thought that the tight knit community over there would be into Bike Tag. I did find a thread on the London Fixed Gear and Single Speed (LFGSS) forum however, where the most recent post was only a week ago, and it’s been running for over five years! So maybe I’ll play on there.

Filling gaps in plot coverage across a landscape based on forest structure

2025-09-06T00:00:00+0000

In the GEO-TREES project we are developing sites across tropical forests to calibrate and validate biomass maps, using a combination of airborne LiDAR (ALS), terrestrial LiDAR (TLS), and tree inventory data from permanent sample plots. We use the airborne LiDAR to scale up biomass estimates from the permanent plots across the landscape, by fitting a site-specific model which predicts biomass from forest structure (canopy height, canopy density, etc). To fit a model with good predictive power we need to have plots which cover the diversity of forest structural types found across the site. Most of the GEO-TREES sites already have some plots, but it’s important to assess whether those plots are representative of the structural diversity found across the plots.

I’ve written some code which (1) does an assessment of the structural diversity of the site from ALS data, (2) determines the extent to which existing plots within the site represent the structural diversity of the site, and (3) recommends locations for new plots which fill gaps in the coverage of the structural diversity of the site.

First, load packages:

# How representative of forest structure are plots in a site?
# John L. Godlee (johngodlee@gmail.com)
# Last updated: 2025-09-04

# Purpose:
# To what extent are existing plots representative of the broader landscape forest structure? 
# Identify optimal locations for new plots to fill gaps in multidimensional forest structure space.

# Load required libraries
library(dplyr)
library(tidyr)
library(ggplot2)
library(patchwork)
library(terra)
library(sf)
library(plotly)  # Interactive 3D plots
library(FNN)  # Nearest neighbor analysis
library(scico)  # Color palettes
library(lhs)  # Latin-hypercube sampling

Then I define extract_plot_metrics() to extract structural metrics from the ALS for each of the existing plots:

# Extract values from raster across polygons
#
# @param r raster
# @param p_sf sf object containing plot polygons 
# @param plot_id column name of plot IDs in `p_sf` 
#
# @return dataframe containing extracted metrics for each polygon
# 
extract_plot_metrics <- function(r, p_sf, plot_id = "plot_id", fun = mean, ...) {

  # Extract metrics for each plot polygon
  out <- terra::extract(r, vect(p_sf), fun = fun, 
    na.rm = TRUE, ID = FALSE, ...)
  
  # Add plot IDs
  out <- cbind(p_sf[[plot_id]], out)
  names(out)[1] <- plot_id

  # Add XY coordinates of centroids
  coords <- as.data.frame(st_coordinates(st_centroid(p_sf)))
  names(coords) <- c("x", "y")
  out <- cbind(out, coords)

  # Return
  return(out)
}

Then I define analyse_repres() which runs a principal component analysis of the structural metrics across the site and places the existing plots in PCA-space.

# Run a PCA on the landscape structural metrics, and place plots in that space
# Get nearest neighbour distance from each landscape pixel to plots
# Return dataframe with metrics of plot coverage
# 
# @param r raster 
# @param p dataframe containing structural metrics for each plot, as returned
#     by `extract_plot_metrics()`
# @param n_pca number of PCA axes used in analysis
#
# @return list containing: `r_df`: pixel values, `p_df`: plot values, `r_pca`:
#     PCA object from pixel values, `p_pca` plot values in PCA space,
#     `nn_dist_mean`, `nn_dist_max`, `nn_dist_q95`: mean, max and 95th
#     percentile structural distance of pixels to nearest plot across the
#     landscape, `coverage_score`: `1 - (mean(nn) / max(nn)`
# 
analyse_repres <- function(r, p, n_pca = 3) {
  # Convert raster to data frame for landscape
  r_df <- as.data.frame(r, xy = TRUE, na.rm = TRUE)
  
  # Select only metric columns 
  metric_cols <- names(r_df)[!names(r_df) %in% c("x", "y")]
  
  # Standardize metrics
  r_sc <- scale(r_df[,metric_cols])
  p_sc <- scale(p[,metric_cols])
  
  # PCA to reduce dimensionality
  r_pca <- prcomp(r_sc, scale = FALSE)
  
  # Project plots into PCA space
  p_pca <- predict(r_pca, p_sc)
  
  # Calculate nearest neighbor distances
  # For each landscape pixel, find distance to nearest plot
  nn <- get.knnx(p_pca[, 1:n_pca], r_pca$x[, 1:n_pca], k = 1)$nn.dist[,1]
  
  # Add distances back to landscape dataframe
  r_df$nn_dist <- nn
  r_df <- cbind(r_df, r_pca$x[,1:n_pca])

  # Add PCA values 
  p_df <- p
  p_df <- cbind(p_df, p_pca[,1:n_pca])
  
  # Create representativeness metrics
  out <- list(
    r_df = r_df,
    p_df = p_df,
    r_pca = r_pca,
    p_pca = p_pca,
    nn_dist_mean = mean(nn),
    nn_dist_max = max(nn),
    nn_dist_q95 = quantile(nn, 0.95),
    coverage_score = 1 - (mean(nn) / max(nn))
  )
  
  # Return
  return(out)
}

Then I define identify_optimal_plots() to identify potential locations for new plots which most optimally fill gaps in PCA-space. This function allows different gap-filling algorithms:

maximin_select() - iteratively proposes new plots in pixels with structural attributes furthest away from the existing (and previously proposed) plots.
minimax_select() - minimizes the maximum distance of any pixel to its nearest plot in PCA space.
lhs_select() - latin-hypercube sampling. Optimises for uniform coverage across PCA space.

# Define function for latin-hypercube sampling 
lhs_select <- function(r_df, n_plots, n_pca, min_dist) {
  # Scale PCs to [0,1] for uniform LHS sampling
  pcs <- r_df[, paste0("PC", 1:n_pca)]
  pcs_scaled <- scale(pcs,
    center = apply(pcs, 2, min),
    scale  = apply(pcs, 2, max) - apply(pcs, 2, min))
  
  # Generate LHS design
  lhs_design <- randomLHS(n_plots, n_pca)
  
  # Prepare candidates
  cand <- r_df
  cand$id <- seq_len(nrow(cand))
  plots_sel <- data.frame()
  
  for (i in seq_len(n_plots)) {
    # LHS target point
    target <- lhs_design[i, ]
    
    # Compute distance from all candidates to LHS target
    dists <- rowSums((pcs_scaled - matrix(target, nrow(cand), 
      n_pca, byrow=TRUE))^2)
    
    # Filter by spatial distance to already-selected plots
    if (nrow(plots_sel) > 0) {
      dists_spat <- get.knnx(
        plots_sel[, c("x","y")],
        cand[, c("x","y")],
        k = 1
      )$nn.dist[,1]
      valid_cand <- which(dists_spat > min_dist)
    } else {
      valid_cand <- seq_len(nrow(cand))
    }
    
    if (length(valid_cand) > 0) {
      # Select candidate closest to the LHS target
      best_idx <- valid_cand[which.min(dists[valid_cand])]
      new_plot <- cand[best_idx, ]
    } else {
      warning(paste("Could not find valid location for plot", i))
      next
    }
    
    # Append proposed plot
    plots_sel <- rbind(plots_sel, new_plot)
    
    # Remove selected location from candidates
    cand <- cand[cand$id != new_plot$id, ]
    pcs_scaled <- pcs_scaled[-new_plot$id, , drop = FALSE]
  }
  
  # Return
  return(plots_sel)
}

# Define function for maximin sampling 
maximin_select <- function(r_df, n_plots, n_pca, min_dist) {
  # Maximin: maximize the minimum distance to existing plots
  cand <- r_df[order(r_df$nn_dist, decreasing = TRUE),]
  cand$id <- seq_len(nrow(cand))
  
  # Iteratively add plots 
  plots_sel <- data.frame()
  for (i in seq_len(n_plots)) {
    if (nrow(plots_sel) == 0) {
      # First plot: choose furthest from existing plots
      new_plot <- cand[1,]
    } else {
      # Re-calculate minimum distance between new plots and pixels 
      dist_sel <- get.knnx(
        plots_sel[,paste0("PC", 1:n_pca)], 
        cand[,paste0("PC", 1:n_pca)], 
        k = 1)$nn.dist[,1]
      
      # Combine with distance to existing plots
      comb_score <- pmin(cand$nn_dist, dist_sel)
      
      # Calculate minimum spatial distance between new plots and pixels 
      dists_spat <- get.knnx(
        plots_sel[, c("x", "y")],
        cand[, c("x", "y")],
        k = 1)$nn.dist[,1]
      
      # Filter to plots a minimum spatial distance away from other proposed plots
      valid_cand <- which(dists_spat > min_dist)
      
      # Select candidate with maximum combined score
      if (length(valid_cand) > 0) {
        best_idx <- valid_cand[which.max(comb_score[valid_cand])]
        new_plot <- cand[best_idx, ]
      } else {
        warning(paste("Could not find valid location for plot", i))
        next
      }
    }
    
    # Append proposed plot
    plots_sel <- rbind(plots_sel, new_plot)

    # Remove selected location from cand
    cand <- cand[cand$id != new_plot$id,]
  }

  # Return
  return(plots_sel)
}

# Define function for minimax sampling 
minimax_select <- function(r_df, n_plots, n_pca, min_dist) {
  # Minimax: minimize the maximum distance from any pixel to the nearest plot
  cand <- r_df[order(r_df$nn_dist, decreasing = TRUE),]
  cand$id <- seq_len(nrow(cand))
  
  # Iteratively add plots
  plots_sel <- data.frame()
  for (i in seq_len(n_plots)) {
    if (nrow(plots_sel) == 0) {
      # First plot: choose furthest from existing plots
      new_plot <- cand[1, ]
    } else {
      # Re-calculate minimum distance between new plots and pixels 
      dist_sel <- get.knnx(
        plots_sel[, paste0("PC", 1:n_pca)], 
        cand[, paste0("PC", 1:n_pca)], 
        k = 1)$nn.dist[, 1]
      
      # Effective nearest distance for each candidate
      comb_score <- pmin(cand$nn_dist, dist_sel)
      
      # Calculate max distance if each candidate were added
      # Lower is better (minimax criterion)
      max_dists <- sapply(seq_len(nrow(cand)), function(j) {
        test_sel <- rbind(plots_sel, cand[j,])
        test_dists <- get.knnx(
          test_sel[, paste0("PC", 1:n_pca)],
          cand[, paste0("PC", 1:n_pca)],
          k = 1)$nn.dist[,1]
        max(test_dists)
      })
      
      # Enforce spatial separation
      dists_spat <- get.knnx(
        plots_sel[,c("x", "y")],
        cand[, c("x", "y")],
        k = 1)$nn.dist[, 1]
      valid_cand <- which(dists_spat > min_dist)
      
      # Select candidate that minimizes the maximum distance
      if (length(valid_cand) > 0) {
        best_idx <- valid_cand[which.min(max_dists[valid_cand])]
        new_plot <- cand[best_idx, ]
      } else {
        warning(paste("Could not find valid location for plot", i))
        next
      }
    }
    
    # Append proposed plot
    plots_sel <- rbind(plots_sel, new_plot)
    
    # Remove selected location from cand
    cand <- cand[cand$id != new_plot$id,]
  }
  
  # Return
  return(plots_sel)
}

# Iteratively add locations which most efficiently fill the structural space
#
# @param repr object returned by `analyse_repres()`
# @param n_plots maximum number of new plots to add
# @param n_pca number of PCA axes used in analysis
# @param min_dist minimum spatial distance between new plots
# @param method either "maximin", "minimax" or "lhs" to choose a gap-filling
#     algorithm
# @param elbow logical, if TRUE then plots are iteratively added up to
#     `n_plots` to determine the reduction in mean structural distance across
#     the landscape
#
# @details
# `method`: "maximin" iteratively proposes new plots in pixels with structural
#     attributes furthest away from the existing (and previously proposed)
#     plots. "minimax" aims to minimize the maximum distance of any pixel to
#     its nearest plot in PCA space. "lhs" (latin-hypercube sampling) doesn’t
#     focus on distances between points directly, instead it optimises for
#     uniform coverage across PCA space.
#
# @return dataframe containing locations and structural metrics for proposed
#     new plots, ordered by largest reduction in mean structural distance of
#     pixels to nearest plots
# 
identify_optimal_plots <- function(repr, n_plots = 10, n_pca = 3, min_dist = 0, method = "maximin", elbow = FALSE) {
  
  # Extract dataframes
  r_df <- repr$r_df
  p_df <- repr$p_df
  

  if (method == "maximin") {
    plots_sel <- maximin_select(r_df, n_plots, n_pca, min_dist)
  } else if (method == "minimax") { 
    plots_sel <- minimax_select(r_df, n_plots, n_pca, min_dist)
  } else if (method == "lhs") { 
    plots_sel <- lhs_select(r_df, n_plots, n_pca, min_dist)
  } else {
    stop("'method' must be one of 'maximin', 'minimax' or 'lhs'")
  }

  # Remove ID value
  plots_sel <- plots_sel[,!names(plots_sel) == "id"]

  # Optionally create elbow plot to find optimal number of new plots
  if (elbow) {
    elbow_dist <- c()
    # Iteratively add new plots to plot data
    for (i in 0:n_plots) {
      pca_comb <- rbind(
        p_df[,paste0("PC", 1:n_pca)], 
        plots_sel[1:i,paste0("PC", 1:n_pca)])

      # Calculate mean distance between pixels and plots (old and new) 
      nn <- get.knnx(pca_comb, r_df[,paste0("PC", 1:n_pca)], k = 1)$nn.dist[,1]
      elbow_dist[i+1] <- mean(nn) 
    }

    # Create pretty dataframe
    elbow_df <- data.frame(
      new_plots = 0:n_plots,
      nn_dist_mean = elbow_dist)

    # Create bar plot
    p <- ggplot(data = elbow_df, aes(x = new_plots, y = nn_dist_mean)) + 
      geom_col() + 
      theme_bw() + 
      scale_x_continuous(breaks = seq(0, n_plots)) + 
      labs(
        x = "Number of additional plots",
        y = "Mean relative distance in structural space to nearest plot") + 
      coord_cartesian(ylim = c(
        min(elbow_df$nn_dist_mean), 
        max(elbow_df$nn_dist_mean)))

    return(list(p, elbow_df))
  }

  # Return
  return(plots_sel)
}

And finally I define plot_repres() to visualise the results of the analysis:

# Visualise outputs of representivity analysis
#
# @param repr object returned by `analyse_repres()`
# @param plots_sel optional, object returned by `identify_optimal_plots()`
#
# @return plots to visualise plots in structural space. `map` shows the
#     location of plots and the structural distance of each pixel in the
#     landscape to its nearest plot, if `plots_sel` is provided this includes
#     the proposed new plots. `pca2d` scatter plot of the first two PCA axes
#     of structural metrics. `pca3d` an interactive (plotly) 3D scatter plot of
#     the first three PCA axes of structural metrics. `hist` (only returned if
#     `plots_sel` is provided) histograms showing the distance in structural
#     PCA space from each pixel to its nearest plot, comparing the distribution
#     when using only existing plots to the distribution when including the
#     proposed new plots.
# 
plot_repres <- function(repr, plots_sel = NULL) {

  # Extract dataframes
  r_df <- repr$r_df
  p_df <- repr$p_df
  
  # Map of representativeness (multi-dimensional distance to nearest plot)
  p_old <- p_df[,c("x", "y")] 
  p_old$type <- "Existing plot"
  if (!is.null(plots_sel)) { 
    p_new <- plots_sel[,c("x", "y")] 
    p_new$type <- "Proposed plot"
    p_all <- rbind(p_old, p_new)
  } else {
    p_all <- p_old
  }

  # Define legend items 
  size_map <- c("Existing plot" = 3, "Proposed plot" = 3, "Landscape value" = 1)
  opacity_map <- c("Existing plot" = 1, "Proposed plot" = 1, "Landscape value" = 0.4)
  colour_map <- c("Existing plot" = "red", "Proposed plot" = "blue", "Landscape value" = "grey")
  shape_map <- c("Existing plot" = "circle", "Proposed plot" = "circle", "Landscape value" = "circle")

  p1 <- ggplot() +
    geom_raster(data = r_df, aes(x = x, y = y, fill = nn_dist)) +
    scale_fill_scico(name = "Distance to nearest plot", palette = "bamako") +
    geom_point(data = p_all, 
      aes(x = x, y = y, shape = type, colour = type)) + 
    scale_colour_manual(name = NULL, 
      values = colour_map) + 
    scale_shape_manual(name = NULL, 
      values = shape_map) + 
    coord_equal() +
    theme_bw() +
    ggtitle("Landscape representativeness") +
    labs(
      x = NULL, 
      y = NULL) + 
    theme(
      plot.title = element_text(hjust = 0.5),
      legend.position = "bottom",
      legend.title = element_text(size = 12),
      legend.text = element_text(size = 12))
  
  # Extract variance explained by each PCA axis
  pca_var <- summary(repr$r_pca)$importance[2, 1:3] * 100

  pca_pt_r <- as.data.frame(repr$r_pca$x[,1:3])
  pca_pt_r$type <- "Landscape value" 
  pca_pt_p <- as.data.frame(repr$p_pca[,1:3])
  pca_pt_p$type <- "Existing plot" 
  if (!is.null(plots_sel)) {
    pca_pt_n <- plots_sel[,paste0("PC", 1:3)]
    pca_pt_n$type <- "Proposed plot" 
    pca_pt_all <- rbind(pca_pt_r, pca_pt_p, pca_pt_n)
  } else {
    pca_pt_all <- rbind(pca_pt_r, pca_pt_p) 
  }
  pca_pt_all$type <- factor(pca_pt_all$type, 
    levels = c("Landscape value", "Existing plot", "Proposed plot"))
  
  p2 <- ggplot() +
    geom_point(data = pca_pt_all, 
      aes(x = PC1, y = PC2, 
        size = type, shape = type, colour = type, alpha = type)) + 
    scale_size_manual(name = NULL, values = size_map) + 
    scale_colour_manual(name = NULL, values = colour_map) + 
    scale_shape_manual(name = NULL, values = shape_map) + 
    scale_alpha_manual(name = NULL, values = opacity_map) + 
    xlab(paste0("PC1 (", round(pca_var[1], 1), "%)")) +
    ylab(paste0("PC2 (", round(pca_var[2], 1), "%)")) +
    theme_bw() +
    ggtitle("Structural space coverage") +
    theme(plot.title = element_text(hjust = 0.5))
  
  # 3D PCA plot
  p3 <- plot_ly(type = "scatter3d", mode = "markers") %>% 
    layout(
      title = "Structural space coverage",
      scene = list(
        xaxis = list(title = paste0("PC1 (", round(pca_var[1], 1), "%)")),
        yaxis = list(title = paste0("PC2 (", round(pca_var[2], 1), "%)")),
        zaxis = list(title = paste0("PC3 (", round(pca_var[3], 1), "%)"))
      )
    )

  for (t in unique(pca_pt_all$type)) {
    subset_pca_pt_all <- pca_pt_all[pca_pt_all$type == t,]
  
    p3 <- add_trace(
      p3,
      data = subset_pca_pt_all,
      x = ~PC1, y = ~PC2, z = ~PC3,
      name = t,
      marker = list(
        size = size_map[t],
        opacity = opacity_map[t],
        color = colour_map[t],
        symbol = shape_map[t],
        line = list(width = 1, color = "black")
      )
    )
  }
  
  # Coverage improvement analysis
  if (!is.null(plots_sel)) {
    # Recalculate distances with new plots
    all_plots_pca <- rbind(
      repr$p_pca[,paste0("PC", 1:3)],
      as.matrix(plots_sel[,paste0("PC", 1:3)])
    )
    
    nn_new <- get.knnx(all_plots_pca, repr$r_pca$x[,paste0("PC", 1:3)], k = 1)
    
    # Create dataframe
    improvement_df <- data.frame(
        orig = repr$r_df$nn_dist,
        with_new = nn_new$nn.dist[, 1]) %>%
      pivot_longer(
        everything(), 
        names_to = "scenario", 
        values_to = "distance") %>% 
      mutate(scenario = factor(scenario, 
        levels = c("orig", "with_new"),
        labels = c("Existing plots", "Existing and proposed plots")))
    
    p4 <- ggplot(improvement_df, aes(x = distance, fill = scenario)) +
      geom_histogram(alpha = 0.7, position = "identity", bins = 50) +
      scale_fill_manual(name = NULL, 
        values = c("Existing plots" = "red", "Existing and proposed plots" = "blue")) +
      theme_bw() +
      ggtitle("Landscape coverage by plots") +
      labs(
        x = "Relative distance in structural space to nearest plot",
        y = "Number of pixels") + 
      theme(
        plot.title = element_text(hjust = 0.5),
        legend.position = "bottom")

    return(list(map = p1, pca2d = p2, pca3d = p3, hist = p4))
  }
  
  return(list(map = p1, pca2d = p2, pca3d = p3))
}

Here is a worked example with the latin-hypercube sampling:

# Import ALS metrics
als <- rast("./als.tiff")

# Import 50x50 m plot polygons
subplots <- st_read("./plots.gpkg")

# Filter subplots to ALS data
als_poly <- st_as_sf(as.polygons(als, na.rm = TRUE))
subplots_als <- st_join(subplots, als_poly, join = st_intersects) %>% 
  filter(!is.na(pulse_density)) 

# Only include bottomleft subplots
subplots_fil <- subplots_als %>% 
  filter(grepl("bottomleft", subplot_id))

# Select relevant metrics from ALS data
# names(als)
als_sel <- als[[c(
  "zmax.canopy.vox",
  "zmean.canopy.vox",
  "zcv.canopy.vox",
  "zskew.canopy.vox",
  "zkurt.canopy.vox",
  "zq10.canopy.vox",
  "zq30.canopy.vox",
  "zq50.canopy.vox",
  "zq70.canopy.vox",
  "zq90.canopy.vox",
  "lad_cv.aboveground.vox",
  "lad_sum.aboveground.vox")]]

# Extract metrics from raster
p_ext <- extract_plot_metrics(als_sel, subplots_fil, 
  plot_id = "subplot_id", fun = mean)

# Analyse representivity of plots
repr <- analyse_repres(als_sel, p_ext, n_pca = 3)

# Explore the optimal number of new plots
identify_optimal_plots(repr, n_plots = 50, method = "maximin", elbow = TRUE)

# Find optimal plots
optimal_plots_maximin <- identify_optimal_plots(repr, n_plots = 12, 
  method = "maximin")

# Visualize
plots_vis <- plot_repres(repr, optimal_plots_maximin)

plots_vis$map 

plots_vis$pca2d

plots_vis$hist

Toggle nvim-cmp keybinding

2025-07-27T00:00:00+0000

I use nvim-cmp in neovim for auto-completion. It’s great for programming, but if I’m writing prose I only rarely want completion, for example if there’s a difficult to spell species name that I want to repeat. I added to my nvim-cmp lua config a function and keybinding which toggles completion in any buffer.

These are the relevant bits of the config. Full config at the end:

This function goes in the config = function() part of the config, and defines the function to toggle completion in the local buffer, with a notification showing the status of the toggle. Below this is a keybinding (<C-k>) which runs the function in normal and visual modes.

-- Define custom function to toggle cmp
local function toggle_cmp_buffer() 
    local buf_enabled = cmp.get_config().enabled 
    cmp.setup.buffer({ enabled = not buf_enabled })
    vim.notify("nvim-cmp " .. (not buf_enabled and "enabled" or "disabled") .. " in buffer", vim.log.levels.INFO)
end
vim.keymap.set({ "n", "v" }, "<C-k>", toggle_cmp_buffer, { 
    noremap = true, silent = true 
})

This next part goes in the cmp.setup({ ... mapping = { section alongside other cmp keybindings. It simply runs the function using the same keybinding as above, but in insert and select modes, since nvim-cmp is only active in these modes.

-- Toggle cmp in insert and select modes
["<C-k>"] = cmp.mapping(function() 
    toggle_cmp_buffer() 
end, { "i", "s" }),

Full nvim-cmp config:

-- Completion
return {
	{
		"hrsh7th/nvim-cmp",
		event = { "InsertEnter", "CmdlineEnter" },
		dependencies = {
			"hrsh7th/cmp-buffer",
			"hrsh7th/cmp-path",
			"hrsh7th/cmp-cmdline",
			{
				"L3MON4D3/LuaSnip",
				version = "v2.*",
			},
			"saadparwaiz1/cmp_luasnip",
			"onsails/lspkind.nvim",
			"R-nvim/cmp-r",
		},
		config = function()
			local cmp = require("cmp")
			local luasnip = require("luasnip")
			local lspkind = require("lspkind")
			-- Load SnipMate style snippets
			require("luasnip.loaders.from_snipmate").lazy_load()
			
			-- Define custom function to only expand if preceded
			local has_words_before = function()
				unpack = unpack or table.unpack
				local line, col = unpack(vim.api.nvim_win_get_cursor(0))
				return col ~= 0 and vim.api.nvim_buf_get_lines(0, line - 1, line, true)[1]:sub(col, col):match("%s") == nil
			end

			-- Define custom function to toggle cmp
			local function toggle_cmp_buffer() 
				local buf_enabled = cmp.get_config().enabled 
				cmp.setup.buffer({ enabled = not buf_enabled })
				vim.notify("nvim-cmp " .. (not buf_enabled and "enabled" or "disabled") .. " in buffer", vim.log.levels.INFO)
			end
			vim.keymap.set({ "n", "v" }, "<C-k>", toggle_cmp_buffer, { 
				noremap = true, silent = true 
			})
			
			cmp.setup({ 
				completion = {
					completeopt = "menu,menuone,preview,noselect",
				},

				snippet = {
					expand = function(args)
						luasnip.lsp_expand(args.body)
					end,
				},
				
				mapping = {
					-- Toggle cmp in insert and select modes
					["<C-k>"] = cmp.mapping(function() 
						toggle_cmp_buffer() 
					end, { "i", "s" }),

					-- <Enter> will insert return unless item selected
					-- Insert snippet if selected
					['<CR>'] = cmp.mapping({
						i = function(fallback)
							if cmp.visible() and cmp.get_active_entry() then
								if luasnip.expandable() then
									luasnip.expand()
								else
									cmp.confirm({
										select = true,
									})
								end
							else 
								fallback()
							end
						end,
						s = cmp.mapping.confirm({ select = false }),
						c = cmp.mapping.confirm({ 
							behavior = cmp.ConfirmBehavior.Replace,
							select = false
						}),
					}),
					
					-- <Tab> will select next item in list
					["<Tab>"] = cmp.mapping(function(fallback)
						if cmp.visible() then
							cmp.select_next_item()
						elseif luasnip.locally_jumpable(1) then
							luasnip.jump(1) 
						elseif has_words_before() then
							cmp.complete()
							if #cmp.get_entries() == 1 then
								cmp.confirm({ select = true })
							end
						else
							fallback()
						end
					end, { "i", "s" }),
					
					-- <Shift-Tab> will select previous item in list
					["<S-Tab>"] = cmp.mapping(function(fallback)
					  if cmp.visible() then
						cmp.select_prev_item()
					  elseif luasnip.locally_jumpable(-1) then
						luasnip.jump(-1)
					  else
						fallback()
					  end
					end, { "i", "s" }),
				},
				sources = cmp.config.sources({
					{ name = "luasnip" },
					{ name = "buffer" },
					{ name = "path" },
					{ name = "cmp_r" },
				}),
				formatting = {
					format = function(entry, vim_item)
					if vim.tbl_contains({ 'path' }, entry.source.name) then
						local icon, hl_group = require('nvim-web-devicons').get_icon(entry:get_completion_item().label)
						if icon then
							vim_item.kind = icon
							vim_item.kind_hl_group = hl_group
							return vim_item
						end
					end
					return require('lspkind').cmp_format({ with_text = true })(entry, vim_item)
					end
				},
			})
			
			-- Use buffer source for `/` and `?` 
			cmp.setup.cmdline({ '/', '?' }, {
				mapping = cmp.mapping.preset.cmdline(),
				sources = {
					{ name = 'buffer' }
				}
			})
			
			-- Use cmdline & path source for ':'
			cmp.setup.cmdline(':', {
				mapping = cmp.mapping.preset.cmdline(),
				sources = cmp.config.sources({
					{ name = 'path' }
				}, {
					{ name = 'cmdline' }
				}),
				matching = { disallow_symbol_nonprefix_matching = false }
			})
		end,
	},
}

Prototype taxonomic name checking function for SEOSAW

2025-07-09T00:00:00+0000

We are hoping to move the SEOSAW database to use World Flora Online (WFO) as its taxonomic backbone, rather than the African Plant Database (APD) which we have been using since 2019.

The WorldFlora R package , developed by Roeland Kindt, provides code for querying a downloaded copy of the WFO database and providing taxonomic information. The key features we want for SEOSAW are: check the validity of taxonomic names in tree inventory data, fuzzy find accepted names to catch spelling errors, and provide accepted names for synonyms.

I’ve written a wrapper function around the code in the WorldFlora R package. Some features:

Optionally submit a lookup table to replace unmatched names.
Consolidate consecutive whitespaces in the WFO database to a single space, which can lead to poor matching.
Use WorldFlora::WFO.prepare() with a default set of replacements to fix common orthographic errors.
Use WorldFlora::WFO.one() to find the best match where multiple names are fuzzy matched by WorldFlora::WFO.match().
Extract subspecies and variety epithets from matched names.
Optionally return unmatched or multiply-matched names.

#' Replace taxonomic names using lookup tables
#'
#' @param x vector of species names
#' @param lookup a single dataframe or a list of dataframes containing lookup
#'     tables. The first column should contain names in `x` to be changed. The
#'     second column should contain the new names.
#'
#' @return Vector of corrected species names
#' 
#' @details Lookup tables are run in order through the list of lookup tables, meaning 
#' names may change incrementally multiple times.
#' 
#' @export
#' 
synonymyFix <- function(x, lookup) {

  # Make list if not already
  if (!inherits(lookup, "list")) {
    lookup <- list(lookup)
  }

  # Combine lookup tables into a single dataframe
  lookup_combi <- as.data.frame(fastRbind(lookup))

  # Check no NAs
  if (any(is.na(lookup_combi))) {
    stop("Lookup table cannot contain NA entries")
  }

  # Do substitution
  out <- lookup_combi[,2][match(x, lookup_combi[,1])]
  out[is.na(out)] <- x[is.na(out)]

  return(out)
}

#' Return default pattern substitution for `taxonCheck()`
#'
#' @return vector of regex patterns for use with `taxonCheck()` in argument
#'     `sub.pattern`
#' 
#' @export
#' 
WFO.prepare_default <- function() { 
  c(
    " indet$",
    " sp[.]",
    " spp[.]",
    " ssp[.]",
    " pl[.]",
    " indet[.]",
    " ind[.]",
    " gen[.]",
    " g[.]",
    " fam[.]",
    " nov[.]",
    " prox[.]",
    " cf[.]",
    " aff[.]",
    " s[.]s[.]",
    " s[.]l[.]",
    " p[.]p[.]",
    " p[.] p[.]",
    "[?]",
    " inc[.]",
    " stet[.]",
    "nom[.] cons[.]",
    "nom[.] dub[.]",
    " nom[.] err[.]",
    " nom[.] illeg[.]",
    " nom[.] inval[.]",
    " nom[.] nov[.]",
    " nom[.] nud[.]",
    " nom[.] obl[.]",
    " nom[.] prot[.]",
    " nom[.] rej[.]",
    " nom[.] supp[.]",
    " sensu auct[.]"
  )
}

#' Correct and match taxonomic names to the World Flora Taxonomic Backbone
#'
#' @param x vector of taxonomic names
#' @param WFO.file optional file name of static copy of World Flora Online
#'     Taxonomic Backbone. If not NULL, data will be reloaded from this file
#' @param WFO.data optional dataset with static copy of World Flora Online
#'     Taxonomic backbone. Ignored if `WFO.file` is not NULL
#' @param lookup optional a single dataframe or a list of dataframes containing
#'     lookup tables. The first column should contain names in `x` to be
#'     changed. The second column should contain the new names.
#' @param ret_wfo logical, if TRUE the function stops after
#'     `WorldFlora::WFO.match()` and returns the raw output from this function.
#' @param ret_unk logical, if TRUE taxa not matched in the World
#'     Flora Online are returned to the user as a vector containing
#'     the unmatched values. If FALSE these taxa are returned as NA.
#' @param ret_multi logical, if TRUE taxa matching multiple records in the
#'     World Flora Online are returned to the user as a list with one element
#'     for each original name containing the unmatched values. If FALSE the
#'     "best" name is selected by `WorldFlora::WFO.one()`
#' @param sub.pattern vector with regular expressions defining sections of `x`
#'     to be removed during correction of common orthographic errors by
#'     `WorldFlora::WFO.prepare()`
#' @param fuzzy If larger than 0, then attempt fuzzy matching. See `WorldFlora::WFO.match()`
#' @param ... Additional arguments passed to `WorldFlora::WFO.match()`
#'
#' @return Dataframe with cleaned taxonomic names and metadata
#'
#' @details
#' Taxonomic names are matched against the World Flora Online database using
#' `WorldFlora::WFO.match()`.
#' 
#' The search algorithm is as follows:
#'     \enumerate{
#'       \item{Optionally replace names with `lookup`}
#'       \item{Correct common orthographic errors with `WorldFlora::WFO.prepare()`}
#'       \item{Query `WorldFlora::WFO.match()` for accepted
#'             name and taxonomic rank information}
#'       \item{Optionally return multiple matches or unsuccessful matches}
#'       \item{Consolidate multiple matches with `WorldFlora::WFO.one()`}
#'       \item{Return formatted dataframe}
#'     }
#' 
#' Names that cannot be matched should be replaced with "Indet indet" in
#' `lookup`. These are replaced with NA_character_ before `WorldFlora::WFO.match()`
#'
#' @importFrom data.table fread data.table
#' @importFrom WorldFlora WFO.prepare WFO.match WFO.one
#'
#' @export
#'
taxonCheck <- function(x, WFO.file = NULL, WFO.data = NULL, 
   lookup = NULL, ret_wfo = FALSE, ret_unk = FALSE, ret_multi = FALSE,
   sub.pattern = WFO.prepare_default(), fuzzy = 0.1, ...) {

  # Check WFO data is available
  if (is.null(WFO.data) & is.null(WFO.file)) {
    stop("Either WFO.data or WFO.file must be provided")
  }

  if (is.null(WFO.data)) {
    message(paste("Reading WFO data"))
    if (!file.exists(WFO.file)) {
      stop("If WFO.data is NULL, a valid WFO.file must be provided. See WorldFlora::WFO.download()")
    }
    WFO.data <- data.table::fread(WFO.file, encoding = "UTF-8")
  } else {
    WFO.data <- data.table::data.table(WFO.data)
  }

  WFO.data$scientificName <- gsub("\\s+", " ", WFO.data$scientificName)

  # Get unique taxonomic names
  xu <- unique(x)

  # Substitute names with lookup table
  if (!is.null(lookup)) {
    message("Substituting names with `lookup`")
    xf <- synonymyFix(xu, lookup = lookup)
  } else {
    xf <- xu
  }

  # Prepare taxonomic names for WFO query
  xs <- WorldFlora::WFO.prepare(xf, sub.pattern = sub.pattern)$spec.name
  
  # Replace Indet genera with ""
  xi <- xs
  xi[xi == "Indet"] <- ""

  # Run WFO matching 
  message("Querying World Flora Online")
  wfo <- WorldFlora::WFO.match(unique(xi), 
    WFO.data = WFO.data, Fuzzy = fuzzy, ...)


  # Optionally return raw WFO output  
  if (ret_wfo) { 
    # Add original names
    wfo_all <- dplyr::bind_rows(lapply(seq_along(xu), function(i) {
      orig <- xu[i]
      cbind("taxon_name_orig" = orig, wfo[wfo$spec.name.ORIG == xi[i],])
    }))

    # Check all original names are matched back 
    stopifnot(all(!is.na(wfo_all$taxon_name_orig)))

    return(wfo_all)
  }

  # Consolidate to single best name per taxon
  wfo_one <- WorldFlora::WFO.one(wfo, verbose = FALSE)

  # Add original names
  wfo_one_all <- dplyr::bind_rows(lapply(seq_along(xu), function(i) {
    orig <- xu[i]
    cbind("taxon_name_orig" = orig, wfo_one[wfo_one$spec.name.ORIG == xi[i],])
  }))

  # Check all original names are matched back 
  stopifnot(all(!is.na(wfo_one_all$taxon_name_orig)))
  
  wfo_sel <- wfo_one_all[,c(
    "taxon_name_orig",
    "spec.name.ORIG",  # taxon_name_sanit
    "Old.name",  # taxon_name_syn
    "Old.ID",  # taxon_wfo_syn
    "scientificName",  # taxon_name_acc
    "taxonID",  # taxon_wfo_acc
    "scientificNameAuthorship",  # taxon_auth_acc
    "taxonRank",  # taxon_rank_acc
    "parentNameUsageID",  # taxon_wfo_parent
    "specificEpithet",  # taxon_epithet_acc
    "genus",  # taxon_genus_acc
    "family"  # taxon_family_acc
  )]
  wfo_sel <- unique(wfo_sel)

  # All submitted names should be included in WFO output
  stopifnot(all(sort(unique(wfo_sel$spec.name.ORIG)) == sort(unique(xi))))

  # Consolidate genus and species
  wfo_sel$species <- trimws(paste(wfo_sel$genus, wfo_sel$specificEpithet))

  wfo_sel$species <- ifelse(!wfo_sel$taxonRank %in% 
      c("species", "subspecies", "variety", "subvariety", 
          "form", "subform", "prole", "unranked"), 
    NA_character_, wfo_sel$species)

  # Extract subsp. and var. epithets from accepted names
  wfo_sel$taxon_subspecies_acc <- gsub(".*subsp\\.\\s", "", wfo_sel$scientificName)
  wfo_sel$taxon_subspecies_acc[!grepl("\\ssubsp\\.\\s", wfo_sel$scientificName)] <- NA_character_

  wfo_sel$taxon_variety_acc <- gsub(".*var\\.\\s", "", wfo_sel$scientificName)
  wfo_sel$taxon_variety_acc[!grepl("\\svar\\.\\s", wfo_sel$scientificName)] <- NA_character_

  # Fill wfo ID of synonyms
  wfo_sel$Old.ID <- ifelse(wfo_sel$Old.ID == "", 
    wfo_sel$taxonID, wfo_sel$Old.ID)

  wfo_sel$Old.name <- ifelse(wfo_sel$Old.name == "", 
    wfo_sel$scientificName, wfo_sel$Old.name)

  # Add date of processing
  wfo_sel$taxon_wfo_date <- Sys.Date()

  # Create output dataframe
  out <- wfo_sel[,c(
    "taxon_name_orig",  
    "spec.name.ORIG",  # taxon_name_sanit
    "Old.name",  # taxon_name_syn
    "Old.ID",  # taxon_wfo_syn
    "scientificName",  # taxon_name_acc
    "taxonID",  # taxon_wfo_acc
    "scientificNameAuthorship",  # taxon_auth_acc
    "taxonRank",  # taxon_rank_acc
    "parentNameUsageID",  # taxon_wfo_parent
    "taxon_variety_acc",
    "taxon_subspecies_acc",
    "specificEpithet",  # taxon_epithet_acc
    "species",  # taxon_species_acc
    "genus",  # taxon_genus_acc
    "family",  # taxon_family_acc
    "taxon_wfo_date")]

  names(out) <- c(
    "taxon_name_orig",
    "taxon_name_sanit",
    "taxon_name_syn",
    "taxon_wfo_syn",
    "taxon_name_acc",
    "taxon_wfo_acc",
    "taxon_auth_acc",
    "taxon_rank_acc",
    "taxon_wfo_parent",
    "taxon_variety_acc",
    "taxon_subspecies_acc",
    "taxon_epithet_acc",
    "taxon_species_acc",
    "taxon_genus_acc",
    "taxon_family_acc",
    "taxon_wfo_date")

  # Optionally return unmatched names
  if (ret_unk & any(out$taxon_name_sanit != out$taxon_name_syn, na.rm = TRUE)) {
    unmatched <- out$taxon_name_orig[
      (out$taxon_name_sanit != out$taxon_name_syn) | 
        is.na(out$taxon_name_syn) | is.na(out$taxon_name_sanit)]
    warning("Some taxonomic names not matched by WFO.match, returning original names")
    return(unmatched)
  }

  # Optionally return names with multiple matches
  if (ret_multi & any(duplicated(wfo$taxon_name_orig))) {
    multis <- wfo$taxon_name_orig[duplicated(wfo$taxon_name_orig)]
    multis_df <- wfo[wfo$taxon_name_orig %in% multis,]
    multis_list <- split(multis_df, multis_df$taxon_name_orig)
    warning("Some taxonomic names matched to multiple names by WFO.match, returning options")
    return(multis_list)
  }

  # Change "" to NA in all columns
  out[] <- lapply(out, function(x) {
    if (is.character(x)) {
      x[x == ""] <- NA_character_
    }
    x
  })

  # All original names should be filled
  stopifnot(all(!is.na(out$species[out$species_sanit != "Indet indet"])))

  # Return
  return(out)
}

Predicting forest tree stem abundance in unsampled size classes

2025-07-02T00:00:00+0000

Most tree inventory plots have a minimum stem diameter threshold. Tree stems with a diameter lower than this threshold are not measured, because they are often too numerous to measure, and they contribute comparatively little to the total woody biomass of the plot.

Different sites have different minimum stem diameter thresholds, though 5, 10 and 20 cm are common. If we are going to compare woody biomass stocks across sites, how do we account for this difference in methodology, which could otherwise lead to lower estimates of the biomass stock where the minimum stem diameter threshold is higher?

One option would be to do nested sub-sampling, where smaller stems are measured within a small portion of the total plot area. Then you multiply up the biomass of small stems within the smaller subplots to the area of the whole plot. This method assumes that the spatial distribution of small stem biomass is consistent across the plot. Many plots don’t do this nested sub-sampling, but I believe it is the best way to deal with this problem.

Another option is to predict the abundance of stems in smaller size classes within the plot by extrapolating the stem size distribution. Stem size distributions in undisturbed forests often follow something close to a Weibull distribution .

Fitting a basic Weibull distribution to the data is not appropriate, because we know that it’s truncated at the minimum stem diameter threshold. I wrote some functions in R that fit a truncated Weibull distribution, then predict the abundance of stems in smaller size classes from this fitted distribution:

First create some fake data with a known Weibull distribution, for testing:

# Create fake data with known Weibull distribution
D <- rweibull(100000, shape = 1.2, scale = 50)

# Truncate to lower bound
Dt <- D[D > lower_bound]

Then define basic distribution functions for a truncated Weibull distribution, using the truncdist package:

# Define distribution functions for truncated Weibull
dtweibull <- function(x, shape, scale, lower, upper) {
  truncdist::dtrunc(x, "weibull", 
    a = lower, b = upper, 
    shape = shape, scale = scale)
}

ptweibull <- function(q, shape, scale, lower, upper) {
  truncdist::ptrunc(q, "weibull", 
    a = lower, b = upper, 
    shape = shape, scale = scale)
}

# Define function to fit Weibull distribution to data
tweibull_fit <- function(x, shape, scale, lower, upper) {
  fitdistrplus::fitdist(x, "tweibull", 
    start = list(
      shape = shape, 
      scale = scale),
    fix.arg = list(
      lower = lower,
      upper = upper))
}

And finally a function to fit the model and use it to predict stem size abundance in lower size classes:

# Define function to predict distribution outside truncation
tweibull_pred_fun <- function(x, lower = Inf, upper = Inf, bins) { 
  # Rescale data by mean 
  scale_val <- mean(x)
  x_scale <- x / scale_val
  bins_scale <- bins / scale_val
  lower_scale <- lower / scale_val
  upper_scale <- upper / scale_val

  # Estimate starting parameters of Weibull distribution
  fit_est <- unname(MASS::fitdistr(x_scale, "weibull")$estimate)

  # Fit truncated Weibull, using full Weibull parameters as starting
  fit_trunc <- tweibull_fit(x_scale, fit_est[1], fit_est[2], 
    lower_scale, upper_scale)

  # Extract parameters from truncated Weibull fit
  var_arg <- as.list(fit_trunc$estimate)
  fix_arg <- as.list(fit_trunc$fix.arg)

  # Get cumulative probabilities at bin edges
  probs <- pweibull(bins_scale, var_arg$shape, var_arg$scale)

  # Calculate bin probabilities (differences between successive CDF values)
  bin_probs <- diff(probs)

  # Get total probability within non-truncated region 
  probs_trunc <- sum(
    bin_probs[bins_scale >= lower_scale & bins_scale < upper_scale], 
    na.rm = TRUE)

  # Multiply up
  bin_probs_mult <- (1 / probs_trunc) * bin_probs

  # Multiply bin probabilities by total number of values 
  abundance_bins <- length(x) * bin_probs_mult

  # Construct dataframe
  out <- data.frame(
    bin = bins[-length(bins)],
    abund = abundance_bins)

  return(out)
}

Then run the function on the testing data:

fit_trunc_df <- tweibull_pred_fun(
  x = Dt, 
  lower = lower_bound, 
  upper = upper_bound, 
  bins = seq(0, max(Dt), 5))

And compare the predicted data to the original data. Blue is the original non-truncated data, with the truncated training data in dark blue. Red is the estimated distribution from the truncated data:

# Create test plot
ggplot() + 
  geom_histogram(aes(x = D), fill = "blue", binwidth = 5, alpha = 0.4, boundary = 0) +
  geom_col(data = fit_trunc_df, aes(x = bin, y = abund),
    fill = "red", width = 2, alpha = 0.5, just = 0) + 
  theme_bw() + 
  labs(
    x = "Stem diameter (cm)",
    y = "Number of stems")

Planning cycle routes in Washington DC

2025-05-03T00:00:00+0000

Having moved to Washington DC for work , I have spent some time looking at potential bike routes around the city. I brought my Dawes Super Galaxy touring bike rather than the single-speed , so I can do some riding on gravel trails. These routes are all longer rides. I think the shorter rides around town will emerge organically as I ride more. All these routes are adaptations of existing routes that others have posted online through websites like Komoot , ridewithgps , and bikewashington.org . I haven’t tested any of the routes yet, but I hope to try at least the three shorter ones over the next few weeks. As in my post about Edinburgh bike routes , I calculated the length of each route using R.

Arlington Loop

GPX track

Length: 29.6 km, 18.4 miles

Recommended by both bikewashington.org and bikearlington.com . This loop follows the Mt. Vernon Trail down the Potomac river, then west along the Four Mile Run Trail, switching to the W&OD Trail, and finally back east along the Custis Trail, mostly avoiding roads.

DC Zoo Loop

GPX track

Length: 33.3 km, 20.7 miles

This loop appears in various guises on Komoot, ridewithgps and bikewashington. The route follows the Rock Creek Park Trail going north, then connects through Chevy Chase and Bethesda on the Capital Crescent Trail down to Georgetown. It seems like this is a very popular route. The northern part of the trail varies a bit among sources, with some missing out Chevy Chase. Along the portion which runs along the Potomac river it is also possible to follow the C&O canal trail.

Anacostia Climbs

GPX track

Length: 112.5 km, 69.9 miles

This route is a lot longer than the first two, but is still a loop. It has more bits on roads, and is generally more complicated to follow. I think I’ll need a GPS unit or to have my phone attached to the handlebars to navigate this one. The route came off Komoot, and has some weird detours which I think might have resulted from the original rider getting lost. The trail takes advantage of the Anacostia River Trail up through Hyattsville all the way to Wheaton Regional Park, then uses the Matthew Henson Trail to connect to the top end of the Rock Creek Park Trail, which it follows all the way down to Georgetown. The bit from 11th Stree Bridge to Hyattsville looks most complicated, and I wonder why they didn’t follow the Anacostia River Trail for that bit as well.

C&O Canal Trail

GPX track

Length: 297 km, 185 miles

This route is apparently one of the most popular gravel rides in the country, running all the way from Washington DC to Cumberland almost exclusively on well-graded gravel trails along the C&O Canal Trail . Potentially you could go on from Cumberland all the way to Pittsburgh along the Great Allegheny Passage , which turns this into a 330 mile route.

I have wondered whether I could do this over a weekend, with one overnight stop and then taking the Amtrak back from Cumberland to DC, or vice versa.

Update 2025-05-07 - Mount Vernon Trail

GPX track

I also want to do this route. Some of it is covered by the Arlington Loop, above, but goes all the way down to Mount Vernon.

Gathering data on plant growth form for a regional species checklist

2025-04-26T00:00:00+0000

A colleague had a list of plant species names from a regional checklist they have compiled. They wanted to add a description of the growth form to each species, but with over 2000 species it was becoming laborious to look up each species individually online.

This was my email response:

There are obviously many different data sources you could use to get information on growth form, but many of them will be incomplete, and they will vary in how easy it is to process the data. Two of the best in terms of coverage and systematic recording of growth form are probably World Flora Online (WFO, https://www.worldfloraonline.org/ ) and the TRY traits database (https://www.try-db.org/TryWeb/Home.php) .

WFO has growth form information on their website for some species, but I have been unable to find a way to scrape this information. They have an API, but it only returns taxonomic information. If you were to use this method you would have to search for each species individually and copy the data from the table. Realistically it might only take a couple of days, maybe you could enlist the help of some eager Masters students?! It might be possible to scrape the Data table from each of the species, but when I tried this I kept getting 403 denied errors.

TRY has growth form information for many species. You can Download the “Plant Growth Form” data (trait ID 42) from their website. You have to submit a data request, but it’s fairly quick to do and they are approved automatically after a waiting period of a few hours so long as you only use their public dataset. Alternatively or in addition to this, you could look at their categorical traits table, which is a snapshot from the original 2012 debut of the database.

One key consideration is aligning the taxonomic names in your species list with those in whatever growth form data source you end up using. I would recommend using the WorldFlora R package to do this. I have attached an R script (below) which shows how to do this.

# Packages
library(dplyr)
library(readxl)
library(WorldFlora)

# Import data
x <- read_excel("./species.xlsx")

# Get first two words
x_clean$species_sanit <- unlist(lapply(strsplit(x_clean$species_ws, " "), function(y) { 
  paste(na.omit(y[1:2]), collapse = " ")
}))

# Find duplicated species names
# These species have different authorities but the same name. 
# For WorldFlora I will only use the species name, without the authority 
stopifnot(all(!duplicated(x_clean$species)))
x_clean$species_sanit[duplicated(x_clean$species_sanit)]

# Extract unique species names
x_un <- unique(x_clean$species_sanit)

# Download WFO (WorldFlora Online) back-bone data
WFO.download(save.dir = "./dat", WFO.remember = FALSE)

# Load WFO back-bone data from downloaded file
WFO.remember(WFO.file = "./dat/wfo/classification.csv")

# Run species names through WFO matching function
x_wfo <- WFO.match(x_un, WFO.data = WFO.data, Fuzzy = 0) 

# Keep only unique species names
x_wfo_clean <- x_wfo %>% 
  dplyr::select(
    species_orig = spec.name.ORIG,
    species_wfo = scientificName) %>% 
  distinct() %>% 
  filter(!is.na(species_wfo))

# Import TRY categorical database
# You can get this file from try-db.org in their categorical datasets page.
# You could supplement this with the data you request from the current database.
try_db <- read_excel("./dat/Try2025426112154TRY_Categorical_Traits_Lookup_Table_2012_03_17_TestRelease/TRY_Categorical_Traits_Lookup_Table_2012_03_17_TestRelease.xlsx")

# Run TRY species names through WFO matching function
# Warning, this can take a while
try_wfo <- WFO.match(try_db$AccSpeciesName,
  WFO.data = WFO.data, Fuzzy = 0)

# Keep only unique species names
try_wfo_clean <- try_wfo %>% 
  dplyr::select(
    species_orig = spec.name.ORIG,
    species_wfo = scientificName) %>% 
  distinct()

# Add WFO matched species names to TRY data
try_db_wfo <- left_join(try_db, try_wfo_clean, 
  by = c("AccSpeciesName" = "species_orig")) %>% 
  rename(species_orig = AccSpeciesName)

# Filter TRY data to species in Tchamba's species list
try_db_wfo_fil <- try_db_wfo %>% 
  filter(species_wfo %in% x_wfo_clean$species_wfo) %>% 
  dplyr::select(species_orig, PlantGrowthForm) %>% 
  distinct()

# Join growth form and taxonomic names back to original data table
out <- left_join(x_clean, try_db_wfo_fil, 
  by = c("species_sanit" = "species_orig")) %>% 
  dplyr::select(-species_ws, -species_sanit)

# Write table to CSV
write.csv(out, "./out.csv", row.names = FALSE)

Job talk for GEO-TREES post-doc

2025-04-08T00:00:00+0000

I will soon start a job with GEO-TREES as a post-doc, based in the ForestGEO offices at the Smithsonian National Museum of Natural History .

When I was applying for this job back in December last year, I gave a seminar as part of the interview process. The talk was a mixture of my general interests as a scientist, an overview of some of my previous work, and some potential ideas for the post-doc.

Here is a link to the presentation slides.

Leaf trait sampling protocol for SECO

2025-01-22T00:00:00+0000

At the start of the SECO project , we had the idea that we would sample leaf traits across our field sites to help constrain models of carbon cycle processes. I wrote a protocol with a PhD student at the University of Edinburgh, Matt Rees, with guidance on how to collect leaves from a representative sample of trees at each site, with the aim of calculating realistic community-weighted means of the leaf trait values that would be useful to the modelling team.

In the end, this protocol was only rolled out at a couple of sites in southern Africa, as the project went in a different direction quite early on.

I’m going to host the protocol here so anybody can use it.

Comparison of Mo et al. (2024) global wood density with plots in the seasonally dry tropics

2024-12-21T00:00:00+0000

This paper was recently published :

Mo, L., Crowther, T.W., Maynard, D.S. et al. The global distribution and drivers of wood density and their impact on forest carbon stocks. Nat Ecol Evol 8, 2195–2212 (2024).

In the paper, the authors use plot data from 1.1 million forest plots, and wood density data from 10,703 tree species, to explore global patterns in wood density. They find that water availability, measured in their case by mean annual temperature and soil moisture, is correlated with wood density, globally. They suggest that the mechanism for this is that trees in “warm and dry regions are likely to develop denser wood to maintain xylem resistance against implosion and rupture”.

Notably, this study included hardly any plot data from the seasonally dry tropics, including tropical savannas and dry forests. There is a particular lack of data from southern Africa:

The authors use random-forest models to develop wall-to-wall maps of predicted wood density across forested landscapes.

In my post-doc, we have amassed a dataset of ~1500 plots from across the seasonally dry tropics, for which we have estimates of wood density for each tree (>5 or >10 cm diameter). We used wood density data from the Global Wood Density Database (Zanne et al. 2009) with extra data from Vieilledent et al. (2018). We used the BIOMASS:getWoodDensity() function to estimate individual tree wood density, which uses the species estimate where possible, then genus, family, and finally plot-level if no data is available.

As in Mo et al. (2024), I took the Community Weighted Mean (CWM) of wood density by basal area from each plot, using the most recent census for each plot.

Below is a plot comparing our estimates of the CWM of wood density from each of our plots, with the corresponding pixels from the community wood density map in Mo et al. (2024) (see Figure 3a in the paper). The line is a GAM smooth fit:

I think this shows good agreement between our plot-level estimates and the spatialised estimates from the paper. We show greater variation in wood density, but the average wood density of our plots at any level of Mo et al.’s estimates is about the same.

We do not however, see strong relationships between plot-level wood density estimates in the seasonally dry tropics with precipitation or temperature (ERA5-Land 1980-2022). There is a weak negative correlation between precipitation and wood density, as in the paper, but we don’t see any effect of temperature, which the paper regards as the strongest environmental filter acting on wood density.

This might because our data, which span the environmental space of woody ecosystems in the dry tropics, don’t cover a wide enough environmental gradient to detect an effect of temperature, while the data in Mo et al. (2024) cover a wide range of biomes across a broad latitudinal range.

From this basic comparison, it seems like the lack of data from the seasonally dry tropics hasn’t harmed the estimates in Mo et al. (2024). I wonder though, if they did add more data from the seasonally dry tropics, would they find a stronger effect of fire disturbance, and a weaker effect of temperature on wood density? The authors acknowledge that their dataset of global “forests” might under-represent fire, and there is a clear bias towards temperate and boreal regions in their plot data.

I see this wood density map being especially helpful in building biomass maps from radar or LiDAR data, which can sense woody volume, but not wood density. For plot-level analyses however, using an individual-level estimation of wood density will remain the better option.

GPX files for Edinburgh cycle loops

2024-10-27T00:00:00+0000

Here are some routes that I cycle fairly regularly in Edinburgh. I cycle them predominantly on my single speed . There are occasional sections where I would prefer something with wider tyres, but nothing that requires a proper mountain bike. Most of the tracks start around Holyrood Park, then head out of the city in different directions.

I calculated the length of the GPX files in R:

# Packages
library(sf)
library(units)

# Conversion factor: km to miles
km_mi <- 0.6213712

# List GPX files
gpx_files_list <- list.files(pattern = "*.gpx")

# Read GPX files
gpx_list <- lapply(gpx_files_list, function(x) {
  st_read(x, layer = "tracks")
})
names(gpx_list) <- gsub("\\.gpx$", "", gpx_files_list)

# Calculate lengths of GPX files
lapply(gpx_list, function(x) {
  x_length <- drop_units(st_length(x))
  x_length_km <- x_length * 0.001
  x_length_mi <- x_length_km * km_mi

  return(c("km" = x_length_km, "mi" = x_length_mi))
})

Inverkeithing

GPX track

Length: 52.2 km, 32.4 miles

This route heads north from Haymarket via the Roseburn Path down to Granton, then west along the coast to Cramond along the promenade along National Cycle-route 1, which follows the Roseburn path from Haymarket. From Cramond the route then follows National Cycle-route 1 (NCR1) alongside the busy A90. Unfortunately there is a short section of fast road between the B294 and Dalmeny, which makes this route difficult after dark. The route then heads through Dalmeny to Inverkeithing over the old Forth Road Bridge and back again to Cramond. From Cramond back into town the route continues to follow NCR1 to Haymarket, then through Grassmarket and down Cowgate back towards Holyrood Park.

Musselburgh to Roslin via the Penicuik-Dalkeith Walkway

GPX track

Length: 47.4 km, 29.4 miles

I got the idea for this route from another route which goes all the way down to Penicuik, but recently the Penicuik-Dalkeith Walkway has been partially closed for resurfacing work. The route starts by following NCR1 down toward the Jewel, then towards Musselburgh and Queen Margaret University through winding housing estates. Then towards Dalkeith and Bonnyrigg onto the Penicuik-Dalkeith Walkway. Going through Roslin Glen there are a few walking sections, then after Roslin village it’s back on the cycle path, through Loanhead to Newton Village and past Shawfair train station. The landscape is very odd round here, with lots of abandoned farmland, abandoned roads and buildings. The section between Newton Village and the turn-off at Hilltown along the A6106 is quite nasty. I cycles along the pavement. Beyond Craighall Junction the route goes the same way as at the start.

Patina bakery

GPX track

Length: 24.6 km, 15.3 miles

This route worms through the middle of town towards Haymarket, then through Murrayfield on the cycle path that follows the tramline all the way to Edinburgh Park. Once in the business park there are various roads that never have any traffic on them, which are good for doing laps to extend the length of the ride a bit. Patina Bakery is a good stop for a pastry or a pint in the adjacent restaurant. The route through the centre of town could be varied, for example to avoid Princes Steet, or to avoid Cowgate.

Portobello and the Roseburn Path

GPX track

Length: 26.8 km, 16.6 miles

This is my most frequent after work route. It starts of the road down to Joppa, then along Portobello Road and onto the promenade to follow the bike path road to Seafield. This section of the ride isn’t very pretty, but at least it’s not on the busy road, as there is a wide bike path that runs alongside. Through the Shore towards the Roseburn Path is a fast road, but there’s lots of space in the bus lane. Once on the Roseburn Path the route is very pleasant, though if doing this route at night it’s vital to have a bright front light. From the end of the Roseburn Path back towards Holyrood the route is very urban. I normally head through Grassmarket and down Cowgate, but there are many ways of doing this section.

Slateford climb and the Balerno cycle path

GPX track

Length: 23.8 km, 14.8 miles

The entire purpose of this route is to do the long climb from Slateford to Juniper Green along the A70. Much of this road now has a segregated cycle lane, which makes it more pleasant, but it’s still a fast road. It’s easy to miss the turn-off towards the Balerno cycle path. It’s also necessary to carry your bike down the steps into the valley of the Water of Leith. Once on the Balerno cycle path, proceeded by the Union Canal Path, the route is very nice, though like the Roseburn Path it’s important to have a bright front light if doing this route after dark. When I recorded this route I went up the hill to Bruntsfield Links before heading back down to the Meadows because I wanted another climb, but you could just take the junction at the end of Gilmore Place and onto the cycle link on Valleyfield Street straight on to the Meadows.

Bash script to download audio from Youtube

2024-06-26T00:00:00+0000

This post is actually about a trick I learned that allows bash scripts to accept input either as a string or from stdin.

Here is the code. It first checks whether at least one argument is provided to the script. If an argument is found it creates a variable containing all the arguments. If no arguments are found, then it waits for input from stdin, which can either come from a pipe or can be typed in after the script is called.

#!/usr/bin/env bash

# If argument provided
if [ $# -gt 0 ]; then
    input="$*"
else
    # Read from stdin 
    while IFS= read -r line; do
        input+="$line"
    done
fi

echo $input

I used this trick to write a script to download audio files from Youtube using yt-dlp . I wanted to be able to integrate the script with ytfzf , which can search Youtube from the terminal using FZF and optionally print the URL of the selected video.

#!/usr/bin/env sh

# Download audio only using yt-dlp

# If argument provided
if [ $# -gt 0 ]; then
    input="$*"
else
    # Read from stdin 
    while IFS= read -r line; do
        input+="$line"
    done
fi

# Download 
yt-dlp \
	-f bestaudio \
	--extract-audio \
	--audio-format m4a \
	-S +size,+br \
	-o "$PWD/%(title)s.%(ext)s" \
	--external-downloader aria2c \
	--external-downloader-args "-x 5 -s 5 -j 5 -c -k 1M" $input

The script can be called in various ways.

Passing an argument:

yt_audio https://www.youtube.com/watch?v=Atkp8mklOh0

Using stdin:

echo "https://www.youtube.com/watch?v=Atkp8mklOh0" | yt_audio

Using stdin with ytfzf:

ytfzf -L Terry Barentsen Hotline Cooper Ray | yt_audio

With multiple URLs as arguments:

yt_audio https://www.youtube.com/watch?v=WyV894c8oqI https://www.youtube.com/watch?v=Atkp8mklOh0

With multiple URLs from stdin:

echo "https://www.youtube.com/watch?v=WyV894c8oqI https://www.youtube.com/watch?v=Atkp8mklOh0" | yt_audio