#===========================================================================# # Discrete choice modelling of natal dispersal: # # "Choosing" where to breed from a finite set of available areas 2015 # # Michalis Vardakis, # # Peter Goos, Frank Adriaensen & Erik Matthysen # #===========================================================================# ### Year selection for training and test set rawD<-read.csv("pmraw.csv",header=T,sep=",") save(rawD,file="rawD.Rdata") # 1022x10 Individuals x alternatives str(rawD) years<-1996:2011 # Random selected year Training:Test (12:4) TestyearsC<-c(1996,2001,2006,2011) TrainyearsC<-years[!is.element(years,TestyearsC)] # Only the chosen lines 1022x1 wide format stay<-subset(rawD,rawD$real==1) str(stay) # Training Set stay2<-subset(stay,stay$winter%in%Trainyears) # Test set stay2cv<-subset(stay,stay$winter%in%Testyears) write.csv(stay2,"stay2.csv") write.csv(stay2cv,"stay2cv.csv") # Long format all the alternatives # Training Set PM2<-subset(rawD,rawD$winter%in%Trainyears) # Test set PM2cv<-subset(rawD,rawD$winter%in%Testyears) write.csv(PM2,"parus2.csv") write.csv(PM2cv,"parus2cv.csv") rm(list=ls(all=TRUE)) ###################### Training set ########################################## rm(list=ls(all=TRUE)) # Import the data long format 773x10 PM<-read.csv("parus2.csv",header=TRUE,sep=";") PM$sex<-as.factor(PM$sex) # Sex of disperser PM$winter<-as.factor(PM$winter) # Winter year (between birth-breed) PM$pgb2<-as.numeric(PM$pgb2) # plot of origin PM$pnn2<-as.factor(PM$pnn) # family identity PM$d15med<-floor(PM$d15med)#fledging date of the breeding bird PM$SdensFpgb<-PM$SdensFpgb # Import the revealed only data the random effects: pgb 773x1 stay<-read.csv("stay2.csv",header=TRUE,sep=";") stay$pgbm<-as.numeric(stay$pgb) # plot of origin stay$pnn2<-as.factor(stay$pnn) # family y.j<-length(unique(stay$pgbm)) #number of choices y.n<- length(stay$real) # number individuals Y<-as.numeric(stay$pgb) # mumeric choice set #Rename some variables Center and Scale any Continuous Predictors PART I PM$t_area<-(PM$T_area-mean(PM$T_area))/(sd(PM$T_area)) PM$t_mindist<-(PM$T_mindist-mean(PM$T_mindist))/(sd(PM$T_mindist)) PM$densR<-(PM$densRoo-mean(PM$densRoo))/(sd(PM$densRoo)) PM$densT<-(PM$densTbox-mean(PM$densTbox))/(sd(PM$densTbox)) PM$densP<-(PM$SdensFpgb-mean(PM$SdensFpgb))/(sd(PM$SdensFpgb)) PM$fd<-PM$d15med stay$fd<-stay$d15med fd<-stay$fd ### Create some interactions # For the interactions sex*mindist sexi<-model.matrix(~PM$sex:PM$t_mindist) sex2mindist<-data.frame(sexi) # For the interactions fd with mindist fdi<-model.matrix(~PM$fd:PM$t_mindist)#for the interactions fd with mindist fdmd<-data.frame(fdi) # For the interactions fd with densR dRfdi<-model.matrix(~PM$fd:PM$densR) dRfd<-data.frame(dRfdi) # For the interactions fd with area afd<-model.matrix(~PM$fd:PM$t_area) afdmd<-data.frame(afd) # For the interactions sex with area asex<-model.matrix(~PM$sex:PM$t_area) asexmd<-data.frame(asex) # For the interactions sex with area da<-model.matrix(~PM$t_mindist:PM$t_area) damd<-data.frame(da) ## Put variables in matrix form for winBUGS dR_fd<-t(matrix(dRfd$PM.fd.PM.densR,y.j,y.n)) # interaction fled date with Roost dens choices<-t(matrix(as.numeric(PM$real),y.j,y.n)) # the real choices t_area<-t(matrix(PM$t_area,y.j,y.n)) # size of the area t_mindist<-t(matrix(PM$t_mindist,y.j,y.n)) # minimun distance to the plot of destination ha<-t(matrix(as.numeric(PM$ha),y.j,y.n)) # home advantage densP<-t(matrix(as.numeric(PM$densP),y.j,y.n)) # density of succesfully fledged nestlings densR<-t(matrix(PM$densR,y.j,y.n)) # roosting density of the target plot sex2t_mindist<-t(matrix(sex2mindist$PM.sex2.PM.t_mindist,y.j,y.n)) # sex*mindist fd_md<-t(matrix(fdmd$PM.fd.PM.t_mindist,y.j,y.n)) # fd*mindist a_fd<-t(matrix(afdmd$PM.fd.PM.t_area,y.j,y.n)) # fd*area a_sx<-t(matrix(asexmd$PM.sex2.PM.t_area,y.j,y.n)) # sex*area pgb<-stay$pgbm # plot of origin pnn<-as.numeric(as.factor(stay$pnn)) # family winter<-as.numeric(PM$winter) # year effect sex<-stay$sex # Sex da<-t(matrix(damd$PM.t_mindist.PM.t_area,y.j,y.n)) # distance*area # long format of the interactions for validation analysis PM$sex2t_mindist <-sex2mindist$PM.sex2.PM.t_mindist PM$fd_md<-fdmd$PM.fd.PM.t_mindist PM$dR_fd<-dRfd$PM.fd.PM.densR PM$a_fd<-afdmd$PM.fd.PM.t_area PM$a_sx<-asexmd$PM.sex2.PM.t_area PM$da<-damd$PM.t_mindist.PM.t_area # Save the data save(list=ls(),file="PMtrain.RData") rm(list=ls(all=TRUE)) ######################### Cross Validation set ################################## # Import the data long format 249x10 PM<-read.csv("parus2cv.csv",header=TRUE,sep=";") PM$sex<-as.factor(PM$sex) # Sex of disperser PM$winter<-as.factor(PM$winter) # Winter year (between birth-breed) PM$pgb2<-as.numeric(PM$pgb2) # plot of origin PM$pnn2<-as.factor(PM$pnn) # family identity PM$d15med<-floor(PM$d15med)#fledging date of the breeding bird PM$SdensFpgb<-PM$SdensFpgb # Import the revealed only data the random effects: pgb 249x1 stay<-read.csv("stay2cv.csv",header=TRUE,sep=";") stay$pgbm<-as.numeric(stay$pgb) # plot of origin stay$pnn2<-as.factor(stay$pnn) # family y.j<-length(unique(stay$pgbm)) #number of choices y.n<- length(stay$real) # number individuals Y<-as.numeric(stay$pgb) # mumeric choice set #Rename some variables Center and Scale any Continuous Predictors PART I PM$t_area<-(PM$T_area-mean(PM$T_area))/(sd(PM$T_area)) PM$t_mindist<-(PM$T_mindist-mean(PM$T_mindist))/(sd(PM$T_mindist)) PM$densR<-(PM$densRoo-mean(PM$densRoo))/(sd(PM$densRoo)) PM$densT<-(PM$densTbox-mean(PM$densTbox))/(sd(PM$densTbox)) PM$densP<-(PM$SdensFpgb-mean(PM$SdensFpgb))/(sd(PM$SdensFpgb)) PM$fd<-PM$d15med stay$fd<-stay$d15med fd<-stay$fd ### Create some interactions # For the interactions sex*mindist sexi<-model.matrix(~PM$sex:PM$t_mindist) sex2mindist<-data.frame(sexi) # For the interactions fd with mindist fdi<-model.matrix(~PM$fd:PM$t_mindist)#for the interactions fd with mindist fdmd<-data.frame(fdi) # For the interactions fd with densR dRfdi<-model.matrix(~PM$fd:PM$densR) dRfd<-data.frame(dRfdi) # For the interactions fd with area afd<-model.matrix(~PM$fd:PM$t_area) afdmd<-data.frame(afd) # For the interactions sex with area asex<-model.matrix(~PM$sex:PM$t_area) asexmd<-data.frame(asex) # For the interactions sex with area da<-model.matrix(~PM$t_mindist:PM$t_area) damd<-data.frame(da) ## Put variables in matrix form for winBUGS dR_fd<-t(matrix(dRfd$PM.fd.PM.densR,y.j,y.n)) # interaction fled date with Roost dens choices<-t(matrix(as.numeric(PM$real),y.j,y.n)) # the real choices t_area<-t(matrix(PM$t_area,y.j,y.n)) # size of the area t_mindist<-t(matrix(PM$t_mindist,y.j,y.n)) # minimun distance to the plot of destination ha<-t(matrix(as.numeric(PM$ha),y.j,y.n)) # home advantage densP<-t(matrix(as.numeric(PM$densP),y.j,y.n)) # density of succesfully fledged nestlings densR<-t(matrix(PM$densR,y.j,y.n)) # roosting density of the target plot sex2t_mindist<-t(matrix(sex2mindist$PM.sex2.PM.t_mindist,y.j,y.n)) # sex*mindist fd_md<-t(matrix(fdmd$PM.fd.PM.t_mindist,y.j,y.n)) # fd*mindist a_fd<-t(matrix(afdmd$PM.fd.PM.t_area,y.j,y.n)) # fd*area a_sx<-t(matrix(asexmd$PM.sex2.PM.t_area,y.j,y.n)) # sex*area pgb<-stay$pgbm # plot of origin pnn<-as.numeric(as.factor(stay$pnn)) # family winter<-as.numeric(PM$winter) # year effect sex<-stay$sex # Sex da<-t(matrix(damd$PM.t_mindist.PM.t_area,y.j,y.n)) # distance*area # long format of the interactions for validation analysis PM$sex2t_mindist <-sex2mindist$PM.sex2.PM.t_mindist PM$fd_md<-fdmd$PM.fd.PM.t_mindist PM$dR_fd<-dRfd$PM.fd.PM.densR PM$a_fd<-afdmd$PM.fd.PM.t_area PM$a_sx<-asexmd$PM.sex2.PM.t_area PM$da<-damd$PM.t_mindist.PM.t_area # Save the data save(list=ls(),file="PMcv.RData") rm(list=ls(all=TRUE))