rm(list = ls())
library(psych)

numClusters = 11

score <- function(x){
	x = scale(x, scale = FALSE)
	x  = ((x-min(x))/(max(x)-min(x))) * 100
	return(x)
}

l = read.table(paste0("classes-", numClusters, ".txt"))
k = read.table(paste0("allCountsNorm.txt"))

c1 = which(l[[1]] == 1)
c2 = which(l[[1]] == 2)
c3 = which(l[[1]] == 3)
c4 = which(l[[1]] == 4)
c5 = which(l[[1]] == 5)
c6 = which(l[[1]] == 6)
c7 = which(l[[1]] == 7)
c8 = which(l[[1]] == 8)
c9 = which(l[[1]] == 9)
c10 = which(l[[1]] == 10)
c11 = which(l[[1]] == 11)

k27ac = cbind(k[[5]], k[[6]], k[[7]], k[[8]])
k27me3 = cbind(k[[9]], k[[10]], k[[11]], k[[12]])
me3 = cbind(k[[13]], k[[14]], k[[15]], k[[16]])

me3 = matrix(score(as.vector(me3)), ncol = 4, byrow = FALSE)
k27ac = matrix(score(as.vector(k27ac)), ncol = 4, byrow = FALSE)
k27me3 = matrix(score(as.vector(k27me3)), ncol = 4, byrow = FALSE)

pdf(paste0("vals-", numClusters, ".pdf"), width = 20, height = 8)
library("psych")
cbbPalette <- c("gray", "#009E73", "#D50F25")

nn = ceiling(numClusters / 2)
par(mfrow = c(2,nn))

error.bars((cbind(me3[c1,1], me3[c1,2], me3[c1,3], me3[c1,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[1], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[1], main = paste0("Cluster 1 - n=", length(c1)))
lines(colMeans((cbind(me3[c1,1], me3[c1,2], me3[c1,3], me3[c1,4]))), col = cbbPalette[1], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27ac[c1,1], k27ac[c1,2], k27ac[c1,3], k27ac[c1,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[2], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[2], add = TRUE)
lines(colMeans((cbind(k27ac[c1,1], k27ac[c1,2], k27ac[c1,3], k27ac[c1,4]))), col = cbbPalette[2], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27me3[c1,1], k27me3[c1,2], k27me3[c1,3], k27me3[c1,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[3], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[3], add = TRUE)
lines(colMeans((cbind(k27me3[c1,1], k27me3[c1,2], k27me3[c1,3], k27me3[c1,4]))), col = cbbPalette[3], ylim = c(0,30), lwd = 4)

error.bars((cbind(me3[c2,1], me3[c2,2], me3[c2,3], me3[c2,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[1], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[1], main = paste0("Cluster 2 - n=", length(c2)))
lines(colMeans((cbind(me3[c2,1], me3[c2,2], me3[c2,3], me3[c2,4]))), col = cbbPalette[1], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27ac[c2,1], k27ac[c2,2], k27ac[c2,3], k27ac[c2,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[2], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[2], add = TRUE)
lines(colMeans((cbind(k27ac[c2,1], k27ac[c2,2], k27ac[c2,3], k27ac[c2,4]))), col = cbbPalette[2], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27me3[c2,1], k27me3[c2,2], k27me3[c2,3], k27me3[c2,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[3], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[3], add = TRUE)
lines(colMeans((cbind(k27me3[c2,1], k27me3[c2,2], k27me3[c2,3], k27me3[c2,4]))), col = cbbPalette[3], ylim = c(0,30), lwd = 4)

error.bars((cbind(me3[c3,1], me3[c3,2], me3[c3,3], me3[c3,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[1], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[1], main = paste0("Cluster 3 - n=", length(c3)))
lines(colMeans((cbind(me3[c3,1], me3[c3,2], me3[c3,3], me3[c3,4]))), col = cbbPalette[1], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27ac[c3,1], k27ac[c3,2], k27ac[c3,3], k27ac[c3,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[2], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[2], add = TRUE)
lines(colMeans((cbind(k27ac[c3,1], k27ac[c3,2], k27ac[c3,3], k27ac[c3,4]))), col = cbbPalette[2], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27me3[c3,1], k27me3[c3,2], k27me3[c3,3], k27me3[c3,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[3], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[3], add = TRUE)
lines(colMeans((cbind(k27me3[c3,1], k27me3[c3,2], k27me3[c3,3], k27me3[c3,4]))), col = cbbPalette[3], ylim = c(0,30), lwd = 4)

error.bars((cbind(me3[c4,1], me3[c4,2], me3[c4,3], me3[c4,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[1], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[1], main = paste0("Cluster 4 - n=", length(c4)))
lines(colMeans((cbind(me3[c4,1], me3[c4,2], me3[c4,3], me3[c4,4]))), col = cbbPalette[1], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27ac[c4,1], k27ac[c4,2], k27ac[c4,3], k27ac[c4,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[2], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[2], add = TRUE)
lines(colMeans((cbind(k27ac[c4,1], k27ac[c4,2], k27ac[c4,3], k27ac[c4,4]))), col = cbbPalette[2], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27me3[c4,1], k27me3[c4,2], k27me3[c4,3], k27me3[c4,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[3], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[3], add = TRUE)
lines(colMeans((cbind(k27me3[c4,1], k27me3[c4,2], k27me3[c4,3], k27me3[c4,4]))), col = cbbPalette[3], ylim = c(0,30), lwd = 4)

error.bars((cbind(me3[c5,1], me3[c5,2], me3[c5,3], me3[c5,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[1], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[1], main = paste0("Cluster 5 - n=", length(c5)))
lines(colMeans((cbind(me3[c5,1], me3[c5,2], me3[c5,3], me3[c5,4]))), col = cbbPalette[1], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27ac[c5,1], k27ac[c5,2], k27ac[c5,3], k27ac[c5,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[2], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[2], add = TRUE)
lines(colMeans((cbind(k27ac[c5,1], k27ac[c5,2], k27ac[c5,3], k27ac[c5,4]))), col = cbbPalette[2], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27me3[c5,1], k27me3[c5,2], k27me3[c5,3], k27me3[c5,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[3], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[3], add = TRUE)
lines(colMeans((cbind(k27me3[c5,1], k27me3[c5,2], k27me3[c5,3], k27me3[c5,4]))), col = cbbPalette[3], ylim = c(0,30), lwd = 4)

error.bars((cbind(me3[c6,1], me3[c6,2], me3[c6,3], me3[c6,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[1], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[1], main = paste0("Cluster 6 - n=", length(c6)))
lines(colMeans((cbind(me3[c6,1], me3[c6,2], me3[c6,3], me3[c6,4]))), col = cbbPalette[1], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27ac[c6,1], k27ac[c6,2], k27ac[c6,3], k27ac[c6,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[2], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[2], add = TRUE)
lines(colMeans((cbind(k27ac[c6,1], k27ac[c6,2], k27ac[c6,3], k27ac[c6,4]))), col = cbbPalette[2], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27me3[c6,1], k27me3[c6,2], k27me3[c6,3], k27me3[c6,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[3], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[3], add = TRUE)
lines(colMeans((cbind(k27me3[c6,1], k27me3[c6,2], k27me3[c6,3], k27me3[c6,4]))), col = cbbPalette[3], ylim = c(0,30), lwd = 4)

error.bars((cbind(me3[c7,1], me3[c7,2], me3[c7,3], me3[c7,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[1], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[1], main = paste0("Cluster 7 - n=", length(c7)))
lines(colMeans((cbind(me3[c7,1], me3[c7,2], me3[c7,3], me3[c7,4]))), col = cbbPalette[1], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27ac[c7,1], k27ac[c7,2], k27ac[c7,3], k27ac[c7,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[2], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[2], add = TRUE)
lines(colMeans((cbind(k27ac[c7,1], k27ac[c7,2], k27ac[c7,3], k27ac[c7,4]))), col = cbbPalette[2], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27me3[c7,1], k27me3[c7,2], k27me3[c7,3], k27me3[c7,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[3], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[3], add = TRUE)
lines(colMeans((cbind(k27me3[c7,1], k27me3[c7,2], k27me3[c7,3], k27me3[c7,4]))), col = cbbPalette[3], ylim = c(0,30), lwd = 4)

error.bars((cbind(me3[c8,1], me3[c8,2], me3[c8,3], me3[c8,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[1], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[1], main = paste0("Cluster 8 - n=", length(c8)))
lines(colMeans((cbind(me3[c8,1], me3[c8,2], me3[c8,3], me3[c8,4]))), col = cbbPalette[1], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27ac[c8,1], k27ac[c8,2], k27ac[c8,3], k27ac[c8,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[2], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[2], add = TRUE)
lines(colMeans((cbind(k27ac[c8,1], k27ac[c8,2], k27ac[c8,3], k27ac[c8,4]))), col = cbbPalette[2], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27me3[c8,1], k27me3[c8,2], k27me3[c8,3], k27me3[c8,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[3], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[3], add = TRUE)
lines(colMeans((cbind(k27me3[c8,1], k27me3[c8,2], k27me3[c8,3], k27me3[c8,4]))), col = cbbPalette[3], ylim = c(0,30), lwd = 4)

error.bars((cbind(me3[c9,1], me3[c9,2], me3[c9,3], me3[c9,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[1], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[1], main = paste0("Cluster 9 - n=", length(c9)))
lines(colMeans((cbind(me3[c9,1], me3[c9,2], me3[c9,3], me3[c9,4]))), col = cbbPalette[1], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27ac[c9,1], k27ac[c9,2], k27ac[c9,3], k27ac[c9,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[2], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[2], add = TRUE)
lines(colMeans((cbind(k27ac[c9,1], k27ac[c9,2], k27ac[c9,3], k27ac[c9,4]))), col = cbbPalette[2], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27me3[c9,1], k27me3[c9,2], k27me3[c9,3], k27me3[c9,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[3], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[3], add = TRUE)
lines(colMeans((cbind(k27me3[c9,1], k27me3[c9,2], k27me3[c9,3], k27me3[c9,4]))), col = cbbPalette[3], ylim = c(0,30), lwd = 4)

error.bars((cbind(me3[c10,1], me3[c10,2], me3[c10,3], me3[c10,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[1], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[1], main = paste0("Cluster 10 - n=", length(c10)))
lines(colMeans((cbind(me3[c10,1], me3[c10,2], me3[c10,3], me3[c10,4]))), col = cbbPalette[1], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27ac[c10,1], k27ac[c10,2], k27ac[c10,3], k27ac[c10,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[2], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[2], add = TRUE)
lines(colMeans((cbind(k27ac[c10,1], k27ac[c10,2], k27ac[c10,3], k27ac[c10,4]))), col = cbbPalette[2], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27me3[c10,1], k27me3[c10,2], k27me3[c10,3], k27me3[c10,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[3], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[3], add = TRUE)
lines(colMeans((cbind(k27me3[c10,1], k27me3[c10,2], k27me3[c10,3], k27me3[c10,4]))), col = cbbPalette[3], ylim = c(0,30), lwd = 4)

error.bars((cbind(me3[c11,1], me3[c11,2], me3[c11,3], me3[c11,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[1], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[1], main = paste0("Cluster 11 - n=", length(c11)))
lines(colMeans((cbind(me3[c11,1], me3[c11,2], me3[c11,3], me3[c11,4]))), col = cbbPalette[1], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27ac[c11,1], k27ac[c11,2], k27ac[c11,3], k27ac[c11,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[2], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[2], add = TRUE)
lines(colMeans((cbind(k27ac[c11,1], k27ac[c11,2], k27ac[c11,3], k27ac[c11,4]))), col = cbbPalette[2], ylim = c(0,30), lwd = 4)
error.bars((cbind(k27me3[c11,1], k27me3[c11,2], k27me3[c11,3], k27me3[c11,4])),labels = c("EB0h","EB12h", "EB24h", "EB48h"), eyes = FALSE, sd = FALSE, bars = FALSE, arrow.col = cbbPalette[3], ylim = c(0,30), xaxt = "n", ylab = "Normalized Average Signal", xlab = "", col = cbbPalette[3], add = TRUE)
lines(colMeans((cbind(k27me3[c11,1], k27me3[c11,2], k27me3[c11,3], k27me3[c11,4]))), col = cbbPalette[3], ylim = c(0,30), lwd = 4)

dev.off()


# PROPOSAL TO CALCULATE WINDOW MEAN
# =================================
# =================================

# Idea: Get Data From all words in timespan, calculate, write back

# Steps
#   Connect to DB
#   Get all data from DB
#   Reshape 1: make big table
#   Calculation
#   Plot Example Word "Flugzeug"
#   Reshape II: make tall table (date, w_id, window_value)
#   Write back into DB

#RESHAPE I
#=========
#Make big table

#install.packages("reshape2")
library(reshape2)
# Reshape Data in one big table : Zeile: date ~ Spalte: word
# varie value.var to use other data then freq (for exaple tf/idf)
words_vs_date <- dcast(marchData[ ,], formula = date ~ w_id, mean, value.var="freq", fill=0)

# add new column names, becaus integers as columnnames produce failures
wordNames <- colnames(words_vs_date)
add_w_id <- function(id) {paste("w_id_",id,sep="")}
wordNames <- mapply(add_w_id, wordNames)
colnames(words_vs_date) <- wordNames


# 4. faza: Analiza podatkov
library(StatMeasures)

#==============================================================================================================
#razvoj tekaskih disciplin

#sprememba glede na leto 2005
##zenske
#filtreras rezultate po zenskah in 1 mestu
t1 <- rezultati.tekaske %>% filter(spol=="Zenski", uvrstitev==1)

#razdelis rezultate po disciplinah
t1 <- split(t1, t1$disciplina)

rezultati1 <- data.frame()

#gres cez vse discipline, za vsako disciplino zracunas spremembo glede na 2005 in potem das vse v tabelo rezultati
for(i in 1:length(t1)){
  for(g1 in t1[i]){
    sprememba <- g1$rezultat / g1$rezultat[length(g1$rezultat)]
    g1 <- as.data.frame(cbind(g1, sprememba))
    rezultati1 <- rbind(rezultati1, g1)
  }
}

#graf sprememba glede na 2005
graf.Ztek.mark <- ggplot(data = rezultati1, aes(x=factor(leto), y=sprememba, group=disciplina, color=disciplina)) +
  geom_line(size=2) +
  labs(x="Leto", y="Sprememba glede na 2005", color="Disciplina") +
  ggtitle("Sprememba rezultatov tekaških disciplin pri ženskah\nglede na leto 2005")

#
##moski tekaske
t2 <- rezultati.tekaske %>% filter(spol=="Moski", uvrstitev==1)

#razdelis rezultate po disciplinah
t2 <- split(t2, t2$disciplina)

rezultati2 <- data.frame()

#gres cez vse discipline, za vsako disciplino zracunas spremembo glede na 2005 in potem das vse v tabelo rezultati
for(i in 1:length(t2)){
  for(g2 in t2[i]){
    sprememba <- g2$rezultat / g2$rezultat[length(g2$rezultat)]
    g2 <- as.data.frame(cbind(g2, sprememba))
    rezultati2 <- rbind(rezultati2, g2)
  }
}

#
##zenske tehnicne
t3 <- rezultati.tehnicne %>% filter(spol=="Zenski", uvrstitev==1)

#razdelis rezultate po disciplinah
t3 <- split(t3, t3$disciplina)

rezultati3 <- data.frame()

#gres cez vse discipline, za vsako disciplino zracunas spremembo glede na 2005 in potem das vse v tabelo rezultati
for(i in 1:length(t3)){
  for(g3 in t3[i]){
    sprememba <- g3$rezultat / g3$rezultat[length(g3$rezultat)]
    g3 <- as.data.frame(cbind(g3, sprememba))
    rezultati3 <- rbind(rezultati3, g3)
  }
}

#
##moski tehnicne
t4 <- rezultati.tehnicne %>% filter(spol=="Moski", uvrstitev==1)

#razdelis rezultate po disciplinah
t4 <- split(t4, t4$disciplina)

rezultati4 <- data.frame()

#gres cez vse discipline, za vsako disciplino zracunas spremembo glede na 2005 in potem das vse v tabelo rezultati
for(i in 1:length(t4)){
  for(g4 in t4[i]){
    sprememba <- g4$rezultat / g4$rezultat[length(g4$rezultat)]
    g4 <- as.data.frame(cbind(g4, sprememba))
    rezultati4 <- rbind(rezultati4, g4)
  }
}

#tabela vseh sprememb skupaj
rezultati1$kategorija <- "Tekaske"
rezultati2$kategorija <- "Tekaske"
rezultati3$kategorija <- "Tehnicne"
rezultati4$kategorija <- "Tehnicne"

rezultati <- bind_rows(rezultati1, rezultati2, rezultati3, rezultati4)

#=========================================================================================================
#reakcijski časi

# graf reakcijskih casov prvouvrscenih v posameznih disciplinah za moske in zenske
graf.react <- ggplot(data = sprint %>% filter(POS==1), mapping = aes(x=factor(leto), y=get("Reaction Time"), group=disciplina, color=disciplina)) +
  geom_line() +
  labs(x="Leto", y="Reakcijski čas", color="Disciplina") +
  ggtitle("Reakcijski čas prvouvrščenega iz vsake discipline") +
  facet_wrap(spol ~., ncol=2, labeller = as_labeller(c("Zenski" = "Ženske", "Moski" = "Moški"))) +
  theme(axis.text.x = element_text(angle = 90, size = 8))

# graf reakcijskih časov prvih treh uvrščenih za vsako disciplino in spol

oznake <- c("Moski" = "Moški", "Zenski" = "Ženske", "100 m" = "100 m", "200 m" = "200 m", "400 m" = "400 m")

graf.sprint.react <- ggplot(data = sprint %>% filter(POS<=3), mapping = aes(x=leto, y=get("Reaction Time"))) +
  geom_smooth(method = "loess",se=FALSE, color="black", size=2) +
  geom_point(aes(colour=factor(POS),group=POS), size=2) +
  labs(x="Leto", y="Reakcijski čas", color="Uvrstitev") +
  ggtitle("Reakcijski časi prvih treh uvrščenih") +
  scale_x_continuous(breaks = seq(1999,2017,2)) +
  facet_grid(spol ~ disciplina, labeller = as_labeller(oznake)) +
  theme(axis.text.x = element_text(angle = 90, size = 8))

#=======================================================================================================
#regresija

s1z <- sprint %>% filter(POS==1, disciplina=="100 m", spol=="Zenski")
s2z <- sprint %>% filter(POS==1, disciplina=="200 m", spol=="Zenski")
s4z <- sprint %>% filter(POS==1, disciplina=="400 m", spol=="Zenski")
s1m <- sprint %>% filter(POS==1, disciplina=="100 m", spol=="Moski")
s2m <- sprint %>% filter(POS==1, disciplina=="200 m", spol=="Moski")
s4m <- sprint %>% filter(POS==1, disciplina=="400 m", spol=="Moski")

p1z <- lm(data = s1z, MARK ~ leto)
p2z <- lm(data = s2z, MARK ~ leto)
p4z <- lm(data = s4z, MARK ~ leto)
p1m <- lm(data = s1m, MARK ~ leto)
p2m <- lm(data = s2m, MARK ~ leto)
p4m <- lm(data = s4m, MARK ~ leto)

leta <- data.frame(leto=seq(2019, 2023, 2))

n1z <- mutate(leta, MARK=predict(p1z, leta), disciplina="100 m", spol="Zenski")
n2z <- mutate(leta, MARK=predict(p2z, leta), disciplina="200 m", spol="Zenski")
n4z <- mutate(leta, MARK=predict(p4z, leta), disciplina="400 m", spol="Zenski")
n1m <- mutate(leta, MARK=predict(p1m, leta), disciplina="100 m", spol="Moski")
n2m <- mutate(leta, MARK=predict(p2m, leta), disciplina="200 m", spol="Moski")
n4m <- mutate(leta, MARK=predict(p4m, leta), disciplina="400 m", spol="Moski")

napoved <- bind_rows(n1z, n2z, n4z, n1m, n2m, n4m)

graf.regresija <- ggplot(data = sprint %>% filter(POS==1), mapping = aes(x=leto, y=MARK)) +
  geom_smooth(method = lm, fullrange = TRUE, color="black") +
  geom_point(color="blue") +
  geom_point(data=napoved, mapping = aes(x=leto, y=MARK), color="red") +
  labs(x="Leto", y="Čas") +
  ggtitle("Napoved rezultatov v disciplinah 100, 200 in 400 m") +
  facet_wrap(spol ~ disciplina, scales = "free_y", labeller = as_labeller(oznake)) +
  theme(axis.text.x = element_text(angle = 90, size = 8))

#=========================================================================================
# podatki za shiny

sample.data <- merge(x = drzave.koordinate, y = sprint, by = "COUNTRY", all.x = TRUE)
sample.data <- sample.data[!is.na(sample.data$ATHLETE), ] %>% arrange(leto)


#' wetbulb_stull
#'
#' Compute natural wetbulb temperature by using Stull empirical formulation
#'
#' @param t numeric      Air temperature in degC.
#' @param rh numeric     Relative humidity in percentage.
#' @return Wet bulb temperature in degC
#'
#'
#' @author  Istituto per la Bioeconomia CNR Firenze Italy  Alfonso Crisci \email{alfonso.crisci@@ibe.cnr.it}
#' @keywords  wetbulb
#' @references  Stull, R.B., 2011, Meteorology for Scientists and Engineers, 3rd Edition. 938 pages.
#' @export
#'
#'
#'
#'

wetbulb_stull=function(t,rh) {
                         ct$assign("t", as.array(t))
                         ct$assign("rh", as.array(rh))
                         ct$eval("var res=[]; for(var i=0, len=t.length; i < len; i++){ res[i]=wetbulb_stull(t[i],rh[i]};")
                         res=ct$get("res")
                         return(ifelse(!is.numeric(res),NA,res))
}


library("arm")
library ("MCMCpack")
library (foreign)
library (car)
library (gtools)

library (R2WinBUGS)
#library (R2OpenBUGS)
#library(BRugs)

rm(list = ls())
##
workdir <- c("~/Dropbox/data/rollcall/DipMex")
#workdir <- c("C:/Documents and Settings/emagarm/Mis documentos/My Dropbox/data/rollcall/DipMex")
setwd(workdir)

load("ip60_5+5k.RData")

results <- list(results, results.2, results.3)
rm(results.2, results.3)
chains <- list ( results[[1]]$sims.matrix, results[[2]]$sims.matrix, results[[3]]$sims.matrix )

post.draw <- rbind(chains[[1]], chains[[2]], chains[[3]])
post.x     <- post.draw[,grep("x", colnames(post.draw))]
post.y     <- post.draw[,grep("y", colnames(post.draw))]
post.alpha <- post.draw[,grep("alpha", colnames(post.draw))]
post.beta  <- post.draw[,grep("beta", colnames(post.draw))]
post.delta <- post.draw[,grep("delta", colnames(post.draw))]

## SACA CONSTANTE Y PENDIENTE DE CUTLINES
a <- post.beta / post.delta  ## pendiente de cutline
b <- post.alpha / post.delta ## constante de cutline

## MATRIZ CON MEDIANA E INTERVALOS DE CREDIBILIDAD BAYESIANA
jotas <- matrix(NA, nrow=J, ncol=6)
for (j in 1:J){
    jotas[j,1] <- quantile (post.x[,j], 0.025, names=F)
    jotas[j,2] <- quantile (post.x[,j], 0.50, names=F)
    jotas[j,3] <- quantile (post.x[,j], 0.975, names=F)
    jotas[j,4] <- quantile (post.y[,j], 0.025, names=F)
    jotas[j,5] <- quantile (post.y[,j], 0.50, names=F)
    jotas[j,6] <- quantile (post.y[,j], 0.975, names=F)
    }

## MIN y MAX (PUEDE SER UTIL)
tmp <- c(jotas[,1],jotas[,4])
for (i in 1:length(tmp)) { tmp[i] <- ifelse(is.na(tmp[i])==TRUE,0,tmp[i]) }
min <- min( tmp )
tmp <- c(jotas[,3],jotas[,6])
for (i in 1:length(tmp)) { tmp[i] <- ifelse(is.na(tmp[i])==TRUE,0,tmp[i]) }
max <- max( tmp )
lims <- c(NA,NA)
lims[1] <- ifelse(abs(min)>max, min, -max)
lims[2] <- ifelse(abs(min)>max, abs(min), max)

par(mar = c(3.1, 3.1, 2.1, 2.1) )
## dipdat$color[dipdat$color=="."] <- "black"
##plot(c(min(jotas[,2]),max(jotas[,2])), c(min(jotas[,5]),max(jotas[,5])), type="n")
plot(c(-3.5,3), c(-3.5,3), type="n",
           xlab="",
           ylab="",
           main="60th Leg. 2006-09")
##abline(0,1)
abline(v=seq(-3,3,by=1),col="grey",lty=3); ## OPCIONAL
abline(h=seq(-3,3,by=1),col="grey",lty=3); ## OPCIONAL
points(jotas[,2],jotas[,5], pch=19, cex=.75, col=dipdat$color)
##points(jotas[,5],jotas.gac[,5], pch=19, cex=.75, col=dipdat$color)
legend(2.2,-1.6, legend=part.list, cex=.75, pch=20, pt.cex=1.25, col=color.list, bg="white")

## cutlines
amed <- rep(NA,times=I)
bmed <- rep(NA,times=I)
for (i in 1:I){
    amed[i] <- quantile (a[,i], 0.50, names=F)
    bmed[i] <- quantile (b[,i], 0.50, names=F)  }
#
plot(c(-2.2,2.2), c(-2.2,2.2), type="n",
           xlab=c(""),
           ylab=c(""),
           main="60th Leg. 2006-09")
    for (i in 1:I){
        abline(a=bmed[i], b=amed[i], col="grey") } ## OJO: a en mi modelo es slope, en R es constant
    for (j in 1:J){
        points(jotas[j,2],jotas[j,5],pch=20,col=dipdat$color[j])
        }


avg_distances <- function(distance_matrix_file, file_path = "./", groups_list = "groups", output_file, output_dir = "./", debug = 0){ #10-20-11 - function to calculate average distances with specified groupings from a distance matrix

  if ( nargs() == 0){print_usage()}

  suppressPackageStartupMessages(library(matlab))

  output_file = gsub(" ", "", paste(output_dir, output_file, ".AVG_DIST"))

  file_path = gsub(" ", "", paste(file_path, distance_matrix_file))
  distance_matrix <<- data.matrix(read.table(file_path, row.names=1, header=TRUE, check.names=FALSE, sep="\t", comment.char="", quote=""))

  #groups_dataframe <<- read.table(groups_list, header=FALSE, check.names=FALSE, sep = ",", comment.char="", quote="", fill=TRUE)
  groups_dataframe <<- read.table(groups_list, header=FALSE, check.names=FALSE, sep = ",", comment.char="", quote="", fill=TRUE, blank.lines.skip=TRUE)
  groups_characterlist <<- readLines(groups_list)

  groups_in <<- readLines(groups_list)
  num_groups <<- dim(data.frame(groups_in))[1]

  write(paste("######", distance_matrix_file, "avg_distances.r analysis ######"), file=output_file, append=TRUE)
  write("                                             ", file=output_file, append=TRUE)
  write("#############################################", file=output_file, append=TRUE)
  write("#>WITHIN GROUP Distances or Dissimilarities", file=output_file, append=TRUE)
  write("#############################################", file=output_file, append=TRUE)
  write("                                             ", file=output_file, append=TRUE)
  # This part extracts all of the within group distances
  for (i in 1:num_groups){

    if ( debug>0 ) { print(paste("Group:", i)) }
    #
    group_samples <- strsplit(groups_in[i], ",")
    num_samples <- dim(data.frame(group_samples))[1]
    write(gsub( " ", "", (paste(">Group(", i, ")", "\t", "group_members=", group_samples))), file=output_file, append=TRUE)
    group_distances <<- matrix (NA, size(combn(num_samples,2))[2], 1) #####
    gd_index <- 1

      for (m in 2:num_samples){ # get all of the unique non-redundant pairs

        for (n in 1:(m-1)){

          if (
              identical( toString(charmatch( group_samples[[1]][m], dimnames(distance_matrix)[[1]])), "NA" ) ||
              identical( toString(charmatch(   group_samples[[1]][n], dimnames(distance_matrix)[[1]])), "NA" )
              )
            {
              #print()
              stop (paste("sample names in the groups file:\n", groups_list,"\n (", noquote(group_samples[[1]][m]), " or ", noquote(group_samples[[1]][n]), ")\n are not in the distance_matrix:\n",distance_matrix_file, "\n",
                    "check the names in the groups and distance_matrix files to make sure that they match\n\n"))
            }

          if (debug>0){ print(paste("gd_index =", gd_index, "distance:", distance_matrix[ noquote(group_samples[[1]][m]), noquote(group_samples[[1]][n]) ] )) } #####
          group_distances[gd_index,1] <<- distance_matrix[ noquote(group_samples[[1]][m]), noquote(group_samples[[1]][n]) ] #####
          gd_index <- gd_index + 1

          write(
                gsub(
                     " ", "", paste(
                                    noquote(group_samples[[1]][m]),
                                    "::",
                                    noquote(group_samples[[1]][n]),
                                    "\t",
                                    distance_matrix[ noquote(group_samples[[1]][m]), noquote(group_samples[[1]][n]) ]
                                    )
                     ),
                file = output_file,
                append=TRUE
                )
          ##

        }

      }

    write(gsub(" ", "", paste("->mean_Group(", i, ")", "\t", mean(group_distances), "\t", "stdev", "\t", sd(as.vector(group_distances)),"\t", "group_members=", group_samples)), file=output_file, append=TRUE)#####

    write("_____________________________________________", file=output_file, append=TRUE)
  }

  # This portion extracts the between group distances
  if (num_groups<2){
    write("                                             ", file=output_file, append=TRUE)
    write("#############################################", file=output_file, append=TRUE)
    write("#>>BETWEEN GROUP Distances or Dissimilarities", file=output_file, append=TRUE)
    write("        NA -- There is just one group        ", file=output_file, append=TRUE)
    write("#############################################", file=output_file, append=TRUE)
  }else{
    write("                                             ", file=output_file, append=TRUE)
    write("#############################################", file=output_file, append=TRUE)
    write("#>>BETWEEN GROUP Distances or Dissimilarities", file=output_file, append=TRUE)
    write("#############################################", file=output_file, append=TRUE)
    write("                                             ", file=output_file, append=TRUE)

    for (p in 2:num_groups){ # get all of the unique non-redundant pairs

      for (q in 1:(p-1)){

        alpha_samples <- strsplit(groups_in[p], ",")
        num_alpha_samples <- dim(data.frame(alpha_samples))[1]
        #alpha_distances <- matrix(NA, size(combn(num_alpha_samples,2))[2], 1) ### ###

        beta_samples <- strsplit(groups_in[q], ",")
        num_beta_samples <- dim(data.frame(beta_samples))[1]
        #beta_distances <- matrix(NA, size(combn(num_beta_samples,2))[2], 1) ### ###

        alpha_beta_distances <<- matrix(NA, (num_alpha_samples*num_beta_samples), 1) # alpha and beta should be the same size
        dist_index <- 1 ### ###

        write(gsub(" ", "", (paste(">>Group(", p, ")::Group(", q, ")"))), file=output_file, append=TRUE)

        for (na in 1:num_alpha_samples){
          for (nb in 1:num_beta_samples){

            alpha_beta_distances[dist_index,1] <<- distance_matrix[ noquote(alpha_samples[[1]][na]), noquote(beta_samples[[1]][nb]) ] ### ###
            dist_index <- dist_index + 1 ### ###

            write(
                  gsub(
                       " ", "", paste(
                                      "Group(", p,")",
                                      noquote(alpha_samples[[1]][na]),
                                      "::Group(", q,")",
                                      noquote(beta_samples[[1]][nb]),
                                      "\t",
                                      distance_matrix[ noquote(alpha_samples[[1]][na]), noquote(beta_samples[[1]][nb]) ]
                                      )
                       ),
                  file = output_file,
                  append=TRUE
                  )
          }
        }
        write(gsub(" ", "", paste("->>mean_Group(", p, ")::Group(", q, ")", "\t", mean(alpha_beta_distances), "\t", "stdev", "\t", sd(as.vector(alpha_beta_distances)) )), file=output_file, append=TRUE)
        write("_____________________________________________", file=output_file, append=TRUE)
      }
      #write(gsub(" ", "", paste("->>mean_Group(", p, ")::Group(", q, ")", "\t", mean(alpha_beta_distances), "\t", "stdev", "\t", sd(alpha_beta_distances))), file=output_file, append=TRUE)
      #write("_____________________________________________", file=output_file, append=TRUE)
    }
  }

}

# write(gsub(" ", "", paste("mean Group(", i, ")", "\t", mean(group_distances), "\t", "stdev", "\t", sd(group_distances))), file=output_file, append=TRUE)

## if ( debug>0 ) { print(
##                                  paste(
##                                        noquote(group_samples[[1]][m]), "vs.", noquote(group_samples[[1]][n]), "dist =",
##                                        distance_matrix[ noquote(group_samples[[1]][m]), noquote(group_samples[[1]][n]) ]
##                                        )
##                                  )
##                          }

#### SUBS
print_usage <- function() {
  writeLines("  ------------------------------------------------------------------------------
  avg_distances.r
  ------------------------------------------------------------------------------
  DESCRIPTION:
  This script will calculate the average within and between group distances given an
  input distance matrix and groupings file

  USAGE:
  sample_matrix(distance_matrix_file, file_path, groups_list, output_file)

       distance_matrix_file : string, no default         : name of the distance matrix file (a *.DIST output of plot_pco_with_stats.pl)
       file_path            : string, default = ./       : path of the distance_matrix_file
       groups_list          : string, default = groups   : name of the groups list - the groups list needs to follow these conventions:
                                - each line is a group
                                - individual sample names are comma separated on each line
                                - sample names must match the sample names in the distance_matrix_file

       output_file          : string, no default         : name for the output file
       output_dir           : string, default = ./       : path for the output
       debug                : boolean, default = 0       : (0|1) run the script in debug mode
  ------------------------------------------------------------------------------
Arguents you supplied:")
  print(paste("distance_matrix_file: ", distance_matrix_file))
  print(paste("file_path:            ", file_path))
  print(paste("groups_list:          ", groups_list))
  print(paste("output_file:          ", output_file))
  print("------------------------------------------------------------------------------")
  stop("you did not enter the correct args -- see above")
}


#!/usr/bin/env Rscript

#Andrew Burt - a.burt@ucl.ac.uk

suppressMessages(library(ggplot2))
suppressMessages(library(extrafont))
suppressMessages(library(RColorBrewer))

plotFig0 <- function()
{
	df <- data.frame()
	f0 <- ggplot(df) + geom_point() + xlim(0, 10) + ylim(0, 10)
	f0 <- f0 + labs(x="Improving precision",y="Improving trueness")
	f0 <- f0 + labs(tag = "Improving accuracy")
	f0 <- f0 + geom_segment(aes(x,y,xend=xend,yend=yend,size=size),data.frame(x=seq(2,7.99,0.005),xend=seq(2.01,8,0.005),y=0,yend=0,size=seq(0,1,l=1199)))
	f0 <- f0 + geom_segment(aes(7.8,0,xend=8.2,yend=0),size=2.1,arrow =arrow(length=unit(1,"cm")))
	f0 <- f0 + geom_segment(aes(x,y,xend=xend,yend=yend,size=size),data.frame(x=0,xend=0,y=seq(2,7.99,0.005),yend=seq(2.01,8,0.005),size=seq(0,1,l=1199)))
	f0 <- f0 + geom_segment(aes(0,7.8,xend=0,yend=8.2),size=2.1,arrow =arrow(length=unit(1,"cm")))
	f0 <- f0 + geom_segment(aes(x,y,xend=xend,yend=yend,size=size),data.frame(x=10,xend=10,y=seq(2.5,9.49,0.005),yend=seq(2.51,9.5,0.005),size=seq(0,0.2,l=1399)))
	f0 <- f0 + geom_segment(aes(10,9.5,xend=10,yend=9.7),size=2.1,arrow =arrow(length=unit(1,"cm")))
	f0 <- f0 + geom_segment(aes(x,y,xend=xend,yend=yend,size=size),data.frame(x=seq(2.5,9.49,0.005),xend=seq(2.51,9.5,0.005),y=10,yend=10,size=seq(0,0.2,l=1399)))
	f0 <- f0 + geom_segment(aes(9.5,10,xend=9.7,yend=10),size=2.1,arrow =arrow(length=unit(1,"cm")))
	f0 <- f0 + theme(aspect.ratio=1,legend.position="none",panel.grid.minor=element_blank(),text=element_text(family="CMU Serif", size=15))
	f0 <- f0 + theme(axis.title=element_text(size=15),axis.text.x=element_blank(),axis.text.y=element_blank(),axis.ticks=element_blank())
#	f0 <- f0 + theme(plot.title=element_text(size=10,hjust = 1.0))
	f0 <- f0 + theme(plot.margin = unit(c(1,3,1,1), "lines"),plot.tag.position=c(1.025, 0.855),plot.tag=element_text(size=15,angle=270))
	set.seed(1)
	x <- seq(1,25)
	y <- seq(1,25) + rnorm(n=25,mean=3,sd=6)
	data <- data.frame(x,y)
	f0a <- ggplot(data=data,aes(x,y))
	f0a <- f0a + geom_point() + coord_fixed()
	f0a <- f0a + geom_abline(aes(intercept=0,slope=1,color='1:1'),linetype="dashed")
	f0a <- f0a + labs(x="True AGB",y="Predicted AGB")
	f0a <- f0a + scale_fill_manual(name="legend",values="1:1")
	f0a <- f0a + scale_colour_manual(values=c("black"),labels=c("1:1"))
	f0a <- f0a + theme(aspect.ratio=1,axis.title=element_text(size=15),axis.text.x=element_blank(),axis.text.y = element_blank(),axis.ticks = element_blank(),panel.grid.major = element_blank(), panel.grid.minor = element_blank(),plot.background = element_rect(fill = "grey92"),legend.title=element_blank(),legend.position = c(.25, .90),legend.background=element_blank(),legend.key=element_blank(),text=element_text(family="CMU Serif", size=15),legend.text=element_text(size=15))
	set.seed(1)
	x <- seq(1,25)
	y <- seq(1,25) + rnorm(n=25,mean=3,sd=2)
	data <- data.frame(x,y)
	f0b <- ggplot(data=data,aes(x,y))
	f0b <- f0b + geom_point() + coord_fixed()
	f0b <- f0b + geom_abline(intercept=0,slope=1,linetype="dashed")
	f0b <- f0b + theme(aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),axis.text.x=element_blank(),axis.text.y = element_blank(),axis.ticks = element_blank(),panel.grid.major = element_blank(), panel.grid.minor = element_blank(),plot.background = element_rect(fill = "grey92"))
	set.seed(1)
	x <- seq(1,25)
	y <- seq(1,25) + rnorm(n=25,mean=0,sd=6)
	data <- data.frame(x,y)
	f0c <- ggplot(data=data,aes(x,y))
	f0c <- f0c + geom_point() + coord_fixed()
	f0c <- f0c + geom_abline(intercept=0,slope=1,linetype="dashed")
	f0c <- f0c + theme(aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),axis.text.x=element_blank(),axis.text.y = element_blank(),axis.ticks = element_blank(),panel.grid.major = element_blank(), panel.grid.minor = element_blank(),plot.background = element_rect(fill = "grey92"))
	set.seed(1)
	x <- seq(1,25)
	y <- seq(1,25) + rnorm(n=25,mean=0,sd=2)
	data <- data.frame(x,y)
	f0d <- ggplot(data=data,aes(x,y))
	f0d <- f0d + geom_point() + coord_fixed()
	f0d <- f0d + geom_abline(intercept=0,slope=1,linetype="dashed")
	f0d <- f0d + theme(aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),axis.text.x=element_blank(),axis.text.y = element_blank(),axis.ticks = element_blank(),panel.grid.major = element_blank(), panel.grid.minor = element_blank(),plot.background = element_rect(fill = "grey92"))
	f0 <- f0 + annotation_custom(ggplotGrob(f0a),xmin=0.5,xmax=4.5,ymin=0.5,ymax=4.5)
	f0 <- f0 + annotation_custom(ggplotGrob(f0b),xmin=5,xmax=10,ymin=0.5,ymax=4.5)
	f0 <- f0 + annotation_custom(ggplotGrob(f0c),xmin=0.5,xmax=4.5,ymin=5.5,ymax=9.5)
	f0 <- f0 + annotation_custom(ggplotGrob(f0d),xmin=5.5,xmax=9.5,ymin=5.5,ymax=9.5)
	ggsave("f0b.pdf",plot=f0,scale=1)
}

plotFig1 <- function(data)
{
	f1 <- ggplot(data=data,aes(d,agb))
	f1 <- f1 + geom_point(size=1.5,alpha=0.75,stroke=0)
	f1 <- f1 + scale_y_continuous(breaks=c(0,20000,40000,60000,80000), labels = function(x){paste0(x/1000)})
	f1 <- f1 + coord_cartesian(ylim = c(0,80000))
	f1 <- f1 + theme(aspect.ratio=1/1.61803398875,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=14),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	f1 <- f1 + labs(x=expression(paste("D"," (m)")),y=expression(paste("AGB"," (kg)")))
#	ggExtra::ggMarginal(f1,type = "histogram",alpha=0.75)
	ggsave("f1.pdf",plot=f1,scale=1)

	f1a <- ggplot(data=data,aes(x=agb))
	f1a <- f1a + geom_histogram(binwidth=2500,boundary=0,color='black',alpha=0.75)
	f1a <- f1a + theme(aspect.ratio=0.125/1.61803398875,axis.title.x=element_blank(),axis.title.y=element_blank(),panel.grid.minor = element_blank(),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"),text=element_text(family="CMU Serif",size=14))
	f1a <- f1a + scale_x_continuous(breaks=c(0,20000,40000,60000,80000),labels = function(x){paste0(x/1000)})
	f1a <- f1a + scale_y_continuous(breaks=c(0,1500,3000))
	ggsave("f1a.pdf",plot=f1a,scale=1)

	f1b <- ggplot(data=data,aes(x=d))
	f1b <- f1b + geom_histogram(binwidth=0.1,boundary=0,color='black',alpha=0.75)
	f1b <- f1b + theme(aspect.ratio=0.125/1.61803398875,axis.title.x=element_blank(),axis.title.y=element_blank(),panel.grid.minor = element_blank(),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"),text=element_text(family="CMU Serif",size=14))
	f1b <- f1b + scale_x_continuous(breaks=c(0,0.5,1.0,1.5,2.0))
	f1b <- f1b + scale_y_continuous(breaks=c(0,600,1200))
	ggsave("f1b.pdf",plot=f1b,scale=1)

	f1c <- ggplot(data=data,aes(x=h))
	f1c <- f1c + geom_histogram(binwidth=5,boundary=0,color='black',alpha=0.75)
	f1c <- f1c + theme(aspect.ratio=0.125/1.61803398875,axis.title.x=element_blank(),axis.title.y=element_blank(),panel.grid.minor = element_blank(),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"),text=element_text(family="CMU Serif",size=14))
	f1c <- f1c + scale_x_continuous(breaks=c(0,15,30,45,60,75))
	f1c <- f1c + scale_y_continuous(breaks=c(0,400,800))
	ggsave("f1c.pdf",plot=f1c,scale=1)

	f1d <- ggplot(data=data,aes(x=rho))
	f1d <- f1d + geom_histogram(binwidth=50,boundary=0,color='black',alpha=0.75)
	f1d <- f1d + theme(aspect.ratio=0.125/1.61803398875,axis.title.x=element_blank(),axis.title.y=element_blank(),panel.grid.minor = element_blank(),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"),text=element_text(family="CMU Serif",size=14))
	f1d <- f1d + scale_x_continuous(limits=c(0,1200),breaks=c(0,300,600,900,1200))
	f1d <- f1d + scale_y_continuous(breaks=c(0,250,500))
	ggsave("f1d.pdf",plot=f1d,scale=1)
}

plotFig2 <- function(data,alpha,runs,ncpus)
{
	func_d <- log(agb) ~ log(d)
	model_d <- fitOLS(data,func_d)
	d_bresults <- bootOLS(data,func_d,runs,ncpus)
	d_b0_cis <- boot.ci(d_bresults,index=1,conf=0.95,type="bca")
	d_b1_cis <- boot.ci(d_bresults,index=2,conf=0.95,type="bca")
	d_b0_lower <- d_b0_cis$bca[4]
	d_b0_upper <- d_b0_cis$bca[5]
	d_b1_lower <- d_b1_cis$bca[4]
	d_b1_upper <- d_b1_cis$bca[5]
	#
	func_h <- log(agb) ~ log(h)
	model_h <- fitOLS(data,func_h)
	h_bresults <- bootOLS(data,func_h,runs,ncpus)
	h_b0_cis <- boot.ci(h_bresults,index=1,conf=0.95,type="bca")
	h_b1_cis <- boot.ci(h_bresults,index=2,conf=0.95,type="bca")
	h_b0_lower <- h_b0_cis$bca[4]
	h_b0_upper <- h_b0_cis$bca[5]
	h_b1_lower <- h_b1_cis$bca[4]
	h_b1_upper <- h_b1_cis$bca[5]
	#
	colours <- colorRampPalette(brewer.pal(8,"Dark2"))(length(levels(data$study)))
	colScale <- scale_colour_manual(name="study",values="colours")
	#######
	##B ~ D
	#######
	x_d <- seq(-4,max(log(data$d))*2,length.out=50)
	x_d <- data.frame(x_d)
	colnames(x_d) <- c("d")
	yhat_d <- coefficients(model_d)[1] + coefficients(model_d)[2] * x_d
	df <- data.frame(x_d,yhat_d)
	colnames(df) <- c("x","y")
	f2a <- ggplot()
	f2a <- f2a + geom_point(aes(x=log(data$d),y=log(data$agb),color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f2a <- f2a + geom_line(data=df,aes(x,y),colour="black",alpha=0.75)
	f2a <- f2a + geom_segment(aes(x=-3.1,xend=-2.9,y=9.75,yend=9.75),colour="black")
	f2a <- f2a + scale_colour_manual(name="study",values=colours)
	f2a <- f2a + coord_cartesian(xlim = c(-3,0.75),ylim=c(0,11))
	f2a <- f2a + annotate("text", x=-1.75, y=10.09, label = deparse(bquote(hat(beta[0]) ==~ .(format(round(coefficients(model_d)[[1]],3),nsmall=3)) ~ "(" * .(format(round(d_b0_lower,3),nsmall=3)) * "," ~ .(format(round(d_b0_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=8.5,family="CMU Serif")
	f2a <- f2a + annotate("text", x=-1.75, y=9.19, label = deparse(bquote(hat(beta[1]) ==~ .(format(round(coefficients(model_d)[[2]],3),nsmall=3)) ~ "(" * .(format(round(d_b1_lower,3),nsmall=3)) * "," ~ .(format(round(d_b1_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=8.5,family="CMU Serif")
	f2a <- f2a + annotate("text", x=-2.35, y=8.29, label = deparse(bquote(s ==~ .(format(round(summary(model_d)$sigma,3),nsmall=3)))),parse=TRUE,size=8,5,family="CMU Serif")
	f2a <- f2a + theme(legend.position=c(0.012,0.92),legend.justification=c(0,1),legend.background = element_rect(fill=alpha('grey', 0)),legend.key=element_blank(),legend.text.align=0,legend.title=element_blank(),plot.title=element_text(hjust=0.5),aspect.ratio=1,text=element_text(family="CMU Serif",size=30),axis.title.x=element_blank(),axis.title.y=element_blank(),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f2a.pdf",plot=f2a,scale=1)
	#
	f2b <- ggplot()
	f2b <- f2b + geom_point(aes(model_d$fitted.values,resid(model_d),color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f2b <- f2b + geom_hline(yintercept=0,linetype="dashed",color="black",alpha=0.75)
	f2b <- f2b + scale_colour_manual(name="study",values=colours)
	f2b <- f2b + theme(plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=30),axis.text.x = element_text(colour="black"),axis.text.y = element_text(colour="black"))
	ggsave("f2b.pdf",plot=f2b,scale=1)
	#
	f2c <- ggplot()
	f2c <- f2c + geom_point(aes(x=qqnorm((log(data$agb)-yhatOLSLog(data,model_d))/summary(model_d)$sigma,plot.it=FALSE)$x,y=qqnorm((log(data$agb)-yhatOLSLog(data,model_d))/summary(model_d)$sigma,plot.it=FALSE)$y,color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f2c <- f2c + scale_colour_manual(name="study",values=colours)
	f2c <- f2c + geom_abline(linetype="dashed",colour="black",alpha=0.75)
	f2c <- f2c + scale_y_continuous(breaks=c(-6,-4,-2,0,2,4))
	f2c <- f2c + theme(plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=30),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f2c.pdf",plot=f2c)
	#######
	##B ~ H
	#######
	x_h <- seq(0,max(log(data$h))*2,length.out=10)
	x_h <- data.frame(x_h)
	colnames(x_h) <- c("h")
	yhat_h <- coefficients(model_h)[1] + coefficients(model_h)[2] * x_h
	df <- data.frame(x_h,yhat_h)
	colnames(df) <- c("x","y")
	f2d <- ggplot()
	f2d <- f2d + geom_point(aes(x=log(data$h),y=log(data$agb),color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f2d <- f2d + geom_line(data=df,aes(x,y),colour="black",alpha=0.75)
	f2d <- f2d + geom_segment(aes(x=0.15,xend=0.35,y=9.75,yend=9.75),colour="black")
	f2d <- f2d + scale_colour_manual(name="study",values=colours)
	f2d <- f2d + coord_cartesian(xlim = c(0.25,4.25),ylim=c(0,11))
	f2d <- f2d + annotate("text", x=1.919, y=10.09, label = deparse(bquote(hat(beta[0]) ==~ .(format(round(coefficients(model_h)[[1]],3),nsmall=3))~"(" * .(format(round(h_b0_lower,3),nsmall=3)) ~ .(format(round(h_b0_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=8.5,family="CMU Serif")
	f2d <- f2d + annotate("text", x=1.686, y=9.19, label = deparse(bquote(hat(beta[1]) ==~ .(format(round(coefficients(model_h)[[2]],3),nsmall=3)) ~ "(" * .(format(round(h_b1_lower,3),nsmall=3)) * "," ~ .(format(round(h_b1_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=8.5,family="CMU Serif")
	f2d <- f2d + annotate("text", x=1.053, y=8.20, label = deparse(bquote(s ==~ .(format(round(summary(model_h)$sigma,3),nsmall=3)))),parse=TRUE,size=8.5,family="CMU Serif")
	f2d <- f2d + theme(legend.position=c(0.012,0.92),legend.justification=c(0,1),legend.background = element_rect(fill=alpha('grey', 0)),legend.key=element_blank(),legend.text.align=0,legend.title=element_blank(),plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=30),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f2d.pdf",plot=f2d,scale=1)
	#
	f2e <- ggplot()
	f2e <- f2e + geom_point(aes(model_h$fitted.values,resid(model_h),color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f2e <- f2e + geom_hline(yintercept=0,linetype="dashed",color="black",alpha=0.75)
	f2e <- f2e + scale_colour_manual(name="study",values=colours)
	f2e <- f2e + scale_x_continuous(breaks=c(0,3,6,9))
	f2e <- f2e + theme(plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=30),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f2e.pdf",plot=f2e,scale=1)
	#
	f2f <- ggplot()
	f2f <- f2f + geom_point(aes(x=qqnorm((log(data$agb)-yhatOLSLog(data,model_h))/summary(model_h)$sigma,plot.it=FALSE)$x,y=qqnorm((log(data$agb)-yhatOLSLog(data,model_h))/summary(model_h)$sigma,plot.it=FALSE)$y,color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f2f <- f2f + scale_colour_manual(name="study",values=colours)
	f2f <- f2f + geom_abline(linetype="dashed",colour="black",alpha=0.75)
	f2f <- f2f + theme(plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=30),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f2f.pdf",plot=f2f)
}

plotFig3 <- function(data,alpha,runs,ncpus)
{
	#
	func_drho <- log(agb) ~ log(d) + log(rho)
	model_drho <- fitOLS(data,func_drho)
	drho_bresults <- bootOLS(data,func_drho,runs,ncpus)
	drho_b0_cis <- boot.ci(drho_bresults,index=1,conf=0.95,type="bca")
	drho_b1_cis <- boot.ci(drho_bresults,index=2,conf=0.95,type="bca")
	drho_b2_cis <- boot.ci(drho_bresults,index=3,conf=0.95,type="bca")
	drho_b0_lower <- drho_b0_cis$bca[4]
	drho_b0_upper <- drho_b0_cis$bca[5]
	drho_b1_lower <- drho_b1_cis$bca[4]
	drho_b1_upper <- drho_b1_cis$bca[5]
	drho_b2_lower <- drho_b2_cis$bca[4]
	drho_b2_upper <- drho_b2_cis$bca[5]
	#
	func_dh <- log(agb) ~ log(d) + log(h)
	model_dh <- fitOLS(data,func_dh)
	dh_bresults <- bootOLS(data,func_dh,runs,ncpus)
	dh_b0_cis <- boot.ci(dh_bresults,index=1,conf=0.95,type="bca")
	dh_b1_cis <- boot.ci(dh_bresults,index=2,conf=0.95,type="bca")
	dh_b2_cis <- boot.ci(dh_bresults,index=3,conf=0.95,type="bca")
	dh_b0_lower <- dh_b0_cis$bca[4]
	dh_b0_upper <- dh_b0_cis$bca[5]
	dh_b1_lower <- dh_b1_cis$bca[4]
	dh_b1_upper <- dh_b1_cis$bca[5]
	dh_b2_lower <- dh_b2_cis$bca[4]
	dh_b2_upper <- dh_b2_cis$bca[5]
	#
	func_dhrho <- log(agb) ~ log(d) + log(h) + log(rho)
	model_dhrho <- fitOLS(data,func_dhrho)
	dhrho_bresults <- bootOLS(data,func_dhrho,runs,ncpus)
	dhrho_b0_cis <- boot.ci(dhrho_bresults,index=1,conf=0.95,type="bca")
	dhrho_b1_cis <- boot.ci(dhrho_bresults,index=2,conf=0.95,type="bca")
	dhrho_b2_cis <- boot.ci(dhrho_bresults,index=3,conf=0.95,type="bca")
	dhrho_b3_cis <- boot.ci(dhrho_bresults,index=4,conf=0.95,type="bca")
	dhrho_b0_lower <- dhrho_b0_cis$bca[4]
	dhrho_b0_upper <- dhrho_b0_cis$bca[5]
	dhrho_b1_lower <- dhrho_b1_cis$bca[4]
	dhrho_b1_upper <- dhrho_b1_cis$bca[5]
	dhrho_b2_lower <- dhrho_b2_cis$bca[4]
	dhrho_b2_upper <- dhrho_b2_cis$bca[5]
	dhrho_b3_lower <- dhrho_b3_cis$bca[4]
	dhrho_b3_upper <- dhrho_b3_cis$bca[5]
	#
	colours <- colorRampPalette(brewer.pal(8,"Dark2"))(length(levels(data$study)))
	colScale <- scale_colour_manual(name="study",values="colours")
	#############
	##B ~ D * rho
	#############
	f3a <- ggplot()
	f3a <- f3a + geom_point(aes(x=model_drho$fitted.values,y=log(data$agb),color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f3a <- f3a + geom_abline(aes(slope=1,intercept=0),colour="black",linetype="dashed",alpha=0.75)
	f3a <- f3a + geom_segment(aes(x=0.845,xend=1.245,y=11.35,yend=11.35),colour="black",linetype="dashed",alpha=1)
	f3a <- f3a + scale_colour_manual(name="study",values=colours)
	f3a <- f3a + annotate("text", x=1.835,y= 11.4, label="1:1",size=9,family="CMU Serif")
	f3a <- f3a + annotate("text", x=4.07, y=10.6, label = deparse(bquote(hat(beta[0]) ==~ .(format(round(coefficients(model_drho)[[1]],3),nsmall=3)) ~ "(" * .(format(round(drho_b0_lower,3),nsmall=3)) * "," ~ .(format(round(drho_b0_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=9,family="CMU Serif")
	f3a <- f3a + annotate("text", x=4.07, y=9.7, label = deparse(bquote(hat(beta[1]) ==~ .(format(round(coefficients(model_drho)[[2]],3),nsmall=3)) ~ "(" * .(format(round(drho_b1_lower,3),nsmall=3)) * "," ~ .(format(round(drho_b1_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=9,family="CMU Serif")
	f3a <- f3a + annotate("text", x=4.07, y=8.8, label = deparse(bquote(hat(beta[2]) ==~ .(format(round(coefficients(model_drho)[[3]],3),nsmall=3)) ~ "(" * .(format(round(drho_b2_lower,3),nsmall=3)) * "," ~ .(format(round(drho_b2_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=9,family="CMU Serif")
	f3a <- f3a + annotate("text", x=2.32, y=7.9, label = deparse(bquote(s ==~ .(format(round(summary(model_drho)$sigma,3),nsmall=3)))),parse=TRUE,size=9,family="CMU Serif")
	f3a <- f3a + theme(legend.position=c(0.012,0.92),legend.justification=c(0,1),legend.background = element_rect(fill=alpha('grey', 0)),legend.key=element_blank(),legend.text.align=0,legend.title=element_blank(),plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=36),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f3a.pdf",plot=f3a,scale=1)
	#
	f3b <- ggplot()
	f3b <- f3b + geom_point(aes(model_drho$fitted.values,resid(model_drho),color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f3b <- f3b + geom_hline(yintercept=0,linetype="dashed",color="black",alpha=0.75)
	f3b <- f3b + scale_colour_manual(name="study",values=colours)
	f3b <- f3b + theme(plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=36),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f3b.pdf",plot=f3b,scale=1)
	#
	f3c <- ggplot()
	f3c <- f3c + geom_point(aes(x=qqnorm((log(data$agb)-yhatOLSLog(data,model_drho))/summary(model_drho)$sigma,plot.it=FALSE)$x,y=qqnorm((log(data$agb)-yhatOLSLog(data,model_drho))/summary(model_drho)$sigma,plot.it=FALSE)$y,color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f3c <- f3c + scale_colour_manual(name="study",values=colours)
	f3c <- f3c + geom_abline(linetype="dashed",colour="black",alpha=0.75)
	f3c <- f3c + theme(plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=36),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f3c.pdf",plot=f3c)
	###########
	##B ~ D * H
	###########
	f3d <- ggplot()
	f3d <- f3d + geom_point(aes(x=model_dh$fitted.values,y=log(data$agb),color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f3d <- f3d + geom_abline(aes(slope=1,intercept=0),colour="black",linetype="dashed",alpha=0.75)
	f3d <- f3d + geom_segment(aes(x=0.845,xend=1.245,y=11.35,yend=11.35),colour="black",linetype="dashed",alpha=1)
	f3d <- f3d + scale_colour_manual(name="study",values=colours)
	f3d <- f3d + annotate("text", x=1.835,y= 11.4, label="1:1",size=9,family="CMU Serif")
	f3d <- f3d + annotate("text", x=4.07, y=10.6, label = deparse(bquote(hat(beta[0]) ==~ .(format(round(coefficients(model_dh)[[1]],3),nsmall=3)) ~ "(" * .(format(round(dh_b0_lower,3),nsmall=3)) * "," ~ .(format(round(dh_b0_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=9,family="CMU Serif")
	f3d <- f3d + annotate("text", x=4.07, y=9.7, label = deparse(bquote(hat(beta[1]) ==~ .(format(round(coefficients(model_dh)[[2]],3),nsmall=3)) ~ "(" * .(format(round(dh_b1_lower,3),nsmall=3)) * "," ~ .(format(round(dh_b1_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=9,family="CMU Serif")
	f3d <- f3d + annotate("text", x=4.07, y=8.8, label = deparse(bquote(hat(beta[2]) ==~ .(format(round(coefficients(model_dh)[[3]],3),nsmall=3)) ~ "(" * .(format(round(dh_b2_lower,3),nsmall=3)) * "," ~ .(format(round(dh_b2_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=9,family="CMU Serif")
	f3d <- f3d + annotate("text", x=2.32, y=7.9, label = deparse(bquote(s ==~ .(format(round(summary(model_dh)$sigma,3),nsmall=3)))),parse=TRUE,size=9,family="CMU Serif")
	f3d <- f3d + theme(legend.position=c(0.012,0.92),legend.justification=c(0,1),legend.background = element_rect(fill=alpha('grey', 0)),legend.key=element_blank(),legend.text.align=0,legend.title=element_blank(),plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=36),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f3d.pdf",plot=f3d,scale=1)
	#
	f3e <- ggplot()
	f3e <- f3e + geom_point(aes(model_dh$fitted.values,resid(model_dh),color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f3e <- f3e + geom_hline(yintercept=0,linetype="dashed",color="black",alpha=0.75)
	f3e <- f3e + scale_colour_manual(name="study",values=colours)
	f3e <- f3e + theme(plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=36),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f3e.pdf",plot=f3e,scale=1)
	#
	f3f <- ggplot()
	f3f <- f3f + geom_point(aes(x=qqnorm((log(data$agb)-yhatOLSLog(data,model_dh))/summary(model_dh)$sigma,plot.it=FALSE)$x,y=qqnorm((log(data$agb)-yhatOLSLog(data,model_dh))/summary(model_dh)$sigma,plot.it=FALSE)$y,color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f3f <- f3f + scale_colour_manual(name="study",values=colours)
	f3f <- f3f + geom_abline(linetype="dashed",colour="black",alpha=0.75)
	f3f <- f3f + scale_y_continuous(breaks=c(-6,-4,-2,0,2,4))
	f3f <- f3f + theme(plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=36),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f3f.pdf",plot=f3f)
	#################
	##B ~ D * H * rho
	#################
	f3g <- ggplot()
	f3g <- f3g + geom_point(aes(x=model_dhrho$fitted.values,y=log(data$agb),color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f3g <- f3g + geom_abline(aes(slope=1,intercept=0),colour="black",linetype="dashed",alpha=0.75)
	f3g <- f3g + geom_segment(aes(x=0.245,xend=0.645,y=11.35,yend=11.35),colour="black",linetype="dashed",alpha=1)
	f3g <- f3g + scale_colour_manual(name="study",values=colours)
	f3g <- f3g + annotate("text", x=1.1,y= 11.4, label="1:1",size=9,family="CMU Serif")
	f3g <- f3g + annotate("text", x=3.46, y=10.6, label = deparse(bquote(hat(beta[0]) ==~ .(format(round(coefficients(model_dhrho)[[1]],3),nsmall=3)) ~ "(" * .(format(round(dhrho_b0_lower,3),nsmall=3)) * "," ~ .(format(round(dhrho_b0_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=9,family="CMU Serif")
	f3g <- f3g + annotate("text", x=3.46, y=9.7, label = deparse(bquote(hat(beta[1]) ==~ .(format(round(coefficients(model_dhrho)[[2]],3),nsmall=3)) ~ "(" * .(format(round(dhrho_b1_lower,3),nsmall=3)) * "," ~ .(format(round(dhrho_b1_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=9,family="CMU Serif")
	f3g <- f3g + annotate("text", x=3.46, y=8.8, label = deparse(bquote(hat(beta[2]) ==~ .(format(round(coefficients(model_dhrho)[[3]],3),nsmall=3)) ~ "(" * .(format(round(dhrho_b2_lower,3),nsmall=3)) * "," ~ .(format(round(dhrho_b2_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=9,family="CMU Serif")
	f3g <- f3g + annotate("text", x=3.46, y=7.9, label = deparse(bquote(hat(beta[3]) ==~ .(format(round(coefficients(model_dhrho)[[4]],3),nsmall=3)) ~ "(" * .(format(round(dhrho_b3_lower,3),nsmall=3)) * "," ~ .(format(round(dhrho_b3_upper,3),nsmall=3)) * ")" )),parse=TRUE,size=9,family="CMU Serif")
	f3g <- f3g + annotate("text", x=1.62, y=7.0, label = deparse(bquote(s ==~ .(format(round(summary(model_dhrho)$sigma,3),nsmall=3)))),parse=TRUE,size=9,family="CMU Serif")
	f3g <- f3g + theme(legend.position=c(0.012,0.92),legend.justification=c(0,1),legend.background = element_rect(fill=alpha('grey', 0)),legend.key=element_blank(),legend.text.align=0,legend.title=element_blank(),plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=36),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f3g.pdf",plot=f3g,scale=1)
	#
	f3h <- ggplot()
	f3h <- f3h + geom_point(aes(model_dhrho$fitted.values,resid(model_dhrho),color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f3h <- f3h + geom_hline(yintercept=0,linetype="dashed",color="black",alpha=0.75)
	f3h <- f3h + scale_colour_manual(name="study",values=colours)
	f3h <- f3h + theme(plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=36),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f3h.pdf",plot=f3h,scale=1)
	#
	f3i <- ggplot()
	f3i <- f3i + geom_point(aes(x=qqnorm((log(data$agb)-yhatOLSLog(data,model_dhrho))/summary(model_dhrho)$sigma,plot.it=FALSE)$x,y=qqnorm((log(data$agb)-yhatOLSLog(data,model_dhrho))/summary(model_dhrho)$sigma,plot.it=FALSE)$y,color=data$study),size=2,alpha=0.8,stroke=0,show.legend=FALSE)
	f3i <- f3i + scale_colour_manual(name="study",values=colours)
	f3i <- f3i + geom_abline(linetype="dashed",colour="black",alpha=0.75)
	f3i <- f3i + scale_y_continuous(breaks=c(-6,-4,-2,0,2,4,6))
	f3i <- f3i + theme(plot.title=element_text(hjust=0.5),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=36),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f3i.pdf",plot=f3i)
}

plotFig4 <- function(data)
{
	func_d <- log(agb) ~ log(d)
	func_dh <- log(agb) ~ log(d) + log(h)
	func_dhrho <- log(agb) ~ log(d) + log(h) + log(rho)
	#
	results_d <- crossValidateOLS(data,func_d)
	results_dh <- crossValidateOLS(data,func_dh)
	results_dhrho <- crossValidateOLS(data,func_dhrho)
	#
	f4 <- ggplot()
	f4 <- f4 + geom_hline(yintercept=0,linetype="solid",color="black",size=0.5,alpha=1)
	#
	f4 <- f4 + geom_boxplot(aes(rep(0.5+(2/8)),results_d[[1]][[1]],color="d"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(0.5+(4/8)),results_dh[[1]][[1]],color="dh"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(0.5+(6/8)),results_dhrho[[1]][[1]],color="dhrho"),width=1/8)
	#
	f4 <- f4 + geom_boxplot(aes(rep(1.5+(2/8)),results_d[[1]][[2]],color="d"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(1.5+(4/8)),results_dh[[1]][[2]],color="dh"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(1.5+(6/8)),results_dhrho[[1]][[2]],color="dhrho"),width=1/8)
	#
	f4 <- f4 + geom_boxplot(aes(rep(2.5+(2/8)),results_d[[1]][[3]],color="d"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(2.5+(4/8)),results_dh[[1]][[3]],color="dh"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(2.5+(6/8)),results_dhrho[[1]][[3]],color="dhrho"),width=1/8)
	#
	f4 <- f4 + geom_boxplot(aes(rep(3.5+(2/8)),results_d[[1]][[4]],color="d"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(3.5+(4/8)),results_dh[[1]][[4]],color="dh"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(3.5+(6/8)),results_dhrho[[1]][[4]],color="dhrho"),width=1/8)
	#
	f4 <- f4 + geom_boxplot(aes(rep(4.5+(2/8)),results_d[[1]][[5]],color="d"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(4.5+(4/8)),results_dh[[1]][[5]],color="dh"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(4.5+(6/8)),results_dhrho[[1]][[5]],color="dhrho"),width=1/8)
	#
	f4 <- f4 + geom_boxplot(aes(rep(5.5+(2/8)),results_d[[1]][[6]],color="d"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(5.5+(4/8)),results_dh[[1]][[6]],color="dh"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(5.5+(6/8)),results_dhrho[[1]][[6]],color="dhrho"),width=1/8)
	#
	f4 <- f4 + geom_boxplot(aes(rep(6.5+(2/8)),results_d[[1]][[7]],color="d"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(6.5+(4/8)),results_dh[[1]][[7]],color="dh"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(6.5+(6/8)),results_dhrho[[1]][[7]],color="dhrho"),width=1/8)
	#
	f4 <- f4 + geom_boxplot(aes(rep(7.5+(2/8)),results_d[[1]][[8]],color="d"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(7.5+(4/8)),results_dh[[1]][[8]],color="dh"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(7.5+(6/8)),results_dhrho[[1]][[8]],color="dhrho"),width=1/8)
	#
	f4 <- f4 + geom_boxplot(aes(rep(8.5+(2/8)),results_d[[1]][[9]],color="d"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(8.5+(4/8)),results_dh[[1]][[9]],color="dh"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(8.5+(6/8)),results_dhrho[[1]][[9]],color="dhrho"),width=1/8)
	#
	f4 <- f4 + geom_boxplot(aes(rep(9.5+(2/8)),results_d[[1]][[10]],color="d"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(9.5+(4/8)),results_dh[[1]][[10]],color="dh"),width=1/8)
	f4 <- f4 + geom_boxplot(aes(rep(9.5+(6/8)),results_dhrho[[1]][[10]],color="dhrho"),width=1/8)
	#
	name1 <- as.expression(bquote(" AGB"=="f(D)  "))
	name2 <- as.expression(bquote(" AGB"=="f(D,H)  "))
	name3 <- as.expression(bquote(" AGB"=="f(D,H,"*rho["b"]*")  "))
	f4 <- f4 + scale_colour_manual(name="",values=c("d"="black","dh"="red","dhrho"="blue"),labels=c("d"=name1,"dh"=name2,"dhrho"=name3))
	f4 <- f4 + scale_x_continuous(breaks=c(1,2,3,4,5,6,7,8,9,10))
	f4 <- f4 + theme(legend.position="top",legend.background = element_rect(fill=alpha("white",0)),legend.key=element_blank(),legend.text.align=0,legend.title=element_blank(),legend.text=element_text(family="CMU Serif",size=13),axis.title.x=element_blank(),axis.title.y=element_blank(),aspect.ratio=1/1.61803398875,text=element_text(family="CMU Serif",size=13),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"),legend.margin=margin(t = 0, unit='cm'))
	ggsave("f4.pdf",plot=f4,scale=1)
}

plotFig5 <- function(data,alpha,runs,ncpus)
{
	func <- log(agb) ~ log(d) + log(h) + log(rho)
	#0
	d <- data[data$d >= 0,]
	m0 <- fitOLS(d,func)
	b0 <- bootOLS(d,func,runs,ncpus)
	b0_0_cis <- boot.ci(b0,index=1,conf=0.95,type='bca')
	b0_1_cis <- boot.ci(b0,index=2,conf=0.95,type='bca')
	b0_2_cis <- boot.ci(b0,index=3,conf=0.95,type='bca')
	b0_3_cis <- boot.ci(b0,index=4,conf=0.95,type='bca')
	#0.1
	d <- data[data$d >= 0.1,]
	m1 <- fitOLS(d,func)
	b1 <- bootOLS(d,func,runs,ncpus)
	b1_0_cis <- boot.ci(b1,index=1,conf=0.95,type='bca')
	b1_1_cis <- boot.ci(b1,index=2,conf=0.95,type='bca')
	b1_2_cis <- boot.ci(b1,index=3,conf=0.95,type='bca')
	b1_3_cis <- boot.ci(b1,index=4,conf=0.95,type='bca')
	#0.25
	d <- data[data$d >= 0.25,]
	m2 <- fitOLS(d,func)
	b2 <- bootOLS(d,func,runs,ncpus)
	b2_0_cis <- boot.ci(b2,index=1,conf=0.95,type='bca')
	b2_1_cis <- boot.ci(b2,index=2,conf=0.95,type='bca')
	b2_2_cis <- boot.ci(b2,index=3,conf=0.95,type='bca')
	b2_3_cis <- boot.ci(b2,index=4,conf=0.95,type='bca')
	#0.5
	d <- data[data$d >= 0.5,]
	m3 <- fitOLS(d,func)
	b3 <- bootOLS(d,func,runs,ncpus)
	b3_0_cis <- boot.ci(b3,index=1,conf=0.95,type='bca')
	b3_1_cis <- boot.ci(b3,index=2,conf=0.95,type='bca')
	b3_2_cis <- boot.ci(b3,index=3,conf=0.95,type='bca')
	b3_3_cis <- boot.ci(b3,index=4,conf=0.95,type='bca')
	#0.75
	d <- data[data$d >= 0.75,]
	m4 <- fitOLS(d,func)
	b4 <- bootOLS(d,func,runs,ncpus)
	b4_0_cis <- boot.ci(b4,index=1,conf=0.95,type='bca')
	b4_1_cis <- boot.ci(b4,index=2,conf=0.95,type='bca')
	b4_2_cis <- boot.ci(b4,index=3,conf=0.95,type='bca')
	b4_3_cis <- boot.ci(b4,index=4,conf=0.95,type='bca')
	#1
	d <- data[data$d >= 1,]
	m5 <- fitOLS(d,func)
	b5 <- bootOLS(d,func,runs,ncpus)
	b5_0_cis <- boot.ci(b5,index=1,conf=0.95,type='bca')
	b5_1_cis <- boot.ci(b5,index=2,conf=0.95,type='bca')
	b5_2_cis <- boot.ci(b5,index=3,conf=0.95,type='bca')
	b5_3_cis <- boot.ci(b5,index=4,conf=0.95,type='bca')
	###
	f5a <- ggplot()
	f5a <- f5a + geom_point(aes(x=0,y=coefficients(m0)[1]))
	f5a <- f5a + geom_point(aes(x=0.1,y=coefficients(m1)[1]))
	f5a <- f5a + geom_point(aes(x=0.25,y=coefficients(m2)[1]))
	f5a <- f5a + geom_point(aes(x=0.5,y=coefficients(m3)[1]))
	f5a <- f5a + geom_point(aes(x=0.75,y=coefficients(m4)[1]))
	f5a <- f5a + geom_point(aes(x=1,y=coefficients(m5)[1]))
	f5a <- f5a + geom_errorbar(aes(x=0,ymin=b0_0_cis$bca[4],ymax=b0_0_cis$bca[5]),width=0.09)
	f5a <- f5a + geom_errorbar(aes(x=0.1,ymin=b1_0_cis$bca[4],ymax=b1_0_cis$bca[5]),width=0.09)
	f5a <- f5a + geom_errorbar(aes(x=0.25,ymin=b2_0_cis$bca[4],ymax=b2_0_cis$bca[5]),width=0.09)
	f5a <- f5a + geom_errorbar(aes(x=0.5,ymin=b3_0_cis$bca[4],ymax=b3_0_cis$bca[5]),width=0.09)
	f5a <- f5a + geom_errorbar(aes(x=0.75,ymin=b4_0_cis$bca[4],ymax=b4_0_cis$bca[5]),width=0.09)
	f5a <- f5a + geom_errorbar(aes(x=1,ymin=b5_0_cis$bca[4],ymax=b5_0_cis$bca[5]),width=0.09)
	f5a <- f5a + scale_x_continuous(breaks=c(0,0.1,0.25,0.5,0.75,1))
	f5a <- f5a + theme(legend.title=element_blank(),plot.title=element_blank(),panel.grid.minor.x = element_blank(),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=21),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f5a.pdf",plot=f5a)
	###
	f5b <- ggplot()
	f5b <- f5b + geom_point(aes(x=0,y=coefficients(m0)[2]))
	f5b <- f5b + geom_point(aes(x=0.1,y=coefficients(m1)[2]))
	f5b <- f5b + geom_point(aes(x=0.25,y=coefficients(m2)[2]))
	f5b <- f5b + geom_point(aes(x=0.5,y=coefficients(m3)[2]))
	f5b <- f5b + geom_point(aes(x=0.75,y=coefficients(m4)[2]))
	f5b <- f5b + geom_point(aes(x=1,y=coefficients(m5)[2]))
	f5b <- f5b + geom_errorbar(aes(x=0,ymin=b0_1_cis$bca[4],ymax=b0_1_cis$bca[5]),width=0.09)
	f5b <- f5b + geom_errorbar(aes(x=0.1,ymin=b1_1_cis$bca[4],ymax=b1_1_cis$bca[5]),width=0.09)
	f5b <- f5b + geom_errorbar(aes(x=0.25,ymin=b2_1_cis$bca[4],ymax=b2_1_cis$bca[5]),width=0.09)
	f5b <- f5b + geom_errorbar(aes(x=0.5,ymin=b3_1_cis$bca[4],ymax=b3_1_cis$bca[5]),width=0.09)
	f5b <- f5b + geom_errorbar(aes(x=0.75,ymin=b4_1_cis$bca[4],ymax=b4_1_cis$bca[5]),width=0.09)
	f5b <- f5b + geom_errorbar(aes(x=1,ymin=b5_1_cis$bca[4],ymax=b5_1_cis$bca[5]),width=0.09)
	f5b <- f5b + scale_x_continuous(breaks=c(0,0.1,0.25,0.5,0.75,1))
	f5b <- f5b + theme(legend.title=element_blank(),plot.title=element_blank(),panel.grid.minor.x = element_blank(),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=21),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f5b.pdf",plot=f5b)
	###
	f5c <- ggplot()
	f5c <- f5c + geom_point(aes(x=0,y=coefficients(m0)[3]))
	f5c <- f5c + geom_point(aes(x=0.1,y=coefficients(m1)[3]))
	f5c <- f5c + geom_point(aes(x=0.25,y=coefficients(m2)[3]))
	f5c <- f5c + geom_point(aes(x=0.5,y=coefficients(m3)[3]))
	f5c <- f5c + geom_point(aes(x=0.75,y=coefficients(m4)[3]))
	f5c <- f5c + geom_point(aes(x=1,y=coefficients(m5)[3]))
	f5c <- f5c + geom_errorbar(aes(x=0,ymin=b0_2_cis$bca[4],ymax=b0_2_cis$bca[5]),width=0.09)
	f5c <- f5c + geom_errorbar(aes(x=0.1,ymin=b1_2_cis$bca[4],ymax=b1_2_cis$bca[5]),width=0.09)
	f5c <- f5c + geom_errorbar(aes(x=0.25,ymin=b2_2_cis$bca[4],ymax=b2_2_cis$bca[5]),width=0.09)
	f5c <- f5c + geom_errorbar(aes(x=0.5,ymin=b3_2_cis$bca[4],ymax=b3_2_cis$bca[5]),width=0.09)
	f5c <- f5c + geom_errorbar(aes(x=0.75,ymin=b4_2_cis$bca[4],ymax=b4_2_cis$bca[5]),width=0.09)
	f5c <- f5c + geom_errorbar(aes(x=1,ymin=b5_2_cis$bca[4],ymax=b5_2_cis$bca[5]),width=0.09)
	f5c <- f5c + labs(x="D-threshold (m)",y=expression(paste(beta[2])))#,title=expression(paste("LLT-OLS: ln(AGB) = ",beta[0]," + ",beta[1]," ln(D)"," + ",beta[2]," ln(H)"," + ",beta[3]," ln(",rho["b"],") + ",epsilon,"  [",epsilon," ~ N(0,",sigma^2,")]")))
	f5c <- f5c + scale_x_continuous(breaks=c(0,0.1,0.25,0.5,0.75,1))
	f5c <- f5c + theme(legend.title=element_blank(),plot.title=element_blank(),panel.grid.minor.x = element_blank(),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=21),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f5c.pdf",plot=f5c)
	###
	f5d <- ggplot()
	f5d <- f5d + geom_point(aes(x=0,y=coefficients(m0)[4]))
	f5d <- f5d + geom_point(aes(x=0.1,y=coefficients(m1)[4]))
	f5d <- f5d + geom_point(aes(x=0.25,y=coefficients(m2)[4]))
	f5d <- f5d + geom_point(aes(x=0.5,y=coefficients(m3)[4]))
	f5d <- f5d + geom_point(aes(x=0.75,y=coefficients(m4)[4]))
	f5d <- f5d + geom_point(aes(x=1,y=coefficients(m5)[4]))
	f5d <- f5d + geom_errorbar(aes(x=0,ymin=b0_3_cis$bca[4],ymax=b0_3_cis$bca[5]),width=0.09)
	f5d <- f5d + geom_errorbar(aes(x=0.1,ymin=b1_3_cis$bca[4],ymax=b1_3_cis$bca[5]),width=0.09)
	f5d <- f5d + geom_errorbar(aes(x=0.25,ymin=b2_3_cis$bca[4],ymax=b2_3_cis$bca[5]),width=0.09)
	f5d <- f5d + geom_errorbar(aes(x=0.5,ymin=b3_3_cis$bca[4],ymax=b3_3_cis$bca[5]),width=0.09)
	f5d <- f5d + geom_errorbar(aes(x=0.75,ymin=b4_3_cis$bca[4],ymax=b4_3_cis$bca[5]),width=0.09)
	f5d <- f5d + geom_errorbar(aes(x=1,ymin=b5_3_cis$bca[4],ymax=b5_3_cis$bca[5]),width=0.09)
	f5d <- f5d + labs(x="D-threshold (m)",y=expression(paste(beta[3])))#,title=expression(paste("LLT-OLS: ln(AGB) = ",beta[0]," + ",beta[1]," ln(D)"," + ",beta[2]," ln(H)"," + ",beta[3]," ln(",rho["b"],") + ",epsilon,"  [",epsilon," ~ N(0,",sigma^2,")]")))
	f5d <- f5d + scale_x_continuous(breaks=c(0,0.1,0.25,0.5,0.75,1))
	f5d <- f5d + theme(legend.title=element_blank(),plot.title=element_blank(),panel.grid.minor.x = element_blank(),aspect.ratio=1,axis.title.x=element_blank(),axis.title.y=element_blank(),text=element_text(family="CMU Serif",size=21),axis.text.x = element_text(colour="black"), axis.text.y = element_text(colour="black"))
	ggsave("f5d.pdf",plot=f5d)
}


rm(list=ls())
library(testthat)
library(ShipPowerModel)

context("Test common input functions for resistance-power methods")

test_that("calclwl works",
          {
            shipType<-c("tanker", "ro.ro", "misc")
            customTypes<-c("zamboni","penguin","apple")
            tankerBulkCarrierGCargoShipTypes<-c("zamboni","sled")
            roroPaxShipTypes<-c("penguin", "duck", "robin")
            lbp<-rep(100,3)
            lwl<-lbp*c(1.02,1.035,1.01)

            expect_equal(calclwl(shipType,lbp),
                         lwl)

            expect_equal(calclwl(customTypes,
                                 lbp,
                                 tankerBulkCarrierGCargoShipTypes,
                                 roroPaxShipTypes),
                         lwl)

          }
        )

test_that("calcCb works",
          {
            maxDisplacement<-c(1,0.5,2,4)
            lwl<-c(1,1,1,2)
            breadth<-c(1,1,1,2)
            maxDraft<-c(1,1,1,2)

            cb<-c(1,0.5,1,0.5)

            expect_equal(calcCb(maxDisplacement,
                                lwl,
                                breadth,
                                maxDraft),
                         cb)
          }
        )

test_that("calcPropNum works",
          {
            expect_equal(calcPropNum(c("tanker","passenger","fish")),
                         c(1,2,1)
                         )

            expect_equal(calcPropNum(shipType = c("tanker","passenger","fish"),
                                     paxTugShipTypes = c("tanker","fish")
                                     ),
                         c(2,1,2)
                        )
          }
         )

test_that("calcCbw Works",
          {
           expect_equal(calcCbw(Cb=c(1, 0.75, 0.5),
                                actualDraft=c(1,.75,0.5),
                                maxDraft=c(1, 1, 1)
                                ),
                        c(0.99,
                          1-(1-0.75)*(1/0.75)^(1/3),
                          1-(1-0.5)*(1/0.5)^(1/3)
                          )
                        )
          }
         )

test_that("calcCm works",
          {
            shipType<-shipType<-c("tanker","tug", "passenger", "misc")
            Cbw<-rep(0.25,0.5,0.75, 0.99)
            maxDraft<-rep(1,4)
            actualDraft<-c(0.25,0.5,0.75,1)
            kirstCoefs<-c(0.995, 0.92, 0.95, 0.98)

            tankerBulkCarrierShipTypes=c("octopus","squid","snail","clam")
            tugShipTypes=c("aligator","snake", "turtle")
            roroPaxShipTypes=c("apple","cucumber","squash")
            altShips<- c("octopus", "turtle", "cucumber","zamboni")

            expect_equal(calcCm(shipType = shipType,
                                Cbw = Cbw,
                                maxDraft = maxDraft,
                                actualDraft = actualDraft,
                                CmEquationType = "kristensen"
                                ),
                         1-(maxDraft/actualDraft)*(1 - kirstCoefs)

                        )

            expect_equal(calcCm(shipType = altShips,
                                Cbw = Cbw,
                                maxDraft = maxDraft,
                                actualDraft = actualDraft,
                                CmEquationType = "kristensen",
                                tankerBulkCarrierShipTypes,
                                tugShipTypes,
                                roroPaxShipTypes
                               ),
                         1-(maxDraft/actualDraft)*(1 - kirstCoefs)
                        )

            expect_equal(calcCm(shipType = shipType,
                                Cbw = Cbw,
                                maxDraft = maxDraft,
                                actualDraft = actualDraft,
                                CmEquationType = "BeNfOrD"
                                ),
                         0.977+0.085*(Cbw-0.6)
                        )

            expect_equal(calcCm(shipType = shipType,
                                Cbw = Cbw,
                                maxDraft = maxDraft,
                                actualDraft = actualDraft,
                                CmEquationType = "ScHnEeKlUtH"
                               ),
                         1.006-0.0056*Cbw^-3.56
                        )

})

test_that("calcTEU works",
          {
            shipType<-c("zamboni", rep("container.ship",3))
            dwt<-c(10000,35000,60000, 60001)

            output<-c(0,
                      (dwt[2]/15.19)^(1/0.9814),
                      (dwt[3]/28.81)^(1/0.902),
                      (dwt[4]/37)^(1/0.875)
                      )

            expect_equal(calcTEU(shipType = shipType,
                                 dwt = dwt),
                         output
                         )
          }
         )

#calcSubType====================================================================

test_that("calcSubType works for IMO ship types",
          {
            # Create Benchmark
            testIMOGHG3SubTypeDF<-data.table::data.table(
              shipType=c("bulk.carrier","chemical.tanker","container.ship",
                         "general.cargo","liquified.gas.tanker","oil.tanker","other.tanker",
                         "ferry.pax","cruise","ferry.ro.pax","reefer","ro.ro","vehicle.carrier",
                         "yacht","service.tug","miscellaneous.fishing","offshore","service.other","miscellaneous.other"
              ),
              DWT=c(50000,9000,NA,3000,15600, 119000,1000,NA,NA,NA,1000,NA, 24000,rep(NA,6)),
              Gross_Tonnage=c(rep(NA,7),3700,43000,1500,NA,6000,NA,10000,1000,300,4000,560,790),
              TEU=c(rep(NA,2),7900,rep(NA,16)),
              subType=c("bulk.carrier.handymax","chemical.tanker.small","container.ship.8000",
                        "general.cargo.5000","liquified.gas.tanker.20000","oil.tanker.aframax","other.tanker",
                        "ferry.pax.largest","cruise.60000","ferry.ro.pax.2000","reefer","ro.ro.largest","vehicle.carrier.30000",
                        "yacht","service.tug","miscellaneous.fishing","offshore","service.other","miscellaneous.other"
              )
            )

            #Run Calculation
            testIMOGHG3SubTypeDF[,newSubType:=calcSubType(shipType = shipType,
														  DWT=DWT,
                                                          GT= Gross_Tonnage,
                                                          TEU = TEU
            )
            ]

            #compare output against benchmark
            expect_equal(testIMOGHG3SubTypeDF$newSubType,
                         testIMOGHG3SubTypeDF$subType
            )
          }
)

test_that("calcSubType works for Starcrest ship types",
          {
            # Create Benchmark
            testSCSubTypeDF<-data.table::data.table(
              shipType=c("vehicle.carrier", "bulk.carrier","container.ship",
                         "cruise", "general.cargo", "service.tug",
                         "miscellaneous", "reefer", "ro.ro",
                         "tanker", "cruise.ed"
              ),
              DWT=c(1000, 1000, 1000,
                    1000, 1000, 1000,
                    1000, 1000, 1000,
                    45000, 500
              ),
              Gross_Tonnage=rep(NA,11),
              TEU=c(NA,NA, 3500, rep(NA,8)),
              nPassengers = c(rep(NA,10),3200),
              subType=c("vehicle.carrier", "bulk.carrier","container.ship.3000",
                        "cruise", "general.cargo", "tug",
                        "miscellaneous", "reefer", "ro.ro",
                        "tanker.handysize", "cruise.ed.3500"
              )
            )

            #Run Calculation
            testSCSubTypeDF[,newSubType:=calcSubType(shipType = shipType,
                                                     DWT = DWT,
                                                     GT= Gross_Tonnage,
                                                     TEU = TEU,
                                                     nPassengers = nPassengers,
                                                     method = "starcrest"
            )
            ]

            #compare output against benchmark
            expect_equal(testSCSubTypeDF$newSubType,
                         testSCSubTypeDF$subType
            )
          }
)

test_that("calcSubType works with input file",
          {
            # Create Benchmark
            tbl<-data.table(shipType = c("fruit","fruit","boat","boat"),
                            subType = c("apple","watermelon","canoe","kayak"),
                            sizeMin = c(1,2.1,2,0),
                            sizeMax = c(2,5,3,2),
                            sizeUnits = c("Gross_Tonnage","Gross_Tonnage","Number_of_Passengers","Number_of_Passengers")
                            )

            tmpName<-tempfile()
            fwrite(tbl, file = tmpName)

            # Run Calculation
            testOut<-calcSubType(shipType = c("boat","boat","fruit","fruit"),
                                 GT = c(NA, NA, 1.2,3),
                                 nPassengers = c(1, 2, NA, NA),
                                 DWT = c(NA,NA,NA,NA),
                                 TEU = c(NA,NA,NA,NA),
                                 inputTableLocation = tmpName
                                 )

            # Compare output against benchmark
            expect_equal(testOut$subType,
                         c("kayak","canoe","apple","watermelon"))

            #delete that temporary file
            file.remove(tmpName)
            }
          )

#calcShipType==================================================================
test_that("calcShipType works",{
  # Create Benchmark
  testShipTypeDF<-data.table::data.table(
    Vessel_Type=c("Chip Carrier","Fully Cellular Container","Cruise Ship","Ferry","Ore/Oil Carrier",
                  "General Cargo/Passenger (Inland)","LPG Carrier","Tug, Naval Auxiliary","Multi-Purpose",
                  "Replenishment Tanker","Pipe Laying Barge","Reefer","Ro-Ro Cargo (Inland)","Small Harbor Tug",
                  "Chemical & Oil Carrier","Asphalt & Bitumen Carrier","FPSO","Oil & Liquid Gas Carrier","Recreational"
    ),
    imoShipType=c("bulk.carrier","container.ship","cruise","ferry.ro.pax","general.cargo","general.cargo",
                  "liquified.gas.tanker","service.tug","miscellaneous.other","other.tanker","offshore","reefer",
                  "ro.ro","service.tug","chemical.tanker","other.tanker","offshore","oil.tanker","yacht"
    ),
    starcrestShipType=c("bulk.carrier","container.ship","cruise","cruise.ed","general.cargo","general.cargo",
                        "tanker","service.tug","miscellaneous","tanker","miscellaneous","reefer","ro.ro","service.tug",
                        "tanker","tanker","tanker","tanker","cruise.ed"
    )
  )

  #Run Calculation
  testShipTypeDF[,newIMOShipType:=calcShipType(Vessel_Type,method="imo")]

  testShipTypeDF[,newStarcrestShipType:=calcShipType(Vessel_Type,method="starcrest")]

  #compare output against benchmark
  #IMO Method
  expect_equal(testShipTypeDF$newIMOShipType,
               testShipTypeDF$imoShipType
  )

  #Starcrest Method
  expect_equal(testShipTypeDF$newStarcrestShipType,
               testShipTypeDF$starcrestShipType
  )
}
)

test_that("calcShipType works with input file",
          {
            # Create Benchmark
            tbl<-data.table(Vessel_Type = c("canoe","kayak","apple","pear"),
                            shipType = c("boat","boat","fruit","fruit")
                            )

            tmpName<-tempfile()
            fwrite(tbl, file = tmpName)

            #Run Calculation
            testOut<-calcShipType(c("apple","canoe"),
                                  inputTableLocation = tmpName)

            #compare output against benchmark
            expect_equal(testOut$shipType,
                         c("fruit","boat")
                         )

            #delete that temporary file
            file.remove(tmpName)

          }
         )

#calcOperatingMode=============================================================

test_that("calcOperatingMode works",
          {
            #create Benchmark
            testOperatingModes<-c("Berth","Anchorage","Manuevering","Transit")
            #Run Calculation
            testOperatingModes_out<-calcOperatingMode(shipSpeed = c(0.5, 2, 7, 16),
                                                      loadFactor = c(0.02, 0.17, 0.19, 0.75)
            )
            #Compare output against benchmark
            expect_equal(testOperatingModes_out,
                         testOperatingModes
            )
          }
)


library(devtools)
devtools::load_all()

data <- gen.data(deviation = "trigonometric", nsubj = 100, r = 0, M = 10)
times <- seq(-1, 1, length.out = 80) # all possible time points

# Implement the tests
system.time(face.b <- bootstrap.face(data, nbs = 10, argvals.new = times))

face.b$p
face.b$Tn
face.b$bs.approx


# lhl.r
# Church two step breakpoint algorithm, from Church et al, 1994.
# Author: Emmanuel Alcalá
# Date: 5 may 2019
#
# ------------------------------------------------------------------------------
# This is an improved version of lhl_old. It is just marginally faster, but
# cleaner and more intuitive. It sets first all possible combinations of s1
# and s2 (start and stop), then it computes the differences between the overall
# rate r and the state rates r1, r2 and r3, weighted by their respective
# durations t1, t2 and t3. Then it computes the index (i.e., an integer of the
# position in the vector) at which the differences were maximized, with which
# all other metrics can be solved.
# inputs:
#        - r_times: every time at which there was a response
#        - trial_duration: the duration of peal trial
# ------------------------------------------------------------------------------

lhl = function(r_times, trial_duration) {
  # Number of responses
  nr = length(r_times)
  # overall response rate
  r = nr/trial_duration
  # Vector of putative starts (all time of responses except the last)
  s1 = r_times[1:(nr - 1)]
  # Vector of putative stops (except the first)
  s2 = r_times[2:nr]

  # Get all combinations of s1 and s2 with s1 less than s2.
  #   For example, if s1 can be 1, 2, 3, and s2 = 2, 3, 4,
  #   the combinations are (1, 2), (1, 3), (1, 4), (2, 3), (2, 4), (3, 4)
  grid = expand.grid.jc(s1,s2) # matrix of nx2; n = all possible combinations
  grid = grid[grid[ ,1] < grid[ ,2], ] # select n with s1 < s2
  # Vector of 0 to store results
  A = numeric(nrow(grid))
  # Computations of differences between the r and r(i), with i = 1, 2, 3
  # which are the rates at the low, high and low states.
  # Store the results of the differences in A[j]
  for (j in 1:nrow(grid)) { # loop trough all combinations of s1 & s2
    t1 = grid[j, 1]
    t2 = grid[j, 2] - t1
    t3 = trial_duration - grid[j, 2]
    # Previous versions looked if some t equals 0 and assigned 0 to rates
    # to avoid division by 0, but isn' necessary: there are 0 responses
    # with duration 0!
    r1 = sum(r_times <= t1)/t1
    r2 = sum(r_times > t1 & r_times <= grid[j, 2])/t2
    r3 = sum(r_times > grid[j, 2])/t3

    A[j] = sum(t1*(r - r1), t2*(r2 - r), t3*(r - r3), na.rm = T)

  }
  # Get the index which maximizes A
  argmaxA = which.max(A)
  # Vector of 2 at which A were maximum. column 1 is s1, 2 is s2
  s1s2 = grid[argmaxA, ]
  # High rate state duration: s2 - s1
  t2 = s1s2[2] - s1s2[1]
  # Low rate 1
  r1 = sum(r_times <= s1s2[1])/s1s2[1]
  # Low rate 2
  r3 = sum(r_times > s1s2[2])/(trial_duration - s1s2[2])
  # High rate
  hrate = sum(r_times > s1s2[1] & r_times <= s1s2[2])/t2
  # Middle time
  mid = sum(s1s2)/2
  # Return results
  data.frame(start = s1s2[1],
             stop = s1s2[2],
             spread = t2,
             hrate = hrate,
             mid = mid,
             r1 = r1,
             r3 = r3)
}


pdf_file<-"pdf/timeseries_seasonal_minmax_2x1.pdf"
cairo_pdf(bg="grey98", pdf_file,width=14,height=7)

par(omi=c(0.25,0.25,0.5,0.25),mai=c(0.45,0.35,0.5,0),mfcol=c(1,2),family="Lato Light",las=1)
library(gplots)
library(gdata)

# Import data and prepare chart

myData<-read.xls("myData/Climate.xlsx", encoding="latin1")
attach(myData)
myLines<-c(-5,0,5,10,15,20,25,30)

# Create chart and other elements

myT1<-barplot2(t(cbind(NY_min,NY_max-NY_min)),col=c(NA,"coral3"),border=NA,names.arg=Month,ylim=c(-5,35),panel.first=abline(h=myLines,col="grey",lwd=1,lty="dotted"),axes=F)
for (i in 1:length(myLines)) {text(-0.8,myLines[i]+1.1,myLines[i],xpd=T)}
text(-0.25,33,"Degrees Celsius",xpd=T,cex=0.8)
mtext(side=3,"New York",cex=1.5,col=rgb(64,64,64,maxColorValue=255))
myT2<-barplot2(t(cbind(MAJ_min,MAJ_max-MAJ_min)),col=c(NA,"cornflowerblue"),border=NA,names.arg=Month,ylim=c(-5,35),panel.first=abline(h=myLines,col="grey",lwd=1,lty="dotted"),axes=F)

# Titling

mtext(side=3,"Majorca",cex=1.5,col=rgb(64,64,64,maxColorValue=255))
mtext(side=3,"Monthly average temperatures",cex=1.5,family="Lato Black",outer=T)
mtext(side=1,"Source: Wikipedia",cex=0.75,adj=1,font=3,outer=T)
dev.off()


library(tidyverse)
library(dslabs)
data(murders)

murders %>%
  ggplot(aes(population, total, label=abb, color=region)) +
  geom_label()

murders$state[which.max(murders$population)]

heighs<- c(69, 62, 66, 70, 70, 73, 67, 73, 67, 70)
heigh*2.54


#plot(data)

#v <- c(-5,-2,0,2,5)

#plot(tanh(v))

#curve(tanh(x), from=-100, to=100, add=TRUE)

########################
#x <- seq(-4,4,length=200)
#y <- x^2
#z <- tanh(x)

#plot(x,y,type="l")
#lines(x,x*tanh(x),lty=2)
#######################

name <- "data"

data <- read.table(name, header=T)

png("output.png")

plot(0, type = "n", main = "Plot Title", ylab = "Crossover", xlab = "Selection Pressure", xlim = c(0,1), ylim = c(0,1))
grid()                              # add grid
points(data[,2], data[,1], type="p", pch=19)  # draw first dataset
#lines(data[,1], data[,3], lty = 2)  # draw second dataset
#legend("topright", c("first dataset", "second dataset"), lty = c(1, 2) )

dev.off()


## Test correctness ------------------------------------------------------------

act <- rep(1, 4)
pred1 <- rep(1, 4)
pred2 <- rep(0, 4)
pred3 <- c(0, 0, 1, 1)

expect_equal(mtr_brier_score(act, pred1), 0)

expect_equal(mtr_brier_score(act, pred2), 1)

expect_equal(mtr_brier_score(act, pred3), 0.5)

expect_equal(mtr_brier_score(1, 0.4), 0.36)

expect_equal(mtr_brier_score(0, 0.4), 0.16)

## Test error ------------------------------------------------------------------

## raise error if actual is multiclass
expect_error(mtr_brier_score(c(0, 1, 2), c(0, 0, 0)))

## raise error if length of input vectors is inconsistent
expect_error(mtr_brier_score(act, pred1[-1]))

## raise error if predicted probabilities > 1
expect_error(mtr_brier_score(c(0, 1), predicted = c(2, 0.5)))

## raise error if predicted probabilities < 0
expect_error(mtr_brier_score(c(0, 1), predicted = c(-1, 0.5)))

## raise error if actual is different than 0 and 1
expect_error(mtr_brier_score(actual = c(0, -1), c(0.1, 0.1)))


deaths_dt

deaths_dt <- read_fst(file.path("data", "processed", "deaths_dt_SWE.fst"), as.data.table = TRUE)

# Include only up to 14 days
n_days <- 14
DT <- deaths_dt[days_lag <= n_days]
DT <- DT[date > "2020-04-02"]
DT <- DT[date <= max(publication_date) - n_days]
# DT[, N_14d := N[days_lag == 14], by = date]

# Ignore negative reports
DT[n_diff < 0, n_diff := 0]
DT <- DT[!is.na(workdays_lag)]

lag_means <- function(lags, N, groups = seq(0, 1, 0.25)) {
    means <- data.table(cut(1:sum(N), quantile(1:sum(N), probs = groups), include = TRUE), rep(lags, N))[, .(l=max(V2)), by = V1][, l]
    out <- data.table(t(means))
    setnames(out, paste0("p", gsub("\\.", "", groups[2:length(groups)])))

    return(out)
}

plot_data <- melt(DT[, lag_means(as.integer(workdays_lag), n_diff, groups = seq(0, 1, 0.25)), by = date], id.vars = "date")

g <- ggplot(data = plot_data, aes(x = date, y = value, group = variable, color = variable)) + geom_line()
g

model[date == "2020-05-20", ]

g <- ggplot(data = deaths_dt[date > "2020-04-02", sum(n_diff), by = .(date, workdays_lag <= 2)], aes(x = date, y = V1, color = workdays_lag, group = workdays_lag)) + geom_point() + geom_smooth()
g

deaths_dt[date > "2020-04-02", sum(n_diff), by = .(date, workdays_lag <= 1)][date <= "2020-04-15"]
deaths_dt[date == "2020-04-12"]


#!/usr/bin/Rscript

# R (http://www.r-project.org/) script
# from https://en.wikipedia.org/wiki/R_(programming_language)#Basic_syntax

install.packages("caTools")  # install external package
library(caTools)             # external package providing write.gif function
jet.colors <- colorRampPalette(c("red", "blue", "#007FFF", "cyan", "#7FFF7F",
                                 "yellow", "#FF7F00", "red", "#7F0000"))
dx <- 1500                    # define width
dy <- 1400                    # define height
C  <- complex(real = rep(seq(-2.2, 1.0, length.out = dx), each = dy),
              imag = rep(seq(-1.2, 1.2, length.out = dy), dx))
C <- matrix(C, dy, dx)       # reshape as square matrix of complex numbers
Z <- 0                       # initialize Z to zero
X <- array(0, c(dy, dx, 20)) # initialize output 3D array
for (k in 1:20) {            # loop with 20 iterations
  Z <- Z^2 + C               # the central difference equation
  X[, , k] <- exp(-abs(Z))   # capture results
}
write.gif(X, "out/mandelbrot.gif", col = jet.colors, delay = 100)