# GetAuditFreqData.r
#                                       RBLandau 20171230
# where to run?
# setwd("C:/cygwin64/home/landau/working/PreservationSimulation/audit/frequency")
#
# For copies 3,4,5, what is the impact of more frequent total audits?
#

source("./DataUtil.r")
source("./PlotUtil.r")

# G E T   D A T A
if (exists("results")) {rm(results)}
results <- fndfGetGiantData("./")
# Get fewer columns to work with, easier to see.
dat.auditallcopies <- as.data.frame(fndfGetAuditData(results))
dat.auditall <- dat.auditallcopies[dat.auditallcopies$copies>=3
                & dat.auditallcopies$copies<=5,]

# S U B S E T S

if (nrow(dat.auditall) > 0)
{
    source("./AuditFreqPlots.r")

    dat.audit3 <- subset(dat.auditall, copies==3)
    gp <- fnPlotAuditFreq1(trows=dat.audit3, nCopies=3)
    plot(gp)
    fnPlotMakeFile(gp, "Audit_FrequencyComparisons_copies3_MonthToBiennial.png")

    dat.audit4 <- subset(dat.auditall, copies==4)
    gp <- fnPlotAuditFreq1(trows=dat.audit4, nCopies=4)
    plot(gp)
    fnPlotMakeFile(gp, "Audit_FrequencyComparisons_copies4_MonthToBiennial.png")

    dat.audit5 <- subset(dat.auditall, copies==5)
    gp <- fnPlotAuditFreq1(trows=dat.audit5, nCopies=5)
    plot(gp)
    fnPlotMakeFile(gp, "Audit_FrequencyComparisons_copies5_MonthToBiennial.png")

}

# Unwind any remaining sink()s to close output files.
while (sink.number() > 0) {sink()}

#END


library(rstan)
library(matrixStats)
library(data.table)
library(lubridate)
library(gdata)
library(dplyr)
library(tidyr)
library(EnvStats)
library(scales)
library(tidyverse)
library(dplyr)
library(abind)

library(ggplot2)
library(gridExtra)
library(ggpubr)
library(bayesplot)
library(cowplot)
library(optparse)

source("Brazil/code/preprocessing-subnation-brazil.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
Sys.setenv(DEBUG = "TRUE") # to run  in debug mode
if(is.null(cmdoptions$options$debug)) {
  DEBUG = Sys.getenv("DEBUG") == "TRUE"
} else {
  DEBUG = cmdoptions$options$debug
}
# Sys.setenv(FULL = "TRUE") # to run  in full mode
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'
} else {
  StanModel = cmdoptions$args[1]
}

args = cmdoptions$args
# if using rstudio change this, 1: pooling method, 2: formula to use, debug and full are either commandline or sys variable
if(length(args) == 0) {
  args = c('base')
}

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

####################################################################
#### Parameters to input:
forecast <- 7
N2 <- (max(as.Date(df$DateRep, format="%Y-%m-%d")) - min(as.Date(df$DateRep, format="%Y-%m-%d")) + 1 + forecast)[[1]]
countries <- c("RJ","SP","PE","CE","AM","BA","ES","MA","MG","PR","PA","RN","RS","SC","AL","PB")
####################################################################
processed_data <- process_data(countries,N2,df)
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('Brazil/code/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=1500,warmup=500,chains=8,thin=1,
                 control = list(adapt_delta = 0.95, max_treedepth = 15))
} else {
  fit = sampling(m,data=stan_data,iter=400,warmup=200,chains=4,thin=4,
                 control = list(adapt_delta = 0.95, max_treedepth = 10))
}

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

JOBID = Sys.getenv("PBS_JOBID")
if(JOBID == "")
  JOBID = as.character(abs(round(rnorm(1) * 1000000)))
print(sprintf("Jobid = %s",JOBID))
filename <- paste0(StanModel,'-',JOBID)
save(fit, dates, reported_cases,deaths_by_country, countries,
     prediction, estimated.deaths,stan_data,JOBID,df_pop,filename,df_region_codes,
     file=paste0('Brazil/results/',StanModel,'-',JOBID,'-stanfit.Rdata'))

################Code for plotting and making attack rate table#############
source('Brazil/code/plot-3-panel.r')
make_data_plot(filename)


library(arules)
library(arulesViz)
library(base)
library(methods)
library(modules)
library(rstudioapi)
library(tidyverse)
library(utils)

base::setwd(base::dirname(rstudioapi::getActiveDocumentContext()$path))
start <- base::Sys.time()

base::set.seed(0xACDC)

data_or <- modules::use('data')$get_data$get_data()

to_remove <- base::c()

for (i in 1:base::ncol(data_or)) {
  if (base::length(base::unique(data_or[, i])) > 2) {
    to_remove <- base::append(to_remove, i)
  }
}

data <- data_or[, -to_remove]

for (i in 1:base::ncol(data)) {
  data[, i] <- base::as.factor(data[, i])
}
base::rm(i, to_remove)

data = methods::as(data, 'transactions')

rules <-
  arules::apriori(data,
                  parameter = base::list(
                    supp = 0.01,
                    conf = 0.5,
                    maxtime = 0
                  ))

rules <-
  rules[-base::which(Matrix::colSums(arules::is.subset(rules, rules)) > 1)]

subrules <- rules[arules::quality(rules)$coverage < 1]

base::plot(subrules, method = 'graph')

base::print(base::Sys.time() - start)
base::rm(start)


# Get T-Bar locations for select cell types. To test alignment to atlas space.
# Turner, Mann, Clandinin.
# https://github.com/mhturner/SC-FC
# mhturner@stanford.edu

library(nat.flybrains)
library(nat.jrcbrains)
library(nat.h5reg)
library(neuprintr)
library(dplyr)
library(bioimagetools)

options(warn=1)

# Input arg Cell type: LC, MBON, OPN, KC, ER, LNO (see below)
cell_type <- commandArgs(trailingOnly = TRUE)

data_dir = '/oak/stanford/groups/trc/data/Max/flynet/data'

# load atlas in JRC2018 space
res = 0.38 # um/voxel of atlas
ito_atlas <- bioimagetools::readTIF(file.path(data_dir, 'template_brains', 'ito_2018.tif'), as.is=TRUE)

# Craft neuprint cell search based on cell type
if (cell_type == 'LC'){
  neur = neuprint_search("LC[0-9].*", field = "type", meta=TRUE)
} else if (cell_type == 'MBON') {
  neur = neuprint_search("MBON[0-9][0-9]", field = "type", meta=TRUE)
} else if (cell_type == 'OPN') {
  neur = neuprint_search(".*vPN.*", field = "type", meta=TRUE)
} else if (cell_type == 'KC') {
  neur = neuprint_search("KCab-c", field = "type", meta=TRUE)
} else if (cell_type == 'ER') {
  neur = neuprint_search("ER.*", field = "type", meta=TRUE)
} else if (cell_type == 'LNO') {
  neur = neuprint_search("LNO.*", field = "type", meta=TRUE)
}

body_ids = neur$bodyid
# body_ids = body_ids[1:100] # testing
body_ids = neuprint_ids(body_ids)

# get synapses and types associated with bodies
syn_data = neuprint_get_synapses(body_ids)
syn_data = syn_data[!duplicated(syn_data[2:5]),] # remove duplicate T-bar locations (single t-bar -> multiple postsynapses)
types = neuprint_get_meta(body_ids)$type

# convert hemibrain raw locations to microns
syn_data[,c("x", "y", "z")] = syn_data[,c("x", "y", "z")] * 8/1000 # vox -> um
# Go from hemibrain space to JRC2018 space
syn_data[,c("x", "y", "z")] = xform_brain(syn_data[,c("x", "y", "z")], sample = JRCFIB2018F, reference = JRC2018F) / res # x,y,z um -> atlas voxels
# get output synapses (Tbars)
output_synapses = as.data.frame(syn_data[syn_data$prepost==0, c("x", "y", "z", "bodyid")])

cols = unique(types)
ito_tbar <- data.frame(matrix(0, ncol = length(cols), nrow = max(ito_atlas)))
colnames(ito_tbar) <- cols

for (i in seq_along(body_ids)){
  body_id = body_ids[i]
  type = types[i]
  output_yxz = data.matrix(output_synapses[output_synapses$bodyid==body_id, c("y", "x", "z")])
  mode(output_yxz) = 'integer' # floor to int to index

  # Find ito regions where tbars are
  output_regions = ito_atlas[output_yxz]
  output_regions = output_regions[output_regions!=0]
  output_tab = table(output_regions)
  output_regions = as.numeric(names(output_tab))  # now unique regions
  output_counts = as.vector(output_tab)

  if (length(output_regions) > 0){
    ito_tbar[output_regions, type] = ito_tbar[output_regions, type] + output_counts
  }

} # end body_ids

write.csv(ito_tbar, file.path(data_dir, 'hemi_2_atlas', paste(cell_type, 'ito_tbar.csv', sep='_')))


pdf_file<-"pdf/radial_columncharts_4x4_inc.pdf"
cairo_pdf(bg=rgb(0.3137,0.3137,0.3137), pdf_file,width=18,height=18)

par(omi=c(0,0,0,0),family="Lato Light",mfcol=c(4,4))
library(plotrix)
mySelection<-c("AUS","CAN","CZE","FRA","GRC","DEU","IRL","ITA","JPN","KOR", "NOR","POL","SWE","TUR","GBR","USA")
source("scripts/inc_data_radial_columncharts.r")
source("scripts/inc_colours_radial_columncharts.r")
myGridColour<-par("bg")
myRadial_mar<-c(0,0,2,0)
myMLine<-0
myNames<-rep("", (length(myData)-2))
source("scripts/inc_plot_radial_columncharts.r")
dev.off()


#' Mutable ranges have a two methods (`train` and `reset`), and make
#' it possible to build up complete ranges with multiple passes.
#'
#' These range objects should be instantiated with
#' [continuous_range()] and [discrete_range()].
#'
#' @noRd
Range <- ggproto("Range", NULL,
  range = NULL,
  reset = function(self) {
    self$range <- NULL
  }
)

RangeDiscrete <- ggproto("RangeDiscrete", Range,
  train = function(self, x, drop = FALSE, na.rm = FALSE) {
    self$range <- scales::train_discrete(x, self$range, drop = drop, na.rm = na.rm)
  }
)

RangeContinuous <- ggproto("RangeContinuous", Range,
  train = function(self, x) {
    self$range <- scales::train_continuous(x, self$range)
  }
)

continuous_range <- function() {
  ggproto(NULL, RangeContinuous)
}

discrete_range <- function() {
  ggproto(NULL, RangeDiscrete)
}


#######DESCRIPTION###############################
#processes raw altimetry data from Charon Birkett UMd
#outputs rdata object and csv
#################################################
##load libraries
library(dplyr)
library(data.table)
library(readr)
library(tidyr)
nasa_base_date = as.Date('1958-01-01')
##user inputs
#raw file location
dir_raw = '/Volumes/gonggong/flood forecasting/data/raw/altimetry/'
#output location
dir_dat = '/Volumes/gonggong/flood forecasting/data/'
run_name = 'alt_jan15a'
#process raw files
alt_list = list.files(paste0(dir_raw), pattern = '.txt')
alt_names = substr(do.call(rbind, strsplit(alt_list, '.try'))[, 2], 1, 3)
alt_sta = as.numeric(substr(alt_names, 1, 2))
alt_stavar = substr(alt_names, 3, 3)
alt_dt = NULL
for(i in 1:length(alt_list)){
	alt_temp = data.table(read.table(paste0(dir_raw, alt_list[i]),
		skip = 6, header = T))
	fileName = paste0(dir_raw, alt_list[i])
	alt_meta = readChar(fileName, file.info(fileName)$size)
	alt_meta = substr(alt_meta, 0, 331)
	refalt = as.numeric(unlist(strsplit(alt_meta, '='))[12])
	alt_name = alt_names[i]
	alt_temp = alt_temp %>% dplyr::mutate(sta = alt_sta[i], stavar = alt_stavar[i], refalt = refalt)
	alt_dt = rbind_list(alt_dt, alt_temp)
}
alt_dt = alt_dt %>% data.table() %>% dplyr::mutate(date = nasa_base_date + timday, alt = avhgt + refalt, sta = as.numeric(sta)) %>% dplyr::select(date, sta, stavar, avhgt, error, totbias, alt)
#output processed files
write.csv(alt_dt, paste0(dir_dat, run_name, '.csv'), row.names = F)
saveRDS(alt_dt, paste0(dir_dat, run_name, '.rda'))


library(tidyverse)
library(lme4)
library(ggrepel)
library(ggbeeswarm)
source("C:/Jessica_data_analysis/R/Inventory/AccuracyAssessment.R")
source("C:/Jessica_data_analysis/R/Disertation/rescalechange.r")

#function
#####################
pvalue_fun <- function(p.value){
  if(is.na(p.value)){
    NA_character_
  }else if(p.value > 0.05){
    "> 0.05"
  }else if(p.value < 0.05 & p.value > 0.01){
    "< 0.05"
  }else if(p.value < 0.01 & p.value > 0.001){
    "< 0.01"
  }else if(p.value < 0.001){
    "< 0.001"
  }else {
    "something went wrong"
  }
}

pvalue_star <- function(p.value){
  if(is.na(p.value)){
    NA_character_
  }else if(p.value > 0.05){
    "."
  }else if(p.value < 0.05 & p.value > 0.01){
    "*"
  }else if(p.value < 0.01 & p.value > 0.001){
    "**"
  }else if(p.value < 0.001){
    "***"
  }else {
    "something went wrong"
  }
}

stat_paste_fun <- function(stat, log = FALSE){
  if(log != TRUE){
    paste0(str_remove_all(stat[["method"]][[1]], "\n\t"), ": ",
           str_remove_all(names(stat[["statistic"]]), "Kruskal-Wallis "), " = ",
           round(stat[["statistic"]][[1]],1), ", ",
           if(length(stat[["parameter"]]) == 0)
           {""
           }else if(is.na(stat[["parameter"]])){
             ""
           }else if(length(stat[["parameter"]]) > 0){
             paste0("df = ", round(stat[["parameter"]], 0), ", ")
           } ,
           "p-value ",  pvalue_fun(stat[["p.value"]]))
  }else{
    paste0(str_remove_all(stat[["method"]][[1]], "\n\t"), " (log y): ",
           str_remove_all(names(stat[["statistic"]]), "Kruskal-Wallis "), " = ",
           round(stat[["statistic"]][[1]],1), ", ",
           if(length(stat[["parameter"]]) == 0)
           {""
           }else if(is.na(stat[["parameter"]])){
             ""
           }else if(length(stat[["parameter"]]) > 0){
             paste0("df = ", round(stat[["parameter"]], 0), ", ")
           } ,
           "p-value ",  pvalue_fun(stat[["p.value"]]))
  }
}

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

#data import
###########################
data <- read_csv("Barbara_full_dataset_Bangor.csv")

flow <- read_csv("flow.csv")
##########################

#clean
##########################
long <- data|>
  select(-contains("RSV"), -contains("phi6"))|>
  group_by(sample_site_name, timestamp_sample_collected, timestamp_sample_received)|>
  mutate(biorep = row_number())|>
  pivot_longer(cols = contains("_gc_l"), names_to = "con_vir", values_to = "gc_l")|>
  separate(con_vir, into = c("method", "virus"), sep = "_", extra = "drop")|>
  filter(method != "SN")#, !str_detect(virus, "Flu|MeV|RoV|EVD68"))

long_sc <- long|>
  ungroup()|>
  mutate(gc_l_log = log10(gc_l),
         sample_ph_pre_ansis = scale(sample_ph_pre_ansis)[,1],
         conductivity_ms_cm = scale(conductivity_ms_cm)[,1],
         ammonia_mg_l = scale(ammonia_mg_l)[,1],
         ophosph_mg_l = scale(ophosph_mg_l)[,1],
         Turbidity = scale(Turbidity)[,1])

diff <- long_sc|>
  select(-gc_l_log)|>
  pivot_wider(names_from = "method", values_from = "gc_l")|>
  group_by(virus)|>
  mutate(
      #PEG = rescale01(PEG),
      #AM = rescale01(AM),
      PEG_divby_AM = PEG / AM,
        AM_divby_PEG = AM / PEG)|>
  filter(PEG != 0, AM != 0,
         PEG_divby_AM < 10 & AM_divby_PEG < 10)

outliers <- diff|>
  filter(PEG_divby_AM > 10 | AM_divby_PEG > 10)|>
  select(-PEG_divby_AM)|>
  pivot_wider(names_from = "virus", values_from = c("PEG", "AM"))|>
  select("sample_id", "sample_site_name", "sample_site_code", "grab_compo_ind" ,
         "timestamp_sample_collected", "timestamp_sample_received" ,
         contains("CrAss"), contains("N1"), contains("Flu"),
         contains("EVD68"), contains("EV"), contains("NoVGII"),  contains("NoV"))

flow_clean <- flow|> #not done....
  mutate(site = str_replace_all(site, c("Barnoldswick STW" = "BARNOLDSWICK STW",
                                        "Cambridge STW" = "CAMBRIDGE STW"
                                        )))
#################################

diff|>
  ggplot(aes(sample = log(PEG_divby_AM)))+
  geom_qq()+
  geom_qq_line()

diff|>
  ggplot(aes(log(PEG_divby_AM)))+
  geom_histogram(bins = 70)

diff|>
  ggplot(aes(sample = log(AM_divby_PEG)))+
  geom_qq()+
  geom_qq_line()

diff|>
  ggplot(aes(log(AM_divby_PEG)))+
  geom_histogram(bins = 70)

#mean comp
###########################
meth_comp_data <- semi_join(long_sc, diff,
                            by = c("sample_site_name",
                                   "timestamp_sample_collected",
                                   "timestamp_sample_received", "biorep", "virus"))

#mean_adj_gc_l <- meth_comp_data|>
#  group_by(virus)|>
#  mutate(mean = mean(gc_l, na.rm = TRUE),
#         gc_l = gc_l - mean,
#         virus = "Combined mean adj.")|>
#  select(-mean)

#meth_comp_data_wadj <- meth_comp_data|>
#  bind_rows(mean_adj_gc_l)

qq_meth_comp <- meth_comp_data|>
  group_by(virus)|>
  mutate(row = row_number())|>
  ggplot(aes(sample = log10(gc_l)))+
  geom_qq()+
  geom_qq_line()+
  facet_grid(method ~ virus, scales = "free")

viruses_t.test <- meth_comp_data|>
  group_by(virus)|>
  summarise(max = max(gc_l, na.rm = T),
            min = min(gc_l, na.rm = T),
            mean = mean(gc_l, na.rm = T))|>
  bind_cols(stat = NA_character_,
            row = 1)

for (i in 1:nrow(viruses_t.test )) {
  filt_virus <- viruses_t.test [i,1][[1]]

  viruses_t.test [i,5] <- stat_paste_fun(t.test(gc_l_log ~ method, data = filter(meth_comp_data, virus == filt_virus)), log = TRUE)

}

meth_comp_data|>
  group_by(virus)|>
  mutate(row = row_number())|>
  left_join(viruses_t.test, by = c("virus", "row"))|>
  ggplot(aes(method, gc_l))+
  geom_boxplot(outlier.shape = NA)+
  geom_beeswarm(cex = 1.5, size = 1.5)+
  geom_beeswarm(cex = 1.5, colour = "white", shape = ".")+
  geom_text(aes(label = stat, x = 1.5, y = max + (0.07 * (max - min))), size = 3)+
  facet_wrap(~virus, scale = "free")

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

#peg_div_am
######################################
boxcox <- MASS::boxcox(PEG_divby_AM ~ virus + sample_ph_pre_ansis + ammonia_mg_l + ophosph_mg_l + conductivity_ms_cm + Turbidity,
                       data = diff)

boxcoxlambda <- boxcox$x[which.max(boxcox$y)]

boxcox_trans <- function(x, lambda){
  (x ^ lambda - 1) / lambda
}

lmm_bc <- lmer(PEG_divby_AM ~ (1|virus) +
                sample_ph_pre_ansis + ammonia_mg_l + ophosph_mg_l + conductivity_ms_cm + Turbidity,
              data = mutate(diff, PEG_divby_AM = boxcox_trans(PEG_divby_AM, boxcoxlambda)))

plot_assumptions(lmm_bc,
                 mutate(diff, PEG_divby_AM = boxcox_trans(PEG_divby_AM, boxcoxlambda))|>
                   filter(!is.na(PEG_divby_AM))|>
                   pull(PEG_divby_AM))

as_tibble(summary(lmm_bc)[["coefficients"]], rownames = "variables")|>
  mutate(variables = str_replace_all(variables, c("methodPEG" = "PEG",
                                                  "methodAM" = "AM",
                                                  "sample_ph_pre_ansis" = "pH",
                                                  "ammonia_mg_l" = "Ammonia",
                                                  "ophosph_mg_l" = "Orthophosphate",
                                                  "conductivity_ms_cm" = "Conductivity")),
         CI90 = (`Std. Error`*1.65),
         CI95 = (`Std. Error`*1.96),
         CI99 = (`Std. Error`*2.59),
         label99 = c("99% CI", rep(NA_character_, 5)),
         label95 = c( "95% CI", rep(NA_character_, 5)),
         label90 = c( "90% CI", rep(NA_character_, 5)))|>
  #filter(!str_detect(variables, "ntercept"))|>
  ggplot(aes( Estimate, variables))+
  geom_point(shape = 16, fill = "red")+
  geom_errorbar(aes(xmin = Estimate - CI99,
                    xmax = Estimate + CI99), width = 0.2)+
  geom_errorbar(aes(xmin = Estimate - CI95,
                    xmax = Estimate + CI95), colour = "grey40", width = 0.2)+
  geom_errorbar(aes(xmin = Estimate - CI90,
                    xmax = Estimate + CI90), colour = "grey50", width = 0.2)+
  geom_text_repel(aes(x = (Estimate + CI99), label = label99), nudge_y = 0.5)+
  geom_text_repel(aes(x = (Estimate + CI95), label = label95), nudge_y = 0.5, colour = "grey40")+
  geom_text_repel(aes(x = (Estimate + CI90), label = label90), nudge_y = 0.5, colour = "grey50")+
  geom_vline(xintercept = 0)
#########################

#am div peg
##########################
boxcox2 <- MASS::boxcox(AM_divby_PEG ~ virus + sample_ph_pre_ansis + ammonia_mg_l + ophosph_mg_l + conductivity_ms_cm + Turbidity,
                       data = diff)

boxcoxlambda2 <- boxcox2$x[which.max(boxcox2$y)]

boxcox_trans <- function(x, lambda){
  (x ^ lambda - 1) / lambda
}

lmm_bc2 <- lmer(AM_divby_PEG ~ (1|virus) +
                 sample_ph_pre_ansis + ammonia_mg_l + ophosph_mg_l + conductivity_ms_cm + Turbidity,
               data = mutate(diff, AM_divby_PEG = boxcox_trans(AM_divby_PEG, boxcoxlambda2)))

plot_assumptions(lmm_bc2,
                 mutate(diff, AM_divby_PEG = boxcox_trans(AM_divby_PEG, boxcoxlambda2))|>
                   filter(!is.na(AM_divby_PEG))|>
                   pull(AM_divby_PEG))

#plot(lm(AM_divby_PEG ~ virus + sample_ph_pre_ansis + ammonia_mg_l + ophosph_mg_l + conductivity_ms_cm + Turbidity,
#        data = mutate(diff, AM_divby_PEG = boxcox_trans(AM_divby_PEG, boxcoxlambda2))))

as_tibble(summary(lmm_bc2)[["coefficients"]], rownames = "variables")|>
  mutate(variables = str_replace_all(variables, c("methodPEG" = "PEG",
                                                  "methodAM" = "AM",
                                                  "sample_ph_pre_ansis" = "pH",
                                                  "ammonia_mg_l" = "Ammonia",
                                                  "ophosph_mg_l" = "Orthophosphate",
                                                  "conductivity_ms_cm" = "Conductivity")),
         CI90 = (`Std. Error`*1.65),
         CI95 = (`Std. Error`*1.96),
         CI99 = (`Std. Error`*2.59),
         label99 = c("99% CI", rep(NA_character_, 5)),
         label95 = c( "95% CI", rep(NA_character_, 5)),
         label90 = c( "90% CI", rep(NA_character_, 5)))|>
  #filter(!str_detect(variables, "ntercept"))|>
  ggplot(aes( Estimate, variables))+
  geom_point(shape = 16, fill = "red")+
  geom_errorbar(aes(xmin = Estimate - CI99,
                    xmax = Estimate + CI99), width = 0.2)+
  geom_errorbar(aes(xmin = Estimate - CI95,
                    xmax = Estimate + CI95), colour = "grey40", width = 0.2)+
  geom_errorbar(aes(xmin = Estimate - CI90,
                    xmax = Estimate + CI90), colour = "grey50", width = 0.2)+
  geom_text_repel(aes(x = (Estimate + CI99), label = label99), nudge_y = 0.5)+
  geom_text_repel(aes(x = (Estimate + CI95), label = label95), nudge_y = 0.5, colour = "grey40")+
  geom_text_repel(aes(x = (Estimate + CI90), label = label90), nudge_y = 0.5, colour = "grey50")+
  geom_vline(xintercept = 0)
#######################

qt(1 - 0.001 / 2,  (round(348/2)) - 1)

glmm <- glmer(PEG_divby_AM ~ (1|virus) +
              sample_ph_pre_ansis + ammonia_mg_l + ophosph_mg_l + conductivity_ms_cm + Turbidity, family = Gamma(link = vlog(boxcoxlambda)),
            data = diff)

lm <- lm(PEG_divby_AM ~ 1, data = diff)

boxcox$x[which.max(boxcox$y)]

plot_assumptions(lmm, filter(diff, !is.na(PEG_divby_AM))$PEG_divby_AM)

as_tibble(summary(lmm)[["coefficients"]], rownames = "variables")|>
  mutate(variables = str_replace_all(variables, c("methodPEG" = "PEG",
                                                  "methodAM" = "AM",
                                                  "sample_ph_pre_ansis" = "pH",
                                                  "ammonia_mg_l" = "Ammonia",
                                                  "ophosph_mg_l" = "Orthophosphate",
                                                  "conductivity_ms_cm" = "Conductivity")),
         CI90 = (`Std. Error`*1.65),
         CI95 = (`Std. Error`*1.96),
         CI99 = (`Std. Error`*2.59),
         label99 = c("99% CI", rep(NA_character_, 5)),
         label95 = c( "95% CI", rep(NA_character_, 5)),
         label90 = c( "90% CI", rep(NA_character_, 5)))|>
  #filter(!str_detect(variables, "ntercept"))|>
  ggplot(aes( Estimate, variables))+
  geom_point(shape = 16, fill = "red")+
  geom_errorbar(aes(xmin = Estimate - CI99,
                     xmax = Estimate + CI99), width = 0.2)+
  geom_errorbar(aes(xmin = Estimate - CI95,
                     xmax = Estimate + CI95), colour = "grey40", width = 0.2)+
  geom_errorbar(aes(xmin = Estimate - CI90,
                     xmax = Estimate + CI90), colour = "grey50", width = 0.2)+
  geom_text_repel(aes(x = (Estimate + CI99), label = label99), nudge_y = 0.5)+
  geom_text_repel(aes(x = (Estimate + CI95), label = label95), nudge_y = 0.5, colour = "grey40")+
  geom_text_repel(aes(x = (Estimate + CI90), label = label90), nudge_y = 0.5, colour = "grey50")+
  geom_vline(xintercept = 0)

lmm2 <- glmer(AM_divby_PEG ~ (1|virus) +
               sample_ph_pre_ansis + ammonia_mg_l + ophosph_mg_l + conductivity_ms_cm + Turbidity, family = Gamma(link = "log"),
             data = diff)

plot_assumptions(lmm2, filter(diff, !is.na(PEG_divby_AM))$PEG_divby_AM)

as_tibble(summary(lmm2)[["coefficients"]], rownames = "variables")|>
  mutate(variables = str_replace_all(variables, c("methodPEG" = "PEG",
                                                  "methodAM" = "AM",
                                                  "sample_ph_pre_ansis" = "pH",
                                                  "ammonia_mg_l" = "Ammonia",
                                                  "ophosph_mg_l" = "Orthophosphate",
                                                  "conductivity_ms_cm" = "Conductivity")),
         CI90 = (`Std. Error`*1.65),
         CI95 = (`Std. Error`*1.96),
         CI99 = (`Std. Error`*2.59),
         label99 = c("99% CI", rep(NA_character_, 5)),
         label95 = c( "95% CI", rep(NA_character_, 5)),
         label90 = c( "90% CI", rep(NA_character_, 5)))|>
  #filter(!str_detect(variables, "ntercept"))|>
  ggplot(aes( Estimate, variables))+
  geom_point(shape = 16, fill = "red")+
  geom_errorbar(aes(xmin = Estimate - CI99,
                    xmax = Estimate + CI99), width = 0.2)+
  geom_errorbar(aes(xmin = Estimate - CI95,
                    xmax = Estimate + CI95), colour = "grey40", width = 0.2)+
  geom_errorbar(aes(xmin = Estimate - CI90,
                    xmax = Estimate + CI90), colour = "grey50", width = 0.2)+
  geom_text_repel(aes(x = (Estimate + CI99), label = label99), nudge_y = 0.5)+
  geom_text_repel(aes(x = (Estimate + CI95), label = label95), nudge_y = 0.5, colour = "grey40")+
  geom_text_repel(aes(x = (Estimate + CI90), label = label90), nudge_y = 0.5, colour = "grey50")+
  geom_vline(xintercept = 0)

library(ggeffects)
ggpredict(lmm, terms = c("ammonia_mg_l"))|>
  ggplot() +
  geom_line(aes(x = x, y = predicted)) +          # slope
  geom_ribbon(aes(x = x, ymin = predicted - std.error, ymax = predicted + std.error),
              fill = "lightgrey", alpha = 0.5) +  # error band
  geom_point(data = diff,                      # adding the raw data (scaled values)
             aes(x = ammonia_mg_l, y = PEG_divby_AM)) + #, colour = virus
  labs(x = "Ammonia (mg/l)", y = "log10 (PEG / AM)")+
  scale_y_log10()

lmm <- lmer(gc_l_log ~ 0 + (1|virus) + (1|method) +
              method:sample_ph_pre_ansis + method:ammonia_mg_l + method:ophosph_mg_l + method:conductivity_ms_cm + method:Turbidity,
                   data = filter(long, !is.infinite(gc_l_log)), REML = FALSE)
summary(lmm)
plot_assumptions(lmm, filter(long, !is.infinite(gc_l_log), !is.na(gc_l_log))$gc_l_log)

as_tibble(summary(lmm)[["coefficients"]], rownames = "variables")|>
  mutate(variables = str_replace_all(variables, c("methodPEG" = "PEG",
                                                  "methodAM" = "AM",
                                                  "sample_ph_pre_ansis" = "pH",
                                                  "ammonia_mg_l" = "Ammonia",
                                                  "ophosph_mg_l" = "Orthophosphate",
                                                  "conductivity_ms_cm" = "Conductivity")))|>
    #filter(!str_detect(variables, "ntercept"))|>
    ggplot(aes( Estimate, variables))+
    geom_point(shape = 16, fill = "red")+
    geom_linerange(aes(xmin = Estimate - (`Std. Error`*1.96),
                       xmax = Estimate + (`Std. Error`*1.96)))+
    geom_vline(xintercept = 0)

qt(1 - 0.01 / 2,  (round(973/2)) - 1)

    geom_text(aes(Variables, Estimate, label = paste(round(Estimate,2), p.value)), nudge_x = 0.2)+
    ylab("Coefficients")+
    coord_flip()+
    theme_bw())

(random_effect_varience_lmm_sur <- summary(lmm_sur_sc)[["varcor"]][["method"]][[1]])


# Load packages needed for DeployR
require(deployrUtils)
deployrPackage("RevoScaleR")

load("pricingModel.rda")
load("inputExample.rda")

# age, gender and product selected are inputs to the service
inputExample[1,]$age <- as.numeric(age)
inputExample[1,]$gender <- gender
inputExample[1,]$productSelected <- productSelected

prediction <- rxPredict(pricingModel, data = inputExample)


library('plyr')
library('ggplot2')
library('outliers')
library('gridExtra')

args <- commandArgs(trailingOnly = TRUE)

df <- read.csv (
	args[1],
	col.names = c('event','class','method','source','version','time'),
	stringsAsFactors = FALSE)

removeCol <- function (c)
	function (df)
		df[,!(names(df) %in% c)]

renameCol <- function (c)
	function (df)
		rename(df,c)

compose <- function (f,g)
	function (x)
		f(g(x))

plotClass <- function(df,class) {
	sub <- rm.outlier(df[df$class == class,]$delta)
	qplot(sub / 1e6) +
		xlab('latency (ms)') +
		ylab('count') +
		ggtitle(class) +
		geom_histogram()
}

plotClassMethod <- function(df,class,method) {
	df <- df[df$class == class,]
	sub <- rm.outlier(df[df$method == method,]$delta)
	qplot(sub / 1e6) +
		xlab('latency (ms)') +
		ylab('count') +
		ggtitle(paste(class,method)) +
		geom_histogram()
}

plotMethod <- function(df,method) {
	sub <- rm.outlier(df[df$method == method,]$delta)
	qplot(sub / 1e6) +
		xlab('latency (ms)') +
		ylab('count') +
		ggtitle(paste(method)) +
		geom_histogram()
}

df1 <- df[!(df$class %in% c('JsonPrettyPrinter', 'MontoParseController')),]
start <- compose(renameCol(c('time' ='start')),removeCol('event')) (df1[df1$event == 'start',])
end <- compose(renameCol(c('time' ='end')),removeCol('event')) (df1[df1$event == 'end',])
df2 <- transform(merge(start,end),delta = end - start)

classes <- unique(df2$class)

pdf(file=paste("products-",args[2],sep=""))
grid.arrange(
	plotClass(df2,"JavaTokenizer"),
	plotClass(df2,"JavaParser"),
	plotClass(df2,"JavaOutliner"),
	plotClass(df2,"JavaCodeCompletion"),
	ncol=2)
dev.off()

pdf(file=paste("versionmsg-",args[2],sep=""))
grid.arrange(
	plotClassMethod(df2,"VersionMessage","encode"),
	plotClassMethod(df2,"VersionMessage","decode"),
	ncol=2)
dev.off()

# calculate round trip

df1 <- df[df$class == 'MontoParseController',]
start <- compose(renameCol(c('time' ='start')),removeCol('event')) (df1[df1$event == 'start',])
end <- compose(renameCol(c('time' ='end')),removeCol('event')) (df1[df1$event == 'end',])
df2 <- transform(merge(start,end,by=c('class','source','version')),delta = end - start)
df2 <- compose(renameCol(c('method.y'='method')), removeCol('method.x')) (df2)

pdf(file=paste("roundtrip-",args[2],sep=""))
grid.arrange(
	plotMethod(df2,"product_tokens"),
	plotMethod(df2,"product_outline"),
	plotMethod(df2,"product_completions"),
	ncol=2)
dev.off()


#Read no. of species, years and seasons

Read.SMS.dat<-function(dir=data.path){
    info<<-scan(file.path(dir,"sms.dat"),comment.char = "#")
    i<-3
    years<<-info[i:(i+1)]
    i<-i+2
    nyr<<-years[2]-years[1]+1

    l.model.y<<-info[i]
    i<-i+1
    seasons<<-rep(1,2)
    seasons[2]<<-info[i]
    i<-i+1
    n.seasons<<-seasons[2]-seasons[1]+1
    last.season.last.year<<-info[i]
    i<-i+1
    nsp<<-info[i]    #no. of species
    i<-i+1
    fa<<-info[i]     #first age all species
    i<-i+1
    rec.season<<-info[i]
    i<-i+1
    maximum.age.all.species<<-info[i]
    i<-i+1           #counter in info file
    SP.settings<<-t(matrix(info[i:(i+nsp*8-1)],nrow=8,ncol=nsp))

    for (ii in (1:nsp))  if (SP.settings[ii,6]!=2) { first.VPA<<-ii; break;} #first VPA  species number
    for (ii in (1:nsp))  if (SP.settings[ii,6]==0) { npr<<-ii-1; break;}  #no. of predators

    i<-i+nsp*8
    beta.cor<<-info[i:(i+nsp-first.VPA)]

    i<-i+nsp-first.VPA+1
    SSB.R.first.year<<-info[i:(i+nsp-first.VPA)]
    SSB.R.first.year[SSB.R.first.year==-1]<<-years[1]

    i<-i+nsp-first.VPA+1
    SSB.R.last.year<<-info[i:(i+nsp-first.VPA)]
    SSB.R.last.year[SSB.R.last.year==-1]<<-years[2]

    SMS.control<<-read.FLSMS.control()

}


args = commandArgs(trailingOnly=TRUE)
cwd = args[1]
window = as.numeric(args[2]) # number of time steps in window
w_center = as.numeric(args[3]) # ref time step size (first time in window)
maxplots = as.numeric(args[4]) # limit # plots
ref_dir = paste0(cwd, "/eof-w", window, "-c", w_center, "/")

suppressMessages(library(pbdMPI))
suppressMessages(library(rhdf5))
suppressMessages(library(pbdIO))
suppressMessages(library(kazaam))
suppressMessages(library(ggplot2))
source("function_def.r")

myrank = comm.rank()
commsize = comm.size()

## note file names and variable names specfic to fusion data
data_dir = "your_data_directory"
file_mesh= paste0(data_dir, "xgc.mesh.h5")
file_var = paste0(data_dir, "xgc.3d.#####.h5")
var = "dpot"

## Crate output directories
screedir = paste0(ref_dir, "scree/")
ref = sprintf("%0.5d", w_center)
plotdir = paste0(ref_dir, "plots", ref, "/")
if(myrank == 0) { # only one rank should be creating a directory
    dir.create(ref_dir, showWarnings=FALSE)
    dir.create(screedir, showWarnings=FALSE)
    dir.create(plotdir, showWarnings=FALSE)
}
barrier() # must be reachable by all ranks

## read the xgc mesh file
mesh = read_xgc_mesh(file_mesh)$rz

## read a window of steps and create tensor array as list with attributes
##    mesh dimension is split across ranks
tens = read_xgc_window(file_var, var, w_center, window)$Data
tdim = dim(tens) # tensor dimensions (1, 2, 3d) = (toro, time, mesh)

## u1 slices: want dimensions (1, 3d*2) - need tshaq
u1tens = as.vector(tens) # (1, 2, 3d)
dim(u1tens) = c(tdim[1], tdim[2]*tdim[3]) # (1, 2*3d)
u1tens.s = tshaq(u1tens) # (1, 2*3d) tshaq
u1svd = svd(u1tens.s)
scree_plots(u1svd$d, paste0(ref, "u1"), myrank)

## u3 mesh: want dimensions (3d, 1*2) - need shaq of transpose
u3tens = as.vector(tens) # (1, 2, 3d)
dim(u3tens) = c(tdim[1]*tdim[2], tdim[3]) # dim (1*2, 3d)
u3tens.s = shaq(t(u3tens)) # transposed so dim (3d, 1*2) shaq
u3svd = svd(u3tens.s)
scree_plots(u3svd$d, paste0(ref, "u3"), myrank)
space_plots(mesh, u3svd$d, DATA(u3svd$u), maxplots, myrank, tag="u3")

## u2 time: want dimensions (2, 1*3d) - need tshaq
## Note that tens has dims (toro, time, mesh) and we want an unfolding
##      with (time, toro*mesh). Respecting contiguous sections, we can
##      use u3tens with rows indexed by (toro, time) -> (time, toro)
rindex = rep(tdim[2]*(1:tdim[1] - 1), times=tdim[2]) +
    rep(1:tdim[2], each=tdim[1]) # reorders (1*2, 3d) to (2*1, 3d)
u2tens = u3tens[rindex, ] # reordered to (2, 1, 3d) dim (2*1, 3d)
dim(u2tens) = c(tdim[2], tdim[1]*tdim[3]) # dim (2, 1*3d)
u2tens.s = tshaq(u2tens) # (2, 1*3d)
u2svd = svd(u2tens.s)
scree_plots(u2svd$d, paste0(ref, "u2"), myrank)

## Core tensor computation
u1core1 = crossprod(u1svd$u, u1tens) # dim (1, 2*3d), all local op

u3core1 = as.vector(u1core1) # (1, 2, 3d)
dim(u3core1) = c(tdim[1]*tdim[2], tdim[3]) # dim (1*2, 3d)
u2core1 = u3core1[rindex, ] # reordered to (2, 1, 3d) dim (2*1, 3d)
dim(u2core1) = c(tdim[2], tdim[1]*tdim[3]) # dim (2, 1*3d)
u2core21 = crossprod(u2svd$u, u2core1) # dim(2, 1*3d), all local

u3core21 = as.vector(u2core21) # (2, 1, 3d)
dim(u3core21) = c(tdim[2]*tdim[1], tdim[3]) # dim (2*1, 3d)
u3core321 = crossprod(u3svd$u, shaq(t(u3core21))) # dim (3td, 2*1)
## Note that 3td = 2*1 as 3 > 2*1 leads to 3 - 2*1 zero eigenvalues
##      so that leading dimension of u3core321 is 2*1 instead of 3.
##      u3core ends up a local matrix that is replicated. The shaq
##      crossprod collapses the long dimension.

## Now apply u2svd to whiten over time (it's a local operation!)
##     removes time covariance structure iid implications and systematic bias.
w2u2tens = crossprod(diag(1/u2svd$d) %*% u2svd$u, u2tens) # still (2*1, 3d)

## next reorder whitened to make u3 and redo u3 svd
w2u3tens = as.vector(w2u2tens) # (2, 1, 3d)
dim(w2u3tens) = c(tdim[2]*tdim[1], tdim[3]) # dim (2*1, 3d)
w2u3tens.s = shaq(t(w2u3tens)) # transposed so dim (3d, 2*1)
w2u3svd = svd(w2u3tens.s)
scree_plots(w2u3svd$d, paste0(ref, "w2u3"), myrank)
space_plots(mesh, w2u3svd$d, DATA(w2u3svd$u), maxplots, myrank, tag="w2u3")

## take u2-whitened and apply u1 whitening. Having systematic toro
##     distances may have iid implications and systematic bias.
w2u1tens = w2u3tens[order(rindex), ] # reverses (2*1, 3d) back to (1*2, 3d)
dim(w2u1tens) = c(tdim[1], tdim[2]*tdim[3]) # dim (1, 2*3d)
w1w2u1tens = crossprod(diag(1/u1svd$d) %*% u1svd$u, w2u1tens)

## next reoder w1w2u1 into u3 and redo u3 svd
w1w2u3tens = as.vector(w1w2u1tens) # (1, 2, 3d)
dim(w1w2u3tens) = c(tdim[1]*tdim[2], tdim[3]) # dim (1*2, 3d)
w1w2u3tens.s = shaq(t(w1w2u3tens)) # transposed so dim (3d, 1*2)
w1w2u3svd = svd(w1w2u3tens.s)
scree_plots(w1w2u3svd$d, paste0(ref, "w1w2u3"), myrank)
space_plots(mesh, w1w2u3svd$d, DATA(w1w2u3svd$u), maxplots, myrank, tag="w1w2u3")

finalize()


# (7) ######### (skip this one)

print("Work on a matrix")
##
ct <- makeCluster(cores)
registerDoParallel(ct)
##

nt<-10
mymat<-matrix(nrow=nt,ncol=nt)
mymat[1:nt,]<-0
asum=0
bsum=0
bsum<-foreach(ijk = 1:nt ) %dopar% {
	set.seed(ijk)
	mymat[,ijk]<-rnorm(mymat[,ijk])
	junk<-sum(mymat[,ijk])
}
print(bsum)
print(sum(mymat))

stopCluster(ct)
#readline(prompt = "NEXT>")


##CTE534_Gráficos=group
##Imagen=raster
##Título=string Título_Gráfico
##showplots
library(raster)
l <- dim(Imagen)[3]
pairs(Imagen[[1:l]], main=Título, col="darkgreen")


make.maturity.spatial = function( distance=50 ) {

  require(MASS)
  require(doBy)

    # sex codes
    male = 0
    female = 1
    sex.unknown = 2

    # maturity codes
    immature = 0
    mature = 1
    mat.unknown = 2

  #  distance = seq(10,60,10)
  #  distance = 50

  #  subsample size-at-maturity estimates in a spatio-temporal context and then map it
  # mapping is continued in functions,figures.r and "map.maturity" in 2.figures.r

  det = snowcrab.db("det.georeferenced")
  to.keep = c("trip", "set", "sex", "cw", "mass", "abdomen", "chela", "mat",
    "shell", "gonad", "eggcol", "eggPr", "durometer", "legs",
    "station", "t0", "lon", "lat",
    "timestamp", "julian", "yr", "z", "t",
    "zsd", "tsd", "sa"
  )
  det = det[,to.keep]
  gc()

  loc = c("lon", "lat")

  years = sort( unique( det$yr ) )
  nyears = length( years )

  output = NULL

  for (y in 1:nyears) {
    j = which( det$yr == years[y] )
    dj = det[j,]
    sets = sort( unique(dj$uniqueid ) )
    nset = length(sets)

    print (years[y])

    for (s in 1:nset) {
      i = which( dj$uniqueid == sets[s] )
      dji = dj[i,]
      coord0 = dji[1,loc]  # focal pt
      d.ss = which( geodist(
        point=coord0, locations=dji[,loc], method="great.circle") <= distance
      )
      dji = dji[d.ss,]

      for (sex in c(male, female)) {
        sexi = which(dji$sex == sex )
        out = inf = NULL
        out = est.size.at.maturity (dji[sexi,], sex)

        if (!is.null(out) ) {
          out = data.frame( t(out ))
          inf = cbind( sex=sex, distance=distance, uniqueid=I(sets[s]),
                       yr=years[y], lon=coord0[1], lat=coord0[2], out
                )
          output = rbind( output , inf )
  }}}}

  good = which(
    output$converged==1 &
    output$cw50 >  20 &
    output$cw50 < 150 &
    output$deviance < 400 &
    output$aic < 400
  )

  maturity = output[good,]
  return (maturity )
}