This page reports the analyses for the second experiment described in ‘Colour biases in learned foraging preferences in Trinidadian guppies.’ The code run to produce the results is included on the page along with explanations of what the code is doing and why. The raw R script to reproduce the data preparation, analysis, figures, and this page are in analysis-experiment-2.Rmd. Note the code blocks that produce the figures and tables are not shown on this page as they are rather long, however the code to produce the figures and tables can also be seen in analysis-experiment-2.Rmd. To get straight to the results go to the Models section. To see how to reproduce these results please visit the How to Reproduce the Results section of the README.
In this section we detail the steps taken to process the raw data produced by
processing video footage with automated tracking from Noldus EthoVision
(Noldus et al., 2001). The raw data can be found in the
data/experiment-2-raw-data/
directory. They are composed of .xlsx
files exported from EthoVision XT
Version 11. Each trial is in a separate .xlsx
file. The full processed data
are available as a .csv
file in the file
colour-learning-experiment-2-full-data.csv
.
Descriptions of the variables found in the data set are given in the
Experiment 2 Metadata section of
metadata.md
file.
To prepare the data first we download the raw data files from the Google Drive
folder they are stored in. We make use of the tidyverse package googledrive
to
do this. We put googledrive
into a de-authorized state so we can access public
Google Drive resources without a Google sign-in. We then get the list of files
that are present in the Google drive directory and use a for()
loop which
downloads each file using the drive_download()
function. The data are
downloaded to the
data/experiment-2-raw-data/
directory.
# Downloading data from Google drive
## Put googledrive into a de-authorized state
drive_deauth()
## Store link to data folder
data_folder_link <- "https://drive.google.com/drive/folders/1A8NRlBMQ-BfkgNHzEpmw6hEbgePJncLj?usp=sharing"
## Get id for data folder
data_folder_id <- drive_get(as_id(data_folder_link))
## Store the list of file names and ids found in the data folder
data_files <- drive_ls(data_folder_id)
## Loop through and download each file
for (file_x in 1:length(data_files$name)) {
drive_download(
as_id(data_files$id[file_x]),
path = str_c("data/experiment-2-raw-data/",data_files$name[file_x]),
overwrite = TRUE)
}
Next we read in and format the raw .xlsx
files from EthoVision which are in
data/experiment-2-raw-data/
using one of my custom functions,
read_and_format_ethovision_data()
. The code for this can be seen in
read-and-format-ethovision-data.R
.
# Reading in Data
full_data <- read_and_format_ethovision_data("data/experiment-2-raw-data/")
Next we add the rewarding object colour treatments to the correct guppy IDs that
were established a priori in
treatment-object-side-assignment.Rmd
.
The treatments are represented by the variable rewarding.object.colour
.
## Assigning treatments
full_data <- full_data %>%
mutate(
rewarding.object.colour =
case_when(
id == "1a" ~ "blue", id == "1b" ~ "green",
id == "2a" ~ "blue", id == "2b" ~ "blue",
id == "3a" ~ "blue", id == "3b" ~ "green",
id == "4a" ~ "green", id == "4b" ~ "green",
id == "5a" ~ "green", id == "5b" ~ "blue",
id == "6a" ~ "green", id == "6b" ~ "green",
id == "7a" ~ "blue", id == "7b" ~ "blue",
id == "8a" ~ "green", id == "8b" ~ "blue"
)
)
All the variables for the data set are read in as characters due to the
read_excel()
call in read_and_format_ethovision_data()
, so we need to
convert them to their appropriate data structures for the analysis. Variables
are converted to either factors or numerics where appropriate using the
lapply()
function which applies a function over a vector. We apply the
as.factor()
function to categorical variables identified in the Factors
vector and the as.numeric()
function to the numerical variables identified in
the Numerics
vector.
For the latency measures, dashes in the raw data sheet indicate that an
individual never visited the zone of interest. In being converted to numerics
these values are changed to NAs. We convert these values to the maximum value
which is the trial duration (300 seconds) using the tidyr
function
replace_na()
.
# Converting variables
## Factors
Factors <- c("ate", "id", "object.side", "rewarding.object.colour", "object.pair")
full_data[Factors] <- lapply(full_data[Factors], as.factor)
## Numeric
Numerics <- c(
"trial", "left.object.visits", "time.with.left.object",
"left.object.latency", "right.object.visits", "time.with.right.object",
"right.object.latency", "periphery.visits", "time.in.periphery",
"latency.to.periphery", "center.visits", "time.in.center",
"latency.to.center", "distance.moved", "mean.velocity"
)
full_data[Numerics] <- lapply(full_data[Numerics], as.numeric)
## Latency NA replacement
full_data <- full_data %>%
replace_na(
list(
left.object.latency = 300,
right.object.latency = 300,
latency.to.periphery = 300,
latency.to.center = 300
)
)
New variables and measures need to be created from the variables present in the
raw data sheets. We do this using the mutate()
and case_when()
functions
from the tidyverse package dplyr
. First we invert the object side because the
camera image is reversed from the perspective of the experimenter. We then
create the variables time.with.trained.object
and time.with.untrained.object
by identifying whether the left or right object is the reward object.
The preference metrics green.object.preference
and
rewarding.object.preference
are created by subtracting the time spent near the
blue object from the time spent near the green object and subtracting the time
spent near the untrained object from the time spent near the trained object
respectively.
time.with.both.objects
is obtained by summing the time spent near the left and
the right object. total.time
is obtained by summing the time.in.periphery
with the time.in.center
. total.time
should be close to 300 since trials
last 5 minutes (300 seconds).
We also create the variable trial.type
to identify whether a trial is a test
trial (unreinforced), training trial (reinforced), or refresher trial
(reinforced).
# Creating new variables
## Inverting object side
full_data <- full_data %>%
mutate(
reward.object.side =
as.factor(
case_when(
object.side == "left" ~ "right",
object.side == "right" ~ "left"
)
)
)
## Time with trained object
full_data <- full_data %>%
mutate(
time.with.trained.object =
case_when(
reward.object.side == "left" ~ time.with.left.object,
reward.object.side == "right" ~ time.with.right.object
)
)
## Time with untrained object
full_data <- full_data %>%
mutate(
time.with.untrained.object =
case_when(
reward.object.side == "left" ~ time.with.right.object,
reward.object.side == "right" ~ time.with.left.object
)
)
## Green object preference
full_data <- full_data %>%
mutate(
green.object.preference =
case_when(
rewarding.object.colour == "green" ~
time.with.trained.object - time.with.untrained.object,
rewarding.object.colour == "blue" ~
time.with.untrained.object - time.with.trained.object
)
)
## Rewarding object preference
full_data <- full_data %>%
mutate(
rewarding.object.preference =
time.with.trained.object - time.with.untrained.object
)
## Proportionanl Rewarding object preference
full_data <- full_data %>%
mutate(
prop.rewarding.object.preference =
time.with.trained.object / (time.with.trained.object + time.with.untrained.object)
)
## Time with both objects
full_data <- full_data %>%
mutate(
time.with.both.objects =
time.with.left.object + time.with.right.object
)
## Total time
full_data <- full_data %>%
mutate(
total.time =
time.in.center + time.in.periphery
)
## Trial type
full_data <- full_data %>%
mutate(
trial.type =
as.factor(
case_when(
trial == 0 | trial == 21 | trial == 23 |
trial == 25 | trial == 27 | trial == 29 ~ "test",
trial > 0 & trial < 21 ~ "training",
trial == 22 | trial == 24 | trial == 26 | trial == 28 ~ "refresher"
)
)
)
We now create a variable which establishes how many trials an individual guppy
fed in during the 20 training trials. We do this by creating a variable called
fed
which can be either True or False. Every time ate
, the variable which
indicates whether an individual ate during that trial or not, is equal to yes
fed is set to True. When this is not the case fed is set to False. We then
retrieve only the rows of fed which have fed set to True. We remove the column
fed to keep only the counts. We then add the feeding values to the full data
set. We end by extracting a smaller data set that contains only the variables
id
, feeding.count
, and rewarding.object.colour
treatment which will be
used for model 4.
# Group by ID and count the number of sessions in which an individual ate during training
feeding <- full_data %>%
filter(trial.type == "training") %>%
group_by(id) %>%
count(fed = ate == "yes")
# Count only the yeses
feeding <- feeding %>%
filter(fed == "TRUE")
# Remove the column feeding.count to keep only the counts
feeding <- feeding %>%
dplyr::select(-fed)
# Add the feeding values to the main data frame so I can get treatment IDs
full_data <- left_join(full_data, feeding, by = "id") %>%
replace_na(list(n = 0)) %>%
rename(training.feeding.count = n)
# Extract id, feeding count, and rewarding object colour treatment
feeding_data <- full_data %>%
filter(trial == 0) %>%
dplyr::select(id, training.feeding.count, rewarding.object.colour)
After trial 21 all guppies were weighed. In the next chunk of code we programmatically assign the weights (measured in grams) to their respective guppy IDs.
## Assigning weights
full_data <- full_data %>%
mutate(
weight =
case_when(
id == "1a" ~ 0.29, id == "1b" ~ 0.10,
id == "2a" ~ 0.20, id == "2b" ~ 0.11,
id == "3a" ~ 0.20, id == "3b" ~ 0.12,
id == "4a" ~ 0.21, id == "4b" ~ 0.11,
id == "5a" ~ 0.18, id == "5b" ~ 0.13,
id == "6a" ~ 0.15, id == "6b" ~ 0.11,
id == "7a" ~ 0.31, id == "7b" ~ 0.13,
id == "8a" ~ 0.17, id == "8b" ~ 0.14
)
)
Finally we export the full data set as a .csv
file to future proof the full
data sheet in a plain text, machine-readable format. row.names
is set to
FALSE
so that the index column is not exported into the .csv
file.
write.csv(full_data,
file = "data/colour-learning-experiment-2-full-data.csv",
row.names = FALSE)
For our analyses we made the decision to omit an individual that did not feed throughout all reinforced trials. This fish appeared otherwise normal and healthy but did not eat in any of the 20 training trials and also did not eat in any of the 4 refresher trials which is quite aberrant behaviour. We therefore believe that data from this individual is not likely to be informative as the fish has not participated in the experiment in a meaningful way.
full_data <- full_data %>% filter(training.feeding.count > 0)
To conduct the analyses we planned, we create subsets of the full data set that
are restricted to the training trials (reinforced), the test trials
(unreinforced), and the initial test trial (unreinforced) using the filter()
function from dplyr
. We change trial to a factor for the unreinforced test
trial data subset since we are interested in comparing the levels of trial to
each other rather than looking at differences in trends like we are with the
larger training data subset. Trial in the training data subset is coded as
integer to allow us to look at trends in the shift of rewarding object
preference during training.
# Restrict data to only the baseline data
baseline_data <- full_data %>%
filter(trial == 0)
# Restrict data to training data
training_data <- full_data %>%
filter(trial.type == "training")
# Restrict data to only the baseline and re-test data
test_data <- full_data %>%
filter(trial.type == "test")
# Change trial to factor for test trials
test_data$trial <- as.factor(test_data$trial)
# Change trial to integer for training trials
training_data$trial <- as.integer(training_data$trial)
This script will generate figures but to store them we need to create specific
directories that have been hard coded into the script. We create the figs/
directory and all the subdirectories within it using the next line of code. Now
all figures that are created in this script are accessible as individual files
in the figs/
directory. If this script is run multiple times it will return a
warning saying that the directory already exists. However, this is not
problematic since the figures are always regenerated by running the script so we
set showWarnings
to FALSE
. Every figure seen on this page will be available
as an individual file in the figs/
directory if one runs all the code chunks
of analysis-experiment-2.Rmd
.
dir.create(file.path("figs/exp-2/exp-2-residual-plots"),
recursive = TRUE,
showWarnings = FALSE)
We analysed the data from our experiment using linear, linear mixed effect,
generalized linear mixed effect, and generalized linear models with the lm()
,
lmer()
, glmmTMB()
, and glm.nb()
functions from the stats
, lme4
,
glmmTMB
, and MASS
packages respectively. P-values and effective degrees of
freedom were obtained using the lmerTest
package which uses Satterthwaite’s
degrees of freedom method (Kuznetsova et al., 2017). Model
residuals were checked they met distributional assumptions with the DHARMa
package. The ‘See Model Residuals’ button below the model formulas can be
clicked to see the residual diagnostic plots produced by DHARMa
for that
particular model.
This first model contains the data for all individual guppies during the initial
test. We looked at the green object preference of all guppies in an intercept
only model to see if the green object preference at baseline was significantly
different from zero. green.object.preference
is the time spent near the green
object subtracted by the time spent near the blue object.
baseline_data_model <-
lm(green.object.preference ~ 1,
data = baseline_data
)
simulationOutput <- simulateResiduals(fittedModel = baseline_data_model)
plot(simulationOutput)
# Saving plot to figs directory
ggsave(
filename = "exp-2-model-1-residual-plot.png",
plot = (plot(simulationOutput)),
path = "figs/exp-2/exp-2-residual-plots",
device = "png",
dpi = 300
)
Factor | Estimate | Std. Error | T statistic | P value |
---|---|---|---|---|
Intercept | 1.201 | 3.884 | 0.309 | 0.762 |
Before training began, there was no significant difference in the time spent near the green versus the blue object across all guppies (green object preference: 1 ± 4 seconds, p = 0.762).
To see how fish behaved during training our second model asks whether the preference for the rewarding object changes throughout training and whether the change in rewarding object preference is different between the treatments.
training_data_model <-
lmer(rewarding.object.preference ~ trial * rewarding.object.colour + (1 | id),
data = training_data
)
# Residual diagnostics
simulationOutput <- simulateResiduals(
fittedModel = training_data_model,
n = 1000
)
plot(simulationOutput)
# Saving plot to figs directory
ggsave(
filename = "exp-2-model-2-residual-plot.png",
plot = (plot(simulationOutput)),
path = "figs/exp-2/exp-2-residual-plots",
device = "png",
dpi = 300
)
There is a slight deviation in the lower quantile but no indication in the residual plot of a gross model misfit.
Factor | Estimate | Std. Error | T statistic | df | P value |
---|---|---|---|---|---|
Intercept | 72.349 | 25.517 | 2.835 | 32.032 | 0.008 |
Reward object colour | 5.917 | 1.474 | 4.015 | 283.000 | < .001 |
Trial | -45.940 | 34.940 | -1.315 | 32.032 | 0.198 |
Rewarding object colour X Trial | 5.381 | 2.018 | 2.666 | 283.000 | 0.008 |
There was a significant interaction effect between trial and rewarding object
colour (5 ± 2
seconds, p = 0.008) indicating that the
change in rewarding object preference has a different trend depending on the
rewarding object colour. We used the emtrends()
function from emmeans
to
estimate and compare the trends.
training_data_model_trends <-
emtrends(training_data_model,
pairwise ~ rewarding.object.colour,
var = "trial"
)
Rewarding object colour | Trial trend | Std. Error | df | Lower CL | Upper CL | T Ratio | P Value |
---|---|---|---|---|---|---|---|
blue | 5.917 | 1.474 | 283 | 3.016 | 8.819 | 4.015 | < .001 |
green | 11.298 | 1.379 | 283 | 8.585 | 14.012 | 8.195 | < .001 |
Guppies that were trained to green objects increased their relative preference for rewarding objects by 11.3 seconds on average each trial whereas guppies trained to blue objects increased their relative preference for rewarding objects by 5.9 seconds on average each trial. Thus, while both groups increased their preference for their respective rewarding objects over training, green trained guppies increased their preference at a rate that was 1.9x faster than blue trained guppies (Figure 2).
To determine whether learning had occurred we used the initial preference for
the rewarding object colour as a control and compared each probe test trial to
this control trial for each treatment. To do so we fit a generalized linear
mixed effects model with a Gaussian distribution with fixed effects of trial and
rewarding object colour (green versus blue), a random effect of individual
identity, and a response variable of rewarding object preference using the
package glmmTMB
.
To control for heterogeneous variance across trials we additionally modelled the
variance due to trial.
test_data_model_glm <-
glmmTMB(rewarding.object.preference ~
trial * rewarding.object.colour + (1 |id) +
diag(0 + trial |id),
data = test_data,
family = gaussian
)
simulationOutput <- simulateResiduals(fittedModel = test_data_model_glm, n = 1000)
plot(simulationOutput)
# Saving plot to figs directory
ggsave(
filename = "exp-2-model-3-residual-plot.png",
plot = (plot(simulationOutput)),
path = "figs/exp-2/exp-2-residual-plots/",
device = "png",
dpi = 300
)
Given our factor trial
has more than two levels, six in this case, we produced
an ANOVA table for our model. We used the Anova()
function from the car
package to produce a type-III ANOVA table based on Wald chi-square tests for
Model 3.
car::Anova(test_data_model_glm, type = "III")
Factor | Chisq | Df | P Value |
---|---|---|---|
Intercept | 3.237 | 1 | 0.072 |
Trial | 15.706 | 5 | 0.008 |
Rewarding object colour | 0.256 | 1 | 0.613 |
Trial X Rewarding object colour | 16.191 | 5 | 0.006 |
There is an overall interaction effect between trial and rewarding object colour for the test trials (p = 0.006). To investigate the interaction effect and determine where the differences in performance were apparent we conducted treatment versus control post-hoc tests. Here we compared the estimated marginal means of rewarding object preference for each post-training test trial to the estimated marginal mean of the initial rewarding object preference for each rewarding object colour respectively to establish whether learning had occurred. Learning was assumed to have occurred if the change in preference between the initial trial (serving as the control) and the test trial was significant. We used a multivariate t adjustment to correct p values in light of multiple comparisons (Hothorn et al., 2008). Since the multivariate t adjustment is simulation based we set a random seed to produce consistent confidence intervals upon re-running the code.
set.seed(123)
test_data_model_emmeans <- emmeans(test_data_model_glm,
specs = trt.vs.ctrl ~ rewarding.object.colour:trial,
adjust = "mvt",
by = "rewarding.object.colour")
Contrast | Rewarding object colour | Estimate | Std. Error | df | Lower CL | Upper CL | T ratio | P Value |
---|---|---|---|---|---|---|---|---|
Probe 1 - Initial | blue | 47.430 | 14.804 | 70 | 8.413 | 86.447 | 3.204 | 0.01 |
Generalization 1 - Initial | blue | 28.855 | 17.720 | 70 | -17.846 | 75.557 | 1.628 | 0.426 |
Generalization 2 - Initial | blue | 14.067 | 21.155 | 70 | -41.687 | 69.820 | 0.665 | 0.969 |
Probe 2 - Initial | blue | 16.664 | 20.970 | 70 | -38.603 | 71.931 | 0.795 | 0.935 |
Odour - Initial | blue | 28.317 | 11.819 | 70 | -2.831 | 59.466 | 2.396 | 0.091 |
Probe 1 - Initial | green | 47.507 | 13.848 | 70 | 11.013 | 84.001 | 3.430 | 0.005 |
Generalization 1 - Initial | green | 13.550 | 16.576 | 70 | -30.131 | 57.231 | 0.817 | 0.928 |
Generalization 2 - Initial | green | 73.577 | 19.788 | 70 | 21.429 | 125.725 | 3.718 | 0.002 |
Probe 2 - Initial | green | 50.276 | 19.616 | 70 | -1.417 | 101.969 | 2.563 | 0.06 |
Odour - Initial | green | 81.804 | 11.055 | 70 | 52.670 | 110.938 | 7.399 | < .001 |
We also computed simple contrasts for the estimated marginal means of the rewarding object preference between green-trained guppies and blue-trained guppies within the same test trial to see if performance significantly differed between the two groups during a test trial.
test_data_simple_contrasts <- contrast(test_data_model_emmeans$emmeans,
method = "revpairwise",
simple = "rewarding.object.colour")
Contrast | Trial | Estimate | Std. Error | df | Lower CL | Upper CL | T ratio | P Value |
---|---|---|---|---|---|---|---|---|
Green - Blue | Initial | 3.339 | 6.597 | 70 | -9.819 | 16.496 | 0.506 | 0.614 |
Green - Blue | Probe 1 | 3.415 | 19.168 | 70 | -34.815 | 41.645 | 0.178 | 0.859 |
Green - Blue | Generalization 1 | -11.967 | 23.350 | 70 | -58.538 | 34.604 | -0.513 | 0.61 |
Green - Blue | Generalization 2 | 62.849 | 28.206 | 70 | 6.594 | 119.104 | 2.228 | 0.029 |
Green - Blue | Probe 2 | 36.950 | 27.947 | 70 | -18.787 | 92.688 | 1.322 | 0.19 |
Green - Blue | Odour | 56.826 | 14.778 | 70 | 27.352 | 86.300 | 3.845 | < .001 |
Finally we compared the mean for each colour group in each test trial against zero to see if the preference for the rewarding object was significantly different from zero within a test trial.
emmeans(test_data_model_glm,
specs = ~ rewarding.object.colour:trial,
adjust = "mvt")
Rewarding object colour | Trial | Estimate | Std. Error | df | Lower CL | Upper CL | T ratio | P Value |
---|---|---|---|---|---|---|---|---|
blue | Initial | -8.668 | 4.818 | 70 | -22.874 | 5.538 | -1.799 | 0.596 |
green | Initial | -5.329 | 4.507 | 70 | -18.618 | 7.959 | -1.183 | 0.957 |
blue | Probe 1 | 38.762 | 13.999 | 70 | -2.515 | 80.039 | 2.769 | 0.081 |
green | Probe 1 | 42.177 | 13.095 | 70 | 3.566 | 80.788 | 3.221 | 0.023 |
blue | Generalization 1 | 20.187 | 17.053 | 70 | -30.094 | 70.469 | 1.184 | 0.956 |
green | Generalization 1 | 8.220 | 15.951 | 70 | -38.814 | 55.255 | 0.515 | 1 |
blue | Generalization 2 | 5.399 | 20.599 | 70 | -55.339 | 66.136 | 0.262 | 1 |
green | Generalization 2 | 68.247 | 19.268 | 70 | 11.432 | 125.063 | 3.542 | 0.008 |
blue | Probe 2 | 7.996 | 20.409 | 70 | -52.183 | 68.175 | 0.392 | 1 |
green | Probe 2 | 44.947 | 19.091 | 70 | -11.346 | 101.239 | 2.354 | 0.222 |
blue | Odour | 19.649 | 10.792 | 70 | -12.173 | 51.472 | 1.821 | 0.579 |
green | Odour | 76.475 | 10.095 | 70 | 46.708 | 106.242 | 7.575 | < .001 |
Both rewarding object colour treatments showed evidence of having learned during the first probe trial. Blue-trained guppies significantly increased their preference for the rewarding object by 47 seconds (p = 0.01, 95% CI [8, 86]) and green-trained guppies significantly increased their preference for the rewarding object by 48 seconds (p = 0.005, 95% CI [11, 84]). There is no difference in performance between the two colour treatments in this test (p = 0.859, 95% CI [-35, 42]). Green-trained guppies have a rewarding object preference that differs significantly from zero (p = 0.023) but blue-trained guppies do not (p = 0.081).
Neither group displayed evidence of generalizing the learned colour preference to a Lego object with a darker blue or green colouration (blue: p = 0.426, 95% CI [-18, 76], green: p = 0.928, 95% CI [-30, 57]) and the groups did not perform differently on this test (p = 0.61, 95% CI [-59, 35]). Neither green-trained nor blue-trained guppies have a rewarding object preference that differs significantly from zero: (green: p = 1 ; blue: p = 0.956).
Green-trained guppies showed evidence of generalizing their learned preference to a non-Lego clay object (p = 0.002, 95% CI [21, 126]), displaying a change in preference of 74 seconds whereas blue-trained guppies did not show evidence of a learned preference (p = 0.969, 95% CI [-42, 70]). There is a significant difference in performance between the two colour treatments in this test with green-trained guppies displaying a superior performance over blue-trained guppies (p = 0.029, 95% CI [7, 119]). Green-trained guppies have a rewarding object preference that differs significantly from zero (p = 0.008) but blue-trained guppies do not (p = 1).
For the second probe test to see if the learned preference would habituate with a repeated test, green-trained guppies displayed limited evidence of having retained their learned preference maintaining a shift in preference of 50 seconds (p = 0.06, 95% CI [-1, 102]) but blue-trained guppies did not (p = 0.935, 95% CI [-39, 72]). Green-trained guppies do not significantly outperform blue-trained guppies in this test (p = 0.19, 95% CI [-19, 93]). Neither green-trained nor blue-trained guppies have a rewarding object preference that differs significantly from zero (green: p = 0.222; blue: p = 1).
For the odour test green-trained guppies showed evidence of learning, displaying a shift in preference of 82 seconds (p < .001, 95% CI [53, 111]) but blue-trained guppies did not (p = 0.091, 95% CI [-3, 59]) displaying a non-significant shift of 28 seconds. There is a significant difference in performance between the two colour treatments in this test with green-trained guppies displaying a superior performance over blue (p < .001, 95% CI [27, 86]). Green-trained guppies have a rewarding object preference that differs significantly from zero (p < .001) but blue-trained guppies do not (p = 0.579).
Thus, in three out of five post-training test trials green-trained guppies showed evidence of learning while blue-trained guppies show evidence of learning in only one out of five test trials with this trial being the very first probe trial after training. Additionally, in three out of five post-training test trials, green-trained guppies show a preference for their rewarding object that is significantly different from chance whereas blue-trained guppies never display a rewarding object preference that is significantly different from chance. Moreover, in two out of five test trials green-trained guppies outperform blue-trained guppies. Meanwhile blue-trained guppies never outperform green-trained guppies.
A discrepancy in reinforcement between treatments may influence performance on a final preference test. To see whether there was a difference in feeding between treatments we counted the number of trials in which an individual fish ate throughout all of training and compared the feeding counts between treatments. To do this we fit a generalized linear model with a negative binomial distribution. The response variable ‘feeding count’ is a sum of the number of trials in which a guppy ate.
feeding_data_model <-
glm.nb(training.feeding.count ~ rewarding.object.colour,
data = feeding_data %>% filter(training.feeding.count > 0)
)
simulationOutput <- simulateResiduals(fittedModel = feeding_data_model)
plot(simulationOutput)
# Saving plot to figs directory
ggsave(
filename = "exp-2-model-4-residual-plot.png",
plot = (plot(simulationOutput)),
path = "figs/exp-2/exp-2-residual-plots/",
device = "png",
dpi = 300
)
Factor | Estimate | Std. Error | T statistic | P value |
---|---|---|---|---|
Intercept | 2.745 | 0.114 | 24.004 | 0.000 |
Rewarding object colour | -0.089 | 0.159 | -0.558 | 0.577 |
We found no significant difference in the number of trials individuals fed between green-rewarded and blue-rewarded fish (Figure 4, p = 0.577).
A reviewer of our manuscript asks
Why the authors did not (also) exploit a percentage preference, which is commonly used?
To determine whether our results are robust despite our different measure we also ran an analysis with the percentage preference as an ESM Model. The main pattern of results from the main experiment remain robust when we do this with slight differences.
Since our data are continuous proportions we used a generalized linear mixed effect model with a beta distribution to model these data. Beta distributions do not accept 0s and 1s and, in our 90 data points, we had a single occurrence (Trial 23, Generalization 1, individual 2a) of an individual spending 100% of their time spent near an object near one object. A common transformation is to convert 0s to 0.001 and 1s to 0.999 to control for this and thus we converted this value of 1 to 0.999 to meet distributional assumptions.
prop_test_data_model_glm <-
glmmTMB(prop.rewarding.object.preference ~
trial * rewarding.object.colour + (1|id),
data = test_data %>%
mutate(
prop.rewarding.object.preference =
case_when(
prop.rewarding.object.preference == 1 ~ 0.999,
prop.rewarding.object.preference != 1 ~ prop.rewarding.object.preference
)
),
family = beta_family(link="logit")
)
simulationOutput <- simulateResiduals(fittedModel = prop_test_data_model_glm)
plot(simulationOutput)
# Saving plot to figs directory
ggsave(
filename = "exp-2-ESM-model-1-residual-plot.png",
plot = (plot(simulationOutput)),
path = "figs/exp-2/exp-2-residual-plots/",
device = "png",
dpi = 300
)
We once again produce a type-III ANOVA table based on Wald chi-square tests, this time for ESM Model 1.
car::Anova(prop_test_data_model_glm, type = "III")
Factor | Chisq | Df | P Value |
---|---|---|---|
Intercept | 0.807 | 1 | 0.369 |
Trial | 12.041 | 5 | 0.034 |
Rewarding object colour | 0.101 | 1 | 0.751 |
Trial X Rewarding object colour | 14.021 | 5 | 0.015 |
As in Model 3 we find there there is an interaction effect between trial and rewarding object colour for the test trials (p = 0.015). We again conduct post-hoc tests as described in the Model 3 section.
prop_test_data_model_emmeans <- emmeans(prop_test_data_model_glm,
specs = trt.vs.ctrl ~ rewarding.object.colour:trial,
adjust = "mvt",
by = "rewarding.object.colour")
Contrast | Rewarding object colour | Estimate | Std. Error | df | T ratio | P Value |
---|---|---|---|---|---|---|
Probe 1 - Initial | blue | 0.645 | 0.339 | 76 | 1.903 | 0.217 |
Generalization 1 - Initial | blue | 1.137 | 0.352 | 76 | 3.234 | 0.008 |
Generalization 2 - Initial | blue | 0.254 | 0.337 | 76 | 0.753 | 0.913 |
Probe 2 - Initial | blue | 0.381 | 0.336 | 76 | 1.134 | 0.685 |
Odour - Initial | blue | 0.467 | 0.338 | 76 | 1.382 | 0.508 |
Probe 1 - Initial | green | 0.651 | 0.318 | 76 | 2.048 | 0.164 |
Generalization 1 - Initial | green | 0.254 | 0.314 | 76 | 0.809 | 0.889 |
Generalization 2 - Initial | green | 0.892 | 0.322 | 76 | 2.767 | 0.03 |
Probe 2 - Initial | green | 0.748 | 0.319 | 76 | 2.344 | 0.086 |
Odour - Initial | green | 1.080 | 0.328 | 76 | 3.289 | 0.007 |
Finally we compared the mean for each colour group in each test trial against chance to see if the preference for the rewarding object was significantly different from 50% within a test trial.
Rewarding object colour | Trial | Estimate | Std. Error | df | Lower CL | Upper CL | T ratio | P Value |
---|---|---|---|---|---|---|---|---|
blue | Initial | 0.445 | 0.061 | 76 | 0.281 | 0.623 | -0.898 | 0.995 |
green | Initial | 0.472 | 0.057 | 76 | 0.314 | 0.635 | -0.501 | 1.000 |
blue | Probe 1 | 0.605 | 0.059 | 76 | 0.425 | 0.760 | 1.722 | 0.656 |
green | Probe 1 | 0.631 | 0.054 | 76 | 0.463 | 0.773 | 2.299 | 0.248 |
blue | Generalization 1 | 0.714 | 0.054 | 76 | 0.534 | 0.845 | 3.460 | 0.011 |
green | Generalization 1 | 0.535 | 0.057 | 76 | 0.370 | 0.692 | 0.613 | 1.000 |
blue | Generalization 2 | 0.508 | 0.061 | 76 | 0.335 | 0.680 | 0.138 | 1.000 |
green | Generalization 2 | 0.685 | 0.052 | 76 | 0.518 | 0.815 | 3.246 | 0.021 |
blue | Probe 2 | 0.540 | 0.060 | 76 | 0.365 | 0.706 | 0.662 | 1.000 |
green | Probe 2 | 0.653 | 0.053 | 76 | 0.486 | 0.790 | 2.695 | 0.097 |
blue | Odour | 0.561 | 0.060 | 76 | 0.384 | 0.724 | 1.007 | 0.987 |
green | Odour | 0.724 | 0.049 | 76 | 0.559 | 0.845 | 3.901 | 0.002 |
For full results see Table 6. With the proportional data we again find an overall interaction effect between trial and rewarding object colour (p = 0.015) find that there is no strong evidence for learning on the first probe test trial for both colour treatments (blue: p = 0.217, green: p = 0.164). This differs from the original model in which both groups displayed evidence of having learned the association.
We find in the proportional data model that blue-trained guppies displayed evidence of generalizing their colour preference to a Lego object of a similar colour (p = 0.008) but green-trained guppies do not (p = 0.889). In our original model neither group displayed evidence of generalizing the learned colour preference to a Lego object with a different blue and green colouration.
The pattern of results is the same between both models for the second generalization trial where guppies were tested to see whether they could generalize the colour prefernce to a non-Lego clay object. Green-trained guppies showed evidence of generalizing their learned preference to a non-Lego clay object (p = 0.03), displaying a change in preference of 21% whereas blue-trained guppies did not show evidence of a learned preference (p = 0.913).
For the second probe test to see if the learned preference would habituate with a repeated test the pattern of results between both models is the same. Green-trained guppies display limited evidence of having retained their learned preference maintaining a non-significant shift in preference of 18% (p = 0.086) but blue-trained guppies do not (p = 0.685).
The odour test displays the same pattern of results as in the original model green-trained guppies showed evidence of learning, displaying a shift in preference of 25% (p = 0.007) but blue-trained guppies did not (p = 0.508).
Thus, in this proportional data model green-trained guppies showed evidence of learning in two out of five test trials while blue-trained guppies again show evidence of learning in one out of five test trials, albeit a different test trial. However, the trend for green to consistently outperform blue is maintained in the effect sizes (Figure 5).
To determine whether guppies were treating object pairs differently from each other during training (e.g., avoiding larger object pairs), we asked whether there was a difference in rewarding object preference among the object pairs across all of the 20 training trials. To do this we fit a linear mixed effects model with a response variable of rewarding object preference and a fixed effect of the factor object pair. We then produced a type 3 ANOVA table of the model.
object_pair_model <-
lmer(rewarding.object.preference ~ object.pair + (1 | id),
data = training_data
)
simulationOutput <- simulateResiduals(fittedModel = object_pair_model)
plot(simulationOutput)
# Saving plot to figs directory
ggsave(
filename = "exp-2-ESM-model-2-residual-plot.png",
plot = (plot(simulationOutput)),
path = "figs/exp-2/exp-2-residual-plots/",
device = "png",
dpi = 300
)
There is a significant deviation from uniformity as indicated by the significant Kolmogorov-Smirnov test. However, this model has a particularly large sample size (n = 300) so even slight deviations will be significant. Looking at the effect size of the deviation (D = 0.094) shows that it is minor (D < 0.1) and visual inspection does not suggest large deviations in the residuals so our model is still appropriate.
car::Anova(object_pair_model, type = "III")
Factor | Chisq | Df | P Value |
---|---|---|---|
Intercept | 53.659 | 1 | 0.000 |
Object pair | 3.565 | 3 | 0.312 |
We find no evidence that guppies spent a different amount of time near a rewarding object based on which object pair it came from (p = 0.312). Plotting the data reveals a slight trend for guppies to spend more time near object pair 4 (Figure 6A). However, we note that object pair 4 is the only object pair to have 4 out of 5 of its presentations after the halfway mark of training (trial 10, Figure 6B). This means guppies were much more experienced with the colour association task by the time object pair 4 began regularly appearing and likely explains the slightly higher rewarding object preference for trials where object pair 4 is present.
We only need one trial in order to have the data needed to compare the weights of the groups so we arbitrarily pick trial 0.
weight_data <- full_data %>% filter(trial == 0)
The weights ranged from 0.1 to 0.31 grams. Guppies weighed on average 0.17 grams. Blue-trained guppies tended to weigh more than green-trained guppies (0.2 grams vs 0.14 grams) but this difference was not statistically significant when investigated with a linear model (Table 9).
Factor | Estimate | Std. Error | T statistic | P value |
---|---|---|---|---|
Intercept | 0.196 | 0.023 | 8.421 | 0.000 |
Rewarding object colour | -0.052 | 0.032 | -1.633 | 0.126 |
The analyses on this page were done with R version 3.6.2 (2019-12-12) and with functions
from packages listed in Table 10. This page was written in
Rmarkdown and rendered with knitr
. In Table 10 we provide a
list of packages used, their versions, and references. Note this list does not
include the dependencies of these packages, it includes only packages
explicitly loaded with a library()
call. Installing these packages would
automatically install all their dependencies but to see the full list of
dependencies for all packages used as well as their versions please visit the
metadata
section of the README.
Package | Version | Reference |
---|---|---|
broom | 0.5.5 | David Robinson and Alex Hayes (2020). broom: Convert Statistical Analysis Objects into Tidy Tibbles. R package version 0.5.5. https://CRAN.R-project.org/package=broom |
broom.mixed | 0.2.6 | Ben Bolker and David Robinson (2020). broom.mixed: Tidying Methods for Mixed Models. R package version 0.2.6. https://CRAN.R-project.org/package=broom.mixed |
DHARMa | 0.3.3.0 | Florian Hartig (2020). DHARMa: Residual Diagnostics for Hierarchical (Multi-Level / Mixed) Regression Models. R package version 0.3.3.0. http://florianhartig.github.io/DHARMa/ |
dplyr | 1.0.3 | Hadley Wickham, Romain François, Lionel Henry and Kirill Müller (2021). dplyr: A Grammar of Data Manipulation. R package version 1.0.3. https://CRAN.R-project.org/package=dplyr |
emmeans | 1.5.1 | Russell Lenth (2020). emmeans: Estimated Marginal Means, aka Least-Squares Means. R package version 1.5.1. https://CRAN.R-project.org/package=emmeans |
ggplot2 | 3.3.3 | H. Wickham. ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York, 2016. |
ggpubr | 0.2.5 | Alboukadel Kassambara (2020). ggpubr: ‘ggplot2’ Based Publication Ready Plots. R package version 0.2.5. https://CRAN.R-project.org/package=ggpubr |
glmmTMB | 1.0.0 | Mollie E. Brooks, Kasper Kristensen, Koen J. van Benthem, Arni Magnusson, Casper W. Berg, Anders Nielsen, Hans J. Skaug, Martin Maechler and Benjamin M. Bolker (2017). glmmTMB Balances Speed and Flexibility Among Packages for Zero-inflated Generalized Linear Mixed Modeling. The R Journal, 9(2), 378-400. |
googledrive | 1.0.1 | Lucy D’Agostino McGowan and Jennifer Bryan (2020). googledrive: An Interface to Google Drive. R package version 1.0.1. https://CRAN.R-project.org/package=googledrive |
knitr | 1.30 | Yihui Xie (2020). knitr: A General-Purpose Package for Dynamic Report Generation in R. R package version 1.30. |
lme4 | 1.1.21 | Douglas Bates, Martin Maechler, Ben Bolker, Steve Walker (2015). Fitting Linear Mixed-Effects Models Using lme4. Journal of Statistical Software, 67(1), 1-48. doi:10.18637/jss.v067.i01. |
lmerTest | 3.1.1 | Kuznetsova A, Brockhoff PB, Christensen RHB (2017). “lmerTest Package:Tests in Linear Mixed Effects Models.” Journal of StatisticalSoftware, 82(13), 1-26. doi: 10.18637/jss.v082.i13 (URL:https://doi.org/10.18637/jss.v082.i13). |
magrittr | 2.0.1 | Stefan Milton Bache and Hadley Wickham (2020). magrittr: A Forward-Pipe Operator for R. R package version 2.0.1. https://CRAN.R-project.org/package=magrittr |
MASS | 7.3.51.4 | Venables, W. N. & Ripley, B. D. (2002) Modern Applied Statistics with S. Fourth Edition. Springer, New York. ISBN 0-387-95457-0 |
Matrix | 1.2.18 | Douglas Bates and Martin Maechler (2019). Matrix: Sparse and Dense Matrix Classes and Methods. R package version 1.2-18. https://CRAN.R-project.org/package=Matrix |
R | 3.6.2 | R Core Team (2019). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/. |
report | 0.2.0 | Makowski, D., Ben-Shachar, M.S., Patil, I. & Lüdecke, D. (2020). Automated reporting as a practical tool to improve reproducibility and methodological best practices adoption. CRAN. Available from https://github.com/easystats/report. doi: . |
rmarkdown | 2.6.4 | JJ Allaire and Yihui Xie and Jonathan McPherson and Javier Luraschi and Kevin Ushey and Aron Atkins and Hadley Wickham and Joe Cheng and Winston Chang and Richard Iannone (2021). rmarkdown: Dynamic Documents for R. R package version 2.6.4. URL https://rmarkdown.rstudio.com. |
stringr | 1.4.0 | Hadley Wickham (2019). stringr: Simple, Consistent Wrappers for Common String Operations. R package version 1.4.0. https://CRAN.R-project.org/package=stringr |
tidyr | 1.0.2 | Hadley Wickham and Lionel Henry (2020). tidyr: Tidy Messy Data. R package version 1.0.2. https://CRAN.R-project.org/package=tidyr |