# /* !/usr/bin/Rscript */

#' ## Data munging
#' Pre-process and explore datasets in preparation for feature creation.
#'
#'

#'
survival

#'
Survival (0 = No; 1 = Yes)

#'
pclass

#'
Passenger Class (1 = 1st; 2 = 2nd; 3 = 3rd)

#'
name

#'
Name (Title-Firstnames-Surname)

#'
sex

#'
Sex (Male/Female)
#'
age

#'
Age (in years, float)
#'
sibsp

#'
Number of Siblings/Spouses aboard

#'
parch

#'
Number of Parents/Children aboard

#'
ticket

#'
Ticket Number (alphanumeric)

#'
fare

#'
Passenger Fare (in US$)

#'
cabin

#'
Cabin (alphanumeric)

#'
embarked

#'
Port of Embarkation (C=Cherbourg; Q=Queenstown; S=Southampton)

#'

#'
#' #### Family Relation Details
#' With respect to the family relation variables (i.e. *Sibsp* and
#' *Parch*) some relations were ignored. The following are the
#' definitions used for sibsp and parch (aboard Titanic):
#' - Sibling: Brother, Sister, Stepbrother, or Stepsister of Passenger
#' - Spouse: Husband or Wife of Passenger (Mistresses and Fiances
#'   ignored)
#' - Parent: Mother or Father of Passenger
#' - Child: Son, Daughter, Stepson, or Stepdaughter of Passenger
#'
#' Other family relatives excluded from this study include cousins,
#' nephews/nieces, aunts/uncles, and in-laws. Some children travelled
#' only with a nanny, therefore `parch=0` for them. As well, some
#' travelled with very close friends or neighbors in a village, however,
#' the definitions do not support such relations.

# /*
writeLines("\n-------------")
writeLines("Combining datasets, cleaning & imputing for exploration")
# */

#' ### Combine raw datasets
#' The data provided by Kaggle is pre-split into "Training" and "Test" sets,
#' the former possessing the "ground truth" (or real outcome), the latter
#' requiring prediction.
#'
#' In order to obtain the clearest possible picture of the date, as well as
#' clean, impute missing data, and create new features, it is necessary to
#' combine the two sets into one. The two sets will be re-created based on
#' record ID before the modelling phase of the analysis.
#'
#' First a `Survived` column is added to the "Test" set (since it was missing
#' and is required to match the columns in the "Training" set), and then the
#' two combined:
test$Survived <- NA
combi <- rbind(raw, test)

#' ### Inspection
#' First assert the viability of creating a predictor for the response
#' variable by examining the proportions of each level. Prevailing wisdom
#' holds that if any proportion < 15% (0.15) then it might be classifed
#' "rare", in which case it is much more difficult to model.
prop.table(table(combi$Survived))

#' Next use str to obtain a quick overview of the combined dataset dimensions
#' and features (auto-created onRead).
str(combi)

#' Looks like *Name* and *Cabin* should be of type `character`, not `factor`:
combi$Name <- as.character(combi$Name)
combi$Cabin <- as.character(combi$Cabin)

#' Determine missing values:
#' - is.na tests for any missing vals
#' - missmap in Amelia package visualizes this
sum(is.na(combi))

missmap(combi,
  main="Titanic Training Data - Missings Map",
  col=c("yellow", "black"),
  legend=FALSE
)

#' *Age*, *Cabin*, *Fare* and *Embarkation* have missing data points. Impute
#' *Embarkation* data using most common value. The others require the
#' creation of new synthetic features for optimal imputation.
summary(combi$Embarked)
combi$Embarked[which(combi$Embarked == "")] <- "S"

#' Before engineering new features, convert and re-level `numeric` classes to
#' factors, and rename *Survived* => *Fate* (as "Survived" is one of the
#' levels). This aids understanding of confusion matrices, visualizations,
#' and summary output.
combi$Class <- as.factor(combi$Pclass)
levels(combi$Class) <- c("Upper", "Middle", "Lower")
combi$Fate <- as.factor(combi$Survived)
levels(combi$Fate) <- c("Perished", "Survived")

# /*
writeLines("\n-------------")
writeLines("Munging DONE")
# */


#'
#' @importFrom R6 R6Class
#'
#'
RCTtoolbox <- R6::R6Class("RCTtoolbox",
  public = list(
    data = NULL,
    initialize = function(formula_yd = NULL,
                          formula_x = NULL,
                          yvec = NULL,
                          xvec = NULL,
                          dvec = NULL,
                          dvec_levels = NULL,
                          dvec_labels = NULL,
                          data = NULL) {
      private$formula.yd <- formula_yd
      private$formula.x <- formula_x
      private$yvec <- yvec
      private$xvec <- xvec
      private$dvec <- dvec
      private$dvec.levels <- dvec_levels
      private$dvec.labels <- dvec_labels
      self$data <- data
    },
    print = function(...) {
      cat("-- Activate Information ---------------------\n")
      cat("Create new toolbox (Class: RCTtoolbox)\n")
      cat("- Outcomes:", private$yvec, "\n")
      cat("- Treatment:", private$dvec, "\n")
      cat("  - Level:", private$dvec.levels)
      cat(" (Control arm:", private$dvec.levels[1], ")\n")
      cat("  - Label:", private$dvec.labels, "\n")
      cat("- Covariates: ", private$xvec, "\n")
      cat("-- Fields and Methods -----------------------\n")
      cat("- data: Store data\n")
      cat("- print(): Show this message\n")
      cat("- ttest(): Run t-test/permutation test\n")
      cat("- power(): Run power analysis\n")
      cat("- balance(): Run balance test\n")
      cat("- lm(): Estimate linear model\n")
      cat("- chi2test(): Run chi-square/fisher exact test\n")
    },
    ttest = function(...) {
      RCTtoolbox.ttest$new(
        private$formula.yd,
        self$data,
        private$dvec.levels,
        private$dvec.labels,
        ...
      )
    },
    power = function(...) {
      RCTtoolbox.power.analysis$new(
        private$dvec,
        self$data,
        private$dvec.levels,
        private$dvec.labels,
        ...
      )
    },
    balance = function(...) {
      RCTtoolbox.balance.test$new(
        private$xvec,
        private$dvec,
        self$data,
        private$dvec.levels,
        private$dvec.labels,
        ...
      )
    },
    lm = function(...) {
      RCTtoolbox.lm$new(
        private$formula.yd,
        private$formula.x,
        self$data,
        private$dvec,
        private$dvec.levels,
        private$dvec.labels,
        ...
      )
    },
    chi2test = function(...) {
      RCTtoolbox.chi2test$new(
        private$formula.yd,
        self$data,
        private$dvec.levels,
        private$dvec.labels,
        ...
      )
    }
  ),
  private = list(
    formula.yd = NULL,
    formula.x = NULL,
    yvec = NULL,
    xvec = NULL,
    dvec = NULL,
    dvec.levels = NULL,
    dvec.labels = NULL
  )
)

RCTtoolbox.ttest <- R6::R6Class("RCTtoolbox.ttest",
  public = list(
    result = NULL,
    initialize = function(baseline, data, levels, labels, ...) {
      self$result <- ttest_multi_mod_arm(
        baseline, data, levels, labels, ...
      )
    },
    print = function(...) {
      cat("-- Activate Information ----------------\n")
      cat("Run t-test (Class: RCTtoolbox.ttest)    \n")
      cat("-- Fields and Methods ------------------\n")
      cat("- result: Store estimated result\n")
      cat("- print(): Show this message\n")
      cat("- plot(): Visualization\n")
      cat("- summary(): Print result in console\n")
    },
    plot = function(...) rctplot(self, ...),
    summary = function(...) summary(self, ...)
  )
)

RCTtoolbox.power.analysis <- R6::R6Class("RCTtoolbox.power.analysis",
  public = list(
    result = NULL,
    initialize = function(treat, data, levels, labels, ...) {
      self$result <- power_calculation(
        treat, data, levels, labels, ...
      )
    },
    print = function(...) {
      cat("-- Activate Information ------------------------------\n")
      cat("Run Power Analysis (Class: RCTtoolbox.power.analysis) \n")
      cat("-- Fields and Methods --------------------------------\n")
      cat("- result: Store estimated result\n")
      cat("- print(): Show this message\n")
      cat("- summary(): Print result in console\n")
      cat("- table(): Create output table\n")
    },
    summary = function(...) summary(self, ...),
    table = function(...) rcttable(self, ...)
  )
)

RCTtoolbox.balance.test <- R6::R6Class("RCTtoolbox.balance.test",
  public = list(
    result = NULL,
    initialize = function(x, d, data, levels, labels, ...) {
      self$result <- balance_test_multi_var(
        x, d, data, levels, labels, ...
      )
    },
    print = function(...) {
      cat("-- Activate Information ------------------------------\n")
      cat("Run Balance Test (Class: RCTtoolbox.balance.test) \n")
      cat("-- Fields and Methods --------------------------------\n")
      cat("- result: Store estimated result\n")
      cat("- print(): Show this message\n")
      cat("- table(): Create output table\n")
    },
    table = function(...) rcttable(self, ...)
  )
)

RCTtoolbox.lm <- R6::R6Class("RCTtoolbox.lm",
  public = list(
    result = NULL,
    initialize = function(yd, x, data, dvec, levels, labels, ...) {
      self$result <- rct_lm(
        yd, x, data, levels, labels, ...
      )
      private$dvar <- dvec
    },
    print = function(...) {
      cat("-- Activate Information ------------------------------\n")
      cat("Estimate Linear Model (Class: RCTtoolbox.lm) \n")
      cat("-- Fields and Methods --------------------------------\n")
      cat("- result: Store estimated result\n")
      cat("- print(): Show this message\n")
      cat("- summary(): Print result in console\n")
      cat("- table(): Create output table\n")
    },
    summary = function(...) summary(self, ...),
    table = function(...) rcttable(self, private$dvar, ...)
  ),
  private = list(dvar = NULL)
)

RCTtoolbox.chi2test <- R6::R6Class("RCTtoolbox.chi2test",
  public = list(
    result = NULL,
    initialize = function(yd, data, levels, labels, ...) {
      self$result <- chi2test_multi_mod(
        yd, data, levels, labels, ...
      )
      private$labels <- labels
    },
    print = function(...) {
      cat("-- Activate Information ------------------------------\n")
      cat("Estimate Linear Model (Class: RCTtoolbox.chi2test) \n")
      cat("-- Fields and Methods --------------------------------\n")
      cat("- result: Store estimated result\n")
      cat("- print(): Show this message\n")
      cat("- table(): Create output table\n")
    },
    table = function(...) rcttable(self, private$labels, ...)
  ),
  private = list(labels = NULL)
)


Getshiftsperrotation<- function() {
  g<- seq(from = 50, to = 480, by = 12)
  h<- seq(from = 61, to = 481, by = 12)
  h[36]<- h[36]-1
  rotation<- c()
  localizations<- c()
  VP_Data<- getreachesformodel(variation_localization)

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

    localizations[i]<- mean(VP_Data$meanreaches[g[i]:h[i]], na.rm = TRUE)
    rotation[i]<- variation_reaches$distortion[g[i]]
  }

  return(variation_prop<- data.frame(rotation, localizations))
}

Getreachesperrotation<- function() {
  g<- seq(from = 50, to = 480, by = 12)
  h<- seq(from = 61, to = 481, by = 12)
  h[36]<- h[36]-1
  rotation<- c()
  stuff<- c()
  VR_Data<- getreachesformodel(variation_reaches)

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

    stuff[i]<- mean(VR_Data$meanreaches[g[i]:h[i]], na.rm = TRUE)
    rotation[i]<- variation_reaches$distortion[g[i]]
  }

  return(variation_reach<- data.frame(rotation, stuff))
}

plotvariation<- function (){
  vprop<- Getshiftsperrotation()
  vreac<- Getreachesperrotation()
  localizations<-vprop$localizations
  Variation_means<- cbind(vreac,localizations)

  g<- seq(from = 50, to = 480, by = 12)
  h<- seq(from = 61, to = 481, by = 12)
  h[36]<- h[36]-2

  z<-c(0,50)
  for (i in 1:36) {

    z<- c(z, g[i], h[i]+1)
  }

  sizes<- c(0,0)

  for (i in 1:36){

    sizes<- c(sizes,Variation_means$rotation[i],Variation_means$rotation[i])
    sizes[sizes == 360] <- NA
  }
  g<- seq(from = 50, to = 480, by = 12)
  g<- c(1,g,480)
  for (i in 1:length(sizes)){

    if (is.na(sizes[i])){
      sizes[i]<- 0
    }

  }
  plot(NULL, col = 'white', axes = F,cex.lab = 1.5,
       cex.main = 1.5,    xlab = "Trial",
       ylab = "Hand Location [°]", ylim = c(-30, 30), xlim = c(1,480))

  lines(x = z[1:25], y = sizes[1:25], type = 'l')
  lines(x = z[25:26], y = c(0,0), lty = 2)
  lines(x = z[26:33], y = sizes[26:33], type = 'l')
  lines(x = z[33:36], y = c(0,0,0,0), lty = 2)
  lines(x = z[36:51], y = sizes[36:51], type = 'l')
  lines(x = z[51:52], y = c(0,0), lty = 2)
  lines(x = z[52:61], y = sizes[52:61], type = 'l')
  lines(x = z[61:62], y = c(0,0), lty = 2)
  lines(x = z[62:71], y = sizes[62:71], type = 'l')
  lines(x = z[71:72], y = c(0,0), lty = 2)
  lines(x = z[73:74], y = sizes[73:74], type = 'l')

  legend(
    -5,
    30,
    legend = c(
      'Reaches',
      'Localizations'),
    col = c('blue', 'red'),
    lty = c(1),
    lwd = c(2),
    bty = 'n',
    cex = 1.2
  )
  axis(2, at = c(-30, -15, 0, 15, 30), cex.axis = 1.5,
       las = 2)
  axis(1, at = g, cex.axis = .75, las = 2)
  reachdata<- getreachesformodel(variation_reaches)
  lines(reachdata$meanreaches*-1, type = 'l', col = 'Blue')
  locdata<- getreachesformodel(variation_localization)
  lines(locdata$meanreaches, type = 'l', col = 'red')
  dataCIs <- trialCI(data = variation_localization)
  dataCIs <- dataCIs
  x <-  c(c(1:480), rev(c(1:480)))
  y <- c(dataCIs[, 1], rev(dataCIs[, 2]))
  polygon(x, y, col = rgb(1,0,0,.2), border = NA)

  dataCIs <- trialCI(data = variation_reaches)
  dataCIs <- dataCIs*-1
  x <-  c(c(1:480), rev(c(1:480)))
  y <- c(dataCIs[, 1], rev(dataCIs[, 2]))
  polygon(x, y, col = rgb(0,0,1,.2), border = NA)

}


a <- sum(x)/length(x)


remove(list=ls())
library(plyr)

#assign and display starting values and call parameter-estimation function
# encoding-factor ; encoding-exponent ; preptime

## three params:
startParms <- c(0.004, 0.004, 0.0130)
transvect <- c(1, 100, 10)
lower <- c(0.002, 0.003, 0.0110)
upper <- c(0.005, 0.005, 0.0135)

## two params:
#startParms <- c(0.003, 0.0125)
#transvect <- c(1, 10)
#lower <- c(0.001, 0.0100)
#upper <- c(0.006, 0.0135)

write.table(rbind(c(0,NA,startParms*transvect)), "output/estimation-r.txt", col.names=c("cycle", "score", "enc.fact", "enc.exp", "preptime"))

bestvalues <- list()
bestscore <- 1000
run <- 1
l <- 0
#################################
getpred <-function(parms) {
	l <<- l+1
	print(paste("Cycle: ",l))
	parms <- parms * transvect
	print(parms)
	parms1 <- parms
#	parms <- c(parms[1], 0.4, parms[2]) # insert non-estimated parameter
    result <- run.paramlist(parms)
	rscore <- ifelse(result!="NA", analyze(), NA)
	write.table(rbind(c(l,rscore,parms1)), "output/estimation-r.txt", append=T, col.names=FALSE)
	if(rscore<bestscore) {bestscore<<-rscore; bestvalues<<-parms}
    print(rscore)
    return(rscore)
   }

#parms <- startParms
run.paramlist <- function(parms) {
  parmstr <- paste(parms,collapse=" ")
  # send params to lisp
  cm <- paste("echo \"",parmstr,"\" > listener",sep="")
  system(cm)
  # wait for lisp to send result
  result <- system("cat listener", intern=T)
  if(result == "STOP") {run <<- 0; stop("Aborted from LISP side")}
  as.numeric(result)
}

analyze <- function() {
  source("1-analyze.R")
  source("2-f-statistics.R")
  load("data/fstat.RData")

  ## penalize range difference and variance
  scores <- as.vector(1*c(fstat1.rmsd,fstat2.rmsd) + 1*(1 - c(fstat1.cor,fstat2.cor)) + 0.01*fstat.rangediff)
  pscore <- mean(scores, na.rm=T) #+ var(scores, na.rm=T) + 0.1*fstat.zeros
#  print(pscore)
  return(pscore)
#  return(mean(c(fstat1.rmsd,fstat2.rmsd),na.rm=T))
}

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

#xout <- optim(startParms, getpred, gr=NULL, method="Nelder-Mead", control=list(maxit=100,trace=1)) #to be equivalent to fminsearch

#xout <- optim(startParms, getpred, gr=NULL, method="Nelder-Mead", control=list(maxit=100,trace=1,reltol=2e-3)) #to be equivalent to fminsearch

xout <- optim(startParms, getpred, gr=NULL, method="L-BFGS-B", lower=lower, upper=upper, control=list(maxit=300,trace=2,factr=1e3))

#xout <- optim(startParms, getpred, gr=NULL, method="SANN", lower=lower, upper=upper, control=list(maxit=100, trace=2, factr=1e3, reltol=0.01, abstol=0.1))

# send stop command to lisp
if(run==1) system("echo STOP > listener")

print(bestvalues)
print(bestscore)
write.table(rbind(c(0,bestscore,bestvalues)), "output/estimation-r.txt", append=T, col.names=FALSE)


add.alpha <- function(col, alpha=1){
  if(missing(col))
    stop("Please provide a vector of colours.")
  apply(sapply(col, col2rgb)/255, 2,
        function(x)
          rgb(x[1], x[2], x[3], alpha=alpha))
}

allMetric <- function(ls, legend = 1) {
  simreps = ncol(ls[[1]][[1]]$covout)

  cols <- c("darkgreen","red", "purple", "darkorange", "cyan", "darkgrey", "black")
  frac <- log(ls[[1]][[1]]$r * 150000, base = 2)
  xlim <- c(min(frac), max(frac))
  mets <- 4

  ### Power

  plot(1, type="n", xaxt = 'n', ylab = "Power", xlab = "Compounds Tested",
       ylim = c(0,1), xlim = xlim)
  ticks <- c(1, 2, log(10, base = 2), seq(6, 8, by = 2), log(1500, base = 2), log(15000, base = 2))
  axis(1, at = ticks, labels = 2^ticks)

  for(i in 1:mets) {
    covprobs <- apply(ls[[1]][[i]]$covout, MARGIN=1, mean)

    # col.i <- ifelse(j == 2 & i == 4, cols[i+1], cols[i])
    lines(frac, covprobs, type="l", col = cols[i], lty = 1, lwd = 1.25)
    se <- sqrt(covprobs*(1-covprobs)/simreps)
    ucl <- covprobs + 1.96 * se
    lcl <- covprobs - 1.96 * se
    polygon(c(frac, rev(frac)), c(ucl, rev(lcl)),
            col = add.alpha(cols[i], .25), border = NA)
  }

  if(legend){
    legend(x= 0.5, y = 1.05, legend= c("EmpProc", "CorrBinom", "JZ Ind", "McNemar"),
           col=cols[1:4], lty=rep(1, 5), cex=.75, bty = "n", lwd = 2)
  }
}


library(rstan)
library(data.table)
library(lubridate)
library(gdata)
library(dplyr)
library(tidyr)
library(EnvStats)
library(optparse)
library(stringr)
library(bayesplot)
library(matrixStats)
library(scales)
library(gridExtra)
library(ggpubr)
library(cowplot)
library(ggplot2)
library(abind)

source('nature/utils/process-covariates.r')

# Commandline options and parsing
parser <- OptionParser()
parser <- add_option(parser, c("-D", "--debug"), action="store_true",
                     help="Perform a debug run of the model")
parser <- add_option(parser, c("-F", "--full"), action="store_true",
                     help="Perform a full run of the model")
cmdoptions <- parse_args(parser, args = commandArgs(trailingOnly = TRUE), positional_arguments = TRUE)

# Default run parameters for the model
if(is.null(cmdoptions$options$debug)) {
  DEBUG = Sys.getenv("DEBUG") == "TRUE"
} else {
  DEBUG = cmdoptions$options$debug
}

# Sys.setenv(FULL = "TRUE")
if(is.null(cmdoptions$options$full)) {
  FULL = Sys.getenv("FULL") == "TRUE"
} else {
  FULL = cmdoptions$options$full
}

if(DEBUG && FULL) {
  stop("Setting both debug and full run modes at once is invalid")
}

if(length(cmdoptions$args) == 0) {
  StanModel = 'base-nature'
} else {
  StanModel = cmdoptions$args[1]
}

print(sprintf("Running %s",StanModel))
if(DEBUG) {
  print("Running in DEBUG mode")
} else if (FULL) {
  print("Running in FULL mode")
}

cat(sprintf("Running:\nStanModel = %s\nDebug: %s\n",
            StanModel,DEBUG))

# Read which countires to use
countries <- readRDS('nature/data/regions.rds')
# Read deaths data for regions
d <- readRDS('nature/data/COVID-19-up-to-date.rds')
# Read IFR and pop by country
ifr.by.country <- readRDS('nature/data/popt-ifr.rds')

# Read interventions
interventions <- readRDS('nature/data/interventions.rds')

forecast <- 0 # increase to get correct number of days to simulate
# Maximum number of days to simulate
N2 <- (max(d$DateRep) - min(d$DateRep) + 1 + forecast)[[1]]

processed_data <- process_covariates(countries = countries, interventions = interventions,
                                     d = d , ifr.by.country = ifr.by.country, N2 = N2)

stan_data = processed_data$stan_data
dates = processed_data$dates
deaths_by_country = processed_data$deaths_by_country
reported_cases = processed_data$reported_cases
options(mc.cores = parallel::detectCores())
rstan_options(auto_write = TRUE)
m = stan_model(paste0('nature/stan-models/',StanModel,'.stan'))

if(DEBUG) {
  fit = sampling(m,data=stan_data,iter=40,warmup=20,chains=2)
} else if (FULL) {
  fit = sampling(m,data=stan_data,iter=1800,warmup=1000,chains=5,thin=1,control = list(adapt_delta = 0.99, max_treedepth = 20))
} else {
  fit = sampling(m,data=stan_data,iter=600,warmup=300,chains=4,thin=1,control = list(adapt_delta = 0.95, max_treedepth = 10))
}

out = rstan::extract(fit)
prediction = out$prediction
estimated.deaths = out$E_deaths
estimated.deaths.cf = out$E_deaths0

JOBID = Sys.getenv("PBS_JOBID")
if(JOBID == "")
  JOBID = as.character(abs(round(rnorm(1) * 1000000)))
print(sprintf("Jobid = %s",JOBID))

countries <- countries$Regions
save(fit,prediction,dates,reported_cases,deaths_by_country,countries,estimated.deaths,estimated.deaths.cf,stan_data, file=paste0('nature/results/',StanModel,'-',JOBID,'-stanfit.Rdata'))

library(bayesplot)
filename <- paste0(StanModel,'-',JOBID)

print('Generating mu, rt plots')
mu = (as.matrix(out$mu))
colnames(mu) = countries
g = (mcmc_intervals(mu,prob = .9))
ggsave(sprintf("nature/figures/%s-mu.png",filename),g,width=4,height=6)
tmp = lapply(1:length(countries), function(i) (out$Rt_adj[,stan_data$N[i],i]))
Rt_adj = do.call(cbind,tmp)
colnames(Rt_adj) = countries
g = (mcmc_intervals(Rt_adj,prob = .9))
ggsave(sprintf("nature/figures/%s-final-rt.png",filename),g,width=4,height=6)

print("Generate 3-panel plots")
source('nature/utils/plot-3-panel.r')
make_three_panel_plot(filename)

print('Covars plots')
source('nature/utils/covariate-size-effects.r')
plot_covars(filename)

print('Making table')
source('nature/utils/make-table.r')
make_table(filename)


source("./Data/column_constants.r")

AddMissingColumns <- function(country_data) {
    missing_columns <- setdiff(COLUMNS, names(country_data))
    country_data[missing_columns] <- NA
    return(country_data)
}

GenerateDiffColumn <- function(infection_data, dimension_name, base_column_name) {
    col_names <- colnames(infection_data)

    total_name <- paste("total_", base_column_name, sep="")
    daily_name <- paste("daily_", base_column_name, sep="")

    if(total_name %in% col_names) {
        if(!(daily_name %in% col_names)) {
            infection_data[[daily_name]] <- ave(infection_data[[total_name]], infection_data[[dimension_name]], FUN = function(x) c(NA, diff(x)))
        }
    }

    return(infection_data)
}


#' Function to detect year transitions and calculate cumulative age
#' of model results
#'
#' Takes the result of iterative growth modeling and
#' transforms data from Julian Day (0 - 365) to cumulative
#' day of the shell age by detecting where transitions
#' from one year to the next occur and adding full years
#' (365 days) to simulations in later years.
#' @param resultarray Array containing the full results of
#' the optimized growth model
#' @param threshold Artificial threshold value used to recognize
#' peaks in occurrences of year transitions (default = 5)
#' @param plotyearmarkers Should the location of identified year
#' transitions be plotted? \code{TRUE/FALSE}
#' @return A new version of the resultarray with Julian Day model
#' estimates replaced by estimates of cumulative age of the record
#' in days.
#' @references package dependencies: zoo 1.8.7
#' @importFrom graphics plot
#' @examples
#' testarray <- array(NA, dim = c(20, 16, 9)) # Create empty array
#' # with correct third dimension
#' windowfill <- seq(50, 500, 50) # Create dummy simulation data
#' # (ages) to copy through the array
#' for(i in 6:length(testarray[1, , 1])){
#'     testarray[, i, 3] <- c(windowfill, rep(NA, length(testarray[, 1, 3]) -
#'         length(windowfill)))
#'     windowfill <- c(NA, (windowfill + 51) %% 365)
#' }
#' testarray[, 1, 3] <- seq(1, length(testarray[, 1, 3]), 1) # Add
#' # dummy /code{D} column.
#' testarray2 <- cumdy(testarray, 3, FALSE) # Apply function on array
#' @export
cumdy <- function(resultarray, # Align Day of year results from modeling in different windows to a common time axis
    threshold = 5, # Threshold for separating peaks in year changes for marking the transitions between years
    plotyearmarkers = TRUE
    ){

    dat <- resultarray[, 1:5, 3]
    Yearends <- rbind(rep(NA, length(resultarray[1, -(1:length(dat[1, ])), 3])), diff(resultarray[, -(1:length(dat[1, ])), 3]) < 0) # Matrix of positions in individual windows where end of year (day 365) is recorded
    Tyearmarkers <- cbind(c(0, dat[-nrow(dat), 1]) + c(0, diff(dat[, 1])), rowSums(Yearends, na.rm = TRUE)) # Aggregate of end of year (Day = 365) positions across windows against depth of record
    Tyearmarkers <- cbind(Tyearmarkers, c(rep(0, floor(threshold / 2)), zoo::rollmean(Tyearmarkers[, 2], threshold, align = "center"), rep(0, threshold - floor(threshold / 2) - 1))) # Add moving average of threshold value, pad with zeroes to match column length
    if(!all(Tyearmarkers[, 3] < (3 / threshold))){Tyearmarkers[which(Tyearmarkers[, 3] < (3 / threshold)), 3] <- 0} # Remove small numbers consisting of averages of 1 or 2 yearends in windows except in cases with very low resolution

    pks <- which(diff(sign(diff(Tyearmarkers[, 3], na.pad = FALSE)), na.pad = FALSE) < 0) + 2 # Find peaks in the number of yearmarkers by taking the second derivative
    Tyearmarkers <- cbind(Tyearmarkers, rep(0, length(Tyearmarkers[, 3]))) # Add column to store yearmarkers based on age modeling
    for(i in 1:(length(which(diff(pks) > threshold)) + 1)){ # Loop through the instances where peaks are far enough apart to be taken as separate (as judged through the threshold)
        Tyearmarkers[mean(pks[(c(0, which(diff(pks) > threshold), length(pks))[i] + 1) : c(0, which(diff(pks) > threshold), length(pks))[i + 1]]), 4] <- 1 # Combine peaks that cluster together and add markers to the mean positions where windows record the end of the year
    }
    Tyearends <- cbind(seq(1, sum(Tyearmarkers[, 4]), 1), Tyearmarkers[which(Tyearmarkers[, 4] == 1), 1]) # Find numbers and positions of mean yearmarkers in record based on age modeling

    if(plotyearmarkers == TRUE){
        dev.new()
        plot(Tyearmarkers[, c(1, 3)], type = "l") # Plot aggregate of yearmarkers
        points(Tyearmarkers[which(Tyearmarkers[, 4] == 1), c(1, 3)], col = "red") # Plot location of yearmarkers
    }

    Yearends[which(Yearends == TRUE)] <- apply(abs(outer(Tyearends[, 2], Tyearmarkers[which(Yearends == TRUE) %% nrow(Yearends), 1], "-")), 2, which.min)  # Find distance values for year ends in all windows and replace the positions of the year ends with the number of years along the records based on the nearest peak in yearends found earlier

    for(col in 1:ncol(Yearends)){ # Loop through columns and create matrix of the cumulative year in which the datapoints of all models are set.
        Yearends[min(which(!is.na(Yearends[, col]))) - 1, col] <- 0 # Replace the last NA before the modeled values start with a zero to compensate for the missing first value due to diff() function above (first line of function)
        if(length(Yearends[which(Yearends[, col] > 0), col]) > 0){ # Check if there are year ends in the column
            X <- Yearends[which(Yearends[, col] > 0), col] # Find values associated with the year ends
            row <- which(Yearends[, col] %in% X) # Find rows in which these year end values are contained
            row0 <- which(Yearends[, col] == 0) # Find rownumbers of zeroes in column
            if(length(row) > 1){ # Check if multiple year ends are present on the column
                rowcomp <- outer(row0, row, "-") # Match rownumbers of all zeroes in the column with the rownumbers of all year end values
                rowcomp[rowcomp < 0] <- NA # Remove all instances where zeroes precede year ends
                Yearends[row0, col] <- as.numeric(apply(rowcomp, 1, which.min)) # Replace zeroes with closest year end directly above
                Yearends[row0[which(is.na(Yearends[row0, col]))], col] <- X[1] - 1 # Replace all zeroes above the year end with the number of the previous year (year end - 1)
            }else{ # Alternatively, if there is only one year end:
                Yearends[row0[which(row0 > row)], col] <- Yearends[row, col] # Replace all zeroes below the year end with the number belonging to the year end
                Yearends[row0[which(row0 < row)], col] <- Yearends[row, col] - 1 # Replace all zeroes above the year end with the number of the previous year (year end - 1)
            }
        }else if(col > 1){
            Yearends[which(!is.na(Yearends[, col])), col] <- rep(as.numeric(names(sort(table(Yearends[, (col - 1)]), decreasing = TRUE)[1])), length(which(!is.na(Yearends[, col])))) # If no yearends are present, replace all zeroes with the most common year in the previous column
        }
    }

    result <- resultarray[, , 3] + cbind(matrix(0, ncol = length(dat[1, ]), nrow = length(Yearends[,1])), Yearends) * 365 # Create matrix of cumulative days in model centered on position of highest summer value (default t_maxtemp = day 182.5) and based on length of day (default T_per = G_per = 365)
    return(result)
}


#install.packages("bio3d")
#downloading the file with protein ids  in the Home folder
#f=download.file("ftp://ftp.wwpdb.org/pub/pdb/derived_data/index/compound.idx",destfile="idx_file.idx");

#-------------------------------import libraries---------------------------

library("bio3d");

#------------------read from idx file with ids and move data into matrix-----------------------
fileName <- 'idx_file.idx'
fff= readChar(fileName, file.info(fileName)$size);
fff=strsplit(fff, "\n");
l=length(fff[[1]]);
ccc=fff[[1]][5:l];
remove(l);
fff=ccc;
remove(ccc);
fff=strsplit(fff, "\t");
output <- matrix(unlist(fff), ncol = 2, byrow = TRUE);
remove(fff);
remove(fileName);
#remove(f);

#============================ask from user the Query========1N21========5L5V=====2QPS====1U98====1U99=====5NQ3

#Q=readline(prompt = "Give the pdb_id of the query \n");

#-----------------------download from database or load if there is already downloaded----------------
query_id = Q;
Q=read.pdb(Q, maxlines = -1, multi = FALSE, rm.insert = FALSE,rm.alt = TRUE, ATOM.only = FALSE, hex = FALSE, verbose = TRUE);

#***********************************start of algorithm**************************

#=======================computation of Query=======================================
#--------------------we need only Calpha coordinates-----------------------------------------

t = length((which(Q$calpha==TRUE))*3);
cord = rep(NaN,t);
counter=1;

for (i in 1:length(Q$calpha)) {
  if(Q$calpha[i]==TRUE){
    cord[counter]   = Q$xyz[[(i-1)*3+1]];
    cord[counter+1] = Q$xyz[[(i-1)*3+2]];
    cord[counter+2] = Q$xyz[[(i-1)*3+3]];
    counter=counter+3;
  }
}

coordinates_Q = c(xyz=c("xyz"),size=0,name=query_id);
coordinates_Q$xyz = cord;
coordinates_Q$size = length((which(Q$calpha==TRUE)))*3;

#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-finding centroids G_right, G_left-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

half_v = length(coordinates_Q$xyz)-(length(coordinates_Q$xyz))%%2;
half_v = (half_v - half_v%%3)/2;

sumx = 0;
sumy = 0;
sumz = 0;
i=1;
while(i<half_v) {
  sumx = sumx + coordinates_Q$xyz[i];
  sumy = sumy + coordinates_Q$xyz[i+1];
  sumz = sumz + coordinates_Q$xyz[i+2];
  i=i+3;
}
G_right = c(sumx,sumy,sumz) /half_v;

sumx = 0;
sumy = 0;
sumz = 0;
i=half_v+1;
while(i<length(coordinates_Q$xyz)) {
  sumx = sumx + coordinates_Q$xyz[i];
  sumy = sumy + coordinates_Q$xyz[i+1];
  sumz = sumz + coordinates_Q$xyz[i+2];
  i=i+3;
}
G_left = c(sumx,sumy,sumz) /(length(coordinates_Q$xyz)-half_v);

#----------------------compute F for even or odd n------------------------
if((length(coordinates_Q$xyz)/3)%%2==0 ){
  F1 = sqrt((G_right[1]-G_left[1])^2+ (G_right[2]-G_left[2])^2+(G_right[3]-G_left[3])^2 )/1;
}else{
  F1 = (sqrt(   (((coordinates_Q$size/3)/2)-1)/((coordinates_Q$size/3)/2)  ))*(sqrt((G_right[1]-G_left[1])^2+ (G_right[2]-G_left[2])^2+(G_right[3]-G_left[3])^2 )/2);
}

#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-finding centroids G_right, G_left-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

#=============================read ids from matrix, download pdb files==========

#==============iteration over packets===============================

counter_iter=1;
counter1=1;
packet=100;
total_time=0;
iter=length(output)-(length(output)%%packet);
number_of_proteins =0;
number_of_substructures=0;
rmsd_var = list(value=-1,name="NaN",start=-1);
while(counter1<=(iter+1)){

  ids = unlist(output[((counter1-1)*100+1):(counter1*packet),1], recursive = TRUE, use.names = TRUE);
  ids = as.character(ids);

  #-------------create a list of pdb files----------------------------
  pdb_list=NULL;
  coordinates_P=NULL;
  pdb_length <- rep(0,length(ids));
  pdb_file=1;

  coordinates_P = c(xyz=c("NaN"),size=0);
  cord = rep(NaN,1);
  #cord = c(xyz=NaN,calpha=-1);
  coordinates_P$xyz = cord;
  coordinates_P$name = "NaN";

  #--------------store coordinates of Calpha and length of each molecule---------------
  for (i in 1:(length(ids))) {
    pdb_file=try(read.pdb(ids[i],maxlines=-1,multi=FALSE,rm.insert=FALSE,rm.alt=TRUE,ATOM.only=FALSE,hex=FALSE,verbose=TRUE));

    if(typeof(pdb_file)!="character"){
      Calpha = which(pdb_file$calpha==TRUE);
      t = length((which(pdb_file$calpha==TRUE)))*3;
      cord = rep(NaN,1);
      counter=1;
      tr=length(which(Q$calpha==TRUE))*3;
      #------------if there is Calpha or protein is greater than the query--------------
      if( t >=tr){
        for (j in 1:(length(pdb_file$calpha))) {
          if(pdb_file$calpha[j]==TRUE){
            cord[counter]   = pdb_file$xyz[[(j-1)*3+1]];
            cord[counter+1] = pdb_file$xyz[[(j-1)*3+2]];
            cord[counter+2] = pdb_file$xyz[[(j-1)*3+3]];
            counter=counter+3;
          }
        }
        coordinates_P$xyz = c(coordinates_P$xyz,cord);
        coordinates_P$size = c(coordinates_P$size,length(cord));
        coordinates_P$name = c(coordinates_P$name,ids[i])
      }else{
        #-remove from list------
        ids = ids[(which(ids!=ids[i]))];
      }
    }else{
      #----------------if pdb doesn't exist remove from list----------------------
      print(ids[i]); print("doesn't exist or cannot be read properly due to C++ error remove from list");
      #ids = ids[(which(ids!=ids[i]))];
    }
  }#--------------------end of for--------------

  coordinates_P$size = coordinates_P$size[which(coordinates_P$size!="NaN")];
  coordinates_P$xyz = coordinates_P$xyz[which(coordinates_P$xyz!="NaN")];
  coordinates_P$name = coordinates_P$name[which(coordinates_P$name!="NaN")];

  #---------------remove false data------------------------------
  if(length((which(coordinates_P$size!=0)))){
    ids = ids[(which(coordinates_P$size!=0))];
    coordinates_P$size = coordinates_P$size[(which(coordinates_P$size!=0))];

  }

  coordinates_P$size = strtoi(coordinates_P$size);

  b = -1;

  D_values = -1;
  #si = sum(coordinates_P$size)/3+length(coordinates_P$size) - length(coordinates_P$size)*coordinates_Q$size/3;
  F2 = list(value=rep(0, 2),name=coordinates_P$name,pos=1:2,pos_in_protein=1:2);

  #=======================calculating from 100 substructures of P=======================================
  number_of_proteins = number_of_proteins+length(coordinates_P$size);
  number_of_substructures = number_of_substructures/3 + sum(coordinates_P$size)/3-sum(coordinates_Q$size)/3+length(coordinates_P$size)/3;
  start_time <- Sys.time();
  counter3=1;
  counter4=0;
  si=0;
  for (i in 1:(length(coordinates_P$size))) {
    start=TRUE;
    j=1;

    while(j<=(coordinates_P$size[i]-(length(coordinates_Q$xyz))+1)) {

      if(start==TRUE){

        #finding centroids G_right, G_left

        half_v = length(coordinates_Q$xyz)-(length(coordinates_Q$xyz))%%2;
        half_v = (half_v - half_v%%3)/2;

        sumx = 0;
        sumy = 0;
        sumz = 0;
        e=1;
        while(e<=half_v) {
          sumx = sumx + coordinates_P$xyz[e+(counter4+j)-1];
          sumy = sumy + coordinates_P$xyz[e+(counter4+j)+1-1];
          sumz = sumz + coordinates_P$xyz[e+(counter4+j)+2-1];
          e=e+3;
        }
        G_right = c(sumx,sumy,sumz) /half_v;

        sumx = 0;
        sumy = 0;
        sumz = 0;
        e=half_v+1;
        while(e<=length(coordinates_Q$xyz)) {
          sumx = sumx + coordinates_P$xyz[e+(counter4+j)-1];
          sumy = sumy + coordinates_P$xyz[e+(counter4+j)+1-1];
          sumz = sumz + coordinates_P$xyz[e+(counter4+j)+2-1];
          e=e+3;
        }
        G_left = c(sumx,sumy,sumz) /(length(coordinates_Q$xyz)-half_v);

        start=FALSE;
      }else{
        #finding centroids G_right, G_left

        tt= length(coordinates_Q$xyz) - (length(coordinates_Q$xyz))%%2;
        tt = tt/2;
        G_left = G_left - (1/tt)*( c(coordinates_P$xyz[(counter4+j)],coordinates_P$xyz[(counter4+j)+1],coordinates_P$xyz[(counter4+j)+2])  );
        G_right = G_right - (1/tt)*(c(coordinates_P$xyz[tt+(counter4+j)],coordinates_P$xyz[tt+(counter4+j)+1],coordinates_P$xyz[tt+(counter4+j)+2]));
      }

      #----------------------compute F for even or odd n---------------------------------
      if((length(Q$xyz)/3)%%2==0 ){
        F2$value[si+(j-1)/3 +1] = sqrt((G_right[1]-G_left[1])^2+ (G_right[2]-G_left[2])^2+(G_right[3]-G_left[3])^2 )/2;
      }else{
        F2$value[si+(j-1)/3 +1] = (sqrt(   ((coordinates_Q$size/3)/2-1)/((coordinates_Q$size/3)/2)  ))*(sqrt((G_right[1]-G_left[1])^2+ (G_right[2]-G_left[2])^2+(G_right[3]-G_left[3])^2 )/2);
      }
      F2$pos_in_protein[si+(j-1)/3 +1] = sum(coordinates_P$size[1:i])-coordinates_P$size[i] +j;
      F2$pos[si+(j-1)/3 +1] = si+(j-1)/3+1;
      F2$name[si+(j-1)/3 +1] = coordinates_P$name[i];

      #----------------------compute D---------------------------
      D = abs(F1 - F2$value[si+(j-1)/3 +1]);

      if((1/(2*sqrt(2))*D)<1){
        r =rmsd(coordinates_Q$xyz,coordinates_P$xyz[(counter4+j):(length(coordinates_Q$xyz)+(counter4+j) -1)]);
        if(r<1){
          #rmsd_var = c(rmsd_var$value,r);
          #rmsd_var$value = c(rmsd_var$value,r);
          #rmsd_var$name = c(rmsd_var$name,coordinates_P$name[i]);
          #rmsd_var$start = c(rmsd_var$start,j);

        }
      }

      counter_iter = counter_iter +1;
      counter3=counter3+1;
      j=j+3;

    }#end of whilej
    si = si+sum(coordinates_P$size[i])/3-sum(coordinates_Q$size)/3+1;
    counter4=counter4+coordinates_P$size[i];

  }#end of fori

  if(iter!=counter1){
    counter1 = counter1 +1;
  }else{
    packet = length(output)%%packet;
  }

}#-----------end of while iter----------

F2 = list(value=F2$value,name=F2$name,pos=F2$pos,pos_in_protein=F2$pos_in_protein);

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@------------pre-processing---------------@@@@
N=sum(coordinates_P$size)/3;
m =coordinates_Q$size/3;

#sorting
for (l in 1:(length(F2$value)-1)) {
  for (k in 2:(length(F2$value))) {
    if (F2$value[k-1] > F2$value[k]){
      v=F2$value[k-1];
      F2$value[k-1] = F2$value[k];
      F2$value[k] = v;
      v=F2$name[k-1];
      F2$name[k-1] = F2$name[k];
      F2$name[k] = v;
      v=F2$pos_in_protein[k-1];
      F2$pos_in_protein[k-1] = F2$pos_in_protein[k];
      F2$pos_in_protein[k] = v;
      v=F2$pos[k-1];
      F2$pos[k-1] = F2$pos[k];
      F2$pos[k] = v;
    }
  }
}

#which(F2$value==F2$value[(which(F2$name=="1N21"))])

#binary_search
left=1;
right=length(F2$value);
const=(1/(2*sqrt(2)));
m = (left+right-(left+right)%%2)/2
flag=TRUE;
while((left<=right)&&(flag==TRUE)){
  m = (left+right-(left+right)%%2)/2

  if(abs(F1-F2$value[right])<abs(F1-F2$value[m])){

    if( const<(1/(2*sqrt(2)))){
      #const=abs(F1-F2$value[m]);
      r =rmsd(coordinates_Q$xyz,(coordinates_P$xyz[F2$pos_in_protein[left]:coordinates_P$xyz[F2$pos_in_protein[left+coordinates_Q$size-1]]]));
      if(r<1){
        flag=FALSE;
        #rmsd_var = c(rmsd_var$value,r);
        #rmsd_var$value = c(rmsd_var$value,r);
        #rmsd_var$name = c(rmsd_var$name,coordinates_P$name[m]);
        const=0;
      }else{

        left = left+ 1;
        right = right-1;
      }
    }else{

        right = right+ 1;

      }

    left = m+ 1;
  }else{

    if(abs(F1-F2$value[left])<abs(F1-F2$value[m])){
      print(const);

      if( const<(1/(2*sqrt(2)))){  print(const);
        #const=abs(F1-F2$value[m]);
        r =rmsd(coordinates_Q$xyz,(coordinates_P$xyz[F2$pos_in_protein[right]:coordinates_P$xyz[F2$pos_in_protein[right+coordinates_Q$size-1]]]));
        if(r<1){
          flag=FALSE;
          #rmsd_var = c(rmsd_var$value,r);
          #rmsd_var$value = c(rmsd_var$value,r);
          #rmsd_var$name = c(rmsd_var$name,coordinates_P$name[m]);
          const=0;
        }else{

          left = left+ 1;
          right = right-1;
        }
      }else{

        left = left+ 1;

      }

      right = m- 1;
    }else{

        if( abs(F1-F2$value[m])<(1/(2*sqrt(2)))){
          #const=abs(F1-F2$value[m]);
          r =rmsd(coordinates_Q$xyz,(coordinates_P$xyz[F2$pos_in_protein[m]:coordinates_P$xyz[F2$pos_in_protein[m+coordinates_Q$size]-1]]));
          if(r<1){
            flag=FALSE;
            #rmsd_var = c(rmsd_var$value,r);
            #rmsd_var$value = c(rmsd_var$value,r);
            #rmsd_var$name = c(rmsd_var$name,coordinates_P$name[m]);
            const=0;
          }else{
            print(left)
            left=left+1;
            print(left)
            right = right-1;
          }
        }else{

          left = left+1;
          right = right-1;
        }
    }
  }

}

u=m;
while(abs(F1-F2$value[u])<=const){
u=u-1;
}
left=u;
u=m;
while(abs(F1-F2$value[u])<=const){
  u=u+1;
}
right=u;
u=right;

start_time <- Sys.time();
for (i in left:u){

  r =rmsd(coordinates_Q$xyz,coordinates_P$xyz[(F2$pos_in_protein[i]):(coordinates_Q$size+F2$pos_in_protein[i] -1)]);
  if(r<1){
    #rmsd_var = c(rmsd_var$value,r);
    rmsd_var$value = c(rmsd_var$value,r);
    rmsd_var$name = c(rmsd_var$name,F2$name[i]);
    rmsd_var$start = NULL;
    end_time <- Sys.time();

  }
}
time_is=end_time-start_time;

total_time = total_time+time_is;
#which(F2$name[left:right]=="1N21")
b = -1;
D_values = -1;
#=======================calculating from 100 substructures of P=======================================
number_of_proteins = number_of_proteins+length(coordinates_P$size);
number_of_substructures = number_of_substructures + sum(coordinates_P$size)/3-sum(coordinates_Q$size)/3+length(coordinates_P$size);

counter3=1;
counter4=0;

#------------after algorithm processing-----------------

#-----remove initialized values NaN-------------
rmsd_var[[1]] = rmsd_var[[1]][2:length(rmsd_var[[1]])];
rmsd_var[[2]] = rmsd_var[[2]][2:length(rmsd_var[[2]])];
rmsd_var[[3]] = rmsd_var[[3]][2:length(rmsd_var[[3]])];

b=b[2:length(b)];

#--------------------use plot3D---library---------------
library("plot3D");

pdf('results_3.pdf')
i=1;
x = rep(NaN,(coordinates_Q$size/3));
y = rep(NaN,(coordinates_Q$size/3));
z = rep(NaN,(coordinates_Q$size/3));
while(i<coordinates_Q$size) {
  x[((i-1))/3+1]=coordinates_Q$xyz[i];
  y[((i-1))/3+1]=coordinates_Q$xyz[i+1];
  z[((i-1))/3+1]=coordinates_Q$xyz[i+2];
  i=i+3;
}

scatter3D(x,y,z,type="l",main=coordinates_Q$name,pch=20)
points3D(x,y,z,type="b",main=coordinates_Q$name, pch=20)
points3D(x,y,z,type="p",main=coordinates_Q$name,pch=19)
points3D(x,y,z,type="l",main=coordinates_Q$name,pch=20)

scatter3D(x,y,z,type="b",main="0 degrees",theta = 0,pch=20)
scatter3D(x,y,z,type="b",main="60 degrees",theta = 60,pch=20)
scatter3D(x,y,z,type="b",main="180 degrees",theta = 120,pch=20)
scatter3D(x,y,z,type="b",main="180 degrees",theta = 180,pch=20)
scatter3D(x,y,z,type="b",main="240 degrees",theta = 240,pch=20)
scatter3D(x,y,z,type="b",main="300 degrees",theta = 300,pch=20)

scatter3D(x,y,z,type="l",main="0 degrees",theta = 0,pch=20)
scatter3D(x,y,z,type="l",main="60 degrees",theta = 60,pch=20)
scatter3D(x,y,z,type="l",main="180 degrees",theta = 120,pch=20)
scatter3D(x,y,z,type="l",main="180 degrees",theta = 180,pch=20)
scatter3D(x,y,z,type="l",main="240 degrees",theta = 240,pch=20)
scatter3D(x,y,z,type="l",main="300 degrees",theta = 300,pch=20)

i=1;
links=NULL;
while(i<=length(rmsd_var$name)) {

  links=c(links,paste("https://files.rcsb.org/download/",rmsd_var$name[i],sep=""));
  i=i+1;
}
barplot(rmsd_var$value,names.arg =rmsd_var$name,col="dark blue",ylab = "rmsd",y=c(0,max(rmsd_var$value)+1))
barplot(rmsd_var$value,names.arg =links,col="dark blue",ylab = "rmsd",y=c(0,max(rmsd_var$value)+1))
dev.off();

#-------------------end-------------------------


# Author: Jason Albino

## This code describes how the different plots were created

## Bar Chart for create

gr_Create <- aggCreate[ , 1:2]
> colnames(gr_Create) <- c("Rank", "Average")
> gr_Create <- gr_Create[order(gr_Create$Average), ]
> gr_Create$Rank <- factor(gr_Create$Rank, levels = gr_Create$Rank)
> ggplot(gr_Create, aes(x=Rank, y=Average))+ geom_bar(stat = "identity", width = .5, fill = "tomato3")+
labs(title = "Ordered Bar Chart", subtitle = "Rank Vs Average Reports Created", caption = "source: DND")+
theme(axis.text.x = element_text(angle = 65, vjust = 0.6))

## Bar Chart for view

> view <- c(1,3)
> gr_View <- aggCreate[, view]
> colnames(gr_View) <- c("Rank", "Average")
> gr_View <- gr_View[order(gr_View$Average), ]
> gr_View$Rank <- factor(gr_View$Rank, levels = gr_View$Rank)
> ggplot(gr_View, aes(x=Rank, y=Average))+ geom_bar(stat = "identity", width = .5, fill = "tomato3")+
labs(title = "Ordered Bar Chart", subtitle = "Rank Vs Average Reports Viewed", caption = "source: DND")+
theme(axis.text.x = element_text(angle = 65, vjust = 0.6))

## Bar Chart for recency of views, by rank

> gr_Recent <- aggRecent2[ , view]

> gr_Recent
   Group.1  daysSince
1      2LT 200.16667
2     CAPT 157.33333
3      CDR 248.16667
4      CIV 148.94131
5      CPL  60.16667
6     LCDR  90.16667
7     LCOL 184.36667
8    LT(N)  97.16667
9      MAJ 110.71212
10    MCPL 115.50000
11     MWO 150.83333
12      WO  61.16667
> colnames(gr_Recent) <- c("Rank", "Days")
> gr_Recent <- gr_Recent[order(gr_Recent$Days),]
> gr_Recent$Rank <- factor(gr_Recent$Rank, levels = gr_Recent$Rank)
> ggplot(gr_Recent, aes(x=Rank, y=Days))+ geom_bar(stat = "identity", width = .5, fill = "tomato3")+
labs(title = "Ordered Bar Chart", subtitle = "Rank Vs Average Days Since Last Used", caption = "source: DND")+
theme(axis.text.x = element_text(angle = 65, vjust = 0.6))

> gr_Recent$Days <- as.numeric(gr_Recent$Days)
> ggplot(gr_Recent, aes(x=Rank, y=Days))+ geom_bar(stat = "identity", width = .5, fill = "tomato3")+
labs(title = "Ordered Bar Chart", subtitle = "Rank Vs Average Days Since Last Used", caption = "source: DND")+
theme(axis.text.x = element_text(angle = 65, vjust = 0.6))

## Bar Chart for create, by L1

gr_CreateL1 <- aggCreateL1[ , 1:2]
> colnames(gr_CreateL1) <- c("L1", "Average")
> gr_CreateL1 <- gr_CreateL1[order(gr_CreateL1$Average), ]
> gr_CreateL1$L1 <- factor(gr_CreateL1$L1, levels = gr_CreateL1$L1)
> ggplot(gr_CreateL1, aes(x=L1, y=Average))+ geom_bar(stat = "identity", width = .5, fill = "tomato3")+
labs(title = "Ordered Bar Chart", subtitle = "L1 Vs Average Reports Created", caption = "source: DND")+
theme(axis.text.x = element_text(angle = 65, vjust = 0.6))

## Bar Chart for view, by L1

> view <- c(1,3)
> gr_ViewL1 <- aggCreateL1[, view]
> colnames(gr_ViewL1) <- c("L1", "Average")
> gr_ViewL1 <- gr_ViewL1[order(gr_ViewL1$Average), ]
> gr_ViewL1$L1 <- factor(gr_ViewL1$L1, levels = gr_ViewL1$L1)
> ggplot(gr_ViewL1, aes(x=L1, y=Average))+ geom_bar(stat = "identity", width = .5, fill = "tomato3")+
labs(title = "Ordered Bar Chart", subtitle = "L1 Vs Average Reports Viewed", caption = "source: DND")+
theme(axis.text.x = element_text(angle = 65, vjust = 0.6))

## Bar Chart for recency of views, by L1

gr_Recent2L1 <- aggRecent2L1[ , view]
> colnames(gr_Recent2L1) <- c("L1", "Days")
> gr_Recent2L1 <- gr_Recent2L1[order(gr_Recent2L1$Days),]
> gr_Recent2L1$L1 <- factor(gr_Recent2L1$L1, levels = gr_Recent2L1$L1)
> ggplot(gr_Recent2L1, aes(x=L1, y=Days))+ geom_bar(stat = "identity", width = .5, fill = "tomato3")+
labs(title = "Ordered Bar Chart", subtitle = "L1 Vs Average Days Since Last Used", caption = "source: DND")+
theme(axis.text.x = element_text(angle = 65, vjust = 0.6))


# Initialize the speed variable
speed<-64

# Code the while loop
while(speed>=30 ) {
  print(paste("Slow down!",speed))
  speed<-speed-7
}

# Print out the speed variable
speed


source('./r_files/flatten_HTML.r')

############### Library Declarations ###############
libraryRequireInstall("ggplot2");
libraryRequireInstall("plotly");
libraryRequireInstall("dplyr");
libraryRequireInstall("reshape2");
####################################################

################### Actual code ####################

# Reformatting the data so it can be used as a plotly surface plot
data_z <- acast(Values, Frequency~Timestamp, value.var='Magnitude')

# Plotting the surface plot
g <- plot_ly(z = data_z, type='surface') %>%
	  layout(
		scene = list(
		  xaxis = list(title = "Timestamp"),
		  yaxis = list(title = "Frequency"),
		  zaxis = list(title = "Magnitude")
		))

############# Create and save widget ###############
internalSaveWidget(g, 'out.html');
####################################################


rm(list = ls())
gc()
library(tidyverse)
library(readxl)
library(ggthemes)
library(ggfortify)
#library(plotly)
library(knitr)
library(factoextra)
library(cluster)
library(viridis)
library(treemapify)
library(jsonlite)
library(scales)
library(LaplacesDemon)
library(RColorBrewer)
library(gganimate)

data <- read_rds("data/data_cadena.rds")
#renombro las variables
data <- data %>%
  rename(reporter = Reporter, partner = Partner, year = Year, flow = TradeFlowName, value = Valor.en.1000.USD)

agregados <- c("Mercosur", "Sudamerica","RDM_Mercosur", "World")
data_filt <- data %>%
  filter(!partner %in% agregados)

##### Videos treemaps por cadena y subcadena y uso, expo e impo #######
grow_treemap_cadsubcad_gif <- function(data = data_filt, reportante = "Argentina"){

  cadenas <- unique(data$Cadena)
  #Tomo toda la escala cromática, y eligo por k-means los colores más distintivos posibles
  colores <- c("#455930",
               "#c057c5",
               "#63b649",
               "#6148b9",
               "#c49d35",
               "#7a8fd0",
               "#d1503b",
               "#5ea7a3",
               "#c7407f",
               "#80a25e",
               "#56426d",
               "#bc8960",
               "#c787a5",
               "#793933")
  names(colores) <- cadenas

  data_filt <-   data %>%
    filter(reporter==reportante)

  if (reportante == "Sudamerica") {
    data_filt <-   data
  }
  if (nrow(data_filt)==0) {
    print(paste("No hay data para ",reportante,", ",nano))

  }else{

    graf <- data_filt  %>%
      group_by(Cadena,Subcadena, flow, year) %>%
      summarise(value = sum(value)) %>%
      ggplot(., aes(area = value, fill = Cadena, label = Subcadena, subgroup = Cadena, frame = year)) +
      geom_treemap( fixed =  TRUE, alpha = 1)+
      #geom_treemap_subgroup_border(fixed = TRUE)+
      geom_treemap_subgroup_text(place = "bottomright", grow = T, alpha = 0.5, colour =
                                   "black", fontface = "italic", min.size = 0,  fixed =  TRUE) +
      geom_treemap_text(colour = "white", place = "topleft", reflow = T,  fixed =  TRUE)+
      # geom_treemap_text(colour = "white", place = "left",
      #                     grow = F)+
      facet_grid(.~flow)+
      labs(title= paste0('Treemap ', reportante, ".Año "))+
      scale_fill_manual(values = colores)+
      theme_tufte()+
      theme(legend.position = "None",
            title = element_text(size = 18),
            strip.text = element_text(size=18))

    gganimate(graf,filename =  paste0("graficos/treemap_byproduct_",reportante,".mp4"),
              ani.width = 1600, ani.height = 900, interval = 0.3)

  }
}
grow_treemap_caduse_gif <- function(data = data_filt, reportante = "Argentina"){

  cadenas <- unique(data$Cadena)
  #Tomo toda la escala cromática, y eligo por k-means los colores más distintivos posibles
  colores <- c("#455930",
               "#c057c5",
               "#63b649",
               "#6148b9",
               "#c49d35",
               "#7a8fd0",
               "#d1503b",
               "#5ea7a3",
               "#c7407f",
               "#80a25e",
               "#56426d",
               "#bc8960",
               "#c787a5",
               "#793933")
  names(colores) <- cadenas

  data_filt <-   data %>%
    filter(reporter==reportante)

  if (reportante == "Sudamerica") {
    data_filt <-   data
  }
  if (nrow(data_filt)==0) {
    print(paste("No hay data para ",reportante,", ",nano))

  }else{

    graf <- data_filt  %>%
      group_by(Cadena,Flores,Cadena,flow, year) %>%
      summarise(value = sum(value)) %>%
      ggplot(., aes(area = value, fill = Cadena, label = Flores, subgroup = Cadena, frame = year)) +
      geom_treemap( fixed =  TRUE, alpha = 1)+
      #geom_treemap_subgroup_border(fixed = TRUE)+
      geom_treemap_subgroup_text(place = "bottomright", grow = T, alpha = 0.5, colour =
                                   "black", fontface = "italic", min.size = 0,  fixed =  TRUE) +
      geom_treemap_text(colour = "white", place = "topleft", reflow = T,  fixed =  TRUE)+
      # geom_treemap_text(colour = "white", place = "left",
      #                     grow = F)+
      facet_grid(.~flow)+
      labs(title= paste0('Treemap ', reportante, ".Año "))+
      scale_fill_manual(values = colores)+
      theme_tufte()+
      theme(legend.position = "None",
            title = element_text(size = 18),
            strip.text = element_text(size=18))

    gganimate(graf,filename =  paste0("graficos/treemap_byproduc_tUse_",reportante,".mp4"),
              ani.width = 1600, ani.height = 900, interval = 0.3)

  }
}
######treemap con y sin RDM ########
grow_treemap_cadsubcad_rdm_gif <- function(data = data_filt, reportante = "Argentina", flow_filter = "Export"){

  cadenas <- unique(data$Cadena)
  #Tomo toda la escala cromática, y eligo por k-means los colores más distintivos posibles
  colores <- c("#455930",
               "#c057c5",
               "#63b649",
               "#6148b9",
               "#c49d35",
               "#7a8fd0",
               "#d1503b",
               "#5ea7a3",
               "#c7407f",
               "#80a25e",
               "#56426d",
               "#bc8960",
               "#c787a5",
               "#793933")
  names(colores) <- cadenas

  data_filt <-   data %>%
    filter(reporter==reportante, flow== flow_filter)

  if (reportante == "Sudamerica") {
    data_filt <-   data %>%
      filter(flow== flow_filter)
  }
  if (nrow(data_filt)==0) {
    print(paste("No hay data para ",reportante,", ",nano))

  }else{

    graf <- data_filt  %>%
      mutate(RDM = case_when(partner=="RDM_Sudamerica"~"Resto del mundo",
                             TRUE ~ "Sudamérica")) %>%
      group_by(Cadena,Subcadena, year,RDM) %>%
      summarise(value = sum(value)) %>%
      ggplot(., aes(area = value, fill = Cadena, label = Subcadena, subgroup = Cadena, frame = year)) +
      geom_treemap( fixed =  TRUE, alpha = 1)+
      #geom_treemap_subgroup_border(fixed = TRUE)+
      geom_treemap_subgroup_text(place = "bottomright", grow = T, alpha = 0.5, colour =
                                   "black", fontface = "italic", min.size = 0,  fixed =  TRUE) +
      geom_treemap_text(colour = "white", place = "topleft", reflow = T,  fixed =  TRUE)+
      # geom_treemap_text(colour = "white", place = "left",
      #                     grow = F)+
      facet_grid(.~RDM)+
      labs(title= paste0('Treemap ',flow_filter,", ", reportante, ".Año "))+
      scale_fill_manual(values = colores)+
      theme_tufte()+
      theme(legend.position = "None",
            title = element_text(size = 18),
            strip.text = element_text(size=18))

    gganimate(graf,filename =  paste0("graficos/treemap_byproduct_RDM_",reportante,"_", flow_filter,".mp4"),
              ani.width = 1600, ani.height = 900, interval = 0.3)

  }
}

for (pais in c(paste(unique(data_filt$reporter)),"Sudamerica")) {
  grow_treemap_cadsubcad_gif(data = data_filt, reportante = pais)
}

for (pais in c(paste(unique(data_filt$reporter)),"Sudamerica")) {
  grow_treemap_caduse_gif(data = data_filt, reportante = pais)
}

for (pais in c(paste(unique(data_filt$reporter)),"Sudamerica")) {
  for (flow_filt in c("Export", "Import")) {
  grow_treemap_cadsubcad_rdm_gif(data = data_filt, reportante = pais,flow_filter = flow_filt)
  }
}

# for (pais in c(paste(unique(data_filt$reporter)),"Sudamerica")) {
#   for (flow_filt in c("Import")) {
#     grow_treemap_cadsubcad_rdm_gif(data = data_filt, reportante = pais,flow_filter = flow_filt)
#   }
# }


#######DESCRIPTION###############################
#processes stage topology table from GIS analysis
#stage stations upstream of a given station
#################################################
##load libraries
library(dplyr)
library(data.table)
library(stringr)
library(tidyr)
library(readr)

##user inputs
dir_ref = '/Volumes/gonggong/flood forecasting/data/reference tables/'
file_name = 'Upstream_Gages_Stage_Station_Wsheds.txt'

##read in raw data
stage_meta = fread(paste0(dir_ref, 'cwc_honumber_match_edit_thm_v3.csv'))
stage_meta = stage_meta %>% dplyr::select(sta_name, sta_id, ho_number) %>% dplyr::mutate(ho_number = as.numeric(ho_number))
stage_meta_us = stage_meta  %>% dplyr::rename(sta_name_us = sta_name, sta_id_us = sta_id, ho_number_us = ho_number)

stage_topology_raw = readLines(file.path(dir_ref, file_name))

##process data
stage_topology = NULL
for(i in 2:length(stage_topology_raw)){
	str_temp = unlist(strsplit(stage_topology_raw[i], split = ','))
	str_temp = str_replace_all(str_temp, '[[:punct:]]', '')
	str_temp = str_trim(str_temp)
	nele = length(str_temp)
	stage_topology_temp = data.table(sta_name = str_temp[2], ho_number = str_temp[1], ho_number_us = str_temp[3:nele])
	stage_topology = bind_rows(stage_topology, stage_topology_temp)
	# gauge_order = rbind_list(gauge_order, gauge_order_tmp)
}

stage_topology = stage_topology %>% dplyr::mutate(ho_number = as.numeric(ho_number), ho_number_us = as.numeric(str_replace_all(ho_number_us, 'u', ''))) %>% dplyr::filter(!is.na(ho_number_us))
stage_topology = stage_topology %>% left_join(stage_meta)
stage_topology = stage_topology %>% left_join(stage_meta_us)

##save processed tables
saveRDS(stage_topology, paste0(dir_ref, 'stage_topology_tbl.rda'))
write.csv(stage_topology, paste0(dir_ref, 'stage_topology_tbl.csv'), row.names = F)


p = read.table("D:/_tmp/20150330/sim3/RocCfb.txt", header = T, sep =",")
plot(p$FA * 50000, p$TP, type = 'b')

###
realchps = read.table("D:/_tmp/data/dataAchps.out", header=F)$V1
mean(diff(realchps[1:12]))
sd(diff(realchps[1:12]))
max (diff(realchps[1:12]))
#
sig = read.table("D:/_tmp/data/dataA.out")$V1
truechps = read.table("D:/_tmp/data/dataAchps.out")$V1
detected = read.table("D:/_tmp/20150330/exp2cfb/true-chps-cfb.txt")$V1

# PLOT DETECTED TRUE CFB CHANGES
plot(sig, cex = 0.1)
plot(sig, xlim = c(20000, 30000), cex = 0.1)
abline(v = detected, col = "red")
abline(v = truechps, col = "blue")
#
plot(sig, xlim = c(11300, 11450), cex = 0.1)
abline(v = detected, col = "red")
abline(v = truechps, col = "blue")
# END

#pcfb = read.table("D:/_tmp/20150330/exp2cfb/ProbsCfb.txt")$V1
#plot(pcfb)

#


library(tidyverse)

# Create class method to split sample data into traing and test data
# All columns except last are assumed to be independant variables (predictor)
# Last column is assumed to be dependant (response)
# Therefore Input Data must be in the format of an Analytics Base Table

split_sample <- function(df){
  # Using Sample_frac from dplyr lib takes a percentage of source to use as training data
  # anti_join then takes remaining rows to be used for test data
  train <- sample_frac(df, 0.7)
  test <- anti_join(df, train)

  sampleclass <- setClass(
    "Split_sample",
    slots = c(
      xtrain="tbl_df",
      ytrain="tbl_df",
      xtest="tbl_df",
      ytest="tbl_df"
      )
  )

  sampleData <- sampleclass(
    xtrain = train[,-ncol(train)],
    ytrain = train[,ncol(train)],
    xtest = test[,-ncol(test)],
    ytest = test[,ncol(test)]
  )

  return(sampleData)
}


#' Impute missing values as lowest observed value.
#'
#' @param data - Normalized, imputed data. Data matrix with observations as rows, features as columns.
#' @param ref - Reference samples normalized, imputed data.
#' @return imputed.data - Z-transformed data.
#' @export data.imputeData
data.imputeData = function(data, ref) {
  data = data[which(rownames(data) %in% rownames(ref)),]
  ref = ref[which(rownames(ref) %in% rownames(data)),]
  data = data[sort(rownames(data)),]
  ref = ref[sort(rownames(ref)),]

  imputed.data = data
  for (met in 1:nrow(ref)) {
    rowData = ref[met,]
    if (any(is.na(rowData))) {
      rowData = as.numeric(rowData[-which(is.na(rowData))])
    } else {
      rowData = as.numeric(rowData)
    }
    # Impute using uniform random variable, where a = 0.99*observed minimum, and b = observed minimum
    min_row = min(rowData)
    if (min_row<0) {
      min_row = -1*min_row
      imputed.data[met, is.na(data[met,])] = tryCatch(-1*runif(sum(is.na(data[met,])), min = 0.99*min_row, max= min_row),
                                                      error = function(e) e, warning=function(w) print(sprintf("%s: met%d", w, met)))
    } else {
      imputed.data[met, is.na(data[met,])] = tryCatch(runif(sum(is.na(data[met,])), min = 0.99*min(rowData), max= min(rowData)),
                                                      error = function(e) e, warning=function(w) print(sprintf("%s: met%d", w, met)))
    }
  }
  return(imputed.data)
}


# 3. faza: Vizualizacija podatkov

# Uvozimo zemljevid.
#zemljevid <- uvozi.zemljevid("http://baza.fmf.uni-lj.si/OB.zip", "OB",
#                             pot.zemljevida="OB", encoding="Windows-1250")
#levels(zemljevid$OB_UIME) <- levels(zemljevid$OB_UIME) %>%
#  { gsub("Slovenskih", "Slov.", .) } %>% { gsub("-", " - ", .) }
#zemljevid$OB_UIME <- factor(zemljevid$OB_UIME, levels=levels(obcine$obcina))
#zemljevid <- fortify(zemljevid)

# Izračunamo povprečno velikost družine
#povprecja <- druzine %>% group_by(obcina) %>%
#summarise(povprecje=sum(velikost.druzine * stevilo.druzin) / sum(stevilo.druzin))

povprecje.regije <- povprecja.kmetijskih.kultur %>% group_by(regija) %>% summarise(povprecje = mean(povprecje, na.rm = TRUE))

library(tmap)
source("https://raw.githubusercontent.com/TrafelaT18/APPR-2019-20/master/lib/uvozi.zemljevid.r")
obcine <- uvozi.zemljevid("http://baza.fmf.uni-lj.si/OB.zip", "OB",
                          pot.zemljevida="OB", encoding="Windows-1250")


library(data.table)
library(curl)
library(jsonlite)

h <- new_handle()
handle_setheaders(h, "Accepts" = "application/json",
                  "LOL_API_KEY" = apikey)

champions <- curl_fetch_memory(
  "http://ddragon.leagueoflegends.com/cdn/11.23.1/data/en_US/champion.json",
  handle = h
)
champions <- fromJSON(rawToChar(champions$content), flatten = T)
champions <- champions$data

champ_stats <- c()
for (i in 1:length(champions)){
  champ_stats <- unique(c(champ_stats, names(champions[[i]]$stats)))
}

champions_base_stats <- data.table()
for (i in 1:length(champions)){
  len <- length(champions[[i]]$stats)
  champions_base_stats <- rbind(
    champions_base_stats,
    data.table(
      champion = rep(names(champions[i]), len),
      statistic = names(champions[[i]]$stats),
      value = unlist(champions[[i]]$stats)
    )
  )
}

champions_base_stats[,value_std := (value - min(value)) / (max(value) - min(value)), by = .(statistic)]
champions_base_stats[is.na(value_std), value_std := 0]


source("functions_setup/mlab-setup.r")

#####################
# Joining with Congressional Districts
#		Since the US Census API does not yet support geometries for Congressional
#		Districts, instead, we'll use an imported shapefile to obtain the geometries.
#
# Import shapefile as an sf dataframe
cd_115<- st_read(dsn="geofiles/us_legislative_districts",
	layer="cb_2017_us_cd115_500k", quiet=TRUE)

# Filter to the state we're interested in
MN_cd_115 <- filter(cd_115, STATEFP == "27")

#####################
# Get and prepare M-Lab Download speed data
#####################
with_config(config(http_version = 2), {
	MN_2018_download_initial <- pull_mm_ndt("2018-01-01", "2018-07-31", sql_download,
		"'Minnesota'","MN") })

## A little data cleaning to filter data any rows that might not be in the correct country
MN_2018_download <- filter(MN_2018_download_initial, country_code == "US")

## Convert to a simple features dataframe
coordinates(MN_2018_download) <- c("client_lon", "client_lat")
MN2018_down_sf <- st_as_sf(MN_2018_download)

## Set the layer CRSs to be the same
st_crs(MN2018_down_sf) <- st_crs(MN_cd_115)

## Do spatial join to add congressional district to speed test rows
MN_2018_down_cd115 <- bind_cols(
  MN_2018_download@data,
  MN_cd_115[as.numeric(st_within(MN2018_down_sf, MN_cd_115)),]
)

#####################
# Compute Download medians by district
#####################
# First summary of median download speed to reduce sample bias
#   This first step produces download speed medians by district, day, and client_ip, reducing potential sample bias from
#   multiple tests from the same ip addresses over time
MN_2018_DL_IP_day_district <- MN_2018_down_cd115 %>%
  group_by(CD115FP,format(as.Date(log_time), "%Y-%m-%d"),client_ip) %>%
  summarize(median_dl = median(download_speed_Mbps))

## Rename the 'day' column generated by the transform of log_time in the previous DF
names(MN_2018_DL_IP_day_district)[2] = "day"

## Second and final summary of median download speed by district
##   This second summarization groups the previously calculated medians by district, day, and client_ip to simply medians by district
MN_2018_download_median_cd115 <- MN_2018_DL_IP_day_district %>%
  group_by(CD115FP) %>%
  summarize(median_download_Mbps = median(median_dl))

## Prepare for mapping
MN_districts <- readOGR(dsn="examples/geofiles/MN_legis_dists", layer="MN_cd115",
	stringsAsFactors = FALSE)
centroids.MN_districts <- as.data.frame(coordinates(MN_districts))
MN_2018_DL_median_ip_day_district_withCentroids <- data.frame(MN_2018_download_median_cd115, centroids.MN_districts)

## Rejoin the geometry field so we can map median speeds by district
MN_2018_DL_median_ip_day_district_map_centers <- left_join(MN_2018_download_median_cd115,
                                                           MN_2018_DL_median_ip_day_district_withCentroids, by=c("CD115FP"))
MN_2018_DL_median_ip_day_district_map_final <- left_join(MN_2018_DL_median_ip_day_district_map_centers,
                                                         MN_cd_115, by=c("CD115FP"))
names(MN_2018_DL_median_ip_day_district_map_final)[4] = "longitude"
names(MN_2018_DL_median_ip_day_district_map_final)[5] = "latitude"
names(MN_2018_DL_median_ip_day_district_map_final)[2] = "median_download_mbps"

#####################
# Create some visualizations
#####################

## Make a map with the ggplot package
MN_2018_median_down_cd115_plot <- MN_2018_DL_median_ip_day_district_map_final %>%
  ggplot(aes(fill=median_download_mbps),color=median_download_mbps) +
  guides(fill=guide_legend(title="Median Download Speed (Mbps)")) +
  theme_bw() +
  geom_sf() +
  geom_label_repel(aes(x=longitude, y=latitude, label=CD115FP), color="white", fill="darkgrey") +
  theme(panel.background = element_rect(fill= NA), panel.grid = element_blank(), panel.border = element_blank(),
        panel.grid.major = element_line(colour = "white"), panel.grid.minor = element_line(colour = "white"),
        axis.text = element_blank(), axis.ticks = element_blank() )

## Make a bar chart by district
ggplot(MN_2018_DL_median_ip_day_district_map_final,aes(CD115FP, median_download_mbps, fill=median_download_mbps)) +
  guides(fill=guide_legend(title="Median Download Speed (Mbps)")) +
  theme_bw() +
  geom_col() +
  theme(panel.background = element_rect(fill= NA), panel.grid = element_blank(), panel.border = element_blank(),
        panel.grid.major = element_line(colour = "white"), panel.grid.minor = element_line(colour = "white"))+
  ggtitle("M-Lab Median Download Speeds by Congressional District, 2018 Q1-2") +
  xlab("Minnesota Congressional District") + ylab("Median Download Speed (Mbps)") +
  geom_text(aes(label=round(median_download_mbps,2)), vjust=1.5, color="white")

#####################
# Compute Download Speed by District and City
#####################
MN_2018_DL_IP_day_district_city <- MN_2018_down_cd115 %>%
  group_by(CD115FP,format(as.Date(log_time), "%Y-%m-%d"),client_ip,city) %>%
  summarize(median_dl = median(download_speed_Mbps))

names(MN_2018_DL_IP_day_district_city)[2] = "day"

MN_2018_download_median_cd115_city <- MN_2018_DL_IP_day_district_city %>%
  group_by(CD115FP,city) %>%
  summarize(median_download_Mbps = median(median_dl))

MN_3_DL_city <- filter(MN_2018_download_median_cd115_city, CD115FP == "03")

## Create a bar chart by city
ggplot(MN_3_DL_city,aes(reorder(city, -median_download_Mbps), median_download_Mbps, fill=median_download_Mbps)) +
  guides(fill=guide_legend(title="Median Download Speed (Mbps)")) +
  theme_bw() +
  geom_col() +
  theme(panel.background = element_rect(fill= NA), panel.grid = element_blank(), panel.border = element_blank(),
        panel.grid.major = element_line(colour = "white"), panel.grid.minor = element_line(colour = "white"))+
  ggtitle("M-Lab Median Download Speeds by City, MN 3, 2018 Q1-2") +
  xlab("City") + ylab("Median Download Speed (Mbps)") +
  geom_text(aes(label=round(median_download_Mbps,2)), hjust=1, color="white") +
  coord_flip()

#####################
# Get and prepare M-Lab Upload speed data
#####################
with_config(config(http_version = 2), {
  MN_2018_upload_initial <- pull_mm_ndt("2018-01-01", "2018-07-31", sql_upload,
  	"'Minnesota'","MN")})

MN_2018_upload <- filter(MN_2018_upload_initial, country_code == "US")
coordinates(MN_2018_upload) <- c("client_lon", "client_lat")

MN2018_up_sf <- st_as_sf(MN_2018_upload)

st_crs(MN2018_up_sf) <- st_crs(MN_cd_115)

MN_2018_up_cd115 <- bind_cols(
  MN_2018_upload@data,
  MN_cd_115[as.numeric(st_within(MN2018_up_sf, MN_cd_115)),]
)

MN_2018_UL_IP_day_district <- MN_2018_up_cd115 %>%
  group_by(CD115FP,format(as.Date(log_time), "%Y-%m-%d"),client_ip) %>%
  summarize(median_ul = median(upload_speed_Mbps))

names(MN_2018_UL_IP_day_district)[2] = "day"

MN_2018_upload_median_cd115 <- MN_2018_UL_IP_day_district %>%
  group_by(CD115FP) %>%
  summarize(median_upload_Mbps = median(median_ul))

MN_2018_UL_median_ip_day_district <- left_join(MN_2018_upload_median_cd115, MN_cd_115, by=c("CD115FP"))

MN_districts <- readOGR(dsn="examples/geofiles/MN_legis_dists", layer="MN_cd115",stringsAsFactors = FALSE)
centroids.MN_districts <- as.data.frame(coordinates(MN_districts))

MN_2018_UL_median_ip_day_district_withCentroids <- data.frame(MN_2018_upload_median_cd115, centroids.MN_districts)

MN_2018_UL_median_ip_day_district_map_centers <- left_join(MN_2018_upload_median_cd115,
                                                           MN_2018_UL_median_ip_day_district_withCentroids, by=c("CD115FP"))
MN_2018_UL_median_ip_day_district_map_final <- left_join(MN_2018_UL_median_ip_day_district_map_centers,
                                                         MN_cd_115, by=c("CD115FP"))
names(MN_2018_UL_median_ip_day_district_map_final)[4] = "longitude"
names(MN_2018_UL_median_ip_day_district_map_final)[5] = "latitude"
names(MN_2018_UL_median_ip_day_district_map_final)[2] = "median_upload_mbps"

MN_2018_median_up_cd115_plot <- MN_2018_UL_median_ip_day_district_map_final %>%
  ggplot(aes(fill=median_upload_mbps),color=median_upload_mbps) +
  guides(fill=guide_legend(title="Median Upload Speed (Mbps)")) +
  theme_bw() +
  geom_sf() +
  geom_label_repel(aes(x=longitude, y=latitude, label=CD115FP), color="white", fill="darkgrey") +
  theme(panel.background = element_rect(fill= NA), panel.grid = element_blank(), panel.border = element_blank(),
        panel.grid.major = element_line(colour = "white"), panel.grid.minor = element_line(colour = "white"),
        axis.text = element_blank(), axis.ticks = element_blank() )

ggplot(MN_2018_UL_median_ip_day_district_map_final,aes(CD115FP, median_upload_mbps, fill=median_upload_mbps)) +
  guides(fill=guide_legend(title="Median Upload Speed (Mbps)")) +
  theme_bw() +
  geom_col() +
  theme(panel.background = element_rect(fill= NA), panel.grid = element_blank(), panel.border = element_blank(),
        panel.grid.major = element_line(colour = "white"), panel.grid.minor = element_line(colour = "white"))+
  ggtitle("M-Lab Median Upload Speeds by Congressional District, 2018 Q1-2") +
  xlab("Minnesota Congressional District") + ylab("Median Upload Speed (Mbps)") #+

#####################
# Compute Upload Speed by District and City
#####################
MN_2018_UL_IP_day_district_city <- MN_2018_up_cd115 %>%
  group_by(CD115FP,format(as.Date(log_time), "%Y-%m-%d"),client_ip,city) %>%
  summarize(median_ul = median(upload_speed_Mbps))

names(MN_2018_UL_IP_day_district_city)[2] = "day"

MN_2018_upload_median_cd115_city <- MN_2018_UL_IP_day_district_city %>%
  group_by(CD115FP,city) %>%
  summarize(median_upload_Mbps = median(median_ul))

MN_3_UL_city <- filter(MN_2018_upload_median_cd115_city, CD115FP == "03")

ggplot(MN_3_UL_city,aes(reorder(city, -median_upload_Mbps), median_upload_Mbps, fill=median_upload_Mbps)) +
  guides(fill=guide_legend(title="Median Upload Speed (Mbps)")) +
  theme_bw() +
  geom_col() +
  theme(panel.background = element_rect(fill= NA), panel.grid = element_blank(), panel.border = element_blank(),
        panel.grid.major = element_line(colour = "white"), panel.grid.minor = element_line(colour = "white"))+
  ggtitle("M-Lab Median Upload Speeds by City, MN 3, 2018 Q1-2") +
  xlab("City") + ylab("Median Upload Speed (Mbps)") +
  geom_text(aes(label=round(median_upload_Mbps,6)), hjust=1.2, color="white") +
  coord_flip()


#Usage:
#Rscript cell_classified_trajectory.r dimension_number
library("monocle")
library("reshape")
library('ggplot2')
args <- commandArgs(trailingOnly=TRUE)
if(length(args)==0)
{
	print("Usage: Rscript cell_classified_trajectory.r dimension_number")
}
dimension_number <- args[1]
HSMM <- readRDS("classified_cells.rds")
HSMM <- reduceDimension(HSMM, max_components=as.numeric(dimension_number))
HSMM <- orderCells(HSMM, reverse=FALSE)
print(plot_cell_trajectory(HSMM, color_by="CellType"))
ggsave("cell_classified_trajectory_plot.png")
ggsave("cell_classified_trajectory_plot.tiff", width = 7, height = 7,dpi=600)
dev.off()


library(scales)
library(OECD)
library(glue)
library(ggrepel)
library(lubridate)
library(tidyverse)

pays <- c("ITA", "GRC", "SVK", "ESP", "POL", "KOR", "PRT", "HUN", "IRL", "AUT", "CAN", "BEL", "NZL", "GBR", "FRA", "DEU", "FIN", "USA", "NLD", "DNK", "SWE", "NOR")

datasets <- OECD::get_datasets() |> filter(str_detect(id, "SNA_TABLE11"))

query_cofog <- ".TLYCG+D1CG+B1_GE.T+010+020+030+040+050+060+070+080+090+100.GS13+S1.C"
query_d1 <- ".P1A+P2A+B1GA+D1A+D11A+B2G_B3GA+K1A+B2N_B3NA+D29_D39A+B1_GE.VTOT+VO+VP+VQ.C"

d1_oecd <- OECD::get_dataset(dataset="SNA_TABLE6A", query_d1) |>
  transmute(value=as.numeric(ObsValue),
            measure = factor(MEASURE),
            year=as.numeric(Time),
            country = factor(LOCATION),
            branche = factor(ACTIVITY),
            transac = factor(TRANSACT),
            unit = factor(UNIT)) |>
  filter(unit!="IDX") |>
  group_by(country, year) |>
  summarize(
    rd1 = sum(value[branche%in%c("VO", "VP", "VQ")&transac=="D1A"]),
    d1tot = value[branche=="VTOT"&transac=="D1A"],
    pib = value[branche=="VTOT"&transac=="B1_GE"],
    educ = value[branche=="VP"&transac=="D1A"]/d1tot,
    admin = value[branche=="VO"&transac=="D1A"]/d1tot,
    sante = value[branche=="VQ"&transac=="D1A"]/d1tot,
    d1_nm = rd1/pib,
    unit = unique(unit)) |>
  filter(!near(rd1,0))

cofog_oecd <- OECD::get_dataset(dataset="SNA_TABLE11", query_cofog) |>
  transmute(value=as.numeric(ObsValue),
         year=as.numeric(Time),
         country = factor(LOCATION),
         cofog = factor(ACTIVITY),
         transac = factor(TRANSACT),
         unit = factor(UNIT)) |>
  group_by(cofog, year, country) |>
  summarize(d1s13_td =  value[transac=="D1CG"]/value[transac=="TLYCG"],
            d1s13_pib = value[transac=="D1CG"]/value[transac=="B1_GE"],
            d1s13 = value[transac=="D1CG"]) |>
  ungroup() |>
  arrange(country, cofog, -year) |>
  mutate(country = fct_reorder(country, d1s13_pib, .fun = first))

data <- cofog_oecd |> filter(cofog=="T") |>
  left_join(d1_oecd, by=c("year", "country")) |>
  drop_na(d1_nm) |>
  group_by(country) |>
  summarize(year_max = max(year),
            d1_pib = d1s13_pib[year==year_max],
            d1_nm = d1_nm[year==year_max],
            d1_d1tot = d1s13[year==year_max]/d1tot[year==year_max],
            d1_educ = educ[year==year_max],
            d1_sante = sante[year==year_max],
            d1_admin = admin[year==year_max],
            d1_vnm = d1_educ+d1_admin+d1_sante,
            delta_d1tot = d1s13[year==year_max]/d1tot[year==year_max]-d1s13[year==year_max-5]/d1tot[year==year_max-5]) |>
  ungroup() |>
  mutate(
    country_a = str_c(country,case_when(
      year_max==2020 ~ "",
      year_max==2019 ~ "*",
      year_max <=2018 ~ "**")),
    country2 = fct_reorder(str_c(country, ' (', year_max, ')'), d1_nm),
    country_a = fct_reorder(country_a, d1_vnm)) |>
  filter(country%in%pays)

ggcofog <- ggplot(data |> select(country_a, d1_educ, d1_sante, d1_admin) |> pivot_longer(cols=-country_a), aes(x=country_a)) +
  geom_col(aes(y=value, fill = name), width = 0.5, alpha=0.75)+
  scale_fill_discrete(type = RColorBrewer::brewer.pal(3, "Blues"), labels=c("Administration", "Education", "Santé")) +
  theme_minimal(base_family="Nunito", base_size = unit(8, "pt"))+
  scale_y_continuous(labels = label_percent(1))+
  xlab("")+ylab("")+labs(fill="Part de la masse \ndu secteur dans la masse \nsalariale totale", size=3)+
  geom_segment(data = data,
               mapping=aes(x=country_a, xend=country_a, y=d1_d1tot-delta_d1tot, yend=d1_d1tot),
               col="orange", arrow=arrow(type="closed", length=unit(2.5,"pt")))+
  geom_point(data = data, mapping=aes(x=country_a, y=d1_d1tot), col="darkorange")+
  geom_point(data = data, mapping=aes(x=country_a, y=d1_d1tot-delta_d1tot), col="orange" |> colorspace::lighten())+
  annotate("text", x="SVK*", y=0.32, color= "orange", hjust = 0, size=2,
           label="Part de la masse salariale des employés publics \ndans la masse salariale totale\n(dernier point connu et 5 ans avant)")+
  annotate("curve", curvature=0, x="SVK*", xend="HUN*", yend=0.25, y=0.32, arrow = arrow(length = unit(2, "mm")), color= "orange")+
  theme(legend.position = "bottom")+
  labs(caption="données pour 2020, *2019, **2018\n Sources : OCDE Comptes Nationaux table 11 et table 6a")

ggsave("fonctionnaires en masse salariale.svg", plot=ggcofog, width = 16, height=14, unit="cm")

data.table::fwrite(data |> select(country_a, d1_educ, d1_sante, d1_admin, d1_d1tot, delta_d1tot), "secteur public data.csv")


#' Extract the information from the simulation data frame to analyse the dose response effects
#'
#' @param allsim dataset with all simulations values
#' @param dataset dataset with all variables
#' @param dr a vector with dose response values
#' @return a data frame with dose response values
#' @export

dose_resp_ind <- function(allsim, dataset, dr = seq(0, 1, 0.1)) {
  dataset <- data.frame(dataset)
    N <- dim(dataset)[1]
    sim <- dim(allsim)[2]
    size <- length(dr)
    m2 <- NA
    sum_dr <- data.frame(matrix(NA, size, 3))
    names(sum_dr) <- c("Quantile", "Mean", "SE")
    pos <- 1
    for (g in 1:size) {
        newpos <- pos + N - 1
        m3 <- as.matrix(allsim[pos:newpos, ])
        for (f in 1:sim) {
            m1 <- mean(as.matrix(allsim[pos:newpos, f]))
            m2 <- c(m2, m1)
        }
        m2 <- m2[-1]
        se <- stats::sd(m2)
        sum_dr[g, 2] <- mean(m3)
        sum_dr[g, 3] <- se
        sum_dr[g, 1] <- paste0("DR_", dr[g])
        pos <- newpos + 1
    }
    return(sum_dr)
}


library(data.table)
N = 2e9/8
K = 100

DT <- data.table(
  id3 = sample(sprintf("id%010d",1:(N/K)), N, TRUE),
  v1 =  sample(5, N, TRUE)
)

system.time(DT[, sum(v1),keyby = id3])
system.time(DT[, sum(v1),keyby = id3])

system.time(setkey(DT, id3))
system.time(DT[, sum(v1),id3])
system.time(DT[, sum(v1),id3])


getwd()
workingDir <- "/home/luke/Documents/E_FEM_clean/E_FEM"
setwd(workingDir)

require(haven)
require(dplyr)

par(mfrow=c(2,2))

baseline <- read_dta('output/ELSA_Baseline/ELSA_Baseline_summary.dta')

cohort <- read_dta('output/ELSA_cohort/ELSA_cohort_summary.dta')

### COMMIT INTERVENTION
commit3 <- read_dta('output/COMMIT_cSmoken3/COMMIT_cSmoken3_summary.dta')
## Visualise the 3% intervention
#plot(cohort$year, cohort$n_smoken_all, type='l', col='red')
#lines(commit3$year, commit3$n_smoken_all, col='green')

plot(commit3$year, commit3$p_smoken_all, type='l', col='green')
lines(cohort$year, cohort$p_smoken_all, col='red')

plot(commit3$year, commit3$n_lunge_all, type='l', col='green')
lines(cohort$year, cohort$n_lunge_all, col='red')

plot(commit3$year, commit3$p_lunge_all, type='l', col='green')
lines(cohort$year, cohort$p_lunge_all, col='red')

plot(commit3$year, commit3$p_cancre_all, type='l', col='green')
lines(cohort$year, cohort$p_cancre_all, col='red')

tmp <- commit3$m_endpop_all / commit3$m_endpop_all[1]
tmp2 <- cohort$m_endpop_all / cohort$m_endpop_all[1]

plot(commit3$year, tmp, type='l', col='green')
lines(cohort$year, tmp2, col='red')

## Now work with the PSmoke_stopMult intervention
smoke_stop <- read_dta('output/Smoke_Stop_Cohort200/Smoke_Stop_Cohort200_summary.dta')
## Visualise
#plot(smoke_stop$year, smoke_stop$n_smoken_all, type='l', col='green')
#lines(cohort$year, cohort$n_smoken_all, col='red')

plot(cohort$year, cohort$p_smoken_all, type='l', col='red')
lines(smoke_stop$year, smoke_stop$p_smoken_all, col='green')

plot(cohort$year, cohort$p_lunge_all, type='l', col='red')
lines(smoke_stop$year, smoke_stop$p_lunge_all, col='green')

plot(smoke_stop$year, smoke_stop$p_cancre_all, type='l', col='green')
lines(cohort$year, cohort$p_cancre_all, col='red')

plot(smoke_stop$year, smoke_stop$p_diabe_all, type='l', col='green')
lines(cohort$year, cohort$p_diabe_all, col='red')

plot(smoke_stop$year, smoke_stop$n_smoke_stop_all, type='l', col='green')
lines(cohort$year, cohort$n_smoke_stop_all, col='red')

###########
SmokeStopInt <- read_dta('output/SmokeStopIntervention/SmokeStopIntervention_summary.dta')

#plot(SmokeStopInt$year, SmokeStopInt$n_smoken_all, type='l', col='green')
#lines(cohort$year, cohort$n_smoken_all, col='red')

plot(SmokeStopInt$year, SmokeStopInt$p_smoken_all, type='l', col='green')
lines(cohort$year, cohort$p_smoken_all, col='red')

plot(SmokeStopInt$year, SmokeStopInt$p_lunge_all, type='l', col='green')
lines(cohort$year, cohort$p_lunge_all, col='red')

plot(SmokeStopInt$year, SmokeStopInt$p_cancre_all, type='l', col='green')
lines(cohort$year, cohort$p_cancre_all, col='red')

plot(SmokeStopInt$year, SmokeStopInt$p_diabe_all, type='l', col='green')
lines(cohort$year, cohort$p_diabe_all, col='red')

#################################################
smoke_stop_init <- read_dta('output/Smoke_Stop_Cohort_Init/Smoke_Stop_Cohort_Init_summary.dta')

#plot(smoke_stop_init$year, smoke_stop_init$n_smoken_all, type='l', col='green')
#lines(cohort$year, cohort$n_smoken_all, col='red')

plot(smoke_stop_init$year, smoke_stop_init$p_smoken_all, type='l', col='green')
lines(cohort$year, cohort$p_smoken_all, col='red')

plot(cohort$year, cohort$p_smoken_all, col='red', type='l')
lines(smoke_stop_init$year, smoke_stop_init$p_smoken_all, col='green')

plot(smoke_stop_init$year, smoke_stop_init$p_lunge_all, type='l', col='green')
lines(cohort$year, cohort$p_lunge_all, col='red')

plot(smoke_stop_init$year, smoke_stop_init$p_cancre_all, type='l', col='green')
lines(cohort$year, cohort$p_cancre_all, col='red')

plot(smoke_stop_init$year, smoke_stop_init$p_diabe_all, type='l', col='green')
lines(cohort$year, cohort$p_diabe_all, col='red')


# Initialize i
i<-1

# Code the while loop
while (i<=10) {
    if (i%%8==0){
	print (i*3)
    break
	}
    else {
    print (i*3)
    i<-i+1
	}
 }


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

GetSlopeData <- function(raw.data.name="train",datasets=c("alsfrs","fvc","svc","vital","lab")) {
	# Calculates the slope data for alsfrs, fvc, svc, vital, and lab data
	#
	# Args:
	#	raw.data.name: name of the raw dataset
	#	datasets: a vector with the names of datasets to get slopes for
	#
	# Returns:
	#	a list of slope datasets
	#
	# Example usage:
	# 	slope.list <- GetSlopeData("train")

  # Initialize slope data list
  slope.data.list<-list()

 	if ("alsfrs" %in% datasets) {

 		# Check to see if slope data has been created, if so, load
		rda.filename = paste("Data/slope_alsfrs_",raw.data.name,".rda",sep="")

  		if (file.exists(rda.filename)) {
    		print(paste("loading saved alsfrs slope from",rda.filename,sep=" "))
    		load(rda.filename)
    		print("finished loading")
  		}

		else {
  			# Get ALSFRS data
	  		alsfrs.data<-GetAlsfrsData(raw.data.name)

	  		# Create vector of alsfrs measures to get slopes for
	  		als.measures<-c("alsfrs.score","speech","salivation","swallowing",
    			"handwriting","cutting","dressing","turning","walking",
    			"climbing.stairs")

	  		alsfrs.slopes<-lapply(als.measures,CalcSlopeData,dataset=alsfrs.data)

	  		# Name datasets in list
	  		names(alsfrs.slopes)<-paste("slope",als.measures,sep=".")

	  		# Save to file
	  		save(alsfrs.slopes,file=rda.filename)
	  }
	  # Add to list of slope datasets
	  slope.data.list<-c(slope.data.list,alsfrs.slopes)
  }

  if ("fvc" %in% datasets) {

	# Check to see if slope data has been created, if so, load
	rda.filename = paste("Data/slope_fvc_",raw.data.name,".rda",sep="")

  	if (file.exists(rda.filename)) {
    		print(paste("loading saved fvc slope from",rda.filename,sep=" "))
    		load(rda.filename)
    		print("finished loading")
  	}
  	else {
		# Get FVC slopes
	  	fvc.slopes<-CalcSlopeData(GetFvcData(raw.data.name),"fvc.liters")

	  	# Save to file
	  	save(fvc.slopes,file=rda.filename)
	 }
	 # Add to list of slope datasets
	 slope.data.list<-c(slope.data.list,list(slope.fvc.liters=fvc.slopes))
  }

  if ("svc" %in% datasets) {

  	# Check to see if slope data has been created, if so, load
	rda.filename = paste("Data/slope_svc_",raw.data.name,".rda",sep="")

  	 if (file.exists(rda.filename)) {
    		print(paste("loading saved svc slope from",rda.filename,sep=" "))
    		load(rda.filename)
    		print("finished loading")
  	}
	else {
  		# Get SVC slopes
	  	svc.slopes<-CalcSlopeData(GetSvcData(raw.data.name),"svc.liters")

	  	# Save to file
	  	save(svc.slopes,file=rda.filename)
	}

	# Add to list of slope datasets
	slope.data.list<-c(slope.data.list,list(slope.svc.liters=svc.slopes))
  }

  if ("vital" %in% datasets) {

  	# Check to see if slope data has been created, if so, load
	rda.filename = paste("Data/slope_vital_",raw.data.name,".rda",sep="")

  	if (file.exists(rda.filename)) {
    		print(paste("loading saved vital slope from",rda.filename,sep=" "))
    		load(rda.filename)
    		print("finished loading")
  	}
	else {
  		# Get vital slopes
	  	vital.data<-GetVitalData(raw.data.name)
	  	vital.names<-names(vital.data)
		vital.slopes<-mapply(CalcSlopeData,vital.data,vital.names,SIMPLIFY=FALSE)

	  	# Rename datasets in vital list
	  	names(vital.slopes)<-paste("slope",vital.names,sep=".")

	  	# Save to file
	  	save(vital.slopes,file=rda.filename)
	 }

	 # Add to list of slope datasets
	 slope.data.list<-c(slope.data.list,vital.slopes)
  }

  if ("lab" %in% datasets) {

  	# Check to see if slope data has been created, if so, load
	rda.filename = paste("Data/slope_lab_",raw.data.name,".rda",sep="")

  	if (file.exists(rda.filename)) {
    		print(paste("loading saved lab slope from",rda.filename,sep=" "))
    		load(rda.filename)
    		print("finished loading")
  	}
  	else {
		# Get lab slopes
	  	lab.data<-GetLabData(raw.data.name)
		lab.names<-names(lab.data)
	  	lab.slopes<-mapply(CalcSlopeData,lab.data,lab.names,SIMPLIFY=FALSE)

	  	# Rename datasets in lab list
	  	names(lab.slopes)<-paste("slope",lab.names,sep=".")

	  	# Save to file
	  	save(lab.slopes,file=rda.filename)
	 }
	 # Add to list of slope datasets
	slope.data.list<-c(slope.data.list,lab.slopes)
	}

  return(slope.data.list)
}

CalcSlopeData<-function(dataset, measure) {
# Given a dataset, returns a new dataset where the new measure is the slope of
# the old measure.  If dataset is empty, returns an empty dataset with the
# correct slope column names
#
# Args:
#   dataset: data frame generated from Get*Dataa
#   measure: the name of the measurement column
#
# Returns:
#   a data frame with columns consisting of subject ids, mid point deltas, and
#   slopes of the measure in the dataset
#
# Example usage:
#   slope.data<-CalcSlopeData(GetFvcData("train"),"fvc.liters")

  # Get length of dataset
  nrow<-dim(dataset)[1]

  # Get delta column number
  delta.col<-grep("delta",colnames(dataset))

  # Get value column number
  value.col<-match(measure,colnames(dataset))

  # Calculate slopes
  slope<-diff(dataset[,value.col])/
    DaysToMonths(diff(dataset[,delta.col]))

  # Calculate midpoint deltas
  delta.mid<-dataset[,delta.col][2:nrow]-diff(dataset[,delta.col]/2)

  # Get lagged differences in subjects to indicate change in subject.id
  sub.diff<-diff(dataset$subject.id)

  # Form dataset containing subject ids, midpoint deltas, slopes, and sub diff
  slope.data<-data.frame(subject.id=dataset$subject.id[-1],delta.mid,slope,
    sub.diff)

  # Drop rows where subject changes and drop sub diff column
  slope.data<-slope.data[slope.data$sub.diff==0,1:3]

  # Rename columns
  colnames(slope.data)<-c("subject.id",paste("slope",measure,"delta",sep="."),
    paste("slope",measure,sep="."))

  return(slope.data)

}


# Libraries

library(htmlwidgets)
library(dplyr)
library(ggplot2)
library(dygraphs)
library(htmltools)
library(widgetframe)
library(icesSAG)
library(plotly)

library(shiny)
library(shinythemes)
library(glue)
library(sf)
library(leaflet)
library(fisheryO)
library(DT)
library(tidyverse)
library(icesVocab)
library(tm)
library(shinyWidgets)
library(shinyjs)
library(reshape2)
library(scales)
library(ggradar)
library(icesFO)
library(icesTAF)

# required if using most recent version of sf
sf::sf_use_s2(FALSE)

################################
# sources
source("Shiny/utilities_load_shapefiles.r")
source("Shiny/utilities_shiny_formatting.r")
source("Shiny/utilities_plotting.r")
source("Shiny/utilities_mapping.r")
source("Shiny/utilities_sag_data.r")
source("Shiny/utilities_shiny_Input.r")
source("Shiny/utilities_SID_data.r")
source("Shiny/utilities_catch_scenarios.r")

## If this code is run for the first time and the SAG data in not present on the local machine
## the following line will download the last 5 years of SAG data (summary and ref points).
## This process will take several minutes but, once the data is in the local folder,
## the app will run much faster.
if (!file.exists("SAG_ 2021/SAG_summary.csv")) {
    source("Shiny/update_SAG_data.r")
}

# ui and server
# source("Shiny/ui_05052021.r")
# source("Shiny/server_18052021.r")

### run app
# shinyApp(server = server, ui = ui)

### runApp function (Colin way of running the app which shows the png images in folder www)
runApp("temp")


 a <- read.table("allNN_nolabel.txt",sep="\t",header=F)
 b <- read.table("label.txt",sep="\t",header=F)
 b1 <- as.factor(b)

 for (i in 1:nrow(a)){

 a1 <- as.numeric(a[i,])

 c <- data.frame(a1,b1)

 score_aov<-aov(a1~b1,data = c)

 x <- anova(score_aov)

 x1 <- x$ 'Pr(>F)'

 x2 <- as.matrix(x1)

 x3 <- x2[1,]

 write.table(x3,"gene_p.txt",sep = "\t", append=T ,quote=F, col.names=F, row.names=F)

}


bottom.contact.gating.depth = function( Z, good, bcp ) {

  ## Preliminary gating: simple range limits (gating) of depths to remove real extremes
  # eliminate records with NA for depth
  i = which(!is.finite(Z))
  if (length(i) > 0) good[i] = FALSE

  ##--------------------------------
  # eliminiate shallow records due to operation at sea level
  i = which(Z< bcp$depth.min )
  if (length(i) > 0) good[i] = FALSE

  zm = modes( Z[good] )
  zsd = zm$sd
  ir = which( Z < (zm$lb2 +bcp$depth.range[1]) | Z > (zm$ub2 + bcp$depth.range[2])  )  # a bit more inclusive as these are crude gates at an early stage
  if (length(ir) > 0) good[ir] =FALSE
  depth.bottom = zm$mode

  ##--------------------------------
  # eliminiate records that are shallower than a given percentage of the bottom depth
  i = which(  Z< ( bcp$depthproportion * depth.bottom ) )
  if (length(i) > 0) good[i] = FALSE
  # points( Z[good] ~ iz[good] , pch=20, col="green" )

  ##--------------------------------
  ## record filter
  depth.diff =  Z - depth.bottom
  i = which( depth.diff < bcp$depth.range[1] | depth.diff> bcp$depth.range[2])
  if (length(i) > 0) good[i] = FALSE
  # points( Z[good] ~ iz[good] , pch=20, col="cyan" )

  return(good)

}