# script for ploting pretty heatmaps for contrast RNAseq data
# jmmunozp@usp.br
#install.packages("tidyverse")
#install.packages("BiocManager")
install.packages("pheatmap",
lib = "./libraries",
repos = 'http://cran.us.r-project.org')
#BiocManager::install("DESeq2")

# variables
wd = "/Storage/data1/jorge.munoz/NRGSC"
mdata = "./metadata_complete.csv"
vst_path = "./DEA/vst.Rdata"

# libraries
library(tidyverse, lib.loc = "./libraries")
library(DESeq2, lib.loc = "./libraries")
library(pheatmap, lib.loc = "./libraries")

# set working directory
setwd(wd)

sample_table <-read.table(mdata, sep = ",", header = T)
sample_table$Condition <- as.factor((sample_table$Condition))
sample_table$Genotype <- as.factor((sample_table$Genotype))
sample_table$DevStage <- as.factor((sample_table$DevStage))
sample_table$Individual <- as.factor((sample_table$Individual))
sample_table$Group <- as.factor(paste(sample_table$Genotype, '_', sample_table$Condition, '_', sample_table$DevStage, sep=''))

# read vst file
load(vst_path)
# function to graph heatmaps from contrast data

contrast_heatmaps <- function (vst, contrast_samples_index, title, contrast_table) {

dea_contrast <- read.table(contrast_table, header = T, sep = ",")

df <- as.data.frame(t(assay(vst)))
# NR_270_B (Sample_34, Sample_30, Sample_26)
# NR_10_B (Sample_46, Sample_42, Sample_38)
contrast <- df[contrast_samples_index,]

annotation_col <- sample_table[contrast_samples_index,]
anot <- select(annotation_col, "Group","DevStage","Genotype", "Condition")
dat <- as.data.frame(t(contrast[dea_contrast$names]))
rownames(anot) <- colnames(dat)
#heat map complete with all genes
png(paste("./DEA/hm_", title, ".png", sep = ""),  width = 15*1.3, height = 15, res = 320, units = "cm")
pheatmap(dat, main = title, annotation_col = anot, show_rownames = F , cellwidth = 20)
dev.off()

# upregulated genes
upregulated <- dea_contrast[tail(order(dea_contrast$log2FoldChange),20),]
dat <- as.data.frame(t(contrast[upregulated$names]))
png(paste("./DEA/upregulated_", title, ".png", sep = ""),  width = 15*1.3, height = 15, res = 320, units = "cm")
pheatmap(dat, main =  paste( title," upregulated", sep = ""), annotation_col = anot, show_rownames = T, fontsize_row = 8, cellwidth = 20,)
dev.off()

# downregulated genes
downregulated <- dea_contrast[head(order(dea_contrast$log2FoldChange),20),]
dat <- as.data.frame(t(contrast[downregulated$names]))
png(paste("./DEA/downregulated_", title, ".png", sep = ""),  width = 15*1.3, height = 15, res = 320, units = "cm")
pheatmap(dat, main = paste( title," downregulated", sep = ""), annotation_col = anot, show_rownames = T, fontsize_row = 8, cellwidth = 20)
dev.off()
}

# call function with different contrast
# NR_270_B vs NR_10_B
contrast_heatmaps(vst,c(26,30,34,38,42,46), "NR_270_B vs NR_10_B", "./DEA/filter3_NR_270_B_vs_NR_10_B.csv")
# NR_270_B0_vs_NR_10_B0
contrast_heatmaps(vst,c(25,29,33,37,41,45), "NR_270_B0 vs NR_10_B0", "./DEA/filter3_NR_270_B0_vs_NR_10_B0.csv")
# NR_270_M_vs_NR_10_M
contrast_heatmaps(vst,c(27,31,35,39,43,47), "NR_270_M vs NR_10_M", "./DEA/filter3_NR_270_M_vs_NR_10_M.csv")
# NR_270_P_vs_NR_10_P
contrast_heatmaps(vst,c(28,32,36,40,44,48), "NR_270_P vs NR_10_P", "./DEA/filter3_NR_270_P_vs_NR_10_P.csv")
# R_270_B0_vs_R_10_B0
contrast_heatmaps(vst,c(1,5,9,13,17,21), "R_270_B0 vs R_10_B0", "./DEA/filter3_R_270_B0_vs_R_10_B0.csv")
# R_270_B_vs_R_10_B
contrast_heatmaps(vst,c(2,6,10,14,18,22), "R_270_B vs R_10_B", "./DEA/filter3_R_270_B_vs_R_10_B.csv")
# R_270_M_vs_R_10_M
contrast_heatmaps(vst,c(3,7,11,15,19,23), "R_270_M vs R_10_M", "./DEA/filter3_R_270_M_vs_R_10_M.csv")
# R_270_P_vs_R_10_P
contrast_heatmaps(vst,c(4,8,12,16,20,24), "R_270_P vs R_10_P", "./DEA/filter3_R_270_P_vs_R_10_P.csv")


#clearing the workspace
rm(list=ls())
graphics.off()
options(show.error.locations = TRUE)

# If we cannot load the ubiquity package we try the stand alone distribution
if("ubiquity" %in% rownames(installed.packages())){require(ubiquity)} else
{source(file.path("library", "r_general", "ubiquity.R")) }

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

# flowctl       = "plot previous estimate"
# flowctl       = "previous estimate as guess"
# flowctl       = "estimate"
  flowctl       = "plot guess"
analysis_name   = "ANAME"
archive_results = TRUE

# For documentation explaining how to modify the commands below see
# the estimation vignette:
# vignette(package="ubiquity", topic="Estimation")
# Or the estimation tutorial at the bottom of this page:
# http://r.ubiquity.tools/

# -------------------------------------------------------------------------
# Rebuilding the system (R scripts and compiling C code)
cfg = build_system(system_file="<SYSTEM_FILE>",
                   output_directory     = file.path(".", "output"),
                   temporary_directory  = file.path(".", "transient"))

# Initializing the log file ./transient/ubiquity.log
cfg = system_log_init(cfg)
# -------------------------------------------------------------------------

<PSETS>

# # This will estiamte all parameters:
# cfg = system_select_set(cfg, "default")

# # To fix parameters, simply specify only those you want to estimate here:
# pnames = c("PNAME1", "PNAME2")
# cfg = system_select_set(cfg, "default", pnames)

# Change initial guess for parameter PNAME to VALUE. The lower bound (lb) and
# upper bound (ub) can also be changed as well
#
# cfg = system_set_guess(cfg, pname="PNAME", value=VALUE, lb=NULL, ub=NULL)

# -------------------------------------------------------------------------
# Setting options
#
# Specify output times here using sparse sampling (large time steps) to make
# the estimation quick. See down below where you can specify the sampling to
# generate smooth profiles when plotting. This will be the
# default output times unless overwritten at the cohort level:
# cfg=system_set_option(cfg, group  = "simulation",
#                            option = "output_times",
#                            seq(0,100,1))
#
# cfg=system_set_option(cfg,group = "simulation", option = "solver", value = "lsoda")
#
# To overwrite solver options use the following:
# cfg=system_set_option(cfg,group  = "solver",
#                           option = "atol",
#                           value  = 1e-10)
#
# cfg=system_set_option(cfg,group  = "solver",
#                           option = "rtol",
#                           value  = 1e-10)
#
# Uncomment to specify ode file to use. r-file or c-file
# cfg=system_set_option(cfg, group  = "simulation",
#                            option = "integrate_with",
#                            value  = "r-file")
#
# Optimizer options
#
# See the documentation for optim (?optim) for valid values for method and
# elements for the control. You can change the optimizer to optimx and then
# you would just need to adjust the method and control options accordingly.
# The commented code below represents the default values that are used. To
# perform a simulated annealing change the "method" to SANN.
#
# cfg = system_set_option(cfg, group  = "estimation",
#                              option = "optimizer",
#                              value  = "optim")
#
# cfg = system_set_option(cfg, group  = "estimation",
#                              option = "method",
#                              value  = "Nelder-Mead")
#
# cfg = system_set_option(cfg, group  = "estimation",
#                              option = "control",
#                              value  = list(trace  = TRUE,
#                                            maxit  = 500,
#                                            REPORT = 10))
#
# To use the global optimization routines, uncomment the appropriate lines
# below. IMPORTANT: Because of how the parameter space is sampled it is
# important to set the parameter bounds to reasonable values>
#
# To use particle swarm optimization use the following:
#
# cfg = system_set_option(cfg, group  = "estimation",
#                              option = "optimizer",
#                              value  = "pso")
#
# cfg = system_set_option(cfg, group  = "estimation",
#                              option = "method",
#                              value  = "psoptim")
#
# The following will use the genetic algorithm:
#
# cfg = system_set_option(cfg, group  = "estimation",
#                              option = "optimizer",
#                              value  = "ga")
#
# cfg = system_set_option(cfg, group  = "estimation",
#                              option = "method",
#                              value  = "ga")
#
# cfg = system_set_option(cfg, group  = "estimation",
#                              option = "control",
#                              value  = list(maxiter   = 10000,
#                                            optimArgs = list(method  = "Nelder-Mead",
#                                                             maxiter = 1000)))

# -------------------------------------------------------------------------
# Loading Datasets
#
# From Excel sheet
# cfg = system_load_data(cfg, dsname     = "DSNAME",
#                             data_file  = "DS.xls",
#                             data_sheet = "SHEET")
#
# From csv
# cfg = system_load_data(cfg, dsname     = "DSNAME",
#                             data_file  = "DS.csv")
#
# From tab
# cfg = system_load_data(cfg, dsname     = "DSNAME",
#                             data_file  = "DS.tab")
#

# -------------------------------------------------------------------------
# Defining the cohorts
#
# Clearing all of the cohorts
cfg = system_clear_cohorts(cfg)

# One entry for each cohort:
# For more information type:
#
# help system_define_cohort
#
# It is necessary to replace the following components:
#
# CHNAME    - cohort name
# COLNAME   - column name in dataset
# ONAME     - output name, you can use a more descriptive name for your output
# TIMECOL   - column name in dataset with the observation times
# TS        - model timescale corresponding to TIMECOL
# OBSCOL    - column name in dataset with the observation values
# MODOUTPUT - model output corresponding to OBSCOL
#
# Only specify bolus and infusion inputs that are non-zero. Simply ignore
# those that don't exist for the given cohort. Covariates should be specified
#
# The cf elements are optional and will be used to filter the dataset down to
# the records needed for this cohort. If you do not need the placeholders
# simply delete the lines
#
cohort = list(
  name         = "CHNAME",
  cf           = list(COLNAME   = c(),
                      COLNAME   = c()),
  inputs       = NULL,
  outputs      = NULL,
  dataset      = "DSNAME")

<BOLUS><INFUSION_RATES><COVARIATES>

# Here you define information about the outputs you're modeling for this
# cohort. The output "ONAME" used in the list below is a placeholder. You can
# substitute it with a more descriptive string string suchas:
#       PK, Cp_ngml, TV_mm3, etc.
# No spaces or weird characters.
cohort[["outputs"]][["ONAME"]] = list()
# "of" is the output filter used to further filter the records down to those
# that apply to the current output ONAME. If you do not need them you can just
# delete this part:
cohort[["outputs"]][["ONAME"]][["of"]] = list(
       COLNAME          = c(),
       COLNAME          = c())

# This identifies the columns in the data set that relate to the observation
# times, values and the numerical flag for missing data:
cohort[["outputs"]][["ONAME"]][["obs"]] = list(
         time           = "TIMECOL",
         value          = "OBSCOL",
         missing        = -1)

# Here you are mapping model timescales and outputs to the observations. The
# variance model is also specified here.
#         variance = '1'               # Least squares
#         variance = 'PRED^2'          # Weighted least squares proportional
#                                      # to the prediction squared
#         variance = '(SLOPE*PRED)^2'  # Maximum likelihood estimation where
#                                      # SLOPE is defined as a variance parameter <VP>
#
cohort[["outputs"]][["ONAME"]][["model"]] = list(
         time           = "TS",
         value          = "MODOUTPUT",
         variance       = "PRED^2")

# This controls the plotted output associated with this cohort
# the color, shape and line values are the values used by ggplot
# functions.
cohort[["outputs"]][["ONAME"]][["options"]] = list(
         marker_color   = "black",
         marker_shape   = 16,
         marker_line    = 1 )
cfg = system_define_cohort(cfg, cohort)
# -------------------------------------------------------------------------

# -------------------------------------------------------------------------
# Defining the cohorts with dosing from a NONMEM file
#
#  DS - name of dataset defined using system_load_dataset
#
# Include all records in the dataset
#  filter = NULL
#
# Include only records matching the following filter
#  filter = list()
#  filter$COLNAME = c()
#
# Mapping information:
#
# Inputs:
#  INPUTMAP = list()
#  INPUTMAP$bolus$SPECIES$CMT_NUM            =  1
#  INPUTMAP$infusion_rates$RATE$CMT_NUM      =  1
#  INPUTMAP$covariates$CVNAME$col_COV        = "CNAME"
#
# Outputs
#  OBSMAP = list()
#  OBSMAP$ONAME=list(variance     = "PRED^2",
#                    CMT          =  1,
#                    output       = "<O>",
#                    missing      =  NULL )
#
#  cfg = system_define_cohorts_nm(cfg        =  cfg,
#                                  filter    =  filter,
#                                  INPUTS    =  INPUTMAP,
#                                  OBS       =  OBSMAP,
#                                  col_GROUP =  NULL,
#                                  group     =  FALSE)
#
# To overwrite column name mapping the following can be used
#  col_ID    - unique subject identifier
#  col_CMT   - compartment
#  col_DV    - observations
#  col_TIME  - system time
#  col_AMT   - infusion/dose amounts
#               - these need to be in the same units specified in the system.txt file
#  col_RATE  - rate of infusion or . for bolus
#  col_EVID  - evid (0 - observation, 1 dose)
#  col_GROUP - used to group subjects for plotting purposes. For example if
#              the cohorts were grouped by dose and the column DOSE contained
#              this information, then this will be set to "DOSE".
#
#  cfg = system_define_cohorts_nm( cfg       = cfg,
#                                  DS        = "DSNAME",
#                                  col_ID    = "ID",
#                                  col_CMT   = "CMT",
#                                  col_DV    = "DV",
#                                  col_TIME  = "TIME",
#                                  col_AMT   = "AMT",
#                                  col_RATE  = "RATE",
#                                  col_EVID  = "EVID",
#                                  col_GROUP =  NULL,
#                                  filter    =  filter,
#                                  INPUTS    =  INPUTMAP,
#                                  OBS       =  OBSMAP,
#                                  group     =  FALSE)
#
# -------------------------------------------------------------------------
# performing estimation or loading guess/previous results
pest = system_estimate_parameters(cfg,
                                  flowctl         = flowctl,
                                  analysis_name   = analysis_name,
                                  archive_results = archive_results)

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

# Here you can specify the output times used for the simulations that will
# be used for plotting. Here you want frequent sampling (small time steps)
# so that you have smoother profiles.
# cfg=system_set_option(cfg, group  = "simulation",
#                            option = "output_times",
#                            seq(0,100,1))

# Any cohorts added here will be plotted by will not have been used to
# estimate parameters. This allows you to see how the current estimates
# predict data (validation)

# Simulating the system at the estimates
erp = system_simulate_estimation_results(pest = pest, cfg = cfg)
# -------------------------------------------------------------------------

plot_opts = c()
# To customize the figures
# Replace ONAME with the specific outputs defined in the cohorts above. Then
# change the values
# plot_opts$outputs$ONAME$yscale   = "linear" # "linear" or "log"
# plot_opts$outputs$ONAME$ylim     = c(0,1)   # NULL
# plot_opts$outputs$ONAME$xlim     = c(0,1)   # NULL
# plot_opts$outputs$ONAME$ylabel   = ""       # output ONAME
# plot_opts$outputs$ONAME$xlabel   = ""       # cohort time units
# plot_opts$tc$width               = 10       # width  of timecourse plot
# plot_opts$tc$height              = 5.5      # height of timecourse plot
# plot_opts$op$width               = 10       # width  of observed vs predicted
# plot_opts$op$height              = 8.0      # height of observed vs predicted

# Plotting the simulated results at the estimates
# These figures will be placed in output/
system_plot_cohorts(erp, plot_opts, cfg, analysis_name=analysis_name)

#-------------------------------------------------------
# Writing the results to a PowerPoint report
# cfg = system_rpt_read_template(cfg, template="PowerPoint")
# cfg = system_rpt_estimation(cfg=cfg, analysis_name=analysis_name)
# system_rpt_save_report(cfg=cfg, output_file=file.path("output",paste(analysis_name, "-report.pptx", sep="")))
#-------------------------------------------------------
# Writing the results to a Word report
# cfg = system_rpt_read_template(cfg, template="Word")
# cfg = system_rpt_estimation(cfg=cfg, analysis_name=analysis_name)
# system_rpt_save_report(cfg=cfg, output_file=file.path("output",paste(analysis_name, "-report.docx", sep="")))
#-------------------------------------------------------


alldat <- fndfGetGiantDataRaw("")

newdat <- alldat %>%
group_by(copies, lifem, auditfrequency, audittype, auditsegments) %>%
summarize(losspct=round(midmean(lost/docstotal)*100.0, 2), n=n())


#finds singificant values of autocorrealtion
rm(list=ls())

x<-read.table("C:\\Users\\msc2\\Desktop\\zara_t_val.txt")     #reading t-value file
pract<-list()       #declaring hash

#making hash for t-value
for( rahman in seq_along(x$V1)){
pract[rahman]=x[rahman,1]
}

kate<-read.table("C:\\Users\\msc2\\Desktop\\rajaRampool\\1A8V_B_2_phi_psi_pot_r_k.pdb",skip=1)
#kate<-read.table(file.choose(),skip=1)
badme<-kate[,2]
d_f<-length(badme)-2     #degree of freedom

for( medicine in seq_along(badme) ){
if(d_f<=75){
if(badme[medicine]>= pract[d_f] && badme[medicine]<= pract[d_f]  )print(paste(badme[medicine],medicine ) ) }
else{  if(badme[medicine]>= 1.645 )print(paste(badme[medicine],medicine ) ) }  }

   #for ends


library(vioplot)
library(devtools)
library(digest)

#Generating usage frequency

title_eng_vocab <- read.csv("Data/C1_Title_Data/Usages/eng.dict", header = FALSE, sep='\t')
title_code_vocab <- read.csv("Data/C1_Title_Data/Usages/code.dict", header = FALSE, sep='\t')

freq_title_eng_vocab <- subset(title_eng_vocab, title_eng_vocab$V3 > 1) #Ignoring tokens used only once
freq_title_code_vocab <- subset(title_code_vocab, title_code_vocab$V3 > 1)

length(freq_title_eng_vocab$V3)
length(freq_title_code_vocab$V3)

summary(freq_title_eng_vocab$V3)
summary(freq_title_code_vocab$V3)

title_alignment <- read.csv("Data/C1_Title_Data/Alignment/eng2code_alignment_entropy.csv", header = FALSE, sep='\t')

summary(title_alignment$V1)

rake_eng_vocab <- read.csv("Data/C2_StandardNLP/Usages/eng.dict", header = FALSE, sep='\t')
rake_code_vocab <- read.csv("Data/C2_StandardNLP/Usages/code.dict", header = FALSE, sep='\t')

freq_rake_eng_vocab <- subset(rake_eng_vocab, rake_eng_vocab$V3 > 1)
freq_rake_code_vocab <- subset(rake_code_vocab, rake_code_vocab$V3 > 1)

length(freq_rake_eng_vocab$V3)
length(freq_rake_code_vocab$V3)

summary(freq_rake_eng_vocab$V3)
summary(freq_rake_code_vocab$V3)

rake_alignment <- read.csv("Data/C2_StandardNLP/Alignment/eng2code_alignment_entropy.csv", header = FALSE, sep='\t')

summary(rake_alignment$V1)

raw_eng_vocab <- read.csv("Data/C0_Raw/Usages/eng.dict", header = FALSE, sep='\t')
raw_code_vocab <- read.csv("Data/C0_Raw/Usages/code.dict", header = FALSE, sep='\t')

freq_raw_eng_vocab <- subset(raw_eng_vocab, raw_eng_vocab$V3 > 1)
freq_raw_code_vocab <- subset(raw_code_vocab, raw_code_vocab$V3 > 1)

length(freq_raw_eng_vocab$V3)
length(freq_raw_code_vocab$V3)

summary(freq_raw_eng_vocab$V3)
summary(freq_raw_code_vocab$V3)

raw_alignment <- read.csv("Data/C0_Raw/Alignment/eng2code_alignment_entropy.csv", header = FALSE, sep='\t')

summary(raw_alignment$V1)

task_eng_vocab <- read.csv("Data/C3_SETask/Usages/eng.dict", header = F, sep='\t')
task_code_vocab <- read.csv("Data/C3_SETask/Usages/code.dict", header = F, sep='\t')

freq_task_eng_vocab <- subset(task_eng_vocab, task_eng_vocab$count > 1)
freq_task_code_vocab <- subset(task_code_vocab, task_code_vocab$count > 1)

length(freq_task_eng_vocab$V3)
length(freq_task_code_vocab$V3)

summary(freq_task_eng_vocab$V3)
summary(freq_task_code_vocab$V3)

task_alignment <- read.csv("Data/C3_SETask/Alignment/eng2code_alignment_entropy.csv", header = FALSE, sep='\t')
summary(task_alignment)

summary(task_alignment$V1)

#Generating violinplot

source_url("https://gist.githubusercontent.com/mbjoseph/5852613/raw/1f4c940b703b0e2d2b480abaed25a896a10ef92d/vioplot2")

png(filename="per-word_alignment.png")
par(cex.lab=1.2,cex.axis=1.05)

plot(x=NULL, y=NULL,
     xlim = c(0.6, 4.4),
     ylim = c(0,max(raw_alignment$V1)),
     type="n", ann=FALSE, axes=F)
axis(1, at=c(1,2,3,4),  labels=c("Raw Corpus", "Title Corpus", "Standard NLP", "SE Task Copus"))
axis(2)

vioplot2(raw_alignment$V1,at = 1, col = 'white', add = T)

vioplot2(title_alignment$V1, at = 2, col = 'white' , add = T)

vioplot2(rake_alignment$V1, at = 3, col = 'white' , add = T)

vioplot2(task_alignment$V1, at = 4, col = 'white' , add = T)

title("", xlab="", ylab = "Per-word alignment entropy")

dev.off()


dataset(iris)
summary(iris)
plot(iris)


d = read.csv("mannenkatu2.csv", header=F)

plot(d)
lines(d)

#plot(d$V5, d$V6, asp=1)
#lines(d$V5, d$V6)

#points(1.0522000094796893,1.2955447271518423, pch="X")
#points(1.032556,1.26164, pch="*")
#points(1.211155,1.260732, pch="*")

#points(1.1773423201278104,0.45720242916684545, pch="+")

#points(1.188869, 0.110574, pch="%")
#points(1.182998, 0.705065, pch="%")

#points(read.csv("output.csv", header=F), pch="x")

q = read.csv("stream.csv", header=F)

points(tail(q, 30), pch="*")


##--------------------------
## LOAD PACKAGES & FUNCTIONS
##--------------------------
library(cowplot)
library(dplyr)
library(genefilter)
library(ggalt)
library(ggplot2)
library(ggpubr)
library(ggrepel)
library(jcolors)
library(RColorBrewer)
library(viridis)
library(wesanderson)

##--------------
## LOAD DATASETS
##--------------
Info_Archip_Threat <- read.csv("outputs/Info_Archip_Threat.txt", sep="")

data <- Info_Archip_Threat[,c(1:3, 5:7)]
colnames(data) <- c("ArchipThreat", "Archip", "Threat", "TD", "PD", "FD")
data$TD <- data$TD/max(data$TD)
data$PD <- data$PD/max(data$PD)
data$FD <- data$FD/max(data$FD, na.rm = TRUE)

#RANK DES ARCHIPELS
SAR_TD_Archip <- read.csv("outputs/DAR_TD_Archip.txt", sep="")
SAR_PD_Archip <- read.csv("outputs/DAR_PD_Archip.txt", sep="")
SAR_FD_Archip <- read.csv("outputs/DAR_FD_Archip.txt", sep="")

TD_Rank <- SAR_TD_Archip[,c(1,6)]
PD_Rank <- SAR_PD_Archip[,c(1,6)]
FD_Rank <- SAR_FD_Archip[,c(1,6)]

Hotspot_Rank_Sum <- TD_Rank
Hotspot_Rank_Sum <- left_join(Hotspot_Rank_Sum, PD_Rank, by = "Archip")
Hotspot_Rank_Sum <- left_join(Hotspot_Rank_Sum, FD_Rank, by = "Archip")
colnames(Hotspot_Rank_Sum) <- c("Archip", "TD_Rank", "PD_Rank", "FD_Rank")
Hotspot_Rank_Sum$Tot_rank <- rowSums(Hotspot_Rank_Sum[,2:4], na.rm = TRUE)
Hotspot_Rank_Sum <- Hotspot_Rank_Sum[order(Hotspot_Rank_Sum$Tot_rank, decreasing=F), ]
Hotspot_Rank_Sum$Rank_final <- c(1:6, 8, 7, 9:19)
rm(SAR_TD_Archip, SAR_PD_Archip, SAR_FD_Archip, TD_Rank, PD_Rank, FD_Rank)
data <- left_join(data, Hotspot_Rank_Sum[,c(1,6)], by = "Archip")
rm(Hotspot_Rank_Sum)

levels(data$Threat)
data$Threat <- factor(data$Threat, levels = c("Wildlife exploitation",
                                              "Cultivation", "Energy production & mining", "Habitat modifications", "Urbanization",
                                              "Climate change", "Geological events", "Human intrusions & disturbance", "Biological invasions", "Pollution", "Transport corridors"))

TD <- ggplot(data, aes(x = Threat, y = reorder(Archip, -Rank_final))) + geom_tile(aes(fill = TD), colour = "white") +
        scale_fill_gradientn(colours = wes_palette("Zissou1", 1000, type = "continuous")) +
        theme_bw() + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank()) +
        scale_x_discrete(drop = FALSE) + scale_y_discrete(drop = FALSE) +
        theme(axis.title.x = element_blank(), axis.text.x = element_blank()) +
        theme(axis.title.y = element_blank(), axis.text.y  = element_text(colour="black", size=10)) +
        theme(legend.position="none")

PD <- ggplot(data, aes(x = Threat, y = reorder(Archip, -Rank_final))) + geom_tile(aes(fill = PD), colour = "white") +
        scale_fill_gradientn(colours = wes_palette("Zissou1", 1000, type = "continuous")) +
        theme_bw() + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank()) +
        scale_x_discrete(drop = FALSE) + scale_y_discrete(drop = FALSE) +
        theme(axis.title.x = element_blank(), axis.text.x = element_blank()) +
        theme(axis.title.y = element_blank(), axis.text.y  = element_text(colour="black", size=10)) +
        theme(legend.position="none")

FD <- ggplot(data, aes(x = Threat, y = reorder(Archip, -Rank_final))) + geom_tile(aes(fill = FD), colour = "white") +
        scale_fill_gradientn(colours = wes_palette("Zissou1", 1000, type = "continuous")) +
        theme_bw() + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank()) +
        scale_x_discrete(drop = FALSE) + scale_y_discrete(drop = FALSE) +
        theme(axis.title.x = element_blank(), axis.text.x = element_text(colour="black", size=10)) +
        theme(axis.title.y = element_blank(), axis.text.y  = element_text(colour="black", size=10)) +
        theme(legend.position="none")

ggdraw() +
  draw_plot(TD, 0, 0.66, 1, 0.33) +
  draw_plot(PD, 0, 0.33, 1, 0.33) +
  draw_plot(FD, 0, 0, 1, 0.33) +
  draw_plot_label(c("A", "B", "C"), c(0, 0, 0), c(1, 0.66, 0.33), size = 15)


library(dplyr, warn.conflicts = FALSE)
library(tidyr)
library(utils)
library(rlang)
library(stats)
library(lubridate)

# Annotator functions for MPOG ASPIRE measurements

############
# Run Once #
############

# Setup cache is run once per measure-comparator
#  The top level env will include comparator_id and measure_id
setup_cache <- function(data, spek){
  cache <- list()

  # Id column will always be id
  cache$id_colname      <- 'id'
  cache$id_col_sym      <- rlang::sym(cache$id_colname)

  # Hardcode column names.  Extract from spek in subsequent versions.
  cache$denom_colname   <- 'Denominator'
  cache$numer_colname   <- 'Passed_Count'
  cache$time_colname    <- 'Month'
  cache$measure_colname <- 'Measure_Name'

  # Make a symbol of the numerator and denominator columns
  cache$denom_col_sym   <- rlang::sym(cache$denom_colname)
  cache$numer_col_sym   <- rlang::sym(cache$numer_colname)
  cache$time_col_sym    <- rlang::sym(cache$time_colname)
  cache$measure_col_sym <- rlang::sym(cache$measure_colname)

  # Calculate peer average by measure
  #cache$peer_mean <- calc_peer_measure_means(data, cache)
  cache$measure_id <- measure_id
  cache$comparator_id <- comparator_id
  cache$comparator <- calc_comparator_value(data, spek, measure_id, comparator_id)

  return(cache)
}

calc_comparator_value <- function(data, spek, m_id, c_id){
  if(is.null(c_id)){
    return(NA)
  }else{
    comparator <- spekex::lookup_comparator(c_id, spek)
  }

  val <- spekex::comparison_value_of_comparator(comparator)
  # Assume comparators without values are social comparator.
  # TODO: Lookup compartor type
  if(is.null(val)){
    # TODO: Do symbol lookup and substitution via quasiquotation
    measure <- spekex::lookup_measure(m_id, spek)
    m_name <- spekex::identifier_of_measure(measure)
    val <- data %>%
      dplyr::filter(Measure_Name == m_name) %>%
      summarize(value=mean(Passed_Count / Denominator)) %>%
      pull(value)
  }

  return(val)
}

####################
# Helper Functions #
####################

# Only pass in time points to be evaluated, as this will check for trend across all points given
eval_positive_trend <- function(x){
  len <- length(x)
  if(len < 2){ return(FALSE) }
  is_tail_ascending <- !is.unsorted(x, strictly=T)
  return(is_tail_ascending)
}

eval_negative_trend <- function(x){
  len <- length(x)
  if(len < 2){ return(FALSE) }
  is_tail_descending <- !is.unsorted(rev(x), strictly=T)
  return(is_tail_descending)
}

# This does not handle a missing most recent time point.  That needs to be accounted for elsewhere.
# Most recent (greatest) timepoint is at or above comparator and all others are below
# All FALSE with single TRUE at end
eval_achievement <- function(x, comp){
  if(length(x) < 2){ return(FALSE)}

  bools <- x >= comp
  return( sum(bools)==1 & dplyr::last(bools) == TRUE)
}

eval_consec_neg_gap <- function(x, comp){
  if(length(x) < 2){ return(FALSE) }
  bools <- x < comp
  return( sum(bools)==2 )
}

eval_consec_pos_gap <- function(x, comp){
  if(length(x) < 2){ return(FALSE) }
  bools <- x > comp
  return( sum(bools)==2 )
}

########################
# Annotation Functions #
########################

annotate_negative_gap <- function(data, spek){
  time <- cache$time_col_sym
  denom <- cache$denom_col_sym
  numer <- cache$numer_col_sym
  id <- cache$id_col_sym

  # DEBUG:Catch bad data
  if(max(data$Month) == -Inf){
    rlang::abort(data)
  }

  data %>%
    dplyr::filter(!!time == max(!!time)) %>%
    mutate(rate = !!numer / !!denom) %>%
    group_by(!!id) %>%
    summarize(negative_gap = rate < cache$comparator)
}

annotate_positive_gap <- function(data, spek){
  time <- cache$time_col_sym
  denom <- cache$denom_col_sym
  numer <- cache$numer_col_sym
  id <- cache$id_col_sym

  data %>%
    dplyr::filter(!!time == max(!!time)) %>%
    mutate(rate = !!numer / !!denom) %>%
    group_by(!!id) %>%
    summarize(positive_gap = (rate > cache$comparator))
}

annotate_negative_trend <- function(data, spek){
  time <- cache$time_col_sym
  denom <- cache$denom_col_sym
  numer <- cache$numer_col_sym
  id <- cache$id_col_sym

  max_month <- max(data[[time]])
  min_month <- max_month %m-% months(1)

  data %>%
    dplyr::filter(!!time >= min_month) %>%
    mutate(rate = !!numer / !!denom) %>%
    group_by(!!id) %>%
    summarize(negative_trend = eval_negative_trend(rate))
}

annotate_positive_trend <- function(data, spek){
  time <- cache$time_col_sym
  denom <- cache$denom_col_sym
  numer <- cache$numer_col_sym
  id <- cache$id_col_sym

  max_month <- as_date(max(data[[time]]))
  min_month <- max_month %m-% months(1)

  data %>%
    dplyr::filter(!!time >= min_month) %>%
    mutate(rate = !!numer / !!denom) %>%
    group_by(!!id) %>%
    summarize(positive_trend = eval_positive_trend(rate))
}

annotate_performance_gap <- function(data, spek){
  time <- cache$time_col_sym
  denom <- cache$denom_col_sym
  numer <- cache$numer_col_sym
  id <- cache$id_col_sym

  data %>%
    dplyr::filter(!!time == max(!!time)) %>%
    mutate(rate = !!numer / !!denom) %>%
    group_by(!!id) %>%
    summarize(performance_gap = (rate != cache$comparator))
}

annotate_achievement <- function(data, spek){
  time <- cache$time_col_sym
  denom <- cache$denom_col_sym
  numer <- cache$numer_col_sym
  id <- cache$id_col_sym

  all_ids_df <- data %>% select(!!id) %>% distinct

  elidgibile_ids <- data %>%
    dplyr::filter(!!time == max(!!time)) %>%
    pull(!!id) %>%
    unique

  data %>%
    dplyr::filter(!!id %in% elidgibile_ids) %>%
    mutate(rate = !!numer / !!denom) %>%
    arrange(!!time) %>%
    group_by(!!id) %>%
    summarize( achievement = eval_achievement(rate,cache$comparator)) %>%
    right_join(all_ids_df)

  id <- cache$id_col_sym
  data %>% group_by(!!id) %>% summarize( achievement = FALSE)
}

annotate_comparators <- function(data, spek){
  # comparator_id provided by running environment into cache
  cache$comparator_id
  comp_type <- spekex::type_of_comparator( spekex::lookup_comparator(cache$comparator_id, spek))

  is_std <- identical(spekex::SE$STANDARD_COMPARATOR_IRI, comp_type)
  is_soc <- identical(spekex::SE$SOCIAL_COMPARATOR_IRI, comp_type)
  is_gol <- identical(spekex::SE$GOAL_COMPARATOR_IRI, comp_type)

  id <- cache$id_col_sym

  # Do three annotations at once.
  data %>% group_by(!!id) %>% summarize(standard_comparator = is_std,
                                        social_comparator = is_soc,
                                        goal_comparator = is_gol)
}

# No-op Annotations
annotate_capability_barrier <- function(data, spek){
  id <- cache$id_col_sym
  data %>% group_by(!!id) %>% summarize( capability_barrier = FALSE)
}

annotate_large_gap <- function(data, spek){
  id <- cache$id_col_sym
  data %>% group_by(!!id) %>% summarize( large_gap = FALSE)
}

annotate_consec_neg_gap <- function(data, spek){
  id <- cache$id_col_sym
  data %>% group_by(!!id) %>% summarize( consec_neg_gap = FALSE)
}

annotate_consec_pos_gap <- function(data, spek){
  id <- cache$id_col_sym
  data %>% group_by(!!id) %>% summarize( consec_pos_gap = FALSE)
}


#!/usr/bin/env Rscript

library ('boot')
library ('digest')
library ('logger')
library ('zeallot')
library ('jsonlite')
library ('parallel')
library ('tidyverse')
library ('assertthat')
library ('changepoint')

options (boot.parallel = 'multicore')
options (boot.ncpus = detectCores ())

DATA_PATH <- '.'
DATA_FILE <- file.path (DATA_PATH, 'data.Rds')
NAME_VM_FILE <- file.path (DATA_PATH, 'name_vm.csv')
NAME_METRICS_FILE <- file.path (DATA_PATH, 'name_metrics.csv')

PLOT_ROWS <- 4
PLOT_WIDTH <- 300
PLOT_HEIGHT <- 300

REPLICATES <- 33333
CONFIDENCE <- 0.99

OUTLIER_LIMIT <- 0.05
OUTLIER_SLACK <- 0.1

# The size of the window is in samples.
OUTLIER_WINDOW <- 333

METRICS <- tribble (~name, ~label, ~unit, ~suffix,
    'time', 'time', 's', 'time',
    'ubench_agent_PAPI_ref_cycles', 'clock cycles', '1', 'cycles',
    'ubench_agent_PAPI_instructions', 'instructions', 'ins', 'instructions',
    'ubench_agent_PAPI_branch_instructions', 'branch instructions', 'ins', 'branch-refs',
    'ubench_agent_PAPI_branch_misses', 'branch misses', 'miss', 'branch-miss',
    'ubench_agent_PAPI_cache_references', 'cache references', 'ref', 'cache-refs',
    'ubench_agent_PAPI_cache_misses', 'cache misses', 'miss', 'cache-miss',
)

# Load modules.

MODULES <- c (
    'util.r',
    'load_util.r', 'load_csv.r', 'load_json.r',
    'comp_util.r', 'comp_warmup.r', 'comp_mean_with_ci.r', 'comp_ratio_with_ci.r',
    'plot_util.r', 'plot_simple_samples.r', 'plot_simple_mean.r', 'plot_website_figures.r'
)

library ('scriptName')
HOME_PATH <- dirname (current_filename ())
for (module in MODULES) source (file.path (HOME_PATH, module))

# Load data.

if (file.exists (DATA_FILE)) {
    data_both <- readRDS (DATA_FILE)
} else {
    data_both <- load_data_json (DATA_PATH)
    saveRDS (data_both, DATA_FILE)
}

# Add VM and JDK information.
data_both <- data_both %>% add_vm_jdk_from_name_version_configuration (NAME_VM_FILE)

# Keep warm data separately.
data_warm <- data_both %>% comp_warm () %>% filter (warm) %>% select (-warm)

# Individual scatter plots for all metrics considered.
METRICS %>% pwalk (function (name, label, unit, suffix) {
    if (name %in% names (data_both)) {
        plot_samples_scatter (data_both, FALSE, sprintf ('%s-both', suffix),          sprintf ('Complete repetition %s samples', label), name, label, unit)
        plot_samples_scatter (data_warm, FALSE, sprintf ('%s-warm-outliers', suffix), sprintf ('Warm repetition %s samples including outliers', label), name, label, unit)
        plot_samples_scatter (data_warm, TRUE,  sprintf ('%s-warm-inliers', suffix),  sprintf ('Warm repetition %s samples except outliers', label), name, label, unit)
    }
})

# Overview plots for performance.
data_both %>% distinct (jdk) %>% pwalk (function (jdk) {

    baseline <- sprintf ('OpenJDK %d', jdk)

    data_both_this_jdk <- data_both %>% filter (jdk == !! jdk)
    data_warm_this_jdk <- data_warm %>% filter (jdk == !! jdk)

    METRICS %>% pwalk (function (name, label, unit, suffix) {
        if (name %in% names (data_both)) {
            data_mean_with_ci <- data_warm_this_jdk %>% group_by (vm, benchmark) %>% comp_mean_with_ci (name) %>% ungroup ()
            plot_mean_bar (data_mean_with_ci, sprintf ('jdk-%d-%s', jdk, suffix), sprintf ('Warm repetition mean %s on JDK %d', label, jdk), label, unit)
            plot_samples_violin (data_both_this_jdk, FALSE, sprintf ('jdk-%d-%s-both', jdk, suffix),          sprintf ('Complete %s distribution including outliers on JDK %d', label, jdk), name, label, unit)
            plot_samples_violin (data_warm_this_jdk, TRUE,  sprintf ('jdk-%d-%s-warm-inliers', jdk, suffix),  sprintf ('Warm repetition %s distribution except outliers on JDK %d', label, jdk), name, label, unit)
            plot_samples_violin (data_warm_this_jdk, FALSE, sprintf ('jdk-%d-%s-warm-outliers', jdk, suffix), sprintf ('Warm repetition %s distribution including outliers on JDK %d', label, jdk), name, label, unit)
        }
    })

    data_ratio_with_ci <- data_warm_this_jdk %>% group_by (vm, benchmark) %>% comp_ratio_with_ci (baseline, 'time') %>% ungroup ()
    plot_website_stripe (data_ratio_with_ci, sprintf ('stripe-jdk-%d.png', jdk))
    write_csv (data_ratio_with_ci, sprintf ('summary-jdk-%d.csv', jdk))
})


# save(JOBID,
# nStanIterations,
# duration,
# fit,
# prediction,
# dates,
# reported_cases,
# deaths_by_country,
# countries,
# estimated.deaths,
# estimated.deaths.cf,
# out,
# lastObs,
# covariate_list_partial_county,
# file=paste0('../modelOutput/results/',StanModel,'-',JOBID,'-stanfit.Rdata'))

library(jsonlite)

args <- commandArgs(trailingOnly = TRUE)
filename2 <- args[1]
load(paste0("../modelOutput/results/", filename2))
# print(sprintf("loading: %s",paste0("../modelOutput/results/",filename2)))

obs <- read.csv("../modelInput/ILCaseAndMortalityV1.csv")
obs$date = as.Date(obs$dateRep,format='%m/%d/%y')
obs$countryterritoryCode <- sapply(obs$countryterritoryCode, as.character)
obs$countryterritoryCode <- sub("840", "", obs$countryterritoryCode)

l <- list()

for(i in 1:length(countries)){

    # county index
    county <- countries[[i]]
    N <- length(dates[[i]])
    countyDates <- dates[[i]]

    # last index is county
    countyForecast <- colMeans(estimated.deaths[,(N+1):N2,i])

    countyObs <- obs[obs$countryterritoryCode == county,]
    validationObs <- countyObs[countyObs$date > lastObs, ]

    # number of points for this county
    n <- min(length(countyForecast), nrow(validationObs))

    vdf <- data.frame("date"=validationObs$date[1:n], "obs"=validationObs$deaths[1:n], "pred"=countyForecast[1:n])
    vdf$county <- county

    l[[i]] <- vdf
}

# could save this df - not sure how necessary that is though
fullSet <- do.call(rbind, l)

# look at it
# print(fullSet)

# number of points
pts <- nrow(fullSet)

# compute the score
correlationScore <- cor(fullSet$pred, fullSet$obs)

## write results

outDir <- file.path("../modelOutput/validation", JOBID)
dir.create(outDir, showWarnings = FALSE)

# create summary
summary <- list(
    jobid=JOBID,
    time=duration, # in seconds
    nIter=nStanIterations,
    start=min(fullSet$date),
    end=max(fullSet$date),
    nDays=n,
    nCounties=length(countries),
    deathsCutoff=minimumReportedDeaths,
    nPoints=pts,
    correlation=correlationScore
)
exportJSON <- toJSON(summary, pretty=TRUE, auto_unbox=TRUE)
# sent to stdout
print("--- validation summary ---")
print(exportJSON)
# write summary to log
write(exportJSON, file.path(outDir, "log.json"))

# save plot
png(filename=file.path(outDir, "v.png"), width=1600, height=1600, units="px", pointsize=36)
plot(fullSet$obs, fullSet$pred, sub=sprintf("correlation: %f", correlationScore))
naught <- dev.off()

# save log plot (sometimes this is easier to look at)
png(filename=file.path(outDir, "v_logScale.png"), width=1600, height=1600, units="px", pointsize=36)
plot(log(fullSet$obs), log(fullSet$pred), sub=sprintf("correlation: %f", correlationScore))
naught <- dev.off()


#MR id -> complications
#ml GCC/8.2.0  OpenMPI/3.1.4 Intel/2019.1.144  IntelMPI/2018.4.274 R/3.6.0

library('MendelianRandomization')
library('ggplot2')

anno<-read.table('/data/c***/z***/anno/gencode/37/gencode.v32.GRCh37.txt',header = T,stringsAsFactors = F)

info<-read.table('/data/g***/z***/hihost_gwas/mr_id_complications/top.txt',header = T,stringsAsFactors = F,sep='\t')

info<-merge(info,anno[,c('genename','chr','left','right')],by=1)
info$chr=sub('chr','',info$chr)

p_cutoff=1e-5

#top ranked genes
info<-read.table('/data/g***/z***/hihost_gwas/mr_id_complications/top.txt',header = T,stringsAsFactors = F,sep='\t')
info<-merge(info,anno[,c('genename','chr','left','right')],by=1)
info$chr=sub('chr','',info$chr)

for(i in 1:nrow(info)){
  exp_phecode=paste0('X',info[i,'exp_phecode'])
  outcome_phecode=paste0('X',info[i,'outcome_phecode'])

  #plink clumping
  cmd=paste0('plink --bfile /data/g***/z***/biovu/23k/geno/ea --clump /data/g***/z***/hihost_gwas/asso/',exp_phecode,'.txt.gz --clump-field P --clump-p1 ',p_cutoff,' --clump-r2 0.01 --out /data/g***/z***/hihost_gwas/mr_id_complications/tmp/',exp_phecode,'_',p_cutoff)
  #system(cmd,wait = T)

  #load clumped snps
  clumped<-read.table(paste0('/data/g***/z***/hihost_gwas/mr_id_complications/tmp/',exp_phecode,'_',p_cutoff,'.clumped'),header = T,stringsAsFactors = F)

  #load exp gwas
  exp<-read.table(paste0('/data/g***/z***/hihost_gwas/asso/',exp_phecode,'.txt.gz'),header = T,stringsAsFactors = F)
  exp<-exp[(exp$SNP %in% clumped$SNP),]
  exp$beta_exp=log(exp$OR,2.718)
  exp$se_exp=exp$beta_exp/exp$Z_STAT
  exp<-exp[,c('SNP','A1','beta_exp','se_exp')]
  colnames(exp)<-c('SNP','eff_exp','beta_exp','se_exp')

  #load outcome gwas
  outcome<-read.table(paste0('/data/g***/z***/hihost_gwas/asso/',outcome_phecode,'.txt.gz'),header = T,stringsAsFactors = F)
  outcome$beta_outcome=log(outcome$OR,2.718)
  outcome$se_outcome=outcome$beta_outcome/outcome$Z_STAT
  outcome<-outcome[,c('SNP','A1','beta_outcome','se_outcome')]

  df<-merge(exp,outcome,by='SNP')

  #rm na
  df<-df[!is.na(df$beta_exp+df$beta_outcome),]

  #harmonize
  df$beta_outcome=ifelse(df$eff_exp==df$A1,df$beta_outcome,df$beta_outcome*-1)

  #flip the allele
  df$beta_outcome=ifelse(df$beta_exp>0,df$beta_outcome,df$beta_outcome*-1)
  df$beta_exp=abs(df$beta_exp)

  info[i,paste0('n_SNPs_allgenes_p_cutoff_',p_cutoff)]<-nrow(df)
  if(nrow(df)<3){next}

  #mr weighted median
  ans_median_weighted<-mr_median(mr_input(bx = df$beta_exp, bxse = df$se_exp, by = df$beta_outcome, byse = df$se_outcome),weighting = "weighted", iterations = 100)

  info[i,paste0('median_weighted_allgenes_p_cutoff_',p_cutoff,'_beta')]<-ans_median_weighted@Estimate
  info[i,paste0('median_weighted_allgenes_p_cutoff_',p_cutoff,'_pvalue')]<-ans_median_weighted@Pvalue

  #mr egger
  ans_egger<-try(mr_egger(mr_input(bx = df$beta_exp, bxse = df$se_exp, by = df$beta_outcome, byse = df$se_outcome),alpha=0.05))
  if('try-error' %in% class(ans_egger)){next}
  info[i,paste0('egger_allgenes_p_cutoff_',p_cutoff,'_beta')]<-ans_egger@Estimate
  info[i,paste0('egger_allgenes_p_cutoff_',p_cutoff,'_pvalue')]<-ans_egger@Pvalue.Est

  #generate scatter plot

  png(paste0('/data/g***/z***/hihost_gwas/mr_id_complications/plot/expo_',info[i,'exp_phecode'],'_outcome_',info[i,'outcome_phecode'],'.png'),width = 1500,height = 1500,res=400)

  scatter_p<-ggplot(df, aes(x=beta_exp, y=beta_outcome)) +
    geom_errorbar(aes(ymin=beta_outcome-se_outcome*1.96, ymax=beta_outcome+se_outcome*1.96),size=0.05,color='ivory3') +
    geom_errorbarh(aes(xmin=beta_exp-se_exp*1.96, xmax=beta_exp+se_exp*1.96),size=0.05,color='ivory3') +
    geom_point(size=1.5,color='dodgerblue4') +
    xlab(paste0("Effect size of SNP-Exposure \n",info[i,'exp_trait'])) +
    ylab(paste0("Effect size of SNP-Outcome \n",info[i,'outcome_trait']))+
    theme_classic()
  #xlim(-0.5,3)
  print(scatter_p)
  dev.off()

}

write.table(info,paste0('/data/g***/z***/hihost_gwas/mr_id_complications/result/allgenes_',p_cutoff,'.txt'),quote = F,sep='\t',row.names = F)


#
# Example R program
#

library(glmnet)
data(QuickStartExample)
fit = glmnet(x, y)
print(fit)


#' Custom CAI reference table
#'
#' @param x a list of KZsqns object, from which the reference table will be calculated
#' @param y y an optional number denoting the codon table to be used. 0 = standard codon table (default), 2 = vertibrate mitchodrial (See dna2aa for additional options). When an option other than those mentioned above is provided, the standard codon table will be used
#' @param method a charactor string denoting which method to use for codons absent from the reference set: "bulmer", set the adaptiveness of the codon to 0.01; "sharp", in calculating the adaptiveness of an absent codon, use a frequency of 0.5 instead
#' @details If any codon is missing from the reference set, the adaptiveness value of that codon need to be adjusted in order to obtain valid CAI for sequences that have that codon in their sequence. The sharp's method is the default option [1], but the user may choose to use bulmer's method [2].
#'
#' @description A helper method to calculate the codon adaptiveness index reference table based on a list of highly expressed genes
#' @references [1] Sharp, P. M., & Li, W.-H. (1987). The codon adaptation index-a measure of directional synonymous codon usage bias, and its potential applications. Nucleic acids research, 15(3), 1281-1295.
#' [2] Bulmer, M. (1988). Are codon usage patterns in unicellular organisms determined by selection-mutation balance? Journal of Evolutionary Biology, 1(1), 15-26.
#' @export

cai_crt <- function(x, y=0, method=c("sharp", "bulmer")){
  if(!is.list(x)) {
    cat("Just one sequence?\n")
    x = list(x)
  }
  cTable = arg_check(x[[1]], 'KZsqns',y)
  ttx = lapply(x, table)

  tx = rep(0, 64)
  names(tx) <- cTable[,1]

  for (i in 1:length(ttx)){
    tx = colSums(rbind(tx+ttx[[i]][cTable[,1]]), na.rm = T)
  }

  if(method[1] == "sharp"){
    tx[tx==0] <- 0.5
  }

  temp = table(cTable[,2])
  degv = numeric(0)
  for(j in names(temp)){
    dx = which(cTable[,2]==j)
    if(sum(tx[dx])==0){
      degv[dx] = NA
      cat('An animo acid is missing, and NAs will be produced for this animo acid\n')
    } else {
      degv[dx] = tx[dx]/max(tx[dx])
    }
  }
  names(degv) = cTable[,1]
  degv[which(cTable[,2]=='*')] <- NA
  if(method[1]=="bulmer"){
    degv[degv==0] <- 0.01
  }
  return(degv)
}


EFSA<-function(train_data,train_labels,test_data=NULL,test_labels,nofsample=50){
	source('shapeletSimilarity.r')
	shapelets_dict = generate_shapelets(train_data,as.factor(train_labels),nofsample)
	shapelets = shapelets_dict$shapelets
	shapelet_length = shapelets_dict$shapelet_length

	model = train.EFSA(train_data,as.factor(train_labels),shapelets,shapelet_length)
	train_accuracy = model$train_accuracy
	print(train_accuracy)
	test_accuracy = NA
	predictions=NA
	if(!is.null(test_data)){
		test_dict = test.EFSA(model,test_data,test_labels)
		test_accuracy = test_dict$test_accuracy
		predictions = test_dict$predictions
	}
	return(structure(list("model"=model,"test_accuracy"=test_accuracy,"predictions"=predictions),class='EFSA'))
}


suppressMessages(library(stats)) # for prcomp()
suppressMessages(library(fmlr))

if (fml_mpi()){
  m = 3
  n = 2
  bfr = 1
  bfc = 1
  g = grid()

  x = mpimat(g, m, n, bfr, bfc)
  x$fill_linspace(1, m*n)
  xr = x$to_robj()

  s = cpuvec()

  source("internals/common.r")
  source("internals/stats.r")
} # end if (fml_mpi())


#Jenny Smith

#June 21, 2017

#Purpose: Perform gene set enrichement analysis with A) Inpur normalized counts (from limma)
# and B) input log2 fold changes for significantly differentially expressed genes.

#DE analysis with the gsva matrix.
gsva_DE <- function(gsva_matrix,clinData,col,p.value=0.001){
  #clinData must be factor leveled!

  #Example:
  # X <-  sample_info[samps_all, ] %>%
  #   mutate(USI=Sample) %>%
  #   mutate_at(vars(NUP98.Rearranged.Groups),
  #             ~factor(., levels=c("OtherAML","NUP98-X"))) %>%
  #   set_rownames(.$Sample)
  # gsva_DE(gsva_matrix = gsva.res.all[,X$Sample],
  #         clinData=X,
  #         col="NUP98.Rearranged.Groups",
  #         p.value = 0.25)

  library(edgeR)
  library(limma)

  gsva <- gsva_matrix[,clinData$Sample]
  design <- model.matrix(formula(paste("~0 +", col)),
                         data=clinData)
  colnames(design) <- c("Ref","Comparitor")

  cm <- makeContrasts("Comparitor-Ref", levels = design)

  fit <- lmFit(gsva, design = design)
  fit2 <- contrasts.fit(fit, contrasts = cm)
  fit2 <- eBayes(fit2)

  allGeneSets <- topTable(fit2, p.value = p.value,number=Inf) %>%
    rownames_to_column("GeneSet") %>%
    dplyr::arrange(desc(logFC), desc(adj.P.Val))

  res <- list("contrast"=cm,"fit"=fit2, "gene_sets"=allGeneSets)

  return(res)
}

GAGE_GSA <- function(df, type, geneset=NULL, ref=NULL,samp=NULL, min_size=15){
  #df has genes symbols as rownames and patients as columns with normalized expression data
  #type is either limma differential expression results (FC) or expression matrix of normalized counts (expn)
  # library(pathview)
  library(magrittr)
  library(gage)
  library(gageData)

  if(is.null(geneset)){
    #Load the kegg human datasets
    data("kegg.gs")
    # data("go.sets.hs")
    data("egSymb")

    #create objects to hold the information from the datasets loaded above
    kg.hsa=kegg.gsets("hsa")

    #Examine all Kegg genesets, signalling, metabolic, and disease.
    kegg.gs <- kg.hsa$kg.sets

    #convert to gene symbols
    geneset <- lapply(kegg.gs, eg2sym)

  }else{
    geneset = geneset
  }

  if (type == "FC"){
    FCs <- df$logFC #Note: the FCs should include ALL genes tested - so approx. 17-20,000 regarless of p-value.
    names(FCs) <- rownames(df)

    gsa <- gage(FCs, gsets=geneset, same.dir = TRUE,
                saaTest = gs.tTest, #gs.KSTest
                ref=ref, samp=samp, set.size = c(20, 450)) #examine all differntially expressed genes.

    sigRes <- subset(gsa$greater, gsa$greater[,"q.val"] <  0.1 &
                       !is.na(gsa$greater[,"q.val"]))

    #Final results list
    res <- list(gsa, sigRes)
    names(res) <- c("gsa", "SigPaths")

    if (nrow(sigRes) > 1){
      essSets.Up <- esset.grp(gsa$greater, FCs, gsets=geneset,
                           use.q = TRUE,cutoff = 0.1,
                           ref=NULL, sampl=NULL,
                           output = FALSE,
                           test4up = FALSE,
                           same.dir = FALSE)

      res[["essSets"]] <-  essSets.Up
    }

  }else if(type=="expn"){
    gsa <- gage(df, gsets=geneset,
                same.dir = TRUE, ref= ref,
                samp=samp,compare ="unpaired",
                set.size = c(20, 450))

    sigRes.Up <- subset(gsa$greater, gsa$greater[,"q.val"] <  0.1 &
                       !is.na(gsa$greater[,"q.val"]))

    sigRes.Dn <- subset(gsa$less, gsa$less[,"q.val"] <  0.1 &
                          !is.na(gsa$less[,"q.val"]))

    #Final results list
    res <- list(gsa, sigRes.Up, sigRes.Dn)
    names(res) <- c("gsa", "SigPaths.Up","SigPaths.Dn")

    if (nrow(sigRes.Up) > 1){
      essSets.Up <- esset.grp(gsa$greater, df, gsets=geneset,
                              use.q = TRUE,
                              ref=ref, sampl=samp,
                              compare = "unpaired",
                              output = FALSE,
                              cutoff = 0.1,
                              test4up = TRUE)

      res[["essSets.Up"]] <-  essSets.Up

      if (nrow(sigRes.Dn) > 1){
      essSets.Dn <- esset.grp(gsa$less, df, gsets=geneset,
                              use.q = TRUE,
                              ref=ref, sampl=samp,
                              compare = "unpaired",
                              output = FALSE,
                              cutoff = 0.1,
                              test4up = FALSE)

      res[["essSets.Dn"]] <-  essSets.Dn

      }
    }
  }

  return(res)
}

#Wrapper Function to run GAGE GSEA on the output for the DEGs pipeline
gage_from_pipeline <- function(twoGroups_DEGs.res,type,geneset=NULL, method="voom",min_size=15,... ){

  if (type == "FC"){
    #change this to use ALL genes tested (~20K genes regardless of significance)
    df <- twoGroups_DEGs.res$DE$DE
    ref <- NULL
    cond <- NULL

  }else if (type == "expn" ) {

    if(method=="voom"){
      df <- twoGroups_DEGs.res$DE$Voom$E
    }else if(method=="trend"){
      df <- twoGroups_DEGs.res$DE$dge
    }

    ref <- which(colnames(df) %in%
                   names(twoGroups_DEGs.res$phenovector[twoGroups_DEGs.res$phenovector == "GroupB"]))

    cond <- which(colnames(df) %in%
                    names(twoGroups_DEGs.res$phenovector[twoGroups_DEGs.res$phenovector == "GroupA"]))
  }

  #Run GSA
  print(min_size)
  GSA <- GAGE_GSA(df=df, type=type, geneset = geneset, ref=ref, samp=cond, min_size=min_size)

  return(GSA)

}

##Simple function to read in a .gmt file and return a list of pathways
#https://github.com/arcolombo/junk/blob/5d39a5893bb7dd6328d587791b9735de14b2ff45/R/qusageArm.R
#Directly from github. Cannot install the library.
read.gmt = function(file){
  if(!grepl("\\.gmt$",file)[1]){stop("Pathway information must be a .gmt file")}
  geneSetDB = readLines(file)                                ##read in the gmt file as a vector of lines
  geneSetDB = strsplit(geneSetDB,"\t")                       ##convert from vector of strings to a list
  names(geneSetDB) = sapply(geneSetDB,"[",1)                 ##move the names column as the names of the list
  geneSetDB = lapply(geneSetDB, "[",-1:-2)                   ##remove name and description columns
  geneSetDB = lapply(geneSetDB, function(x){x[which(x!="")]})##remove empty strings
  return(geneSetDB)
}

#Simply function to write custom list of gene-sets to gmt file format.
write.gmt <- function(list_of_genesets,Description_list=NA, filename="gene_sets.gmt"){

  if(is.na(Description_list)){
    Description_list <- as.list(rep(NA,length(list_of_genesets)))
  }

  for (i in 1:length(list_of_genesets)){
    append <- ifelse(i==1,FALSE,TRUE)
    list_of_genesets[[i]] <- c(Description_list[[i]],list_of_genesets[[i]])

    line <- paste0(c(names(list_of_genesets)[i], list_of_genesets[[i]]),
                   collapse = "\t")
    line <- paste0(line,"\n")

    # cat(line,
    #     file = filename,
    #     sep = " ",
    #     fill = FALSE,
    #     labels = NULL,
    #     append = append)
  }

  print(paste("Finshed writing gene-sets to file", filename))
}

#Needs to be tested
extract_core_genes <- function(gage_from_pipeline.res,direction="up", ret.genesets=FALSE){

  gage.res.sig <- gage_from_pipeline.res[sapply(gage_from_pipeline.res,length) == 5]

  if(direction=="up"){
    idx <- "essSets.Up"
    idx.num <- 4
  }else if (direction=="down"){
    idx <- "essSets.Dn"
    idx.num <- 5
  }

  #select the correct index for the pathway core genesets
  core.genes <- lapply(gage.res.sig, `[[`, idx.num)
  core.genes <- lapply(core.genes, `[[`, 7)

  if(ret.genesets){
    return(core.genes)
  }

  #Define an empty list to append to
  paths.core.genes <- list()
  #index position for the new list
  n <- 1

  #for loop to un-nest the core.genes, so that they are not in a depth == 2 list
  for (i in 1:length(core.genes)){

    gs <- core.genes[[i]]

    if(i == 1){
      stop=length(gs)
    }else{
      stop <- n + c(length(gs)-1)
    }

    items <- n:stop
    paths.core.genes[items] <- gs
    names(paths.core.genes)[items] <- names(gs)

    n <- stop+1
  }

  return(paths.core.genes)

}

#MUST FINISH
# GAGE.heatmap <- function(GAGE_GSA.res){
# library(pheatmap)
#   #result object from GAGE_GSA() function above
#
#
#   essSets.Up <- GAGE_GSA.res$essSets$essentialSets
#   up <- kegg$SigPaths[Kegg.essSets.Up[1:15],1:5]
#   up[,"q.val"]  <- round(up[,"q.val"], digits = 3)
#   up <- up[up[,"q.val"] <= 0.001,]
#
#   # dim(up) #11 with FDR < 0.001
#
#   dn <- kegg$gsa$less[Kegg.essSets.Dn$essentialSets[1:10],1:5]
#   dn[,"q.val"]  <- round(dn[,"q.val"], digits = 3)
#   dn <- dn[dn[,"q.val"] <= 0.001,]
#
#   head(dn)
#   dim(dn) #8 with FDR < 0.001
#
#
#   # col <-  colorRampPalette(rev(brewer.pal(n = 5, name ="RdYlBu")))(299)
#   len <- 299
#   col <- colorRampPalette(c("deepskyblue4", "deepskyblue3", "deepskyblue2", "deepskyblue1","white","red1", "red2", "red3", "red4"))(n=len)
#
#   paths <- c(rownames(up), rownames(dn))
#   stat <- kegg$gsa$stats[paths, 2:ncol(kegg$gsa$stats)] #ranges from -5.4 to 4.5
#
#
#   Breaks <- c(seq(min(stat), 0, length.out=ceiling(len/2) + 1),
#               seq(max(stat)/len, max(stat), length.out=floor(len/2)))
#
#   q.val <- as.character(c(up[,4],dn[,4]))
#   q.val <- ifelse(q.val!="0", paste("FDR =", q.val), "FDR < 0.001")
#   labs <- gsub("KEGG_", "", paths ) %>% gsub("_"," ", .) %>%
#     paste0(.,", ", q.val )
#
#   anno.col <- merged %>%
#     filter(TARGET.USI.1 %in% names(DEGs$cts.hd.1031$phenovector)) %>%
#     filter(CBFA2T3.GLIS2=="Yes") %>%
#     dplyr::select(TARGET.USI.1,M7_AML) %>%
#     column_to_rownames("TARGET.USI.1")

# pheatmap::pheatmap(mat=stat,
#                    color=col,
#                    scale = "none",
#                    breaks = Breaks,
#                    cluster_rows=FALSE,
#                    clustering_method="complete",
#                    clustering_distance_cols="euclidean",
#                    kmeans_k = NA,
#                    # annotation_col = anno.col,
#                    # annotation_colors = list(M7_AML=c("Yes"="firebrick4","No"="red")),
#                    gaps_row=11,
#                    # cutree_cols = 2,
#                    labels_row = labs,
#                    fontsize = 20,
#                    fontsize_number = 14,
#                    gp=gpar(col="blue"),
#                    show_colnames=FALSE,
#                    display_numbers=FALSE,
#                    number_format="%.1f",
#                    number_color="black")
#
#
#
# }

############# 11/8/18 for Hallmark sets ###########

# gmt <- read.gmt(file="~/RNA_seq_Analysis/0000.00.01_GSEA_geneSets_gmt/hallmark_MdbSig/h.all.v6.2.symbols.gmt")
# head(gmt)
# length(gmt)
#
# idx <- sapply(gmt, function(x) length(x) > 15 & length(x) < 500)
#
# gmt <- gmt[idx]
# length(gmt)

# saveRDS(gmt, "~/RNA_seq_Analysis/0000.00.01_GSEA_geneSets_gmt/hallmark_MdbSig/h.all.v6.2.symbols.RDS")

############ 7/13/18 create GO gene sets
# p <- "~/RNA_seq_Analysis/0000.00.01_GSEA_geneSets_gmt/"
# files <- paste0(p, dir(pattern = "c5.+symbols.gmt", path=p))

# GMTs <- lapply(files, read.gmt)
# names(GMTs) <- c("c5.bp","c5.cc", "c5.mf")
# summary(GMTs)
# saveRDS(GMTs, file="~/RNA_seq_Analysis/0000.00.01_GSEA_geneSets_gmt/c5_list_v6.1.symbols.RDS")

# idxs <- lapply(GMTs, function(x) sapply(x, function(y) length(y) >= 50 & length(y) <= 300))
# names(idxs)
#
# GMTs.Sub <- lapply(names(GMTs), function(i) GMTs[[i]][idxs[[i]]])
# names(GMTs.Sub) <- names(GMTs)
# summary(GMTs.Sub)

# saveRDS(GMTs.Sub, file="~/RNA_seq_Analysis/0000.00.01_GSEA_geneSets_gmt/c5_list_SetSize_GE.50_LE.300_v6.1.symbols.RDS")

# sapply(GMTs$c5.bp, function(y) length(y) >= 50 & length(y) <= 300)

############ 10/05/18 create GO gene sets

# c3 <- read.gmt(file="~/RNA_seq_Analysis/0000.00.01_GSEA_geneSets_gmt/c3.tft.v6.2.symbols.gmt")
# length(c3)
# idx <- sapply(c3, function(x) length(x) > 20 & length(x) < 300) #546
# c3 <- c3[idx]
# length(c3)
# head(c3)
# saveRDS(c3, "~/RNA_seq_Analysis/0000.00.01_GSEA_geneSets_gmt/c3.tft.v6.2.symbols.RDS")

#################### Example useage
# library(qusage)
# files <- dir(pattern = "symbols.gmt", path="GAGE/") %>% paste("GAGE/", ., sep="")
# GMTs <- lapply(files, read.gmt)

# all_genes <- NULL
# for (gs in rownames(sigRes)){
#   outname <-gsub("hsa[0-9]+ (\\w+)", "\\1", gs)
#   genes <- geneset[[gs]]
#   all_genes <- c(all_genes, genes)
#
#   if (length(genes) < 100){
#     cex=0.8
#   }else if(length(genes) > 100 & length(genes) < 150){
#     cex=0.5
#   }else{
#     cex=0.25
#   }
#
#   geneData(genes=geneset[[gs]], exprs = df,
#            ref=ref, samp=ref, txt=TRUE, heatmap = heatmap,outname = outname, cexRow=cex)
# }


library(ggplot2)
library(reshape2)

microbial<-read.delim(parFile2, header=T, row.names=1,check.names=F)

all<-read.csv(parFile1, row.names=1,check.names=F)
all<-data.frame(t(all))
all$all<-rowSums(all)
all$Host<-(all$Host.Small.RNA + all$Mapped.to.Host.Genome) / all$all * 100
all$Microbial<-(microbial[rownames(all), "Count"]) / all$all * 100
all$Other<-100 - all$Host - all$Microbial

figData<-all[,c("Host", "Microbial", "Other")]

hasGroup = parSampleFile1 != ""
if(hasGroup){
  group<-read.delim(parSampleFile1, stringsAsFactors = F, header=F)
  if (exists("groupNames")){
    group<-group[group$V2 %in% groupNames,]
  }
  rownames(group)<-group$V1
  figData$Group<-group[rownames(figData), "V2"]
} else {
  figData$Group<-"All"
}
figData$Sample<-rownames(figData)

figData<-figData[!(rownames(figData) %in% c("B020", "B114", "D031")),]
figData<-figData[order(figData$Microbial, decreasing = T),]

mFigData<-melt(figData, id.vars=c("Sample", "Group"))
colnames(mFigData)<-c("Sample", "Group", "Category", "Percentage")
mFigData$Sample<-factor(mFigData$Sample, levels=figData$Sample)
mFigData$Category<-factor(mFigData$Category, levels=c("Microbial", "Host", "Other"))

mFigData$Group[is.na(mFigData$Group)] = "Unknown group"
write.table(mFigData, file=paste0(outFile, ".txt"), sep="\t", row.names=F, col.names=T, quote=F)

pdf(paste0(outFile, ".pdf"), width=10, height=6)
colors<-c("Microbial" = "chartreuse3", "Host" = "deepskyblue", "Other" = "gray")
g<-ggplot(mFigData) + geom_bar(aes(y = Percentage, x = Sample, fill = Category), stat="identity", width=1) + facet_grid(~Group, scales = "free_x") +
  scale_fill_manual(values=colors) +
  ylab("Percentage of Reads") +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        strip.background =element_blank(),
        panel.background = element_blank())
print(g)
dev.off()


library(XML)
library(RCurl)
library(httr)

rm(list=ls(all.names=TRUE))

indexUrl <- "http://www.horoscope.com/us/horoscopes/general/horoscope-general-daily-today.aspx?sign="

zodiac <- c('Aries','Taurus','Gemini','Cancer','Leo','Virgo','Libra','Scorpio','Sagittarius'
            ,'Capricorn','Aquarius','Pisces')

#get url
url <- c()

for( i in 1:12){
  a <- paste0(indexUrl,i)
  url <- c(url,a)
}

factor <- c('Love','Finance','Career')
factorXpath <- '//div[@class="block-daily-facts-rat-div"]/noscript/img/@src'

data <- matrix(0,3,12)

rownames(data) <- factor
colnames(data) <- zodiac

for( i in 1:12 ){
  tmp <- getURL(url[i])
  xmldoc <- htmlParse(tmp)
  rawdata <- xpathSApply(xmldoc,factorXpath)

  score <- c(as.numeric( substr(rawdata[1],23,23) ),as.numeric( substr(rawdata[2],23,23))
             ,as.numeric( substr(rawdata[4],23,23) ))
  data[,i] <- score
}

date <- Sys.Date()

filename <- paste0('data\\horoscope.com\\horoscope.com',date,'.csv')

write.csv(data,filename)


library(tidyverse)

train_files <- fs::dir_ls("data/7T/images/train") %>%
    enframe %>%
    transmute(
        file=str_replace(value,".*train/",""),
        Id=str_replace(file,"_slice.*",""),
        frame=str_replace(file,".*frame",""),
        frame=str_replace(frame,"-.*",""),
        frame=as.numeric(frame),
        slice=str_replace(file,".*slice",""),
        slice=str_replace(slice,"_frame.*",""),
        slice=as.numeric(slice)
    )

set.seed(42)

volunteers_7 <- train_files %>% pull(Id) %>% unique %>% sample(7,replace=FALSE)
volunteers_3 <- volunteers_7 %>% sample(3,replace=FALSE)
volunteers_1 <- volunteers_3 %>% sample(1,replace=FALSE)
print(volunteers_7)
print(volunteers_3)
print(volunteers_1)

train_files <- train_files %>% mutate(
    v7 = Id %in% volunteers_7,
    v3 = Id %in% volunteers_3,
    v1 = Id %in% volunteers_1
)

file_random_order <- train_files %>% pull(file) %>% sample

train_files <- train_files %>% mutate(
    r7 = file %in% head(file_random_order, sum(v7)),
    r3 = file %in% head(file_random_order, sum(v3)),
    r1 = file %in% head(file_random_order, sum(v1))
)

# Add subsets with end-systolic and end-diastolic frames

pixel_counts <- read_tsv("analysis/7T/pixel_counts_by_class.tsv")

pixel_counts_by_tf <- pixel_counts %>%
    filter(source == "7T") %>%
    separate(file, "_", into=c("Id","slice","frame")) %>%
    mutate(
        slice=str_replace(slice,"slice",""),
        slice=as.numeric(slice),
        frame=str_replace(frame,"frame",""),
        frame=str_replace(frame,"-mask.png",""),
        frame=as.numeric(frame)
    ) %>%
    group_by(Id, frame) %>%
    summarize(bg=sum(bg),lv=sum(lv),my=sum(my))

es_frame <- pixel_counts_by_tf %>% group_by(Id) %>% top_n(1,-lv) %>% ungroup %>% transmute(id_frame=paste(Id, frame, sep="_")) %>% pull
ed_frame <- pixel_counts_by_tf %>% group_by(Id) %>% top_n(1,lv) %>% ungroup %>% transmute(id_frame=paste(Id, frame, sep="_")) %>% pull
es_tbl <- pixel_counts_by_tf %>% group_by(Id) %>% top_n(1,-lv) %>% ungroup %>% select(Id, es=frame)
ed_tbl <- pixel_counts_by_tf %>% group_by(Id) %>% top_n(1,lv) %>% ungroup %>% select(Id, ed=frame)

left_join(es_tbl, ed_tbl, by="Id") %>% write_tsv("analysis/7T/esed_frames.tsv")

train_files <- train_files %>% mutate(
    esed = paste(Id,frame,sep="_") %in% c(es_frame,ed_frame),
    r_esed = file %in% head(file_random_order, sum(esed)),
)

train_files %>% write_tsv("analysis/7T/image_subsets.tsv")

train_files %>% summarise(all=n(),sum(v7),sum(v3),sum(v1),sum(r7),sum(r3),sum(r1),sum(esed),sum(r_esed))


#Formatting mapping file, subsetting to temperate latitudes, and rarefying OTU table to 1k reads.
#clear environment, source packages, functions and paths.
rm(list=ls())
source('paths.r')
source('NEFI_functions/worldclim2_grab.r')
source('NEFI_functions/arid_extract.r')
library(data.table)

#Set output path.----
map.output.path <- tedersoo_ITS_clean_map.path
otu.output.path <- ted_2014_SV.table_1k.rare.path

#load  files.----
map <- read.csv(ted_map_raw.path, header = TRUE, na.strings=c("", "NA"))
map <- data.table(map)
#load times- sent separately by Leho Tedersoo.
time <- read.csv(ted_sampling_dates.path, header = TRUE, row.names=1, check.names = FALSE)
#load SV table as otu file.
otu <- readRDS(ted_2014_SV.table.path)

#subset to northern temperate latitudes.----
map <- map[latitude < 66.5 & latitude > 23.5,]

#format the time data frame (get rid of an empty column, etc.)----
colnames(time)[1] <- 'human.date'
time[2] <- NULL
#convert human readable date to days since epoch
time$epoch.date <- round(
  as.numeric(
    as.POSIXlt(time$human.date,
               format = "%m/%d/%y", origin = "01/01/1970"))/86400)
#get day of year (doy) as well.
time$doy  <- lubridate::yday(as.Date(time$human.date,format='%m/%d/%Y'))
time$year <- lubridate::year(as.Date(time$human.date,format='%m/%d/%Y'))
time$epoch.date <- (time$year - 9)*365 + time$doy

#drop samples in time table not present in mapping file.
time <- time[row.names(time) %in% map$tedersoo.code,]
#push times into the mapping file
time$tedersoo.code <- rownames(time)
map <- merge(map,time, by = 'tedersoo.code', all.x=T)

#Assign whether sites are forests and if conifers are present.----
map$forest <-ifelse(map$Biome %in% c('Temperate coniferous forests','Temperate deciduous forests','Dry Tropical Forests','Boreal forests'),1,0)
map$conifer <- ifelse(map$Biome %in% c('Temperate coniferous forests'),1,0)
map[grep('Pinus',Dominant.Ectomycorrhizal.host),conifer := 1]

#rename some columns, subset to columns of interest.----
map$relEM <- map$Relative.basal.area.of.EcM.trees.....of.total.basal.area.of.all.AM.and.EcM.tees.taken.together.
map$SRR.id <- as.character(map$SRR.id)
rownames(map) <- map$SRR.id
map <- map[,.(tedersoo.code,SRR.id,Site,longitude,latitude,pH,Moisture,N,C,C_N,human.date,doy,epoch.date,NPP,forest,conifer,relEM,LogP,LogK,LogMg,LogCa)]
setnames(map,c('tedersoo.code','Moisture','N' ,'C' ,'C_N','LogP','LogK','LogMg','LogCa'),
             c('Mapping.ID'   ,'moisture','pN','pC','cn','P','K','Mg','Ca'))
map <- as.data.frame(map)

#get worldclim2 climate variables and aridity index.----
climate <- worldclim2_grab(latitude = map$latitude, longitude = map$longitude)
climate$aridity <- arid_extract(map$latitude, map$longitude)
map <- cbind(map, climate)

#Rarefy OTU table.----
otu <- otu[rowSums(otu) >= 1000,]
otu <- vegan::rrarefy(otu, 1000)

#subset map so that it does not include observations not in otu table.----
map <- map[map$SRR.id %in% rownames(otu),]
otu <- otu[rownames(otu) %in% map$SRR.id,]

#save output.----
saveRDS(map, map.output.path)
saveRDS(otu, otu.output.path)


REBOL [
	Title: "REBOL Quick and Dirty Speed Test"
	Author: "Carl Sassenrath"
	Name: 'speed-test
	Version: 1.3.0
	Purpose: "For comparing machines running REBOL"
]

print "Running..."

;-- Time console writes:
recycle
t1: now/precise
loop 100 [
	loop 72 [prin #"."]
	loop 72 [prin #"^(back)"]
]
print newline
t2: now/precise
d: difference t2 t1
sp: to-integer 100 * 72 * 72 / d/3 / 1024
print ["Console:  " d "-" sp "KC/S"]

;-- Time CPU loop:
recycle
t1: now/precise
loop 1'000'000 [tail? next "x"]
t2: now/precise
d: difference t2 t1
sp: to-integer 1.44 / d/3 * 600
print ["Processor:" d "-" sp "RHz (REBOL-Hertz)"]

;-- Time memory access:
mem: make binary! 500'000
recycle
t1: now/precise
repeat n 100 [
    c: either system/version > 2.100.0 [n][to-char n]
	change/dup mem c 500'000
]
t2: now/precise
d: difference t2 t1
sp: to-integer 100 * 500'000 / d/3 / 1024 / 1024
print ["Memory:   " d "-" sp "MB/S"]

;-- Time disk/filesystem speed:
write %junk.txt "" ; force security request before timer
buf: head insert/dup "" "test^/" 32000
recycle
t1: now/precise
either system/version > 2.100.0 [
	loop 100 [
		write %junk.txt buf
		read %junk.txt
	]
][
	loop 100 [
		write/binary %junk.txt buf
		read/binary %junk.txt
	]
]
delete %junk.txt
t2: now/precise
d: difference t2 t1
sp: to-integer (100 * 2 * length? buf) / d/3 / 1024 / 1024
print ["Disk/File:" d "-" sp "MB/S"]

halt