Display trendline equations for facet wrapped date

Question

I am working with a lot of data looking for variation in spider behavior. Here, multiple behaviors were recorded for multiple spiders in an experiment simulating rain. I have the amount of time each spider spend performing each behavior recorded in seconds on the y axis, and an objective measure of the spiders personality on the x axis. Each subgraph represents the correlation of the objective measure to the time spent in the specific behavior as a black trendline. The spider IDs are represented as different colors. I am building this with ggplot2

I am attempting to simply display the equation of the trendline with each graph. I would use the slope of the trendline as a correlative index. I would love to do this without splitting up my data and doing the line of best fit for each individual action. Please let me know if there are any insights or questions.

code: ggplot(data = water,mapping = aes(x=avg_time, y = time, color= as.factor(ID))) + facet_wrap(~action) + geom_point() + geom_smooth(method = lm, color = 'black') + labs(x= 'INDEX', y= 'Time spent in each behavior (sec)', title = 'FIGURE 12: A little bit of p hacking for the water trails', color = 'Spider ID') Resulting plot

A portion of my 'water' data

Answer 1

Here's one way you could do it. Hope it helps!

It's better if you can provide a minimal reproducible example that may be easily copied into an R session rather than using an image :)

library(tidyverse)
library(glue)

water <- tribble(
  ~id, ~action, ~time, ~burrow, ~avg_time,
  9, "latency", 1, "Y", 36.5,
  3, "latency", 2, "Y", 766.25,
  9, "famil", 300, "Y", 36.5,
  3, "famil", 305, "Y", 766.25
  )

lm_df <- water |>
  mutate(
    lab_y = mean(time), 
    lab_x = mean(avg_time), 
    .by = action
    ) |> 
  nest(data = -c(action, lab_x, lab_y)) |> 
  mutate(
    model = map(data, \(x) lm(time ~ avg_time, data = x)),
    intercept = map_dbl(model, \(x) coef(x)[1]) |> round(2),
    avg_time = map_dbl(model, \(x) coef(x)[2]) |> round(4)
    ) |> 
  select(action, intercept, avg_time, lab_x, lab_y)

water |>
  ggplot(aes(avg_time, time, color = as.factor(id))) +
  facet_wrap(~action, scales = "free_y") +
  geom_point() +
  geom_smooth(method = lm, color = "black") +
  geom_label(
    aes(lab_x, lab_y, label = glue("Intercept: {intercept}\nSlope: {avg_time}")),
    color = "black", size = 2, data = lm_df
  ) +
  labs(
    x = "INDEX",
    y = "Time spent in each behavior (sec)",
    title = "FIGURE 12: A little bit of p hacking for the water trails",
    color = "Spider ID"
  )

^{Created on 2024-03-13 with reprex v2.1.0}