library(TMB)

#don't uncomment this, just paste it into R if you have used the debugger flags above.
#gdbsource("ss_mat_paper_v4.r")

#this allows dbs debugger to be used
dyn.unload("ss_mat_paper_v4.so")
compile("ss_mat_paper_v4.cpp","-O0 -g")
dyn.load("ss_mat_paper_v4.so")

mat.dat <- read.csv('../../cod_gb_19702014s_0yr_mvavg.csv', header = TRUE)
mat.dat = mat.dat[which(mat.dat$yc %in% 1963:2014),]
mat.dat = mat.dat[which(mat.dat$AGE > 0),]
fall.temp.dat = read.csv("../../1963-2014-fall-temp-for-state-space.csv", header = TRUE)
temp = aggregate(as.integer(!(mat.dat$MATURITY == 'I')), by = list(yc = mat.dat$yc, age = mat.dat$AGE), FUN = sum)
temp = cbind.data.frame(temp, aggregate(as.integer(!(mat.dat$MATURITY == 'I')), by = list(yc = mat.dat$yc, age = mat.dat$AGE), FUN = length)[[3]])
names(temp)[3:4] = c("Y","N")
x = list(Y = temp$Y)
x$N = temp$N
x$age_obs = temp$age
x$year_obs = temp$age + temp$yc - 1962
x$cy_obs = temp$yc - 1962
x$Ecov_maxages_k = rep(0,length(x$Y))
x$Ecov_maxages_a50 = rep(0,length(x$Y))
x$Ecov_obs = cbind(fall.temp.dat$anom_bt)
x$use_Ecov_obs = cbind(match(as.integer(!is.na(x$Ecov_obs)),c(0,1)) - 1)
x$Ecov_obs[which(is.na(x$Ecov_obs))] = -999
x$Ecov_obs_sigma = cbind(fall.temp.dat$sd1_bt)
x$Ecov_obs_sigma[which(is.na(x$Ecov_obs_sigma))] = -999
x$fit_k = 0
x$fit_a50 = 0
x$binomial = 1

y = list(beta_k = 0)
y$beta_a50 = 0
y$beta_Ecov_k = rep(0,max(1,x$Ecov_maxages_k+1))
y$beta_Ecov_a50 = rep(0,max(1,x$Ecov_maxages_a50+1))
y$Ecov_mu = 0
y$Ecov_AR_pars = rep(0, 2)
y$Ecov_re = cbind(c(x$Ecov_obs))
y$Ecov_re[which(x$use_Ecov_obs == 0)] = 0
y$beta_phi = 0
y$k_AR_pars = rep(0,2)
y$k_re = rep(0, length(y$Ecov_re))
y$a50_AR_pars = rep(0,2)
y$a50_re = rep(0, length(y$Ecov_re))

gbcod.mat.rev = list(dat = x, par = y)

gbcod.mat.rev$map = list(
    beta_Ecov_k = factor(rep(NA, length(gbcod.mat.rev$par$beta_Ecov_k))),
    beta_Ecov_a50 = factor(rep(NA, length(gbcod.mat.rev$par$beta_Ecov_a50))),
    beta_phi = factor(rep(NA, length(gbcod.mat.rev$par$beta_phi))),
    k_AR_pars = factor(rep(NA, length(gbcod.mat.rev$par$k_AR_pars))),
    k_re = factor(rep(NA, length(gbcod.mat.rev$par$k_re))),
    a50_AR_pars = factor(rep(NA, length(gbcod.mat.rev$par$a50_AR_pars))),
    a50_re = factor(rep(NA, length(gbcod.mat.rev$par$a50_re)))
    )

temp = gbcod.mat.rev
#no temperature effects, constant a50, k
x = MakeADFun(temp$dat,temp$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = temp$map)
x$opt = nlminb(x$par,x$fn,x$gr)
mod0 = x
mod0$rep = mod0$report()
mod0$sdrep = sdreport(x)

#fall temperature effects at age 0 on k
temp = gbcod.mat.rev
temp$map = temp$map[which(names(temp$map) != "beta_Ecov_k")]
mod1 = MakeADFun(temp$dat,temp$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = temp$map)
mod1$opt = nlminb(mod1$par,mod1$fn,mod1$gr)
mod1$rep = mod1$report()
mod1$sdrep = sdreport(mod1)

#fall temperature effects at age 0 on a50
temp = gbcod.mat.rev
temp$map = temp$map[which(names(temp$map) != "beta_Ecov_a50")]
mod2 = MakeADFun(temp$dat,temp$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = temp$map)
mod2$opt = nlminb(mod2$par,mod2$fn,mod2$gr)
mod2$rep = mod2$report()
mod2$sdrep = sdreport(mod2)

#fall temperature effects at age 0 on k and a50
temp = gbcod.mat.rev
temp$map = temp$map[which(!(names(temp$map) %in% c("beta_Ecov_k","beta_Ecov_a50")))]
mod3 = MakeADFun(temp$dat,temp$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = temp$map)
mod3$opt = nlminb(mod3$par,mod3$fn,mod3$gr)
mod3$rep = mod3$report()
mod3$sdrep = sdreport(mod3)

#fall temperature effects at age 0 on a50 and 0,1 on k
gbcod.mat.rev.4 = gbcod.mat.rev
gbcod.mat.rev.4$dat$Ecov_maxages_k = rep(1,length(gbcod.mat.rev.4$dat$Y))
gbcod.mat.rev.4$dat$Ecov_maxages_k[gbcod.mat.rev.4$dat$age_obs==1] = 0
gbcod.mat.rev.4$par$beta_Ecov_k = rep(0,max(1,gbcod.mat.rev.4$dat$Ecov_maxages_k+1))
gbcod.mat.rev.4$map = gbcod.mat.rev.4$map[which(!(names(gbcod.mat.rev.4$map) %in% c("beta_Ecov_k","beta_Ecov_a50")))]
mod4 = MakeADFun(gbcod.mat.rev.4$dat,gbcod.mat.rev.4$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = gbcod.mat.rev.4$map)
mod4$opt = nlminb(mod4$par,mod4$fn,mod4$gr)
mod4$rep = mod4$report()
mod4$sdrep = sdreport(mod4)

#fall temperature effects at age 0,1 on a50 and 0 on k
#fall temperature effects at age 0 and 1 on k
gbcod.mat.rev.5 = gbcod.mat.rev.4
gbcod.mat.rev.5$dat$Ecov_maxages_k = rep(0,length(gbcod.mat.rev.5$dat$Y))
gbcod.mat.rev.5$par$beta_Ecov_k = rep(0,max(1,gbcod.mat.rev.5$dat$Ecov_maxages_k+1))
gbcod.mat.rev.5$dat$Ecov_maxages_a50 = rep(1,length(gbcod.mat.rev.5$dat$Y))
gbcod.mat.rev.5$dat$Ecov_maxages_a50[gbcod.mat.rev.5$dat$age_obs==1] = 0
gbcod.mat.rev.5$par$beta_Ecov_a50 = rep(0,max(1,gbcod.mat.rev.5$dat$Ecov_maxages_a50+1))
#gbcod.mat.rev.5$map = gbcod.mat.rev.5$map[which(!(names(gbcod.mat.rev.5$map) %in% c("beta_Ecov_k","beta_Ecov_a50")))]
mod5 = MakeADFun(gbcod.mat.rev.5$dat,gbcod.mat.rev.5$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = gbcod.mat.rev.5$map)
mod5$opt = nlminb(mod5$par,mod5$fn,mod5$gr)
mod5$rep = mod5$report()
mod5$sdrep = sdreport(mod5)

#fall temperature effects at ages 0,1 on a50 and k
gbcod.mat.rev.6 = gbcod.mat.rev.5
gbcod.mat.rev.6$dat$Ecov_maxages_k = rep(1,length(gbcod.mat.rev.6$dat$Y))
gbcod.mat.rev.6$dat$Ecov_maxages_k[gbcod.mat.rev.6$dat$age_obs==1] = 0
gbcod.mat.rev.6$par$beta_Ecov_k = rep(0,max(1,gbcod.mat.rev.6$dat$Ecov_maxages_k+1))
#gbcod.mat.rev.6$map = gbcod.mat.rev.6$map[which(!(names(gbcod.mat.rev.6$map) %in% c("beta_Ecov_k","beta_Ecov_a50")))]
mod6 = MakeADFun(gbcod.mat.rev.6$dat,gbcod.mat.rev.6$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = gbcod.mat.rev.6$map)
mod6$opt = nlminb(mod6$par,mod6$fn,mod6$gr)
mod6$rep = mod6$report()
mod6$sdrep = sdreport(mod6)

#fall temperature effects at ages 0,1 on a50 and 0,1,2 on k
gbcod.mat.rev.7 = gbcod.mat.rev.6
gbcod.mat.rev.7$dat$Ecov_maxages_k = rep(2,length(gbcod.mat.rev.7$dat$Y))
gbcod.mat.rev.7$dat$Ecov_maxages_k[gbcod.mat.rev.7$dat$age_obs==1] = 0
gbcod.mat.rev.7$dat$Ecov_maxages_k[gbcod.mat.rev.7$dat$age_obs==2] = 1
gbcod.mat.rev.7$par$beta_Ecov_k = rep(0,max(1,gbcod.mat.rev.7$dat$Ecov_maxages_k+1))
#gbcod.mat.rev.7$map = gbcod.mat.rev.7$map[which(!(names(gbcod.mat.rev.7$map) %in% c("beta_Ecov_k","beta_Ecov_a50")))]
mod7 = MakeADFun(gbcod.mat.rev.7$dat,gbcod.mat.rev.7$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = gbcod.mat.rev.7$map)
mod7$opt = nlminb(mod7$par,mod7$fn,mod7$gr)
mod7$rep = mod7$report()
mod7$sdrep = sdreport(mod7)

#fall temperature effects at ages 0,1,2 on a50 and 0,1 on k
gbcod.mat.rev.8 = gbcod.mat.rev.7
gbcod.mat.rev.8$dat$Ecov_maxages_k = rep(1,length(gbcod.mat.rev.8$dat$Y))
gbcod.mat.rev.8$dat$Ecov_maxages_k[gbcod.mat.rev.8$dat$age_obs==1] = 0
gbcod.mat.rev.8$par$beta_Ecov_k = rep(0,max(1,gbcod.mat.rev.8$dat$Ecov_maxages_k+1))
gbcod.mat.rev.8$dat$Ecov_maxages_a50 = rep(2,length(gbcod.mat.rev.8$dat$Y))
gbcod.mat.rev.8$dat$Ecov_maxages_a50[gbcod.mat.rev.8$dat$age_obs==1] = 0
gbcod.mat.rev.8$dat$Ecov_maxages_a50[gbcod.mat.rev.8$dat$age_obs==2] = 1
gbcod.mat.rev.8$par$beta_Ecov_a50 = rep(0,max(1,gbcod.mat.rev.8$dat$Ecov_maxages_a50+1))
mod8 = MakeADFun(gbcod.mat.rev.8$dat,gbcod.mat.rev.8$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = gbcod.mat.rev.8$map)
mod8$opt = nlminb(mod8$par,mod8$fn,mod8$gr)
mod8$rep = mod8$report()
mod8$sdrep = sdreport(mod8)

#fall temperature effects at ages 0,1,2 on a50 and 0,1,2 on k
gbcod.mat.rev.9 = gbcod.mat.rev.8
gbcod.mat.rev.9$dat$Ecov_maxages_k = rep(2,length(gbcod.mat.rev.9$dat$Y))
gbcod.mat.rev.9$dat$Ecov_maxages_k[gbcod.mat.rev.9$dat$age_obs==1] = 0
gbcod.mat.rev.9$dat$Ecov_maxages_k[gbcod.mat.rev.9$dat$age_obs==2] = 1
gbcod.mat.rev.9$par$beta_Ecov_k = rep(0,max(1,gbcod.mat.rev.9$dat$Ecov_maxages_k+1))
mod9 = MakeADFun(gbcod.mat.rev.9$dat,gbcod.mat.rev.9$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = gbcod.mat.rev.9$map)
mod9$opt = nlminb(mod9$par,mod9$fn,mod9$gr)
mod9$rep = mod9$report()
mod9$sdrep = sdreport(mod9)

#betabinomial models
dyn.unload("ss_mat_paper_v4.so")
compile("ss_mat_paper_v4.cpp","-O0 -g")
dyn.load("ss_mat_paper_v4.so")

temp = gbcod.mat.rev
temp$dat$binomial = 0
temp$map = temp$map[which(names(temp$map) != "beta_phi")]
x = MakeADFun(temp$dat,temp$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = temp$map)
x$opt = nlminb(x$par,x$fn,x$gr)
mod0.bb = x
mod0.bb$rep = mod0.bb$report()
mod0.bb$sdrep = sdreport(x)

x = mod0.bb$simulate(complete=TRUE)
temp = list(mod0.bb$rep$mat, exp(mod0.bb$opt$par['beta_phi']))
temp = rbeta(length(temp[[1]]), temp[[1]]*temp[[2]], (1-temp[[1]])*temp[[2]])
temp = rbinom(length(temp), size = mod0.bb$env$data$N, prob = temp)
x = mod0.bb$env$data
x$Y = as.numeric(temp)
x = MakeADFun(x,mod0.bb$env$parList(),random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = mod0.bb$env$map, silent = TRUE)
nlminb(x$par,x$fn,x$gr)$par
mod0.bb$opt$par

temp = gbcod.mat.rev
temp$dat$binomial = 0
temp$map = temp$map[which(names(temp$map) != "beta_Ecov_k")]
temp$map = temp$map[which(names(temp$map) != "beta_phi")]
x = MakeADFun(temp$dat,temp$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = temp$map)
x$opt = nlminb(x$par,x$fn,x$gr)
mod1.bb = x
mod1.bb$rep = mod1.bb$report()
mod1.bb$sdrep = sdreport(x)

temp = gbcod.mat.rev
temp$dat$binomial = 0
temp$map = temp$map[which(names(temp$map) != "beta_Ecov_a50")]
temp$map = temp$map[which(names(temp$map) != "beta_phi")]
x = MakeADFun(temp$dat,temp$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = temp$map)
x$opt = nlminb(x$par,x$fn,x$gr)
mod2.bb = x
mod2.bb$rep = mod2.bb$report()
mod2.bb$sdrep = sdreport(x)

temp = gbcod.mat.rev
temp$dat$binomial = 0
temp$map = temp$map[which(!(names(temp$map) %in% c("beta_Ecov_k","beta_Ecov_a50","beta_phi")))]
x = MakeADFun(temp$dat,temp$par,random=c("Ecov_re"),DLL="ss_mat_paper_v4", map = temp$map)
x$opt = nlminb(x$par,x$fn,x$gr)
mod3.bb = x
mod3.bb$rep = mod3.bb$report()
mod3.bb$sdrep = sdreport(x)

#binomial models with AR1 in k or a50

#AR1 in k at age 0
temp = gbcod.mat.rev
#temp$dat$Ecov_maxages_k = rep(temp$dat$age_obs-1,length(temp$dat$Y))
#temp$par$beta_Ecov_k = rep(0, max(temp$dat$age_obs))
temp$dat$fit_k = 1
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re")))]
#temp$map$beta_Ecov_k = factor(rep(NA,length(temp$par$beta_Ecov_k)))
mod0.k.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod0.k.AR$opt = nlminb(mod0.k.AR$par,mod0.k.AR$fn,mod0.k.AR$gr)
#801.72

#AR1 in a50 at age 0
temp = gbcod.mat.rev
#temp$dat$Ecov_maxages_a50 = rep(temp$dat$age_obs-1,length(temp$dat$Y))
#temp$par$beta_Ecov_a50 = rep(0, max(temp$dat$age_obs))
temp$dat$fit_a50 = 1
temp$map = temp$map[which(!(names(temp$map) %in% c("a50_AR_pars","a50_re")))]
#temp$map$beta_Ecov_a50 = factor(rep(NA,length(temp$par$beta_Ecov_a50)))
mod0.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod0.a50.AR$opt = nlminb(mod0.a50.AR$par,mod0.a50.AR$fn,mod0.a50.AR$gr)
#665.97

#AR1 in k at age 0:1 and a50 age 0
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_k = rep(1,length(temp$dat$Y))
temp$dat$Ecov_maxages_k[temp$dat$age_obs==1] = 0
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$par$beta_Ecov_k = rep(0,max(1,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
mod1.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod1.k.a50.AR$opt = nlminb(mod1.k.a50.AR$par,mod1.k.a50.AR$fn,mod1.k.a50.AR$gr)
#669.85

#AR1 in a50 at age 0:1 and k age 0
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(1,length(temp$dat$Y))
temp$dat$Ecov_maxages_a50[temp$dat$age_obs==1] = 0
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$par$beta_Ecov_a50 = rep(0,max(1,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
mod2.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod2.k.a50.AR$opt = nlminb(mod2.k.a50.AR$par,mod2.k.a50.AR$fn,mod2.k.a50.AR$gr)
#665.02

#AR1 in k at age 0:1
#AR1 in a50 at age 0:1
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(1,length(temp$dat$Y))
temp$dat$Ecov_maxages_a50[temp$dat$age_obs==1] = 0
temp$dat$Ecov_maxages_k = rep(1,length(temp$dat$Y))
temp$dat$Ecov_maxages_k[temp$dat$age_obs==1] = 0
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$par$beta_Ecov_a50 = rep(0,max(1,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$par$beta_Ecov_k = rep(0,max(1,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
mod3.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod3.k.a50.AR$opt = nlminb(mod3.k.a50.AR$par,mod3.k.a50.AR$fn,mod3.k.a50.AR$gr)
#662.09

#AR1 in k at age 0:2
#AR1 in a50 at age 0:2
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(2,length(temp$dat$Y))
temp$dat$Ecov_maxages_a50[temp$dat$age_obs==2] = 1
temp$dat$Ecov_maxages_a50[temp$dat$age_obs==1] = 0
temp$dat$Ecov_maxages_k = rep(2,length(temp$dat$Y))
temp$dat$Ecov_maxages_k[temp$dat$age_obs==2] = 1
temp$dat$Ecov_maxages_k[temp$dat$age_obs==1] = 0
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$par$beta_Ecov_a50 = rep(0,max(2,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$par$beta_Ecov_k = rep(0,max(2,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
mod4.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod4.k.a50.AR$opt = nlminb(mod4.k.a50.AR$par,mod4.k.a50.AR$fn,mod4.k.a50.AR$gr)
mod4.k.a50.AR$rep = mod4.k.a50.AR$report()
x = mod4.k.a50.AR
mod4.k.a50.AR$sdrep = sdreport(x)
#626.39

temp = list(dat = mod4.k.a50.AR$env$data, par = mod4.k.a50.AR$env$parList(), map = mod4.k.a50.AR$env$map)
temp$map$beta_Ecov_k = factor(c(1,NA,NA))
#temp$map$beta_Ecov_a50 = factor(c(1,NA,NA))
mod4.k.a50.AR.Ecov.1 = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod4.k.a50.AR.Ecov.1$opt = nlminb(mod4.k.a50.AR.Ecov.1$par,mod4.k.a50.AR.Ecov.1$fn,mod4.k.a50.AR.Ecov.1$gr)
#625.93

temp = list(dat = mod4.k.a50.AR$env$data, par = mod4.k.a50.AR$env$parList(), map = mod4.k.a50.AR$env$map)
#temp$map$beta_Ecov_k = factor(c(1,NA,NA))
temp$map$beta_Ecov_a50 = factor(c(1,NA,NA))
mod4.k.a50.AR.Ecov.2 = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod4.k.a50.AR.Ecov.2$opt = nlminb(mod4.k.a50.AR.Ecov.2$par,mod4.k.a50.AR.Ecov.2$fn,mod4.k.a50.AR.Ecov.2$gr)
#626.03

temp = list(dat = mod4.k.a50.AR$env$data, par = mod4.k.a50.AR$env$parList(), map = mod4.k.a50.AR$env$map)
temp$map$beta_Ecov_k = factor(c(1,NA,NA))
temp$map$beta_Ecov_a50 = factor(c(1,NA,NA))
mod4.k.a50.AR.Ecov.3 = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod4.k.a50.AR.Ecov.3$opt = nlminb(mod4.k.a50.AR.Ecov.3$par,mod4.k.a50.AR.Ecov.3$fn,mod4.k.a50.AR.Ecov.3$gr)
#625.75

#AR1 in k at age 0:3
#AR1 in a50 at age 0:3
maxage = 3
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
x = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
x$opt = nlminb(x$par,x$fn,x$gr)
#610.08

#AR1 in k at age 0:4
#AR1 in a50 at age 0:4
maxage = 4
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$par = mod4.k.a50.AR$env$parList()
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
x = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
x$opt = nlminb(x$par,x$fn,x$gr)
#602.73

#AR1 in k at age 0:5
#AR1 in a50 at age 0:5
maxage = 5
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$par = mod4.k.a50.AR$env$parList()
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
x = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
x$opt = nlminb(x$par,x$fn,x$gr)
#601.68

#AR1 in k at age 0:6
#AR1 in a50 at age 0:6
maxage = 6
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$par = mod4.k.a50.AR$env$parList()
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
x = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
x$opt = nlminb(x$par,x$fn,x$gr)
#601.02

#AR1 in k at age 0:7
#AR1 in a50 at age 0:7
maxage = 7
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$par = mod4.k.a50.AR$env$parList()
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
mod5.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod5.k.a50.AR$opt = nlminb(mod5.k.a50.AR$par,mod5.k.a50.AR$fn,mod5.k.a50.AR$gr)
#600.67

#AR1 in k at age 0:8
#AR1 in a50 at age 0:7
temp = gbcod.mat.rev
temp$par = mod4.k.a50.AR$env$parList()
maxage = 7
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
maxage = 8
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
mod6.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod6.k.a50.AR$opt = nlminb(mod6.k.a50.AR$par,mod6.k.a50.AR$fn,mod6.k.a50.AR$gr)
#600.69

#AR1 in k at age 0:7
#AR1 in a50 at age 0:8
temp = gbcod.mat.rev
temp$par = mod4.k.a50.AR$env$parList()
maxage = 8
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
maxage = 7
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
mod7.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod7.k.a50.AR$opt = nlminb(mod7.k.a50.AR$par,mod7.k.a50.AR$fn,mod7.k.a50.AR$gr)
mod7.k.a50.AR$rep = mod7.k.a50.AR$report()
x = mod7.k.a50.AR
mod7.k.a50.AR$sdrep = sdreport(x)
#600.66

#AR1 in k at age 0:8
#AR1 in a50 at age 0:8
maxage = 8
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$par = mod4.k.a50.AR$env$parList()
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
mod8.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod8.k.a50.AR$opt = nlminb(mod8.k.a50.AR$par,mod8.k.a50.AR$fn,mod8.k.a50.AR$gr)
#600.68

#betabinomial models with AR1 in k or a50

#AR1 in k at age 0
temp = gbcod.mat.rev
#temp$dat$Ecov_maxages_k = rep(temp$dat$age_obs-1,length(temp$dat$Y))
#temp$par = mod0.k.AR$env$parList()
#temp$par$beta_Ecov_k = rep(0, max(temp$dat$age_obs))
temp$dat$fit_k = 1
temp$dat$binomial = 0
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re")))]
temp$map = temp$map[which(!(names(temp$map) %in% c("beta_phi")))]
#temp$map$beta_Ecov_k = factor(rep(NA,length(temp$par$beta_Ecov_k)))
mod0.bb.k.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod0.bb.k.AR$opt = nlminb(mod0.bb.k.AR$par,mod0.bb.k.AR$fn,mod0.bb.k.AR$gr)
temp$map = temp$map[which(!(names(temp$map) %in% c("beta_phi")))]
temp$par = mod0.bb.k.AR$env$parList()
mod0.bb.k.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod0.bb.k.AR$opt = nlminb(mod0.bb.k.AR$par,mod0.bb.k.AR$fn,mod0.bb.k.AR$gr)

#AR1 in a50 at age 0
temp = gbcod.mat.rev
#temp$dat$Ecov_maxages_a50 = rep(temp$dat$age_obs-1,length(temp$dat$Y))
#temp$par = mod0.a50.AR$env$parList()
#temp$par$beta_Ecov_a50 = rep(0, max(temp$dat$age_obs))
temp$dat$fit_a50 = 1
temp$dat$binomial = 0
temp$map = temp$map[which(!(names(temp$map) %in% c("a50_AR_pars","a50_re")))]
#temp$map$beta_Ecov_a50 = factor(rep(NA,length(temp$par$beta_Ecov_a50)))
mod0.bb.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod0.bb.a50.AR$opt = nlminb(mod0.bb.a50.AR$par,mod0.bb.a50.AR$fn,mod0.bb.a50.AR$gr)
temp$map = temp$map[which(!(names(temp$map) %in% c("beta_phi")))]
temp$par = mod0.bb.a50.AR$env$parList()
mod0.bb.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod0.bb.a50.AR$opt = nlminb(mod0.bb.a50.AR$par,mod0.bb.a50.AR$fn,mod0.bb.a50.AR$gr)

#AR1 in k and a50 at age 0
temp = gbcod.mat.rev
#temp$dat$Ecov_maxages_k = rep(temp$dat$age_obs-1,length(temp$dat$Y))
#temp$dat$Ecov_maxages_a50 = rep(temp$dat$age_obs-1,length(temp$dat$Y))
#temp$par = mod0.bb.k.AR$env$parList()
#temp$par$beta_Ecov_k = rep(0, max(temp$dat$age_obs))
#temp$par$beta_Ecov_a50 = rep(0, max(temp$dat$age_obs))
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$dat$binomial = 0
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
temp$map = temp$map[which(!(names(temp$map) %in% c("beta_phi")))]
#temp$map$beta_Ecov_k = factor(rep(NA,length(temp$par$beta_Ecov_k)))
#temp$map$beta_Ecov_a50 = factor(rep(NA,length(temp$par$beta_Ecov_a50)))
mod0.bb.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod0.bb.k.a50.AR$opt = nlminb(mod0.bb.k.a50.AR$par,mod0.bb.k.a50.AR$fn,mod0.bb.k.a50.AR$gr)
#temp$map = temp$map[which(!(names(temp$map) %in% c("beta_phi")))]
#temp$par = mod0.bb.k.a50.AR$env$parList()
#mod0.bb.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
#mod0.bb.k.a50.AR$opt = nlminb(mod0.bb.k.a50.AR$par,mod0.bb.k.a50.AR$fn,mod0.bb.k.a50.AR$gr)
mod0.bb.k.a50.AR$rep = mod0.bb.k.a50.AR$report()
x = mod0.bb.k.a50.AR
mod0.bb.k.a50.AR$sdrep = sdreport(x)
#571.70

#AR1 in k at age 0:1 and a50 age 0
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_k = rep(1,length(temp$dat$Y))
temp$dat$Ecov_maxages_k[temp$dat$age_obs==1] = 0
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$dat$binomial = 0
temp$par = mod0.bb.k.a50.AR$env$parList()
temp$par$beta_Ecov_k = rep(0,max(1,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re")))]
temp$map = temp$map[which(!(names(temp$map) %in% c("beta_phi")))]
mod1.bb.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod1.bb.k.a50.AR$opt = nlminb(mod1.bb.k.a50.AR$par,mod1.bb.k.a50.AR$fn,mod1.bb.k.a50.AR$gr)
mod1.bb.k.a50.AR$rep = mod1.bb.k.a50.AR$report()
x = mod1.bb.k.a50.AR
mod1.bb.k.a50.AR$sdrep = sdreport(x)
#556.56

#AR1 in a50 at age 0:1 and k age 0
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(1,length(temp$dat$Y))
temp$dat$Ecov_maxages_a50[temp$dat$age_obs==1] = 0
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$dat$binomial = 0
temp$par = mod0.bb.k.a50.AR$env$parList()
temp$par$beta_Ecov_a50 = rep(0,max(1,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re","beta_phi")))]
mod2.bb.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod2.bb.k.a50.AR$opt = nlminb(mod2.bb.k.a50.AR$par,mod2.bb.k.a50.AR$fn,mod2.bb.k.a50.AR$gr)
mod2.bb.k.a50.AR$rep = mod2.bb.k.a50.AR$report()
x = mod2.bb.k.a50.AR
mod2.bb.k.a50.AR$sdrep = sdreport(x)
#554.73

#AR1 in k at age 0:1
#AR1 in a50 at age 0:1
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(1,length(temp$dat$Y))
temp$dat$Ecov_maxages_a50[temp$dat$age_obs==1] = 0
temp$dat$Ecov_maxages_k = rep(1,length(temp$dat$Y))
temp$dat$Ecov_maxages_k[temp$dat$age_obs==1] = 0
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$dat$binomial = 0
temp$par = mod0.bb.k.a50.AR$env$parList()
temp$par$beta_Ecov_a50 = rep(0,max(1,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$par$beta_Ecov_k = rep(0,max(1,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re","beta_phi")))]
mod3.bb.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod3.bb.k.a50.AR$opt = nlminb(mod3.bb.k.a50.AR$par,mod3.bb.k.a50.AR$fn,mod3.bb.k.a50.AR$gr)
mod3.bb.k.a50.AR$rep = mod3.bb.k.a50.AR$report()
x = mod3.bb.k.a50.AR
mod3.bb.k.a50.AR$sdrep = sdreport(x)
#554.69

#AR1 in k at age 0:1
#AR1 in a50 at age 0:2
maxage = 2
temp = gbcod.mat.rev
temp$par = mod0.bb.k.a50.AR$env$parList()
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
maxage = 1
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$dat$binomial = 0
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re","beta_phi")))]
x = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
x$opt = nlminb(x$par,x$fn,x$gr)
mod4.bb.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod4.bb.k.a50.AR$opt = nlminb(mod4.bb.k.a50.AR$par,mod4.bb.k.a50.AR$fn,mod4.bb.k.a50.AR$gr)
mod4.bb.k.a50.AR$rep = mod4.bb.k.a50.AR$report()
x = mod4.bb.k.a50.AR
mod4.bb.k.a50.AR$sdrep = sdreport(x)
#545.03
mod4.bb.k.a50.AR$parList = mod4.bb.k.a50.AR$env$parList()
save(mod4.bb.k.a50.AR, file = "mod4.bb.k.a50.AR.RData")

temp = list(dat = mod4.bb.k.a50.AR$env$data, par = mod4.bb.k.a50.AR$env$parList(), map = mod4.bb.k.a50.AR$env$map)
temp$map$beta_Ecov_k = factor(c(1,NA))
#temp$map$beta_Ecov_a50 = factor(c(1,NA,NA))
mod4.bb.k.a50.AR.Ecov.1 = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod4.bb.k.a50.AR.Ecov.1$opt = nlminb(mod4.bb.k.a50.AR.Ecov.1$par,mod4.bb.k.a50.AR.Ecov.1$fn,mod4.bb.k.a50.AR.Ecov.1$gr)
#544.97

temp = list(dat = mod4.bb.k.a50.AR$env$data, par = mod4.bb.k.a50.AR$env$parList(), map = mod4.bb.k.a50.AR$env$map)
#temp$map$beta_Ecov_k = factor(c(1,NA))
temp$map$beta_Ecov_a50 = factor(c(1,NA,NA))
mod4.bb.k.a50.AR.Ecov.2 = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod4.bb.k.a50.AR.Ecov.2$opt = nlminb(mod4.bb.k.a50.AR.Ecov.2$par,mod4.bb.k.a50.AR.Ecov.2$fn,mod4.bb.k.a50.AR.Ecov.2$gr)
#544.97

temp = list(dat = mod4.bb.k.a50.AR$env$data, par = mod4.bb.k.a50.AR$env$parList(), map = mod4.bb.k.a50.AR$env$map)
temp$map$beta_Ecov_k = factor(c(1,NA))
temp$map$beta_Ecov_a50 = factor(c(1,NA,NA))
mod4.bb.k.a50.AR.Ecov.3 = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod4.bb.k.a50.AR.Ecov.3$opt = nlminb(mod4.bb.k.a50.AR.Ecov.3$par,mod4.bb.k.a50.AR.Ecov.3$fn,mod4.bb.k.a50.AR.Ecov.3$gr)
#544.93

#AR1 in k at age 0:1
#AR1 in a50 at age 0:2
maxage = 1
temp = gbcod.mat.rev
temp$par = mod0.bb.k.a50.AR$env$parList()
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
maxage = 2
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$dat$binomial = 0
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re","beta_phi")))]
mod5.bb.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod5.bb.k.a50.AR$opt = nlminb(mod5.bb.k.a50.AR$par,mod5.bb.k.a50.AR$fn,mod5.bb.k.a50.AR$gr)
mod5.bb.k.a50.AR$rep = mod5.bb.k.a50.AR$report()
x = mod5.bb.k.a50.AR
mod5.bb.k.a50.AR$sdrep = sdreport(x)
#554.52

#AR1 in k at age 0:2
#AR1 in a50 at age 0:2
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(2,length(temp$dat$Y))
temp$dat$Ecov_maxages_a50[temp$dat$age_obs==2] = 1
temp$dat$Ecov_maxages_a50[temp$dat$age_obs==1] = 0
temp$dat$Ecov_maxages_k = rep(2,length(temp$dat$Y))
temp$dat$Ecov_maxages_k[temp$dat$age_obs==2] = 1
temp$dat$Ecov_maxages_k[temp$dat$age_obs==1] = 0
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$dat$binomial = 0
temp$par = mod0.bb.k.a50.AR$env$parList()
temp$par$beta_Ecov_a50 = rep(0,max(2,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$par$beta_Ecov_k = rep(0,max(2,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re","beta_phi")))]
mod6.bb.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod6.bb.k.a50.AR$opt = nlminb(mod6.bb.k.a50.AR$par,mod6.bb.k.a50.AR$fn,mod6.bb.k.a50.AR$gr)
mod6.bb.k.a50.AR$rep = mod6.bb.k.a50.AR$report()
x = mod6.bb.k.a50.AR
mod6.bb.k.a50.AR$sdrep = sdreport(x)
#545.01

#AR1 in k at age 0:2
#AR1 in a50 at age 0:3
maxage = 3
temp = gbcod.mat.rev
temp$par = mod0.bb.k.a50.AR$env$parList()
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
maxage = 2
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$dat$binomial = 0
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re","beta_phi")))]
x = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
x$opt = nlminb(x$par,x$fn,x$gr)
x$opt$obj
#548.49

#AR1 in k at age 0:3
#AR1 in a50 at age 0:2
maxage = 2
temp = gbcod.mat.rev
temp$par = mod0.bb.k.a50.AR$env$parList()
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
maxage = 3
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$dat$binomial = 0
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re","beta_phi")))]
mod7.bb.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod7.bb.k.a50.AR$opt = nlminb(mod7.bb.k.a50.AR$par,mod7.bb.k.a50.AR$fn,mod7.bb.k.a50.AR$gr)
mod7.bb.k.a50.AR$rep = mod7.bb.k.a50.AR$report()
x = mod7.bb.k.a50.AR
mod7.bb.k.a50.AR$sdrep = sdreport(x)
#544.97
mod7.bb.k.a50.AR$parList = mod7.bb.k.a50.AR$env$parList()
save(mod7.bb.k.a50.AR, file = "mod7.bb.k.a50.AR.RData")

x = summary(mod7.bb.k.a50.AR$sdrep)
x[rownames(x) %in% "a50_re",1]
x = x[rownames(x) %in% c("Ecov_y","k_re","a50_re","beta_a50","beta_k","beta_Ecov_k", "beta_Ecov_a50"),1]
ind = sum(names(x) == "Ecov_y")
ind = c(1:(sum(names(x) == "Ecov_y")-2),ind)
x = x[-which(names(x) == "Ecov_y")[ind]]
x = x[-which(names(x) == "k_re")[ind]]
x = x[-which(names(x) == "a50_re")[ind]]
x
k = exp(x["beta_k"] + x["k_re"])
a50 = exp(x["beta_a50"] + x["a50_re"])
1/(1 + exp(-k*(1-a50)))

x = summary(mod7.bb.k.a50.AR$sdrep)
x = x[rownames(x) %in% "a50_re",1]

exp(temp["beta_Linf"])*(1-exp(-k1*(1-temp["t0"])))

#AR1 in k at age 0:3
#AR1 in a50 at age 0:3
maxage = 3
temp = gbcod.mat.rev
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$dat$binomial = 0
temp$par = mod0.bb.k.a50.AR$env$parList()
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re","beta_phi")))]
mod8.bb.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod8.bb.k.a50.AR$opt = nlminb(mod8.bb.k.a50.AR$par,mod8.bb.k.a50.AR$fn,mod8.bb.k.a50.AR$gr)
mod8.bb.k.a50.AR$opt$obj
#546.14
#not as good

#AR1 in k at age 0:4
#AR1 in a50 at age 0:2
maxage = 2
temp = gbcod.mat.rev
temp$par = mod0.bb.k.a50.AR$env$parList()
temp$dat$Ecov_maxages_a50 = rep(maxage,length(temp$dat$Y))
if(maxage>0) for(i in 1:maxage) temp$dat$Ecov_maxages_a50[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_a50 = rep(0,max(maxage,temp$dat$Ecov_maxages_a50+1))
temp$map$beta_Ecov_a50 = factor(rep(NA, length(temp$par$beta_Ecov_a50)))
maxage = 4
temp$dat$Ecov_maxages_k = rep(maxage,length(temp$dat$Y))
if(maxage>0) for(i in 1:maxage) temp$dat$Ecov_maxages_k[temp$dat$age_obs==i] = i-1
temp$par$beta_Ecov_k = rep(0,max(maxage,temp$dat$Ecov_maxages_k+1))
temp$map$beta_Ecov_k = factor(rep(NA, length(temp$par$beta_Ecov_k)))
temp$dat$fit_k = 1
temp$dat$fit_a50 = 1
temp$dat$binomial = 0
temp$map = temp$map[which(!(names(temp$map) %in% c("k_AR_pars","k_re","a50_AR_pars","a50_re","beta_phi")))]
mod9.bb.k.a50.AR = MakeADFun(temp$dat, temp$par, random = c("Ecov_re","k_re","a50_re"), DLL = "ss_mat_paper_v4", map = temp$map)
mod9.bb.k.a50.AR$opt = nlminb(mod9.bb.k.a50.AR$par,mod9.bb.k.a50.AR$fn,mod9.bb.k.a50.AR$gr)
mod9.bb.k.a50.AR$opt$obj
#545.06
#not as good

temp = list(mod0$opt,mod1$opt,mod2$opt,mod3$opt,mod4$opt,mod5$opt,mod6$opt,mod7$opt,mod8$opt,mod9$opt)
temp = sapply(temp, function(x) 2 * x$obj + 2 * length(x$par))
temp - min(temp)
#temp = list(mod0.bb$opt,mod1.bb$opt,mod2.bb$opt,mod3.bb$opt,mod4.bb$opt,mod5.bb$opt,mod6.bb$opt,mod7.bb$opt,mod8.bb$opt,mod9.bb$opt)
temp = list(mod0.bb$opt,mod1.bb$opt,mod2.bb$opt,mod3.bb$opt)
temp = sapply(temp, function(x) 2 * x$obj + 2 * length(x$par))
temp - min(temp)
#temp = list(mod0.bb$opt,mod1.bb$opt,mod2.bb$opt,mod3.bb$opt,mod4.bb$opt,mod5.bb$opt,mod6.bb$opt,mod7.bb$opt,mod8.bb$opt,mod9.bb$opt,
temp = list(mod0$opt,mod1$opt,mod2$opt,mod3$opt,mod4$opt,mod5$opt,mod6$opt,mod7$opt,mod8$opt,mod9$opt,
  mod0.bb$opt,mod1.bb$opt,mod2.bb$opt,mod3.bb$opt)
aic = sapply(temp, function(x) 2 * x$obj + 2 * length(x$par))
delta.aic = aic - min(aic)
aic.wts = exp(-0.5*delta.aic)/sum(exp(-0.5*delta.aic))

temp = list(
  mod0$opt,mod7$opt,mod4.k.a50.AR$opt,mod4.k.a50.AR.Ecov.1$opt,mod4.k.a50.AR.Ecov.2$opt,mod4.k.a50.AR.Ecov.3$opt,
  mod0.bb$opt,mod1.bb$opt,mod2.bb$opt,mod3.bb$opt,mod4.bb.k.a50.AR$opt,
  mod4.bb.k.a50.AR.Ecov.1$opt,mod4.bb.k.a50.AR.Ecov.2$opt,mod4.bb.k.a50.AR.Ecov.3$opt)
sapply(temp, function(x) length(x$par))
aic = sapply(temp, function(x) 2 * x$obj + 2 * length(x$par))
aic - min(aic)

library(plotrix)
tcol <- col2rgb('black')
tcol <- paste(rgb(tcol[1,],tcol[2,], tcol[3,], maxColorValue = 255), "55", sep = '')

mat.dat.table = table(mat.dat$YEAR, mat.dat$AGE)
temp = apply(mat.dat.table[,-(1:8)], 1, sum)
mat.dat.table = cbind(mat.dat.table[,1:8], "$>$ 8" = temp)
mat.dat.table = cbind(mat.dat.table, Weight = sapply(unique(mat.dat$YEAR), function(x) sum(mat.dat$YEAR == x & mat.dat$INDWT>0)))
#mat.dat.table = cbind(mat.dat.table, Length = sapply(unique(mat.dat$YEAR), function(x) sum(mat.dat$YEAR == x & mat.dat$LENGTH>0)))
mat.dat.table = cbind(mat.dat.table, Total = sapply(unique(mat.dat$YEAR), function(x) sum(mat.dat$YEAR == x)))
mat.dat.table = rbind(mat.dat.table, Total = apply(mat.dat.table, 2, sum))

library(Hmisc)
x = latex(mat.dat.table, file = '~/work/cod/ss_maturity/tex/mat_data_table_v2.tex',
  rowlabel = 'Year', cgroup = c("Age", "", ""), n.cgroup = c(9,1,1), table.env = FALSE, rowlabel.just = "c", cgroupTexCmd = NULL)#, collabel.just)

x = cbind(gbcod.mat$dat$Ecov_obs, gbcod.mat$dat$Ecov_obs_sigma)
x[which(x < -99)] = NA
colnames(x) = c("Anomaly", "Standard Error")
rownames(x) = 1963:2014
temp = latex(x, file = '~/work/cod/ss_maturity/tex/bottom_temperature_anomalies.tex',
  rowlabel = 'Year', table.env = FALSE, rowlabel.just = "c")#, collabel.just)
temp = latex(x[1963:2000-1962,], file = '~/work/cod/ss_maturity/tex/bottom_temperature_anomalies_1.tex',
  rowlabel = 'Year', table.env = FALSE, rowlabel.just = "c")#, collabel.just)
temp = latex(x[2001:2014-1962,], file = '~/work/cod/ss_maturity/tex/bottom_temperature_anomalies_2.tex',
  rowlabel = 'Year', table.env = FALSE, rowlabel.just = "c")#, collabel.just)

par(mfrow = c(1,1), mar = c(1,4,1,1), oma = c(4,1,0,0))
temp = summary(mod0.sdrep)
temp = temp[which(rownames(temp) == "Ecov_y"),]
temp = cbind(temp[,1], temp[,1] + qnorm(0.975)*cbind(-temp[,2],temp[,2]))
plot(1963:2014, temp[,1], type = 'n', axes = FALSE, ylim = range(temp), xlab = "", ylab = "")
grid(col = gray(0.7), lwd = 1)
lines(1963:2014, temp[,1], lwd = 2)
polygon(c(1963:2014,2014:1963), c(temp[,2],rev(temp[,3])), col = tcol, border = "transparent", lty = 2)
x = gbcod.mat$dat
temp <- which(x$use_Ecov_obs == 1)
plotCI((1963:2014)[temp], x$Ecov_obs[temp], li = (x$Ecov_obs - qnorm(0.975)*x$Ecov_obs_sigma)[temp], ui = (x$Ecov_obs + qnorm(0.975)*x$Ecov_obs_sigma)[temp],
  add = TRUE, lwd = 2)
axis(1, labels = FALSE, lwd = 2)
axis(2, lwd = 2, cex.axis = 1.5)
box(lwd = 2)
mtext(side = 2, outer = FALSE, line = 3, "Bottom temperature anomaly", cex = 1.5)

###########################################################
#plots comparing maturity predictions and emperical estimates

y = summary(mod7.bb.k.a50.AR$sdrep)
y = y[rownames(y) == "logit_pmat",]
z = matrix(1/(1+exp(-y[,1])), ncol = 3)
plot((1963:2014)[-(1:3)],z[-(1:3),3], ylim = c(0,1), xlab = '', ylab = '', type = 'l')
lines((1963:2014)[-1],z[-1,1], col = 'red')
plot((1963:2014)[-(1:2)],z[-(1:2),2], ylim = c(0,1), xlab = '', ylab = '', type = 'n')

temp.fn = function(whichage = 2, model = mod7.bb.k.a50.AR)
{
  library(plotrix)
  y = summary(model$sdrep)
  #y = summary(sdreport(x))
  y = y[rownames(y) == "logit_pmat",]
  y = cbind(y[,1], y[,1] +qnorm(0.975)*cbind(-y[,2],y[,2]))
  z = cbind(matrix(1/(1+exp(-y[,1])), ncol = 3)[,whichage], matrix(1/(1+exp(-y[,2])), ncol = 3)[,whichage],matrix(1/(1+exp(-y[,3])), ncol = 3)[,whichage])
  years = 1963:2014
  years.dat = 1970:2014
  ind = which(years %in% years.dat)#[-(1:whichage)]
  plot(years.dat,z[ind,2], ylim = c(0,1), xlab = '', ylab = '', type = 'n', axes = FALSE, xlim = range(years.dat))
  grid(col = gray(0.7), lwd = 1)
  lines(years.dat ,z[ind,1], col = 'black', lwd = 2)
  polygon(c(years.dat,rev(years.dat)), c(z[ind,2],rev(z[ind,3])), col = tcol, border = "transparent", lty = 2)

  temp = cbind.data.frame(mat = gbcod.mat.rev$dat$Y, n = gbcod.mat.rev$dat$N, age = gbcod.mat.rev$dat$age_obs,
    cohort = gbcod.mat.rev$dat$cy_obs + 1962, year = gbcod.mat.rev$dat$year_obs + 1962)
  x = t(sapply(1970:2014, function(y)
  {
    #x = summary(glm(mat ~ 1, family = binomial, data = temp, subset = age == 3 & year == 1975))$coef[1:2]
    x = try(summary(glm(cbind(mat,n-mat) ~ 1, family = binomial, data = temp, subset = age == whichage & year == y))$coef[1:2])
    if(!is.character(x))
    {
      x = c(1/(1 + exp(-x[1])), 1/(1 + exp(-(x[1] + c(-1,1)*qnorm(0.975)*x[2]))))
#      print(x)
      plotCI(x = y, y = x[1], li = x[2], ui = x[3], add = TRUE, slty = 2, sfrac = 0, lwd = 2)
      return(x)
    }
    else return(rep(NA,3))
  }))
}

par(mfcol = c(2,3), mar = c(1,1,1,1), oma = c(4,4,0,0))
temp.fn(3, mod4.k.a50.AR)
temp.fn(2, mod4.k.a50.AR)
temp.fn(3, mod7.k.a50.AR)
temp.fn(2, mod7.k.a50.AR)
temp.fn(3, model = mod4.bb.k.a50.AR)
temp.fn(2, model = mod4.bb.k.a50.AR)

cairo_pdf('~/work/cod/ss_maturity/tex/maturity_at_age.pdf', family = "Times", height = 10, width = 7)
#png(filename = '~/work/cod/ss_maturity/tex/maturity_at_age.png', width = 7*144, height = 10*144, res = 144, pointsize = 12, family = "Times")#,
par(mfrow = c(2,1), mar = c(1,1,1,1), oma = c(4,4,0,0))
temp.fn(3, model = mod4.bb.k.a50.AR)
axis(2, lwd = 2, cex.axis = 1.5)
axis(1, labels = FALSE, cex.axis = 1.5)
box(lwd =2)
temp.fn(2, model = mod4.bb.k.a50.AR)
axis(2, lwd = 2, cex.axis = 1.5)
axis(1, lwd = 2, cex.axis = 1.5)
box(lwd =2)
#temp.fn(1)
#axis(2, lwd = 2, cex.axis = 1.5)
#axis(1, lwd = 2, cex.axis = 1.5)
#box(lwd =2)
mtext(side = 1, line = 2, "Year", cex = 2, outer = TRUE)
mtext(side = 2, line = 2, "Proportion mature", cex = 2, outer = TRUE)
dev.off()


#' A box and whiskers plot (in the style of Tukey)
#'
#' The boxplot compactly displays the distribution of a continuous variable.
#' It visualises five summary statistics (the median, two hinges
#' and two whiskers), and all "outlying" points individually.
#'
#' @eval rd_orientation()
#'
#' @section Summary statistics:
#' The lower and upper hinges correspond to the first and third quartiles
#' (the 25th and 75th percentiles). This differs slightly from the method used
#' by the [boxplot()] function, and may be apparent with small samples.
#' See [boxplot.stats()] for for more information on how hinge
#' positions are calculated for [boxplot()].
#'
#' The upper whisker extends from the hinge to the largest value no further than
#' 1.5 * IQR from the hinge (where IQR is the inter-quartile range, or distance
#' between the first and third quartiles). The lower whisker extends from the
#' hinge to the smallest value at most 1.5 * IQR of the hinge. Data beyond the
#' end of the whiskers are called "outlying" points and are plotted
#' individually.
#'
#' In a notched box plot, the notches extend `1.58 * IQR / sqrt(n)`.
#' This gives a roughly 95% confidence interval for comparing medians.
#' See McGill et al. (1978) for more details.
#'
#' @eval rd_aesthetics("geom", "boxplot")
#'
#' @seealso [geom_quantile()] for continuous `x`,
#'   [geom_violin()] for a richer display of the distribution, and
#'   [geom_jitter()] for a useful technique for small data.
#' @inheritParams layer
#' @inheritParams geom_bar
#' @param geom,stat Use to override the default connection between
#'   `geom_boxplot()` and `stat_boxplot()`.
#' @param outlier.colour,outlier.color,outlier.fill,outlier.shape,outlier.size,outlier.stroke,outlier.alpha
#'   Default aesthetics for outliers. Set to `NULL` to inherit from the
#'   aesthetics used for the box.
#'
#'   In the unlikely event you specify both US and UK spellings of colour, the
#'   US spelling will take precedence.
#'
#'   Sometimes it can be useful to hide the outliers, for example when overlaying
#'   the raw data points on top of the boxplot. Hiding the outliers can be achieved
#'   by setting `outlier.shape = NA`. Importantly, this does not remove the outliers,
#'   it only hides them, so the range calculated for the y-axis will be the
#'   same with outliers shown and outliers hidden.
#'
#' @param notch If `FALSE` (default) make a standard box plot. If
#'   `TRUE`, make a notched box plot. Notches are used to compare groups;
#'   if the notches of two boxes do not overlap, this suggests that the medians
#'   are significantly different.
#' @param notchwidth For a notched box plot, width of the notch relative to
#'   the body (defaults to `notchwidth = 0.5`).
#' @param varwidth If `FALSE` (default) make a standard box plot. If
#'   `TRUE`, boxes are drawn with widths proportional to the
#'   square-roots of the number of observations in the groups (possibly
#'   weighted, using the `weight` aesthetic).
#' @export
#' @references McGill, R., Tukey, J. W. and Larsen, W. A. (1978) Variations of
#'     box plots. The American Statistician 32, 12-16.
#' @examples
#' p <- ggplot(mpg, aes(class, hwy))
#' p + geom_boxplot()
#' # Orientation follows the discrete axis
#' ggplot(mpg, aes(hwy, class)) + geom_boxplot()
#'
#' p + geom_boxplot(notch = TRUE)
#' p + geom_boxplot(varwidth = TRUE)
#' p + geom_boxplot(fill = "white", colour = "#3366FF")
#' # By default, outlier points match the colour of the box. Use
#' # outlier.colour to override
#' p + geom_boxplot(outlier.colour = "red", outlier.shape = 1)
#' # Remove outliers when overlaying boxplot with original data points
#' p + geom_boxplot(outlier.shape = NA) + geom_jitter(width = 0.2)
#'
#' # Boxplots are automatically dodged when any aesthetic is a factor
#' p + geom_boxplot(aes(colour = drv))
#'
#' # You can also use boxplots with continuous x, as long as you supply
#' # a grouping variable. cut_width is particularly useful
#' ggplot(diamonds, aes(carat, price)) +
#'   geom_boxplot()
#' ggplot(diamonds, aes(carat, price)) +
#'   geom_boxplot(aes(group = cut_width(carat, 0.25)))
#' # Adjust the transparency of outliers using outlier.alpha
#' ggplot(diamonds, aes(carat, price)) +
#'   geom_boxplot(aes(group = cut_width(carat, 0.25)), outlier.alpha = 0.1)
#'
#' \donttest{
#' # It's possible to draw a boxplot with your own computations if you
#' # use stat = "identity":
#' y <- rnorm(100)
#' df <- data.frame(
#'   x = 1,
#'   y0 = min(y),
#'   y25 = quantile(y, 0.25),
#'   y50 = median(y),
#'   y75 = quantile(y, 0.75),
#'   y100 = max(y)
#' )
#' ggplot(df, aes(x)) +
#'   geom_boxplot(
#'    aes(ymin = y0, lower = y25, middle = y50, upper = y75, ymax = y100),
#'    stat = "identity"
#'  )
#' }
geom_boxplot <- function(mapping = NULL, data = NULL,
                         stat = "boxplot", position = "dodge2",
                         ...,
                         outlier.colour = NULL,
                         outlier.color = NULL,
                         outlier.fill = NULL,
                         outlier.shape = 19,
                         outlier.size = 1.5,
                         outlier.stroke = 0.5,
                         outlier.alpha = NULL,
                         notch = FALSE,
                         notchwidth = 0.5,
                         varwidth = FALSE,
                         na.rm = FALSE,
                         orientation = NA,
                         show.legend = NA,
                         inherit.aes = TRUE) {

  # varwidth = TRUE is not compatible with preserve = "total"
  if (is.character(position)) {
    if (varwidth == TRUE) position <- position_dodge2(preserve = "single")
  } else {
    if (identical(position$preserve, "total") & varwidth == TRUE) {
      warn("Can't preserve total widths when varwidth = TRUE.")
      position$preserve <- "single"
    }
  }

  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomBoxplot,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      outlier.colour = outlier.color %||% outlier.colour,
      outlier.fill = outlier.fill,
      outlier.shape = outlier.shape,
      outlier.size = outlier.size,
      outlier.stroke = outlier.stroke,
      outlier.alpha = outlier.alpha,
      notch = notch,
      notchwidth = notchwidth,
      varwidth = varwidth,
      na.rm = na.rm,
      orientation = orientation,
      ...
    )
  )
}

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
GeomBoxplot <- ggproto("GeomBoxplot", Geom,

  # need to declare `width` here in case this geom is used with a stat that
  # doesn't have a `width` parameter (e.g., `stat_identity`).
  extra_params = c("na.rm", "width", "orientation"),

  setup_params = function(data, params) {
    params$flipped_aes <- has_flipped_aes(data, params)
    params
  },

  setup_data = function(data, params) {
    data$flipped_aes <- params$flipped_aes
    data <- flip_data(data, params$flipped_aes)
    data$width <- data$width %||%
      params$width %||% (resolution(data$x, FALSE) * 0.9)

    if (!is.null(data$outliers)) {
      suppressWarnings({
        out_min <- vapply(data$outliers, min, numeric(1))
        out_max <- vapply(data$outliers, max, numeric(1))
      })

      data$ymin_final  <- pmin(out_min, data$ymin)
      data$ymax_final  <- pmax(out_max, data$ymax)
    }

    # if `varwidth` not requested or not available, don't use it
    if (is.null(params) || is.null(params$varwidth) || !params$varwidth || is.null(data$relvarwidth)) {
      data$xmin <- data$x - data$width / 2
      data$xmax <- data$x + data$width / 2
    } else {
      # make `relvarwidth` relative to the size of the largest group
      data$relvarwidth <- data$relvarwidth / max(data$relvarwidth)
      data$xmin <- data$x - data$relvarwidth * data$width / 2
      data$xmax <- data$x + data$relvarwidth * data$width / 2
    }
    data$width <- NULL
    if (!is.null(data$relvarwidth)) data$relvarwidth <- NULL

    flip_data(data, params$flipped_aes)
  },

  draw_group = function(data, panel_params, coord, fatten = 2,
                        outlier.colour = NULL, outlier.fill = NULL,
                        outlier.shape = 19,
                        outlier.size = 1.5, outlier.stroke = 0.5,
                        outlier.alpha = NULL,
                        notch = FALSE, notchwidth = 0.5, varwidth = FALSE, flipped_aes = FALSE) {
    data <- flip_data(data, flipped_aes)
    # this may occur when using geom_boxplot(stat = "identity")
    if (nrow(data) != 1) {
      abort("Can't draw more than one boxplot per group. Did you forget aes(group = ...)?")
    }

    common <- list(
      colour = data$colour,
      size = data$size,
      linetype = data$linetype,
      fill = alpha(data$fill, data$alpha),
      group = data$group
    )

    whiskers <- new_data_frame(c(
      list(
        x = c(data$x, data$x),
        xend = c(data$x, data$x),
        y = c(data$upper, data$lower),
        yend = c(data$ymax, data$ymin),
        alpha = c(NA_real_, NA_real_)
      ),
      common
    ), n = 2)
    whiskers <- flip_data(whiskers, flipped_aes)

    box <- new_data_frame(c(
      list(
        xmin = data$xmin,
        xmax = data$xmax,
        ymin = data$lower,
        y = data$middle,
        ymax = data$upper,
        ynotchlower = ifelse(notch, data$notchlower, NA),
        ynotchupper = ifelse(notch, data$notchupper, NA),
        notchwidth = notchwidth,
        alpha = data$alpha
      ),
      common
    ))
    box <- flip_data(box, flipped_aes)

    if (!is.null(data$outliers) && length(data$outliers[[1]] >= 1)) {
      outliers <- new_data_frame(list(
        y = data$outliers[[1]],
        x = data$x[1],
        colour = outlier.colour %||% data$colour[1],
        fill = outlier.fill %||% data$fill[1],
        shape = outlier.shape %||% data$shape[1],
        size = outlier.size %||% data$size[1],
        stroke = outlier.stroke %||% data$stroke[1],
        fill = NA,
        alpha = outlier.alpha %||% data$alpha[1]
      ), n = length(data$outliers[[1]]))
      outliers <- flip_data(outliers, flipped_aes)

      outliers_grob <- GeomPoint$draw_panel(outliers, panel_params, coord)
    } else {
      outliers_grob <- NULL
    }

    ggname("geom_boxplot", grobTree(
      outliers_grob,
      GeomSegment$draw_panel(whiskers, panel_params, coord),
      GeomCrossbar$draw_panel(box, fatten = fatten, panel_params, coord, flipped_aes = flipped_aes)
    ))
  },

  draw_key = draw_key_boxplot,

  default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5,
    alpha = NA, shape = 19, linetype = "solid"),

  required_aes = c("x|y", "lower|xlower", "upper|xupper", "middle|xmiddle", "ymin|xmin", "ymax|xmax")
)


test_that("define_means",{
  result <- define_means("variable_of_interest_name")
  expect_equal(result, 'variable_of_interest_name_level ~ 0*1')
})

test_that("define_means - with include_slopes true",{
  result <- define_means("variable_of_interest_name", TRUE)
  expect_equal(result, 'variable_of_interest_name_level ~ 0*1\nvariable_of_interest_name_slope ~ 1')
})

test_that("define_means - with include_slopes true and constrain_group_means_to_be_equal is true",{
  result <- define_means("variable_of_interest_name", TRUE, TRUE)
  expect_equal(result, 'variable_of_interest_name_level ~ 0*1\nvariable_of_interest_name_slope ~ c(SM,SM)*1')
})


#Read refence points from file reference_points.in

Read.reference.points<-function(dir=data.path,read.init.function=TRUE){
    if (read.init.function) Init.function()

    a<-scan(file.path(dir,"reference_points.in"),comment.char = "#",quiet = TRUE)
    b<-matrix(a,nrow=nsp,ncol=4,byrow=TRUE)
    colnames(b)<-c("Flim","Fpa","Blim","Bpa")
    rownames(b)<-sp.names[1:nsp]
    b
}

Read.reference.points.OP<-function(dir=data.path,read.init.function=TRUE){
    if (read.init.function) Init.function()

    a<-scan(file.path(dir,"OP_reference_points.in"),comment.char = "#",quiet = TRUE)
    b<-matrix(a,ncol=4,byrow=TRUE)
    colnames(b)<-c("Flim","Fpa","Blim","Bpa")
    rownames(b)<-sp.names[first.VPA:nsp]
    b
}


#!/usr/bin/env Rscript

source("/tmp/class-libs.R")

class_name = "2021 Spring Stat 20"
class_libs = c(
  "swirl", "2.4.5"
)
class_libs_install_version(class_name, class_libs)

devtools::install_github("mdbeckman/dcData", ref="56888a6")


#研究f_eject射出次数和频率
#分为single单次射出，即单脉冲内射出的次数
#还有eject，总体射出频率

#设定工作目录
setwd("D:/data")
library(xlsx)

#读取数据
#k2 <- read.xlsx("f_eject.xls", sheetName = "single_k4", header = TRUE)
#k4 <- read.xlsx("f_eject.xls", sheetName = "single_k4", header = TRUE)
k4 <- read.xlsx("f_eject.xls", sheetName = "single_k4", header = TRUE)
#k5 <- read.xlsx("f_eject.xls", sheetName = "single_k5", header = TRUE)

#保存数据
#pdf("f_k0.4.pdf")

#画图
#设定空间位置
par(fig=c(0,1,0,1), new = F)

##################################画图--占空比k为0.2#######################
plot(k4$fv, k4$X1.5, xaxs = "i", col = 0, xlab = "Voltage frequency (Hz)", ylab = "Frequency in cycle (Hz)", main = "Eject frequency in duty = 0.4", cex.lab = 1.2, cex.main = 1.5, xlim = c(0, 2050), ylim = c(0, 172))

#model1 = loess(k4$X1.5 ~ k4$fv, span = 0.8 , degree = 2)
lines(k4$fv, k4$X1.5,  col="#458B74", pch=21, lwd=2.5, type="b", lty=2)

#model2 = loess(k4$X27 ~ k4$fv, span = 0.8, degree = 2)
lines(k4$fv, k4$X27, col="#FF00FF", pch=22, lwd=2.5, type="b", lty=2)

#model3 = loess(k4$X54 ~ k4$fv, span = 0.8, degree = 2)
lines(k4$fv, k4$X54, col="#EE0000", pch=23, lwd=2.5, type="b", lty=2)

#model4 = loess(k4$X180 ~ k4$fv, span = 0.8, degree =2)
lines(k4$fv, k4$X180, col="#27408B", pch=24, lwd=2.5, type="b", lty=2)

#区域划线

legend("topleft", c("1.5nl/min", "27nl/min", "54nl/min", "180nl/min"), col = c("#458B74", "#FF00FF", "#EE0000", "#27408B"), pch = c(21, 22, 23, 24), lwd = 2, lty = 2, cex = 1.2, inset = .03, bty = "n")

###############画小图########
par(fig = c(0.22,0.98,0.2,0.98), new  = TRUE)

plot(k4$fv, k4$X1.5, xaxs = "i", col = 0, xlab = "0 ~ 250 Hz", ylab = "f_eject in cycle (Hz)", main = "", cex.lab = 1.2, cex.main = 1.5, xlim = c(0, 250), ylim = c(0, 172))

#model1 = loess(k4$X1.5 ~ k4$fv, span = 0.8 , degree = 2)
lines(k4$fv, k4$X1.5,  col="#458B74", lwd=2.5, type="l", lty=3)

#model2 = loess(k4$X27 ~ k4$fv, span = 0.8, degree = 2)
lines(k4$fv, k4$X27, col="#FF00FF", lwd=2.5, type="l", lty=3)

#model3 = loess(k4$X54 ~ k4$fv, span = 0.8, degree = 2)
lines(k4$fv, k4$X54, col="#EE0000", lwd=2.5, type="l", lty=3)

#model4 = loess(k4$X180 ~ k4$fv, span = 0.8, degree =2)
lines(k4$fv, k4$X180, col="#27408B", lwd=2.5, type="l", lty=3)

#legend("topright", c("1.5nl/min", "27nl/min", "54nl/min", "180nl/min"), col = c("#458B74", "#FF00FF", "#EE0000", "#27408B"), pch = c(21, 22, 23, 24), lwd = 2, lty = 2, cex = 1.2, bty = "n", inset = .03)

#画小小图
par(fig = c(0.35,0.95,0.4,0.95), new  = TRUE)

plot(k4$fv, k4$X1.5, xaxs = "i", col = 0, xlab = "0 ~ 75 Hz", ylab = "f_eject in cycle (Hz)", main = "", cex.lab = 1.2, cex.main = 1.5, xlim = c(0,  75), ylim = c(0, 172))

#text(260, 0.85, "射出时间在[0.3ms, 0.8ms]内", font = 2, col = "blue", cex = 1.3)

#model1 = loess(k4$X1.5 ~ k4$fv, span = 1.6 , degree = 2)
lines(k4$fv, k4$X1.5, col="#458B74", lwd=2, type="l")

#model2 = loess(k4$X27 ~ k4$fv, span = 1.6, degree = 2)
lines(k4$fv,  k4$X27, col="#FF00FF", lwd=2, type="l")

#model3 = loess(k4$X54 ~ k4$fv, span = 1.6, degree = 2)
lines(k4$fv, k4$X54, col="#EE0000", lwd=2, type="l")

#model4 = loess(k4$X180 ~ k4$fv, span = 1.6, degree =2)
lines(k4$fv, k4$X180, col="#27408B", lwd=2, type="l")

abline(h=40, lty = 3, col = "red", lwd = 2)
abline(h=1, lty = 3, col = "red", lwd = 2)

#legend("topright", c("1.5nl/min", "27nl/min", "54nl/min", "180nl/min"), col = c("#458B74", "#FF00FF", "#EE0000", "#27408B"), pch = c(21, 22, 23, 24), lwd = 2, lty = 2, cex = 1.2, bty = "n", inset = .03)

#dev.off()


#' Constructor function to create a likert class.
#'
#' This function will provide various summary statistics about a set of likert
#' items. The resulting object will have the following items:
#' \itemize{
#'    \item results this data frame will contain a column 'Item','Group' (if a
#'          grouping variable was specified,and a column for each level of the
#'          items (e.g. agree,disagree,etc.). The value within each cell corresponds
#'          to the percentage of responses for that level and group.
#'    \item items a copy of the original items data frame.
#'    \item grouping a copy of the original grouping vector.
#'    \item nlevels the number of levels used in the calculations.
#'    \item summary this data frame provides additional summary information. It
#'          will contain 'Item' and 'Group' columns similiar to the results data
#'          frame as well as a column 'low' corresponding to the sum of levels below
#'          neutral,a column 'high' corresponding to the sum of levels above
#'          neutral,and columns 'mean' and 'sd' corresponding to the mean and
#'          standard deviation,respectively,of the results. The numeric values
#'          are determined by as.numeric which will use the values of the factors.
#' }
#'
#' @export
#' @param items data frame containing the likert based items. The variables
#'        in the data frame should be factors.
#' @param grouping (optional) should the results be summarized by the given
#'        grouping variable.
#' @param nlevels number of possible levels. Only necessary if there are missing levels.
#' @return a likert class with the following elements: results,items,grouping,
#'        nlevels,and summary.
likert<-function(items,grouping=NULL,nlevels=length(levels(items[,1]))) {
	lowrange <- 1 : ceiling(nlevels / 2 - nlevels %% 2)
	highrange <- ceiling(nlevels / 2 + 1 ) : nlevels

	results<-data.frame()
	if(!is.null(grouping)) {
		results <- data.frame(
			Group=rep(unique(grouping),each=nlevels),
			Response=rep(1:nlevels,length(unique(grouping)))
			)
		for(i in 1:ncol(items)) {
			t <- as.data.frame(table(grouping, items[, i]))
			t <- cast(t, Var2 ~ grouping, value='Freq', add.missing=T)
			t <- apply(t, 2, FUN=function(x) { x / sum(x) * 100 } )
			t <- melt(t)
			results <- cbind(results, t[, 3])
		}

		names(results)[3:ncol(results)] <- names(items)

		results2 <- data.frame(Group=rep(unique(results$Group), each=ncol(items)),
                               Item=rep(names(items),length(unique(results$Group))),
                               low=rep(NA,ncol(items) * length(unique(results$Group))),
                               high=rep(NA,ncol(items) * length(unique(results$Group))),
                               mean=rep(NA,ncol(items) * length(unique(results$Group))),
                               sd=rep(NA,ncol(items) * length(unique(results$Group))) )
		for(g in unique(results$Group)) {
			results2[which(results2$Group == g),]$low <- apply(
				results[results$Response %in% lowrange &
					results$Group == g,3:ncol(results)],2,sum)
			results2[which(results2$Group == g),]$high <- apply(
				results[results$Response %in% highrange &
					results$Group == g,3:ncol(results)],2,sum)
			for(i in names(items)) {
				results2[which(results2$Group == g & results2$Item == i),'mean'] <-
					mean(as.numeric(items[which(grouping == g),i]),na.rm=T)
				results2[which(results2$Group == g & results2$Item == i),'sd'] <-
					sd(as.numeric(items[which(grouping == g),i]),na.rm=T)
			}
		}

		results$Response <- factor(results$Response, levels=1:nlevels,
                                   labels=levels(items[,i]))
		results <- melt(results, id=c('Group', 'Response'))
		results <- cast(results, Group + variable ~ Response)
		results <- as.data.frame(results)
		names(results)[2] <- 'Item'
	} else {
		results <- data.frame(Response=1:nlevels)
		means <- numeric()
		sds <- numeric()
		for(i in 1:ncol(items)) {
			t <- table(items[, i])
			t <- (t / sum(t) * 100)
			means[i] <- mean(as.numeric(items[, i]), na.rm=T)
			sds[i] <- sd(as.numeric(items[, i]), na.rm=T)
			results <- cbind(results, as.data.frame(t)[2])
			names(results)[ncol(results)] <- names(items)[i]
		}
		results <- as.data.frame(t(results))
		names(results) <- as.character(unique(items[!is.na(items[, 1]), 1]))
		results <- results[2:nrow(results),]
		results$Item <- row.names(results)
		row.names(results) <- 1:nrow(results)
		results2 <- data.frame(Item=results$Item,
                               low=apply(results[,lowrange],1,sum),
                               high=apply(results[,highrange],1,sum),
                               mean=means, sd=sds)
		#results=melt(results,id.vars='Item')
	}

	r <- list(results=results, items=items, grouping=grouping, nlevels=nlevels,
              summary=results2)
	class(r) <- 'likert'
	return(r)
}

#' Prints results table.
#'
#' @param x the likert class to print.
#' @export
#' @method print likert
#' @S3method print likert
print.likert<-function(x,...) {
	return(x$results)
}

#' Prints summary table.
#'
#' @param x the likert class to summarize.
#' @export
#' @method summary likert
#' @S3method summary likert
summary.likert<-function(x,...) {
	return(x$summary)
}

#' Plots a set of likert items.
#'
#' @param likert the likert items to plot
#' @param low.colour colour corresponding to the lowest value likert items
#' @param high.colour colour corresponding to the highest value likert items
#' @param neutral.colour colour for middle values. Only used when there are an odd
#'        number of levels.
#' @param text.size size or text labels
#' @param type whether to plot a bar or heat map graphic
#' @export
#' @method plot likert
#' @S3method plot likert
plot.likert<-function(likert,low.colour='blue',high.colour='red',
			neutral.colour='white',text.colour='white',text.size=2,
			type=c('bar','heat'),...)
{
	if(type[1] == 'bar') {
		plot.likert.bar(likert,low.colour=low.colour,high.colour=high.colour,
						neutral.colour=neutral.colour,text.size=text.size,...)
	} else {
		plot.likert.heat(likert,low.colour=low.colour,high.colour=high.colour,
						text.size=text.size,...)
	}
}


## compare DNAm values from ONT to Array values

filterRD<-function(data, threshold){
	return(data[which(data$called_sites/data$num_motifs_in_group > threshold),])
}

setwd("DNAmethylation/")

files<-list.files("Nanopolish/", pattern = "_methylation_frequency.tsv", recursive=TRUE)

ont.nano<-lapply(paste0("Nanopolish/",files), read.table, header = TRUE)

## only consider CpGs with at least 10 reads.
ont.nano.filt<-lapply(ont.nano, filterRD, 10)

## convert to GRanges
sam1<-GRanges(seqnames = ont.nano.filt[[1]]$chromosome, strand = "*", ranges = IRanges(start = ont.nano.filt[[1]]$start, end = ont.nano.filt[[1]]$end), DNAm = ont.nano.filt[[1]]$methylated_frequency, Reads = ont.nano.filt[[1]]$called_sites, Coverage = ont.nano.filt[[1]]$called_sites/ont.nano.filt[[1]]$num_motifs_in_group, nCpG = ont.nano.filt[[1]]$num_motifs_in_group)

sam2<-GRanges(seqnames = ont.nano.filt[[2]]$chromosome, strand = "*", ranges = IRanges(start = ont.nano.filt[[2]]$start, end = ont.nano.filt[[2]]$end), DNAm = ont.nano.filt[[2]]$methylated_frequency, Reads = ont.nano.filt[[2]]$called_sites, Coverage = ont.nano.filt[[2]]$called_sites/ont.nano.filt[[2]]$num_motifs_in_group, nCpG = ont.nano.filt[[2]]$num_motifs_in_group)

## focus in on target regions

allGuides<-read.csv("../Resources/SmokingEWAS/GuideRNAsFINAL.csv")

targetRegions<-cbind(aggregate(allGuides$hg38, by = list(allGuides$Chr), min), aggregate(allGuides$hg38, by = list(allGuides$Chr), max)$x)

targetGRanges<-GRanges(seqnames = paste0("chr", targetRegions[,1]), strand = "*", ranges = IRanges(start = targetRegions[,2], end = targetRegions[,3]))

inTargets1<-subsetByOverlaps(sam1, targetGRanges)
inTargets2<-subsetByOverlaps(sam2, targetGRanges)

### how many overlapping sites ?
sharedSites<-findOverlaps(inTargets1, inTargets2)
allCpGs<-union(inTargets1, inTargets2)

<<<<<<< HEAD

=======
>>>>>>> 638f31e2662b1d1498cd237a8809634e886c7425
aggregate(inTargets1$nCpG, by = list(as.character(seqnames(inTargets1))), sum)
aggregate(inTargets2$nCpG, by = list(as.character(seqnames(inTargets2))), sum)
aggregate(inTargets1$nCpG[queryHits(sharedSites)], by = list(as.character(seqnames(inTargets1[queryHits(sharedSites)]))), sum)

## first genome-wide correlations and error metrics
load("../Resources/SmokingEWAS/ArrayData.rda")

probeAnno<-read.table("/gpfs/mrc0/projects/Research_Project-MRC190311/References/EPICArray/EPIC.anno.GRCh38.tsv", header = TRUE, fill = TRUE)
probeAnno<-probeAnno[match(rownames(smokebetas), probeAnno$probeID),]
arrayData<-GRanges(seqnames = probeAnno$chrm, strand = "*", ranges = IRanges(start = probeAnno$start, end = probeAnno$end), smokebetas)

## count number of sites on EPIC array within these regions
epicOverlap<-subsetByOverlaps(arrayData, targetGRanges)
table(seqnames(epicOverlap))

## compare the spacing profile
<<<<<<< HEAD
intraDist<-NULL
for(i in 1:length(targetGRanges)){
	subCpGs<-allCpGs[which(as.character(seqnames(allCpGs)) == as.character(seqnames(targetGRanges)[i])),]
	intraDist<-c(intraDist, width(gaps(allCpGs)))
	## Need to add in distances between CpGs called in a single region
	## calculate average distance
}

=======
for(i in 1:length(targetGRanges)){
	subCpGs<-allCpGs[which(as.character(seqnames(allCpGs)) == as.character(seqnames(targetGRanges)[i]),]
	width(gaps(allCpGs))

}

>>>>>>> 638f31e2662b1d1498cd237a8809634e886c7425
overlapArray1<-findOverlaps(sam1, arrayData)
overlapArray2<-findOverlaps(sam2, arrayData)

## need to double check which sample is which.
pdf("Plots/ScatterplotDNAmArrayvsNanopolishGenomewide.pdf", width = 10, height = 5)
par(mfrow = c(1,2))
plot(sam1$DNAm[queryHits(overlapArray1)], arrayData$"Non-Smoker"[subjectHits(overlapArray1)], pch = 16, xlab = "ONT", ylab = "EPIC array")
mtext(side = 3, line = 0, adj = 1, paste0("cor = ", signif(cor(sam1$DNAm[queryHits(overlapArray1)], arrayData$"Non-Smoker"[subjectHits(overlapArray1)]),3), "; n = ", length(overlapArray1), " sites"))

plot(sam2$DNAm[queryHits(overlapArray2)], arrayData$Smoker[subjectHits(overlapArray2)], pch = 16, xlab = "ONT", ylab = "EPIC array")
mtext(side = 3, line = 0, adj = 1, paste0("cor = ", signif(cor(sam2$DNAm[queryHits(overlapArray2)], arrayData$Smoker[subjectHits(overlapArray2)]),3), "; n = ", length(overlapArray2), " sites"))
dev.off()

## cor as a function of read depth
thresholds<-seq(5,100,1)
errorMetrics<-matrix(data = NA, nrow = length(thresholds), ncol = 7)
errorMetrics[,1]<-thresholds
rowNum<-1
for(rdThres in thresholds){
	keep<-which(sam2$Coverage[queryHits(overlapArray2)] > rdThres)
	r1<-cor(sam2$DNAm[queryHits(overlapArray2)[keep]], arrayData$Smoker[subjectHits(overlapArray2)[keep]])
	rmse1<-sqrt(median((sam2$DNAm[queryHits(overlapArray2)[keep]] - arrayData$Smoker[subjectHits(overlapArray2)[keep]])^2))
	ncpg1<-length(keep)

	keep<-which(sam1$Coverage[queryHits(overlapArray1)] > rdThres)
	r2<-cor(sam1$DNAm[queryHits(overlapArray1)[keep]], arrayData$"Non-Smoker"[subjectHits(overlapArray1)[keep]])
	rmse2<-sqrt(median((sam1$DNAm[queryHits(overlapArray1)[keep]] - arrayData$"Non-Smoker"[subjectHits(overlapArray1)[keep]])^2))
	ncpg2<-length(keep)

	errorMetrics[rowNum,2:7]<-c(r1, rmse1, ncpg1, r2, rmse2, ncpg2)
	rowNum<-rowNum+1
}

pdf("Plots/LineGraphArrayONTComparisionAgainstReadDepth.pdf", width = 10, height = 5)
par(mfrow = c(1,2))
plot(errorMetrics[,1], errorMetrics[,2], xlab = "RD Threshold", ylab = "r", type = "l", lwd = 2, ylim = c(0.8,1), xlim = c(0,45))
lines(errorMetrics[,1], errorMetrics[,5], lwd = 2)

plot(errorMetrics[,1], errorMetrics[,3], xlab = "RD Threshold", ylab = "RMSE", type = "l", lwd = 2, ylim = c(0,0.18), xlim = c(0,45))
lines(errorMetrics[,1], errorMetrics[,6], lwd = 2)
dev.off()

## as a function of DNAm level

errorMetrics.dnam<-matrix(data = NA, ncol = 7, nrow = 10)
errorMetrics.dnam[,1]<-seq(0.05, 0.95, 0.1)

dnamFilter<-cut(arrayData$Smoker[subjectHits(overlapArray1)], breaks = seq(0,1,0.1))
rowNum<-1
for(each in levels(dnamFilter)){
	keep<-which(dnamFilter == each)
	r1<-cor(sam2$DNAm[queryHits(overlapArray2)[keep]], arrayData$Smoker[subjectHits(overlapArray2)[keep]])
	rmse1<-sqrt(median((sam2$DNAm[queryHits(overlapArray2)[keep]] - arrayData$Smoker[subjectHits(overlapArray2)[keep]])^2))
	ncpg1<-length(keep)
	errorMetrics.dnam[rowNum,2:4]<-c(r1, rmse1,ncpg1)

	rowNum<-rowNum+1
}

dnamFilter<-cut(arrayData$"Non-Smoker"[subjectHits(overlapArray2)], breaks = seq(0,1,0.1))
rowNum<-1
for(each in levels(dnamFilter)){
	keep<-which(dnamFilter == each)
	r2<-cor(sam1$DNAm[queryHits(overlapArray1)[keep]], arrayData$"Non-Smoker"[subjectHits(overlapArray1)[keep]])
	rmse2<-sqrt(median((sam1$DNAm[queryHits(overlapArray1)[keep]] - arrayData$"Non-Smoker"[subjectHits(overlapArray1)[keep]])^2))
	ncpg2<-length(keep)

	errorMetrics.dnam[rowNum,5:7]<-c(r2, rmse2,ncpg2)
		rowNum<-rowNum+1
}

pdf("Plots/LineGraphArrayONTComparisionAgainstDNAmLevel.pdf", width = 10, height = 5)
par(mfrow = c(1,2))
plot(errorMetrics.dnam[,1], errorMetrics.dnam[,2], xlab = "DNAm mean", ylab = "r", type = "l", lwd = 2, ylim = c(0.8,1))
lines(errorMetrics.dnam[,1], errorMetrics.dnam[,5], lwd = 2)

plot(errorMetrics.dnam[,1], errorMetrics.dnam[,3], xlab = "DNAm mean", ylab = "RMSE", type = "l", lwd = 2, ylim = c(0,0.18))
lines(errorMetrics.dnam[,1], errorMetrics.dnam[,6], lwd = 2)
dev.off()


#Comparing R2 and R2 1:1 for Mike.
rm(list=ls())
source('paths.r')
source('NEFI_functions/zero_truncated_density.r')

#set output path.----
output.path <- 'test.png'

#Load calibration data.----
d <- readRDS(NEON_dmilti.ddirch_analysis_summary.path)

#get calibration/validation values by group.----
cal.mu.a <- d$calibration$cal.stat.predictable.sum$rsq
val.mu.a <- d$validation$site.stat.predictable.sim$rsq
cal.mu.b <- d$calibration$cal.stat.predictable.sum$rsq.1
val.mu.b <- d$validation$site.stat.predictable.sim$rsq.1
names(cal.mu.a) <- rownames(d$calibration$cal.stat.predictable.sum)
names(cal.mu.b) <- rownames(d$calibration$cal.stat.predictable.sum)

#png save line.----
png(filename=output.path,width=9,height=6,units='in',res=300)

#global plot settings.----
par(mfrow = c(1,2), mar = c(5,4,2,1), oma = c(1,1,1,1))
limx <- c(0,1)
limy <- c(0, 5.1)
trans <- 0.2 #shading transparency.
o.cex <- 1.2 #outer label size.
cols <- c('purple','cyan','yellow')

#Calibration and Validation rsq ~ function/phylo scale.----
x <- 1:length(cal.mu.a)
limy <- c(0,max(cal.mu.a)*1.1)
plot(cal.mu.a ~ x, cex = 2.5, ylim = limy, pch = 16, ylab = NA, xlab = NA, bty='l', xaxt = 'n', yaxs='i', las = 1, lwd = 0)
#arrows(x, lev.mu - lev.se, x1 = x, y1 = lev.mu + lev.se, length=0.00, angle=90, code=3, col = 'black')
lines(x, cal.mu.a, lty = 2)
lines(x, val.mu.a, lty = 2)
points(val.mu.a ~ x, cex = 2.5, pch = 16, col = 'gray')
mtext(expression(paste("Site-Level R"^"2")), side = 2, line = 2.5, cex = o.cex)
axis(1, labels = F)
text(x=x+0.05, y = limy[1] - limy[2]*0.1, labels= names(cal.mu.a), srt=45, adj=1, xpd=TRUE, cex = 1.1)
#legend
legend(x = 1, y = 0.1, legend = c('calibration','validation'), col =c('black','gray'), bty = 'n', pch = 16, pt.cex = 2.5, cex = 1.2)
mtext('(a)', side = 3, adj = 0.95, line = -2)

#Calibration and Validation RMSE ~ function/phylo scale.----
x <- 1:length(cal.mu.b)
limy <- c(min(val.mu.b)*1.1,max(cal.mu.b)*8)
plot(cal.mu.b ~ x, cex = 2.5, ylim = limy, pch = 16, ylab = NA, xlab = NA, bty='l', xaxt = 'n', yaxs='i', las = 1, lwd = 0)
#arrows(x, lev.mu - lev.se, x1 = x, y1 = lev.mu + lev.se, length=0.00, angle=90, code=3, col = 'black')
lines(x, cal.mu.b, lty = 2)
lines(x, val.mu.b, lty = 2)
points(val.mu.b ~ x, cex = 2.5, pch = 16, col = 'gray')
mtext(expression(paste("Site-Level R"^"2"," 1:1")), side = 2, line = 2.5, cex = o.cex)
axis(1, labels = F)
text(x=x+0.05, y = limy[1] - abs(limy[1])*0.1, labels= names(cal.mu.a), srt=45, adj=1, xpd=TRUE, cex = 1.1)
mtext('(b)', side = 3, adj = 0.95, line = -2)

#end plot.----
dev.off()


#!/usr/bin/env Rscript

#===========================================================
# R script for finding the significant contact count distribution for individual peaks

#Author: Sourya Bhattacharyya
#Vijay-Ay lab, LJI

# usage: Rscript ContactCountDistr.r $PeakFile $InteractionFile $PlotFile $OutText
#===========================================================

library(data.table)

options(scipen = 999)
options(datatable.fread.datatable=FALSE)

args <- commandArgs(TRUE)

PeakFile <- args[1]
InteractionFile <- args[2]
PlotFile <- args[3]
OutText <- args[4]

# peaks in the input peak file (PD = PeakData)
# PD <- read.table(PeakFile, header=FALSE)
PD <- data.table::fread(PeakFile, header=FALSE)

# peaks from the interaction file (PI = peaks from interactions)
# PI <- read.table(InteractionFile, header=FALSE)
PI <- data.table::fread(InteractionFile, header=FALSE)

# significant contact count (filtered according to Q value) for individual peaks
count <- c()

for (i in (1:nrow(PD))) {
	chr1 <- as.character(PD[i,1])
	s1 <- as.integer(PD[i,2])
	e1 <- as.integer(PD[i,3])

	# cat(sprintf("\n\n ===>>> checking chr1: %s s1: %s e1: %s \n ", chr1, s1, e1))

	# overlap between peaks in the peak file and in the interaction file
	# comparison with respect to three columns
	# note: use of '&' operator
	c <- 0

	# set of indices matching with chr1
	idx <- which(PI[,1] == chr1)

	# cat(sprintf("\n idx: %s \n length of idx: %s \n ", idx, length(idx)))

	if (length(idx) > 0) {
		for (j_idx in (1:length(idx))) {
			j <- idx[j_idx]

			chr2 <- as.character(PI[j,1])
			s2 <- as.integer(PI[j,2])
			e2 <- as.integer(PI[j,3])

			# cat(sprintf("\n --- individual  chr1: %s  s1: %s  e1: %s chr2: %s s2: %s e2: %s \n ", chr1, s1, e1, chr2, s2, e2))

			if ((!is.na(s1)) & (!is.na(e1)) & (!is.na(s2)) & (!is.na(e2))) {
				if ((s2 <= s1) & (e2 >= e1)) {
					c <- c + 1
				} else if ((s2 >= s1) & (e2 <= e1)) {
					c <- c + 1
				} else if ((s2 <= s1) & (e2 >= s1)) {
					c <- c + 1
				} else if ((s2 <= e1) & (e2 >= e1)) {
					c <- c + 1
				}
			}
		}
	}
	count[i] <- c
}

# dump the original peaks vs significant contact count in a text file
write.table(cbind(PD[,1:3], count), OutText, row.names = FALSE, col.names = FALSE, sep = "\t", quote=FALSE, append=FALSE)

# first sort the count vector and then draw the frequency distribution
pdf(PlotFile, width=14, height=10)
plot(sort(count, decreasing=TRUE), type = "o", cex=0.5, col="red", xlab="Peak counter", ylab="Contact count (filtered)")
title(sub('\\.pdf$', '', basename(PlotFile)))
dev.off()


# Merge EU DEM with GLSDEM, preferring EU DEM
library(raster)

GLSDir = "../../userdata/dem/glsdem"
EUDir = "../../userdata/dem/eeadem"
MergedDir = "../../userdata/dem/merged"
files = c("pv-height.tif", "pv-aspect.tif", "pv-tpi.tif", "pv-slope.tif")
GLSFiles = paste0(GLSDir, "/", files)
EUFiles = paste0(EUDir, "/", files)
MergedFiles = paste0(MergedDir, "/", files)

for (i in 1:length(files))
{
    if (!file.exists(MergedFiles[i]))
        raster::merge(raster(EUFiles[i]), raster(GLSFiles[i]), filename=MergedFiles[i])
}


# Converts a time to the previous time in whole minutes. Eg: 15:41:40 goes to 15:41:00.
wholemin <- function(x) trunc(x, units="minutes")


fs <- dir("Results")
fsfull <- dir("Results",full.names = T)

library(data.table)
library(magrittr)
library(tidyr)

hehe <- lapply(split(fsfull, substr(fs,1,1) == "r"), function(fss) {
  lapply(fss, fread) %>% rbindlist
})

hehe$`FALSE`$test <- paste0("test",2:11)

comp <- merge(hehe$`FALSE`,hehe$`TRUE`)

comp_for_plotting <- comp[,.(Julia = mean(julia_timings), R = mean(elapsed)), test] %>%
  gather(key = jr, value = timings, -test)

library(ggplot2)

comp_for_plotting %>% ggplot +
  geom_bar(aes(fill = jr,x = test, y = timings),
           stat = "identity", position = "dodge")

library(data.table)
system.time(lapply(
  file.path(dir("../../data/InitialTrainingSet_rev1/",full.names = T),"ASDI/asdifpwaypoint.csv"),
  function(f) {
    fst::write.fst(fread(f),paste0(f,".fst"), compress=100)
    gc()
  }
))

library(data.table)
library(future)
plan(multiprocess)

system.time(future_lapply(
  file.path(dir("../../data/InitialTrainingSet_rev1/",full.names = T),"ASDI/asdifpwaypoint.csv"),
  function(f) {
    fst::write.fst(fread(f),paste0(f,".fst"), compress=100)
    gc()
  }
))

library(magrittr)
system.time(a <- future_lapply(
  file.path(dir("../../data/InitialTrainingSet_rev1/",full.names = T),"ASDI/asdifpwaypoint.csv.fst"),
  fst::read.fst, as.data.table = T)
 %>% rbindlist)

system.time(a <- future_lapply(
  file.path(dir("../../data/InitialTrainingSet_rev1/",full.names = T),"ASDI/asdifpwaypoint.csv"),
  fread)
%>% rbindlist)


#!/usr/bin/env Rscript
#
#  indicator_species.r - R slave for indicator species analysis with R package indicspecies
#
#  Version 1.0.0 (July, 16, 2016)
#
#  Copyright (c) 2016-- Lela Andrews
#
#  This software is provided 'as-is', without any express or implied
#  warranty. In no event will the authors be held liable for any damages
#  arising from the use of this software.
#
#  Permission is granted to anyone to use this software for any purpose,
#  including commercial applications, and to alter it and redistribute it
#  freely, subject to the following restrictions:
#
#  1. The origin of this software must not be misrepresented; you must not
#     claim that you wrote the original software. If you use this software
#     in a product, an acknowledgment in the product documentation would be
#     appreciated but is not required.
#  2. Altered source versions must be plainly marked as such, and must not be
#     misrepresented as being the original software.
#  3. This notice may not be removed or altered from any source distribution.
#

## Recieve input files from bash
args <- commandArgs(TRUE)
mapfile=(args[1])
biomfile=(args[2])
factor=(args[3])
outdir=(args[4])
perms0=(args[5])
perms <- as.integer(perms0)

## Load libraries
library(indicspecies)
options(width=300)

## Read in data
map <- read.csv(mapfile, sep="\t", header=TRUE)
biom <- read.csv(biomfile, sep="\t", header=TRUE)
f1 <- map[,factor]

## Run indval and print to screen
invalperms <- paste("\n********************************\nIndicator value analysis summary\n(", perms, " permutations, uncorrected for multiple testing):", sep="")
writeLines(invalperms)
indval = multipatt(biom, f1, control=how(nperm=perms))
summary(indval)

## Run coverage and print to screen
writeLines("\n********************************\nCoverage (IndVal):")
coverage(biom, indval)

## Run phi and print to screen
phiperms <- paste("\n********************************\nPearson's phi coefficient of association summary\n(", perms, " permutations, uncorrected for multiple testing):", sep="")
writeLines(phiperms)
phi = multipatt(biom, f1, func="r.g", control=how(nperm=perms))
summary(phi)

## Run coverage and print to screen
writeLines("\n********************************\nCoverage (Phi):")
coverage(biom, phi)

## Read all indval results to variable
indval.all <- indval$sign

## Extract p-values to separate vector
indval.all.pvals <- indval.all[,"p.value"]

## Correct p-values (FDR) and bind the result to original output
fdr.p.value <- p.adjust(indval.all.pvals, method="fdr")
indval.all.fdr <- cbind(indval.all, fdr.p.value)

## Omit NA values and print only those with p <= 0.05
attach(indval.all.fdr)
indval.all.fdr.nona.sort <- indval.all.fdr[order(fdr.p.value, p.value, na.last=NA),]
indvalfdrperms <- paste("\n********************************\nIndVal results with FDR corrections\n(only valid p-values shown, ", perms, " permutations):\n", sep="")
writeLines(indvalfdrperms)
indval.all.fdr.nona.sort
detach(indval.all.fdr)

## Repeat FDR correction and NA omission for Phi output
phi.all <- phi$sign
phi.all.pvals <- phi.all[,"p.value"]
fdr.p.value <- p.adjust(phi.all.pvals, method="fdr")
phi.all.fdr <- cbind(phi.all, fdr.p.value)
attach(phi.all.fdr)
phi.all.fdr.nona.sort <- phi.all.fdr[order(fdr.p.value, p.value, na.last=NA),]
phivalfdrperms <- paste("\n********************************\nPhi results with FDR corrections\n(only valid p-values shown, ", perms, " permutations):\n", sep="")
writeLines(phivalfdrperms)
phi.all.fdr.nona.sort

## Blank line at end of file
writeLines("")
## End
q()


REBOL [
	System: "REBOL [R3] Language Interpreter and Run-time Environment"
	Title: "REBOL Graphics - SHAPE commands"
	Rights: {
		Copyright 2012 REBOL Technologies
		REBOL is a trademark of REBOL Technologies
	}
	License: {
		Licensed under the Apache License, Version 2.0.
		See: http://www.apache.org/licenses/LICENSE-2.0
	}
	Name: shape
	Type: extension
	Exports: none
	Note: "Run make-host-ext.r to convert"
]

;don't change order of already defined words unless you know what you are doing

words: [
	;arc
	negative
	positive
	small
	large
]

;temp hack - will be removed later
init-words: command [
	words [block!]
]

init-words words

;please alphabetize the order of commands so it easier to lookup things

arc: command [
	"Draws an elliptical arc from the current point."
	end-point [pair!]
	radius [pair!]
	angle [number!]
	'sweep-flag [word!] "The arc will be drawn in POSITIVE or NEGATIVE angle direction"
	'arc-flag [word!] "User SMALL or LARGE arc sweep"
]

arc': command [
	"Draws an elliptical arc from the current point.(uses relative coordinates)"
	end-point [pair!]
	radius [pair!]
	angle [number!]
	'sweep-flag [word!] "The arc will be drawn in POSITIVE or NEGATIVE angle direction"
	'arc-flag [word!] "User SMALL or LARGE arc sweep"
]

close: command [
	"Closes previously defined set of lines in the SHAPE block."
]

curv: command [
	"Draws a cubic Bezier curve or polybezier using two points."
	points [block!] "Block of point pairs (2nd control point, end point)"
]

curv': command [
	"Draws a cubic Bezier curve or polybezier using two points.(uses relative coordinates)"
	points [block!] "Block of point pairs (2nd control point, end point)"
]

curve: command [
	"Draws a cubic Bezier curve or polybezier using three points."
	points [block!] "Block of point triplets (1st control point, 2nd control point, end point)"
]

curve': command [
	"Draws a cubic Bezier curve or polybezier using three points.(uses relative coordinates)"
	points [block!] "Block of point triplets (1st control point, 2nd control point, end point)"
]

hline: command [
	"Draws a horizontal line from the current point."
	end-x [number!]
]

hline': command [
	"Draws a horizontal line from the current point.(uses relative coordinates)"
	end-x [number!]
]

line: command [
	"Draws a line from the current point through the given points."
	points [pair! block!]
]

line': command [
	"Draws a line from the current point through the given points.(uses relative coordinates)"
	points [pair! block!]
]

move: command [
	"Set's the starting point for a new path without drawing anything."
	point [pair!]
]

move': command [
	"Set's the starting point for a new path without drawing anything.(uses relative coordinates)"
	point [pair!]
]

qcurv: command [
	"Draws a quadratic Bezier curve from the current point to end point."
	end-point [pair!]
]

qcurv': command [
	"Draws a quadratic Bezier curve from the current point to end point.(uses relative coordinates)"
	end-point [pair!]
]

qcurve: command [
	"Draws a quadratic Bezier curve using two points."
	points [block!] "Block of point pairs (control point, end point)"
]

qcurve': command [
	"Draws a quadratic Bezier curve using two points.(uses relative coordinates)"
	points [block!] "Block of point pairs (control point, end point)"
]

vline: command [
	"Draws a vertical line from the current point."
	end-y [number!]
]

vline': command [
	"Draws a vertical line from the current point.(uses relative coordinates)"
	end-y [number!]
]


#' @name afrilandcover
#' @aliases afrilandcover
#' @title landcover raster for Africa, categorical, 20km resolution
#'
#' @description a \code{raster} object storing the majority landcover in 2019 for all 20km squares in Africa.
#' Categorical, 20km resolution from [MODIS](https://lpdaac.usgs.gov/products/mcd12c1v006/).
#' Cell values are numeric, landcover type names are stored in Raster Attribute Table (RAT) that can be accessed via `levels(afrilandcover)`
#' See data-raw/afrilearndata-creation.R for how the data object is created.
#'
#' @format Formal class 'raster';
#'
#' Geographical coordinates WGS84 datum (CRS EPSG 4326)
#'
#' @seealso
#' Friedl, M., D. Sulla-Menashe. MCD12C1 MODIS/Terra+Aqua Land Cover Type Yearly L3 Global 0.05Deg CMG V006. 2015, distributed by NASA EOSDIS Land Processes DAAC, https://doi.org/10.5067/MODIS/MCD12C1.006. Accessed 2021-06-07.#'
#' @source \url{https://lpdaac.usgs.gov/products/mcd12c1v006/}
#' @docType data
#' @keywords datasets sf
#' @examples
#' if (requireNamespace("raster", quietly = TRUE)) {
#'   library(raster)
#'   data(afrilandcover)
#'   # or
#'   filename <- system.file("extdata","afrilandcover.grd", package="afrilearndata", mustWork=TRUE)
#'   afrilandcover <- raster::raster(filename)
#'
#'   plot(afrilandcover)
#' }
#'
#' # interactive plotting with mapview
#' if (requireNamespace("mapview", quietly = TRUE) &
#'     requireNamespace("rgdal", quietly = TRUE)) {
#'   library(mapview)
#'   mapview(afrilandcover,
#'           att="landcover",
#'           col.regions=levels(afrilandcover)[[1]]$colour)
#' }
#'
#'
"afrilandcover"


\docType{data}
\name{mtautos}
\alias{mtautos}
\title{Pruebas de ruta de automóviles de Motor Trend}
\format{Un data.frame con 32 filas y 12 columnas
\describe{
\item{millas}{millas por galón de Estados Unidos}
\item{cilindros}{número de cilindros}
\item{cilindrada}{suma del volumen útil de todos los cilindros del motor en pulgadas cúbicas}
\item{caballos}{caballos de fuerza brutos}
\item{eje}{relación del eje de transmisión trasero}
\item{peso}{peso (1000 libras)}
\item{velocidad}{tiempo en recorrer 1/4 de milla}
\item{forma}{forma del motor (en V o en línea)}
\item{transmision}{tipo de transmisión (0 = automático, 1 = manual)}
\item{cambios}{número de cambios de la caja de cambios}
\item{carburadores}{número de carburadores}
}}
\usage{mtautos}
\description{Los datos fueron extraídos de la revista Motor Trend de Estados Unidos de 1974, y tiene datos de consumo de combustible y 10 aspectos de diseño y rendimiento de automóviles para 32 automóviles (modelos de 1973-1974).}
\keyword{datasets}


#ggplot2のインストール
install.packages("ggplot2")

library(ggplot2)

#data.frameの要素が数字の場合はグラフが作成できないので
#それぞれa, b, cに名前を変更する

sekkaku <- data.frame("a" <- tsuchinoko, "b" <- sabaiteiku,
"c"<- Awajishima, "x" <- xx)

#ggplotでグラフを作成する
ggplot(sekkaku, aes(x)) +
  geom_line(aes(y = a, colour = "3.4")) +
  geom_line(aes(y = b, colour = "3.5")) +
  geom_line(aes(y = c, colour = "3.55"))


library(jpeg)
library(png)
#a="/home/xiaoyh/inmic/inmic/static/image/phylo_tree.jpg"
#a="/home/xiaoyh/source/graphlan.png"
a="1.jpg"
    x <- readJPEG(a)
    dimx <- dim(x)
    n <- dimx[1]*dimx[2]
    r <- x[1:n]
    g <- x[(n+1):(2*n)]
    b <- x[(2*n+1):(3*n)]
    ps <- 10; ps <- dimx[1]*(ps-1) + ps  # 背景取值，ps为左上到右下角的像素，5。按情况修改
    tv <-  0.1                      # tv为容差范围，0-1取值，越小越精确
    sel <- abs(r-r[ps])<tv & abs(g-g[ps])<tv & abs(b-b[ps])<tv
    alpha <- rep(1, n)
    alpha[sel] <- 0
    x <- array(c(x, alpha), dim=c(dimx[1:2], 4))
    writePNG(x, "2.png")


suppressMessages(library(edgeR))
options(scipen=999)

x <- read.delim('/data/./edgeR_matfile.csv', sep=',', stringsAsFactors=TRUE)

x$strain <- factor(x$strain)

x$cuminic_acid <- factor(x$cuminic_acid)

x$iptg <- factor(x$iptg)

x$timepoint <- factor(x$timepoint)

x$vanillic_acid <- factor(x$vanillic_acid)

x$xylose <- factor(x$xylose)

drops <- c('strain', 'cuminic_acid', 'iptg', 'timepoint', 'vanillic_acid', 'xylose')
counts <- x[, !(names(x) %in% drops)]
t_cts <- t(counts)
t_cts[is.na(t_cts)] <- 0

#colnames(t_cts) <- x$filename

group <- factor(c(1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 8, 7, 1, 2, 3, 4, 5, 6, 8, 7, 1, 2, 3, 4, 5, 6, 8, 7, 9, 10, 11, 12, 12, 12, 12, 9, 13, 14, 15, 15, 15, 15, 9, 13, 14, 11))

y <- DGEList(counts=t_cts, group=group)
y <- calcNormFactors(y)
design <- model.matrix(~0 + group)
keep <- rowSums(cpm(y[, c(7, 15, 23, 31, 40, 47)]) >1) >= 6
y <- y[keep, ,]
y <- estimateDisp(y, design)
fit <- glmQLFit(y, design)
qlf <- glmQLFTest(fit, contrast=c(0,0,0,0,0,0,1,0,0,0,0,0,-1,0,0))
tab <- topTags(qlf, n=Inf)
write.table(tab, file="Bacillussubtilis168Marburg_False_False_0_False_False-vs-Bacillussubtilis168Marburg_False_False_18_True_False.txt")