 read.ma <- function(out){

          ma.name <- out$input$ma.name
      browser()
      tif.dir <- out$dat$tif.dir$dname
      out.list <- out$dat$ma
      out.list$status[1] <- file.access(ma.name,mode=0)==0

      if(is.null(out$input$tif.dir)){
          try(ma<-read.csv(ma.name,skip=3))
          hl<-readLines(ma.name,1)
          hl=strsplit(hl,',')
          colnames(ma) = hl[[1]]

          tif.info<-readLines(ma.name,3)
          tif.info<-strsplit(tif.info,',')
          temp<-tif.info[[2]]
          temp[1:3]<-0
          include<-as.numeric(temp)

          paths<-as.character(tif.info[[3]])
            }
      if(class(ma)=="try-error") stop("Error reading MDS")
          else out.list$status[2]<-T

              temp<-strsplit(tif.info[[2]][1],split="\\\\")[[1]]
            out.list$input$FieldDataTemp<-temp[length(temp)]

                temp<-strsplit(tif.info[[2]][2],split="\\\\")[[1]]
            out.list$input$OrigFieldData<-temp[length(temp)]

               temp<-strsplit(tif.info[[2]][3],split="\\\\")[[1]]
            out.list$input$CovSelectName<-temp[length(temp)]

                temp<-strsplit(tif.info[[3]][1],split="\\\\")[[1]]
            out.list$input$ParcTemplate<-temp[length(temp)]

            temp<-strsplit(tif.info[[3]][2],split="\\\\")[[1]]
            out.list$input$ParcOutputFolder<-temp[length(temp)]

            temp<-strsplit(tif.info[[2]][2],split="\\\\")[[1]]
            out.list$input$OrigFieldData<-temp[length(temp)]

          r.name <- out$input$response.col
          if(r.name=="responseCount") out$input$model.family="poisson"

      r.col <- grep(r.name,names(ma))
      if(length(r.col)==0) stop("Response column was not found")
      if(length(r.col)>1) stop("Multiple columns matched the response column")
         rm.list<-r.col

        # remove background points which aren't used here
         if(length(which(ma[,r.col]==-9999,arr.ind=TRUE))>0) ma<-ma[-c(which(ma[,r.col]==-9999,arr.ind=TRUE)),]
         response<-ma[,r.col]

      # find and save xy columns#
      xy.cols <- na.omit(c(match("x",tolower(names(ma))),match("y",tolower(names(ma)))))
      if(length(xy.cols)>0) {out.list$train.xy<-ma[,xy.cols]
      rm.list<-c(rm.list,xy.cols)}

       # remove weights column except for Random Forest
       site.weights<-match("site.weights",tolower(names(ma)))
       if(!is.na(site.weights)){
          out.list$train.weights<-ma[,site.weights]
          rm.list<-c(rm.list,site.weights)
          } else out.list$train.weights<-rep(1,times=dim(ma)[1]))

      ma.names<-names(ma)
      # tagging factors and looking at their levels
         factor.cols <- grep("categorical",names(ma))
      factor.cols <- factor.cols[!is.na(factor.cols)]
      if(length(factor.cols)==0){
          out.list$factor.levels <- NA
          } else {
                names(ma) <- ma.names <-  sub("_categorical","",ma.names)
                factor.names <- ma.names[factor.cols]
                factor.levels <- list()
                for (i in 1:length(factor.cols)){
                 f.col <- factor.cols[i]

                        x <- table(ma[,f.col])
                        if(nrow(x)<2){
                              out$dat$bad.factor.cols <- c(out$dat$bad.factor.cols,factor.names[i])
                              }
                        lc.levs <-  as.numeric(row.names(x))[x>0] # make sure there is at least one "available" observation at each level
                        lc.levs <- data.frame(number=lc.levs,class=lc.levs)
                        factor.levels[[i]] <- lc.levs

                    ma[,f.col] <- factor(ma[,f.col],levels=lc.levs$number,labels=lc.levs$class)
                    }

                    names(factor.levels)<-factor.names
                    out.list$factor.levels <- factor.levels
          }

     #remove test training split column if present
          split.indx<-match("split",tolower(names(ma)))
          if(length(na.omit(split.indx))>0){
              split.col<-ma[,split.indx]
              out.list$ma.test<-ma[split.col=="test",]
              ma<-ma[split.col=="train",]
              out.list$test.weights<-out.list$train.weights[split.col=="test"]
              out.list$train.weights<-out.list$train.weights[split.col=="train"]
              out.list$test.xy<-out.list$train.xy[split.col=="test",]
              out.list$train.xy<-out.list$train.xy[split.col=="train",]
              rm.list<-c(rm.list,split.indx)
            }

      # check that response column contains only 1's and 0's, but not all 1's or all 0's if GLMFamily==binomial
      if(out$input$model.source.file=="rf.r") out$input$model.family="bernoulli"

      if(tolower(out$input$model.family)=="bernoulli" || tolower(out$input$model.family)=="binomial"){
          if(any(ma[,r.col]!=1 & ma[,r.col]!=0) | sum(ma[,r.col]==1)==nrow(ma) | sum(ma[,r.col]==0)==nrow(ma))
          stop("response column (#",r.col,") in ",ma.name," is not binary 0/1",sep="")

          out.list$n.pres[1] <- sum(ma[,r.col])
          out.list$n.abs[1] <- nrow(ma)-sum(ma[,r.col])
          }

     #check that response column contains at least two unique values for counts

      if(tolower(out$input$model.family)=="poisson"){
          if(length(table(unique(ma[,r.col])))==1)
          stop("response column (#",r.col,") in ",ma.name," does not have at least two unique values",sep="")

          out.list$n.pres[1] <- sum(ma[,r.col]!=0)
          out.list$n.abs[1] <- sum(ma[,r.col]==0)
          }

         out$dat$ma$resp.name <- names(ma)[r.col]<-"response"
         out.list$resp.name <- names(ma)[r.col]

          include[is.na(include)]<-0
          rm.list<-c(rm.list,(which(include!=1,arr.ind=TRUE)))
          rm.list<-unique(rm.list[!is.na(rm.list)])

         ma <- ma[,-rm.list]
                  if(is.null(out$input$tif.dir)){
                    paths<-paths[-c(rm.list)]
                    include<-include[-c(rm.list)]
                    #ma.names[-c(rm.cols)]
                    }

         ma[ma==-9999]<-NA
         ma.names<-names(ma)
          browser()
      # if producing geotiff output, check to make sure geotiffs are available for each column of the model array #
        if(out$input$make.binary.tif==T | out$input$make.p.tif==T){
                #Now check that tiffs to be used exist

              ma.cols <- match(ma.names,sub(".tif","",basename(paths[-r.col])))
                if(any(is.na(ma.cols))){
                  stop("the following geotiff(s) are missing in ",
                        tif.dir,":  ",paste(ma.names[-r.col][is.na(ma.cols)],collapse=" ,"),
                        "\nif these are intentionally left blank, uncheck makeBinMap and makeProbabilityMap options",sep="")

              if(sum(file.access(paths[include==1]),mode=0)!=0)
                  stop("the following geotiff(s) are missing : ",
                        paths[(file.access(paths)!=0),][1],"\nif these are intentionally left blank, uncheck makeBinMap and makeProbabilityMap options", sep="")

                out$dat$tif.ind<-paths
                }

          if(!is.null(out$input$tif.dir)){
              tif.names <- out$dat$tif.names
              ma.cols <- match(ma.names[-r.col],sub(".tif","",basename(tif.names)))
              if(any(is.na(ma.cols)))stop("the following geotiff(s) are missing in ",
                        tif.dir,":  ",paste(ma.names[is.na(ma.cols)],collapse=" ,"),sep="")

            out$dat$tif.names <- tif.names[ma.cols]

            } else out$dat$tif.names <- ma.names
       #Removing NAs this might be better in a loop
          out.list$ma <- ma[complete.cases(ma),c(r.col,c(1:ncol(ma))[-r.col])]
         if(length(na.omit(split.indx))>0) out.list$test.xy<-out.list$test.xy[complete.cases(out.list$ma.test),]
         out.list$train.xy<-out.list$train.xy[complete.cases(ma),]

      if(!is.null(out.list$ma.test)){
      if(out$input$model.source.file!="rf.r") out.list$test.weights<- out.list$test.weights[complete.cases(out.list$ma.test)]
        out.list$ma.test<-out.list$ma.test[complete.cases(out.list$ma.test),c(r.col,c(1:ncol(out.list$ma.test))[-r.col])]
        if(out$input$model.source.file!="rf.r") out.list$test.weights<- out.list$test.weights[complete.cases(out.list$ma.test)]
        # out.list$ma.test<-out.list$ma.test[,c(r.col,c(1:ncol(out.list$ma.test))[-r.col])]
        #if(out$input$model.source.file!="rf.r") out.list$test.weights<- out.list$test.weights
        out.list$n.pres[4] <- sum(out.list$ma.test[,r.col]!=0)
        out.list$n.abs[4] <- nrow(out.list$ma.test)-sum(out.list$ma.test[,r.col]!=0)
        }
      if(out$input$model.source.file!="rf.r") out.list$train.weights <- out.list$train.weights[complete.cases(ma)]
      if(!is.null(out$dat$bad.factor.cols)) out.list$ma <- out.list$ma[,-match(out$dat$bad.factor.cols,names(out.list$ma))]

        out.list$dims <- dim(out.list$ma)
        out.list$ratio <- min(sum(out$input$model.fitting.subset)/out.list$dims[1],1)
        out.list$n.pres[2] <- sum(out.list$ma[,1]!=0)
        out.list$n.abs[2] <- nrow(out.list$ma)-sum(out.list$ma[,1]!=0)
        out.list$used.covs <- names(out.list$ma)[-1]

      if(!is.null(out$input$model.fitting.subset)){
            pres.sample <- sample(c(1:nrow(out.list$ma))[out.list$ma[,1]>=1],min(out.list$n.pres[2],out$input$model.fitting.subset[1]))
            abs.sample <- sample(c(1:nrow(out.list$ma))[out.list$ma[,1]==0],min(out.list$n.abs[2],out$input$model.fitting.subset[2]))
            out.list$ma.subset <- out.list$ma[c(pres.sample,abs.sample),]
            if(out$input$model.source.file!="rf.r") out.list$weight.subset<-out.list$train.weights[c(pres.sample,abs.sample)]
            out.list$n.pres[3] <- length(pres.sample)
            out.list$n.abs[3] <- length(abs.sample)
            } else {
            out.list$ma.subset <- NULL
            out.list$weight.subset<-NULL
            out.list$n.pres[3] <- NA
            out.list$n.abs[3] <- NA }

if(tolower(out$input$model.family)=="poisson"){
out.list$ma.subset<-out.list$ma
out.list$weight.subset<-out.list$train.weights
}

          out$dat$ma <- out.list

      return(out)
      }


# Final Shiny app
# Libraries
{
  library(shiny)
  library(tidyverse)
  library(reshape2)
  library(plotly)
  library(reactable)
}

# Predictions
# Load predictions from GitHub
predictions = read.csv("https://raw.githubusercontent.com/skycope/grass-pollen/master/Shiny/predictions.csv")  %>%
  mutate(date = as.Date(date)) %>% rename(Date = date)

# format dates and days correctly
predictions$Date = format(predictions$Date, "%d %b")
predictions$day = factor(predictions$day, levels = as.character(predictions$day))

# get the right colours
colours = c('#40b101', '#b1eb36', '#ffe100', '#ffa200', '#ff4a36')

# User Interface -------
ui <- fluidPage(
  fluidRow(
    column(width = 12,
           reactableOutput("table", height = 120),
           div(style = 'padding:20px;')
    )
  ),
  fluidRow(
    column(width = 12,
           plotlyOutput("plot2", height = 400)
    )
  )
)

# Server ---------
risk_df = predictions  %>%
  mutate(lowrisk = Low + Very_Low,
         highrisk = High + Very_High,
         medrisk = Moderate) %>%
  mutate(`Pollen Risk` = case_when(
    lowrisk >= medrisk & lowrisk >= highrisk ~ "Low",
    highrisk >= medrisk & highrisk >= lowrisk ~ 'High',
    medrisk >= highrisk & medrisk >= lowrisk ~ 'Moderate'
  ) ) %>% dplyr::select(-lowrisk, -highrisk, -medrisk, -day) %>% t() %>% data.frame()

names(risk_df) = predictions$day
risk_df = risk_df[-1:-5,]

server <- function(input, output){

  output$table <- renderReactable(
    reactable(
      risk_df,
      columns = list(
        Monday = colDef(
          style = function(risk_cat) {
            colour =  case_when(
              risk_cat == 'Low' ~ '#40b101',
              risk_cat == 'Moderate' ~ '#ffa800',
              risk_cat == 'High' ~ '#DC4130'
            )
            list(fontWeight = 600, color = colour)
          }
        ),
        Tuesday = colDef(
          style = function(risk_cat) {
            colour =  case_when(
              risk_cat == 'Low' ~ '#40b101',
              risk_cat == 'Moderate' ~ '#ffa800',
              risk_cat == 'High' ~ '#DC4130'
            )
            list(fontWeight = 600, color = colour)
          }
        ),
        Wednesday = colDef(
          style = function(risk_cat) {
            colour =  case_when(
              risk_cat == 'Low' ~ '#40b101',
              risk_cat == 'Moderate' ~ '#ffa800',
              risk_cat == 'High' ~ '#DC4130'
            )
            list(fontWeight = 600, color = colour)
          }
        ),
        Thursday = colDef(
          style = function(risk_cat) {
            colour =  case_when(
              risk_cat == 'Low' ~ '#40b101',
              risk_cat == 'Moderate' ~ '#ffa800',
              risk_cat == 'High' ~ '#DC4130'
            )
            list(fontWeight = 600, color = colour)
          }
        ),
        Friday = colDef(
          style = function(risk_cat) {
            colour =  case_when(
              risk_cat == 'Low' ~ '#40b101',
              risk_cat == 'Moderate' ~ '#ffa800',
              risk_cat == 'High' ~ '#DC4130'
            )
            list(fontWeight = 600, color = colour)
          }
        ),
        Saturday = colDef(
          style = function(risk_cat) {
            colour =  case_when(
              risk_cat == 'Low' ~ '#40b101',
              risk_cat == 'Moderate' ~ '#ffa800',
              risk_cat == 'High' ~ '#DC4130'
            )
            list(fontWeight = 600, color = colour)
          }
        ),
        Sunday = colDef(
          style = function(risk_cat) {
            colour =  case_when(
              risk_cat == 'Low' ~ '#40b101',
              risk_cat == 'Moderate' ~ '#ffa800',
              risk_cat == 'High' ~ '#DC4130'
            )
            list(fontWeight = 600, color = colour)
          }
        )
      )
    ))

  output$plot2 = renderPlotly({
    q  = predictions %>% rename(`Very Low` = Very_Low, `Very High` = Very_High) %>%
      dplyr::select(-Date) %>%
      melt(id.vars = 'day') %>%
      group_by(day, variable) %>%
      rename(Category = variable) %>%
      ggplot(aes(x = day, y = value, fill = Category, group = Category)) +
      geom_area(position = 'stack', alpha = 0.8) +
      scale_fill_manual(values = colours) +
      ylab("Cumulative Probability") +
      xlab("Day") +
      theme_minimal()
    ggplotly(q)
  })
}

# Run App ----------
shinyApp(ui, server)


tf_enrichment <- function(sigs, cmap_path, landmark){
  #landmark = landmark annotation
  #sigs = vector of signature IDs
  #cmap_path = path to lvl 5 mod z gctx
  library(tidyverse)
  library(cmapR)
  library(rhdf5)
  library(CARNIVAL)
  library(AnnotationDbi)
  library(org.Hs.eg.db)
  library(viper)
  load(file = system.file("BEST_viperRegulon.rdata",package="CARNIVAL")) # loading the viper regulons
  ### load the profiles expression
  cmap_data <- get_cmap_signatures(cmap_path_to_gctx = cmap_path,sig_ids = sigs,landmark = TRUE,landmark_df = landmark)
  ### calculate tf enrichment
  TF_cmap <-runDoRothEA(cmap_data, regulon=viper_regulon, confidence_level=c('A','B','C')) # Estimating TF activities
  return(TF_cmap)
}


# ==============================
# Graphs and tables of simulated regressions
# Nuno Prista, SLU Aqua, 2019 @ KustMonitoring project
# ==============================

rm(list=ls()); graphics.off()

library(data.table)

# select scenario
scenario <- "AllocScenarioOriginal"

for (site in c("Asköfjärden", "Galtfjärden","Gaviksfjärden","Holmön","Kinnbäcksfjärden","Kvädöfjärden_Warm","Lagnö","Långvindsfjärden","Norrbyn", "Råneå","Torhamn")
{

	# use during testing and site by site runs
	# site<-"Kinnbäcksfjärden"

	# site specific output vars
	if (site == "Asköfjärden") output_vars <- c("CyprinidsN","HerringN","PerchN","FlounderN","WhitefishN")
	if (site == "Kvädöfjärden_Warm") output_vars <- c("CyprinidsN","HerringN","PerchN","FlounderN","PikeperchN")
	if (site == "Norrbyn") output_vars <- c("CyprinidsN","HerringN","PerchN","WhitefishN")
	if (site == "Galtfjärden") output_vars <- c("CyprinidsN","HerringN","PerchN","PikeperchN","WhitefishN")
	if (site == "Gaviksfjärden") output_vars <- c("CyprinidsN","HerringN","PerchN","WhitefishN")
	if (site == "Holmön") output_vars <- c("CyprinidsN","HerringN","PerchN","WhitefishN")
	if (site == "Kinnbäcksfjärden") output_vars <- c("CyprinidsN","HerringN","PerchN","WhitefishN")
	if (site == "Lagnö") output_vars <- c("CyprinidsN","HerringN","PerchN","WhitefishN")
	if (site == "Långvindsfjärden") output_vars <- c("CyprinidsN","HerringN","PerchN","WhitefishN")
	if (site == "Torhamn") output_vars <- c("CyprinidsN","HerringN","PerchN","FlounderN")
	if (site == "Råneå") output_vars <- c("CyprinidsN","HerringN","PerchN","WhitefishN")

	# =======================
	# Loading
	# =======================

	# loads original data
		dir_inputs<-"001_Inputs/prepared_main/"
		load(file=paste("001_Inputs/prepared_main/NordicGillNets/",site,".Rdata",sep=""))

 	# loads simulations (Asköfjärden)
		dir_sim_outputs <- paste("002_Sim_Outputs/",scenario,"/prepared/",sep="")
		load(file=paste(dir_sim_outputs, site, "_", scenario,"_5000sims_res_pop_prep.rdata", sep=""))
		load(file=paste(dir_sim_outputs, site, "_", scenario,"_5000sims_res_strata_prep.rdata", sep=""))

	# loads regression simulations
		dir_sim_outputs <- paste("002_Sim_Outputs/",scenario,"/prepared/",sep="")
		res_omdrev1<-data.table(readRDS(file=paste(dir_sim_outputs, site, "_", scenario,"_omdrev_1_1000sims_res_model.rds", sep="")))
		res_omdrev2<-data.table(readRDS(file=paste(dir_sim_outputs, site, "_", scenario,"_omdrev_2_1000sims_res_model.rds", sep="")))
		res_omdrev3<-data.table(readRDS(file=paste(dir_sim_outputs, site, "_", scenario,"_omdrev_3_1000sims_res_model.rds", sep="")))

	# =======================
	# Data prep
	# =======================

		dir_results <- paste("003_Results/008_Regression_Results/",site,"/", scenario, "/",sep=""); dir.create(dir_results, recursive=T)

		# assigns true slope

		ls1<-split(res_pop, res_pop$variable)
		ls2<-lapply(ls1, function(x, site1 = site)
				{
				true_model<-lm(st_mean~Year,data=x)
				x<-data.frame(Area = site1, variable = x$variable[1], true_slope = coef(true_model)[2], true_sign = summary(true_model)[[4]][8]<0.05)
				x
				})
		res_regr<-do.call("rbind",ls2)
		write.csv2(res_regr, file=paste(dir_results, site, "_origin_regr.csv", sep=""))

			res_omdrev1$true_slope<-res_regr$true_slope[match(res_omdrev1$variable, res_regr$variable)]
			res_omdrev1$true_sign<-res_regr$true_sign[match(res_omdrev1$variable, res_regr$variable)]

			res_omdrev2$true_slope<-res_regr$true_slope[match(res_omdrev2$variable, res_regr$variable)]
			res_omdrev2$true_sign<-res_regr$true_sign[match(res_omdrev2$variable, res_regr$variable)]

			res_omdrev3$true_slope<-res_regr$true_slope[match(res_omdrev3$variable, res_regr$variable)]
			res_omdrev3$true_sign<-res_regr$true_sign[match(res_omdrev3$variable, res_regr$variable)]

	# =======================
	# Exploratory results
	# =======================

		# omdrev1
			dt1 <- res_omdrev1
			table(dt1$SampSize)

			# biases and variances
				dt1$slope_negative <- dt1$slope<0
				dt1$true_slope_negative <- dt1$true_slope<0
				dt1$slope_dif<-dt1$slope-dt1$true_slope
				dt1$slope_dif_perc<-dt1$slope_dif/dt1$true_slope*100
				dt1$slope_dif_perc_abs<-abs(dt1$slope_dif/dt1$true_slope*100)

				dt1[, mean(slope_dif_perc), SampSize]
				dt1[, mean(slope_dif_perc_abs), SampSize]
				dt1[, var(slope_dif_perc), SampSize]

				# same slope sign
				res1 <- dt1[variable %in% output_vars, sum(slope_negative==true_slope_negative), list(SampSize, variable)]; res1
				dcast(res1, SampSize~variable)

				# same slope sign and significance
				res2 <- dt1[variable %in% output_vars, sum(slope_negative==true_slope_negative & sign==true_sign), list(SampSize, variable)]; res2
				dcast(res2, SampSize~variable)
				write.csv2( dcast(res2, SampSize~variable), file = paste(dir_results, site, "_", scenario,"_identical_omdrev1.csv", sep=""))

				# same slope sign and significance and slope within 10%
				res3 <- dt1[variable %in% output_vars, sum(slope_negative==true_slope_negative & sign==true_sign & slope_dif_perc_abs<50), list(SampSize, variable)]; res3
				dcast(res3, SampSize~variable)

		# omdrev2
			dt2 <- res_omdrev2
			table(dt2$SampSize)

			# biases and variances
				dt2$slope_negative <- dt2$slope<0
				dt2$true_slope_negative <- dt2$true_slope<0
				dt2$slope_dif<-dt2$slope-dt2$true_slope
				dt2$slope_dif_perc<-dt2$slope_dif/dt2$true_slope*100
				dt2$slope_dif_perc_abs<-abs(dt2$slope_dif/dt2$true_slope*100)

				dt2[, mean(slope_dif_perc), SampSize]
				dt2[, mean(slope_dif_perc_abs), SampSize]
				dt2[, var(slope_dif_perc), SampSize]
				dt2[, list(same_slope=sum(slope<0), same_sign = sum(sign==true_sign)), SampSize]

			# same slope sign
				res1 <- dt2[variable %in% output_vars, sum(slope_negative==true_slope_negative), list(SampSize, variable)]; res1
				dcast(res1, SampSize~variable)

				# same slope sign and significance
				res2 <- dt2[variable %in% output_vars, sum(slope_negative==true_slope_negative & sign==true_sign), list(SampSize, variable)]; res2
				dcast(res2, SampSize~variable)
				write.csv2( dcast(res2, SampSize~variable), file = paste(dir_results, site, "_", scenario,"_identical_omdrev2.csv", sep=""))

				# same slope sign and significance and slope within 10%
				res3 <- dt2[variable %in% output_vars, sum(slope_negative==true_slope_negative & sign==true_sign & slope_dif_perc_abs<50), list(SampSize, variable)]; res3
				dcast(res3, SampSize~variable)

		# omdrev3
			dt3 <- res_omdrev3
			table(dt3$SampSize)

			# biases and variances
				dt3$slope_negative <- dt3$slope<0
				dt3$true_slope_negative <- dt3$true_slope<0
				dt3$slope_dif<-dt3$slope-dt3$true_slope
				dt3$slope_dif_perc<-dt3$slope_dif/dt3$true_slope*100
				dt3$slope_dif_perc_abs<-abs(dt3$slope_dif/dt3$true_slope*100)

				dt3[, mean(slope_dif_perc), SampSize]
				dt3[, mean(slope_dif_perc_abs), SampSize]
				dt3[, var(slope_dif_perc), SampSize]

			# same slope sign
				res1 <- dt3[variable %in% output_vars, sum(slope_negative==true_slope_negative), list(SampSize, variable)]; res1
				dcast(res1, SampSize~variable)

				# same slope sign and significance
				res2 <- dt3[variable %in% output_vars, sum(slope_negative==true_slope_negative & sign==true_sign), list(SampSize, variable)]; res2
				dcast(res2, SampSize~variable)
				write.csv2( dcast(res2, SampSize~variable), file = paste(dir_results, site, "_", scenario,"_identical_omdrev3.csv", sep=""))

				# same slope sign and significance and slope within 10%
				res3 <- dt3[variable %in% output_vars, sum(slope_negative==true_slope_negative & sign==true_sign & slope_dif_perc_abs<50), list(SampSize, variable)]; res3
				dcast(res3, SampSize~variable)
}

	# =======================
	# exploratory "power" analysis
	# =======================

		dt1[, list(same_slope=sum(c(slope<0)==c(true_slope<0)), same_signif = sum(sign==true_sign)), SampSize]
		dt2[, list(same_slope=sum(c(slope<0)==c(true_slope<0)), same_signif = sum(sign==true_sign)), SampSize]
		dt3[, list(same_slope=sum(c(slope<0)==c(true_slope<0)), same_signif = sum(sign==true_sign)), SampSize]


# SSSEQ.R
#
# Simple R script to display a sequence with structural annotation

# define sequence and secondary structure
seq <- "GARVHMDGARLMNAAVALRIPPARLVEHCDSVSFCFSKG"
struct <- c(0,0,2,2,2,2,2,1,1,1,1,0,0,0,0,0,0,0,0,0,0,
                   1,1,1,1,0,0,0,0,0,2,2,2,2,2,0,0,0,0)
residuecount <- 39;

# set up the window for plotting
x11()  # may need to change to quartz() for Mac or windows() for PC
plot.new()
plot.window(c(0,40),c(-20,20))

# plot a line representing the length of the sequence
segments(0.5,0,39.5,0)

# plot the sequence and features
for (i in 1:residuecount) {
	text(i,-2,substr(seq,i,i))	# write residue letter
	if (struct[i] != 0) {
		if (struct[i] == 1) boxcolour <- "firebrick"	# alpha helix
		if (struct[i] == 2) boxcolour <- "yellow3"	# beta sheet
		rect(i-0.5,-1,i+0.5,1,col = boxcolour, border = NA)
	}
}

# plot a legend
legend(x=0,y=8,legend=(c("alpha helix","beta sheet")),
    pch=15,col=c("firebrick","yellow3"),bg="snow")


########## This R code is meant to simulate data from a simple dag.

### z.
### x= f(c,z)
### y = f2(c).

### z -> x, c -> x,c -> y.

### z and c are from the set {1,0}.

### The domain of x is {}.

### The domain of y is {}


#' Make display maps for a species
#'
#' Make display maps for a species.
#' @param species Name of species
#' @param family Family of species
#' @param focus2Sp Spatial data frame object in equal-area projection
#' @param gadm1Sp Spatial object with states, does not have to be cropped to focus2Sp
#' @param q Vector of posterior samples of false positive rate of detection
#' @param waic WAIC object or \code{NULL}
#' @param loo LOO object or \code{NULL}
#' @param minUnconverged Proportion of unconverged parameters that is acceptable for a model
#' @param outDir Directory to which to save image
#' @param isOk TRUE/FALSE if model is sufficiently converged.
#' @param appendToName \code{NULL} or character to append to file name.
#' @param footer \code{NULL} or character to append to add to footer.
#' @param ... Arguments to pass to text()
#' @return Write an image to disk.
#' @export

mapBayesODM <- function(
	species,
	family,
	focus2Sp,
	gadm1Sp,
	q,
	waic,
	loo,
	minUnconverged,
	outDir,
	isOk,
	appendToName = NULL,
	footer = NULL,
	...
) {

	### formatting
	occCol <- 'forestgreen' # green--map color for occupancy
	occUncertCol <- 'red' # map color for uncertainty in occupancy
	knownOccCol <- 'steelblue3' # map color for counties with known occurrences
	effortCol <- '#6a51a3' # blue--map color number of collections

	lwd <- 0.4 # line width of political borders

	### assess convergence
	######################

		# if (TRUE) {
			# ignore <- c('z[[]', 'falseDetect[[]', 'constraintFalseDetect[[]')
			# conv <- rhatStats(mcmc$samples, rhatThresh = 1.1, minConv = minUnconverged, ignore = ignore)
		# } else {
			# if (FALSE) conv <- list(); conv$sufficient <- TRUE
		# }

	### prepare plot elements
	#########################

		# centroids of counties with occurrences
		occ2Sp <- focus2Sp[focus2Sp@data$detect > 0, ]
		centsSp <- rgeos::gCentroid(focus2Sp[focus2Sp@data$detect > 0, ], byid=TRUE)

		# fix any potentially orphaned holes
		focus2Sp <- rgeos::gBuffer(focus2Sp, width=0, byid=TRUE)

		# create plotting extent: focal region plus a buffer
		ext <- raster::extent(focus2Sp)
		extSp <- as(ext, 'SpatialPolygons')
		raster::projection(extSp) <- raster::projection(focusSp)

		extCentSp <- rgeos::gCentroid(extSp)
		maxDist_m <- rgeos::gDistance(extCentSp, extSp, hausdorff=TRUE)
		extSp <- rgeos::gBuffer(extSp, width=0.05 * maxDist_m)

		ext <- raster::extent(extSp)
		extSp <- as(ext, 'SpatialPolygons')
		projection(extSp) <- raster::projection(focus2Sp)

		# crop GADM1
		extSp_inGadm <- sp::spTransform(extSp, sp::CRS(raster::projection(gadm1Sp)))
		gadm1SpCrop <- raster::crop(gadm1Sp, extSp_inGadm)
		gadm1SpCrop <- sp::spTransform(gadm1SpCrop, sp::CRS(raster::projection(focusSp)))

	### plot
	########

		# ok <- if (isOk) { 'ok' } else { 'notOk'}
		ok <- 'notAssessed'
		filename <- paste0(tolower(family), '_', species)
		if (!is.null(appendToName)) filename <- paste0(filename, '_', appendToName)
		png(paste0(outDir, '/', filename, '.png'), width=1800, height=1100, res=300)

			# layout
			par(bg='white', oma=c(0.7, 0.5, 1.3, 0), mar=c(0, 2, 0, 0))
			lay <- matrix(c(1, 1, 2, 1, 1, 3), nrow=2, byrow=TRUE)
			layout(lay)

		### occupancy

			col <- occCol

			plot(gadm1SpCrop, col='gray90', border=NA)

			x <- focus2Sp@data$psi
			if (any(focus2Sp@data$detect == 0)) x[focus2Sp@data$detect > 0] <- NA
			xMaxNonDetect <- max(x, na.rm=TRUE)
			cols <- scales::alpha(col, x / xMaxNonDetect)
			plot(focus2Sp, col='white', border=NA, add=TRUE)
			plot(focus2Sp, col=cols, border='gray80', lwd=lwd, add=TRUE)
			plot(occ2Sp, col=knownOccCol, border='gray80', lwd=lwd, add=TRUE)
			plot(gadm1SpCrop, col=NA, border='gray60', lwd=lwd, add=TRUE)

			# legend
			labels <- seq(0, xMaxNonDetect, length.out=5)
			labels <- round(labels, 2)
			labels <- sprintf('%0.2f', labels)
			labels[1] <- '0'

			width <- 0.04
			height <- 0.9

			legTitle <- 'Occupancy\nprobability'
			legCex <- 0.62

			swatches <- list(
				list(swatchAdjY=c(0, 0.02), col=knownOccCol, border='gray', labels='Specimens')
			)

			legendary::legendGrad('left', inset=-0.01, title=legTitle, col=c('white', col), labels=labels, width=width, height=height, border='gray', boxBorder=NA, adjX=c(0.6, 1), adjY=c(0.06, 0.90), titleAdj=c(1.39, 0.95), labAdj=0.82, boxBg=NA, cex=legCex, lwd=0.5 * lwd, swatches=swatches, pos=2)

		### uncertainty in occupancy

			col <- occUncertCol

			plot(gadm1SpCrop, col='gray90', border=NA)

			x <- focus2Sp$psi90CI
			if (any(focus2Sp@data$detect == 0)) x[focus2Sp@data$detect > 0] <- NA
			xMaxNonDetect <- max(x, na.rm=TRUE)
			cols <- scales::alpha(col, x / xMaxNonDetect)
			plot(focus2Sp, col='white', border=NA, add=TRUE)
			plot(focus2Sp, col=cols, border='gray80', lwd=lwd, add=TRUE)
			plot(occ2Sp, col=knownOccCol, border='gray80', lwd=lwd, add=TRUE)
			plot(gadm1SpCrop, col=NA, border='gray60', lwd=lwd, add=TRUE)

			# legend
			labels <- seq(0, xMaxNonDetect, length.out=5)
			labels <- round(labels, 2)
			labels <- sprintf('%0.2f', labels)
			labels[1] <- '0'

			legCex <- 0.58
			width <- 0.12
			height <- 0.3

			legTitle <- 'Occupancy\nuncertainty\n(90% CI)'

			swatches <- list(
				list(swatchAdjY=c(0, 0.04), col=knownOccCol, border='gray', labels='Specimens')
			)

			legendary::legendGrad('left', inset=-0.01, title=legTitle, col=c('white', col), labels=labels, width=width, height=0.925, border='gray', boxBorder=NA, adjX=c(0, 0.29), adjY=c(0.07, 0.81), titleAdj=c(0.55, 0.93), labAdj=0.2, boxBg=NA, cex=legCex, lwd=0.5 * lwd, swatches=swatches, pos=2)

		### effort

			title <- expression(paste('Total '*italic(family.)))
			legTitle <- 'Specimens'
			legCex <- 0.35
			col <- effortCol

			plot(gadm1SpCrop, col='gray90', border=NA)

			x <- focus2Sp@data$effort
			x <- log10(x + 1)
			cols <- scales::alpha(col, x / max(x))
			plot(focus2Sp, col='white', border=NA, add=TRUE)
			plot(focus2Sp, col=cols, border='gray80', lwd=lwd, add=TRUE)
			plot(gadm1SpCrop, col=NA, border='gray60', lwd=lwd, add=TRUE)
			points(centsSp, pch=16, cex=0.25)

			# legend
			labels <- seq(0, 1, by=0.2) * max(x)
			labels <- round(10^labels - 1, digits=1)
			labels <- sprintf('%.1f', labels)
			labels[1] <- '0'

			width <- 0.12
			height <- 0.3

			legCex <- 0.58
			width <- 0.12
			height <- 0.3

			legTitle <- paste('Total\n', family)

			legendary::legendGrad('left', inset=-0.01, title=legTitle, col=c('white', col), labels=labels, width=width, height=0.925, border='gray', boxBorder=NA, adjX=c(0, 0.29), adjY=c(0, 0.84), titleAdj=c(0.55, 0.93), labAdj=0.2, boxBg=NA, cex=legCex, lwd=0.5 * lwd, pos=2)

		### titles

			main <- substitute(paste(family, ': ', italic(species)), env=list(species=species, family=family))
			mtext(text=main, at=c(0.01), outer=TRUE, cex=1, line=-0.3, adj=0)
			if (!isOk) mtext(text='Insufficient convergence', at=c(0.01), outer=TRUE, cex=1, line=-1.3, adj=0, col='red')

			text <- paste(footer, ' | ', date())
			mtext(text=text, side=1, at=0.985, outer=TRUE, cex=0.35, line=-0.27, adj=1)

			qMean <- round(mean(q), 3)
			qLow <- round(quantile(q, 0.05), 3)
			qHigh <- round(quantile(q, 0.95), 3)

			# msg1 <- paste0('WAIC: ', round(waic$estimates['waic', 1], 2), ' | LOO: ', round(loo$estimates['looic', 1], 2))
			msg1 <- ''
			msg2 <- paste0('Probability all specimens in a county in which ', species, ' is truely absent are mistaken identifications: ', sprintf('%0.3f', qMean), ' (90% CI: ', sprintf('%0.3f', qLow), '-', sprintf('%0.3f', qHigh), ')')
			mtext(msg1, side=1, at=0.005, outer=TRUE, cex=0.35, line=-0.8, adj=0)
			mtext(msg2, side=1, at=0.005, outer=TRUE, cex=0.35, line=-0.3, adj=0)

		dev.off()

}


dykstra <- bavg %>%
  filter(batterid=='dyksl001') %>%
  select(H,AB,RDate) %>%
  arrange(RDate) %>%
  mutate(Total_H=cumsum(H), Total_AB=cumsum(AB)) %>%
  mutate(AVG = round(Total_H / Total_AB),3)


library(tidyverse)
library(dyngen)
library(anndata)
library(ggplot2)

backbone_linear()

module_info <- tribble(
    ~module_id, ~basal, ~burn, ~independence,
    "Burn1", 1, TRUE,1,
    "Burn2", 0, TRUE,1,
    "Burn3", 0, TRUE,1,
    "Burn4", 0, TRUE,1,
    "A1", 0,FALSE, 1,
    "A2", 0, FALSE, 1,
    "A3", 0, FALSE, 1,
    "A4", 0, FALSE, 1,
    "A5", 0, FALSE, 1,
    "B1",0, FALSE, 1,
    "B2", 0, FALSE, 1,
    "B3", 0, FALSE, 1,
    "B4", 0, FALSE, 1,
    "C1", 0, FALSE, 1,
    "C2", 0, FALSE, 1,
    "C3", 0, FALSE, 1,
    "C4", 0, FALSE, 1,
    "C5", 0, FALSE, 1,
    "Burn5", 1, TRUE,1,
    "Burn6", 0, TRUE,1,
    "Burn7", 0, TRUE,1,
    "Burn8", 0, TRUE,1,
    "X1", 0, FALSE,1,
    "X2", 0, FALSE,1,
    "X3", 0, FALSE,1,
    "Y1", 0, FALSE,1,
    "Y2", 0, FALSE,1,
    "Y3", 0, FALSE,1,
)

source_module_network <- tribble(
    ~from, ~to, ~effect, ~strength, ~hill,
    "Burn1", "Burn2", 1L, 1, 2,
    "Burn2", "Burn3", 1L, 1, 2,
    "Burn3", "Burn4", 1L, 1, 2,
    "Burn4", "A1", 1L, 1, 2,
    "A1", 'A2', 1L, 1, 2,
    "A2", "A3", 1L, 1, 2,
    "A3", "A4", 1L, 1, 2,
    "A4", "A5", 1L, 1, 2,
    "A5", "B1", 1L, 1, 2,
    "B1", "B2", 1L, 1, 2,
    "B2", "B3", -1L, 1, 2,
    "B3", "B4", -1L, 1, 2,
    "B4", "C1", 1L, 1, 2,
    "B1", "B3", 1L, 1, 2,
    "B2", "B4", 1L, 2, 2,
    "C1", "C2", 1L, 1, 2,
    "C2", "C3", 1L, 1, 2,
    "C3", "C4", 1L, 1, 2,
    "C4", "C5", 1L, 1, 2,
    "C5", "A1", -1L, 10, 2,
    "Burn5", "Burn6", 1L, 1, 2,
    "Burn6", "X1", 1L, 2, 2,
    "X1", 'X2', 1L, 1, 2,
    "X2", "X3", 1L, 1, 2,
    "X3", "B1", 1L, 3, 2,
    "Y1", 'Y2', 1L, 1, 2,
    "Y2", "Y3", 1L, 1, 2,
    "Y3", "C1", -1L, 3, 2,
)

source_expression_patterns <- tribble(
    ~from, ~to, ~module_progression, ~start, ~burn, ~time,
    "sBurn1", "s1", "+Burn1,+Burn2,+Burn3,+Burn4,+A1,+A2,+A3,+A4,+A5,+B1,+B2,+B3,+B4", TRUE, TRUE, 300,
    "s1", "s2", "+C1,+C2,+C3,+C4,+C5,-B1,-B2,-B3,-B4", FALSE, FALSE, 300,
    "s2", "s3", "+B1,+B2,+B3,+B4,-A1,-A2,-A3,-A4,-A5", FALSE, FALSE, 300,
    "s3", "s1", "+A1,+A2,+A3,+A4,+A5,-C1,-C2,-C3,-C4,-C5", FALSE, FALSE, 300,
    #"sBurn2", "ext1", "+Burn5,+Burn6,+Burn7,+X1,+X2,X3", TRUE, TRUE, 300,
)

# Create source model
source_backbone <- backbone(
  module_info = module_info,
  module_network = source_module_network,
  expression_patterns = source_expression_patterns
)

source_config <- initialise_model(
  backbone = source_backbone,
  num_cells = 20000,
  num_tfs = nrow(source_backbone$module_info),
  num_targets = 5,
  num_hks = 5,
  simulation_params = simulation_default(
    experiment_params = simulation_type_wild_type(num_simulations = 40),
    total_time = 500,
    census_interval = 1.,
  ),
  verbose = FALSE
)
pdf("../figures/model_II_source_medium_targets_5.pdf", width=12)
plot_backbone_modulenet(source_config)
dev.off()

print("###\n# START SOURCE\n###")
print("TF NETWORK")
source_model <- generate_tf_network(source_config)

print("FEATURE NETWORK")
source_model <- generate_feature_network(source_model)
# Save feature network
saveRDS(source_model$feature_network, file = "../output/source_feature_network_large_targets_5.rds")

print("GENERATE KINETICS")
source_model <- generate_kinetics(source_model)

print("GOLD STANDARD")
source_model <- generate_gold_standard(source_model)

print("CELLS")
source_model <- generate_cells(source_model)

print("EXPERIMENT")
source_model <- generate_experiment(source_model)
experiment_synchronised(
    source_model,
    realcount="regulatorycircuits_32_lung_epithelium_lung_cancer",
    map_reference_ls=TRUE
)

print("SAVE")
souce_ad <- as_anndata(source_model)
souce_ad$write_h5ad("../output/source_dataset_large_targets_5.h5ad")
souce_ad$write_csvs("../output/source_dataset_large_targets_5.csv")
saveRDS(source_model, file = "../output/source_model_large_targets_5.rds")


#! /usr/bin/Rscript

library("nmecr")
library("bsyncr")
library("rjson")

run_analysis <- function(bsync_filepath, model_type) {
  baseline_scenario_id <- "Scenario-bsyncr"
  bsync_doc <- xml2::read_xml(bsync_filepath) %>%
    bsyncr::bs_stub_scenarios(linked_building_id = "My-Fav-Building", baseline_id = baseline_scenario_id)

  baseline_xpath <- sprintf("//auc:Scenario[@ID = '%s']", baseline_scenario_id)
  sc_baseline <- xml2::xml_find_first(bsync_doc, baseline_xpath)
  not_used <- sc_baseline %>% bsyncr::bs_stub_derived_model(dm_id = "DerivedModel-bsyncr",
                                                            dm_period = "Baseline")

  b_df <- bsyncr::bs_parse_nmecr_df(bsync_doc, insert_weather_data=TRUE)

  if (model_type == "SLR") {
    model <- nmecr::model_with_SLR(b_df,
                                   nmecr::assign_model_inputs(regression_type = "SLR"))
  } else if (model_type == "3PC") {
    model <- nmecr::model_with_CP(b_df,
                                  nmecr::assign_model_inputs(regression_type = "3PC"))
  } else if (model_type == "3PH") {
    model <- nmecr::model_with_CP(b_df,
                                  nmecr::assign_model_inputs(regression_type = "3PH"))
  } else if (model_type == "4P") {
    model <- nmecr::model_with_CP(b_df,
                                  nmecr::assign_model_inputs(regression_type = "4P"))
  } else {
    stop('Invalid model_type')
  }

  # add model to bsync tree
  bs_gen_dm_nmecr(nmecr_baseline_model = model,
                  x = bsync_doc)

  return(list("bsync_doc"=bsync_doc, "model"=model))
}

# setup
args <- commandArgs(trailingOnly=TRUE)
if (length(args) != 3) {
  print('USAGE:')
  print('Rscript bsyncRunner.r bsync_input model_type output_directory')
  print('  bsync_input: path to input file')
  print('  model_type: type of model to fit')
  print('  output_directory: directory to output files')
  stop("Invalid arguments to script. See usage")
}
bsync_filepath <- args[1]
model_type <- args[2]
output_dir <- args[3]
output_xml <- paste(output_dir, "result.xml", sep="/")
output_plot <- paste(output_dir, "plot.png", sep="/")
err_filename <- paste(output_dir, "error.json", sep="/")

NOAA_TOKEN <- Sys.getenv('NOAA_TOKEN')
if (NOAA_TOKEN == "") {
  stop("Missing NOAA token env var: NOAA_TOKEN")
}
options(noaakey=NOAA_TOKEN)

tryCatch({
  # run analysis
  analysis_result <- run_analysis(bsync_filepath, model_type)
  bsync_doc <- analysis_result$bsync_doc
  model <- analysis_result$model

  # save the updated bsync doc
  xml2::write_xml(bsync_doc, output_xml)

  # save the plot
  model_df <- model$training_data %>%
    tidyr::gather(key = "variable", value = "value", c("eload", "model_fit"))

  if (model$model_input_options$regression_type != "SLR") {
    # Add a data point for the derived change point to make sure the line plot looks correct
    temp_change_point <- abs(model$model$psi[2]) # this is the estimated temperature for the change point - taking abs b/c it is incorrectly negative for some models
    predictions <- calculate_model_predictions(
      training_data=model$training_data,
      prediction_data=as.data.frame(list(time=c(2019-01-01), temp=c(temp_change_point))),
      modeled_object=model
    )
    load_change_point <- predictions$predictions[1]
    model_df <- model_df %>% add_row(
      temp=temp_change_point,
      variable="model_fit",
      value=load_change_point)
  }

  ggplot2::ggplot(model_df, aes(x = temp, y = value)) +
    geom_point(aes(color = variable), data=model_df[model_df$variable == "eload",]) +
    geom_line(aes(color = variable), data=model_df[model_df$variable == "model_fit",]) +
    xlab("Temperature") +
    scale_y_continuous(name = "Energy Data & Model Fit (kWh)", labels = scales::comma) +
    theme_minimal() +
    theme(legend.position = "bottom") +
    theme(legend.title = element_blank())

  ggsave(output_plot)
}, error = function(e) {
  print(e)
  err <- list(message=e$message)
  write(rjson::toJSON(err), err_filename)
  quit(status=1)
})


require (scales)
require (ggrepel)
require (scales)

#NOTE THAT IT WON'T PUT THE ACTUAL NAMES OF THE PROTEINS, BUT THEIR ENSEMBLIDs INSTEAD
#IT WON'T PUT IN THE NETWORK EITHER, AS IT WASN'T GENERATED WITH R BUT GEPHI

#GOT IT FROM http://stackoverflow.com/questions/11053899/how-to-get-a-reversed-log10-scale-in-ggplot2
reverselog_trans <- function(base = exp(1)) {
    trans <- function(x) -log(x, base)
    inv <- function(x) base^(-x)
    trans_new(paste0("reverselog-", format(base)), trans, inv,
              log_breaks(base = base),
              domain = c(1e-100, Inf))
}

#THIS CALCULATES THE P VALUES - CHECK THAT SCRIPT IF YOU WANT TO REPEAT THAT ANALYSIS
source ("recalculate_adjusting_neoags.r")

#THIS DOES THE ACTUAL PLOTTING
cor.data <- read.table ("results_adjusting_neoags.txt", sep = "\t", header = TRUE)
cor.data$Label <- ifelse (cor.data$Region %in% c ("ENSP00000299367-PF00092-254-452", "ENSP00000268603-IDR-703-762", "ENSP00000378752-IDR-508-589", "ENSP00000308541-PF00089-364-613", "ENSP00000308938-PF00089-582-803", "ENSP00000228347-PF04560-1043-1128", "ENSP00000237172-IDR-147-255", "ENSP00000407586-PF00009-45-162", "ENSP00000271450-IDR-257-317"), 1, 0)
text.cor.p <- data.frame (x = 0.3, y = 0.0005, label = c ("R > 0.9"))
figure.2 <- ggplot (cor.data, aes (x = domainXplorer, y = AdjNeo)) + geom_point (aes (color = as.factor(Label), size = as.factor (Label))) + geom_vline (xintercept = 0.1, linetype = 2) + geom_hline (yintercept = 0.1, linetype = 2) + geom_smooth (method = "lm", color = "black", size = 0.5) + geom_label_repel (data = subset (cor.data, Label == 1), aes (label = Region)) + theme (legend.position = "none", axis.text = element_text (color = "black"), axis.ticks = element_line (color = "black"), axis.line = element_line (color = "black"), panel.background = element_blank()) + scale_color_manual (values = c ("darkgray", "black")) + scale_size_manual (values = c (1, 2)) + scale_x_continuous (trans=reverselog_trans(10)) + scale_y_continuous (trans=reverselog_trans(10)) + xlab ("\nP domainXplorer") + ylab ("P domainXplorer and neoantigens\n") + geom_text (data = text.cor.p, aes (x = x, y = y, label = label), fontface = "italic", size = 5)

ggsave (file = "Figure_2.pdf", figure.2)


# ------------------------------------------------------------------------------
# Description:  Script to create figures to include in publication of
#               Grassland Connectivity study in Walnut Gulch Experimental
#               Watershed (2018).
# Date:         1/6/21
# Author:       Justin Johnson
# ------------------------------------------------------------------------------
# Install and load packages
pkgs <- c('tidyverse','ggpubr', 'grid')

check <- sapply(pkgs,require,warn.conflicts = TRUE,character.only = TRUE)
if(any(!check)){
  pkgs.missing <- pkgs[!check]
  install.packages(pkgs.missing)
  check <- sapply(pkgs.missing,require,warn.conflicts = TRUE,character.only = TRUE)
}

# ------------------------------------------------------------------------------
# Figure 3 ---------------------------------------------------------------------
# ------------------------------------------------------------------------------

# ------------------------------------------------------------------------------
# Inputs
filename <- "Data/rg47_coarsescale_main.csv"

# ------------------------------------------------------------------------------
# Set col_types for read_csv
col_typesa <- "fcnfff"
col_typesb <- paste(rep("n", 88), collapse = "")
col_typesc <- "l"
col_typesd <- paste(rep("n", 48), collapse = "")
col_types <- paste(col_typesa, col_typesb, col_typesc, col_typesd, sep = "")

# Read in coarse-scale data
coarse <- read_csv(filename, col_type = col_types)

#Start by formatting data, calculating mean and standard error, and adding results from t.tests.
basal_gap <- coarse %>%
  dplyr::select(plot_ID,
         treatment,
         "25-50"= basal_gap_25_50cm.pct,
         "51-100"= basal_gap_51_100cm.pct,
         "101-200"= basal_gap_101_200cm.pct,
         "201-450"= basal_gap_201_450cm.pct) %>%
  rename(Treatment = "treatment") %>%
  mutate(Treatment = fct_rev(Treatment)) %>%
  gather("Variable", "Percent", c(-plot_ID, -Treatment)) %>%
  group_by(Treatment, Variable) %>%
  summarize(mean=mean(Percent),
            standard_error=sd(Percent)/sqrt(length(Percent)),
            low.lim=mean-standard_error,
            high.lim=mean+standard_error)%>%
  add_column(stat_diff=c("a","a","b","b","b","b","a","a"))%>%
  mutate(Variable=fct_relevel(Variable, "25-50","51-100","101-200","201-450"))

#Basal gap figure.
basal_figure <- ggplot(basal_gap, aes(Variable, mean/100, fill=Treatment))+
  geom_col(position=position_dodge())+
  geom_errorbar(aes(ymin=low.lim/100, ymax=high.lim/100), width=.2,
                position=position_dodge(.9),size=1)+
  geom_text(aes(label=stat_diff, y=high.lim/100, vjust=-0.5), position=position_dodge(width=.9), size=8, fontface="bold")+
  theme(
    text = element_text(size=14),
    panel.background = element_blank(),
    plot.title = element_text(face = "bold", size=28),
    plot.subtitle = element_text(size=24),
    axis.text = element_text(size=22),
    axis.title = element_text(face="bold", size=24), #moves y axis title back
    axis.title.y=element_text(angle=90, vjust=2),
    axis.title.x=element_text(vjust=-0.25),
    axis.line = element_line(colour="black", size=1), #add line to bottom and left axis
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(), #removes minor grid lines
    legend.key = element_rect(colour = NA), #removes box surrounding colors in key
    legend.position = "bottom", #puts legend on bottom of plot
    legend.direction = "horizontal", #puts legend horizontal
    legend.key.size= unit(0.75, "cm"), #reduces legend size
    legend.text=element_text(size=24),
    legend.title = element_text(face="italic", size=24), #adds italics to legend title
    plot.margin=unit(c(10,5,5,5),"mm"))+ #increases margins around plot
  labs(x="Basal Gap Class (cm)", y="Proportion of Transects")+
  scale_fill_manual(values = c("Control" = "#fdb462", "Tebuthiuron" = "#386cb0"))+
  scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits=c(0,0.5))

#Export figure
ggsave("Figures/Figure_3.png",
       plot=basal_figure,
       unit="in",
       height=10,
       width=10,
       dpi=300,
       device="png")

# ------------------------------------------------------------------------------
# Figure 4 ---------------------------------------------------------------------
# ------------------------------------------------------------------------------

# ------------------------------------------------------------------------------
# Inputs
filename <- "Data/rg47_finescale_rainfall_time_series.csv"

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

# Brings in small plot time series and formats variables to fit with old code
small_time <- read_csv(filename, col_types = "fffffnfnnnnn")

small_time <- small_time %>%
  rename(Plot = "plot_ID",
         Rate = "target_rainfall_intensity.mmhr",
         Year = "year",
         Site = "site",
         Treatment = "treatment",
         Microsite_Simplified = "microsite",
         plot_time = "time.sec",
         Inf_mmperhr_30sec = "Inf.mmhr",
         Sed_gpers_30sec = "Sed.gsec",
         Sedcon_gL_30sec = "Sed.gL") %>%
  mutate(plot_time = plot_time/60) %>%
  unite(Microsite, Treatment, Microsite_Simplified, remove = FALSE, sep = " - ")

# Create average hydrographs
small.time.means <- small_time %>%
  group_by(Treatment,Microsite_Simplified, Rate, plot_time) %>%
  summarize(mean_Inf = mean(Inf_mmperhr_30sec))

# Formats rates for faceting.
levels(small.time.means$Rate) <- c("paste(bold('64 mm·h'^{-1}))",
                                   "paste(bold('100 mm·h'^{-1}))",
                                   "paste(bold('120 mm·h'^{-1}))")

# Create average sedigraphs
small.time.sed.means <- small_time %>%
  group_by(Treatment,Microsite_Simplified, Rate, plot_time) %>%
  summarize(mean_Sed = mean(Sed_gpers_30sec))

# Formats rates for faceting.
levels(small.time.sed.means$Rate) <- c("paste(bold('64 mm·h'^{-1}))",
                                       "paste(bold('100 mm·h'^{-1}))",
                                       "paste(bold('120 mm·h'^{-1}))")

# Create average sedigraphs
small.time.sedcon.means <- small_time %>%
  group_by(Treatment,Microsite_Simplified, Rate, plot_time) %>%
  summarize(mean_Sed_Con = mean(Sedcon_gL_30sec))

# Formats rates for faceting.
levels(small.time.sedcon.means$Rate) <- c("paste(bold('64 mm·h'^{-1}))",
                                          "paste(bold('100 mm·h'^{-1}))",
                                          "paste(bold('120 mm·h'^{-1}))")

# Create labels for infiltration facets.
inf_text <- data.frame(
  label = c("a", "b", "c"),
  Rate =  factor(c("paste(bold('64 mm·h'^{-1}))",
                   "paste(bold('100 mm·h'^{-1}))",
                   "paste(bold('120 mm·h'^{-1}))"),
                 levels = c("paste(bold('64 mm·h'^{-1}))",
                            "paste(bold('100 mm·h'^{-1}))",
                            "paste(bold('120 mm·h'^{-1}))"))
)

# Create labels for sediment facets.
sed_text <- data.frame(
  label = c("g", "h", "i"),
  Rate =  factor(c("paste(bold('64 mm·h'^{-1}))",
            "paste(bold('100 mm·h'^{-1}))",
            "paste(bold('120 mm·h'^{-1}))"),
            levels = c("paste(bold('64 mm·h'^{-1}))",
                       "paste(bold('100 mm·h'^{-1}))",
                       "paste(bold('120 mm·h'^{-1}))"))
)

# Create labels for sediment concentration facets.
sedcon_text <- data.frame(
  label = c("d", "e", "f"),
  Rate =  factor(c("paste(bold('64 mm·h'^{-1}))",
                   "paste(bold('100 mm·h'^{-1}))",
                   "paste(bold('120 mm·h'^{-1}))"),
                 levels = c("paste(bold('64 mm·h'^{-1}))",
                            "paste(bold('100 mm·h'^{-1}))",
                            "paste(bold('120 mm·h'^{-1}))"))
)

# Create infiltration plots
infiltration <- ggplot()+
  geom_line(data=small.time.means,aes(plot_time, mean_Inf, color=interaction(Treatment, Microsite_Simplified),
                                      linetype=interaction(Treatment, Microsite_Simplified)), size=2)+
  facet_wrap(Rate~.,
             labeller=label_parsed, nrow=3)+
  labs(x="", y=bquote(bold('Infiltration rate (mm·'*h^-1*')')))+
  scale_color_manual(name="Microsite", values= rep(c("#fdb462", "#386cb0","#fdb462", "#386cb0"), times = 2),
                     labels = c("Control - Canopy", "Tebuthiuron - Canopy", "Control - Interspace", "Tebuthiuron - Interspace"))+
  scale_linetype_manual(name="Microsite",values = rep(c(6, 6, 1, 1), times = 2),
                        labels = c("Control - Canopy", "Tebuthiuron - Canopy", "Control - Interspace", "Tebuthiuron - Interspace"))+
  scale_y_continuous(limits=c(0,140),
                     breaks=c(0,25,50,75,100,125)
  )+
  geom_vline(data=filter(small.time.means, Rate=="paste(bold('100 mm·h'^{-1}))"), aes(xintercept=30), color="grey", linetype="dotted", size=1)+
  geom_vline(data=filter(small.time.means, Rate=="paste(bold('120 mm·h'^{-1}))"), aes(xintercept=25), color="grey", linetype="dotted", size=1)+
  geom_text(data=inf_text, aes(x=1,y=135,label=label),
            size=8, fontface="bold")+
  theme_bw(base_size=20)+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(0,4,5,4),"mm"),
        plot.title = element_text(face = "bold", size=28),
        plot.subtitle = element_text(size=24),
        plot.caption = element_text(size=14, face="italic", color="grey50"),
        panel.grid = element_blank(),
        panel.spacing = unit(-4,"mm"),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size =18),
        axis.title = element_text(face="bold", size=22),
        axis.title.y=element_text(angle=90, vjust=2),
        axis.title.x=element_text(vjust=-0.25),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-10,-10,-10,-10),
        legend.key = element_rect(colour = NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom",
        strip.background=element_blank(),
        strip.text = element_text(size=17, vjust=-1))+
  guides(linetype = guide_legend(nrow=2, reverse = TRUE),
         color= guide_legend(nrow=2, reverse = TRUE))

# Create sedigraph.
sedigraph <- ggplot()+
  geom_line(data=small.time.sed.means,aes(plot_time, mean_Sed, color=interaction(Treatment, Microsite_Simplified),
                                          linetype=interaction(Treatment, Microsite_Simplified)), size=2)+
  facet_wrap(Rate~.,
             labeller=label_parsed, nrow=3)+
  labs(x="", y=bquote(bold('Sediment discharge (g·'*s^-1*')')))+
  scale_color_manual(name="Microsite", values= rep(c("#fdb462", "#386cb0","#fdb462", "#386cb0"), times = 2),
                     labels = c("Control - Canopy", "Tebuthiuron - Canopy", "Control - Interspace", "Tebuthiuron - Interspace"))+
  scale_linetype_manual(name="Microsite",values = rep(c(6, 6, 1, 1), times = 2),
                        labels = c("Control - Canopy", "Tebuthiuron - Canopy", "Control - Interspace", "Tebuthiuron - Interspace"))+
  scale_y_continuous(limits=c(0,NA), position = "left")+
  geom_vline(data=filter(small.time.sed.means, Rate=="paste(bold('100 mm·h'^{-1}))"), aes(xintercept=30), color="grey", linetype="dotted", size=1)+
  geom_vline(data=filter(small.time.sed.means, Rate=="paste(bold('120 mm·h'^{-1}))"), aes(xintercept=25), color="grey", linetype="dotted", size=1)+
  geom_text(data=sed_text, aes(x=1,y=0.01125,label=label),
            size=8, fontface="bold")+
  theme_bw(base_size=20)+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(0,4,5,0),"mm"),
        plot.title = element_text(face = "bold", size=28),
        plot.subtitle = element_text(size=24),
        plot.caption = element_text(size=14, face="italic", color="grey50"),
        panel.grid = element_blank(),
        panel.spacing=unit(-4,"mm"),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size=18),
        axis.title = element_text(face="bold", size=22),
        axis.title.y=element_text(angle=90, vjust=2, face="bold"),
        axis.title.x=element_text(vjust=-0.25),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-10,-10,-10,-10),
        legend.key = element_rect(colour = NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom",
        strip.background=element_blank(),
        strip.text = element_text(size=17, vjust=-1))+
  guides(linetype = guide_legend(nrow=2, reverse = TRUE),
         color= guide_legend(nrow=2, reverse = TRUE))

#Create sediment concentration time series figure.
sed_con_figure <- ggplot()+
  geom_line(data=small.time.sedcon.means,aes(plot_time,mean_Sed_Con, color=interaction(Treatment, Microsite_Simplified),
                                             linetype=interaction(Treatment, Microsite_Simplified)), size=2)+
  facet_wrap(Rate~.,
             labeller=label_parsed, nrow=3)+
  labs(x="Simulation duration (min)", y=bquote(bold('Sediment concentration (g·'*L^-1*')')))+
  scale_color_manual(name="Microsite", values= rep(c("#fdb462", "#386cb0","#fdb462", "#386cb0"), times = 2),
                     labels = c("Control - Canopy", "Tebuthiuron - Canopy", "Control - Interspace", "Tebuthiuron - Interspace"))+
  scale_linetype_manual(name="Microsite",values = rep(c(6, 6, 1, 1), times = 2),
                        labels = c("Control - Canopy", "Tebuthiuron - Canopy", "Control - Interspace", "Tebuthiuron - Interspace"))+
  scale_y_continuous(limits=c(0,2))+
  geom_vline(data=filter(small.time.sed.means, Rate=="paste(bold('100 mm·h'^{-1}))"), aes(xintercept=30), color="grey", linetype="dotted", size=1)+
  geom_vline(data=filter(small.time.sed.means, Rate=="paste(bold('120 mm·h'^{-1}))"), aes(xintercept=25), color="grey", linetype="dotted", size=1)+
  theme_bw(base_size=20)+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(0,4,5,4),"mm"),
        plot.title = element_text(face = "bold", size=28),
        plot.subtitle = element_text(size=24),
        plot.caption = element_text(size=14, face="italic", color="grey50"),
        panel.grid = element_blank(),
        panel.spacing=unit(-4,"mm"),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size=18),
        axis.title = element_text(face="bold", size=22),
        axis.title.y=element_text(angle=90, vjust=2, face="bold"),
        axis.title.x=element_text(vjust=-0.25, hjust=1),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-10,-10,-10,-10),
        legend.key = element_rect(colour = NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom",
        strip.background=element_blank(),
        strip.text = element_text(size=17, vjust=-1))+
  geom_text(data=sedcon_text, aes(x=0.75,y=1.85,label=label),
            size=8, fontface="bold")+
  guides(linetype = guide_legend(nrow=2, reverse = TRUE),
         color= guide_legend(nrow=2, reverse = TRUE))

combined <- ggarrange(infiltration, sed_con_figure, sedigraph,
                      nrow=1,
                      common.legend=TRUE,
                      legend="bottom")

#Adds space to bottom of plot, so legend isn't cut off.
combined <- annotate_figure(combined, bottom=text_grob(""))

ggsave("Figures/Figure_4.png",
       plot=combined,
       unit="in",
       height=10,
       width=12,
       dpi=300,
       device="png")

# ------------------------------------------------------------------------------
# Figure 5 ---------------------------------------------------------------------
# ------------------------------------------------------------------------------

#Inputs
filename <- "Data/rg47_finescale_main.csv"

# ------------------------------------------------------------------------------
# Set col_types for read_csv
col_typesa <- "fcnfffc"
col_typesb <- paste(rep("n", 82), collapse = "")
col_types <- paste(col_typesa, col_typesb, sep = "")

# Read in fine-scale data
fine <- read_csv(filename, col_type = col_types)

# ------------------------------------------------------------------------------

#Gather all intensities for cumulative runoff
small_cumro <- gather(fine, key="intensity", value="Runoff_cum.mm",
                      Runoff_cum_64mmhr.mm, Runoff_cum_100mmhr.mm, Runoff_cum_120mmhr.mm)%>%
  dplyr::select(plot_ID, treatment, intensity, microsite, Runoff_cum.mm)%>%
  mutate(intensity=recode_factor(intensity, Runoff_cum_64mmhr.mm ="64 mm/hr",
                                 Runoff_cum_100mmhr.mm ="100 mm/hr",
                                 Runoff_cum_120mmhr.mm ="120 mm/hr"))

#Gather all intensities for cumulative sediment
small_cumsed <- gather(fine, key="intensity", value="Sed_cum.g",
                       Sed_cum_64mmhr.g, Sed_cum_100mmhr.g, Sed_cum_120mmhr.g)%>%
  dplyr::select(plot_ID, intensity, Sed_cum.g)%>%
  mutate(intensity=recode_factor(intensity, Sed_cum_64mmhr.g ="64 mm/hr",
                                 Sed_cum_100mmhr.g ="100 mm/hr",
                                 Sed_cum_120mmhr.g ="120 mm/hr"))

#Join combined datasets
small_all <- full_join(small_cumro, small_cumsed, by=c("plot_ID", "intensity"))

#Create runoff/sediment scatter plot.
runsed <- ggplot(small_all, aes(x=Runoff_cum.mm, y=Sed_cum.g))+
  geom_point(aes(x=Runoff_cum.mm, y=Sed_cum.g, color=interaction(treatment, microsite),
                 shape=interaction(treatment, microsite)), size=4)+
  geom_smooth(method="lm", color="black", size=2)+
  labs(x="Cumulative Runoff (mm)", y="Cumulative Sediment Yield (g)",
       shape = "Microsite")+
  scale_color_manual(name="Microsite", values= rep(c("#fdb462", "#386cb0","#fdb462","#386cb0"), times = 2),
                     labels = c("Control - Interspace", "Tebuthiuron - Interspace","Control - Canopy","Tebuthiuron - Canopy"))+
  scale_shape_manual(name="Microsite",values = rep(c(17,17, 16, 16), times = 2),
                     labels = c("Control - Interspace", "Tebuthiuron - Interspace","Control - Canopy","Tebuthiuron - Canopy"))+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(10,5,5,5),"mm"),
        plot.title = element_text(face = "bold", size=28),
        plot.subtitle = element_text(size=24),
        plot.caption = element_text(size=14, face="italic", color="grey50"),
        panel.grid = element_blank(),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size=20),
        axis.title = element_text(face="bold", size=22),
        axis.title.y=element_text(angle=90, vjust=2),
        axis.title.x=element_text(vjust=1),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-5,-5,-5,-5),
        legend.key = element_rect(fill = NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom")+
  annotate(geom="text", x=1, y=58, label="Sediment = 0.54(Runoff) + 0.34", size=5, fontface="italic", hjust=0)+
  annotate("text", x = 1, y = 53, label = "italic(R ^ 2 == 0.64)", parse=TRUE, size=5, hjust=0)+
  annotate("text", x = 1, y = 48, label = "italic(p < 0.001)", parse=TRUE, size=5, hjust=0)+
  annotate("text", x = 0, y = 68, label = "bold(b)", parse=TRUE, size=8, hjust=0)+
  guides(shape = guide_legend(nrow=4),
         color= guide_legend(nrow=4))

#Create runoff/grass cover scatter plot
grassrun <- ggplot(fine, aes(x=can_grass.pct/100, y=Runoff_cum_120mmhr.mm))+
  geom_point(aes(x=can_grass.pct/100, y=Runoff_cum_120mmhr.mm, color=interaction(treatment, microsite),
                 shape=interaction(treatment, microsite)), size=4)+
  geom_smooth(method="lm", aes(linetype=microsite), color="black", size=2, show.legend=FALSE)+
  labs(x="Grass Foliar Cover", y="Cumulative Runoff (mm)",
       shape = "Microsite")+
  scale_color_manual(name="Microsite", values= rep(c("#fdb462", "#386cb0","#fdb462","#386cb0"), times = 2),
                     labels = c("Control - Interspace", "Tebuthiuron - Interspace","Control - Canopy","Tebuthiuron - Canopy"))+
  scale_shape_manual(name="Microsite",values = rep(c(17,17, 16, 16), times = 2),
                     labels = c("Control - Interspace", "Tebuthiuron - Interspace","Control - Canopy","Tebuthiuron - Canopy"))+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(10,5,5,5),"mm"),
        plot.title = element_text(face = "bold", size=28),
        plot.subtitle = element_text(size=24),
        plot.caption = element_text(size=14, face="italic", color="grey50"),
        panel.grid = element_blank(),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size=20),
        axis.title = element_text(face="bold", size=22),
        axis.title.y=element_text(angle=90, vjust=2),
        axis.title.x=element_text(vjust=1),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-5,-5,-5,-5),
        legend.key = element_rect(fill = NA, color=NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom")+
  annotate(geom="text", x=0.01, y=2, label="Canopy RO = -0.34(Grass) + 36.7", size=5, fontface="italic", hjust=0)+
  annotate(geom="text", x=0.12, y=62, label="Interspace RO = -0.04(Grass) + 48.9", size=5, fontface="italic", hjust=0)+
  annotate("text", x = 0.01, y = 7, label = "italic(R ^ 2 == 0.70)", parse=TRUE, size=5, hjust=0)+
  annotate("text", x = 0.12, y = 58, label = "italic(R ^ 2 == 0.01)", parse=TRUE, size=5, hjust=0)+
  annotate("text", x = 0.73, y = 58, label = "p = 0.60",  fontface="italic", size=5, hjust=0)+
  annotate("text", x = 0.01, y = 12, label = "p < 0.001",  fontface="italic", size=5, hjust=0)+
  scale_x_continuous(labels = scales::percent_format(accuracy = 1))+
  annotate("text", x = 0, y = 60, label = "bold(a)", parse=TRUE, size=8, hjust=0)+
  guides(shape = guide_legend(nrow=4),
         color= guide_legend(nrow=4))

#Combine plots
combined_small <- ggarrange(grassrun, runsed,
                            nrow=2,
                            common.legend=TRUE,
                            legend="bottom")

#Save combined plots
ggsave("Figures/Figure_5.png",
       plot=combined_small,
       unit="in",
       height=12,
       width=6,
       dpi=300,
       device="png")

# ------------------------------------------------------------------------------
# Figure 6 ---------------------------------------------------------------------
# ------------------------------------------------------------------------------

# ------------------------------------------------------------------------------
# Inputs
filename <- "Data/rg47_coarsescale_main.csv"

# ------------------------------------------------------------------------------
# Set col_types for read_csv
col_typesa <- "fcnfff"
col_typesb <- paste(rep("n", 88), collapse = "")
col_typesc <- "l"
col_typesd <- paste(rep("n", 48), collapse = "")
col_types <- paste(col_typesa, col_typesb, col_typesc, col_typesd, sep = "")

# Read in fine-scale data
coarse <- read_csv(filename, col_type = col_types)

# ------------------------------------------------------------------------------

#Create runoff and basal cover scatter plot.
basal_cumro <- ggplot(coarse,aes(x=grd_basal.pct/100, y=Runoff_cum_40Lmin.L, color=treatment))+
  geom_point(size=6)+
  geom_smooth(method="lm", color="black", size=2, show.legend=FALSE)+
  labs(x="Basal Cover",
       y="Cumulative Runoff (L)",
       color = "Treatment")+
  scale_color_manual(limits=c("Control", "Tebuthiuron"),
                     values = c("Control" = "#fdb462", "Tebuthiuron" = "#386cb0"))+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(10,5,5,5),"mm"),
        plot.title = element_text(face = "bold", size=28),
        plot.subtitle = element_text(size=24),
        plot.caption = element_text(size=14, face="italic", color="grey50"),
        panel.grid = element_blank(),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size=22),
        axis.title = element_text(face="bold", size=24),
        axis.title.y=element_text(angle=90, vjust=2),
        axis.title.x=element_text(vjust=1),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-5,-5,-5,-5),
        legend.key = element_rect(fill = NA, color=NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom")+
  annotate(geom="text", x=0.17, y=270, label="Runoff = -4.54(Basal) + 236", size=7, fontface="italic", hjust=1)+
  annotate("text", x = 0.17, y = 258, label = "italic(R ^ 2) == 0.37", parse=TRUE, size=7, hjust=1)+
  annotate("text", x = 0.17, y= 246, label = "p = 0.034", size=7, fontface="italic", hjust=1)+
  scale_x_continuous(labels = scales::percent_format(accuracy = 1))+
  annotate("text", x = 0, y = 300, label = "bold(a)", parse=TRUE, size=12, hjust=0)

#Gather all flow rates for cumulative runoff
rill_cumro <- gather(coarse, key="flow_rate", value = "Runoff_cum.L",
                     Runoff_cum_15Lmin.L,
                     Runoff_cum_30Lmin.L,
                     Runoff_cum_40Lmin.L)%>%
  dplyr::select(plot_ID, treatment, flow_rate, Runoff_cum.L)%>%
  mutate(flow_rate=recode_factor(flow_rate, Runoff_cum_15Lmin.L = "15 L/min",
                                 Runoff_cum_30Lmin.L = "30 L/min",
                                 Runoff_cum_40Lmin.L = "40 L/min"))

#Gather all flow rates for velocities
rill_vel <- gather(coarse, key="flow_rate", value="velo_mean_1_3m.msec",
                   velo_mean_1_3m_15Lmin.msec,
                   velo_mean_1_3m_30Lmin.msec,
                   velo_mean_1_3m_40Lmin.msec)%>%
  dplyr::select(plot_ID, flow_rate, velo_mean_1_3m.msec)%>%
  mutate(flow_rate=recode_factor(flow_rate, velo_mean_1_3m_15Lmin.msec="15 L/min",
                                 velo_mean_1_3m_30Lmin.msec="30 L/min",
                                 velo_mean_1_3m_40Lmin.msec="40 L/min"))

#Gather all flow rates for cumulative sediment
rill_sed <- gather(coarse, key="flow_rate", value="Sed_cum.g",
                   Sed_cum_15Lmin.g,
                   Sed_cum_30Lmin.g,
                   Sed_cum_40Lmin.g)%>%
  dplyr::select(plot_ID, flow_rate, Sed_cum.g)%>%
  mutate(flow_rate=recode_factor(flow_rate, Sed_cum_15Lmin.g="15 L/min",
                                 Sed_cum_30Lmin.g="30 L/min",
                                 Sed_cum_40Lmin.g="40 L/min"))

#Join combined datasets
rill_all <- full_join(rill_cumro, rill_vel, by=c("plot_ID", "flow_rate"))%>%
  full_join(rill_sed, by=c("plot_ID", "flow_rate"))

#Create runoff and velocity scatter plot.
cumro_velo <- ggplot(rill_all, aes(x=Runoff_cum.L, y=velo_mean_1_3m.msec, color=treatment))+
  geom_point(size=6)+
  geom_smooth(method="lm", color="black", size=2, show.legend=FALSE)+
  labs(x="Cumulative Runoff (L)",
       y=bquote(bold("Flow Velocity (m·"*s^-1*")")),
       color = "Treatment")+
  scale_color_manual(limits=c("Control", "Tebuthiuron"),
                     values = c("Control" = "#fdb462", "Tebuthiuron" = "#386cb0"))+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(10,5,5,5),"mm"),
        plot.title = element_text(face = "bold", size=28),
        plot.subtitle = element_text(size=24),
        plot.caption = element_text(size=14, face="italic", color="grey50"),
        panel.grid = element_blank(),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size=22),
        axis.title = element_text(face="bold", size=24),
        axis.title.y=element_text(angle=90, vjust=2),
        axis.title.x=element_text(vjust=1),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-5,-5,-5,-5),
        legend.key = element_rect(fill = NA, color=NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom")+
  annotate(geom="text", x=10, y=0.16, label="Velocity = 0.00035(Runoff) + 0.04", size=7, fontface="italic", hjust=0)+
  annotate("text", x = 10, y = 0.15, label = "italic(R ^ 2) == 0.72", parse=TRUE, size=7, hjust=0)+
  annotate("text", x = 10, y= 0.14, label = "p < 0.001", size=7, fontface="italic", hjust=0)+
  annotate("text", x = 1, y = 0.18, label = "bold(b)", parse=TRUE, size=12, hjust=0)

#Create velocity and sediment scatter plot.
velo_sed <- ggplot(rill_all, aes(x=velo_mean_1_3m.msec, y=Sed_cum.g, color=treatment))+
  geom_point(size=6)+
  geom_smooth(method="lm", color= "black", size=2, show.legend=FALSE)+
  labs(y="Cumulative Sediment (g)",
       x=bquote(bold("Flow Velocity (m·"*s^-1*")")),
       color = "Treatment")+
  scale_color_manual(limits=c("Control", "Tebuthiuron"),
                     values = c("Control" = "#fdb462", "Tebuthiuron" = "#386cb0"))+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(10,5,5,5),"mm"),
        plot.title = element_text(face = "bold", size=28),
        plot.subtitle = element_text(size=24),
        plot.caption = element_text(size=14, face="italic", color="grey50"),
        panel.grid = element_blank(),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size=22),
        axis.title = element_text(face="bold", size=24),
        axis.title.y=element_text(angle=90, vjust=2),
        axis.title.x=element_text(vjust=1),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-5,-5,-5,-5),
        legend.key = element_rect(fill = NA, color=NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom")+
  annotate(geom="text", x=0.04, y=300, label="Sediment = 1802(Velocity) - 81.17", size=7, fontface="italic", hjust=0)+
  annotate("text", x = 0.04, y = 270, label = "italic(R ^ 2) == 0.63", parse=TRUE, size=7, hjust=0)+
  annotate("text", x = 0.04, y= 240, label = "p < 0.001", size=7, fontface="italic", hjust=0)+
  annotate("text", x = 0.036, y = 410, label = "bold(c)", parse=TRUE, size=12, hjust=0)

#Combine plots
combined_rill <- ggarrange(basal_cumro, cumro_velo, velo_sed,
                           nrow=1,
                           common.legend=TRUE,
                           legend="bottom")

#Save combined plots
ggsave("Figures/Figure_6.png",
       plot=combined_rill,
       unit="in",
       height=7,
       width=20,
       dpi=300,
       device="png")

# ------------------------------------------------------------------------------
# Figure 7 ---------------------------------------------------------------------
# ------------------------------------------------------------------------------

# ------------------------------------------------------------------------------
# Inputs
filename <- "Data/rg47_coarsescale_main.csv"

# ------------------------------------------------------------------------------
# Set col_types for read_csv
col_typesa <- "fcnfff"
col_typesb <- paste(rep("n", 88), collapse = "")
col_typesc <- "l"
col_typesd <- paste(rep("n", 48), collapse = "")
col_types <- paste(col_typesa, col_typesb, col_typesc, col_typesd, sep = "")

# Read in fine-scale data
coarse <- read_csv(filename, col_type = col_types)

# ------------------------------------------------------------------------------

#Create runoff and 25-50 basal gap class scatter plot.
gap50_cumro <- ggplot(coarse, aes(x=basal_gap_25_50cm.pct/100, y=Runoff_cum_40Lmin.L, color=treatment))+
  geom_point(size=6)+
  geom_smooth(method="lm", color="black", size=2, show.legend=FALSE)+
  labs(x="% 25-50 cm Basal Gaps",
       y="Cumulative Runoff (L)",
       color = "Treatment")+
  scale_color_manual(limits=c("Control", "Tebuthiuron"),
                     values = c("Control" = "#fdb462", "Tebuthiuron" = "#386cb0"))+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(10,5,5,5),"mm"),
        panel.grid = element_blank(),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size=22),
        axis.title = element_text(face="bold", size=24),
        axis.title.y=element_text(angle=90, vjust=2),
        axis.title.x=element_text(vjust=1),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-5,-5,-5,-5),
        legend.key = element_rect(fill = NA, color=NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom")+
  annotate(geom="text", x=0.2, y=260, label="Runoff = -3.43(% Gaps) + 240", size=7, fontface="italic", hjust=1)+
  annotate("text", x = 0.2, y = 240, label = "italic(R ^ 2) == 0.28", parse=TRUE, size=7, hjust=1)+
  annotate("text", x = 0.02, y = 150, label="p = 0.078", size=7, fontface="italic", hjust=0)+
  scale_x_continuous(labels = scales::percent_format(accuracy = 1))+
  annotate("text", x = 0, y = 300, label = "bold(a)", parse=TRUE, size=12, hjust=0)

#Create runoff and 51-100 cm basal gap class scatter plot.
gap100_cumro <- ggplot(coarse, aes(x=basal_gap_51_100cm.pct/100, y=Runoff_cum_40Lmin.L, color=treatment))+
  geom_point(size=6)+
  geom_smooth(method="lm", color="black", size=2, show.legend=FALSE)+
  labs(x="% 51-100 cm Basal Gaps",
       y="Cumulative Runoff (L)",
       color = "Treatment")+
  scale_color_manual(limits=c("Control", "Tebuthiuron"),
                     values = c("Control" = "#fdb462", "Tebuthiuron" = "#386cb0"))+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(10,5,5,5),"mm"),
        panel.grid = element_blank(),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size=22),
        axis.title = element_text(face="bold", size=24),
        axis.title.y=element_text(angle=90, vjust=2),
        axis.title.x=element_text(vjust=1),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-5,-5,-5,-5),
        legend.key = element_rect(fill = NA, color=NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom")+
  annotate(geom="text", x=0.4, y=270, label="Runoff = -3.35(% Gaps) + 295", size=7, fontface="italic", hjust=1)+
  annotate("text", x = 0.4, y = 250, label = "italic(R ^ 2) == 0.51", parse=TRUE, size=7, hjust=1)+
  annotate("text", x = 0.18, y = 150, label="p = 0.009", size=7, fontface="italic", hjust=0)+
  scale_x_continuous(labels = scales::percent_format(accuracy = 1), limits=c(0.15,0.42), breaks=c(0.2,0.3,0.4))+
  annotate("text", x = 0.15, y = 300, label = "bold(b)", parse=TRUE, size=12, hjust=0)

#Create runoff and 101-200 cm basal gap class scatter plot.
gap200_cumro <- ggplot(coarse, aes(x=basal_gap_101_200cm.pct/100, y=Runoff_cum_40Lmin.L, color=treatment))+
  geom_point(size=6)+
  geom_smooth(method="lm", color="black", size=2, show.legend=FALSE)+
  labs(x="% 101-200 cm Basal Gaps",
       y="Cumulative Runoff (L)",
       color = "Treatment")+
  scale_color_manual(limits=c("Control", "Tebuthiuron"),
                     values = c("Control" = "#fdb462", "Tebuthiuron" = "#386cb0"))+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(10,5,5,5),"mm"),
        panel.grid = element_blank(),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size=22),
        axis.title = element_text(face="bold", size=24),
        axis.title.y=element_text(angle=90, vjust=2),
        axis.title.x=element_text(vjust=1),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-5,-5,-5,-5),
        legend.key = element_rect(fill = NA, color=NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom")+
  annotate(geom="text", x=0, y=265, label="Runoff = 0.82(% Gaps) + 185", size=7, fontface="italic", hjust=0)+
  annotate("text", x = 0, y = 250, label = "italic(R ^ 2) == 0.12", parse=TRUE, size=7, hjust=0)+
  annotate("text", x = 0.55, y = 150, label = "italic(p) == 0.277", parse=TRUE, size=7, hjust=1, fontface="bold")+
  scale_x_continuous(labels = scales::percent_format(accuracy = 1))+
  annotate("text", x = 0, y = 300, label = "bold(c)", parse=TRUE, size=12, hjust=0)

#Create runoff and 201-450 cm basal gap class scatter plot.
gap450_cumro <- ggplot(coarse, aes(x=basal_gap_201_450cm.pct/100, y=Runoff_cum_40Lmin.L, color=treatment))+
  geom_point(size=6)+
  geom_smooth(method="lm", color="black", size=2, show.legend=FALSE)+
  labs(x="% 201-450 cm Basal Gaps",
       y="Cumulative Runoff (L)",
       color = "Tebuthiuron")+
  scale_color_manual(limits=c("Control", "Tebuthiuron"),
                     values = c("Control" = "#fdb462", "Tebuthiuron" = "#386cb0"))+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(10,5,5,5),"mm"),
        panel.grid = element_blank(),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size=22),
        axis.title = element_text(face="bold", size=24),
        axis.title.y=element_text(angle=90, vjust=2),
        axis.title.x=element_text(vjust=1),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-5,-5,-5,-5),
        legend.key = element_rect(fill = NA, color=NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom")+
  annotate(geom="text", x=0, y=275, label="Runoff = 1.68(% Gaps) + 183", size=7, fontface="italic", hjust=0)+
  annotate("text", x = 0, y = 260, label = "italic(R ^ 2) == 0.52", parse=TRUE, size=7, hjust=0)+
  annotate("text", x = 0.35, y = 180, label = "italic(p) == 0.008", parse=TRUE, size=7, hjust=0, fontface="bold")+
  scale_x_continuous(labels = scales::percent_format(accuracy = 1))+
  annotate("text", x = 0, y = 300, label = "bold(d)", parse=TRUE, size=12, hjust=0)

#Combine plots
combined_gaps <- ggarrange(gap50_cumro, gap100_cumro, gap200_cumro, gap450_cumro,
                           nrow=4,
                           common.legend=TRUE,
                           legend="bottom")

#Save combined plots
ggsave("Figures/Figure_7.png",
       plot=combined_gaps,
       unit="in",
       height=20,
       width=7,
       dpi=300,
       device="png")

# ------------------------------------------------------------------------------
# Supplemental Figure 1 --------------------------------------------------------
# ------------------------------------------------------------------------------

# Inputs
filename <- "Data/rg47_finescale_main.csv"

# ------------------------------------------------------------------------------
# Set col_types for read_csv
col_typesa <- "fcnfffc"
col_typesb <- paste(rep("n", 82), collapse = "")
col_types <- paste(col_typesa, col_typesb, sep = "")

# Read in fine-scale data
fine <- read_csv(filename, col_type = col_types)

# ------------------------------------------------------------------------------
fine$wet_2cm.pct
#Gather wetted areas.
wet <- fine %>%
  gather(key="depth.cm", value="Wetted", wet_2cm.pct:wet_20cm.pct) %>%
  mutate(depth.cm=recode_factor(depth.cm, wet_2cm.pct="2",
                                wet_4cm.pct="4",
                                wet_6cm.pct="6",
                                wet_8cm.pct="8",
                                wet_10cm.pct="10",
                                wet_12cm.pct="12",
                                wet_14cm.pct="14",
                                wet_16cm.pct="16",
                                wet_18cm.pct="18",
                                wet_20cm.pct="20"))%>%
  dplyr::select(plot_ID, microsite, treatment, depth.cm, Wetted)

#Gather rock distribution.
rock <- fine %>%
  gather(key="depth.cm", value="Rock", rock_2cm.pct:rock_20cm.pct)%>%
  mutate(depth.cm=recode_factor(depth.cm, rock_2cm.pct="2",
                                rock_4cm.pct="4",
                                rock_6cm.pct="6",
                                rock_8cm.pct="8",
                                rock_10cm.pct="10",
                                rock_12cm.pct="12",
                                rock_14cm.pct="14",
                                rock_16cm.pct="16",
                                rock_18cm.pct="18",
                                rock_20cm.pct="20"))%>%
  dplyr::select(plot_ID, depth.cm, Rock)

#Calculate the percent of soil that was available to be wetted (deal with rocks).
soil_map <- full_join(wet,rock, by=c("plot_ID", "depth.cm"))%>%
  mutate(Wet=Wetted/(100-Rock))

#Create bar chart of soil depth.
soil_pattern <- ggplot(soil_map, aes(fct_rev(depth.cm), Wet, fill=fct_rev(treatment)))+
  geom_bar(position = "dodge", stat = "summary", fun = "mean", width = 0.75)+
  coord_flip()+
  facet_wrap(~rev(microsite))+
  scale_fill_manual(values = c("Control" = "#fdb462", "Tebuthiuron" = "#386cb0"))+
  labs(x="Depth (cm)", y="Proportion of Soil Wetted", fill="Treatment")+
  scale_y_continuous(labels = scales::percent_format(accuracy = 1))+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(10,5,5,5),"mm"),
        panel.grid = element_line(color="lightgray"),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size=20),
        axis.title = element_text(face="bold", size=22),
        axis.title.y=element_text(angle=90, vjust=2),
        axis.title.x=element_text(vjust=1),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-5,-5,-5,-5),
        legend.key = element_rect(fill = NA),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom",
        strip.background=element_blank(),
        strip.text = element_text(size=22))

#Save combined plots
ggsave("Figures/Supplemental_Figure_1.png",
       plot=soil_pattern,
       unit="in",
       height=5,
       width=15,
       dpi=300,
       device="png")

# ------------------------------------------------------------------------------
# Supplemental Figure 2 --------------------------------------------------------
# ------------------------------------------------------------------------------

# Inputs
RHEM_control <- "Scripts/RHEM/Control/Simulation_120mmhr/CONTROL_120MMHR.csv"
RHEM_tebuthiuron <- "Scripts/RHEM/Tebuthiuron/Simulation_120mmhr/TEBUTHIURON_120MMHR.csv"

# ------------------------------------------------------------------------------

#Bring in control RHEM dataset
control <- read_csv(RHEM_control,
                      skip=2,
                      col_types="dddddddddd",
                      col_names=c("Time.min", "Precip.mmhr", "Q.mmhr", "Q.m3s", "Sed.kgs", "6", "7", "8", "9", "10"))%>%
  dplyr::select(-6, -7, -8, -9, -10) %>%
  mutate(Treatment="Control")

#Bring in tebuthiuron RHEM dataset
tebuthiuron<- read_csv(RHEM_tebuthiuron,
                    skip=2,
                    col_types="dddddddddd",
                    col_names=c("Time.min", "Precip.mmhr", "Q.mmhr", "Q.m3s", "Sed.kgs", "6", "7", "8", "9", "10"))%>%
  dplyr::select(-6, -7, -8, -9, -10) %>%
  mutate(Treatment="Tebuthiuron")

#Binds together datasets and filters out storage runoff
RHEM <- bind_rows(control, tebuthiuron)%>%
  filter(Time.min < 45.1)%>%
  mutate(Sed.gs=Sed.kgs*1000)

RHEM_plot <- ggplot(RHEM, aes(x=Time.min, color=Treatment))+
  geom_line(aes(y=Q.mmhr), size=2)+
  geom_line(aes(y=Sed.gs*10), linetype="dashed", size=2)+
  scale_y_continuous(name = bquote(bold('Runoff rate (mm·'*h^-1*')')),
                     sec.axis = sec_axis(~./10, name=bquote(bold('Sediment discharge (g·'*s^-1*')'))))+
  labs(x=bquote(bold("Time (min)")))+
  theme(panel.background = element_blank(),
        plot.margin=unit(c(5,5,5,5),"mm"),
        plot.title = element_text(face = "bold", size=28),
        plot.subtitle = element_text(size=24),
        plot.caption = element_text(size=14, face="italic", color="grey50"),
        panel.grid = element_blank(),
        axis.line = element_line(colour="black", size=1),
        axis.text = element_text(size =22),
        axis.title = element_text(face="bold", size=24),
        axis.title.y=element_text(angle=90, vjust=2),
        axis.title.x=element_text(vjust=-0.25),
        legend.box="vertical",
        legend.direction = "horizontal",
        legend.margin=margin(-10,-10,-10,-10),
        legend.key = element_blank(),
        legend.key.size= unit(1, "cm"),
        legend.text= element_text(size = 16),
        legend.title=element_text(face="italic", size=20),
        legend.position = "bottom",
        strip.background=element_rect(colour="white",fill="white"),
        strip.text = element_text(face="bold", vjust=-0.25, size=20))+
  scale_color_manual(values = c("Tebuthiuron" = "#386cb0", "Control" = "#fdb462"), labels=c("Control", "Tebuthiuron"))

#Save plot
ggsave("Figures/Supplemental_Figure_2.png",
       plot=RHEM_plot,
       unit="in",
       height=6,
       width=9,
       dpi=300,
       device="png")