options(bitmapType='cairo')

args = commandArgs(trailingOnly=TRUE)

inputFile = args[1]
outputFile = args[2]
fisherConditionFile=args[3]

#inputFile = "/scratch/cqs/shengq1/dnaseq/20161013_liuqi_gene_panel/bwa_refine_hc_gvcf_vqsr_annovar_filter_base1/result/Adenoma.base1.exac0.01.snv.tsv"
#outputFile = "/scratch/cqs/shengq1/dnaseq/20161013_liuqi_gene_panel/bwa_refine_hc_gvcf_vqsr_annovar_filter_base1/result/Adenoma.base1.exac0.01.snv.fisher.tsv"
#fisherConditionFile = "/scratch/cqs/shengq1/dnaseq/20161013_liuqi_gene_panel/documents/Base1RecurNorecur.txt"

cat("inputFile=", inputFile, "\n")
cat("outputFile=", outputFile, "\n")
cat("fisherConditionFile=", fisherConditionFile, "\n")

data=read.table(inputFile, sep="\t", header=T)

if("Chr" == colnames(data)[1]){
	rownames(data)=paste(data$Chr, data$Start, data$End, data$Ref, data$Alt, sep="_")
	infocolumns=c(1,2,3,4,5,7,9)
}else{
	rownames(data)=data$Gene
	infocolumns=c(1,2)
}

condition=read.table(fisherConditionFile, sep="\t", header=T, stringsAsFactor=F)
condition=condition[condition[,1] %in% colnames(data),]

uniqConds = unlist(unique(condition[,2]))
if(length(uniqConds) != 2){
  stop(paste0("Only two condition allowed for fisher test, now is " , paste(uniqConds, collapse=",")))
}

conditionData=data[,condition[,1]]

cond1=condition[,2]==uniqConds[1]
cond2=!cond1
cond1Count=sum(cond1)
cond2Count=sum(cond2)

ft <- apply(conditionData, 1, function(x){
			cond1data=x[cond1]
			cond2data=x[cond2]
			cond1true=sum(cond1data)
			cond1false=cond1Count-cond1true
			cond2true=sum(cond2data)
			cond2false=cond2Count-cond2true
			m = matrix(c(cond1true, cond1false, cond2true, cond2false),
					nrow=2,
					dimnames=list(cond1=c("yes", "no"),
					              cond2=c("yes", "no")))
			cat(m, "\n")
			ft=fisher.test(m)
			return(c(cond1true, cond1false, cond2true, cond2false, ft$p.value ))
		})

ft<-t(ft)
colnames(ft)<-c(paste0(uniqConds[1], c("True", "False")), paste0(uniqConds[2], c("True", "False")), "pValue" )
ft<-data.frame(ft)
ft<-ft[order(ft$pValue),]
fdata<-data.frame(data[rownames(ft), infocolumns], ft)
write.table(fdata, file=outputFile, sep="\t", row.names=F, quote=F)


## This replication file
## makes the following tables and figures:
# Figure 5

# Packages
library(MatchIt)
library(lmtest)
library(sandwich)
library(tidyverse)

##
# Figure 5
##

savepdf <- function(file, width=7.28, height=3.54){ # 3.46, 1.77
    fname <- paste("",file,".pdf",sep="")
    pdf(fname, width=width, height=height,
        pointsize=7)
    par(mgp=c(2.2,0.45,0), tcl=-0.4, mar=c(3.3,3.6,1.1,1.1))
}

savepdf("output/Fukumoto_Fig5")
par(mfcol=c(1,2))

p_path <- "preprocess/preprocess.0406.R"
m_path <- "matching_results/alt_att_0406_1000_1000.RDS"
source("genetic_matching/gen.0406.att.R")

plot(YMD[part.adj], average.C2, col = 2, lty = 2,
     xlim=c(YMD[part.adj[1]], YMD[part.adj[length(part.adj)]]),
     xlab="Day", ylab="Outcome",
     type="l",
     main = "a Outcome (April 6)",
     ylim=c(0,2))
lines(YMD[part.adj], average.C2, col = 2, lty = 1)
lines(YMD[part.adj], average.T2, lty = 1)
lines(YMD[part.adj], average.all.T2[part.adj], lty = 2)
abline(v=YMD[part.adj[8]], col = "turquoise") # April 6

plot(YMD[part.adj], summary.Match.out2[, 1],
     xlim=c(YMD[part.adj[1]], YMD[part.adj[length(part.adj)]]),
     ylim=c(-0.5,1.5),
     main = "b ATT",
     xlab="Day", ylab="ATT",
     type="l")
polygon(c(YMD[part.adj], rev(YMD[part.adj])), c(UB2, rev(LB2)), col = "gray90", border = "gray90")
lines(YMD[part.adj], summary.Match.out2[, 1], col = 1, lty = 1, lwd = 3)
abline(v=YMD[part.adj[8]], col = "turquoise") # April 6
abline(0,0,lty=2)

# Fukumoto_Fig5_a_source
Fukumoto_Fig5_a <- cbind(as.character(YMD[part.adj]), average.C2, average.T2, average.all.T2[part.adj])
colnames(Fukumoto_Fig5_a) <- c("date", "outcome average in matched control municipalities", "outcome average in matched treated municipalities",
                               "outcome average in all treated municipalities")
write.csv(Fukumoto_Fig5_a, "output/Fukumoto_Fig5_a_source.csv", row.names = FALSE)

# Fukumoto_Fig5_b_source
Fukumoto_Fig5_b <- cbind(as.character(YMD[part.adj]), summary.Match.out2[, 1], LB2, UB2)
colnames(Fukumoto_Fig5_b) <- c("date", "ATC", "lower bound of 95% confidence interval",
                               "upper bound of 95% confidence interval")
write.csv(Fukumoto_Fig5_b, "output/Fukumoto_Fig5_b_source.csv", row.names = FALSE)

#### Inserted by Endo A
saveRDS(m.out,"output/mout_ATT0406.rds")
####

dev.off()


#' More useful defaults for plotting matrices
#' @export

image0 <- function(x, xlab, ylab, yaxt, ...) {

  if (missing(xlab))
    xlab <- ""
  if (missing(ylab))
    ylab <- ""

  image(1:ncol(x), 1:nrow(x), t(x[nrow(x):1, ]), xlab=xlab, ylab=ylab, yaxt='n', ...)
  if (missing(yaxt) || yaxt != 'n')
    axis(2, nrow(x)-axTicks(2)+1, axTicks(2))
}


#' Title
#'
#' @param model
#' @param parms
#' @param rho_1_ini
#' @param times
#' @param method
#'
#' @return
#' @export
#' @examples
#'
#' library(foreach)
#' p <- set_parms(livestock$parms, set = list(b = 0.2,f = 0.8))
#' sim_trajectories(livestock, parms = p)
#'
#'

sim_trajectories<- function(model,
                          parms = model$parms,
                          rho_1_ini = seq(0,1, length = 11),
                          times = c(0,1000),
                          func =  model$pair,
                          method = "ode45") {

  # draw trajectories of mortality and growth
  ini <- list(
    rho_1 = c(rho_1_ini),
    rho_11 = c(0, NA)

  )

  ini <- expand.grid(ini)

  ini$rho_11[is.na(ini$rho_11)] <- ini$rho_1[is.na(ini$rho_11)] # replace NA-placeholder: assume maximal clustering, i.e. all vegetated cells have occupied neighbors. rho_11 == rho_1,

  rho <- ini_rho(ini$rho_1, ini$rho_11)
#
#   for(x in 1:nrow(ini)) {
#     temp <- unlist(expand_rho(c(ini[[x,1]], ini[[x,2]])))
#
#     #if(ini[x,]$rho_11 == 0) {
#     while(any(is.na(temp)) & ini[[x,2]] <= ini[[x,1]]) {
#       ini[[x,2]] <-  ini[[x,2]]+0.005
#       temp <- expand_rho(c(ini[[x,1]], ini[[x,2]]))
#     }
#
#     ini[x,] <- temp
#   }

  ini$q_11 <- q_11(rho) # <- data.frame(rho_1 = rho$rho_1, rho_11 = rho$rho_11)
  ini$m_ini <- mortality(rho, parms)
  ini$g_ini <- growth(rho, parms)

  ini <- cbind(ID = 1:nrow(ini),ini)
  ini <- subset(ini, !is.na(m_ini) & !is.na(ini$g_ini) &  ini$g_ini >= 0)

  foreach(iteration = ini$ID, .packages = c("deSolve")) %dopar% {

    rho_starting <- ini_rho(ini$rho_1[ini$ID == iteration],ini$rho_11[ini$ID == iteration])

    # running the ode-solver
    runmodel <- run_ode(rho_starting, func = func, times = 1.05^seq(0,100,1), parms = parms, method = method)
    colnames(runmodel) <- c("time", "rho_1", "rho_11")
    return(as.data.frame(runmodel))
  } -> output

  return(output)
}


# GetShockData_compare_pct67.r
#                                       RBLandau 20171230
# where to run?
# setwd("C:/cygwin64/home/landau/working/PreservationSimulation/shocks/compare/pct67")
#
# For copies=3,4,5, what are the failure rates at shock impact 67%?
#

source("./DataUtil.r")
source("./PlotUtil.r")

# G E T   D A T A
if (exists("results")) {rm(results)}
results <- fndfGetGiantData("./")
# Get fewer columns to work with, easier to see.
dat.shockallcopies <- as.data.frame(fndfGetShockData(results))
dat.shockall <- dat.shockallcopies[dat.shockallcopies$copies>=3
                & dat.shockallcopies$copies<=5,]

# S U B S E T S

if (nrow(dat.shockall) > 0)
{
    source("./ShockLowPlots.r")

    dat.shockspan2 <- dat.shockall[dat.shockall$shockspan==2,]
    gp <- fnPlotShock1(dat.shockspan2, nFreq=2, nDuration=12, nSpan=2, nImpact=67)
    plot(gp)
    fnPlotMakeFile(gp, "Shock_compare_copvar_freq2yr_dur1yr_span2_impact67.png")

    dat.shockspan3 <- dat.shockall[dat.shockall$shockspan==3,]
    gp <- fnPlotShock1(dat.shockspan3, nFreq=2, nDuration=12, nSpan=3, nImpact=67)
    plot(gp)
    fnPlotMakeFile(gp, "Shock_compare_copvar_freq2yr_dur1yr_span3_impact67.png")

}

# Unwind any remaining sink()s to close output files.
while (sink.number() > 0) {sink()}

#END


# plotmat(): Simple plotting using a square matrix mat (filled with 0/1). v. 8/31/16
# Where: mat - matrix; fn - file name; clr - color; ttl - plot title;
#        dflg - writing dump file flag (0-no/1-yes): psz - picture size.
plotmat <- function(mat, fn, clr, ttl, dflg=0, psz=600) {
  m <- nrow(mat); d <- 0;
  X=NULL; Y=NULL;
  pf = paste0(fn, ".png"); df = paste0(fn, ".dmp");
  for (i in 1:m) {
    for (j in 1:m) {if(mat[i,j]==0){next} else {d=d+1; X[d] <- i; Y[d] <- j;} }
  };
  cat(" *** Matrix(", m,"x",m,")", d, "DOTS\n");
  # Dumping if requested (dflg=1).
  if (dflg==1) {dump(c("X","Y"), df); cat(" *** Dump file:", df, "\n")};
  # Plotting
  plot(X,Y, main=ttl, axes=FALSE, xlab="", ylab="", col=clr, pch=20);
  dev.copy(png, filename=pf, width=psz, height=psz);
  # Cleaning
  dev.off(); graphics.off();
}

# plotv2(): Simple plotting using 2 vectors (dumped into ".dmp" file by plotmat()).
# Where: fn - file name; clr - color; ttl - plot title; psz - picture size.
# v. 8/31/16
plotv2 <- function(fn, clr, ttl, psz=600) {
  cat(" *** START:", date(), "clr=", clr, "psz=", psz, "\n");
  cat(" *** File name -", fn, "\n");
  pf = paste0(fn, ".png"); df = paste0(fn, ".dmp");
  source(df);
  d <- length(X);
  cat(" *** Source dump-file:", df, d, "DOTS\n");
  cat(" *** Plot file -", pf, "\n");
  # Plotting
  plot(X, Y, main=ttl, axes=FALSE, xlab="", ylab="", col=clr, pch=20);
  # Writing png-file
  dev.copy(png, filename=pf, width=psz, height=psz);
  # Cleaning
  dev.off(); graphics.off();
  cat(" *** END:", date(), "\n");
}


library(ggplot2)
library(dplyr)
library(shiny)
library(lubridate)
library(stringr)
library(gridExtra)
library(RCurl)
library(scales)

shinyServer(function(input, output) {

  ########LOAD SONAR#######
  load("data/sonar.rda")
  ########GET REALTIME#####
  load("data/rt_dat.rda")
  ########TEST FISH########
  load("data/testFish.rda")

  #input <- list(year = c(2002,2012),
  #              start_date = "06-30",
  #              end_date = "08-05")

    foo <- sonar
    year(foo$date) <- 2015
    average_sonar <- foo %>% group_by(date) %>% summarize(mean = mean(n))

  sonar_reactive <- reactive({
    year(sonar$date) <- 2014
    factor(sonar$year)
    start_year <- input$year[1]
    end_year   <- input$year[2]
    start_date <- ymd(paste("2014", input$start_date, sep = "-"))
    end_date   <- ymd(paste("2014", input$end_date, sep = "-"))

    sonar %>%
      filter(year >= start_year, year <= end_year,
             date >= start_date,
             date <= end_date) %>%
      mutate(year = factor(year))

  #sonar_reactive <- sonar
  })

  realtime_reactive <- reactive({
    return(rt_dat2)
    #realtime_reactive <- rt_dat
  })
  ########################

  #######PLOTING#########
  prior_barchart <- reactive({
    p <- ggplot(data = sonar_reactive(), aes(x = date, y = n, group = year, fill = year)) +
         geom_bar(stat = "identity") + ylab("Cumulative Daily Count Across Years") + xlab("Date") +
      scale_y_continuous(labels =comma)
    return(p)
  })

  ######Publishing#########

  output$realtime <- renderPlot({
  x <- getURL("http://www.adfg.alaska.gov/sf/FishCounts/index.cfm?ADFG=export.excel&countLocationID=40&year=2015&speciesID=420")
  this_season <- read.csv(text = x, sep = "\t")
  this_season$count_date <- ymd(paste(this_season$year, this_season$count_date))
  blank <- this_season[1,]
  blank$fish_count <- 0
  blank$count_date <- blank$count_date - days(1)
  this_season <- rbind(this_season, blank)

  ggplot(data = average_sonar, aes(x = date, y = mean)) + geom_line() +
     geom_bar(data = this_season, aes(x = count_date, y = fish_count), fill = "red", stat = "identity") +
     ylab("Fish Count") + xlab("Date") + ggtitle("Kenai River Sockeye")  +
     geom_vline(xintercept = as.numeric(ymd("2015-07-10")), linetype = "dashed", colour="#000099") +
     geom_vline(xintercept = as.numeric(ymd("2015-07-31")), linetype = "dashed", colour="#000099") +
    scale_y_continuous(labels =comma)

  })

  ###TABSET: PRIOR DATA####
  output$linechart <- renderPlot({
    print(prior_linechart())
  })

  output$barchart <- renderPlot({
    p <- prior_barchart()
    print(p)
  })

})
  ##TABSET: ABOUT


library(dplyr, warn.conflicts = FALSE)
library(utils)

# Annotator functions for example situation

# Helper functions

## Mastery evaluation
eval_mastery_unknown <- function(x){ 10 >= mean(x) && mean(x) >= 7 }

eval_positive_trend <- function(x){
  is_tail_ascending <- !is.unsorted(utils::tail(x,3), strictly=T)
  return(is_tail_ascending)
}

eval_negative_trend <- function(x){
  is_tail_descending <- !is.unsorted(rev(utils::tail(x,3)), strictly=T)
  return(is_tail_descending)
}

## Gap size evaluation
GUIDELINE <- 10

## Gap size evaluation
eval_small_gap <- function(x){
  gap <- (GUIDELINE - x)
  1 >= gap && gap > 0
}

eval_medium_gap <- function(x){
  gap <- (GUIDELINE - x)
  3 >= gap && gap > 1
}

eval_large_gap <- function(x){
  gap <- (GUIDELINE - x) > 3
}

# Annotation functions
annotate_negative_gap <- function(data, spek){
  data %>%
    group_by(id) %>%
    dplyr::filter(timepoint == max(timepoint)) %>%
    summarize(negative_gap = performance < GUIDELINE )
}

annotate_positive_trend <- function(data, spek){
  data %>%
    group_by(id) %>%
    arrange(timepoint) %>%
    summarize(positive_trend = eval_positive_trend(performance))
}

annotate_negative_trend <- function(data, spek){
  data %>%
    group_by(id) %>%
    arrange(timepoint) %>%
    summarize(negative_trend = eval_negative_trend(performance))
}

annotate_small_gap <- function(data, spek){
  data %>% group_by(id) %>%
    dplyr::filter(timepoint == max(timepoint)) %>%
    summarize(small_gap = eval_small_gap(performance))
}

annotate_medium_gap <- function(data, spek){
  data %>% group_by(id) %>%
    dplyr::filter(timepoint == max(timepoint)) %>%
    summarize(medium_gap = eval_medium_gap(performance))
}

annotate_large_gap <- function(data, spek){
  data %>% group_by(id) %>%
    dplyr::filter(timepoint == max(timepoint)) %>%
    summarize(large_gap = eval_large_gap(performance))
}

annotate_mastery_present <- function(data, spek){
  data %>% group_by(id) %>%
    summarize(mastery_present = mean(performance) > 10)
}

annotate_mastery_absent <- function(data, spek){
  data %>% group_by(id) %>%
    summarize(mastery_absent = mean(performance) < 7)
}

annotate_mastery_unknown <- function(data, spek){
  data %>% group_by(id) %>%
    summarize(mastery_unknown = eval_mastery_unknown(performance))
}


#' Converts surveys to age matrices
#'
#' Converts West Coast style surveys (total abundance and age comps) into catch at age matrices for age consistency plots.
#' @param asap name of the variable that read in the asap.rdat file
#' @return list with catch at age matrices by index
#' @export

ConvertSurveyToAtAge <- function(asap){
  # takes West Coast style surveys and converts them to catch at age matrices
  index.mats <- list()
  index.mats$ob <- list()
  index.mats$pr <- list()
  weight.mat.counter <- 0
  years <- asap$parms$styr:asap$parms$endyr
  for (ind in 1:asap$parms$nindices){
    if (asap$control.parms$index.age.comp.flag[ind] == 1){  # used age composition for the index
      # get the aggregate index observed and predicted time series
      agg.ob <- asap$index.obs[[ind]]
      agg.pr <- asap$index.pred[[ind]]

      # get proportions for correct years and ages only
      age.min <- asap$control.parms$index.sel.start.age[ind]
      age.max <- asap$control.parms$index.sel.end.age[ind]
      props.ob <- asap$index.comp.mats[[(ind*2-1)]][asap$index.year.counter[[ind]],age.min:age.max]
      props.pr <- asap$index.comp.mats[[(ind*2)]][asap$index.year.counter[[ind]],age.min:age.max]

      # figure out units for aggregate and proportions
      agg.units <- asap$control.parms$index.units.aggregate[ind]
      prp.units <- asap$control.parms$index.units.proportions[ind]

      # get weight (matrix if necessary)
      if (agg.units==1 || prp.units==1){  # either in weight
        weight.mat.counter <- weight.mat.counter+1
        use.me <- weight.mat.counter + (asap$parms$nfleets * 2) + 4
        waa <- asap$WAA.mats[[use.me]][asap$index.year.counter[[ind]],age.min:age.max]
      }

      # create index.obs and pred based on which of the four possible combinations of units is used for this index
      if (agg.units==1 && prp.units==1){  # both in weight
        index.ob <- agg.ob * props.ob / waa
        index.pr <- agg.pr * props.pr / waa
      }
      if (agg.units==1 && prp.units==2){  # agg in weight, props in numbers
        index.ob <- wtprop2caa(agg.ob,waa,props.ob)  # use catch function
        index.pr <- wtprop2caa(agg.pr,waa,props.pr)
      }
      if (agg.units==2 && prp.units==1){  # agg in numbers, props in weight
        # need to search for correct agg total in weight to result in observed agg total in number
        # for now just use simple approximation that agg.wt = sum(waa*prop) *ctot and then solve using both in weight approach
        agg.wt.ob <- apply((waa * props.ob),1,sum) * agg.ob
        agg.wt.pr <- apply((waa * props.pr),1,sum) * agg.pr
        index.ob <- agg.wt.ob * props.ob / waa
        index.pr <- agg.wt.pr * props.pr / waa
      }
      if (agg.units==2 && prp.units==2){  # both in numbers
        index.ob <- agg.ob * props.ob
        index.pr <- agg.pr * props.pr
      }

      # put matrices into full year matrix (ages only for selected ages though)
      # need to do this to account for missing years of data interspersed in time series
      index.ob.full <- matrix(NA, nrow=asap$parms$nyears, ncol=(age.max-age.min+1))
      index.pr.full <- matrix(NA, nrow=asap$parms$nyears, ncol=(age.max-age.min+1))
      for (i in 1:asap$index.nobs[ind]){
        index.ob.full[asap$index.year.counter[[ind]][i],] <- as.vector(index.ob[i,])
        index.pr.full[asap$index.year.counter[[ind]][i],] <- as.vector(index.pr[i,])
      }

      # save the results for this index
      index.mats$ob[[ind]] <- index.ob.full
      index.mats$pr[[ind]] <- index.pr.full
      # NEW 9/23/2016 added year and age labels to matrices for use with Sinclair Z functions
      rownames(index.mats$ob[[ind]]) <- years
      rownames(index.mats$pr[[ind]]) <- years
      colnames(index.mats$ob[[ind]]) <- age.min:age.max
      colnames(index.mats$pr[[ind]]) <- age.min:age.max
    }
    if (asap$control.parms$index.age.comp.flag[ind] != 1){  # cannot use this index
      index.mats$ob[[ind]] <- NA
      index.mats$pr[[ind]] <- NA
    }
  }
  return(index.mats)
}


b -> c (6): a -> b (5)
c -> a (7): b -> c (6)
a -> d (1): c -> a (7)
d -> c (2): a -> d (1)
c -> e (3): d -> c (2)
e -> a (4): c -> e (3)


########################################
## cfg							      ##
########################################
source("cfg.r")
graphics.off()

limits = c(1, 10, 20, 30, 40, 50, 60, 70)
cols = c("white", "#AAAA00", "#003300")

limits_stn = c(0.25, 0.5, 0.75)#c(0.1, 0.25, 0.75, 0.9)
limits_pot = limits_stn#c(0.2, 0.4, 0.6, 0.8)
limits_sen = limits_stn#c(0.2, 0.4, 0.6, 0.8)
cols = c("FF", "BB","88", "44", "00")

dlimits = c(-40, -20, -10, -5, -2, -1, 1, 2, 5, 10, 20, 40)
dcols = c("#330000", "#DD0033", "#FF33FF", "white", "#FFFF00", "#00FF00", "#003300")
items = c(2, 6, 5, 4)

########################################
## load and analyes  			      ##
########################################

plot4pr_droughts <- function(fire_dataset, pr_dataset, drought_var) {
    out = makeOrLoadEnsembles(fire_dataset = fire_dataset, pr_dataset = pr_dataset,
                              drought_var = drought_var)
    lim = lapply(items, function(i) selectOutput(out, i)[[1]])
    sen = lapply(items, function(i)  tail(selectOutput(out, i), 1)[[1]])

    xy = xyFromCell(lim[[1]], 1:length(lim[[1]]))
    mlim = lim

    tot = lim[[1]] * lim[[2]] * lim[[3]] * lim[[4]]

    pot <- function(i) {
        limi = lim[-i]
        return((limi[[1]] * limi[[2]] * limi[[3]] - tot))
    }
    nlim = lapply(1:4, pot)
    #nlim[[2]] = nlim[[2]] * 10
    tot = nlim[[1]] + nlim[[2]] + nlim[[3]] + nlim[[4]]
    nlim = lapply(nlim, function(i) i/tot)

    mlim = lapply(lim, function(i) 1-i)
    #sen[[2]] = sen[[2]] * 10
    #mlim[[3]] = mlim[[3]] * 10
    #nlim = mlim[[1]] + mlim[[2]] + mlim[[3]] + mlim[[4]]
    #nlim = lapply(mlim, '/', nlim)

    plotMap <- function(x, limits, fname = '', normalise = FALSE,
                        ePatternRes = 50, ePatternThick = 0.4) {
	x = lapply(x, function(i) max.raster(i, na.rm = TRUE) *
                               (i-min.raster(i, na.rm = TRUE))/
                               diff(range.raster(i, na.rm = TRUE)))

	#2.5:4.5
	pout = lapply(x, values)

	if (normalise) cols = rev(cols)
	# if rev: c,m,y else: c,m,y

        print(limits)
	plot_4way(xy[,1], xy[,2], pout[[1]], pout[[3]], pout[[2]], pout[[4]],
			  x_range = c(-120, 160), y_range = c(-30, 30),
			  cols = c(cols), limits = limits,
			  coast.lwd=par("lwd"),
                          ePatternRes = ePatternRes, ePatternThick = ePatternThick,
			  add_legend=FALSE, smooth_image=FALSE,smooth_factor=5,
                          normalise = normalise)
        mask = raster('data/seamask.nc')
        plot_raster_from_raster(mask, x_range = c(-120, 160), y_range = c(-30, 30),
                                add = TRUE, col = c("white", "transparent"), limits = c(0.5),
                                quick = TRUE, interior = FALSE, coast.lwd = NULL,
                                add_legend = FALSE)

    }

    plotMaps <- function(x, fname, limits, ...) {
	plotStuff <- function(ID1, FUN1, FUN2, FUN3 = NULL, txt = '') {
            x0 = x
	    x[[ID1]] = FUN1(x[[ID1]])
	    x[-ID1] = lapply(x[-ID1], FUN2)
            if (!is.null(FUN3)) x = mapply(function(x, x0) x - FUN3(x0), x, x0)
            #browser()
	    plotMap(x, limits = limits, ...)
            mtext(txt)
	}
        if (!is.null(fname)) {
            fname = paste('figs/limPlot', fname, '.png', sep = '')
	    png(fname, height = 2.4, width = 4.75, res = 300, unit = 'in')
	    print(fname)
	   # layout(rbind(t(matrix(1:6, ncol = 3)), 7), heights = c(1,1,1,0.5))
	    par(mfrow = c(3, 2), mar = c(1, 0, 1, 0), oma = c(0,0,0.5, 0))
        }

	    plotStuff(1, mean, mean)
        if (is.null(fname)) return()
            mtext(paste(LETTERS[1], '', 'Mean'))
            add_raster_4way_legend(cols = cols ,limits = limits,
				   labs = c('<- Moisture', 'Fuel ->',
                                            'Igntions ->', 'Land Use'))

	    mapply(plotStuff, 1:4, txt =  paste(LETTERS[2:5], '', 'Max',
                                                 c('MAP', 'MAT', 'stress', 'exclusion')),
                   MoreArgs = list( function(i) max(i),  function(i) min(i)))
	    #mapply(plotStuff, 1:4, paste('min', 1:4), MoreArgs = list( function(i) min(i),  function(i) max(i)))

        dev.off()#.gitWatermark()
    }

    fname = paste0(pr_dataset, '-', drought_var, '-')
    #plotMaps(mlim, paste0(fname, 'standard'), limits_stn)
    plotMaps(nlim, paste0(fname, 'potential'), limits_pot)
    plotMaps(sen, paste0(fname, 'sensitivity'), limits_sen)

    fname = paste0('figs/lim_pop_sen_maps', fname, '.png')

    png(fname, width = 4.75, height = 2.7*2, units = 'in', res = 300)
        layout(rbind(1, 2, 3, 4))
        par(mar = rep(0, 4), oma = c(0, 0, 1, 0))
        plotMaps(mlim, NULL, limits_stn, ePatternRes = 40, ePatternThick = 0.6)
        mtext(paste(LETTERS[1], '', 'Standard limitation'), line = -0.75)
        plotMaps(nlim, NULL, limits_pot, FALSE, ePatternRes = 40, ePatternThick = 0.6)
        mtext(paste(LETTERS[1], '', 'Potential limitation'), line = -0.75)
        plotMaps(sen, NULL, limits_sen, ePatternRes = 40, ePatternThick = 0.6)
        mtext(paste(LETTERS[2], '', 'Sensitivity'), line = -0.75)
    dev.off()
    browser()
}

plot4pr_droughts("GFED_four_s", 'MSWEP', 'MADD')
#runAll_pr_droughts(plot4pr_droughts)


#
# Exemplo 3
#

# atribui valores para x1 e x2
x1 <- 0.3815
x2 <- 123456789015
# cálculo 1
resultado1 <- (x1 + x2) - x2
resultado1
# cálculo 2
resultado2 <- x1 + (x2 - x2)
resultado2


############################################################
# Exports_plot
#
# y - vector of years
# p - vector of annual production amounts

Exports_plot <- function(countryID='MZM_WORLD',countrylist=c('BP_WORLD'),
                         datasource='BP_2012',fuel='oil',units='mtoe',
                         overlay='MZM_NONE',yscalecode='auto',showmap='M',
                         special_years=c(),special_x=1975,special_y=90,special_text='',
                         firstyear=1965,lastyear=2011,txt=list()) {

  # Default plotting parameters
  par(las=1, lend='butt')

  # set up map colors
  color_export_map = '#22CCAA'
  color_import_map = '#EE5555'
  color_missing_map = 'gray90'
  color_net_0_map = '#AAAAB9'

  # set up plot colors
  color_exports = '#00BB99'
  color_imports = 'firebrick2'  #EE2C2C
  color_consumption = 'black'
  color_production = 'gray80'
  color_production_decades = 'gray75'
  color_guide_lines = 'gray95'
  color_overlay = 'black'
  color_yscalecode = 'black'

  # set up text colors
  color_labels_text = 'black'
  color_production_text = 'gray40'
  color_consumption_text = 'black'
  color_export_text = '#008050'
  color_import_text = 'firebrick3'
  color_overlay_text = 'black'
  color_yscalecode_text = 'black'
  color_missing_text = 'gray80'
  color_net_0_text = '#777799'

  color_map_label_1 = 'black'
  color_map_label_2 = 'black'

  include_plot_label_1 = TRUE  # Consumption
  include_plot_label_2 = TRUE  # Production
  include_plot_label_3 = FALSE # Exports
  include_plot_label_4 = FALSE # Imports

  include_map_label_1 = FALSE
  include_map_label_2 = FALSE

  yscale = 0
  divisor = 1
  # set up defaults for each datasource
  if (fuel == 'coal') {

    # Only 'mtoe' units are available for Coal
    if (units == 'mtoe') {
      divisor = 1
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 600 }
      if (yscalecode == 'world') { yscale = 3500 }
    } else if (units == 'joule') {
      # NOTE:  1 mtoe ~= 0.042 exajoules
      divisor = 1/0.042
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 25 }
      if (yscalecode == 'world') { yscale = 150 }
    }

  } else if (fuel == 'oil') {

    if (units == 'bbl') {
      divisor = 1000
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 22 }
      if (yscalecode == 'world') { yscale = 85 }
    } else if (units == 'mtoe') {
      divisor = 1
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 1000 }
      if (yscalecode == 'world') { yscale = 4000 }
    } else if (units == 'joule') {
      # NOTE:  1 mtoe ~= 0.042 exajoules
      divisor = 1/0.042
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 40 }
      if (yscalecode == 'world') { yscale = 170 }
    }

  } else if (fuel == 'gas') {

    if (units == 'ft3') {
      divisor = 1
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 65 }
      if (yscalecode == 'world') { yscale = 300 }
    } else if (units == 'mtoe') {
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 650 }
      if (yscalecode == 'world') { yscale = 3000 }
    } else if (units == 'm3') {
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 650 }
      if (yscalecode == 'world') { yscale = 3000 }
    } else if (units == 'joule') {
      # NOTE:  1 mtoe ~= 0.042 exajoules
      divisor = 1/0.042
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 25 }
      if (yscalecode == 'world') { yscale = 120 }
    }

  } else if (fuel == 'nuclear') {

    if (units == 'twh') {
      divisor = 1
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 800 }
      if (yscalecode == 'world') { yscale = 3000 }
    } else if (units == 'mtoe') {
      divisor = 1
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 200 }
      if (yscalecode == 'world') { yscale = 700 }
    } else if (units == 'joule') {
      # NOTE: 1 Terawatt-hour = 0.0036 Exajoules
      divisor = 1 / 0.0036
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 3 }
      if (yscalecode == 'world') { yscale = 12 }
    }

  } else if (fuel == 'hydro') {

    if (units == 'twh') {
      divisor = 1
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 300 }
      if (yscalecode == 'world') { yscale = 3000 }
    } else if (units == 'mtoe') {
      divisor = 1
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 75 }
      if (yscalecode == 'world') { yscale = 750 }
    } else if (units == 'joule') {
      # NOTE: 1 Terawatt-hour = 0.0036 Exajoules
      divisor = 1 / 0.0036
      if (yscalecode == 'auto') { yscale = 0 }
      if (yscalecode == 'us') { yscale = 2 }
      if (yscalecode == 'world') { yscale = 12 }
    }

  } else {

    divisor = 1

  }

  # For testing the EIA data
  if (datasource == 'EIA_2008' && fuel == 'oil') {
    divisor = 1000
  }

  # Defaults for named labels
  map_label_1 = ''
  map_label_2 = ''
  special_note = ''
  warning_text = ''

  # Set up arrays of zeroes and NA's
  y = c(firstyear:lastyear)
  y_p = y + 0.5
  y_p1 = y + 1.0
  y_m = y - 0.5
  zeroes = y * 0.0
  missing = y * NA
  n = lastyear - firstyear + 1

  # Create the production and consumption data frames:
  # Production data exist for all fuel types except 'nuclear' and 'hydro' where BP assumes production = consumption

  if (units == 'joule') {
    if (fuel == 'nuclear' || fuel == 'hydro') {
      filename = paste('/var/www/mazamascience.com/html/OilExport/',datasource,'_',fuel,'_consumption_twh.csv',sep='',collapse='')
    } else {
      filename = paste('/var/www/mazamascience.com/html/OilExport/',datasource,'_',fuel,'_consumption_mtoe.csv',sep='',collapse='')
    }
  } else {
    filename = paste('/var/www/mazamascience.com/html/OilExport/',datasource,'_',fuel,'_consumption_',units,'.csv',sep='',collapse='')
  }

  c1 = read.csv(file=filename,skip=6,na.strings=c('na'))
  c4 = c1 / divisor

  if (fuel == 'nuclear' || fuel == 'hydro') {
    p4 = c4
  } else {
    if (units == 'joule') {
      filename = paste('/var/www/mazamascience.com/html/OilExport/',datasource,'_',fuel,'_production_mtoe.csv',sep='',collapse='')
    } else {
      filename = paste('/var/www/mazamascience.com/html/OilExport/',datasource,'_',fuel,'_production_',units,'.csv',sep='',collapse='')
    }
    p1 = read.csv(file=filename,skip=6,na.strings=c('na'))
    p4 = p1 / divisor
  }

  # For every country in the list
  # 1) production is zero if not listed (BP is keeping track of all the major producers.)
  # 2) consumption is zero if not listed (We know it won't be negative and we'd at least like to calculate a minimum.
  #    But we keep track of countries with missing consumption data because it is probably growing and we'd like to
  #    let folks know we're only displaying a minimum here.)

  production_data_missing = FALSE
  consumption_data_missing = FALSE
  production = zeroes       # total production for all countries in the list
  consumption = zeroes      # total consumption for all countries in the list
  exportable_oil = zeroes   # total exportable oil for all countries in the list
  ei_col = countrylist
  country_index = 0
  for (country in countrylist) {
    country_consumption_data_missing = FALSE
    country_production_data_missing = FALSE
    country_index = country_index + 1
    # NOTE:  R will do 'partial matches' of "YE" to "YEAR".
    # NOTE:  To avoid this, we need to use the more complicated match() method
    ###if (is.null(p4[[country]])) {
    ###if (is.null(p4[,match(country,names(p4))])) {
    # NOTE:  R 2.14 generates a "no columns selected" error with the above.
    # NOTE:  So we're trying something new
    if (!(country %in% names(p4))) {
      country_production_data_missing = TRUE
      production_data_missing = TRUE
      p5 = zeroes
    } else {
      p5 = as.numeric(as.character(p4[,match(country,names(p4))]))
    }
    # NOTE:  R will do 'partial matches' of "YE" to "YEAR".
    # NOTE:  To avoid this, we need to use the more complicated match() method
    ###if (is.null(c4[[country]])) {
    ###if (is.null(c4[,match(country,names(c4))])) {
    # NOTE:  R 2.14 generates a "no columns selected" error with the above.
    # NOTE:  So we're trying something new
    if (!(country %in% names(c4))) {
      country_consumption_data_missing = TRUE
      consumption_data_missing = TRUE
      c5 = zeroes
    } else {
      c5 = as.numeric(as.character(c4[,match(country,names(c4))]))
    }
    production = production + p5
    consumption = consumption + c5
    national_export = pmax(zeroes,(p5-c5),na.rm=TRUE)  # Assume NA means 'zero' for national_export
    exportable_oil = exportable_oil + national_export

    if (country_production_data_missing && country_consumption_data_missing) {
      ei_col[country_index] = c(color_missing_map)
      map_label_2 = txt$missing
      include_map_label_2 = TRUE
      color_map_label_2 = color_missing_text
    } else if (is.na(p5[n]) || is.na(c5[n]) || country_consumption_data_missing) {
      ei_col[country_index] = c(color_export_map)
    } else {
      # If production is within +/- 0.5% of consumption, color this country 'net_0'
      if (p5[n] > (c5[n] * 1.005)) {
        ei_col[country_index] = c(color_export_map)
      } else if (c5[n] > (p5[n] * 1.005)) {
        ei_col[country_index] = c(color_import_map)
      } else {
        ei_col[country_index] = c(color_net_0_map)
        map_label_1 = txt$net_0
        include_map_label_1 = TRUE
        color_map_label_1 = color_net_0_text
      }
    }

    # Override ei_col for BP 'other' groupings which have totals but no inidvidual country data.
    bp_other_groups = c('BP_OSCA','BP_OEE','BP_OME','BP_OAF','BP_OAP')
    if (country %in% bp_other_groups) {
      ei_col[country_index] = c(color_missing_map)
      map_label_2 = txt$missing
      include_map_label_2 = TRUE
      color_map_label_2 = color_missing_text
    }

    # Override ei_col for 'nuclear' and 'hydro'.  Color only countries with non-zero, non-missing production.
    # (Otherwise everything ends up with color_net_0_map.)
    if (fuel == 'nuclear' || fuel == 'hydro') {
      if (p5[n] >= 0.001) { # 0.001 works for units of mtoe, twh and joules
        ei_col[country_index] = c(color_export_map)
      } else {
        ei_col[country_index] = c(color_missing_map)
      }
      # Now set the labeling information
      if (fuel == 'nuclear') {
        map_label_1 = txt$nuclear
        map_label_2 = txt$missing
      } else {
        map_label_1 = txt$hydro
        map_label_2 = txt$missing
      }
      include_map_label_1 = TRUE
      include_map_label_2 = TRUE
      color_map_label_1 = color_export_text
      color_map_label_2 = color_missing_text
    }

  } # End of "for (country in countrylist)" loop

  if (country_production_data_missing && country_consumption_data_missing && length(countrylist) == 1) {
    warning_text = txt$msg_nodata
  }

  # Now that we have created the ei_col list of colors for all countries involved we
  # need to check to see if this is a special grouping that has it's own row in the
  # BP data files.  In such a case we use the BP_~ row instead of our sum as the sum
  # will have missing values if even one small nation has missing values.  The BP
  # special groupings do not have missing values and we'll just assume that BP did
  # things right.

  # The following groups should be available in all BP data files
  # BP_TNA   Total North America
  # BP_OSCA  Other South & Central America
  # BP_TSCA  Total South & Central America
  # BP_OEE   Other Europe & Eurasia
  # BP_TEE   Total Europe & Eurasia
  # BP_OME   Other Middle East
  # BP_TME   Total Middle East
  # BP_OAF   Other Africa
  # BP_TAF   Total Africa
  # BP_OAP   Other Asia-Pacific
  # BP_TAP   Total Asia-Pacific
  # BP_WORLD World
  # BP_OECD  OECD
  # BP_FSU   Former Soviet Untion

  special_groups = c('MZM_TNA','MZM_OSCA','MZM_TSCA','MZM_OEE','MZM_TEE','MZM_OME','MZM_TME',
                     'MZM_OAF','MZM_TAF','MZM_OAP','MZM_TAP','MZM_WORLD','MZM_OECD','MZM_FSU')
  MZM_to_BP = list('MZM_TNA'='BP_TNA',
                   'MZM_OSCA'='BP_OSCA',
                   'MZM_TSCA'='BP_TSCA',
                   'MZM_OEE'='BP_OEE',
                   'MZM_TEE'='BP_TEE',
                   'MZM_OME'='BP_OME',
                   'MZM_TME'='BP_TME',
                   'MZM_OAF'='BP_OAF',
                   'MZM_TAF'='BP_TAF',
                   'MZM_OAP'='BP_OAP',
                   'MZM_TAP'='BP_TAP',
                   'MZM_WORLD'='BP_WORLD',
                   'MZM_OECD'='BP_OECD',
                   'MZM_FSU'='BP_FSU')

  if ( countryID %in% special_groups ) {
    consumption_data_missing = FALSE
    BP_ID = MZM_to_BP[[countryID]]
    if (is.null(p4[[BP_ID]])) {
      production = zeroes
    } else {
      production = as.numeric(as.character(p4[[BP_ID]]))
    }
    if (is.null(c4[[BP_ID]])) {
      consumption_data_missing = TRUE
      consumption = zeroes
    } else {
      consumption = as.numeric(as.character(c4[[BP_ID]]))
    }
  }

  # Create the special_note
  if (consumption_data_missing) {
    if (length(countrylist) == 1) {
      special_note = txt$note_nodata
    } else {
      special_note = txt$note_minvalue
    }
  }

  # Create a masks to identify decades and hilighted years
  #           5 6 7 8 970 1 2 3 4 5 6 7 8 980 1 2 3 4 5 6 7 8 990 1 2 3 4 5 6 7 8 900 1 2 3 4 5 6 7 8 910 1
  decades = c(0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,1,1)
  ### SAVE ### special_years = c(1980,1981,1982,1983,1992)
  label_years = zeroes
  for (year in special_years) {
    year_index = year - 1964
    label_years[year_index] = 1
  }

  # Line width must be just enough to cause histogram bars to overlap.
  # This will depend upon the width of the graphic.
  lwd = 10

  # Now for the actual plot

  exports = production - consumption     # Positive or negative
  exports_0 = pmax(exports, exports * 0) # Positive or zero only

  if (yscale == 0) {
    pcmax = pmax(production,consumption,na.rm=FALSE)
    ylo = min(exports,na.rm=TRUE)
    ylo = min(ylo,0)
    yhi = max(pcmax,na.rm=TRUE)
    yscale = max(abs(ylo),yhi)
    if (yscale == 0) { yscale = 1 }
  }

  # The production graph goes on the bottom, shaded by decade
  plot(production ~ y_p, axes=FALSE, type='h', lwd=lwd, col=color_production,
                         xlim=c(1954,2014), ylim=c(-1.0*yscale,yscale),
                         main='', xlab='', ylab='')
  axis(1)
  axis(4,las=0)
  points(production*decades ~ y_p, type='h', lwd=lwd, col=color_production_decades)

  # Add user selected years associated with a label
  ### SAVE ### points(production*label_years ~ y_p, type='h', lwd=lwd, col='gray50')

  # Add exports and imports on top (for the 'world' plot exportable_oil)
  if (countryID == 'MZM_WORLD') {
    points(exportable_oil ~ y_p, type='h', lwd=lwd, col=color_exports)
  } else {
    # The variable with both pos + neg values is plotted first in the 'import' color.
    # Then the variable with pos-only values is overlayed in the 'export' color.
    if (!consumption_data_missing || length(countrylist) > 1) {
      points(exports ~ y_p, type='h', lwd=lwd, col=color_imports)
      ### SAVE ### points(exports*label_years ~ y_p, type='h', lwd=lwd, col='firebrick4')
      points(exports_0 ~ y_p, type='h', lwd=lwd, col=color_exports)
      ### SAVE ### points(exports_0*label_years ~ y_p, type='h', lwd=lwd, col='#44DDAA')
    }
  }

  # Add year guides (thin gray lines that mark the decades)
  guide_years = c(1970,1980,1990,2000,2010)
  guide_indices = c(6,16,26,36,46)
  guides = production[guide_indices]
  points(guides ~ guide_years, type='h', lwd=2, col=color_guide_lines)
  guides = exports[guide_indices]
  points(guides ~ guide_years, type='h', lwd=2, col=color_guide_lines)

  # Add the overlay line
  if (overlay != 'MZM_NONE') {
    overlay_consumption = as.numeric(as.character(c4[[overlay]]))
    points(overlay_consumption ~ y, type='s', lwd=1, col=color_overlay)
    points(overlay_consumption ~ y_p1, type='S', lwd=1, col=color_overlay)
  }

  # Add the consumption line for the 'yscalecode'
  if (yscalecode == 'us') {
    yscalecode_consumption = c4[['US']]
    points(yscalecode_consumption ~ y, type='s', lwd=1, col=color_yscalecode)
    points(yscalecode_consumption ~ y_p1, type='S', lwd=1, col=color_yscalecode)
  } else if (yscalecode == 'world') {
    yscalecode_consumption = c4[['BP_WORLD']]
    points(yscalecode_consumption ~ y, type='s', lwd=1, col=color_yscalecode)
    points(yscalecode_consumption ~ y_p1, type='S', lwd=1, col=color_yscalecode)
  } else {
    noop = 1
  }

  # The consumption line goes on top
  if (!consumption_data_missing || length(countrylist) > 1) {
    points(consumption ~ y, type='s', lwd=3, col=color_consumption)
    points(consumption ~ y_p1, type='S', lwd=3, col=color_consumption)
  }

  # Lastly, calculate labeling information
  height = exports[n]
  if (abs(exports[n-1]) > 0) {
    if (countryID == 'MZM_WORLD') {
      pct_chg = 100 * (production[n] - production[n-1]) / abs(production[n-1])
    } else {
      pct_chg = 100 * (exports[n] - exports[n-1]) / abs(exports[n-1])
    }

    if (is.na(pct_chg)) {
      pct_chg_string = '--'
    } else {
      pct_chg_string = as.character(abs(pct_chg))
      if (pct_chg >= 100) {
        pct_chg_string = strtrim(pct_chg_string,5)
      } else if (pct_chg >= 10) {
        pct_chg_string = strtrim(pct_chg_string,4)
      } else {
        pct_chg_string = strtrim(pct_chg_string,3)
      }
    }
  } else {
    pct_chg_string = '--'
  }

  # Exports
  if (height > 0) {
    if (exports[n] > exports[n-1] ) {
      if (consumption_data_missing && length(countrylist) == 1) {
        ei_text = txt$production_increased
      } else {
        ei_text = txt$exports_increased
      }
    } else {
      if (consumption_data_missing && length(countrylist) == 1) {
        ei_text = txt$production_decreased
      } else {
        ei_text = txt$exports_decreased
      }
    }

  # Imports
  } else {
    if (exports[n] > exports[n-1] ) {
      ei_text = txt$imports_decreased
    } else {
      ei_text = txt$imports_increased
    }
  }

  # Special case for the entire world
  if (countryID == 'MZM_WORLD') {
    if (production[n] > production[n-1] ) {
      ei_text = txt$production_increased
    } else {
      ei_text = txt$production_decreased
    }
  }

  # Override the titles for 'nuclear' and 'hydro' where BP assumes production = consumption
  if (fuel == 'nuclear' || fuel == 'hydro') {

    pct_chg = 100 * (production[n] - production[n-1]) / abs(production[n-1])
    if (is.na(pct_chg)) {
      pct_chg_string = '--'
    } else {
      pct_chg_string = as.character(abs(pct_chg))
      if (pct_chg >= 100) {
        pct_chg_string = strtrim(pct_chg_string,5)
      } else if (pct_chg >= 10) {
        pct_chg_string = strtrim(pct_chg_string,4)
      } else {
        pct_chg_string = strtrim(pct_chg_string,3)
      }
    }

    if (production[n] > production[n-1] ) {
      ei_text = txt$production_increased
    } else {
      ei_text = txt$production_decreased
    }

  }

  # Add the title
  if (showmap == 'M') {
    main1_line = 3
    main_line = 1.5
  } else {
    main1_line = 5
    main_line = 3
  }
  title(main=txt$main1,line=main1_line,cex.main=2.0,xpd=NA)
  label = paste(txt$fromto,ei_text,pct_chg_string,'%')
  title(main=label,line=main_line,xpd=NA)
  # Add the mazamascience.com and datasource attribution
  title(sub=txt$subtitle,line=2.5,family='Times',col=color_labels_text,xpd=NA)

  # Add the axis labels
  mtext(text=txt$year,side=1,line=0.8,cex=1.0,adj=0,xpd=TRUE)
  mtext(text=txt$units,side=4,line=3.0,cex=1.2,las=0,xpd=NA)
  if (units == 'mtoe') {
    if (fuel == 'nuclear' | fuel == 'hydro') {
      mtext(text=txt$efficiency,side=4,line=4.5,cex=1.0,las=0,xpd=NA)
    }
  }

  # Add a legend as colored text labels on the left
  if (showmap == 'M') {
    label_size = 1.2
  } else {
    label_size = 1.2
  }
  if (showmap == 'M') {
    if (include_map_label_1) {
      mtext(text=map_label_1,col=color_map_label_1,side=3,line=4,adj=-0.1,cex=label_size,xpd=TRUE)
    }
    if (include_map_label_2) {
      mtext(text=map_label_2,col=color_map_label_2,side=3,line=3,adj=-0.1,cex=label_size,xpd=TRUE)
    }
  }
  text(x=1952,y=1.0*yscale,pos=4,lab=txt$consumption,col=color_consumption_text,cex=label_size,font=2,xpd=TRUE)
  text(x=1952,y=0.80*yscale,pos=4,lab=txt$production,col=color_production_text,cex=label_size,font=2,xpd=TRUE)

  # Only include the import/export labels in some circumstances
  if (fuel != 'nuclear' && fuel != 'hydro') {
    if (showmap == 'M') {
      include_plot_label_3 = TRUE
      include_plot_label_4 = TRUE
    } else {
      if (countryID == 'MZM_WORLD') {
        include_plot_label_3 = TRUE
        include_plot_label_4 = FALSE
      } else {
        include_plot_label_3 = TRUE
        include_plot_label_4 = TRUE
      }
    }
  }

  if (include_plot_label_3) {
    text(x=1952,y=0.10*yscale,pos=4,lab=txt$exports,col=color_export_text,cex=label_size,font=2,xpd=TRUE)
  }
  if (include_plot_label_4) {
    text(x=1952,y=-0.10*yscale,pos=4,lab=txt$imports,col=color_import_text,cex=label_size,font=2,xpd=TRUE)
  }

  # Add a label for the 'overlay' if one was chosen
  if (overlay != 'MZM_NONE') {
    ypos = overlay_consumption[n-10]
    xpos = lastyear - 10
    label = paste(overlay,txt$consumption)
    text(x=xpos,y=ypos,pos=1,lab=label,col=color_overlay_text,cex=1.0,font=2,xpd=TRUE)
  }

  # Add a label for the 'yscalecode' if one was chosen
  if (yscalecode != 'auto') {
    ypos = yscalecode_consumption[n]
    xpos = lastyear - 2
    if (yscalecode == 'us') {
      text(x=xpos,y=ypos,pos=3,lab=txt$US,col=color_yscalecode_text,cex=label_size-0.2,font=1,xpd=TRUE)
    } else {
      text(x=xpos,y=ypos,pos=3,lab=txt$World,col=color_yscalecode_text,cex=label_size-0.2,font=1,xpd=TRUE)
    }
  }

  # Add user specified label
# NOTE:  yhi and ylo have been replaced by yscale
#  y = special_y*(yhi-ylo)*0.01 + ylo
#  text(x=c(special_x),y=c(y),labels=c(special_text),cex=1.0,font=2,col=color_labels_text)

  # Add the special note if found
  if (special_note != '') {
    text(x=1967,y=1.0*yscale,pos=4,lab=special_note,col=color_labels_text,cex=0.7,xpd=TRUE)
  }

  # Add the warning text if found
  if (warning_text != '') {
    text(x=1985,y=0,pos=4,lab=warning_text,col=color_labels_text,cex=1.2,xpd=TRUE)
  }

  # Return the list of colors associated with the countrylist variable.
  return(ei_col)
}


# Clean images using the time series method
#
# Input: blue band images.
# Output: a mask file (QCFile), and it applied to NDVI to get an NDVI time series (CleanNDVI)

library(probaV)
library(tools)
source("utils/set-temp-path.r")
source("extra/cloud_filter.r") # JD's extra utility script

IntermediaryDir = "../../userdata/semicleaned/radiometry/"
OutputDir = "../../userdata/composite/tscleaned/"
TileOfInterest = "X20Y01"

# Subset for testing
xmin <- 27
xmax <- 28
ymin <- 58
ymax <- 59

# Create a virtual raster (faster stack) from all blue bands
VrtPattern = "(BLUE)_sm.tif$"
VrtName = file.path(paste0(OutputDir,TileOfInterest, "_",paste0(VrtPattern, collapse = "_"), ".vrt"))
file.remove(VrtName)
Vrt = timeVrtProbaV(IntermediaryDir, pattern = VrtPattern, vrt_name = VrtName, tile = TileOfInterest,
    return_raster = TRUE)#,
    #te = c(xmin, ymin, xmax, ymax))

# QC file and log file names
QCFile = paste0(OutputDir, 'ts-mask-whole-optimised.tif')
LogFile = paste0(OutputDir, 'ts-cleaning.log')

Cores = 30
Rows = 6
psnice(value = min(Cores - 1, 19))
system.time(
    QCMask <- cloud_filter(x = Vrt, probav_sm_dir = IntermediaryDir, pattern = VrtPattern,
        tiles = TileOfInterest, minrows = Rows, mc.cores = Cores, logfile=LogFile, overwrite=TRUE,
        span=0.3, cf_bands = c(1), thresholds=c(-30, Inf), filename = QCFile)
)

# select date
QCMask = brick(QCFile)
plot(Vrt[[which(names(Vrt) == "PROBAV_S5_TOC_X20Y01_20160711_100M_V101_BLUE_sm.tif")]],
    xlim=c(xmin, xmax), ylim=c(ymin, ymax))
plot(QCMask[[which(names(Vrt) == "PROBAV_S5_TOC_X20Y01_20160711_100M_V101_BLUE_sm.tif")]],
    xlim=c(xmin, xmax), ylim=c(ymin, ymax))
plot(Vrt[[which(names(Vrt) == "PROBAV_S5_TOC_X20Y01_20160821_100M_V101_BLUE_sm.tif")]],
    xlim=c(xmin, xmax), ylim=c(ymin, ymax))
plot(QCMask[[which(names(Vrt) == "PROBAV_S5_TOC_X20Y01_20160821_100M_V101_BLUE_sm.tif")]],
    xlim=c(xmin, xmax), ylim=c(ymin, ymax))
plot(Vrt[[which(names(Vrt) == "PROBAV_S5_TOC_X20Y01_20160621_100M_V101_BLUE_sm.tif")]],
    xlim=c(xmin, xmax), ylim=c(ymin, ymax))
plot(QCMask[[which(names(Vrt) == "PROBAV_S5_TOC_X20Y01_20160621_100M_V101_BLUE_sm.tif")]],
    xlim=c(xmin, xmax), ylim=c(ymin, ymax))
plot(Vrt[[which(names(Vrt) == "PROBAV_S5_TOC_X20Y01_20160826_100M_V101_BLUE_sm.tif")]],
    xlim=c(xmin, xmax), ylim=c(ymin, ymax))
plot(QCMask[[which(names(Vrt) == "PROBAV_S5_TOC_X20Y01_20160826_100M_V101_BLUE_sm.tif")]],
    xlim=c(xmin, xmax), ylim=c(ymin, ymax))
plot(Vrt[[which(names(Vrt) == "PROBAV_S5_TOC_X20Y01_20160601_100M_V101_BLUE_sm.tif")]],
    xlim=c(xmin, xmax), ylim=c(ymin, ymax))
plot(QCMask[[which(names(Vrt) == "PROBAV_S5_TOC_X20Y01_20160601_100M_V101_BLUE_sm.tif")]],
    xlim=c(xmin, xmax), ylim=c(ymin, ymax))
plot(Vrt[[which(names(Vrt) == "PROBAV_S5_TOC_X20Y01_20160611_100M_V101_BLUE_sm.tif")]],
    xlim=c(xmin, xmax), ylim=c(ymin, ymax))
plot(QCMask[[which(names(Vrt) == "PROBAV_S5_TOC_X20Y01_20160611_100M_V101_BLUE_sm.tif")]],
    xlim=c(xmin, xmax), ylim=c(ymin, ymax))


R
library(immuneSIM)

# first obtain BCR fasta sequences with different amount of mutations in the variable domains (15, 30, 45, 60).
# here an example for IGK BCR with 15 somatic hypermutations (SHM):

sim_repertoire_IGK_shm15 <- immuneSIM(number_of_seqs = 100,
                                        species = "hs",
                                        receptor = "ig",
                                        chain = "k",
                                        shm.mode="data",
                                        shm.prob=15/350)

write.table(sim_repertoire_IGK_shm15,"igk_shm15.tsv",quote=F,col.names=T,row.names=F,sep="\t")

sim_repertoire_IGK_shm30 <- immuneSIM(number_of_seqs = 100,
                                        species = "hs",
                                        receptor = "ig",
                                        chain = "k",
                                        shm.mode="data",
                                        shm.prob=30/350)

write.table(sim_repertoire_IGK_shm30,"igk_shm30.tsv",quote=F,col.names=T,row.names=F,sep="\t")

sim_repertoire_IGK_shm45 <- immuneSIM(number_of_seqs = 100,
                                        species = "hs",
                                        receptor = "ig",
                                        chain = "k",
                                        shm.mode="data",
                                        shm.prob=45/350)

write.table(sim_repertoire_IGK_shm45,"igk_shm45.tsv",quote=F,col.names=T,row.names=F,sep="\t")

sim_repertoire_IGK_shm60 <- immuneSIM(number_of_seqs = 100,
                                        species = "hs",
                                        receptor = "ig",
                                        chain = "k",
                                        shm.mode="data",
                                        shm.prob=60/350)

write.table(sim_repertoire_IGK_shm60,"igk_shm60.tsv",quote=F,col.names=T,row.names=F,sep="\t")
q()


 # read VPA_CAO1 data, on the 4M format  (please note catches are in pure numbers (not thousands )
old<-read.table(file.path(root,"data_northSea","data_incl05","VPA_ca01.IN"),header = T)
fy.old<-min(old$year)
ly.old<-max(old$year)

sps<- c("Fulmar","Guillemot","Her. Gull","Kittiwake","GBB. Gull","Gannet","Puffin","Razorbill","R. radiata",
       "G. gurnards","W_M" ,"N_M" ,"W_H", "N_H" ,"COD" ,"WHG","HAD","POK","HER","SAN","NOP", "PLE" ,"SOL")

mer<-data.frame(year=0,species='dummy', spno=0,age=0,yearGroup=0,ageGroup=0 )

for (sp in (first.VPA:nsp)) {
  species<-sps[sp]
  sp.index<-sp-first.VPA+1
  max.season.age<-length(SMS.control@catch.season.age[[sp.index]])
  ageGroup<-1
  season.age<-SMS.control@catch.season.age[[sp-first.VPA+1]][ageGroup]
  for (age in (SMS.control@species.info[sp,"first-age F>0"]:SMS.control@species.info[sp,"last-age-selec"])) {
    yearGroup<-1
    max.yearGroup<-length(SMS.control@catch.sep.year[[sp.index]])
    for (year in (fy.old:ly.old) )  {
      if (year==SMS.control@catch.sep.year[[sp.index]][min(yearGroup+1,max.yearGroup)]) yearGroup<-min(yearGroup+1,max.yearGroup)
      #print(paste(species,age,ageGroup,year,yearGroup))
      mer<-rbind(mer, data.frame(year=year,species=species, spno=sp,age=age,yearGroup=yearGroup,ageGroup=ageGroup ))
     }
    if (season.age==age) {
       ageGroup<-min(ageGroup+1,max.season.age)
       season.age<-SMS.control@catch.season.age[[sp.index]][ageGroup]
    }
  }
}

a<-merge(old,mer)

b1<-aggregate(a$CATCHN,list(a$spno, a$species,a$ageGroup,a$yearGroup,a$quarter),mean)
names(b1)<-c('spno','species','ageGroup','yearGroup','quarter','C')
head(b1)

b2<-aggregate(b1$C,list(b1$spno,b1$species,b1$ageGroup,b1$yearGroup),sum)
names(b2)<-c('spno','species','ageGroup','yearGroup','sumC')
head(b2)

b3<-merge(b1,b2)
b3$prop<-b3$C/b3$sumC
fq<-subset(b3,spno>0, select=-c(sumC,C))

fq<-reshape(fq,idvar=c('spno','species','ageGroup','yearGroup'),direction='wide',timevar='quarter')

fq$ref4<-ifelse(is.na(fq$prop.2),0.50,0.25)
fq$p1<-fq$prop.1/fq$prop.4*fq$ref4
fq$p2<-fq$prop.2/fq$prop.4*fq$ref4
fq$p3<-fq$prop.3/fq$prop.4*fq$ref4
fq$p4<-fq$prop.4/fq$prop.4*fq$ref4
fq

ofile<-file.path(data.path,'F_q_ini.in')
#ofile<-''
cat("# relative F by quarter 1 - 4 by species, first age in separable season age group and first year in separable year group\n#\n",file=ofile)
aa<-1
yy<-1
sp<-1

for (a in (1:dim(fq)[1]))  {
 if (is.na(fq[a,'p1']))  cat (paste('           ',                          round(fq[a,'p3'],3),"\t#",round(fq[a,'p4'],2),fq[a,'species']),file=ofile,append=T)
 if (!is.na(fq[a,'p1'])) cat (paste(round(fq[a,'p1'],3),round(fq[a,'p2'],3),round(fq[a,'p3'],3),"\t#",round(fq[a,'p4'],2),fq[a,'species']),file=ofile,append=T)
 cat(paste(",  age:", SMS.control@catch.season.age[[sp]][aa]," year:",SMS.control@catch.sep.year[[sp]][yy],"\n"),file=ofile,append=T)
 yy<-yy+1
 if (length(SMS.control@catch.sep.year[[sp]])<yy) {
   yy<-1
   aa<-aa+1;
   if (length(SMS.control@catch.season.age[[sp]])<aa)  {sp<-sp+1; aa<-1; yy<-1; cat('#\n',file=ofile,append=T)}
 }
}


#################################################
#
# make_figure_2.r    16 FEB 2017
#
# Generates figure 2 in "Priority for the
# worse off and the Social Cost of Carbon". This
# code is meant to be sourced from make_figures.r
# and not necessarily run on its own.
#
#################################################

# Setup the plotting device
outfile <- paste(plotdir, "/figure2.pdf", sep="")
pdf(outfile, width=7, height=12)

# Make the subsets of data
util.subset <- my.data[which(with(my.data, focusregion %in% norm.regions &
                                    eta <= 3.0 & eta >= 0.0 &
                                    rho >= 0.0 & rho <= 0.03 &
                                    gamma == 0 & c0 == 1)),]
prior.subset <- my.data[which(with(my.data, focusregion %in% norm.regions &
                                     eta <= 3.0 & eta >= 0.0 &
                                     gamma <= 3.0 & gamma >= 0.0 &
                                     rho == 0 & c0 == 500)),]

# Cap the SCC to the zlim range
my.zlim <- c(0,10000)
util.subset[which(with(util.subset, SCC<my.zlim[1])),"SCC"] <- my.zlim[1]
util.subset[which(with(util.subset, SCC>my.zlim[2])),"SCC"] <- my.zlim[2]
prior.subset[which(with(prior.subset, SCC<my.zlim[1])),"SCC"] <- my.zlim[1]
prior.subset[which(with(prior.subset, SCC>my.zlim[2])),"SCC"] <- my.zlim[2]

# Put the rho values in the util frame into percentage values
util.subset$rho <- util.subset$rho * 100

# Colors for plots
scc.cols <- colorRampPalette(c(brewer.pal(8, "PuOr"), "black"), bias=1.7)(100)

# Define zoom level for plots
my.zoom <- 0.7

# Define distance of axis labels from the plot
my.dist <- c(1.2,1.2,1.2)

# Axis label locations and labels
at.eta <- 0:3
labels.eta <- c("0",rep("", length(at.eta)-2),"3")
at.gamma <- 0:3
labels.gamma <- c("0","","","3")
at.rho <- 0:3
labels.rho <- c("0","","","3")
my.ztics <- c(0,10000)

# Generate the plot panels
util.plot <- wireframe(SCC ~ eta+rho|focusregion, util.subset, zoom=my.zoom,
                       screen=list(x=-70,y=-50,z=-15), index.cond=list(c(4,2,3,1)),
                       scales=list(arrows=F, x=list(at=at.eta, labels=labels.eta), y=list(at=at.rho, labels=labels.rho), z=list(at=my.ztics, labels=c(0,parse(text="10^4"))), distance=my.dist),
                       drape=T, col.regions=scc.cols, layout=c(1,4),
                       colorkey=list(at=seq(my.zlim[1], my.zlim[2], l=101), col=scc.cols))

prior.plot <- wireframe(SCC ~ eta+gamma|focusregion, prior.subset, zlim=my.zlim,  zoom=my.zoom,
                        screen=list(x=-70,y=-50,z=-15), index.cond=list(c(4,2,3,1)),
                        scales=list(arrows=F, x=list(at=at.eta, labels=labels.eta), y=list(at=at.gamma, labels=labels.gamma), z=list(at=my.ztics, labels=c(0,parse(text="10^4"))), distance=my.dist),
                        drape=T, col.regions=scc.cols, layout=c(1,4),
                        colorkey=list(at=seq(my.zlim[1], my.zlim[2], l=101), col=scc.cols))

# Print the two panels side by side
print(util.plot, position=c(0,0,0.5,1), more=T)
print(prior.plot, position=c(0.5,0,1,1))

# Turn off the plotting device if necessary
dev.off()


library(nVennR)
# Load data
setwd("~/Documents/thesis/nitwit/bench")
validators = read.csv('./data.csv') # Don't forget to manually add name of first column as "Witness"

# Get intersecting subsets
cpa <- subset(validators, CPAchecker == 0)$Witness
ua <- subset(validators, Ult..Auto. == 0)$Witness
cpaw2t <- subset(validators, CPA.w2t == 0)$Witness
fshell <- subset(validators, FShell.w2t == 0)$Witness
cwv <- subset(validators, NITWIT == 0)$Witness
metaval <- subset(validators, MetaVal == 0)$Witness
none <- subset(validators, CPAchecker != 0 & Ult..Auto. != 0 & CPA.w2t != 0 & FShell.w2t != 0 & MetaVal != 0 & NITWIT != 0)$Witness

awesome_venn <- plotVenn(list(CPAchecker=cpa, 'Ult. Auto.'=ua,
                              'CPA-w2t'=cpaw2t, 'FShell-w2t'=fshell,
                              MetaVal=metaval, NITWIT=cwv),
                nCycles = 100000,
                outFile='./output/imgs20/venn_false.svg')

showSVG(nVennObj = awesome_venn,
        opacity = 0.2,
        borderWidth = 1,
        fontScale = 0.9,
        labelRegions = T,
        outFile='./output/imgs20/venn_false_custom.svg')


library(igraph)
library(RColorBrewer)

#source("/Users/Olga/Google_Drive/PhD/Projects/terraces/scripts/script-colors.r")

plot_terrace_subgraph<-function(g,V_list,terrNUM,terrID = 1,cols,file=""){

	if(file == ""){
		file=paste("plot-terrace-",terrID,".pdf",sep="")
	}

	if(length(cols)==0){
		cols=brewer.pal(11, 'Spectral')
	}

	pal <- colorRampPalette(cols)
	new_cols=pal(terrNUM) # color of vertices
	mark_border_cols=pal(terrNUM)	# color of borders of communities

	# color of communities
	pal2=colorRampPaletteAlpha(cols, n = terrNUM,alpha = 0.4)
	mark_cols=pal2

	#V(g)$community=comm
	g2=induced_subgraph(g,V_list)

	vNUM=length(V(g2))
	V(g2)$community=rep(terrID,vNUM)

	tsc_g2=cluster_label_prop(g2)
	tsc_g2$membership=V(g2)$community

	wd=5
	ht=5
	if(vNUM>2){
		#weights <- ifelse(crossing(tsc_g2, g2), 10, 1)      # 10,1 is best for kk | for fr 1,50
		#layout <- layout_with_kk(g2, weights=weights)
		#layout <- layout_with_kk(g2)
		#layout=layout_as_star(g2, center = V(g2)[1], order = NULL)
		layout=layout_with_fr(g2)
		#layout=layout_nicely
	}else if(vNUM==2){
		layout=matrix(c(1,2,1,1),nrow=2,ncol=2)
	}

	pdf(file,w=wd,h=ht)
	par(oma=c(0,0,0,0),mai = c(0, 0, 0, 0))
        plot(tsc_g2,g2,
	     vertex.label=NA,vertex.size=10,
	     col=new_cols[terrID],mark.col=mark_cols[terrID],
	     edge.width=1,
	     mark.border=mark_border_cols[terrID],
	     edge.color="black",edge.lty=1,
	     layout=layout)
        dev.off()

}


# Remove NA values from all rasters, using different techniques:
# For the summer composite, use extra pixels from the Collection 0 composite.
# For all other rasters, apply a weighted average filter

library(raster); source("utils/set-temp-path.r")
library(foreach)
library(doParallel)
library(iterators)
library(tools)

OutputDir = "../../userdata/indices-no-na/"
RasterOptions = c("COMPRESS=DEFLATE", "ZLEVEL=9", "NUMTHREADS=4")

NewCompositeFile = "../../userdata/indices/composite.tif"
OldCompositeFile = "../../userdata/composite/composite.tif"
NewerCompositeFile = "../../userdata/indices/composite-merged.tif"

NewComposite = brick(NewCompositeFile)
OldComposite = brick(OldCompositeFile)

#cellStats(is.na(OldComposite[[1]]), "sum")
if (!file.exists(NewerCompositeFile))
    NewerComposite = merge(NewComposite, OldComposite,
        progress="text", filename=NewerCompositeFile, options=RasterOptions)

# Now fill out NAs using a focal filter
# The weights are approximate inverse distances
Weights = matrix(c(1/124, 1/55, 1/124, 1/111, 0, 1/111),3,3)
Weights = Weights / sum(Weights)

fill.na = function(x, i=5)
{
    if (is.na(x)[i])
        return(weighted.mean(x, Weights, na.rm=TRUE))
    return(x[i])
}

FillRasterNAs = function(InputFile, OutputFile, RasterOptions = c("COMPRESS=DEFLATE", "ZLEVEL=9", "NUMTHREADS=4"))
{
    if (file.exists(OutputFile))
    {
        message(paste("File", OutputFile, "already exists, skipping."))
        return()
    }
    InputRaster = brick(InputFile)
    InputType = dataType(InputRaster)

    NumLayers = nlayers(InputRaster)
    registerDoParallel(cores = NumLayers)
    psnice(value = min(NumLayers - 1, 19))
    OutputStack = foreach(i=iter(names(InputRaster)), .packages="raster", .verbose=TRUE, .inorder=TRUE,
        .combine=stack) %dopar%
    {
        Output = focal(InputRaster[[i]], w=matrix(1,3,3), fun=fill.na, pad=TRUE, na.rm=FALSE,
            datatype=InputType, progress="text")

        message(paste("File", InputFile, "layer", i, "processed, remaining NAs:",
            cellStats(is.na(Output), "sum")))

        Output
    }
    writeRaster(OutputStack, filename=OutputFile, options=RasterOptions, datatype=InputType, progress="text")
    message(paste("Output written to", OutputFile))
}

FillRasterNAs(NewerCompositeFile, paste0(OutputDir, "composite.tif"))
FillRasterNAs("../../userdata/dem/merged/pv-height.tif", paste0(OutputDir, "pv-height.tif"))
FillRasterNAs("../../userdata/dem/merged/pv-slope.tif", paste0(OutputDir, "pv-slope.tif"))
FillRasterNAs("../../userdata/dem/merged/pv-aspect.tif", paste0(OutputDir, "pv-aspect.tif"))
FillRasterNAs("../../userdata/dem/merged/pv-tpi.tif", paste0(OutputDir, "pv-tpi.tif"))
FillRasterNAs("../../userdata/harmonics/phase-amplitude.tif", paste0(OutputDir, "phase-amplitude.tif"))

# DEM ones that use focal have edge effects, so have to process twice
FillRasterNAs(paste0(OutputDir, "pv-aspect.tif"), paste0(OutputDir, "pv-aspect-2.tif"))
FillRasterNAs(paste0(OutputDir, "pv-tpi.tif"), paste0(OutputDir, "pv-tpi-2.tif"))
# And harmonics require a lot of data, so also large spaces with NAs (in clumps)
FillRasterNAs(paste0(OutputDir, "phase-amplitude.tif"), paste0(OutputDir, "phase-amplitude-2.tif"))
FillRasterNAs(paste0(OutputDir, "phase-amplitude-2.tif"), paste0(OutputDir, "phase-amplitude-3.tif"))
FillRasterNAs(paste0(OutputDir, "phase-amplitude-3.tif"), paste0(OutputDir, "phase-amplitude-4.tif"))
FillRasterNAs(paste0(OutputDir, "phase-amplitude-4.tif"), paste0(OutputDir, "phase-amplitude-5.tif"))
FillRasterNAs(paste0(OutputDir, "phase-amplitude-5.tif"), paste0(OutputDir, "phase-amplitude-6.tif"))


# Basis for Spontaneous Pain analysis of behavioural data
# # Isabel Ellerbrock, October 2019

rm(list=ls(all=TRUE))
library(utils)
library(ggplot2)
library(tidyverse)
library(readr)

# read in data
pth <- "C:/Users/Isabel/Documents/POADOS/logfiles/logfiles_MR/SponPain"
file.names <- dir(pth, pattern ="sponPain")
out.file<-vector()

for(j in 1:length(file.names)) {

  file <- read.table(file.path(pth, file.names[j]),header=TRUE, sep="\t")
  kk <- strsplit(file.names[j], "\\_")[[1]]
  id<-rep(kk[2], nrow(file))  # extract name from file name and add to data
  file<-cbind(id, file)   # attach id to data frame in first column

  out.file <- rbind(out.file, file) # concatenate data and create df of original data for all participants

  if (tail(file$Time, n=1) < 600) {   # make sure there are values until 600 frames, right-pad last rating
    paddedtailtime<-round(tail(file$Time, n=1), digits = 0):600
    paddedtailscore<-rep(tail(file$Rating, n=1), length(paddedtailtime))
    paddedid<-rep(id[1], length(paddedtailtime))
    tailfile <- data.frame(paddedid, paddedtailtime, paddedtailscore); colnames(tailfile)<-c("id", "Time", "Rating")
    afile <- dplyr::bind_rows(file, tailfile)
  } else {afile<-file}

  if (head(file$Time, n=1) > 1) {
    paddedheadtime<-1:trunc(head(file$Time, n=1), digits = 0)
    paddedheadscore<-rep(0, length(paddedheadtime))
    paddedid<-rep(id[1], length(paddedheadtime))
    headfile <- data.frame(paddedid, paddedheadtime, paddedheadscore); colnames(headfile)<-c("id", "Time", "Rating")

    if (exists("afile")) {
    afile <- dplyr::bind_rows(headfile, afile)
    } else {afile<-file}
  }

  # plot data
  if (id[1] < 4000) {
  print(ggplot(data=afile, aes(x=Time, y=Rating, ymin=0, ymax=50, xmin=0, xmax=600)) + geom_line(size=2) +
          theme_minimal() + xlab("Time") + ylab("Rating") + ggtitle(paste("spontaneous pain ratings: ", kk[2])))
  } else {
    print(ggplot(data=afile, aes(x=Time, y=Rating, ymin=0, ymax=50, xmin=0, xmax=600)) + geom_line(size=2) +
            theme_minimal() + xlab("Time") + ylab("Rating") + ggtitle(paste("spontaneous unpleasantness ratings: ", kk[2])))
  }

  #  Sys.sleep(3) # pause for 3 sec to look at the plot
}

inx <- out.file %>%  group_by(id) %>% summarise_at(vars(Rating), list(mean=mean, sd=sd, med=median, max=max))


#!/usr/bin/env Rscript

#sink(file("/dev/null", "w"), type = "message");

library(pathprint);

# Figure out the relative path to the galaxy-pathprint.r library.
script.args  <- commandArgs(trailingOnly = FALSE);
script.name  <- sub("--file=", "", script.args[grep("--file=", script.args)])
script.base  <- dirname(script.name)
library.path <- file.path(script.base, "galaxy-pathprint.r");
source(library.path)

data(GEO.metadata.matrix);

usage <- function() {
  stop("Usage: distance.r <input> <output> <output2>", call. = FALSE)
}

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

input  <- ifelse(! is.na(args[1]), args[1], usage())
output <- ifelse(! is.na(args[2]), args[2], usage())
output2 <- ifelse(! is.na(args[3]), args[3], usage())

fingerprint <- loadFingerprint(input);
distance    <- calculateDistanceToPluripotent(fingerprint, verbose = 0);
saveDistance(distance, output);

generateHistograms(distance, output2);

quit("no", 0)


# This script specifies some test cases (test_cases variable below) and uses the GetNewDataB function from
# MultiPLIER to project the data into the latent space. Then it saves these results into .RDS files, which will be
# used by unit tests to check the Python implementation of the GetNewDataB function.

suppressMessages(require(PLIER))

source(file.path("scripts", "plier_util.R"))

args <- commandArgs(trailingOnly=TRUE)
if (length(args) == 0) {
  stop('At least one argument is required: the path to the MultiPLIER model file (.rds).')
}

message('Reading MultiPLIER model')
model <- readRDS(args[1])

output_dir <- args[2]

# specify some small use cases for unit tests
test_cases <- list(
  # Two genes and two traits
  list(
    genes = c('GAS6', 'DSP'),
    trait1 = c(-0.25, 0.50),
    trait2 = c(1.25, -1.50)
  ),
  # Three genes and two traits
  list(
    genes = c('GAS6', 'DSP', 'MMP14'),
    trait1 = c(-0.25, 0.50, 0.90),
    trait2 = c(1.25, -1.50, -1.56)
  ),
  # Three genes (one does not exist in the model) and three traits
  list(
    genes = c('GAS6', 'DOESNOTEXIST', 'MMP14'),
    trait1 = c(-0.25, 0.50, 0.90),
    trait2 = c(1.25, -1.50, -1.56),
    trait3 = c(-11.2, 0.17, 1.99)
  ),
  # Missing data pattern #1
  list(
    genes = c('GAS6', 'DSP', 'MMP14'),
    trait1 = c(-0.25, 0.50, 0.90),
    trait2 = c(1.25, -1.50, -1.56),
    trait3 = c(-11.2, 0.17, NA)
  )
)

# this test case contains a sample from PhenomeXcan data
new_data <- readRDS(file.path(output_dir, 'test_case5', 'phenomexcan_sample.rds'))
test_cases[[length(test_cases) + 1]] <- list(
  genes = rownames(new_data),
  trait1 = new_data[[1]],
  trait2 = new_data[[2]],
  trait3 = new_data[[3]]
)

# go through all test cases, project them into the latent space, and save the results in an rds file.
for (tc.idx in 1:length(test_cases)) {
  message(paste0('Test case ', tc.idx))
  tc <- test_cases[[tc.idx]]

  tc.df <- data.frame(tc)
  tc.mat <- as.matrix(tc.df)
  tc.mat <- matrix(as.numeric(tc.mat[, 2:ncol(tc.mat)]), nrow=nrow(tc.mat))
  rownames(tc.mat) <- tc.df$genes
  colnames(tc.mat) <- colnames(tc.df)[2:ncol(tc.df)]

  tc_output_dir <- file.path(output_dir, paste0('test_case', tc.idx))
  if (!dir.exists(tc_output_dir)) {
    dir.create(tc_output_dir)
  }

  # save input data
  print(head(tc.mat))
  saveRDS(tc.mat, file.path(tc_output_dir, 'input_data.rds'))

  # save output data
  b.matrix <- GetNewDataB(exprs.mat = tc.mat, plier.model = model)
  saveRDS(b.matrix, file.path(tc_output_dir, 'output_data.rds'))

  message('\n')
}

message('Finished')


#==============================================================================#
# This function will place any list of files with any pattern into a vector
# in an object. The way it should be used for the functions on this page
# is to search for .dat files.
#==============================================================================#
getfile <- function(multFile=NULL, pattern=NULL){
# the default option is to grab all of the files in a directory matching a
# specified pattern. If no pattern is set, all files will be listed.
	if (is.null(multFile) || toupper(multFile) == "YES"){
		# this sets the path variable that the user can use to set the path
		# to the files with setwd(x$path), where x is the datastructure
		# this function dumped into.
		path <- sub("(^.+?/).+?\\.[a-z]{3}$", "\\1", file.path(file.choose()))
		if (!is.null(pattern)){
			pat <- pattern
			x <- list.files(path, pattern=pat)
		}
		else {
			x <- list.files(path)
		}
	}
	else {
		# if the user chooses to analyze only one file, a pattern is not needed
		csv <- file.choose()
		path <- sub("(^.+?/).+?\\.[a-z]{3}$", "\\1", file.path(csv))
		csv <- sub("^.+?/(.+?\\.[a-z]{3})$", "\\1", csv)
		x <- csv
	}
	filepath <- list(files=x, path=path)
	return(filepath)
}
#==============================================================================#
# The calculation of the Index of Association and standardized Index of
# Association.
#==============================================================================#
stdIa <- function(x){
#------------------------------------------------------------------------------#
# Testing for valid filetypes
#------------------------------------------------------------------------------#
	if (toupper(.readExt(x)) == "DAT") {
		pop <- read.fstat(x, missing = 0, quiet=T)
	}
	else if (toupper(.readExt(x)) %in% c("STR", "STRU")) {
		pop <- read.structure(x, missing = 0, ask=FALSE, quiet=TRUE)
	}
	else if (toupper(.readExt(x)) == "GTX") {
		pop <- read.genetix(x, missing = 0, quiet=T)
	}
	else if (toupper(.readExt(x)) == "GEN") {
		pop <- read.genepop(x, missing = 0, quiet=T)
	}
	else {
		stop("File ext .dat, .str, .gtx, or .gen expected")
	}
	numAlleles <- length(pop@loc.names)
	numIsolates <- length(pop@ind.names)
	# Creating this number is necessary because it is how the variance is
	# calculated.
	np <- (numIsolates*(numIsolates-1))/2
	# Creation of the datastructures
	if (!exists("Ia.vector")){
		Ia.vector <- NULL
		rbarD.vector <- NULL
		file.vector <- NULL
	}
	D.matrix <- matrix(0, nrow=numIsolates, ncol=numIsolates)
	d.matrix <- D.matrix
	d.vector <- NULL
	d2.vector <- NULL
	vard.vector <- NULL
	vardpair.vector <- NULL
	count <- 0
#--------------------------------------------------------------------------#
# This is the loop for analyzing the pairwise distances at each locus,
# also known as d. These values will be placed into two vectors representing
# the sum of d for each locus and the sum of d^2 for each locus.
#
# This will also calculate D, the pairwise comparison of all isolates over
# all loci.
#--------------------------------------------------------------------------#
	for (loc in names(pop@loc.nall)){
		n <- count + 1
		count <- pop@loc.nall[loc] + count
		m <- count
		#print(paste(n, m, sep=":"))
		for(j in 1:numIsolates){
			# Loop for the rows of the distance matrix
			for(i in 1:numIsolates){
				z <- 0
				# Setting the contraint for the pairwise comparisons by the
				# equation (n(n-1))/2 where n = numIsolates
				if(j < i && i <= numIsolates){
					z <- sum(abs(pop@tab[j,m:n]
								-pop@tab[i,m:n]))
				}
				# The value of z (0, 1, or 2) is pushed into the matrix
				d.matrix[i,j] <- d.matrix[i,j]+z
				# This value is added to the matrix for pairwise comparison
				# of all the isolates over all loci as opposed to each locus
				D.matrix[i,j] <- D.matrix[i,j]+d.matrix[i,j]
			}
		}
		d.vector <- append(d.vector, sum(d.matrix))
		d2.vector <- append(d2.vector, sum(d.matrix^2))
		d.matrix[1:numIsolates,1:numIsolates] <- 0
	}
	rm(d.matrix)
#--------------------------------------------------------------------------#
# Now to begin the calculations. First, set the variance of D
#--------------------------------------------------------------------------#
	varD <- ((sum(D.matrix^2)-((sum(D.matrix))^2)/np))/np
#--------------------------------------------------------------------------#
# Next is to create a vector containing all of the variances of d (there
# will be one for each locus)
#--------------------------------------------------------------------------#
	vard.vector <- ((d2.vector-((d.vector^2)/np))/np)
#--------------------------------------------------------------------------#
# Here the roots of the products of the variances are being produced and
# the sum of those values is taken.
#--------------------------------------------------------------------------#
	for (b in 1:length(d.vector)){
		for (d in 1:length(d.vector)){
			if(b < d && d <= length(d.vector)){
				vardpair <- sqrt(vard.vector[b]*vard.vector[d])
				vardpair.vector <- append(vardpair.vector, vardpair)
			}
		}
	}
#--------------------------------------------------------------------------#
# The sum of the variances necessary for the calculation of Ia is calculated
#--------------------------------------------------------------------------#
	sigVarj <- sum(vard.vector)
	rm(vard.vector)
#--------------------------------------------------------------------------#
# Finally, the Index of Association and the standardized Index of associati-
# on are calculated.
#--------------------------------------------------------------------------#
	Ia <- (varD/sigVarj)-1
	rbarD <- (varD - sigVarj)/(2*sum(vardpair.vector))
	# Prints to screen as loop progresses
	print(paste("File Name:", x, sep=" "))
	print(paste("Index of Association:", Ia, sep=" "))
	print(paste("Standardized Index of Association (rbarD):", rbarD, sep=" "))
	# Saves the values of Ia, rbarD, and the filename into datastructures
	# that will be listed in a dataframe
	file.vector <- append(file.vector, x)
	Ia.vector <- append(Ia.vector, Ia)
	rbarD.vector <- append(rbarD.vector, rbarD)
	Iout <- list(Ia=Ia.vector, rbarD=rbarD.vector, File=file.vector)
	return(as.data.frame(Iout))
}

#==============================================================================#
# This function allows the user to analyze many separate files automatically
#==============================================================================#
stdIa.all <- function(x) {
	Iout <- NULL
	for(a in x){
		Iout <- rbind(Iout, stdIa(a))
	}
	return(Iout)
}

extract.info <- function(x) {
	x$clone <- as.factor(sub("^clone.(\\d{3}.\\d{2}).+?$)","\\1", x$File))
	x$rep <- as.numeric(sub("^clone.+?rep.(\\d{2}).+?$)","\\1", x$File))
	x$pop.size <- as.numeric(sub("^clone.+?pop.(\\d+?).+?$)","\\1", x$File))
	x$sex.rate <- (100-x$clone)/100
	return(x)
}


#  James Rekow

plotColorCodedDOC = function(M = 40, N = 20, iStrength = 1, univ = 1,
                             sigmaMax = 0.1, thresholdMult = 10 ^ (-2), maxSteps = 10 ^ 4,
                             tStep = 10 ^ (-2), intTime = 1, interSmplMult = 0.01,
                             lambda = 0.1, numDOC = 10){

  #  ARGS: numDOC - number of DOCs from which the aggregate points should be assembled
  #
  #  RETURNS:

  library(hexbin)
  library(ggplot2)
  source("abdListCreator_optimizedBaseCase.r")
  source("intraCohortInteraction_optimizedBaseCase.r")
  source("DOCProcedure.r")

  #  let half of the samples be interacting samples
  numI = floor(M / 2)

  produceDOCDF = function(x = NULL){

    #  select the indices of the interacting samples
    intIx = sample(M, numI)

    #  create abundance list
    abdList = abdListCreator_optimizedBaseCase(intIx = intIx, M = M, N = N, iStrength = iStrength,
                                               univ = univ, sigmaMax = sigmaMax,
                                               thresholdMult = thresholdMult, maxSteps = maxSteps,
                                               tStep = tStep, intTime = intTime,
                                               interSmplMult = interSmplMult, lambda = lambda)

    #  create DOC
    doc = DOCProcedure(abdList)

    #  create a numerical vector with 1's in positions with the indices of interacting elements
    #  and 0's elsewhere
    intSmpls = rep(0, M)
    intSmpls[intIx] = 1

    #  create a matrix whose columns are each unique pair of sample indices
    pairMat = combn(M, 2)

    #  function to count the number of interacting samples in a vector of sample indices
    intCounter = function(ixVec) sum(intSmpls[ixVec])

    #  numerical vector of the number of samples in each sample pair that were interacting samples
    intCount = apply(pairMat, 2, intCounter)

    #  store data in a data frame
    DOCDF = data.frame(intCount = intCount, over = doc$x, diss = doc$y)

    return(DOCDF)

  } #  end produceDOC function

  #  create a list of replicate data frames
  DOCDFList = lapply(as.list(1:numDOC), produceDOCDF)

  #  aggregate data from the replicates
  aggDOCDF = Reduce(rbind, DOCDFList)

  #  make the intCount variable a factor
  aggDOCDF$intCount = as.factor(aggDOCDF$intCount)

  #  create title text
  titleText = "DOC Points"

  #  create parameter text
  paramText = paste("M = ", M, "N = ", N, "lambda = ", lambda, "numDOC = ", numDOC)

  #  compute the mean overlap of points that correspond to comparisons between samples that are
  #  both non-interacting (intCount == 0), one interacting and one non-interacting (intCount == 1),
  #  or both interacting (intCount == 2)
  meanVec = sapply(0:2, function(x) round(mean(aggDOCDF$over[aggDOCDF$intCount == x]), 2))

  #  create text to display means in plot title
  meanText = paste("meanOverlap: ", "nonInt-nonInt = ", meanVec[1], ", nonInt-int = ", meanVec[2],
                   ", int-int = ", meanVec[3])

  aggDOCDF = aggDOCDF[aggDOCDF$intCount != 1, ]

  ##  create ggplot object
  p = ggplot(aggDOCDF, aes(x = over, y = diss, col = intCount)) +
    #geom_point(alpha = 0.2) +
    stat_bin_2d() +
    coord_cartesian(xlim = c(0.5, 1), ylim = c(0, 0.6)) +
    ggtitle(titleText) +
    annotate("text", x = 0.75, y = 0.6, label = paramText) +
    annotate("text", x = 0.75, y = 0.55, label = meanText)

  #  plot the ggplot object in a new graphics window
  dev.new()
  plot(p)

} #  end plotColorCodedDOC function


# Script to test the OP program
SMS.installed<-T
area_model<-T

library(lattice)

if (!SMS.installed) {
  data.path<-file.path("C:","mv","sms","FBA")
  source(file.path(data.path,"R-prog","FLOP.control.r"))
  source(file.path(data.path,"R-prog","OP_plot.r"))
}

if (SMS.installed) {
  #read the "environment"
  SMS<-read.FLSMS.control(file=file.path(data.path,'SMS.dat'))
  no.areas<-SMS@no.areas     # 4
  no.q<-SMS@last.season      # 4
  nsp<-SMS@no.species        # 3
  max.age.all<-SMS@max.age.all  # 8
  n.other.pred<-sum(SMS@species.info[,'predator']==2) # 0
  n.vpa<-nsp-n.other.pred # 3
}  else {
  if (area_model) no.areas<-4 else no.areas<-1
  no.q<-4
  nsp<-3
  max.age.all<- 8
  n.other.pred<-0
  n.vpa<-3
  first.VPA<-1
  sp.names<-c("Cod","Herring","Sprat")
  fa<-0
  rec.season<-3
  av.F.age<- matrix(c(4,7,3,6,3,5),byrow=T, ncol=2)
  setwd(data.path)
}

# Read the OP.par file
OP<-read.FLOP.control(file=file.path(data.path,'OP.dat'),n.VPA=n.vpa,n.other.pred=n.other.pred)

OP@first.year<-2012
OP@last.year<-2012
OP@F.or.C[1,]<-rep(1,n.vpa)    # set input as F at age
OP@output<-15                  # very detailed output!
write.FLOP.control(OP,file='OP.dat',nice=T)   # write the OP.dat file with updated values

# SMS has provided stock numbers
# first we have to create catch by area from dummy F
# create F at age by area
f<-array(0.1,dim=c(no.q,no.areas,n.vpa,max.age.all+1),
   dimnames=list(paste('q_',(1:no.q),sep=''),
                 paste('area_',(1:no.areas),sep=''),
                 paste('sp_',(nsp-n.vpa+1):n.vpa,sep=''),
                 paste('a_',(0:max.age.all),sep='')))
f[,,'sp_1',]<-0.15   # higher F on cod
if (area_model) f[,4,'sp_1',]<-0    # no cod in area 4 (outside area 25, 26 and 28)
f[,,,1]<-0         # no fishing for the 0-group

read_area_file<-function(filename) {
    f<-scan(file=file.path(data.path,filename),comment.char = "#" )
    dim(f)<-c(max.age.all+1,n.vpa,no.areas,no.q)
    dimnames(f)=list( paste('a_',(0:max.age.all),sep=''),
                     paste('sp_',(nsp-n.vpa+1):n.vpa,sep=''),
                     paste('area_',(1:no.areas),sep=''),
                     paste('q_',(1:no.q),sep=''))
    f<-aperm(f,c(4,3,2,1))
    return(f)
}

write_area_file<-function(out,vari) {
  outFile<-file.path(data.path,out)
  cat("# data by quarter, area, species and age\n",file=outFile)
  for (q in (1:no.q))  {
    cat("# quarter:",q,"\n",file=outFile,append=T)
    for (d in (1:no.areas)) write.table(vari[q,d,,],file=outFile,append=TRUE,quote=FALSE,sep=" ",row.names=FALSE,col.names=FALSE)
  }
}

write_area_file('OP_F.in',f)

# make a run one year ahead (you could change the years in OP.dat, but it is really not nesesary)
system("op -maxfn 0 -nohess",show.output.on.console=T)

# read detalied data for year y
a<-read.table(file=file.path(data.path,"OP_summary.out"),header=T)
head(a)

# read detalied annual data  for year y
anno<-read.table(file=file.path(data.path,"OP_summary_anno.out"),header=T)

# read stock number in year y+1
readN<-function() {
  matrix(scan(file=file.path(data.path,"OP_N.out"),comment.char = "#",quiet=T),nrow=n.vpa,ncol=max.age.all+1,byrow=T,dimnames=list(sp.names,paste("age",0:max.age.all,sep="")))
}

# write stock number in year y+1
writeN<-function(N){
  write(t(N),ncolumns=max.age.all+1,file.path(data.path,"OP_N.in"))
}

N<-readN()

# just checking  that F going in and out are the same
Fout<-tapply(a$F,list(Quarter=a$Quarter,Area=a$Area,Species=a$Species.n,Age=a$Age),sum,na.rm=T)

ftable(Fout/f)

# just for testing: Give C as input and see if you get the same F outs as used to produce C
Cout<-tapply(a$C,list(Quarter=a$Quarter,Area=a$Area,Species=a$Species.n,Age=a$Age),sum,na.rm=T)
ftable(round(Cout/1000))
Cout[is.na(Cout)]<-0
write_area_file('OP_C.in',Cout)

OP@F.or.C[1,]<-rep(2,n.vpa)    # set input as C at age
write.FLOP.control(OP,file='OP.dat',nice=T)
system("op -maxfn 0 -nohess",show.output.on.console=T)

a<-read.table(file=file.path(data.path,"OP_summary.out"),header=T)

# just checking that F derived from catches are the same as F used to calculate catches
Fout<-tapply(a$F,list(Quarter=a$Quarter,Area=a$Area,Species=a$Species.n,Age=a$Age),sum,na.rm=T)
ftable(Fout/f)

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

# test
# get a fresh copy of initial stock numbers and F at age
file.copy(file.path(data.path,'backup','OP_N.in'),file.path(data.path,'OP_N.in'), overwrite = TRUE)
file.copy(file.path(data.path,'backup','OP_F.in'),file.path(data.path,'OP_F.in'), overwrite = TRUE)

OP@F.or.C[1,]<-rep(1,n.vpa)    # set input as F at age
OP@output<-15                  #  detailed output!
OP@stochastic.recruitment[]<-1  # Stochastic recrruitment
OP@rec.noise['lower',]<--2
OP@rec.noise['upper',]<- 2

write.FLOP.control(OP,file='OP.dat',nice=T)   # write the OP.dat file with updated values

res.N<-NULL
res.all<-NULL
res.anno<-NULL
for (y in (1:30) ) {

 cat(file='op_seed.in',round(runif(1, min=0, max=1E5)),'\n')
 system("op -maxfn 0 -nohess",show.output.on.console=T)
 Nnew<-readN()
 tmp<-arr2df(Nnew)
 tmp$year<-y
 res.N<-rbind(tmp,res.N)

 tmp<-read.table(file=file.path(data.path,"OP_summary.out"),header=T)
 tmp$Year<-y
 res.all<-rbind(tmp,res.all)

 tmp<-read.table(file=file.path(data.path,"OP_summary_anno.out"),header=T)
 tmp$Year<-y
 res.anno<-rbind(tmp,res.anno)

 ## simulate the assessment

 writeN(Nnew)  # initial population     # write Real N (recived from Operating model) to be used for next round
}

names(res.N)<-c("Species","Age","N","year")
xyplot(N~year |Species,groups=Age,scales=list(relation='free') ,type='b',data=res.N)

OP_plot(res.all)

# sprat dies out!!

#########################
# get a fresh copy of initial stock numbers and F at age
file.copy(file.path(data.path,'backup','OP_N.in'),file.path(data.path,'OP_N.in'), overwrite = TRUE)
file.copy(file.path(data.path,'backup','OP_F.in'),file.path(data.path,'OP_F.in'), overwrite = TRUE)

f<-read_area_file('OP_F.in')
# decrease sprat F
f[,,'sp_3',] <-f[,,'sp_3',]/2

# increase F on cod
f[,,'sp_1',] <-f[,,'sp_1',]*1.5

write_area_file('OP_F.in',f)

# just testing
ftable(apply(f,c(1,2,3,4),sum))

res.N<-NULL
res.all<-NULL
res.anno<-NULL
for (y in (1:40) ) {

cat(file='op_seed.in',round(runif(1, min=0, max=1E5)),'\n')
 system("op -maxfn 0 -nohess",show.output.on.console=T)
 Nnew<-readN()
 tmp<-arr2df(Nnew)
 tmp$year<-y
 res.N<-rbind(tmp,res.N)

 tmp<-read.table(file=file.path(data.path,"OP_summary.out"),header=T)
 tmp$Year<-y
 res.all<-rbind(tmp,res.all)

 tmp<-read.table(file=file.path(data.path,"OP_summary_anno.out"),header=T)
 tmp$Year<-y
 res.anno<-rbind(tmp,res.anno)

 ## simulate the assessment

 writeN(Nnew)  # initial population     # write Real N (recived from Operating model) to be used for next round
}

names(res.N)<-c("Species","Age","N","year")
xyplot(N~year |Species,groups=Age,scales=list(relation='free') ,type='b',data=res.N)

xyplot(N~year |Species,groups=Age,scales=list(relation='free') ,type='b',data=res.N,subset=(Species=='Cod' & Age=='age2'))

OP_plot(res.all)


# R program to read in station data and make diurnal cycle plots

# use "station_longitude"?
# 6.1 or 7.0 for AMS?

library('ncdf4')
library('RColorBrewer')
cols=brewer.pal(6,'Set1')

localdatadir='local-data-files'

meanwin=c(1998.8,2019.2) # window for calculating means, inclusive

flag='_Custom'

# read in NOAA in situ record from SPO for subtraction
sponc=nc_open(paste(localdatadir,'/obspack_co2_1_GLOBALVIEWplus_v6.0_2020-09-11/data/nc/co2_spo_surface-insitu_1_allvalid.nc',sep=''))
spoco2=data.frame(cbind(t(ncvar_get(sponc,'time_components')),ncvar_get(sponc,'value')*1E6)) ; colnames(spoco2)=c('year','mon','day','hour','min','sec','co2')
qcflag=ncvar_get(sponc,'qcflag'); spoco2$co2[substr(qcflag,1,1)!='.']=NA; spoco2$co2[substr(qcflag,2,2)!='.']=NA
spoco2dt=ISOdatetime(spoco2$year,spoco2$mon,spoco2$day,spoco2$hour,spoco2$min,spoco2$sec,tz='UTC')

# set up png
png(paste('so_co2_diurnal_cycles',flag,'.png',sep=''),width=1200,height=1200,pointsize=25)
par(mfrow=c(2,2))
par(mar=c(3,3,2,1))
par(oma=c(2,2,0,0))
par(mgp=c(2.5,0.75,0))

# loop on site
siteno=0
for(site in c('ams','cpt','mqa','syo')){
print(site)
siteno=siteno+1

isgvp=NULL # in situ GlobalView+ record
iscust=NULL # in situ custom record

# read in data
if(site=='ams'){

	is=nc_open(paste(localdatadir,'/obspack_co2_1_GLOBALVIEWplus_v6.0_2020-09-11/data/nc/co2_',site,'_surface-insitu_11_representative.nc',sep=''))
	isgvp=data.frame(cbind(t(ncvar_get(is,'time_components')),ncvar_get(is,'value')*1E6)) ; colnames(isgvp)=c('year','mon','day','hour','min','sec','co2')
	lon=median(ncvar_get(is,'longitude'))

	# for custom, now using GV+ 7.0 with flagging ### use GV+ 6.1 instead? if so, set value_original_scale back to value
	is=nc_open(paste(localdatadir,'/obspack_co2_1_GLOBALVIEWplus_v7.0_2021-08-18/data/nc/co2_',site,'_surface-insitu_11_allvalid.nc',sep=''))
	iscust=data.frame(cbind(t(ncvar_get(is,'time_components')),ncvar_get(is,'value_original_scale')*1E6)) ; colnames(iscust)=c('year','mon','day','hour','min','sec','co2')
	iscust$co2[ncvar_get(is,'obs_flag')==0]=NA

} else if(site=='cpt'){

	is=nc_open(paste(localdatadir,'/obspack_co2_1_GLOBALVIEWplus_v6.0_2020-09-11/data/nc/co2_',site,'_surface-insitu_36_marine.nc',sep=''))
	isgvp=data.frame(cbind(t(ncvar_get(is,'time_components')),ncvar_get(is,'value')*1E6)) ; colnames(isgvp)=c('year','mon','day','hour','min','sec','co2')
	lon=median(ncvar_get(is,'longitude'))

	# for custom, now using WDCGG 222Rn to filter (WDCGG CO2 appears to be on X2019 so still using ObsPack)
	# filter for 222Rn < 150
     	rn=nc_open(paste(localdatadir,'/wdcgg/nc/222rn/hourly/222rn_cpt_surface-insitu_7_9999-9999_hourly.nc',sep=''))
        rncust=data.frame(cbind(t(ncvar_get(rn,'start_time_components')),ncvar_get(rn,'value'))) ; colnames(rncust)=c('year','mon','day','hour','min','sec','rn')
	iscust=merge(isgvp,rncust,by=c('year','mon','day','hour','min','sec'),all=F)
	iscust$co2[iscust$rn>150]=NA
	iscust$co2[is.na(iscust$rn)]=NA

} else if(site=='mqa'){

	# for custom, now using WDCGG
	is=nc_open(paste(localdatadir,'/wdcgg/nc/co2/hourly/co2_mqa_surface-insitu_16_9999-9999_hourly.nc',sep=''))
	iscust=data.frame(cbind(t(ncvar_get(is,'start_time_components')),ncvar_get(is,'value'))) ; colnames(iscust)=c('year','mon','day','hour','min','sec','co2')
	iscust$co2[ncvar_get(is,'QCflag')!=1]=NA
	lon=median(ncvar_get(is,'longitude'),na.rm=T)

} else if(site=='syo'){

	site='syo'
	is=nc_open(paste(localdatadir,'/obspack_co2_1_GLOBALVIEWplus_v6.0_2020-09-11/data/nc/co2_',site,'_surface-insitu_8_allvalid.nc',sep=''))
	isgvp=data.frame(cbind(t(ncvar_get(is,'time_components')),ncvar_get(is,'value')*1E6)) ; colnames(isgvp)=c('year','mon','day','hour','min','sec','co2')
	lon=median(ncvar_get(is,'longitude'))

}

# trim for 1999-present
if(!is.null(isgvp)){
	decdate=isgvp$year+(isgvp$mon-0.5)/12
	isgvp=isgvp[decdate>=meanwin[1]&decdate<meanwin[2],]
}
if(!is.null(iscust)){
	decdate=iscust$year+(iscust$mon-0.5)/12
	iscust=iscust[decdate>=meanwin[1]&decdate<meanwin[2],]
}

ylm=NULL
yspan=0.8
xlm=c(0,24)

localnoon=-lon/360*24+12

# subtract off SPO, calculate mean diurnal cycle, and shift to local time
if(!is.null(isgvp)){

	isgvpdt=ISOdatetime(isgvp$year,isgvp$mon,isgvp$day,isgvp$hour,isgvp$min,isgvp$sec,tz='UTC')
	isgvp$mmint=approx(as.POSIXct(spoco2dt),spoco2$co2,as.POSIXct(isgvpdt),rule=2)$y # interpolate spo monthly means to times of obs
	isgvp$anom=isgvp$co2-isgvp$mmint
	diur=aggregate(isgvp$anom,by=list(hour=isgvp$hour),median,na.rm=T)
	diur$hour=diur$hour+0.5; diur$lst=diur$hour-localnoon+12
	diur$lst[diur$lst>24]=diur$lst[diur$lst>24]-24; diur$lst[diur$lst<0]=diur$lst[diur$lst<0]+24
	diur=diur[order(diur$lst),] # 'solar' local standard time
	ylm=(max(diur$x)+min(diur$x))/2+c(-0.5,0.5)*yspan

} # if(!is.null(isgvp))

if(!is.null(iscust)){

        #iscust$mmint=approx(spoco2$year+(spoco2$mon-0.5)/12,spoco2$co2,iscust$year+(iscust$mon-1)/12+iscust$day/365+iscust$hour/365/24,rule=2)$y # interpolate spo monthly means to times of obs
	iscustdt=ISOdatetime(iscust$year,iscust$mon,iscust$day,iscust$hour,iscust$min,iscust$sec,tz='UTC')
	iscust$mmint=approx(as.POSIXct(spoco2dt),spoco2$co2,as.POSIXct(iscustdt),rule=2)$y # interpolate spo monthly means to times of obs
        iscust$anom=iscust$co2-iscust$mmint
        diurcust=aggregate(iscust$anom,by=list(hour=iscust$hour),median,na.rm=T)
        diurcust$hour=diurcust$hour+0.5; diurcust$lst=diurcust$hour-localnoon+12
        diurcust$lst[diurcust$lst>24]=diurcust$lst[diurcust$lst>24]-24; diurcust$lst[diurcust$lst<0]=diurcust$lst[diurcust$lst<0]+24
        diurcust=diurcust[order(diurcust$lst),] # 'solar' local standard time
        if(is.null(ylm)){
                ylm=(max(diurcust$x)+min(diurcust$x))/2+c(-0.5,0.5)*yspan
        } else {
                ylm=(max(c(diurcust$x,diur$x))+min(c(diurcust$x,diur$x)))/2+c(-0.5,0.5)*yspan
        }
}

# plot
plot(c(1:3),c(1:3),type='n',xlab='',ylab='',cex.main=1.5,cex.lab=1.5,cex.axis=1.5,xlim=xlm,ylim=ylm,axes=F) # blank plot
abline(h=0)
box()
axis(1,at=seq(0,24,6),cex.axis=1.5,cex.lab=1.5)
axis(2,at=seq(-0.4,0.2,0.2),cex.axis=1.5,cex.lab=1.5)
if(!is.null(isgvp)){
	if(site!='syo'){
		points(diur$lst,diur$x,cex=1.5,lwd=2.5,col='black')
	} else {
		points(diur$lst,diur$x,cex=1.5,lwd=4,col='black')
	}
	print(paste('GV+ mean',round(mean(diur$x),2)))
}
if(!is.null(iscust)){
	points(diurcust$lst,diurcust$x,cex=1.5,lwd=4,col=cols[siteno])
	print(paste('Custom mean',round(mean(diurcust$x),2)))
}
if(site=='syo'){ ptlwd=4 } else { ptlwd=2.5 }
sel=c(!is.null(isgvp),!is.null(iscust))
legend('bottomleft',c('GV+ 6.0','Custom')[sel],col=c('black',cols[siteno])[sel],pt.lwd=c(ptlwd,4)[sel],pch=1,cex=1.5,bty='n')
mtext(c('A','B','C','D')[siteno],3,adj=0.05,line=0.5,cex=1.5,font=2)
mtext(toupper(site),3,adj=0.95,line=-2,cex=1.5)

} # loop on site

mtext(expression(paste(CO[2],' - SPO (ppm)')),2,0,outer=T,cex=1.5)
mtext('Hour (Local Solar Time)',1,0,outer=T,cex=1.5)

dev.off()


library(ggplot2)
library(dplyr)
library(RColorBrewer)
library(tidyr)
library(readr)
library(stringr)
library(ggbeeswarm)
options(scipen = 999)

df = read.csv('~/Downloads/time.csv')
df2 = read.csv('~/Downloads/time.csv')
df_header = df[,1]
df2_header = df2[,1]
df_tmp = log(df[,2:6])
df2_tmp = log(df2[,2:6])
df = cbind(df_header,df_tmp)
df2 = cbind(df2_header,df2_tmp)
names(df)[names(df) == "df_header"] <- "Benchmark"
names(df2)[names(df2) == "df2_header"] <- "Benchmark"
df = df %>% filter(!grepl('CTS', Benchmark))
df2 = df2 %>% filter(!grepl('CTS', Benchmark))
df = df %>% filter(!grepl('BPT_ATP', Benchmark))
df2 = df2 %>% filter(!grepl('BPT_ATP', Benchmark))
df = df %>% mutate(t = str_split(Benchmark, "_")) %>% mutate(t1 = sapply(t, '[', 1)) %>% mutate(t2 = sapply(t, '[', 2))
df2 = df2 %>% mutate(t = str_split(Benchmark, "_")) %>% mutate(t1 = sapply(t, '[', 1)) %>% mutate(t2 = sapply(t, '[', 2))
df = df %>% gather("type", "value", 2:6)
df2 = df2 %>% mutate(mean = rowMeans(select(.,starts_with("Time")), na.rm = TRUE))
df2 %>% head
p = ggplot () + theme_light()
p + theme(axis.title.x=element_blank(),axis.text.x=element_blank(), axis.ticks.x=element_blank()) +  theme(axis.title.y=element_blank(),axis.text.y=element_blank(), axis.ticks.y=element_blank()) +
#p + theme(axis.text.x = element_text(angle = 45, hjust = 0.1, size = 12)) + theme(axis.text.y = element_text(size = 12)) + xlab("") + ylab("") +
  geom_point(data = df2, aes(x = t1, y = mean, colour = t2, shape = t2, size = 12), show.legend = FALSE)
ggsave("figure_7.pdf", width = 5, height = 5)


#### Preamble ####
# Purpose: Prepare and clean the survey data downloaded from [...UPDATE ME!!!!!]
# Author: Rohan Alexander and Sam Caetano [CHANGE THIS TO YOUR NAME!!!!]
# Data: 22 October 2020
# Contact: rohan.alexander@utoronto.ca [PROBABLY CHANGE THIS ALSO!!!!]
# License: MIT
# Pre-requisites:
# - Need to have downloaded the ACS data and saved it to inputs/data
# - Don't forget to gitignore it!

#### Workspace setup ####
library(haven)
library(tidyverse)
# Read in the raw data.
#setwd("C:/Users/Sammi-Jo/Desktop/PS3")
raw_data <- read_dta("usa_00001.dta")

# Add the labels
raw_data <- labelled::to_factor(raw_data)

# Just keep some variables that may be of interest (change
# this depending on your interests)
reduced_data <-
  raw_data %>%
  select(#region,
         #stateicp,
         sex,
         age,
         race)#,
         #hispan,
         #marst,
         #bpl,
         #citizen,
         #educd,
         #labforce,
         #labforce)

#### What's next? ####

## Here I am only splitting cells by age, but you
## can use other variables to split by changing
## count(age) to count(age, sex, ....)

reduced_data <-
  reduced_data %>%
  count(age, sex, race) %>%
  group_by(age, sex, race)

reduced_data <-
  reduced_data %>%
  filter(age != "less than 1 year old") %>%
  filter(age != "90 (90+ in 1980 and 1990)")

reduced_data$age <- as.integer(reduced_data$age)

reduced_data$race<-revalue(reduced_data$race, c("american indian or alaska native"="Some other race"))
reduced_data$race<-revalue(reduced_data$race, c("black/african american/negro"="Black, or African American"))
reduced_data$race<-revalue(reduced_data$race, c("chinese"="Asian/Pacific Islander"))
reduced_data$race<-revalue(reduced_data$race, c("japanese"="Asian/Pacific Islander"))
reduced_data$race<-revalue(reduced_data$race, c("other asian or pacific islander"="Asian/Pacific Islander"))
reduced_data$race<-revalue(reduced_data$race, c("other race, nec"="Some other race"))
reduced_data$race<-revalue(reduced_data$race, c("three or more major races"="Some other race"))
reduced_data$race<-revalue(reduced_data$race, c("two major races"="Some other race"))
reduced_data$race <- revalue(reduced_data$race, c("white" = "AA_White"))

reduced_data$sex<-revalue(reduced_data$sex, c("male"="Male"))
reduced_data$sex<-revalue(reduced_data$sex, c("female"="Female"))

names(reduced_data)[1]<-"gender"
names(reduced_data)[3]<-"race_ethnicity"

reduced_data <-
  reduced_data %>%
  filter(age >17) %>%
  group_by(age)%>%
  count()

# Saving the census data as a csv file in my
# working directory
write_csv(reduced_data, "census_data.csv")