#' ---
#' title: "Prior probabilities in the interpretation of 'some': analysis of uniform prior wonky world model predictions"
#' author: "Judith Degen"
#' date: "January 26, 2014"
#' ---

library(ggplot2)
library(wesanderson)
theme_set(theme_bw(18))
setwd("/Users/titlis/cogsci/projects/stanford/projects/thegricean_sinking-marbles/writing/_2015/_journal_cognition/")
source("rscripts/helpers.r")

## load priors for generating plots
priorprobs = read.table(file="~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/12_sinking-marbles-prior15/results/data/smoothed_15marbles_priors_withnames.txt",sep="\t", header=T, quote="")
row.names(priorprobs) = priorprobs$Item
nrow(priorprobs)

# prior all-state probability for each item
prior_allprobs = priorprobs[,c("Item","X15")]
row.names(prior_allprobs) = prior_allprobs$Item

# prior expectation for each item
gathered_probs <- priorprobs %>%
  gather(State,Probability,X0:X15)
gathered_probs$State = as.numeric(as.character(gsub("X","",gathered_probs$State)))
prior_exps <- gathered_probs %>%
  group_by(Item) %>%
  summarise(exp.val=sum(State*Probability))
prior_exps = as.data.frame(prior_exps)
row.names(prior_exps) = prior_exps$Item
summary(prior_exps)

# histogram of expectations
exps = ggplot(prior_exps, aes(x=exp.val)) +
  geom_histogram() +
  scale_x_continuous(name="Expected value of prior distribution",breaks=seq(1,15, by=2)) +
  scale_y_continuous(name="Number of cases",breaks=seq(0,8, by=2))
ggsave("pics/priorexpectations-histogram.pdf",width=5,height=3.7)

# histogram of allstate-probs
allprobs = ggplot(prior_allprobs, aes(x=X15)) +
  geom_histogram() +
  scale_x_continuous(name="Prior all-state probability") +
  scale_y_continuous(name="Number of cases")
ggsave("priorallprobs-histogram.pdf")

pdf("pics/priordistributions.pdf",width=10,height=3.5)
grid.arrange(exps, allprobs, nrow=1,widths=unit.c(unit(.5, "npc"), unit(.5, "npc")))
dev.off()

# load inferred priors (with guessing parameter)
exps_inferred_phi = read.table(file="~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/bayesian_model_comparison/priors/results/summary_priorBDA-binomials-phi_incrMH100000burn50000.csv",sep=",", header=T, quote="")
exps_inferred_phi$X.Item. = gsub("\"","",exps_inferred_phi$X.Item.)
row.names(exps_inferred_phi) = exps_inferred_phi$X.Item.
nrow(exps_inferred_phi)
head(exps_inferred_phi)

# histogram of expectations
exps = ggplot(exps_inferred_phi, aes(x=X.expectation.*15)) +
  geom_histogram() +
  scale_x_continuous(name="Expected value of prior distribution",breaks=seq(1,15, by=2)) +
  scale_y_continuous(name="Number of cases")
ggsave("pics/priorexpectations-inferred-phi-histogram.pdf",width=5,height=3.7)

# load inferred priors (without guessing parameter)
exps_inferred = read.table(file="~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/bayesian_model_comparison/priors/results/summary_priorBDA-binomials_incrMH100000burn50000.csv",sep=",", header=T, quote="")
exps_inferred$X.Item. = gsub("\"","",exps_inferred$X.Item.)
row.names(exps_inferred) = exps_inferred$X.Item.
nrow(exps_inferred)
head(exps_inferred)
row.names(exps_inferred) = exps_inferred$X.Item.

# histogram of expectations
exps = ggplot(exps_inferred, aes(x=X.expectation.*15)) +
  geom_histogram() +
  scale_x_continuous(name="Expected value of prior distribution",breaks=seq(1,15, by=2)) +
  scale_y_continuous(name="Number of cases")
ggsave("pics/priorexpectations-inferred-histogram.pdf",width=5,height=3.7)

### PLOT COMPREHENSION RESULTS
# expectations
load("~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/13_sinking-marbles-priordv-15/results/data/r.RData")

r$PriorExpectationProportion = prior_exps[as.character(r$Item),]$exp.val
r$PriorExpectationProportionInferred = exps_inferred[as.character(r$Item),]$X.expectation.
r$PriorExpectationProportionInferredPhi = exps_inferred_phi[as.character(r$Item),]$X.expectation.

cor(r$PriorExpectationProportionInferred*15,r$PriorExpectationProportion)
cor(r$PriorExpectationProportionInferredPhi*15,r$PriorExpectationProportion)
# exclude people who weren't literal above some threshold
# lit = droplevels(r[r$quantifier %in% c("All","None"),]) %>%
#   group_by(workerid,quantifier) %>%
#   summarise(Mean=mean(response))
# lit = as.data.frame(lit)
# lit = lit %>% spread(quantifier,Mean)
# lit$Literal = as.factor(as.character(ifelse(lit$All > .80*15 & lit$None < .20*15,"literal","non-literal")))
# table(lit$Literal)
# row.names(lit) = as.character(lit$workerid)
# r$Literal = lit[as.character(r$workerid),]$Literal

agr = aggregate(ProportionResponse ~ PriorExpectationProportion + quantifier + Item,data=r,FUN=mean)

min(agr[agr$quantifier == "Some",]$ProportionResponse)*15
max(agr[agr$quantifier == "Some",]$ProportionResponse)*15
agr$Quantifier = factor(x=agr$quantifier, levels=c("Some","All","None","long_filler","short_filler"))

p_eexps = ggplot(agr, aes(x=PriorExpectationProportion, y=ProportionResponse*15, color=Quantifier, shape=Quantifier)) +
  geom_point() +
  #geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  geom_smooth() +
  scale_color_manual(values=c(wes_palette("Darjeeling")[1:3],"black","gray40")) +#values=c("#F8766D", "black", "#00BF7D", "gray30", "#00B0F6"),breaks=levels(agr$quantifier),labels=c("all","long filler","none","short filler","some")) +
  scale_y_continuous(breaks=seq(1,15,by=2),name="Posterior mean number of objects") +
  #  geom_abline(intercept=0,slope=1,color="gray70") +
  scale_x_continuous(breaks=seq(1,15,by=2),name="Prior mean number of objects")
p_eexps
ggsave(file="empirical_exps.pdf")#,width=5,height=3.7)

# plot with inferred prior expectation on x axis
agr = aggregate(ProportionResponse ~ PriorExpectationProportionInferred + quantifier + Item,data=r,FUN=mean)

min(agr[agr$quantifier == "Some",]$ProportionResponse)*15
max(agr[agr$quantifier == "Some",]$ProportionResponse)*15
agr$Quantifier = factor(x=agr$quantifier, levels=c("Some","All","None","long_filler","short_filler"))

p_eexps = ggplot(agr, aes(x=PriorExpectationProportionInferred*15, y=ProportionResponse*15, color=Quantifier, shape=Quantifier)) +
  geom_point() +
  #geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  geom_smooth() +
  scale_color_manual(values=c(wes_palette("Darjeeling")[1:3],"black","gray40")) +#values=c("#F8766D", "black", "#00BF7D", "gray30", "#00B0F6"),breaks=levels(agr$quantifier),labels=c("all","long filler","none","short filler","some")) +
  scale_y_continuous(breaks=seq(1,15,by=2),name="Posterior mean number of objects") +
  #  geom_abline(intercept=0,slope=1,color="gray70") +
  scale_x_continuous(breaks=seq(1,15,by=2),name="Prior mean number of objects")
p_eexps
ggsave(file="pics/empirical_exps_inferredprior.pdf",width=7)#,width=5,height=3.7)

# plot with inferred prior (phi) expectation on x axis
agr = aggregate(ProportionResponse ~ PriorExpectationProportionInferredPhi + quantifier + Item,data=r,FUN=mean)

min(agr[agr$quantifier == "Some",]$ProportionResponse)*15
max(agr[agr$quantifier == "Some",]$ProportionResponse)*15
agr$Quantifier = factor(x=agr$quantifier, levels=c("Some","All","None","long_filler","short_filler"))

p_eexps = ggplot(agr, aes(x=PriorExpectationProportionInferredPhi*15, y=ProportionResponse*15, color=Quantifier, shape=Quantifier)) +
  geom_point() +
  #geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  geom_smooth() +
  scale_color_manual(values=c(wes_palette("Darjeeling")[1:3],"black","gray40")) +#values=c("#F8766D", "black", "#00BF7D", "gray30", "#00B0F6"),breaks=levels(agr$quantifier),labels=c("all","long filler","none","short filler","some")) +
  scale_y_continuous(breaks=seq(1,15,by=2),name="Posterior mean number of objects") +
  #  geom_abline(intercept=0,slope=1,color="gray70") +
  scale_x_continuous(breaks=seq(1,15,by=2),name="Prior mean number of objects")
p_eexps
ggsave(file="pics/empirical_exps_inferredprior_phi.pdf",width=7)#,width=5,height=3.7)

# allstate-probs
load("~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/16_sinking-marbles-sliders-certain/results/data/r.RData")

# exclude people who are doing some sort of bullshit and not responding reasonably to all/none (see subject-variability.pdf for behavior on zero-slider)
#tmp = subset(r,!workerid %in% c(0,22,43,98,100,103,117,118))
r$AllPriorProbability = prior_allprobs[as.character(r$Item),]$X15
tmp=r
#tmpub = droplevels(subset(tmp, Proportion == "100"))
#tmpub$Quantifier = factor(x=tmpub$quantifier, levels=c("Some","All","None","long_filler","short_filler"))
agrr = aggregate(normresponse ~ AllPriorProbability + Proportion + quantifier + Item,data=r,FUN=mean)
ub = subset(agrr, Proportion == "100")
ub = droplevels(ub)
ub$Quantifier = factor(x=ub$quantifier, levels=c("Some","All","None","long_filler","short_filler"))

p_eprobs = ggplot(ub, aes(x=AllPriorProbability, y = normresponse, color=Quantifier, shape=Quantifier)) +
  geom_point() +
  geom_smooth() +
  scale_color_manual(values=c(wes_palette("Darjeeling")[1:3],"black","gray40")) +#values=c("#F8766D", "black", "#00BF7D", "gray30", "#00B0F6"),breaks=levels(agr$quantifier),labels=c("all","long filler","none","short filler","some")) +
  scale_y_continuous(limits=c(0,1),breaks=seq(0,1,by=.2),name="Posterior probability of all-state ") +
  #  geom_abline(intercept=0,slope=1,color="gray70") +
  scale_x_continuous(name="Prior probability of all-state")
p_eprobs
ggsave(file="empirical-allprobs.pdf")#,width=5,height=3.7)

library(gridExtra)
#  share a legend between multiple plots
g <- ggplotGrob(p_eexps + theme(legend.position="right"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
p_eexps_nolegend = p_eexps + theme(legend.position="none")
p_eprobs_nolegend = p_eprobs + theme(legend.position="none")

pdf("pics/empirical-results.pdf",width=13,height=5)
grid.arrange(p_eexps_nolegend, p_eprobs_nolegend, legend,nrow=1,widths=unit.c(unit(.45, "npc"), unit(.45, "npc"), unit(.1, "npc")))
dev.off()

### PLOT WONKY RESULTS
load("/Users/titlis/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/11_sinking-marbles-normal/results/data/r.RData")

r$PriorExpectation = prior_exps[as.character(r$Item),]$exp.val
ans = r %>%
  filter(quantifier %in% c("All","None","Some")) %>%
  group_by(quantifier, Item, PriorExpectation) %>%
  summarise(mean.prop=mean(numWonky))

p_wempirical =ggplot(ans,aes(x=PriorExpectation,y=mean.prop,color=quantifier)) +
  geom_point() +
  geom_smooth() +
  scale_color_manual(values=c(wes_palette("Darjeeling")[1:3])) +
  scale_y_continuous(limits=c(-0.1,1.2),breaks=seq(0,1,by=.2),name="Proportion of `wonky' judgments") +
  scale_x_continuous(limits=c(0,15),breaks=seq(1,15,by=2),name="Prior mean number of objects")

# get wonky model predictions
load("~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/models/wonky_world/results/data/wr-uniform.RData")

# plot expectations for best basic model:
toplot = droplevels(subset(wr, WonkyWorldPrior == .5 & Wonky == "true"))
nrow(toplot)

toplot = droplevels(subset(toplot, SpeakerOptimality == 2))
nrow(toplot)
head(toplot)
#toplot$quantifier = capitalize(as.character(toplot$Quantifier))
toplot$Quantifier = factor(toplot$Quantifier, levels=c("all","none","some"))

p_wmodel = ggplot(toplot, aes(x=PriorExpectation, y=PosteriorProbability,color=Quantifier,shape=Quantifier)) +
  geom_point() +
  geom_smooth() +
  scale_color_manual(values=c(wes_palette("Darjeeling")[1:3],"black","gray40")) +
  #scale_color_manual(values=c("#F8766D","#00BF7D","#00B0F6")) +
  scale_x_continuous(limits=c(0,15),breaks=seq(1,15,by=2),name="Prior mean number of objects") +
  scale_y_continuous(limits=c(-0.1,1.2),breaks=seq(0,1,by=.25),name="Predicted posterior wonkiness probability") +
  theme(plot.margin=unit(c(0,0,0,0),units="cm"))
p_wmodel

pdf("pics/wonkiness-results.pdf",width=10,height=4)
#grid.arrange(p_wmodel, p_wempirical, legend,nrow=1,widths=unit.c(unit(.45, "npc"), unit(.45, "npc"), unit(.1, "npc")))
grid.arrange(p_wmodel, p_wempirical, nrow=1,widths=unit.c(unit(.5, "npc"), unit(.5, "npc"), unit(.1, "npc")))
dev.off()

## PLOT SPEAKER RELIABILITY RESULTS
load("/Users/titlis/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/19_speaker_reliability_withins/results/data/r.RData")
r = r[!is.na(r$normresponse),]
r$AllPriorProbability = prior_allprobs[as.character(r$Item),]$X15

some100 = droplevels(subset(r, Proportion == "100" & quantifier == "Some"))
agr = aggregate(normresponse ~ AllPriorProbability  + trial_type + Item,data=some100,FUN=mean)
agr$CILow = aggregate(normresponse ~ AllPriorProbability + trial_type + Item,data=some100, FUN=ci.low)$normresponse
agr$CIHigh = aggregate(normresponse ~ AllPriorProbability + trial_type + Item,data=some100,FUN=ci.high)$normresponse
agr$YMin = agr$normresponse - agr$CILow
agr$YMax = agr$normresponse + agr$CIHigh

p=ggplot(agr, aes(x=AllPriorProbability,y=normresponse, color=trial_type)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
#  geom_smooth(method="lm") +
  scale_y_continuous(name="Posterior probability of all-state") +
  scale_x_continuous(name="Prior probability of all-state") +
  scale_color_manual(values=c(wes_palette("Darjeeling")[1:3]),name="Trial type",breaks=levels(agr$trial_type),labels=c("uninformative (court)", "unreliable (drunk)", "cooperative (sober)"))
p
ggsave("pics/speakerreliabilityresults.pdf",width=7,height=4)

some100$Reliability = as.factor(ifelse(some100$trial_type == "sober","reliable","unreliable"))
centered = cbind(some100, myCenter(some100[,c("AllPriorProbability","Reliability","Trial")]))
m = lmer(normresponse ~ cAllPriorProbability * cReliability + (cAllPriorProbability * cReliability | Item) + (cAllPriorProbability * cReliability | workerid), data=centered)
summary(m)
save(m, file="data/model.RData")

m = lmer(normresponse ~ cAllPriorProbability * trial_type + (1 | Item) + (1 | workerid), data=centered)
summary(m)

m.trial = lmer(normresponse ~ cAllPriorProbability * cReliability * cTrial + (cAllPriorProbability * cReliability| Item) + (cAllPriorProbability * cReliability| workerid), data=centered)
summary(m.trial)

m.trial.nopr = lmer(normresponse ~ cAllPriorProbability + cReliability + cTrial + cReliability:cTrial + cAllPriorProbability:cTrial + cAllPriorProbability:cReliability:cTrial + (cAllPriorProbability * cReliability| Item) + (cAllPriorProbability * cReliability| workerid), data=centered)
summary(m.trial.nopr)

anova(m.trial.nopr,m.trial) #

m.trial.nopt = lmer(normresponse ~ cAllPriorProbability + cReliability + cTrial + cAllPriorProbability:cReliability + cReliability:cTrial + cAllPriorProbability:cReliability:cTrial + (cAllPriorProbability * cReliability| Item) + (cAllPriorProbability * cReliability| workerid), data=centered)
summary(m.trial.nopr)

anova(m.trial.nopt,m.trial)

# spell out all the interactions
#m.trial = lmer(normresponse ~ cAllPriorProbability + cReliability + cTrial + cAllPriorProbability:cReliability + cReliability:cTrial + cAllPriorProbability:cTrial + cAllPriorProbability:cReliability:cTrial + (cAllPriorProbability * cReliability| Item) + (cAllPriorProbability * cReliability| workerid), data=centered)

# PLOT SPEAKER RELIABILITY RESULTS BY BLOCK
agr = aggregate(normresponse ~ AllPriorProbability  + trial_type + Item + block,data=some100,FUN=mean)
agr$CILow = aggregate(normresponse ~ AllPriorProbability + trial_type + Item + block,data=some100, FUN=ci.low)$normresponse
agr$CIHigh = aggregate(normresponse ~ AllPriorProbability + trial_type + Item + block,data=some100,FUN=ci.high)$normresponse
agr$YMin = agr$normresponse - agr$CILow
agr$YMax = agr$normresponse + agr$CIHigh

p=ggplot(agr, aes(x=AllPriorProbability,y=normresponse, color=trial_type)) +
  geom_point() +
  #geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  geom_smooth(method="lm") +
  scale_y_continuous(name="Posterior probability of all-state") +
  scale_x_continuous(name="Prior probability of all-state") +
  scale_color_manual(values=c(wes_palette("Darjeeling")[1:3]),name="Trial type",breaks=levels(agr$trial_type),labels=c("uninformative (court)", "unreliable (drunk)", "cooperative (sober)")) +
  facet_wrap(~block)
p
ggsave("pics/speakerreliabilityresults-byblock.pdf",width=12,height=4)

#####################################
# plot model predictions: expectations
load("~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/models/wonky_world/results/data/mp-uniform.RData")

library(dplyr)
library(plyr)
# plot expectations for best basic model:
toplot = droplevels(subset(mp, Quantifier == "some" & WonkyWorldPrior == .5))
nrow(toplot)
pexpectations = ddply(toplot, .(Item), summarise, PosteriorExpectation_predicted=sum(State*PosteriorProbability)/15)
head(pexpectations)
some = pexpectations#droplevels(subset(pexpectations, Quantifier == "some"))

toplot = some
nrow(toplot)
head(toplot)
toplot$Mode = priormodes[as.character(toplot$Item),]$Mode

ggplot(toplot, aes(x=PriorExpectation_smoothed, y=PosteriorExpectation_predicted)) +
  geom_point(color="#00B0F6") + #values=c("#F8766D", "#A3A500", "#00BF7D", "#E76BF3", "#00B0F6")
  geom_smooth(color="#00B0F6") +
  #  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1), name="Prior expectation") +
  scale_y_continuous(limits=c(0,1), name="Model predicted posterior expectation")

load("~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/models/wonky_world/results/data/mp-uniform.RData")

# plot expectations for best basic model:
toplot = droplevels(subset(mp, Quantifier == "some" & WonkyWorldPrior == .5 & State == 15))
nrow(toplot)

# adjust speaker optimality at will
toplot = droplevels(subset(toplot, SpeakerOptimality == 2))
nrow(toplot)
head(toplot)

toplot_w = toplot
# get rRSA predictions for qud=how-many, alts=0_basic, spopt=2
load("~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/models/complex_prior/smoothed_unbinned15/results/data/mp.RData")
summary(mp)
toplot = droplevels(subset(mp, QUD == "how-many" & Alternatives == "0_basic" &  State == 15))
nrow(toplot)

# adjust speaker optimality at will
toplot = droplevels(subset(toplot, SpeakerOptimality == 2))
nrow(toplot)
head(toplot)

toplot_r = toplot
toplot_r$Model = "RSA"
toplot_w$Model = "wRSA"

# plot both rRSA and uniform wRSA expectation predictions in same plot
toplot = merge(toplot_r,toplot_w, all=T)
head(toplot)
nrow(toplot)
p_probs = ggplot(toplot, aes(x=PriorProbability, y=PosteriorProbability, color=Model)) +
  geom_point() + #color="#00B0F6") + #values=c("#F8766D", "#A3A500", "#00BF7D", "#E76BF3", "#00B0F6")
  geom_smooth() + #color="#00B0F6") +
  scale_color_manual(values=c("darkred",wes_palette("Darjeeling")[1])) +
  #  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1), name="Prior mean all-state probability") +
  scale_y_continuous(limits=c(0,1), name="Predicted posterior all-state probability")
p_probs
ggsave("pred_probs.pdf")

p_probs = ggplot(toplot_r, aes(x=PriorProbability, y=PosteriorProbability, color=Model)) +
  geom_point() + #color="#00B0F6") + #values=c("#F8766D", "#A3A500", "#00BF7D", "#E76BF3", "#00B0F6")
  geom_smooth() + #color="#00B0F6") +
  scale_color_manual(values=c("darkred")) +
  #  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1), name="Prior all-state probability") +
  scale_y_continuous(limits=c(0,1), name="Posterior all-state probability")
p_probs
ggsave("pred_prob_rsa.pdf")

# plot model predictions: expectations
load("~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/models/wonky_world/results/data/mp-uniform.RData")

# plot expectations for best basic model:
toplot = droplevels(subset(mp, Quantifier == "some" & WonkyWorldPrior == .5))
nrow(toplot)

pexpectations = ddply(toplot, .(Item, SpeakerOptimality,PriorExpectation), summarise, PosteriorExpectation_predicted=sum(State*PosteriorProbability)/15)
head(pexpectations)
some = pexpectations#droplevels(subset(pexpectations, Quantifier == "some"))

toplot = droplevels(subset(some, SpeakerOptimality == 2))
nrow(toplot)
head(toplot)
toplot_w = toplot

# get rRSA predictions for qud=how-many, alts=0_basic, spopt=2
load("~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/models/complex_prior/smoothed_unbinned15/results/data/toplot-expectations.RData")
toplot_r = toplot
head(toplot_w)
summary(toplot_r)
toplot_r$Model = "RSA"
toplot_r$PriorExpectation = toplot_r$PriorExpectation_smoothed*15
toplot_w$Model = "wRSA"

# plot both rRSA and uniform wRSA expectation predictions in same plot
toplot = merge(toplot_r,toplot_w, all=T)
head(toplot)
nrow(toplot)

p_exps = ggplot(toplot, aes(x=PriorExpectation, y=PosteriorExpectation_predicted*15, color=Model)) +
  geom_point() + #color="#00B0F6") + #values=c("#F8766D", "#A3A500", "#00BF7D", "#E76BF3", "#00B0F6")
  geom_smooth() + #color="#00B0F6") +
  scale_color_manual(values=c("darkred",wes_palette("Darjeeling")[1])) +#values=c("#007fb1", "#4ecdff")) +
  #  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,15), breaks=seq(1,15,by=2), name="Prior mean number of objects") +
  scale_y_continuous(limits=c(0,15), breaks=seq(1,15,by=2), name="Predicted posterior number of objects")
p_exps
ggsave("pred_exps.pdf")

p_exps = ggplot(toplot_r, aes(x=PriorExpectation, y=PosteriorExpectation_predicted*15, color=Model)) +
  geom_point() + #color="#00B0F6") + #values=c("#F8766D", "#A3A500", "#00BF7D", "#E76BF3", "#00B0F6")
  geom_smooth() + #color="#00B0F6") +
  scale_color_manual(values=c("darkred")) +#values=c("#007fb1", "#4ecdff")) +
  #  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,15), breaks=seq(1,15,by=2), name="Prior expectation") +
  scale_y_continuous(limits=c(0,15), breaks=seq(1,15,by=2), name="Posterior expectation")
p_exps
ggsave("pred_exps_rsa.pdf")

library(gridExtra)
#  share a legend between multiple plots
g <- ggplotGrob(p_exps + theme(legend.position="right"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
p_exps_nolegend = p_exps + theme(legend.position="none")
p_probs_nolegend = p_probs + theme(legend.position="none")

pdf("rsa-predictions.pdf",width=12,height=4.9)
grid.arrange(p_exps_nolegend, p_probs_nolegend, legend,nrow=1,widths=unit.c(unit(.45, "npc"), unit(.45, "npc"), unit(.1, "npc")))
dev.off()

# expectations
load("~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/13_sinking-marbles-priordv-15/results/data/r.RData")

agr = aggregate(ProportionResponse ~ PriorExpectationProportion + quantifier + Item,data=r,FUN=mean)

min(agr[agr$quantifier == "Some",]$ProportionResponse)
max(agr[agr$quantifier == "Some",]$ProportionResponse)
agr$Quantifier = factor(x=agr$quantifier, levels=c("Some","All","None","long_filler","short_filler"))

p_eexps = ggplot(agr, aes(x=PriorExpectationProportion*15, y=ProportionResponse*15, color=Quantifier, shape=Quantifier)) +
  geom_point() +
  #geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  geom_smooth(method="lm") +
  scale_color_manual(values=c(wes_palette("Darjeeling")[1:3],"black","gray40")) +#values=c("#F8766D", "black", "#00BF7D", "gray30", "#00B0F6"),breaks=levels(agr$quantifier),labels=c("all","long filler","none","short filler","some")) +
  scale_y_continuous(breaks=seq(1,15,by=2),name="Posterior mean number of objects") +
  #  geom_abline(intercept=0,slope=1,color="gray70") +
  scale_x_continuous(breaks=seq(1,15,by=2),name="Prior mean number of objects")
p_eexps
ggsave(file="empirical_exps.pdf")#,width=5,height=3.7)

# allstate-probs
load("~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/16_sinking-marbles-sliders-certain/results/data/r.RData")

# exclude people who are doing some sort of bullshit and not responding reasonably to all/none (see subject-variability.pdf for behavior on zero-slider)
tmp = subset(r,!workerid %in% c(0,22,43,98,100,103,117,118))
agrr = aggregate(normresponse ~ AllPriorProbability + Proportion + quantifier + Item,data=tmp,FUN=mean)
agrr = aggregate(normresponse ~ AllPriorProbability + Proportion + quantifier + Item,data=r,FUN=mean)
ub = subset(agrr, Proportion == "100")
ub = droplevels(ub)
ub$Quantifier = factor(x=ub$quantifier, levels=c("Some","All","None","long_filler","short_filler"))

p_eprobs = ggplot(ub, aes(x=AllPriorProbability, y = normresponse, color=Quantifier, shape=Quantifier)) +
  geom_point() +
  geom_smooth(method="lm") +
  scale_color_manual(values=c(wes_palette("Darjeeling")[1:3],"black","gray40")) +#values=c("#F8766D", "black", "#00BF7D", "gray30", "#00B0F6"),breaks=levels(agr$quantifier),labels=c("all","long filler","none","short filler","some")) +
  scale_y_continuous(limits=c(0,1),name="Posterior probability of all-state ") +
  #  geom_abline(intercept=0,slope=1,color="gray70") +
  scale_x_continuous(limits=c(0,1),name="Prior probability of all-state")
p_eprobs
ggsave(file="empirical-allprobs.pdf")#,width=5,height=3.7)

library(gridExtra)
#  share a legend between multiple plots
g <- ggplotGrob(p_eexps + theme(legend.position="right"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
p_eexps_nolegend = p_eexps + theme(legend.position="none")
p_eprobs_nolegend = p_eprobs + theme(legend.position="none")

pdf("empirical-results.pdf",width=12,height=4.9)
grid.arrange(p_eexps_nolegend, p_eprobs_nolegend, legend,nrow=1,widths=unit.c(unit(.45, "npc"), unit(.45, "npc"), unit(.1, "npc")))
dev.off()

load("~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/models/wonky_world/results/data/wr-uniform.RData")

# plot expectations for best basic model:
toplot = droplevels(subset(wr, WonkyWorldPrior == .5 & Wonky == "true"))
nrow(toplot)
toplot$Mode = priormodes[as.character(toplot$Item),]$Mode

toplot = droplevels(subset(toplot, SpeakerOptimality == 2))
nrow(toplot)
head(toplot)
#toplot$quantifier = capitalize(as.character(toplot$Quantifier))
toplot$Quantifier = factor(toplot$Quantifier, levels=c("some","all","none"))

p_wmodel = ggplot(toplot, aes(x=PriorExpectation, y=PosteriorProbability,color=Quantifier,shape=Quantifier)) +
  geom_point() +
  geom_smooth() +
  scale_color_manual(values=c(wes_palette("Darjeeling")[1:3],"black","gray40")) +
  #scale_color_manual(values=c("#F8766D","#00BF7D","#00B0F6")) +
  scale_x_continuous(breaks=seq(1,15,by=2),name="Prior mean number of objects") +
  scale_y_continuous(breaks=seq(0,1,by=.25),name="Predicted posterior wonkiness probability") +
  theme(plot.margin=unit(c(0,0,0,0),units="cm"))
p_wmodel
ggsave("model-wonkiness-uniform.pdf",width=6.8,height=5)#,width=30,height=10)

############
# empirical wonkiness posteriors
############
load("/Users/titlis/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/17_sinking-marbles-normal-sliders/results/data/r.RData")
head(r)
nrow(r)

toplot = aggregate(response ~ quantifier + Item + PriorExpectation, FUN="mean", data=r)
toplot = droplevels(subset(toplot, quantifier %in% c("All","Some","None")))
toplot$Quantifier = factor(tolower(toplot$quantifier), levels=c("all", "none","some"))
toplot$Mode = priormodes[as.character(toplot$Item),]$Mode
toplot$quantifier = capitalize(as.character(toplot$Quantifier))
toplot$Quantifier = factor(toplot$quantifier, levels=c("Some","All","None"))

p_wempirical = ggplot(toplot, aes(x=PriorExpectation, y=response, color=Quantifier,shape=Quantifier)) +
  geom_point() +
  geom_smooth() +
  scale_color_manual(values=c(wes_palette("Darjeeling")[1:3],"black","gray40")) +
  scale_x_continuous(breaks=seq(1,15,by=2),name="Prior mean number of objects") +
  scale_y_continuous(breaks=seq(0,1,by=.25),name="Mean empirical wonkiness probability")  +
  theme(plot.margin=unit(c(0,0,0,0),units="cm"))
p_wempirical
ggsave(file="empirical-wonkiness.pdf",width=6.8,height=5)

library(gridExtra)
#  share a legend between multiple plots
g <- ggplotGrob(p_wmodel + theme(legend.position="right"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
p_wmodel_nolegend = p_wmodel + theme(legend.position="none")
p_wempirical_nolegend = p_wempirical + theme(legend.position="none")

#pdf("rsa-predictions-uniform.pdf",width=10,height=4)
pdf("wonkiness-fullplot.pdf",width=12,height=5)
grid.arrange(p_wmodel_nolegend, p_wempirical_nolegend, legend,nrow=1,widths=unit.c(unit(.45, "npc"), unit(.45, "npc"), unit(.1, "npc")))
dev.off()

## load four-step priors for generating appendix plots
priorprobs = read.table(file="~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/24_sinking-marbles-prior-fourstep/results/data/smoothed_15marbles_priors_withnames.txt",sep="\t", header=T, quote="")
row.names(priorprobs) = priorprobs$Item
nrow(priorprobs)

# prior all-state probability for each item
prior_allprobs = priorprobs[,c("Item","X15")]
row.names(prior_allprobs) = prior_allprobs$Item

# prior expectation for each item
gathered_probs <- priorprobs %>%
  gather(State,Probability,X0:X15)
gathered_probs$State = as.numeric(as.character(gsub("X","",gathered_probs$State)))
prior_exps <- gathered_probs %>%
  group_by(Item) %>%
  summarise(exp.val=sum(State*Probability))
prior_exps = as.data.frame(prior_exps)
row.names(prior_exps) = prior_exps$Item
summary(prior_exps)

# histogram of expectations
exps = ggplot(prior_exps, aes(x=exp.val)) +
  geom_histogram() +
  scale_x_continuous(name="Expected value of prior distribution",breaks=seq(1,15, by=2)) +
  scale_y_continuous(name="Number of cases",breaks=seq(0,8, by=2))
ggsave("pics/priorexpectations-histogram-fourstep.pdf",width=5,height=3.7)

# histogram of allstate-probs
allprobs = ggplot(prior_allprobs, aes(x=X15)) +
  geom_histogram() +
  scale_x_continuous(name="Prior all-state probability") +
  scale_y_continuous(name="Number of cases")
ggsave("priorallprobs-histogram-fourstep.pdf")

pdf("pics/priordistributions-fourstep.pdf",width=10,height=3.5)
grid.arrange(exps, allprobs, nrow=1,widths=unit.c(unit(.5, "npc"), unit(.5, "npc")))
dev.off()


# Compare current habitat temperatures
# to upper thermal limits in marine and terrestrial species
# Use operative temperature on land, use SST in ocean
# Use temp at each location, rather than lat averages

require(mgcv)
require(data.table)
require(lme4)

##################
# Functions
##################

# round a single value (x) to nearest value in a vector (y)
roundto <- function(x, y){
	a <- abs(x - y)
	i <- which(a==min(a)) # can return 1 or 2 matches
	return(y[i])
}

##################
# Parameters
##################
# for adjusting max air temperature to account for elevation
lapse <- 0.0055 # degC/m elevation. See Sunday et al. 2014 PNAS supplement

#set Acclimation Response Ratio for terrestrial and marine organisms
# from Gunderson and Stillman model-averaged results (Gunderson pers. comm.)
ARRland <- 0.11
ARRoce <- 0.24

#################
# Read in data
#################

# Measurements of upper thermal tolerance and NicheMapR (terrestrial microclimates)
dat <- fread(file="output/dataset_1_hotwater_Nichemapped_GHCNDnonequil.csv") # nonequilibrium Tb calculations. Built from dataset_1_hotwater_Nichemapped_GHCND.csv

	# fix column names
	setnames(dat, c('tmax', 'REF_max', 'lat_max', 'long_max'), c('Tmax', 'citation', 'lat', 'lon'))

	# read in traits
	traits <- fread('data/tmax_data/dataset_1_traits.csv')

		# fix benthopelagic and pelagic
		traits[demers_pelag_fb == 'benthopelagic', demers_pelag := 'demersal']
		traits[demers_pelag_fb == 'pelagic-neritic', demers_pelag := 'pelagic-neritic']

	# read in species-specific ARR
	arr <- fread('data/tmax_data/dataset_1_ARRs.tsv')

		# merge traits and arr
		traits2 <- merge(traits, arr[, .(Genus, Species, ctmax_ARR_GS)], by=c('Genus', 'Species'), all.x=TRUE)

	# merge	traits and data
	dat <- merge(dat[,.(Genus, Species, Tmax, tmax_metric, tmax_acc, lat, lon, altitude, citation, Phylum, Class, Order, Family, NMGHCND_2m_shade_Tb95, NMGHCND_exposed_Tb95, NMGHCND_exposed_Tb_wet95, NMGHCND_shade_Tb_wet95)], traits2[, .(Genus, Species, thermy, Realm, Realm_detail, demers_pelag, mobility, weight, length, ctmax_ARR_GS)], all.x=TRUE, by=c('Genus', 'Species'))
		dim(dat)

	# trim out freshwater and intertidal
	dat <- dat[Realm %in% c('Marine', 'Terrestrial') & Genus != 'Gillichthys' & !(Realm_detail %in% c('catadromous', 'anadromous', 'amphidromous', 'freshwater')),]
		dim(dat)

	# re-order dat alphabetically
	dat <- dat[order(dat$Genus, dat$Species, dat$citation),]

	# how much trait data?
	dat[,sort(unique(Realm))]
	dat[Realm=='Marine', summary(length)]
	dat[Realm=='Marine', sort(unique(demers_pelag))]
	dat[Realm=='Marine', sort(unique(mobility))]

# Elevation
	load('temp/elev.rdata') # elev data.frame 0.5x0.5

# Current temperatures
	# read in climatologies for annual mean
	load('temp/lstclimatology.rdata') # lstclim (0.25x0.25)
	load('temp/sstclimatology.rdata') # sstclim
#		lstclimn <- lstclim
#		sstclimn <- sstclim
#
#	# read in climatologies for summer mean
	load('temp/lstclimatology_warm3.rdata') # lstclimwarm3 (0.25x0.25 grid)
	load('temp/sstclimatology_warm3.rdata') # sstclimwarm3
		lstclimwarm3n <- lstclimwarm3
		sstclimwarm3n <- sstclimwarm3
#
#	# read in climatology for the warmest month
	load('temp/sstclimatology_warmestmonth.rdata') # sstclimwarmestmo (0.25x0.25 grid)
	load('temp/lstclimatology_warmestmonth.rdata')
		lstclimwarmestmon <- lstclimwarmestmo
		sstclimwarmestmon <- sstclimwarmestmo

	# read in data for the 95% warmest daily maximum
	load('temp/tos95max.rdata') # tos95max (0.25x0.25 grid): ocean (95% warmest day + 50% DTR)

	# read in data for the warmest daily maximum
	load('temp/tosmax.rdata') # tosmax (0.25x0.25 grid): ocean (warmest day + 50% DTR)
#	load('temp/tasmax.rdata') # tasmax: air 0.25x0.25 (warmest daily max value averaged across any month). Use NicheMapR instead

############################################################################################################
# match habitat temperature to lat/lon of thermal tolerance (mostly for ocean since NicheMapR used on land
############################################################################################################

# Initialize columns for current habitat temperatures (those not from NicheMapR) and elevation
dat$elev.grid <- dat$thab95hr <- dat$thabmaxmo <- dat$thabsum <- dat$thabann <-  NA

# Get lists of latitude and longitude values in the temperature data
llons <- as.numeric(colnames(lstclimwarmestmon))
llats <- as.numeric(rownames(lstclimwarmestmon))
slons <- as.numeric(colnames(tosmax))
slats <- as.numeric(rownames(tosmax))

llonstep <- abs(diff(llons)[1])
slonstep <- abs(diff(slons)[1])
llatstep <- abs(diff(llats)[1])
slatstep <- abs(diff(slats)[1])

# Match each data point to temperature and elevation data based on lat/lon and habitat
for(i in 1:nrow(dat)){
	if(!is.na(dat$lat[i]) & !is.na(dat$lon[i])){

		# land
		if(dat$Realm[i]=='Terrestrial'){
			if(dat$lon[i] < 0){ # may need to correct lon to 0-360
				lons <- roundto(dat$lon[i] + 360, llons) # find the closest longitude (or lons)
			} else {
				lons <- roundto(dat$lon[i], llons)
			}
			lats <- roundto(dat$lat[i], llats) # find the closest latitudes (or latitudes)

			# look for grid cell with data
			ltemp <- mean(lstclimwarmestmon[as.character(lats), as.character(lons)], na.rm=TRUE) # test

			if(is.na(ltemp)){ # if didn't get a value, try searching in a slightly wider area (may have moved off land in rounding)
				cat(paste('Going to wider search area for i=', i, dat$Genus[i], dat$Species[i], 'on land\n'))
				origlats <- lats
				origlons <- lons

				if(all(lats > dat$lat[i])){ # move down one step if all rounded lats are greater
					lats <- c(lats, lats - llatstep)
				}
				if(all(lats < dat$lat[i])){
					lats <- c(lats, lats + llatstep)
				}
				if(all(lons > dat$lon[i])){
					lons <- c(lons, lons - llonstep)
				}
				if(all(lons < dat$lon[i])){
					lons <- c(lons, lons + llonstep)
				}

				ltemp <- mean(lstclimwarmestmon[as.character(lats), as.character(lons)], na.rm=TRUE) # land temp

				# take only the first element so that  addition and subtraction work in following steps
				origlats <- lats[1]
				origlons <- lons[1]

				if(is.na(ltemp)){ # if still don't get a value, try searching in 9-grid area
					cat(paste('\tGoing to 9-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'on land\n'))
					lats <- c(origlats-llatstep, origlats, origlats+llatstep)
					lons <- c(origlons-llonstep, origlons, origlons+llonstep)
					ltemp <- mean(lstclimwarmestmon[as.character(lats), as.character(lons)], na.rm=TRUE) # land temp
				}

				if(is.na(ltemp)){ # if still don't get a value, try searching in 25-grid area
					cat(paste('\tGoing to 25-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'on land\n'))
					lats <- c(origlats-llatstep*(2:1), origlats, origlats+llatstep*(1:2))
					lons <- c(origlons-llonstep*(2:1), origlons, origlons+llonstep*(1:2))
					ltemp <- mean(lstclimwarmestmon[as.character(lats), as.character(lons)], na.rm=TRUE) # land temp
				}

				if(is.na(ltemp)){ # if still don't get a value, try searching in 49-grid area
					cat(paste('\tGoing to 49-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'on land\n'))
					lats <- c(origlats-llatstep*(3:1), origlats, origlats+llatstep*(1:3))
					lons <- c(origlons-llonstep*(3:1), origlons, origlons+llonstep*(1:3))
					ltemp <- mean(lstclimwarmestmon[as.character(lats), as.character(lons)], na.rm=TRUE) # land temp
				}

				if(is.na(ltemp)){ # if still don't get a value, try searching in 81-grid area
					cat(paste('\tGoing to 81-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'on land\n'))
					lats <- c(origlats-llatstep*(4:1), origlats, origlats+llatstep*(1:4))
					lons <- c(origlons-llonstep*(4:1), origlons, origlons+llonstep*(1:4))
					ltemp <- mean(lstclimwarmestmon[as.character(lats), as.character(lons)], na.rm=TRUE) # land temp
				}

				if(is.na(ltemp)){
					cat(paste('\tGoing to 121-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'on land\n'))
					lats <- c(origlats-llatstep*(5:1), origlats, origlats+llatstep*(1:5))
					lons <- c(origlons-llonstep*(5:1), origlons, origlons+llonstep*(1:5))
					ltemp <- mean(lstclimwarmestmon[as.character(lats), as.character(lons)], na.rm=TRUE) # land temp
				}

				if(is.na(ltemp)){
					cat(paste('\tGoing to 169-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'on land\n'))
					lats <- c(origlats-llatstep*(6:1), origlats, origlats+llatstep*(1:6))
					lons <- c(origlons-llonstep*(6:1), origlons, origlons+llonstep*(1:6))
					ltemp <- mean(lstclimwarmestmon[as.character(lats), as.character(lons)], na.rm=TRUE) # land temp
				}

				if(is.na(ltemp)){
					cat(paste('\tGoing to 225-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'on land\n'))
					lats <- c(origlats-llatstep*(7:1), origlats, origlats+llatstep*(1:7))
					lons <- c(origlons-llonstep*(7:1), origlons, origlons+llonstep*(1:7))
					ltemp <- mean(lstclimwarmestmon[as.character(lats), as.character(lons)], na.rm=TRUE) # land temp
				}

				if(is.na(ltemp)){
					cat(paste('\tGoing to 289-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'on land\n'))
					lats <- c(origlats-llatstep*(9:1), origlats, origlats+llatstep*(1:9))
					lons <- c(origlons-llonstep*(9:1), origlons, origlons+llonstep*(1:9))
					ltemp <- mean(lstclimwarmestmon[as.character(lats), as.character(lons)], na.rm=TRUE) # land temp
				}

				cat(paste('\tltemp now', ltemp, '\n'))

			}

			# for annual mean
			dat$thabann[i] <- mean(lstclim[as.character(lats), as.character(lons)], na.rm=TRUE)

			# for summer mean
			dat$thabsum[i] <- mean(lstclimwarm3n[as.character(lats), as.character(lons)], na.rm=TRUE)

			# for max month
			dat$thabmaxmo[i] <- mean(lstclimwarmestmo[as.character(lats), as.character(lons)], na.rm=TRUE)

			# for elevation
			dat$elev.grid[i] <- mean(elev[as.character(lats), as.character(lons)], na.rm=TRUE)

		}

		# ocean
		if(dat$Realm[i]=='Marine'){
			if(dat$lon[i] < 0){
				lons <- roundto(dat$lon[i] + 360, slons)
			} else {
				lons <- roundto(dat$lon[i], slons)
			}
			lats <- roundto(dat$lat[i], slats)

			# look for grid cell with data
			stemp <- mean(tosmax[as.character(lats), as.character(lons)], na.rm=TRUE) # ocean temp

			if(is.na(stemp)){ # if didn't get a value, try searching in a slightly wider area (may have moved off ocean in rounding)
				cat(paste('Going to wider search area for i=', i, dat$Genus[i], dat$Species[i], 'at sea\n'))
				origlats <- lats
				origlons <- lons

				if(all(lats > dat$lat[i])){ # move down one step if all rounded lats are greater
					lats <- c(lats, lats - slatstep)
				}
				if(all(lats < dat$lat[i])){
					lats <- c(lats, lats + slatstep)
				}
				if(all(lons > dat$lon[i])){
					lons <- c(lons, lons - slonstep)
				}
				if(all(lons < dat$lon[i])){
					lons <- c(lons, lons + slonstep)
				}

				stemp <- mean(tosmax[as.character(lats), as.character(lons)], na.rm=TRUE) # ocean temp

				# take only the first element so that  addition and subtraction work in following steps
				origlats <- lats[1]
				origlons <- lons[1]

				if(is.na(stemp)){ # if still don't get a value, try searching in 9-grid area
					cat(paste('\tGoing to 9-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'at sea\n'))
					lats <- c(origlats-slatstep, origlats, origlats+slatstep)
					lons <- c(origlons-slonstep, origlons, origlons+slonstep)
					stemp <- mean(tosmax[as.character(lats), as.character(lons)], na.rm=TRUE) # ocean temp
				}

				if(is.na(stemp)){ # if still don't get a value, try searching in 25-grid area
					cat(paste('\tGoing to 25-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'at sea\n'))
					lats <- c(origlats-slatstep*(2:1), origlats, origlats+slatstep*(1:2))
					lons <- c(origlons-slonstep*(2:1), origlons, origlons+slonstep*(1:2))
					stemp <- mean(tosmax[as.character(lats), as.character(lons)], na.rm=TRUE)
				}

				if(is.na(stemp)){ # if still don't get a value, try searching in 49-grid area
					cat(paste('\tGoing to 49-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'at sea\n'))
					lats <- c(origlats-slatstep*(3:1), origlats, origlats+slatstep*(1:3))
					lons <- c(origlons-slonstep*(3:1), origlons, origlons+slonstep*(1:3))
					stemp <- mean(tosmax[as.character(lats), as.character(lons)], na.rm=TRUE)
				}

				if(is.na(stemp)){ # if still don't get a value, try searching in 81-grid area
					cat(paste('\tGoing to 81-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'at sea\n'))
					lats <- c(origlats-slatstep*(4:1), origlats, origlats+slatstep*(1:4))
					lons <- c(origlons-slonstep*(4:1), origlons, origlons+slonstep*(1:4))
					stemp <- mean(tosmax[as.character(lats), as.character(lons)], na.rm=TRUE)
				}

				if(is.na(stemp)){
					cat(paste('\tGoing to 121-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'at sea\n'))
					lats <- c(origlats-slatstep*(5:1), origlats, origlats+slatstep*(1:5))
					lons <- c(origlons-slonstep*(5:1), origlons, origlons+slonstep*(1:5))
					stemp <- mean(tosmax[as.character(lats), as.character(lons)], na.rm=TRUE)
				}

				if(is.na(stemp)){
					cat(paste('\tGoing to 169-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'at sea\n'))
					lats <- c(origlats-slatstep*(6:1), origlats, origlats+slatstep*(1:6))
					lons <- c(origlons-slonstep*(6:1), origlons, origlons+slonstep*(1:6))
					stemp <- mean(tosmax[as.character(lats), as.character(lons)], na.rm=TRUE)
				}

				if(is.na(stemp)){
					cat(paste('\tGoing to 225-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'at sea\n'))
					lats <- c(origlats-slatstep*(7:1), origlats, origlats+slatstep*(1:7))
					lons <- c(origlons-slonstep*(7:1), origlons, origlons+slonstep*(1:7))
					stemp <- mean(tosmax[as.character(lats), as.character(lons)], na.rm=TRUE)
				}

				cat(paste('\tstemp now', stemp, '\n'))
			}

			# for annual mean
			dat$thabann[i] <- mean(sstclim[as.character(lats), as.character(lons)], na.rm=TRUE)

			# for summer mean
			dat$thabsum[i] <- mean(sstclimwarm3n[as.character(lats), as.character(lons)], na.rm=TRUE)

			# for max month
			dat$thabmaxmo[i] <- mean(sstclimwarmestmo[as.character(lats), as.character(lons)], na.rm=TRUE)

			# for 95% max hour
			dat$thab95hr[i] <- mean(tos95max[as.character(lats), as.character(lons)], na.rm=TRUE)

		}

	}
}

	# check
	dat[,summary(thabann)]
	dat[,summary(thabsum)]
	dat[,summary(thabmaxmo)]
	dat[Realm=='Marine',summary(thabann)]
	dat[Realm=='Marine',summary(thab95hr)]

	dat[!is.na(NMGHCND_2m_shade_Tb95),summary(thabann)] # have NM data, but not thabann

	dat[Realm=='Marine' & is.na(thabann),]

##############################################################
# adjust terrestrial habitat temperatures based on elevation differences
##############################################################
dat[,thabann.adj := thabann]
dat[,thabsum.adj := thabsum]
dat[,thabmaxmo.adj := thabmaxmo]

i <- dat[,!is.na(altitude) & !is.na(elev.grid) & Realm=='Terrestrial']
dat[i,thabann.adj := thabann + lapse*(elev.grid - altitude)] # adjust for altitude offset from grid cell
dat[i,thabsum.adj := thabsum + lapse*(elev.grid - altitude)] # adjust for altitude offset from grid cell
dat[i,thabmaxmo.adj := thabmaxmo + lapse*(elev.grid - altitude)] # adjust for altitude offset from grid cell

##############################################################################
# adjust marine habitat temperatures based on behavioral thermoregulation
##############################################################################
# let marine species access cooler microhabitats through behavioral thermoregulation, down to -2degC (for warmest hours)

# initialize columns
dat[,thab95hr.marineBT := as.numeric(NA)]
dat[Realm=='Marine',thab95hr.marineBT := thab95hr]
dat[,thab95hr.marineBTmore := as.numeric(NA)]
dat[Realm=='Marine',thab95hr.marineBTmore := thab95hr] # 50% more
dat[,thab95hr.marineBTless := as.numeric(NA)]
dat[Realm=='Marine',thab95hr.marineBTless := thab95hr] # 50% less

# marine behavioral thermoregulation table
marBT <- data.table(mobility=c('swim', 'swim', 'swim', 'swim', 'swim', 'swim', 'crawl', 'crawl', 'sessile', 'sessile'), demers_pelag=c('pelagic-neritic', 'pelagic-neritic', 'demersal', 'pelagic', 'demersal', 'pelagic', 'demersal', 'demersal', 'demersal', 'demersal'), big=c(TRUE, FALSE, TRUE, TRUE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE), MBTrefuge=c(10, 3, 3, 10, 1, 10, 1, 0.5, 0, 0))
	marBT

# merge in the MBT table
dat[,big := length>50] # mark the big species (>50cm)
dat <- merge(dat, marBT, all.x=TRUE, by=c('demers_pelag', 'mobility', 'big'))
	nrow(dat)

# calculate refugium temperatures
dat[, thab95hr.marineBT := pmax(-2, thab95hr - MBTrefuge)] # for 95% warmest hour
dat[, thab95hr.marineBTmore := pmax(-2, thab95hr - MBTrefuge*1.5)] # 50% more
dat[, thab95hr.marineBTless := pmax(-2, thab95hr - MBTrefuge*0.5)] # 50% less

############################################
# adjust Tmax for acclimation temperature
############################################
dat[,tmax.accsum := as.numeric(NA)] # use summer temp for acclimation
dat[,tmax.accsum.elev := as.numeric(NA)]
dat[,tmax.accsumbyspp := as.numeric(NA)] # with species-specific ARRs
dat[,tmax.accsumbyspp.elev := as.numeric(NA)]

# if acclimation value is "F" (field?), set to missing
dat[tmax_acc=='F', tmax_acc := as.character(NA)]
if(class(dat$tmax_acc)!='numeric') dat[,tmax_acc := as.numeric(tmax_acc)]

# adjust Tmax based on acclimation (average ARR)
lnd <- dat[,Realm=='Terrestrial' & !is.na(tmax_acc)]
dat[lnd, tmax.accsum := Tmax + ARRland*(thabsum-tmax_acc)] # adjust from acclimation temp to the summer temperature
dat[lnd, tmax.accsum.elev := Tmax + ARRland*(thabsum.adj-tmax_acc)] # adjust from acclimation temp to the summer temperature. with elevation correction

oce <- dat[,Realm=='Marine' & !is.na(tmax_acc)]
dat[oce, tmax.accsum := Tmax + ARRoce*(thabsum-tmax_acc)]
dat[oce, tmax.accsum.elev := Tmax + ARRoce*(thabsum.adj-tmax_acc)]

	# no adjustment to Tmax where acclimation temp unknown
	dat[Realm=='Terrestrial' & is.na(tmax.accsum), tmax.accsum := Tmax]
	dat[Realm=='Terrestrial' & is.na(tmax.accsum.elev), tmax.accsum.elev := Tmax]

	dat[Realm=='Marine' & is.na(tmax.accsum), tmax.accsum := Tmax]
	dat[Realm=='Marine' & is.na(tmax.accsum.elev), tmax.accsum.elev := Tmax]

# adjust Tmax based on species-specific ARRs
lnd <- dat[,Realm=='Terrestrial' & !is.na(tmax_acc) & !is.na(ctmax_ARR_GS)]
dat[lnd, tmax.accsumbyspp := Tmax + ctmax_ARR_GS*(thabsum-tmax_acc)]
dat[lnd, tmax.accsumbyspp.elev := Tmax + ctmax_ARR_GS*(thabsum.adj-tmax_acc)]

oce <- dat[,Realm=='Marine' & !is.na(tmax_acc) & !is.na(ctmax_ARR_GS)]
dat[oce, tmax.accsumbyspp := Tmax + ctmax_ARR_GS*(thabsum-tmax_acc)]
dat[oce, tmax.accsumbyspp.elev := Tmax + ctmax_ARR_GS*(thabsum.adj-tmax_acc)]

# Examine
dat[,summary(Tmax)]
dat[,summary(tmax.accsum)]
dat[,summary(tmax.accsum.elev)]
dat[,summary(tmax.accsumbyspp.elev)]

	# examine missing values
dat[is.na(tmax.accsumbyspp),]

	# difference from uncorrected tmax
dat[!is.na(tmax.accsum),.(mean=mean(Tmax - tmax.accsum), se=sd(Tmax - tmax.accsum)/sqrt(.N)), by=Realm]

	# difference from average ARR
dat[!is.na(tmax.accsumbyspp),.(mean=mean(tmax.accsum - tmax.accsumbyspp), se=sd(tmax.accsum - tmax.accsumbyspp)/sqrt(.N))]
dat[!is.na(tmax.accsumbyspp.elev),.(mean=mean(tmax.accsum.elev - tmax.accsumbyspp.elev), se=sd(tmax.accsum.elev - tmax.accsumbyspp.elev)/sqrt(.N))]
dat[!is.na(tmax.accsumbyspp),.(N=.N)]
dat[!is.na(tmax.accsumbyspp.elev),.(N=.N)]

#	dat[,plot(Tmax, tmax.accsum)]; abline(0,1)
#	dat[,plot(Tmax, tmax.accsum.elev)]; abline(0,1)
#	dat[,plot(tmax.accsum.elev, tmax.accsumbyspp.elev)]; abline(0,1)
		dat[,cor.test(tmax.accsum.elev, tmax.accsumbyspp.elev)]

#####################################################################################
# calculate thermal safety margin for each measurement of upper thermal tolerance
#####################################################################################

# thermal safety margin annual (elevation adjusted air temp/not, no tmax acclimation corrections)
	# body temp from air/water
dat[, tsm_ann := Tmax - thabann] # air temperature no corrections
dat[, tsm_ann_elev := Tmax - thabann.adj] # air temp elevation corrected, no acclimation

# thermal safety margin summer (elevation adjusted air temp/not, no tmax acclimation corrections)
	# body temp from air/water climatologies
dat[, tsm_sum := Tmax - thabsum] # air temperature no corrections
dat[, tsm_sum_elev := Tmax - thabsum.adj] # air temp elevation corrected, no acclimation

# thermal safety margin warmest month (elevation adjusted air temp/not, no tmax acclimation corrections)
	# body temp from air/water climatologies
dat[, tsm_maxmo := Tmax - thabmaxmo] # air temperature no corrections
dat[, tsm_maxmo_elev := Tmax - thabmaxmo.adj] # air temp elevation corrected, no acclimation

# thermal safety margin 95% max hour (elevation adjusted air temp/not/NM, tmax acclimation corrected to summer/max month/none)
	# body temp from water climatologies (thab95hr not available on land)
dat[, tsm_95hr_accsum := tmax.accsum - thab95hr] # water temp, acclimation to summer

	# body temp with marine behavioral thermoregulation (no sense to include elevation corrections since all ocean)
dat[, tsm_95hr_marineBT := Tmax - thab95hr.marineBT]
dat[, tsm_95hr_marineBT_accsum := tmax.accsum - thab95hr.marineBT]
dat[, tsm_95hr_marineBT_accsumbyspp := tmax.accsumbyspp - thab95hr.marineBT]

dat[, tsm_95hr_marineBTmore_accsum := tmax.accsum - thab95hr.marineBTmore] # more marine BT
dat[, tsm_95hr_marineBTless_accsum := tmax.accsum - thab95hr.marineBTless] # less marine BT

# thermal safety margin 95% GHCND max hour Tb calculation (only on land)
	# body temp from NM 2m shade (on land)
dat[, tsm_NMGHCND_2m_shade_Tb95 := Tmax - NMGHCND_2m_shade_Tb95]
dat[, tsm_NMGHCND_2m_shade_Tb95_accsum := tmax.accsum - NMGHCND_2m_shade_Tb95]
dat[ ,tsm_NMGHCND_2m_shade_Tb95_accsum.elev := tmax.accsum.elev - NMGHCND_2m_shade_Tb95]
dat[ ,tsm_NMGHCND_2m_shade_Tb95_accsumbyspp.elev := tmax.accsumbyspp.elev - NMGHCND_2m_shade_Tb95]

	# body temp from NM exposed (on land)
dat[, tsm_NMGHCND_exposed_Tb95 := Tmax - NMGHCND_exposed_Tb95]
dat[, tsm_NMGHCND_exposed_Tb95_accsum := tmax.accsum - NMGHCND_exposed_Tb95]
dat[ ,tsm_NMGHCND_exposed_Tb95_accsum.elev := tmax.accsum.elev - NMGHCND_exposed_Tb95]

	# body temp from 100% wet skin sun in shade (on land)
dat[, tsm_NMGHCND_shade_Tb_wet95 := Tmax - NMGHCND_shade_Tb_wet95]
dat[, tsm_NMGHCND_shade_Tb_wet95_accsum := tmax.accsum - NMGHCND_shade_Tb_wet95]
dat[, tsm_NMGHCND_shade_Tb_wet95_accsum.elev := tmax.accsum.elev - NMGHCND_shade_Tb_wet95]
dat[, tsm_NMGHCND_shade_Tb_wet95_accsumbyspp.elev := tmax.accsumbyspp.elev - NMGHCND_shade_Tb_wet95]

###########################
# Add species types
###########################

# add species types
dat[, animal.type := as.character(rep(NA, .N))]
dat[Class=='Amphibia' & Realm=='Terrestrial', animal.type := 'amphibian']
dat[Phylum=='Arthropoda' & Class %in% c('Insecta', 'Entognatha') & Realm=='Terrestrial', animal.type := 'insect']
dat[Class %in% c('Malacostraca', 'Collembola', 'Gastropoda') & Realm=='Terrestrial', animal.type := 'other terrestrial invert']
dat[Phylum=='Chordata' & Class %in% c('Reptilia', 'Archelosauria', 'Lepidosauria'), animal.type := 'reptile']
dat[Phylum=='Arthropoda' & Class == 'Arachnida' & Realm=='Terrestrial', animal.type := 'spider']

dat[Phylum=='Arthropoda' & Realm=='Marine', animal.type := 'crustacean']
dat[Phylum=='Chordata' & Realm=='Marine', animal.type := 'fish']
dat[Phylum=='Mollusca' & Realm=='Marine', animal.type := 'mollusc']
dat[Phylum %in% c('Bryozoa', 'Echinodermata', 'Brachiopoda') & Realm=='Marine', animal.type := 'other marine invert']

	# any missing?
	dat[is.na(animal.type), sort(unique(paste(Realm, Phylum, Class)))]
	dat[is.na(animal.type), sort(unique(paste(Realm, Phylum, Class, Order)))]

########################################
# Make aggregate vectors of Te and TSM
########################################

## Tb
	# make a single vector of body temperatures (Tb) on land and at sea in favorable microclimates
	# (shade or wet skin on land, with behavioral thermoregulation at sea for all animals)
	# 95% max hour from GHCND
	dat[, tb_favorableGHCND95 := as.numeric(rep(NA, .N))]
	dat[Realm=='Terrestrial' & animal.type!='amphibian', tb_favorableGHCND95 := NMGHCND_2m_shade_Tb95]
	dat[Realm=='Terrestrial' & animal.type=='amphibian', tb_favorableGHCND95 := NMGHCND_shade_Tb_wet95]
	dat[Realm=='Marine', tb_favorableGHCND95 := thab95hr.marineBT]

	# make a single vector of body temperatures (Tb) on land and at sea in full sun
	# 95% max hour GHCND
	dat[, tb_sunGHCND95 := as.numeric(rep(NA, .N))]
	dat[Realm=='Terrestrial' & animal.type!='amphibian', tb_sunGHCND95 := NMGHCND_exposed_Tb95]
	dat[Realm=='Terrestrial' & animal.type=='amphibian', tb_sunGHCND95 := NMGHCND_exposed_Tb_wet95]
	dat[Realm=='Marine', tb_sunGHCND95 := thab95hr]

## TSM
	# make a single vector of TSMs on land and at sea in full sun/at surface
	# use 95% GHCND Tb
	# includes acclimation to summer temperatures
	dat[, tsm_exposedGHCND95 := as.numeric(rep(NA, .N))]
	dat[Realm=='Terrestrial', tsm_exposedGHCND95 := tsm_NMGHCND_exposed_Tb95_accsum.elev]
	dat[Realm=='Marine', tsm_exposedGHCND95 := tsm_95hr_accsum]

	# use 95% warmest hour GHCND Tb for TSMs. favorable microclimates (shade or wet skin + behavioral thermoregulation)
	dat[, tsm_favorableGHCND95 := as.numeric(rep(NA, .N))]
	dat[Realm=='Terrestrial' & animal.type!='amphibian', tsm_favorableGHCND95 := tsm_NMGHCND_2m_shade_Tb95_accsum.elev]
	dat[Realm=='Terrestrial' & animal.type=='amphibian', tsm_favorableGHCND95 := tsm_NMGHCND_shade_Tb_wet95_accsum.elev]
	dat[Realm=='Marine', tsm_favorableGHCND95 := tsm_95hr_marineBT_accsum]

	dat[, tsm_favorableGHCND95_marBTmore := as.numeric(rep(NA, .N))] # more marine BT
	dat[Realm=='Terrestrial' & animal.type!='amphibian', tsm_favorableGHCND95_marBTmore := tsm_NMGHCND_2m_shade_Tb95_accsum.elev]
	dat[Realm=='Terrestrial' & animal.type=='amphibian', tsm_favorableGHCND95_marBTmore := tsm_NMGHCND_shade_Tb_wet95_accsum.elev]
	dat[Realm=='Marine', tsm_favorableGHCND95_marBTmore := tsm_95hr_marineBTmore_accsum]

	dat[, tsm_favorableGHCND95_marBTless := as.numeric(rep(NA, .N))] # less marine BT
	dat[Realm=='Terrestrial' & animal.type!='amphibian', tsm_favorableGHCND95_marBTless := tsm_NMGHCND_2m_shade_Tb95_accsum.elev]
	dat[Realm=='Terrestrial' & animal.type=='amphibian', tsm_favorableGHCND95_marBTless := tsm_NMGHCND_shade_Tb_wet95_accsum.elev]
	dat[Realm=='Marine', tsm_favorableGHCND95_marBTless := tsm_95hr_marineBTless_accsum]

	# sensitivity analysis: use species-specific ARRS
	# use 95% warmest hour GHCND for TSMs. favorable microclimates (shade or wet skin + behavioral thermoregulation)
	dat[, tsm_favorableGHCND95byspp := as.numeric(rep(NA, .N))]
	dat[Realm=='Terrestrial' & animal.type!='amphibian', tsm_favorableGHCND95byspp := tsm_NMGHCND_2m_shade_Tb95_accsumbyspp.elev]
	dat[Realm=='Terrestrial' & animal.type=='amphibian', tsm_favorableGHCND95byspp := tsm_NMGHCND_shade_Tb_wet95_accsumbyspp.elev]
	dat[Realm=='Marine', tsm_favorableGHCND95byspp := tsm_95hr_marineBT_accsumbyspp]

	# sensitivity analysis: make a single vector of TSMs on land and at sea in favorable microclimates
	# (shade or wet skin on land, WITHOUT behavioral thermoregulation at sea)
	# 95% warmest hour from GHCND Tb
	# includes acclimation to summer temperatures
	dat[, tsm_favorableGHCND95_nomarineBT := as.numeric(rep(NA, .N))]
	dat[Realm=='Terrestrial' & animal.type!='amphibian', tsm_favorableGHCND95_nomarineBT := tsm_NMGHCND_2m_shade_Tb95_accsum.elev]
	dat[Realm=='Terrestrial' & animal.type=='amphibian', tsm_favorableGHCND95_nomarineBT := tsm_NMGHCND_shade_Tb_wet95_accsum.elev]
	dat[Realm=='Marine', tsm_favorableGHCND95_nomarineBT := tsm_95hr_accsum]

	# make a single vector of TSMs on land and at sea in favorable microclimates
	# (shade or wet skin on land, with behavioral thermoregulation at sea)
	# 95% warmest hour from GHCND Tb
	# no acclimation: for comparison against maxmo, sum, and ann TSMs
	dat[, tsm_favorableGHCND95_noacc := as.numeric(rep(NA, .N))]
	dat[Realm=='Terrestrial' & animal.type!='amphibian', tsm_favorableGHCND95_noacc := tsm_NMGHCND_2m_shade_Tb95]
	dat[Realm=='Terrestrial' & animal.type=='amphibian', tsm_favorableGHCND95_noacc := tsm_NMGHCND_shade_Tb_wet95]
	dat[Realm=='Marine', tsm_favorableGHCND95_noacc := tsm_95hr_marineBT]

#######################
# write out
#######################
write.csv(dat, 'temp/warmingtolerance_byspecies.csv', row.names=FALSE)


#############################################################
# Modelling dose - responses

library(drc)
library(mixtox)
library(bmdModeling)
library(synergyfinder)
library(multcomp)
library(bmd)

# library(BIGL)

#############################################################
# Read and graphics

library(readxl)
library(ggplot2)

#############################################################
# Setup working directory

setwd("")

#############################################################
# Setup working directory

names_end=excel_sheets("data/TOX_VIVO_CHICKEN.xls")

endlen=length(names_end)

cases_ls=list()

for ( i in 1:endlen) {

  cases_ls[[i]]=as.data.frame(read_excel("data/TOX_VIVO_CHICKEN.xls",names_end[i]))

  }

saveRDS(cases_ls,"cases_ls.rds")

###############################################################################################
#

cases_ls_liv=list()
cases_ls_mar=list()

for(  i in 1:endlen) {
  cases_ls_liv[[i]]=cases_ls[[i]][which(cases_ls[[i]]$Specie=="White Leghorn chickens"),]
  cases_ls_mar[[i]]=cases_ls[[i]][which(cases_ls[[i]]$Specie=="Marek chickens"),]
}

saveRDS(cases_ls_liv,"cases_ls_liv.rds")
saveRDS(cases_ls_mar,"cases_ls_mar.rds")

############################################################
# 'LL.3' and 'LL2.3' provide the three-parameter
#  log-logistic function where the lower limit is equal to 0. '

############################################################
old.par=par()
par(old.par)
set.seed(2)
range01 <- function(x){(x-min(x,na.rm=T))/(max(x,na.rm=T)-min(x,na.rm=T))}

############################################################
# BW  gain
# Marek

datamyc=cases_ls_mar[[1]]
dataexpand=data.frame(Bodyweight_gain=rep(datamyc$Bodyweight_gain,100)+runif(length(datamyc$Bodyweight_gain)*100,-1.5,1.5)*rep(datamyc$Bodyweight_gain.sd,100),
                      Mycotoxin=rep(datamyc$Mycotoxin,100),
                      Dose_T=rep(datamyc$Dose_T,100))

############################################################
# BW  gain
# Marek

datamyc=cases_ls_mar[[1]]
dataexpand=data.frame(Bodyweight_gain=rep(datamyc$Bodyweight_gain,100)+runif(length(datamyc$Bodyweight_gain)*100,-1.5,1.5)*rep(datamyc$Bodyweight_gain.sd,100),
                      Mycotoxin=rep(datamyc$Mycotoxin,100),
                      Dose_T=rep(datamyc$Dose_T,100))

dataexpand$response=range01(dataexpand$Bodyweight_gain)

multi.m3=drm(Bodyweight_gain~Dose_T,Mycotoxin,data=dataexpand,fct = AR.3())
#multi.s=drm(response~Dose_T,Mycotoxin,data=dataexpand,fct = LL.2())

ED(multi.m3,c(10,50), interval = "delta")

file.remove("summary_BW_gain_Marek.txt")

cat(capture.output(ED(multi.m3,c(10,50), interval = "delta")),
    file = "summary_BW_gain_Marek.txt",
    sep="\n",append = T)

cat(capture.output(summary(multi.m3)),
    file = "summary_BW_gain_Marek.txt",
    sep="\n",append = T)

png("images/BW_gain_Marek.png")

plot(multi.m3,
     col = TRUE,
     xlab = "Log Dose(mg/kg feed)",
     ylab = "BW_gain",
     main="Bodyweight_gain AF & OTA Marek chickens\n Bootstrap=Yes Model=L.3")

dev.off()

############################################################

datamyc=cases_ls_liv[[1]]

multi.m3 <- drm(Terminal_bodyweight~Dose_T,Mycotoxin,data=datamyc,fct = MM.3())
print(summary(multi.m3))

file.remove("summary_TW_gain_Liv.txt")

cat(capture.output(ED(multi.m3,c(10,50), interval = "delta")),
    file = "summary_TW_gain_Liv.txt",
    sep="\n",append = T)

cat(capture.output(summary(multi.m3)),
    file = "summary_TW_gain_Liv.txt",
    sep="\n")

png("images/TW_gain_Liv.png")

plot(multi.m3,
     col = TRUE,
     xlab = "Log Dose(mg/kg feed)",
     ylab = "Terminal BW",
     main="Terminal BW AF & OTA  White Leghorn chickens\n Bootstrap=Not Model=MM.3")
dev.off()

########################################################################################à
# Feed conversion #Marek

datamyc=cases_ls_mar[[2]]
dataexpand=data.frame(Feed_conversion=rep(datamyc$Feed_conversion,100)+runif(length(datamyc$Feed_conversion)*100,-1.5,1.5)*rep(datamyc$Feed_conversion.sd,100),
                      Mycotoxin=rep(datamyc$Mycotoxin,100),
                      Dose_T=rep(datamyc$Dose_T,100))

multi.m3 <- drm(Feed_conversion~Dose_T,Mycotoxin,data=dataexpand,fct = AR.3())

print(summary(multi.m3))

file.remove("summary_Feed_conversion_mar.txt")

cat(capture.output(ED(multi.m3,c(10,50), interval = "delta")),
    file = "summary_Feed_conversion_mar.txt",
    sep="\n",append = T)

cat(capture.output(summary(multi.m3)),
    file = "summary_Feed_conversion_mar.txt",
    sep="\n")

png("images/Feed_conversion_mar.png")

plot(multi.m3,
     col = TRUE,
     xlab = "Log Dose(mg/kg feed)",
     ylab = "Feed_conversion",
     main="Feed_conversion AF & OTA  Marek chickens\n Bootstrap=Yes Model=AR.3",
     legendPos = c(0.4, 2.8))

dev.off()

#########################################################################################
# Feed intake #Marek

datamyc=cases_ls_mar[[3]]
multi.m3 <- drm(Feed_intake~Dose_T,Mycotoxin,data=datamyc,fct = AR.3())
print(summary(multi.m3))

png("images/Feed_intake_mar_bootno.png")

plot(multi.m3,
     col = TRUE,
     xlab = "Log Dose(mg/kg feed)",
     ylab = "Feed_intake",
     main="Feed_intake AF & OTA Marek chickens\n Bootstrap=No Model=AR.3")

dev.off()

dataexpand=data.frame(Feed_intake=rep(datamyc$Feed_intake,100)+runif(length(datamyc$Feed_intake)*100,-1.5,1.5)*rep(datamyc$Feed_intake.sd,100),
                      Mycotoxin=rep(datamyc$Mycotoxin,100),
                      Dose_T=rep(datamyc$Dose_T,100))

multi.m3 <- drm(Feed_intake~Dose_T,Mycotoxin,data=dataexpand,fct = AR.3())
print(summary(multi.m3))

file.remove("summary_Feed_intake_mar.txt")

cat(capture.output(ED(multi.m3,c(10,50), interval = "delta")),
    file = "summary_Feed_intake_mar.txt",
    sep="\n",append = T)

cat(capture.output(summary(multi.m3)),
    file = "summary_Feed_intake_mar.txt",
    sep="\n",append = T)

png("images/Feed_intake_mar.png")

plot(multi.m3,
     col = TRUE,
     xlab = "Log Dose(mg/kg feed)",
     ylab = "Feed_intake",
     main=" Feed_intake AF & OTA  Marek chickens\n Bootstrap=Yes Model=AR.3")
dev.off()

##########################################################################################

datamyc=cases_ls_liv[[3]]
multi.m3 <- drm(Feed_intake~Dose_T,Mycotoxin,data=datamyc,fct = L.3())
print(summary(multi.m3))

file.remove("summary_Feed_intake_liv.txt")

cat(capture.output(ED(multi.m3,c(10,50), interval = "delta")),
    file = "summary_Feed_intake_liv.txt",
    sep="\n",append = T)

cat(capture.output(summary(multi.m3)),
    file = "summary_Feed_intake_mar.txt",
    sep="\n",append = T)

png("images/Feed_intake_liv_bootno.png")

plot(multi.m3,
     col = TRUE,
     xlab = "Log Dose(mg/kg feed)",
     ylab = "Feed_intake",
     xlim=c(0,10),
     main="Feed_intake AF & OTA   White Leghorn chickens\n Bootstrap=No Model=L.3",
     legendPos = c(9, 5400))

dev.off()

##########################################################################################
# Liver_relative_weight #Marek

datamyc=cases_ls_mar[[4]]

dataexpand=data.frame(Liver_relative_weight=rep(datamyc$Liver_relative_weight,100)+runif(length(datamyc$Liver_relative_weight)*100,-1.2,1.2)*rep(datamyc$Liver_relative_weight.sd,100),
                      Mycotoxin=rep(datamyc$Mycotoxin,100),
                      Dose_T=rep(datamyc$Dose_T,100))

multi.m3 <- drm(Liver_relative_weight~Dose_T,Mycotoxin,data=dataexpand,fct = AR.3())
print(summary(multi.m3))
file.remove("summary_Liver_RW_mar.txt")

cat(capture.output(ED(multi.m3,c(10,50), interval = "delta")),
    file = "summary_Liver_RW_mar.txt",
    sep="\n",append = T)

cat(capture.output(summary(multi.m3)),
    file = "summary_Liver_RW_mar.txt",
    sep="\n",append = T)

png("images/Liver_RW_mar.png")

plot(multi.m3, col = TRUE,
     xlab = "Log Dose(mg/kg feed)",
     ylab = "Liver RW",
     main="Liver RW AF & OTA  Marek chickens\n Bootstrap=Yes Model=AR.3",
     legendPos = c(0.5, 4.8))

dev.off()

##########################################################################################
# Kidney_relative_weight#Marek

datamyc=cases_ls_mar[[5]]

dataexpand=data.frame(Kidney_relative_weight=rep(datamyc$Kidney_relative_weight,100)+runif(length(datamyc$Kidney_relative_weight)*100,-1.5,1.5)*rep(datamyc$Kidney_relative_weight.sd,100),
                      Mycotoxin=rep(datamyc$Mycotoxin,100),
                      Dose_T=rep(datamyc$Dose_T,100))

multi.m3 <- drm(Kidney_relative_weight~Dose_T,Mycotoxin,data=dataexpand,fct = AR.3())
print(summary(multi.m3))

file.remove("summary_Kidney_RW_mar.txt")

cat(capture.output(ED(multi.m3,c(10,50), interval = "delta")),
    file = "summary_Kidney_RW_mar.txt",
    sep="\n",append = T)

cat(capture.output(summary(multi.m3)),
    file = "summary_Kidney_RW_mar.txt",
    sep="\n",append = T)

png("images/Kidney_RW_mar.png")

plot(multi.m3, col = TRUE,
     xlab = "Log Dose(mg/kg feed)",
     ylab = "Kidney RW",
     main="Kidney RW AF & OTA Marek chickens\n Bootstrap=Yes Model=AR.3",
     legendPos = c(0.5, 0.9))

dev.off()

##########################################################################################
# Spleen_relative weight

datamyc=cases_ls_mar[[6]]
multi.m4 <- drm(Spleen_relative_weight~Dose_T,Mycotoxin,data=datamyc[,],fct=L.3())
print(summary(multi.m4))

file.remove("summary_Spleen_RW_mar.txt")

cat(capture.output(ED(multi.m4,c(10,50), interval = "delta")),
    file = "summary_Spleen_RW_mar.txt",
    sep="\n",append = T)

cat(capture.output(summary(multi.m4)),
    file = "summary_Spleen_RW_mar.txt",
    sep="\n",append = T)

png("images/Spleen_RW_mar.png")

plot(multi.m4, col = TRUE,
     xlab = "Log Dose(mg/kg feed)",
     ylab = "Spleen RW",
     main="Spleen RW AF & OTA Marek chickens\n Bootstrap=No Model=L.3",
     legendPos = c(0.4, 0.329))

dev.off()


#####################################################################
# Fitting generalized additive models to fraction feeding data
# See '...GAM_robustness.r' for model justifications, including
# error family and link function and gamma wiggliness penalty
#####################################################################
#####################################################################
rm(list = ls())
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
library(plyr)
library(mgcv)
library(xtable) # for LaTeX export
library(ggplot2)
source('R/FracFeed-Functions.r') # Convenience functions
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Load saved 'fdat' w/ tWS
load('Data/FracFeed_DataPhylo.Rdata') # load full post-ToL FracFeed database
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
nrow(fdat) # total number of surveys in database
length(unique(fdat$Consumer.identity)) # total number of species in database
range(fdat$Latitude, na.rm = TRUE)
range(fdat$Year, na.rm = TRUE)

#####################################################################
# Summary stats by Taxonomic Group
##################################
TaxonGroupLevels <-
  c(
    'Ctenophores',
    'Cnidarians',
    'Annelids',
    'Chaetognaths',
    'Molluscs',
    'Echinoderms',
    'Arthropods',
    'Fish',
    'Reptiles',
    'Amphibians',
    'Birds',
    'Mammals'
  )
fdat$Taxon.group <- factor(fdat$Taxon.group, levels = TaxonGroupLevels)
sfdat <-
  ddply(
    fdat,
    .(Taxon.group),
    summarise,
    'Mean' = mean(fF),
    'Std.dev.' = sd(fF),
    Min = min(fF),
    Max = max(fF),
    Surveys = length(fF),
    Species = length(unique(Consumer.identity)),
    minObs = min(Total.stomachs.count, na.rm = T),
    maxObs = max(Total.stomachs.count, na.rm = T)
  )
sfdat[, 2:5] <- round(sfdat[, 2:5], 2)

setwd('Figures/Supp/')
print(
  xtable(sfdat, type = "latex", caption = 'Summary statistics for all taxa in the database, including those that could not be used in the analyses of the main text for lack of co-variate information. minObs and maxObs refer to the minimum and maximum number of individuals assessed in a single survey across all surveys of the group.'),
  file = "FracFeed-Tab-SummStats.tex",
  include.rownames = FALSE,
  table.placement = 'H'
)
setwd('../../')

pdf(
  'Figures/Supp/FracFeed-FigS-TaxonViolins.pdf',
  height = 3,
  width = 5
)
viol <-
  ggplot(fdat, aes(Taxon.group, Percent.feeding)) +
  geom_violin(scale = "width", bg = 'grey') +
  labs(x = '', y = 'Percent feeding') +
  theme_classic() + theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
  stat_summary(fun.data = data_summary, color = "black") +
  annotate("text", x = 1:nrow(sfdat), y = 106,
           label = sfdat$Species, size = 1.5) +
  annotate("text", x = 1:nrow(sfdat), y = 103,
           label = paste0("(", sfdat$Surveys, ")"),                                                               size = 1.5)
print(viol)
dev.off()

################################################
# General model specifications
# (justified in GAM_robustness)
################################################
fam <- quasibinomial(link = 'logit')

# To get actual used sample size (after dropped rows)
# (needed for determining BIC-like gamma penalty)
fit <- gam(
  (FSc / TSc) ~
    s(tWS, bs = 'cc') + s(Lat) + s(DRlog) + s(Year) +
    TAlog + SAlog + Eco + EE + TG,
  family = fam,
  weights = TSc,
  knots = list(tWS = c(0, 365)),
  data = fdat,
  na.action = 'na.omit',
  method='REML'
)
gamma <- log(nrow(fit$model)) / 2

#######################
# All primary variables
#######################
fit1.cont <- fit <- gam(
  (FSc / TSc) ~
    s(tWS, bs = 'cc') + s(Lat) + s(DRlog) + s(Year) +
    TAlog + SAlog + Eco + EE + TG,
  family = fam,
  weights = TSc,
  knots = list(tWS = c(0, 365)),
  data = fdat,
  na.action = 'na.omit',
  method = 'REML',
  gamma = gamma
)

# Compare data lost vs. included
nrow(fit$model)
excl <- fdat[fit$na.action, ]
nrow(excl)

incl <- fdat[-fit$na.action, ]
nrow(incl)
length(unique(incl$Consumer.identity))
range(incl$Year, na.rm = TRUE)
range(incl$Lat, na.rm = TRUE)

nrow(fdat)
nrow(excl) + nrow(incl)
length(unique(fdat$Consumer.identity))

# odds ratio
exp(cbind("Odds ratio" = coef(fit)[c('TAlog', 'SAlog')],
          confint.default(fit, c('TAlog', 'SAlog'), level = 0.95)))
1 / exp(cbind("Odds ratio" = coef(fit)[c('SAlog')],
              confint.default(fit, c('SAlog'), level = 0.95)))

save(fit, file = 'Output/GAM/GAM_fit_wTaxInf.Rdata')

pdf('Output/GAM/GAM_fit_wTaxInf.pdf',
    height = 8,
    width = 10)
plot(
  fit,
  residuals = F,
  seWithMean = TRUE,
  shade = TRUE,
  rug = TRUE,
  all.terms = TRUE,
  pch = '.',
  pages = 1
)
par(mfrow = c(2, 2))
gam.check(fit)
dev.off()

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Same but with TA and SA as factors
fit1.fact <- fit <- gam(
  (FSc / TSc) ~
    s(tWS, bs = 'cc') + s(Lat) + s(DRlog) + s(Year) +
    TA + SA + Eco + EE + TG,
  family = fam,
  weights = TSc,
  knots = list(tWS = c(0, 365)),
  data = fdat,
  na.action = 'na.omit',
  method = 'REML',
  gamma = gamma
)

summary(fit)
logit_tr(summary(fit)$p.coeff)

save(fit, file = 'Output/GAM/GAM_fit_wTaxInf_TASAfact.Rdata')

pdf('Output/GAM/GAM_fit_wTaxInf_TASAfact.pdf',
    height = 8,
    width = 10)
plot(
  fit,
  residuals = F,
  seWithMean = TRUE,
  shade = TRUE,
  rug = TRUE,
  all.terms = TRUE,
  pch = '.',
  pages = 1
)
par(mfrow = c(2, 2))
gam.check(fit)
dev.off()

# Export summary tables
p.out <- summary(fit1.fact)$p.table
p.out[, 1:3] <- signif(p.out[, 1:3], 2)
p.out[, 4] <- signif(p.out[, 4], 3)
p.out[p.out[, 4] < 10 ^ -3, 4] <- '< 0.001'
p.out[p.out == 'NaN'] <- ''

rownames(p.out) <- sub('TA', '', rownames(p.out))
rownames(p.out) <- sub('SA', '', rownames(p.out))
rownames(p.out) <- sub('Eco', '', rownames(p.out))
rownames(p.out) <- sub('EE', '', rownames(p.out))
rownames(p.out) <- sub('TG', '', rownames(p.out))

s.out <- summary(fit1.fact)$s.table
s.out[, 1:3] <- round(s.out[, 1:3], 2)
s.out[, 4] <- round(s.out[, 4], 3)
s.out[s.out[, 4] < 10 ^ -3, 4] <- '< 0.001'

setwd('Figures/Supp/')
print(
  xtable(
    p.out,
    type = "latex",
    caption = 'Estimated effects (log-odds) of the parametric terms in the primary statistical model describing variation in the observed fraction of feeding individuals.  The intercept to which all effects are relative corresponds to an ectothermic marine mollusc surveyed at a spatial scale of up to 1 meter for under an hour.  Birds correspond to the endotherm baseline.',
    label = 'tab:gam_main_p'
  ),
  file = "FracFeed-Tab-GAM_main_ptable.tex",
  table.placement = 'H'
)

print(
  xtable(
    s.out,
    type = "latex",
    caption = 'Estimated effects of the smooth terms in the primary statistical model describing variation in the observed fraction of feeding individuals. $tWS$ refers to the days since the last winter solsctice, $Lat$ refers to latitude, $DRlog$ refers to $log_{10}$ of minimum diet richness, and $Year$ refers to the year of the survey.',
    label = 'tab:gam_main_s'
  ),
  file = "FracFeed-Tab-GAM_main_stable.tex",
  table.placement = 'H'
)
setwd('../../')

##############################################################
# Same (with TA and SA as factors) but relative to terrestrial
# (to ease language of main text)
##############################################################
orig <- levels(fdat$Eco)
fdat$Eco <- factor(fdat$Eco, levels = rev(orig))
fit <- gam(
  (FSc / TSc) ~
    s(tWS, bs = 'cc') + s(Lat) + s(DRlog) + s(Year) +
    TA + SA + Eco + EE + TG,
  family = fam,
  weights = TSc,
  knots = list(tWS = c(0, 365)),
  data = fdat,
  na.action = 'na.omit',
  method = 'REML',
  gamma = gamma
)

summary(fit)
trms <- summary(fit)$p.coeff
sel <- grep('Eco', names(trms))
# Log-odds
trms[sel]
# Odds-ratios
exp(trms[sel])
exp(cbind("Odds ratio" = coef(fit)[sel],
          confint.default(fit, sel, level = 0.95)))

# now to compare lakes and streams
fdat$Eco <- factor(fdat$Eco, levels = orig[c(3, 4, 5, 1, 2)])
fit <- gam(
  (FSc / TSc) ~
    s(tWS, bs = 'cc') + s(Lat) + s(DRlog) + s(Year) +
    TA + SA + Eco + EE + TG,
  family = fam,
  weights = TSc,
  knots = list(tWS = c(0, 365)),
  data = fdat,
  na.action = 'na.omit',
  method = 'REML',
  gamma = gamma
)

summary(fit)
trms <- summary(fit)$p.coeff
sel <- grep('Eco', names(trms))
# Log-odds
trms[sel]
# Odds-ratios
exp(trms[sel])
exp(cbind("Odds ratio" = coef(fit)[sel],
          confint.default(fit, sel, level = 0.95)))

# Reorder to original
fdat$Eco <- factor(fdat$Eco, levels = orig)

################################################################
# Same (with TA and SA as factors) but with DRlog as parametric linear term
# (to enable language of main text)
################################################################
fit <- gam(
  (FSc / TSc) ~
    s(tWS, bs = 'cc') + s(Lat) + DRlog + s(Year) +
    TA + SA + Eco + EE + TG,
  family = fam,
  weights = TSc,
  knots = list(tWS = c(0, 365)),
  data = fdat,
  na.action = 'na.omit',
  method = 'REML',
  gamma = gamma
)

summary(fit)
trms <- summary(fit)$p.coeff
sel <- grep('DRlog', names(trms))
# Log-odds
trms[sel]
# Odds-ratios
exp(cbind("Odds ratio" = coef(fit)[sel],
          confint.default(fit, sel, level = 0.95)))

####################################################################
# Without taxonomic information for phylogenetic tests
# (i.e. remove Endo/Ecto, Taxon Group, Diet richness and Ecosystem)
####################################################################
fit.noTaxInf <- fit <- gam(
  (FSc / TSc) ~
    s(tWS, bs = 'cc') + s(Lat) + s(Year) +
    TAlog + SAlog,
  family = fam,
  weights = TSc,
  knots = list(tWS = c(0, 365)),
  data = fdat,
  na.action = 'na.omit',
  method = 'REML',
  gamma = gamma
)

anova(fit)
summary(fit)

# How many data points included (because the others didn't have info for all variables)?
nrow(fit$model)
excl <- fdat[fit$na.action, ]
nrow(excl)

save(fit, file = 'Output/GAM/GAM_fit_noTaxInf.Rdata')

pdf(paste0('Output/GAM/GAM_fit_noTaxInf.pdf'),
    height = 8,
    width = 10)
plot(
  fit,
  residuals = F,
  seWithMean = TRUE,
  shade = TRUE,
  rug = TRUE,
  all.terms = TRUE,
  pch = '.',
  pages = 1
)
par(mfrow = c(2, 2))
gam.check(fit)
dev.off()

########################################################################
####################################
# Final model plus feeding data type
# (dismissed during robustness checks
# but requested by reviewers)
####################################
fit1.fact <- fit <- gam(
  (FSc / TSc) ~
    s(tWS, bs = 'cc') + s(Lat) + s(DRlog) + s(Year) +
    TA + SA + Eco + EE + TG + FD,
  family = fam,
  weights = TSc,
  knots = list(tWS = c(0, 365)),
  data = fdat,
  na.action = 'na.omit',
  method = 'REML',
  gamma = gamma
)

summary(fit)
logit_tr(summary(fit)$p.coeff)

pdf(
  'Output/GAM/GAM_fit_wTaxInf_TASAfact_wFD.pdf',
  height = 8,
  width = 10
)
plot(
  fit,
  residuals = F,
  seWithMean = TRUE,
  shade = TRUE,
  rug = TRUE,
  all.terms = TRUE,
  pch = '.',
  pages = 1
)
par(mfrow = c(2, 2))
gam.check(fit)
dev.off()

# Export summary tables
p.out <- summary(fit1.fact)$p.table
p.out[, 1:3] <- signif(p.out[, 1:3], 2)
p.out[, 4] <- signif(p.out[, 4], 3)
p.out[p.out[, 4] < 10 ^ -3, 4] <- '< 0.001'
p.out[p.out == 'NaN'] <- ''

rownames(p.out) <- sub('TA', '', rownames(p.out))
rownames(p.out) <- sub('SA', '', rownames(p.out))
rownames(p.out) <- sub('Eco', '', rownames(p.out))
rownames(p.out) <- sub('EE', '', rownames(p.out))
rownames(p.out) <- sub('TG', '', rownames(p.out))
rownames(p.out) <- sub('FD', '', rownames(p.out))

s.out <- summary(fit1.fact)$s.table
s.out[, 1:3] <- round(s.out[, 1:3], 2)
s.out[, 4] <- round(s.out[, 4], 3)
s.out[s.out[, 4] < 10 ^ -3, 4] <- '< 0.001'

setwd('Figures/Supp/')
print(
  xtable(
    p.out,
    type = "latex",
    caption = 'Estimated effects (log-odds) of the parametric terms in the primary statistical model but with data type (stomach contents versus direct observation) also included.',
    label = 'tab:gam_main_p'
  ),
  file = "FracFeed-Tab-GAM_main_wFD_ptable.tex",
  table.placement = 'H'
)

print(
  xtable(
    s.out,
    type = "latex",
    caption = 'Estimated effects of the smooth terms in the primary statistical model but with data type (stomach contents versus direct observation) also included.',
    label = 'tab:gam_main_wFD_s'
  ),
  file = "FracFeed-Tab-GAM_main_wFD_stable.tex",
  table.placement = 'H'
)
setwd('../../')

####################################################################
####################################################################
####################################################################