length(dispersers1)
table(P[match(dispersers1, P$id),]$sex)
dispersers.fromMLP
MLP[1,]
MLP[2,]
dispersers.fromMLP
length(dispersers.fromMLP)
P[match(dispersers.fromMLP, P$id)]
P[match(dispersers.fromMLP, P$id),]
dispersers
prob_mum[1,]
prob_mum[1]
mP2$P
dispersers.fromMLP
pop_parents[1,]
pop_parents[2,]
table(pop_parents)
table(P$population)
pop_parents<-pop_parents[,-seq(2,4000,2)]
table(pop_parents[1:100,])
table(pop_parents[1:200,])
table(pop_parents[1:400,])
j<-1
pop_parents[j,]
placeborn[j]
table(as.numeric(placeborn[j])==pop_parents[j,] | pop_parents[j,]=="us")
pop_parents=="us"
any(pop_parents=="us")
any(pop_parents=="us", na.rm=T)
for(j in 1:dim(m1$P)[1]){
pop_parents[,j][which(is.na(pop))]
}
pop_parents<-pop_parents[,-seq(2,4000,2)]#
#
prob_mum<-1:dim(m1$P)[1]#
  for(j in 1:dim(m1$P)[1]){#
    prob_mum[j]<-prop.table(table(as.numeric(placeborn[j])==pop_parents[j,] | is.na(pop_parents[j,])))["FALSE"] #
  }
dispersers<-rownames(m1$P)[which(prob_mum>0.9)]
dispersers
length(dispersers)
dispersers1<-P$id[match(dispersers, P$id)][which(P$yrl[match(dispersers, P$id)]=="Y")]
dispersers1
dispersers<-rownames(m1$P)[which(prob_mum>0.9)]#
dispersers1<-P$id[match(dispersers, P$id)][which(P$yrl[match(dispersers, P$id)]=="Y")]#
#
MLP<-matrix(NA,dim(mP2$P)[1],2)#
  for(j in 1:dim(mP2$P)[1]){#
	if(is.na(mP2$P[,2][j])==FALSE){#
      MLP[j,]<-c(P$population[which(P$id==mP2$P[,1][j] & P$year==yearborn[j])], P$population[which(P$id==mP2$P[,2][j] & P$year==yearborn[j])])#
	}	  #
  }	  #
#
dispersers.fromMLP<-mP2$P[,1][which(MLP[,1]!=MLP[,2])]
dispersers.fromMLP
length(dispersers.fromMLP)
dispersers.fromMLP1<-P$id[match(dispersers.fromMLP, P$id)][which(P$yrl[match(dispersers.fromMLP, P$id)]=="Y")]
dispersers.fromMLP1
P$yrl[match(dispersers.fromMLP, P$id)]=="Y")]
dispersers
lenegth(dispersers)
P[match(dispersers, P$id),]
?table
j<-1
prop.table(table(as.numeric(placeborn[j])==pop_parents[j,] | placeborn[j]!="OFFSITER", exclude=NULL)["FALSE"]
)
as.numeric(placeborn[j])==pop_parents[j,] | placeborn[j]!="OFFSITER"
prop.table(table(as.numeric(placeborn[j])==pop_parents[j,] | placeborn[j]!="OFFSITER", exclude=NULL))["FALSE"]
table(as.numeric(placeborn[j])==pop_parents[j,] | placeborn[j]!="OFFSITER", exclude=NULL))
table(as.numeric(placeborn[j])==pop_parents[j,] | placeborn[j]!="OFFSITER", exclude=NULL)
#
prob_mum<-1:dim(m1$P)[1]#
  for(j in 1:dim(m1$P)[1]){#
    prob_mum[j]<-prop.table(table(as.numeric(placeborn[j])==pop_parents[j,] | placeborn[j]!="OFFSITER", exclude=NULL))["FALSE"] #
  }
dispersers<-rownames(m1$P)[which(prob_mum>0.9)]  # individuals that were assigned to a different population
dispersers
pop_parents[100,]
pop_parents[200,]
table(as.numeric(placeborn[j])==pop_parents[j,] | placeborn[j]!="OFFSITER", exclude=NULL)
placeborn[j]
prop.table(table(as.numeric(placeborn[j])!=pop_parents[j,] & placeborn[j]!="OFFSITER", exclude=NULL))["TRUE"]
prop.table(table(as.numeric(placeborn[j])!=pop_parents[j,] & placeborn[j]!="OFFSITER", exclude=NULL))
#
prob_mum<-1:dim(m1$P)[1]#
  for(j in 1:dim(m1$P)[1]){#
    prob_mum[j]<-prop.table(table(as.numeric(placeborn[j])!=pop_parents[j,] & placeborn[j]!="OFFSITER", exclude=NULL))["TRUE"] #
  }#
#
dispersers<-rownames(m1$P)[which(prob_mum>0.9)]  # individuals that were assigned to a different population
dispersers
length(dispersers)
mP2$P[,1][which(MLP[,1]!=MLP[,2])]
length(mP2$P[,1][which(MLP[,1]!=MLP[,2])])
P$population2<-factor(rep(NA, dim(P)[1]), levels=c("R2", "SSW", "R1W", "R1E"))#
P$population2[which(P$long<c(-700))]<-"R2"#
P$population2[which(P$lat>c(-600))]<-"R1E"#
P$population2[which(P$lat<c(-915) & P$long >c(-700))]<-"SSW"#
P$population2[which(P$lat<c(-600) & P$lat>c(-915) & P$long >c(-700))]<-"R1W"
P$population2
table(P$population, P$population2)
P$population<-rep(NA, length(P$terr))#
#
P$population[which(substr(P$terr, nchar(P$terr)-1, nchar(P$terr))=="R2")]<-"R2"#
P$population[which(substr(P$terr, 1, 2)=="SS")]<-"SSW"#
P$population[which(substr(P$terr, 1, 2)=="OF")]<-"OFFSITER"#
P$population[which(substr(P$terr, 1, 2)=="SH")]<-"R1W"
table(P$population, P$population2)
tmp<-substr(P$terr, 1, 3)#
tmp[which(is.na(P$population)==FALSE)]<-NA#
tmp<-as.numeric(unlist(strsplit(tmp, "[A-Z | a-z]")))#
P$population[which(tmp<89)]<-"R1W"#
P$population[which(tmp>78)]<-"R1E"#
P$population<-as.factor(P$population)
table(P$population, P$population2)
P$population<-rep(NA, length(P$terr))#
#
P$population[which(substr(P$terr, nchar(P$terr)-1, nchar(P$terr))=="R2")]<-"R2"#
P$population[which(substr(P$terr, 1, 2)=="SS")]<-"SSW"#
P$population[which(substr(P$terr, 1, 2)=="OF")]<-"OFFSITER"#
P$population[which(substr(P$terr, 1, 2)=="SH")]<-"R1W"#
#
#
tmp<-substr(P$terr, 1, 3)#
tmp[which(is.na(P$population)==FALSE)]<-NA
tmp
tmp<-as.numeric(unlist(strsplit(tmp, "[A-Z | a-z]")))
length(tmp)
tmp
which(tmp<89)
P$population<-rep(NA, length(P$terr))#
#
P$population[which(substr(P$terr, nchar(P$terr)-1, nchar(P$terr))=="R2")]<-"R2"#
P$population[which(substr(P$terr, 1, 2)=="SS")]<-"SSW"#
P$population[which(substr(P$terr, 1, 2)=="OF")]<-"OFFSITER"#
P$population[which(substr(P$terr, 1, 2)=="SH")]<-"R1W"#
#
#
tmp<-substr(P$terr, 1, 3)#
tmp[which(is.na(P$population)==FALSE)]<-NA#
tmp<-as.numeric(unlist(strsplit(tmp, "[A-Z | a-z]")))
table(P$population, P$population2)
which(tmp<89 & P$population2!=R1W)
which(tmp<89 & P$population2!="R1W")
tmp[which(tmp<89 & P$population2!="R1W")]
P$population[which(tmp<89 & P$population2!="R1W")]
P$terr[which(tmp<89 & P$population2!="R1W")]
table(P$terr[which(tmp<89 & P$population2!="R1W")])
table(P$terr[which(tmp>78 & P$population2!="R1E")])
sum(table(P$terr[which(tmp>78 & P$population2!="R1E")]))
sum(table(P$terr[which(tmp<89 & P$population2!="R1W")]))
tmp<-substr(P$terr, 1, 3)#
tmp[which(is.na(P$population)==FALSE)]<-NA#
tmp<-as.numeric(unlist(strsplit(tmp, "[A-Z | a-z]")))#
P$population[which(tmp<89)]<-"R1W"#
P$population[which(tmp>78)]<-"R1E"#
P$population<-as.factor(P$population)
table(P$population, P$population2)
#load("pop_parents", "~/Desktop/Work/Waser/Data/Intermediate/pop_parents.Rdata")#
pop_parents<-pop_parents[,-seq(2,4000,2)]#
#
prob_mum<-1:dim(m1$P)[1]#
  for(j in 1:dim(m1$P)[1]){#
    prob_mum[j]<-prop.table(table(as.numeric(placeborn[j])!=pop_parents[j,] & placeborn[j]!="OFFSITER", exclude=NULL))["TRUE"] #
  }#
#
dispersers<-rownames(m1$P)[which(prob_mum>0.9)]  # individuals that were assigned to a different population
dispersers
P[match(P$dispersers, P$id),]
P[match(dispersers, P$id),]
P[match(dispersers, P$id),]$sex
table(P[match(dispersers, P$id),]$sex)
dispersers1
dispersers
dispersers[1]
"1232"
m1$P[which(rownames(m1$P)=="1232"),]
table(m1$P[which(rownames(m1$P)=="1232"),][seq(1,4000,2)])
dispersers
table(m1$P[which(rownames(m1$P)=="2051"),][seq(1,4000,2)])
which(P$id=="2051")
P[which(P$id=="2051"),]
P[which(P$id=="9053"),]
P[which(P$id=="699"),]
table(m1$P[which(rownames(m1$P)=="699"),][seq(1,4000,2)])
P[which(P$id=="4853"),]
dispersers
table(dispersers)
table(P[match(dispersers, P$id),]$sex)
dispersers.fromMLP
length(dispersers.fromMLP)
hist(prob_mum)
sum(is.na(mP$P[,2])==FALSE & is.na(mP$P[,3])==FALSE & mP$P[,1]%in%missingG==FALSE)  # 1354 assignments based on both parents#
sum(is.na(mP$P[,2])==FALSE & mP$P[,1]%in%missingG==FALSE)  # 1454 assignments based on mother alone
table(P$population, exclude=NULL)
dispersers.fromMLP
table(P[match(dispersers.fromMLP, P$id),]$sex)
dispersers
table(P[match(dispersers, P$id),]$sex)
(15+19)/275
(14+9)/277
29/(552)
(29+28)/(552)
dispersers
dispersers.fromMLP
mP2$P[which(MLP[,1]!=MLP[,2]),]
dispersers
plot(P$lat, P$long, col=P$population)
plot(P$lat, P$long, col=P$population2)
dipsersers
dispersers
dispersers1
dispersers
dispersers%in$dispersers.MLP
dispersers%in$dispersers.fromMLP
dispersers%in%dispersers.fromMLP
dispersers[which(dispersers%in%dispersers.fromMLP)]
additional<-dispersers[which(dispersers%in%dispersers.fromMLP)]
additional
P[match(additional, P$id),]
P[,c("lat", "long")][match(additional, P$id),]
points(P[,c("lat", "long")][match(additional, P$id),], pch=16)
additional<-dispersers[which(dispersers%in%dispersers.fromMLP==FALSE)]
points(P[,c("lat", "long")][match(additional, P$id),], pch=16)
plot(P$lat, P$long, col=P$population)
points(P[,c("lat", "long")][match(additional, P$id),], pch=16)
P[,c("lat", "long")][match(additional, P$id),]
P[match(additional, P$id),]
16*sqrt(pi)/15*3
vignette("CourseNotes", "MCMCglmm")
16*sqrt(3)/(15*pi)
(16*sqrt(3)/(15*pi))^2
(16*sqrt(3)/(15*pi))^2+1
((16*sqrt(3)/(15*pi))^2+1)
sqrt((16*sqrt(3)/(15*pi))^2+1)
hist(rlnorm(10000))
exp(-6)
hist(rlnorm(10000, 0,0.1))
hist(rlnorm(10000, 0,0.2))
hist(rlnorm(10000, 0,0.2)*-1)
hist(rlnorm(10000, 0,0.2)*-1-5)
hist(rlnorm(10000, 0,0.3)*-1-5)
hist(rlnorm(10000, 0,0.4)*-1-5)
hist(rlnorm(10000, 0,0.5)*-1-5)
hist(inv.logit(rlnorm(10000, 0,0.5)*-1-5)*sqrt((16*sqrt(3)/(15*pi))^2+1))
library(MCMCglmm)
hist(inv.logit(rlnorm(10000, 0,0.5)*-1-5)*sqrt((16*sqrt(3)/(15*pi))^2+1))
mean(inv.logit(-6*sqrt((16*sqrt(3)/(15*pi))^2+1))
)
inv.logit(-6*sqrt((16*sqrt(3)/(15*pi))^2+1))
inv.logit(-5*sqrt((16*sqrt(3)/(15*pi))^2+1))
vignette("CourseNotes", "MCMCglmm")
exp(=0.43)
exp(-0.43)
exp(-0.043)
d<-seq(0,1000)
plot(exp(-0.043*d)~d)
plot(exp(-0.043)~)
exp(-0.043*360)
setwd("~/Desktop/Work/MasterBayes_2.47/inst/doc/Tutorial.Rnw")
setwd("~/Desktop/Work/MasterBayes_2.47/inst/doc")
Sweave("Tutorial.Rnw")
ped1
ped2
ped2$prob
which(ped1$P[, 3] != ped2$P[, 3])
which(ped1$P[, 3][1:59] != ped2$P[, 3][3:63])
which(ped1$P[, 3][1:59] != ped2$P[, 3][3:61])
ped1$P[10,]
ped1$P[12,]
ped2$P[12,]
ped1$prob[10]
ped1$prob.male[10]
?modeP
modeP
ls()
modeP(model1$P)
as.vector(hell)
m1$P
model1$P[[1]]
model1$P[[2]]
model1$P[[10]]
which.max(model1$P[[10]])
which.max(model1$P[[10]])%%dim(model1$P[[10]])
which.max(model1$P[[10]])%%dim(model1$P[[10]])[1]
which.max(model1$P[[10]])%%dim(model1$P[[10]])[2]
?which.max
which.max(model1$P[[10]])/dim(model1$P[[10]])[1]
which.max(model1$P[[x]])/dim(model1$P[[x]])[1]
x<-20
which.max(model1$P[[x]])/dim(model1$P[[x]])[1]
which(model1$P[[x]]=max(model1$P[[x]]), arr.ind=TRUE)
which(model1$P[[x]]==max(model1$P[[x]]), arr.ind=TRUE)
which(model1$P[[x]]==max(model1$P[[x]]), arr.ind=TRUE)[1,]
which(model1$P[[x]]==max(model1$P[[x]]), arr.ind=TRUE)[1,][2]
which.max(c(1,3,4))
which.max(c(1,4,4))
?which.max
"modeP"<-function(postP, threshold=0, marginal=FALSE, USasNA=TRUE){#
#
    post_prob2=NULL#
  if(is.list(postP)){#
    ped<-matrix(NA, length(postP), 3)#
    ped[,1]<-names(postP)#
    if(marginal){#
      ped[,2]<-unlist(lapply(postP, function(x){colnames(x)[which.max(colSums(x))]})) #
      post_prob<-unlist(lapply(postP, function(x){colSums(x)[which.max(colSums(x))]/sum(x)})) #
      ped[,2][which(post_prob<threshold)]<-NA#
      if(USasNA){#
        ped[,2][which(ped[,2]=="us")]<-NA#
      }#
      ped[,3]<-unlist(lapply(postP, function(x){rownames(x)[which.max(rowSums(x))]})) #
      post_prob2<-unlist(lapply(postP, function(x){rowSums(x)[which.max(rowSums(x))]/sum(x)})) #
      ped[,3][which(post_prob2<threshold)]<-NA#
      if(USasNA){#
        ped[,3][which(ped[,3]=="us")]<-NA#
      }#
    }else{#
      ml.pair<-colnames(x){which(x==max(x), arr.ind=TRUE)[1,][2]#
      ped[,2]<-unlist(lapply(postP, function(x){colnames(x){which(x==max(x), arr.ind=TRUE)[1,][2]})) #
      ped[,3]<-unlist(lapply(postP, function(x){rownames(x){which(x==max(x), arr.ind=TRUE)[1,][1]})) #
      post_prob<-unlist(lapply(postP, function(x){max(x)[which.max(x)]/sum(x)})) #
      ped[,2][which(post_prob<threshold)]<-NA#
      ped[,3][which(post_prob<threshold)]<-NA#
      if(USasNA){#
        ped[,2][which(ped[,2]=="us")]<-NA#
        ped[,3][which(ped[,3]=="us")]<-NA#
      }#
#
#
    }#
  }else{#
    ped<-matrix(NA, dim(postP)[1], 3)#
    lpost<-dim(postP)[2]#
    ped[,1]<-rownames(postP)#
    if(marginal){#
       postP1<-apply(postP, 1, function(x){table(x[seq(1,lpost,2)])/(lpost/2)})#
       ped[,2]<-unlist(lapply(postP1, function(x){names(x)[which.max(x)]}))#
       post_prob<-unlist(lapply(postP1, function(x){max(x)}))#
       ped[,2][which(post_prob<threshold)]<-NA#
       if(USasNA){#
         ped[,2][which(ped[,2]=="us")]<-NA#
       }       #
       postP2<-apply(postP, 1, function(x){table(x[seq(2,lpost,2)])/(lpost/2)})#
       ped[,3]<-unlist(lapply(postP2, function(x){names(x)[which.max(x)]}))#
       post_prob2<-unlist(lapply(postP2, function(x){max(x)}))#
       ped[,3][which(post_prob2<threshold)]<-NA#
       if(USasNA){#
         ped[,3][which(ped[,3]=="us")]<-NA#
       }#
    }else{#
      postP<-apply(postP, 1, function(x){table(paste(x[seq(1,lpost,2)], x[seq(2,lpost,2)]))})#
      ped[,2]<-unlist(lapply(postP, function(x){strsplit(names(x)[which.max(x)], " ")[[1]][1]})) #
      ped[,3]<-unlist(lapply(postP, function(x){strsplit(names(x)[which.max(x)], " ")[[1]][2]}))#
      post_prob<-unlist(lapply(postP, function(x){x[which.max(x)]/sum(x)})) #
      ped[,2:3][which(post_prob<threshold),]<-NA#
      if(USasNA){#
        ped[,2][which(ped[,2]=="us")]<-NA#
        ped[,3][which(ped[,3]=="us")]<-NA#
      }#
    }#
  }#
  list(P=ped, prob=as.vector(post_prob), prob.male=as.vector(post_prob2))#
}
"modeP"<-function(postP, threshold=0, marginal=FALSE, USasNA=TRUE){#
#
    post_prob2=NULL#
  if(is.list(postP)){#
    ped<-matrix(NA, length(postP), 3)#
    ped[,1]<-names(postP)#
    if(marginal){#
      ped[,2]<-unlist(lapply(postP, function(x){colnames(x)[which.max(colSums(x))]})) #
      post_prob<-unlist(lapply(postP, function(x){colSums(x)[which.max(colSums(x))]/sum(x)})) #
      ped[,2][which(post_prob<threshold)]<-NA#
      if(USasNA){#
        ped[,2][which(ped[,2]=="us")]<-NA#
      }#
      ped[,3]<-unlist(lapply(postP, function(x){rownames(x)[which.max(rowSums(x))]})) #
      post_prob2<-unlist(lapply(postP, function(x){rowSums(x)[which.max(rowSums(x))]/sum(x)})) #
      ped[,3][which(post_prob2<threshold)]<-NA#
      if(USasNA){#
        ped[,3][which(ped[,3]=="us")]<-NA#
      }#
    }else{#
      ped[,2]<-unlist(lapply(postP, function(x){colnames(x){which(x==max(x), arr.ind=TRUE)[1,][2]})) #
      ped[,3]<-unlist(lapply(postP, function(x){rownames(x){which(x==max(x), arr.ind=TRUE)[1,][1]})) #
      post_prob<-unlist(lapply(postP, function(x){max(x)[which.max(x)]/sum(x)})) #
      ped[,2][which(post_prob<threshold)]<-NA#
      ped[,3][which(post_prob<threshold)]<-NA#
      if(USasNA){#
        ped[,2][which(ped[,2]=="us")]<-NA#
        ped[,3][which(ped[,3]=="us")]<-NA#
      }#
#
#
    }#
  }else{#
    ped<-matrix(NA, dim(postP)[1], 3)#
    lpost<-dim(postP)[2]#
    ped[,1]<-rownames(postP)#
    if(marginal){#
       postP1<-apply(postP, 1, function(x){table(x[seq(1,lpost,2)])/(lpost/2)})#
       ped[,2]<-unlist(lapply(postP1, function(x){names(x)[which.max(x)]}))#
       post_prob<-unlist(lapply(postP1, function(x){max(x)}))#
       ped[,2][which(post_prob<threshold)]<-NA#
       if(USasNA){#
         ped[,2][which(ped[,2]=="us")]<-NA#
       }       #
       postP2<-apply(postP, 1, function(x){table(x[seq(2,lpost,2)])/(lpost/2)})#
       ped[,3]<-unlist(lapply(postP2, function(x){names(x)[which.max(x)]}))#
       post_prob2<-unlist(lapply(postP2, function(x){max(x)}))#
       ped[,3][which(post_prob2<threshold)]<-NA#
       if(USasNA){#
         ped[,3][which(ped[,3]=="us")]<-NA#
       }#
    }else{#
      postP<-apply(postP, 1, function(x){table(paste(x[seq(1,lpost,2)], x[seq(2,lpost,2)]))})#
      ped[,2]<-unlist(lapply(postP, function(x){strsplit(names(x)[which.max(x)], " ")[[1]][1]})) #
      ped[,3]<-unlist(lapply(postP, function(x){strsplit(names(x)[which.max(x)], " ")[[1]][2]}))#
      post_prob<-unlist(lapply(postP, function(x){x[which.max(x)]/sum(x)})) #
      ped[,2:3][which(post_prob<threshold),]<-NA#
      if(USasNA){#
        ped[,2][which(ped[,2]=="us")]<-NA#
        ped[,3][which(ped[,3]=="us")]<-NA#
      }#
    }#
  }#
  list(P=ped, prob=as.vector(post_prob), prob.male=as.vector(post_prob2))#
}
source("~/Desktop/Work/MasterBayes_2.47")
source("~/Desktop/Work/MasterBayes_2.47/R/modeP.R)
""
)
p[poq1-o]12
1
9081088230230-3030-230-12
""""))KP{K{P}}
source("~/Desktop/Work/MasterBayes_2.47/R/modeP.R")
source("~/Desktop/Work/MasterBayes_2.47/R/modeP.R")
source("~/Desktop/Work/MasterBayes_2.47/R/modeP.R")
source("~/Desktop/Work/MasterBayes_2.47/R/modeP.R")
source("~/Desktop/Work/MasterBayes_2.47/R/modeP.R")
modeP(model1$P)
modeP(model1$P)
max(model1$P[[1]])[which.max(model1$P[[1]])]/sum(model1$P[[1]])
which.max(model1$P[[1]])
source("~/Desktop/Work/MasterBayes_2.47/R/modeP.R")
modeP(model1$P)
modeP(model1$P)$prob[10]
Sweave("Tutorial.Rnw")
Sweave("Tutorial.Rnw")
