#!/usr/bin/env Rscript
options(stringAsfactors = FALSE, useFancyQuotes = FALSE)

# Taking the command line arguments
args <- commandArgs(trailingOnly = TRUE)

if(length(args)==0)stop("No file has been specified!\n")
require(xcms)
require(CAMERA)
require(intervals)

ppmCal<-function(run,ppm)
{
  return((run*ppm)/1000000)
}
metFragToCamera<-function(metFragSearchResult=NA,cameraObject=NA,ppm=5,MinusTime=5,PlusTime=5,method="fast")
{
  #metFragSearchResult<-bb
  IDResults<-metFragSearchResult
  #cameraObject<-an
  listofPrecursorsmz<-c()
  listofPrecursorsmz<-IDResults[,"parentMZ"]
  listofPrecursorsrt<-IDResults[,"parentRT"]
  CamerartLowColumnIndex<-which(colnames(cameraObject@groupInfo)=="rtmin")
  CamerartHighColumnIndex<-which(colnames(cameraObject@groupInfo)=="rtmax")
  CameramzColumnIndex<-which(colnames(cameraObject@groupInfo)=="mz")
    imatch=NA
  if(method=="regular")
      {
  MassRun1<-Intervals_full(cbind(listofPrecursorsmz,listofPrecursorsmz))

  MassRun2<-Intervals_full(cbind(cameraObject@groupInfo[,CameramzColumnIndex]-
                                   ppmCal(cameraObject@groupInfo[,CameramzColumnIndex],ppm),
                                 cameraObject@groupInfo[,CameramzColumnIndex]+
                                   ppmCal(cameraObject@groupInfo[,CameramzColumnIndex],ppm)))

  Mass_iii <- interval_overlap(MassRun1,MassRun2)

  TimeRun1<-Intervals_full(cbind(listofPrecursorsrt,listofPrecursorsrt))

  TimeRun2<-Intervals_full(cbind(cameraObject@groupInfo[,CamerartLowColumnIndex]-MinusTime,
                                 cameraObject@groupInfo[,CamerartHighColumnIndex]+PlusTime))
  Time_ii <- interval_overlap(TimeRun1,TimeRun2)

  imatch = mapply(intersect,Time_ii,Mass_iii)
   }else if(method=="fast")
      {
      featureMzs<-cbind(cameraObject@groupInfo[,CameramzColumnIndex]-
                    ppmCal(cameraObject@groupInfo[,CameramzColumnIndex],ppm),
                  cameraObject@groupInfo[,CameramzColumnIndex]+
                    ppmCal(cameraObject@groupInfo[,CameramzColumnIndex],ppm))

featureRTs<-cbind(cameraObject@groupInfo[,CamerartLowColumnIndex]-MinusTime,
                  cameraObject@groupInfo[,CamerartHighColumnIndex]+PlusTime)

imatch<-list()
for(i in 1:length(listofPrecursorsmz))
{
  mz<-listofPrecursorsmz[i]
  rt<-listofPrecursorsrt[i]

  imatch[[i]]<-which(featureMzs[,1]<mz & featureMzs[,2]>mz & featureRTs[,1]<rt & featureRTs[,2]>rt)

}
 }else if (method=="par"){
      featureMzs<-cbind(cameraObject@groupInfo[,CameramzColumnIndex]-
                    ppmCal(cameraObject@groupInfo[,CameramzColumnIndex],ppm),
                  cameraObject@groupInfo[,CameramzColumnIndex]+
                    ppmCal(cameraObject@groupInfo[,CameramzColumnIndex],ppm))

featureRTs<-cbind(cameraObject@groupInfo[,CamerartLowColumnIndex]-MinusTime,
                  cameraObject@groupInfo[,CamerartHighColumnIndex]+PlusTime)
     imatch <-mclapply(c(1:length(listofPrecursorsmz)),FUN =function(x) { which(featureMzs[,1]<listofPrecursorsmz[x] & featureMzs[,2]>listofPrecursorsmz[x] & featureRTs[,1]<listofPrecursorsrt[x] & featureRTs[,2]>listofPrecursorsrt[x])},mc.cores=ncore)

      }else{stop("Method should be either fast,par and regular")}

  listOfMS2Mapped<-list()
  for (i in 1:length(imatch)) {
    for(j in imatch[[i]])
    {
      if(is.null(listOfMS2Mapped[[as.character(j)]]))
      {
        listOfMS2Mapped[[as.character(j)]]<-data.frame(IDResults[i,],stringsAsFactors = F)
      }else
      {
        listOfMS2Mapped[[as.character(j)]]<-
          rbind(listOfMS2Mapped[[as.character(j)]],data.frame(IDResults[i,],stringsAsFactors = F))
      }

    }
  }
  return(list(mapped=listOfMS2Mapped))
}

ppmTol<-5
rtTol = 10
higherTheBetter<-T
scoreColumn<-"q.value"
impute<-T
typeColumn<-"type"
selectedType<-"p"
renameCol<-"rename"
rename<-T
onlyReportWithID<-T
combineReplicate<-F
combineReplicateColumn<-"rep"
iflog<-F
sampleCoverage<-0
sampleCoverageMethod<-"global"
ncore=1
Ifnormalize<-NA
scoreInput<-NA
for(arg in args)
{
  argCase<-strsplit(x = arg,split = "=")[[1]][1]
  value<-strsplit(x = arg,split = "=")[[1]][2]

  if(argCase=="inputcamera")
  {
    inputCamera=as.character(value)
  }
  if(argCase=="inputscores")
  {
    scoreInput=as.character(value)
  }
  if(argCase=="inputpheno")
  {
    phenotypeInfoFile=as.character(value)
  }
  if(argCase=="ppm")
  {
    ppmTol=as.numeric(value)
  }
  if(argCase=="rt")
  {
    rtTol=as.numeric(value)
  }
  if(argCase=="higherTheBetter")
  {
    higherTheBetter=as.logical(value)
  }
  if(argCase=="scoreColumn")
  {
    scoreColumn=as.character(value)
  }
  if(argCase=="impute")
  {
    impute=as.logical(value)
  }
  if(argCase=="typeColumn")
  {
    typeColumn=as.character(value)
  }
  if(argCase=="selectedType")
  {
    selectedType=as.character(value)
  }
  if(argCase=="rename")
  {
    rename=as.logical(value)
  }
  if(argCase=="renameCol")
  {
    renameCol=as.character(value)
  }
  if(argCase=="onlyReportWithID")
  {
    onlyReportWithID=as.logical(value)
  }
  if(argCase=="combineReplicate")
  {
    combineReplicate=as.logical(value)
  }
  if(argCase=="combineReplicateColumn")
  {
    combineReplicateColumn=as.character(value)
  }
   if(argCase=="log")
  {
    iflog=as.logical(value)
  }
  if(argCase=="sampleCoverage")
  {
    sampleCoverage=as.numeric(value)
  }
  if(argCase=="sampleCoverageMethod")
  {
    sampleCoverageMethod=as.character(value)
  }
  if(argCase=="outputPeakTable")
  {
    outputPeakTable=as.character(value)
  }
  if(argCase=="outputVariables")
  {
    outputVariables=as.character(value)
  }
  if(argCase=="outputMetaData")
  {
    outputMetaData=as.character(value)
  }
  if(argCase=="ncore")
  {
    ncore=as.numeric(value)
  }
    if(argCase=="normalize")
  {
    Ifnormalize=as.numeric(value)
  }

}

load(inputCamera)
cameraObject<-get(varNameForNextStep)
cameraPeakList<-getPeaklist(cameraObject)

phenotypeInfo<-read.csv(file = phenotypeInfoFile,stringsAsFactors = F)
#sepScore<-","
#if(scoreColumn=="q.value")
  sepScore="\t"

if(!is.na(scoreInput))
{
metfragRes<-read.table(file = scoreInput,header = T,sep = sepScore,quote="",stringsAsFactors = F,comment.char = "")

mappedToCamera<-metFragToCamera(metFragSearchResult = metfragRes,
                                cameraObject = cameraObject,MinusTime = rtTol,PlusTime = rtTol,ppm = ppmTol,method="par")

  VariableData<-data.frame(matrix("Unknown",nrow = nrow(cameraPeakList),
                                                                ncol = (ncol(metfragRes)+1)),stringsAsFactors = F)

  colnames(VariableData)<-c("variableMetadata",colnames(metfragRes))

  VariableData[,"variableMetadata"]<-paste("variable_",1:nrow(cameraPeakList),sep="")

  for(rnName in rownames(cameraPeakList))
  {
    if(rnName %in% names(mappedToCamera$mapped))
    {
      tmpId<-mappedToCamera$mapped[[rnName]]
      if(higherTheBetter)
        {
  tmpId<-tmpId[which.max(tmpId[,scoreColumn]),]
  }else{
  tmpId<-tmpId[which.min(tmpId[,scoreColumn]),]
  }

      VariableData[VariableData[,"variableMetadata"]==paste("variable_",rnName,sep=""),
                   c(2:ncol(VariableData))]<-tmpId
    }
  }

  if(impute)
  {

    toBeImputed<-rownames(VariableData[VariableData[,2]=="Unknown",])
    pcgroups<-cameraPeakList[rownames(cameraPeakList)%in%toBeImputed,"pcgroup"]

    for(pcgr in pcgroups)
    {
      selectedFeatures<-
        VariableData[,"variableMetadata"]%in%paste("variable_",rownames(cameraPeakList[cameraPeakList[,"pcgroup"]==pcgr,]),sep="") &
        VariableData[,2]!="Unknown"

      if(any(selectedFeatures))
      {
        tmpIDs<-VariableData[selectedFeatures,]
        tmpId<-NA
        if(higherTheBetter)
  {
  tmpId<-tmpIDs[which.max(tmpIDs[,scoreColumn]),]
  }else
  {
  tmpId<-tmpIDs[which.min(tmpIDs[,scoreColumn]),]
  }

        imputedVariables<- paste("variable_",rownames(cameraPeakList[ cameraPeakList[,"pcgroup"]==pcgr,]),sep="")

        imputedVariables<- VariableData[,"variableMetadata"]%in%imputedVariables & VariableData[,2]=="Unknown"

        VariableData[imputedVariables,c(2:ncol(VariableData))]<-tmpId[,c(2:ncol(tmpId))]
      }
    }

  }

}else{

VariableData<-data.frame(matrix("Unknown",nrow = nrow(cameraPeakList),
                                                              ncol = 2),stringsAsFactors = F)
colnames(VariableData)<-c("variableMetadata","extraColumn")
VariableData[,"variableMetadata"]<-paste("variable_",1:nrow(cameraPeakList),sep="")
}

peakMatrix<-c()
peakMatrixNames<-c()
peakMatrixTMP<-cameraPeakList
technicalReps<-c()

phenotypeInfo<-phenotypeInfo[phenotypeInfo[,typeColumn]==selectedType,]
for(i in 1:nrow(cameraObject@xcmsSet@phenoData))
{
  index<-which(phenotypeInfo==rownames(cameraObject@xcmsSet@phenoData)[i],arr.ind = T)[1]
  if(!is.na(index))
  {
    peakMatrix<-cbind(peakMatrix, peakMatrixTMP[,rownames(cameraObject@xcmsSet@phenoData)[i]])
    if(rename)
    {

      peakMatrixNames<-c(peakMatrixNames,phenotypeInfo[index,renameCol])
    }else
    {
      peakMatrixNames<-c(peakMatrixNames,phenotypeInfo[index,1])
      #peakMatrixNames<-c(peakMatrixNames,rownames(cameraObject@xcmsSet@phenoData)[i])
    }
    if(combineReplicate)
    {
      technicalReps<-c(technicalReps,phenotypeInfo[index,combineReplicateColumn])
    }

  }
}

peakMatrix<-data.frame(peakMatrix)
colnames(peakMatrix)<-peakMatrixNames

sampleMetaData<-c()
phenotypeInfo<-phenotypeInfo[,!grepl(pattern = "step_",x = colnames(phenotypeInfo),fixed=T)]
if(rename)
{

  sampleMetaData<-phenotypeInfo[,c(renameCol,colnames(phenotypeInfo)[colnames(phenotypeInfo)!=renameCol])]
}else
{
  sampleMetaData<-phenotypeInfo

}
colnames(sampleMetaData)[1]<-"sampleMetadata"

technicalReps<-technicalReps[match(sampleMetaData[,1],colnames(peakMatrix))]
peakMatrix<-peakMatrix[,match(sampleMetaData[,1],colnames(peakMatrix))]
peakMatrixNames<-colnames(peakMatrix)
if(combineReplicate)
{
  newpheno<-c()
  newNames<-c()
  combinedPeakMatrix<-c()
  techs<-unique(technicalReps)
  for(x in techs)
  {
    if(ncol(data.frame(peakMatrix[,technicalReps==x]))>1)
    {

      dataTMP<-apply(data.frame(peakMatrix[,technicalReps==x]),MARGIN = 1,FUN = median,na.rm=T)
      newNames<-c(newNames,as.character(unique(peakMatrixNames[technicalReps==x]))[1])
      newpheno<-rbind(newpheno,sampleMetaData[sampleMetaData[,combineReplicateColumn]==x,][1,])
      combinedPeakMatrix<-cbind(combinedPeakMatrix,dataTMP)
    }else
    {
      dataTMP<-peakMatrix[,technicalReps==x]
      newNames<-c(newNames,as.character(unique(peakMatrixNames[technicalReps==x]))[1])
      newpheno<-rbind(newpheno,sampleMetaData[sampleMetaData[,combineReplicateColumn]==x,][1,])
      combinedPeakMatrix<-cbind(combinedPeakMatrix,dataTMP)
    }
  }

  peakMatrix<-  combinedPeakMatrix
  peakMatrixNames<-newNames
  sampleMetaData<-newpheno[,colnames(newpheno)!=combineReplicateColumn]
}

peakMatrix<-data.frame(peakMatrix)
colnames(peakMatrix)<-peakMatrixNames

if(iflog)
{
peakMatrix<-log2(peakMatrix)
}
normalize.median <- function(x, weights = NULL) {
	l <- dim(x)[2]

	if(is.null(weights)) {
		for(j in 1:l)
			x[, j] <- x[, j] - median(x[, j], na.rm = TRUE)
	} else {
		for(j in 1:l)
			x[, j] <- x[, j] - weighted.median(x[, j], weights[, j],
				na.rm = TRUE)
	}

	x
}
 # normalize.regression
# based on pek
norm.regression <- function(x) {
		y<-rowMedians(as.matrix(x), na.rm=TRUE)
		for(j in 1:ncol(x)){
		fit<-lm(y~x[,j],na.action=na.exclude)
		x[,j] <- predict(fit,na.action=na.exclude)
		}
return(x)
}
normalize.reference <- function(x) {
{
		sel <-1
		y<-1
		for(j in 1:ncol(x)){
		as.matrix(sel)
		sel[j] <- length(which(!is.na(x[,j])))
		ref<-which.max(sel[])
		}
		for(j in 1:ncol(x))
		{
		     y[j]<-median(x[, j]-x[,ref], na.rm = TRUE)
		     x[, j] <- (x[, j]-y[j])

}

return(x)
}
}

if(!is.na(Ifnormalize))
{
    if(Ifnormalize==1)
peakMatrix<-limma::normalizeCyclicLoess(peakMatrix)
    if(Ifnormalize==2)
peakMatrix<-normalize.median(peakMatrix)
    if(Ifnormalize==3)
peakMatrix<-normalize.reference(peakMatrix)
    if(Ifnormalize==4)
peakMatrix<-norm.regression(peakMatrix)

}
if(!onlyReportWithID & !is.na(scoreInput))
{
  peakMatrix<-peakMatrix[VariableData[,2]!="Unknown",]
  VariableData<-VariableData[VariableData[,2]!="Unknown",]
}

sep_covWithGroup<-function(X,groups)
{
  lft_f<-X

  dt<-list()
  dt_cov<-list()
  for(x in unique(groups))
  {
    assign(x,lft_f[,groups==x])
    assign(paste(x,"_cov",sep=""),(apply((!is.na(get(x))),1,function(x1){sum(x1)})/dim(get(x))[2])*100)
    dt[[x]]<-get(x)
    dt_cov[[x]]<-get(paste(x,"_cov",sep=""))
  }

  return(list(dt,dt_cov))
}

if(sampleCoverage>0)
{
coverageLogical<-rep(T,nrow(peakMatrix))
if(sampleCoverageMethod=="global")
{

groups<-rep("g",nrow(sampleMetaData))
coverage<-sep_covWithGroup(peakMatrix,groups)
coverageLogical<-coverage[[2]]$g>sampleCoverage
}else{

groups<-sampleMetaData[,sampleCoverageMethod]

coverage<-sep_covWithGroup(peakMatrix,groups)

for(gr in unique(groups))
{
coverageLogical<-coverageLogical & (coverage[[2]][[gr]]>sampleCoverage)
}

}
peakMatrix<-peakMatrix[coverageLogical==T,]
VariableData<-VariableData[coverageLogical==T,]
}
peakMatrix<-cbind.data.frame(dataMatrix=VariableData[,"variableMetadata"],peakMatrix,stringsAsFactors = F)
VariableData<-sapply(VariableData, gsub, pattern="\'|#", replacement="")
VariableData<-VariableData[apply(is.na(peakMatrix),1,sum)!=(ncol(peakMatrix)-1),]
peakMatrix<-peakMatrix[apply(is.na(peakMatrix),1,sum)!=(ncol(peakMatrix)-1),]
#peakMatrix[VariableData[,2]!="Unknown",1]<-VariableData[VariableData[,2]!="Unknown","Identifier"]
#VariableData[VariableData[,2]!="Unknown",1]<-VariableData[VariableData[,2]!="Unknown","Identifier"]

write.table(x = peakMatrix,file = outputPeakTable,
            row.names = F,quote = F,sep = "\t")
write.table(x = VariableData,file = outputVariables,
            row.names = F,quote = F,sep = "\t")

write.table(x = sampleMetaData,file = outputMetaData,
            row.names = F,quote = F,sep = "\t")


# Calculate warming of the hottest hour
# Also calculate hottest future hours (add to climatology)

require(ncdf4)
require(abind)
require(raster)
require(data.table)

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

# read in TXx rcp26
infile <- nc_open('data_dl/cmip5/txx_yr_modmean_rcp26_ave.nc') # tasmax for each month
	# print(infile)
	tasmax26 <- ncvar_get(infile, 'txxETCCDI') # 144 x 72 x 240 lon x lat x years 1861-2100)
	dim(tasmax26)
	dimnames(tasmax26) <- list(lon=1:144, lat=1:72, time=1:240)
	dimnames(tasmax26)[[1]] <- infile$var[['txxETCCDI']]$dim[[1]]$vals # add lon
	dimnames(tasmax26)[[2]] <- infile$var[['txxETCCDI']]$dim[[2]]$vals # add lat
	dimnames(tasmax26)[[3]] <- 1861:2100 # year of the CMIP5 time dimension
	nc_close(infile)

# read in tos rcp26
infile <- nc_open('data_dl/cmip5/tos_Omon_modmean_rcp26_ave.nc') # tos for each month
	# print(infile)
	tos26 <- ncvar_get(infile, 'tos') # tos 288 x 144 x 2800 lon x lat x months 1861-2100
	dim(tos26)
	dimnames(tos26) <- list(lon=1:288, lat=1:144, time=1:2880)
	dimnames(tos26)[[1]] <- infile$var[['tos']]$dim[[1]]$vals # add lon
	dimnames(tos26)[[2]] <- infile$var[['tos']]$dim[[2]]$vals # add lat
	dimnames(tos26)[[3]] <- paste(rep(1861:2100, rep(12, length(1861:2100))), paste('_', 1:12, sep=''), sep='') # year and month of the CMIP5 time dimension
	nc_close(infile)

# read in TXx rcp85
infile <- nc_open('data_dl/cmip5/txx_yr_modmean_rcp85_ave.nc') # tasmax for each month
	# print(infile)
	tasmax85 <- ncvar_get(infile, 'txxETCCDI') # 144 x 72 x 240 lon x lat x years 1861-2100)
	dim(tasmax85)
	dimnames(tasmax85) <- list(lon=1:144, lat=1:72, time=1:240)
	dimnames(tasmax85)[[1]] <- infile$var[['txxETCCDI']]$dim[[1]]$vals # add lon
	dimnames(tasmax85)[[2]] <- infile$var[['txxETCCDI']]$dim[[2]]$vals # add lat
	dimnames(tasmax85)[[3]] <- 1861:2100 # year of the CMIP5 time dimension
	nc_close(infile)

# read in tos rcp85
infile <- nc_open('data_dl/cmip5/tos_Omon_modmean_rcp85_ave.nc') # tos for each month
	# print(infile)
	tos85 <- ncvar_get(infile, 'tos') # tos 288 x 144 x 2800 lon x lat x months 1861-2100
	dim(tos85)
	dimnames(tos85) <- list(lon=1:288, lat=1:144, time=1:2880)
	dimnames(tos85)[[1]] <- infile$var[['tos']]$dim[[1]]$vals # add lon
	dimnames(tos85)[[2]] <- infile$var[['tos']]$dim[[2]]$vals # add lat
	dimnames(tos85)[[3]] <- paste(rep(1861:2100, rep(12, length(1861:2100))), paste('_', 1:12, sep=''), sep='') # year and month of the CMIP5 time dimension
	nc_close(infile)

# read in DTR (daily temperature range)
load('temp/dtrclimatology_interp1.25.rdata') # dtr125

# read in max hr climatologies
load('temp/tosmax.rdata') # tosmax 0.25x0.25 from OISST daily + HadDTR
load('temp/hadex2_txx.rdata') # hadex2txx 2.5x3.75 from HadEX2
	tasmax <- hadex2txx

##################################################################################
# permute CMIP5 dimensions: lat x lon x time
# lat 90 to -90; lon 0 to 360
##################################################################################
# change dimension order
tasmax26 <- aperm(tasmax26, c(2,1,3))
tasmax85 <- aperm(tasmax85, c(2,1,3))
tos26 <- aperm(tos26, c(2,1,3))
tos85 <- aperm(tos85, c(2,1,3))

# rotate so columns 0 -> 360 lon, rows 90 -> -90 lat
	# tasmax26
lons <- as.numeric(colnames(tasmax26)) # good

lats <- as.numeric(rownames(tasmax26))
newlatord <- sort(lats, decreasing=TRUE)
newrownms <- as.character(newlatord)
newlatord <- as.character(newlatord)

tasmax26 <- tasmax26[newlatord, ,]

	#image(tasmax26[,,1]) # north pole should be at the left, America at the top

	# tasmax85
lons <- as.numeric(colnames(tasmax85)) # good

lats <- as.numeric(rownames(tasmax85))
newlatord <- sort(lats, decreasing=TRUE)
newrownms <- as.character(newlatord)
newlatord <- as.character(newlatord)

tasmax85 <- tasmax85[newlatord, ,]

	#image(tasmax85[,,1])

	# tos26
lons <- as.numeric(colnames(tos26)) # good

lats <- as.numeric(rownames(tos26))
newlatord <- sort(lats, decreasing=TRUE)
newrownms <- as.character(newlatord)
newlatord <- as.character(newlatord)

tos26 <- tos26[newlatord, ,]

	#image(tos26[,,1])

	# tos85
lons <- as.numeric(colnames(tos85)) # good

lats <- as.numeric(rownames(tos85))
newlatord <- sort(lats, decreasing=TRUE)
newrownms <- as.character(newlatord)
newlatord <- as.character(newlatord)

tos85 <- tos85[newlatord, ,]

	#image(tos85[,,1])

############################
# Compute tosmax26 and 86 (CMIP5 temperatures)
# Irrelevant since we compute a delta?
############################
# extend dtr125 so that it matches the dimensions of tos85
dtr125l <- abind(list(dtr125)[rep(1,dim(tos85)[3]/dim(dtr125)[3])], along=3)
	dim(dtr125l)
	dim(tos26)
	dim(tos85)

# add to get daily maximum
tosmax26 <- tos26 + 0.5*dtr125l
tosmax85 <- tos85 + 0.5*dtr125l

#############################################
# Calculate CMIP5 anomalies from 1986-2005
#############################################
climtime <- as.character(1986:2005) # year of the climatology period
futtime <- as.character(2006:2100) # year the future period

# Reshape CMIP5 to lat x lon x month x year
	# not needed for tasmax26 and tasmax85 since already annual TXx

	# tosmax26
nms <- dimnames(tosmax26)
mos <- as.numeric(unlist(strsplit(nms[[3]], split='_'))[seq(2,length(nms[[3]])*2,by=2)]) # months
yrs <- as.numeric(unlist(strsplit(nms[[3]], split='_'))[seq(1,length(nms[[3]])*2,by=2)]) # years
dm <- dim(tosmax26)
tosmax26bymo <- array(tosmax26, dim=c(dm[1], dm[2], 12, dm[3]/12), dimnames=list(lat=nms[[1]], lon=nms[[2]], mo=1:12, year=sort(unique(yrs)))) # add a month dimension (3rd dimension)

	# tosmax85
nms <- dimnames(tosmax85)
mos <- as.numeric(unlist(strsplit(nms[[3]], split='_'))[seq(2,length(nms[[3]])*2,by=2)]) # months
yrs <- as.numeric(unlist(strsplit(nms[[3]], split='_'))[seq(1,length(nms[[3]])*2,by=2)]) # years
dm <- dim(tosmax85)
tosmax85bymo <- array(tosmax85, dim=c(dm[1], dm[2], 12, dm[3]/12), dimnames=list(lat=nms[[1]], lon=nms[[2]], mo=1:12, year=sort(unique(yrs)))) # add a month dimension (3rd dimension)

# find highest daily max within years (TXx)
tasmax26yr <- tasmax26 # already annual TXx on land (HadEX2)
tasmax85yr <- tasmax85
tosmax26yr <- apply(tosmax26bymo, MARGIN=c(1,2,4), FUN=max)
tosmax85yr <- apply(tosmax85bymo, MARGIN=c(1,2,4), FUN=max)

# calculate climatology as the highest TXx across 20-year chunk
tasmax26clim <- apply(tasmax26yr[,,climtime], MARGIN=c(1,2), FUN=max) # climatological average for CMIP5
tasmax26climlong <- abind(list(tasmax26clim)[rep(1,length(futtime))], along=3) # expand to match future projections
	dim(tasmax26climlong)

tasmax85clim <- apply(tasmax85yr[,,climtime], MARGIN=c(1,2), FUN=max) # climatological average for CMIP5
tasmax85climlong <- abind(list(tasmax85clim)[rep(1,length(futtime))], along=3) # expand to match future projections
	dim(tasmax85climlong)

tosmax26clim <- apply(tosmax26yr[,,climtime], MARGIN=c(1,2), FUN=max)
tosmax26climlong <- abind(list(tosmax26clim)[rep(1,length(futtime))], along=3)
	dim(tosmax26climlong)

tosmax85clim <- apply(tosmax85yr[,,climtime], MARGIN=c(1,2), FUN=max)
tosmax85climlong <- abind(list(tosmax85clim)[rep(1,length(futtime))], along=3)
	dim(tosmax85climlong)

# calculate deltas by years
tasmax26dyr <- tasmax26yr[,,futtime] - tasmax26climlong # CMIP5 deltas
tasmax85dyr <- tasmax85yr[,,futtime] - tasmax85climlong # CMIP5 deltas
tosmax26dyr <- tosmax26yr[,,futtime] - tosmax26climlong
tosmax85dyr <- tosmax85yr[,,futtime] - tosmax85climlong

# write out for use in future_tsm_byyear.r
save(tasmax26dyr, file='temp/tasmax26dyr.rdata')
save(tasmax85dyr, file='temp/tasmax85dyr.rdata')
save(tosmax26dyr, file='temp/tosmax26dyr.rdata')
save(tosmax85dyr, file='temp/tosmax85dyr.rdata')

#######################################################
# average warming by latitude for 2081-2100 and write out
# for use in figure
#######################################################
# Make a "not ocean" mask
searast <- raster(!is.na(tos26[,,1]), xmn=0, xmx=360, ymn=-90, ymx=90) # 1 for ocean, 0 for land
landrast <- raster(tasmax26dyr[,,1], xmn=0, xmx=360, ymn=-90, ymx=90)
seamask <- round(resample(searast, landrast, method='bilinear')) # includes areas >=50% land as land (floor): 0 is land, 1 is ocean
seamask <- as.matrix(seamask)
seamask[seamask==1] <- NA # turn ocean to NA
seamask <- abind(list(seamask)[rep(1,dim(tasmax26dyr)[3])], along=3) # expand to match future projections

# mask out ocean for terrestrial air temp
tasmax26dyrmask <- tasmax26dyr + seamask
tasmax85dyrmask <- tasmax85dyr + seamask

# data.frame to hold results
lstwarmingbylat <- data.table(lat=as.numeric(dimnames(tasmax26dyr)[[1]]))
sstwarmingbylat <- data.table(lat=as.numeric(dimnames(tosmax26dyr)[[1]]))

# average by lat
lstwarmingbylat$tasmax26 <- apply(tasmax26dyrmask[,,as.character(2081:2100)], MARGIN=1, FUN=mean, na.rm=TRUE)
lstwarmingbylat$tasmax85 <- apply(tasmax85dyrmask[,,as.character(2081:2100)], MARGIN=1, FUN=mean, na.rm=TRUE)
sstwarmingbylat$tosmax26 <- apply(tosmax26dyr[,,as.character(2081:2100)], MARGIN=1, FUN=mean, na.rm=TRUE)
sstwarmingbylat$tosmax85 <- apply(tosmax85dyr[,,as.character(2081:2100)], MARGIN=1, FUN=mean, na.rm=TRUE)

	# plot to check
	lstwarmingbylat[,plot(lat, tasmax26, type='l', ylim=c(0,6))]
	lstwarmingbylat[,lines(lat, tasmax85, lty=2)]
	sstwarmingbylat[,lines(lat, tosmax26, col='blue')]
	sstwarmingbylat[,lines(lat, tosmax85, col='blue', lty=2)]

# SD by lat
lstwarmingbylat$tasmax26sd <- apply(tasmax26dyrmask[,,as.character(2081:2100)], MARGIN=1, FUN=sd, na.rm=TRUE)
lstwarmingbylat$tasmax85sd <- apply(tasmax85dyrmask[,,as.character(2081:2100)], MARGIN=1, FUN=sd, na.rm=TRUE)
sstwarmingbylat$tosmax26sd <- apply(tosmax26dyr[,,as.character(2081:2100)], MARGIN=1, FUN=sd, na.rm=TRUE)
sstwarmingbylat$tosmax85sd <- apply(tosmax85dyr[,,as.character(2081:2100)], MARGIN=1, FUN=sd, na.rm=TRUE)

# Sample size by lat
lstwarmingbylat$tasmax26n <- apply(tasmax26dyrmask[,,as.character(2081)], MARGIN=1, FUN=function(x) sum(!is.na(x)))
lstwarmingbylat$tasmax85n <- apply(tasmax85dyrmask[,,as.character(2081)], MARGIN=1, FUN=function(x) sum(!is.na(x)))
sstwarmingbylat$tosmax26n <- apply(tosmax26dyr[,,as.character(2081)], MARGIN=1, FUN=function(x) sum(!is.na(x)))
sstwarmingbylat$tosmax85n <- apply(tosmax85dyr[,,as.character(2081)], MARGIN=1, FUN=function(x) sum(!is.na(x)))

# write out
write.csv(lstwarmingbylat, file='temp/warmingmaxhr_bylat_land.csv')
write.csv(sstwarmingbylat, file='temp/warmingmaxhr_bylat_ocean.csv')

##################################################################
# Add deltas to climatology to get future temperatures 2081-2100
##################################################################
# average deltas for 2081-2100
tasmax26d2100 <- apply(tasmax26dyr[,,dimnames(tasmax26dyr)[[3]] %in% 2081:2100], MARGIN=c(1,2), FUN=max)
tasmax85d2100 <- apply(tasmax85dyr[,,dimnames(tasmax85dyr)[[3]] %in% 2081:2100], MARGIN=c(1,2), FUN=max)
tosmax26d2100 <- apply(tosmax26dyr[,,dimnames(tosmax26dyr)[[3]] %in% 2081:2100], MARGIN=c(1,2), FUN=max)
tosmax85d2100 <- apply(tosmax85dyr[,,dimnames(tosmax85dyr)[[3]] %in% 2081:2100], MARGIN=c(1,2), FUN=max)

# create rasters for interpolation
tasmax26d2100r <- raster(tasmax26d2100, xmn=0, xmx=360, ymn=-90, ymx=90)
tasmax85d2100r <- raster(tasmax85d2100, xmn=0, xmx=360, ymn=-90, ymx=90)
tosmax26d2100r <- raster(tosmax26d2100, xmn=0, xmx=360, ymn=-90, ymx=90)
tosmax85d2100r <- raster(tosmax85d2100, xmn=0, xmx=360, ymn=-90, ymx=90)

tasmaxr <- raster(tasmax, xmn=0, xmx=360, ymn=-90, ymx=90)
tosmaxr <- raster(tosmax, xmn=0, xmx=360, ymn=-90, ymx=90)

# interpolate to resolution of the climatology (2.5x3.75 on land, 0.25x0.25 in ocean)
tasmax26d2100_025r <- resample(tasmax26d2100r, tasmaxr, method='bilinear')
tasmax85d2100_025r <- resample(tasmax85d2100r, tasmaxr, method='bilinear')
tosmax26d2100_025r <- resample(tosmax26d2100r, tosmaxr, method='bilinear')
tosmax85d2100_025r <- resample(tosmax85d2100r, tosmaxr, method='bilinear')

# add deltas to climatologies
tasmax26_2100r <- tasmaxr + tasmax26d2100_025r
tasmax85_2100r <- tasmaxr + tasmax85d2100_025r
tosmax26_2100r <- tosmaxr + tosmax26d2100_025r
tosmax85_2100r <- tosmaxr + tosmax85d2100_025r

# convert to matrices
tasmax26_2100 <- as.matrix(tasmax26_2100r)
tasmax85_2100 <- as.matrix(tasmax85_2100r)
tosmax26_2100 <- as.matrix(tosmax26_2100r)
tosmax85_2100 <- as.matrix(tosmax85_2100r)

#############################################
# Average future temperatures by latitude
#############################################

# data.frame to hold results
lstmaxhrlat_2100 <- data.table(lat=yFromRow(tasmax26_2100r, 1:nrow(tasmax26_2100r)))
sstmaxhrlat_2100 <- data.table(lat=yFromRow(tosmax26_2100r,1:nrow(tosmax26_2100r)))

# average by lat
lstmaxhrlat_2100$tasmax26 <- apply(tasmax26_2100, MARGIN=1, FUN=mean, na.rm=TRUE)
lstmaxhrlat_2100$tasmax85 <- apply(tasmax85_2100, MARGIN=1, FUN=mean, na.rm=TRUE)
sstmaxhrlat_2100$tosmax26 <- apply(tosmax26_2100, MARGIN=1, FUN=mean, na.rm=TRUE)
sstmaxhrlat_2100$tosmax85 <- apply(tosmax85_2100, MARGIN=1, FUN=mean, na.rm=TRUE)

	# plot to check
	lstmaxhrlat_2100[,plot(lat, tasmax26, type='l', ylim=c(0,50))]
	lstmaxhrlat_2100[,lines(lat, tasmax85, lty=2)]
	sstmaxhrlat_2100[,lines(lat, tosmax26, col='blue')]
	sstmaxhrlat_2100[,lines(lat, tosmax85, col='blue', lty=2)]

# SD by lat
lstmaxhrlat_2100$tasmax26sd <- apply(tasmax26_2100, MARGIN=1, FUN=sd, na.rm=TRUE)
lstmaxhrlat_2100$tasmax85sd <- apply(tasmax85_2100, MARGIN=1, FUN=sd, na.rm=TRUE)
sstmaxhrlat_2100$tosmax26sd <- apply(tosmax26_2100, MARGIN=1, FUN=sd, na.rm=TRUE)
sstmaxhrlat_2100$tosmax85sd <- apply(tosmax85_2100, MARGIN=1, FUN=sd, na.rm=TRUE)

# Sample size by lat
lstmaxhrlat_2100$tasmax26n <- apply(tasmax26_2100, MARGIN=1, FUN=function(x) sum(!is.na(x)))
lstmaxhrlat_2100$tasmax85n <- apply(tasmax85_2100, MARGIN=1, FUN=function(x) sum(!is.na(x)))
sstmaxhrlat_2100$tosmax26n <- apply(tosmax26_2100, MARGIN=1, FUN=function(x) sum(!is.na(x)))
sstmaxhrlat_2100$tosmax85n <- apply(tosmax85_2100, MARGIN=1, FUN=function(x) sum(!is.na(x)))

# write out
write.csv(lstmaxhrlat_2100, file='temp/lstmaxhrlat_2081-2100.csv')
write.csv(sstmaxhrlat_2100, file='temp/sstmaxhrlat_2081-2100.csv')


(iRecreateData
RecreateData
p1
(dp2
S'min_score'
p3
I1
sS'mean_precision'
p4
F0
sS'un_mut_num_samples'
p5
I3
sS'poss_vals'
p6
(lp7
I1
aI2
aI3
aI4
aI5
aI6
aI7
aI8
aI9
aI10
asS'variance_precision'
p8
F2.2400000000000007
sS'un_mut_variance'
p9
F2.6000000000000001
sS'sols'
p10
(dp11
(F5
F1
tp12
(lp13
(lp14
I0
aI0
aI0
aI1
aI1
aI1
aI0
aI0
aI0
aI0
aas(F5
F4
tp15
(lp16
(lp17
I0
aI0
aI1
aI0
aI1
aI0
aI1
aI0
aI0
aI0
aas(F5
F3
tp18
(lp19
(lp20
I0
aI0
aI1
aI0
aI0
aI2
aI0
aI0
aI0
aI0
aa(lp21
I0
aI0
aI0
aI2
aI0
aI0
aI1
aI0
aI0
aI0
aassS'simpleData'
p22
(lp23
(lp24
I4
aI5
aI6
aa(lp25
I3
aI5
aI7
aa(lp26
I3
aI6
aI6
aa(lp27
I4
aI4
aI7
aasS'num_samples'
p28
I3
sS'debug'
p29
I01
sS'variance'
p30
F2.6000000000000001
sS'max_score'
p31
I10
sS'un_mut_mean'
p32
I5
sS'mean'
p33
I5
sb.


for (line in readLines(tail(commandArgs(), n=1))) {
  cat(sapply(strsplit(line, ","), function(s) {
    a <- table(s)
    m <- which.max(a)
    if (a[m] > length(s)/2) {
      names(m)
    } else {
      "None"
    }
  }), sep="\n")
}


library(devtools)
library(parallel)
devtools::load_all()
RNGkind("L'Ecuyer-CMRG")
data(grid)

seed <- 999983
s_k <- 1000
s_n <- 100
s_m <- 4

sim_type2_trig_1004 <- mclapply(r_grid_trig[-1], r_loop <- function(s_r) {
    type_2(seed, s_k, s_n, s_m, "trigonometric", s_r, L = 1000,
            fast.tn = F, semi.iter = F, center.bs = T)
}, mc.cores = 4)

save(sim_type2_trig_1004, file = "sim_type2_trig_1004.RData")


suppressMessages(library(ggplot2))
suppressMessages(library(multcomp))
suppressMessages(library(nlme))
suppressMessages(library(pastecs))
suppressMessages(library(reshape))
suppressMessages(library(tidyverse))
suppressMessages(library(sjPlot))
suppressMessages(library(sjmisc))
suppressMessages(library(dplyr))
suppressMessages(library(emmeans))

oldw <- getOption("warn")
options(warn = -1)

print("Plotting main effects in facets...")

myData <- read.csv(file="output/meltedDataThreeCategories.csv", header=TRUE, sep=",")

myData<-myData[!(myData$ScoreSystem=="B" | myData$ScoreSystem=="D"),]

levels(myData$ScoreSystem)[levels(myData$ScoreSystem) == "A"] <- "Competition"
levels(myData$ScoreSystem)[levels(myData$ScoreSystem) == "C"] <- "Mutual Help"

#myData$ScoreSystem <- factor(myData$ScoreSystem, levels=rev(levels(myData$ScoreSystem)))

myData$C <- factor(myData$C , levels=c("High", "Medium", "Low"))
myData$A <- factor(myData$A , levels=c("High", "Medium", "Low"))

lm0 = lm(takes ~ C * ScoreSystem, data = myData)
x <- emmip(lm0, C ~ ScoreSystem, engine="ggplot", CIs = TRUE) + labs(x="Game Version", y="Average Take Actions", colour="Conscienciousness") + theme(text = element_text(size=20)) + coord_cartesian(ylim=c(0,4)) + scale_x_discrete(labels=c("Competition", "Mutual Help"))
x + scale_colour_manual(values=c("#d7301f", "#fc8d59", "#fdcc8a"), labels=c("High", "Medium", "Low"), guide = guide_legend(reverse = FALSE)) #+ geom_jitter(aes(x = ScoreSystem, y = takes, colour = C), data = myData, pch = 20, width = 0.1, size=2)

suppressMessages(ggsave("plots/interactionEffects/takes/takes.png", height = 4, width = 10))

lm0 = lm(who ~ A * ScoreSystem, data = myData)
x <- emmip(lm0, A ~ ScoreSystem, engine="ggplot", CIs = TRUE) + labs(x="Game Version", y="Focus", colour="Agreeableness") + theme(text = element_text(size=20)) + coord_cartesian(ylim=c(1,7)) + scale_x_discrete(labels=c("Competition", "Mutual Help"))
x + scale_colour_manual(values=c("#d7301f", "#fc8d59", "#fdcc8a"), labels=c("High", "Medium", "Low"), guide = guide_legend(reverse = FALSE)) + scale_y_reverse("Focus", labels = as.character(c("Me  3","2", "1", "Neutral  0", "-1", "-2", "The Other  -3")), breaks = c(1,2,3,4,5,6,7)) #+ geom_jitter(aes(x = ScoreSystem, y = takes, colour = C), data = myData, pch = 20, width = 0.1, size=2)

suppressMessages(ggsave("plots/interactionEffects/who/who.png", height = 4, width = 10))

lm0 = lm(what ~ A * ScoreSystem, data = myData)
x <- emmip(lm0, A ~ ScoreSystem, engine="ggplot", CIs = TRUE) + labs(x="Game Version", y="Social Valence", colour="Agreeableness") + theme(text = element_text(size=20)) + coord_cartesian(ylim=c(1,7)) + scale_x_discrete(labels=c("Competition", "Mutual Help"))
x + scale_colour_manual(values=c("#d7301f", "#fc8d59", "#fdcc8a"), labels=c("High", "Medium", "Low"), guide = guide_legend(reverse = FALSE)) + scale_y_reverse("Social Valence", labels = as.character(c("Help  3","2", "1", "Neutral  0", "-1", "-2", "Complicate  -3")), breaks = c(1,2,3,4,5,6,7)) #+ geom_jitter(aes(x = ScoreSystem, y = takes, colour = C), data = myData, pch = 20, width = 0.1, size=2)

suppressMessages(ggsave("plots/interactionEffects/what/what.png", height = 4, width = 10))

options(warn = oldw)


library(RJSONIO)
library(factoextra)

root = "likelihood_incubation_exp/tuned/"
model_subdirs = list.dirs(root, recursive=FALSE)
model_subdirs = model_subdirs[!grepl("legacy", model_subdirs)]

models = list()
# unpack each fitted model's parameters
for (model_subdir in model_subdirs) {
  model_path = paste(model_subdir, "model.json", sep="/")
  model = fromJSON(model_path)
  as_row = c(model$beta, model$tau1, model$tau2, model$N0, model$A0, model$loss)
  models[[model_subdir]] = as_row
}
models = do.call("rbind", models)
models = data.frame(models)
colnames(models) = c(paste0("beta", 1:length(model$beta)), "tau1", "tau2", "N0", "A0", "loss")
X = models[colnames(models)[colnames(models) != "loss"]]
col_sds = apply(X, 2, sd)
col_means = apply(X, 2, mean)
X = sweep(X, 2, col_means, `-`)
X = sweep(X, 2, col_sds, `/`)

# perform k-means clustering at several numbers of clusters
wss = c()
clusterings = list()
for (k in 1:20) {
  clusters = kmeans(X, k, nstart=1000)
  wss = c(wss, clusters$tot.withinss)
  # de-normalize clusters
  clusters$centers = sweep(clusters$centers, 2, col_sds, `*`)
  clusters$centers = sweep(clusters$centers, 2, col_means, `+`)
  clusterings[[k]] = clusters
}
plot(1:length(wss), wss, "l")

# plot per-cluster mean loss
mean_cluster_losses = aggregate(models$loss, by=list(clusterings[[6]]$cluster), FUN=mean)
for (i in 1:5) {
  cluster_losses = models[clusterings[[5]]$cluster == i, "loss"]
  plot(1:length(cluster_losses), cluster_losses, main=paste("Losses for cluster", i))
}


context("itee iterator")

test_that("itee returns n independent numeric vectors", {
  # Iterate through each of the iterators without any order in mind
  iter_list <- itee(1:5, n=3)
  expect_equal(nextElem(iter_list[[1]]), 1)
  expect_equal(nextElem(iter_list[[1]]), 2)
  expect_equal(nextElem(iter_list[[1]]), 3)

  expect_equal(nextElem(iter_list[[2]]), 1)
  expect_equal(nextElem(iter_list[[2]]), 2)

  expect_equal(nextElem(iter_list[[3]]), 1)
  expect_equal(nextElem(iter_list[[3]]), 2)

  expect_equal(nextElem(iter_list[[1]]), 4)
  expect_equal(nextElem(iter_list[[1]]), 5)
  expect_error(nextElem(iter_list[[1]]), "StopIteration")

  expect_equal(nextElem(iter_list[[2]]), 3)
  expect_equal(nextElem(iter_list[[2]]), 4)
  expect_equal(nextElem(iter_list[[2]]), 5)
  expect_error(nextElem(iter_list[[2]]), "StopIteration")

  expect_equal(nextElem(iter_list[[3]]), 3)
  expect_equal(nextElem(iter_list[[3]]), 4)
  expect_equal(nextElem(iter_list[[3]]), 5)
  expect_error(nextElem(iter_list[[3]]), "StopIteration")

  # After the iterators are exhausted, ensure that they are truly exhausted
  expect_error(nextElem(iter_list[[1]]), "StopIteration")
  expect_error(nextElem(iter_list[[2]]), "StopIteration")
  expect_error(nextElem(iter_list[[3]]), "StopIteration")
})

# Based on GitHub Issue #36
test_that("itee returns n independent numeric vectors based on n iterators", {
  # Iterate through each of the iterators without any order in mind
  it <- iterators::iter(1:5)
  iter_list <- itee(it, n=3)
  expect_equal(nextElem(iter_list[[1]]), 1)
  expect_equal(nextElem(iter_list[[1]]), 2)
  expect_equal(nextElem(iter_list[[1]]), 3)

  expect_equal(nextElem(iter_list[[2]]), 1)
  expect_equal(nextElem(iter_list[[2]]), 2)

  expect_equal(nextElem(iter_list[[3]]), 1)
  expect_equal(nextElem(iter_list[[3]]), 2)

  expect_equal(nextElem(iter_list[[1]]), 4)
  expect_equal(nextElem(iter_list[[1]]), 5)
  expect_error(nextElem(iter_list[[1]]), "StopIteration")

  expect_equal(nextElem(iter_list[[2]]), 3)
  expect_equal(nextElem(iter_list[[2]]), 4)
  expect_equal(nextElem(iter_list[[2]]), 5)
  expect_error(nextElem(iter_list[[2]]), "StopIteration")

  expect_equal(nextElem(iter_list[[3]]), 3)
  expect_equal(nextElem(iter_list[[3]]), 4)
  expect_equal(nextElem(iter_list[[3]]), 5)
  expect_error(nextElem(iter_list[[3]]), "StopIteration")

  # After the iterators are exhausted, ensure that they are truly exhausted
  expect_error(nextElem(iter_list[[1]]), "StopIteration")
  expect_error(nextElem(iter_list[[2]]), "StopIteration")
  expect_error(nextElem(iter_list[[3]]), "StopIteration")
})


library(reprtree)
library(caret)
library(randomForest)
setwd("~/Documents/Models/variant-filtering")
set.seed(123) # here I fix the seed of the random generator to have the same random numbers if re-run

train_table="tables/K2H_AllVariants_All_Lib_NoMinAF_noequal_GOF_addVCFfeatures_illuminaBED_WES_samples_annotated_with_coverage_INFO_GENO_status_supp_features.txt"
test_table="tables/K2H_AllVariants_All_Lib_NoMinAF_noequal_GOF_addVCFfeatures_illuminaBED_WES_samples_annotated_with_coverage_INFO_GENO_status_supp_features.txt"

# if we want to test the downsampling
#train_table="downsampling/K2H_AllVariants_All_Lib_downsampling_noequal_GOF_addVCFfeatures_illuminaBED_WES_samples_annotated_with_coverage_INFO_GENO_status_supp_features.txt"
#test_table="downsampling/K2H_AllVariants_All_Lib_downsampling_noequal_GOF_addVCFfeatures_illuminaBED_WES_samples_annotated_with_coverage_INFO_GENO_status_supp_features.txt"

train_table = read.table(train_table, quote="\"", stringsAsFactors=F, sep="\t", header=T)
test_table = read.table(test_table, quote="\"", stringsAsFactors=F, sep="\t", header=T)

train_table$IoD = 1 + train_table$SIG * 10^(train_table$ERR)
test_table$IoD = 1 + test_table$SIG * 10^(test_table$ERR)

type="snv"
if(type=="snv"){
  train_table = train_table[which(train_table$TYPE_INFO=="snv"),]
}
if(type=="indel"){
  train_table = train_table[which(train_table$TYPE_INFO=="ins" | train_table$TYPE_INFO=="del"),]
}

train_table[which(is.infinite(train_table$MIN_DIST)),"MIN_DIST"] = 1000000000
train_table[which(is.infinite(train_table$MaxRatioWin)),"MaxRatioWin"] = 1000000000
test_table[which(is.infinite(test_table$MIN_DIST)),"MIN_DIST"] = 1000000000
test_table[which(is.infinite(test_table$MaxRatioWin)),"MaxRatioWin"] = 1000000000

propTP = as.numeric(table(train_table$status)["TP"] / nrow(train_table))
propFP = as.numeric(table(train_table$status)["FP"] / nrow(train_table))

my_features=c("status","RVSB", "QVAL","AF","ERR_INFO","DP", "medianDP_INFO",
              "FS", "MIN_DIST", "AO", "QUAL", "MaxRatioWin", "NbVarWin", "IoD", "HpLength", "N_QVAL_20_50_INFO")

if(exists("dbsnp_status")){
  if(dbsnp){
    train_table$WES_status = train_table$status
    train_table$status = "FP"
    train_table[which(!is.na(train_table$avsnp150)),"status"] = "TP"
  }
}

rf = randomForest(as.factor(status) ~ .,
                  data = train_table[,my_features],
                  importance = TRUE, # to allow us to inspect variable importance
                  ntree = 500, sampsize = as.numeric(table(train_table$status)["TP"]) #classwt = c(propTP, propFP), # weighted FP by propTP and TP by propFP
                  # ,maxnodes=10, nodesize=20
                  )

test_table$prediction = predict(rf, test_table)
sens = sum(test_table$status == "TP" & test_table$prediction == "TP") / sum(test_table$status == "TP")
fdr = 1 - (sum(test_table$status == "TP" & test_table$prediction == "TP") / sum(test_table$prediction == "TP"))

# look at variable importance
varImpPlot(rf)

# contruct the representative tree and plot it
# definition: Representative trees are, in some sense, trees in the ensemble which are on average the "closest" to
#             all the other trees in the ensemble.
tree = ReprTree(rf, train_table, metric='d2')
plot(tree)

# plot first tree from the forest : reprtree:::plot.getTree(rf, k = 1)

# use K-fold
kfold_spec = c()
kfold_sens = c()
kfold_TDR = c()

folds <- createFolds(test_table$status, 10)

for(i in 1:10){
  print(paste("fold: ",i,sep=""))
  test = test_table[folds[[i]],]
  train = test_table[-folds[[i]],]

  propTP = as.numeric(table(train$status)["TP"] / nrow(train))
  propFP = as.numeric(table(train$status)["FP"] / nrow(train))

  rf_fold = randomForest(as.factor(status) ~ .,
                         data = train[,my_features],
                         importance = TRUE, # to allow us to inspect variable importance
                         ntree = 500, sampsize = as.numeric(table(train$status)["TP"])) #classwt = c(propTP, propFP))
  test$prediction = predict(rf_fold, test)
  kfold_sens = c(kfold_sens, (sum(test$status == "TP" & test$prediction == "TP") / sum(test$status == "TP")) )
  kfold_spec = c(kfold_spec, (sum(test$status == "FP" & test$prediction == "FP") / sum(test$status == "FP")) )
  kfold_TDR = c(kfold_TDR, (sum(test$status == "TP" & test$prediction == "TP") / sum(test$prediction == "TP")) )
}

if(type=="snv") { boxplot(data.frame("TDR"=kfold_TDR, "sensitivity"=kfold_sens), col="lightgrey", ylim=c(0.85,1), outpch=20,
        outcex=0.75, axes=F, staplelwd=2, main=type)
axis(side=3, at=c(1,2), labels=c("TDR","sensitivity"), col = NA, col.ticks = NA)
axis(side=2, at=c("0.85","0.90","0.95","1")) }

if(type=="indel") { boxplot(data.frame("TDR"=kfold_TDR, "sensitivity"=kfold_sens), col="lightgrey", ylim=c(0,1), outpch=20,
                          outcex=0.75, axes=F, staplelwd=2, main=type)
  axis(side=3, at=c(1,2), labels=c("TDR","sensitivity"), col = NA, col.ticks = NA)
  axis(side=2, at=seq(0,1,by=0.1)) }

# load functions from MLP.r and run plot_ggviolin(kfold_TDR, kfold_sens, type)

# compare with home filters
train_table$prediction_home_filters = "FP"
train_table[which(train_table$AF>0.1 & train_table$RVSB<0.95 & train_table$DP>50 & train_table$ERR<(-2)),"prediction_home_filters"] = "TP"
sens_home_filter = sum(train_table$status=="TP" & train_table$prediction_home_filters=="TP") / sum(train_table$status=="TP")
TDR_home_filters = sum(train_table$status == "TP" & train_table$prediction_home_filters == "TP") / sum(train_table$prediction_home_filters == "TP")

points(1, TDR_home_filters, pch=8, col="darkred", lwd=2)
points(2, sens_home_filter, pch=8, col="darkred", lwd=2)

legend(x=2, y=0.88, c("AF>0.1","RVSB<0.95","DP>50","ERR<0.01"), col=c("black","white","white","white"), pch=4, bty="n", cex=0.75)

sens_rf = sum(train_table$status=="TP" & train_table$prediction=="TP") / sum(train_table$status=="TP")
TDR_rf = sum(train_table$status == "TP" & train_table$prediction == "TP") / sum(train_table$prediction == "TP")


##' @title diagnoseBiomass
##'
##' @param beem.out output of a beem run
##' @param true.biomass measured/true biomass (default: the biomass of last iteration)
##' @param alpha transparency parameter of the biomass lines
##' @description plot the trace of the fitted error of biomass
##' @author Chenhao Li, Niranjan Nagarajan
##' @export
diagnoseBiomass <- function(beem.out, true.biomass=NA, alpha=0.1,...){
    trace.m <- beem.out$trace.m
    nIter <- ncol(trace.m)
    if(any(is.na(true.biomass))){
        true.m <- trace.m[,nIter]
    }else{
        true.m <- true.biomass
    }
    rel.err.m <- (t((trace.m-true.m)/true.m))*100
    col <- rep(rgb(0,0,0,alpha), nrow(trace.m))
    col[beem.out$sample2rm] <- rgb(1,1,0, alpha)
    matplot(rel.err.m, type='l',
            xlab="Iterations",
            ylab="Relative difference (%)",
            main='Biomass trace',
            lty=1, lwd = 3,
            col=col,
            ...
            )
    lines(x=1:ncol(trace.m),y=apply(rel.err.m,1,median), col='red', lwd=5)
}

##' @title diagnoseFit
##'
##' @param beem.out output of a beem run
##' @param dat input data for the beem run
##' @param thre threshold of R2 to show the label
##' @param annotate display the label for the species with R2 > thre
##' @import ggplot2
##' @import ggrepel
##' @description plot the R2 value for each species
##' @author Chenhao Li, Niranjan Nagarajan
##' @export
diagnoseFit <- function(beem.out, dat, thre=0.5, annotate=TRUE){
    dat.tss <- tss(dat)
    r_ss <- rowSums(beem.out$err.p^2, na.rm=TRUE)
    if(length(beem.out$sample2rm) > 0 ) {
        dat.tss <- dat.tss[, -beem.out$sample2rm]
    }
    t_ss <- apply(dat.tss, 1, function(x) sum((x[x!=0]-mean(x[x!=0]))^2))
    r2 <- 1-r_ss/t_ss
    if(is.null(rownames(dat.tss))){
        species <- paste0('species', 1:nrow(dat.tss))
    }else{
        species <- rownames(dat)}
    plot.dat <- data.frame(r2=r2, species=species)

    p <- ggplot(plot.dat, aes(y=r2, x=species, label=species)) +
        geom_point(size=2) +
        geom_abline(intercept=thre, slope=0, lty=2, size=1.5, col='red') +
        labs(x='Species', y=expression(R^{2})) +
        coord_flip() +
        theme_bw()
    if(annotate){
        p <- p +
            geom_text_repel(data=subset(plot.dat, r2>thre))
    }
    p
}

##' @title checkPackage
##'
##' @param x package to check
##' @description Check if a package is available
##' @author Chenhao Li, Niranjan Nagarajan
checkPackage <- function(x){
    if (!requireNamespace(x, quietly = TRUE)) {
        stop(paste0("Package \"", x, "\" needed for this function to work. Please install it."),
             call. = FALSE)
    }
}

##' @title showInteraction
##'
##' @param beem.out output of a beem run
##' @param dat input data for the beem run
##' @param layout graph layout (see the documentation for ggraph)
##' @param node.text.size node text size
##' @param t.strength the threshold used to limit the number of interactions (strength)
##' @param t.stab the threshold used to limit the number of interactions (stability)
##' @description plot the interaction network inferred by beem (using ggraph)
##' @author Chenhao Li, Niranjan Nagarajan
##' @export
showInteraction <- function(beem.out, dat, layout='fr', node.text.size=2, t.strength=0.001, t.stab=0.8){
    checkPackage("ggraph")
    checkPackage("igraph")
    suppressMessages(require(igraph))
    suppressMessages(require(ggraph))
    b <- t(beem2param(beem.out)$b.est) ## need transpose
    diag(b) <- 0
    if(!is.null(beem.out$resample)){
        b[t(beem.out$resample$b.stab<t.stab)] <- 0
    }
    b[abs(b)<t.strength] <- 0

    g <- graph.adjacency(b, mode='directed', weighted='I')
    V(g)$label <- rownames(dat)
    V(g)$RelativeAbundance <- rowMeans(tss(dat))
    E(g)$Type <- ifelse( E(g)$I >0, '+', '-')
    E(g)$Strength <- abs(E(g)$I)
    g.simple <- delete.vertices(g, V(g)[degree(g) == 0])
    ggraph(g.simple, layout = layout)+#, circular=TRUE) +
        geom_edge_arc(aes(col=Type, width=Strength),arrow = arrow(length = unit(2, 'mm')),
                      curvature = 0.1, alpha=0.8,
                      end_cap=circle(1.5, 'mm'), start_cap=circle(1.5, 'mm')) +
        geom_node_point(pch=1, aes(size=RelativeAbundance)) +
        geom_node_text(aes(label = label), size=node.text.size, repel = TRUE) +
        scale_edge_width(range = c(0.5,1.5), guide=FALSE) +
        theme_void()
}

##' @title showGrowth
##'
##' @param beem.out output of a beem run
##' @param dat input data for the beem run
##' @description ordered barplot for growth rates
##' @import ggplot2
##' @author Chenhao Li, Niranjan Nagarajan
##' @export
showGrowth <- function(beem.out, dat){
    a <- beem2param(beem.out)$a.est
    ggplot(data.frame(Name=rownames(dat), Growth=a),
           aes(x=reorder(Name, Growth, function(x) x), y=Growth)) +
        geom_bar(stat='identity') +
        labs(x=NULL) + theme_bw() +
        coord_flip()
}

##' @title pcoa
##'
##' @param countData OTU/species abundance table (each row is one species, each column is one site)
##' @param col a vector of colors for the points
##' @description perform a PCoA analysis using Bray-Curtis distance
##' @importFrom vegan vegdist
##' @import ggplot2
##' @author Chenhao Li, Niranjan Nagarajan
##' @export
pcoa <- function(countData, col='Color'){
    dat.pcoa <- cmdscale(vegan::vegdist(t(countData)), eig=TRUE)
    per.var <- (dat.pcoa$eig/sum(dat.pcoa$eig))[1:2] * 100
    dat <- data.frame(dat.pcoa$points, col=col)
    ggplot(dat, aes(x=X1, y=X2, col=col)) +
        geom_point(size=2) +
        labs(x=paste0('MDS1 (', round(per.var[1], 2),'%)'),
             y=paste0('MDS2 (', round(per.var[2], 2),'%)'))
}

##' @title cluster
##'
##' @param countData OTU/species abundance table (each row is one species, each column is one site)
##' @description perform a hierachical clustering analysis using Bray-Curtis distance
##' @importFrom vegan vegdist
##' @author Chenhao Li, Niranjan Nagarajan
##' @export
cluster <- function(countData){
    hc <- hclust(vegan::vegdist(t(countData)))
    hc
}

##' @title auc.b
##'
##' @param b.est The estimated interaction network (This can be a correlation matrix and the edges will be ranked based on the absolute value of the correlation coefficents)
##' @param b.true The true interaction network
##' @param is.association b.est is an association structure
##' @author Chenhao Li, Niranjan Nagarajan
##' @description plot ROC curve with AUC for the interaction graph (interaction signs are ignored)
##' @export
auc.b <- function(b.est, b.true, is.association=FALSE, ...){
    checkPackage("pROC")
    diag(b.est) <- NA
    diag(b.true) <- NA
    if(is.association){
        b.true <- interaction2association(b.true)
        est <- b.est[lower.tri(b.est)]
        lab <- b.true[lower.tri(b.true)]
    }else{
        est <- c(b.est)
        lab <- c(b.true)
    }
    est <- abs(est[!is.na(est)])
    lab <- lab[!is.na(lab)]
    lab <- (lab!=0 ) *1
    pROC::plot.roc(lab,est, print.auc = TRUE, ...)
}

##' @title interaction2association
##'
##' @param m an interaction matrix
##' @author Chenhao Li, Niranjan Nagarajan
##' @description Convert interaction matrix to association matrix by taking the average of the symmetric entries
interaction2association <- function(m){
    m.cp <- m
    tmp <- (m[lower.tri(m)] + t(m)[lower.tri(m)])/2
    m.cp[lower.tri(m.cp)] <- tmp
    m.cp[upper.tri(m.cp)] <- tmp
    m.cp
}


# input args <- input file, popmap
args <- commandArgs(trailingOnly = TRUE)

# file name for parsing chromosome and window bounds
filename_simple <- strsplit(args[1], "windows/")[[1]][2]

# add functions for calculations
source("window_stat_calculations.r")

# define minimum number of sites to keep a fasta file
min_sites <- 50000

# no scientific notation
options(scipen=999)

# read in input file
input_file <- read.table(args[1], sep="\t", stringsAsFactors=F)

# subset input file
input_file_genotypes <- input_file[,4:ncol(input_file)]

# read in populations
populations <- read.table(args[2], sep="\t", stringsAsFactors=F, header=T)

# define output name
output_name <- paste(strsplit(args[1], ".simple")[[1]][1], "__stats.txt", sep="")

# write output file
write(c("pop1", "pop2", "stat", "chr", "start", "end", "number_sites", "number_variable_sites", "calculated_stat"), ncolumns=9, file=output_name, sep="\t")

# calculate heterozygosity for each individual
heterozygosity(input_file, populations, output_name, filename_simple)

# calculate differentiation statistics for each pairwise comparison
all_combinations <- combn(unique(populations$PopName), 2)
# keep only those where the species is the same in the combination
all_combinations <- all_combinations[,sapply(strsplit(all_combinations[1,], "_"), "[[", 1) == sapply(strsplit(all_combinations[2,], "_"), "[[", 1)]
for(a in 1:ncol(all_combinations)) {
	# define populations
	a_pop1 <- all_combinations[1,a]
	a_pop2 <- all_combinations[2,a]

	# subset vcf inputs
	a_input1 <- input_file_genotypes[,populations$PopName == a_pop1]
	if(is.null(dim(a_input1))) { a_input1 <- as.matrix(a_input1) }
	# remove sites that are not either invariant or bi-allelic SNPs
	a_input1 <- a_input1[nchar(input_file[,2]) == 1 & nchar(input_file[,3]) == 1, ]
	if(is.null(dim(a_input1))) { a_input1 <- as.matrix(a_input1) }

	a_input2 <- input_file_genotypes[,populations$PopName == a_pop2]
	if(is.null(dim(a_input2))) { a_input2 <- as.matrix(a_input2) }
	# remove sites that are not either invariant or bi-allelic SNPs
	a_input2 <- a_input2[nchar(input_file[,2]) == 1 & nchar(input_file[,3]) == 1, ]
	if(is.null(dim(a_input2))) { a_input2 <- as.matrix(a_input2) }

	# determine which sites have missing data and remove them
	a_input <- cbind(a_input1, a_input2)
	dont_keep <- apply(a_input, 1, any_missing)
	a_input1 <- a_input1[dont_keep == FALSE, ]
	if(is.null(dim(a_input1))) { a_input1 <- as.matrix(a_input1) }
	a_input2 <- a_input2[dont_keep == FALSE, ]
	if(is.null(dim(a_input2))) { a_input2 <- as.matrix(a_input2) }

	differentiation(a_input1, a_input2, a_pop1, a_pop2, output_name, filename_simple)

}


# Snow crab --- Areal unit modelling of habitat

# -------------------------------------------------
# Part 1 -- construct basic parameter list defining the main characteristics of the study

  year.assessment = 2020

  p = bio.snowcrab::snowcrab_parameters(
    project_class="carstm",
    yrs=2000:year.assessment,
    areal_units_type="tesselation",
    arstm_model_label = "nonseparable_space-time_pa_fishable_binomial",
    selection = list(type = "presence_absence")
  )

  if (0) {

      p$selection$type = "presence_absence"
      p$selection$biologicals=list(
        spec_bio=bio.taxonomy::taxonomy.recode( from="spec", to="parsimonious", tolookup=p$groundfish_species_code ),
        sex=0, # male
        mat=1, # do not use maturity status in groundfish data as it is suspect ..
        len= c( 95, 200 )/10, #  mm -> cm ; aegis_db in cm
        ranged_data="len"
      )
      p$selection$survey=list(
        data.source = c("snowcrab", "groundfish", "logbook"),
        yr = p$yrs,      # time frame for comparison specified above
        settype = 1, # same as geartype in groundfish_survey_db
        polygon_enforce=TRUE,  # make sure mis-classified stations or incorrectly entered positions get filtered out
        strata_toremove = NULL #,  # emphasize that all data enters analysis initially ..
        # ranged_data = c("dyear")  # not used .. just to show how to use range_data
      )
      p$variabletomodel = "pa"

      p$carstm_model_label = "nonseparable_space-time_pa_fishable_binomial"
      p$carstm_modelengine = "inla"
      p$formula = as.formula( paste(
        p$variabletomodel, ' ~ 1 ',
          ' + f( dyri, model="ar1", hyper=H$ar1 ) ',
          ' + f( inla.group( t, method="quantile", n=11 ), model="rw2", scale.model=TRUE, hyper=H$rw2) ',
          ' + f( inla.group( z, method="quantile", n=11 ), model="rw2", scale.model=TRUE, hyper=H$rw2) ',
          ' + f( inla.group( substrate.grainsize, method="quantile", n=11 ), model="rw2", scale.model=TRUE, hyper=H$rw2) ',
          ' + f( inla.group( pca1, method="quantile", n=11 ), model="rw2", scale.model=TRUE, hyper=H$rw2) ',
          ' + f( inla.group( pca2, method="quantile", n=11 ), model="rw2", scale.model=TRUE, hyper=H$rw2) ',
          ' + f( space, model="bym2", graph=slot(sppoly, "nb"), scale.model=TRUE, constr=TRUE, hyper=H$bym2 ) '
          ' + f( space_time, model="bym2", graph=slot(sppoly, "nb"), group=time_space, scale.model=TRUE, constr=TRUE, hyper=H$bym2, control.group=list(model="ar1", hyper=H$ar1_group)) '
      ) )

      p$family = "binomial"  # "nbinomial", "betabinomial", "zeroinflatedbinomial0" , "zeroinflatednbinomial0"
      p$carstm_model_inla_control_familiy = list(control.link=list(model='logit'))

    #  p$family  = "zeroinflatedbinomial1", #  "binomial",  # "nbinomial", "betabinomial", "zeroinflatedbinomial0" , "zeroinflatednbinomial0"
    #  p$carstm_model_inla_control_familiy = NULL

  }

  sppoly = areal_units( p=p )  # to reload
  plot( sppoly[, "au_sa_km2"]  )

  M = snowcrab.db( p=p, DS="carstm_inputs", redo=TRUE )  # will redo if not found

  fit = carstm_model( p=p, data='snowcrab.db( p=p, DS="carstm_inputs" )' ) # 151 configs and long optim .. 19 hrs

  # fit = carstm_model( p=p, DS="carstm_modelled_fit")

    # extract results
    if (0) {
      # very large files .. slow
      fit = carstm_model( p=p, DS="carstm_modelled_fit" )  # extract currently saved model fit
      plot(fit)
      plot(fit, plot.prior=TRUE, plot.hyperparameters=TRUE, plot.fixed.effects=FALSE )
    }

  res = carstm_model( p=p, DS="carstm_modelled_summary"  ) # to load currently saved results
  res$summary$dic$dic
  res$summary$dic$p.eff
  res$dyear

  plot_crs = p$aegis_proj4string_planar_km
  coastline=aegis.coastline::coastline_db( DS="eastcoast_gadm", project_to=plot_crs )
  isobaths=aegis.bathymetry::isobath_db( depths=c(50, 100, 200, 400), project_to=plot_crs )
  managementlines = aegis.polygons::area_lines.db( DS="cfa.regions", returntype="sf", project_to=plot_crs )

  time_match = list( year=as.character(2020)  )
  carstm_map(  res=res,
      vn="predictions",
      time_match=time_match ,
      coastline=coastline,
      managementlines=managementlines,
      isobaths=isobaths,
      main=paste("Habitat probability - mature male ", paste0(time_match, collapse="-") )
  )

  # map all :
  vn "= predictions"

  outputdir = file.path( p$modeldir, p$carstm_model_label, "predicted.probability.observation" )

  if ( !file.exists(outputdir)) dir.create( outputdir, recursive=TRUE, showWarnings=FALSE )

  brks = pretty(  res[[vn]]  )

  for (y in res$year ){

      time_match = list( year=y  )
      fn_root = paste("Predicted_abundance", paste0(time_match, collapse="-"), sep="_")
      fn = file.path( outputdir, paste(fn_root, "png", sep=".") )

        carstm_map(
          res=res,
          vn=vn,
          time_match=time_match,
          breaks =brks,
#          palette="-RdYlBu",
          coastline=coastline,
          isobaths=isobaths,
          managementlines=managementlines,
          main=paste("Habitat probability - mature male ", paste0(time_match, collapse="-") ),
          outfilename=fn
        )

  }

  snowcrab.db(p=p, DS="carstm_output_compute" )

  RES = snowcrab.db(p=p, DS="carstm_output_timeseries" )

  pa = snowcrab.db(p=p, DS="carstm_output_spacetime_pa"  )

# plots with 95% PI

  outputdir = file.path( p$modeldir, p$carstm_model_label, "aggregated_biomass_timeseries" )

  if ( !file.exists(outputdir)) dir.create( outputdir, recursive=TRUE, showWarnings=FALSE )

  (fn = file.path( outputdir, "cfa_all.png"))
  png( filename=fn, width=3072, height=2304, pointsize=12, res=300 )
    plot( cfaall ~ yrs, data=RES, lty="solid", lwd=4, pch=20, col="slateblue", type="b", ylab="Prob of observing snow crab", xlab="",  ylim=c(0,1))
    lines( cfaall_lb ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
    lines( cfaall_ub ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
  dev.off()

  (fn = file.path( outputdir, "cfa_south.png") )
  png( filename=fn, width=3072, height=2304, pointsize=12, res=300 )
    plot( cfasouth ~ yrs, data=RES, lty="solid", lwd=4, pch=20, col="slateblue", type="b", ylab="Prob of observing snow crab", xlab="",  ylim=c(0,1))
    lines( cfasouth_lb ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
    lines( cfasouth_ub ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
  dev.off()

  (fn = file.path( outputdir, "cfa_north.png"))
  png( filename=fn, width=3072, height=2304, pointsize=12, res=300 )
    plot( cfanorth ~ yrs, data=RES, lty="solid", lwd=4, pch=20, col="slateblue", type="b", ylab="Prob of observing snow crab", xlab="",  ylim=c(0,1))
    lines( cfanorth_lb ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
    lines( cfanorth_ub ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
  dev.off()

  (fn = file.path( outputdir, "cfa_4x.png"))
  png( filename=fn, width=3072, height=2304, pointsize=12, res=300 )
    plot( cfa4x ~ yrs, data=RES, lty="solid", lwd=4, pch=20, col="slateblue", type="b", ylab="Prob of observing snow crab", xlab="",  ylim=c(0,1))
    lines( cfa4x_lb ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
    lines( cfa4x_ub ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
  dev.off()

# end