write.growth.out<-T

dat<-Read.summary.data(read.init.function=F)

#clupeids<-c(2,3)      # Herring and sprat
clupeids<-c(3)      # sprat only
N<-subset(dat, Species.n %in% clupeids  & Quarter==1 )

clu.N<-aggregate(N~Year,data=N,sum)

g<-subset(dat,select=c(-M1,-M2,-M,-F,-Z,-N,-C.hat,-C.obs,-Yield,-CWsum,-propmat,-ration,-Lsea,-BIO,-SSB,-N.bar))
g$cohort<-g$Year-g$Age
head(g)

# Species Year Quarter Species.n Age     N.bar  west   weca
#1     Cod 1974       1         1   1 394432.00 0.065 0.0060  27920.4     0.00

g<-g[order(g$Species.n,g$cohort,g$Year,g$Quarter),]
ll<-dim(g)[1]
west1<-c(g$west[2:(ll)],0)
west2<-c(g$west[3:(ll)],0,0)
west3<-c(g$west[4:(ll)],0,0,0)
west4<-c(g$west[5:(ll)],0,0,0,0)
g$cohort4<-c(g$cohort[5:(ll)],0,0,0,0)

g<-data.frame(g,west1=west1,west2=west2,west3=west3,west4=west4)
g[g$Age==0,'west4']<-g[g$Age==0,'west2']
g[g$Age==0,'west3']<-g[g$Age==0,'west2']

g$growth1<-g$west1-g$west
g$growth2<-g$west2-g$west
g$growth3<-g$west3-g$west
g$growth4<-g$west4-g$west
head(g,20)

head(subset(g,Age<2 & Species.n==3 ),20)

g<-subset(g,cohort==cohort4 & west4>0 )

head(subset(g,Age<2 & Species.n==3 ),20)

g<-merge(clu.N,g)
g<-g[order(g$Species.n,g$cohort,g$Year,g$Quarter),]
g$age<-g$Age+(g$Quarter-1)*0.25

head(g,20)
if (F) {

  cleanup()
  a<-by(g,g$Species.n,function(g){
  trellis.device(height=10,width=10,pointsize=8)
  tit<-paste(g[1,'Species'],', mean weight by cohort',sep='')
  print(xyplot(west*1000~age| paste(cohort),data=g,layout = c(6, 6),subset=(cohort>=1972 & cohort<=2006 ) ,
    main=tit, ylab='Weight in the stock (gram)',
     panel=function(x,y) {
      panel.xyplot(x,y,col=1 ,pch=1,type='p')
      panel.loess(x,y, span=1)
      panel.lmline(x,y,col=2)
    }
  ))
  })

   cleanup()
  a<-by(g,g$Species.n,function(g){
  trellis.device(height=10,width=10,pointsize=8)
  tit<-paste(g[1,'Species'],', mean weight by cohort, Q1',sep='')
  print(xyplot(west*1000~age| paste(cohort),data=g,layout = c(6, 6),subset=(cohort>=1972 & cohort<=2006 & Quarter==1) ,
    main=tit, ylab='Weight in the stock (gram)',
     panel=function(x,y) {
      panel.xyplot(x,y,col=1 ,pch=1,type='p')
      panel.loess(x,y, span=1)
      panel.lmline(x,y,col=2)
    }
  ))
  })

   cleanup()
  a<-by(g,g$Species.n,function(g){
  trellis.device(height=10,width=10,pointsize=8)
  tit<-paste(g[1,'Species'],', Annual Growth by cohort, Q1',sep='')
  print(xyplot(growth4*1000~Age| paste(cohort),data=g,layout = c(6, 6),subset=(cohort>=1972 & cohort<=2006 & Quarter==1) ,
    main=tit, ylab='Growth (gram)',
     panel=function(x,y) {
      panel.xyplot(x,y,col=1 ,pch=1,type='p')
      panel.loess(x,y, span=1)
      panel.lmline(x,y,col=2)
    }
  ))
  })

   cleanup()
  a<-by(g,g$Species.n,function(g){
  trellis.device(height=10,width=10,pointsize=8)
  tit<-paste(g[1,'Species'],', Growth by cohort',sep='')
  print(xyplot(growth4*1000~age| paste(cohort),data=g,layout = c(6, 6),subset=(cohort>=1972 & cohort<=2006) ,
    main=tit, ylab='Weight in the stock (gram)',
     panel=function(x,y) {
      panel.xyplot(x,y,col=1 ,pch=1,type='p')
      panel.loess(x,y, span=1)
      panel.lmline(x,y,col=2)
    }
  ))
  })

  cleanup()
  a<-by(g,g$Species.n,function(g){
  trellis.device(height=10,width=10,pointsize=8)
  tit<-paste(g[1,'Species'],', Growth versus clupeid abundance, Q1',sep='')
  print(xyplot(growth4*1000~N/1000000 |paste( Species,Age),data=g,layout = c(3,3),subset=( Quarter==1) ,
    main=tit, ylab='Annual growth (gram)',xlab='Clupeid abundance (10^9)',
     panel=function(x,y) {
      panel.xyplot(x,y,col=1 ,pch=1,type='p')
      panel.loess(x,y, span=1)
      panel.lmline(x,y,col=2)
    }
  ))
  })

  cleanup()
  a<-by(g,g$Species.n,function(g){
  trellis.device(height=10,width=10,pointsize=8)
  tit<-paste(g[1,'Species'],', Growth versus clupeid abundance, Q1',sep='')
  print(xyplot(growth4*1000~N/1000000 |paste( Species,Age),data=g,layout = c(3,3),subset=( Quarter==1 | (Age==0 & Quarter==3)) ,
    main=tit, ylab='Annual growth,(half yearly for 0-groups (gram)',xlab='Clupeid abundance (10^9)',
     panel=function(x,y) {
      panel.xyplot(x,y,col=1 ,pch=1,type='p')
      panel.loess(x,y, span=1)
      panel.lmline(x,y,col=2)
    }
  ))
  })
}

gg<-subset(g,Quarter==1 | (Quarter==3 & Age==0))

#dat<-subset(gg,Species.n==3 & Age==4)
cleanup()
aa<-by(gg,list(gg$Age,gg$Species.n),function(dat) {

  m<-lm(west4~west+N,data=dat)
  newplot(nox=2,noy=2,dev='screen')
  plot(m,main=paste("sp:",dat[1,'Species.n']," Age:",dat[1,'Age']))

  newplot(nox=2,noy=2,dev='screen')
  plot(dat$N,dat$west4,xlab='Clupeid abundance',ylab="W(t+1)",main=paste("sp:",dat[1,'Species.n']," Age:",dat[1,'Age']))
  plot(dat$N,dat$growth4,xlab='Clupeid abundance',ylab="growth, W(t+1)-w(t)")
  plot(dat$west,dat$west4,xlab='W(t)',ylab="W(t+1)")
  abline(a=0,b=1,col='red')

  pred.w.plim <- predict(m, dat, interval="prediction")
  pred.w.clim <- predict(m, dat, interval="confidence")
  matplot(dat$Year,cbind(pred.w.clim, pred.w.plim[,-1]),
          lty=c(1,2,2,3,3), type="l", ylab="predicted",xlab='')
  points(dat$Year,dat$west4)

  return(list(sp=dat[1,'Species.n'],Age=dat[1,'Age'],mod=m))

})

#subset(g,Species.n==3 & Age==1 & Quarter==1)

mm<-lapply(aa,function(x)coef(x$mod))
mm<-matrix(unlist(mm),ncol=3,byrow=T)
mm<-data.frame(mm)
names(mm)<-c('Intercept','Wt','Clup_N')
ll<-dim(mm)[1]

sp<-unlist(lapply(aa,function(x)x$sp)); sp<-sp[1:ll]
age<-unlist( lapply(aa,function(x)x$Age));age<-age[1:ll]
mm$sp<-sp
mm$Age<-age
mm

a<-lapply(aa,function(x){print(paste(sp.names[x$sp],"Age:",x$Age)); print(summary(x$mod))})

round(summary(unique(g$N))/1000000)

clup<-summary(unique(g$N))
clup<-clup[c(1,2,3,5,6)]
a<-data.frame(clup)
a$abun<-paste(1:5,rownames(a))

g1<-subset(dat,Quarter==1 | (Quarter==3 & Age==0))
g1<-aggregate(west~Species.n+Age,mean,data=g1)
g1<-merge(a,g1)

w<-tapply(g1$west,list(g1$abun,g1$Species.n,g1$Age),mean)
dimnames(w)[3]<-list(paste('Age',0:8,sep='-'))
dimnames(w)[2]<- list(sp.names)
ftable(w)
w[,,2:8]<-0
ftable(w)

mm

inter<-tapply(mm$Intercept,list(Sp=mm$sp,Age=mm$Age),sum)
Wt<-tapply(mm$Wt,list(Sp=mm$sp,Age=mm$Age),sum)
Clup_N<-tapply(mm$Clup_N,list(Sp=mm$sp,Age=mm$Age),sum)

for (abun in (1:5)) for (sp in (1:3)) for ( age in (0:7))  {
 a<-age+1  # age 0 has index 1
 w[abun,sp,a+1]<-inter[sp,a]+Wt[sp,a]*w[abun,sp,a]+ Clup_N[sp,a]*clup[abun]
}

ftable(round(w,5))

cleanup()
for (sp in (1:3)) {
 X11()
 matplot(x=0:8,y=t(w[,sp,]),type='b',lwd=3,main=sp.names[sp],xlab='Age')
 obs<-subset(dat,Species.n==sp & Quarter==1,select=c(Year,Age,west))
 points(obs$Age,obs$west)
}
w

cleanup()
for (sp in (1:3)) {
  X11()
  obs<-subset(dat,Species.n==sp & Quarter==1,select=c(Year,Age,west))
  boxplot(west~Age,data=obs,ylim=c(0,max(obs$west)),main=sp.names[sp])
 for (i in (1:5)) points(0:8,w[i,sp,],col=i,type='b',lwd=3)
}

#######

dat<-Read.summary.data(read.init.function=F)
g1<-subset(dat,select=c(-M1,-M2,-M,-F,-Z,-C.hat,-C.obs,-Yield,-CWsum,-propmat,-ration,-Lsea,-BIO,-SSB,-N.bar))
g1$cohort<-g1$Year-g1$Age
g1<-subset(g1,Quarter==1 | (Quarter==3 & Age==0))
obs<-tapply(g1$west,list(g1$Species.n,g1$cohort,g1$Age),sum)
ftable(round(obs,4))
pred<-obs
cl<-aggregate(N~Year,data=g1,FUN=sum,subset=(Species.n %in% clupeids))
cl<-tapply(cl$N,cl$Year,sum)

for (s in (1:3)) for (y in as.character(1974:2009)) for (a in (1:8)){
  cohort<-as.character(as.numeric(y)-a)
  #print(paste(y,cohort,a))
  pred[s,cohort,as.character(a)]<-inter[s,as.character(a-1)]+Wt[s,as.character(a-1)]*obs[s,cohort,as.character(a-1)]+Clup_N[s,as.character(a-1)]*cl[y]
}

pred<-arr2df(pred)
names(pred)<-c('Species.n','cohort','Age','w')
pred$type='predicted'
obs<-arr2df(obs)
names(obs)<-c('Species.n','cohort','Age','w')
obs$type='Observed'

a<-rbind(pred,obs)
a<-subset(a,!is.na(w) & paste(cohort)>="1974" & paste(cohort)<="2006")

cleanup()

b<-by(a,a$Species.n,function(g){
trellis.device(height=8,width=10,pointsize=8)
tit<-paste(sp.names[g[1,'Species.n']],', mean weight Quarter 1 by cohort',sep='')
print(xyplot(w*1000~Age| paste(cohort),group=type, data=g,layout = c(6, 6) ,
  main=tit, ylab='Weight in the stock (gram)' ,type='b'
))
})

###########
# changes from one quarter to the next
g1<-subset(g,Quarter==1 | (Quarter==3 & Age==0) )
q<-aggregate(list(ratio2=g1$west1/g1$west,ratio3=g1$west2/g1$west,ratio4=g1$west3/g1$west),
          list(Species.n=g1$Species.n,Quarter=g1$Quarter,Age=g1$Age),mean)
q$ratio1<-1
q<-subset(q,select=c(Species.n,Age,ratio1,ratio2,ratio3,ratio4))

q
a1<-subset(q,Species.n==1 & Age==7);a1$Age<-8
a2<-subset(q,Species.n==2 & Age==7);a2$Age<-8
a3<-subset(q,Species.n==3 & Age==6);a3$Age<-7
a4<-subset(q,Species.n==3 & Age==6);a4$Age<-8

g03<-aggregate(west~Species.n+Age,data=dat,subset=(Quarter==3 & Age==0),FUN=mean)
g04<-aggregate(west~Species.n+Age,data=dat,subset=(Quarter==4 & Age==0),FUN=mean)
a5<-data.frame(Species.n=g03$Species.n,Age=g03$Age,ratio1=1,ratio2=g04$west/g03$west,ratio3=1,ratio4=1)

q<-rbind(q,a1,a2,a3,a4)
q<-q[order(q$Species.n,q$Age),]
q<-subset(q,select=c(Species.n,Age,ratio1,ratio2,ratio3,ratio4))

#q.gem<-rbind(q,a5)
q.gem<-q
q.gem<-q.gem[order(q.gem$Species.n,q.gem$Age),]

q<-subset(q,select=c(ratio1,ratio2,ratio3,ratio4))

q<-as.matrix(q)

a<-seq(0,8.75,0.25)
sp<-2; i<-3;
t(w[i,sp,]*q[(1+(sp-1)*9):(9+(sp-1)*9),])
length(t(w[i,sp,]*q[(1+(sp-1)*9):(9+(sp-1)*9),]))
length(a)

cleanup()
for (sp in (1:3)) {
  X11()
  obs<-subset(dat,Species.n==sp & (Quarter==1 | (Quarter==0 & Age==3)),select=c(Year,Age,west))
  boxplot(west~Age,data=obs,ylim=c(0,max(obs$west)),main=sp.names[sp],xlab='Age',ylab='Mean weight (g)')
 for (i in (1:5)) points(a,t(w[i,sp,]*q[(1+(sp-1)*9):(9+(sp-1)*9),]),col=i,type='b',lwd=3)
}

# ratio between weca and west
obs<-subset(dat,weca>0 & west>0 & Year>2000)
obs$ratio<-obs$weca/obs$west
a<-tapply(obs$ratio,list(obs$Species.n,obs$Quarter,obs$Age),mean)
ftable(round(a,1))
ratio<-a

if (write.growth.out) {
  outfile<-file.path(data.path,'growth_type1.in')
  cat("# Density dependent Growth parameter for type 1 growth where W(t+1)=intercept+ a*W(t) + b* clupeid total N\n",
      "#  W(t+1) is for Quarter 1 \n",
      "#\n#  Intercept   a            b",file=outfile)
  mm.out<-mm
  mm.out$Age<-mm.out$Age+1

  dat<-Read.summary.data(read.init.function=F)

  obs<-subset(dat,west>0 & (Quarter==3 & Age==0) )
  a<-aggregate(west~Species.n+Age,mean,data=obs)
  names(a)<-c("sp","Age","Intercept")
  a$Wt<-a$Clup_N<-0
  a<-subset(a,select=c(Intercept, Wt, Clup_N, sp, Age))

  #all<-rbind(mm.out,a, data.frame(Intercept=0,Wt=0,Clup_N=0,sp=3,Age=8))
  all<-rbind(mm.out,a,data.frame(Intercept=0,Wt=0,Clup_N=0,sp=3,Age=8))

  all<-all[order(all$sp,all$Age),]
  for (s in (1:3)) {
    cat("#", sp.names[s],"\n",file=outfile,append=T)
    for (a in (0:8)){
      cat(all[all$sp==s & all$Age==a,"Intercept"],all[all$sp==s & all$Age==a,"Wt"],all[all$sp==s & all$Age==a,"Clup_N"]," #",sp.names[s]," Age",a,"\n",file=outfile,append=T)
  }}

  cat("#############################################################\n",
      "#  Ratio between weight in the first quarter and Q1 , Q2, Q3 and Q4\n",file=outfile,append=T)
  b<-q.gem
  for (s in (1:3)) {
    cat("#", sp.names[s],"\n",file=outfile,append=T)
    for (a in (0:8)){
      cat(unlist(b[b$Species.n==s & b$Age==a,3:6])," #",sp.names[s]," Age",a,"\n",file=outfile,append=T)
  }}

   cat("#############################################################\n",
      "#  Ratio between weca and west\n",file=outfile,append=T)
  ratio[is.na(ratio)]<-0
  ratio[ratio>2]<-2
  ratio[1,3,1]<-ratio[1,4,1]<-1
  write.table(ftable(round(ratio,2)),file=outfile,append=T,col.names=F,row.names=F)

  dat<-subset(Read.summary.data(read.init.function=F),Quarter==1 | (Quarter=3 & Age==0))
  minW<-aggregate(west~Species.n+Age,data=dat,FUN=quantile,p=0.1)
  names(minW)<-c("Species.n","Age","minW")
  maxW<-aggregate(west~Species.n+Age,data=dat,FUN=quantile,p=0.9)
  w<-merge(minW,maxW)

  minw<-tapply(w$minW,list(w$Species,w$Age),sum)
  minw[is.na(minw)]<-0
  cat("#############################################################\n",
      "#  Minimum Weight, Q1\n",file=outfile,append=T)
  write.table(round(minw,6),file=outfile,append=T,col.names=F,row.names=F)

  maxw<-tapply(w$west,list(w$Species,w$Age),sum)
  maxw[is.na(maxw)]<-0
  cat("#############################################################\n",
      "#  Maximum Weight, Q1\n",file=outfile,append=T)
  write.table(round(maxw,6),file=outfile,append=T,col.names=F,row.names=F)

  cleanup()
  aa<-by(w,list(w$Species.n),function(x) {
    X11()
    obs<-subset(dat,Species.n==x[1,"Species.n"]& Quarter==1)
   plot(x$Age,x$west,ylim=c(0,max(obs$west)),main=sp.names[x[1,"Species.n"]],type='b',col='red',lwd=3,xlab='Age',ylab='mean weight')
   points(x$Age,x$minW,type='b',col='red',lwd=3)
    points(obs$Age,obs$west,type='p',col='blue')
  })

}

dat<-subset(Read.summary.data(read.init.function=F),Quarter==1)
minW<-aggregate(west~Species.n+Age,data=dat,subset=(Quarter==1),FUN=quantile,p=0.1)
names(minW)<-c("Species.n","Age","minW")
maxW<-aggregate(west~Species.n+Age,data=dat,subset=(Quarter==1),FUN=quantile,p=0.9)
w<-merge(minW,maxW)

minw<-tapply(w$minW,list(w$Species,w$Age),sum)
minw[is.na(minw)]<-0

maxw<-tapply(w$west,list(w$Species,w$Age),sum)
maxw[is.na(maxw)]<-0

#cleanup()
aa<-by(w,list(w$Species.n),function(x) {
  X11()
  obs<-subset(dat,Species.n==x[1,"Species.n"]& Quarter==1)
 plot(x$Age,x$west*1000,ylim=c(0,max(obs$west*1000)),main=sp.names[x[1,"Species.n"]],type='b',col='red',lwd=3,xlab='Age',ylab='mean weight')
 points(x$Age,x$minW*1000,type='b',col='red',lwd=3)
  points(obs$Age,obs$west*1000,type='p',col='blue')
})


#' @title inf_counter
#' @description identifies the -Inf values
#' @param bool decides if -Inf is not replaced with NaN
#' @param snsr_data the dataset
#' @param label the identifer for the dataset (e.g. sky, gro, skyo, groo)
#' @return data set that replaces all -Infs for NaN (If bool == FALSE).
#' @export
inf_counter <- function(bool, snsr_data, label){
    output <- list()
    for (i in seq(1, length(snsr_data))){
        if (bool == FALSE){
            if ('-Inf' %in% snsr_data[[ paste(paste("snsr_",label,sep=""),i,sep="") ]]) {
                snsr_data[[ paste(paste("snsr_",label,sep=""),i,sep="") ]] <- replace(snsr_data[[ paste(paste("snsr_",label,sep=""),i,sep="") ]], snsr_data[[ paste(paste("snsr_",label,sep=""),i,sep="") ]] == "-Inf", NaN)
            }
        }
        output <- append(output, values=list(snsr_data[[ paste(paste("snsr_",label,sep=""),i,sep="") ]]))
    }
    return(output)
}

#' @title exp.regression
#' @description Function includes all of the stuff to generate the exponential regression model with intervals
#' @param x the domain of the dataset
#' @param y the range of the dataset
#' @return A list of stat stuff
#' @export
exp.regression 	<- function(x,y){
	# Finds and removes NaNed values from the dataset
	# nans <- c(grep("NaN", y)); nans <- append(nans, grep("NaN", x))
	# x <- x[-(nans)]; y <- y[-(nans)]
	# Porblem seems to be nan values are still being counted in the resid(model.0)
	if (args$overcast){
		pw_loc 	<- overcast.results$pw_loc
		avg 	<- overcast.results$avg
	} else {
		pw_loc 	<- clear_sky.results$pw_loc
		avg 	<- clear_sky.results$avg
	}
	data_indx <- mean.filter(pw_loc, avg)
	data_sep <- data.partition(x[data_indx], y[data_indx])
	# data_sep <- data.partition(x, y)
	train <- data_sep$train
	test <- data_sep$test
	print(train$x)
	# creates a uniform sequence of numbers that fit within the limits of x
	xmin 	<- min(train$x, na.rm=TRUE)
	xmax 	<- max(train$x, na.rm=TRUE)
	newx 	<- seq(xmin, xmax, length.out=length(train$x))
	# Non-linear model (exponential)
	## Initial values are in fact the converged values
	model.0 <- lm(log(y, base=exp(1))~x, data=data.frame(x=train$x, y=train$y))
	# print(as.numeric(unlist(resid(model.0))))
	print(length(resid(model.0)))
	start 	<- list(a=coef(model.0)[1], b=coef(model.0)[2])
	model 	<- nls(log(y, base=exp(1))~a+x*b, data=data.frame(x=train$x, y=train$y), start=start)
	# Intervals (confidence/prediction)
	confint <- predict(model.0, newdata=data.frame(q=newx), interval='confidence')
	predint <- predict(model.0, newdata=data.frame(q=newx), interval='prediction')
	# Coefficient of determination
	r2		<- summary(model.0)$r.squared
    # estimate from regression
	est     <- exp(coef(model)[1]+coef(model)[2]*test$x)
	# accuracy of model
	acc     <- sqrt((1/length(test$x))*(sum((est-test$y)^2)/length(test$x)))
    # Residual Standard Deiviation
	S       <- sqrt(sum((est-test$y)^2)/(length(test$x) - 2))
	# Root Square Mean Error
	rsme    <- sqrt(sum((est-test$y)^2)/length(test$x))
	# Function outputs
	output 	<- list("x"=train$x,
					"y"=train$y,
					"newx"=newx,
					"xmin"=xmin,
					"xmax"=xmax,
					"model.0"=model.0,
					"model"=model,
					"confint"=confint,
					"predint"=predint,
					"R2"=r2,
					'est'=est,
					'acc'=acc,
					'S'=S,
					'rsme'=rsme,
					"seed"=def_seed)
	return (output)
}

#' @title clear_sky.analysis
#' @description Computes all averages for plotting for clear sky labeled data
#' @param overcast results of the overcast.filter function
#' @export
clear_sky.analysis <- function(overcast){
## Pulls date from filter function
	clear_date  <- overcast$clear_date	# Date
	comments    <- overcast$com
## Pulls relative humidity from filter function
	clear_rh <- as.numeric(overcast$rh)
## Initialize empty lists
	snsr_del 	<- snsr_sky <- snsr_gro <- pw_loc <- loc_avg <- snsr_sky_calc <- tmp_avg <- list()
## Adds PW measurements for clear sky to list
	for (i in 1:length(pw_name)){
		pw_loc[[ paste("pw_loc", i, sep="")]]	 <- as.numeric(unlist(overcast[grep("clear_pw", names(overcast), fixed=TRUE)[1]+i-1]))
	}
## Adds Sky temperature, Ground temperature, and Change in temperature for each sensor to empty list
	for (i in 1:length(snsr_name)){
		snsr_gro[[ paste("snsr_gro",i,sep="") ]] <- as.numeric(unlist(overcast[grep("clear_gro", names(overcast), fixed=TRUE)[1]+i-1]))
		snsr_sky[[ paste("snsr_sky",i,sep="") ]] <- as.numeric(unlist(overcast[grep("clear_sky", names(overcast), fixed=TRUE)[1]+i-1]))
		snsr_del[[ paste("snsr_del",i,sep="") ]] <- as.numeric(unlist(overcast[grep("clear_gro", names(overcast), fixed=TRUE)[1]+i-1])) - as.numeric(unlist(overcast[grep("clear_sky", names(overcast), fixed=TRUE)[1]+i-1]))
	}

	out_sky <- inf_counter(FALSE, snsr_sky, 'sky')
	for (i in 1:length(snsr_sky)){
		snsr_sky[[ paste("snsr_sky",i,sep="") ]] <- out_sky[[i]]
	}

	out_gro <- inf_counter(FALSE, snsr_gro, 'gro')
	for (i in 1:length(snsr_gro)){
		snsr_gro[[ paste("snsr_gro",i,sep="") ]] <- out_gro[[i]]
	}
	for (i in 1:length(clear_date)) {
		if (grepl("This datapoint has been omitted from the final analysis; refer to documentation on how to handle this day", comments[i], fixed=TRUE)){
			for (j in 1:length(snsr_name)){
				snsr_sky[[ paste("snsr_sky",j,sep="") ]][i] <- "NaN"
				snsr_gro[[ paste("snsr_gro",j,sep="") ]][i] <- "NaN"
			}
		}
	}
	for (i in 1:length(snsr_sky)){
		for (j in 1:(length(unlist(snsr_sky))/length(snsr_sky))){
			snsr_sky_calc[[ paste("snsr_sky_calc",j,sep="") ]] <-
				append(x=snsr_sky_calc[[ paste("snsr_sky_calc", j, sep="")]], values=as.numeric(snsr_sky[[i]][j]))
		}
	}
	print(snsr_sky_calc[[100]])
	for (i in 1:(length(unlist(snsr_sky))/length(snsr_sky))){
		snsr_sky_calc[[ paste("snsr_sky_calc",i,sep="") ]] <- mean(na.omit(snsr_sky_calc[[ paste("snsr_sky_calc",i,sep="") ]]))
	}
## Takes locational average of the precipitable water measurements
	for (i in 1:length(col_pwpl)){
		tmp <- unlist(col_pwpl[i])
		for (j in col_pwpl[i]){
			loc_avg[[ paste("loc_avg",i,sep="") ]] <-
				array(overcast[grep("clear_pw", names(overcast), fixed=TRUE)][j])
		}
		tmp <- loc_avg[i]
		loc_avg[[ paste("loc_avg",i,sep="") ]] <- Reduce("+", tmp[[1]])/length(col_pwpl)
	}
	for (i in 1:length(col_pwtm)){
		tmp <- unlist(col_pwtm[i])
		for (j in col_pwtm[i]){
			tmp_avg[[ paste("tmp_avg",i,sep="") ]] <-
				array(overcast[grep("clear_pw", names(overcast), fixed=TRUE)][j])
		}
		tmp <- tmp_avg[i]
		tmp_avg[[ paste("tmp_avg",i,sep="") ]] <- Reduce("+", tmp[[1]])/length(col_pwtm)
	}
## Takes super average of the precipitable water measurements
	avg 		<-  Reduce("+", pw_loc)/length(pw_loc)
	return(list("avg"=avg,
				"date"=clear_date,
				"snsr_sky"=snsr_sky,
				"snsr_gro"=snsr_gro,
				"snsr_del"=snsr_del,
				"rh"=clear_rh,
				"comments"=comments,
				"pw_loc"=pw_loc,
				"loc_avg"=loc_avg,
				"tmp_avg"=tmp_avg,
				"snsr_sky_calc"=snsr_sky_calc))
}

#' @title overcast.analysis
#' @description Computes all averages for plotting for overcast labeled data
#' @param overcast results of the overcast.filter function
#' @export
overcast.analysis <- function(overcast){
## Pulls date from filter function (overcast)
	over_date  	<- overcast$over_date
## Pulls relative humidity from filter function
	over_rh <- as.numeric(overcast$rho)
	comments    <- overcast$como
# Initialize empty lists
	snsr_delo  	<- snsr_skyo <- snsr_groo <- pw_loco <- loc_avgo <- snsr_sky_calco <- tmp_avgo <- list()
## Adds PW measurements for overcast to list
	for (i in 1:length(pw_name)){
		pw_loco[[ paste("pw_loco", i, sep="")]] 	<- as.numeric(unlist(overcast[grep("over_pw", names(overcast), fixed=TRUE)[1]+i-1]))
	}
## Adds Sky temperature, Ground temperature, and Change in temperature for each sensor to empty list
	for (i in 1:length(snsr_name)){
		snsr_skyo[[ paste("snsr_skyo",i,sep="") ]] <- as.numeric(unlist(overcast[grep("over_sky", names(overcast), fixed=TRUE)[1]+i-1]))
		snsr_groo[[ paste("snsr_groo",i,sep="") ]] <- as.numeric(unlist(overcast[grep("over_gro", names(overcast), fixed=TRUE)[1]+i-1]))
		snsr_delo[[ paste("snsr_delo",i,sep="") ]] <- as.numeric(unlist(overcast[grep("over_gro", names(overcast), fixed=TRUE)[1]+i-1])) - as.numeric(unlist(overcast[grep("over_sky", names(overcast), fixed=TRUE)[1]+i-1]))
	}

	out_skyo <- inf_counter(FALSE, snsr_skyo, 'skyo')
	for (i in seq(1, length(snsr_skyo))){
		snsr_skyo[[ paste("snsr_skyo",i,sep="") ]] <- out_skyo[[i]]
	}

	out_groo <- inf_counter(FALSE, snsr_groo, 'groo')
	for (i in seq(1, length(snsr_groo))){
		snsr_groo[[ paste("snsr_groo",i,sep="") ]] <- out_groo[[i]]
	}
	for (i in seq(from = 1,to = length(over_date))) {
		if (grepl("This datapoint has been omitted from the final analysis; refer to documentation on how to handle this day", comments[i], fixed=TRUE)){
			for (j in length(snsr_skyo)){
				snsr_skyo[[ paste("snsr_skyo",j,sep="") ]][i] <- "-Inf"
			}
			for (j in length(snsr_gro)){
				snsr_groo[[ paste("snsr_groo",j,sep="") ]][i] <- "Inf"
			}
		}
	}
## Takes average of available sky temperature measurements
# Removes all NaN values from daily lists
	for (i in snsr_skyo){
		for (j in 1:(length(unlist(snsr_skyo))/length(snsr_skyo))){
			snsr_sky_calco[[ paste("snsr_sky_calco",j,sep="") ]] <-
				append(x=snsr_sky_calco[[ paste("snsr_sky_calco", j, sep="")]], values=na.omit(c(i[j])))
		}
	}
# Takes averages of each list
	for (i in 1:(length(unlist(snsr_skyo))/length(snsr_skyo))){
		snsr_sky_calco[[ paste("snsr_sky_calco",i,sep="") ]] <- mean(snsr_sky_calco[[ paste("snsr_sky_calco",i,sep="") ]])
	}
## Takes locational average of the precipitable water measurements
	for (i in 1:length(col_pwpl)){
		tmp <- unlist(col_pwpl[i])
		for (j in col_pwpl[i]){
			loc_avgo[[ paste("loc_avgo",i,sep="") ]] <-
				array(overcast[grep("over_pw", names(overcast), fixed=TRUE)][j])
		}
		tmp <- loc_avgo[i]
		loc_avgo[[ paste("loc_avgo",i,sep="") ]] <- Reduce("+", tmp[[ 1 ]])/length(col_pwpl)
	}
## Takes temporal average of the precipitable water measurements
	for (i in 1:length(col_pwtm)){
		tmp <- unlist(col_pwtm[i])
		for (j in col_pwtm[i]){
			tmp_avgo[[ paste("tmp_avgo",i,sep="") ]] <-
				array(overcast[grep("over_pw", names(overcast), fixed=TRUE)][j])
		}
		tmp <- tmp_avgo[i]
		tmp_avgo[[ paste("tmp_avgo",i,sep="") ]] <- Reduce("+", tmp[[ 1 ]])/length(col_pwtm)
	}
## Takes super average of the precipitable water measurements
	avgo 		<-  Reduce("+", pw_loco)/length(pw_loco)
	return(list("avg"=avgo,
				"date"=over_date,
				"snsr_sky"=snsr_skyo,
				"snsr_gro"=snsr_groo,
				"snsr_del"=snsr_delo,
				"rh"=over_rh,
				"pw_loc"=pw_loco,
				"loc_avg"=loc_avgo,
				"tmp_avg"=tmp_avgo,
				"snsr_sky_calc"=snsr_sky_calco))
}


#
# Example R program
#

library(rgeos)

# Example taken from rgeos documentation

gArea(readWKT("POINT(1 1)"))
gArea(readWKT("LINESTRING(0 0,1 1,2 2)"))
gArea(readWKT("LINEARRING(0 0,3 0,3 3,0 3,0 0)"))

p1 = readWKT("POLYGON((0 0,3 0,3 3,0 3,0 0))")
p2 = readWKT("POLYGON((0 0,3 0,3 3,0 3,0 0),(1 1,2 1,2 2,1 2,1 1))")

gArea(p1)
p1@polygons[[1]]@area

gArea(p2)
p2@polygons[[1]]@area


#' @title variable.recode
#' @description load transformation tables associated with a given variable
#' @family abysmally documented
#' @author  unknown, \email{<unknown>@@dfo-mpo.gc.ca}
#' @export
  variable.recode = function( x, variable, direction="forward", db="snowcrab", rm.na=F ) {
    tl = lookup.datatransformation(db)

    if (file.exists( tl$repository) ) {
      load (tl$repository)
    } else {
      REPOS = recode.variable.initiate.db ( db )
    }

    ii = which( REPOS$varname == variable )
    if (length(ii) == 0 ) { # missing from list .. print error message and stop to figure out why
      print( paste("Recode:", variable, "is missing from database, assuming no transformation"))
      # tmp = REPOS[1,]
      # tmp[1,] = c(variable, "none", 0, 1 )
      return( x )
    } else if ( length(ii) > 1 ) {
      print(paste( "Error in recode:", variable, "has too many incidences in database"))
      stop()
    }

    TF = REPOS[ii ,]
    if ( TF$transform %in% c("", "none") ) {
      B = x
    }

    if ( TF$transform == "log10") {
      if (direction =="forward") {
        B = log10( x + TF$offset )
      } else if (direction =="backward") {
        B = 10^x - TF$offset
      }
    }

    if ( TF$transform == "scaled+centered") {
      if (direction =="forward") {
        B = scale( x, center=TF$offset, scale=TF$scaling )
      } else if (direction=="backward" ) {
        B = fields::unscale( x, x.center=TF$offset, x.scale=TF$scaling )
      }
    }

    if (rm.na) B = B[which(is.finite(B))]

    return (B)
  }


library(hdfmat)
suppressMessages(library(float))

f = tempfile()
n = "mydata"

nr = 5
nc = 3
h = hdfmat::hdfmat(f, n, nr, nc, "float")

v = 13
h$fill_val(v)

test = h$read()
truth = float::fl(matrix(v, nr, nc))

stopifnot(all.equal(test, truth))

h$close()
unlink(f)


library(sqldf)
employees <- read.csv(file.choose())
View(employees)
orders <- read.csv(file.choose())
View(orders)
.libPaths("")
str(employees)
str(orders)
#singleTable Operation

#filter male data from dataset
male_emp <- sqldf("select * from employees where gender == 'm' ")
View(male_emp)

#count by first name
occ <- sqldf("select firstname, COUNT(firstname) as occ from employees group by firstname")
View(occ)

#Multitable operation

#1 Left Join
data=sqldf("Select * from employees emp LEFT JOIN orders ord ON emp.id=ord.id ")
View(data)

#2 Right Join
data=sqldf("Select * from orders ord LEFT JOIN employees emp ON emp.id=ord.id ")
View(data)

#3 INNER JOIN
data=sqldf("Select * from orders ord INNER JOIN employees emp where emp.id=ord.id ")
View(data)

data <- sqldf("select * from orders ord,employees emp where emp.id=ord.id")
View(data)

#join orders to employees
# find who is ordering item less than 10 dollar sort the data
# in lowest cost
data <- sqldf("select firstname,item_cost from
              orders ord LEFT JOIN employees emp ON
              emp.id=ord.id where ord.item_cost<10 Order by item_cost")

View(data)

data <- sqldf("select firstname ,quantity_ordered*item_cost as Total_cost from
              orders ord LEFT JOIN employees emp ON emp.id=ord.id
              where quantity_ordered*item_cost<20
              order by quantity_ordered*item_cost ")
View(data)

# wnat to analyse whose total lunch cost is <30 dollar

#you want to know whose total luch cost is 30$


  applySD = function( f, method="slow", newnames=NULL ) {
    cnames= c("id", "x")

    if (is.null( newnames )) newnames=names(f)

    nv = ncol(f)
    names(f) = cnames[1:nv]

    if (method=="slow") {
        r = by( f, f$id, with, sd( x, na.rm=TRUE ))
        out = data.frame( id=names(r), x=as.numeric(as.vector(r)) , stringsAsFactors=FALSE )
    }

    if (method=="compact_but_slow") {
      rowindex = 1:nrow(f)
      out = aggregate(rowindex ~ id, f, function(i) sd(f$x[i], na.rm=TRUE ), na.action=na.omit ) #arithmetic mean
    }

    names(out) = newnames[1:2]
    return( out )
  }


rm(list=ls())

library(raster)

LC <- raster("C:/Users/k1076631/Google Drive/Shared/Crafty Telecoupling/Data/CRAFTYInput/Data/ObservedLCmaps/LandCover2001_PastureB_Disagg.asc")  #land cover from LandCoverMap.r (or ClassifyDisaggregateMap.r)
plot(LC)

LC[LC == 2] <- 0.1
LC[LC == 3] <- 0.1
LC[LC == 1] <- 0.8
LC[LC == 4] <- 0.8
LC[LC == 5] <- 0.8

writeRaster(LC, "C:/Users/k1076631/Google Drive/Shared/Crafty Telecoupling/Data/CRAFTYInput/Data/AgriLocations2001.asc", format = 'ascii', overwrite=T)


library(methods)
library(fastLiquidAssociation)
{{rimport}}('__init__.r', 'plot.r')
options(stringsAsFactors = FALSE)
set.seed(8525)

infile   = {{i.infile | R}}
outfile  = {{o.outfile | R}}
outdir   = {{o.outdir | R}}
casefile = {{i.casefile | R}}
inopts   = {{args.inopts | R}}
plotla   = {{args.plot | R}}
pval     = {{args.pval | R}}
dofdr    = {{args.fdr | R}}
fdrfor   = {{args.fdrfor | R}}
devpars  = {{args.devpars | R}}
nthread  = {{args.nthread | R}}
zcat     = {{args.zcat | R}}
ggs      = {{args.ggs | R}}

if (dofdr == T) dofdr = 'BH'

onecase = function(idata, zs, xs = NULL, nthread, zcat, case) {
	ncut   = max(ceiling(nrow(idata)/22), 4)
	inames = colnames(idata)
	z      = na.omit(match(zs, inames))
	x      = ifelse(is.null(xs), NULL, na.omit(match(xs, inames)))
	if (length(z) == 0)
		stop('Find no rows in "Z" group from input file.')
	ret    = fastMLA(
		as.matrix(idata),
		nvec    = list(z = z, x = x),
		rvalue  = 0.3,
		cut     = ncut,
		zcat    = zcat,
		threads = nthread
	)
	if (nrow(ret) == 0) {
		return(cbind(ret, Pval = double()))
	} else {
		dupFlag = F
		if (nrow(ret) == 1) {
			dupFlag = T
			ret = rbind(ret, ret)
		}
		ret = mass.CNM(data=idata,GLA.mat=ret,nback=max(2, nrow(ret)))$`top p-values`
		ret = ret[, c(1:5, 9), drop = F]
		colnames(ret) = c('X', 'Y', 'Z', 'rhoDiff', 'LA', 'Pval')
		if (dupFlag)
			ret = ret[1,,drop=F]
		ret = cbind(Case = case, ret)
		return(ret)
	}
}

indata = t(read.table.inopts(infile, inopts))
ret = data.frame(
	Case    = character(),
	X       = character(),
	Y       = character(),
	Z       = character(),
	rhoDiff = double(),
	LA      = double(),
	Pval    = double()
)
if (dofdr != FALSE) {
	ret = cbind(ret, Qval = double())
}

casedata = read.table(casefile, header = F, row.names = NULL, check.names = F, sep = "\t")
if (ncol(casedata) == 2)
	casedata$Case = 'Case1'

cases = levels(factor(casedata[,3]))
for (case in cases) {
	cdata = casedata[which(casedata[,3] == case),,drop=F]
	zs    = cdata[which(cdata[,2] == 'Z'), 1]
	xs    = cdata[which(cdata[,2] == 'X'), 1]
	if (length(xs) == 0 || is.na(xs)) xs = NULL

	out = onecase(indata, zs, xs, nthread, zcat, case)

	if (dofdr != FALSE && fdrfor == 'case') {
		out = cbind(out, Qval = p.adjust(out$Pval, method = dofdr))
	}
	ret = rbind(ret, out)
}
if (dofdr != FALSE && fdrfor == 'all') {
	ret = cbind(ret, Qval = p.adjust(ret$Pval, method = dofdr))
}
ret = ret[ret$Pval < pval,,drop = FALSE]
write.table(pretty.numbers(ret, list(rhoDiff..LA = '%.3f', Pval..Qval = '%.2E')), outfile, col.names = T, row.names = F, sep = "\t", quote = F)

# plot
if (plotla && nrow(ret)>0) {
	ncut = max(ceiling(nrow(indata)/22), 4)
	for (i in 1:nrow(ret)) {
		row = ret[i,]
		plotfile = file.path(outdir, sprintf('%s.%s.', case, paste(row[2:4], collapse = '_')))
		if (!zcat) {
			LiquidAssociation::plotGLA(indata[, unlist(row[2:4]), drop = F], cut = ncut, dim = 3, pch = 4, filen = plotfile, save = T)
		} else {
			plotdata = data.frame(
				X = indata[, row$X],
				Y = indata[, row$Y],
				Z = as.character(indata[, row$Z]))
			rcase = make.names(row$Z)
			colnames(plotdata) = c(row$X, row$Y, rcase)

			subgroups = levels(factor(plotdata[,3]))
			labels = sapply(subgroups, function(m) {
				r = cor(plotdata[plotdata[,3]==m, 1], plotdata[plotdata[,3]==m, 2], use = "pairwise.complete.obs")
				paste0(row$Z, '=', m, ' (r=', round(r, 3), ')')
			})
			ggs1 = c(ggs, list(
				geom_smooth = list(
					aes_string(color = rcase),
					method  = 'lm',
					se      = F
				),
				theme = list(
					legend.position = "bottom"
				),
				guides = list(
					color=guide_legend(ncol=1),
					shape=F
				),
				scale_color_manual = list(
					values = scales::hue_pal()(length(subgroups)),
					name   = "",
					limit  = subgroups,
					labels = labels
				)
			))
			plot.scatter(
				plotdata,
				paste0(plotfile, '.png'),
				x      = 1,
				y      = 2,
				ggs    = ggs1,
				params = list(aes_string(shape = rcase, color = rcase))
			)
		}
	}
}


#londongrapher.r

#classIntStyle <- "equal"

londongrapher <- function(variable, colourbrewerpalette, classIntStyle){
  breaks<-classIntervals(wardBoundaries@data[[variable]], n=6, style=classIntStyle)
  breaks <- breaks$brks

  pal <- colorBin(palette = colourbrewerpalette,
                  domain = wardBoundaries@data[[variable]],
                  #create bins using the breaks object from earlier
                  bins = breaks
  )

  #plot_ly(wardBoundaries@data, x=wardBoundaries@data[[variable]])
  ggplot(wardBoundaries@data, aes_string(x = variable)) +
    geom_histogram(data = subset(wardBoundaries@data, wardBoundaries@data[[variable]] < breaks[1]), fill=pal(breaks[1]), bins = 100)+
    geom_histogram(data = subset(wardBoundaries@data, wardBoundaries@data[[variable]] >= breaks[1] & wardBoundaries@data[[variable]] < breaks[2]), fill=pal(breaks[2]), bins = 100)+
    geom_histogram(data = subset(wardBoundaries@data, wardBoundaries@data[[variable]] >= breaks[2] & wardBoundaries@data[[variable]] < breaks[3]), fill=pal(breaks[3]), bins = 100)+
    geom_histogram(data = subset(wardBoundaries@data, wardBoundaries@data[[variable]] >= breaks[3] & wardBoundaries@data[[variable]] < breaks[4]), fill=pal(breaks[4]), bins = 100)+
    geom_histogram(data = subset(wardBoundaries@data, wardBoundaries@data[[variable]] >= breaks[4] & wardBoundaries@data[[variable]] < breaks[5]), fill=pal(breaks[5]), bins = 100)+
    geom_histogram(data = subset(wardBoundaries@data, wardBoundaries@data[[variable]] >= breaks[5] & wardBoundaries@data[[variable]] < breaks[6]), fill=pal(breaks[6]), bins = 100)+
    theme_dark()
}


server <- function(input, output){
  #get the data for each dataset
  beerDF <- read.csv('..\\datasets\\Beers.csv')
  breweriesDF <- read.csv('..\\datasets\\Breweries.csv')

  #rename the brewery_id and name columns so we can merge later
  beerDF <- beerDF %>% rename(Brew_ID = 'Brewery_id', Beer_Name = 'Name')
  breweriesDF <- breweriesDF %>% rename(Brew_Name = 'Name')

  #merge the data on Brew_ID column name
  beerBrewDF<- merge(beerDF,breweriesDF,by=c("Brew_ID"))

  #ibu data
  allIBU <- repBeerBrewDF %>% select(State, IBU)
  allIBU[allIBU==0] <- NA
  ibuOmit <- na.omit(allIBU)

  #abv data
  allABV <- repBeerBrewDF %>% select(State, ABV)
  allABV[allABV==0] <- NA
  abvOmit <- na.omit(allABV)
  #ibu histogram
  output$ibuHPlot <- renderPlot({
        x <- ibuOmit$IBU
        bins <- seq(min(x), max(x), length.out = input$bins+1)
        hist(x, breaks = bins, col= "#75AADB", border = "white",
             xlab = "IBU Values",
             main = "histogram of IBU values")
      })

  output$ibuBPlot <- renderPlot({
        x <- ibuOmit$IBU
        bins <- seq(min(x), max(x), length.out = input$bins+1)
        boxplot(x, xlab = "IBU Values", main = "Boxplot of IBU values")
      })

  output$abvHPlot <- renderPlot({
        x <- abvOmit$ABV
        bins <- seq(min(x), max(x), length.out = input$bins+1)
        hist(x, breaks = bins, col= "#75AADB", border = "white",
             xlab = "ABV Values",
             main = "histogram of ABV values")
      })

    output$abvBPlot <- renderPlot({
        x <- abvOmit$ABV
        bins <- seq(min(x), max(x), length.out = input$bins+1)
        boxplot(x, xlab = "ABV Values", main = "Boxplot of ABV values")
      })

}