library(ggplot2)
library(xtable)
library(data.table)

source('../../../functions.r')
## source('../../data/parameters.r')
source('../../../labs.r')
## load('../../generated/data.rdata')

load('../../generated/model/model-data-image.rdata')

spplist  <- fread('../../acap-species-list.csv')
setkey(spplist, code.sra)
spplist <- spplist[base_species == T]
nspp <- nrow(spplist)

## sppdem  <- fread('../../data/species-info/demographic-parameters-processed.csv')
## load('../../../generated//effort-and-captures.rdata', v=F)

## capts <- captures

mcsumm <- readRDS('../../generated/model/mcmc-results-summary.rds')
mcsumm[spplist, common_name := i.cname, on = c('species_code' = 'code.sra')]
mcsumm[, fishery := labs[as.character(fishery_group)]]

setorder(mcsumm, vartype, ind1, ind2)

## * Observed captures

cat('\n* Observed captures\n\n')

pred_vs_obs <- cbind(mcsumm[vartype == 'captures_o'],  obs = CAPTURES_O)

pred_vs_obs[, out := (obs < lcl | obs > ucl)]
cat(sprintf('\n\tNumber of strata with observed value outside 95%% c.i. = %i out of %i strata (%0.2f%%)\n',
            pred_vs_obs[, sum(out)], nrow(pred_vs_obs), 100 * pred_vs_obs[, mean(out)]))

brks <- c(0, c(1, 3) * rep(10^(0:2), each=2))
g <- ggplot(pred_vs_obs, aes(x = obs, y = mean, ymin = lcl, ymax = ucl, colour = out)) +
    geom_errorbar() +
    geom_point(size=2) +
    geom_abline(intercept=0, slope=1) +
    scale_x_continuous(trans = 'log1p', breaks=brks) +
    scale_y_continuous(trans = 'log1p', breaks=brks) +
    scale_colour_discrete(name = NULL) +
    theme_minimal() +
    theme(legend.position=c(0.85, 0.32),
          legend.text = element_text(size = 6),
          legend.key.height = unit(0.4, 'cm'),
          legend.background=element_rect(fill=grey(0.95), colour=NA),
          panel.grid.minor=element_blank()) +
    labs(x = 'Observed number of captures', y = 'Predicted number of captures')
ggsave('../assets/observed-vs-predicted-captures-species.png', width = 7, height = 5)

plot_prior_posterior <- function(mc, mainlab=NULL, sublab=NULL) {
    g <- ggplot(mc) +
        geom_density(aes(x = value, y = ..scaled.., fill = type), size = 0.1, colour = 'black') +
        facet_wrap(~ label, scales = 'free_y') +
        scale_x_continuous(limits = c(0, 1)) +
        scale_fill_manual(name = NULL, values = c(Prior = '#55555555', Posterior = "#238B4599")) +
        labs(x = 'Probability', y = 'Density') +
        theme_minimal() +
        theme(panel.grid.major.y=element_blank(),
              panel.grid.minor.y=element_blank())
    if (!is.null(mainlab)) {
        if (!is.null(sublab)) {
            g <- g + ggtitle(mainlab, sublab)
        } else {
            g <- g + ggtitle(mainlab)
        }
    }
    return(g)
}

## * Probabilities

load('../../generated/model/mcmc-results.rdata', v=F)
nsamples <- max(mcmc$sample)

## ** Posteriors
mc <- mcmc[grep('^p_', variable, perl=T)]
mc <- merge(mc, mc_attributes, by = c('variable'), all.x=T, all.y=F)
mc[, lab1 := sprintf('%s%s', ifelse(is.na(fishery_group), '', as.character(fishery_group)),
                     ifelse(is.na(species_group), '', as.character(species_group)))]
mc[, type := 'Posterior']

## ** Re-create priors from initial parameters
priors <- rbindlist(lapply(unique(mc$variable), function(v) {
        data.table(variable = v, sample = 1:1e5, value = rbeta(1e5, 1, 1))
    }))
priors[, type := 'Prior']

priors[unique(mc[, .(variable, lab1, vartype)]), `:=`(lab1 = i.lab1, vartype = i.vartype), on = 'variable']

mc <- rbind(mc[, .(variable, vartype, lab1, type, sample, value)],
            priors[, .(variable, vartype, lab1, type, sample, value)])
mc[, type := factor(type, levels = c('Prior', 'Posterior'))]

mc[vartype=='p_observable', `:=`(label = 'P(Observable)')]

## ** Plots
g <- plot_prior_posterior(mc)
ggsave('../assets/comparison-with-actual_probabilities.png', width = 9, height = 7)


##CTE534_ClasificacionSupervisada=group
##Imagen=raster
##Vector=vector
##Codigo=field Vector
##Usos=field Vector
##Clasificacion=output raster
#showplots
Salida<-raster::extract(Imagen, Vector, df=TRUE)
Vector$ID<-row.names(Vector)
TablaUsos<-merge(Salida, Vector, x.by="ID", by.y="ID")

#Rasterizar
EntrenamientoRaster <- raster::rasterize(Vector, Imagen[[1]], field=Codigo)

#CoVariables
Covariables <- raster::mask(Imagen, EntrenamientoRaster)

#Training Brick
Trainingbrick <- raster::addLayer(Covariables, EntrenamientoRaster)

#Extraer todos los valores en una matriz
valuetable<- raster::getValues(Trainingbrick)
#Convertir a data frame
valuetable <- as.data.frame(valuetable)
#Eliminar los na
ValueTable  <- na.omit(valuetable)

Levels <- length(unique(Vector[[Codigo]]))

#RANDOM FOREST
library(randomForest)

#valuetable <- read.csv("CSV/ValueTable.csv")
modelRF <- randomForest(x = ValueTable[ ,c(1:(dim(ValueTable)[2] - 1))], y=factor(ValueTable$layer),
                        importance = TRUE, type="classification")

Clasificacion <- raster::predict(Imagen, model = modelRF, na.rm = TRUE)


#Libraries to import
library(ggplot2)
library(reshape2)
library(cowplot)
library(lubridate)

#Read in all data
all <- read.table("all_clusters-eps_0.1.csv",sep=",",header=TRUE)
all.sum <- colSums(all[,7:ncol(all)])
#Normalize by column
all[,7:ncol(all)] <- t(t(all[,7:ncol(all)])/all.sum)
#Read in time points, then set as offset from first sample date
tp.int <- read.table("all_clusters-eps_0.1.csv",sep=",",header=FALSE)[1,7:ncol(all)]
basedate <- date("2000-03-15")
tp <- basedate + as.numeric(tp.int)
#acI-A: main 223, 241, 350,... 200, 348
#acI-B: main 101, 257
#acI-C: main 1, 129, 605
# Compute the proportional abundances
print("acI-A proportion:")
all.acIa <- all[grep(";acI-A;", all$TaxonomicID),]
sum(all.acIa[,7:ncol(all.acIa)])/sum(all[,7:ncol(all)])
max(all.acIa$Abundance)/sum(all.acIa$Abundance)
print("acI-B proportion:")
all.acIb <- all[grep(";acI-B;", all$TaxonomicID),]
sum(all.acIb[,7:ncol(all.acIb)])/sum(all[,7:ncol(all)])
max(all.acIb$Abundance)/sum(all.acIb$Abundance)
print("acI-C proportion:")
all.acIc <- all[grep(";acI-C;", all$TaxonomicID),]
sum(all.acIc[,7:ncol(all.acIc)])/sum(all[,7:ncol(all)])
max(all.acIc$Abundance)/sum(all.acIc$Abundance)

#Filter only the TSC that we want to show
all <- all[all$TimeCluster %in% c(223, 241, 350, 200, 101, 257, 1, 129, 605), ]
#Normalize by row (comment out if you want to see sequences on a more interpretable scale)
for (row in rownames(all)) { all[row, 7:ncol(all)] <- all[row, 7:ncol(all)] / sum(all[row, 7:ncol(all)]) }
#Melt for ggplot2
all.m <- melt(t(all[, 7:ncol(all)]))
df <- data.frame(Time=tp, Abundance=all.m$value, Sequence=all.m$Var2, TSC=as.factor(rep(all$TimeCluster, each=length(tp))))
df$Clade[df$TSC %in% c(223, 241, 350, 200)] <- "acI-A"
df$Clade[df$TSC %in% c(101, 257)] <- "acI-B"
df$Clade[df$TSC %in% c(1, 129, 605)] <- "acI-C"
df$TSC <- paste("TSC", df$TSC)
df$TSC <- factor(df$TSC, levels=c("TSC 223","TSC 241","TSC 350", "TSC 200", "TSC 101","TSC 257","TSC 1","TSC 129","TSC 605"))

#Consistent number of decimal points, for consistency
fmt_dcimals <- function(){
   # return a function responpsible for formatting the
   # axis labels with a given number of decimals
   function(x) sprintf("%.3f", x)
}
ggplot(df, aes(x=Time, y=Abundance, group=Sequence, colour=Clade))+
geom_line(alpha=0.7)+facet_grid(TSC~., scale="free_y")+scale_x_date(date_labels="%Y", date_breaks="1 year")+
ylab("Relative Abundance")+theme(legend.position="top")+
geom_vline(xintercept=as.numeric(date("2000-11-01")+years(0:10)),alpha=0.5, col="yellow")+
geom_vline(xintercept=as.numeric(date("2000-05-01")+years(0:11)),alpha=0.5, col="lightblue")+
scale_y_continuous(labels = fmt_dcimals())

ggsave("MendotaFig2_normal.pdf",height=8,width=7)


"%gcd%" <- function(v, t) {
  while ( (c <- v%%t) != 0 ) {
    v <- t
    t <- c
  }
  t
}


fun sum(v)
    x = length(v)
    g = sub(0,x)
    r = c(0)
    while(g)
        i = sub(x,1)
        t = get(v,i)
        r = add(t,r)
        x = sub(x,1)
        g = add(g,1)
    end
    r = c(r)
end
prog
  v = c(1,2,3)
  r = sum(v)
end


# loading DIFSLIKAx.TXT files
DIFSLIKA <- vector("list", 251)

for (i in 1:100) {
  str_path = paste("Desktop/master/input", i, "/DIFSLIKA.TXT", sep = "")
  temp_data_frame <- read.table(str_path, quote="\"", comment.char="")
  DIFSLIKA[[i]] <- temp_data_frame
}

for (i in 1:151) {
  str_path = paste0("Desktop/new_cluster/input", i, "/DIFSLIKA.TXT")
  temp_data_frame <- read.table(str_path, quote = "\"", comment.char = "")
  DIFSLIKA[[i + 100]] <- temp_data_frame
}

# finding min and max for luminance
max_lum <- DIFSLIKA[[1]]$V3[1]
min_lum <- DIFSLIKA[[1]]$V3[1]
for (i in 1:251) {
  min_cur = min(DIFSLIKA[[i]]$V3)
  max_cur = max(DIFSLIKA[[i]]$V3)
  if (max_cur > max_lum) {
    max_lum <- max_cur
  }
  if (min_cur < min_lum) {
    min_lum <- min_cur
  }
}

# normalizing images
for (i in 1:251) {
  DIFSLIKA[[i]]$V3 <- DIFSLIKA[[i]]$V3 / max_lum
}

# transforming indexes
for (i in 1:251) {
  DIFSLIKA[[i]]$V1 <- (DIFSLIKA[[i]]$V1 + 10000) / 100 + 1
  DIFSLIKA[[i]]$V2 <- (DIFSLIKA[[i]]$V2 + 10000) / 100 + 1
}

# creating matrices
IMG_MAT <- vector("list", 251)

for (i in 1:251) {
  IMG_MAT[[i]] <- matrix(, 201, 201)
  for (j in 1:nrow(DIFSLIKA[[i]])) {
    IMG_MAT[[i]][DIFSLIKA[[i]][j, 1], DIFSLIKA[[i]][j, 2]] <- DIFSLIKA[[i]][j, 3]
  }
}

# checking the correctness of normalization
max_sv <- DIFSLIKA[[1]]$V3[1]
for (i in 1:251) {
  if (max(DIFSLIKA[[i]]$V3) > max_sv) {
    max_sv <- max(DIFSLIKA[[i]]$V3)
  }
}

max(DIFSLIKA[[5]]$V3)

image(IMG_MAT[[1]], useRaster = TRUE, axes = TRUE, col = gray((0:65536)/65536))

# loading INPUT files
PARAM <- vector("list", 100)
for (i in 1:100) {
  str_path = paste("Desktop/master/input", i, "/INPUT.TXT", sep = "")
  res <- readLines(str_path)
  res[0] <- as.double(res[1])
  res[1] <- as.double(res[2])
  PARAM[[i]] <- res
}

for (i in 1:151) {
  str_path = paste("Desktop/new_cluster/input", i, "/INPUT.TXT", sep = "")
  res <- readLines(str_path)
  res[0] <- as.double(res[1])
  res[1] <- as.double(res[2])
  PARAM[[i + 100]] <- res
}

# finding diffraction image with max luminance
max_values_img <- c()
max_value_ind = 1

for (i in 1:100) {
  if (i > 1 && (max(DIFSLIKA[[i]]$V3) > max(max_values_img)))
    max_value_ind = i
  max_values_img <- c(max_values_img, max(DIFSLIKA[[i]]$V3))
}

# writing matrices to files

for (i in 1:251) {
  str_path <- paste("Desktop/image_matrix/SLIKA", i, ".txt", sep = "")
  write.table(IMG_MAT[[i]], file = str_path, row.names = FALSE, col.names = FALSE)
}


library(animation)
library(rasterPlot)
library(gitBasedProjects)

p_rock = 0.3
p_paper = 0.1
p_scissors = 0.6

x = seq(0, 1, 0.01)
p0 = rep(1, length(x))

p = list(Rock = p0, Paper = p0, Scissors = p0)

results = c(1, 3, 1, sample(1:3, 96, TRUE, c(p_rock, p_paper, p_scissors)), 3)
totals = rep(0, 3)

plotAt = c(1, 2, 10, 100)

tPlot = rep(FALSE, length(results))
tPlot[plotAt] = TRUE

cols = c("brown", "cyan", "green")

plotN = 0
newGiff <- function() {
	if (plotN > 0) {
		my_command = paste('C:/"Program Files"/ImageMagick-7.0.8-Q16/convert.exe ', plotDir, '/*.png -delay 20 -loop 2 rps/filtering-', plotN, '.gif', sep = '')
		system(my_command)
	}
	plotN <<- plotN +1
	plotDir <<- paste('rps/bayes_image_', plotN, '/', sep = '')
	makeDir(plotDir)
}
newGiff()

updateResult <- function(res = NaN, n = 0, tPlot = TRUE) {
	if (n < 10)
		np = paste('00', n , sep = '')
	else if (n < 100)
		np = paste('0', n, sep = '')
	else np = n
	png(paste(plotDir, 'p', np, '.png', sep = ''), unit = 'in', res = 200, height = 5, width = 5)
	par(mfrow = c(3,1), mar = c(1, 3, 0, 1), oma = c(2, 0, 1, 0))
	labs = rep('', 3)
	if (!is.na(res)) {
		ps <<- p
		p[[res]] = p[[res]]* seq(0, 1, length.out = length(x))
		p[-res] = lapply(p[-res], function(i) i * seq(1, 0, length.out = length(x)))

		p = lapply(p, function(i) i/max(i))
		p <<- p

		labs[res] = paste(names(p)[res], '!', sep = '')

		totals[res] = totals[res] + 1
		totals <<- totals
	}

	plotDist <- function(p,name, lab, total, col) {
		p = p / max(p)
		prange = range(p) + 0.000001 * c(-1, 0.0)
		plot(x, p, axes = FALSE, ylim = prange, lwd = 2, type = 'n')
		mtext(side = 2, line = 1, name)
		polygon(c(x, rev(x)), c(p, rep(-9E9, length(p))), col = make.transparent(col, 0.6), border = NA)
		lines(x, p, col = col, lwd = 2)
		axis(1, at = seq(0, 1, 0.2), labels = rep('', 6))
		axis(2, at = prange, labels = c('', ''))
		mtext(side = 4, cex = 2, lab)
		mtext(total, side = 3, adj = 0.1, line = -3)
	}

	mapply(plotDist, p, names(p), labs, totals, col = cols)
	axis(1, at = seq(0, 1, 0.2))

	dev.off()
	if (tPlot) newGiff()
	print(n)
	return(p)
}

updateResult()
mapply(updateResult, results, (1:length(results)), tPlot)
 my_command <- 'C:/"Program Files"/ImageMagick-7.0.8-Q16/convert.exe rps/*.png -delay 5 -loop 2 filtering.gif'


context("stat_function")

test_that("uses scale limits, not data limits", {
  dat <- data.frame(x = c(0.1, 1:100))
  dat$y <- dexp(dat$x)

  base <- ggplot(dat, aes(x, y)) +
    stat_function(fun = dexp)

  full <- base +
    scale_x_continuous(limits = c(0.1, 100)) +
    scale_y_continuous()
  ret <- layer_data(full)

  full_log <- base +
    scale_x_log10(limits = c(0.1, 100)) +
    scale_y_continuous()
  ret_log <- layer_data(full_log)

  expect_equal(ret$y[c(1, 101)], ret_log$y[c(1, 101)])
  expect_equal(range(ret$x), c(0.1, 100))
  expect_equal(range(ret_log$x), c(-1, 2))
  expect_false(any(is.na(ret$y)))
  expect_false(any(is.na(ret_log$y)))
})

test_that("works with discrete x", {
  dat <- data.frame(x = c("a", "b"))

  base <- ggplot(dat, aes(x, group = 1)) +
    stat_function(fun = as.numeric, geom = "point", n = 2)
  ret <- layer_data(base)

  expect_equal(ret$x, 1:2)
  expect_equal(ret$y, 1:2)
})


# # Numerical Calculation"s methods class.
# **NOTE** observes that all methods have _VERBOSE_ parameter,
# this parameter can be used to see steps inside loops && another
# infos. Also they have an _VECTOR_ param, wich gives same info as
# Verbose, returning in Data-frame

# rm(list = ls()) # Clear all local variables

# To do ----------------------------------
# [X] 1. Check exibitions inside methods
#    (verbose flag).
# [±] 2. Create & update documentation
# [?] 3. Make plots from differences
# [#] 4. Do report
# [ ] 5. Fix Secant method

# Formating ------------------------------
hline <- function(value = 2){
    cat(sprintf("------------", sep="", 1:value), sep="")
    cat('\n')
}
hfill <- function(n = 1){
    while (n) {
        cat("\n")
        n=n-1
    }
}

# Constants ------------------------------
# Set default tolerance
self.tol = 10^(-15)
# Set default NUMBER of decimal places
self.DECIMAL = 13

# Others methods -------------------------
about <- function(){
    cat("CalcNum.\nVersion: 1.0\n\nCommands:\n")
    cat("VERBOSE=1\tTo see all infos\n")
}

getFuncValue <- function(kwg, ...){
    # Unpacking parameters
    args = list(...)
    func = args$func

    if ("x" %in% names(args)){func = gsub("x", args$x, func)}
    if ("y" %in% names(args)){func = gsub("y", args$y, func)}
    return(eval( parse(text=func) ))
}

# Solutions of Eqs in One Variable -------
minSteps <- function (kwg,...){
    args = list(...)
    n = (log10(args$b-args$a) - log10(args$E)) / log10(2)
    return (ceiling(n))
}

bisection <- function(kwg, ...){
    # Unpacking parameters
    args = list(...)

    # Tolerance
    tol = if ("tol" %in% names(args)) args$tol else self.tol

    # Decimal places
    DECIMAL = if ("DECIMAL" %in% names(args)) args$DECIMAL else self.DECIMAL

    # Function in point
    fa = round(getFuncValue(func=args$func, x=args$a), digits = DECIMAL)
    pi = fp = 0.0

    if ("VERBOSE" %in% names(args) && args["VERBOSE"]==1){
        cat(sprintf("Function: \t%s\nTol:\t\t%.1E\n", args$func,tol))
        hline(6)
        cat(sprintf("i\tan\t\tbn\t\tpn\t\tf(pn)"), sep = '\n')
        hline(6)
    }

    if ("VECTOR" %in% names(args) && args$VECTOR==1)
        m = matrix(ncol=5)

    for (i in 1:args$n0){
        pi = round((args$a+args$b)/2, digits = DECIMAL)
        fp = round(getFuncValue(func=args$func, x=pi, format=0), digits = DECIMAL)

        if ("VERBOSE" %in% names(args) && args["VERBOSE"]==1)
            cat(sprintf("%d\t%.9f\t%.9f\t%.9f\t%.9f", i,args$a,args$b,pi,fp), step='\n')

        if ("VECTOR" %in% names(args) && args$VECTOR==1) {
            m <- rbind(m, round(c(i, args$a, args$b, pi, fp), digits=9) )
            if (i == args$n0) {
                df = data.frame(An=m[2:nrow(m),2],
                                Bn=m[2:nrow(m),3], Pn=m[2:nrow(m),4],
                                F_Pn=m[2:nrow(m),5])
                m = NULL
                return (df)
            }
        }
        if (fp==0 || ((args$b-args$a)/2 < tol)) return(pi)

        if( fa*fp > 0) {
            args$a = pi
            fa = fp
        }
        else args$b = pi

    }
    return('Fail')
}

newtonIteration <- function(kwg, ...) {
    # Unpacking parameters
    args = list(...)

    # Tolerance
    tol = if ("tol" %in% names(args)) args$tol else self.tol

    # Decimal places
    DECIMAL = if ("DECIMAL" %in% names(args)) args$DECIMAL else self.DECIMAL

    if ("VERBOSE" %in% names(args) && args["VERBOSE"]==1){
        cat(sprintf("Function: \t%s\nTol:\t\t%.1E\n", args$func,tol))
        cat(sprintf("Function: \t%s\n", args$funcDeriv))
        hline()
        cat(sprintf("i\tp"), sep = '\n')
        hline()
        cat(sprintf("%d\t%.9f", 0,args$p0), sep = '\n')

    }

    if ("VECTOR" %in% names(args) && args$VECTOR==1) {
        # Matrix
        m = matrix(ncol = 2)
        m <- rbind(m, round(c(0, args$p0), DECIMAL) )
    }

    for (i in 1:args$n0) {
        # Note:     Package deriv not working
        # Error:    Error in deriv.default(a,'x') :
        #               invalid expression in 'FindSubexprs'
        aux = getFuncValue(func=args$func, x=args$p0) / getFuncValue(func=args$funcDeriv, x=args$p0)
        p = args$p0 - aux

        if ("VERBOSE" %in% names(args) && args["VERBOSE"]==1)
            cat(sprintf("%d\t%.9f", i,p), sep = '\n')

        if ("VECTOR" %in% names(args) && args$VECTOR==1) {
            m <- rbind(m, round(c(i, p), DECIMAL) )
            if (i == args$n0) {
                df = data.frame(Pn=m[2:nrow(m),2])
                m = NULL
                return (df)
            }
        }
        if (abs(p - args$p0) < tol) return(p)
        args$p0 = p
    }
    return('Fail')
}

fixedPointIteration <- function(kwg, ...) {
    # Unpacking parameters
    args = list(...)

    # Tolerance
    tol = if ("tol" %in% names(args)) args$tol else self.tol

    # Decimal places
    DECIMAL = if ("DECIMAL" %in% names(args)) args$DECIMAL else self.DECIMAL

    if ("VERBOSE" %in% names(args) && args["VERBOSE"]==1){
        cat(sprintf("Function: \t%s\nTol:\t\t%.1E\n", args$func,tol))
        hline(2)
        cat(sprintf("i\t p"), sep = '\n')
        hline(2)
        cat(sprintf("%d\t %.9f", 0, args$p0), sep = '\n')
    }

    if ("VECTOR" %in% names(args) && args$VECTOR==1){
        m = matrix(ncol=2)
        m <- rbind(m, round(c(1,args$p0),DECIMAL) )
    }

    for (i in 1:args$n0) {
        p = getFuncValue(func=args$func, x=args$p0)

        if ("VECTOR" %in% names(args) && args$VECTOR==1) {
            m <- rbind(m, round(c(i, p), DECIMAL) )
            if ((i == args$n0) || (abs(p - args$p0) < tol)) {
                df = data.frame(Pn=m[2:nrow(m),2])
                m = NULL
                return (df)
            }
        }
        if ("VERBOSE" %in% names(args) && args["VERBOSE"]==1)
            cat(sprintf("%d\t %.9f", i, p), sep='\n')

        if (abs(p - args$p0) < tol) return(p)
        args$p0 = p
    }
    return('Fail')
}

falsePosition <- function(kwg, ...) {
    # Uncompressing list
    args = list(...)

    # Tolerance
    tol = if ("tol" %in% names(args)) args$tol else self.tol

    # Decimal places
    DECIMAL = if ("DECIMAL" %in% names(args)) args$DECIMAL else self.DECIMAL

    if ("VERBOSE" %in% names(args) && args["VERBOSE"]==1){
        cat(sprintf("Function: \t%s\nTol:\t\t%.1E\nN0\t%d", args$func,tol, args$n0), sep = '\n')
        hline(2)
        cat(sprintf("n\tpn"), sep='\n')
        hline(2)
        cat(sprintf("%d\t%.9f",0, args$p0), sep = '\n')
        cat(sprintf("%d\t%.9f",1, args$p1), sep = '\n')
    }

    if ("VECTOR" %in% names(args) && args$VECTOR==1) {
        m = matrix(ncol=2)
        m <- rbind(m, round(c(1, args$p0), DECIMAL) )
        m <- rbind(m, round(c(2, args$p1), DECIMAL) )
    }

    q0 = round(getFuncValue(func=args$func, x=args$p0), DECIMAL)
    q1 = round(getFuncValue(func=args$func, x=args$p1), DECIMAL)

    for (i in seq(from=2, to=args$n0)) {
        p = round(args$p1 - q1*(args$p1 - args$p0)/(q1 - q0), DECIMAL)

        if ("VERBOSE" %in% names(args) && args["VERBOSE"]==1)
            cat(sprintf("%d\t%.9f",i, p), sep = '\n')

        if ("VECTOR" %in% names(args) && args$VECTOR==1) {
            m <- rbind(m, round(c(i+1, p), DECIMAL) )
            if ((i == args$n0) || (abs(p - args$p1) < tol)) {
                df = data.frame(Pn=m[2:nrow(m),2])
                m = NULL
                return (df)
            }
        }

        if (abs(p - args$p1) < tol) return(p)

        q = round(getFuncValue(func=args$func, x=p), DECIMAL)
        if (q*q1 < 0) {
            args$p0 = round(args$p1, DECIMAL)
            q0 = round(q1, DECIMAL)
        }
        args$p1 = p
        q1 = q
    }
    return('Fail')
}

# Differential Equations -----------------
odeEuler <- function(kwg, ...){
    # Unpacking parameters
    args = list(...)

    h = (args$b-args$a)/args$m
    x = args$a
    y = args$y0

    fxy = getFuncValue(func=args$func, x=x,y=y)

    m = matrix(ncol=3)

    if ("VERBOSE" %in% names(args) && args$VERBOSE==1){
        cat("Values from Euler's method\n")
        cat("i \t x \t\t y \t\t fxy\n")
        cat(sprintf("%i\t%.5f\t\t%.5f\t\t%.5f\n", 0,x,y,fxy))
    }
    if ("VECTOR" %in% names(args) && args$VECTOR==1){
        m = matrix(ncol=4)
        m <- rbind(m, round(c(0, x, y, fxy), digits=9) )
    }

    for (i in 1:args$m){
        x = args$a + i * h
        y = y + h * fxy
        fxy = getFuncValue(func=args$func, x=x,y=y)
        if ("VERBOSE" %in% names(args) && args$VERBOSE==1){
            cat(sprintf("%i\t%.5f\t\t%.5f\t\t%.5f\n", i,x,y,fxy))
        }
        if ("VECTOR" %in% names(args) && args$VECTOR==1) {
            m <- rbind(m, round(c(i, x, y, fxy), digits=9) )
            if (i == args$m) {
                df = data.frame(i=m[2:nrow(m),1], x=m[2:nrow(m),2],
                                y=m[2:nrow(m),3], fxy=m[2:nrow(m),4])
                m = NULL
                return (df)
            }
        }
    }
    c(x,y,fxy)
}

odeRK4 <- function(kwg, ...){
    # Unpacking parameters
    args = list(...)

    h = (args$b-args$a)/args$m
    xt = args$a
    yt = args$y0

    if ("VERBOSE" %in% names(args) && args$VERBOSE==1){
        cat("Values from RK4's method\n")
        cat("i \t x \t\t y\n")
        cat(sprintf("0 \t %.5f \t %.5f\n", xt,yt))
    }

    if ("VECTOR" %in% names(args) && args$VECTOR==1){
        m = matrix(ncol=3)
        m <- rbind(m, round(c(0, xt, yt), digits=9) )
    }

    for (i in 1:args$m){
        x = xt
        y = yt
        k1 = getFuncValue(func=args$func, x=x,y=y)

        x = xt + h/2
        y = yt + (h/2)*k1
        k2 = getFuncValue(func=args$func, x=x,y=y)

        y = yt + (h/2)*k2
        k3 = getFuncValue(func=args$func, x=x,y=y)

        x = xt + h
        y = yt + h*k3
        k4 = getFuncValue(func=args$func, x=x,y=y)

        xt = args$a + i*h
        yt = yt + (h/6)*(k1 + 2*(k2 + k3) + k4)

        if ("VERBOSE" %in% names(args) && args$VERBOSE==1){
            cat(sprintf("%i \t %.5f \t %.5f\n",i,xt,yt))
        }
        if ("VECTOR" %in% names(args) && args$VECTOR==1) {
            m <- rbind(m, round(c(i, xt, yt), digits=9) )
            if (i == args$m) {
                df = data.frame(i=m[2:nrow(m),1], xt=m[2:nrow(m),2],
                                yt=m[2:nrow(m),3])
                m = NULL
                return (df)
            }
        }
    }
    c(xt, yt)
}

# Tests and analysis ---------------------
euler <- odeEuler(func='x-2*y+1',a=0,b=1,y0=1,m=10,VECTOR=1)
rk4 <- odeRK4(func='x-2*y+1',a=0,b=1,y0=1,m=10,VECTOR=1)

x <- euler[1:11, 2]
y_exata <- (1/4)*(3*exp(-2*x)+2*x+1) # Função resolvida analiticamente
y_euler <- euler[1:11, 3]
y_rk4   <- rk4[1:11, 3]

DRACULA_ORCHID= "#2d3436"
WET_ASPHALT = "#34495e"
ORANGE_VILLE = "#e17055"
BRIGHT_YARROW = "#fdcb6e"
MINT_LEAF = "#00b894"
PRUNUS_AVIUM = "#e84393"
ELECTRON_BLUE = "#0984e3"
EXODUS_FRUIT = "#6c5ce7"
cor_exata = ELECTRON_BLUE
cor_rk4   = DRACULA_ORCHID
cor_euler = EXODUS_FRUIT

plot(frame = FALSE,
     ylim=c(0.75,1),
     lwd = 1,
     pch = 19,
     x, y_exata,
     xlab = "x",
     ylab = "Y",
     type = "b",
     col = cor_exata,
     main = "Diferença entre RK4, Euler e o valor Exato"
)
lines(x, y_rk4, col=cor_rk4, lwd = 1)
lines(x, y_euler, col=cor_euler, lwd = 1)
grid(lty="solid")#longdash")
legend(
    "topright",
    c("Exata","RK4","Euler"),
    fill = c(cor_exata,cor_rk4,cor_euler)
)

# https://subscription.packtpub.com/book/big_data_and_business_intelligence/9781849513067/4/ch04lvl1sec06/adding-horizontal-and-vertical-grid-lines


#################
## Parameters and functions
#################
source('scripts/error.bar.R')
require(data.table)
require(RColorBrewer)
require(png)

# takes values 0-1 and turns them into colors. takes ColorBrewer pallete as argument.
colramp <- function(x, pal='RdBu', alpha=255){
	cr <- colorRamp(brewer.pal(9, pal))
	i <- !is.na(x)
	cols <- rgb(cr(x[i]), alpha=rep(alpha, sum(i)), maxColorValue=255)
	out <- rep(NA, length(x))
	out[i] <- cols
	return(out)
}

cols <- c('#33a02c', '#1f78b4') # land, ocean
cols2 <- c('#33a02c33', '#1f78b433') # land, ocean partially transparent
cols3 <- c('#b2df8a', '#a6cee3') # land, ocean light
cols4 <- c('#b2df8a55', '#a6cee355') # land, ocean light, partially transparent
cols5 <- c('#ff7f00', '#e31a1c') # orange/red for Te favorable/exposed
cols6 <- c('#ff7f0055', '#e31a1c55') # orange/red for Te favorable/exposed, partially transparent
lw <- 2 # line width

#############################################################################
## Fig. 1
## hottest hours across latitudes, warming of hottest hours across latitudes
#############################################################################

# read in data
lstmaxhrlat <- fread('temp/hadex2txxlat.csv') # uses HadEx2
sstmaxhrlat <- fread('temp/sstmaxhrlat.csv')
lstfutwarmlat <- read.csv('temp/warmingmaxhr_bylat_land.csv', row.names=1) # uses TXx
sstfutwarmlat <- read.csv('temp/warmingmaxhr_bylat_ocean.csv', row.names=1)

# plot marine and Terrestrial comparisons

	quartz(width=5,height=2.5)
	# pdf('figures/fig1.pdf', width=5, height=2.5)
	# png('figures/fig1.png', width=5, height=2.5, units='in', res=300)
	xlims=c(-90, 90)
	par(mfrow=c(1,2), mai=c(0.2, 0.65, 0.2, 0.1), omi = c(0.4,0,0,0), mgp=c(1.6,0.4,0), las=1, tcl=-0.3, cex.axis=0.9)

	# Mean and max hr
	i1 <- complete.cases(lstmaxhrlat)
	i2 <- complete.cases(sstmaxhrlat)
	print(sum(lstmaxhrlat$n[i1])) # land sample size
	print(sum(sstmaxhrlat$n[i2])) # ocean sample size

	plot(0, 0, xlab='', ylab=expression(paste('Temperature (', degree, 'C)')), ylim=c(0,45), xlim=xlims, type='n') # just to set it up

	lstmaxhrlat[i1, polygon(c(lat, rev(lat)), c(mean-sd, rev(mean+sd)), col=cols2[1], border=NA)]
	sstmaxhrlat[i2, polygon(c(lat, rev(lat)), c(mean-sd, rev(mean+sd)), col=cols2[2], border=NA)]
	lstmaxhrlat[i1, lines(lat, mean, col=cols[1], lwd=lw)]
	sstmaxhrlat[i2, lines(lat, mean, col=cols[2], lwd=lw)]

	mtext(side=3, "a", adj=0)
	axis(1, at=seq(-80, 80, by=10), labels=FALSE, tcl=-0.2)
	mtext(side=1, expression(paste('Latitude (', degree, 'N)')), outer=TRUE, cex=1, adj=0.26, line=0.5)

	# Future warming
	i1.1 <- complete.cases(lstfutwarmlat) & lstfutwarmlat$lat < -66.25 # south of southern ocean
	i1.2 <- complete.cases(lstfutwarmlat) & lstfutwarmlat$lat > -52.75 # north of southern ocean
	i2 <- complete.cases(sstfutwarmlat)
	print(sum(lstfutwarmlat$tasmax26n[i1.1|i1.2])) # land sample size
	print(sum(lstfutwarmlat$tasmax85n[i1.1|i1.2])) # land sample size
	print(sum(sstfutwarmlat$tosmax26n[i2])) # ocean sample size
	print(sum(sstfutwarmlat$tosmax85n[i2])) # ocean sample size

	plot(0, 0, xlab='', ylab=expression(paste('Projected warming (', Delta*degree, 'C)')), ylim=c(0,7), xlim=xlims, type='n') # just to set it up
		# rcp85
	with(lstfutwarmlat[i1.1,], polygon(c(lat, rev(lat)), c(tasmax85+tasmax85sd, rev(tasmax85-tasmax85sd)), col=cols2[1], border=NA))
	with(lstfutwarmlat[i1.2,], polygon(c(lat, rev(lat)), c(tasmax85+tasmax85sd, rev(tasmax85-tasmax85sd)), col=cols2[1], border=NA))
	with(sstfutwarmlat[i2,], polygon(c(lat, rev(lat)), c(tosmax85+tosmax85sd, rev(tosmax85-tosmax85sd)), col=cols2[2], border=NA))
	with(lstfutwarmlat[i1.1,], lines(lat, tasmax85, col=cols[1], lwd=lw))
	with(lstfutwarmlat[i1.2,], lines(lat, tasmax85, col=cols[1], lwd=lw))
	with(sstfutwarmlat, lines(lat, tosmax85, col=cols[2], lwd=lw))

		# rcp26
	with(lstfutwarmlat[i1.1,], polygon(c(lat, rev(lat)), c(tasmax26+tasmax26sd, rev(tasmax26-tasmax26sd)), col=cols2[1], border=NA))
	with(lstfutwarmlat[i1.2,], polygon(c(lat, rev(lat)), c(tasmax26+tasmax26sd, rev(tasmax26-tasmax26sd)), col=cols2[1], border=NA))
	with(sstfutwarmlat[i2,], polygon(c(lat, rev(lat)), c(tosmax26+tosmax26sd, rev(tosmax26-tosmax26sd)), col=cols2[2], border=NA))
	with(lstfutwarmlat[i1.1,], lines(lat, tasmax26, col=cols[1], lwd=lw, lty=2))
	with(lstfutwarmlat[i1.2,], lines(lat, tasmax26, col=cols[1], lwd=lw, lty=2))
	with(sstfutwarmlat, lines(lat, tosmax26, col=cols[2], lwd=lw, lty=2))

	legend('topleft', legend=c('RCP 8.5', 'RCP 2.6'), col='black', lty=c(1,2), lwd=1, bty='n', cex=0.7)

	axis(1, at=seq(-80, 80, by=10), labels=FALSE, tcl=-0.2)
	mtext(side=3, "b", adj=0)
	mtext(side=1, expression(paste('Latitude (', degree, 'N)')), outer=TRUE, cex=1, adj=0.88, line=0.5)

	# Legend
	legend(-190,-0.7, legend=c('terrestrial', 'marine'), col=c(cols), lty=c('solid','solid'), lwd=2, bty='n', cex=0.7, xpd=NA) # xpd NA to clip to device region. specify dash/space length with hex codes.

	dev.off()

#############################################################################
## Fig. 2
## (A) Tmax and Thab on land and
## (B) at sea
## (C) Thermal safety margin of marine and terrestrial species
#############################################################################

# read in data
tsmpreds <- fread('temp/warmingtolerance_bylatlon.csv')
tsm <- fread('temp/warmingtolerance_byspecies.csv', stringsAsFactors=TRUE)
tsmpredsfut <- fread('temp/warmingtolerance_bylat_to2100.csv')
fish <- readPNG('data/images/fish-1739110_640.png')
lizard <- readPNG('data/images/lizard-1299577_640.png')

# reorder by lat
setkey(tsm, lat)
setkey(tsmpreds, lat)
setkey(tsmpredsfut, lat)

# adjust clipart colors
lizard[,,1:3] <- aperm(array(col2rgb(cols2[1]), dim=c(3,640,320)), c(2,3,1))/256 # land. Aperm needed since arrays filled by first dimension first.
fish[,,1:3] <- aperm(array(col2rgb(cols2[2]), dim=c(3,414,640)), c(2,3,1))/256 # land. Aperm needed since arrays filled by first dimension first.

# plot

	quartz(width=5, height=6)

	# pdf(width=5, height=6, file='figures/fig2.pdf')
	# png('figures/fig2.png', width=5, height=6, units='in', res=300)
	xlims <- c(-78, 78)
	layout(matrix(c(1,2,3), nrow=3, ncol=1), heights=c(1,70/65,2))
	par(las=1, mai=c(0, 0, 0.2, 2), omi=c(0.5,0.7,0,0), mgp=c(3, 0.7, 0), cex.lab=0.9, cex.axis=0.8, tcl=-0.4, cex.lab=1.5, cex.axis=1.2, bty='L')

	# A: Tmax and body temp Land
		ylimsA <- tsm[Realm=='Terrestrial',range(c(tb_favorableGHCND95, tb_sunGHCND95), na.rm=TRUE)]

		plot(-100, -100, ylim=ylimsA, xlim=xlims, main='', ylab='', xlab='', xaxt='n')
			# Tb in favorable and full sun microclimates
		tsm[Realm=='Terrestrial', points(lat, tb_favorableGHCND95, col=cols6[1], cex=0.7)]
		tsm[Realm=='Terrestrial', points(lat, tb_sunGHCND95, col=cols6[2], cex=0.7)]

				# prediction ribbons
		tsmpreds[Realm=='Terrestrial' & lat<57 & lat>-47, polygon(c(lat, rev(lat)), c(tb_favorableGHCND95-tb_favorableGHCND95se, rev(tb_favorableGHCND95+tb_favorableGHCND95se)), col=cols6[1], border=NA)] # 95% CIs
		tsmpreds[Realm=='Terrestrial' & lat<57 & lat>-47, polygon(c(lat, rev(lat)), c(tb_sunGHCND95-tb_sunGHCND95se, rev(tb_sunGHCND95+tb_sunGHCND95se)), col=cols6[2], border=NA)]

				# prediction lines
		tsmpreds[Realm=='Terrestrial' & lat<57 & lat>-47, lines(lat, tb_favorableGHCND95, col=cols5[1])]
		tsmpreds[Realm=='Terrestrial' & lat<57 & lat>-47, lines(lat, tb_sunGHCND95, col=cols5[2])]

			# Tmax points, ribbons, lines
		tsm[Realm=='Terrestrial', points(lat, tmax.accsum.elev, col=rgb(0,0,0,0.5), cex=0.7)]
		tsmpreds[Realm=='Terrestrial' & lat<57 & lat>-55, polygon(c(lat, rev(lat)), c(tmax-tmaxse, rev(tmax+tmaxse)), col=rgb(0,0,0,0.33), border=NA)]
		tsmpreds[Realm=='Terrestrial' & lat<57 & lat>-55, lines(lat, tmax, col=rgb(0,0,0,1))]

		text(-76,ylimsA[2]-3, 'a', cex=1.5)
		rasterImage(lizard, -70, 49-10, -57, 75-10)

		axis(1, at=seq(-80, 80, by=10), labels=FALSE, tcl=-0.2)
		axis(1, at=c(-50, 0, 50), labels=FALSE, tcl=-0.4)

		leg1 <- c(as.expression(bquote('T'['b,exposed'])), as.expression(bquote('T'['b,protected'])), as.expression(bquote('T'[max]*minute)))
		legend(80,ylimsA[2], bty='n', col=c(cols5[2:1], rgb(0,0,0,1)), pch=1, legend=leg1, border=NA, cex=1, pt.cex=1, y.intersp=1.5, xpd=TRUE)

	# B: Tmax and body temp ocean
		ylimsB <- range(c(tsm[Realm=='Marine',c(tb_favorableGHCND95, tb_sunGHCND95, tmax.accsum.elev)], tsmpreds[Realm=='Marine' & lat<80 & lat>-80, tmax+tmaxse]), na.rm=TRUE)

		plot(-100, -100, ylim=ylimsB, xlim=xlims, main='', ylab='', xlab='', xaxt='n')

			# operative temperatures
				# points
		tsm[Realm=='Marine', points(lat, tb_favorableGHCND95, col=cols6[1], cex=0.7)]
		tsm[Realm=='Marine', points(lat, tb_sunGHCND95, col=cols6[2], cex=0.7)]

				# prediction ribbons
		tsmpreds[Realm=='Marine' & lat<80 & lat>-80, polygon(c(lat, rev(lat)), c(tb_sunGHCND95-tb_sunGHCND95se, rev(tb_sunGHCND95+tb_sunGHCND95se)), col=cols6[2], border=NA)]
		tsmpreds[Realm=='Marine' & lat<80 & lat>-80, polygon(c(lat, rev(lat)), c(tb_favorableGHCND95-tb_favorableGHCND95se, rev(tb_favorableGHCND95+tb_favorableGHCND95se)), col=cols6[1], border=NA)] # 95% CIs

				# prediction lines
		tsmpreds[Realm=='Marine' & lat<80 & lat>-80, lines(lat, tb_sunGHCND95, col=cols5[2])]
		tsmpreds[Realm=='Marine' & lat<80 & lat>-80, lines(lat, tb_favorableGHCND95, col=cols5[1])]

			# Tmax
		tsm[Realm=='Marine' & !is.na(tb_favorableGHCND95),points(lat, tmax.accsum.elev, col=rgb(0,0,0,0.5), cex=0.7)]
		tsmpreds[Realm=='Marine' & lat<80 & lat>-80, polygon(c(lat, rev(lat)), c(tmax-tmaxse, rev(tmax+tmaxse)), col=rgb(0,0,0,0.33), border=NA)] # 95% CIs
		tsmpreds[Realm=='Marine' & lat<80 & lat>-80, lines(lat, tmax, col=rgb(0,0,0,1))]

		text(-76,ylimsB[2]-3, 'b', cex=1.5)
		rasterImage(fish, -70, 63-18*414/640-20, -70+26, 63-20)
		axis(1, at=seq(-80, 80, by=10), labels=FALSE, tcl=-0.2)
		axis(1, at=c(-50, 0, 50), labels=FALSE, tcl=-0.4)

#		leg2 <- c(as.expression(bquote('T'['e,exposed'])), as.expression(bquote('T'['e,favorable'])), as.expression(bquote('T'[max])))
#		legend(80,70, bty='n', col=c(cols5[2:1], rgb(0,0,0,1)), pch=1, legend=leg2, border=NA, cex=1, pt.cex=1, y.intersp=1.5, xpd=TRUE)

	# C: Thermal safety margin
		ylimsC <- range(tsm$tsm_favorableGHCND95, na.rm=TRUE)

		linds1 <- tsm[, Realm=='Terrestrial'] # indices for land (points)
		oinds1 <- tsm[, Realm=='Marine'] # for ocean (points)
		linds2 <- tsmpreds[, Realm=='Terrestrial' & lat > -50 & lat < 60] # indices for land (where data were available) (lines)
		oinds2 <- tsmpreds[, Realm=='Marine' & lat > -80 & lat < 75] # for ocean (where data were available) (lines)

		# set up plot
	tsm[linds1 & animal.type!='amphibian', plot(0, -100, type='n', xlab='', ylab='Thermal safety margin (°C)', ylim=ylimsC, xlim=xlims, log='')]

		# points: solid for Terrestrial (square, triangle), open for marine (circle, cross)
	tsm[linds1 & animal.type!='amphibian', points(lat, tsm_favorableGHCND95, col=cols2[1], pch=15, cex=0.7)] # current TSM in favorable Realms
	tsm[linds1 & animal.type=='amphibian', points(lat, tsm_favorableGHCND95, col=cols2[1], pch=17, cex=0.7)]
	tsm[oinds1 & mobility=='sessile', points(lat, tsm_favorableGHCND95, col=cols2[2], pch=1, cex=0.7)]
	tsm[oinds1 & mobility!='sessile', points(lat, tsm_favorableGHCND95, col=cols2[2], pch=4, cex=0.7)]

		# predictions
		tsmpreds[linds2, polygon(c(lat, rev(lat)), c(tsm_favorableGHCND95-tsm_favorableGHCND95se, rev(tsm_favorableGHCND95+tsm_favorableGHCND95se)), col=cols2[1], border=NA)] # 95% CIs
		tsmpreds[oinds2, polygon(c(lat, rev(lat)), c(tsm_favorableGHCND95-tsm_favorableGHCND95se, rev(tsm_favorableGHCND95+tsm_favorableGHCND95se)), col=cols2[2], border=NA)]

		tsmpreds[linds2, lines(lat, tsm_favorableGHCND95, col=cols[1], lwd=2)] # mean prediction
		tsmpreds[oinds2, lines(lat, tsm_favorableGHCND95, col=cols[2], lwd=2)]

		# 2081-2100
		tsmpredsfut[linds2, polygon(c(lat, rev(lat)), c(tsm_2081_2100_acc_rcp85-tsm_2081_2100_acc_rcp85se, rev(tsm_2081_2100_acc_rcp85+tsm_2081_2100_acc_rcp85se)), col=cols2[1], border=NA)] # 95% CIs
		tsmpredsfut[oinds2, polygon(c(lat, rev(lat)), c(tsm_2081_2100_acc_rcp85-tsm_2081_2100_acc_rcp85se, rev(tsm_2081_2100_acc_rcp85+tsm_2081_2100_acc_rcp85se)), col=cols2[2], border=NA)]

		tsmpredsfut[linds2, lines(lat, tsm_2081_2100_acc_rcp85, col=cols[1], lwd=2, lty=2)] # mean prediction
		tsmpredsfut[oinds2, lines(lat, tsm_2081_2100_acc_rcp85, col=cols[2], lwd=2, lty=2)]

		# legend and subfigure label
		text(-76,ylimsC[2]-0.4, 'c', cex=1.5)

		legend(80,25, bty='n', lty=c('solid', 'solid', '22', NA, NA, NA, NA), lwd=c(2, 2, 2, NA, NA, NA, NA), pch=c(NA, NA, NA, 15, 17, 1, 4), col=c(cols, '#00000080', cols[1], cols[1], cols[2], cols[2]), legend=c('Terrestrial', 'Marine', 'Future', 'Terrestrial non-amphibian', 'Terrestrial amphibian', 'Marine sedentary', 'Marine mobile'), border=NA, cex=1, pt.cex=1, y.intersp=1.2, xpd=TRUE)

	# labels
	mtext('Temperature (°C)', side=2, line=3, las=3, adj=0.8, outer=TRUE)
	mtext('Thermal safety margin\nin favorable microclimates (°C)', side=2, line=2.5, las=3, adj=0.1, outer=TRUE, cex=1)
	mtext('Latitude (°N)', side=1, outer=TRUE, line=2, adj=0.25, cex=0.9)
	axis(1, at=seq(-80, 80, by=10), labels=FALSE, tcl=-0.2)

	dev.off()

# sample sizes
	# part a
tsm[Realm=='Terrestrial' & !is.na(lat) & !is.na(tb_favorableGHCND95), .N] # Tb in protected microclimates on land
tsm[Realm=='Terrestrial' & !is.na(lat) & !is.na(tb_sunGHCND95), .N] # Tb in exposed microclimates on land
tsm[Realm=='Terrestrial' & !is.na(lat) & !is.na(tmax.accsum.elev), .N] # Tmax on land
	# part b
tsm[Realm=='Marine' & !is.na(lat) & !is.na(tb_favorableGHCND95), .N]
tsm[Realm=='Marine' & !is.na(lat) & !is.na(tb_sunGHCND95), .N]
tsm[Realm=='Marine' & !is.na(tb_favorableGHCND95) & !is.na(lat) & !is.na(tmax.accsum.elev), .N]
	# part c
tsm[linds1 & !is.na(lat) & !is.na(tsm_favorableGHCND95), .N]
tsm[oinds1 & !is.na(lat) & !is.na(tsm_favorableGHCND95), .N]

##############
## Fig. S1
## Tmax corrections
##############
dat <- fread('temp/warmingtolerance_byspecies.csv')

# plot
	setkey(dat, thabsum.adj)
	cex1 <- 0.6
	cex2 <- 0.4

	quartz(width=6.5, height=2.5)
	# pdf(width=6.5, height=2.5, file='figures/figS1.pdf')
	# png('figures/figS1.png', width=6.5, height=2.5, units='in', res=300)
	par(mfrow=c(1,3), las=1, mai=c(0.5,0.5,0.2, 0.1), mgp=c(2.5,0.8,0))
	dat[Realm=='Terrestrial',plot(1:.N, tmax_acc, col='grey', cex=cex1, main='', ylab='°C', xlab='Rank order', ylim=c(-10,60))]
	dat[Realm=='Terrestrial', points(1:.N, Tmax, col='blue', cex=cex2)]
	dat[Realm=='Terrestrial', points(1:.N, tmax.accsum.elev, col='purple', cex=cex2)]
	dat[Realm=='Terrestrial',points(1:.N, thabsum.adj, col='black', cex=cex2)]
	mtext(side=3, "a", adj=0)

	legend('bottomright', legend=c('Experimental acclimation temperature', 'Local acclimation temperature', 'Experimental Tmax', "Acclimated Tmax'"), col=c('grey', 'black', 'blue', 'purple'), pch=1, cex=0.6)

	dat[Realm=='Marine',plot(1:.N, tmax_acc, col='grey', cex=cex1, main='', ylab='°C', xlab='Rank order', ylim=c(-5,45))]
	dat[Realm=='Marine', points(1:.N, Tmax, col='blue', cex=cex2)]
	dat[Realm=='Marine', points(1:.N, tmax.accsum.elev, col='purple', cex=cex2)]
	dat[Realm=='Marine',points(1:.N, thabsum.adj, col='black', cex=cex2)]
	mtext(side=3, "b", adj=0)

	plot(-10,-10, xlim=range(dat$tmax.accsum.elev, na.rm=TRUE), ylim=range(dat$tmax.accsumbyspp.elev, na.rm=TRUE), main='', ylab=as.expression(bquote('T'['max, by species']*minute~'(°C)')), xlab=as.expression(bquote('T'[max]*minute~'(°C)')))
	abline(0,1, col='grey')
	dat[,points(tmax.accsum.elev, tmax.accsumbyspp.elev, col='black', cex=cex1)]
	mtext(side=3, "c", adj=0)

	dev.off()

##############
## Fig. S2
## uncertainty in peak locations
## average TSM in latitude bands
##############
preds <- fread('temp/warmingtolerance_bylatlon.csv')
peaks <- list(readRDS('temp/peaks_modTbGHCND95_terr.rds'), readRDS('temp/peaks_modTmax_terr.rds'), readRDS('temp/peaks_modGHCND95_terr.rds'))
TSMbylat <- fread('temp/warmingtolerance_bylatband_land.csv')
	setkey(TSMbylat, latband)

# plotting parameters
# order: tb_favorable terr, tmax terr, tsm terr
rlm <- rep(c('Terrestrial'), 3)
ylims <- list(c(17,32), c(34,48), c(11,22))
xlims <- c(-50, 50)
vars <- list(quote(tb_favorableGHCND95), quote(tmax), quote(tsm_favorableGHCND95))
labs <- c('a', 'b', 'c')
xlabshist <- c('# peaks', '# peaks', '# valleys')
ylabs <- c('Tb (°C)', 'Tmax (°C)', 'TSM (°C)')

	quartz(width=4.8, height=4)
	# pdf(width=5.05, height=4, file='figures/figS2.pdf') # pdf is wider so that x-axis prints fully
	# png('figures/figS2.png', width=4.8, height=4, units='in', res=300)

	layout(matrix(c(1,3,4,6,2,3,5,6,7,9,10,10,8,9,10,10), nrow=4, byrow=TRUE), heights=c(1,5,1,5), widths=c(4,1,4,1))
	par(mai=c(0.5, 0.4, 0.05, 0.1), mgp=c(1.8,0.4,0), tcl=-0.2, las=1, omi=c(0,0,0,0), cex.axis=1, cex.lab=1.3)

	for(i in 1:length(peaks)){
		# top plot
		opar <- par(mai=c(0, 0.4, 0, 0.1)) # have to expand slightly so that x-axis lines up with middle plot
		hist(unlist(peaks[[i]]$peaklocs), breaks=seq(-85,85,by=5), col='grey', main='', xaxt='n', yaxt='n', ylab='', xlim=xlims)
		mtext(side=2, labs[i], adj=3, padj=0, las=1)
		par(opar)

		# middle plot
		with(preds[Realm==rlm[i],], plot(lat, eval(vars[[i]]), type='l', ylim=ylims[[i]], xlim=xlims, bty='l', xlab='Latitude (°N)', ylab=ylabs[i])) # plot the basic prediction for -50 to 50
 		for(j in 1:50) lines(preds[Realm==rlm[i], lat], peaks[[i]]$y[[j]], col=rgb(0,0,0,0.05), lty=1) # plot the uncertainty in lines (a sample)
# 		mtext('°C', line=1.7, side=2, cex=1, las=1, padj=0, outer=FALSE)

		# right plot
		opar <- par(mai=c(0.5, 0, 0.8, 0), cex.lab=1, cex.axis=0.7, mgp=c(1.6, 0.3, 0))
		hist(peaks[[i]]$npeaks, breaks=seq(0.5,4.5,by=1), col='grey', main='', yaxt='n', xlab=xlabshist[i])
		par(opar)
	}

	# TSM averages in latitude bands
	TSMbylat[,plot(latband, mean, type='l', xlab='Latitude (°N)', ylab='TSM (°C)', bty='l')]
	TSMbylat[,arrows(latband, mean-se, latband, mean+se, length=0, angle=90, code=3)]
	mtext(side=2, 'd', adj=3.5, padj=-5, las=1)

	dev.off()

	# sample sizes
	TSMbylat[,sum(n)]

##############
## Fig. S3
## future thermal safety margin (TSM)
## TSM with acclimation
##############

# read in data
wt <- fread('temp/warmingtolerance_bylat_to2100.csv')
tsmpreds <- fread('temp/warmingtolerance_bylatlon.csv')
lstmaxhrfutlat <- fread('temp/lstmaxhrlat_2081-2100.csv')
sstmaxhrfutlat <- fread('temp/sstmaxhrlat_2081-2100.csv')

# set data to plot (where data were available)
	linds <- wt[,Realm=='Terrestrial' & lat > -50 & lat < 50] # indices for land
	oinds <- wt[,Realm=='Marine' & lat > -75 & lat < 75] # for ocean

	linds2 <- tsmpreds[, Realm=='Terrestrial' & lat > -50 & lat < 50] # indices for land (where data were available)
	oinds2 <- tsmpreds[, Realm=='Marine' & lat > -75 & lat < 75] # for ocean (where data were available)

# plot
	lw <- 2 # line width
	xlims <- c(-80, 80)
	ylims <- wt[linds | oinds, range(c(tsm_2081_2100_rcp85-tsm_2081_2100_rcp85se, tsm_2081_2100_acc_rcp26+tsm_2081_2100_acc_rcp26se), na.rm=TRUE)]

	quartz(width=6.5, height=2)
	# pdf(width=6.5, height=2, file='figures/figS3.pdf')
	# png('figures/figS3.png', width=6.5, height=2, units='in', res=300)

	par(mfrow=c(1,3), las=1, mai=c(0.45, 0.45, 0.2, 0.05), omi=c(0,0,0,1), mgp=c(1.8, 0.55, 0), cex.lab=1, cex.axis=0.8, tcl=-0.3)

	# Future temperatues
		i.1 <- complete.cases(lstmaxhrfutlat) & lstmaxhrfutlat$lat < -66.25 # for polygon plotting
		i.2 <- complete.cases(lstmaxhrfutlat) & lstmaxhrfutlat$lat > -52.75 # for polygon plotting
		i2 <- complete.cases(sstmaxhrfutlat)

		plot(0, 0, xlab='Latitude (°N)', ylab='Projected temperature (°C)', ylim=c(0,50), xlim=xlims, type='n') # just to set it up
			# rcp85
		with(lstmaxhrfutlat[i.2,], polygon(c(lat, rev(lat)), c(tasmax85+tasmax85sd, rev(tasmax85-tasmax85sd)), col=cols2[1], border=NA))
		with(sstmaxhrfutlat[i2,], polygon(c(lat, rev(lat)), c(tosmax85+tosmax85sd, rev(tosmax85-tosmax85sd)), col=cols2[2], border=NA))
		with(lstmaxhrfutlat[i.2,], lines(lat, tasmax85, col=cols[1], lwd=1))
		with(sstmaxhrfutlat, lines(lat, tosmax85, col=cols[2], lwd=1))

			#rcp26
		with(lstmaxhrfutlat[i.2,], lines(lat, tasmax26, col=cols[1], lwd=1, lty=2))
		with(sstmaxhrfutlat, lines(lat, tosmax26, col=cols[2], lwd=1, lty=2))

		axis(1, at=seq(-80, 80, by=10), labels=FALSE, tcl=-0.2)
		mtext(side=3, "a", adj=0)

			# sample sizes
		with(lstmaxhrfutlat[i.2,], sum(tasmax85n))
		with(sstmaxhrfutlat, sum(tosmax85n))
		with(lstmaxhrfutlat[i.2,], sum(tasmax26n))
		with(sstmaxhrfutlat, sum(tosmax26n))

	# Future thermal safety margin
	plot(-100, 100, xlim=xlims, ylim=ylims, xlab='Latitude (°N)', ylab='Thermal safety margin (°C)')

		# rcp26
	wt[linds, polygon(c(lat, rev(lat)), c(tsm_2081_2100_rcp26-tsm_2081_2100_rcp26se, rev(tsm_2081_2100_rcp26+tsm_2081_2100_rcp26se)), col=cols4[1], border=NA)] # 95% CIs
	wt[linds, lines(lat, tsm_2081_2100_rcp26, col=cols3[1], lwd=1, lty=2)]

	wt[oinds, polygon(c(lat, rev(lat)), c(tsm_2081_2100_rcp26-tsm_2081_2100_rcp26se, rev(tsm_2081_2100_rcp26+tsm_2081_2100_rcp26se)), col=cols4[2], border=NA)] # 95% CIs
	wt[oinds, lines(lat, tsm_2081_2100_rcp26, col=cols3[2], lwd=1, lty=2)]

		# rcp86
	wt[linds, polygon(c(lat, rev(lat)), c(tsm_2081_2100_rcp85-tsm_2081_2100_rcp85se, rev(tsm_2081_2100_rcp85+tsm_2081_2100_rcp85se)), col=cols2[1], border=NA)] # 95% CIs
	wt[linds, lines(lat, tsm_2081_2100_rcp85, col=cols[1], lwd=1)]

	wt[oinds, polygon(c(lat, rev(lat)), c(tsm_2081_2100_rcp85-tsm_2081_2100_rcp85se, rev(tsm_2081_2100_rcp85+tsm_2081_2100_rcp85se)), col=cols2[2], border=NA)] # 95% CIs
	wt[oinds, lines(lat, tsm_2081_2100_rcp85, col=cols[2], lwd=1)]

	abline(h=0, col='grey', lty=2)
	axis(1, at=seq(-80, 80, by=10), labels=FALSE, tcl=-0.2)
	mtext(side=3, "b", adj=0)

	# Future TSMs with acclimation
	plot(-100, 100, xlim=xlims, ylim=ylims, xlab='Latitude (°N)', ylab='Thermal safety margin (°C)')

		# rcp26
	wt[linds, polygon(c(lat, rev(lat)), c(tsm_2081_2100_acc_rcp26-tsm_2081_2100_acc_rcp26se, rev(tsm_2081_2100_acc_rcp26+tsm_2081_2100_acc_rcp26se)), col=cols4[1], border=NA)] # 95% CIs
	wt[linds, lines(lat, tsm_2081_2100_acc_rcp26, col=cols3[1], lwd=1, lty=2)]

	wt[oinds, polygon(c(lat, rev(lat)), c(tsm_2081_2100_acc_rcp26-tsm_2081_2100_acc_rcp26se, rev(tsm_2081_2100_acc_rcp26+tsm_2081_2100_acc_rcp26se)), col=cols4[2], border=NA)] # 95% CIs
	wt[oinds, lines(lat, tsm_2081_2100_acc_rcp26, col=cols3[2], lwd=1, lty=2)]

		# rcp86
	wt[linds, polygon(c(lat, rev(lat)), c(tsm_2081_2100_acc_rcp85-tsm_2081_2100_acc_rcp85se, rev(tsm_2081_2100_acc_rcp85+tsm_2081_2100_acc_rcp85se)), col=cols2[1], border=NA)] # 95% CIs
	wt[linds, lines(lat, tsm_2081_2100_acc_rcp85, col=cols[1], lwd=1)]

	wt[oinds, polygon(c(lat, rev(lat)), c(tsm_2081_2100_acc_rcp85-tsm_2081_2100_acc_rcp85se, rev(tsm_2081_2100_acc_rcp85+tsm_2081_2100_acc_rcp85se)), col=cols2[2], border=NA)] # 95% CIs
	wt[oinds, lines(lat, tsm_2081_2100_acc_rcp85, col=cols[2], lwd=1)]

	abline(h=0, col='grey', lty=2)
	axis(1, at=seq(-80, 80, by=10), labels=FALSE, tcl=-0.2)
	mtext(side=3, "c", adj=0)

	# legend
	legend(90, 18, legend=c('terrestrial', 'marine', 'RCP 8.5', 'RCP 2.6'), col=c(cols,'black', 'black'), lty=c(1,1,1,2), lwd=c(1,1,1,1), bty='n', cex=1, xpd=NA)

	dev.off()

##############
## Fig. S4
## TSM with annual, monthly, or hourly temperatures
## with 95% or max temperatures
## with or without marine behavioral thermoregulation
## in exposed microclimates
##############

# read in data
tsmpreds <- fread('temp/warmingtolerance_bylatlon.csv')
tsm <- fread('temp/warmingtolerance_byspecies.csv', stringsAsFactors=TRUE) # for calculating lats where we have data
	tsm[Realm=='Terrestrial', range(lat, na.rm=TRUE)]
	tsm[Realm=='Terrestrial' & !is.na(tsm_favorableGHCND95), range(lat, na.rm=TRUE)]
	tsm[Realm=='Terrestrial' & !is.na(tsm_ann), range(lat, na.rm=TRUE)]

# plot
	linds <- tsmpreds[, Realm=='Terrestrial' & lat > -72 & lat < 56] # indices for land (where data were available)
	oinds <- tsmpreds[, Realm=='Marine' & lat > -75 & lat < 75] # for ocean (where data were available)
#	ylimsAB <- tsmpreds[linds | oinds, range(tsm_ann, tsm_sum, tsm_maxmo, tsm_favorable_noacc, na.rm=TRUE)]
	ylimsAB <- c(8,40)
	xlims <- c(-75, 75)

	colsS3 <- colorRampPalette(brewer.pal(9, 'YlOrRd'))(5)[2:5]
	colsS3_2 <- paste(colorRampPalette(brewer.pal(9, 'YlOrRd'))(5), '55', sep='')[2:5]

	quartz(width=4.5, height=5)
	# pdf(width=4.5, height=5, file='figures/figS4.pdf')
	# png('figures/figS4.png', width=4.5, height=5, units='in', res=300)
	par(mfrow=c(2,2), mai=c(0.7,0.3,0.2, 0.1), omi=c(0,0.3,0,0), las=1, mgp=c(2,0.5,0), tcl=-0.3)

	# A) land
		plot(-100, 100, xlim=xlims, ylim=ylimsAB, xlab='Latitude (°N)', ylab='')
		mtext('Thermal safety margin (°C)', side=2, outer=TRUE, adj=0.94, las=3, padj=-0.5, cex=0.8)

		# tsm_favorable maxhr GAMMs
		tsmpreds[linds, polygon(c(lat, rev(lat)), c(tsm_favorable_noacc-tsm_favorable_noaccse, rev(tsm_favorable_noacc+tsm_favorable_noaccse)), col=colsS3_2[1], border=NA)] # 95% CIs
		tsmpreds[linds, lines(lat, tsm_favorable_noacc, col=colsS3[1], lwd=2)] # mean prediction

		# tsm_maxmo GAMMs
		tsmpreds[linds, polygon(c(lat, rev(lat)), c(tsm_maxmo-tsm_maxmose, rev(tsm_maxmo+tsm_maxmose)), col=colsS3_2[2], border=NA)] # 95% CIs
		tsmpreds[linds, lines(lat, tsm_maxmo, col=colsS3[2], lwd=2)] # mean prediction

		# tsm_sum GAMMs
		tsmpreds[linds, polygon(c(lat, rev(lat)), c(tsm_sum-tsm_sumse, rev(tsm_sum+tsm_sumse)), col=colsS3_2[3], border=NA)] # 95% CIs
		tsmpreds[linds, lines(lat, tsm_sum, col=colsS3[3], lwd=2)] # mean prediction

		# tsm_ann GAMMs
		tsmpreds[linds, polygon(c(lat, rev(lat)), c(tsm_ann-tsm_annse, rev(tsm_ann+tsm_annse)), col=colsS3_2[4], border=NA)] # 95% CIs
		tsmpreds[linds, lines(lat, tsm_ann, col=colsS3[4], lwd=2)] # mean prediction

		mtext(side=3, "a", adj=0)
		axis(1, at=seq(-80, 80, by=10), labels=FALSE, tcl=-0.2)
		legend('top', legend=c('Average Year', 'Warmest Season', 'Warmest Month', 'Warmest Hour'), col=rev(colsS3_2), pch=15, lwd=1, border=NA, cex=0.5, bty='n', title='Terrestrial', title.col=cols[1])

	# B) ocean
		plot(-100, 100, xlim=xlims, ylim=ylimsAB, xlab='Latitude (°N)', ylab='')

		# tsm_favorable hour GAMMs
		tsmpreds[oinds, polygon(c(lat, rev(lat)), c(tsm_favorable_noacc-tsm_favorable_noaccse, rev(tsm_favorable_noacc+tsm_favorable_noaccse)), col=colsS3_2[1], border=NA)] # 95% CIs
		tsmpreds[oinds, lines(lat, tsm_favorable_noacc, col=colsS3[1], lwd=2)] # mean prediction

		# tsm_maxmo GAMMs
		tsmpreds[oinds, polygon(c(lat, rev(lat)), c(tsm_maxmo-tsm_maxmose, rev(tsm_maxmo+tsm_maxmose)), col=colsS3_2[2], border=NA)] # 95% CIs
		tsmpreds[oinds, lines(lat, tsm_maxmo, col=colsS3[2], lwd=2)] # mean prediction

		# tsm_sum GAMMs
		tsmpreds[oinds, polygon(c(lat, rev(lat)), c(tsm_sum-tsm_sumse, rev(tsm_sum+tsm_sumse)), col=colsS3_2[3], border=NA)] # 95% CIs
		tsmpreds[oinds, lines(lat, tsm_sum, col=colsS3[3], lwd=2)] # mean prediction

		# tsm_ann GAMMs
		tsmpreds[oinds, polygon(c(lat, rev(lat)), c(tsm_ann-tsm_annse, rev(tsm_ann+tsm_annse)), col=colsS3_2[4], border=NA)] # 95% CIs
		tsmpreds[oinds, lines(lat, tsm_ann, col=colsS3[4], lwd=2)] # mean prediction

		mtext(side=3, "b", adj=0)
		axis(1, at=seq(-80, 80, by=10), labels=FALSE, tcl=-0.2)

	legend('topleft', legend=c('Average Year', 'Warmest Season', 'Warmest Month', 'Warmest Hour'), col=rev(colsS3_2), pch=15, lwd=1, border=NA, cex=0.5, bty='n', title='Marine', title.col=cols[2])

	# C) Marine TSM with and without behavioral thermoregulation (no need to worry about GHCND since doesn't affect ocean)
		ylimsC <- c(7,22)

		oinds2 <- tsmpreds[, Realm=='Marine'] # for ocean (where data were available)

		plot(-100, -100, type='n', xlab='', ylab='', ylim=ylimsC, xlim=xlims) # set up plot
		mtext('Thermal safety margin (°C)', side=2, outer=TRUE, adj=0.2, las=3, padj=-0.5, cex=0.8)

		# Behavioral thermoregulation
		tsmpreds[oinds2, polygon(c(lat, rev(lat)), c(tsm_favorableGHCND95-tsm_favorableGHCND95se, rev(tsm_favorableGHCND95+tsm_favorableGHCND95se)), col=cols2[2], border=NA)]
		tsmpreds[oinds2, lines(lat, tsm_favorableGHCND95, col=cols[2], lwd=2)]

		# No behavioral thermoregulation (doesn't matter if this uses GHCND or not... plot here is for marine)
		tsmpreds[oinds2, polygon(c(lat, rev(lat)), c(tsm_favorableGHCND95_nomarineBT-tsm_favorableGHCND95_nomarineBTse, rev(tsm_favorableGHCND95_nomarineBT+tsm_favorableGHCND95_nomarineBTse)), col=cols2[2], border=NA)]
		tsmpreds[oinds2, lines(lat, tsm_favorableGHCND95_nomarineBT, col=cols[2], lwd=2, lty=2)]

		mtext(side=3, "c", adj=0)
		legend('topleft', bty='n', lty=c('solid', '22'), lwd=c(1, 1), col=c(cols[2]), legend=c('Thermoregulation', 'No thermoregulation'), border=NA, cex=0.5, pt.cex=1, y.intersp=1.2)

	# D) Terrestrial TSM in exposed habitats or favorable habitats
		ylimsC <- c(-15,20)

		linds2 <- tsmpreds[, Realm=='Terrestrial' & lat > -50 & lat < 50] # indices for land (where data were available)

		plot(-100, -100, type='n', xlab='', ylab='', ylim=ylimsC, xlim=xlims) # set up plot

		# favorable
		tsmpreds[linds2, polygon(c(lat, rev(lat)), c(tsm_favorableGHCND95-tsm_favorableGHCND95se, rev(tsm_favorableGHCND95+tsm_favorableGHCND95se)), col=cols2[1], border=NA)] # 95% CIs
		tsmpreds[linds2, lines(lat, tsm_favorableGHCND95, col=cols[1], lwd=2)] # mean prediction

		# exposed
		tsmpreds[linds2, polygon(c(lat, rev(lat)), c(tsm_exposedGHCND95-tsm_exposedGHCND95se, rev(tsm_exposedGHCND95+tsm_exposedGHCND95se)), col=cols2[1], border=NA)] # 95% CIs
		tsmpreds[linds2, lines(lat, tsm_exposedGHCND95, col=cols[1], lwd=2, lty=2)] # mean prediction

		abline(h=0, lty=2, col='grey')

		mtext(side=3, "d", adj=0)
		legend(20,12, bty='n', lty=c('solid', '22'), lwd=c(1, 1), col=cols[1], legend=c('Shade', 'Full sun'), border=NA, cex=0.5, pt.cex=1, y.intersp=1.2)

	dev.off()

################
## Fig. S5
## Topt vs. Tmax
################
microbe_data <- read.csv("data/topt_tmax/Chen_2015_fbv009supp.csv")
insect_data <- read.csv("data/topt_tmax/Deutsch_thermal_curves.csv")
lizard_data <- read.csv("data/topt_tmax/Huey_2009_supp_data.csv")
alldata <- data.frame(topt=c(microbe_data$t_opt, insect_data$Topt, lizard_data$newTopt),
                    tmax=c(microbe_data$t_max, insect_data$CTmax, lizard_data$CTmax),
                    group=c(rep("microbes", nrow(microbe_data)), rep("insects", nrow(insect_data)), rep("lizards", nrow(lizard_data))))
	sum(!is.na(alldata$topt) & !is.na(alldata$tmax))

preds <- read.csv('temp/topt_tmax_fit.csv')

# plot with model
	quartz(height=4, width=4)
	# pdf(height=4, width=4, file='figures/figS5.pdf')
	# png('figures/figS5.png', width=4, height=4, units='in', res=300)

	par(mai=c(1,1,0.1, 0.1), las=1)
	plot(tmax ~ topt, data=alldata, col='#00000055', xlab=as.expression(bquote('T'['opt'])), ylab=as.expression(bquote('T'['max'])))
	abline(0,1, col='grey', lty=2)

	with(preds, polygon(c(topt, rev(topt)), c(tmax-tmax.se, rev(tmax+tmax.se)), col='#00000055', border=NA))
	with(preds, lines(topt, tmax, col='#000000'))

	dev.off()

###########################
# Table S1
# data by Class
###########################
dat <- fread('temp/warmingtolerance_byspecies.csv', stringsAsFactors=TRUE)

tab <- as.data.frame.matrix(table(dat$Class, dat$Realm))
tab$Class <- row.names(tab)

tab <- merge(tab, unique(dat[,.(Phylum, Class)])) # add Phylum

sum(tab$Marine) # 88
sum(tab$Terrestrial) # 318

# reformat
#tab <- tab[order(tab$Phylum, tab$Class) ,c('Phylum', 'Class', 'Terrestrial', 'Marine')]
tab1 <- tab[tab$Terrestrial>0, c('Phylum', 'Class', 'Terrestrial')]
tab2 <- tab[tab$Marine>0, c('Phylum', 'Class', 'Marine')]
names(tab1)[3] <- 'Species with Tmax'
names(tab2)[3] <- 'Species with Tmax'
tab1$Realm <- 'Terrestrial'
tab2$Realm <- 'Marine'
tab1 <- tab1[order(tab1$Phylum, tab1$Class), ]
tab2 <- tab2[order(tab2$Phylum, tab2$Class), ]

out <- rbind(tab1, tab2)
out <- out[,c('Realm', 'Phylum', 'Class', 'Species with Tmax')]

#examine
out

# write out
write.csv(out, file='tables/TableS1.csv', row.names=FALSE)

###########################
# Supplementary Dataset 1
# Tmax data
###########################
dat <- fread('temp/warmingtolerance_byspecies.csv', stringsAsFactors=TRUE)

out <- dat[, .(Genus, Species, Realm, lat, lon, altitude, Tmax, tmax_metric, tmax_acc, citation, Phylum, Class, Order, Family, demers_pelag, mobility, length, weight)]

setkey(out, Realm, Genus, Species, citation)

out

write.csv(out, quote=FALSE, na='', file='tables/datasetS1.csv', row.names=FALSE)

###########################
# Supplementary Dataset 2
# Extirpation
###########################
dat <- fread('temp/warmingtolerance_byspecies.csv', stringsAsFactors=TRUE)

out <- dat[, .(Genus, Species, Realm, lat, lon, altitude, Tmax, tmax_metric, tmax_acc, citation, Phylum, Class, Order, Family, demers_pelag, mobility, length, weight)]

setkey(out, Realm, Genus, Species, citation)

out

write.csv(out, quote=FALSE, na='', file='tables/datasetS1.csv', row.names=FALSE)


# Author: Nikos Kougianos
# Date: 18/12/2020

# Use these 2 lines to set working directory as the current directory of the
# file. Tested on Rstudio @ Windows 10 OS.
this.dir <- dirname(parent.frame(2)$ofile)
setwd(this.dir);

# Read data
data <- read.table("data.csv", sep=",",header=TRUE)

# Create dataframe with 2 columns instead of 4
df <- data.frame('Plant_Height'=c(data$Plant.Height,data$Plant.Height.1), 'Geo_Position'=c(data$Geo.Position,data$Geo.Position.1))

# Create plot parameters
geoPosition <- df[,'Geo_Position']
plantHeight <- df[,'Plant_Height']

# Create plot
plot(geoPosition, plantHeight,
     main = "Plot of plant heights separated by geo_position" ,
     xlab="Plant Geo Position",
     ylab="Plant Height"
     )

# Add extra space for legend
par(mar=c(5.1, 4.1, 4.1, 10.1))

# Add legend
legend("topright", inset=c(-0.6,0), legend=c("1.0 = North Greece","2.0 = South Greece"), pch=c(1,1), title="Geo Position Legend")


# Install packages and define libraries for use

install.packages("car", "DataExplorer", "dataMaid", "dataReporter", "dplyr", "fBasics", "forcats", "ggplot2","ggpubr", "knitr","MASS","nortest","outliers","pgirmess", "PCMCR","PCMCRplus","psych","purrr","readr","rmarkdown","statmod",'stringr',"tibble","tidyr","tidyverse","timeDate","timeSeries")
library(car)
library(DataExplorer)
library(dataMaid)
library(dataReporter)
library(dplyr)
library(fBasics)
library(forcats)
library(ggplot2)
library(ggpubr)
library(knitr)
library(MASS)
library(nortest)
library(outliers)
library(pgirmess)
library(PCMCR)
library(PCMCRplus)
library(psych)
library(purrr)
library(readr)
library(rmarkdown)
library(statmod)
library(stringr)
library(tibble)
library(tidyr)
library(tidyverse)
library(timeDate)
library(timeSeries)

# set the working directory and create the base data frames

swd("C:\\Users\\trdun\\OneDrive\\Documents\\WGU_Capstone")

# Full two year dataset
dfull <- read_csv("full_set.csv")
dfull_t2q <- dfull[order(dfull$T2Q), ]
dfull_t2d <- dfull[order(dfull$T2Disp), ]
dfull_pt <- dfull[order(dfull$ProcTime), ]

df19 <- read_csv("full_set_2019.csv")
df19_t2q <- df19[order(df19$T2Q), ]
df19_t2d <- df19[order(df19$T2Disp), ]
df19_pt <- df19[order(df19$ProcTime), ]

df20 <- read_csv("full_set_2020.csv")
df20_t2q <- df20[order(df20$T2Q), ]
df20_t2d <- df20[order(df20$T2Disp), ]
df20_pt <- df20[order(df20$ProcTime), ]

# Use DataExplorer to do a quick EDA for the datasets
create_report(dfull)
create_report(df19)
create_report(df20)

# Longer intoductory univariate analysis
summary(dfull)
summary(df19)
summary(df20)

dim(dfull)
dim(df19)
dim(df20)

str(dfull)
str(df19)
str(df20)

introduce(dfull)
introduce(df19)
introduce(df20)

describe(dfull)
describe(df19)
describe(df20)

ls(dfull)
ls(df19)
ls(df20)

head(dfull)
head(df19)
head(df20)

tail(dfull)
tail(df19)
tail(df20)

makeDataReport(dfull)
makeDataReport(df19)
makeDataReport(df20)

# Check for the number of rows where the processing time in question is less than 0
sum(dfull$T2Q < 0, na.rm=TRUE)
sum(dfull$T2Disp < 0, na.rm = TRUE)
sum(dfull$ProcTime < 0, na.rm=TRUE)
sum(dfull$T2Q < 0 & dfull$T2Disp < 0, na.rm=TRUE)
sum(dfull$T2Q < 0 & dfull$ProcTime < 0, na.rm=TRUE)
sum(dfull$ProcTime < 0 & dfull$T2Disp < 0, na.rm=TRUE)

# Outlier detection and identification

fullT2Q_lb <- quantile(dfull$T2Q, 0.01)
fullT2Q_ub <- quantile(dfull$T2Q, 0.99)
fullT2Q_outTest <- grubbs.test(dfull$T2Q)
fullT2Q_lb
fullT2Q_ub
fullT2Q_outTest

fullT2D_lb <- quantile(dfull$T2Disp, 0.01)
fullT2D_ub <- quantile(dfull$T2Disp, 0.99)
fullT2D_outTest <- grubbs.test(dfull$T2Disp)
fullT2D_lb
fullT2D_ub
fullT2D_outTest

fullPT_lb <- quantile(dfull$ProcTime, 0.01)
fullPT_ub <- quantile(dfull$ProcTime, 0.99)
fullPT_outTest <- grubbs.test(dfull$ProcTime)
fullPT_lb
fullPT_ub
fullPT_outTest

f19T2Q_lb <- quantile(df19$T2Q, 0.01)
f19T2Q_ub <- quantile(df19$T2Q, 0.99)
f19T2Q_outTest <- grubbs.test(df19$T2Q)
f19T2Q_lb
f19T2Q_ub
f19T2Q_outTest

f19T2D_lb <- quantile(df19$T2Disp, 0.01)
f19T2D_ub <- quantile(df19$T2Disp, 0.99)
f19T2D_outTest <- grubbs.test(df19$T2Disp)
f19T2D_lb
f19T2D_ub
f19T2D_outTest

f19PT_lb <- quantile(df19$ProcTime, 0.01)
f19PT_ub <- quantile(df19$ProcTime, 0.99)
f19PT_outTest <- grubbs.test(df19$ProcTime)
f19PT_lb
f19PT_ub
f19PT_outTest

f20T2Q_lb <- quantile(df20$T2Q, 0.01)
f20T2Q_ub <- quantile((df20$T2Q, 0.99)
f20T2Q_outTest <- grubbs.test((df20$T2Q)
f20T2Q_lb
f20T2Q_ub
f20T2Q_outTest

f20T2D_lb <- quantile((df20$T2Disp, 0.01)
f20T2D_ub <- quantile((df20$T2Disp, 0.99)
f20T2D_outTest <- grubbs.test((df20$T2Disp)
f20T2D_lb
f20T2D_ub
f20T2D_outTest

f20PT_lb <- quantile((df20$ProcTime, 0.01)
f20PT_ub <- quantile((df20$ProcTime, 0.99)
f20PT_outTest <- grubbs.test((df20$ProcTime)
f20PT_lb
f20PT_ub
f20PT_outTest

# Remove na and rows where processing times are less than 0
dfull <- na.omit(dfull)
df19 <- na.omit(df19)
df20 <- na.omit(df20)

dfull <- dfull[!dfull$T2Q<0, ]
dfull <- dfull[!dfull$T2Disp<0, ]

df19 <- df19[!df19$T2Q<0, ]
df19 <- df19[!df19$T2Disp<0, ]

df20 <- df20[!df20$T2Q<0, ]
df20 <- df20[!df20$T2Disp<0, ]

# normality tests
# Kolmogorov-Smirnov normality test p<0.05 = non-normal distribution
ksnormTest(dfull$T2Q)
ksnormTest(dfull$T2Disp)
ksnormTest(dfull$ProcTime)

ksnormTest(df19$T2Q)
ksnormTest(df19$T2Disp)
ksnormTest(df19$ProcTime)

ksnormTest(df20$T2Q)
ksnormTest(df20$T2Disp)
ksnormTest(df20$ProcTime)

# Jarque-Bera normality test p<0.05 = non-normal distribution
jarqueberaTest(dfull$T2Q)
jarqueberaTest(dfull$T2Disp)
jarqueberaTest(dfull$ProcTime)

jarqueberaTest(df19$T2Q)
jarqueberaTest(df19$T2Disp)
jarqueberaTest(df19$ProcTime)

jarqueberaTest(df20$T2Q)
jarqueberaTest(df20$T2Disp)
jarqueberaTest(df20$ProcTime)

# D'Agostino normality test p<0.05 = non-normal distribution.
dagoTest(dfull$T2Q)
dagoTest(dfull$T2Disp)
dagoTest(dfull$ProcTime)

dagoTest(df19$T2Q)
dagoTest(df19$T2Disp)
dagoTest(df19$ProcTime)

dagoTest(df20$T2Q)
dagoTest(df20$T2Disp)
dagoTest(df20$ProcTime)

# Anderson-Darling normality test p<0.05 = non-normal distribution
ad.test(dfull$T2Q)
ad.test(dfull$T2Disp)
ad.test(dfull$ProcTime)

ad.test(df19$T2Q)
ad.test(df19$T2Disp)
ad.test(df19$ProcTime)

ad.test(df20$T2Q)
ad.test(df20$T2Disp)
ad.test(df20$ProcTime)

# Lillefors Test
lillieTest(dfull$T2Q)
lillieTest(dfull$T2Disp)
lillieTest(dfull$ProcTime)

lillieTest(df19$T2Q)
lillieTest(df19$T2Disp)
lillieTest(df19$ProcTime)

lillieTest(df20$T2Q)
lillieTest(df20$T2Disp)
lillieTest(df20$ProcTime)


Init.function()

dat<-Read.summary.data(extend=F,read.init.function=F)
unique(dat$Species)

#dat<-subset(dat,Species %in% c("Cod","Whiting","Haddock","Saithe","Mackerel","W.horse mac","N.horse mac","R. radiata","G. gurnards"))
head(dat)

dat$dayli<-dat$ration/dat$west/91*100; #dayly ration i % of body mass
r<-subset(dat,select=c(Species,Quarter,west,dayli))
r<-unique(r)
subset(r,Species=="N.horse mac")
subset(r,Species=="W.horse mac")

print(xyplot(dayli~west|
               Species,groups=Quarter,data=r,type='a',scales = "free",xlab='Mean weight (kg)',ylab='Dayly Ration (% of body mass)',lwd=2,
             auto.key =   list(space = "right", points = FALSE, lines = TRUE)))

by(r,r$Species,function(x) {
  #trellis.device(device='png',file=file.path(OutputDir,paste0('CatchN_',x[1,'species'],'.png')),width = 1000, height = 800)
  print(xyplot(dayli~west|
                 Species,groups=Quarter,data=x,type='a',scales = "free",xlab='Mean weight (kg)',ylab='Dayly Ration (% of body mass)',lwd=2,
               auto.key =   list(space = "right", points = FALSE, lines = TRUE)))
 # cleanup()
})


library(scales)
message("Reading in clinical file")
clinical_file <- read.csv(file='./test_data.csv',header=T,as.is=T,check.names=F)
# Add a rudimentary imputation step
clinical_file$D_ISS[is.na(clinical_file$D_ISS)] <- median(as.numeric(clinical_file$D_ISS),na.rm=T);
clinical_file$D_Age <- as.numeric(clinical_file$D_Age)
clinical_file$D_Age[is.na(clinical_file$D_Age)] <- median(as.numeric(clinical_file$D_Age),na.rm=T);
output <- data.frame(study=clinical_file$Study,
patient=clinical_file$Patient,
predictionscore=rescale(clinical_file$D_ISS,to=c(1,10))*rescale(clinical_file$D_Age,to=c(1,10)),
highriskflag=clinical_file$D_ISS>2 & clinical_file$D_Age > 65)
message("Write out prediction file")
write.table(file="./predictions.csv",output,sep=",", row.names=FALSE,quote=FALSE)


if (F) {	#Will fishing top predatory species (cod and saithe) at current single species estimate of FMSY allow prey stocks above precautionary biomass reference points?
    a<-droplevels(subset(a,(COD<=0.4 & POK<=0.4) & SPR<0.6))
    out.file='option1'
    plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    table.MSY(a,out.file=out.file)
}

if (F) { # 3.4.2.5	Which combinations of fishing mortality will lead to biomasses of all modelled species above Blim?
    a<-droplevels(subset(a,(COD>=0.5 & POK>=0.45) & SPR<0.6))
    out.file='option2'
    plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    table.MSY(a,out.file=out.file)

    out.file='option2b'
    goOn<-T; sink(file.path(scenario.dir,paste(out.file,'_','reductions','.out',sep='')));  while (goOn) {a2<-reduceCombBlim(a,last.sp=no.MSY.sp); if (goOn) a<-a2} ; sink()
    plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    table.MSY(a,out.file=out.file)
}

if (F) { # 3.4.2.6	For which fishing mortalities is close-to-maximum average yield obtained for each of the modelled species when species interactions are included in a model
     a<-droplevels(subset(a,(COD==0.5 & POK==0.45) & SPR<0.6))
    #a<-droplevels(subset(a,(COD==0.5 & POK==0.45) ))

    out.file='option3'
    plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    table.MSY(a,out.file=out.file)

    out.file='option3a'
    goOn<-T; sink(file.path(scenario.dir,paste(out.file,'_','reductions','.out',sep='')));  while (goOn) {a2<-reduceCombMSY.one.left(a); if (goOn) a<-a2}; sink()
    plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    table.MSY(a,out.file=out.file)

    rm(a)
    load(file =file.path(scenario.dir, "a.RData"))
    a<-droplevels(subset(a,SPR<0.6))
    out.file='option3c'
    plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    table.MSY(a,out.file=out.file)

    out.file='option3d'
    goOn<-T; sink(file.path(scenario.dir,paste(out.file,'_','reductions','.out',sep='')));  while (goOn) {a2<-reduceCombMSY.one.left(a); if (goOn) a<-a2}; sink()
    plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    table.MSY(a,out.file=out.file)

       rm(a)
    load(file =file.path(scenario.dir, "a.RData"))
    a<-droplevels(subset(a,COD==0.5 & POK==0.45 & WHG==0.3 & SPR<0.6))
    out.file='option3e'
    plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    table.MSY(a,out.file=out.file)

    out.file='option3f'
    goOn<-T; sink(file.path(scenario.dir,paste(out.file,'_','reductions','.out',sep='')));  while (goOn) {a2<-reduceCombMSY.one.left(a); if (goOn) a<-a2}; sink()
    plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
    table.MSY(a,out.file=out.file)

}

if (scenario=="Baltic_Fixed-F_stoc_rec") {
  out.file='no1'
  table.MSY(a,out.file=out.file)
  out.file='final'
  goOn<-T; sink(file.path(scenario.dir,paste(out.file,'_','reductions','.out',sep='')));  while (goOn) {a2<-reduceCombMSY.one.left(a); if (goOn) a<-a2}; sink()
  out.file='no4'
  table.MSY(a,out.file=out.file)

  #start with a "fresh" a
  a<-droplevels(subset(a,COD==0.48))
    out.file='no2'
  table.MSY(a,out.file=out.file)
  out.file='final2'
  goOn<-T; sink(file.path(scenario.dir,paste(out.file,'_','reductions','.out',sep='')));  while (goOn) {a2<-reduceCombMSY.one.left(a); if (goOn) a<-a2}; sink()
      out.file='no3'
  table.MSY(a,out.file=out.file)
}

plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
plot.matrix(tit='Recruitment',  type='Recruit',spNames=sp.names[17:24],my.dev='png',out.file=out.file)
plot.matrix(tit='Realized Fbar',  type='Fbar',spNames=sp.names[17:24],my.dev='png',out.file=out.file)

a<-subset(a,COD==0.5 & WHG==0.3 & HAD==0.35 & POK==0.45 & HER==0.55 & SAN==0.55 & NOR==0.6 & SPR==0.55)
out.file='no2'
table.MSY(a,out.file=out.file)

if (F) {
   # find MSY for predator only (saithe)
   aa<-tapply(a$yield,list(a$Species.n,a$Fround),median)
   dimnames(aa)[[1]]<-sp.names[as.numeric(dimnames(aa)[[1]])]
   round(aa)
   a<-droplevels(subset(a,(POK>0.39 & POK<0.41)) )
   aa<-tapply(a$yield,list(a$Species.n,a$Fround),median)
   dimnames(aa)[[1]]<-sp.names[as.numeric(dimnames(aa)[[1]])]
   round(aa)

  out.file='no2'
  plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
  plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
  table.MSY(a,out.file=out.file)

  out.file='no3'
  goOn<-T; sink(file.path(scenario.dir,paste(out.file,'_','reductions','.out',sep='')));  while (goOn) {a2<-reduceCombBlim(a,last.sp=no.pred); if (goOn) a<-a2} ; sink()
  plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
  plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
  table.MSY(a,out.file=out.file)

  out.file='no4'
  goOn<-T; sink(file.path(scenario.dir,paste(out.file,'_','reductions','.out',sep='')));  while (goOn) {a2<-reduceCombBlim(a,last.sp=no.MSY.sp); if (goOn) a<-a2} ; sink()
  plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
  plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
  table.MSY(a,out.file=out.file)

  out.file='no5'
  goOn<-T; sink(file.path(scenario.dir,paste(out.file,'_','reductions','.out',sep=''))); while (goOn) {a2<-reduceCombMSY(a); if (goOn) a<-a2}; sink()
  plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
  plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
  table.MSY(a,out.file=out.file)

  out.file='no6'
  goOn<-T; sink(file.path(scenario.dir,paste(out.file,'_','reductions','.out',sep=''))); while (goOn) {a2<-reduceCombBpa(a); if (goOn) a<-a2}; sink()
  plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
  plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
  table.MSY(a,out.file=out.file)

  out.file='no7'
  goOn<-T; sink(file.path(scenario.dir,paste(out.file,'_','reductions','.out',sep=''))); while (goOn) {a2<-reduceCombMSYfinal(a); if (goOn) a<-a2}; sink()
  plot.matrix(tit='Yield',type=c('Yield','SSB')[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
  plot.matrix(tit='SSB',  type=c('Yield','SSB')[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file)
  table.MSY(a,out.file=out.file)
}


data<-read.table('random.out',col.names=c('values'))
summary(data)

subset<-head(data$values,1000)
summary(subset)

png("randomRandom.png", width=600, height=600)
plot(subset)
dev.off()

png("randomSorted.png", width=600, height=600)
plot(sort(subset))
dev.off()


my_df <- data.frame(project_id ,senario_id , year_end , year_id ,year_end_discounted, paste(project_id,senario_id) , Revenue, Risk , Discount_rate, Priority, Commodity, Total_Capex);
#write.xlsx(my_df, "MyData_In.xlsx")
write.csv(my_df, "my_df_IN.csv");
write.csv(as.data.frame(.arg2), "my_df_IN2.csv");
write.csv(as.data.frame(.arg3), "my_df_IN3.csv");

senario_id_new = senario_id +1

my_df <- subset(my_df , my_df$year_id>2015  & my_df$year_id<=time_horizon);

my_df <- my_df[with(my_df, order(project_id, senario_id, year_id)), ]

write.xlsx(my_df, "MyData_In.xlsx")
names(my_df)[6]="combined_id"

out <- split( my_df , f = my_df$combined_id)
#out <- split( my_df , f = my_df$paste.project_id..senario_id.)

irr <- NULL

for( i in 1:length(out))
{
  year_end_list = out[[i]]$year_end
  year_end_discounted_list = out[[i]]$year_end_discounted
  y = cf(year_end_list)
  out[[i]]$irr =max(y$irr)
  out[[i]]$NPV =sum(year_end_discounted_list)
}

my_df_new <- unsplit(out, f = my_df$combined_id)
#my_df_new <- unsplit(out, f = my_df$paste.project_id..senario_id.)
my_df_new$PI = my_df_new$NPV/Mod(my_df_new$Total_Capex)
write.csv(my_df_new, "my_df_new_MyData_loc1.csv")


context("id")

simple_vectors <- list(
  letters,
  sample(letters),
  1:26
)

test_that("for vector, equivalent to rank", {
  for (case in simple_vectors) {
    rank <- rank(case, ties = "min")
    rank_df <- id(as.data.frame(case))

    expect_that(rank, is_equivalent_to(rank_df))
  }
})

test_that("duplicates numbered sequentially", {
  for (case in simple_vectors) {
    rank <- rep(rank(case, ties = "min"), each = 2)
    rank_df <- id(as.data.frame(rep(case, each = 2)))

    expect_that(rank, is_equivalent_to(rank_df))
  }
})

test_that("n calculated correctly", {
  n <- function(x) attr(id(x), "n")
  for (case in simple_vectors) {
    expect_that(n(as.data.frame(case)), equals(26))
  }

})

test_that("for vector + constant, equivalent to rank", {
  for (case in simple_vectors) {
    rank <- rank(case, ties = "min")

    after <- id(data.frame(case, x = 1))
    before <- id(data.frame(x = 1, case))

    expect_that(rank, is_equivalent_to(before))
    expect_that(rank, is_equivalent_to(after))
  }
})

test_that("grids are correctly ranked", {
  df <- rev(expand.grid(1:10, 1:2))

  expect_that(id(df), is_equivalent_to(1:20))
  expect_that(id(df, drop = T), is_equivalent_to(1:20))
})

test_that("NAs are placed last", {
  expect_that(id_var(c(NA, 1)), is_equivalent_to(c(2, 1)))
})

test_that("factor with missing levels has correct count", {
  id <- id_var(factor(1, NA))
  expect_equal(attr(id, "n"), 1)
})

test_that("zero length input gives single number", {
  expect_that(id(character()), is_equivalent_to(integer()))
})

test_that("zero column data frame gives seq_len(nrow)", {
  df <- as.data.frame(matrix(nrow = 10, ncol = 0))
  expect_equivalent(id(df), 1:10)
})

test_that("empty list doesn't affect n", {
  out <- id(list(integer(), 1:5))
  expect_equivalent(out, 1:5)
  expect_equal(attr(out, "n"), 5)
})


setwd('/home/pc-752828/Dev/results-search-master/outputs-normal')

library(reshape2)
library(nortest)

data_norm <- read.csv(file = 'output-n-price.csv', sep = ',', header = T)

get_df <- function(seed, data) {
  my_ite <- 10
  bo1 <- list()
  bo2 <- list()
  bo3 <- list()
  bo4 <- list()
  rs <- list()
  app <- list()
  seed_l <- list()

  for(i in levels(factor(data$name))) {
    r_bo1 <- data[data['name'] == i & data['bo'] == 'bo1' & data['ite'] == my_ite,][seed,]
    r_bo4 <- data[data['name'] == i & data['bo'] == 'bo4' & data['ite'] == my_ite,][seed,]
    r_bo3 <- data[data['name'] == i & data['bo'] == 'bo3' & data['ite'] == my_ite,][seed,]
    r_bo2 <- data[data['name'] == i & data['bo'] == 'bo5' & data['ite'] == my_ite,][seed,]
    r_rs <- data[data['name'] == i & data['bo'] == 'rs' & data['ite'] == my_ite,][seed,]
    bo1 <- append(bo1, levels(factor(r_bo1$best)))
    bo2 <- append(bo2, levels(factor(r_bo2$best)))
    bo3 <- append(bo3, levels(factor(r_bo3$best)))
    bo4 <- append(bo4, levels(factor(r_bo4$best)))
    rs <- append(rs, levels(factor(r_rs$best)))
    app <- append(app, i)
    seed_l <- append(seed_l, seed)
  }

  df <- cbind(bo1, bo2, bo3, bo4, rs, app)
  df <- data.frame(df)
  df$bo1 = as.numeric(as.character(df$bo1))
  df$bo2 = as.numeric(as.character(df$bo2))
  df$bo3 = as.numeric(as.character(df$bo3))
  df$bo4 = as.numeric(as.character(df$bo4))
  df$rs = as.numeric(as.character(df$rs))

  return(df)
}

get_effect_size <- function(df) {
  cols <- c("BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search", "ID")
  colnames(df) <- cols
  df$ID = as.character(df$ID)
  df$ID <- factor(df$ID)
  new_df <- melt(df, id = c("ID"), measured = cols)
  new_df %>% wilcox_effsize(value ~ variable, paired = TRUE)
}

get_wilco <- function(df) {
  cols <- c("BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search", "ID")
  colnames(df) <- cols
  df$ID = as.character(df$ID)
  df$ID <- factor(df$ID)
  new_df <- melt(df, id = c("ID"), measured = cols)
  pairwise.wilcox.test(new_df$value, new_df$variable, p.adjust = "bonferroni", paired = TRUE, exact = F)
}

df_1 <- get_df(1, data_norm)
df_2 <- get_df(2, data_norm)
df_3 <- get_df(3, data_norm)
df_4 <- get_df(4, data_norm)
df_5 <- get_df(5, data_norm)

get_effect_size(df_1)
get_effect_size(df_2)
get_effect_size(df_3)
get_effect_size(df_4)
get_effect_size(df_5)

get_wilco(df_1)
get_wilco(df_2)
get_wilco(df_3)
get_wilco(df_4)
get_wilco(df_5)

df_norm <- rbind(df_1, df_2, df_3, df_4, df_5)
df <- df_norm
df <- df_3

cols <- c("BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search", "ID")
colnames(df) <- cols
df$ID = as.character(df$ID)
df$ID <- factor(df$ID)
new_df <- melt(df, id = c("ID"), measured = cols)

glimpse(df)
friedman.test(value ~ variable | ID, data = new_df)
colnames(new_df) <- c("ID", "Abordagem", "Best")

wilcox.test(df$`BO-6rnd-EIdef`, df$`BO-6rnd-EInova`, paired = TRUE, alternative = "greater")

new_df %>% wilcox_effsize(value ~ variable, paired = TRUE)
pairwise.wilcox.test(new_df$value, new_df$variable, p.adjust = "bonferroni", paired = TRUE, exact = F)

cols <- c("BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search", "ID")
colnames(df) <- cols
df$ID = as.character(df$ID)
df$ID <- factor(df$ID)
cols <- c("BO-6rnd-EIdef","BO-6rnd-EInova","BO-6sel-EIdef", "PB3Opt", "Ranking Search")
new_df <- melt(df, id = c("ID"), measured = cols)
glimpse(df)
friedman.test(value ~ variable | ID, data = new_df)
colnames(new_df) <- c("ID", "Abordagem", "Best")

shapiro.test(df$bo1)

new_df %>% group_by(Abordagem) %>%
  print(Best)

ad.test(df$rs)
new_df

new_df %>% group_by(Abordagem) %>%
  shapiro.test(Best)

new_df %>% friedman_effsize(value ~ variable | ID)
new_df %>% wilcox_effsize(value ~ variable, paired = TRUE)

new_df %>% group_by(Abordagem) %>%
  get_summary_stats(Best, type = "median_iqr")

new_df %>% group_by(Abordagem) %>%
  get_summary_stats(Best, type = "median_iqr")

frdAllPairsSiegelTest (new_df$Best, new_df$Abordagem, new_df$ID, p.adjust = "bonferroni")
frdAllPairsConoverTest(new_df$Best, new_df$Abordagem, new_df$ID, p.adjust = "bonferroni")
frdAllPairsNemenyiTest(new_df$Best, new_df$Abordagem, new_df$ID, p.adjust = "bonferroni")

library(WebPower)
library(pwr)
library(wmwpow)

pwr.anova.test(k = NULL, n = 38, f = 0.311, sig.level = 0.05, power = NULL)
wp.rmanova(n = NULL, ng = 1, nm = 5, f = .3, alpha = 0.05, power = .8, type = 0)
wp.rmanova(n=30, ng=1, nm=5, f=0.36, nscor=0.7)
wmwpowd(n=38, m=38, distn="norm", distm="norm", sides="greater", alpha = 0.05, nsims = 10000)
shiehpow(n = 38, m = 38, p=.5, alpha = .05, sides="one.sided")
wmwpowp(38, 38, "norm", k = 1, p = NA, wmwodds = .5, sides="greater", alpha = 0.05, nsims = 10000)


\name{hc_rect-HilbertCurve-method}
\alias{hc_rect,HilbertCurve-method}
\title{
Add rectangles on Hilbert curve
}
\description{
Add rectangles on Hilbert curve
}
\usage{
\S4method{hc_rect}{HilbertCurve}(object, ir = NULL, x1 = NULL, x2 = NULL,
    gp = gpar(fill = "red"),
    mean_mode = c("w0", "absolute", "weighted", "max_freq"))
}
\arguments{

  \item{object}{A \code{\link{HilbertCurve-class}} object.}
  \item{ir}{an \code{\link[IRanges:IRanges-constructor]{IRanges}} object which specifies the input intervals.}
  \item{x1}{if start positions are not integers, they can be set by \code{x1}.}
  \item{x2}{if end positions are not integers, they can be set by \code{x2}.}
  \item{gp}{graphic parameters for rectangles. It should be specified by \code{\link[grid]{gpar}}. Note you cannot set \code{linejoin} and \code{lineend}.}
  \item{mean_mode}{when a segment in the curve can not be overlapped with intervals in \code{ir}, how to calculate  the mean values for this segment. See explanation in \code{\link{hc_points,HilbertCurve-method}}.}

}
\details{
Rectangles are put if a segment in the Hilbert curve overlaps with the input intervals.
You cannot set the width or height of the rectangles. It is always fixed (actually it is a square).

It can be thought as the low-resolution version of \code{\link{hc_layer,HilbertCurve-method}}.
}
\value{
A data frame which contains coordinates (in the 2D space) of rectangles.
}
\author{
Zuguang Gu <z.gu@dkfz.de>
}
\examples{
hc = HilbertCurve(1, 100, level = 4, reference = TRUE)

x = sort(sample(100, 20))
s = x[1:10*2 - 1]
e = x[1:10*2]
require(IRanges)
ir = IRanges(s, e)
hc_rect(hc, ir)
}


fn.si = file.path(PROJECT_DIR, "generated_data", "SLE", "SLE_sample_info_2_sle_lowDA.txt")
info = fread(fn.si, data.table=F)

sledai = info %>%
  dplyr::select(SUBJECT, SLEDAI) %>%
  group_by(SUBJECT) %>%
  summarise(SLEDAI.lowDA.mean = mean(SLEDAI), n.samples=n())

fn = file.path(PROJECT_DIR, "generated_data", "SLE", "SLE_SLEDAI.lowDA.mean.txt")
fwrite(sledai, fn, sep="\t")


# ---
# title: "Exploring Baseball Pitching Data"
# author: "Francisco Roman Peña de la Rosa"
# date: "29/5/2020"
# output: Script file
# ---

# Importing libraries
library(dplyr)
library(tidyr)

# Read dataset file
greinke <- read.csv('greinke2015.csv')

# Print the first 6 rows of the data
head(greinke)

# Print the number of rows in the data frame
nrow(greinke)

# Summarize the start_speed variable
summary(greinke$start_speed)

# Get rid of data without start_speed
greinke <- subset(greinke, !is.na(start_speed))

# Print the number of complete entries
nrow(greinke)

# Print the structure of greinke
str(greinke)

# Check if dates are formatted as dates
class(greinke$game_date)

# Change them to dates
greinke$game_date <- as.Date(greinke$game_date, "%m/%d/%Y")

# Check that the variable is now formatted as a date
class(greinke$game_date)

# Separate game_date into "year", "month", and "day"
greinke <- separate(data = greinke, col = game_date,
                    into = c("year", "month", "day"),
                    sep = "-", remove = FALSE)

# Convert month to numeric
greinke$month <- as.numeric(greinke$month)

# Create the july variable
greinke$july <- ifelse(greinke$month == 7, "july", "other")

# View the head() of greinke
head(greinke)

# Print a summary of the july variable
summary(factor(greinke$july))

#***-----

# VELOCITY DISTRIBUTION
# Make a histogram of Greinke's start speed
hist(greinke$start_speed)

# Create greinke_july
greinke_july <- subset(greinke,greinke$july == 'july')

# Create greinke_other
greinke_other <- subset(greinke, greinke$july == 'other')

# Use par to format your plot layout
par(mfrow = c(1,2))

# Plot start_speed histogram from july
hist(greinke_july$start_speed)

# Plot start_speed histogram for other months
hist(greinke_other$start_speed)

#***----

#FASTBALL VELOCITY DISTRIBUTION

# Create july_ff
july_ff <- subset(greinke_july, pitch_type == "FF")

# Create other_ff
other_ff <- subset(greinke_other, pitch_type == "FF")

# Formatting code, don't change this
par(mfrow = c(1, 2))

# Plot histogram of July fastball speeds
hist(july_ff$start_speed)

# Plot histogram of other month fastball speeds
hist(other_ff$start_speed)

#****----

#DISTRIBUTION COMPARISON WITH COLORS
# Make a fastball speed histogram for other months
hist(other_ff$start_speed,
     col = "#00009950", freq = FALSE,
     ylim = c(0, .35), xlab = "Velocity (mph)",
     main = "Greinke 4-Seam Fastball Velocity")

# Add a histogram for July
hist(july_ff$start_speed, add = TRUE,
     col = "#99000050", freq = FALSE)

# Draw vertical line at the mean of other_ff
abline(v = mean(other_ff$start_speed),
       col = "#00009950", lwd = 2)

# Draw vertical line at the mean of july_ff
abline(v = mean(july_ff$start_speed),
       col = "#99000050", lwd = 2)

#***----
# tapply() for velocity changes

# Summarize velocity in July and other months
tapply(greinke$start_speed, greinke$july, mean)

# Create greinke_ff
greinke_ff <- subset(greinke, greinke$pitch_type == 'FF')

# Calculate mean fastball velocities: ff_velo_month
ff_velo_month <- tapply(greinke_ff$start_speed, greinke_ff$july, mean)

# Print ff_velo_month
ff_velo_month

#***----
# Game-by-game velocity changes

# Create ff_dt
ff_dt <- data.frame(tapply(greinke_ff$start_speed, greinke_ff$game_date, mean))

# Print the first 6 rows of ff_dt
head(ff_dt)

#***----

# Tidying the data frame

# Create game_date in ff_dt
ff_dt$game_date <- as.Date(row.names(ff_dt), "%Y-%m-%d")

# Rename the first column
colnames(ff_dt)[1] <- "start_speed"

# Remove row names
row.names(ff_dt) <- NULL

# View head of ff_dt
head(ff_dt)

#***----

# A game-by-game line plot

# Plot game-by-game 4-seam fastballs
par(mfrow = c(1, 1))
plot(ff_dt$start_speed ~ ff_dt$game_date,
     lwd = 4, type = "l", ylim = c(88, 95),
     main = 'Greinke 4-Seam Fastball Velocity',
     xlab = 'Date', ylab = 'Velocity (mph)')

#***----

# Adding jittered points

# Add jittered points to the plot
points(greinke_ff$start_speed ~ jitter(as.numeric(greinke_ff$game_date)),
       pch = 16, col = "#99004450")

#***----

# Pitch mix tables
# Subset the data to remove pitch types "IN" and "EP"
greinke <- subset(greinke, pitch_type != "IN" & pitch_type != "EP")

# Drop the levels from pitch_type
greinke$pitch_type <- droplevels(greinke$pitch_type)

# Create type_tab
type_tab <- table(greinke$pitch_type, greinke$july)

# Print type_tab
type_tab

#***----

# Pitch mix table using prop.table()

# Create type_prop table
type_prop <- round(prop.table(type_tab, margin = 2), 3)

# Print type_prop
type_prop

#***---- Pitch mix tables - July vs. other

# Pitch mix tables - July vs. other

# Create ff_prop
ff_prop <- type_prop[3, ]

# Print ff_prop
ff_prop

# Print ff_velo_month
ff_velo_month

#***----

# Pitch mix tables - changes in pitch type rates

# Create the Difference column
type_prop$Difference <- (type_prop$July - type_prop$Other) / type_prop$Other

# Print the type_prop
type_prop

# Create the Difference column
type_prop$Difference <- (type_prop$July - type_prop$Other) / type_prop$Other

# Print the type_prop
type_prop

# Plot a barplot
barplot(type_prop$Difference, names.arg = type_prop$Pitch,
        main = "Pitch Usage in July vs. Other Months",
        ylab = "Percentage Change in July",
        ylim = c(-0.3, 0.3))

#***----

# Ball-strike count frequency

# Create bs_table
bs_table <- table(greinke$balls, greinke$strikes)

# Create bs_prop_table
bs_prop_table <- round(prop.table(bs_table), 3)

# Print bs_prop_table
bs_prop_table

# Print row sums
rowSums(bs_prop_table)

# Print column sums
colSums(bs_prop_table)

#***-----

# Make a new variable

# Create bs_count
greinke$bs_count <- paste(greinke$balls, greinke$strikes, sep = "-")

# Print the first 6 rows of greinke
head(greinke)


setwd(".")
library(plyr)
library(dplyr)
library(ggplot2)
library(extrafont)
require(reshape2)
library(nortest)
library(effsize)
library(splitstackshape)
library(car)
library(rstatix)
library(tidyverse)
library(ggpubr)
library(ez)
library(bestNormalize)

loadfonts()
options(max.print=50)
fontSize = 10

data = read.csv("data.csv")

# Beautify the data frame

data = data %>% select(!X)

data$movement = as.factor(data$movement)
data$environment = as.factor(data$environment)
data$tactic = as.factor(data$tactic)

data = rename(data, energy = total_energy)
data = rename(data, cpu = total_cpu)
data = rename(data, ram = total_ram)

data$energy = data$energy / 1000

data$run = as.factor(data$run)

data$tactic = revalue(data$tactic, c("baseline"="B", "ee1"="EE1", "ee2"="EE2", "ee3"="EE3", "ee4"="EE4", "combined"="C"))
data$tactic <- factor(data$tactic, levels = c("B", "EE1", "EE2", "EE3", "EE4", "C"))

data$environment = revalue(data$environment, c("empty"="empty", "obstacles"="cluttered"))
data$environment <- factor(data$environment, levels = c("empty", "cluttered"))

data$movement = revalue(data$movement, c("AUTONOMOUS"="autonomous", "NO"="noMovement", "FIXED"="sweep"))
data$movement <- factor(data$movement, levels = c("noMovement", "autonomous", "sweep"))

data$trial_id = factor(paste(data$tactic, data$movement, data$environment, sep="_"))

#=========================================================
# Data exploration
#=========================================================

# Summarize data for the table

data %>% group_by(tactic) %>%
  summarise(min=min(energy), max=max(energy), median=median(energy), mean=mean(energy), sd=sd(energy)) %>%
  mutate(cv=100 * sd/mean) %>% as.data.frame()

data %>%
  summarise(min=min(energy), max=max(energy), median=median(energy), mean=mean(energy), sd=sd(energy)) %>%
  mutate(cv=100 * sd/mean) %>% as.data.frame()

#=========================================================
# Normality checks
#=========================================================

check_normality = function(data) {
  plot(density(data))
  qqPlot(data)
  shapiro.test(data)
}

check_normality(data$energy)

#=========================================================
# Statistical tests
#=========================================================

# data = data %>% filter(movement == "autonomous")
#
res.kruskal <- data %>% kruskal_test(energy ~ tactic)
res.kruskal

data %>% kruskal_effsize(energy ~ tactic)

pwc2 <- data %>%
  wilcox_test(energy ~ tactic, p.adjust.method = "BH", ref.group = "B", exact=F)
pwc2

pwc2 <- data %>% group_by(movement, environment) %>%
  wilcox_test(energy ~ tactic, p.adjust.method = "BH", ref.group = "B", exact=F)
pwc2

# pwc3 <- data %>%
#   dunn_test(energy ~ tactic, p.adjust.method = "holm")
# pwc3

#=========================================================
# Effect size
#=========================================================

check_effect_size = function(df) {
  result = data.frame()

  df.b = df %>% filter(tactic == "B")
  df.ee1 = df %>% filter(tactic == "EE1")
  df.ee2 = df %>% filter(tactic == "EE2")
  df.ee3 = df %>% filter(tactic == "EE3")
  df.ee4 = df %>% filter(tactic == "EE4")
  df.c = df %>% filter(tactic == "C")

  cd.ee1 = cliff.delta(df.b$energy, df.ee1$energy)
  cd.ee2 = cliff.delta(df.b$energy, df.ee2$energy)
  cd.ee3 = cliff.delta(df.b$energy, df.ee3$energy)
  cd.ee4 = cliff.delta(df.b$energy, df.ee4$energy)
  cd.c = cliff.delta(df.b$energy, df.c$energy)

  va.ee1 = VD.A(df.b$energy, df.ee1$energy)
  va.ee2 = VD.A(df.b$energy, df.ee2$energy)
  va.ee3 = VD.A(df.b$energy, df.ee3$energy)
  va.ee4 = VD.A(df.b$energy, df.ee4$energy)
  va.c = VD.A(df.b$energy, df.c$energy)

  result = rbind(result, list("EE1", "cd", cd.ee1$estimate, cd.ee1$magnitude))
  result = rbind(result, list("EE2", "cd", cd.ee2$estimate, cd.ee2$magnitude))
  result = rbind(result, list("EE3", "cd", cd.ee3$estimate, cd.ee3$magnitude))
  result = rbind(result, list("EE4", "cd", cd.ee4$estimate, cd.ee4$magnitude))
  result = rbind(result, list("C", "cd", cd.c$estimate, cd.c$magnitude))

  result = rbind(result, list("EE1", "va", va.ee1$estimate, va.ee1$magnitude))
  result = rbind(result, list("EE2", "va", va.ee2$estimate, va.ee2$magnitude))
  result = rbind(result, list("EE3", "va", va.ee3$estimate, va.ee3$magnitude))
  result = rbind(result, list("EE4", "va", va.ee4$estimate, va.ee4$magnitude))
  result = rbind(result, list("C", "va", va.c$estimate, va.c$magnitude))

  colnames(result) <- c("tactic","type", "estimate", "magnitude")

  return(result)
}

check_effect_size(data)

check_effect_size(data %>% filter(movement == "noMovement"))
check_effect_size(data %>% filter(movement == "sweep"))
check_effect_size(data %>% filter(movement == "autonomous"))
check_effect_size(data %>% filter(environment == "empty"))
check_effect_size(data %>% filter(environment == "cluttered"))

#=========================================================
# Visualizations
#=========================================================

fontSize = 12

# Plot global energy

bp <- ggplot(data, aes(x=tactic, y=energy, fill=tactic)) + #+ ylim(0, max(data$energy)) +
  geom_violin(trim = FALSE, alpha = 0.5, position=position_dodge(0.9)) + theme_bw() + xlab("Tactics") + ylab("Energy (J)") +
  geom_boxplot(alpha=1, color="black", width=.2, fill="white", outlier.size=0) +
  stat_summary(fun.y=mean, colour="black", geom="point",
               shape=5, size=1,show_guide = FALSE) +
  theme(legend.position="none") +
  guides(color=guide_legend(title="")) + theme(strip.text.x=element_text(size=fontSize), strip.text.y=element_text(size=fontSize),  axis.text.x=element_text(size=fontSize, angle = 45, hjust = 1), axis.text.y=element_text(size=fontSize), axis.title=element_text(size=fontSize))
bp

ggsave("./plots/energy_global.pdf", scale = 1, height = 6, width = 16, unit = "cm")

# Plot all combinations

fontSize = 11

bp <- ggplot(data, aes(x=tactic, y=energy, group=tactic, fill=tactic)) + #+ ylim(0, max(data$energy)) +
  geom_violin(trim = FALSE, alpha = 0.5, position=position_dodge(0.9)) + theme_bw() + xlab("Tactics") + ylab("Energy (J)") +
  geom_boxplot(alpha=1, color="black", width=.2, fill="white", outlier.size=0) +
  stat_summary(fun.y=mean, colour="black", geom="point",
               shape=5, size=1,show_guide = FALSE) +
  guides(color=guide_legend(title="")) + theme(strip.text.x=element_text(size=fontSize), strip.text.y=element_text(size=fontSize),  axis.text.x=element_text(size=fontSize, angle = 45, hjust = 1), axis.text.y=element_text(size=fontSize), axis.title=element_text(size=fontSize))
# + geom_jitter(shape=16, size = 0.5, position=position_jitter(0.2))
bp
# bp + facet_wrap(environment ~ movement, ncol=3, labeller = label_wrap_gen(multi_line=FALSE))
bp + facet_grid(movement ~ environment, margin=FALSE) + theme(legend.position="none", strip.background = element_rect(
  color="white", fill="white", size=1, linetype="solid"))

ggsave("./plots/energy_faceted.pdf", scale = 1.6, height = 8, width = 10, unit = "cm")

bp <- ggplot(data, aes(x=tactic, y=energy, group=tactic, fill=tactic)) + #+ ylim(0, max(data$energy)) +
  geom_violin(trim = FALSE, alpha = 0.5, position=position_dodge(0.9)) + theme_bw() + xlab("Tactics") + ylab("Energy (J)") +
  geom_boxplot(alpha=1, color="black", width=.2, fill="white", outlier.size=0) +
  stat_summary(fun.y=mean, colour="black", geom="point",
               shape=5, size=1,show_guide = FALSE) +
  guides(color=guide_legend(title="")) + theme(strip.text.x=element_text(size=fontSize), strip.text.y=element_text(size=fontSize),  axis.text.x=element_text(size=fontSize, angle = 45, hjust = 1), axis.text.y=element_text(size=fontSize), axis.title=element_text(size=fontSize))
# + geom_jitter(shape=16, size = 0.5, position=position_jitter(0.2))
bp
# bp + facet_wrap(environment ~ movement, ncol=3, labeller = label_wrap_gen(multi_line=FALSE))
bp + facet_grid(environment ~ movement, margin=TRUE) + theme(legend.position="none", strip.background = element_rect(
  color="white", fill="white", size=1, linetype="solid"))

ggsave("./plots/energy_faceted_large.pdf", scale = 1.6, height = 15, width = 24, unit = "cm")


#####################################################
### Main file for running "full" simulations      ###
### (Section 4.2 of paper )                       ###
### For parameters used see "SimMain.r"           ###
### Ian Durbach, indurbach@gmail.com              ###
### last updated: 2015-09-04                      ###
#####################################################

library(hitandrun)
library(smaa)

# remember to setwd
source('ApplyErrors.r')
source('ApplyMAUT.r')
source('Generate.r')
source('OutputMeasures.r')
source('SMAA-Boot.r')
source('SMAA1.r')
source('SMAA2.r')
source('SMAA3.r')
source('SMAA4.r')
source('Weights.r')
source('SimMain.r')

###################################################################
# k is number of "scenarios" used in generation of attribute values
# runs is number of SMAA runs
# sims is number of simulations run at each combination of parameter values

K=15000
nd="T"
runs=10000
sims=100
simname=date()
identifier="run_sim_main"
thin.f = 100

runsimMain(K=K,nd=nd,runs=runs,sims=sims,simname=simname,identifier=identifier)