Signal-Preference
Olivia Feagles
2026-07-02
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
Preliminaries
Load libraries
library(readxl)
library(car)
library(ggplot2)
library(ggpubr)
library(cowplot)
library(magick)Data processing
PairMatchingR_F77 <- read_excel("C:/Users/olivi/OneDrive/Desktop/manuscripts/In process/Pair Matching MS/PairMatchingR/PairMatchingFullSet_F77_R.xlsx")
PairMatchingR_F77$Call_Peak_Diff <- as.Date.numeric(PairMatchingR_F77$TotalPulseDiff_Corr)Selectivity Demo (Fig 1A, main text)
Generate Data
cropped_gaussian_zero <- function(mean = 5, sd = 1, amp = 1, n = 200, crop_mult = 2.5) {
x_min <- mean - crop_mult * sd
x_max <- mean + crop_mult * sd
x <- seq(x_min, x_max, length.out = n)
y <- amp * dnorm(x, mean = mean, sd = sd)
y <- y - min(y) # y = 0 at ends
data.frame(x = x, y = y)
}
red_curve <- function(x_range = c(2, 8), func = function(x) 3*(1 - exp(-x/2)), n = 400) {
x <- seq(x_range[1], x_range[2], length.out = n)
y_raw <- func(x)
y <- y_raw - y_raw[1] # start at 0
data.frame(x = x, y = y)
}
rescale_to_max <- function(df, target_max) {
df$y <- df$y / max(df$y) * target_max
df
}
add_peak_annotation_gap <- function(p, df_blue, df_red, gap = 0.2, text_offset = 0.1) {
x_blue <- df_blue$x[which.max(df_blue$y)]
x_red <- df_red$x[which.max(df_red$y)]
y_blue <- max(df_blue$y)
y_red <- max(df_red$y)
p +
# Arrows: start above peak (y + gap), point just above peak (y + tiny offset)
annotate("segment", x = x_blue, xend = x_blue,
y = y_blue + gap, yend = y_blue + 0.04,
colour = "navy", arrow = arrow(length = unit(0.1, "inches")), size = 1.2) +
annotate("segment", x = x_red, xend = x_red,
y = y_red + gap, yend = y_red + 0.04,
colour = "olivedrab4", arrow = arrow(length = unit(0.1, "inches")), size = 1.2)
}
x_full <- c(2, 8)
closed_A <- cropped_gaussian_zero(mean = 5, sd = 1, amp = 8, crop_mult = 1)
open_A <- red_curve(x_full, function(x) 3 * (1 - exp(-x / 2)))
open_A <- rescale_to_max(open_A, max(closed_A$y))
closed_B <- cropped_gaussian_zero(mean = 5, sd = 2, amp = 8, crop_mult = 1) # wider
open_B <- red_curve(x_full, function(x) 3 * (1 - exp(-x / 2)))
open_B <- rescale_to_max(open_B, max(closed_B$y))
peak_A <- max(max(closed_A$y), max(open_A$y))
peak_B <- max(max(closed_B$y), max(open_B$y))
shift_B <- peak_A - peak_B
closed_B$y <- closed_B$y + shift_B
open_B$y <- open_B$y + shift_B
lower_amount <- 3
closed_A$y <- closed_A$y - lower_amount
open_A$y <- open_A$y - lower_amount
closed_B$y <- closed_B$y - lower_amount
open_B$y <- open_B$y - lower_amount
global_max <- max(max(closed_A$y), max(open_A$y), max(closed_B$y), max(open_B$y))
global_min <- min(min(closed_A$y), min(open_A$y), min(closed_B$y), min(open_B$y))
y_limits <- c(global_min, global_max + 0.3)High selectivity
highselect <- ggplot() +
geom_line(data = open_A, aes(x, y), color = "olivedrab4", linewidth = 1.5, lineend = "round") +
geom_line(data = closed_A, aes(x, y), color = "navy", linewidth = 1.5, lineend = "round") +
labs(x = "male trait", y = "female response") +
coord_cartesian(ylim = y_limits) +
theme_classic(base_size = 18) +
theme(
panel.grid = element_blank(),
axis.title.y = element_text(size = 18, vjust = -0.3),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_text(size=18),
panel.border = element_blank(),
axis.line = element_line(color = "black", linewidth = 0.9),
plot.title = element_text(face = "bold"),
plot.margin = margin(10, 10, 10, 10)
) +
guides(x = guide_axis(cap = "both"), y = guide_axis(cap = "both"))
highselect <- add_peak_annotation_gap(highselect, closed_A, open_A)Low selectivity
lowselect <- ggplot() +
geom_line(data = open_B, aes(x, y), color = "olivedrab4", linewidth = 1.5, lineend = "round") +
geom_line(data = closed_B, aes(x, y), color = "navy", linewidth = 1.5, lineend = "round") +
labs(x = "male trait", y = "female response") +
coord_cartesian(ylim = y_limits) +
theme_classic(base_size = 18) +
theme(
panel.grid = element_blank(),
axis.title.y = element_text(size = 18, vjust = -0.3),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_text(size=18),
panel.border = element_blank(),
axis.line = element_line(color = "black", linewidth = 0.9),
plot.title = element_text(face = "bold"),
plot.margin = margin(10, 10, 10, 10)
) +
guides(x = guide_axis(cap = "both"), y = guide_axis(cap = "both"))
lowselect <- add_peak_annotation_gap(lowselect, closed_B, open_B)Choosiness Demo (Fig 1B, main text)
Generate Data
fake_data <- data.frame(Variable_X = c(4, 22), Variable_Y = c(4, 22))
regression <- ggplot(fake_data, aes(x = Variable_X, y = Variable_Y)) +
geom_smooth(method = lm, se = FALSE, color = "darkslategrey", linewidth = 1.5, fill = "grey80", fullrange = FALSE) +
labs(
x = "effort",
y = "likelihood of obtaining\nthe preferred mate"
) +
# Truncate both lines dynamically using the theme's break markers
guides(x = guide_axis(cap = "both"), y = guide_axis(cap = "both")) +
# >>> FIX: Start the axis line at 3 (creating a gap at the corner) but run it to 27 <<<
scale_x_continuous(breaks = c(3, 25)) +
scale_y_continuous(breaks = c(3, 25)) +
theme_classic(base_size = 18) +
theme(
axis.text = element_blank(),
axis.title.y = element_text(size = 18, vjust = -0.3),
axis.ticks = element_blank(),
axis.line = element_line(color = "black", linewidth = 0.9)
) +
# Using expand = FALSE keeps the upper and right boundaries clean and flush
coord_equal(xlim = c(0, 27), ylim = c(0, 27), expand = FALSE)
regression <- regression +
scale_x_continuous(breaks = c(1.5, 25)) +
scale_y_continuous(breaks = c(1.5, 25))Amplexus Image (Fig 1C, main text)
amplexus <- ggdraw() + draw_image("C:/Users/olivi/OneDrive/Desktop/manuscripts/In process/Pair Matching MS/PairMatchingR/amplexus.jpg",
scale = 1.3, clip = "off")Data (Fig 1D, main text)
Selectivity
selectivity <- ggplot(PairMatchingR_F77, aes(x=Inverse_SelectivityNoFlat, y=TotalPulseDiff_Corr)) +
geom_point(shape=20, size=4, color="darkorange3",show.legend = FALSE, alpha = 0.5) +
theme_classic(base_size = 18) +
geom_smooth(method=lm, fullrange=FALSE, se=TRUE, level=0.95,color="darkorange3",
linewidth=1.5, fill="darkorange3")+
xlab("selectivity") + scale_x_continuous(breaks=seq(-2,5,1),limits=c(-2,5)) +
ylab("signal-preference match") + scale_y_continuous(breaks=seq(-25,15,5), limits = c(-25,15)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "black", linewidth=1) +
theme(
axis.text = element_text(size = 20),
axis.title.y = element_text(size = 18, vjust = -0.1)
) +
guides(x = guide_axis(cap = "both"), y = guide_axis(cap = "both")) 
Choosiness
choosy <- ggplot(PairMatchingR_F77, aes(x=Choosiness, y=TotalPulseDiff_Corr)) +
geom_point(shape=20, size=4, color="dodgerblue4", show.legend = FALSE, alpha = 0.5) +
theme_classic(base_size = 18) +
geom_smooth(method=lm, fullrange=FALSE, se=TRUE, level=0.95, color="dodgerblue4",
linewidth=1.5, fill="dodgerblue4") +
xlab("choosiness (dB)") + scale_x_continuous(breaks=seq(0,27,3)) +
ylab("signal-preference match") + scale_y_continuous(breaks=seq(-25,15,5), limits = c(-25,15)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "black", linewidth=1) +
theme(
axis.text = element_text(size = 20),
axis.title.y = element_text(size = 18, vjust = -0.15)
) +
guides(x = guide_axis(cap = "both"), y = guide_axis(cap = "both")) 
Merge and export
Merge panels
combofig <- ggarrange(
highselect, lowselect, # Row 1 (The two curve panels)
regression, amplexus, # Row 2 (The regression line and frog photo)
selectivity, choosy, # Row 3 (The bottom scatter plots)
labels = c("A", "", "B", "C", "D", ""), # Labels the left column panels cleanly
ncol = 3,
nrow = 2,
heights = c(1, 1.2),
align = "v",
font.label = list(size = 25, color = "black", face = "bold"))
Export figure
ggsave(filename = "combofig.tiff", dpi = 400, plot = combofig,
bg = "white",
device = "tiff",
width=35,
height=20,
units = "cm")