Analysis of Behaviour for Trust Myself or Trust My Friends? Exploring the Effect of Sex on Social Information Use in Poecilia wingei
2025-05-05
This code analyzes data from male and female Endler guppies exposed to cues of risk (predator cue + alarm cue) in the presence or absence of social groups. Individuals assigned to the “Alone” treatment were placed in a tank next to an empty treatment tank. Individuals assigned to the “Social” treatment were placed in a tank next to a treatment tank with 3 unfamilar same-sex conspecifics. Individuals were recorded for 10 minutes before risk cues were elicited, with minutes 5-10 being considered “baseline” and further recorded for an additional 35 minutes (encompassing Acute-Trial30 stages, 0-2100 seconds) after receipt of cues of risk (0.75 mL of fresh predator cue, 0.75 mL of alarm cue).
Specifically this code analyzes behaviours of activity, measured in bodylengths the individual fish moved over a given time period and proportion of time spent in the upper portion of the tank. This was compared between treatment and sex and stage as time in seconds of baseline and trial periods.
##Clear enviroment
rm(list=ls())##Library loading
#load necessary libraries
library(librarian)
shelf(tidyverse, magrittr, lmerTest, ggpubr, MuMIn, emmeans, rstatix, sjPlot, lsr,mgcv,glm2,patchwork)##
## The 'cran_repo' argument in shelf() was not set, so it will use
## cran_repo = 'https://cran.r-project.org' by default.
##
## To avoid this message, set the 'cran_repo' argument to a CRAN
## mirror URL (see https://cran.r-project.org/mirrors.html) or set
## 'quiet = TRUE'.Behaviour Analysis
#import file
data1 <- read_csv("BehaviourSB.csv")#Checking structure and turning characters into factors as necessary for factor analysis
str(data1)## 'data.frame': 496 obs. of 9 variables:
## $ ID : int 1 1 1 1 1 1 1 1 2 2 ...
## $ Group : int 1 1 1 1 1 1 1 1 1 1 ...
## $ Sex : chr "F" "F" "F" "F" ...
## $ Treatment : chr "Social" "Social" "Social" "Social" ...
## $ Stage : chr "Acute" "Baseline" "Trial" "Second5" ...
## $ PropUp : num 0 0.321 0.192 0.182 0.229 ...
## $ PropFloor : num 0.8589 0.0434 0.4614 0.421 0.4931 ...
## $ Bodylengths.cm.: num 1.14 1.14 1.14 1.14 1.14 ...
## $ center_dist_BL : num 56.3 189 125.3 200.5 224.8 ...#Converting all characters to factors
data1 %<>%
mutate(across(where(is_character), as_factor)) -> data1
data1 %>%
mutate(ID = as.factor(ID)) %>%
mutate(Group = as.factor(Group)) -> data1
str(data1)## 'data.frame': 496 obs. of 9 variables:
## $ ID : Factor w/ 62 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 2 2 ...
## $ Group : Factor w/ 18 levels "1","3","4","5",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ Sex : Factor w/ 2 levels "F","M": 1 1 1 1 1 1 1 1 1 1 ...
## $ Treatment : Factor w/ 2 levels "Social","Control": 1 1 1 1 1 1 1 1 2 2 ...
## $ Stage : Factor w/ 8 levels "Acute","Baseline",..: 1 2 3 4 5 6 7 8 1 2 ...
## $ PropUp : num 0 0.321 0.192 0.182 0.229 ...
## $ PropFloor : num 0.8589 0.0434 0.4614 0.421 0.4931 ...
## $ Bodylengths.cm.: num 1.14 1.14 1.14 1.14 1.14 ...
## $ center_dist_BL : num 56.3 189 125.3 200.5 224.8 ...##Putting factors in desired order
#Putting all factors in the order we want and renaming if necessary
levels(data1$Treatment) <- list(Alone = "Control", Social = "Social")
levels(data1$Sex) <-list(Female = "F", Male = "M")
levels(data1$Stage) <-list(Baseline = "Baseline", Acute = "Acute", Trial = "Trial", Trial_10 = "Second5", Trial_15 = "Third5", Trial_20 = "Fourth5", Trial_25 = "Fifth5", Trial_30 = "Sixth5")##Standard error formula
#Standard error formula:
se <- function(x) sd(x, na.rm=T)/sqrt(length(x))#Obtain sample sizes for each treatment and sex
tapply(data1$ID, list(data1$Treatment, data1$Stage, data1$Sex), length)## , , Female
##
## Baseline Acute Trial Trial_10 Trial_15 Trial_20 Trial_25 Trial_30
## Alone 16 16 16 16 16 16 16 16
## Social 16 16 16 16 16 16 16 16
##
## , , Male
##
## Baseline Acute Trial Trial_10 Trial_15 Trial_20 Trial_25 Trial_30
## Alone 15 15 15 15 15 15 15 15
## Social 15 15 15 15 15 15 15 15#Alone Male - 15, Social, 15
#Alone Female - 16, Social 16#Checking for Outliers and removing if necessary
###First taking a look at activity
list_quantiles <- tapply(data1$center_dist_BL, data1$Sex, quantile, na.rm = TRUE)
dim(data1)## [1] 496 9Q1s <- sapply(1:2, function(i) list_quantiles[[i]][2])
Q3s <- sapply(1:2, function(i) list_quantiles[[i]][4])
IQRs <- tapply(data1$center_dist_BL, data1$Sex, IQR, na.rm = TRUE)
Lowers <- Q1s - 1.5*IQRs
Uppers <- Q3s + 1.5*IQRs
datas <- split(data1, data1$Sex)
data_no_outlierAct <- NULL
for (i in 1:2){
out <- subset(datas[[i]], datas[[i]]$center_dist_BL > Lowers[i] & datas[[i]]$center_dist_BL < Uppers[i])
data_no_outlierAct <- rbind(data_no_outlierAct, out)
}
dim(data_no_outlierAct) #10 data point outliers removed (2 females and 8 males removed)## [1] 485 9dim(data1)## [1] 496 9data_no_outlierAct %>% filter(!ID %in% c(5,9,13,19,50,11,34,51,62)) -> dataActNoOut ##Taking a look at proportion of time in Uppertank
list_quantiles <- tapply(data1$PropUp, data1$Sex, quantile, na.rm = TRUE)
dim(data1)## [1] 496 9Q1s <- sapply(1:2, function(i) list_quantiles[[i]][2])
Q3s <- sapply(1:2, function(i) list_quantiles[[i]][4])
IQRs <- tapply(data1$PropUp, data1$Sex, IQR, na.rm = TRUE)
Lowers <- Q1s - 1.5*IQRs
Uppers <- Q3s + 1.5*IQRs
datas <- split(data1, data1$Sex)
data_no_outlierPropUp<- NULL
for (i in 1:2){
out <- subset(datas[[i]], datas[[i]]$PropUp > Lowers[i] & datas[[i]]$PropUp < Uppers[i])
data_no_outlierPropUp <- rbind(data_no_outlierPropUp, out)
}
dim(data_no_outlierPropUp) #NoOutliers## [1] 496 9tapply(data_no_outlierPropUp$ID, list(data_no_outlierPropUp$Treatment, data_no_outlierPropUp$Stage, data_no_outlierPropUp$Sex), length)## , , Female
##
## Baseline Acute Trial Trial_10 Trial_15 Trial_20 Trial_25 Trial_30
## Alone 16 16 16 16 16 16 16 16
## Social 16 16 16 16 16 16 16 16
##
## , , Male
##
## Baseline Acute Trial Trial_10 Trial_15 Trial_20 Trial_25 Trial_30
## Alone 15 15 15 15 15 15 15 15
## Social 15 15 15 15 15 15 15 15##Taking a look at proportion of time on floor
list_quantiles <- tapply(data1$PropFloor, data1$Sex, quantile, na.rm = TRUE)
dim(data1)## [1] 496 9Q1s <- sapply(1:2, function(i) list_quantiles[[i]][2])
Q3s <- sapply(1:2, function(i) list_quantiles[[i]][4])
IQRs <- tapply(data1$PropFloor, data1$Sex, IQR, na.rm = TRUE)
Lowers <- Q1s - 1.5*IQRs
Uppers <- Q3s + 1.5*IQRs
datas <- split(data1, data1$Sex)
data_no_outlierPropFloor<- NULL
for (i in 1:2){
out <- subset(datas[[i]], datas[[i]]$PropFloor > Lowers[i] & datas[[i]]$PropFloor < Uppers[i])
data_no_outlierPropFloor <- rbind(data_no_outlierPropFloor, out)
}
dim(data_no_outlierPropFloor) #7 data points removed, all points from males## [1] 496 9tapply(data_no_outlierPropFloor$ID, list(data_no_outlierPropFloor$Treatment, data_no_outlierPropFloor$Stage, data_no_outlierPropFloor$Sex), length)## , , Female
##
## Baseline Acute Trial Trial_10 Trial_15 Trial_20 Trial_25 Trial_30
## Alone 16 16 16 16 16 16 16 16
## Social 16 16 16 16 16 16 16 16
##
## , , Male
##
## Baseline Acute Trial Trial_10 Trial_15 Trial_20 Trial_25 Trial_30
## Alone 15 15 15 15 15 15 15 15
## Social 15 15 15 15 15 15 15 151. Investigating acute behavioural responses
#Investigating Acute Activity with outliers removed ###Running mixed model with Treatment (Alone, Social), Sex (Male, Female) and Stage (Baseline vs Acute (immedietae response to cues of risk)) as fixed effects and their interactions, and ID and Group as random effects. Response variable of center_dist_BL, Activity.
dataActNoOut %>%filter(Stage %in% c("Baseline", "Acute")) -> dataActAcuteNoOut #no outliers#Model for Acute Activity
Activity.lmm <- lmer(center_dist_BL ~ Treatment*Sex*Stage
+ (1|ID) + (1|Group),
data=dataActAcuteNoOut)## boundary (singular) fit: see help('isSingular')##Check model residuals for normality
resid(Activity.lmm) -> ActivityResids
#histogram of residuals to check for normality
hist(ActivityResids)
###Density Plot
#Density plot
ggdensity(ActivityResids,
main="Density plot of residuals",
xlab="Residuals") 
###Shapiro-wilk test
shapiro.test(ActivityResids)##
## Shapiro-Wilk normality test
##
## data: ActivityResids
## W = 0.96784, p-value = 0.01182###Activity Acute Anova of Model to check for effects ####Significant effect of Stage
anova(Activity.lmm)## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Treatment 4 4 1 49.213 0.0012 0.97232
## Sex 235 235 1 49.213 0.0680 0.79538
## Stage 131220 131220 1 48.765 37.9836 1.334e-07 ***
## Treatment:Sex 12257 12257 1 49.213 3.5479 0.06554 .
## Treatment:Stage 138 138 1 48.765 0.0399 0.84258
## Sex:Stage 372 372 1 48.765 0.1077 0.74420
## Treatment:Sex:Stage 1696 1696 1 48.765 0.4908 0.48690
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1##Means for each stage
tapply(dataActAcuteNoOut$center_dist_BL, list(dataActAcuteNoOut$Stage), mean)## Baseline Acute Trial Trial_10 Trial_15 Trial_20 Trial_25 Trial_30
## 164.14658 91.50526 NA NA NA NA NA NA##Standard error for each stage
tapply(dataActAcuteNoOut$center_dist_BL, list(dataActAcuteNoOut$Stage), se)## Baseline Acute Trial Trial_10 Trial_15 Trial_20 Trial_25 Trial_30
## 13.368450 7.657915 NA NA NA NA NA NA###Pulling out R2 for acute acitivty
r.squaredGLMM(Activity.lmm)## R2m R2c
## [1,] 0.211832 0.5597366#Table for Random effects for Acute Activity
ranova(Activity.lmm)## ANOVA-like table for random-effects: Single term deletions
##
## Model:
## center_dist_BL ~ Treatment + Sex + Stage + (1 | ID) + (1 | Group) + Treatment:Sex + Treatment:Stage + Sex:Stage + Treatment:Sex:Stage
## npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 -566.10 1154.2
## (1 | ID) 10 -571.32 1162.6 10.421 1 0.001246 **
## (1 | Group) 10 -566.10 1152.2 0.000 1 1.000000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#Plot for Activity for Baseline vs Acute
dataActNoOut %>% filter(Stage %in% c('Baseline', 'Acute')) -> ActBaseTrial
dataActNoOut %>% filter(Stage %in% c("Acute", "Trial","Trial_10","Trial_15", "Trial_20","Trial_25","Trial_30")) -> DatRecoveryAct
ActivityAcute1 <- ggplot(ActBaseTrial, aes(x=Stage, y=center_dist_BL, fill = Stage))+
geom_boxplot(size=1.4, alpha = 0.3) +
geom_point(shape=21, position=position_jitterdodge(0.2), color = "black", size = 3) +
#facet_wrap(~Treatment) +
ylab("Activity (Distance in BL)")+
ggtitle("") +
theme_bw() +
theme(strip.text.x = element_text(size = 20)) +
theme(axis.title.y = element_text(size=20)) +
theme(axis.title.x = element_text(size=20)) +
theme(axis.text.x = element_text(size=18, color = "black")) +
theme(axis.text.y = element_text(size=18, color = "black")) +
theme(legend.position = "none",
legend.justification = c("right","top"),
legend.box.just = "right",
legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect(color = "black", size = 1)) +
theme(legend.title = element_text(size = 15, face = "bold")) +
theme(legend.text = element_text(size = 12))## Warning: The `size` argument of `element_rect()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.AccitivtyAcu2 <- ActivityAcute1+ scale_fill_brewer(palette = "Set2")
AccitivtyAcu2
##Investigating Acute changes in usage of the upper tank ###Running mixed model with Treatment (Alone, Social), Sex (Male, Female) and Stage (Baseline vs Acute (immedietae response to cues of risk)) as fixed effects and their interactions, and ID and Group as random effects. Response variable of PropUp, the proportion of time the individual spent in the upper tank.
###Filteriing whole dataset to have just Baseline and Acute data
data1 %>% filter(Stage %in% c("Baseline", "Acute")) -> AcuteProp###Model
Upper.lmm <- lmer(PropUp ~ Treatment*Sex*Stage
+ (1|ID) + (1|Group),
data=AcuteProp)###Check residuals for normality
resid(Upper.lmm) -> Upper.resids
hist(Upper.resids)
###Density plots for normality
ggdensity(Upper.resids,
main="Density plot of residuals",
xlab="Residuals") 
###QQplot
ggqqplot(Upper.resids)
###Shapiro wilk test
shapiro.test(Upper.resids)##
## Shapiro-Wilk normality test
##
## data: Upper.resids
## W = 0.97007, p-value = 0.007418###Checking effects
anova(Upper.lmm)## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Treatment 0.00033 0.00033 1 41.800 0.0182 0.89324
## Sex 0.00034 0.00034 1 11.989 0.0188 0.89319
## Stage 1.13163 1.13163 1 58.000 61.7954 1.048e-10 ***
## Treatment:Sex 0.09736 0.09736 1 41.800 5.3166 0.02615 *
## Treatment:Stage 0.00782 0.00782 1 58.000 0.4271 0.51599
## Sex:Stage 0.00047 0.00047 1 58.000 0.0256 0.87353
## Treatment:Sex:Stage 0.03519 0.03519 1 58.000 1.9216 0.17099
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1r.squaredGLMM(Upper.lmm)## R2m R2c
## [1,] 0.2975026 0.5041819###Table for random effects
ranova(Upper.lmm)## ANOVA-like table for random-effects: Single term deletions
##
## Model:
## PropUp ~ Treatment + Sex + Stage + (1 | ID) + (1 | Group) + Treatment:Sex + Treatment:Stage + Sex:Stage + Treatment:Sex:Stage
## npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 39.039 -56.078
## (1 | ID) 10 37.195 -54.389 3.6892 1 0.05477 .
## (1 | Group) 10 38.978 -57.955 0.1231 1 0.72573
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1##Means for each stage
tapply(AcuteProp$PropUp, list(AcuteProp$Stage), mean)## Baseline Acute Trial Trial_10 Trial_15 Trial_20 Trial_25
## 0.23091046 0.03962511 NA NA NA NA NA
## Trial_30
## NA##Standard error for each stage
tapply(AcuteProp$PropUp, list(AcuteProp$Stage), se)## Baseline Acute Trial Trial_10 Trial_15 Trial_20 Trial_25
## 0.02692370 0.01131213 NA NA NA NA NA
## Trial_30
## NA##Means for each stage
tapply(AcuteProp$PropUp, list(AcuteProp$Sex, AcuteProp$Treatment), mean)## Alone Social
## Female 0.09476209 0.1733091
## Male 0.17299934 0.1001649##Standard error for each stage
tapply(AcuteProp$PropUp, list(AcuteProp$Sex, AcuteProp$Treatment), se)## Alone Social
## Female 0.02830458 0.04059068
## Male 0.03443080 0.02878285###Plotting stage effects for proportion upper acute
##Acute proportion upper treatment by Stage
PropupStage <- ggplot(AcuteProp, aes(x=Stage, y=PropUp, fill = Stage))+
geom_boxplot(size=1.4, alpha = 0.3) +
geom_point(shape=21, position=position_jitterdodge(0.8), color = "black", size = 3) +
ylim(0,1) +
xlab("Stage")+
ylab("Proportion of Time in Upper Tank")+
# facet_wrap(~Sex)+
theme_bw() +
theme(strip.text.x = element_text(size = 20)) +
theme(axis.title.y = element_text(size=20)) +
theme(axis.title.x = element_text(size=20)) +
theme(axis.text.x = element_text(size=18, color = "black")) +
theme(axis.text.y = element_text(size=18, color = "black")) +
theme(legend.position = "none",
legend.justification = c("right","top"),
legend.box.just = "right",
legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect(color = "black", size = 1)) +
theme(legend.title = element_text(size = 15, face = "bold")) +
theme(legend.text = element_text(size = 12))
PropupStage <- PropupStage+ scale_fill_brewer(palette = "Set2")
PropupStage
###Plotting treatment by sex effects for proportion upper acute
##Acute proportion upper treatment by sex
PropupAcute <- ggplot(AcuteProp, aes(x=Treatment, y=PropUp, fill = Treatment))+
geom_boxplot(size=1.4, alpha = 0.3) +
geom_point(shape=21, position=position_jitterdodge(0.7), color = "black", size = 3) +
ylim(0,1) +
xlab("Treatment")+
ylab("Proportion of Time in Upper Tank")+
facet_wrap(~Sex)+
theme_bw() +
theme(strip.text.x = element_text(size = 20)) +
theme(axis.title.y = element_text(size=20)) +
theme(axis.title.x = element_text(size=20)) +
theme(axis.text.x = element_text(size=18, color = "black")) +
theme(axis.text.y = element_text(size=18, color = "black")) +
theme(legend.position = "none",
legend.justification = c("right","top"),
legend.box.just = "right",
legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect(color = "black", size = 1)) +
theme(legend.title = element_text(size = 15, face = "bold")) +
theme(legend.text = element_text(size = 12))
PropupAcute <- PropupAcute+ scale_fill_brewer(palette = "Set2")
PropupAcute
##Investigating acute proportion floor usage
###Filteriing whole dataset to have just Baseline and Acute data
###Model
Floor.lmm <- lmer(PropFloor ~ Treatment*Sex*Stage
+ (1|ID) + (1|Group),
data=AcuteProp)## boundary (singular) fit: see help('isSingular')###Check residuals for normality
resid(Floor.lmm) -> Floor.resids
hist(Floor.resids)
###Density plots for normality
ggdensity(Floor.resids,
main="Density plot of residuals",
xlab="Residuals") 
###QQplot
ggqqplot(Floor.resids)
###Shapiro wilk test
shapiro.test(Floor.resids)##
## Shapiro-Wilk normality test
##
## data: Floor.resids
## W = 0.99253, p-value = 0.751###Checking effects
anova(Floor.lmm)## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Treatment 0.0449 0.0449 1 58.002 0.6857 0.4110
## Sex 0.0159 0.0159 1 58.002 0.2425 0.6243
## Stage 5.2839 5.2839 1 57.998 80.6686 1.423e-12 ***
## Treatment:Sex 0.0987 0.0987 1 58.002 1.5072 0.2245
## Treatment:Stage 0.0245 0.0245 1 57.998 0.3734 0.5436
## Sex:Stage 0.0026 0.0026 1 57.998 0.0402 0.8418
## Treatment:Sex:Stage 0.0080 0.0080 1 57.998 0.1216 0.7286
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1r.squaredGLMM(Floor.lmm)## R2m R2c
## [1,] 0.3234884 0.5373552###Table for random effects
ranova(Floor.lmm)## ANOVA-like table for random-effects: Single term deletions
##
## Model:
## PropFloor ~ Treatment + Sex + Stage + (1 | ID) + (1 | Group) + Treatment:Sex + Treatment:Stage + Sex:Stage + Treatment:Sex:Stage
## npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 -36.454 94.908
## (1 | ID) 10 -39.501 99.002 6.0934 1 0.01357 *
## (1 | Group) 10 -36.454 92.908 0.0000 1 1.00000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1tapply(AcuteProp$PropFloor, list(AcuteProp$Stage), mean)## Baseline Acute Trial Trial_10 Trial_15 Trial_20 Trial_25 Trial_30
## 0.3021198 0.7148907 NA NA NA NA NA NA##Standard error for each stage
tapply(AcuteProp$PropFloor, list(AcuteProp$Stage), se)## Baseline Acute Trial Trial_10 Trial_15 Trial_20 Trial_25
## 0.03869695 0.03915692 NA NA NA NA NA
## Trial_30
## NA##Acute proportion floor treatment by sex
PropupAcute <- ggplot(AcuteProp, aes(x=Stage, y=PropFloor, fill = Stage))+
geom_boxplot(size=1.4, alpha = 0.3) +
geom_point(shape=21, position=position_jitterdodge(0.7), color = "black", size = 3) +
xlab("Stage")+
ylab("Proportion of Time on Floor")+
#facet_wrap(~Sex)+
theme_bw() +
theme(strip.text.x = element_text(size = 20)) +
theme(axis.title.y = element_text(size=20)) +
theme(axis.title.x = element_text(size=20)) +
theme(axis.text.x = element_text(size=18, color = "black")) +
theme(axis.text.y = element_text(size=18, color = "black")) +
theme(legend.position = "none",
legend.justification = c("right","top"),
legend.box.just = "right",
legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect(color = "black", size = 1)) +
theme(legend.title = element_text(size = 15, face = "bold")) +
theme(legend.text = element_text(size = 12))
PropfloorAcute <- PropupAcute+ scale_fill_brewer(palette = "Set2")
PropfloorAcute
2. Investigating Recovery from Risk cues
#Convert Stage to continous variable of Trial.Seconds, as it is over time.
unique(data1$Stage)## [1] Acute Baseline Trial Trial_10 Trial_15 Trial_20 Trial_25 Trial_30
## 8 Levels: Baseline Acute Trial Trial_10 Trial_15 Trial_20 ... Trial_30data1%<>%
mutate(Trial.Seconds=case_when(.default=0,
Stage=="Baseline"~0,
Stage=="Acute"~300,
Stage=="Trial"~600,
Stage=="Trial_10"~900,
Stage=="Trial_15"~1200,
Stage=="Trial_20"~1500,
Stage=="Trial_25"~1800,
Stage=="Trial_30"~2100))
#Filter Data for Activity Total Post Cue (Time: 0-2100 seconds, 0-5 pre-cue, 0-35 minutes post cue, each start at 5 minute chunks. Ex) Trial at 600 encompasses data from 600-900 seconds.
##Activity have to filter out certain individuals where tracking had portions missing
data1 %>% filter(!ID %in% c(5,9,13,19,50,11,34,51,62)) -> dataAct # outliers are in but some inds. removed
dataActNoOut%<>%dplyr::select(ID:Stage, center_dist_BL)%>%
mutate(Trial.Seconds=case_when(.default=0,
Stage=="Baseline"~0,
Stage=="Acute"~300,
Stage=="Trial"~600,
Stage=="Trial_10"~900,
Stage=="Trial_15"~1200,
Stage=="Trial_20"~1500,
Stage=="Trial_25"~1800,
Stage=="Trial_30"~2100))2z. Proportion of floor usage
###Model
Floor.lmm <- lmer(PropFloor ~ Treatment*Sex*Stage
+ (1|ID) + (1|Group),
data=data1)## boundary (singular) fit: see help('isSingular')###Check residuals for normality
resid(Floor.lmm) -> Floor.resids
hist(Floor.resids)
###Density plots for normality
ggdensity(Floor.resids,
main="Density plot of residuals",
xlab="Residuals") 
###QQplot
ggqqplot(Floor.resids)
###Shapiro wilk test
shapiro.test(Floor.resids)##
## Shapiro-Wilk normality test
##
## data: Floor.resids
## W = 0.97175, p-value = 3.465e-08###Checking effects
anova(Floor.lmm)## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Treatment 0.0997 0.09966 1 58 2.9770 0.08978 .
## Sex 0.0074 0.00745 1 58 0.2225 0.63890
## Stage 8.5580 1.22258 7 406 36.5224 < 2e-16 ***
## Treatment:Sex 0.0341 0.03414 1 58 1.0199 0.31675
## Treatment:Stage 0.2271 0.03244 7 406 0.9691 0.45335
## Sex:Stage 0.0557 0.00796 7 406 0.2378 0.97577
## Treatment:Sex:Stage 0.2276 0.03252 7 406 0.9714 0.45164
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1r.squaredGLMM(Floor.lmm)## R2m R2c
## [1,] 0.199852 0.7042753###Table for random effects
ranova(Floor.lmm)## ANOVA-like table for random-effects: Single term deletions
##
## Model:
## PropFloor ~ Treatment + Sex + Stage + (1 | ID) + (1 | Group) + Treatment:Sex + Treatment:Stage + Sex:Stage + Treatment:Sex:Stage
## npar logLik AIC LRT Df Pr(>Chisq)
## <none> 35 8.023 53.95
## (1 | ID) 34 -135.655 339.31 287.36 1 <2e-16 ***
## (1 | Group) 34 8.023 51.95 0.00 1 1
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#ProportionFloorgraph over time
ggplot(data=data1, aes(x=Trial.Seconds, y=PropFloor, group = ID, colour = ID))+
geom_line(alpha = 0.4) + # Connect points for each individual across stages
geom_point(size = 2, alpha = 0.4) + # Show individual points+
stat_summary(aes(group = 1), fun = median, geom = 'line', color = 'red', size = 1.2) + # Overall mean trend line
stat_summary(aes(group = 1), fun = median, geom = 'point', color = 'black', size = 3) + # Mean points for each stage
ylim(0,1) +
ylab("Proportion of Time on Floor")+
xlab("Time Post Cue (s)")+
#facet_grid(Sex~Treatment)+
theme_bw() +
theme(strip.text.x = element_text(size = 20)) +
theme(axis.title.y = element_text(size=20)) +
theme(axis.title.x = element_text(size=20)) +
theme(axis.text.x = element_text(size=18, color = "black")) +
theme(axis.text.y = element_text(size=18, color = "black")) +
theme(legend.position = "none",
legend.justification = c("right","top"),
legend.box.just = "right",
legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect(color = "black", size = 1)) +
theme(legend.title = element_text(size = 15, face = "bold")) +
theme(legend.text = element_text(size = 12)) -> propStageFloor # Hide legend for Individual_ID ## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.##Total
Propfloor <- ggplot(data1, aes(x=Treatment, y=PropFloor, fill = Treatment))+
geom_boxplot(size=1.4, alpha = 0.3) +
geom_point(shape=21, position=position_jitterdodge(0.7), color = "black", size = 3) +
xlab("Treatment")+
ylab("Proportion of Time on Floor of Tank")+
#facet_wrap(~Treatment)+
theme_bw() +
theme(strip.text.x = element_text(size = 20)) +
theme(axis.title.y = element_text(size=20)) +
theme(axis.title.x = element_text(size=20)) +
theme(axis.text.x = element_text(size=18, color = "black")) +
theme(axis.text.y = element_text(size=18, color = "black")) +
theme(legend.position = "none",
legend.justification = c("right","top"),
legend.box.just = "right",
legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect(color = "black", size = 1)) +
theme(legend.title = element_text(size = 15, face = "bold")) +
theme(legend.text = element_text(size = 12))
Propfloor<- Propfloor+ scale_fill_brewer(palette = "Set2")
Propfloor
2a. Investigating activity over recovery period
##Running mixed model with Treatment (Alone, Social), Sex (Male, Female) and Trial.Seconds (time in seconds) as fixed effects and their interactions, and ID and Group as random effects. Response variable of center_dist_BL, Activity in Bodylengths.
Activity.lmmout <- lmer(center_dist_BL ~ Treatment*Sex*Trial.Seconds
+ (1|ID) + (1|Group),
data=dataActNoOut)## boundary (singular) fit: see help('isSingular')###Checking Normality of Residuals
hist(resid(Activity.lmmout))
ggqqplot(resid(Activity.lmmout))
shapiro.test(resid(Activity.lmmout))##
## Shapiro-Wilk normality test
##
## data: resid(Activity.lmmout)
## W = 0.9654, p-value = 2.59e-08###Checking for effects using Anova
anova(Activity.lmmout)## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Treatment 379 379 1 59.13 0.1265 0.72339
## Sex 99 99 1 59.13 0.0331 0.85620
## Trial.Seconds 558623 558623 1 357.42 186.5121 < 2e-16 ***
## Treatment:Sex 3924 3924 1 59.13 1.3102 0.25698
## Treatment:Trial.Seconds 12407 12407 1 357.42 4.1425 0.04256 *
## Sex:Trial.Seconds 1051 1051 1 357.42 0.3510 0.55394
## Treatment:Sex:Trial.Seconds 17087 17087 1 357.42 5.7048 0.01744 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#Total post-cue activity random effects
ranova(Activity.lmmout)## ANOVA-like table for random-effects: Single term deletions
##
## Model:
## center_dist_BL ~ Treatment + Sex + Trial.Seconds + (1 | ID) + (1 | Group) + Treatment:Sex + Treatment:Trial.Seconds + Sex:Trial.Seconds + Treatment:Sex:Trial.Seconds
## npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 -2321.9 4665.7
## (1 | ID) 10 -2475.4 4970.8 307.09 1 <2e-16 ***
## (1 | Group) 10 -2321.9 4663.7 0.00 1 1
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1###Emmeans for contrasts Activity recovery ###Comparing between sexes/treatments at each time point, no significant differences seen
emmeans(Activity.lmmout,spec = c("Treatment","Sex"), var=c("Treatment"), at = list(Trial.Seconds = c(0, 600, 900, 1500,1800)), by = c("Trial.Seconds")) %>% pairs()## Trial.Seconds = 0:
## contrast estimate SE df t.ratio p.value
## Alone Female - Social Female -40.611 39.0 43.5 -1.040 0.7270
## Alone Female - Alone Male -35.912 40.4 51.1 -0.888 0.8112
## Alone Female - Social Male -14.554 39.9 48.5 -0.364 0.9832
## Social Female - Alone Male 4.700 37.3 46.6 0.126 0.9993
## Social Female - Social Male 26.058 36.7 43.1 0.710 0.8926
## Alone Male - Social Male 21.358 38.1 48.0 0.561 0.9432
##
## Trial.Seconds = 600:
## contrast estimate SE df t.ratio p.value
## Alone Female - Social Female -19.547 37.6 37.3 -0.520 0.9537
## Alone Female - Alone Male -21.718 38.9 43.8 -0.558 0.9439
## Alone Female - Social Male -2.041 38.4 41.4 -0.053 0.9999
## Social Female - Alone Male -2.171 35.9 39.9 -0.061 0.9999
## Social Female - Social Male 17.506 35.3 36.8 0.496 0.9595
## Alone Male - Social Male 19.677 36.7 41.1 0.537 0.9496
##
## Trial.Seconds = 900:
## contrast estimate SE df t.ratio p.value
## Alone Female - Social Female -9.015 37.3 36.1 -0.242 0.9949
## Alone Female - Alone Male -14.621 38.6 42.4 -0.378 0.9813
## Alone Female - Social Male 4.215 38.1 40.1 0.110 0.9995
## Social Female - Alone Male -5.606 35.6 38.7 -0.158 0.9986
## Social Female - Social Male 13.230 35.0 35.7 0.378 0.9814
## Alone Male - Social Male 18.836 36.4 39.9 0.518 0.9544
##
## Trial.Seconds = 1500:
## contrast estimate SE df t.ratio p.value
## Alone Female - Social Female 12.049 37.6 37.4 0.321 0.9884
## Alone Female - Alone Male -0.428 39.0 43.9 -0.011 1.0000
## Alone Female - Social Male 16.727 38.5 41.8 0.434 0.9723
## Social Female - Alone Male -12.477 35.9 40.0 -0.348 0.9853
## Social Female - Social Male 4.678 35.4 37.1 0.132 0.9992
## Alone Male - Social Male 17.154 36.8 41.6 0.467 0.9659
##
## Trial.Seconds = 1800:
## contrast estimate SE df t.ratio p.value
## Alone Female - Social Female 22.581 38.2 39.9 0.591 0.9342
## Alone Female - Alone Male 6.669 39.6 46.8 0.168 0.9983
## Alone Female - Social Male 22.983 39.2 44.8 0.586 0.9358
## Social Female - Alone Male -15.912 36.4 42.6 -0.437 0.9718
## Social Female - Social Male 0.402 36.0 39.8 0.011 1.0000
## Alone Male - Social Male 16.314 37.4 44.7 0.436 0.9719
##
## Degrees-of-freedom method: kenward-roger
## P value adjustment: tukey method for comparing a family of 4 estimatesemmeans(Activity.lmmout,spec = c("Treatment","Trial.Seconds"), var=c("Trial.Seconds"), at = list(Trial.Seconds = c(0, 600, 900, 1500,1800)), by = c("Sex")) %>% pairs()## Sex = Female:
## contrast estimate SE df
## Alone Trial.Seconds0 - Social Trial.Seconds0 -40.611 39.00 43.5
## Alone Trial.Seconds0 - Alone Trial.Seconds600 -44.457 5.17 357.1
## Alone Trial.Seconds0 - Social Trial.Seconds600 -64.004 38.40 40.8
## Alone Trial.Seconds0 - Alone Trial.Seconds900 -66.685 7.76 357.1
## Alone Trial.Seconds0 - Social Trial.Seconds900 -75.700 38.30 40.3
## Alone Trial.Seconds0 - Alone Trial.Seconds1500 -111.142 12.90 357.1
## Alone Trial.Seconds0 - Social Trial.Seconds1500 -99.093 38.40 40.8
## Alone Trial.Seconds0 - Alone Trial.Seconds1800 -133.370 15.50 357.1
## Alone Trial.Seconds0 - Social Trial.Seconds1800 -110.789 38.70 41.9
## Social Trial.Seconds0 - Alone Trial.Seconds600 -3.845 38.20 39.8
## Social Trial.Seconds0 - Social Trial.Seconds600 -23.393 4.36 357.0
## Social Trial.Seconds0 - Alone Trial.Seconds900 -26.074 38.00 39.1
## Social Trial.Seconds0 - Social Trial.Seconds900 -35.089 6.54 357.0
## Social Trial.Seconds0 - Alone Trial.Seconds1500 -70.530 38.20 40.0
## Social Trial.Seconds0 - Social Trial.Seconds1500 -58.481 10.90 357.0
## Social Trial.Seconds0 - Alone Trial.Seconds1800 -92.759 38.60 41.5
## Social Trial.Seconds0 - Social Trial.Seconds1800 -70.178 13.10 357.0
## Alone Trial.Seconds600 - Social Trial.Seconds600 -19.547 37.60 37.3
## Alone Trial.Seconds600 - Alone Trial.Seconds900 -22.228 2.59 357.1
## Alone Trial.Seconds600 - Social Trial.Seconds900 -31.244 37.40 36.8
## Alone Trial.Seconds600 - Alone Trial.Seconds1500 -66.685 7.76 357.1
## Alone Trial.Seconds600 - Social Trial.Seconds1500 -54.636 37.60 37.3
## Alone Trial.Seconds600 - Alone Trial.Seconds1800 -88.914 10.30 357.1
## Alone Trial.Seconds600 - Social Trial.Seconds1800 -66.332 37.80 38.3
## Social Trial.Seconds600 - Alone Trial.Seconds900 -2.681 37.40 36.6
## Social Trial.Seconds600 - Social Trial.Seconds900 -11.696 2.18 357.0
## Social Trial.Seconds600 - Alone Trial.Seconds1500 -47.138 37.60 37.4
## Social Trial.Seconds600 - Social Trial.Seconds1500 -35.089 6.54 357.0
## Social Trial.Seconds600 - Alone Trial.Seconds1800 -69.366 38.00 38.9
## Social Trial.Seconds600 - Social Trial.Seconds1800 -46.785 8.72 357.0
## Alone Trial.Seconds900 - Social Trial.Seconds900 -9.015 37.30 36.1
## Alone Trial.Seconds900 - Alone Trial.Seconds1500 -44.457 5.17 357.1
## Alone Trial.Seconds900 - Social Trial.Seconds1500 -32.408 37.40 36.6
## Alone Trial.Seconds900 - Alone Trial.Seconds1800 -66.685 7.76 357.1
## Alone Trial.Seconds900 - Social Trial.Seconds1800 -44.104 37.60 37.6
## Social Trial.Seconds900 - Alone Trial.Seconds1500 -35.442 37.50 36.9
## Social Trial.Seconds900 - Social Trial.Seconds1500 -23.393 4.36 357.0
## Social Trial.Seconds900 - Alone Trial.Seconds1800 -57.670 37.80 38.4
## Social Trial.Seconds900 - Social Trial.Seconds1800 -35.089 6.54 357.0
## Alone Trial.Seconds1500 - Social Trial.Seconds1500 12.049 37.60 37.4
## Alone Trial.Seconds1500 - Alone Trial.Seconds1800 -22.228 2.59 357.1
## Alone Trial.Seconds1500 - Social Trial.Seconds1800 0.353 37.80 38.4
## Social Trial.Seconds1500 - Alone Trial.Seconds1800 -34.277 38.00 38.9
## Social Trial.Seconds1500 - Social Trial.Seconds1800 -11.696 2.18 357.0
## Alone Trial.Seconds1800 - Social Trial.Seconds1800 22.581 38.20 39.9
## t.ratio p.value
## -1.040 0.9878
## -8.597 <.0001
## -1.666 0.8075
## -8.597 <.0001
## -1.976 0.6195
## -8.597 <.0001
## -2.579 0.2602
## -8.597 <.0001
## -2.865 0.1485
## -0.101 1.0000
## -5.364 <.0001
## -0.686 0.9995
## -5.364 <.0001
## -1.845 0.7034
## -5.364 <.0001
## -2.405 0.3493
## -5.364 <.0001
## -0.520 0.9999
## -8.597 <.0001
## -0.835 0.9975
## -8.597 <.0001
## -1.454 0.9011
## -8.597 <.0001
## -1.754 0.7582
## -0.072 1.0000
## -5.364 <.0001
## -1.254 0.9577
## -5.364 <.0001
## -1.828 0.7143
## -5.364 <.0001
## -0.242 1.0000
## -8.597 <.0001
## -0.867 0.9966
## -8.597 <.0001
## -1.171 0.9724
## -0.946 0.9936
## -5.364 <.0001
## -1.524 0.8739
## -5.364 <.0001
## 0.321 1.0000
## -8.597 <.0001
## 0.009 1.0000
## -0.903 0.9955
## -5.364 <.0001
## 0.591 0.9998
##
## Sex = Male:
## contrast estimate SE df
## Alone Trial.Seconds0 - Social Trial.Seconds0 21.358 38.10 48.0
## Alone Trial.Seconds0 - Alone Trial.Seconds600 -30.263 4.70 357.0
## Alone Trial.Seconds0 - Social Trial.Seconds600 -10.586 37.40 44.6
## Alone Trial.Seconds0 - Alone Trial.Seconds900 -45.395 7.04 357.0
## Alone Trial.Seconds0 - Social Trial.Seconds900 -26.559 37.30 44.0
## Alone Trial.Seconds0 - Alone Trial.Seconds1500 -75.658 11.70 357.0
## Alone Trial.Seconds0 - Social Trial.Seconds1500 -58.503 37.50 45.1
## Alone Trial.Seconds0 - Alone Trial.Seconds1800 -90.789 14.10 357.0
## Alone Trial.Seconds0 - Social Trial.Seconds1800 -74.475 37.80 46.7
## Social Trial.Seconds0 - Alone Trial.Seconds600 -51.621 37.40 44.5
## Social Trial.Seconds0 - Social Trial.Seconds600 -31.945 4.79 358.7
## Social Trial.Seconds0 - Alone Trial.Seconds900 -66.753 37.20 43.8
## Social Trial.Seconds0 - Social Trial.Seconds900 -47.917 7.18 358.7
## Social Trial.Seconds0 - Alone Trial.Seconds1500 -97.016 37.40 44.5
## Social Trial.Seconds0 - Social Trial.Seconds1500 -79.861 12.00 358.7
## Social Trial.Seconds0 - Alone Trial.Seconds1800 -112.147 37.70 46.0
## Social Trial.Seconds0 - Social Trial.Seconds1800 -95.834 14.40 358.7
## Alone Trial.Seconds600 - Social Trial.Seconds600 19.677 36.70 41.1
## Alone Trial.Seconds600 - Alone Trial.Seconds900 -15.132 2.35 357.0
## Alone Trial.Seconds600 - Social Trial.Seconds900 3.704 36.50 40.6
## Alone Trial.Seconds600 - Alone Trial.Seconds1500 -45.395 7.04 357.0
## Alone Trial.Seconds600 - Social Trial.Seconds1500 -28.240 36.80 41.6
## Alone Trial.Seconds600 - Alone Trial.Seconds1800 -60.526 9.39 357.0
## Alone Trial.Seconds600 - Social Trial.Seconds1800 -44.212 37.10 43.2
## Social Trial.Seconds600 - Alone Trial.Seconds900 -34.808 36.50 40.5
## Social Trial.Seconds600 - Social Trial.Seconds900 -15.972 2.39 358.7
## Social Trial.Seconds600 - Alone Trial.Seconds1500 -65.071 36.70 41.2
## Social Trial.Seconds600 - Social Trial.Seconds1500 -47.917 7.18 358.7
## Social Trial.Seconds600 - Alone Trial.Seconds1800 -80.203 37.00 42.6
## Social Trial.Seconds600 - Social Trial.Seconds1800 -63.889 9.57 358.7
## Alone Trial.Seconds900 - Social Trial.Seconds900 18.836 36.40 39.9
## Alone Trial.Seconds900 - Alone Trial.Seconds1500 -30.263 4.70 357.0
## Alone Trial.Seconds900 - Social Trial.Seconds1500 -13.109 36.60 40.9
## Alone Trial.Seconds900 - Alone Trial.Seconds1800 -45.395 7.04 357.0
## Alone Trial.Seconds900 - Social Trial.Seconds1800 -29.081 37.00 42.5
## Social Trial.Seconds900 - Alone Trial.Seconds1500 -49.099 36.50 40.6
## Social Trial.Seconds900 - Social Trial.Seconds1500 -31.945 4.79 358.7
## Social Trial.Seconds900 - Alone Trial.Seconds1800 -64.231 36.80 42.0
## Social Trial.Seconds900 - Social Trial.Seconds1800 -47.917 7.18 358.7
## Alone Trial.Seconds1500 - Social Trial.Seconds1500 17.154 36.80 41.6
## Alone Trial.Seconds1500 - Alone Trial.Seconds1800 -15.132 2.35 357.0
## Alone Trial.Seconds1500 - Social Trial.Seconds1800 1.182 37.10 43.2
## Social Trial.Seconds1500 - Alone Trial.Seconds1800 -32.286 37.10 43.0
## Social Trial.Seconds1500 - Social Trial.Seconds1800 -15.972 2.39 358.7
## Alone Trial.Seconds1800 - Social Trial.Seconds1800 16.314 37.40 44.7
## t.ratio p.value
## 0.561 0.9999
## -6.445 <.0001
## -0.283 1.0000
## -6.445 <.0001
## -0.712 0.9993
## -6.445 <.0001
## -1.560 0.8595
## -6.445 <.0001
## -1.969 0.6240
## -1.381 0.9266
## -6.676 <.0001
## -1.793 0.7356
## -6.676 <.0001
## -2.596 0.2498
## -6.676 <.0001
## -2.977 0.1141
## -6.676 <.0001
## 0.537 0.9999
## -6.445 <.0001
## 0.101 1.0000
## -6.445 <.0001
## -0.768 0.9987
## -6.445 <.0001
## -1.192 0.9698
## -0.953 0.9933
## -6.676 <.0001
## -1.775 0.7465
## -6.676 <.0001
## -2.169 0.4921
## -6.676 <.0001
## 0.518 0.9999
## -6.445 <.0001
## -0.358 1.0000
## -6.445 <.0001
## -0.787 0.9984
## -1.344 0.9368
## -6.676 <.0001
## -1.743 0.7649
## -6.676 <.0001
## 0.467 1.0000
## -6.445 <.0001
## 0.032 1.0000
## -0.871 0.9966
## -6.676 <.0001
## 0.436 1.0000
##
## Degrees-of-freedom method: kenward-roger
## P value adjustment: tukey method for comparing a family of 10 estimates###Pulling out R2
r.squaredGLMM(Activity.lmmout)## R2m R2c
## [1,] 0.1122796 0.7648517str(dataActNoOut)## 'data.frame': 414 obs. of 7 variables:
## $ ID : Factor w/ 62 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 2 2 ...
## $ Group : Factor w/ 18 levels "1","3","4","5",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ Sex : Factor w/ 2 levels "Female","Male": 1 1 1 1 1 1 1 1 1 1 ...
## $ Treatment : Factor w/ 2 levels "Alone","Social": 2 2 2 2 2 2 2 2 1 1 ...
## $ Stage : Factor w/ 8 levels "Baseline","Acute",..: 2 1 3 4 5 6 7 8 2 1 ...
## $ center_dist_BL: num 56.3 189 125.3 200.5 224.8 ...
## $ Trial.Seconds : num 300 0 600 900 1200 1500 1800 2100 300 0 ...ggplot(data=dataActNoOut, aes(x=Trial.Seconds, y=center_dist_BL, group = ID, colour = ID))+
geom_line(alpha = 0.4) + # Connect points for each individual across stages
geom_point(size = 2, alpha = 0.4) + # Show individual points
stat_summary(aes(group = 1), fun = median, geom = 'line', color = 'red', size = 1.2) + # Overall mean trend line
stat_summary(aes(group = 1), fun = median, geom = 'point', color = 'black', size = 3) + # Mean points for each stage
ylab("Activity (distance in BL)")+
xlab("Time Post Cue (s)")+
facet_grid(Sex~Treatment)+
theme_bw() +
theme(strip.text.x = element_text(size = 20)) +
theme(strip.text.y = element_text(size = 20)) +
theme(axis.title.y = element_text(size=20)) +
theme(axis.title.x = element_text(size=20)) +
theme(axis.text.x = element_text(size=18, color = "black")) +
theme(axis.text.y = element_text(size=18, color = "black")) +
theme(legend.position = "none",
legend.justification = c("right","top"),
legend.box.just = "right",
legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect(color = "black", size = 1)) +
theme(legend.title = element_text(size = 15, face = "bold")) +
theme(legend.text = element_text(size = 12)) -> actSexTrt
actSexTrt
###Means of total post cue activity
tapply(dataActNoOut$center_dist_BL, list(dataActNoOut$Treatment, dataActNoOut$Sex, dataActNoOut$Stage), mean)## , , Baseline
##
## Female Male
## Alone 143.4799 177.8265
## Social 189.4038 138.8110
##
## , , Acute
##
## Female Male
## Alone 78.80312 104.53320
## Social 103.89934 76.10875
##
## , , Trial
##
## Female Male
## Alone 147.6495 172.8702
## Social 157.4121 165.3384
##
## , , Trial_10
##
## Female Male
## Alone 180.1567 191.6195
## Social 191.3141 180.6429
##
## , , Trial_15
##
## Female Male
## Alone 198.4919 213.1631
## Social 204.3467 205.7039
##
## , , Trial_20
##
## Female Male
## Alone 221.3453 204.6908
## Social 203.9784 200.6979
##
## , , Trial_25
##
## Female Male
## Alone 228.0089 233.9416
## Social 227.0146 185.4353
##
## , , Trial_30
##
## Female Male
## Alone 253.8367 244.9598
## Social 220.0008 198.7490###Means of total post cue activity
tapply(dataActNoOut$center_dist_BL, list(dataActNoOut$Treatment, dataActNoOut$Sex, dataActNoOut$Trial.Seconds), mean)## , , 0
##
## Female Male
## Alone 143.4799 177.8265
## Social 189.4038 138.8110
##
## , , 300
##
## Female Male
## Alone 78.80312 104.53320
## Social 103.89934 76.10875
##
## , , 600
##
## Female Male
## Alone 147.6495 172.8702
## Social 157.4121 165.3384
##
## , , 900
##
## Female Male
## Alone 180.1567 191.6195
## Social 191.3141 180.6429
##
## , , 1200
##
## Female Male
## Alone 198.4919 213.1631
## Social 204.3467 205.7039
##
## , , 1500
##
## Female Male
## Alone 221.3453 204.6908
## Social 203.9784 200.6979
##
## , , 1800
##
## Female Male
## Alone 228.0089 233.9416
## Social 227.0146 185.4353
##
## , , 2100
##
## Female Male
## Alone 253.8367 244.9598
## Social 220.0008 198.7490###Standard Deviations of total post cue activity
tapply(dataActNoOut$center_dist_BL, list(dataActNoOut$Treatment, dataActNoOut$Sex, dataActNoOut$Trial.Seconds), se)## , , 0
##
## Female Male
## Alone 37.18246 19.36338
## Social 24.45785 26.88057
##
## , , 300
##
## Female Male
## Alone 14.10700 14.42067
## Social 14.72473 16.92811
##
## , , 600
##
## Female Male
## Alone 37.00544 23.71881
## Social 18.60027 33.63458
##
## , , 900
##
## Female Male
## Alone 45.12366 24.09443
## Social 23.83032 35.77933
##
## , , 1200
##
## Female Male
## Alone 38.72056 29.64781
## Social 26.28027 37.07058
##
## , , 1500
##
## Female Male
## Alone 40.02590 22.94606
## Social 24.26859 33.15681
##
## , , 1800
##
## Female Male
## Alone 39.79099 28.48156
## Social 28.60034 24.94175
##
## , , 2100
##
## Female Male
## Alone 45.06030 27.59164
## Social 24.08516 31.56141#2b. Investigating Total Time Post Cue of Proportion Upper Tank Usage # #######################################################################
##Running mixed model with Treatment (Alone, Social), Sex (Male, Female) and Trial.Seconds (time in seconds) as fixed effects and their interactions, and ID and Group as random effects. Response variable of PropUp, Proportion of time spent in the upper tank.
Upper2.lmm <- lmer(PropUp ~ Treatment*Sex*Trial.Seconds
+ (1|ID) + (1|Group),
data=data1)###Check for model residuals for normality
hist(resid(Upper2.lmm))
ggqqplot(resid(Upper2.lmm)) 
shapiro.test(resid(Upper2.lmm))##
## Shapiro-Wilk normality test
##
## data: resid(Upper2.lmm)
## W = 0.98652, p-value = 0.00015###Checking for effects using Anova
anova(Upper2.lmm)## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Treatment 0.00073 0.00073 1 67.73 0.0424 0.83748
## Sex 0.00111 0.00111 1 20.44 0.0646 0.80193
## Trial.Seconds 1.17338 1.17338 1 430.00 68.0333 1.978e-15 ***
## Treatment:Sex 0.06956 0.06956 1 67.73 4.0328 0.04861 *
## Treatment:Trial.Seconds 0.00529 0.00529 1 430.00 0.3065 0.58009
## Sex:Trial.Seconds 0.00509 0.00509 1 430.00 0.2953 0.58713
## Treatment:Sex:Trial.Seconds 0.03675 0.03675 1 430.00 2.1307 0.14511
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#Total post-cue upper tank usage random effects
ranova(Upper2.lmm)## ANOVA-like table for random-effects: Single term deletions
##
## Model:
## PropUp ~ Treatment + Sex + Trial.Seconds + (1 | ID) + (1 | Group) + Treatment:Sex + Treatment:Trial.Seconds + Sex:Trial.Seconds + Treatment:Sex:Trial.Seconds
## npar logLik AIC LRT Df Pr(>Chisq)
## <none> 11 184.599 -347.20
## (1 | ID) 10 96.795 -173.59 175.608 1 <2e-16 ***
## (1 | Group) 10 184.365 -348.73 0.469 1 0.4935
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1###Emmeans for contrasts of proportion upper total post cue
emmeans(Upper2.lmm, pairwise ~ Sex*Treatment*Trial.Seconds)## $emmeans
## Sex Treatment Trial.Seconds emmean SE df lower.CL upper.CL
## Female Alone 1050 0.182 0.0395 34.1 0.102 0.263
## Male Alone 1050 0.260 0.0404 43.1 0.179 0.342
## Female Social 1050 0.237 0.0395 34.1 0.157 0.317
## Male Social 1050 0.202 0.0407 40.8 0.120 0.285
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
##
## $contrasts
## contrast estimate
## Female Alone Trial.Seconds1050 - Male Alone Trial.Seconds1050 -0.0778
## Female Alone Trial.Seconds1050 - Female Social Trial.Seconds1050 -0.0548
## Female Alone Trial.Seconds1050 - Male Social Trial.Seconds1050 -0.0200
## Male Alone Trial.Seconds1050 - Female Social Trial.Seconds1050 0.0231
## Male Alone Trial.Seconds1050 - Male Social Trial.Seconds1050 0.0578
## Female Social Trial.Seconds1050 - Male Social Trial.Seconds1050 0.0347
## SE df t.ratio p.value
## 0.0565 38.6 -1.378 0.5202
## 0.0512 42.6 -1.069 0.7098
## 0.0567 37.5 -0.353 0.9846
## 0.0565 38.6 0.408 0.9767
## 0.0536 47.0 1.078 0.7048
## 0.0567 37.5 0.613 0.9274
##
## Degrees-of-freedom method: kenward-roger
## P value adjustment: tukey method for comparing a family of 4 estimates###Pulling out R2
r.squaredGLMM(Upper.lmm)## R2m R2c
## [1,] 0.2975026 0.5041819###Means of proportion upper total post cue
tapply(data1$PropUp, list(data1$Treatment, data1$Sex, data1$Trial.Seconds), mean)## , , 0
##
## Female Male
## Alone 0.1674853 0.2755438
## Social 0.2956337 0.1848925
##
## , , 300
##
## Female Male
## Alone 0.02203890 0.07045490
## Social 0.05098453 0.01543722
##
## , , 600
##
## Female Male
## Alone 0.1415390 0.2210193
## Social 0.2279737 0.1626979
##
## , , 900
##
## Female Male
## Alone 0.1721123 0.3013452
## Social 0.2363000 0.2200513
##
## , , 1200
##
## Female Male
## Alone 0.2046916 0.2844682
## Social 0.2716362 0.2387539
##
## , , 1500
##
## Female Male
## Alone 0.2500633 0.3024881
## Social 0.2272201 0.2195337
##
## , , 1800
##
## Female Male
## Alone 0.2403239 0.315432
## Social 0.2948675 0.276258
##
## , , 2100
##
## Female Male
## Alone 0.2606858 0.3117145
## Social 0.2925678 0.2712111###Standard Deviations of proportion upper total post cue
tapply(data1$PropUp, list(data1$Treatment, data1$Sex, data1$Trial.Seconds), se)## , , 0
##
## Female Male
## Alone 0.04874832 0.04926948
## Social 0.06411608 0.04789699
##
## , , 300
##
## Female Male
## Alone 0.01516125 0.03133046
## Social 0.02653515 0.01060661
##
## , , 600
##
## Female Male
## Alone 0.04998572 0.05264925
## Social 0.05097001 0.04848639
##
## , , 900
##
## Female Male
## Alone 0.04814867 0.0695417
## Social 0.04773611 0.0518973
##
## , , 1200
##
## Female Male
## Alone 0.03825246 0.06046043
## Social 0.04782576 0.04432070
##
## , , 1500
##
## Female Male
## Alone 0.04170425 0.05425498
## Social 0.03839443 0.05174921
##
## , , 1800
##
## Female Male
## Alone 0.04271051 0.06081117
## Social 0.03903418 0.05747344
##
## , , 2100
##
## Female Male
## Alone 0.05022137 0.04781955
## Social 0.03870898 0.05516817###Graphing Total Post Cue Proportion Upper Tank Usage
str(data1)## 'data.frame': 496 obs. of 10 variables:
## $ ID : Factor w/ 62 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 2 2 ...
## $ Group : Factor w/ 18 levels "1","3","4","5",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ Sex : Factor w/ 2 levels "Female","Male": 1 1 1 1 1 1 1 1 1 1 ...
## $ Treatment : Factor w/ 2 levels "Alone","Social": 2 2 2 2 2 2 2 2 1 1 ...
## $ Stage : Factor w/ 8 levels "Baseline","Acute",..: 2 1 3 4 5 6 7 8 2 1 ...
## $ PropUp : num 0 0.321 0.192 0.182 0.229 ...
## $ PropFloor : num 0.8589 0.0434 0.4614 0.421 0.4931 ...
## $ Bodylengths.cm.: num 1.14 1.14 1.14 1.14 1.14 ...
## $ center_dist_BL : num 56.3 189 125.3 200.5 224.8 ...
## $ Trial.Seconds : num 300 0 600 900 1200 1500 1800 2100 300 0 ...##Total
PropTotStage <-ggplot(data=data1, aes(x=Trial.Seconds, y=PropUp, group = ID, colour = ID))+
geom_line(alpha = 0.4) + # Connect points for each individual across stages
geom_point(size = 2, alpha = 0.4) + # Show individual points+
stat_summary(aes(group = 1), fun = median, geom = 'line', color = 'red', size = 1.2) + # Overall mean trend line
stat_summary(aes(group = 1), fun = median, geom = 'point', color = 'black', size = 3) + # Mean points for each stage
ylim(0,1) +
xlab("Time Post Cue (s)")+
ylab("Proportion of Time in Upper Tank")+
# facet_grid(Sex~Treatment)+
theme_bw() +
theme(strip.text.x = element_text(size = 20)) +
theme(strip.text.y = element_text(size = 20)) +
theme(axis.title.y = element_text(size=20)) +
theme(axis.title.x = element_text(size=20)) +
theme(axis.text.x = element_text(size=18, color = "black")) +
theme(axis.text.y = element_text(size=18, color = "black")) +
theme(legend.position = "none",
legend.justification = c("right","top"),
legend.box.just = "right",
legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect(color = "black", size = 1)) +
theme(legend.title = element_text(size = 15, face = "bold")) +
theme(legend.text = element_text(size = 12))
PropTotStage
##Total
PropupSexTrt <- ggplot(data1, aes(x=Treatment, y=PropUp, fill = Treatment))+
geom_boxplot(size=1.4, alpha = 0.3) +
geom_point(shape=21, position=position_jitterdodge(0.7), color = "black", size = 3) +
xlab("Treatment")+
ylab("Proportion of Time in Upper Tank")+
facet_wrap(~Sex)+
theme_bw() +
theme(strip.text.x = element_text(size = 20)) +
theme(strip.text.y = element_text(size = 20)) +
theme(axis.title.y = element_text(size=20)) +
theme(axis.title.x = element_text(size=20)) +
theme(axis.text.x = element_text(size=18, color = "black")) +
theme(axis.text.y = element_text(size=18, color = "black")) +
theme(legend.position = "none",
legend.justification = c("right","top"),
legend.box.just = "right",
legend.margin = margin(6, 6, 6, 6),
legend.box.background = element_rect(color = "black", size = 1)) +
theme(legend.title = element_text(size = 15, face = "bold")) +
theme(legend.text = element_text(size = 12))
PropupSexTrt<- PropupSexTrt+ scale_fill_brewer(palette = "Set2")
PropupSexTrt
(AccitivtyAcu2 + PropupStage + PropfloorAcute) /
PropupAcute
(PropTotStage + propStageFloor) /
(PropupSexTrt + actSexTrt)## Warning: Removed 3 rows containing non-finite outside the scale range
## (`stat_summary()`).
## Removed 3 rows containing non-finite outside the scale range
## (`stat_summary()`).## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_line()`).## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_point()`).