I considered females to be exhibited bias, or otherwise not particpating in my experiment if they did one of two things: if they spent more than 75% of 10 minutes where male stimuli were present on one side of the tank, and if they spent more than 50% of the time in the neutral zone of the tank during that same 10 minute period.
There are a couple different ways I could do this. For now, I’ll just use the .txt file saved by the tracking script.
# change working directories
volume = "/Volumes/ORIN/transitivity_trials/"
setwd(volume)
files <- list.files(path=volume,pattern = "[leO231].txt",full.names = T)
files[1:5]
## [1] "/Volumes/ORIN/transitivity_trials//Aaliyah_intermediate_vs_large.txt"
## [2] "/Volumes/ORIN/transitivity_trials//Aaliyah_large_vs_small.txt"
## [3] "/Volumes/ORIN/transitivity_trials//Aaliyah_small_vs_intermediate_REDO.txt"
## [4] "/Volumes/ORIN/transitivity_trials//Aaliyah_small_vs_intermediate_REDO2.txt"
## [5] "/Volumes/ORIN/transitivity_trials//Aaliyah_small_vs_intermediate.txt"
# initialize data frame
results <- matrix(rep(rep(NA, length(files)),16), ncol=16) %>% as.data.frame
names(results) <- c("pathname", "name" , "trial_id", "type_of_trial","background1_left","background1_neutral","background1_right","background2_left","background2_neutral","background2_right","males1_left","males1_neutral","males1_right","males2_left","males2_neutral","males2_right")
# get rid of files that have "remade" in them; this is temporary
for(i in 1:length(files)){
if(length(grep("remade",files[i])) > 0){
files <- files[-i]
}
}
# loop through output files
for(i in 1:length(files)){
x <- read.table(files[i], fill=TRUE) %>% .[,1] %>% as.vector %>% factor
results$pathname[i] <- pathname <- strsplit(files[i],"//")[[1]][2]
y <- strsplit(pathname, "_")[[1]] %>% tolower
type_of_triall <- paste(y[2:4],collapse="_")
results$type_of_trial[i] <- strsplit(type_of_triall,"[.]")[[1]][1]
n <- y[1]
#print(n)
results$name[i] <- n
v <- strsplit(files[i],"//")[[1]][2] %>% strsplit(.,"\\.") %>% .[[1]]
results$trial_id[i] <- v[1] %>% tolower
#print(files[i])
# figure out which frame define the different parts of the trial:
frame_end_background_1 <- floor(length(x)*0.2381)
frame_start_males_1 <- frame_end_background_1 + 1
frame_end_males1 <- floor(length(x)*0.4762)
frame_starts_males2 <- floor(length(x)*0.5238)
frame_end_males2 <- floor(length(x)*0.7619)
frame_start_backgroud2 <- frame_end_males2 + 1
# subset the dataframe into parts
background1 <- x[1:frame_end_background_1]
males1 <- x[frame_start_males_1:frame_end_males1]
males2 <- x[frame_starts_males2:frame_end_males2]
background2 <- x[frame_start_backgroud2:length(x)]
results$background1_left[i] <- summary(factor(background1))["left"][[1]]
results$background1_neutral[i] <- summary(factor(background1))["neutral"][[1]]
results$background1_right[i] <- summary(factor(background1))["right"][[1]]
results$background2_left[i] <- summary(factor(background2))["left"][[1]]
results$background2_neutral[i] <- summary(factor(background2))["neutral"][[1]]
results$background2_right[i] <- summary(factor(background2))["right"][[1]]
results$males1_left[i] <- summary(factor(males1))["left"][[1]]
results$males1_neutral[i] <- summary(factor(males1))["neutral"][[1]]
results$males1_right[i] <- summary(factor(males1))["right"][[1]]
results$males2_left[i] <- summary(factor(males2))["left"][[1]]
results$males2_neutral[i] <- summary(factor(males2))["neutral"][[1]]
results$males2_right[i] <- summary(factor(males2))["right"][[1]]
}
# replace NAs with zeros
results[is.na(results)] <- 0
#results$trial_id <- with(results, paste(name,type_of_trial, sep="_"))
head(results)
## pathname name
## 1 Aaliyah_intermediate_vs_large.txt aaliyah
## 2 Aaliyah_large_vs_small.txt aaliyah
## 3 Aaliyah_small_vs_intermediate_REDO.txt aaliyah
## 4 Aaliyah_small_vs_intermediate_REDO2.txt aaliyah
## 5 Aaliyah_small_vs_intermediate.txt aaliyah
## 6 Adeline_Intermediate_vs_Large.txt adeline
## trial_id type_of_trial
## 1 aaliyah_intermediate_vs_large intermediate_vs_large
## 2 aaliyah_large_vs_small large_vs_small
## 3 aaliyah_small_vs_intermediate_redo small_vs_intermediate
## 4 aaliyah_small_vs_intermediate_redo2 small_vs_intermediate
## 5 aaliyah_small_vs_intermediate small_vs_intermediate
## 6 adeline_intermediate_vs_large intermediate_vs_large
## background1_left background1_neutral background1_right background2_left
## 1 76 2134 783 1164
## 2 646 1229 1120 1281
## 3 137 1723 1136 88
## 4 58 2875 55 190
## 5 76 2921 0 629
## 6 444 1877 666 308
## background2_neutral background2_right males1_left males1_neutral
## 1 253 1577 1361 1009
## 2 537 1178 616 413
## 3 298 2611 657 400
## 4 702 2097 0 1556
## 5 916 1453 0 521
## 6 1439 1241 1101 914
## males1_right males2_left males2_neutral males2_right
## 1 624 1518 529 948
## 2 1967 1130 398 1469
## 3 1939 46 39 2912
## 4 1432 536 1815 638
## 5 2477 527 337 2135
## 6 973 2120 346 523
# number of fish tested
results$name %>% factor %>% levels %>% unique %>% length # 40
## [1] 40
total_trials <- nrow(results)
total_females <- results$name %>% factor %>% levels %>% unique %>% length
Now I’ll merge this data from the logging spreadsheet that contains things like the size of the female, the date and time of the trials, etc.
# merge with trial logging dataset
trial_data<-read.csv("/Users/lukereding/Documents/transitivities/trial_data.csv",header=T)
trial_data$female %<>% tolower
trial_data$trial_id <- with(trial_data, paste(female,test, sep="_")) %>% tolower
head(trial_data); nrow(trial_data)
## female test date time.of.trial weight sl
## 1 madeline intermediate_vs_large 9/28/15 11:00 0.62 25.6
## 2 madeline small_vs_intermediate 9/30/15 10:00 0.81 26.4
## 3 madeline large_vs_small 10/2/15 10:30 0.59 26.1
## 4 lottie small_vs_intermediate 9/28/15 11:35 0.98 28.3
## 5 lottie intermediate_vs_large 9/30/15 10:40 0.67 29.5
## 6 lottie large_vs_small 10/2/15 11:10 0.68 27.5
## water_temp male_left_side_part_4 male_right_side_part_4 name bias
## 1 80.8 large intermediate luke no
## 2 81.2 intermediate small joe no
## 3 80.1 small large joe no
## 4 80.3 small intermediate luke no
## 5 80.6 intermediate large joe no
## 6 80.0 large small joe no
## include trial_id
## 1 yes madeline_intermediate_vs_large
## 2 yes madeline_small_vs_intermediate
## 3 yes madeline_large_vs_small
## 4 yes lottie_small_vs_intermediate
## 5 yes lottie_intermediate_vs_large
## 6 yes lottie_large_vs_small
## [1] 134
# get rid of trials with evidence of bias:
trial_data %<>% filter(include=="yes")
# merge dataframes together
trials <- merge(trial_data,results,by="trial_id")
nrow(trials)
## [1] 76
There were a total of 32 females that were tested and had at least 1 or 3 tests that passed our criteria and a total of 76 that passed our criteria.
Now let’s find the number of females who passed all three dichotomous choice tests:
(remaining_females <- trials %>% group_by(female) %>% tally %>% filter(n==3))
## Source: local data frame [18 x 2]
##
## female n
## (chr) (int)
## 1 arianna 3
## 2 ashanti 3
## 3 caitlyn 3
## 4 carrie 3
## 5 cherie 3
## 6 danica 3
## 7 effie 3
## 8 eliza 3
## 9 erika 3
## 10 jordyn 3
## 11 kim 3
## 12 lottie 3
## 13 madeline 3
## 14 madyson 3
## 15 nettie 3
## 16 sara 3
## 17 sierra 3
## 18 tamara 3
This is a bit disappointing.
Let’s restrict the dataset only to these females:
remaining_females <- trials %>% group_by(female) %>% tally %>% filter(n==3) %>% select(female) %>% t %>% as.vector
trials %<>% filter(female %in% remaining_females)
# drop unnec. columns
drops <- c("include", "name.y", "bias")
trials <- trials[ , !(names(trials) %in% drops)]
trials %<>% mutate(frames_male_left_part4 = males2_left + males1_right)
trials %<>% mutate(frames_male_right_part4 = males2_right + males1_left)
trials %<>% mutate(background_left = background1_left + background2_left)
trials %<>% mutate(background_right = background1_right + background2_right)
trials %<>% mutate(frames_large = ifelse(male_left_side_part_4 == "large", frames_male_right_part4, ifelse(male_right_side_part_4 == "large", frames_male_left_part4, NA)))
trials %<>% mutate(frames_small = ifelse(male_left_side_part_4 == "small", frames_male_right_part4, ifelse(male_right_side_part_4 == "small", frames_male_left_part4, NA)))
trials %<>% mutate(frames_intermediate = ifelse(male_left_side_part_4 == "intermediate", frames_male_right_part4, ifelse(male_right_side_part_4 == "intermediate", frames_male_left_part4, NA)))
# calculate preference
trials %<>% mutate(preference = ifelse(is.na(frames_large), frames_intermediate / (frames_small + frames_intermediate),ifelse(is.na(frames_small), frames_large / (frames_intermediate + frames_large), frames_large / (frames_large+frames_small))))
pref <- trials %>% select(preference, type_of_trial,female) %>% data.frame
pref$type_of_trial %<>% factor(levels=c("small_vs_intermediate", "intermediate_vs_large", "large_vs_small"))
Let’s plot some things:
violinplot2(pref, height = 0.1, xlab="trial type", ylab="proportion of time with larger male",cex.lab=1.4, main="overall trends")
## [1] "data frame"
## [1] "number of groups: 3"
## [1] "#3B528BFF" "#21908CFF" "#5DC963FF"
## [[1]]
## dat groups V3
## 1: 0.62291000 small_vs_intermediate arianna
## 2: 0.42315839 small_vs_intermediate ashanti
## 3: 0.32496589 small_vs_intermediate caitlyn
## 4: 0.70929812 small_vs_intermediate carrie
## 5: 0.40259740 small_vs_intermediate cherie
## 6: 0.56711782 small_vs_intermediate danica
## 7: 0.58938153 small_vs_intermediate effie
## 8: 0.74151389 small_vs_intermediate eliza
## 9: 0.89127079 small_vs_intermediate erika
## 10: 0.56789578 small_vs_intermediate jordyn
## 11: 0.76832257 small_vs_intermediate kim
## 12: 0.37181996 small_vs_intermediate lottie
## 13: 0.92586638 small_vs_intermediate madeline
## 14: 0.49290780 small_vs_intermediate madyson
## 15: 0.63126649 small_vs_intermediate nettie
## 16: 0.33318872 small_vs_intermediate sara
## 17: 0.03080569 small_vs_intermediate sierra
## 18: 0.34809098 small_vs_intermediate tamara
## 19: 0.63741423 intermediate_vs_large arianna
## 20: 0.52508704 intermediate_vs_large ashanti
## 21: 0.71562025 intermediate_vs_large caitlyn
## 22: 0.53542781 intermediate_vs_large carrie
## 23: 0.55728226 intermediate_vs_large cherie
## 24: 0.39451297 intermediate_vs_large danica
## 25: 0.68092364 intermediate_vs_large effie
## 26: 0.66632359 intermediate_vs_large eliza
## 27: 0.63278328 intermediate_vs_large erika
## 28: 0.46938776 intermediate_vs_large jordyn
## 29: 0.57481899 intermediate_vs_large kim
## 30: 0.68417695 intermediate_vs_large lottie
## 31: 0.38133533 intermediate_vs_large madeline
## 32: 0.51913357 intermediate_vs_large madyson
## 33: 0.28080340 intermediate_vs_large nettie
## 34: 0.56549965 intermediate_vs_large sara
## 35: 0.27977548 intermediate_vs_large sierra
## 36: 0.60109589 intermediate_vs_large tamara
## 37: 0.59168242 large_vs_small arianna
## 38: 0.54401503 large_vs_small ashanti
## 39: 0.60428202 large_vs_small caitlyn
## 40: 0.74904141 large_vs_small carrie
## 41: 0.56109248 large_vs_small cherie
## 42: 0.80751853 large_vs_small danica
## 43: 0.75315006 large_vs_small effie
## 44: 0.57077626 large_vs_small eliza
## 45: 0.34640073 large_vs_small erika
## 46: 0.49552506 large_vs_small jordyn
## 47: 0.75592276 large_vs_small kim
## 48: 0.51607111 large_vs_small lottie
## 49: 0.77741819 large_vs_small madeline
## 50: 0.59424920 large_vs_small madyson
## 51: 0.70905350 large_vs_small nettie
## 52: 0.26692836 large_vs_small sara
## 53: 0.54014460 large_vs_small sierra
## 54: 0.30761473 large_vs_small tamara
## dat groups V3
##
## [[2]]
## [1] "small_vs_intermediate" "intermediate_vs_large" "large_vs_small"
abline(0.5,0)
pref %<>% spread(female, preference) %>% arrange(type_of_trial)
# empty plot
plot(c(0.8,3.2), c(0,1), type="n", bty="n", xaxt="n",xlab="trial type", cex.lab=1.5, ylab="proportion of time with larger male", main="individual variation")
# add lines for individuals
colors <- viridis(ncol(pref)+3)
# transpose the data frame for easier plotting
x<-t(as.data.frame(pref))
colnames(x) <- x[1,]
x <- x[-1,]
x %<>% as.data.table
for(i in 1:nrow(x)){
lines(c(1,2), c(x$small_vs_intermediate[i], x$intermediate_vs_large[i]),col=colors[i],lwd=1.5)
lines(c(2,3), c(x$intermediate_vs_large[i], x$large_vs_small[i]),col=colors[i], lwd=1.5)
}
mtext("small vs intermediate", side=1, at=1)
mtext("intermediate vs large", side=1, at=2)
mtext("small vs large", side=1, at=3)
abline(0.5,0)
# another way
plot(c(0.8,3.2), c(0,1), type="n", bty="n", xaxt="n",xlab="trial type", cex.lab=1.5, ylab="proportion of time with larger male", main="individual variation")
points(rep(1,nrow(x)) %>% jitter(amount=0.09), x$small_vs_intermediate,pch=letters,col=plasma(nrow(x)+5), cex=1.2)
points(rep(2,nrow(x)) %>% jitter(amount=0.09), x$intermediate_vs_large,pch=letters,col=plasma(nrow(x)+5), cex=1.2)
points(rep(3,nrow(x)) %>% jitter(amount=0.09), x$large_vs_small,pch=letters,col=plasma(nrow(x)+5), cex=1.2)
mtext("small vs intermediate", side=1, at=1)
mtext("intermediate vs large", side=1, at=2)
mtext("small vs large", side=1, at=3)
abline(0.5,0)
We might want to know whether, overall, the proportion of time spent with the larger male differed from 0.5 in each trial type:
x <- pref %>% gather(female,preference,arianna:tamara) %>% as.data.table
x %>% setkey(type_of_trial, female)
x[,t.test(preference, mu=0.5), by=type_of_trial][c(1,3,5),]
## type_of_trial statistic parameter p.value conf.int
## 1: small_vs_intermediate 0.7775363 17 0.44752854 0.4293313
## 2: intermediate_vs_large 1.2479879 17 0.22895200 0.4730906
## 3: large_vs_small 2.1867357 17 0.04303188 0.5029135
## estimate null.value alternative method data.name
## 1: 0.5412432 0.5 two.sided One Sample t-test preference
## 2: 0.5389668 0.5 two.sided One Sample t-test preference
## 3: 0.5828270 0.5 two.sided One Sample t-test preference