#!/usr/bin/env Rscript

# Run with 'Rscript create_data_dictionary.r'

##  Create a data dictionary or codebook
##    a. Manually (e.g., in a spreadsheet)
##    b. Attach to your dataset using the dataMeta package

# Data Dictionary
# This is usually a list of variables or data elements along with a description of each one (metadata about your data).
# You’ll want to include things like file name, column id, column name, variable type, count, notes, and warnings to
# your collaborators regarding any errors or mismatches.
#
#  1. Identify categorical and continuous variables
#  2. Get the overall dimensions of the data set (number of rows and columns)
#  3. Find out how many instances of each variable there are (total count)
#
# You can use the R package [dataMeta](https://cran.r-project.org/web/packages/dataMeta/vignettes/dataMeta_Vignette.html)
# to create a data dictionary and attach it to your dataset. Here's a demonstration with our test set

library(dataMeta)

#erase after testing
companies <- read.csv("/Users/mbc400/Box Sync/GitHub/data-cleaning-with-r/output/companies_cleaned.csv", header = TRUE, stringsAsFactors = FALSE)

### Three steps
##
# Step 1: Build a linker data frame
##
# Add a description for each variable name and identify the type
var_desc <- c("Account number", "Company name", "Current award level status", "2013 gross income", "Number of widgets the company created in 2013", "Is their record in our system complete or not?", "Last time the record was updated")

# Variable types can be:
# 0: can be displayed as a range of values
# 1: descriptive or categorical variables
var_type <- c(0, 0, 1, 0, 0, 1, 0)

# Build the linker data frame
linker <- build_linker(my.data = companies, variable_description = var_desc, variable_type = var_type)
linker

##
# Step 2: Build the data dictionary using the data + the linker
##

# For this data set, no further option description is needed.
dictionary <- build_dict(my.data = companies, linker = linker, option_description = NULL, prompt_varopts = FALSE)

# Create main_string for attributes
main_string <- "This dataset describes several companies' award statuses, income, and productivity in 2013."
complete_dataset <- incorporate_attr(my.data = companies, data.dictionary = dictionary,
                                     main_string = main_string)

# Just the dictionary...
attr(complete_dataset, "dictionary")
# or...
attributes(complete_dataset)$dictionary

# Write the dictionary and dataset + dictionary to output files:

library(lubridate)
library(forcats)

# Change columns to appropriate types before writing to file
complete_dataset$Date = mdy_hm(complete_dataset$Date)
complete_dataset$Status = as_factor(complete_dataset$Status)
complete_dataset$Complete = as_factor(complete_dataset$Complete)

# Export dictionary only:
dict_only <- attributes(complete_dataset)$dictionary
write.csv(dict_only, "/Users/mbc400/Box Sync/GitHub/data-cleaning-with-r/output/companies_cleaned_dict_only.csv")

# Save as an R dataset, .rds (dataset with appended dictionary)
save_it(complete_dataset, name_of_file = "/Users/mbc400/Box Sync/GitHub/data-cleaning-with-r/output/companies_cleaned_with_dict")


############################################################
# For macaque paper, 08.19
# Makes length histograms for human and macaque SVs
# Gregg Thomas
############################################################

binSVs <- function(svs){
# Function to pre-bin SVs by length
  binned_svs = data.frame("bin"=seq(from=0,to=5000,by=100), count=0)
  for(i in 1:nrow(svs)) {
    row <- svs[i,]
    bin = floor(row$Length/100)*100
    binned_svs[binned_svs$bin==bin,]$count = binned_svs[binned_svs$bin==bin,]$count + 1
  }
  return(binned_svs)
}

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

this.dir <- dirname(parent.frame(2)$ofile)
setwd(this.dir)

library(ggplot2)
library(reshape2)
library(cowplot)
library(ggridges)
library(OneR)
library(ggforce)
library(ggbeeswarm)

source("../lib/read_svs.r")
source("../lib/filter_svs.r")
source("../lib/subset_svs.r")

cat("----------\n")

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

savefiles = F
color_plots = T
rm_alus = F
# Run options

minlen = F
maxlen = 5000
# CNV length cutoffs

baseout = "fig3"
human_full = F
macaque_filter = T
figs2_opt = F
figs3_opt = F
if(figs2_opt){
  human_full = T
  baseout = paste(baseout, "_S2", sep="")
}else if(figs3_opt){
  macaque_filter = F
  baseout = paste(baseout, "_S3", sep="")
}

if(rm_alus){
  human_full = F
  macaque_filter = T
  baseout = paste(baseout, "_S4", sep="")
}
# Supplemental figure options

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

sv_list = readSVs()
mq_events = sv_list[[1]]; hu_events = sv_list[[2]];
sv_list = filterSVs(sv_list, minlen, maxlen, human_full, macaque_filter)
mq_events = sv_list[[1]]; hu_events = sv_list[[2]];
# Read and filter data

cat("----------\nSubsetting macaque data...\n")
mqr = subsetSVs(mq_events)
mq_svs = mqr[[4]]
mq_svs = subset(mq_svs, Length <= maxlen)

cat("----------\nSubsetting human data...\n")
hur = subsetSVs(hu_events)
hu_svs = hur[[4]]
hu_svs = subset(hu_svs, Length <= maxlen)
# Subset data

#mq_svs$Length = -mq_svs$Length

hu_svs_noalu = subset(hu_svs, Length < 275 | Length > 325)
mq_svs_noalu = subset(mq_svs, Length < 275 | Length > 325)

hu_svs$Label = "Human"
mq_svs$Label = "Macaque"
hu_svs_noalu$Label = "Human no Alu"
mq_svs_noalu$Label = "Macaque no Alu"
# For Alu stuff

#cat("----------\nPre-binning macaque data...\n")
#mq_bins = binSVs(mq_svs)
#mq_bins$Species = "Macaque"
#mq_bins$count = -mq_bins$count

#cat("----------\nPre-binning human data...\n")
#hu_bins = binSVs(hu_svs)
#hu_bins$Species = "Human"

#hu_svs = subset(hu_svs, Length > 200)
sv_alleles = rbind(hu_svs, hu_svs_noalu, mq_svs, mq_svs_noalu)
#sv_bins = rbind(hu_bins, mq_bins)
#test_count = mq_events %>% group_by(Individual) %>% count(Individual)
# Count number of events per individual
# Combine the two datasets
######################

######################
# SV length histogram -- Fig 2A
cat("SV length distribution...\n")

fig3a = ggplot(sv_alleles, aes(x=Label, y=Length, fill=Label)) +
  geom_quasirandom(size=2, alpha=0.7, width=0.25, color="#d3d3d3") +
  geom_boxplot(outlier.shape=NA, alpha=0.3, width=0.5, color="#000000") +
  labs(y="CNV Length") +
  bartheme() +
  theme(legend.position="none")

if(color_plots){
  fig3a = fig3a + scale_fill_manual(name="", values=c("Macaque"='#490092', "Macaque no Alu"='#490092',"Human"='#920000', "Human no Alu"="#920000"))
}else{
  #fig3a = fig3a + scale_fill_grey(name="", labels=c("Human","Macaque"))
  #fig3a = fig3a + scale_fill_manual(name="", values=c("Macaque"='#d6d6d6',"Human"='#5c5c5c'))
  fig3a = fig3a + scale_fill_manual(name="", values=c("Macaque"='#5c5c5c', "Macaque no Alu"="5c5c5c", "Human"=NA, "Human no Alu"=NA))
}

#print(fig3a)
# ggsave(filename="fig3a-alu-box.png", fig3a, width=6, height=4, units="in")

sv_alleles = rbind(hu_svs_noalu, mq_svs_noalu)
sv_alleles$Label[sv_alleles$Label=="Human no Alu"] = "Human"
sv_alleles$Label[sv_alleles$Label=="Macaque no Alu"] = "Macaque"
fig3a = ggplot(sv_alleles, aes(x=Label, y=Length, fill=Label)) +
  geom_quasirandom(size=2, alpha=0.7, width=0.25, color="#d3d3d3") +
  geom_boxplot(outlier.shape=NA, alpha=0.3, width=0.5, color="#000000") +
  labs(y="CNV Length", x="") +
  bartheme() +
  theme(legend.position="none")

if(color_plots){
  fig3a = fig3a + scale_fill_manual(name="", values=c("Macaque"='#490092', "Human"='#920000'))
}else{
  #fig3a = fig3a + scale_fill_grey(name="", labels=c("Human","Macaque"))
  #fig3a = fig3a + scale_fill_manual(name="", values=c("Macaque"='#d6d6d6',"Human"='#5c5c5c'))
  fig3a = fig3a + scale_fill_manual(name="", values=c("Macaque"='#5c5c5c', "Human"=NA))
}

print(fig3a)
ggsave(filename="figS3.png", fig3a, width=6, height=4, units="in")

stop()

sv_alleles = subset(sv_alleles, Length > 200)
fig3a = ggplot(sv_alleles, aes(x=Label, y=Length, fill=Label)) +
  geom_quasirandom(size=2, alpha=0.7, width=0.25, color="#d3d3d3") +
  geom_boxplot(outlier.shape=NA, alpha=0.3, width=0.5, color="#000000") +
  labs(y="CNV Length", x="") +
  bartheme() +
  theme(legend.position="none")

if(color_plots){
  fig3a = fig3a + scale_fill_manual(name="", values=c("Macaque"='#490092', "Human"='#920000'))
}else{
  #fig3a = fig3a + scale_fill_grey(name="", labels=c("Human","Macaque"))
  #fig3a = fig3a + scale_fill_manual(name="", values=c("Macaque"='#d6d6d6',"Human"='#5c5c5c'))
  fig3a = fig3a + scale_fill_manual(name="", values=c("Macaque"='#5c5c5c', "Human"=NA))
}

print(fig3a)
# ggsave(filename="fig3a-noalu-short-box.png", fig3a, width=6, height=4, units="in")

stop()
#if(savefiles){
#  outfile = "fig3a.pdf"
#  cat(" -> ", outfile, "\n")
#  ggsave(filename=outfile, fig3a, width=6, height=4, units="in")
#}
# SV length plot

cat(" -> SV length KS test...\n")
hu_svs = subset(hu_svs, Length > 200)
mq_svs = subset(mq_svs, Length > 200)
length_ks = wilcox.test(hu_svs$Length, mq_svs$Length)
print(length_ks)
# SV length KS test
# SV length histogram
######################


setwd("/users/ludwig/cfo155/cfo155/longReads/processed")
library(ggplot2)
selcolor <- c("#CB962B","#48A1D9")
##### the one with gap #####
methFiles <- list.files(pattern = "*rep2*.mESC_chr11.*stat.txt$")
cors <- NULL
for(i in 1:length(methFiles)){
  methFile <- methFiles[i]
  dat <- read.table(methFile, header=T)
  dat$ratio_wgbs <- apply(dat[,c(4,5)],1,function(x){ifelse(x[2]>0,x[1]/x[2],0)})
  dat$ratio_taps <- apply(dat[,c(6,7)],1,function(x){ifelse(x[2]>0,x[1]/x[2],0)})
  head(dat)
  dat$cov_wgbs <- cut(dat$aC_wgbs, breaks=c(-Inf,8,+Inf))
  dat$cov_taps <- cut(dat$aC_taps, breaks=c(-Inf,8,+Inf))
  cors <- c(cors, round(cor(dat[dat$aC_taps>8,c(3,9)])[2,1],3))
  # p2 <- ggplot(dat[dat$aC_taps>10, c(3,9,11)],
  #              aes(x=ratio_taps,y=longread, color=factor(cov_taps))) +
  #   geom_point() +
  #   xlim(0,1) +
  #   ylim(0,1) +
  #   theme_minimal() +
  #   xlab("TAPS") +
  #   ylab("longreads-TAPS")+
  #   scale_color_manual(values = selcolor[i]) +
  #   theme(
  #     strip.text.x = element_text(size = 18, color = "black"),
  #     text = element_text(size = 18),
  #     axis.ticks.y = element_line(colour = "black", size = 0.8),
  #     axis.ticks.x = element_line(colour = "black", size = 0.8),
  #     legend.position = "none") +
  #   geom_text(x=0.1, y=1, label=round(cor(dat[dat$aC_taps>8,c(3,9)])[2,1],3), color="black",size=6)
  # ggsave(paste0(methFile,".taps.pdf"),p2, width = 4, height = 4)
}

for(n in c(2,4,6,8,10,12,14)){
  cors<- c()
  for(i in 1:length(methFiles)){
  methFile <- methFiles[i]
  dat <- read.table(methFile, header=T)
  dat$ratio_wgbs <- apply(dat[,c(4,5)],1,function(x){ifelse(x[2]>0,x[1]/x[2],0)})
  dat$ratio_taps <- apply(dat[,c(6,7)],1,function(x){ifelse(x[2]>0,x[1]/x[2],0)})
  dat$cov_wgbs <- cut(dat$aC_wgbs, breaks=c(-Inf,8,+Inf))
  dat$cov_taps <- cut(dat$aC_taps, breaks=c(-Inf,8,+Inf))
  cors <- c(n,cors, round(cor(dat[dat$aC_taps>n,c(3,9)])[2,1],3), nrow(dat[dat$aC_taps>n,c(3,9)]))
  print(cors)
}
}


library('RANN')
# main function that generates the paths. A path is a list of connected x,y,x coords and it's length is set by _hops_.
# origin = the triplet coordinate where a path begins
# limit = linear distance away from the origin after the path will be penalized and forced to return towards the origin
#          it determines the extent of a domain.
# abs_limit = as the path grows (see warp) one might one to bound the scope of the full path. This determines the global limits of the path
# scale = scaling factor
# min_delta = minimim step required by the walker to call a hop valid
# cis =
# warp = a path can suddenly do an abrupt, long-range hop in order to start populating a different volume. This setting determines how ofter an warp will happen. Once the path warps, the origin is reset.
generate_tad_random = function(hops = 1000, origin = rep(0,3), limit =1, abs_limit = limit * 4 ,scale = 0.1, min_delta = scale, cis = 50, warp = NULL){

	central_origin = origin
	tad_loc = data.frame(x = origin[1], y = origin[2], z = origin[3])
	#tad_loc = origin
	current = origin
	pos = data.frame(x = current[1], y = current[2], z = current[3])

	delta = c(0,0,0)
	mem_trail = delta

	hop = 1
	iter = 1
	while(hop <= hops){
		if(!is.null(warp)){
			if(hop%%warp == 0){
				valid_warp = FALSE
				warp_jump = 0
				mem_jump = 0
				center_dist = -1
				w_ori = current
				w_hop = tensor(current, current, limit = limit, scale = 5 * scale)$pos
				while(!valid_warp){
					w_hop = tensor(w_ori, w_hop, limit = limit, scale = 5 * scale)$pos
					center_dist = euclidean_distance(w_hop, central_origin)
					warp_jump = euclidean_distance(w_hop, current)
					mem_jump = euclidean_distance(w_hop, mem_trail[nrow(mem_trail), ])

					valid_warp= ifelse(
							warp_jump > 4 * scale &
							mem_jump > 4 * scale &
							center_dist < abs_limit, T, F)

				}
				current = w_hop
				origin = w_hop
				message(sprintf("\t hop %s warp dist to abs center %.2f %s", hop, center_dist, abs_limit))
				plot_progress(pos, mem_trail, warp)

				pos = rbind(pos, fhop$pos)
				mem_trail = rbind(mem_trail, memory)
				delta = c(delta, fhop$delta)
				current = fhop$pos
				hop = hop + 1
				#cat(sprintf("\r%.2f\t%s", hop/hops, iter))

			}
		}
		iter = iter +1
		fhop = tensor(origin, current, limit = limit, scale = scale)
		if(hop >= cis){
			memory = memory_centroid(pos[(nrow(pos)-cis):nrow(pos), ])
		} else {
			memory = colMeans(pos) #current + rnorm(3, 0, min_delta)
		}

		#cat(sprintf("last jump was of %.2f", euclidean_distance(fhop$pos, current)))
		#message(sprintf("from the origin %.2f", euclidean_distance(fhop$pos, origin)))
		if(nrow(pos) > 0){
			knn = nn2(as.matrix(pos), matrix(fhop$pos, ncol = 3, nrow = 1), k = nrow(pos))
			knn = knn$nn.dist[1,1] > min_delta *1.52
		}else{
			knn = TRUE
		}
		valid = ifelse(euclidean_distance(fhop$pos, current) >= min_delta &
				euclidean_distance(memory, fhop$pos) >= min_delta *2 &
				knn,T, F)

		if(valid){
			pos = rbind(pos, fhop$pos)
			mem_trail = rbind(mem_trail, memory)
			delta = c(delta, fhop$delta)
			current = fhop$pos
			hop = hop + 1
			cat(sprintf("\r%.2f%%\t%s", 100 * hop/hops, iter))
		}

	}
	cat("\n")

	#path = matrix(pos, ncol=3, byrow=T)
	path = pos
	colnames(path) = c("x","y","z")
	deltas = matrix(delta, ncol = 3, byrow = T)
	colnames(deltas) = c("dx","dy","dz")

	#as.data.frame(cbind(path, deltas))
	#as.data.frame(path)
	list(path = as.data.frame(path), deltas = deltas, mem_trail = mem_trail, cis = cis)
}

# main engine that suggests the next step on a path
tensor= function(origin = c(0,0,0), current = c(0,0,0), limit = 1, penalty_factor = 0.25, scale = 0.1){
	pf = penalty_factor
	x = current[1]
	y = current[2]
	z = current[3]
	if(euclidean_distance(origin, current) > limit){
		dx = (origin[1] - x) * pf
		dy = (origin[2] - y) * pf
		dz = (origin[3] - z) * pf
		nx = rnorm(1, 0, scale)
		ny = rnorm(1, 0, scale)
		nz = rnorm(1, 0, scale)
		delta = c(nx, ny, nz) + (c(dx,dy,dz) * sapply(c(0,0,0), function(x){ifelse(sign(x) == 0, 1, sign(x))}))

	} else {
		nx = rnorm(1, 0, scale)
		ny = rnorm(1, 0, scale)
		nz = rnorm(1, 0, scale)
		delta = -c(nx, ny, nz)
	}
	return(list(pos = current + delta, delta = delta))
}
# basic functions
euclidean_distance = function(a, b){
	distance = 0
	if(length(a) != length(b)){
		stop("vectors are not the same length")
	}
	points = rbind(a,b)
	sqrt(sum(apply(points, 2, function(x){diff(x)**2})))

}

memory_centroid = function(a){
	colMeans(a)
}

knn_path = function(tad_list, k = 100, len = 20, region = 20:30){

	end = nrow(tad_list$path)
	start = tad_list$cis + (end * 0.1)

	knn = nn2(tad_list$path, tad_list$path, k = 100)
	k = c()

	x = sample(start:end, 1)
	i = 1
	while(i <= len){
		x <- knn$nn.idx[x, sample(region, 1)]
		if(!(x %in% k)){
			k = c(k,x)
			i = i+1
		}
	}
	dev.new()
	plot(tad_list$path[k,], t = 'l')
	return(tad_list$path[k,])
}

dist_3d = function(a,b){
	x = a[1]; y = a[2]; z = a[3]
	xx = b[1]; yy = b[2]; zz = b[3]
	sqrt(sum((x-xx)^2, (y-yy)^2, (z-zz)^2))
}

plot_progress = function(pos, mem_trail, warp = NULL){
	layout(matrix(c(1, 2, 0, 3), ncol = 2, nrow = 2))
	ext_lim = range(c(pos, mem_trail))

	n_mem = nrow(mem_trail)
	f_warp = 1:n_mem %% warp == 0

	plot(pos[, 1], pos[, 2], t = 'l', xlab = "X", ylab = "Y")
	points(mem_trail[f_warp, 1], mem_trail[f_warp, 2], pch = 19, col = 'red')
	abline(v = mem_trail[n_mem, 1], h = mem_trail[n_mem, 2], col = 'lightblue', lty = 2, lwd = 2)

	plot(pos[, 1], pos[, 3], t = 'l', xlab = "X", ylab = "Z")
	points(mem_trail[f_warp, 1], mem_trail[f_warp, 3], pch = 19, col = 'red')
	abline(v = mem_trail[n_mem, 1], h = mem_trail[n_mem, 3], col = 'lightblue', lty = 2, lwd = 2)

	plot(pos[, 2], pos[, 3], t = 'l', xlab = "Y", ylab = "Z")
	points(mem_trail[f_warp, 2], mem_trail[f_warp, 3], pch = 19, col = 'red')
	abline(v = mem_trail[n_mem, 2], h = mem_trail[n_mem, 3], col = 'lightblue', lty = 2, lwd = 2)

#	plot(mem_trail[,1], mem_trail[,2], t='l', col='red')
#	plot(mem_trail[,2], mem_trail[,3], t='l', col='red')
#	plot(mem_trail[,1], mem_trail[,3], t='l', col='red')

}


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

library(ggplot2)
library(dplyr)
library(extrafont)
library(dplyr)
library('EnvStats')
library("tikzDevice")

data <- read.csv(file = 'output-n-norm-bo4-with-o-w.csv', sep = ',', header = T)
data_new <- data
value <- function(x, name) {
  mym = mean(x)
  mysd = sd(x)
  mysqrt = sqrt(length(x))

  return(c(mn = mym, sd = mysd/mysqrt, bo = name))
}

data_f<-data.frame(data_new[data_new['bo'] == 'bo3',])
bo3 <- aggregate(x = data_f$best,
                 by = list(data_f$ite),
                 FUN = function(x) return(value(x, 'BO-6sel-EIdef')))
bo3 <- as.data.frame(as.list(bo3))

data_f<-data.frame(data_new[data_new['bo'] == 'bo4' & data_new['target'] == 0,])
bo4 <- aggregate(x = data_f$best,
                 by = list(data_f$ite),
                 FUN = function(x) return(value(x, 'PB3Opt - Previsto')))
bo4 <- as.data.frame(as.list(bo4))

data_f<-data.frame(data_new[data_new['bo'] == 'bo4' & data_new['target'] == 1,])
bo5 <- aggregate(x = data_f$best,
                 by = list(data_f$ite),
                 FUN = function(x) return(value(x, 'PB3Opt - Ótimo - SC')))
bo5 <- as.data.frame(as.list(bo5))

data_f<-data.frame(data_new[data_new['bo'] == 'bo4' & data_new['target'] == 3,])
bo6 <- aggregate(x = data_f$best,
                 by = list(data_f$ite),
                 FUN = function(x) return(value(x, 'PB3Opt - Pior - SC')))
bo6 <- as.data.frame(as.list(bo6))

data_f<-data.frame(data_new[data_new['bo'] == 'bo4' & data_new['target'] == 2,])
bo7 <- aggregate(x = data_f$best,
                 by = list(data_f$ite),
                 FUN = function(x) return(value(x, 'PB3Opt - Aleatório')))
bo7 <- as.data.frame(as.list(bo7))

data_f<-data.frame(data_new[data_new['bo'] == 'rs',])
bo9 <- aggregate(x = data_f$best,
                 by = list(data_f$ite),
                 FUN = function(x) return(value(x, 'Ranking Search')))
bo9 <- as.data.frame(as.list(bo9))

data_f<-data.frame(data_new[data_new['bo'] == 'bo4' & data_new['target'] == 5,])
bo10 <- aggregate(x = data_f$best,
                 by = list(data_f$ite),
                 FUN = function(x) return(value(x, 'PB3Opt - Ótimo - TOP5')))
bo10 <- as.data.frame(as.list(bo10))

data_f<-data.frame(data_new[data_new['bo'] == 'bo4' & data_new['target'] == 4,])
bo11 <- aggregate(x = data_f$best,
                  by = list(data_f$ite),
                  FUN = function(x) return(value(x, 'PB3Opt - Pior - TOP5')))
bo11 <- as.data.frame(as.list(bo11))

df <- rbind(bo3, bo4, bo5, bo6, bo10, bo11, bo7, bo9)
df$x.mn = as.numeric(as.character(df$x.mn))
df$Group.1 = as.numeric(as.character(df$Group.1))
df$x.sd = as.numeric(as.character(df$x.sd))
df_new <- df[df['Group.1'] >= 6,]

tikz('fig2.tex')
ggplot(data=df_new, aes(x=Group.1, y=x.mn, group=x.bo)) +
  geom_errorbar(aes(ymin=x.mn-1.96*x.sd, ymax=x.mn+1.96*x.sd,color=x.bo), width=0.2, size=.3) +
  geom_line(aes(color=x.bo), size=1) +
  #coord_cartesian(ylim=c(1,1.2), xlim=c(1,30))+
  geom_vline(xintercept=6, linetype="dashed", size=1)+
  #geom_hline(yintercept=1.22369954611662, linetype="dashed", color = "red", size=1)+
  labs(color = element_blank(), x="Iteração", y="Média do Melhor Custo Normalizado")+
  theme(legend.justification=c(1, 1),legend.position=c(.8, .9),legend.title=element_blank())+
  theme(panel.background = element_rect(fill = 'white', colour = 'gray'),
        panel.grid.major = element_line(color = 'light gray'),
        panel.grid.minor = element_line(color = 'light gray'),
        #axis.title.y=element_blank(),
        axis.text.y = element_text(size=8))+
  scale_x_continuous(breaks = seq(1, 30, 1))
dev.off()


library(tidyverse)

ukbb_pred <- read_csv("ukbb_ventricular_volumes.csv") %>% rename(Id = X1) %>% mutate(pid=str_replace_all(Id,"_rot90",""))
metadata <- read_tsv("patient_metadata.tsv")
all_images <- read_tsv("image_list.tsv.xz", col_names = c("Id", "file"), col_types = "cc")

data <- ukbb_pred %>% select(Id,pid,LVEDV=`LVEDV (mL)`,LVESV=`LVESV (mL)`,LVEF=`LVEF (%)`) %>%
    left_join(metadata, by="pid")

#data <- data %>% mutate(AgeBin = cut(PatientsAgeYears, breaks=c(0,20,40,70,100)))

diff_data <- data %>%
    mutate(sys_diff = LVESV-Systole, sys_perc = sys_diff/Systole) %>%
    mutate(dia_diff = LVEDV-Diastole, dia_perc = dia_diff/Diastole) %>%
    mutate(max_abs_perc_diff = pmax(abs(sys_perc),abs(dia_perc)))

diff_data %>%
    select(Id,predicted_LVEDV=LVEDV,predicted_LVESV=LVESV,predicted_LVEF=LVEF,true_LVEDV=Diastole,true_LVESV=Systole,true_LVEF=EF,set,sys_diff,sys_perc,dia_diff,dia_perc,confidence=max_abs_perc_diff) %>%
    mutate(true_LVEF=100*true_LVEF) %>%
    write_tsv("confidence_by_patient.tsv")

# if there is a rotated version, keep only that one
all_images %>%
    left_join(select(diff_data,Id,pid,score=max_abs_perc_diff,set)) %>%
    mutate(rot90=str_detect(Id,"_rot90")) %>%
    group_by(pid) %>%
    mutate(rot_count=sum(rot90)) %>%
    filter(rot_count==0 | rot90) %>%
    ungroup %>%
    select(-rot90,-rot_count) %>%
    mutate(is_val= (set=="validate")) %>%
    write_tsv("image_list_filtered_score.tsv")


#Cleaning working space
rm(list=ls())
#Creator: 20160817 FPL
#Modifications: 20170408 CG
today<-format(Sys.Date(),"%Y%m%d")
#--------------------------------------------
#From Linux
# get working directory
#setwd("D:/Dropbox/FL+WB/PELA/data")
# Cristóbal
setwd("~/Insync/Laboratorio.Poblaciones.Marinas/Publicaciones BIMAC/Plasticidad pela/analisis/datos")
getwd()     #verifico directorio
#----------------------------------------------

#-----------------------------------------------
#Libraries
#-----------------------------------------------
library(plotrix);library(ggplot2);library(nlme);
library(car);library(multcomp)
#-----------------------------------------------

#------------------------------------------------
#reading my data
#------------------------------------------------
pela<-read.csv("data.pela.csv", header=TRUE,
               sep=",",dec=".", strip.white=TRUE)
names(pela)
summary(pela)
str(pela)

#transformo variables mal asignadas a numericas
pela$stage=as.factor(pela$stage)
pela$oxygen=as.numeric(pela$oxygen)
pela$saturation=as.numeric(pela$saturation)
pela$mo2=as.numeric(pela$mo2)
pela$temperature=as.factor(pela$temperature)
# defino kpa promedio para cada tratamiento
pela$kpa.mean<-ifelse(pela$kpa==2.07 | pela$kpa==2.36 | pela$kpa==2.65, 2.36,
                      ifelse(pela$kpa==4.14 | pela$kpa==4.71 | pela$kpa==5.30, 4.71,
                             ifelse(pela$kpa==8.29 | pela$kpa==9.43 | pela$kpa==10.60, 9.44,
                                    ifelse(pela$kpa==12.43 | pela$kpa==14.14 | pela$kpa==15.89, 14.15,
                                           ifelse(pela$kpa==18.65 | pela$kpa==21.21 | pela$kpa==23.84, 21.23, NA)))))

table(pela$stage, pela$kpa.mean)
# ordeno niveles etapa
pela$stage<- factor(pela$stage, levels = c("Embryo","Megalopae","Juvenile","Adult"))
# Estimo media y sd
pela.mean<-aggregate(cbind(mo2.3,mo2.4)~stage+kpa.mean+temperature,data=pela, mean)
pela.sd<-aggregate(cbind(mo2.3,mo2.4)~stage+kpa.mean+temperature,data=pela, sd)
pela1<-merge(pela.mean, pela.sd, by=c("stage","kpa.mean","temperature"))
names(pela1)[c(4:7)]<-c("mo2.3", "mo2.4", "mo2.3.sd", "mo2.4.sd")
#---------------------------------------------------
# Consuno de oxygeno por etapa y temperatura
#---------------------------------------------------
{
png(filename="Figure S1.png",width=18,height=18,units="cm",res=600)
par(mfrow=c(4,3),oma=c(3,1,1,1),tcl=-0.3, family="Arial", mar=c(2,4.5,0,0)) #mar fija margenes alrededor de figuras
#--------------------------------------
#1.0.Embryos
#--------------------------------------
with(subset(pela1,temperature==6 & stage=="Embryo"),plotCI(kpa.mean,mo2.3, mo2.3.sd, ylim=c(0,40),las=1,ylab="", xaxt="n"))
axis(1,at = seq(5,20,5), labels = F, tick = TRUE, lwd.ticks = 0.6)
#mtext(expression(paste(dot(M)[O[2]], " (",mu,"mol ", O[2], " ",h^-1, " ", g^-1, ")")),side=2,  line=1)
text(10,39,c("Eggs 6°C acclimated"), cex=0.9)

with(subset(pela1,temperature==12 & stage=="Embryo"),plotCI(kpa.mean,mo2.3, mo2.3.sd, ylim=c(0,40), xaxt="n",yaxt="n",las=1, ylab=""))
text(10,39,c("Eggs 12°C acclimated"), cex=0.9)
axis(2,at = seq(0,40,10), labels = F, tick = TRUE, lwd.ticks = 0.6)
axis(1,at = seq(5,20,5), labels = F, tick = TRUE, lwd.ticks = 0.6)

with(subset(pela1,temperature==18 & stage=="Embryo"),plotCI(kpa.mean,mo2.3, mo2.3.sd, ylim=c(0,40), xaxt="n",yaxt="n",las=1, ylab=""))
text(10,39,c("Eggs 18°C acclimated"), cex=0.9)
axis(2,at = seq(0,40,10), labels = F, tick = TRUE, lwd.ticks = 0.6)
axis(1,at = seq(5,20,5), labels = F, tick = TRUE, lwd.ticks = 0.6)
mtext(expression(paste(dot(M)[O[2]], " (",mu,"mol ", O[2], " ",h^-1, " ", g^-1, ")")),side=2,  line=-2, outer=T)
#--------------------------------------
#2.0.Megalopae
#--------------------------------------
with(subset(pela1,temperature==6 & stage=="Megalopae"),plotCI(kpa.mean,mo2.3, mo2.3.sd, ylim=c(0,40),las=1,xaxt="n",ylab=""))
#mtext(expression(paste(dot(M)[O[2]], " (",mu,"mol ", O[2], " ",h^-1, " ", g^-1, ")")),side=2,  line=1)
axis(1,at = seq(5,20,5), labels = F, tick = TRUE, lwd.ticks = 0.6)
text(12,39,c("Megalopae 6°C acclimated"), cex=0.9)

with(subset(pela1,temperature==12 & stage=="Megalopae"),plotCI(kpa.mean,mo2.3, mo2.3.sd, ylim=c(0,40),xaxt="n" ,yaxt="n",las=1, ylab=""))
text(12,39,c("Megalopae 12°C acclimated"), cex=0.9)
axis(2,at = seq(0,40,10), labels = F, tick = TRUE, lwd.ticks = 0.6)
axis(1,at = seq(5,20,5), labels = F, tick = TRUE, lwd.ticks = 0.6)
#text(20,c(0.09),c("12°C acclimated"))
with(subset(pela1,temperature==18 & stage=="Megalopae"),plotCI(kpa.mean,mo2.3, mo2.3.sd, ylim=c(0,40), xaxt="n",yaxt="n",las=1, ylab=""))
text(12,39,c("Megalopae 18°C acclimated"), cex=0.9)
axis(1,at = seq(5,20,5), labels = F, tick = TRUE, lwd.ticks = 0.6)
axis(2,at = seq(0,40,10), labels = F, tick = TRUE, lwd.ticks = 0.6)
#--------------------------------------
#3.0.Juveniles
#--------------------------------------
with(subset(pela1,temperature==6 & stage=="Juvenile"),plotCI(kpa.mean,mo2.3, mo2.3.sd, ylim=c(0,40),las=1,xaxt="n",ylab=""))
text(10,39,c("Juveniles 6°C acclimated"), cex=0.9)
#mtext(expression(paste(dot(M)[O[2]], " (",mu,"mol ", O[2], " ",h^-1, " ", g^-1, ")")),side=2,  line=1)
axis(1,at = seq(5,20,5), labels = F, tick = TRUE, lwd.ticks = 0.6)

with(subset(pela1,temperature==12 & stage=="Juvenile"),plotCI(kpa.mean,mo2.3, mo2.3.sd, ylim=c(0,40), xaxt="n",yaxt="n",las=1, ylab=""))
text(10,39,c("Juveniles 12°C acclimated"), cex=0.9)
axis(2,at = seq(0,40,10), labels = F, tick = TRUE, lwd.ticks = 0.6)
axis(1,at = seq(5,20,5), labels = F, tick = TRUE, lwd.ticks = 0.6)

with(subset(pela1,temperature==18 & stage=="Juvenile"),plotCI(kpa.mean,mo2.3, mo2.3.sd, ylim=c(0,40),xaxt="n" ,yaxt="n",las=1, ylab=""))
text(10,39,c("Juveniles 18°C acclimated"), cex=0.9)
axis(2,at = seq(0,40,10), labels = F, tick = TRUE, lwd.ticks = 0.6)
axis(1,at = seq(5,20,5), labels = F, tick = TRUE, lwd.ticks = 0.6)
#--------------------------------------
#4.0.Juveniles
#--------------------------------------
with(subset(pela1,temperature==6 & stage=="Adult"),plotCI(kpa.mean,mo2.3, mo2.3.sd, ylim=c(0,40),las=1,ylab=""))
abline(a=NULL,b=NULL,v=9.16, lty=2)
text(10,39,c("Adults 6°C acclimated"), cex=0.9)
#mtext(expression(paste(dot(M)[O[2]], " (",mu,"mol ", O[2], " ",h^-1, " ", g^-1, ")")),side=2,  line=1)

with(subset(pela1,temperature==12 & stage=="Adult"),plotCI(kpa.mean,mo2.3, mo2.3.sd, ylim=c(0,40), yaxt="n",las=1, ylab=""))
abline(a=NULL,b=NULL,v=15.46, lty=2)
text(10,39,c("Adults 12°C acclimated"), cex=0.9)
axis(2,at = seq(0,40,10), labels = F, tick = TRUE, lwd.ticks = 0.6)

with(subset(pela1,temperature==18 & stage=="Adult"),plotCI(kpa.mean,mo2.3, mo2.3.sd, ylim=c(0,40), yaxt="n",las=1, ylab=""))
abline(a=NULL,b=NULL,v=15.66, lty=2)
text(10,39,c("Adults 18°C acclimated"), cex=0.9)
axis(2,at = seq(0,40,10), labels = F, tick = TRUE, lwd.ticks = 0.6)
mtext("Oxygen tension (kPa) ",side=1,  line=1, outer=T, at=0.55)

dev.off()
}
#-----------------------------------------------------------------------------------------------------------------
#  2da Revisión
#------------------------------------------------------------------------------------------------------------------
#Reviewer 2: I would suggest to depict for each of the four life stages an additional figure S2 (A-D)
#            presenting the effect of temperature (x-axis) on oxygen consumption rates (y-axis)
#            for each oxygen tension in one graph.
pela1$temperature<-as.numeric(as.character(pela1$temperature))
{
png(filename="Figure S3..png",width=14,height=12,units="cm",res=600)
par(mfrow=c(2,2),oma=c(1,2,1,0),tcl=-0.3, family="Arial", mar=c(2,2,0,1)) #mar fija margenes alrededor de figuras

# embryos
with(subset(pela1,kpa.mean==2.36 & stage=="Embryo"),plotCI(temperature,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=21,pt="white", ylim=c(0,40), xlim=c(6,24)))
with(subset(pela1,kpa.mean==4.71 & stage=="Embryo"),plotCI(temperature+1,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=21,pt="gray", add=T))
with(subset(pela1,kpa.mean==9.44 & stage=="Embryo"),plotCI(temperature+2,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=21,pt="black", add=T))
with(subset(pela1,kpa.mean==14.15 & stage=="Embryo"),plotCI(temperature+3,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=22,pt="white", add=T))
with(subset(pela1,kpa.mean==21.23 & stage=="Embryo"),plotCI(temperature+4,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=22,pt="gray", add=T))
axis(1,at=c(6,10),col="black",line=0,tick=T,labels=rep("",2),lwd=2,lwd.ticks=0)
axis(1,at=c(12,16),col="black",line=0,tick=T,labels=rep("",2),lwd=2,lwd.ticks=0)
axis(1,at=c(18,22),col="black",line=0,tick=T,labels=rep("",2),lwd=2,lwd.ticks=0)
text(6,38, labels = "Eggs",     adj = c( 0, 1 ), col = "black" )
# leyenda
legend("topright", legend=c("2.36 KPa", "4.71 kPa","9.44 kPa","14.15 kPa","21.23 kPa"),pch=c(21,21,21,22,22),
       pt.bg=c("white", "gray","black","white","gray"), cex=0.7)
# Megalopae
with(subset(pela1,kpa.mean==2.36 & stage=="Megalopae"),plotCI(temperature,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=21,pt="white", ylim=c(0,40),xlim=c(6,24)))
with(subset(pela1,kpa.mean==4.71 & stage=="Megalopae"),plotCI(temperature+1,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=21,pt="gray", add=T))
with(subset(pela1,kpa.mean==9.44 & stage=="Megalopae"),plotCI(temperature+2,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=21,pt="black", add=T))
with(subset(pela1,kpa.mean==14.15 & stage=="Megalopae"),plotCI(temperature+3,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=22,pt="white", add=T))
with(subset(pela1,kpa.mean==21.23 & stage=="Megalopae"),plotCI(temperature+4,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=22,pt="gray", add=T))
axis(1,at=c(6,10),col="black",line=0,tick=T,labels=rep("",2),lwd=2,lwd.ticks=0)
axis(1,at=c(12,16),col="black",line=0,tick=T,labels=rep("",2),lwd=2,lwd.ticks=0)
axis(1,at=c(18,22),col="black",line=0,tick=T,labels=rep("",2),lwd=2,lwd.ticks=0)
text(6,38, labels = "Megalopae",     adj = c( 0, 1 ), col = "black" )
# Juvenile
with(subset(pela1,kpa.mean==2.36 & stage=="Juvenile"),plotCI(temperature,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=21,pt="white", ylim=c(0,40),xlim=c(6,24)))
with(subset(pela1,kpa.mean==4.71 & stage=="Juvenile"),plotCI(temperature+1,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=21,pt="gray", add=T))
with(subset(pela1,kpa.mean==9.44 & stage=="Juvenile"),plotCI(temperature+2,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=21,pt="black", add=T))
with(subset(pela1,kpa.mean==14.15 & stage=="Juvenile"),plotCI(temperature+3,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=22,pt="white", add=T))
with(subset(pela1,kpa.mean==21.23 & stage=="Juvenile"),plotCI(temperature+4,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=22,pt="gray", add=T))
text(6,38, labels = "Juveniles",     adj = c( 0, 1 ), col = "black" )
# etiquetas eje x
# identifica estado caligus
axis(1,at=c(6,10),col="black",line=0,tick=T,labels=rep("",2),lwd=2,lwd.ticks=0)
axis(1,at=8,col="black",line=0,labels="6",tick=T)
axis(1,at=c(12,16),col="black",line=0,tick=T,labels=rep("",2),lwd=2,lwd.ticks=0)
axis(1,at=14,col="black",line=0,labels="12",tick=T)
axis(1,at=c(18,22),col="black",line=0,tick=T,labels=rep("",2),lwd=2,lwd.ticks=0)
axis(1,at=20,col="black",line=0,labels="18",tick=T)
# Adult
with(subset(pela1,kpa.mean==2.36 & stage=="Adult"),plotCI(temperature,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=21,pt="white", ylim=c(0,40),xlim=c(6,24)))
with(subset(pela1,kpa.mean==4.71 & stage=="Adult"),plotCI(temperature+1,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=21,pt="gray", add=T))
with(subset(pela1,kpa.mean==9.44 & stage=="Adult"),plotCI(temperature+2,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=21,pt="black", add=T))
with(subset(pela1,kpa.mean==14.15 & stage=="Adult"),plotCI(temperature+3,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=22,pt="white", add=T))
with(subset(pela1,kpa.mean==21.23 & stage=="Adult"),plotCI(temperature+4,mo2.3, mo2.3.sd,las=1,ylab="", xaxt="n",pch=22,pt="gray", add=T))
text(6,38, labels = "Adults",     adj = c( 0, 1 ), col = "black" )
# etiquetas eje x
axis(1,at=c(6,10),col="black",line=0,tick=T,labels=rep("",2),lwd=2,lwd.ticks=0)
axis(1,at=8,col="black",line=0,labels="6",tick=T)
axis(1,at=c(12,16),col="black",line=0,tick=T,labels=rep("",2),lwd=2,lwd.ticks=0)
axis(1,at=14,col="black",line=0,labels="12",tick=T)
axis(1,at=c(18,22),col="black",line=0,tick=T,labels=rep("",2),lwd=2,lwd.ticks=0)
axis(1,at=20,col="black",line=0,labels="18",tick=T)
# etiqueta eje y
mtext(expression(paste(dot(M)[O[2]], " (",mu,"mol ", O[2], " ",h^-1, " ", g^-1, ")")),side=2,  line=0.5, outer=T)
mtext("Temperature (°C)",side=1, line=0, outer=T)
dev.off()
}


##############################################################################
# DCI_fxs.r

dci_fxs<-function(all_sections=F){

    #source in the 7 functions in R
    #see each function for an explanation of inputs and outputs

    source("convert_gis_output_to_r_format.r")
    source("get_adj_matrix_from_gis.r")
    source("graph_fx.r")
    source("sum_fx.r")
    source("graph_and_data_setup_for_DCI.r")
    source("dci_calc_fx.r")
    source("dci_calc.r")

    convert_gis_output_to_r_format()
    adj_matrix<-get_adj_matrix_from_gis()

    #print(adj_matrix)
    #print(as.matrix(adj_matrix))

    #OLD note:
    #have to assign it an object name as this function gets called in
    #in "graph.and.data.setup.for.DCI.r" and "sum.fx.r"

    graph_fx(plot_it=F, adj_matrix=adj_matrix)
    passability<-read.csv("segments_and_barriers.csv")

    NB<-graph_and_data_setup_for_DCI(passability=passability, adj_matrix=adj_matrix)

    dci_calc(NB,all_sections=all_sections)
}


library(pROC)
source(file.path(PROJECT_DIR, "R/functions/load_sig.r"))
source(file.path(PROJECT_DIR, "R/functions/get_score.r"))

# load gene expression data
fn.ge = file.path(PROJECT_DIR, "generated_data", "CHI", "CHI_GE_matrix_gene.txt")
dat = fread(fn.ge, data.table = F) %>%
  tibble::remove_rownames() %>% tibble::column_to_rownames("gene") %>%
  data.matrix()

fn.si = file.path(PROJECT_DIR, "generated_data", "CHI", "CHI_sample_info_2.txt")
info = fread(fn.si)

ng=10
fn.cd38.cor = file.path(PROJECT_DIR, "generated_data", "CHI", "robust_corr_genes.txt")
gene.sig = load_sig(fn.cd38.cor, "cor.mean.sd.ratio", ntop=ng)

fn.rand = file.path(PROJECT_DIR, "generated_data/CHI/gene_sig_random_500_from_all.txt")
if(!file.exists(fn.rand)) {
  fn.rand = file.path(PROJECT_DIR, "data/random_sig/gene_sig_random_500_from_all.txt")
}
if(!file.exists(fn.rand)) {
  stop("No file with random signatures found in data or generated_data\nRun ./R/chi_signature_analysis/rand.sig_generate.r")
}

r.sig.df = read.table(fn.rand, sep="\t",header=F, row.names = 1)

roc.df = data.frame()
rand.df = data.frame()
N_rand = 500
N_rand = min(N_rand, ncol(r.sig.df))

for (time.pt in c(0,-7,70)) {
  cat(time.pt,"")

  day.pt = paste0("day ", time.pt)
  # test signature
  gi = toupper(rownames(dat)) %in% toupper(gene.sig)
  sum(gi)

  iday = info$time==time.pt
  ihl = info$adjMFC_class[iday] %in% c(0,2)
  X = get_score(dat[gi,iday])[ihl]
  Y = info$adjMFC_class[iday][ihl]

  r = roc(Y,X, direction="<", quiet = T)
  r.df = data.frame(day=day.pt, AUC = as.numeric(r$auc))
  roc.df = rbind(roc.df, r.df)

  # test AUC in random signatures
  for (i in 1:N_rand) {
    r.sig = load_sig(r.sig.df, i, ntop=ng)
    gi = toupper(rownames(dat)) %in% r.sig
    sum(gi)

    X = get_score(dat[gi,iday])[ihl]

    r = roc(Y,X, direction="<", quiet = T)
    r.df = data.frame(day=day.pt, AUC = as.numeric(r$auc))
    rand.df = rbind(rand.df, r.df)
  }

}

fn.rand.rds = file.path(PROJECT_DIR, "generated_data/CHI/chi_random.sig.500_3times.rds")
saveRDS(rand.df, "chi_random.sig.500_3times.rds")

# fn.rand.rds = file.path(PROJECT_DIR, "generated_data/CHI/chi_random.sig.500_3times.rds")
# rand.df = readRDS(fn.rand.rds)

roc.df = roc.df %>%
  mutate(day = case_when(
    day == "day 0" ~ "Baseline 1 (day 0)",
    day == "day -7" ~ "Baseline 2 (day -7)",
    day == "day 70" ~ "Baseline 3 (day 70)"
  ) %>% factor())
rand.df = rand.df %>%
  mutate(day = case_when(
    day == "day 0" ~ "Baseline 1 (day 0)",
    day == "day -7" ~ "Baseline 2 (day -7)",
    day == "day 70" ~ "Baseline 3 (day 70)"
  ) %>% factor())

rand.df.p = rand.df %>%
  rename(rAUC = AUC) %>%
  left_join(roc.df, by="day") %>%
  group_by(day, AUC) %>%
  summarise(p=sum(rAUC>AUC)/nrow(.)) %>%
  ungroup()

ggplot(rand.df, aes(AUC, fill=day)) +
  geom_density(col=NA, alpha=1) +
  facet_wrap(~day,ncol=1) +
  scale_fill_manual(values=c("grey65", "grey80","grey50")) +
  xlim(c(0,1)) +
  geom_vline(data=roc.df, aes(xintercept=AUC), col="red", lty=2) +
  geom_text(data=rand.df.p, aes(label=sprintf("p = %.1g",p)), x=-Inf, y=Inf, hjust=-0.1, vjust = 1.1, size=4) +
  theme_bw() + guides(fill="none") +
  theme(strip.background = element_blank(),
        strip.text.x = element_text(size=12))

fn.fig = file.path(PROJECT_DIR, "figure_generation",
                   "CHI_CD38_10genes_random_sig")
ggsave(paste0(fn.fig,".png"), w=4,h=7)
ggsave(paste0(fn.fig,".pdf"), w=4,h=7)


library(testthat)

# first test
test_that("first", {

  expect_equal( sum(myVector), 6) #22.17444, tolerance=1e-4)

  })

# second test
test_that("second", {

  expect_true(is.character(myString))
  expect_true(len(myString) > 2)

})

# third test
test_that("third", {

  expect_equal(myDataFrame[1,1], 700.01, tolerance=1e-3)
  expect_equal(nrow(myDataFrame), 2)
})


library(data.table)
library(ggplot2)
source('../../../labs.r')

load('../../generated/model/mcmc-results.rdata')

mcsel <- mcmc[variable %in% mc_attributes[vartype %in% c('q0', 'q_f', 'q_g', 'q_f0', 'q_g0', 'q_gf', 'q_gf0'), variable]]
mcsel <- merge(mcsel, mc_attributes, by = 'variable', all.x = T, all.y = F)

mcsel[vartype %in% c('q_g', 'q_g0') , lab := sprintf('Species group - %s', as.character(species_group))]
mcsel[vartype %in% c('q_f', 'q_f0') , lab := sprintf('Fishery group - %s', as.character(fishery_group))]
mcsel[vartype %in% c('q_gf', 'q_gf0') , lab := sprintf('Sp. group x F. group - %s x %s',
                                                       as.character(species_group),
                                                       as.character(fishery_group))]
mcsel[vartype == 'q0'  , lab := 'Intercept']

mcsel[, lab := factor(lab, levels = c('Intercept',
                                      sort(grep('Fishery', unique(lab), val=T)),
                                      sort(grep('Species', unique(lab), val=T)),
                                      sort(grep('Sp\\. group x', unique(lab), val=T))))]

n.labs <- mcsel[, length(unique(lab))]
n.brks.y <- ifelse(n.labs > 30, 2, 5)

brks <- c(1, 3) * rep(10^(0:10), each=2)

g <- ggplot(mcsel, aes(x = ch_sample, y = value, colour = factor(chain), group = factor(chain))) +
    geom_line(size = 0.2) +
    facet_wrap(~ lab, ncol=1, strip.position = 'left', scales = 'free_y') +
    scale_x_continuous(expand = c(0,0)) +
    scale_y_continuous(breaks = brks, trans = 'log1p') +
    ## scale_y_continuous(breaks = function(lims) pretty(lims, n=n.brks.y, min.n=2), trans = 'log1p') +
    labs(x = 'MCMC sample', y = NULL) +
    theme_minimal() +
    theme(legend.position='none',
          strip.text.y=element_text(angle=180, hjust = 1, size = 8),
          strip.placement='outside',
          panel.background=element_rect(fill = '#F4F4F4', color = NA),
          panel.grid.minor=element_blank(),
          panel.grid.major.y=element_line(color = 'white'),
          panel.grid.major.x=element_blank(),
          axis.text = element_text(size = 5),
          axis.title.x = element_text(size = 8))

ggsave('../assets/traces_vulnerabilities.png', width = 8, height = 9)


#!/usr/bin/env r

# Take a subset of the currently very LARGE sample size
# We need to get an accurate representation of our current sample
# while maintaining a size that can be usable in D3 and on Github

Input <- {{In1}}
Output <- {{Out1}}

data <- read.csv(Input)
sigma <- sd(data$shannon_entropy)
e <- .05
n <- floor((((1.96) * sigma)/e)^2)
s <- sample(data$shannon_entropy, n)
d <- sample(data$date, n)
df <- paste(d, s, sep=",")
write.table(df, Output)

Input <- {{In2}}
Output <- {{Out2}}

data <- read.csv(Input)
log_data <- log(data$logbase2_entropy)
sigma <- sd(log_data)
e <- .06
n <- floor((((1.96) * sigma)/e)^2)
s <- sample(log_data, n)
d <- sample(data$date, n)
df <- paste(d, s, sep=",")
write.table(df, Output)


#' Pruning edges from disease differential network that also occur in reference-only network.
#'
#' Recursively diffuse probability from a starting node based on the connectivity of the background knowledge graph, representing the likelihood that a variable will be
#'         most influenced by a perturbation in the starting node.
#' @param ig_dis - The igraph object associated with the disease+reference trained differential interaction network.
#' @param ig_ref - The igraph object associated with the reference-only trained interaction network.
#' @return ig_pruned - The pruned igraph object of the disease+reference differential interaction network, with reference edges subtracted.
#' @export graph.naivePruning
#' @examples
#' ig_pruned=graph.naivePruning(ig_dis, ig_ref)
graph.naivePruning = function(ig_dis, ig_ref) {
  ee = get.edgelist(ig_ref)
  ee = ee[which(apply(ee, 1, function(i) all(i %in% V(ig_dis)$name))),]
  it = 0
  for (e in 1:nrow(ee)) {
    e.id.dis = get.edge.ids(ig_dis, vp=ee[e,])
    e.id.ref = get.edge.ids(ig_ref, vp=ee[e,])
    if (e.id.dis != 0) {
      isSameDirection = ifelse((((E(ig_dis)$weight[e.id.dis]<0) && (E(ig_ref)$weight[e.id.ref]<0)) ||
                               ((E(ig_dis)$weight[e.id.dis]>0) && (E(ig_ref)$weight[e.id.ref]>0))), TRUE, FALSE)

      if (isSameDirection && (abs(E(ig_ref)$weight[e.id.ref]) < abs(E(ig_dis)$weight[e.id.dis]))) {
        E(ig_dis)$weight[e.id.dis] = E(ig_dis)$weight[e.id.dis] - E(ig_ref)$weight[e.id.ref]
        it = it + 1
      }
      if (isSameDirection && (abs(E(ig_ref)$weight[e.id.ref]) > abs(E(ig_dis)$weight[e.id.dis]))) {
        ig_dis = delete.edges(ig_dis, edges = E(ig_dis)[[e.id.dis]])
        it = it + 1
      }
    }
  }
  print(sprintf("%s edges were modified in the disease+reference network.", it))
  return (ig_dis)
}


#' wbgt_indoor
#'
#' Calculate web bulb globe index for indoor environments.
#'
#' @param t    numeric Air temperature in degC.
#' @param rh   numeric Relative humidity in percentage .
#' @param wind numeric Mean Wind speed in meters per second.
#' @param pair numeric Air pressure in millibar or hPa. Default 1010 hPa.
#' @param elev numeric Elevation in meters on sea level. Default is 0.
#' @return wbgt for indoor in degC
#'
#'
#' @author Istituto per la Bioeconomia CNR Firenze Italy  Alfonso Crisci \email{alfonso.crisci@@ibe.cnr.it}
#' @keywords  wbgt_indoor
#'
#' @export
#'
#'
#'
#'

wbgt_indoor=function(t,rh,wind=0.1,pair=1010,elev=0) {
                         ct$assign("t", as.array(t))
                         ct$assign("rh", as.array(rh))
                         ct$assign("wind", as.array(wind))
                         ct$assign("press", as.array(pair))
                         ct$assign("elev", as.array(elev))
                         ct$eval("var res=[]; for(var i=0, len=t.length; i < len; i++){ res[i]=wbgt_indoor(t[i],rh[i],wind[i],press[0],elev[0])};")
                         res=ct$get("res")
                         return(ifelse(res==9999,NA,res))
}


inFile<-file.path(data.path,'Risk_tab_minTAC_noise1_.out')

a<-read.table(file=inFile,header=T)
a$Year<-paste(a$fy,a$ly,sep='-')
a$fy<-a$ly<-NULL
head(a)

b<-reshape(a, direction = "long", varying = 2:4,v.names='value',timevar = "prob" )
b$prob<-paste('Prob',b$prob,sep='')
head(b)

ftable(round(tapply(b$value,list(Option=b$option,prob=b$prob,Years=b$Year),sum),2))


##' Get a sampling function for reporting delays
##'
##' This connects to the Google Sheet containing the collated linelist; the
##'   first time this is run, it may require authentiction with Google
##' @return a function that takes one parameter, `n`, the number of reporting
##'   delays to randomly sample
##' @importFrom dplyr filter
##' @importFrom fitdistrplus fitdist gofstat
##' @author Sebastian Funk <sebastian.funk@lshtm.ac.uk>
##'
##' @export
##'
##' @examples
##'
##' ## Example
##' \dontrun{
##' get_rep_sample_fun()
##' }
##'
##' ## Code
##' get_rep_sample_fun
get_rep_sample_fun <- function() {

  ## CRAN check - dealing with global variables flag
  delay_confirmation <- NULL; country <- NULL; . <- NULL;

  message("Downloading linelist")
  confirmation_delays <- get_linelist() %>%
    dplyr::filter(!is.na(delay_confirmation), country == "China") %>%
    .$delay_confirmation %>%
    as.integer()

  ## fit normal and exponential
  test_distributions <- c("geom", "pois", "nbinom")

  fits <- lapply(stats::setNames(test_distributions, test_distributions), function(x) {
    fitdistrplus::fitdist(confirmation_delays, x)
  })

  gof <- fitdistrplus::gofstat(fits, fitnames = names(fits))

  best_fit <- names(which.min(gof$aic))

  message("Best fitting distribution: ", best_fit)

  good_fit <- (gof$chisqpvalue[best_fit] > 0.05) ## arbitrary threshold at 0.05

  if (!good_fit) { ## no good fit obtained
    message("Fit below threshold. Sampling from data.")
    sample_function <- function(n) {
      sample(confirmation_delays, n, replace = TRUE)
    }
  } else {
    pars <- fits[[best_fit]]$estimate
    sample_function <- function(n) {
      do.call(paste0("r", best_fit), c(list(n = n), as.list(pars)))
    }
  }

  return(sample_function)
}


rm(list = ls())

four.in.a.row = function(player, v, debug=FALSE) { #to judge if connected by four
  if (debug) {
    cat(sep="", "four.in.a.row(player=", player, ", v=", v, ")\n")
  }
  if ( length(v) < 4) {
    return(FALSE)
  }
  for (i in 1 : (length(v)-3)) {
    if(all(c(v[i], v[i+1], v[i+2], v[i+3]) == player)) {
      return(TRUE)
    }
  }
  return(FALSE)#
}

won = function(player, board, r, c, debug=FALSE) { # to test win
  if (debug) {
    cat(sep="", "won(player=", player, ", board=\n")
    print(board)
    cat(sep="", ", r=", r, ", c=", c, ")\n")
  }
  stopifnot((0 <= r & r <= nrow(board)))
  stopifnot((0 <= c & c <= ncol(board)))
  test.vector <- c(board[r, ], board[, c], board[row(board) - col(board) == r-c], board[row(board) + col(board) == r+c])
  test_row <- four.in.a.row(player, board[r, ])
  test_col <- four.in.a.row(player, board[, c])
  test_dia <- four.in.a.row(player, board[row(board) - col(board) == r-c])
  test_red <- four.in.a.row(player, board[row(board) + col(board) == r+c])
  if(any(c(test_row, test_col, test_dia, test_red) == TRUE)) {
    return(TRUE)
  }
  return(FALSE)
}

# Returns largest index of an empty position in column col
# of (matrix) board. If there is no such empty position in
# board, return value is NULL.
largest.empty.row = function(board, col, debug=FALSE) {
  if (debug) {
    cat(sep="", "largest.empty.row(board=\n")
    print(board)
    cat(sep="", ", col=", col, ")\n")
  }
  if (!('' %in% board)) {
    return(NULL)
  }
  i <- 1
  while (board[i, col] != 'X' & board[i, col] != 'O') {
    i <- i+1
    if (i > nrow(board)){
      break
    }
  }
  return(i-1)
}

par(pty="s") # square plot type
y = rep(1:6, each = 7)
x = rep(1:7, times = 6)
symbols(x, y, squares=rep(1, times=42),
        inches=FALSE, # match squares to axes
        xlim=c(0,8),
        ylim=c(7,0),
        main = 'Connect Four'
)

board = matrix(data=rep("", 42), nrow=6, ncol=7)

board.is.full = function(board) {
  return(!("" %in% c(board)))
}

choose_symbol <- function() {
  repeat{
  cat("Which symbol do you like: X or O")
  man <- scan(what = character(), n = 1)
  if (man != 'X' & man != "O") {
    cat('Error, please type X or O')
  } else {
    break
  }
}
  return(man)
}

human <- choose_symbol()

choose_order <- function() {
  repeat{
  cat('Who is the first: ME or PC')
  decision <- scan(what = character(), n = 1)
  if (decision != 'ME' & decision != 'PC') {
    cat('Error, please type ME or PC')
  } else {
    break
  }
}
  return(decision)

}

if (choose_order() == 'ME') {
  repeat{
    index = identify(x, y, n=1, plot=FALSE)
    col = x[index]
    row = largest.empty.row(board, col)
    board[row, col] <- human
    print(board)
    text(x = col, y = row, label = human, col = 'blue')
    if (won(player = human, board, r = row, c = col)) {
      text(x=3.5, y=3, labels=paste(" You won!"), col = "blue", cex = 3)
      break
    }

    repeat {
    indices.empty = which(c(board) == "")
    index = sample(indices.empty, size=1)
    row = y[index]
    col = x[index]
    if (largest.empty.row(board, col) == row) {
       break
      }
    }
    pc <- ifelse(test = (human == 'X'), yes = 'O', no = "X")
    board[row, col] = pc
     if (board.is.full(board) == TRUE) {
      break
    }
    print(board)
    text(x = col, y = row, label = pc, col = 'red')
    if (won(player = pc, board, r = row, c = col)) {
      text(x=3.5, y=3, labels=paste(" PC won!"), col = "blue", cex = 3)
      break
    }
  }

} else {
  repeat {
    repeat {
    indices.empty = which(c(board) == "")
    index = sample(indices.empty, size=1)
    row = y[index]
    col = x[index]
    if (largest.empty.row(board, col) == row) {
      break
     }
    }

    pc <- ifelse(test = (human == 'X'), yes = 'O', no = "X")
    board[row, col] = pc
     if (board.is.full(board) == TRUE) {
      break
    }
    print(board)
    text(x = col, y = row, label = pc, col = 'red')
    if (won(player = pc, board, r = row, c = col)) {
      text(x=3.5, y=3, labels=paste(" PC won!"), col = "red", cex = 3)
      break
    }

    repeat {
      index = identify(x, y, n=1, plot=FALSE)
      row = y[index]
      col = x[index]
      if (largest.empty.row(board, col) == row) {
        break
     }
    }
    board[row, col] <- human
     if (board.is.full(board) == TRUE) {
      break
    }
    print(board)
    text(x = col, y = row, label = human, col = 'blue')
    if (won(player = human, board, r = row, c = col)) {
      text(x=3.5, y=3, labels=paste(" You won!"), col = "blue", cex = 3)
      break
    }
  }
}


# read in data from github
deck <- read.csv('https://github.com/gumdropsteve/datasets/raw/master/deck.csv')

# make copy of dataframe named blackjack
blackjack <- deck

facecard <- c('king', 'queen', 'jack')

# focus rows where face column value is in facecard
blackjack[blackjack$face %in% facecard, ]

# focus value column rows where that row's face column value is in facecard
blackjack$value[blackjack$face %in% facecard]

# make a copy of deck dataframe named hearts
deck_2 <- deck

# set all value column values to 0
deck_2$value <- 0

deck_2

# set all value column values where that row's suit value is 'hearts' to 1
deck_2$value[deck_2$suit == "hearts"] <- 1

deck_2

# add new column ('order') to deck_2 dataframe
deck_2$order <- 1:52

deck_2


# Check if RStudio is running to set the working directory to the script directory
# https://stackoverflow.com/questions/35986037/detect-if-an-r-session-is-run-in-rstudio-at-startup
is.na(Sys.getenv("RSTUDIO", unset = NA))
if (!is.na(Sys.getenv("RSTUDIO", unset = NA))) {
  # Get current directory
  current_dir <- dirname(rstudioapi::getSourceEditorContext()$path)
  # Set working directory to current directory (script directory)
  setwd(current_dir)
} else {
  # If sourced https://stackoverflow.com/questions/13672720/r-command-for-setting-working-directory-to-source-file-location-in-rstudio
  this.dir <- dirname(parent.frame(2)$ofile)
  setwd(this.dir)
}
# Include the excel helper functions
source("excelhelper.r")

# we will use ggplot2 for our charts
library(ggplot2)

# Read the input files
diamonds<- getTable("price_scatterplot")

# Let's say we want to create a chart that shows how many diamonds of each size (small/medium/large) are in our data.
ggplot(diamonds, aes(carat, price, color=clarity)) +
  geom_point() +
  labs(x="Carat Weight", y="Price", title="Price by Carat Weight")

# save the chart
saveChart("price_scatterplot")

# Signal the end of the process
done()

# free up all variables
rm(list=ls())


####
# calculates distribution of
# Rural, Town, and Urban residents in sample (subjects only)
# based on current and childhood residences
# and plots as two side-by-side histograms
####

rm(list=ls())
library(dplyr)
library(tidyr)
library(ggplot2)

# read in data
source('inread.r')
almost_everything <- inread('data/2015_lmsim_data.csv')

df <- almost_everything %>%
        select(Subject_Code, Urban_Status.x, Urban_Status.y)

# set up rural-to-urban ordering
df$Urban_Status.x[df$Urban_Status.x %in% "UNKNOWN"] <- NA
df$Urban_Status.y[df$Urban_Status.y %in% "UNKNOWN"] <- NA
orderXZC <- function(myvar){
  x <- factor(myvar,
        levels = c("XIANG_RURAL","ZHEN_TOWN","CHENG_CITY"),
        labels=c("Rural","Town","Urban"),
        ordered=TRUE)
  return(x)
}
df$Urban_Status.x <- orderXZC(df$Urban_Status.x)
df$Urban_Status.y <- orderXZC(df$Urban_Status.y)

# find and remove rows with incomplete data
no.loc.then <- length(df$Urban_Status.y[is.na(df$Urban_Status.y)])
total.then <- length(df$Subject_Code) - no.loc.then

no.loc.now <- length(df$Urban_Status.x[is.na(df$Urban_Status.x)])
total.now <- length(df$Subject_Code) - no.loc.now

df <- na.omit(df) # to get rid of all missing Location data
en <- length(df$Subject_Code)

# long format for plot
then <- as.data.frame(table(df$Urban_Status.y))
then$time <- 1
now <- as.data.frame(table(df$Urban_Status.x))
now$time <- 2
df2 <- rbind(then, now)
colnames(df2) <- c("res", "n", "time")
df2$time <- factor(df2$time,
            labels = c("Childhood Residence", "Current Residence"))

# save plot data to text
write.csv(df2, file="analysis/urb_dist.csv",
                fileEncoding = "UTF-8",
                row.names=FALSE)

# plot elements
colors <- c("#57a3ad", "#dea73a") #teal, gold
  #colors <- c("gray25", "gray75")
X.lab <- "Residence Type"
Y.lab <- "Number of Interviewees"
n <- en
nphrase <- paste("N =", en, "interviewees", sep=" ")
title <- "Rural, town and urban residents in the sample"

p <-
  ggplot(data=df2, aes(x = res, y=n, fill=time)) +
  geom_bar(stat = "identity") +
  scale_fill_manual(values=colors, guide = FALSE)+
  facet_wrap( ~ time) +
  labs(title = paste(title, nphrase, sep = "\n")) +
  theme(plot.title = element_text(hjust = 0.5)) + # center
  theme(axis.text=element_text(size=12),
        axis.title=element_text(size=12)) +
  theme(strip.text = element_text(size=12)) +
  xlab(X.lab) + ylab(Y.lab)

# plot out
ggsave(plot=p, file="figures/urb_dist.pdf",
        width=8, height=5, units="in")
ggsave(plot=p, file="figures/urb_dist.jpg",
        width=8, height=5, units="in")


# after run-model5-3.R

load('…/ch.5/output/result-model5-3.RData')

ms <- rstan::extract(fit)
noise <- t(-t(ms$mu) + d$Y)


rm(list=ls())
source('paths.r')
source('paths_fall2019.r')
library(vegan)
library(ggbiplot)
library(RColorBrewer)

#set output path.----
output.path <- paste0(scc_gen_16S_dir, 'figures/parameter_PCA_ddirch_16S.png')

#load raw data and predictors.----
pl <- readRDS(prior_delgado_ddirch_16S.path)
#pl <- readRDS(bahram_16S_prior_phylo.group_JAGSfits)
#pl <- readRDS(bahram_16S_prior_dmulti.ddirch_all.group_JAGSfits)[1:5]
#names(pl)[6] <- 'functional'

#colors.----
cols <- brewer.pal(length(pl) - 1,'Spectral')
cols <- c(cols,'green')

#get together parameters as a matrix and R2 values.----
d <- list()
col.plot <- list()
rsq.out <- list()
pca.sub <- list()
for(i in 1:5){
    lev <- pl[[i]]$species_parameter_output
  pars <- list()
  rsq.lev <- list()
  for(k in 1:length(lev)){
    pars[[k]] <- as.numeric(as.character(lev[[k]]$Mean))
    mod <- lm(pl[[i]]$observed[,k] ~ pl[[i]]$predicted[,k])
    rsq.lev[[k]] <- summary(mod)$r.squared
  }
  pars <- do.call(cbind, pars)
  rsq.lev <- unlist(rsq.lev)
  names(rsq.lev) <- names(lev)
  colnames(pars) <- names(lev)
  rownames(pars) <- as.character(lev$other$predictor)
  pars <- pars[,!(colnames(pars) == 'other'|colnames(pars) == 'V6'), drop=F]
  d[[i]] <- pars
  rsq.out[[i]] <- rsq.lev
  col.plot[[i]] <- rep(names(pl)[i],ncol(pars))
  pca.sub[[i]] <- prcomp(t(pars), center = T, scale = T)
}

# PCA for functional groups
fg <- list()
for(i in 6:18){
  lev <- pl[[i]]$species_parameter_output
  pars <- list()
  rsq.lev <- list()
  for(k in 1:length(lev)){
    pars[[k]] <- as.numeric(as.character(lev[[k]]$Mean))
  }
  pars <- do.call(cbind, pars)
  colnames(pars) <- names(lev)
  rownames(pars) <- as.character(lev$other$predictor)
  pars <- pars[,!(colnames(pars) == 'other'), drop=F]
  fg[[i]] <- pars
}
d[[6]] <- do.call(cbind, fg[6:18])
col.plot[[6]] <- rep("functional", ncol(d[[6]]))
pca.sub[[6]] <- prcomp(t(d[[6]] ), center = T, scale = T)

col.plot <- unlist(col.plot)
names(pca.sub) <- c(names(pl)[1:5], "functional")

d <- do.call(cbind, d)
d <- d[,!(colnames(d) == 'other')]
# some names are repeated at diff levels - distinguish them
colnames(d)[which(colnames(d) == "actinobacteria")[1]] <- "p.actinobacteria"
colnames(d)[which(colnames(d) == "gemmatimonadetes")[1]] <- "p.gemmatimonadetes"
#Do PCA ordination.----
par.pca <- prcomp(t(d), center = TRUE,scale. = TRUE)

#setup plot output.----
png(filename=output.path,width=10,height=10,units='in',res=300)

col.plot <- factor(col.plot, levels = c("functional", "phylum", "class", "order", "family", "genus"))
#plot code.----
lab <- colnames(d)
par(mfrow = c(1,1))
ggbiplot(par.pca, labels = lab, groups = col.plot) + xlim(-2.25, 2.5)

#end plot.----
dev.off()


directoryfunc <- function() {
print(getwd()) # Get and print current working directory.
}

#The csv file is a text file in which the values in the columns are separated by a comma
csvreader <- function(){
#read.csv() function is used to read a CSV file available in your current working directory
data <- read.csv("input.csv")
print(data)
#By default the read.csv() function gives the output as a data frame
print(is.data.frame(data))
print(ncol(data))
print(nrow(data))
}
csvreader()

getmax <- function(){
# Create a data frame.
data <- read.csv("input.csv")
# Get the max salary from data frame.
sal <- max(data$salary)
print(sal)
# Get the person detail having max salary.
retval <- subset(data, salary == max(salary))
print(retval)
}
getmax()

#getting all the people in a department
department <- function(depart){
# Create a data frame.
data <- read.csv("input.csv")

retval <- subset( data, dept == depart)
print(retval)
}
department("IT")

#getting all the people in a department whom their salary is above a certain amount
departandsalary <- function(depart,sal){
# Create a data frame.
data <- read.csv("input.csv")

info <- subset(data, salary > sal & dept == depart)
print(info)
}
departandsalary("IT",600)

#Get the people who joined on or after a certain date
datefinder <- function(date){
# Create a data frame.
data <- read.csv("input.csv")

retval <- subset(data, as.Date(start_date) > as.Date(date))
print(retval)
}
datefinder("2014-01-01")

#The csv file is a text file in which the values in the columns are separated by a comma
csvwriter <- function(){
# Create a data frame.
data <- read.csv("input.csv")
retval <- subset(data, as.Date(start_date) > as.Date("2014-01-01"))

# Write filtered data into a new file. when we false row.names, the numbers of rows picked will disapear
write.csv(retval,"output.csv", row.names = FALSE)
newdata <- read.csv("output.csv")
print(newdata)
}
csvwriter()


library(date)
#
#  This script MUST be run AFTER the "read_ASCII_grid_generic.r" script
#  is run....this script processes the output of the "read_ASCII_grid" script.
#

source("D:/SMWData/R_Scripts/matrix_manip.r")
source("D:/SMWData/R_Scripts/image_legend.r")

guiSetStyle.tcltk(style = "large", ask = FALSE)

jpeg.filename<-guiDlgInput("Enter prefix for output jpg files",default="Rplot_")

start.mo<-guiDlgInput("Enter starting month of simulation (1-12)",default=1)
start.day<-guiDlgInput("Enter starting day of simulation (1-31)",default=1)
start.year<-guiDlgInput("Enter starting year of simulation (1900-2100)",default=1999)

title.text<-guiDlgInput("Enter text for the plot title",
  default="Black Earth Creek Test Case - Year 1999 RECHARGE Estimates")

scale.min<-as.numeric(guiDlgInput("MINIMUM scale value",default=-1.0))
scale.max<-as.numeric(guiDlgInput("MAXIMUM scale value",default=1.0))

pathname.vic.input<-guiDlgDir(title="Select the directory that contains the ASCII land use grid",
  dir=pathname.vic)

descriptor.text<-guiDlgInput("Enter text description of data type",
  default="RECHARGE (inches)")

setwd(path.to.animations)

land.cover <- readAsciiGrid(paste(pathname.vic.input,"/land_cov.grd",sep=""), as.image=TRUE)

dim(land.cover$z)<-NULL

land.cover.percent<-aggregate(land.cover$z,list(land.cover=land.cover$z),FUN=length)
land.cover.percent$pct.area<-formatC(land.cover.percent$x/length(land.cover$z)*100,digits=1,
   width=3,format="f")
land.cover.percent$x<-NULL

#unlink("Rplot*.jpg")

jpeg(filename = paste(jpeg.filename,"%04d.jpg",sep=""), width = 800, height = 600,
          pointsize = 12, bg = "white", res = NA,quality=100)

#pdf(file = "Rplot%04d.pdf", width = 10.666, height = 8.0,
#          pointsize = 12, bg = "white",onefile=FALSE)

#red to green to blue
colorTable<-c(rainbow(n=10,start=0,end=1/6),rgb(1,1,1),rainbow(n=10,start=2/6,end=5/6))

par("mar" = c(3, 3, 6, 9) + 0.1) # wide righthand margin

near.zero<-1e-4

sum.mean.wes<-0
sum.mean.vic<-0

i<-1

for (i in 1:num.grids.vic) {

  date.string<-as.character(date.mmddyyyy(mdy.date(as.numeric(start.mo),
    as.numeric(start.day),as.numeric(start.year))+(i-1)))
  diffgrid=eval(parse(text=paste(prefix.vic,".vic.",i,"$z - ",prefix.wes,".wes.",i,"$z",sep="")))
  vic.list<-eval(parse(text=paste(prefix.vic,".vic.",i,"$z",sep="")))
  dim(vic.list)<-NULL
  vic.min<-min(vic.list)
  vic.max<-max(vic.list)
  vic.mean<-mean(vic.list)
  vic.sd<-sd(vic.list)
  vic.median<-median(vic.list)
  sum.mean.vic<-sum.mean.vic + vic.mean

  wes.list<-eval(parse(text=paste(prefix.wes,".wes.",i,"$z",sep="")))
  dim(wes.list)<-NULL
  wes.min<-min(wes.list)
  wes.max<-max(wes.list)
  wes.mean<-mean(wes.list)
  wes.sd<-sd(wes.list)
  wes.median<-median(wes.list)
  sum.mean.wes<-sum.mean.wes + wes.mean

#  assign(paste("rech.vic.minus.wes.",i,sep=""),diffgrid)

   g.min<-min(diffgrid)
   g.max<-max(diffgrid)
   g.mean<-mean(diffgrid)

     par(family="sans", font=1)
     image.matrix(diffgrid,col=colorTable,axes=FALSE,zlim=c(scale.min,scale.max))
     box()
     image.scale(c(scale.max:scale.min),col=colorTable,digits=2,size=12,labels="range")
     title(main = list(title.text, cex=1.3,
                       col="red", font=3),line=4)

    dim(diffgrid)<-NULL

    g.sd<-sd(diffgrid)
    g.median<-median(diffgrid)

    mtext(sprintf("JULIAN DAY: %i  (%s)\nDIFFERENCE: min: %8.2f   max: %8.2f   mean: %8.2f   median: %8.2f",
        i,date.string,g.min,g.max,g.mean,g.median),side=1,line=1)

    mtext(sprintf(
     "VIC: min: %8.2f   max: %8.2f   mean: %8.2f   median: %8.2f\nWES: min: %8.2f   max: %8.2f   mean: %8.2f   median: %8.2f",
         vic.min,vic.max,vic.mean,vic.median,wes.min,wes.max,wes.mean,wes.median),line=1)

    diff.min<-aggregate(diffgrid,list(land.cover=land.cover$z),FUN=min)
    diff.min$x<-formatC(diff.min$x,format="f",digits=2,width=6)
    colnames(diff.min)<-c("land.cover","diff.min")

    diff.mean<-aggregate(diffgrid,list(land.cover=land.cover$z),FUN=mean)
    diff.mean$x<-formatC(diff.mean$x,format="f",digits=2,width=6)
    colnames(diff.mean)<-c("land.cover","diff.mean")

    diff.max<-aggregate(diffgrid,list(land.cover=land.cover$z),FUN=max)
    diff.max$x<-formatC(diff.max$x,format="f",digits=2,width=6)
    colnames(diff.max)<-c("land.cover","diff.max")
    txt<-capture.output(merge(merge(merge(land.cover.percent,diff.min,by="land.cover"),
                    diff.mean,by="land.cover"),
                    diff.max,by="land.cover"))

    par(family="mono", font=2)
    text(100,70,paste(txt,collapse="\n"),cex=0.65)

cat("file",i,"of",num.grids.vic,": DIFFERENCE",
  " ==>   min:",g.min," max:",g.max," mean:",g.mean,"\n")
flush.console()

}

dev.off()

cat(descriptor.text,": Wes = ",sum.mean.wes,"   Vic = ",sum.mean.vic,"\n\n")


library(tidyverse)
library(scales)

library(DBI)

formatNumber <-
    function(value, accuracy = NULL) {

        if (is.na(value) || (value == -Inf) || (value == Inf))
            return(value)

        if (value < 1e6)
            return(scales::comma(value))

        # else  ...
        if (is.null(accuracy)) {
            accuracy <- 0.001

        } else if (accuracy == -1)
            accuracy <- NULL

        value <- scales::label_number_si(accuracy = accuracy)(value)

        # know there's a more efficient way to do this, need to get the regex right for the final lookahead
        if (str_detect(value, "\\.[0]+\\D"))
            value <- str_remove(value, "\\.[0]+")

        return(value)
    }
formatNumber <- Vectorize(formatNumber)

# shared legends
# adapted from https://stackoverflow.com/a/13650878
# points to more complex https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs

create_shared_legend <-
    function(selected_plot){

        pseudo_plot <- ggplot_gtable(ggplot_build(selected_plot))
        legend <- which(sapply(pseudo_plot$grobs, function(x) x$name) == "guide-box")

        return(pseudo_plot$grobs[[legend]])
    }

#  adapted from https://maxcandocia.com/article/2020/Aug/30/log-scale-zero-and-negative-values/
# to deal with log transform of values beween 0 and 1 - the log transform to negative is not useful here

log_linear_transform <-
    function(x) case_when(x < -1 ~ -log10(abs(x)) - 1,
                          x > 1 ~ log10(x) + 1,
                          TRUE ~ x
                         )

log_linear_transform_inverse <-
    function(x) case_when(x < -1 ~ -10 ^(abs(x + 1)),
                          x > 1 ~ 10 ^(x - 1),
                          TRUE ~ x
                         )

log_linear_scale_transform = trans_new(

    'LogLinearTransform',
    transform = log_linear_transform,
    inverse = log_linear_transform_inverse,

    breaks = function(x) {
        x = x[is.finite(x)]

        getRange = range(x)

        if (getRange[1] < -1)
            min_val = -ceiling(log10(abs(getRange[1]) + 1)) - 1
        else if (getRange[1] < 0)
            min_val = -1
        else if (getRange[1] < 1)
            min_val = 0
        else
            min_val = ceiling(log10(getRange[1])-1) - 1

        if (getRange[2] > 1)
            max_val = floor(log10(abs(getRange[2]) + 1)) + 1
        else if (getRange[2] > 0)
            max_val = 1
        else if (getRange[2] > -1)
            max_val = 0
        else
            max_val = -floor(log10(abs(getRange[1])) - 1) + 1

        breaks = log_linear_transform_inverse(as.numeric(seq.int(min_val, max_val)))
        return(breaks)

    } # end definition of breaks
)

#
# adapted from https://www.aliciaschep.com/blog/js-rmarkdown
# and that adapted from http://livefreeordichotomize.com/2017/01/24/custom-javascript-visualizations-in-rmarkdown
#
r_dataframe_to_js <- function(x, var_name = "data", ...) {

  json_data <- jsonlite::toJSON(x, ...)
  htmltools::tags$script(paste0("var ",var_name," = ", json_data, ";"))
}

# updated with newer function calls
writeToDataStore <-
    function(dataLoaded, dbConnection, dbTable, overwriteDataStore = FALSE) {

        if (is_null(dataLoaded) || (nrow(dataLoaded) == 0))
            stop("You must read in a dataframe containing at least one row!")

        #table_exists <- as.logical(dbGetQuery(dbConnection, paste0("SELECT COUNT(*) FROM sqlite_master WHERE name = '",
        #                                                           dbTable, "' and type = 'table'")))

        table_exists <- dbExistsTable(dbConnection, dbTable)
        if (!table_exists | overwriteDataStore)
            currentRowCount <- 0
        else
            currentRowCount <- dbGetQuery(dbConnection, paste("SELECT COUNT(*) FROM", dbTable)) %>%
                                    as.integer

        #if (!table_exists)
        #    dbCreateTable(dbConnection, dbTable, dataLoaded) # sometimes fails for no obvious reason ...
        #else
            dbWriteTable(dbConnection, dbTable, dataLoaded, append = !overwriteDataStore, overwrite = overwriteDataStore)

        invisible(as.integer(dbGetQuery(dbConnection, paste("SELECT COUNT(*) FROM", dbTable))) - currentRowCount)
    }

removeDuplicatesFromDataStore <-
    function(dbConnection = NULL, dbTable = NULL) {

        if (is_null(dbConnection) | is_null(dbTable))
            stop("You must specify database connection and table to deduplicate!")

        #if (!as.logical(dbGetQuery(dbConnection,
        #                           paste0("SELECT COUNT(*) FROM sqlite_master WHERE name = '", dbTable, "' and type = 'table'"))))
        if (!dbExistsTable(dbConnection, dbTable))
            stop("No changes made; source table does not exist!")

        row_count <- as.integer(dbGetQuery(dbConnection, paste("SELECT COUNT(*) FROM", dbTable)))
        if (row_count == 0) {

            message(paste0("Table'", dbTable, "' empty; no changes made."))
            invisible(row_count) # nothing to do - allows simple conversion to FALSE
        }

        tmp_table <- paste0(dbTable, "_tmp")
        #if (as.integer(dbGetQuery(dbConnection,
        #                          paste0("SELECT COUNT(*) FROM sqlite_master WHERE name = '", tmp_table, "' and type = 'table'"))) > 0)
        if (dbExistsTable(dbConnection, tmp_table))
            dbRemoveTable(dbConnection, tmp_table)

        dbExecute(dbConnection, paste("CREATE TABLE ", tmp_table, " AS SELECT * FROM", dbTable, "WHERE 0"))
        dbExecute(dbConnection, paste("INSERT INTO", tmp_table,
                                      "SELECT DISTINCT * FROM", dbTable)
                 )

        row_count <- row_count - as.integer(dbGetQuery(dbConnection, paste("SELECT COUNT(*) FROM", tmp_table)))
        if (row_count > 0) {
            dbRemoveTable(dbConnection, dbTable)
            dbExecute(dbConnection, paste("ALTER TABLE", tmp_table, "RENAME TO", dbTable))
        } else
            dbRemoveTable(dbConnection, tmp_table)

        invisible(row_count) # no. of rows deleted
    }


#' Assign HUC 8 & 12 values to sites
#'
#' This function assigns HUC 8 & 12 values to water quality portal type site objects (or data with site information attached).
#' @param data Input dataset. Must include latitude & longitude columns.
#' @param lat Name of latitude column. Default matches WQP objects.
#' @param long Name of longitude column. Default matches WQP objects.
#' @importFrom sf st_as_sf
#' @importFrom sf st_set_crs
#' @importFrom sf st_intersection
#' @examples
#' # Read a couple of sites from Mantua Reservoir
#' sites=readWQP(type="sites", siteid=c("UTAHDWQ_WQX-4900440","UTAHDWQ_WQX-4900470"))
#' sites_HUCs=assignHUCs(sites)
#' @return Returns the input data frame with HUC 8 & 12 information appended.
#' @export
assignHUCs=function(data, lat="LatitudeMeasure", long="LongitudeMeasure"){
	poly=wqTools::huc8_12_poly
	x=data
	x=sf::st_as_sf(x, coords=c(long,lat), crs=4326, remove=F)
	x=sf::st_set_crs(x, sf::st_crs(poly))
	isect=suppressMessages({suppressWarnings({sf::st_join(x, poly, left=TRUE)})})
	sf::st_geometry(isect)=NULL
	return(isect)
}


#!/usr/bin/env Rscript

data = "user/visitors/histogram/histogram_demo2.txt"
melted = FALSE
xvariable = "NULL"
yvariable = "NULL"
color_variable = "NULL"
color_variable_order = "NULL"
group_variable = "NULL"
group_variable_order = "NULL"
legend_variable = "NULL"
value_scale = 1
facet_variable = "NULL"
facet_variable_order = "NULL"
maximum_allowed = Inf
yaxis_statistics = "density"
alpha = 0.4
plot_type = "line"
binwidth = NULL
hist_bar_position = "identity"
yaxis_scale_mode = "NULL"
y_add = 0
fill_area = FALSE
line_size = 1
add_mean_value_vline = FALSE
facet_scales = "fixed"
facet_ncol = NULL
facet_nrow = NULL
xtics = TRUE
ytics = TRUE
legend.position = "top"
xtics_angle = 0
manual_xtics_value = "NULL"
manual_xtics_pos = "NULL"
custom_vline_x_position = "NULL"
custom_vline_anno = "NULL"
manual_color_vector = "white,blue"
x_label = "NULL"
y_label = "NULL"
title = "Histogram result"
width = 25
height = 15
outputprefix = "user/visitors/histogram/histogram_demo2.txt"
outputpictype = "pdf"

library(YSX)
library(ggplot2)
library(reshape2)
library(grid)
library(dplyr)

if (data == "") {
  script = sub(".*=", "", commandArgs()[4])
  #print(script)
  system(paste(script, "-h"))
  stop("At least -f is required!")
}

if (outputprefix == "") {
  outputprefix = data
}

filename = paste0(outputprefix, '.histogram.', outputpictype)

color_variable_order = sp_string2vector(color_variable_order)
group_variable_order = sp_string2vector(group_variable_order)
facet_variable_order = sp_string2vector(facet_variable_order)
manual_color_vector = sp_string2vector(manual_color_vector)

sp_histogram(
  data = data,
  melted = melted,
  xvariable = xvariable,
  yvariable = yvariable,
  color_variable = color_variable,
  color_variable_order = color_variable_order,
  group_variable = group_variable,
  group_variable_order = group_variable_order,
  legend_variable = legend_variable,
  value_scale = value_scale,
  facet_variable = facet_variable,
  facet_variable_order = facet_variable_order,
  maximum_allowed = maximum_allowed,
  yaxis_statistics = yaxis_statistics,
  plot_type = plot_type,
  binwidth = binwidth,
  hist_bar_position = hist_bar_position,
  alpha = alpha,
  yaxis_scale_mode = yaxis_scale_mode,
  y_add = y_add,
  fill_area = fill_area,
  line_size = line_size,
  add_mean_value_vline = add_mean_value_vline,
  manual_color_vector = manual_color_vector,
  facet_scales = facet_scales,
  facet_ncol = facet_ncol,
  facet_nrow = facet_nrow,
  xtics = xtics,
  ytics = ytics,
  legend.position = legend.position,
  xtics_angle = xtics_angle,
  manual_xtics_value = manual_xtics_value,
  manual_xtics_pos = manual_xtics_pos,
  custom_vline_x_position = custom_vline_x_position,
  custom_vline_anno = custom_vline_anno,
  x_label = x_label,
  y_label = y_label,
  title = title,
  file_name = file_name
)


#Create SummaryTables (needed before other CRAFTYOutput scripts)
#Takes mapbiomas maps and converts to tables of summary data by municipality
#Assumes 5 land covers. Outputs data to SummaryTables directory

rm(list=ls())

library(raster)
library(tidyverse)
library(mapview)

######
#FUNCTIONS
#raster to xyz  (with help from https://stackoverflow.com/a/19847419)
#sepcify input raster, whether nodata cells should be output, whether a unique cell ID should be added
#return is a matrix. note format is row (Y) then col (X)
extractXYZ <- function(raster, nodata = FALSE, addCellID = TRUE){

  vals <- raster::extract(raster, 1:ncell(raster))   #specify raster otherwise dplyr used
  xys <- rowColFromCell(raster,1:ncell(raster))
  combine <- cbind(xys,vals)

  if(addCellID){
    combine <- cbind(1:length(combine[,1]), combine)
  }

  if(!nodata){
    combine <- combine[!rowSums(!is.finite(combine)),]  #from https://stackoverflow.com/a/15773560
  }

  return(combine)
}

getLCs <- function(data)
{
  #calculates proportion of each LC in the muni (ignoring NAs, help from https://stackoverflow.com/a/44290753)
  data %>%
    group_by(muniID) %>%
    dplyr::summarise(LC1 = round(sum(lc == 1, na.rm = T) / sum(!is.na(lc)), 3),
                     LC2 = round(sum(lc == 2, na.rm = T) / sum(!is.na(lc)), 3),
                     LC3 = round(sum(lc == 3, na.rm = T) / sum(!is.na(lc)), 3),
                     LC4 = round(sum(lc == 4, na.rm = T) / sum(!is.na(lc)), 3),
                     LC5 = round(sum(lc == 5, na.rm = T) / sum(!is.na(lc)), 3),
                     NonNAs = sum(!is.na(lc)),
                     NAs = sum(is.na(lc))
    ) -> LCs

  return(LCs)
}
######

#####
#Only needed once, hence commented out
#initially needed to create raster of munis on same projection as mapbiomas data
#munis.r <- raster("Raster/sim10_BRmunis_latlon_5km.asc")
#plot(munis.r)

#lc2000 <- raster("Raster/brazillc_2000_int_reclass_5km_txt.txt")

#need to resample to get raster to align?!
#munis.r.new = resample(munis.r, lc2000, "ngb")

#writeRaster(munis.r.new, "Raster/sim10_BRmunis_latlon_5km_2018-03-21", format = 'ascii')
# ######

input_path <- "C:/Users/k1076631/Google Drive/Shared/Crafty Telecoupling/Data/"
classification <- "PastureB"

#load the rasters
munis.r <- raster(paste0(input_path,"CRAFTYInput/Data/sim10_BRmunis_latlon_5km_2018-04-27.asc"))

#calib_yrs <- seq(2001, 2015, 1)
calib_yrs <- c(2000)

for(yr in calib_yrs){

  inname <- paste0("Data/ObservedLCmaps/PlantedArea_brazillc_",classification,"_",yr,".asc")
  outname <- paste0("Data/SummaryTables/LCs",yr,"_",classification,".csv")

  lc <- raster(inname)

  #extract cell values to table format
  munis.t <- extractXYZ(munis.r, addCellID = F)
  lc.t <- extractXYZ(lc, addCellID = F)

  munis.t <- as.data.frame(munis.t)
  munis.t <- plyr::rename(munis.t, c("vals" = "muniID"))

  lc.t <- as.data.frame(lc.t)
  lc.t <- plyr::rename(lc.t, c("vals" = "lc"))

  #set NA in both rasters
  lc[is.na(munis.r)] <- NA
  munis.r[is.na(lc)] <- NA

  lc_munis <- left_join(as.data.frame(munis.t), as.data.frame(lc.t), by = c("row" = "row", "col" = "col"))

  #now summarise by muniID
  lcs <- getLCs(lc_munis)

  head(lcs)
  summary(lcs)

  write.csv(lcs, outname, row.names = F)

}

#plot municipalities with NAs
#library(sf)
#BRmunis <- st_read(paste(CRAFTY_testing, "/Vector/BRmunis_sim10_simple2.shp", sep = ""))

#cDat_map <- left_join(BRmunis, lcs_2000, by = c("CD_GEOCMUn" ="muniID"))

#plot(cDat_map["NAs"], breaks = c(0,1,100), pal = c("darkgreen","red"), graticule = st_crs(cDat_map), axes = TRUE)


S10AAJ Example Program Results

        X               Y
        -2.000e+01      -1.000e+00
        -5.000e+00      -9.999e-01
        5.000e-01       4.621e-01
        5.000e+00       9.999e-01


#'@title  For a monhtly time series, compute sum and proportion by month across all years
#'
#'@usage  tsSum <- sumAcrossYears(tsData)
#'
#'@param tsData A time series object
#'
#'@return A data frame reporting the monthly sum across all years and the proportion this sum contributes to the total.
#'
#'@import dplyr
#'@export

sumAcrossYears  <- function(tsData)
{

	library(dplyr)

    # Read the time series into a data frame with character string months
	tsAsDf <- data.frame(MONTH_NUM=cycle(tsData), TS_VALUE=tsData, stringsAsFactors = F)
	# Summarize by month across all years
	tsAggregatedByMonth <- tsAsDf %>% dplyr::group_by(MONTH_NUM) %>% dplyr::summarize(SUM=sum(TS_VALUE))
	# Compute proportion for each month
	tsPropByMonth <- data.frame(MONTH_NUM=tsAggregatedByMonth$MONTH_NUM, PROP=tsAggregatedByMonth$SUM/sum(tsData), stringsAsFactors = F)
	# Get sum and proportion in a single data frame
	tsSummary <- merge(tsAggregatedByMonth, tsPropByMonth, by.x = "MONTH_NUM", by.y="MONTH_NUM")

	return (tsSummary[order(tsSummary$PROP, decreasing = T),])
}


library(ggplot2)
library(tidyr)
library(dplyr)
library(rstan)
library(data.table)
library(lubridate)
library(gdata)
library(EnvStats)
library(matrixStats)
library(scales)
library(gridExtra)
library(ggpubr)
library(bayesplot)
library(cowplot)
make_data = function(filename,label,counterfactual=FALSE, i, days=7) {
  out=rstan::extract(fit)
  N <- length(dates[[i]])
  N2 <- N + days
  times_forecast <- dates[[i]][N2]
  country <- countries[[i]]

  if(counterfactual == TRUE) {
    out$E_deaths = out$E_deaths0
    estimated.deaths = out$E_deaths0
    out$prediction = out$prediction0
  }
  out$E_deaths <- out$E_deaths[,1:N2,i]
  out$prediction = out$prediction[,1:N2,i]
  estimated.deaths <- estimated.deaths[,1:N2,i]
  estimated_deaths <- colMeans(estimated.deaths)
  estimated_deaths_li <- colQuantiles(estimated.deaths, probs=.025)
  estimated_deaths_ui <- colQuantiles(estimated.deaths, probs=.975)

  data_country <- data.frame("time" = as_date(as.character(dates[[i]][1:N2])),
                             "country" = rep(country, length(dates[[i]][1:N2])),
                             #"country_population" = rep(country_population, length(dates[[i]])),
                             "estimated_deaths_c" =  cumsum(estimated_deaths),
                             "death_min_c" = cumsum(estimated_deaths_li),
                             "death_max_c"= cumsum(estimated_deaths_ui),
                             "estimated_deaths" = estimated_deaths,
                             "death_min" = estimated_deaths_li,
                             "death_max"= estimated_deaths_ui)

  return(list(data_country=data_country, estimated_deaths=out$E_deaths, estimated_infections=out$prediction))
}


library(clinfun)
source(file.path(PROJECT_DIR, "R/functions/get_score.r"))
source(file.path(PROJECT_DIR, "R/functions/load_sig.r"))

# load CD38 signature genes
fn.cd38.cor = file.path(PROJECT_DIR, "generated_data", "CHI", "robust_corr_genes.txt")
gene.sig = load_sig(fn.cd38.cor, "cor.mean.sd.ratio", ntop=10)

# load gene expression data
fn.ge = file.path(PROJECT_DIR, "generated_data", "CHI", "CHI_GE_matrix_gene.txt")
dat = fread(fn.ge, data.table = F) %>%
  tibble::remove_rownames() %>% tibble::column_to_rownames("gene") %>%
  data.matrix()

fn.si = file.path(PROJECT_DIR, "generated_data", "CHI", "CHI_sample_info_2_CD38hi.txt")
info = fread(fn.si, data.table=F)
info = info %>% mutate(Response = factor(Response, levels=c("low","middle","high")))

roc.df = data.frame()
df = data.frame()
df.text = data.frame()

for (tp in c(0,-7,70)) {
  si = with(info, time == tp)# & !is.na(CD38hi))
  sum(si)
  tdat = dat[,si]
  tinfo = info[si,]

  day.pt = case_when(
    tp == 0 ~ "Baseline 1 (day 0)",
    tp == -7 ~ "Baseline 2 (day -7)",
    tp == 70 ~ "Baseline 3 (day 70)"
  )

  gi = toupper(rownames(tdat)) %in% toupper(gene.sig)
  sum(gi)

  ihl = tinfo$Response %in% c("low","middle","high")
  X = get_score(tdat[gi,])[ihl]
  Y = tinfo$Response[ihl]

  w.pv = jonckheere.test(X, as.numeric(Y), alternative="inc")$p.value

  df.text = rbind(df.text,
                  data.frame(day.label = day.pt,
                             label.w.pv=sprintf("p = %.2g",w.pv)))

  tmp = data.frame(day = paste0("day ", tp), day.label=day.pt, subject=tinfo$subject[ihl], score=X, Response=factor(Y))
  df = rbind(df, tmp)
}

df.text$x = rep(0.25, 3)
df.text$y = rep(0.1, 3)

df = df %>%
  mutate(day.label = factor(day.label))

# Generate boxplots
ggplot(df, aes(x=Response, y=score, group=Response)) +
  geom_boxplot(aes(fill=day.label), alpha=1, outlier.colour = NA) +
  geom_dotplot(binaxis = "y", stackdir = "center", aes(fill=Response)) +
  facet_wrap(~day.label, nrow=1) +
  scale_fill_manual(values=c("grey70", "grey90","grey50", "black", "white","grey35"), name="Response",
                    breaks=c(0,2), labels=c("low","high")) +
  geom_text(data = df.text, aes(label=label.w.pv), x=1.5, y=Inf,vjust=1.1, hjust=0.5, size=4, inherit.aes = F) +
  xlab("Response") + ylab("Baseline signature score") +
  coord_cartesian(xlim=c(0.8, 3.2)) +
  theme_bw() + theme(legend.position="none") +
  theme(panel.border = element_blank(), strip.background = element_blank(),
        strip.text.x = element_text(size=12),
        panel.spacing = unit(0,"mm"), panel.grid.major.x = element_blank(),
        axis.ticks = element_blank())

fn.fig = file.path(PROJECT_DIR, "figure_generation", "CD38.10gene.sig_vs_response_3time_with_mid_Johckheere")
ggsave(paste0(fn.fig, ".png"), w=7,h=3.5)
ggsave(paste0(fn.fig, ".pdf"), w=7,h=3.5)


require(haven)
require(mice)
require(tidyverse)

H_ELSA_base <- read_dta('H_ELSA_f_2002-2016.dta')

impVars2 <- H_ELSA_base %>% select(matches(c('idauniq', 'r[0-9]iwstat', 'rabyear$', 'radyear', 'ragender$', 'raeducl$', 'r[0-9]walkra$', 'r[0-9]dressa$', 'r[0-9]batha$',
                                             'r[0-9]eata$', 'r[0-9]beda$', 'r[0-9]toilta$', 'r[0-9]mapa$', 'r[0-9]phonea$', 'r[0-9]moneya$', 'r[0-9]medsa$', 'r[0-9]shopa$', 'r[0-9]mealsa$',
                                             'r[0-9]housewka$', 'r[0-9]hibpe$', 'r[0-9]diabe$', 'r[0-9]cancre$', 'r[0-9]lunge$', 'r[0-9]hearte$', 'r[0-9]stroke$',
                                             'r[0-9]bmi$', 'r[0-9]smokev$', 'r[0-9]smoken$', 'r[0-9]smokef$', 'r[0-9]drink$', 'r[0-9]vgactx_e$', 'r[0-9]mdactx_e$', 'r[0-9]ltactx_e$',
                                             'r[0-9]drinkd_e$')))

impVars2 <- impVars2 %>% select(-matches('s[0-9]idauniq'))

colnames(impVars2)
ncol(impVars2)

# Assign impossible bmi values as missing (values with BMI < 10. Only happens in wave 8, 4 cases)
impVars2$r8bmi[impVars2$r8bmi < 10] <- NA

# Run the imputation
# Tolerance had to be set to low as I kept getting the error:
# Error in solve.default(xtx + diag(pen)) : system is computationally singular: reciprocal condition number = 4.00027e-17 (number changes when different vars are included)
# Removed a number of variables also to try and get around this error, as it is saying that 1 or more of the variables are linearly dependant (or so small they are treated as zero - unlikely)
impData2 <-mice(impVars2, m = 5, maxit=5, seed=500, tol=1e-25)

saveRDS(impData2, file = "/home/luke/Documents/E_FEM_clean/E_FEM/input_data/ELSA_imputed_R.mids")


data  <- read.table("./products.dat", header=T, sep="|")
counts <- data$Quantity
png(filename="./products.png", height=500, width=500, bg="white")
# http://stackoverflow.com/questions/7201341/how-can-2-strings-be-concatenated-in-r
desc = paste("Verteilung der", sum(counts), "Produkte auf die Veganitäten", sep = " ")
barplot(counts, main=desc, ylim=c(0, round_up(max(counts))), names.arg=(data$Veganity),
#		col=c("#468847", "#c05b59", "#c09853", "#3a87ad"))
		col=c("#3a87ad", "#c09853", "#c05b59", "#468847"))
title(xlab="Veganität")
title(ylab="Anzahl Produkte")


##
##  Java Information Dynamics Toolkit (JIDT)
##  Copyright (C) 2012, Joseph T. Lizier
##
##  This program is free software: you can redistribute it and/or modify
##  it under the terms of the GNU General Public License as published by
##  the Free Software Foundation, either version 3 of the License, or
##  (at your option) any later version.
##
##  This program is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##  GNU General Public License for more details.
##
##  You should have received a copy of the GNU General Public License
##  along with this program.  If not, see <http://www.gnu.org/licenses/>.
##

# = Example 3 - Transfer entropy on continuous data using kernel estimators =

# Simple transfer entropy (TE) calculation on continuous-valued data using the (box) kernel-estimator TE calculator.

# Load the rJava library and start the JVM
library("rJava")
.jinit()

# Change location of jar to match yours:
#  IMPORTANT -- If using the default below, make sure you have set the working directory
#   in R (e.g. with setwd()) to the location of this file (i.e. demos/r) !!
.jaddClassPath("../../infodynamics.jar")

# Generate some random normalised data.
numObservations<-1000
covariance<-0.4
sourceArray<-rnorm(numObservations)
destArray = c(0, covariance*sourceArray[1:numObservations-1] + (1-covariance)*rnorm(numObservations-1, 0, 1))
sourceArray2<-rnorm(numObservations) # Uncorrelated source

# Create a TE calculator and run it:
teCalc<-.jnew("infodynamics/measures/continuous/kernel/TransferEntropyCalculatorKernel")
.jcall(teCalc,"V","setProperty", "NORMALISE", "true") # Normalise the individual variables
.jcall(teCalc,"V","initialise", 1L, 0.5) # Use history length 1 (Schreiber k=1), kernel width of 0.5 normalised units
.jcall(teCalc,"V","setObservations", sourceArray, destArray)
# For copied source, should give something close to expected value for correlated Gaussians:
result <- .jcall(teCalc,"D","computeAverageLocalOfObservations")
cat("TE result ",  result, "bits; expected to be close to ", log(1/(1-covariance^2))/log(2), " bits for these correlated Gaussians but biased upwards\n")

.jcall(teCalc,"V","initialise") # Initialise leaving the parameters the same
.jcall(teCalc,"V","setObservations", sourceArray2, destArray)
# For random source, it should give something close to 0 bits
result2 <- .jcall(teCalc,"D","computeAverageLocalOfObservations")
cat("TE result ",  result2, "bits; expected to be close to 0 bits for uncorrelated Gaussians but will be biased upwards\n")

# We can get insight into the bias by examining the null distribution:
nullDist <- .jcall(teCalc,"Linfodynamics/utils/EmpiricalMeasurementDistribution;",
		"computeSignificance", 100L)
cat("Null distribution for unrelated source and destination",
    "(i.e. the bias) has mean", .jcall(nullDist, "D", "getMeanOfDistribution"),
    "bits and standard deviation", .jcall(nullDist, "D", "getStdOfDistribution"), "\n")


\name{convert_x}
\alias{convert_x}
\title{
Convert unit on x direction in data coordinate
}
\description{
Convert unit on x direction in data coordinate
}
\usage{
convert_x(x, unit = c("mm", "cm", "inches"),
    sector.index = get.cell.meta.data("sector.index"),
    track.index = get.cell.meta.data("track.index"),
    h = get.cell.meta.data("ycenter", sector.index = sector.index,
    track.index = track.index))
}
\arguments{

  \item{x}{a numeric vector}
  \item{unit}{supported units, only "mm", "cm", "inches"}
  \item{sector.index}{index for the sector where the conversion is applied}
  \item{track.index}{index for the track where the conversion is applied}
  \item{h}{since the width of the cell is not identical from the top to the bottom in the cell, the position on y direction needs to be specified. By default it is at the middle point on y-axis}

}
\value{
A vector of numeric values which are measured in the specified data coordinate
}
\seealso{
\code{\link{convert_y}} converts on y direction.
}
\author{
Zuguang Gu <z.gu@dkfz.de>
}
\examples{
fa = letters[1:10]
circos.par(cell.padding = c(0, 0, 0, 0), track.margin = c(0, 0))
circos.initialize(fa, xlim = cbind(rep(0, 10), runif(10, 0.5, 1.5)))
circos.track(ylim = c(0, 1), track.height = convert_height(5, "mm"),
    panel.fun = function(x, y) {
        circos.lines(c(0, 0 + convert_x(5, "mm")), c(0.5, 0.5), col = "blue")
    })
circos.par(track.margin = c(0, convert_height(2, "mm")))
circos.track(ylim = c(0, 1), track.height = convert_height(1, "cm"),
    panel.fun = function(x, y) {
        xcenter = get.cell.meta.data("xcenter")
        circos.lines(c(xcenter, xcenter), c(0, convert_y(1, "cm")), col = "red")
    })
circos.par(track.margin = c(0, convert_height(5, "mm")))
circos.track(ylim = c(0, 1), track.height = convert_height(1, "inches"),
    panel.fun = function(x, y) {
        line_length_on_x = convert_x(1*sqrt(2)/2, "cm")
        line_length_on_y = convert_y(1*sqrt(2)/2, "cm")
        circos.lines(c(0, line_length_on_x), c(0, line_length_on_y), col = "orange")
    })
circos.clear()
}


library(dplyr)

windowed.bar.chart <- function(df, filter.col, filter.val, size.left, size.right) {
  idx <- which(df[, filter.col] == filter.val)
  # range will be 4 above and below
  idx.a <- idx - size.left
  idx.b <- idx + size.right
  # but if we go out of range on one side, we want more on the other so we keep the same total
  num.rows <- nrow(df)
  if (idx.a < 1) {
    idx.b <- idx.b + (1 - idx.a)
    idx.a <- 1
  } else if (idx.b > num.rows) {
    idx.a <- idx.a - (idx.b - num.rows)
    idx.b <- num.rows
  }
  df <- df[idx.a:idx.b, ]
  df <- df %>% mutate(damage.style = "blue")
  df[idx - idx.a + 1, "damage.style"] <- "gold"
  return(df)
}

length.check <- function(slat, slon, elat, elon, len) {
  d <- distm(as.matrix(cbind(slon, slat)), as.matrix(cbind(elon, elat)), fun = distHaversine) / 1000 * 0.621
  d <- diag(d)
  dd <- abs(d - len)
  return( (dd / len) < 0.2 )
}