# Advanced plotting

#### Morgan Sparks, Bryan M. Maitland

## Overview

The goal of this vignette is to provide some examples of how you might access results from `predict_phenology()` and how you might plot your data.

    library(hatchR)
    library(purrr)
    library(tidyr)
    library(dplyr)
    library(ggplot2)
    library(lubridate)
    library(stringr)
    library(ggridges)
    library(patchwork)

## A simple example

We’ll return to our first example with Woody Island to show how you might present data for a single spawning season. First let’s get our results and output them into a plotting format.

    # run map to get a vector of models
    WI_mods <- map_df(
      c("hatch", "emerge"),
      model_select,
      author = "Beacham and Murray 1990",
      species = "sockeye",
      model = 2
      ) |>
      select(expression)

    # make vector of spawn dates
    WI_spawn_dates <- c("1990-08-14", "1990-08-18", "1990-09-3")

    # make variables grid
    WI_var_grid <- expand_grid(model = WI_mods$expression, spawn.date = WI_spawn_dates)

    # run pmap for all variable combinations
    WI_results <- pmap(WI_var_grid,
      predict_phenology,
      data = woody_island, # additional arguments required by function
      dates = date,
      temperature = temp_c
    )

    # Now that we have our model results, lets put them in a tibble for plotting
    WI_dev_period <- WI_results |>
      map_df("dev_period") |>
      tibble() |>
      mutate(
        phenology = c(rep("hatch", 3), rep("emerge", 3)), # add a phenology column
        days = as.numeric(stop - start), # column of the number of days (same as days2done)
        index = c(1:3, 5:7)  # index for plotting later
      )

Now we’ll make a plot with the temperature and rectangles to show duration for the hatch and emergence periods.

    # min and max for x-axis with 30 day buffer
    x_lims <- c(min(WI_dev_period$start), max(WI_dev_period$stop) + days(30))
    y_lims <- c(-1, 16)
    # filter data for plot
    p_data <- woody_island |> filter(date >= x_lims[1], date <= x_lims[2])

    plot1 <- p_data |>
      ggplot() +
      geom_rect(
        data = WI_dev_period,
        aes(
          xmin = start, xmax = stop,
          ymin = 10 - index,
          ymax = 10.5 - index,
          fill = phenology
      )) +
      geom_point(aes(x = date, y = temp_c), size = 0.25, ) +
      geom_line(aes(x = date, y = temp_c)) +
      lims(x = x_lims, y = y_lims) +
      scale_fill_manual(values = c("navyblue", "dodgerblue")) +
      theme_classic() +
      theme(
        legend.position = "inside",
        legend.position.inside = c(0.75, 0.75)
        )
    plot1

We can add some labels for days to hatch or emergence and change the labels on the legend.

    plot1 +
      geom_label(
        data = WI_dev_period,
        aes(
          x = start + (stop - start) / 1.25,
          y = (10.25 - index),
          label = days
        )
      ) +
      scale_fill_manual(values = c("navyblue", "dodgerblue"), labels = c("Emerge", "Hatch")) +
      labs(fill = "Phenology", y = "Temperature (C)")

## Plotting multiple years

Let’s use the Crooked River data again as it has a number of continuous years of data without any temperature anomalies.

    # spawn dates
    spawn_dates <- map(
      c(2011:2014), # year vector to map for custom function
      function(year) { # custom paste function
        c(
          paste0(year, "-09-01"),
          paste0(year, "-09-20"),
          paste0(year, "-09-30")
        )
        }
      ) |>
      unlist()

    # run map to get a vector of models
    dev_mods <- map_df(
      c("hatch", "emerge"),
      model_select,
      author = "Austin et al. 2019",
      species = "bull trout",
      model = "MM"
      ) |>
      select(expression)

    # variable grid
    var_grid <- expand_grid(model = dev_mods$expression, spawn.date = spawn_dates)

    ### multiple input mapping

    crooked_predictions <- pmap(var_grid, # combos of variables to iterate over
      predict_phenology, # function
      data = crooked_river, # additional arguments required by function
      dates = date,
      temperature = temp_c
    )

    # make duration dataframe
    CR_dev_period <- crooked_predictions |>
      map_df("dev_period") |>
      tibble() |>
      mutate(
        phenology = c(rep("hatch", 12), rep("emerge", 12)), # add a phenology column
        days = as.numeric(stop - start), # column of the number of days (same as days2done)
        year = year(start), # new column for just year (to facet wrap with)
        index = c(rep(1:3, 4), rep(5:7, 4))
      ) |> # new index because we're making 4 independent graphs
      na.omit() |>
      filter(year >= 2011) # remove the 2010 year

We’ll now make similar plot as above but use `facet_wrap()` to break plots apart by year. We do this by cutting to make a developmental year because phenology spans two calendar years. As a result, we cut between Aug. 1 of one year and Aug. 1 of the subsequent year (August 1 instead of Sept. 1 to match the plot limits we’re setting up) and then make that a developmental year (the year the adult spawned). Then we can `facet_wrap()` to break the years up in the plot.

    ### add a column called year (in this case the developmental year)
    cut_ints <- ymd(
      c(
        "2010-08-01", "2011-08-01", "2012-08-01",
        "2013-08-01", "2014-08-01",
        "2015-08-01", "2016-08-01"
      ),
      tz = "UTC"
    )

    # cut to our cut intervals and label by developmental year
    crooked_river_sy <- crooked_river |>
      mutate(year = cut(date,
        breaks = cut_ints,
        labels = c(2010:2015)
      )) |>
       # cut coerces our labels to factors, this changes them back to numbers
      mutate(year = as.numeric(as.character(year))) |>
      filter(year > 2010 & year < 2015) # remove 2010 and 2015

    # make plot (facet_wrap by development year)
    ggplot() +
      geom_rect(data = CR_dev_period, aes(
        xmin = start,
        xmax = stop,
        ymin = 10 - index,
        ymax = 10.5 - index,
        fill = phenology
      )) +
      geom_point(data = crooked_river_sy, aes(x = date, y = temp_c), size = 0.25, ) +
      geom_line(data = crooked_river_sy, aes(x = date, y = temp_c)) +
      # set limits
      lims(x = c(min(CR_dev_period$start) - days(30), max(CR_dev_period$stop) + days(30))) +
      scale_x_datetime(date_labels = "%b") +
      # facet wrap here subset plots on developmental year
      facet_wrap(~year, ncol = 1, scales = "free_x") +
      scale_fill_manual(values = c("navyblue", "dodgerblue"), labels = c("Emerge", "Hatch")) + # custom colors
      labs(fill = "Phenology", x = "Date", y = "Temperature (C)") +
      theme_classic()

As you can see, this allows us to put our figures on the same X scale despite flowing into multiple years. You’ll have to figure out the right way to cut up your data (or find similar alternative options). But this solves a primary problem of plotting phenology for multiple years, which is that our results span multiple years and may start and stop in the same intervals over multiple years (particularly for fall spawning species).

Note that we run out of temperature data in 2015, which is why it is cutoff relative to the others. If you really wanted to fix that you could be adding on the necessary dates with no temperature data to the `crooked_river_sy` tibble.

## Plotting multiple individual spawning events

Another common plotting scenario is that you might have data for when a number of fish spawn in a single or multiple seasons and want to represent those results.

We can show a hypothetical scenario with the bull trout example above. In this scenario, let’s assume we have 300 spawning adult pairs that spawn in a roughly normal distribution with mean Sept. 15 and a standard deviation of 5 days (which makes Sept. 1st and 30th 3 sd from the mean).

    # draw from a normal distribution with above parameters
    set.seed(322) # allows us to draw same random sample every time for the example
    fish_dist <- round(rnorm(300,
      mean = 15,
      sd = 5
    ), 0)
    # summary
    summary(fish_dist)
    #>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
    #>    1.00   11.00   14.00   14.38   18.00   28.00

    # change 0s to 1s
    fish_dist[which(fish_dist == 0)] <- 1

    # look at distribution
    hist(fish_dist)

    # make a vector of fish dates and add mo_day to combine with fish_dist
    fish_dates <- tibble(date = seq(ymd("2014-09-01"), ymd("2014-09-30"), by = "days")) |>
      mutate(mo_day = mday(date))

    # loop for repping (could do with map, too)
    fish_dates_norm <- NULL
    for (d in fish_dates$mo_day) {
      day <- fish_dates$date[d] # get date

      spawners <- fish_dist[fish_dist == d] # vector of spawners in fish_dist

      spawners_date <- rep(day, times = length(spawners)) # make vector of date repeated the length of the vector spawners

      fish_dates_norm <- append(fish_dates_norm, spawners_date) # append to out file
    }

    head(fish_dates_norm)
    #> [1] "2014-09-01" "2014-09-02" "2014-09-03" "2014-09-03" "2014-09-03"
    #> [6] "2014-09-04"

    # now let's make the same vector for 2013 so we can compare two years
    fish_dates_13 <- fish_dates_norm |>
      str_replace_all("2014", "2013") # replace all the 2014s with 2013 using string replace

    # add the two together in a vector and sort
    fish_dates_all <- sort(append(fish_dates_norm, fish_dates_13))

    # looks good!
    head(fish_dates_all)
    #> [1] "2013-09-01" "2013-09-02" "2013-09-03" "2013-09-03" "2013-09-03"
    #> [6] "2013-09-04"
    tail(fish_dates_all)
    #> [1] "2014-09-25" "2014-09-26" "2014-09-26" "2014-09-26" "2014-09-28"
    #> [6] "2014-09-28"

    # remember these all need to be in a character string for predict_phenology()!
    fish_dates_str <- format(fish_dates_all, "%Y-%m-%d")

Now we can map hatch and emergence timing across the vector of dates we have created for the two years. Notice we have chosen two fairly thermally different years with quite different developmental phenology estimates (see plot from Plotting multiple years).

Also, we’re going to take a short cut with our mapping so we don’t store all the results of each date (1200 total, 600 for each developmental period estimated) in our memory. So instead, we will pipe `|>` our `pmap()` into a `map_dbl("dev_period")` command so we only are left with our phenology estimates and not all the other data we would have otherwise outputted.

    # make variable grid for pmap (we use dev_mods from previous example)
    spawn_grid <- expand_grid(model = dev_mods$expression, spawn.date = fish_dates_str)

    bull_trout_dist <- pmap(spawn_grid,
      predict_phenology,
      data = crooked_river, # additional arguments required by function
      dates = date,
      temperature = temp_c
    ) |> # pipe!
      map_df("dev_period") # just output dev_period

    ### now let's add the key columns for plotting

    # first you can see the output and the spawn grid have the same number of rows so
    # we can borrow the format from the spawn grid
    length(bull_trout_dist)
    #> [1] 2
    dim(spawn_grid)
    #> [1] 1200    2

    # moreover from the grid, you can see that it predicts hatch for all the dates first
    # and then predicts emergence
    head(spawn_grid$model)
    #> [1] "1/exp(5.086 - (x * 0.131))" "1/exp(5.086 - (x * 0.131))"
    #> [3] "1/exp(5.086 - (x * 0.131))" "1/exp(5.086 - (x * 0.131))"
    #> [5] "1/exp(5.086 - (x * 0.131))" "1/exp(5.086 - (x * 0.131))"
    tail(spawn_grid$model)
    #> [1] "1/exp(5.590 - (x  * 0.126))" "1/exp(5.590 - (x  * 0.126))"
    #> [3] "1/exp(5.590 - (x  * 0.126))" "1/exp(5.590 - (x  * 0.126))"
    #> [5] "1/exp(5.590 - (x  * 0.126))" "1/exp(5.590 - (x  * 0.126))"

    # now we can borrow all that information to make the exact data object we want
    bull_trout_dist_phenology <- bull_trout_dist |>
      mutate(
        Date = stop, # rename stop to Date
        Phenology = c(rep("Hatch", 600), rep("Emerge", 600))
      ) |> # make phenology column
      select(Date:Phenology) # select date and phenology columns to put in object

    # make a similar object with spawning data (notice we name the columns the exact same)
    bull_trout_spawn_phenology <- tibble(Date = fish_dates_all) |>
      mutate(Phenology = "Spawn")

    # combine spawn and hatch/emerge objects for a final plotting object
    bull_trout_all_phenology <- bind_rows(
      bull_trout_spawn_phenology,
      bull_trout_dist_phenology
    ) |>
      mutate(y = year(Date)) |>
      na.omit()

    head(bull_trout_all_phenology)
    #> # A tibble: 6 × 3
    #>   Date                Phenology     y
    #>   <dttm>              <chr>     <dbl>
    #> 1 2013-09-01 00:00:00 Spawn      2013
    #> 2 2013-09-02 00:00:00 Spawn      2013
    #> 3 2013-09-03 00:00:00 Spawn      2013
    #> 4 2013-09-03 00:00:00 Spawn      2013
    #> 5 2013-09-03 00:00:00 Spawn      2013
    #> # ℹ 1 more row
    tail(bull_trout_all_phenology)
    #> # A tibble: 6 × 3
    #>   Date                Phenology     y
    #>   <dttm>              <chr>     <dbl>
    #> 1 2015-04-11 00:00:00 Emerge     2015
    #> 2 2015-04-13 00:00:00 Emerge     2015
    #> 3 2015-04-13 00:00:00 Emerge     2015
    #> 4 2015-04-13 00:00:00 Emerge     2015
    #> 5 2015-04-17 00:00:00 Emerge     2015
    #> # ℹ 1 more row

Before we plot, let’s briefly walk through what we did there. First we made our predictions but then only output the start and stop data with the `map_df("dev_period")` command. Next we added a `Phenology` column with the appropriate phenology type determined by the structure of our `spawn_grid` object. Then we made a similar object for spawning which we combined with the mapping ouput all into `bull_trout_all_phenology`. The reason for this is we will plot the distributions of spawning, hatching, and emergence across years.

You can see we also need to cut like we did before to add a developmental year and we use `geom_blank()` and custom limits to set everything on the same scale.

    # before we plot, because we are again plotting across years we need to cut up our data
    # still need 2012 and 2015 because phenology will leak over
    cut_ints_1314 <- ymd(c(
      "2012-08-01", "2013-08-01",
      "2014-08-01", "2015-08-01"
    ), tz = "UTC")

    # cut according to our cut intervals and label by developmental year
    bull_trout_phenology_cut <- bull_trout_all_phenology |>
      mutate(year = cut(Date,
        breaks = cut_ints_1314,
        labels = c(2012:2014)
      )) |>
      mutate(year = as.numeric(as.character(year))) |>
      na.omit()

    # look to see max development days to make custom lims
    bull_trout_dist |>
      mutate(phen_days = stop - start) |>
      slice_max(phen_days) # output max value
    #>        start       stop phen_days
    #> 1 2013-09-28 2014-04-30  214 days
    #> 2 2013-09-28 2014-04-30  214 days

    # make custom lims using 30 days before first spawn and 244 days max (214 + 30) from above
    # makes a 30 day buffer
    cust_lims <- tibble(min = c(ymd(c("2013-08-01", "2014-08-01"), tz = "UTC"))) |>
      mutate(max = min + days(244)) |>
      pivot_longer(everything(), names_to = "type", values_to = "Date") |>
      mutate(year = c(2013, 2013, 2014, 2014))

    # make plot
    ggplot() +
      geom_blank(data = cust_lims, aes(x = Date)) + # we use geom_blank to keep everything on the same limits from our custom lims object
      geom_density_ridges(
        data = bull_trout_phenology_cut,
        aes(x = Date, y = Phenology, color = Phenology, fill = Phenology),
        jittered_points = TRUE,
        position = position_points_jitter(width = 0.05, height = 0),
        point_shape = "|", point_size = 2, point_alpha = 1, alpha = 0.7
      ) +
      lims(x = c(min(cust_lims$Date) - days(1), max(cust_lims$Date) + days(1))) +
      scale_x_datetime(date_labels = "%b") +
      scale_fill_brewer(palette = "Dark2") +
      scale_color_brewer(palette = "Dark2") +
      facet_wrap(~year, ncol = 1, scales = "free_x") +
      theme_classic() +
      theme(legend.position = "none")

As you can see, even small differences in thermal regime can make for big differences in developmental phenology.

We could even combine this plot with the plot we made previously to show regime and duration alongside the distributions. For combining plots we highly recommend the patchwork package.

    # same plot as before but we'll filter the years to 2013 and 2014

    CR_dev_period_1314 <- CR_dev_period |> filter(year %in% c(2013, 2014))
    crooked_river_sy_1314 <- crooked_river_sy |> filter(year %in% c(2013, 2014))

    # name plot as object p1
    p1 <- ggplot() +
      geom_rect(data = CR_dev_period_1314, aes(
        xmin = start, xmax = stop, # draw bars
        ymin = 10 - index, ymax = 10.5 - index, # use index to vertically place rects
        fill = phenology
      )) +
      geom_point(data = crooked_river_sy_1314, aes(x = date, y = temp_c), size = 0.25, ) +
      geom_line(data = crooked_river_sy_1314, aes(x = date, y = temp_c)) +
      lims(x = c(min(CR_dev_period$start) - days(30), max(CR_dev_period$stop) + days(30))) + # set limits
      scale_x_datetime(date_labels = "%b") + # change X label to month
      facet_wrap(~year, ncol = 1, scales = "free_x") + # facet wrap here subset plots on developmental year
      scale_fill_manual(values = c("navyblue", "dodgerblue"), labels = c("Emerge", "Hatch")) + # custom colors
      labs(fill = "Phenology", x = "Date", y = "Temperature (C)") +
      theme_classic()

    # name distribution plot as object p2

    p2 <- ggplot() +
      geom_blank(data = cust_lims, aes(x = Date)) + # we use geom_blank to keep everything on the same limits from our custom lims object
      geom_density_ridges(
        data = bull_trout_phenology_cut,
        aes(x = Date, y = Phenology, color = Phenology, fill = Phenology),
        jittered_points = TRUE,
        position = position_points_jitter(width = 0.05, height = 0),
        point_shape = "|", point_size = 2, point_alpha = 1, alpha = 0.7
      ) +
      lims(x = c(min(cust_lims$Date) - days(1), max(cust_lims$Date) + days(1))) +
      scale_x_datetime(date_labels = "%b") +
      scale_fill_brewer(palette = "Dark2") +
      scale_color_brewer(palette = "Dark2") +
      facet_wrap(~year, ncol = 1, scales = "free_x") +
      theme_classic() +
      theme(legend.position = "none")

    ### patchwork plot

    # plot the two plots side by side using + operator, you can stack with / operator
    p1 + p2

There are many more ways you can plot your data but we these are meant to serve as templates and/or guides around common issues related to plotting phenology data.

# References