# To run this case study, you should have R version of 3.0.2 or later
# This is a modified version of the code available at:
#   http://bioinf.wehi.edu.au/RNAseqCaseStudy/
# Download and extract the files
# Running the 1.download.sh script should perform this automatically
# Then copy this script into that directory and run it instead of code.R
# load libraries
library(Rsubread)
library(limma)
library(edgeR)

# read in target file
options(digits=2)
targets <- readTargets()
targets

# create a design matrix
celltype <- factor(targets$CellType)
design <- model.matrix(~celltype)

# build an index for reference sequence (Chr1 in hg19)
buildindex(basename="chr1",reference="hg19_chr1.fa")

# align reads
align(index="chr1",readfile1=targets$InputFile,input_format="gzFASTQ",output_format="BAM",output_file=targets$OutputFile,unique=TRUE,indels=5)

# count numbers of reads mapped to NCBI Refseq genes
# the file is obtained from:
#   https://ftp.ncbi.nlm.nih.gov/genomes/refseq/vertebrate_mammalian/Homo_sapiens/all_assembly_versions/GCF_000001405.25_GRCh37.p13/GCF_000001405.25_GRCh37.p13_genomic.gtf.gz
# our version is slightly modified from the original gtf version
# gzip -cd "${INFILE_DIR}/GCF_000001405.25_GRCh37.p13_genomic.gtf.gz" | \
#   grep -P "^#|^NC_000001.10\t" | sed "s|NC_000001.10	|chr1	|" > \
#   "${INFILE_DIR}/hg19_chr1.gtf"

fc <- featureCounts(files=targets$OutputFile,isGTFAnnotationFile=TRUE,annot.ext="hg19_chr1.gtf")
write.table(fc$counts, sep="\t", quote=F, "original.tsv")
x <- DGEList(counts=fc$counts, genes=fc$annotation[,c("GeneID","Length")])

# generate RPKM values if you need them
x_rpkm <- rpkm(x,x$genes$Length)

# filter out low-count genes
isexpr <- rowSums(cpm(x) > 10) >= 2
x <- x[isexpr,]

# perform voom normalization
y <- voom(x,design,plot=TRUE)

# cluster libraries
plotMDS(y,xlim=c(-2.5,2.5))

# fit linear model and assess differential expression
fit <- eBayes(lmFit(y,design))
top <- topTable(fit,coef=2,number=Inf,sort.by="P")
write.table(top, sep="\t", quote=F, file="original.tsv.top.tsv")


import_package('dplyr', attach=TRUE)
import_package('igraph', attach=TRUE)
b = import('ebits/base')
io = import('ebits/io')
tfs = import('../util/tfs')$tfs

OUTFILE = commandArgs(TRUE)[1] %or% "genenet/LIHC/snormal.RData"
INFILES = OUTFILE %>%
    sub("\\.RData", "", .) %>%
    paste0(sprintf("/%i.RData", 1:100))

#' Loads a network data.frame, keeps only TF edges, and orders node1/2
load_fun = function(fname) {
    message(fname)
    re = io$load(fname) %>%
        mutate(node1 = as.character(node1),
               node2 = as.character(node2)) %>%
        filter(node1 %in% tfs | node2 %in% tfs,
               qval < 0.01)

    swap = mapply(`>`, re$node1, re$node2)
    tmp = re$node1[swap]
    re$node1[swap] = re$node2[swap]
    re$node2[swap] = tmp

    message("TF edges: ", dim(re))
    re
}

gdf = lapply(INFILES, load_fun) %>%
    bind_rows()

message("# of edges across all models: ", dim(gdf))

median_pos = ceiling(length(INFILES)/2)

gdf = gdf %>%
    group_by(node1, node2) %>%
    filter(length(unique(sign(pcor))) == 1) %>%
    summarize(pcor = sign(pcor[1]) * sort(abs(pcor))[median_pos],
              qval = 10^(sort(log10(qval))[median_pos])) %>%
    filter(abs(pcor) > .Machine$double.eps)

message("# of edges after filtering: ", dim(gdf))

g = graph_from_data_frame(gdf, directed=FALSE)

# write node attribute whether gene is TF
set_vertex_attr(g, "tf", index=V(g), value=V(g)$name %in% tfs)

dg = decompose.graph(g)
if (length(dg) > 1) {
    warning("Graph is not connected, using only first component")
    message("Component size: ", paste(sapply(dg, function(x)
            length(V(x))), collapse=", "))

    g = dg[[1]]
}

save(g, file=OUTFILE)


library(tidyverse)
library(tidytuesdayR)

freed_slaves <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-02-16/freed_slaves.csv')

freed_slaves<-mutate(freed_slaves, Free= paste(freed_slaves$Free, "%", sep=""))

g<-ggplot(freed_slaves, aes(Year, Slave))+
  geom_area(fill="black")+
  labs(title = ("PROPORTION OF FREEMAN AND SLAVES AMONG AMERICAN NEGROES . \n\n\n PROPORTION  DES  NÈGRES  LIBRES ET DES ESCLAVES EN AMÉRIQUE ."),
       subtitle = ("DONE BY ATLANTA UNIVERSITY ."),
       caption="Data source: W.E.B. Du Bois | Visualization: Rodrigo Santos")+
  geom_text(data=(subset(freed_slaves,freed_slaves$Year!=1870)) ,aes(y = Slave, label = Free, size = 12), vjust= -0.2, hjust=0.48, fontface="bold")+
  annotate("text", x = 1870, y = 91, label = "100%", size=4.3, fontface="bold", hjust=0.35)+
  coord_cartesian(clip = "off")+
  theme(panel.background = element_rect(fill = "#157645"),
        plot.background = element_rect(fill = "#d9cbbf"),
        panel.grid = element_blank(),
        axis.title=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks=element_blank(),
        axis.text.x=element_text(size=12, face="bold", colour="black"),
        panel.grid.major.x = element_line(size=0.1),
        legend.position="none",
        plot.margin= margin(4, 1.2, 0.3, 1.2, "cm"),
        plot.title = element_text(hjust = 0.5, vjust = 37, face="bold"),
        plot.subtitle = element_text(size=10,face="bold", hjust = 0.5, vjust = 35))+
  scale_x_continuous(limits = c(1790,1870), expand = c(0, 0), position="top", breaks = seq(1790, 1870, 10))+
  scale_y_continuous(limits=c(0, 120), expand = c(0, 0))+
  annotate("text", x = 1830, y = 112, label = "FREE  -  LIBRE", size=6, fontface="bold")+
  annotate("text", x = 1830, y = 50, label = "SLAVES \nESCLAVES", colour="#b2a9a1", size=7, fontface="bold")

g

ggsave(here::here("week8","gweek8.png"), width=7, height=10)


######
# DOSE-RESPONSE CURVES for SKMEL2 and HCEC
######

library(Cairo)

celltypes  = c('HCEC','SKMEL2')
treatments = c('TGFB3','Wnt3A','BMP4')
jitter     = c(-.01,.01)
names(jitter) = celltypes

cols = c('black','darkred')
names(cols) = celltypes

CairoSVG( 'dose', width=6, height=2 )
par( mfrow=c(1,3) )

########### TGFB3 DOSE-RESPONSE ############

plate    = 'W:/2013_06_wnt_tgfb_crosstalk/TI03/TI03_summaryStats.csv'

allData  = read.table( plate, sep=',', header=T, stringsAsFactors=F )

treatments = c('TGFB3')
channel    = 2
marker     = 'marker.2'

for( treatment in treatments ){

  concentrations   = sort( unique(allData$concentration[allData$treatment==treatment]))
  readouts         = unique(allData[allData$treatment==treatment,c('marker.2')])
  readout          = readouts[readouts != '']
  feature          = paste('sum_nucleus.median',channel,sep='.')

  logUnits         = log10(concentrations)
  logUnits[is.infinite(logUnits)]  = min(logUnits[!is.infinite(logUnits)])-1

  plot( NA,NA, xlab=paste('log10(',treatment,')',sep=''), xaxt='n',
        ylab = readout, xlim=range(logUnits), ylim=c(-.2,1.2),yaxt='n')
  axis(2,at=c(0,.5,1))
  axis(1,at=seq(min(round(logUnits)),max(round(logUnits)),by=1))
  abline( h=.5, col='gray', lty=3 )
  abline( h=1, col='gray', lty=3 )
  abline( h=0, col='gray', lty=3 )

  for( celltype in celltypes ){

    dataSubset = allData[allData$celltype==celltype & allData$treatment==treatment, c(feature,'concentration')]

    dataSubset = dataSubset[order(dataSubset$concentration),]

    responses  = matrix(dataSubset[,feature],ncol=3,byrow=T)

    # Normalize to 0 - 1
    responses = responses - mean(responses[1,])
    responses = responses / mean(responses[dim(responses)[1],])

    means     = apply(responses,1,mean)
    sds       = apply(responses,1,sd)

    for( idx in 1:length(logUnits)){
      lines( rep(logUnits[idx],2)+jitter[celltype], means[idx] + c(-1,1)*sds[idx], col= cols[celltype] )
    }

    lines( logUnits, means, lwd=2, col= cols[celltype] )
  }
  legend('topleft',celltypes,text.col=cols[celltypes],bty='n')
}

########### Wnt3A and BMP4 DOSE-RESPONSE ############

plates     = paste('W:/2013_06_wnt_tgfb_crosstalk/TI01/TI01.',1:2,'_summaryStats.csv',sep='')

allData    = read.table( plates[1], sep=',', header=T, stringsAsFactors=F )
allData    = rbind( allData, read.table( plates[2], sep=',', header=T, stringsAsFactors=F ))
treatments = c('Wnt3A','BMP4')

for( treatment in treatments ){

  concentrations   = sort( unique(allData$concentration[allData$treatment==treatment]))
  readouts         = unique(allData[allData$treatment==treatment,c('marker.2','marker.3')])
  markers          = names(readouts)[readouts != '']
  readout          = readouts[readouts != '']
  channel          = as.numeric(sub('marker.','',markers))
  feature          = paste('sum_nucleus.median',channel,sep='.')

  logUnits         = log10(concentrations)
  logUnits[is.infinite(logUnits)]  = min(logUnits[!is.infinite(logUnits)])-1

  plot( NA,NA, xlab=paste('log10(',treatment,')',sep=''), xaxt='n',
        ylab = readout, xlim=range(logUnits), ylim=c(-.1,1.1),yaxt='n')
  axis(2,at=c(0,.5,1))
  axis(1,at=seq(min(round(logUnits)),max(round(logUnits)),by=1))
  abline( h=.5, col='gray', lty=3 )
  abline( h=1, col='gray', lty=3 )
  abline( h=0, col='gray', lty=3 )

  for( celltype in celltypes ){

    dataSubset = allData[allData$celltype==celltype & allData$treatment==treatment, c(feature,'concentration')]

    dataSubset = dataSubset[order(dataSubset$concentration),]

    responses  = matrix(dataSubset[,feature],ncol=3,byrow=T)

    # Normalize to 0 - 1

    responses = responses - min(apply(responses,1,mean))
    responses = responses / max(apply(responses,1,mean))

    means     = apply(responses,1,mean)
    sds       = apply(responses,1,sd)

    for( idx in 1:length(logUnits)){
      lines( rep(logUnits[idx],2)+jitter[celltype], means[idx] + c(-1,1)*sds[idx], col= cols[celltype] )
    }

    lines( logUnits, means, lwd=2, col= cols[celltype] )
  }
  legend('topleft',celltypes,text.col=cols[celltypes],bty='n')
}

dev.off()


# gen_nsw
source("src/0a_setup.r")
source("src/0c_stand_alone_gen_data.r")

i = 1
for(yr in 2017:2013) {
  for(mths in 12:1) {
    gen_datatable_synthetic2(N = 2e6/((1+0.04/12)^i), mk = yr*100+mths)
  }
}


# attempt to make box plots
# box_plots11.r - add shaded bars to shown medians on some plots
# box_plots12.r - add totals to several boxplot, reduce whitespace

library(tidyverse)
library(cowplot)
library(RColorBrewer)
library(ggthemes)

# path for output
# out_path <- 'run - eckhardt_priors_narrow/'
print(out_path)

# years of simulation
nyears <- 15
print(paste(nyears, "years"))

# functions
"%notin%" <- function(x,y)!("%in%"(x,y))

# read in data
print("reading data")
source('read_data9.r')
nruns <- nrow(runlist)

# read in model samples
print("organising data")
rows <- 1:nruns
datalist <- list()
for (i in rows) {

  # write header
  data_file_name <- paste(runlist$catchfile[i], '_data.dat', sep='')
  opt_file_name <- runlist$optfile[i]

  # assemble run options/data into vectors (?)
  arun <- runlist[i, ]
  adata <- data[grep(pattern=data_file_name, x=data$file), ]
  aarea <- tibble(area=adata$area[1])
  aoptions <- options[opt_file_name, ]
  aalloptions <- cbind(arun, aoptions, aarea) # combine into one data table
  startcalib <- aalloptions$startcalib
  endcalib <- aalloptions$endcalib
  catchname <- aalloptions$catchname
  setname <- aalloptions$setname
  setseq <- aalloptions$setseq

  # read samples
  temp <- read_rds(paste(out_path, setname, '_samples.rds', sep=''))

  # files are missing for Ot(b) and Wp(b), you can use this to create them
  if (FALSE) {
  temp[, ] <- NA
  temp$setname <- 'Ot(b)'
  write_rds(temp, paste(out_path, 'Ot(b)', '_samples.rds', sep=''))
  temp$setname <- 'Wp(b)'
  write_rds(temp, paste(out_path, 'Wp(b)', '_samples.rds', sep=''))
  }

  temp$setseq <- setseq
  datalist[[i]] <- temp # build a list of dataframes

}
sampledata <- bind_rows(datalist)
sampledata$setseqf <- factor(sampledata$setseq, levels=c(1:nruns))
sampledata$catchname <- substr(sampledata$setname, 1, 2)
sampledata$catchnamef <- factor(sampledata$catchname)

# define boxplot stats
# https://github.com/tidyverse/ggplot2/issues/898
custombox1 <- function(y) { # for error bar
  data.frame(ymin=quantile(y,0.025),
             lower=quantile(y,0.25),
             middle=quantile(y,0.5),
             upper=quantile(y,0.75),
             ymax=quantile(y,0.975),
             y=y,
             width=0.5)[1, ]
}
custombox2 <- function(y) { # for box
  data.frame(ymin=quantile(y,0.025),
             lower=quantile(y,0.25),
             middle=quantile(y,0.5),
             upper=quantile(y,0.75),
             ymax=quantile(y,0.975),
             y=y,
             width=0.7)[1, ]
}
custombox3 <- function(y) { # for error bar
  data.frame(ymin=quantile(y,0.025),
             lower=quantile(y,0.25),
             middle=quantile(y,0.5),
             upper=quantile(y,0.75),
             ymax=quantile(y,0.975),
             y=y,
             width=0.25)[1, ]
}
custombox4 <- function(y) { # for box
  data.frame(ymin=quantile(y,0.025),
             lower=quantile(y,0.25),
             middle=quantile(y,0.5),
             upper=quantile(y,0.75),
             ymax=quantile(y,0.975),
             y=y,
             width=0.3)[1, ]
}

# test inputs
varname <- 'medb0'
ylabel <- 'Medium b0\n'
ybreaks <- seq(0,1,0.2)
yref <- 0
ytrans <- "identity"
median_fill <- NA
median_colour <- NA
median_alpha <- 1

# handle number of runs
if (nrow(runlist)==24){
  xlabels <- c('','Wh','',
               '','Wp','',
               '','Po','',
               '','Ot','',
               '','Ta','',
               '','Pu','',
               '','Wt','',
               '','Pi','')
  xint <- c(3.5,6.5,9.5,12.5,15.5,18.5,21.5)
  barwidth <- 2.2
  barfilter <- seq(2,nruns,3)
}else {
  xlabels <- c('Wh',
               'Wp',
               'Po',
               'Ot',
               'Ta',
               'Pu',
               'Wt',
               'Pi')
  xint <- c(1.5,2.5,3.5,4.5,5.5,6.5,7.5)
  barwidth <- 0.8
  barfilter <- 1:nruns
}

# box plot. do it using a function
bplot <- function(sampledata, varname, ylabel, ybreaks, yref=0, ytrans="identity"){
  ggplot(data=sampledata) +
    labs(title='', y=ylabel, x='') +
    theme_cowplot(font_size=10) +
    theme(axis.ticks.x=element_blank(),
          # plot.margin=unit(c(0.2,0.2,0.2,0.2),"cm"),
          plot.title=element_blank()) +
    panel_border(colour='black') +
    geom_hline(yintercept=yref, linetype=2, colour='black') +
    geom_vline(xintercept=xint, colour='grey') +
    # stat_boxplot(data=sampledata, mapping=aes_string(x='setseqf', y=varname),
    #             geom="errorbar", width=0.35) +
    stat_summary(mapping=aes_string(group='setseqf', x='setseqf', y=varname),
                 fun.data=custombox1, geom='errorbar') +
    # geom_boxplot(outlier.size=0.5, notch=FALSE, outlier.shape=NA) +
    # https://stackoverflow.com/questions/17479793/changing-bar-width-when-using-stat-summary-with-ggplot
    stat_summary(mapping=aes_string(group='setseqf', x='setseqf', y=varname),
                 fun.data=custombox2, geom='boxplot') + # width=? is set in custombox
    # stat_summary(data=sampledata, mapping=aes_string(x='setseqf', y=varname), fun.y=median, geom='point', pch=3, size=1) +
    scale_y_continuous(breaks=ybreaks, limits=c(min(ybreaks), max(ybreaks)), expand=c(0, 0), trans=ytrans) +
    scale_x_discrete(labels=xlabels)
}

# testing
p1 <- bplot(sampledata, 'medb0', 'Medium b0\n', seq(0,1,0.2), c(0,0.5))
print(p1)

# colours
choose <- c(3,5,7,5,3)
tpcol <- brewer.pal(9,"OrRd")[choose]
tncol <- brewer.pal(9,"YlGn")[choose]
fcol <- brewer.pal(9,"YlOrBr")[choose-1]
mcol <- brewer.pal(9,"PuBu")[choose+1]
scol <- brewer.pal(9,"RdPu")[choose+1]

# box plot with medians (which make it a lot slower)
bplot1 <- function(sampledata, varname, ylabel, ybreaks, yref=0, box_fill="white",
                  ytrans="identity", median_fill=NA, median_colour=NA, median_alpha=1){
  # medians <- sampledata[, c(varname, "setname", "setseq", "setseqf")] %>%
  #   rename(value=varname) %>%
  #   group_by(catchnamef) %>%
  #   mutate(median=median(value, na.rm=TRUE))
  if (is.na(median_fill)){
    sampledata2 <- sampledata %>%
      rename(varname=varname) %>%
      select(varname, catchnamef, setseqf, setseq) %>%
      mutate(median=NA_real_)
  } else {
    # this is very slow!!! because lots of copies of median??
    sampledata2 <- sampledata %>%
      rename(varname=varname) %>%
      select(varname, catchnamef, setseqf, setseq) %>%
      group_by(catchnamef) %>%
      mutate(median=median(varname, na.rm=TRUE)) %>%
      arrange(setseq)
    sampledata2$median[sampledata2$setseq==lag(sampledata2$setseq)] <- NA_real_ # discard dupes
    sampledata2$median[sampledata2$setseq %notin% barfilter ] <- NA_real_ # discard dupes
  }
  ggplot(data=sampledata2) +
    labs(title='', y=ylabel, x='') +
    theme_cowplot(font_size=10) +
    theme(axis.ticks.x=element_blank(),
          # plot.margin=unit(c(0.2,0.2,0.2,0.2),"cm"),
          plot.title=element_blank()) +
    panel_border(colour='black') +
    geom_col(mapping=aes(x=setseq, y=median), position="dodge", size=1, width=barwidth,
             alpha=median_alpha, fill=median_fill, colour=median_colour) +
    geom_hline(yintercept=yref, linetype=2, colour='black') +
    geom_vline(xintercept=xint, colour='grey') +
    # stat_boxplot(data=sampledata, mapping=aes_string(x='setseqf', y=varname),
    #             geom="errorbar", width=0.35) +
    stat_summary(mapping=aes_string(group='setseqf', x='setseqf', y='varname'),
                 fun.data=custombox1, geom='errorbar') +
    # geom_boxplot(outlier.size=0.5, notch=FALSE, outlier.shape=NA) +
    stat_summary(mapping=aes_string(group='setseqf', x='setseqf', y='varname'),
                 fun.data=custombox2, geom='boxplot', fill=box_fill) +
    # stat_summary(data=sampledata, mapping=aes_string(x='setseqf', y=varname), fun.y=median, geom='point', pch=3, size=1) +
    scale_y_continuous(breaks=ybreaks, limits=c(min(ybreaks), max(ybreaks)), expand=c(0, 0), trans=ytrans) +
    # geom_segment(mapping=aes(x=setseq-0.5, xend=setseq+0.5, y=median, yend=median), linetype=2, size=1, colour=median_colour) +
    scale_x_discrete(labels=xlabels, expand=c(0, 0))
}

# testing
p1 <- bplot1(sampledata, 'medb0', 'Medium b0\n', seq(0,1,0.2), c(0,0.5), median_fill=mcol[3], median_colour=mcol[3], median_alpha=0.2)
print(p1)

# pars
print("making pars box")
p1 <- bplot(sampledata, 'medb0', 'Medium b0\n', seq(0,1,0.2), c(0,0.5))
p2 <- bplot(sampledata, 'slowb0', 'Slow b0\n', seq(0,0.005,0.001), c(0,0.01))
p3 <- bplot(sampledata, 'meda1', 'Medium a1\n', seq(0,1,0.2), c(0.5,0.99))
p4 <- bplot(sampledata, 'slowa1', 'Slow a1\n', seq(0.995,1,0.001), c(0.99,0.9999))
plotbox <- plot_grid(p1, p2, p3, p4, nrow=2, align="hv")
# print(plotbox)
file_name <- paste(out_path, 'box_', 'pars', '.png', sep="")
save_plot(file_name, plotbox, base_height=6, base_width=8)

# Eckhardt pars
print("making eckpars box")
p1 <- bplot(sampledata, 'medBFImax', 'Medium BFImax\n', seq(0,1,0.2), c(0,1))
p2 <- bplot(sampledata, 'slowBFImax', 'Slow BFImax\n', seq(0,1,0.2), c(0,1))
p3 <- bplot(sampledata, 'medrec', 'Medium k\n', seq(0.9,1,0.02), c(0.5,1))
p4 <- bplot(sampledata, 'slowrec', 'Slow k\n', seq(0.999,1,0.0002), c(0.99,1))
plotbox <- plot_grid(p1, p2, p3, p4, nrow=2, align="hv")
# print(plotbox)
file_name <- paste(out_path, 'box_', 'eckpars', '.png', sep="")
save_plot(file_name, plotbox, base_height=6, base_width=8)

# # synthetic pars (trying to reduce unc)
# print("making synth box")
# sampledata$synth_m1 <- log(1-sampledata$meda1)
# sampledata$synth_s1 <- log(1-sampledata$slowa1)
# sampledata$synth_m2 <- sampledata$medb0 * sampledata$meda1
# sampledata$synth_s2 <- sampledata$slowb0 * sampledata$slowa1
# p1 <- bplot(sampledata, 'synth_m1', 'Medium Synth 1\n', seq(-6,0,1), c(0,1))
# p2 <- bplot(sampledata, 'synth_s1', 'Slow Synth 1\n', seq(-10,-5,1), c(0,1))
# p3 <- bplot(sampledata, 'synth_m2', 'Medium Synth 2\n', seq(0,1,0.1), c(0,1))
# p4 <- bplot(sampledata, 'synth_s2', 'Slow Synth 2\n', seq(0,0.005,0.001), c(0,1))
# plotbox <- plot_grid(p1, p2, p3, p4, nrow=2, align="hv")
# # print(plotbox)
# file_name <- paste(out_path, 'box_', 'synth', '.png', sep="")
# save_plot(file_name, plotbox, base_height=6, base_width=8)

# concs
print("making conc0 box")
p1 <- bplot1(sampledata, 'chem1fast0', expression('Fast TP Conc'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p2 <- bplot1(sampledata, 'chem1med0', expression('Medium TP Conc'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p3 <- bplot1(sampledata, 'chem1slow0', expression('Slow TP Conc'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
p4 <- bplot1(sampledata, 'chem2fast0', expression('Fast TN Conc'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p5 <- bplot1(sampledata, 'chem2med0', expression('Medium TN Conc'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p6 <- bplot1(sampledata, 'chem2slow0', expression('Slow TN Conc'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
plotbox <- plot_grid(p1, p4, p2, p5, p3, p6, nrow=3, align="hv")
# print(plotbox)
file_name <- paste(out_path, 'box_', 'conc0', '.png', sep="")
save_plot(file_name, plotbox, base_height=9, base_width=8)

print("making conc1 box")
p1 <- bplot1(sampledata, 'chem1fast1', expression('Fast TP Conc'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p2 <- bplot1(sampledata, 'chem1med1', expression('Medium TP Conc'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p3 <- bplot1(sampledata, 'chem1slow1', expression('Slow TP Conc'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
p4 <- bplot1(sampledata, 'chem2fast1', expression('Fast TN Conc'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p5 <- bplot1(sampledata, 'chem2med1', expression('Medium TN Conc'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p6 <- bplot1(sampledata, 'chem2slow1', expression('Slow TN Conc'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
plotbox <- plot_grid(p1, p4, p2, p5, p3, p6, nrow=3, align="hv")
# print(plotbox)
file_name <- paste(out_path, 'box_', 'conc1', '.png', sep="")
save_plot(file_name, plotbox, base_height=9, base_width=8)

print("making concTP box")
p1 <- bplot1(sampledata, 'chem1fast0', expression('Fast TP Conc0'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p2 <- bplot1(sampledata, 'chem1med0', expression('Medium TP Conc0'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p3 <- bplot1(sampledata, 'chem1slow0', expression('Slow TP Conc0'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
p4 <- bplot1(sampledata, 'chem1fast1', expression('Fast TP Conc1'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p5 <- bplot1(sampledata, 'chem1med1', expression('Medium TP Conc1'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p6 <- bplot1(sampledata, 'chem1slow1', expression('Slow TP Conc1'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
plotbox <- plot_grid(p1, p4, p2, p5, p3, p6, nrow=3, align="hv")
# print(plotbox)
file_name <- paste(out_path, 'box_', 'concTP', '.png', sep="")
save_plot(file_name, plotbox, base_height=9, base_width=8)

print("making concTN box")
p1 <- bplot1(sampledata, 'chem2fast0', expression('Fast TN Conc0'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p2 <- bplot1(sampledata, 'chem2med0', expression('Medium TN Conc0'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p3 <- bplot1(sampledata, 'chem2slow0', expression('Slow TN Conc0'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
p4 <- bplot1(sampledata, 'chem2fast1', expression('Fast TN Conc1'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p5 <- bplot1(sampledata, 'chem2med1', expression('Medium TN Conc1'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p6 <- bplot1(sampledata, 'chem2slow1', expression('Slow TN Conc1'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
plotbox <- plot_grid(p1, p4, p2, p5, p3, p6, nrow=3, align="hv")
# print(plotbox)
file_name <- paste(out_path, 'box_', 'concTN', '.png', sep="")
save_plot(file_name, plotbox, base_height=9, base_width=8)

# side by side two variables
bplot2 <- function(sampledata, varname0, varname1, ylabel, ybreaks, yref=0, box_fill="white",
                   ytrans="identity", median_fill=NA, median_colour=NA, median_alpha=1){
  if (is.na(median_fill)){
    sampledata2 <- sampledata %>%
      rename(varname0=varname0, varname1=varname1) %>%
      select(varname0, varname1, catchnamef, setseqf, setseq) %>%
      mutate(median0=NA_real_, median1=NA_real_)
  } else {
    # this is very slow!!! because lots of copies of median??
    sampledata2 <- sampledata %>%
      rename(varname0=varname0, varname1=varname1) %>%
      select(varname0, varname1, catchnamef, setseqf, setseq) %>%
      group_by(catchnamef) %>%
      mutate(median0=median(varname0, na.rm=TRUE), median1=median(varname1, na.rm=TRUE)) %>%
      arrange(setseq)
    sampledata2$median0[sampledata2$setseq==lag(sampledata2$setseq)] <- NA_real_ # discard dupes
    sampledata2$median0[sampledata2$setseq %notin% barfilter ] <- NA_real_ # discard dupes
    sampledata2$median1[sampledata2$setseq==lag(sampledata2$setseq)] <- NA_real_ # discard dupes
    sampledata2$median1[sampledata2$setseq %notin% barfilter ] <- NA_real_ # discard dupes
  }
  ggplot(data=sampledata2) +
    labs(title='', y=ylabel, x='') +
    theme_cowplot(font_size=10) +
    theme(axis.ticks.x=element_blank(),
          # plot.margin=unit(c(0.2,0.2,0.2,0.2),"cm"),
          plot.title=element_blank()) +
    panel_border(colour='black') +
    geom_col(mapping=aes(x=setseq-0.25, y=median0), position="dodge", size=1, width=barwidth/2,
             alpha=median_alpha, fill=median_fill, colour=median_colour) +
    geom_col(mapping=aes(x=setseq+0.25, y=median1), position="dodge", size=1, width=barwidth/2,
             alpha=median_alpha, fill=median_fill, colour=median_colour) +
    geom_hline(yintercept=yref, linetype=2, colour='black') +
    geom_vline(xintercept=xint, colour='grey') +
    # stat_boxplot(data=sampledata, mapping=aes_string(x='setseqf', y=varname),
    #             geom="errorbar", width=0.35) +
    stat_summary(mapping=aes(group=setseq, x=setseq-0.25, y=varname0), fun.data=custombox3, geom='errorbar') +
    stat_summary(mapping=aes(group=setseq, x=setseq-0.25, y=varname0), fun.data=custombox4, geom='boxplot', fill=box_fill) +
    stat_summary(mapping=aes(group=setseq, x=setseq+0.25, y=varname1), fun.data=custombox3, geom='errorbar') +
    stat_summary(mapping=aes(group=setseq, x=setseq+0.25, y=varname1), fun.data=custombox4, geom='boxplot', fill=box_fill) +
    # stat_summary(data=sampledata, mapping=aes_string(x='setseqf', y=varname), fun.y=median, geom='point', pch=3, size=1) +
    scale_y_continuous(breaks=ybreaks, limits=c(min(ybreaks), max(ybreaks)), expand=c(0, 0), trans=ytrans) +
    # geom_segment(mapping=aes(x=setseq-0.5, xend=setseq+0.5, y=median, yend=median), linetype=2, size=1, colour=median_colour) +
    scale_x_continuous(breaks=seq_along(xlabels), labels=xlabels, expand=c(0, 0))
}

print("making dconc box")
p1 <- bplot2(sampledata, 'chem1fast0', 'chem1fast1', expression('Fast TP Conc'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p2 <- bplot2(sampledata, 'chem1med0', 'chem1med1', expression('Medium TP Conc'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p3 <- bplot2(sampledata, 'chem1slow0', 'chem1slow1', expression('Slow TP Conc'~(mg~L^{-1})*'\n'), seq(0,0.8,0.2), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
p4 <- bplot2(sampledata, 'chem2fast0', 'chem2fast1', expression('Fast TN Conc'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p5 <- bplot2(sampledata, 'chem2med0', 'chem2med1', expression('Medium TN Conc'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p6 <- bplot2(sampledata, 'chem2slow0', 'chem2slow1', expression('Slow TN Conc'~(mg~L^{-1})*'\n'), seq(0,6,1), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
plotbox <- plot_grid(p1, p4, p2, p5, p3, p6, nrow=3, align="hv")
# print(plotbox)
file_name <- paste(out_path, 'box_', 'dconc', '.png', sep="")
save_plot(file_name, plotbox, base_height=9, base_width=8)

# loads
sampledata <- sampledata %>%
  mutate(
    fastflowmm = fastflow/area*86.4*365.25,
    medflowmm = medflow/area*86.4*365.25,
    slowflowmm = slowflow/area*86.4*365.25,
    totalflowmm = fastflowmm+medflowmm+slowflowmm,
    fastTPloadkg = fastTPload/area*10/nyears, # convert from t to kg/ha/y
    medTPloadkg = medTPload/area*10/nyears,
    slowTPloadkg = slowTPload/area*10/nyears,
    totalTPloadkg = fastTPloadkg+medTPloadkg+slowTPloadkg,
    fastTNloadkg = fastTNload/area*10/nyears,
    medTNloadkg = medTNload/area*10/nyears,
    slowTNloadkg = slowTNload/area*10/nyears,
    totalTNloadkg = fastTNloadkg+medTNloadkg+slowTNloadkg,
    fastTPloadpc = fastTPloadkg/(fastTPloadkg+medTPloadkg+slowTPloadkg),
    medTPloadpc = medTPloadkg/(fastTPloadkg+medTPloadkg+slowTPloadkg),
    slowTPloadpc = slowTPloadkg/(fastTPloadkg+medTPloadkg+slowTPloadkg),
    fastTNloadpc = fastTNloadkg/(fastTNloadkg+medTNloadkg+slowTNloadkg),
    medTNloadpc = medTNloadkg/(fastTNloadkg+medTNloadkg+slowTNloadkg),
    slowTNloadpc = slowTNloadkg/(fastTNloadkg+medTNloadkg+slowTNloadkg)
  )
#
print("making totals boxes")
tcol <- tncol[3]
varname <- 'totalTPloadkg'
pt1 <- bplot1(sampledata, 'totalTPloadkg', expression('Total TP Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,1.6,0.2), median_colour=NA, median_fill=tcol, median_alpha=0.2)
varname <- 'totalTNloadkg'
pt2 <- bplot1(sampledata, 'totalTNloadkg', expression('Total TN Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,20,5), median_colour=NA, median_fill=tcol, median_alpha=0.2)
varname <- 'totalflowmm'
pt3 <- bplot1(sampledata, 'totalflowmm', expression('Total Flow'~(mm~y^{-1})~'\n'), seq(0,1200,200), median_colour=NA, median_fill=tcol, median_alpha=0.2)
plotbox <- pt3
file_name <- paste(out_path, 'box_', 'totalflow', '.png', sep="")
save_plot(file_name, plotbox, base_height=3, base_width=4)
plotbox <- plot_grid(pt1, pt2, nrow=2, align="hv")
file_name <- paste(out_path, 'box_', 'totalload', '.png', sep="")
save_plot(file_name, plotbox, base_height=6, base_width=4)
plotbox <- plot_grid(pt3, pt1, pt2, nrow=3, align="hv")
file_name <- paste(out_path, 'box_', 'totalall', '.png', sep="")
save_plot(file_name, plotbox, base_height=9, base_width=4)
# plotbox <- plot_grid(p1, p2, nrow=2, align="hv")
# file_name <- paste(out_path, 'box_', 'totalload', '.png', sep="")
# save_plot(file_name, plotbox, base_height=6, base_width=4)
# file_name <- paste(out_path, 'box_', 'totalflow', '.png', sep="")
# save_plot(file_name, p3, base_height=3, base_width=4)

print("making TPload box")
p1 <- bplot1(sampledata, 'fastTPloadkg', expression('Fast TP Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,1,0.2), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p2 <- bplot1(sampledata, 'medTPloadkg', expression('Medium TP Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,1,0.2), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p3 <- bplot1(sampledata, 'slowTPloadkg', expression('Slow TP Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,1,0.2), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
p4 <- bplot1(sampledata, 'fastTPloadpc', 'Fast TP Yield Fraction\n', seq(0,1,0.2), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p5 <- bplot1(sampledata, 'medTPloadpc', 'Medium TP Yield Fraction\n', seq(0,1,0.2), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
varname <- 'slowTPloadpc'
p6 <- bplot1(sampledata, 'slowTPloadpc', 'Slow TP Yield Fraction\n', seq(0,1,0.2), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
plotbox <- plot_grid(p1, p4, p2, p5, p3, p6, nrow=3, align="hv")
file_name <- paste(out_path, 'box_', 'TPload', '.png', sep="")
save_plot(file_name, plotbox, base_height=9, base_width=8)
# plotbox <- plot_grid(pt1, NULL, p1, p4, p2, p5, p3, p6, nrow=4, align="hv")
# file_name <- paste(out_path, 'box_', 'TPload', '.png', sep="")
# save_plot(file_name, plotbox, base_height=12, base_width=8)

print("making TNload box")
p1 <- bplot1(sampledata, 'fastTNloadkg', expression('Fast TN Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,20,5), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p2 <- bplot1(sampledata, 'medTNloadkg', expression('Medium TN Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,20,5), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p3 <- bplot1(sampledata, 'slowTNloadkg', expression('Slow TN Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,20,5), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
p4 <- bplot1(sampledata, 'fastTNloadpc', 'Fast TN Yield Fraction\n', seq(0,1,0.2), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p5 <- bplot1(sampledata, 'medTNloadpc', 'Medium TN Yield Fraction\n', seq(0,1,0.2), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p6 <- bplot1(sampledata, 'slowTNloadpc', 'Slow TN Yield Fraction\n', seq(0,1,0.2), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
plotbox <- plot_grid(p1, p4, p2, p5, p3, p6, nrow=3, align="hv")
file_name <- paste(out_path, 'box_', 'TNload', '.png', sep="")
save_plot(file_name, plotbox, base_height=9, base_width=8)
# plotbox <- plot_grid(pt2, NULL, p1, p4, p2, p5, p3, p6, nrow=4, align="hv")
# file_name <- paste(out_path, 'box_', 'TNload', '.png', sep="")
# save_plot(file_name, plotbox, base_height=12, base_width=8)

print("making BOTHload box")
p1 <- bplot1(sampledata, 'fastTPloadkg', expression('Fast TP Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,1,0.2), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p2 <- bplot1(sampledata, 'medTPloadkg', expression('Medium TP Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,1,0.2), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p3 <- bplot1(sampledata, 'slowTPloadkg', expression('Slow TP Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,1,0.2), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
p4 <- bplot1(sampledata, 'fastTNloadkg', expression('Fast TN Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,20,5), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p5 <- bplot1(sampledata, 'medTNloadkg', expression('Medium TN Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,20,5), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p6 <- bplot1(sampledata, 'slowTNloadkg', expression('Slow TN Yield '~(kg~ha^{-1}~y^{-1})*'\n'), seq(0,20,5), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
plotbox <- plot_grid(p1, p4, p2, p5, p3, p6, nrow=3, align="hv")
file_name <- paste(out_path, 'box_', 'BOTHload', '.png', sep="")
save_plot(file_name, plotbox, base_height=9, base_width=8)
# plotbox <- plot_grid(pt2, NULL, p1, p4, p2, p5, p3, p6, nrow=4, align="hv")
# file_name <- paste(out_path, 'box_', 'TNload', '.png', sep="")
# save_plot(file_name, plotbox, base_height=12, base_width=8)

# flowpc
print("making flow box")
p4 <- bplot1(sampledata, 'fastflowpc', 'Fast Flow Fraction\n', seq(0,1,0.2), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p5 <- bplot1(sampledata, 'medflowpc', 'Medium Flow Fraction\n', seq(0,1,0.2), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p6 <- bplot1(sampledata, 'slowflowpc', 'Slow Flow Fraction\n', seq(0,1,0.2), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
# plotbox <- plot_grid(p1, p2, p3, nrow=3, align="hv")
# file_name <- paste(out_path, 'box_', 'flowpc', '.png', sep="")
# save_plot(file_name, plotbox, base_height=9, base_width=4)
# flow
p1 <- bplot1(sampledata, 'fastflowmm', expression('Fast Flow'~(mm~y^{-1})~'\n'), seq(0,1000,200), median_colour=NA, median_fill=fcol[3], median_alpha=0.2)
p2 <- bplot1(sampledata, 'medflowmm', expression('Medium Flow'~(mm~y^{-1})~'\n'), seq(0,1000,200), median_colour=NA, median_fill=mcol[3], median_alpha=0.2)
p3 <- bplot1(sampledata, 'slowflowmm', expression('Slow Flow'~(mm~y^{-1})~'\n'), seq(0,1000,200), median_colour=NA, median_fill=scol[3], median_alpha=0.2)
# plotbox <- plot_grid(p1, p2, p3, nrow=3, align="hv")
# file_name <- paste(out_path, 'box_', 'flowmm', '.png', sep="")
# save_plot(file_name, plotbox, base_height=9, base_width=4)
plotbox <- plot_grid(p1, p4, p2, p5, p3, p6, nrow=3, align="hv")
file_name <- paste(out_path, 'box_', 'flow', '.png', sep="")
save_plot(file_name, plotbox, base_height=9, base_width=8)
# plotbox <- plot_grid(pt3, NULL, p1, p4, p2, p5, p3, p6, nrow=4, align="hv")
# file_name <- paste(out_path, 'box_', 'flow', '.png', sep="")
# save_plot(file_name, plotbox, base_height=12, base_width=8)

# this version allows different ref lines for auto
bplot2 <- function(sampledata, varname, ylabel, ybreaks, yref1, yref2){
  # medfn <- function(x){
  #   med <- median(x)
  #   if (med==0) med=NA
  #   return(med)
  # }
  ggplot() +
    labs(title='', y=ylabel, x='') +
    theme_cowplot(font_size=10) +
    theme(axis.ticks.x=element_blank(),
          # plot.margin=unit(c(0.2,0.2,0.2,0.2),"cm"),
          plot.title=element_blank()) +
    panel_border(colour='black') +
    geom_hline(yintercept=0, linetype=1, colour='black') +
    geom_path(aes(x=1:24, y=yref1), linetype=2, colour='black') +
    geom_path(aes(x=1:24, y=yref2), linetype=2, colour='black') +
    geom_vline(xintercept=xint, colour='grey') +
    # stat_boxplot(data=sampledata, mapping=aes_string(x='setseqf', y=varname),
    #             geom="errorbar", width=0.35) +
    stat_summary(data=sampledata, mapping=aes_string(group='setseqf', x='setseqf', y=varname),
                 fun.data=custombox1, geom='errorbar') +
    # geom_boxplot(outlier.size=0.5, notch=FALSE, outlier.shape=NA) +
    stat_summary(data=sampledata, mapping=aes_string(group='setseqf', x='setseqf', y=varname),
                 fun.data=custombox2, geom='boxplot') +
    # stat_summary(data=sampledata, mapping=aes_string(x='setseqf', y=varname), fun.y=median, geom='point', pch=3, size=1) +
    scale_y_continuous(breaks=ybreaks, limits=c(min(ybreaks), max(ybreaks)), expand=c(0, 0)) +
    scale_x_discrete(labels=xlabels)
}
# auto
print("making auto box FIXME bug!")
yscale <- c(-0.8,-0.6,-0.4,-0.2,0.0,0.2,0.4,0.6,0.8)
refline1 <- rep(-0.25303,24)
refline2 <- rep(0.25303,24)
refline1[c(4,10)] <- -0.331294
refline2[c(4,10)] <- 0.331294
p1 <- bplot2(sampledata, 'auto1', 'R(1) TP Calib\n', yscale, refline1, refline2)
# print(p1)
refline1 <- rep(-0.25303,24)
refline2 <- rep(0.25303,24)
p2 <- bplot2(sampledata, 'vauto1', 'R(1) TP Valid\n', yscale, refline1, refline2)
p3 <- bplot2(sampledata, 'auto2', 'R(1) TN Calib\n', yscale, refline1, refline2)
p4 <- bplot2(sampledata, 'vauto2', 'R(1) TN Valid\n', yscale, refline1, refline2)
plotbox <- plot_grid(p1, p2, p3, p4, nrow=2, align="hv")
# print(plotbox)
file_name <- paste(out_path, 'box_', 'auto', '.png', sep="")
save_plot(file_name, plotbox, base_height=6, base_width=8)

# gmrse
print("making grmse box")
sampledata$vgrmse1[sampledata$vgrmse1==0] <- NA
sampledata$vgrmse2[sampledata$vgrmse2==0] <- NA
p1 <- bplot(sampledata, 'grmse1', expression('GRMSE TP Calib'~(mg~L^{-1})*'\n'), seq(0,0.07,0.01), 0.02)
p2 <- bplot(sampledata, 'vgrmse1', expression('GRMSE TP Valid'~(mg~L^{-1})*'\n'), seq(0,0.07,0.01), 0.02)
p3 <- bplot(sampledata, 'grmse2', expression('GRMSE TN Calib'~(mg~L^{-1})*'\n'), seq(0,0.7,0.1), 0.2)
p4 <- bplot(sampledata, 'vgrmse2', expression('GRMSE TN Valid'~(mg~L^{-1})*'\n'), seq(0,0.7,0.1), 0.2)
# plotbox <- plot_grid(p1, p2, p3, p4, nrow=2, align="hv")
plotbox <- plot_grid(p1, p3, nrow=2, align="hv")
# print(plotbox)
file_name <- paste(out_path, 'box_', 'grmse', '.png', sep="")
save_plot(file_name, plotbox, base_height=6, base_width=4)

# bar plot function
barplot <- function(sampledata, varname, ylabel, ybreaks, yref1=NA, yref2=NA, ytrans="identity"){
  ggplot() +
    labs(title='', y=ylabel, x='') +
    theme_cowplot(font_size=10) +
    theme(axis.ticks.x=element_blank(),
          # plot.margin=unit(c(0.2,0.2,0.2,0.2),"cm"),
          plot.title=element_blank()) +
    panel_border(colour='black') +
    geom_bar(data=sampledata, mapping=aes_string(x='setseqf', y=varname), stat="identity", fill="cornflowerblue", width=0.7) +
    geom_hline(yintercept=yref1, linetype=2, colour='black') +
    geom_hline(yintercept=yref2, linetype=2, colour='black') +
    geom_vline(xintercept=xint, colour='grey') +
    #	  stat_summary(data=sampledata, mapping=aes_string(x='setseqf', y=varname), fun.y=median, geom='point', pch=3, size=1) +
    scale_y_continuous(breaks=ybreaks, expand=c(0, 0), trans=ytrans) +
    coord_cartesian(ylim=c(min(ybreaks), max(ybreaks))) + # allows bars to go off the page
    scale_x_discrete(labels=xlabels)
}

# gelman r
print("making gelman box")
runfile <- paste(out_path,'runrecord.tsv', sep='')
runrecord <- read_tsv(runfile, col_types=cols())
if (any(!is.na(runrecord$gelmanr)) & any(!is.na(runrecord$elapsed))){
  runrecord$setseqf <- factor(runrecord$setseq, levels=c(1:nruns))
  p1 <- barplot(runrecord, 'gelmanr', 'Gelman R\n', seq(0,1.5,0.5), 1.1, 1.0)
  temp <- ceiling(max(runrecord$elapsed, na.rm=TRUE))
  p2 <- barplot(runrecord, 'elapsed', 'Elapsed (h)\n', seq(0,temp,0.5), 0, 0)
  plotbox <- plot_grid(p1, p2, nrow=2, align="v")
  print(plotbox)
  file_name <- paste(out_path, 'box_', 'gelmanr', '.png', sep="")
  save_plot(file_name, plotbox, base_height=6, base_width=4)
} else {
  print("missing gelmanr or elapsed data")
}

# redefine boxplot stats
custombox <- function(y) {
  data.frame(ymin=quantile(y,0.0),
             lower=quantile(y,0.25),
             middle=quantile(y,0.5),
             upper=quantile(y,0.75),
             ymax=quantile(y,1.0))
}

# annual flow
bplot3 <- function(sampledata, varname, ylabel, ybreaks, yref, ytrans="identity"){
  ggplot() +
    labs(title='', y=ylabel, x='') +
    theme_cowplot(font_size=10) +
    theme(axis.ticks.x=element_blank(),
          # plot.margin=unit(c(0.2,0.2,0.2,0.2),"cm"),
          plot.title=element_blank()) +
    panel_border(colour='black') +
    geom_hline(yintercept=yref, linetype=2, colour='black') +
    geom_vline(xintercept=xint, colour='grey') +
    # stat_boxplot(data=sampledata, mapping=aes_string(x='setseqf', y=varname),
    #             geom="errorbar", width=0.35) +
    stat_summary(data=sampledata, mapping=aes_string(group='setseqf', x='setseqf', y=varname),
                 fun.data=custombox1, geom='errorbar') +
    # geom_boxplot(outlier.size=0.5, notch=FALSE, outlier.shape=NA) +
    stat_summary(data=sampledata, mapping=aes_string(group='setseqf', x='setseqf', y=varname),
                 fun.data=custombox2, geom='boxplot') +
    geom_point(data=sampledata, mapping=aes_string(x='setseqf', y=varname), size=1) +
    # stat_summary(data=sampledata, mapping=aes_string(x='setseqf', y=varname),
    #              fun.y=mean, geom='point', pch=21, size=1, fill="white", colour="black") +
    scale_y_continuous(breaks=ybreaks, limits=c(min(ybreaks), max(ybreaks)), expand=c(0, 0), trans=ytrans) +
    scale_x_discrete(labels=xlabels)
}

# annual flow alternative version
bplot4 <- function(sampledata, varname, ylabel, ybreaks, yref, ytrans="identity"){
  ggplot() +
    labs(title='', y=ylabel, x='') +
    theme_cowplot(font_size=10) +
    theme(axis.ticks.x=element_blank(),
          # plot.margin=unit(c(0.2,0.2,0.2,0.2),"cm"),
          plot.title=element_blank()) +
    panel_border(colour='black') +
    geom_hline(yintercept=yref, linetype=2, colour='black') +
    geom_vline(xintercept=xint, colour='grey') +
    # stat_boxplot(data=sampledata, mapping=aes_string(x='setseqf', y=varname),
    #             geom="errorbar", width=0.35) +
    # stat_summary(data=sampledata, mapping=aes_string(x='setseqf', y=varname),
    #              fun.data=custombox, geom='errorbar', width=0.35) +
    # geom_boxplot(outlier.size=0.5, notch=FALSE, outlier.shape=NA) +
    # stat_summary(data=sampledata, mapping=aes_string(x='setseqf', y=varname),
    #              fun.data=custombox, geom='boxplot') +
    geom_point(data=sampledata, mapping=aes_string(x='setseqf', y=varname), size=1) +
    geom_point(data=sampledata, mapping=aes_string(x='setseqf', y=varname), size=2, pch=1, stat="summary", fun.y="mean") +
    # stat_summary(data=sampledata, mapping=aes_string(x='setseqf', y=varname),
    #              fun.y=mean, geom='point', pch=21, size=1, fill="white", colour="black") +
    scale_y_continuous(breaks=ybreaks, limits=c(min(ybreaks), max(ybreaks)), expand=c(0, 0), trans=ytrans) +
    scale_x_discrete(labels=xlabels)
}

# annual flow
print("making annual_flow box")
data2 <- data %>%
  filter(period!="None") %>%
  group_by(setname, year, setseq) %>%
  summarize(annualmm=sum(flow2),
            meancumec=mean(flow),
            meanTP=mean(TP, na.rm=TRUE),
            meanTN=mean(TN, na.rm=TRUE))
data2$setseqf <- factor(data2$setseq, levels=c(1:nruns))
p1 <- bplot4(data2, 'annualmm', 'Annual Flow', seq(0,1400,200))
print(p1)
p2 <- bplot4(data2, 'meanTP', 'Annual Mean TP', seq(0,0.3,0.1))
print(p2)
p3 <- bplot4(data2, 'meanTN', 'Annual Mean TN', seq(0,3,1))
print(p3)
plotbox <- plot_grid(p2, p3, p1, nrow=3, align="v")
print(plotbox)
file_name <- paste(out_path, 'box_', 'annual_flow', '.png', sep="")
save_plot(file_name, p1, base_height=3, base_width=4)
file_name <- paste(out_path, 'box_', 'annual_summary', '.png', sep="")
save_plot(file_name, plotbox, base_height=9, base_width=4)

data3 <- data %>%
  filter(period!="None") %>%
  group_by(shortname) %>%
  summarize(avmm=sum(flow2)/length(unique(year)),
            avcumec=mean(flow))

# histograms
# greens 2 # https://www.color-hex.com/color-palette/5016
xpale <- "#F0F7DA"
xlight <- "#C9DF8A"
xmid <- "#77AB59"
xdark <- "#36802D"
xdata <- "#043927" # https://graf1x.com/shades-of-green-color-palette-html-hex-rgb-code/
xaxis <- "#999999"
xgrey <- "grey"
prior_df <- vector("list", length(priortab$parname))
i <- 1
for (i in seq_along(priortab$parname)) {
  key <- priortab$parname[i]
  x <- seq(priortab$parmin[i], priortab$parmax[i], length.out = 101) * priortab$parscale[i]
  y <- dnorm(x, priortab$parmean[i] * priortab$parscale[i], priortab$parsd[i] * priortab$parscale[i])
  x <- case_when(
    key == "medd1raw" ~ x + (-0.1*log(1-0.1)) * 10,
    key == "slowd1raw" ~ x + (-0.1*log(1-0.99)) * 10,
    TRUE ~ x)
  prior_df[[i]] <- tibble(key = factor(key, levels = priortab$parname), x = x, y = y)
}
prior_df <- bind_rows(prior_df)
my_pretty_breaks <- function(n = 5, ...) {
  n_default <- n
  function(x, n = n_default) {
    minx <- min(x)
    maxx <- max(x)
    midx <- (minx + maxx) / 2
    x2 <- midx + (x - midx) * 0.9
    breaks <- pretty(x2, n, ...)
    names(breaks) <- attr(breaks, "labels")
    breaks
  }
}
rows <- 1:nruns
for (i in rows) {
  runlisti <- runlist %>%
    filter(setseq == i)
  print(paste("making par histogram", runlisti$setname))
  sampledatai <- sampledata %>%
    filter(setname == runlisti$setname) %>%
    select_at(priortab$parname)
  scalelist <- setNames(priortab$parscale, priortab$parname)
  post_df <- sampledatai %>%
    pivot_longer(everything(), names_to = "key", values_to = "value") %>%
    mutate(
      key = factor(key, levels = priortab$parname),
      value = value * scalelist[key],
      value = case_when(
        key == "medd1raw" ~ value + (-0.1*log(1-0.5)) * 10,
        key == "slowd1raw" ~ value + (-0.1*log(1-0.99)) * 10,
        TRUE ~ value)
      )
  labellist <- setNames(priortab$parlabel, priortab$parname)
  getlabels <- function(x){
    unname(labellist[x])
  }
  plot1 <- ggplot(data = prior_df) +
    labs(title = runlisti$catchname, x = "", y = "") +
    geom_line(mapping = aes(x = x, y = y), colour = xmid, size = 1) +
    geom_histogram(data = post_df, mapping = aes(x = value, y = ..density..), fill = xlight, bins = 30) +
    geom_line(mapping = aes(x = x, y = y), colour = xmid, size = 1) +
    theme_few() +
    theme(panel.spacing.x = unit(9, "mm"), plot.margin = unit(c(0, 5, 0, 0), "mm")) +
    # theme(axis.text=element_text(size=9)) +
    scale_x_continuous(expand = expand_scale(0, 0), breaks = my_pretty_breaks(n = 2, min.n = 2)) +
    scale_y_continuous(expand = expand_scale(0, 0), breaks = NULL) +
    facet_wrap(vars(key), nrow = 4, scales = "free", labeller = labeller(key = getlabels))
  # print(plot1)
  png(paste0(out_path, "/", runlisti$setname, "_histogram.png"),
      width = 210 * 1.5, height = 210 * 1, units = "mm",
      type = "windows", res = 300 # FIXME res = 600
  )
  print(plot1)
  dev.off()
}


######################################################################
# INF-0611 Recuperação de Informação                                 #
#                                                                    #
# Trabalho 1 - Recuperação de Texto                                  #
######################################################################
# Nome COMPLETO dos integrantes do grupo:                            #
#   - Daniele Montenegro da Silva Barros                             #
#   - Thiago Bruschi Martins                                         #
#   - Rodrigo Silva Dantas                                           #
#                                                                    #
######################################################################

######################################################################
# Configurações Preliminares                                         #
######################################################################

# Carregando as bibliotecas
library(corpus)
library(dplyr)
library(udpipe)
library(tidytext)
library(tidyverse)

# Carregando os arquivos auxiliares
source("ranking_metrics.R", encoding = "UTF-8")
source("trabalho1_base.R", encoding = "UTF-8")

# Configure aqui o diretório onde se encontram os arquivos do trabalho
# setwd("~/Documents/Unicamp/Recuperação de Informação/Atividade 01/")

######################################################################
#
# Questão 1
#
######################################################################

# Lendo os documentos (artigos da revista TIME)
# sem processamento de texto (não mude essa linha)
docs <- process_data("time.txt", "XX-Text [[:alnum:]]", "Article_0",
                     convertcase = TRUE, remove_stopwords = FALSE)
# Visualizando os documentos (apenas para debuging)
head(docs)

# Lendo uma lista de consultas (não mude essa linha)
queries <- process_data("queries.txt", "XX-Find [[:alnum:]]",
                        "Query_0", convertcase = TRUE,
                        remove_stopwords = FALSE)
# Visualizando as consultas (apenas para debuging)
head(queries)
# Exemplo de acesso aos tokens de uma consulta
q1 <- queries[queries$doc_id == "Query_01",]
q1

# Lendo uma lista de vetores de ground_truth
ground_truths <- read.csv("relevance.csv", header = TRUE)

# Visualizando os ground_truths (apenas para debuging)
head(ground_truths)
# Exemplo de acesso vetor de ground_truth da consulta 1:
ground_truths[1,]
# Exemplo de impressão dos ids dos documentos relevantes da consulta 1:
# Visualizando o ranking (apenas para debuging)
names(ground_truths)[ground_truths[1,]==1]

# Computando a matriz de termo-documento
term_freq <- document_term_frequencies(docs, term='word')

# Computando as estatísticas da coleção e convertendo em data.frame
docs_stats <- as.data.frame(document_term_frequencies_statistics(term_freq,
                                                                 k = 1.2,
                                                                 b = 0.75))
# Visualizando as estatísticas da coleção (apenas para debuging)
head(docs_stats)

######################################################################
#
# Questão 2
#
######################################################################

# Incluindo implementacao das metricas
source("ranking_metrics.R")

# query: Elemento da lista de consultas, use a segunda coluna desse
#        objeto para o cálculo do ranking
# ground_truth: Linha do data.frame de ground_truths referente a query
# stats: data.frame contendo as estatísticas da base
# stat_name: Nome da estatística de interesse, como ela está escrita
#            no data.frame stats
# top: Tamanho do ranking a ser usado nos cálculos de precisão
#      e revocação
# text: Título adicional do gráfico gerado, deve ser usado para
#       identificar a questão e a consulta
computa_resultados <- function(query, ground_truth, stats, stat_name,
                               top, text) {
  # Criando ranking (função do arquivo base)
  ranking <- get_ranking_by_stats(stat_name = stat_name,
                                  docs_stats = stats,
                                  tokens_query = text_tokens(query[[1]]))
  # Visualizando o ranking (apenas para debuging)
  # head(ranking, n = 5)

  # Calculando a precisão
  p <- precision(ground_truth,
                 ranking$doc_id,
                 top)

  # Calculando a revocação
  r <- recall(ground_truth,
              ranking$doc_id,
              top)

  # Imprimindo os valores de precisão e revocação
  cat(paste("Consulta: ", query[1,1], "\nPrecisão: ", p,
            "\tRevocação: ", r, "\n"))

  # Gerando o plot Precisão + Revocação (função do arquivo base)
  plot_prec_e_rev(ranking$doc_id, ground_truth, top, text)
}

# Definindo a consulta 1
consulta1 <- queries[queries$doc_id == "Query_014", 2]
n_consulta1 <- 14

## Exemplo de uso da função computa_resultados:
# computa_resultados(consulta1, ground_truths[n_consulta1, ],
#                    docs_stats, "nome da statistica",
#                    top = 15, "titulo")

# Resultados para a consulta 1 e tf_idf
computa_resultados(consulta1, ground_truths[n_consulta1, ],
                   docs_stats, "tf_idf",
                   top = 20, "Ranking TF-IDF")

# Resultados para a consulta 1 e bm25
computa_resultados(consulta1, ground_truths[n_consulta1, ],
                   docs_stats, "bm25",
                   top = 20, "Ranking BM25")

# Definindo a consulta 2
consulta2 <- queries[queries$doc_id == "Query_020", 2]
n_consulta2 <- 20

# Resultados para a consulta 2 e tf_idf
computa_resultados(consulta2, ground_truths[n_consulta2, ],
                   docs_stats, "tf_idf",
                   top = 20, "Ranking TF-IDF")

# Resultados para a consulta 2 e bm25
computa_resultados(consulta2, ground_truths[n_consulta2, ],
                   docs_stats, "bm25",
                   top = 20, "Ranking BM25")

######################################################################
#
# Questão 2 - Escreva sua análise abaixo
#
######################################################################
# Na Query 20, quando k assume o valor de 7 o método bm25 recuperou todos os objetos relevantes,
# assim, a revocação assume o valor 1, mantendo seu valor até k igual a 20. Já a tf-idf a revocação só sai do valor
# de 0 quando k igual a 13, e quando k igual a 15 assume seu maior valor, sendo a precisão inferior utilizando tf-id.
# Assim, no TF-IDF da query20 não chega a recuperar todos os elementos relevantes nem com k igual a 20.

# Enquanto na Query 14, quando k assume o valor de 5, tanto no método tf-id e na BM-25, a revocação é igual 1,
# assim, em ambos os métodos todos os objetos relevantes foram encontrados quando k igual a 5.
# Já a precisão quando k igual a 5 a precisão é igual a 0.8. No entanto,
#  tem uma pequena diferença o TF-IDF começa acertando o primeiro elemento, assumindo um melhor desempenho no
# ínicio do processamento.
######################################################################
#
# Questão 3
#
######################################################################
# Na função process_data está apenas a função para remoção de
# stopwords está implementada. Sinta-se a vontade para testar
# outras técnicas de processamento de texto vista em aula.

# Lendo os documentos (artigos da revista TIME)
# com processamento de texto
docs_proc <- process_data("time.txt", "XX-Text [[:alnum:]]",
                          "Article_0", convertcase = TRUE,
                          remove_stopwords = TRUE)
# Visualizando os documentos (apenas para debuging)
# head(docs_proc)

# Lendo uma lista de consultas
queries_proc <- process_data("queries.txt", "XX-Find [[:alnum:]]",
                             "Query_0", convertcase = TRUE,
                             remove_stopwords = TRUE)
# Visualizando as consultas (apenas para debuging)
# head(queries_proc)

# Computando a matriz de termo-documento
term_freq_proc <- document_term_frequencies(docs_proc, term='word')

# Computando as estatísticas da coleção e convertendo em data.frame
docs_stats_proc <- as.data.frame(document_term_frequencies_statistics(term_freq_proc,
                                                                      k = 1.2,
                                                                      b = 0.75))

# Definindo a consulta 1
consulta1_proc <- queries[queries$doc_id == "Query_014", 2]
n_consulta1_proc <- 14
# Resultados para a consulta 1 e tf_idf
computa_resultados(consulta1_proc, ground_truths[n_consulta1_proc, ],
                   docs_stats, "tf_idf",
                   top = 20, "Ranking TF-IDF (No StopWords)")

# Resultados para a consulta 1 e bm25
computa_resultados(consulta1_proc, ground_truths[n_consulta1_proc, ],
                   docs_stats, "bm25",
                   top = 20, "Ranking BM25 (No StopWords)")

# Definindo a consulta 2
consulta2_proc <- queries[queries$doc_id == "Query_020", 2]
n_consulta2_proc <- 20

# Resultados para a consulta 2 e tf_idf
computa_resultados(consulta2_proc, ground_truths[n_consulta2_proc, ],
                   docs_stats, "tf_idf",
                   top = 20, "Ranking TF-IDF (No StopWords)")

# Resultados para a consulta 2 e bm25
computa_resultados(consulta2_proc, ground_truths[n_consulta2_proc, ],
                   docs_stats, "bm25",
                   top = 20, "Ranking BM25 (No StopWords)")

######################################################################
#
# Questão 3 - Escreva sua análise abaixo
#
######################################################################
#
# Na query 20 tanto a revocação quanto a precisão melhoram significativamente com a remoção das stopwords.
# Podemos verificar isso nos gráficos pois os valores de revocação e precisão atingem valores mais altos para
# K menores em realação ao mesmo modelo com as stopwords. No caso da revocação ela também atinge seu valor máximo
# (100%) antes. No caso da precisão, para K menores que 6 ela fica mais tempo em valores mais altos, embora no final o
# valor seja o mesmo visto que há poucos elementos relevantes nesta pesquisa.
#
# Já na query 14 os gráficos gerados foram os mesmos, ou seja, não houve diferença entre remover ou não as stopwords.
# Provavelmente por ser uma query com menos palavras, e por tanto, menos stopwords.
#
#
######################################################################
#
# Extra
#
# # Comando para salvar todos os plots gerados e que estão abertos no
# Rstudio no momemto da execução. Esse comando pode ajudar a comparar
# os gráfico lado a lado.
#
# plots.dir.path <- list.files(tempdir(), pattern="rs-graphics",
#                              full.names = TRUE);
# plots.png.paths <- list.files(plots.dir.path, pattern=".png",
#                               full.names = TRUE)
# file.copy(from=plots.png.paths, to="~/Desktop/")
######################################################################


#!/usr/bin/Rscript
library('tidyverse')
library('ggplot2')
library('tikzDevice')
library('xtable')
library('lemon')
library('knitr')
library('scales')

# Read input data
# For timeouts, "States" field is set to -1
input <- read_delim('results48.csv', delim=";", col_names=FALSE, trim_ws=TRUE)
colnames(input) <- c("Model","Method", "Workers", "Time", "States")

# Derive Order (-rbs or -rf) from Model name and add as column
input_rf1 <- input %>% filter(grepl("-rf$", Model)) %>% mutate(Model = str_replace(Model, "-rf$", ""))
input_rf2 <- input %>% filter(grepl("^rf-", Method)) %>% mutate(Method = str_replace(Method, "^rf-", ""))
input_rf <- bind_rows(input_rf1, input_rf2)
input_rf$Order <- "rf"
input_rbs <- input %>% filter(!grepl("-rf$", Model)) %>% filter(!grepl("^rf-", Method))
input_rbs$Order <- "rbs"
input <- bind_rows(input_rf, input_rbs)

# Rename "ldd-par" to "ldd-bfs" (because it is parallel BFS)
input <- input %>% mutate(Method = str_replace(Method, "ldd-par", "ldd-bfs"))

# Add "Id" column
input <- input %>% mutate(Id = paste(Model, Order, Method, Workers, sep = "-"))

# Split into <times> and <timeouts> and remove timeouts for which we have times
times <- input %>% filter(States != -1) %>% select(Id, Model, Order, Method, Workers, Time)
timeouts <- input %>% filter(!Id %in% (times %>% distinct(Id))$Id) %>% select(Id, Model, Order, Method, Workers, Time)

# Compute median/mean/sd for times, and highest timeout for timeouts
times <- times %>% group_by(Id, Model, Order, Method, Workers) %>% summarize(MedianTime = median(Time), MeanTime = mean(Time), sd = sd(Time)) %>% ungroup
timeouts <- timeouts %>% group_by(Id, Model, Order, Method, Workers) %>% summarize(Timeout = max(Time)) %>% ungroup

# Compute Model-Order that are solved (or timeout) by all Method-Worker combinations
times_s <- times %>% mutate(MW = paste(Method, Workers)) %>% select(MW, Model, Order, Time=MedianTime)
timeouts_s <- timeouts %>% mutate(MW = paste(Method, Workers)) %>% select(MW, Model, Order, Time=Timeout)
MODone <- bind_rows(times_s, timeouts_s) %>% spread(MW, Time) %>% drop_na() %>% select(Model, Order) %>% mutate(MO = paste(Model, Order)) %>% pull(MO)

# Now only keep the times/timeouts for which we have results of all Method-Worker combinations
times <- times %>% mutate(MO = paste(Model, Order)) %>% filter(MO %in% MODone) %>% select(-MO)
timeouts <- timeouts %>% mutate(MO = paste(Model, Order)) %>% filter(MO %in% MODone) %>% select(-MO)
times_s <- times %>% mutate(MW = paste(Method, Workers)) %>% select(MW, Model, Order, Time=MedianTime)
timeouts_s <- timeouts %>% mutate(MW = paste(Method, Workers)) %>% select(MW, Model, Order, Time=Timeout)

kable(times %>% select(Model, Order, Method, Workers, Time=MeanTime) %>% spread(Workers, Time) %>% drop_na() %>% mutate(S8=`1`/`8`,S16=`1`/`16`,S24=`1`/`24`,S32=`1`/`32`,S40=`1`/`40`,S48=`1`/`48`) %>% arrange(Method), digits=1, format="latex", booktabs=TRUE)

kable(times %>% select(Model, Order, Method, Workers, Time=MeanTime) %>% spread(Workers, Time) %>% drop_na() %>% mutate(S8=`1`/`8`,S16=`1`/`16`,S24=`1`/`24`,S32=`1`/`32`,S40=`1`/`40`,S48=`1`/`48`) %>% arrange(Method, -S48) %>% select(Model,Order,Method,`1`,`24`,`48`,S24,S48), digits=1, format="latex", booktabs=TRUE)

lddsat <- times %>% filter(Method=="ldd-sat") %>% select(Model, Order, Method, Workers, Time=MeanTime) %>% spread(Workers, Time) %>% drop_na() %>% mutate(S1=`1`/`1`,S8=`1`/`8`,S16=`1`/`16`,S24=`1`/`24`,S32=`1`/`32`,S40=`1`/`40`,S48=`1`/`48`) %>% drop_na() %>% mutate(Id=paste(Model, Order)) %>% select(Id, `1`=S1, `8`=S8,`16`=S16,`24`=S24,`32`=S32,`40`=S40,`48`=S48) %>% gather(Workers, Speedup, -Id) %>% mutate(Workers=as.numeric(Workers))
lddsatplot <-
    ggplot(lddsat, aes(x=Workers,y=Speedup,group=Id)) +
    geom_line() +
    scale_x_continuous(breaks=c(1,8,16,24,32,40,48)) +
    scale_y_continuous(breaks=c(0,1,5,8,10,15,20,25,30)) +
    theme_bw()

tikz("lddsatspeedupplot.tex", width=6, height=3, standAlone=F)
print(lddsatplot)
graphics.off()


library(lubridate, warn.conflicts=FALSE)

## script for preprocessing data ===============================================
#
# 1) generate cleaned data frames for all available regions
#    with all available factors and uniform naming conventions
#
# 2) generate aggregated data frames from 1) for availiable
#    region - sub-region combinations
#    e.g. region: "italy"        - sub-regions: "regions"
#         region: "italy"        - sub-regions: "provinces"
#         region: "Deutschland"  - sub-regions: "Bundeslaender"
#         region: "Deutschland"  - sub-regions: "Lanndkreise"
#
# 3) generates lookup tables for regions: regX.id - regX.name
#    with (optional) meta data: lat, long, population, area, ...
#
# uniform column names: (not all factors are always available)
# time:  day (counter starting at 0), yday, date
# space: reg0.id, reg0.name, reg1.id, reg1.name, ... (so far no reg2)
# case:  tot.cases, new.cases,
#        tot.dead, new.dead,
#        tot.recovered, new.recovered,
#        tot.tested, new.tested
# meta:  age, sex, ...
#
## =============================================================================

## 1) region: germany; all data ================================================
#
# this data.frame does NOT contain ALL combinations of factors !
# and they are not completed either since too many combinations...
# all combinations only in derived data frames (see below)
#
ger <- read.csv('./rki_data/RKI_COVID19.csv')
# subsetting and reordering: (ignore "Datenstand" and "ObjectId")
ger <- subset(ger, select=c("Meldedatum", "IdBundesland", "Bundesland",
                            "IdLandkreis", "Landkreis", "AnzahlFall",
                            "AnzahlTodesfall", "Altersgruppe", "Geschlecht"))
# renaming:
names(ger) <- c("date", "reg0.id", "reg0.name", "reg1.id", "reg1.name",
                "new.cases", "new.dead", "age", "sex")
ger$date <- as_date(ger$date) # date in correct format
ger$yday <- yday(ger$date) # add yday
ger$day <- ger$yday - min(ger$yday) # add day
ger <- ger[order(ger$day),] # reorder
# for derived data frames additonal case statistics (tot.cases, ...) are added;
# here too many combinations of factors make this impractical !
# reordering:
ger <- ger[, c("day", "yday", "date",
               "reg0.id", "reg0.name", "reg1.id", "reg1.name",
               "new.cases", "new.dead",
               "age", "sex")]
write.csv(ger, file='./clean/data_ger_all.csv')
## 3) # create lookup table for ger all ========================================
lookup_ger <- subset(ger, select=c("reg0.id", "reg0.name",
                                   "reg1.id", "reg1.name"))
lookup_ger <- unique(lookup_ger[order(lookup_ger$reg0.id),])
write.csv(lookup_ger, file='./clean/lookup_ger_all.csv')


input <- file('stdin', 'r')

a <- as.integer(readLines(input, n=1))
b <- as.integer(readLines(input, n=1))
c <- as.integer(readLines(input, n=1))
d <- as.integer(readLines(input, n=1))

result = sprintf("DIFERENCA = %d", a * b - c * d)
write(result, "")


## This replication file
## makes the following tables and figures:
# Tables 2 and S2-S5
# Figures S1-S3
## calculates numbers mentioned in Supplementary Information (SI), Main analysis section

library(MatchIt) # get_matches()
library(cobalt) # bal.tab()
library(lmtest) # coeftest()
library(sandwich) # vcovCL()
library(tidyverse)

data <- read.csv("covid.csv")
data.all <- data[data$pref %in% c(3, 6, 7, 9, 11, 12, 13, 15,
                                  16, 18, 21, 23, 25, 27, 31,
                                  32, 33, 34, 35, 36, 37, 38,
                                  41, 42, 44, 45, 46),]
survey.dates <- c("0304", "0316", "0406", "0410")#, "0416", "0422", "0511", "0601")
period <- 84:180 # indicates Feb.26 to June 1
# Replace -1's with 0's
cases <- NULL
for(p in 1:length(period)){
  data.all[, period[p]] <- as.character(data.all[, period[p]])
  data.all[, period[p]] <- gsub("-1", "0", data.all[, period[p]])
  data.all[, period[p]] <- as.integer(data.all[, period[p]])
  cases <- c(cases, data.all[, period[p]])
}

##################################################################
# The Numbers of Treated and Control Municipalities by Survey Date

table.treat <- matrix(NA, length(survey.dates), 4)
table.health.mun <- matrix(NA, length(survey.dates), 6)
table.health.cen <- matrix(NA, length(survey.dates), 2)
matched <- rep(NA, 7)

# Jan. 25 - Aug. 10
period <- 52:250 # indicator
YMD <- as.Date("2020-1-25") + 1:length(period) - 1 # year-month-day
survey.date.col <- c(91, 103, 124, 128, 134, 140, 159, 180) - 51
survey.date.col <- survey.date.col[1:length(survey.dates)]
rownames(table.treat) <-
  rownames(table.health.mun) <-
  rownames(table.health.cen) <- as.character(YMD[survey.date.col])

for(d in 1:length(survey.dates)){
  day <- survey.dates[d]

  source(paste0("preprocess/preprocess.", day, ".R"))
  table.treat[d, 1:2] <- table(treat)

  table.out <- table(data.analysis$health.center.id, treat)
  mix <- as.integer(table.out[, 1] * table.out[, 2] > 0) # whether the health center has treated and control municipalities
  table.health.mun[d, 1:2] <- c(sum(mix * table.out[, 1]), # the number of treated municipalities in a mixed health center
                                sum(mix * table.out[, 2])) # the number of control municipalities in a mixed health center
  table.health.cen[d, 1:2] <- c(nrow(table.out),
                                sum(mix)) # whether the health center has treated and control municipalities
  if(d < 8){
    m.out <- readRDS(paste0("matching_results/alt_atc_", day, "_1000_1000.RDS"))
    matched[d] <- length(unique(m.out$match.matrix))
  }
}

# Table 2
table.treat[,3] <- apply(table.treat[,1:2],1,sum)
table.treat[,4] <- round(100*table.treat[,2]/table.treat[,3], 1)
table.treat[,1:2] <- table.treat[,2:1]
colnames(table.treat) <- c("Treated", "Control", "All", "Treated (%)")
table.treat
write.csv(table.treat, "output/Fukumoto_Table2.csv")

# Table S2
#(table.matched <- cbind(matched[1:7], table.treat[1:7,2]))
table.matched <- cbind(matched[1:4], table.treat[1:4,2])
colnames(table.matched) <- c("Treated", "Control")
table.matched
write.csv(table.matched, "output/Fukumoto_TableS2.csv")

# Table S4
#table.health.cen <- table.health.cen[-8,]
colnames(table.health.cen) <- c("All", "Mixed")
table.health.cen
write.csv(table.health.cen, "output/Fukumoto_TableS4.csv")

# Table S5
table.health.mun[, 1:2] <- table.health.mun[, 2:1]
table.health.mun[, 4:5] <- table.treat[, 1:2] - table.health.mun[, 1:2]
table.health.mun[, 3] <- apply(table.health.mun[, 1:2], 1, sum)
table.health.mun[, 6] <- apply(table.health.mun[, 4:5], 1, sum)
#table.health.mun <- table.health.mun[-8,]
colnames(table.health.mun) <- c("Treated (Mixed)", "Control (Mixed)", "All (Mixed)",
                                "Treated (Non-mixed)", "Control (Non-mixed)", "All (Non-mixed)")
table.health.mun
write.csv(table.health.mun, "output/Fukumoto_TableS5.csv")

##############################
# Negative Binomial Regression

# "our analysis covers all of the 847 municipalities in the 27 target prefectures
# from February 26 to June 1 (97 days)." (SI, p. 12)
length(cases)
847 * 97
# "the number of cases is not available for 62 municipalities in Tokyo Prefecture
# from February 26 to March 31 (35 days)." (SI, p. 12)
sum(is.na(cases)) # Tokyo
62 * 35
# "Thus, the total number of units is 847 * 97 - 62 * 35 = 79,989." (SI, p. 12)
table.cases <- table(cases)
sum(table.cases)
length(cases) - sum(is.na(cases))

prop.table.cases <- round(prop.table(table.cases)*100, 1)
# "the number of cases is equal to zero for 95.4% of our 79,989 municipality-day observations
# and less than 10 for 99.9% of our observations." (SI, p. 12)
prop.table.cases[1]
sum(prop.table.cases[1:10])

savepdf <- function(file, width=3.46, height=3.46){
  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))
}

# Figure S2
savepdf("output/Fukumoto_FigS2")
hist.out <- hist(cases, freq = F,
                 breaks = (min(cases, na.rm = T) - 1):max(cases, na.rm = T) + 0.5,
                 xlab="Number of cases", ylab="Proportion", main="",
                 ylim=c(0, 0.025))
dev.off()

Figure.S2.source <- cbind(hist.out$mids, hist.out$density)
colnames(Figure.S2.source) <- c("Number of cases", "Proportion")
head(Figure.S2.source)
write.csv(Figure.S2.source, "output/Fukumoto_FigS2_source.csv", row.names = F)

######################
# Public Health Center

# "Each of the 263 public health centers is in charge of implementing public health policy,
# including counting 26 COVID-19 cases, and covers 1 to 13 municipalities." (Main Text)
(table.out.2 <- table(table(data.all$health.center.id)))
sum(table.out.2)
# "66.9% of the 263 public health centers cover multiple municipalities,
# which occupy 89.7% of the 847 municipalities." (SI, pp. 12-13)
table.out.1 <- table(data.all$health.center.id)
sum(table.out.1)
round((1 - table.out.2[1]/sum(table.out.2))*100, 1)
round((1 - table.out.2[1]/sum(table.out.1))*100, 1)

# Figure S3
savepdf("output/Fukumoto_FigS3")
hist.out <- hist(table.out.1, freq = F, breaks = 0:13 +0.5,
                 xlab="Number of municipalities per public health center",
                 ylab="Proportion", main="")
dev.off()

Figure.S3.source <- cbind(hist.out$mids, hist.out$density)
colnames(Figure.S3.source) <- c("Number of municipalities", "Proportion")
Figure.S3.source
write.csv(Figure.S3.source, "output/Fukumoto_FigS3_source.csv", row.names = F)

#######
# setup

additional <- c("cases_1", "cases_2", "cases_3", "cases_4", "cases_5", "cases_6", "cases_7",
                "prior.infection.per.capita",
                "lon", "lat", "prec_mean", "shine_mean",  "tmean_mean",  "electoral.time", "log.number",
                "shutdown.0304", "shutdown.0316", "shutdown.0406", "shutdown.0410", "shutdown.0416", "shutdown.0422")
bal.tab.out <- list()
mains <- c("a March 4", "b March 16", "c April 6", "d April 10",
           "e April 16", "f April 22", "g May 11", "h April 6 (ATT)")

######
# ASMD

#for (d in 1:8){
for (d in c(1:4, 8)){
  if(d < 8){
    dd <- d
    day <- survey.dates[dd]
    m_path <- paste0("matching_results/alt_atc_", day, "_1000_1000.RDS")
  }
  if(d == 8){# ATT
    dd <- 3
    day <- survey.dates[dd]
    m_path <- paste0("matching_results/alt_att_", day, "_1000_1000.RDS") #
  }
  p_path <- paste0("preprocess/preprocess.", day, ".R")
  lm_form <- as.formula(paste0("gm[, part[p]] ~ shutdown.", day))
  source(paste0("genetic_matching/gen.", day, ".R"))
  bal.tab.out[[d]] <- bal.tab(cbind(control, pref.dummy,
                                    data.analysis[, additional[1:(dd + 14)]],
                                    data.analysis[, c(paste0("age.", day),
                                                      paste0("win_count.", day))]),
                              binary = "std", continuous = "std", treat = m.out$treat,
                              weights = m.out$weights, abs = TRUE, stats = c("mean.diffs"), un = TRUE)$Balance
  bal.tab.out[[d]] <- bal.tab.out[[d]] %>%
    mutate(above2 = ifelse(Diff.Un > 2, "Yes", "No"),
           Diff.Un.draw = ifelse(Diff.Un > 2, 2, Diff.Un),
           Diff.Adj.draw = ifelse(Diff.Adj > 2, 2, Diff.Adj),
           Diff.diff = Diff.Un - Diff.Adj,
           Diff.ratio = Diff.Adj / Diff.Un)
}

savepdf <- function(file, width=7.28, height=3.54){
  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_FigS1")
par(mfrow=c(2,4))

#for (d in 1:8){
for (d in c(1:4, 8)){
  plot(bal.tab.out[[d]]$Diff.Un.draw, bal.tab.out[[d]]$Diff.Adj.draw,
       xlim=c(0,2), ylim=c(0,2),
       xlab = "ASMD before matching", ylab="ASMD after matching",
       main = mains[d],
       pch=c(1, 3)[as.factor(bal.tab.out[[d]]$above2)])
  abline(0, 1, lty = 2)
}
dev.off()

# Table S3
covariate_list <- read.csv("covariate_list.csv")
#for (d in 1:8){
for (d in c(1:4, 8)){
  Figure.S1.d <- bal.tab.out[[d]][,c("Diff.Un", "Diff.Adj")]
  dd <- d
  if(d == 8){# ATT
    dd <- 3
  }
  if(dd <= 3){
    pref.dummy.pos <- c(33:38, 40:58) # excluding Tokyo
  }
  if(dd >= 4){
    pref.dummy.pos <- c(33:58) # including Tokyo
  }
  rownames(Figure.S1.d) <- covariate_list[c(1:32, #control
                                            pref.dummy.pos,
                                            (58 + 1):(58 + 14 + dd), #additional[1:(dd + 14)]]
                                            80, 81), # age, win_count
                                            2]
  Figure.S1.d <- Figure.S1.d[rev(order(Figure.S1.d[, "Diff.Un"])),]
  colnames(Figure.S1.d) <- c("ASMD before matching", "ASMD after matching")
  write.csv(Figure.S1.d, paste0("output/Fukumoto_FigS1_", letters[d], "_source.csv"))
  if(d == 3){
    Figure.S1.d <- cbind(Figure.S1.d, Figure.S1.d[, 2]/Figure.S1.d[, 1])
    colnames(Figure.S1.d)[3] <- c("Ratio")
    Figure.S1.d <- round(Figure.S1.d, 2)
    write.csv(Figure.S1.d, "output/Fukumoto_TableS3.csv")
  }
}

###########################
# Supplementary Information
# Main Analysis

col.shutdown <- 44:51

# March 4
d <- 1
(day <- survey.dates[d])
source(paste0("preprocess/preprocess.", day, ".R"))
shutdown <- data.analysis[,col.shutdown]
shutdown[is.na(shutdown)] <- 9
(table.out <- table(shutdown[,1], shutdown[,2]))
# "Since 9 of the 10 (90.0\%) control municipalities also had open schools as of the next survey date (March 16)," (SI, p. 8)
table.out[1,1]/sum(table.out[1,])
# "718 (94.3\%) % 718/761 treated municipalities reported that their schools continued to be closed until March 16." (SI, p. 8)
table.out[2,2]/sum(table.out[2,])

# # April 6
# d <- 3
# (day <- survey.dates[d])
# source(paste0("preprocess/preprocess.", day, ".R"))
# shutdown <- data.analysis[,col.shutdown]
# shutdown[is.na(shutdown)] <- 9
# # "247 of the 256 (96.5\%) treated municipalities as of April 6 closed schools on all of the following three survey dates as well (April 10, 16, and 22)," (SI, p. 10)
# all.close <- shutdown[,4]==1 & shutdown[,5]==1 & shutdown[,6]==1
# (table.out <- table(shutdown[,d], all.close))
# table.out[2,2]/sum(table.out[2,])
# # "though only 79 of the 483 (16.4\%) control municipalities opened their schools on all three dates." (SI, p. 10)
# all.open <- shutdown[,4]==0 & shutdown[,5]==0 & shutdown[,6]==0
# (table.out <- table(shutdown[,d], all.open))
# table.out[1,2]/sum(table.out[1,])
#
# # April 22
# d <- 6
# (day <- survey.dates[d])
# source(paste0("preprocess/preprocess.", day, ".R"))
# shutdown <- data.analysis[,col.shutdown]
# shutdown[is.na(shutdown)] <- 9
# (table.out <- table(shutdown[,d], shutdown[,7]))
# # "We find that 70 of the 80 (87.5%) control municipalities and 634 (89.3%) of 710 treated municipalities as of April 22 opened and closed their schools as of the next survey date (May 11), respectively." (SI, p. 11)
# table.out[1,1]/sum(table.out[1,])
# table.out[2,2]/sum(table.out[2,])
#
# # May 11
# d <- 7
# (day <- survey.dates[d])
# source(paste0("preprocess/preprocess.", day, ".R"))
# shutdown <- data.analysis[,col.shutdown]
# shutdown[is.na(shutdown)] <- 9
# (table.out <- table(shutdown[,d], shutdown[,8]))
# # "just 2 of the 641 (0.3%) treated municipalities as of May 11 reported closed schools as of the next survey date (June 1)." (SI, p. 11)
# table.out[2,2]/sum(table.out[2,])
# # "All of the control municipalities as of May 11 said that their schools were also open on June 1." (SI, p. 12)
# table.out[1,1]/sum(table.out[1,])

##################
# Irregular values

# March 16

d <- 2
(day <- survey.dates[d])
source(paste0("preprocess/preprocess.", day, ".R"))
outcome <- outcome/10
v1 <- c(66:68)
v2 <- c(117:119)
m.out <- readRDS(paste0("matching_results/alt_atc_", day, "_1000_1000.RDS"))
# Create matched dataset
gm <- get_matches(m.out, data = data.analysis)
# estimate the ATC for every day from one week before (March 30) to three weeks after (April 27)
part <- 99:127 # indicates March 9 to April 6
gm[,part] <- (10^5)*gm[, part]/gm$pop.2020
summary.Match.out <- rep(NA, length(part))
for(p in 1:length(part)){
  fit <- lm(gm[, part[p]] ~ shutdown.0316,
            data = gm, weights = weights)
  summary.Match.out[p] <- coef(summary(fit))[2,1]
}
names(summary.Match.out) <- colnames(gm[,part])
summary.Match.out[24]

# "on April 1 ... In Wadomari Town, Kagoshima Prefecture, in the control group had a case among its 6,537 residents, which is equivalent to 15.3 cases per 100,000 residents." (SI, p. 9)
vv <- 3
colnames(outcome)[v1[vv]]
use <- which(treat == 0 & data.analysis[,v2[vv]]>0)
outlier <- cbind(data.analysis[use, c("municipality_code", "pop.2020")],
                 data.analysis[use, v2[vv]],
                 outcome[use, v1[vv]])
outlier[2,]
# "This single municipality contributes to 103.3\% $(=(-15.3/29)/(-0.511))$ of the ATC (-0.511)." (SI, p. 9)
(-outlier[2,4]/table(treat)[1])/summary.Match.out[24]
# "the mean of population among all of the 785 municipalities in the 26 target prefectures is 76,830." (SI, p. 9)
mean(data.all$pop.2020[data.all$pref != 13])

# # April 16
#
# d <- 5
# (day <- survey.dates[d])
# source(paste0("preprocess/preprocess.", day, ".R"))
# outcome <- outcome/10
# v1 <- c(89:92,98:101)
# v2 <- c(140:143, 149:152)
# m.out <- readRDS(paste0("matching_results/alt_atc_", day, "_1000_1000.RDS"))
# # Create matched dataset
# gm <- get_matches(m.out, data = data.analysis)
# # estimate the ATC for every day from one week before (March 30) to three weeks after (April 27)
# part <- 130:158 # indicates April 9 to May 7
# gm[,part] <- (10^5)*gm[, part]/gm$pop.2020
# summary.Match.out <- rep(NA, length(part))
# for(p in 1:length(part)){
#   fit <- lm(gm[, part[p]] ~ shutdown.0416,
#             data = gm, weights = weights)
#   summary.Match.out[p] <- coef(summary(fit))[2,1]
# }
# names(summary.Match.out) <- colnames(gm[,part])
# summary.Match.out[c(15, 25)]
#
# vv <- 2
# colnames(outcome)[v1[vv]]
# use <- which(treat == 0 & data.analysis[,v2[vv]]>0)
# outlier <- cbind(data.analysis[use, c("municipality_code", "pop.2020")],
#                  data.analysis[use, v2[vv]],
#                  outcome[use, v1[vv]])
# outlier[6,]
# (-outlier[6,4]/table(treat)[1])/summary.Match.out[15]
#
# vv <- 7
# colnames(outcome)[v1[vv]]
# use <- which(treat == 0 & data.analysis[,v2[vv]]>0)
# outlier <- cbind(data.analysis[use, c("municipality_code", "pop.2020")],
#                  data.analysis[use, v2[vv]],
#                  outcome[use, v1[vv]])
# outlier[1,]
# (-outlier[1,4]/table(treat)[1])/summary.Match.out[25]
#
# # the mean of population among all of the 847 municipalities in the 27 target prefectures is 87,540.
# mean(data.all$pop.2020)


library(ggplot2)
library(tidyverse)
library(magrittr)

args = commandArgs(trailingOnly=TRUE)

# test if there is at least one argument: if not, return an error
if (length(args) != 1) {
  stop("At least one argument must be supplied (input file)", call.=FALSE)
}

print(args[[1]])

colTypeSpec = cols(i = col_integer(),
       dist = col_double(),
       length_ = col_double(),
       dups = col_double())

# "Constants"
POINTSIZE = 0.1
globalSize <- 5000000

filename = paste(args[[1]],  sep="")
allData <- read_delim(file = filename, delim = " ", col_types = colTypeSpec, comment="-")

scatterPlot <- function(data_, pointSize, title) {
  plot <- ggplot(data = data_)
  plot <- plot + geom_point(mapping = aes(x = i, y = dist),
                            size = pointSize)
  #plot <- plot + facet_wrap(ByteEncoder ~ dToNRatio )
  plot <- plot + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 5),
                       legend.text = element_text(size = 5),
                       legend.title = element_text(size =  6))
  plot <- plot + ggtitle(title)
  return(plot)
}
scatterPlotDups <- function(data_, pointSize, title) {
  plot <- ggplot(data = data_)
  plot <- plot + geom_point(mapping = aes(x = i, y = dups),
                            size = pointSize)
  #plot <- plot + facet_wrap(ByteEncoder ~ dToNRatio )
  plot <- plot + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 5),
                       legend.text = element_text(size = 5),
                       legend.title = element_text(size =  6))
  plot <- plot + ggtitle(title)
  return(plot)
}

scatterPlotLength <- function(data_, pointSize, title) {
  plot <- ggplot(data = data_)
  plot <- plot + geom_point(mapping = aes(x = i, y = length_),
                            size = pointSize)
  #plot <- plot + facet_wrap(ByteEncoder ~ dToNRatio )
  plot <- plot + theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 5),
                       legend.text = element_text(size = 5),
                       legend.title = element_text(size =  6))
  plot <- plot + ggtitle(title)
  return(plot)
}
sum_ <- function(data_) {
  overallSum <- sum(data_$dist)
  d <- data.frame(data_)
  curSum <- 0
  for(index in 1:(nrow(data_) - 1)) {
    d$dist[index] <- overallSum - curSum
    curSum <- curSum + data_$dist[index]
  }
  return(as.tibble(d))
}
intervals <- function(data_) {

  maxValue <- max(data_$i)
  print(maxValue)
  d <- data.frame("i" = c(), "dist" = c())
  prevI <- 0
  for(index in c(0, 2,4,8,16,32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384, 32768, 65536, 131072, 262144)) {
  cur <- filter(data_, i >= index)

  curSum <- sum(cur$dist)
  curSumDups <- sum(cur$dups)

  d <- rbind(d, data.frame("i" = c(index), "dist" = c(curSum - curSumDups)))
  prevI <- index
    if (index > maxValue)
      return(as.tibble(d))
  }
  return(as.tibble(d))
}

pureDirName <- str_sub(args, start = 1, end = -2)
print(allData)
pdf(paste(pureDirName, "_plots_prefixCompression.pdf",sep=""), width=10, height=5)

scatterPlot(filter(allData, i < 50), POINTSIZE, "i < 50")
scatterPlotDups(filter(allData, i < 50), POINTSIZE, "i < 50")
scatterPlot(filter(allData, i < 200), POINTSIZE, "i < 200")
scatterPlot(filter(allData, i < 2000), POINTSIZE, "i < 2000")
scatterPlot(filter(allData, i < 20000), POINTSIZE, "i < 20000")
small <- filter(allData, i < 2000)
scatterPlot(small, POINTSIZE, "small dist")
scatterPlotDups(small, POINTSIZE, "small dups")
scatterPlot(intervals(small), POINTSIZE, "intervals on sums")
scatterPlot(sum_(small), POINTSIZE, "sum all dists for i > x")


# Goal: Display of a macroeconomic time-series, with a filled colour
#       bar showing a recession.

years <- 1950:2000
timeseries <- cumsum(c(100, runif(50)*5))
hilo <- range(timeseries)
plot(years, timeseries, type="l", lwd=3)
# A recession from 1960 to 1965 --
polygon(x=c(1960,1960, 1965,1965),
        y=c(hilo, rev(hilo)),
        density=NA, col="orange", border=NA)
lines(years, timeseries, type="l", lwd=3) # paint again so line comes on top

# alternative method -- though not as good looking --
# library(plotrix)
# gradient.rect(1960, hilo[1], 1965, hilo[2],
#               reds=c(0,1), greens=c(0,0), blues=c(0,0),
#               gradient="y")

RFrontEndSolution/Tests Repo/Rscripts All (163 files)/g5.r


#!/usr/bin/r

suppressMessages(library(Rcpp))
suppressMessages(library(inline))

foo <- '
  int i, j, na, nb, nab;
  double *xa, *xb, *xab;
  SEXP ab;

  PROTECT(a = AS_NUMERIC(a));
  PROTECT(b = AS_NUMERIC(b));
  na = LENGTH(a); nb = LENGTH(b); nab = na + nb - 1;
  PROTECT(ab = NEW_NUMERIC(nab));
  xa = NUMERIC_POINTER(a); xb = NUMERIC_POINTER(b);
  xab = NUMERIC_POINTER(ab);
  for(i = 0; i < nab; i++) xab[i] = 0.0;
  for(i = 0; i < na; i++)
    for(j = 0; j < nb; j++) xab[i + j] += xa[i] * xb[j];
  UNPROTECT(3);
  return(ab);
'

funx <- cfunction(signature(a="numeric",b="numeric"), foo, Rcpp=FALSE, verbose=FALSE)
funx(a=1:20, b=2:11)


Cit.HepPh.Unique<-unique(Cit.HepPh)
cit.HepPh.dates.Unique<-unique(cit.HepPh.dates)
cit.HepPh.dates.UniqueNode<-unique(cit.HepPh.dates$V1)

nrow(Cit.HepPh)
nrow(Cit.HepPh.Unique)

nrow(cit.HepPh.dates)
nrow(cit.HepPh.dates.Unique)
length(cit.HepPh.dates.UniqueNode)

dateOfPaper <- function(paperNodeId){
  cit.HepPh.dates.Unique[(cit.HepPh.dates.Unique$V1==paperNodeId),]$V2
}
dateOfPaper(112008)

library(igraph)
gg = graph.data.frame(d = Cit.HepPh.Unique, directed = T)
is.simple(gg)


#!/usr/bin/Rscript

library(DESeq2)

# script arguments
args <- commandArgs(trailingOnly=T)
rda_to_load <- args[1]
rda_to_save <- args[2]

# loading
load(rda_to_load)
dds <- data

# variance stabilising transformation
if ( nrow(dds) < 1000 ) {
	#vst <- DESeq2::vst( dds , nsub=nrow(dds) )
	vst <- DESeq2::varianceStabilizingTransformation( dds )
} else {
	#vst <- DESeq2::vst(dds)
	vst <- DESeq2::varianceStabilizingTransformation( dds )
}

# saving
data <- vst
save(data, file=rda_to_save)


library(ggplot2)
library(reshape2)
library(cowplot)

figWidth<-20
figHeight<-10
textFont<-10

#epoch === repair tool
#losses  === tech(sbfl and profl)
#Subs == patches (correct, plausible noncorrect)
#model == result.txt

Basedir="./"

Subs<-c("FL")

losses<-c("NegFix","NoneFix","NoisyFix","CleanFix")

model<-"result"

epochs<-c("jGenProg","GenProg-A","jMutRepair","kPar","RSRepair-A","jKali","Kali-A","Dynamoth","ACS","Cardumen","Arja","Simfix","FixMiner","AVATAR","TBar","PraPR")

#Metrics<-c("Top1","Top3","Top5","MFR","MAR")
Metrics<-c("Top1","MFR")

for(sub in Subs){
	plot_list = list()
	count=1
	pdf(paste(c("../../Results/FinalResults/","RQ2.pdf"),collapse=""), width=figWidth, height=figHeight)

		for(me in Metrics){

			combinemet=cbind(epochs)
			for(loss in losses){
				datafile=paste(Basedir,loss,"/",sub,"/",model,".txt",sep="")
				datamodel<-read.table(datafile,sep = " ")
				colnames(datamodel) <- c("Tool","Top1","Top3","Top5","MFR","MAR")
				combinemet=cbind(combinemet,datamodel[,me])
			}
			combinemet=data.frame(combinemet)
			#colnames(combinemet) <- c("epochs","within-project","cross-project","cross-validation")
			colnames(combinemet) <- c("Tool","NegFix","NoneFix","NoisyFix","CleanFix")
			combinemet <- melt(combinemet, id.vars='Tool')
			colnames(combinemet) <- c("Tool","model","value")
			combinemet$value <- as.numeric(as.character(combinemet$value))
			p<-ggplot(combinemet, aes(x=Tool, y=value, group=model, colour=model,shape=model)) +
				geom_line(aes(linetype=model),size=1.7)+geom_point(size=2)+ ylab(me)+theme(text=element_text(size=20),legend.position="top")
			plot_list[[count]] = p
			count=count+1

		}

		prow<-plot_grid(plot_list[[1]]+theme(legend.position="none"),
						plot_list[[2]]+theme(legend.position="none"),
						#plot_list[[3]]+theme(legend.position="none"),
						#plot_list[[4]]+theme(legend.position="none"),
						#plot_list[[5]]+theme(legend.position="none"),
						#nrow = 1, align = 'h',labels = sub)
						nrow = 2, align = 'h')
		legend_b <- get_legend(plot_list[[1]] + theme(legend.position=c(0.967,45), legend.title = element_blank(),
														legend.text = element_text( size = 11)))
		p <- plot_grid( prow, legend_b, ncol = 1, rel_heights = c(1.1, .01))
		print(p)
		dev.off()

}


	p = bio.snowcrab::load.environment()

  setwd( project.datadirectory("bio.snowcrab") )

  det = snowcrab.db( DS ="det.georeferenced" )
  set = snowcrab.db( DS ="set.complete" )

  xdet = merge( det, set[,c("trip","set", "t", "z")], by=c("trip", "set"), all.x=T, all.y=F )
  xdet = xdet[ which( xdet$sex %in% c(female,male) ), ]

  xdet$sex = as.factor( xdet$sex)
  xdet$size = "small"
  xdet$size[which( xdet$cw > 95) ] =  "big"
  xdet$size[which( xdet$cw > 60 & xdet$cw < 95) ] =  "med"

  xdet$size = as.factor(  xdet$size )
  levels(xdet$mat) = c("Immature", "Mature")
  levels(xdet$sex) = c("Male", "Female")

  setup.lattice.options()

  histogram( ~ t | sex + mat , data = xdet,
    xlab = "Bottom temperature (C)", type = "density",
    panel = function(x, ...) {
      panel.histogram(x, col="white", ...)
      panel.mathdensity( dmath=dnorm, col = "black", args=list(mean=mean(x),sd=sd(x)))
   } )

   Pr( "png", dname=project.datadirectory("bio.snowcrab", "output"), fname="temp.hist", trim=F , res=144)

  histogram( ~ z | sex + mat , data = xdet,
    xlab = "Bottom temperature (C)", type = "density",
    panel = function(x, ...) {
      panel.histogram(x, col="white", ...)
      panel.mathdensity( dmath=dnorm, col = "black", args=list(mean=mean(x),sd=sd(x)))
   } )

   Pr( "png", dname=project.datadirectory("bio.snowcrab", "output"), fname="temp.hist", trim=F , res=144)

  histogram( ~ t | sex + size , data = xdet,
    xlab = "depth", type = "density",
    panel = function(x, ...) {
      panel.histogram(x, col="white", ...)
      panel.mathdensity( dmath=dnorm, col = "black", args=list(mean=mean(x),sd=sd(x)))
   } )
`
   Pr( "png", dname=project.datadirectory("bio.snowcrab", "output"), fname="temp.hist", trim=F , res=144)