---
title: "Pigeon Leadership Analysis"
author: "Richard P Mann"
date: "7/20/2017"
output: pdf_document
---

```{r, echo=F, message=FALSE, warning=F}
#Required Packages
library(xlsx)
library(ordinal)
library(stats)
library(forestplot)
library(plyr)
library(lme4)
source('takaStepwiseFunctions.R')
```

\section{Repeatability Analysis}
First we establish whether personality (i.e. boldness) is a repeated and consistent across trials. We will do this both for boldness defined in a binary sense, using a binomial test, and for boldness rank via a Spearman rank correlation test. We do not consider the raw response times as many trials were stopped at 600s with no response

```{r}
###Set a threshold response time (in seconds) to be considered 'bold' in a binary sense

boldness_threshold =309.5 #median is 309.5

```
\subsection{Old free flight data}
```{r}
#Load results for old (free flight) data
personality_results = read.xlsx("./finalData/TakaDataMaster.xls", sheetName="solo")
```
Process data:
```{r}
#Create binary personality variables for each of the 3 tests, 
#and also rank by mean time to respond. Remove any birds without all 3 trials present

#Rescale weight and age to zero mean, unit sd
personality_results$test1_bin = (personality_results$test1 < boldness_threshold)
personality_results$test2_bin = (personality_results$test2 < boldness_threshold)
personality_results$test3_bin = (personality_results$test3 < boldness_threshold)
personality_results$meantime = (personality_results$test1 + personality_results$test2
                                + personality_results$test3)/3
personality_results$meantime_rank =
  as.ordered(rank(personality_results$meantime, ties.method = 'average'))
personality_results = personality_results[complete.cases(personality_results),]
personality_results[, c('Weight', 'Age')] = 
  scale(personality_results[, c('Weight', 'Age')])
```
\subsubsection{Binary}
First do binomial tests for repeatability from trial 1 to 2, 2 to 3 and 1 to 3
```{r}
#Count repeaters for old data
N_old = nrow(personality_results)
num_repeat12_old = sum(personality_results$test1_bin == personality_results$test2_bin)
num_repeat23_old = sum(personality_results$test2_bin == personality_results$test3_bin)
num_repeat123_old = sum((personality_results$test1_bin == personality_results$test2_bin) &
                          (personality_results$test2_bin == personality_results$test3_bin))

#Binomial tests
p_12_old = 1-pbinom(num_repeat12_old-1, size=N_old, prob=0.5)
p_23_old = 1-pbinom(num_repeat23_old-1, size=N_old, prob=0.5)
p_123_old = 1-pbinom(num_repeat123_old-1, size=N_old, prob=0.25)
```
Test results:
```{r, echo=F}
print(paste(c('Num. repeaters 1-2: ', num_repeat12_old, ' of ', N_old), collapse=''))
print(paste(c('P = ', p_12_old), collapse=''))
print(paste(c('Num. repeaters 2-3: ', num_repeat23_old, ' of ', N_old), collapse=''))
print(paste(c('P = ', p_23_old), collapse=''))
print(paste(c('Num. repeaters 1-2-3: ', num_repeat123_old, ' of ', N_old), collapse=''))
print(paste(c('P = ', p_123_old), collapse=''))
```
\subsubsection{Ordinal}
Calculate Spearman rank correlations between ranks on subsequent trials.
```{r, warning=F}
corr_12_old = cor.test(personality_results$test1, 
                       personality_results$test2, method = 'spearman')
corr_23_old = cor.test(personality_results$test2,
                       personality_results$test3, method='spearman')
```
Test results:
```{r, echo=F}
print(paste(c('Spearman rho 1-2: ', corr_12_old$estimate), collapse=''))
print(paste(c('P =', corr_12_old$p.value), collapse=''))
print(paste(c('Spearman rho 2-3: ', corr_23_old$estimate), collapse=''))
print(paste(c('P = ', corr_23_old$p.value), collapse=''))
```

\subsection{New Data (CH and Noke)}
Load new data for personality trials
```{r}
#Load results for new data
personality_results_newdata = read.xlsx("./finalData/personality_test_2016_R.xlsx",
                                        sheetName="personality")
```
Process data:
```{r}
#Create binary personality variables for each of the 2 tests, 
#and also rank by mean time to respond. 

#Scale weigth and age to 0 mean,sd1
personality_results_newdata$test1_bin = (personality_results_newdata$test1 < boldness_threshold)
personality_results_newdata$test2_bin = (personality_results_newdata$test2 < boldness_threshold)
personality_results_newdata$meantime = (personality_results_newdata$test1 
                                        + personality_results_newdata$test2)/2
personality_results_newdata$meantime_rank = 
  as.ordered(rank(personality_results_newdata$meantime, ties.method = 'average'))

personality_results_newdata[, c('Weight', 'Age')] = 
  scale(personality_results_newdata[, c('Weight', 'Age')])
```
\subsubsection{Binary}
Do binomial tests for repeatability from trial 1 to 2
```{r}
#Count repeaters for new data
N_new = nrow(personality_results_newdata)
num_repeat12_new = sum(personality_results_newdata$test1_bin == personality_results_newdata$test2_bin)

#Binomial tests
p_12_new = 1-pbinom(num_repeat12_new-1, size=N_new, prob=0.5)
```
Test results:
```{r, echo=F}
print(paste(c('Num. repeaters 1-2: ', num_repeat12_new, ' of ', N_new), collapse=''))
print(paste(c('P = ', p_12_new), collapse=''))
```
\subsubsection{Ordinal}
Calculate Spearman rank correlations between ranks on subsequent trials.
```{r, warning=F}
corr_12_new = cor.test(personality_results_newdata$test1,
                       personality_results_newdata$test2, method = 'spearman')
```
Test results:
```{r, echo=F}
print(paste(c('Spearman rho 1-2: ', corr_12_new$estimate), collapse=''))
print(paste(c('P =', corr_12_new$p.value), collapse=''))
```

\section{Effect of age and weight on personality}
We use a logistic regression to assess whether age and weigth affect boldness in a binary sense, and we use an ordinal regression (cumulative link model) to test whether age and weight affect boldness ranking
\subsection{Old data}
\subsubsection{Binary}
Logistic regression is a generalised linear model with binomial family. Dependent variable is proprtion of trial responses which were 'bold'
```{r}
#Proportion of bold responses
personality_results$rho = (personality_results$test1_bin+personality_results$test2_bin
                           +personality_results$test3_bin)/3
#Weight matrix of number of trials
W = matrix(3, nrow=nrow(personality_results), ncol=1)
glm_model_old = glm(rho ~ Weight + Age, 
                    data = personality_results, family=binomial, weights = W)
```
Model results:
```{r, echo=F}
print(summary(glm_model_old)$coefficients)

```
\subsubsection{Ordinal}
Ordinal regression is a cumulative link model (GLM for ranked data). Dependent variable is the rank ordering of boldness
```{r}
clm_personality_old = clm(meantime_rank ~ Age + Weight, data = personality_results)
```
Model results. There is no intercept in a ranking model, and rank thresholds are excluded for brevity
```{r, echo = F}
M =summary(clm_personality_old)$coefficients
idx1 = which(row.names(M)=='Weight')
idx2 = which(row.names(M)=='Age')
print(summary(clm_personality_old)$coefficients[c(idx1, idx2),])
```
\subsubsection{Summary for old data}
No effect of age or weight on personality either in binary or ordinal analyses

\subsection{New data}
\subsubsection{Binary}
```{r}
#Proportion of bold responses
personality_results_newdata$rho =(personality_results_newdata$test1_bin
                                  +personality_results_newdata$test2_bin)/2
#Weight matrix of number of trials (2)
W_new =matrix(2, nrow=nrow(personality_results_newdata), ncol=1)
#Logistic regression
glm_model_new = glm(rho ~ Weight + Age, 
                    data = personality_results_newdata, family=binomial, weights = W_new)

```
Model results:
```{r, echo=F}
print(summary(glm_model_new)$coefficients)
```
\subsubsection{Ordinal}
Same as above but for new data
```{r}
clm_personality_new = clm(meantime_rank ~ Age + Weight, data = personality_results_newdata)
```
Model results. There is no intercept in a ranking model, and rank thresholds are excluded for brevity
```{r, echo = F}
M =summary(clm_personality_new)$coefficients
idx1 = which(row.names(M)=='Weight')
idx2 = which(row.names(M)=='Age')
print(summary(clm_personality_new)$coefficients[c(idx1, idx2),])
```
\subsubsection{Summary for new data}
In both binary and ordinal analyses there is a significant effect of weight: heavier birds are bolder. No effect of age in either analysis

\subsection{Combined data}
Merge the two data sets and define a new set of rankings by mean response time
```{r}
#Merge
all_personality_data = rbind.fill(personality_results, personality_results_newdata)
W_both = rbind(W, W_new)
#Rank boldness
all_personality_data$meantime_rank = as.ordered(rank(all_personality_data$meantime, ties.method = 'average'))
```
\subsubsection{Binary}
Logistic regression on combined data
```{r}
glm_model_all = glm(rho ~ Weight + Age, data = all_personality_data, family=binomial, weights = W_both)
```
Model results:
```{r, echo=F}
print(summary(glm_model_all)$coefficients)
```
\subsubsection{Ordinal}
Ordinal regression on combined data
```{r}
clm_personality_all = clm(meantime_rank ~ Age + Weight, data = all_personality_data)
```
Model results. There is no intercept in a ranking model, and rank thresholds are excluded for brevity
```{r, echo = F}
M =summary(clm_personality_all)$coefficients
idx1 = which(row.names(M)=='Weight')
idx2 = which(row.names(M)=='Age')
print(summary(clm_personality_all)$coefficients[c(idx1, idx2),])
```
\subsubsection{Summary for combined data}
No significant effect of age or weight on personality either in binary or ordinal analyses, though both are not far from significant in the binary analysis

\subsection{Summary for effect of age and weight on personality}
No consistent effect of either age or weight. In the new data weight has a significant effect, but not overall considering both sets of data. This is true for both binary and ordinal boldness


\section{Effect of age, weight, boldness and release number on flight characteristics in solo training (CH site)}
We test for effects on flight speed, efficiency and fidelity.
\subsection{Speed}
Load data and make aggregate object of flights
```{r}
speed_results = read.xlsx("./finalData/solo_data2 fixed.xlsx", sheetName="speed")
agg_data1 = data.frame(Speed = matrix(NA, nrow=10000, ncol=1), 
                       ID = matrix(NA, nrow=10000, ncol=1),
                       Bold = matrix(NA, nrow=10000, ncol=1),
                       Release = matrix(NA, nrow=10000, ncol=1),
                       meantime_rank = matrix(NA, nrow=1000, ncol=1))


count = 0
speed_results$ID = as.character(speed_results$ID)
for (j in 1:13){
  for (k in 1:23){
    count = count +1
    agg_data1$Speed[count] = speed_results[k, 1+j]
    agg_data1$ID[count] = speed_results$ID[k]
    agg_data1$Bold[count] = speed_results$Bold[k]
    agg_data1$Weight[count] = speed_results$Weight[k]
    agg_data1$Age[count]= speed_results$Age[k]
    agg_data1$Release[count] = j
    agg_data1$meantime_rank[count] = 
      personality_results_newdata$meantime_rank[which(personality_results_newdata$ID 
                                                    == agg_data1$ID[count])]
    
    
  }
} 
agg_data1 = agg_data1[1:count,]
agg_data1$ID = as.factor(agg_data1$ID)

ur = unique(agg_data1$meantime_rank)
rur = rank(ur)
for (i in 1:length(agg_data1$meantime_rank)){
  agg_data1$meantime_rank[i] = rur[which(ur == agg_data1$meantime_rank[i])]
}
agg_data1$meantime_rank = as.integer(agg_data1$meantime_rank)
agg_data1[, c('Weight', 'Age', 'Release')] = scale(agg_data1[, c('Weight', 'Age', 'Release')] )

```
\subsubsection{Binary}
Use a linear mixed effects model with stepwise reduction by removal of non-significant effects. Report both full model and reduced model. P-values are determined by likelihood ratio tests (Wilks’ theorem) with the relevant fixed effect present or removed.
```{r}
mymodel =stepLMER('Speed', c('Weight', 'Age', 'Bold', 'Release', 'Bold:Release', 
                            'Age:Release', 'Weight:Release'), '(1  + Release | ID)', agg_data1)
stepDownSummary(mymodel)

```
\subsubsection{Ordinal}
Same as above, but using ordinal boldness
```{r}
mymodel =stepLMER('Speed', c('Weight', 'Age', 'meantime_rank', 'Release','meantime_rank:Release', 
                            'Age:Release', 'Weight:Release'), '(1 + Release | ID)', agg_data1)

stepDownSummary(mymodel)
```

\subsection{Efficiency}
Test if route efficiency is influenced by age, weight, boldness, release number. We transform raw efficiency to make it amenable to linear modelling by an log inverse transform. Load the data and make aggregate object of all flights
```{r}
eff_results = read.xlsx("./finalData/solo_data2 fixed.xlsx", sheetName="efficiency")

eff_results$ID = as.character(eff_results$ID)


agg_data2 = data.frame(Eff = matrix(NA, nrow=10000, ncol=1), 
                       ID = matrix(NA, nrow=10000, ncol=1),
                       Bold = matrix(NA, nrow=10000, ncol=1),
                       Release = matrix(NA, nrow=10000, ncol=1),
                       meantime_rank = matrix(NA, nrow=1000, ncol=1))


count = 0

for (j in 1:13){
  for (k in 1:23){
    count = count +1
    #log inverse transform
    agg_data2$Eff[count] = log(1/eff_results[k, 1+j]-1) 
    agg_data2$ID[count] = eff_results$ID[k]
    agg_data2$Bold[count] = eff_results$Bold[k]
    agg_data2$Release[count] = j
    agg_data2$Weight[count] = eff_results$Weight[k]
    agg_data2$Age[count] = eff_results$Age[k]
    agg_data2$meantime_rank[count] =
      personality_results_newdata$meantime_rank[which(personality_results_newdata$ID 
                                                      == agg_data2$ID[count])]
    
    
  }
} 
agg_data2 = agg_data2[1:count,]
agg_data2$ID = as.factor(agg_data2$ID)

ur = unique(agg_data2$meantime_rank)
rur = rank(ur)
for (i in 1:length(agg_data2$meantime_rank)){
  agg_data2$meantime_rank[i] = rur[which(ur == agg_data2$meantime_rank[i])]
}
agg_data2$meantime_rank = as.integer(agg_data2$meantime_rank)
agg_data2[, c('Weight', 'Age', 'Release')] = scale(agg_data2[, c('Weight', 'Age', 'Release')] )

```
\subsubsection{Binary}
Use a linear mixed effects model with stepwise reduction by removal of non-significant effects. Report both full model and reduced model. P-values are determined by likelihood ratio tests (Wilks’ theorem) with the relevant fixed effect present or removed.
```{r}
mymodel =stepLMER('Eff', c('Weight', 'Age', 'Bold', 'Release', 'Bold:Release', 
                            'Age:Release', 'Weight:Release'), '(1 + Release | ID)', agg_data2)

stepDownSummary(mymodel)

```
\subsubsection{Ordinal}
Same as above, but using ordinal boldness
```{r}
mymodel =stepLMER('Eff', c('Weight', 'Age', 'meantime_rank', 'Release', 'meantime_rank:Release', 
                            'Age:Release', 'Weight:Release'), '(1 + Release | ID)', agg_data2)

stepDownSummary(mymodel)

```

\subsection{Fidelity}
Test if route fidelity is influenced by age, weight, boldness, release number. We transform raw fidelity to make it amenable to linear modelling by a log inverse transform. Load the data and make aggregate object of all flights

```{r}
fid_results = read.xlsx("./finalData/solo_data2 fixed.xlsx", sheetName="fidelity")
agg_data3 = data.frame(Fid = matrix(NA, nrow=10000, ncol=1), 
                       ID = matrix(NA, nrow=10000, ncol=1),
                       Bold = matrix(NA, nrow=10000, ncol=1),
                       Release = matrix(NA, nrow=10000, ncol=1),
                       meantime_rank = matrix(NA, nrow=1000, ncol=1))

count = 0
fid_results$ID = as.character(fid_results$ID)
for (j in 1:12){
  for (k in 1:23){
    count = count +1
    #log inverse transform
    agg_data3$Fid[count] = log(fid_results[k, 1+j])
    agg_data3$ID[count] = fid_results$ID[k]
    agg_data3$Bold[count] = fid_results$Bold[k]
    agg_data3$Release[count] = j+1
    agg_data3$Weight[count] = fid_results$Weight[k]
    agg_data3$Age[count]= fid_results$Age[k]
    agg_data3$meantime_rank[count] = 
      personality_results_newdata$meantime_rank[which(personality_results_newdata$ID 
                                                      == agg_data3$ID[count])]
  }                                                                             
} 
agg_data3 = agg_data3[1:count,]
agg_data3$ID = as.factor(agg_data3$ID)

ur = unique(agg_data3$meantime_rank)
rur = rank(ur)
for (i in 1:length(agg_data3$meantime_rank)){
  agg_data3$meantime_rank[i] = rur[which(ur == agg_data3$meantime_rank[i])]
}
agg_data3$meantime_rank = as.integer(agg_data3$meantime_rank)
agg_data3[, c('Weight', 'Age', 'Release')] = scale(agg_data3[, c('Weight', 'Age', 'Release')] )

```
\subsubsection{Binary}
Use a linear mixed effects model with stepwise reduction by removal of non-significant effects. Report both full model and reduced model. P-values are determined by likelihood ratio tests (Wilks’ theorem) with the relevant fixed effect present or removed.
```{r}
mymodel =stepLMER('Fid', c('Weight', 'Age', 'Bold', 'Release', 'Bold:Release', 
                            'Age:Release', 'Weight:Release'), '(1 + Release | ID)', agg_data3)

stepDownSummary(mymodel)


```
\subsubsection{Ordinal}
Same as above, but using ordinal boldness
```{r}
mymodel =stepLMER('Fid', c('Weight', 'Age', 'meantime_rank', 'Release', 'meantime_rank:Release', 
                            'Age:Release', 'Weight:Release'), '(1 + Release | ID)', agg_data3)

stepDownSummary(mymodel)

```
\section{Leadership rankings}
\subsection{Old (free flight) data}

Load data from the three groups
```{r}
#load data
group1= read.xlsx("./finalData/TakaDataMaster.xls", sheetName = "1st group")
group2 = read.xlsx("./finalData/TakaDataMaster.xls", sheetName = "2nd group")
group3 = read.xlsx("./finalData/TakaDataMaster.xls", sheetName = "3rd group")
groups = list(group1, group2, group3)
```
Make an aggregated data object across all flights. 
```{r}
#Construct aggregated data frame
count = 0;
agg_data_free = data.frame(Rank = matrix(NA, nrow=10000, ncol=1), 
                      ID = matrix(NA, nrow=10000, ncol=1),
                      Weight = matrix(NA, nrow=10000, ncol=1),
                      Age = matrix(NA, nrow=10000, ncol=1),
                      Bold = matrix(NA, nrow=10000, ncol=1),
                      meantime_rank = matrix(NA, nrow=1000, ncol=1),
                      meantime = matrix(NA, nrow=1000, ncol=1),
                      Release = matrix(NA, nrow=1000, ncol=1))
for (i in 1:3){
 
  G = groups[[i]]
  G$ID = as.character(G$ID)
    for (j in 2:(ncol(G)-4)){
      for (k in 1:10){
        count = count +1
      agg_data_free$Rank[count] = G[k, 1+j]
      agg_data_free$ID[count] = G$ID[k]
      agg_data_free$Weight[count] = G$Weight[k] 
      agg_data_free$Age[count] = G$Age[k]
      #agg_data_free$Bold[count] = G$Bold[k]
      agg_data_free$Bold[count] = as.double(personality_results$meantime[which(personality_results$ID == agg_data_free$ID[count])] < boldness_threshold)
      agg_data_free$meantime_rank[count] = personality_results$meantime_rank[which(personality_results$ID == agg_data_free$ID[count])]
      agg_data_free$meantime[count] = personality_results$meantime[which(personality_results$ID == agg_data_free$ID[count])]
      agg_data_free$Release[count] = j-1
      }
    } 
}
agg_data_free = agg_data_free[1:count,]
agg_data_free$ID = as.factor(agg_data_free$ID)
agg_data_free$Rank = as.ordered(agg_data_free$Rank)

ur = unique(agg_data_free$meantime_rank)
rur = rank(ur)
for (i in 1:length(agg_data_free$meantime_rank)){
  agg_data_free$meantime_rank[i] = rur[which(ur == agg_data_free$meantime_rank[i])]
}

agg_data_free[, c('Weight', 'Age', 'Release')] = scale(agg_data_free[, c('Weight', 'Age', 'Release')] )

```
\subsubsection{Binary}

Perform an ordinal regression with random effect on bird ID and fixed effects of age, weight and boldness (binary), along with interactions of these with release, and print model results for each group. We use stepwise removal of non-significant effects and present results from the full and reduced model. P-values are determined by likelihood ratio tests (Wilks’ theorem) with the relevant fixed effect present or removed.
```{r}
mymodel =stepCLMM('Rank', c('Weight', 'Age', 'Bold', 'Bold:Release', 
                            'Age:Release', 'Weight:Release'), '(1 | ID)', agg_data_free)

stepDownSummary(mymodel)

```

\subsubsection{Ordinal}
Same as above, but we use boldness rank rather than binary boldness

```{r}
mymodel =stepCLMM('Rank', c('Weight', 'Age', 'meantime_rank', 'meantime_rank:Release', 
                            'Age:Release', 'Weight:Release'), '(1 | ID)', agg_data_free)

stepDownSummary(mymodel)

```
\subsubsection{Summary of free flight leadership tests}
For both binary and ordinal boldness, full models show a strongly significant effect of boldness on leadership rank. Stepwise reduction of non-significant effects in both cases reduces the model to only boldness as a relevant factor.

\subsection{Navigational flight, unfamiliar site (Noke)}
Load data and construct aggregate object of all flights
```{r}
#First download Speed data to add as an individual characteristic where appropriate
speed_results = read.xlsx("./finalData/solo_data2 fixed.xlsx", sheetName="speed")
speed_results$meanspeed = rowMeans(speed_results[, 2:14], na.rm = T)

G = read.xlsx("./finalData/summary_noke_R3 fixed.xlsx", sheetName="Sheet1")

agg_data_noke = data.frame(Rank = matrix(NA, nrow=10000, ncol=1), 
                      ID = matrix(NA, nrow=10000, ncol=1),
                      Bold = matrix(NA, nrow=10000, ncol=1),
                      Age = matrix(NA, nrow=10000, ncol=1),
                      Weight = matrix(NA, nrow=10000, ncol=1),
                      rho = matrix(NA, nrow=10000, ncol=1),
                      meantime_rank = matrix(NA, nrow=10000, ncol=1))


count = 0
G$PigeonID = as.character(G$PigeonID)
G$r1 = as.double(G$r1)
G$r2 = as.double(G$r2)
G$r3 = as.double(G$r3)
G$r4 = as.double(G$r4)
G$r5 = as.double(G$r5)
G$r6 = as.double(G$r6)
G$r7 = as.double(G$r7)
for (j in 1:7){
  for (k in 1:19){
    count = count +1
    agg_data_noke$Rank[count] = G[k, 1+j]
    agg_data_noke$ID[count] = G$PigeonID[k]
    agg_data_noke$Bold[count] = G$Bold[k]
    agg_data_noke$Release[count] = j
    
    agg_data_noke$Weight[count] = G$Weight[k]
    agg_data_noke$Age[count] = G$Age[k]
    agg_data_noke$meantime_rank[count] = 
      personality_results_newdata$meantime_rank[which(personality_results_newdata$ID == agg_data_noke$ID[count])]
    agg_data_noke$Bold[count] = 
      as.double(personality_results_newdata$meantime[which(personality_results_newdata$ID == agg_data_noke$ID[count])] < boldness_threshold)
    agg_data_noke$Speed[count] = speed_results$meanspeed[which(speed_results$ID == agg_data_noke$ID[count])]

    
    
  }
} 

agg_data_noke = agg_data_noke[1:count,]
agg_data_noke$ID = as.factor(agg_data_noke$ID)
agg_data_noke$Rank = as.ordered(agg_data_noke$Rank)

ur = unique(agg_data_noke$meantime_rank)
rur = rank(ur)
for (i in 1:length(agg_data_noke$meantime_rank)){
  agg_data_noke$meantime_rank[i] = rur[which(ur == agg_data_noke$meantime_rank[i])]
}

agg_data_noke[, c('Weight', 'Age', 'Release', 'Speed')] = scale(agg_data_noke[, c('Weight', 'Age', 'Release', 'Speed')] )

```
\subsubsection{Binary}
Perform an ordinal regression with random effect on bird ID and fixed effects of age, weight and boldness (binary), along with interactions of these with release, and print model results for each group. We use stepwise removal of non-significant effects and present results from the full and reduced model. P-values are determined by likelihood ratio tests (Wilks’ theorem) with the relevant fixed effect present or removed.
```{r}
mymodel =stepCLMM('Rank', c('Weight', 'Age', 'Bold', 'Speed', 'Bold:Release', 
                            'Age:Release', 'Weight:Release', 'Speed:Release'), '(1 | ID)', agg_data_noke)

stepDownSummary(mymodel)

```
\subsubsection{Ordinal}
Same as above, but we use boldness rank rather than binary boldness

```{r}
mymodel =stepCLMM('Rank', c('Weight', 'Age', 'meantime_rank', 'Speed', 'meantime_rank:Release', 
                            'Age:Release', 'Weight:Release', 'Speed:Release'), '(1 | ID)', agg_data_noke)

stepDownSummary(mymodel)

```
\subsection{Navigational flight, familiar site (CH)}
Load data and construct aggregate object of all flights
```{r}
#First download Speed data to add as an individual characteristic where appropriate
speed_results = read.xlsx("./finalData/solo_data2 fixed.xlsx", sheetName="speed")
speed_results$meanspeed = rowMeans(speed_results[, 2:14], na.rm = T)

G = read.xlsx("./finalData/summary_ch_R3 fixed.xlsx", sheetName="Sheet1")

agg_data_ch = data.frame(Rank = matrix(NA, nrow=10000, ncol=1), 
                      ID = matrix(NA, nrow=10000, ncol=1),
                      rho = matrix(NA, nrow=10000, ncol=1),
                      Bold = matrix(NA, nrow=10000, ncol=1),
                      Weight= matrix(NA, nrow=10000, ncol=1),
                      Age = matrix(NA, nrow=10000, ncol=1),
                      meantime_rank = matrix(NA, nrow=10000, ncol=1), 
                      Speed =  matrix(NA, nrow=10000, ncol=1))

count = 0
G$PigeonID = as.character(G$PigeonID)
G$X1 = as.double(G$X1)
G$X2 = as.double(G$X2)
G$X3 = as.double(G$X3)
G$X4 = as.double(G$X4)
for (j in 1:4){
  for (k in 1:23){
    
    count = count +1
    agg_data_ch$Rank[count] = G[k, 1+j]
    agg_data_ch$ID[count] = G$PigeonID[k]
    agg_data_ch$Weight[count] = G$Weight[k]
    agg_data_ch$Age[count] = G$Age[k]
    agg_data_ch$Release[count] = j
    agg_data_ch$meantime_rank[count] = 
      personality_results_newdata$meantime_rank[which(personality_results_newdata$ID == agg_data_ch$ID[count])]
    agg_data_ch$Bold[count] = 
      as.double(personality_results_newdata$meantime[which(personality_results_newdata$ID == agg_data_ch$ID[count])] < boldness_threshold)
    agg_data_ch$Speed[count] = speed_results$meanspeed[which(speed_results$ID == agg_data_ch$ID[count])]
  
    
    
  }
} 

agg_data_ch = agg_data_ch[1:count,]
agg_data_ch$ID = as.factor(agg_data_ch$ID)
agg_data_ch$Rank = as.ordered(agg_data_ch$Rank)

ur = unique(agg_data_ch$meantime_rank)
rur = rank(ur)
for (i in 1:length(agg_data_ch$meantime_rank)){
  agg_data_ch$meantime_rank[i] = rur[which(ur == agg_data_ch$meantime_rank[i])]
}

agg_data_ch[, c('Weight', 'Age', 'Release', 'Speed')] =  scale(agg_data_ch[, c('Weight', 'Age', 'Release', 'Speed')])

```
\subsubsection{Binary}
Perform an ordinal regression with random effect on bird ID and fixed effects of age, weight and boldness (binary), along with interactions of these with release, and print model results for each group. We use stepwise removal of non-significant effects and present results from the full and reduced model. P-values are determined by likelihood ratio tests (Wilks’ theorem) with the relevant fixed effect present or removed.
```{r}
mymodel =stepCLMM('Rank', c('Weight', 'Age', 'Bold', 'Speed', 'Bold:Release', 
                            'Age:Release', 'Weight:Release', 'Speed:Release'), '(1 | ID)', agg_data_ch)

stepDownSummary(mymodel)

```
\subsubsection{Ordinal}
Same as above, but we use boldness rank rather than binary boldness

```{r}
mymodel =stepCLMM('Rank', c('Weight', 'Age', 'meantime_rank', 'Speed', 'meantime_rank:Release', 
                            'Age:Release', 'Weight:Release', 'Speed:Release'), '(1 | ID)', agg_data_ch)

stepDownSummary(mymodel)

```
\subsection{Leadership summary}
In all 3 contexts, boldness (binary or ordinal) is clearly significant as a factor presicting leadership rank - bolder birds tend to occupy higher leadership positions

Speed selected at Noke (unfamilair site). No other factors selected.

No clear evidence whether binary or ordinal boldness is more predictive

\section{Code to make figures}
\subsection{Free flights leadership}
```{r}
#Make histogram plot for old (free) data
idx1 = which(agg_data_free$Bold == 1)
idx0 = which(agg_data_free$Bold == 0)
N_Bold = rep(NA, as.double(max(agg_data_free$Rank, na.rm = T)))
N_Shy = N_Bold
for (r in 1:as.double(max(agg_data_free$Rank, na.rm = T))){
  N_Bold[r] = sum(agg_data_free$Rank[idx1] == r, na.rm=TRUE)/
    sum(agg_data_free$Rank == r, na.rm=TRUE)
  N_Shy[r] = sum(agg_data_free$Rank[idx0] == r, na.rm=TRUE)/
    sum(agg_data_free$Rank == r, na.rm=TRUE)
}

Proportions = rbind(N_Bold, N_Shy)
#Create pdf
postscript("./finalPlots/free_bars.eps", 
           width=8, height = 8, horizontal = FALSE, 
           onefile = FALSE, paper = "special")

barplot(Proportions, beside=TRUE, ylim = c(0, 1),
        names.arg = 1:as.double(max(agg_data_free$Rank, na.rm = T)), 
        xlab="Rank", ylab="Proportion of bird-flights", legend=c("Bold", "Shy"), 
        args.legend = list(x="top"))

dev.off()
#Plot in documents
barplot(Proportions, beside=TRUE, ylim = c(0, 1),
        names.arg = 1:as.double(max(agg_data_free$Rank, na.rm = T)), 
        xlab="Rank", ylab="Proportion of bird-flights", legend=c("Bold", "Shy"), 
        args.legend = list(x="top"))
```
\subsection{Navigational unfamiliar site (Noke) leadership}
```{r}
#Make histogram plot for new (noke) data
idx1 = which(agg_data_noke$Bold == 1)
idx0 = which(agg_data_noke$Bold == 0)
N_Bold = rep(NA, as.double(max(agg_data_noke$Rank, na.rm = T)))
N_Shy = N_Bold
for (r in 1:as.double(max(agg_data_noke$Rank, na.rm = T))){
  N_Bold[r] = sum(agg_data_noke$Rank[idx1] == r, na.rm=TRUE)/
    sum(agg_data_noke$Rank == r, na.rm=TRUE)
  N_Shy[r] = sum(agg_data_noke$Rank[idx0] == r, na.rm=TRUE)/
    sum(agg_data_noke$Rank == r, na.rm=TRUE)
}

Proportions = rbind(N_Bold, N_Shy)
#Create pdf
postscript("./finalPlots/noke_bars.eps", 
           width=8, height = 8, horizontal = FALSE, 
           onefile = FALSE, paper = "special")

barplot(Proportions, beside=TRUE, ylim = c(0, 1), 
        names.arg = 1:as.double(max(agg_data_noke$Rank, na.rm = T)), 
        xlab="Rank", ylab="Proportion of bird-flights", legend=c("Bold", "Shy"), 
        args.legend = list(x="top"))

dev.off()
#plot in document
barplot(Proportions, beside=TRUE, ylim = c(0, 1), 
        names.arg = 1:as.double(max(agg_data_noke$Rank, na.rm = T)), 
        xlab="Rank", ylab="Proportion of bird-flights", legend=c("Bold", "Shy"), 
        args.legend = list(x="top"))

```
\subsection{Navigational famailiar site (CH) leadership}
```{r}
#Make histogram plot for new (ch) data
idx1 = which(agg_data_ch$Bold == 1)
idx0 = which(agg_data_ch$Bold == 0)
N_Bold = rep(NA, as.double(max(agg_data_ch$Rank, na.rm = T)))
N_Shy = N_Bold
for (r in 1:as.double(max(agg_data_ch$Rank, na.rm = T))){
  N_Bold[r] = sum(agg_data_ch$Rank[idx1] == r, na.rm=TRUE)/sum(agg_data_ch$Rank == r, na.rm=TRUE)
  N_Shy[r] = sum(agg_data_ch$Rank[idx0] == r, na.rm=TRUE)/sum(agg_data_ch$Rank == r, na.rm=TRUE)
}

Proportions = rbind(N_Bold, N_Shy)
#Create pdf
postscript("./finalPlots/ch_bars.eps", 
           width=8, height = 8, horizontal = FALSE,
           onefile = FALSE, paper = "special")

barplot(Proportions, beside=TRUE, ylim = c(0, 1), 
        names.arg = 1:as.double(max(agg_data_ch$Rank, na.rm = T)), 
        xlab="Rank", ylab="Proportion of bird-flights", legend=c("Bold", "Shy"), 
        args.legend = list(x="top"))

dev.off()
#Plot in document
barplot(Proportions, beside=TRUE, ylim = c(0, 1), 
        names.arg = 1:as.double(max(agg_data_ch$Rank, na.rm = T)), 
        xlab="Rank", ylab="Proportion of bird-flights", legend=c("Bold", "Shy"), 
        args.legend = list(x="top"))
```

