## calling library
source('https://raw.githubusercontent.com/laurencelin/R-coded-scripts-for-RHESSys-calibration/master/LIB_RHESSys_calibration.R')

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

	## generate random parameters for calibraitons and script file for UVA Rivanna (SLURM) job submission

	RHESSysParamBoundaryDefault # contains all RHESSys calibration parameters
	# see https://github.com/RHESSys/RHESSys/wiki for more information

		# add a new parameter / change parameter search boundary
		RHESSysParamBoundaryDefault$gw1 = c(0.001,0.4) # change boundary values
		RHESSysParamBoundaryDefault$gw2 = c(0.001,0.4) # change boundary values
		RHESSysParamBoundaryDefault$rtz = c(0.5,4.0) # e.g., add new parameter and its bounaries

	# use the block below to customize the calibration parameter search
	itr = 1:1000 # R code; mean from 1 to 1000; you can start from 1001 to 2000 too.
	num=length(itr)
	param = data.frame(itr = itr)
	param$s1 = runif(num, RHESSysParamBoundaryDefault$s1[1],RHESSysParamBoundaryDefault$s1[2])
	param$s2 = runif(num, RHESSysParamBoundaryDefault$s2[1],RHESSysParamBoundaryDefault$s2[2])
	param$sv1 = runif(num, RHESSysParamBoundaryDefault$sv1[1],RHESSysParamBoundaryDefault$sv1[2])
	param$sv2 = runif(num, RHESSysParamBoundaryDefault$sv2[1],RHESSysParamBoundaryDefault$sv2[2])
	param$gw1 = runif(num, RHESSysParamBoundaryDefault$gw1[1],RHESSysParamBoundaryDefault$gw1[2])
	param$gw2 = runif(num, RHESSysParamBoundaryDefault$gw2[1],RHESSysParamBoundaryDefault$gw2[2])
	# some additional parameters may be used for calibration
	param$snowEs = runif(num, RHESSysParamBoundaryDefault$snowEs[1],RHESSysParamBoundaryDefault$snowEs[2])
	param$snowTs = runif(num, RHESSysParamBoundaryDefault$snowTs[1],RHESSysParamBoundaryDefault$snowTs[2])

	# use the block below to customize the RHESSys model runs
	RHESSys_arg = paste(
		'path_to_rhessys_binary',  # (relative) path to RHESSys compiled binary code
		'-st 2006 1 1 1 -ed 2017 12 1 1', # start time and end time; typical span-up time is 5-year for a 62 ha catchment
		'-b', # basin scale output
		'-newcaprise -capr 0.001 -gwtoriparian -capMax 0.01', # some customized flags
		'-t tecfiles/tec_daily.txt',
		'-w worldfiles_fc/worldfile', # worldfile
		'-whdr worldfiles_fc/worldfile.hdr', # worldfile header
		'-r flows/subTestfc.txt flows/surfTestfc.txt'  # flowtable
		)

	# call a library function to generate a shell/bash file that contains all iterated RHESSys runs for UVA Rivanna
	RivannaJobs(
		RHESSys_arg, # defined above
		'output', # output folder name in the RHESSys model folder
		param, # defined above
		'../parallelRun18101fc.sh') # the path/name of the shell/bash file (keep it for it would be used later)

## -------------------------------------------------------------------------------------------------------------------------------------------------------------
	## Once all the submitted jobs are done on UVA Rivanna, download all RHESSys outputs and the shell/bash file

	# set paths/names of the project folder and RHESSys model, ...
	argList$projPath		= "~/BAISMAN" # project folder
	argList$orbFile			= "usgs01583580.csv" # observed flow time series (certain format is required; see below)
	argList$startDate		= "2010-10-1" # start time for calibration (may not the same as model start time)
	argList$endDate			= "2017-9-30" # end time for calibration (may not the same as model end time)
	argList$RHESSysModel		= "rhessys_baisman10m" # RHESSys model folder
	argList$RHESSysOutput		= "output_parallelRun18101fc" # the output folder
	argList$runScript		= "parallelRun18101fc.sh" # the shell/bash file

	# call a library function to caluate a list of fittness and generate a basic plot for each model run.
	outputfile = evaluateModel(argList)


context("Test detection_phenology")

test_that("Test detection_phenology", {

  sink(file=ifelse(Sys.info()["sysname"] == "Windows",
                   "NUL",
                   "/dev/null"))
  # Create data
  n <- 15000 #size of dataset
  nyr <- 20 # number of years in data
  nSamples <- 100 # set number of dates
  nSites <- 50 # set number of sites
  set.seed(125)

  # Create somes dates
  first <- as.Date(strptime("2010/01/01", "%Y/%m/%d"))
  last <- as.Date(strptime(paste(2010+(nyr-1),"/12/31", sep=''),
                           "%Y/%m/%d"))
  dt <- last-first
  rDates <- first + (runif(nSamples)*dt)

  # taxa are set as random letters
  taxa <- sample(letters, size = n, TRUE)

  # three sites are visited randomly
  site <- sample(paste('A', 1:nSites, sep=''), size = n, TRUE)

  # the date of visit is selected at random from those created earlier
  survey <- sample(rDates, size = n, TRUE)

  # format data
  suppressWarnings({visitData <- formatOccData(taxa = taxa,
                                               site = site,
                                               survey = survey,
                                               includeJDay = TRUE)})
  # create some model results
  modelresults <- occDetFunc(taxa_name = 'a',
                        n_iterations = 50,
                        burnin = 15,
                        occDetdata = visitData$occDetdata,
                        spp_vis = visitData$spp_vis,
                        write_results = FALSE,
                        seed = 111,
                        modeltype = c('ranwalk','halfcauchy','jul_date'))

  # quick check this output is as expected
  expect_equal(head(modelresults$BUGSoutput$sims.list$alpha.p[,1]),
               c(-3.0072164156934, -2.17484348943153, -2.04228261009605, -2.53916362332146,
                 -3.18523796966506, -3.02335381838008),
               tolerance = 1e-7)

  # create some model results without Julian date
  modelresults2 <- occDetFunc(taxa_name = 'a',
                             n_iterations = 50,
                             burnin = 15,
                             occDetdata = visitData$occDetdata,
                             spp_vis = visitData$spp_vis,
                             write_results = FALSE,
                             seed = 111,
                             modeltype = c('ranwalk','halfcauchy'))

  # run the function
  results <- detection_phenology(modelresults,
                                 spname ='a',
                                 bins = 12,
                                 density_function = TRUE)

  # create expected data
  head_data_bin <- c(1L, 2L, 3L, 4L, 5L, 6L)
  head_data_mean_pDet <- c(0.07952482, 0.07952476, 0.07952399, 0.07951970, 0.07951016, 0.07955624)
  head_data_lower95CI <- c(0.03930188, 0.03930189, 0.03930365, 0.03936658, 0.04011354, 0.04298810)
  head_data_upper95CI <- c(0.1448798, 0.1448798, 0.1448798, 0.1448798, 0.1448798, 0.1448754)
  head_data_JulianDay <- c(1.00000, 34.09091, 67.18182, 100.27273, 133.36364, 166.45455)

  expect_identical(names(results), c("data", "layers", "scales", "mapping", "theme", "coordinates", "facet", "plot_env", "labels"))
  expect_identical(names(results$data), c("bin", "mean_pDet", "lower95CI", "upper95CI", "JulianDay"))
  expect_equal(head(results$data$bin), head_data_bin, tolerance = 1e-7)
  expect_equal(head(results$data$mean_pDet), head_data_mean_pDet, tolerance = 1e-7)
  expect_equal(head(results$data$lower95CI), head_data_lower95CI, tolerance = 1e-7)
  expect_equal(head(results$data$upper95CI), head_data_upper95CI, tolerance = 1e-7)
  expect_equal(head(results$data$JulianDay), head_data_JulianDay, tolerance = 1e-5)

  expect_error(results <- detection_phenology(modelresults2, spname='a', bins=12, density_function = TRUE),
               'no phenological effect was modelled!')

  sink()
})


# Experiment 2
# Shift in fire regime from small-frequent to large-infrequent
# Shift occurs at different times in the past, and between widely divergent regimes and closer regimes

## Launch model
library(doParallel)
library(foreach)

source("cat_face_mortality_pfire_split.r")

registerDoParallel(cores=16)

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

# Experiment 2: Split regime, mortality on
############################################

FIELD_SIZE=200                    # Number of rows/columns
SIM_LENGTH=700                    # number of years to run
FIRE_FREQ_1=100                   #  percentage of years regime 1
FIRE_PROB_1=5                     # Area regime 1
FIRE_FREQ_2=5                     # Percentage of years regime 2
FIRE_PROB_2=100                   # Area regime 2
MORTALITY_ON=TRUE                     # Non-fire Mortality turned on?
F_MORTALITY_ON=TRUE                    # Fire-Morality turned on?

MORT_b1 = 20                      # First mortality age break
MORT_b2 = 400                     # Second mortality age break

MORT_p1 =.02
MORT_p2 =.005
MORT_p3 =.02

MORT_F_b1 = 10                      # First fire mortality age break
MORT_F_b2 = 30                     # Second fire mortality age break
MORT_F_b3 = 400                     # Second fire mortality age break

MORT_F_p1 = 0.7
MORT_F_p2 = 0.3
MORT_F_p3 = 0.05
MORT_F_p4 = 0.4

NUMBER_SIMS=400

SPLIT_YEAR=rep(c(150,200,250,300,350,400,450,500,550,600),each=40) # Sequence of split years

output_dir="e2_range_wide"
dir.create(output_dir)
#########################################

# Create dataframe to define this sim
# This can vary between runs
#
#########################################

sim_def_frame=data.frame(SIM_ID=1:NUMBER_SIMS)
sim_def_frame$FIELD_SIZE=FIELD_SIZE
sim_def_frame$SIM_LENGTH=SIM_LENGTH
sim_def_frame$FIRE_FREQ_1=FIRE_FREQ_1
sim_def_frame$FIRE_FREQ_2=FIRE_FREQ_2
sim_def_frame$FIRE_PROB_1=FIRE_PROB_1
sim_def_frame$FIRE_PROB_2=FIRE_PROB_2
sim_def_frame$MORTALITY_ON=MORTALITY_ON
sim_def_frame$F_MORTALITY_ON=F_MORTALITY_ON
sim_def_frame$MORT_b1 = MORT_b1
sim_def_frame$MORT_b2 = MORT_b2
sim_def_frame$MORT_p1 = MORT_p1
sim_def_frame$MORT_p2 = MORT_p2
sim_def_frame$MORT_p3 = MORT_p3
sim_def_frame$MORT_F_b1 = MORT_F_b1
sim_def_frame$MORT_F_b2 = MORT_F_b2
sim_def_frame$MORT_F_b3 = MORT_F_b3
sim_def_frame$MORT_F_p1 = MORT_F_p1
sim_def_frame$MORT_F_p2 = MORT_F_p2
sim_def_frame$MORT_F_p3 = MORT_F_p3
sim_def_frame$MORT_F_p4 = MORT_F_p4
sim_def_frame$SPLIT_YEAR=SPLIT_YEAR
sim_def_frame$output_dir = output_dir

write.csv(sim_def_frame,paste0(output_dir,"/sim_list.csv"))

foreach(i=1:NUMBER_SIMS) %dopar% launch_sim_split(i)

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

# Experiment 2: Split regime, mortality on narror
############################################

FIELD_SIZE=200                    # Number of rows/columns
SIM_LENGTH=700                    # number of years to run
FIRE_FREQ_1=20                      #  percentage of years
FIRE_PROB_1=25
FIRE_FREQ_2=10
FIRE_PROB_2=50
MORTALITY_ON=TRUE                     # Non-fire Mortality turned on?
F_MORTALITY_ON=TRUE                    # Fire-Morality turned on?

MORT_b1 = 20                      # First mortality age break
MORT_b2 = 400                     # Second mortality age break

MORT_p1 =.02
MORT_p2 =.005
MORT_p3 =.02

MORT_F_b1 = 10                      # First fire mortality age break
MORT_F_b2 = 30                     # Second fire mortality age break
MORT_F_b3 = 400                     # Second fire mortality age break

MORT_F_p1 = 0.7
MORT_F_p2 = 0.3
MORT_F_p3 = 0.05
MORT_F_p4 = 0.4

NUMBER_SIMS=400

SPLIT_YEAR=rep(c(150,200,250,300,350,400,450,500,550,600),each=40)

output_dir="e2_range_narrow"
dir.create(output_dir)
#########################################

# Create dataframe to define this sim
# This can vary between runs
#
#########################################

sim_def_frame=data.frame(SIM_ID=1:NUMBER_SIMS)
sim_def_frame$FIELD_SIZE=FIELD_SIZE
sim_def_frame$SIM_LENGTH=SIM_LENGTH
sim_def_frame$FIRE_FREQ_1=FIRE_FREQ_1
sim_def_frame$FIRE_FREQ_2=FIRE_FREQ_2
sim_def_frame$FIRE_PROB_1=FIRE_PROB_1
sim_def_frame$FIRE_PROB_2=FIRE_PROB_2
sim_def_frame$MORTALITY_ON=MORTALITY_ON
sim_def_frame$F_MORTALITY_ON=F_MORTALITY_ON
sim_def_frame$MORT_b1 = MORT_b1
sim_def_frame$MORT_b2 = MORT_b2
sim_def_frame$MORT_p1 = MORT_p1
sim_def_frame$MORT_p2 = MORT_p2
sim_def_frame$MORT_p3 = MORT_p3
sim_def_frame$MORT_F_b1 = MORT_F_b1
sim_def_frame$MORT_F_b2 = MORT_F_b2
sim_def_frame$MORT_F_b3 = MORT_F_b3
sim_def_frame$MORT_F_p1 = MORT_F_p1
sim_def_frame$MORT_F_p2 = MORT_F_p2
sim_def_frame$MORT_F_p3 = MORT_F_p3
sim_def_frame$MORT_F_p4 = MORT_F_p4
sim_def_frame$SPLIT_YEAR=SPLIT_YEAR
sim_def_frame$output_dir = output_dir

write.csv(sim_def_frame,paste0(output_dir,"/sim_list.csv"))

foreach(i=1:NUMBER_SIMS) %dopar% launch_sim_split(i)


.normalize = import('./normalize')$normalize

#' Quality control function
#'
#' @param rawData  An `oligo::batch` object
#' @param NUSE     tolerance of meadian NUSE score around 1, set to NA for no QC
#' @param RLE      tolerance of meadian RLE score around 0, set to NA for no QC
#' @return         `rawData` filtered for QC criteria
qc = function(rawData, NUSE=0.1, RLE=0.1) {
    UseMethod("qc")
}

qc.list = function(rawData, NUSE=0.1, RLE=0.1) {
    lapply(rawData, .normalize)
}

qc.FeatureSet = function(rawData, NUSE=0.1, RLE=0.1) {
    plmFit = oligo::fitProbeLevelModel(rawData, target='core')

    discard = F
    if (!is.na(NUSE)) {
        med = apply(oligo::NUSE(plmFit, type="values"), 2, function(x) median(x, na.rm=T))
        discard = discard | med > 1+NUSE | med < 1-NUSE
    }
    if (!is.na(RLE)) {
        med = apply(oligo::RLE(plmFit, type="values"), 2, function(x) median(x, na.rm=T))
        discard = discard | med > RLE | med < -RLE
    }
    if (any(discard)) {
        warning(paste("Discarding", sum(discard), "arrays"))
        rawData = rawData[,!discard]
    }
    rawData
}

qc.NChannelSet = function(rawData, NUSE=0.1, RLE=0.1) {
    warning("do not know how to QC NChannelSet, skipping")
    rawData
}


#Code for analysing data from Bendix Plugin of VMD
#List of Files
inp_list = c("S6A","S6B","S6C","S6D")
data=list()

#Reading in the files and storing the data in a list of lists
for(i in 1:4)
{
	file_id = sprintf("%s_data",inp_list[i])
	data[i] = list(read.csv(file_id, sep = '\t', header = FALSE))
}
residues = readLines('S6_rownames')

#Boxplot of helix curvature of each chain plotted onto same graph
setEPS()
postscript("S6_curvature.eps")
for(i in 1:4)
{
	boxplot(data[[i]],col=i+1,ylim=c(0,25),xlab="Residue Number",ylab="Curvature",main="Helicity of S6 Helix",xaxt = 'n',outline=FALSE)
	par(new=TRUE)
}
text(x =  seq_along(residues), y = par("usr")[3] - 1, srt = 90, adj = 1, labels = residues, xpd = TRUE)
legend(25, 25, c("A Chain","B Chain","C Chain","D Chain"),col=c(2,3,4,5),lty=c(1,1),lwd=c(2.5,2.5))
dev.off()

#Individual Heatmaps of each chain
for(i in 1:4)
{
	plot.new()
	frame()
	setEPS()
	out_file = sprintf("heatmap_%s.eps",inp_list[i])
	postscript(out_file)
	datamatrix <-as.matrix(data[[i]],headers = FALSE)
	cc <- rainbow(ncol(datamatrix), start = 0, end = 0.5)
	frames <- rep("", nrow(datamatrix))
	frames[seq(1,nrow(datamatrix), 100)] <- seq(1, nrow(datamatrix), 100)
	heatmap(datamatrix,Rowv = NA, Colv = NA, scale = "row",xlab = "S6 Helix Residue", ylab =  "Time",col = cc, ColSideColors = cc,labCol = residues,labRow = frames, cexRow=2,cexCol=1)
	dev.off()
}


mut_cats <- unique(agg_5bp_100k$Category2)
compare.all <- data.frame()
compare.err <- data.frame()
compare.aic <- data.frame()

modsumm<-list()

for(j in 1:length(mut_cats)) {
	cat1 <- mut_cats[j]
  cat("Running ", cat1, "models...\n")
	aggcat <- a3[a3$Category2==cat1,]

	if(grepl("^AT", cat1)) {
		bindat <- binsAT
		mcols <- atcols
	} else if(grepl("^GC", cat1)) {
		bindat <- binsGC
		mcols <- gccols
	} else {
		bindat <- binscpgGC
		mcols <- cpggccols
	}

  aggcatm1 <- merge(aggcat, bindat, by=c("CHR", "BIN", "prop_GC"), all.x=T)

  # Subset 7bp rates for category i and sort
  rcat<-rates5 %>% filter(Category2==cat1) %>% arrange(Sequence)

  # Get expected num per window per bin
  z<-as.vector(rcat$rel_prop)*as.matrix(bindat[,6:ncol(bindat)])

  # Merge row sums with CHR/BIN
  # CHR BIN EXP
  r6<-cbind(bindat[,c(1,5)],marg=rowSums(z))

  bases <- c("A", "C", "G", "T")
  nts <- ifelse(grepl("^AT", cat1), "A", "C")

  b3 <- bases
  if(grepl("^cpg", cat1)){
    b3 <- c("G")
  } else if (grepl("^GC", cat1)){
    b3 <- c("A", "C", "T")
  }

  aggcatm2 <- getSubMotifs(aggcatm1, nts, b3)

  # Merge data to include column of marginals
  aggcatm<-merge(aggcatm2, r6, by=c("CHR", "BIN"))

  # Fix issue where a single bin in Chr5 with 15 AT>GC observations
  # causes glm.nb() to fail to converge
  if(cat1=="AT_GC"){
    aggcatm <- aggcatm[aggcatm$obs>15,]
  }

  # Get all 5bp motifs to use
  pset <- results %>%
    filter(Category2==cat1, Q!=1)

  # Get 5bp motifs to be expanded to constituents
  psetq1 <- results %>%
    filter(Category2==cat1, Q==1)

  # Expand significant set to 7
  hierset <- apply(expand.grid(bases, psetq1$Sequence, bases),
    1, paste, collapse="")
  hiersetrev <- sapply(hierset, revcomp)
  hierset <- paste0(hierset, "_", hiersetrev, "_")

  m5set <- c(as.character(pset$Sequence), as.character(psetq1$Sequence))
  m7set <- c(as.character(pset$Sequence), hierset)

	# Fit models with all data
  # wm_form <- as.formula("obs~exp")
  # m1_form <- as.formula("obs~exp1")
  gc_form <- as.formula("obs~prop_GC")
	feat_form <- as.formula(paste("obs~",
		paste(covnames, collapse="+")))
	full_form <- as.formula(paste("obs~",
		paste(m5set, collapse="+"), "+prop_GC+",
		paste(covnames, collapse="+")))
	motif_form <- as.formula(paste("obs~",
		paste(m5set, collapse="+")))
  motif2_form <- as.formula(paste("obs~",
		paste(m7set, collapse="+")))
  full_form_int <- as.formula(paste("obs~prop_GC*(",
		paste(m5set, collapse="+"), ")+",
		paste(covnames, collapse="+")))
  marg_form <- as.formula("obs~marg")
  logit_form <- as.formula("obs~LSUM")

  # Add formulas to list
  forms <- c(gc_form, feat_form,
    full_form, full_form_int,
    motif_form, motif2_form,
    marg_form, logit_form)
  names(forms) <- c("gc", "features",
    "full", "full_gc_inter",
    "motifs5", "motifs5_top7",
    "marginal7", "logit")

  # Run models for each formula in list
  models <- runMod(forms, aggcatm)

  aics <- sapply(models, function(x) AIC(x))
  aicdf <- data.frame(Category2=cat1, model=names(aics), AIC=aics)
  compare.aic <- rbind(compare.aic, aicdf)
	# 5-fold cross-validation--may need to update so expected counts are
	# re-calculated for each 1/N subset
	# gc_cv <- cv.glm(data=aggcatm, glmfit=models$gc, K=5)
	# feat_cv <- cv.glm(data=aggcatm, glmfit=models$feat, K=5)
	# motif_cv <- cv.glm(data=aggcatm, glmfit=models$motif, K=5)
	# full_cv <- cv.glm(data=aggcatm, glmfit=models$full, K=5)
  #
	# mspe <- c(gc_cv$delta[2], feat_cv$delta[2], motif_cv$delta[2], full_cv$delta[2])
	# rmse <- sqrt(mspe)
	# meanct <- mean(aggcat$obs)
	# pcterr <- rmse/meanct
	# mspe.res <- c("GC", "features", "motifs", "motifs+features")
	# mspe.dat <- data.frame(Category2=cat1, res=mspe.res, mspe, rmse, meanct, pcterr)
	# compare.err <-rbind(compare.err, mspe.dat)

  # Get fitted values from each model and name with CHR/BIN
  fits <- getFits(models, aggcatm)

	BIN <- as.integer(gsub(".*\\.", "", names(fits$feat)))
	CHR <- as.integer(gsub("\\..*", "", names(fits$feat)))

  # Build list of dataframes for each model
  moddat <- buildDF(fits, aggcatm)

  # Add column specifying model
  for(i in 1:length(names(moddat))){
    moddat[[i]]$res <- names(moddat)[i]
  }

  # Append model predictions to full df
	compare.all <- rbind(compare.all, bind_rows(moddat))
	marg_nm <- aggcatm %>%
		dplyr::select(CHR, Category2, BIN, exp=marg, obs) %>%
		mutate(res="marg_nm")
	logit_nm <- aggcatm %>%
		dplyr::select(CHR, Category2, BIN, exp=LSUM, obs) %>%
		mutate(res="logit_nm")
	compare.all <- rbind(compare.all, marg_nm, logit_nm)

  modsumm[[j]] <- summary(models$full)
}


l1 : decjz r0 l2
      inc r-1
      inc r-2
      decjz r-4 l1
l2 : decjz r-1 l3
l4 :   decjz r-2 l5
        inc r0
        inc r-3
        decjz r-4 l4
l5 :   decjz r-3 l2
        inc r-2
        decjz r-4 l5
l3 : decjz r-2 end
      decjz r-4 l3


# Note: when switching between tutorial examples,
# restart R by clicking Session | Restart R in RStudio

setwd("~/KDD2017R/Code/MRS")
source("SetComputeContext.r")

library(sparklyr)
library(dplyr)

Sys.setenv(SPARK_VERSION="2.1.1")

cc <- rxSparkConnect(interop = "sparklyr",
                     reset = TRUE,
                     consoleOutput = TRUE,
                     # numExecutors = 1,
                     executorCores = 4,
                     driverMem = "2g",
                     executorMem = "2g",
                     executorOverheadMem = "4g"
)

sc <- rxGetSparklyrConnection(cc)

################################################
# Specify the data sources
################################################

airlineDF <- sparklyr::spark_read_csv(sc = sc,
                                      name = "airline",
                                      path = file.path(dataDir, "AirlineSubsetCsv"),
                                      header = TRUE,
                                      infer_schema = FALSE, # Avoids parsing error
                                      null_value = "null")

weatherDF <- sparklyr::spark_read_csv(sc = sc,
                                      name = "weather",
                                      path = file.path(dataDir, "WeatherSubsetCsv"),
                                      header = TRUE,
                                      infer_schema = TRUE,
                                      null_value = "null")

################################################
# Transform the data
################################################

airlineDF <- airlineDF %>%
  rename(ArrDel15 = ARR_DEL15) %>%
  rename(Year = YEAR) %>%
  rename(Month = MONTH) %>%
  rename(DayOfMonth = DAY_OF_MONTH) %>%
  rename(DayOfWeek = DAY_OF_WEEK) %>%
  rename(Carrier = UNIQUE_CARRIER) %>%
  rename(OriginAirportID = ORIGIN_AIRPORT_ID) %>%
  rename(DestAirportID = DEST_AIRPORT_ID) %>%
  rename(CRSDepTime = CRS_DEP_TIME) %>%
  rename(CRSArrTime = CRS_ARR_TIME)

# Keep only the desired columns from the flight data

airlineDF <- airlineDF %>% select(ArrDel15, Year, Month, DayOfMonth,
                    DayOfWeek, Carrier, OriginAirportID,
                    DestAirportID, CRSDepTime, CRSArrTime)

# Round down scheduled departure time to full hour

airlineDF <- airlineDF %>% mutate(CRSDepTime = floor(CRSDepTime / 100))

weatherDF <- weatherDF %>%
  rename(OriginAirportID = AirportID) %>%
  rename(Year = AdjustedYear) %>%
  rename(Month = AdjustedMonth) %>%
  rename(DayOfMonth = AdjustedDay) %>%
  rename(CRSDepTime = AdjustedHour)

# Average the weather readings by hour

weatherSummary <- weatherDF %>%
  group_by(Year, Month, DayOfMonth, CRSDepTime, OriginAirportID) %>%
  summarise(Visibility = mean(Visibility),
            DryBulbCelsius = mean(DryBulbCelsius),
            DewPointCelsius = mean(DewPointCelsius),
            RelativeHumidity = mean(RelativeHumidity),
            WindSpeed = mean(WindSpeed),
            Altimeter = mean(Altimeter))

#######################################################
# Join airline data with weather at Origin Airport
#######################################################

originDF <- left_join(x = airlineDF,
                      y = weatherSummary)

originDF <- originDF %>%
  rename(VisibilityOrigin = Visibility) %>%
  rename(DryBulbCelsiusOrigin = DryBulbCelsius) %>%
  rename(DewPointCelsiusOrigin = DewPointCelsius) %>%
  rename(RelativeHumidityOrigin = RelativeHumidity) %>%
  rename(WindSpeedOrigin = WindSpeed) %>%
  rename(AltimeterOrigin = Altimeter)

#######################################################
# Join airline data with weather at Destination Airport
#######################################################

weatherSummary <- weatherSummary %>% rename(DestAirportID = OriginAirportID)

destDF <- left_join(x = originDF,
                    y = weatherSummary)

airWeatherDF <- destDF %>%
  rename(VisibilityDest = Visibility) %>%
  rename(DryBulbCelsiusDest = DryBulbCelsius) %>%
  rename(DewPointCelsiusDest = DewPointCelsius) %>%
  rename(RelativeHumidityDest = RelativeHumidity) %>%
  rename(WindSpeedDest = WindSpeed) %>%
  rename(AltimeterDest = Altimeter)

#######################################################
# Register the joined data as a Spark SQL/Hive table
#######################################################

# NOTE: IGNORE "Translator is missing window functions" WARNING
# https://github.com/rstudio/sparklyr/issues/792
airWeatherDF <- airWeatherDF %>% sdf_register("flightsweather")

tbl_cache(sc, "flightsweather")

#######################################################
# The table of joined data can be queried using SQL
#######################################################

# Count the number of rows
tbl(sc, sql("SELECT COUNT(*) FROM flightsweather"))

# Count each distinct value in the ArrDel15 column
tbl(sc, sql("SELECT ArrDel15, COUNT(*) FROM flightsweather GROUP BY ArrDel15"))

# Count rows by Year and Month
tbl(sc, sql("SELECT Year, Month, COUNT(*) FROM flightsweather GROUP BY Year, Month ORDER BY Year, Month"))


2: 1 -> 2
4: 2 -> 4
3: 1 -> 3


require(ggplot2)
require(xtable)

#Arbeitspfad setzen
setwd("/Volumes/cracker/data/nfs/thomas/experiments/rx-factor-anova-7.6.2011-sender=ma-cca-noiseimmu-weak-cali-channel-driver/data/merged-traces")

a-register <- read.csv(file="a-sender=ma-register.csv", header=TRUE, sep = " ")

#Anova Analyse
#1.) Normalverteilung pr√ºfen

#Histogramme erstellen

#ANOVA noise all
noise_model_all = aov(-noise ~ as.factor(weak)*as.factor(position), data = noise_all)
capture.output(summary(noise_model_all), file="anova_all_noise.doc")

noise_model_all_rxbusy = aov(rx.busy ~ as.factor(weak)*as.factor(position), data = noise_all)
capture.output(summary(noise_model_all_rxbusy), file="anova_all_rxbusy.doc")

noise_model_all_edbusy = aov(ed.busy ~ as.factor(weak)*as.factor(position), data = noise_all)
capture.output(summary(noise_model_all_edbusy), file="anova_all_edbusy.doc")

pdf("noise_eb.pdf")
#par(mfrow = c(1,2))
histogram_eb_noise <- qplot(-noise, data=noise_eb, geom="histogram", binwidth=1, facets= rate ~ power)
histogram_eb_noise + opts(title='node:eb - noise histograms of all 4 groups of channel and calibration ')
interaction.plot(noise_eb$rate,noise_eb$calibration,-noise_eb$noise, legend = TRUE, xlab="channel", ylab="noise at EB", trace.label="calibration", main="interaction plot noise at EB")
dev.off()

pdf("noise_vwsf.pdf")
histogram_vws <- qplot(-noise, data=noise_vws, geom="histogram", binwidth=1, facets= rate ~ power)
histogram_vws + opts(title='node:vws - noise histograms of all 4 groups of channel and calibration')
interaction.plot(noise_vws$channel,noise_vws$calibration,-noise_vws$noise, legend = TRUE, xlab="channel", ylab="noise at VWS", trace.label="calibration", main="interaction plot noise at VWS")
dev.off()

pdf("noise_ma.pdf")
histogram_ma <- qplot(-noise, data=noise_ma, geom="histogram", binwidth=1, facets= rate ~ power)
histogram_ma + opts(title='node:ma - noise histograms of all 4 groups of channel and calibration')
interaction.plot(noise_ma$channel,noise_ma$calibration,-noise_ma$noise, legend = TRUE, xlab="channel", ylab="noise at MA", trace.label="calibration", main="interaction plot noise at MA")
dev.off()

#ed.busy is negative ---> error !!!!
#pdf("rx-busy_eb.pdf")
#histogram_eb_rx <- qplot(rx.busy[rx.busy > 0], data=noise_eb, geom="histogram", binwidth=1, facets= channel ~ calibration)
#histogram_eb_rx + opts(title='node:eb - rx-busy histograms of all 4 groups of channel and calibration ')
#interaction.plot(noise_eb$channel,noise_eb$calibration,-noise_eb$rx.busy, legend = TRUE, xlab="channel", ylab="rx-busy at EB", trace.label="calibration", main="interaction plot rx-busy at EB")
#dev.off()

#ANOVA machen EB
noise_model_eb = aov(-noise ~ as.factor(rate)*as.factor(power), data = noise_eb)
capture.output(summary(noise_model_eb), file="anova_eb_noise.doc")

noise_model_eb_rxbusy = aov(rx.busy ~ as.factor(rate)*as.factor(power), data = noise_eb)
capture.output(summary(noise_model_eb_rxbusy), file="anova_eb_rxbusy.doc")

noise_model_eb_edbusy = aov(ed.busy ~ as.factor(rate)*as.factor(power), data = noise_eb)
capture.output(summary(noise_model_eb_edbusy), file="anova_eb_edbusy.doc")

#ANOVA machen VWS
noise_model_vws = aov(-noise ~ as.factor(rate)*as.factor(power), data = noise_vws)
capture.output(summary(noise_model_vws), file="anova_vws_noise.doc")

noise_model_vws_rxbusy = aov(-noise ~ as.factor(rate)*as.factor(power), data = noise_vws)
capture.output(summary(noise_model_vws_rxbusy), file="anova_vws_rxbusy.doc")

noise_model_vws_edbusy = aov(-noise ~ as.factor(rate)*as.factor(power), data = noise_vws)
capture.output(summary(noise_model_vws_edbusy), file="anova_vws_edbusy.doc")

#ANOVA machen MA
noise_model_ma = aov(-noise ~ as.factor(rate)*as.factor(power), data = noise_ma)
capture.output(summary(noise_model_ma), file="anova_ma_noise.doc")

noise_model_ma_rxbusy = aov(-noise ~ as.factor(rate)*as.factor(power), data = noise_ma)
capture.output(summary(noise_model_ma_rxbusy), file="anova_ma_rxbusy.doc")

noise_model_ma_edbusy = aov(-noise ~ as.factor(rate)*as.factor(power), data = noise_ma)
capture.output(summary(noise_model_ma_edbusy), file="anova_ma_edbusy.doc")

#residual histogramme

hist(noise_model_eb$res)
hist(noise_model_vws$res)

#plot residuals against fitted values to look for bvious trends that are not consistent with the model
delivery.res = histogram_eb
histogram_eb$M1.Fit = fitted(noise_model_eb)
histogram_eb$M1.Resid = resid(noise_model_eb)

#consider the normal probability plot of the model residuals, using the stat_qq() option:
p = qplot(sample = M1.Resid, data= histogram_eb)
p + stat_qq()

ggplot(delivery.res, aes(M1.Fit, M1.Resid, colour = Service)) +
  geom_point() +
  xlab("Fitted Values") + ylab("Residuals")

# stuff

#QQ Plot
qqplot_bib <- qplot(sample = -noise, data=noise_bib, facets = channel ~ calibration)
qqplot_bib + opts(title='node:bib - QQ-Plot from 64 groups ')

qqplot_eb <- qplot(sample = -noise, data=noise_eb, facets = channel ~ calibration)
qqplot_eb + opts(title='node:en - QQ-Plot from 64 groups ')

#interactive plot:
interaction.plot(noise_eb$rate,noise_eb$power,-noise_eb$noise, legend = TRUE, xlab="channel", ylab="noise at EB", trace.label="calibration", main="interaction plot noise at EB")
interaction.plot(noise_vws$rate,noise_vws$power,-noise_vws$noise, legend = TRUE, xlab="channel", ylab="noise at VWS", trace.label="calibration", main="interaction plot noise at VWS")

interaction.plot(noise_eb$rate,noise_eb$power,noise_eb$rx.busy, legend = TRUE, xlab="TX rate MA", ylab="noise at EB", trace.label="TX power MA", main="interaction plot noise at EB")
interaction.plot(noise_vws$rate,noise_vws$power,-noise_vws$rx.busy, legend = TRUE, xlab="TX rate MA", ylab="noise at VWS", trace.label="TX power MA", main="interaction plot noise at VWS")

density_vws <- qplot(-noise, data=noise_eb, geom="density", binwidth=1, facets= channel ~ calibration)
density_vws + opts(title='node:vws - noise densitys of all 4 groups of channel and calibration')

density_eb <- qplot(-noise, data=noise_eb, geom="density", binwidth=1, facets= channel ~ calibration)
density_eb + opts(title='node:eb - noise densitys of all 4 groups of channel and calibration')

noise_model_eb.table = xtable(noise_model_eb)
print(noise_model_eb.table, type="html")

noise_model_eb = aov(-noise ~ rate*power, data = noise_eb)

noise_model_eb.table = xtable(noise_model_eb)
print(noise_model_eb.table, type="html")


temprad <- function(t, rh, rshort, rdiffuse, sunelev, albedo) {
    .Call('biometeoR_temprad', PACKAGE = 'biometeoR', t, rh, rshort, rdiffuse, sunelev, albedo)
}


########################################
## cfg							      ##
########################################
source("cfg.r")
graphics.off()

breaks_default = seq(0.1, 0.8, 0.01)
axis_at = seq(0.1, 0.8, 0.1)

anomilies = TRUE
transform = TRUE
########################################
## load and analyes  			      ##
########################################

dat = dats[[1]][['TreeCover']]
out = makeOrLoadEnsembles()
out = selectOutput(out)

addAnololie <- function(r_exp, r_obs, r_cnt, maxV = 0.8) {

	trans <- function(r) {
		r = r / maxV
		r[r > 1] = maxV

		return(r)
	}

	r_exp = trans(r_exp)
	r_obs = trans(r_obs)
	r_cnt = trans(r_cnt)

	if (transform) r_obs = logit(r_obs)

	r_anm = r_obs * r_exp / r_cnt

	if (transform) r_anm = logistic(r_obs * r_exp / r_cnt, 0, 1)
	return(r_anm * maxV)
}

if (anomilies) aout = lapply(out,addAnololie, dat, out[[1]]) else aout = out

dout = lapply(out, function(i) i -out[[1]])
plot_hist <- function(r, title, axis = TRUE, yline = NULL, poly = TRUE, maxY = NULL,
				      breaks = breaks_default, hrange = range(breaks), log = '') {
	print(maxY)
	if (log == 'y') yrange = c(0.001, 1.0) else yrange = c(0, 1.2)
	plot(hrange, yrange, axes = FALSE, type = 'n', xlab = '', ylab = '', log = log)
	if (axis) axis(1, at = axis_at, labels = axis_at * 100)
	mtext(title, line = -3)
	plotPoly <- function(v, alpha = 0.9, poly = TRUE) {
		hr = hist(v, breaks = breaks, plot = FALSE)
		x = hr$mids
		y = hr$density
		if (is.null(maxY)) maxY = max(y)

		y = y/maxY
		if (log == 'y') y[y < 0.001] = 0.001
		if (poly) {
			polygon(c(x, rev(x)), c(y, rep(0, length(y))),
					border = NA, col =  make.transparent('black', alpha))
		} else {
			lines(x, y, col = 'red', lwd = 2.3)
			lines(x, y, col = '#BB0000', lwd = 2)
			lines(x, y, col = '#FF9999', lwd = 2.1, lty = 2)
		}
		return(maxY)
	}
	vr = layer.apply(r, function(i) i[i > hrange[1] & i < hrange[2]])
	maxY_out = lapply(vr, plotPoly, poly = poly)
	if (!is.null(yline))  plotPoly(yline, poly = FALSE)
	return(list(vr, maxY_out))
}

out = plot_hist(dat, 'obs', poly = FALSE)
vdat = out[[1]][[1]]; maxY = out[[2]][[1]]

graphics.off()
png(paste('figs/killer_histergrams', transform, '.png', sep = '-'), height = 9, width = 7, unit = 'in', res = 200)

	par(mfrow = c(4,2), mar = c(0.45, 0.5, 0.1, 0.5), oma = c(2, 0.5, 0.4, 0.5))
	mapply(plot_hist, aout[5:12], names(dats)[5:12], axis = c(rep(F, 6), T, T),
		   MoreArgs = list(vdat, maxY = maxY))

dev.off.gitWatermark()

png(paste('figs/shift_histergrams', transform, '.png', sep = '-'), height = 9, width = 7, unit = 'in', res = 200)

	par(mfrow = c(4,2), mar = c(0.45, 0.5, 0.1, 0.5), oma = c(2, 0.5, 0.4, 0.5))
	mapply(plot_hist, dout[5:12], names(dats)[5:12], axis = c(rep(F, 6), T, T),
		   MoreArgs = list(maxY = NULL, breaks = seq(0.01, 0.5, 0.01), log = ''))

dev.off.gitWatermark()


#Hs liver unique
# Figure Hs_liverunique_TSSgene_numbers
venn.diagram(
	x = list(
		HsLiver = 1:9200,
		TSSgene = 6943:26051
		),
	filename = "Hs_liverunique_TSSgene_numbers.tiff",
col = "transparent",
	fill = c("blue", "green"),
	alpha = 0.5,
	label.col = c("darkblue", "white", "darkgreen"),
	cex = 2.0,
	fontfamily = "arial",
	fontface = "bold",
	);

# Figure Hs_liverunique_TSSgene
venn.diagram(
	x = list(
		HsLiver = 1:9200,
		TSSgene = 6943:26051
		),
	filename = "Hs_liverunique_TSSgene.tiff",
col = "transparent",
	fill = c("blue", "green"),
	alpha = 0.5,
	cex = 0.0,
	cat.cex = 0.0,
);

#Hs Testes unique
# Figure Hs_testesunique_TSSgene_numbers
venn.diagram(
	x = list(
		Hstestes = 1:15118,
		TSSgene = 12808:31907
		),
	filename = "Hs_testesunique_TSSgene_numbers.tiff",
col = "transparent",
	fill = c("blue", "red"),
	alpha = 0.5,
	label.col = c("darkblue", "white", "darkgreen"),
	cex = 2.0,
	fontfamily = "arial",
	fontface = "bold",
	);

# Figure Hs_testesunique_TSSgene
venn.diagram(
	x = list(
		Hstestes = 1:15118,
		TSSgene = 12808:31907
		),
	filename = "Hs_testesunique_TSSgene.tiff",
col = "transparent",
	fill = c("blue", "red"),
	alpha = 0.5,
	cex = 0.0,
	cat.cex = 0.0,
);

#Hs Testes and Liver shared
# Figure Hs_testeslivershared_TSSgene_numbers
venn.diagram(
	x = list(
		Hsshared = 1:20847,
		TSSgene = 8031:26277
		),
	filename = "Hs_testeslivershared_TSSgene_numbers.tiff",
col = "transparent",
	fill = c("blue", "orange"),
	alpha = 0.5,
	label.col = c("darkblue", "white", "darkgreen"),
	cex = 2.0,
	fontfamily = "arial",
	fontface = "bold",
	);

# Figure Hs_testeslivershared_TSSgene
venn.diagram(
	x = list(
		Hsshared = 1:20847,
		TSSgene = 8031:26277
		),
	filename = "Hs_testeslivershared_TSSgene.tiff",
col = "transparent",
	fill = c("blue", "orange"),
	alpha = 0.5,
	cex = 0.0,
	cat.cex = 0.0,
);

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

obsolete/proj007/Fig3b unique and shared intervals.r


fitted.ivmodel <- function(object, ...){
  ivmodel <- object
  residual_est =  resid(ivmodel)
  stopifnot("Number of estimated residuals do not equal number of outcome"= nrow(residual_est) == nrow(ivmodel$Y))

  result = matrix(ivmodel$Y,nrow(residual_est),ncol(residual_est)) - residual_est
  result = result[which(ivmodel$naindex),]
  return(result)
}


#####################################################################################
######################    arrange data    ###########################################
#####################################################################################

## import data
wd = "D:/Ruo_data/2019_Paper_Publish/Publish"
setwd(wd)

sp_TL.result <- read.csv("./SizeAggregTend_data/output/1_size_TL/all_TL_result_16class.csv",stringsAsFactors = F,sep=",",header = T)
sp_TL.result <-sp_TL.result[,-1]
sp.mid.L <- as.matrix(read.table("./SizeAggregTend_data/compiled/allsp_length_mid_16class.txt"))
mature.L <- as.matrix(read.table("./SizeAggregTend_data/compiled/mature_L.txt"))
sp_name <-c("Herring","Cod","Haddock","Whiting","Plaice","Saithe","Mackerel","Sprat","Norwaypout")

# add information #
## calculate the standard length
std.L <- NULL
for(i in 1:9){
  sp.1 <- (sp.mid.L[i,]-mature.L[i,1])/(max(sp.mid.L[i,])-min(sp.mid.L[i,]))
  sp.3 <- (sp.mid.L[i+9,]-mature.L[i,1])/(max(sp.mid.L[i+9,])-min(sp.mid.L[i+9,]))
  std.L <- c(std.L, sp.1, sp.3)
}
sp_TL.result$std_L <- std.L

## add species factor
sp_TL.result$sp_ID <- factor(rep(1:9,each=32))

## add quater factor
sp_TL.result$quarter <- as.factor(rep(c(rep("Q1",16),rep("Q3",16)),9))

## add spawning information
sp_TL.result$spwn <- as.factor(rep(c("Y","Y","Y","N","Y","N",
                                     "Y","N","Y","N","Y","N",
                                     "N","N","N","Y","Y","N"),each=16))

## add temperature data
allsp_T  <- read.csv("./SizeAggregTend_data/compiled/Temperature_info.csv")
colnames(allsp_T)[2:3] <- c("mean_T","cv_T")

sp_TL.result <- cbind(sp_TL.result,allsp_T[,2:3])
sp_TL.result$std_T <- unlist(tapply(sp_TL.result$mean_T,
                                    list(sp_TL.result$sp_ID,sp_TL.result$quarter),
                                    function(x){(x-median(x))/(max(x)-min(x))}))
sp_TL.result$std_T_cv <- unlist(tapply(sp_TL.result$cv_T,
                                    list(sp_TL.result$sp_ID,sp_TL.result$quarter),
                                    function(x){(x-median(x))/(max(x)-min(x))}))
## add maturity stage
size_at_maturity_stage = read.csv("./SizeAggregTend_data/compiled/size_at_maturityStage_byQ.csv")
L05 = size_at_maturity_stage$L05
L95 = size_at_maturity_stage$L95

mat_stage <- NULL
for(i in 1:9){
  stage = rep(NA,32)
  stage[which(sp.mid.L[i,]<L05[i])] = 1
  stage[which(sp.mid.L[i+9,]<L05[i+9])+16] = 1
  stage[which(sp.mid.L[i,]>L95[i])] = 3
  stage[which(sp.mid.L[i+9,]>L95[i+9])+16] = 3
  stage[which(is.na(stage))] = 2
  mat_stage = c(mat_stage,stage)
}
sp_TL.result$mat_stage <- factor(mat_stage)

## add dummy variable
sp_TL.result$dum <- 1

## export sp_TL.result
#write.csv(sp_TL.result,"./SizeAggregTend_data/output/1_size_TL/all_TL_result_16_compiled.csv")

#####################################################################################
######################   Relationship fitting     ###################################
#####################################################################################

library("mgcv")
library("itsadug")
library("ggplot2")
library("dplyr")

### GLMM ############################################################

## Quarter ##
# temp_mean #
fit.QART.temp.lin <- gam(b~std_T*std_L*quarter+s(std_L,sp_ID,bs="re",by=dum)+s(sp_ID,bs="re",by=dum),
                     data = sp_TL.result,method = "ML",
                     family = Gamma(link = log))

# temp_cv #
fit.QART.tempCV.lin <- gam(b~std_T_cv*std_L*quarter+s(std_L,sp_ID,bs="re",by=dum)+s(sp_ID,bs="re",by=dum),
                    data = sp_TL.result,method = "ML",
                    family = Gamma(link = log))

## Spawn ##
# temp_mean #
fit.SPWN.temp.lin <- gam(b~std_T*std_L*spwn+s(std_L,sp_ID,bs="re",by=dum)+s(sp_ID,bs="re",by=dum),
                      data = sp_TL.result,method = "ML",
                      family = Gamma(link = log))

# temp_cv #
fit.SPWN.tempCV.lin <- gam(b~std_T_cv*std_L*spwn+s(std_L,sp_ID,bs="re",by=dum)+s(sp_ID,bs="re",by=dum),
                          data = sp_TL.result,method = "ML",
                          family = Gamma(link = log))

### GAMM ############################################################

fit.QART.temp.smooth.inter <- gam(b~quarter+
                                    ti(std_T,by=quarter,bs="ts")+
                                    ti(std_L,by=quarter,bs="ts")+
                                    ti(std_L,std_T,by=quarter,bs="ts")+
                                    s(std_L,sp_ID,bs="re",by=dum)+s(sp_ID,bs="re",by=dum),
                                  data = sp_TL.result,
                                  method = "ML",
                                  family = Gamma(link = log))
fit.QART.tempCV.smooth.inter <- gam(b~quarter+
                                    ti(std_T_cv,by=quarter,bs="ts")+
                                    ti(std_L,by=quarter,bs="ts")+
                                    ti(std_L,std_T_cv,by=quarter,bs="ts")+
                                    s(std_L,sp_ID,bs="re",by=dum)+s(sp_ID,bs="re",by=dum),
                                  data = sp_TL.result,
                                  method = "ML",
                                  family = Gamma(link = log))

fit.SPWN.temp.smooth.inter <- gam(b~spwn+
                                    ti(std_T,by=spwn,bs="ts")+
                                    ti(std_L,by=spwn,bs="ts")+
                                    ti(std_L,std_T,by=spwn,bs="ts")+
                                    s(std_L,sp_ID,bs="re",by=dum)+s(sp_ID,bs="re",by=dum),
                                  data = sp_TL.result,
                                  method = "ML",
                                  family = Gamma(link = log))
fit.SPWN.tempCV.smooth.inter <- gam(b~spwn+
                                    ti(std_T_cv,by=spwn,bs="ts")+
                                    ti(std_L,by=spwn,bs="ts")+
                                    ti(std_L,std_T_cv,by=spwn,bs="ts")+
                                    s(std_L,sp_ID,bs="re",by=dum)+s(sp_ID,bs="re",by=dum),
                                  data = sp_TL.result,
                                  method = "ML",
                                  family = Gamma(link = log))

# after use shrinkage method, we don't need to do the following part
# std_L smooth, temp smooth , no smoothing interaction #

#fit.QART.temp.smooth <- gam(b~quarter+
#                              s(std_T,by=quarter,bs="ts")+
#                              s(std_L,by=quarter,bs="ts")+
#                              s(std_L,sp_ID,bs="re",by=dum)+s(sp_ID,bs="re",by=dum),
#                            data = sp_TL.result,method = "ML",#select = F,
#                            family = Gamma(link = log))
#fit.SPWN.temp.smooth <- gam(b~spwn+
#                              s(std_T,by=spwn,bs="ts")+
#                              s(std_L,by=spwn,bs="ts")+
#                              s(std_L,sp_ID,bs="re",by=dum)+s(sp_ID,bs="re",by=dum),
#                            data = sp_TL.result,method = "ML",select = F,
#                            family = Gamma(link = log))

# no quarter or spawning #
fit.temp.noQorSPW <- gam(b~s(std_L,bs="ts")+s(std_T,bs="ts")+
                  s(std_L,sp_ID,bs="re")+s(sp_ID,bs="re"),
                data = sp_TL.result,method = "ML",select = F,
                family = Gamma(link = log))
fit.tempCV.noQorSPW <- gam(b~s(std_L,bs="ts")+s(std_T_cv,bs="ts")+
                           s(std_L,sp_ID,bs="re")+s(sp_ID,bs="re"),
                         data = sp_TL.result,method = "ML",select = F,
                         family = Gamma(link = log))

# one factor and no random effect #
fit.size.noRE <- gam(b~s(std_L),
                     data = sp_TL.result,method = "ML",select = F,
                     family = Gamma(link = log))
fit.temp.noRE <- gam(b~s(std_T),
                       data = sp_TL.result,method = "ML",select = F,
                       family = Gamma(link = log))
fit.tempCV.noRE <- gam(b~s(std_T_cv),
                     data = sp_TL.result,method = "ML",select = F,
                     family = Gamma(link = log))

### Model selection##########################################################

AIC(fit.QART.temp.lin,
    fit.QART.tempCV.lin,
    fit.QART.temp.smooth.inter,
    fit.QART.tempCV.smooth.inter,
    fit.SPWN.temp.lin,
    fit.SPWN.tempCV.lin,
    fit.SPWN.temp.smooth.inter,
    fit.SPWN.tempCV.smooth.inter,
    fit.temp.noQorSPW,
    fit.tempCV.noQorSPW,
    fit.size.noRE,
    fit.temp.noRE,
    fit.tempCV.noRE
    )

### Result using REML #######################################

fit.QART.tempCV.smooth.inter_Rslt <- gam(b~quarter+
                                    ti(std_T_cv,by=quarter,bs="ts")+
                                    ti(std_L,by=quarter,bs="ts")+
                                    ti(std_L,std_T_cv,by=quarter,bs="ts")+
                                    s(std_L,sp_ID,bs="re",by=dum)+s(sp_ID,bs="re",by=dum),
                                  data = sp_TL.result,
                                  method = "REML",
                                  family = Gamma(link = log)
                                  #select = T
)
summary(fit.QART.tempCV.smooth.inter_Rslt)
plot(fit.QART.tempCV.smooth.inter_Rslt)

##############################################################
#### propogate error of estimated TL exponents
#### to relationship analysis
##############################################################

##########
## NOTE ## To avoid resampling, use the data already save in 1_size_TL
##########

# TL exponents' bootstrap data -1
#TL_BSdata = apply(sp_TL.result,1,
#                  function(x){sample(seq(x[7],x[8],by=0.01),999,replace = T)})

# TL exponents' bootstrap data -2
#TL_BSdata = NULL

#for(s in 1:9){
#  sp_BS_result_filename =list.files("./SizeAggregTend_data/output/1_size_TL/TL999boot",
#                                    pattern = sp_name[s],
#                                    full.names = T)
#  sp_BS_result_filename_Q1 = sp_BS_result_filename[1:16]
#  size_class_Q1 = substr(sp_BS_result_filename_Q1,nchar(sp_BS_result_filename_Q1)-5,nchar(sp_BS_result_filename_Q1)-4)
#  size_class_Q1 = as.numeric(gsub("_", "", size_class))

#  sp_BS_result_filename_Q3 = sp_BS_result_filename[1:16]
#  size_class_Q3 = substr(sp_BS_result_filename_Q3,nchar(sp_BS_result_filename_Q3)-5,nchar(sp_BS_result_filename_Q3)-4)
#  size_class_Q3 = as.numeric(gsub("_", "", size_class))

#  for(i in 1:16){
#    size_BS_result_Q1 = read.csv(sp_BS_result_filename[i])
#    BS_resample_data_Q1 = sample(size_BS_result_Q1$V1,999,replace = T)
#    TL_BSdata = rbind(TL_BSdata,c(BS_resample_data_Q1,size_class_Q1[i],1))}

#  for(i in 1:16){
#    size_BS_result_Q3 = read.csv(sp_BS_result_filename[i+16])
#    BS_resample_data_Q3 = sample(size_BS_result_Q3$V1,999,replace = T)
#    TL_BSdata = rbind(TL_BSdata,c(BS_resample_data_Q3,size_class_Q3[i],3))
#  }
#}

#TL_BSdata = as.data.frame(TL_BSdata)
#colnames(TL_BSdata)[1000] = "size_class"
#colnames(TL_BSdata)[1001] = "quarter"
#TL_BSdata$sp_ID = rep(c(1:9),each=32)
#library("dplyr")
#TL_BSdata = TL_BSdata %>% arrange(sp_ID,quarter,size_class)

# save bs sample data
#write.csv(TL_BSdata,"./SizeAggregTend_data/output/1_size_TL/resample_TL_bs_data.csv")

TL_BSdata <- read.csv("./SizeAggregTend_data/output/1_size_TL/resample_TL_bs_data.csv")
TL_BSdata <- TL_BSdata[,-1]

# bootstrap 999 times for model fitting and prediction
bs_fit_para_summary <- NULL
bs_fit_smth_summary <- data.frame(temp_cv_Q1=NA,temp_cv_Q3=NA,
                                  size_Q1=NA,size_Q3=NA,
                                  inter_Q1=NA,inter_Q3=NA,
                                  re_slope=NA,re_intercept=NA)
bs_quarter_diff <- NULL
bs_pred_result_Q1 <- NULL
bs_pred_result_Q3 <- NULL
bs_pred_result_Q1_tempCV <- NULL
bs_pred_result_Q3_tempCV <- NULL
bs_pred_result_Q1_inter <- list()
newdat <- expand.grid(std_L = seq(-0.69,0.75,length=200),
                         std_T_cv = 0,
                         quarter = c("Q1","Q3"),
                         sp_ID = factor(c(1:9)),
                         dum=0)

newdat_Q1 <- expand.grid(std_L = seq(-0.69,0.75,length=200),
                      std_T_cv = 0,
                      quarter = c("Q1"),
                      sp_ID = factor(c(1:9)),
                      dum=0)
newdat_Q3 <- expand.grid(std_L = seq(-0.69,0.75,length=200),
                          std_T_cv = 0,
                          quarter = c("Q3"),
                          sp_ID = factor(c(1:9)),
                          dum=0)
newdat_Q3_tempCV <- expand.grid(std_T_cv = seq(-0.80,0.92,length=200),
                         std_L = 0,
                         quarter = c("Q3"),
                         sp_ID = factor(c(1:9)),
                         dum=0)
newdat_Q1_inter <- expand.grid(std_L = seq(-0.69,0.75,length=80),
                               std_T_cv = seq(-0.80,0.92,length=80),
                                quarter = c("Q1"),
                                sp_ID = factor(c(1:9)),
                                dum=0)

for (bs in 1:999){
  bs_TL_result <- cbind(TL_BSdata[,bs],sp_TL.result[,9:19])
  colnames(bs_TL_result)[1] <- "b"
  bs_fit <- gam(b~quarter+
                  ti(std_T_cv,by=quarter,bs="ts")+
                  ti(std_L,by=quarter,bs="ts")+
                  ti(std_L,std_T_cv,by=quarter,bs="ts")+
                  s(std_L,sp_ID,bs="re",by=dum)+s(sp_ID,bs="re",by=dum),
                data = bs_TL_result,
                method = "REML",
                family = Gamma(link = log)
  )
  bs_fit_summary <- summary(bs_fit)
  bs_fit_para_summary = rbind(bs_fit_para_summary,bs_fit_summary$p.table[2,])
  bs_fit_smth_summary = rbind(bs_fit_smth_summary,bs_fit_summary$s.table[,4])

  # quarter different
  bs_pred_b <- predict(bs_fit, newdata = newdat, type="lpmatrix")
  c1 <- grepl('Q1', colnames(bs_pred_b))
  c3 <- grepl('Q3', colnames(bs_pred_b))
  r1 <- with(newdat, quarter == 'Q1')
  r3 <- with(newdat, quarter == 'Q3')
  X <- bs_pred_b[r1, ] - bs_pred_b[r3, ]
  X[, ! (c1 | c3)] <- 0
  X[, !grepl('^ti\\(', colnames(bs_pred_b))] <- 0
  quarter_diff <- X %*% coef(bs_fit)
  quarter_diff <- tapply(quarter_diff,newdat_Q1$std_L,mean)
  bs_quarter_diff <- cbind(bs_quarter_diff,quarter_diff)

  # Q1 prediction
  bs_pred_b_Q1 <- tapply(predict(bs_fit, newdata = newdat_Q1, type="response"),newdat_Q1$std_L,mean)
  bs_pred_result_Q1 <- cbind(bs_pred_result_Q1,bs_pred_b_Q1)

  bs_pred_b_inter <- tapply(predict(bs_fit, newdata = newdat_Q1_inter, type="response"),list(newdat_Q1_inter$std_L,newdat_Q1_inter$std_T_cv),mean)
  bs_pred_result_Q1_inter[[bs]] <- bs_pred_b_inter

  # Q3 prediction

  bs_pred_b_Q3 <- tapply(predict(bs_fit, newdata = newdat_Q3, type="response"),newdat_Q3$std_L,mean)
  bs_pred_b_Q3_tempCV <- tapply(predict(bs_fit, newdata = newdat_Q3_tempCV, type="response"),newdat_Q3_tempCV$std_T_cv,mean)

  bs_pred_result_Q3 <- cbind(bs_pred_result_Q3,bs_pred_b_Q3)
  bs_pred_result_Q3_tempCV <- cbind(bs_pred_result_Q3_tempCV,bs_pred_b_Q3_tempCV)

  if(bs%%50==0){print(bs)}
}

bs_fit_smth_summary <- bs_fit_smth_summary[-1,]
write.csv(bs_fit_para_summary,"./SizeAggregTend_data/output/1_size_TL/bs_fit_para_summary.csv")
write.csv(bs_fit_smth_summary,"./SizeAggregTend_data/output/1_size_TL/bs_fit_smooth_summary.csv")

write.csv(bs_quarter_diff,"./SizeAggregTend_data/output/1_size_TL/bs_fit_quarter_difference.csv")
write.csv(bs_pred_result_Q1,"./SizeAggregTend_data/output/1_size_TL/bs_fit_predicted_data_Q1_way1.csv")
write.csv(bs_pred_result_Q3,"./SizeAggregTend_data/output/1_size_TL/bs_fit_predicted_data_Q3_way1.csv")
write.csv(bs_pred_result_Q1_tempCV,"./SizeAggregTend_data/output/1_size_TL/bs_fit_predicted_data_Q1_tempCV_way1.csv")
write.csv(bs_pred_result_Q3_tempCV,"./SizeAggregTend_data/output/1_size_TL/bs_fit_predicted_data_Q3_tempCV_way1.csv")
save(bs_pred_result_Q1_inter,file="./SizeAggregTend_data/output/1_size_TL/bs_fit_predicted_data_Q1_inter_way1.RData")

# plot p-value distribution in smooth result
bs_fit_para_summary <- read.csv("./SizeAggregTend_data/output/1_size_TL/bs_fit_para_summary.csv")
bs_fit_smth_summary <- read.csv("./SizeAggregTend_data/output/1_size_TL/bs_fit_smooth_summary.csv")

bs_fit_smth_summary <- bs_fit_smth_summary[-1,-1]
smth_var = c("Temp. CV Q1","Temp. CV Q3","Size Q1","Size Q3","Temp.CV:Size Q1","Temp. CV:Size Q3","Random Slope","Random Intercept")
No_p_sig = apply(bs_fit_smth_summary,2,function(x)length(which(x<=0.05)))

jpeg("./SizeAggregTend_data/output/fig/Appendix/Fig_bs_relationship_pval.jpeg", width=6.5, height=3.5, units = "in",res=500)
par(mfrow=c(2,4),mar=c(3,3,3,1),oma=c(2,2,0,0),cex=0.8)
for(i in 1:8){
  hist(bs_fit_smth_summary[,i],
       main="",
       xlim=c(0,max(bs_fit_smth_summary[,i])+0.002),xlab = "p-value",
       breaks = seq(0,max(bs_fit_smth_summary[,i])+0.001,0.001),
       family=c("newrom"))
  title(paste0(smth_var[i],"\n n=",No_p_sig[i]), adj = 0, line = 1,family=c("newrom"),cex.main=0.9)
  abline(v=0.05,lty=2)
}
mtext("p-value",outer = T,side = 1,family=c("newrom"))
mtext("Frequency",outer = T,side = 2,family=c("newrom"))
dev.off()

######################
# plot result
######################
bs_quarter_diff <- read.csv("./SizeAggregTend_data/output/1_size_TL/bs_fit_quarter_difference.csv")
bs_pred_result_Q1 <- read.csv("./SizeAggregTend_data/output/1_size_TL/bs_fit_predicted_data_Q1_way1.csv")
bs_pred_result_Q3 <- read.csv("./SizeAggregTend_data/output/1_size_TL/bs_fit_predicted_data_Q3_way1.csv")
bs_pred_result_Q3_tempCV <- read.csv("./SizeAggregTend_data/output/1_size_TL/bs_fit_predicted_data_Q3_tempCV_way1.csv")
load("./SizeAggregTend_data/output/1_size_TL/bs_fit_predicted_data_Q1_inter_way1.RData")

# original model prediction
# quarter different
pred_b <- predict(fit.QART.tempCV.smooth.inter_Rslt, newdata = newdat, type="lpmatrix")
c1 <- grepl('Q1', colnames(pred_b))
c3 <- grepl('Q3', colnames(pred_b))
r1 <- with(newdat, quarter == 'Q1')
r3 <- with(newdat, quarter == 'Q3')
X <- pred_b[r1, ] - pred_b[r3, ]
X[, ! (c1 | c3)] <- 0
X[, !grepl('^ti\\(', colnames(pred_b))] <- 0
quarter_diff <- X %*% coef(fit.QART.tempCV.smooth.inter_Rslt)
quarter_diff <- tapply(quarter_diff,newdat_Q1$std_L,mean)

pred_b_Q1 <- tapply(predict(fit.QART.tempCV.smooth.inter_Rslt, newdata = newdat_Q1, type="response"),
                    newdat_Q1$std_L,mean)
pred_b_Q3 <- tapply(predict(fit.QART.tempCV.smooth.inter_Rslt, newdata = newdat_Q3, type="response"),
                    newdat_Q3$std_L,mean)
pred_b_Q3_tempCV <- tapply(predict(fit.QART.tempCV.smooth.inter_Rslt, newdata = newdat_Q3_tempCV, type="response"),
                    newdat_Q3$std_L,mean)

bs_quarter_diff <- cbind(bs_quarter_diff[,-1],quarter_diff)
bs_pred_result_Q1 <- cbind(bs_pred_result_Q1[,-1],pred_b_Q1)
bs_pred_result_Q3 <- cbind(bs_pred_result_Q3[,-1],pred_b_Q3)
bs_pred_result_Q3_tempCV <- cbind(bs_pred_result_Q3_tempCV[,-1],pred_b_Q3_tempCV)

# bca 95CI
library("coxed")
bca_Qdiff_95CI <- apply(bs_quarter_diff,1,bca)
bca_size_95CI_Q1 <- apply(bs_pred_result_Q1,1,bca)
bca_size_95CI_Q3 <- apply(bs_pred_result_Q3,1,bca)
bca_tempCV_95CI_Q3 <- apply(bs_pred_result_Q3_tempCV,1,bca)

library(dplyr)

# plot #
jpeg("./SizeAggregTend_data/output/fig/Fig_main_effect_with_bs_and_matstage.jpeg", width=1961, height=800, units = "px",res=300)

par(mfrow=c(1,2),oma=c(0,0,1,1),mar=c(4,4,1,1),cex.axis=0.8,cex.lab=0.8)

#Q1
plot(unique(newdat$std_L),pred_b_Q1,
     type="l",xlim = c(-0.8,0.8),ylim=c(0.5,4),
     xlab="Standardized length",
     ylab="Taylor's exponents",bty="l")
polygon(c(rev(unique(newdat$std_L)), unique(newdat$std_L)),
        c(rev(bca_size_95CI_Q1[2,]), bca_size_95CI_Q1[1,]),
        col = rgb(50, 50, 50, 40, maxColorValue=255), border = NA)

#for(bs in 1:999){
#  lines(unique(newdat_Q1$std_L),bs_pred_result_Q1[,bs],
#        col=rgb(128, 138, 135, 60, maxColorValue=255),lwd=0.5)}
lines(unique(newdat$std_L),pred_b_Q1,lwd=2)

sp_TL.result %>% filter(quarter=="Q1" & mat_stage==1) %>%
  with(points(b~std_L,pch=1,cex=0.6,col="grey30",xlim = c(-0.9,0.9),ylim = c(1,3.5)))
sp_TL.result %>% filter(quarter=="Q1" & mat_stage==2) %>%
  with(points(b~std_L,pch=1,cex=0.6,col="grey80",xlim = c(-0.9,0.9),ylim = c(1,3.5)))
sp_TL.result %>% filter(quarter=="Q1" & mat_stage==3) %>%
  with(points(b~std_L,pch=1,cex=0.6,col="black",xlim = c(-0.9,0.9),ylim = c(1,3.5)))
legend("topright",c("immature","maturing","matured"),pch=1,col=c("grey30","grey80","black"),horiz = F,cex = 0.5)

#points(b~std_L,data=sp_TL.result[which(sp_TL.result$quarter=="Q1"),],
#       col=rgb(0, 0, 0, 80, maxColorValue=255),pch=19,cex=0.5)
mtext("(a)", side = 3, line = 1, outer =F,at =-1,adj=0,cex = 0.9)

#Q3
plot(unique(newdat$std_L),pred_b_Q3,
     type="l",xlim = c(-0.8,0.8),ylim=c(0.5,4),
     xlab="Standardized length",
     ylab="Taylor's exponents",bty="l")
polygon(c(rev(unique(newdat$std_L)), unique(newdat$std_L)),
        c(rev(bca_size_95CI_Q3[2,]), bca_size_95CI_Q3[1,]),
        col = rgb(50, 50, 50, 40, maxColorValue=255), border = NA)

#for(bs in 1:999){
#  lines(unique(newdat_Q3$std_L),bs_pred_result_Q3[,bs],
#        col=rgb(128, 138, 135, 60, maxColorValue=255),lwd=0.5)}
lines(unique(newdat$std_L),pred_b_Q3,lwd=2)
sp_TL.result %>% filter(quarter=="Q3" & mat_stage==1) %>%
  with(points(b~std_L,pch=1,cex=0.6,col="grey30",xlim = c(-0.9,0.9),ylim = c(1,3.5)))
sp_TL.result %>% filter(quarter=="Q3" & mat_stage==2) %>%
  with(points(b~std_L,pch=1,cex=0.6,col="grey80",xlim = c(-0.9,0.9),ylim = c(1,3.5)))
sp_TL.result %>% filter(quarter=="Q3" & mat_stage==3) %>%
  with(points(b~std_L,pch=1,cex=0.6,col="black",xlim = c(-0.9,0.9),ylim = c(1,3.5)))
legend("topright",c("immature","maturing","matured"),pch=1,col=c("grey30","grey80","black"),horiz = F,cex = 0.5)

#points(b~std_L,
#       data=sp_TL.result[which(sp_TL.result$quarter=="Q3"),],
#       col=rgb(0, 0, 0, 80, maxColorValue=255),pch=19,cex=0.5)

mtext("(b)", side = 3, line = 1, outer =F,adj=0,cex = 0.9)
dev.off()

# peak location
Max_b_Q1 <- apply(bs_pred_result_Q1,2,max)
peak_locat_order_Q1 <- apply(bs_pred_result_Q1,2,function(x)which(x==max(x)))
peak_locat_Q1 <- seq(-0.69,0.75,length=200)[peak_locat_order_Q1]
bca(peak_locat_Q1)
peak_locat_Q1[length(peak_locat_Q1)]

Max_b_Q3 <- apply(bs_pred_result_Q3,2,max)
peak_locat_order_Q3 <- apply(bs_pred_result_Q3,2,function(x)which(x==max(x)))
peak_locat_Q3 <- seq(-0.69,0.75,length=200)[peak_locat_order_Q3]
bca(peak_locat_Q3)
peak_locat_Q3[length(peak_locat_Q3)]

#######################################################
### Plot difference between two quarter
jpeg("./SizeAggregTend_data/output/fig/Appendix/Fig_quarter_size_diff.jpeg", width=6, height=5, units = "in",res=600)

plot(unique(newdat$std_L),bs_quarter_diff[,1000],
     type="l",xlim = c(-0.7,0.8),ylim=c(-0.15,0.2),
     xlab="Standardized length",ylab="Difference between quarter",family=c("newrom"),bty="l")
polygon(c(rev(unique(newdat$std_L)), unique(newdat$std_L)),
        c(rev(bca_Qdiff_95CI[2,]), bca_Qdiff_95CI[1,]),
        col = rgb(50, 50, 50, 40, maxColorValue=255), border = NA)
abline(h=0)
abline(v=range(as.numeric(colnames(bca_Qdiff_95CI)[which(bca_Qdiff_95CI[1,]>0)])),lty=2)
abline(v=range(as.numeric(colnames(bca_Qdiff_95CI)[which(bca_Qdiff_95CI[2,]<0)])),lty=2)

dev.off()

#################################################
# mature stage effect on the relationship
#################################################

# dunn-test
library("rstatix")
dunn_matstage_Q1 = sp_TL.result%>%
  filter(quarter=="Q1") %>%
  dunn_test(b~mat_stage, p.adjust.method = "BH")
dunn_matstage_Q1 <- dunn_matstage_Q1 %>% add_xy_position(x = "mat_stage")

dunn_matstage_Q3 = sp_TL.result%>%
  filter(quarter=="Q3") %>%
  dunn_test(b~mat_stage, p.adjust.method = "BH")
dunn_matstage_Q3 <- dunn_matstage_Q3 %>% add_xy_position(x = "mat_stage")

jpeg("./SizeAggregTend_data/output/fig/Fig_matstagebyQ_dunntest_Q1.jpeg", width=980.5, height=700, units = "px",res=300)
library(ggplot2)
library("ggpubr")
ggboxplot(sp_TL.result[which(sp_TL.result$quarter=="Q1"),],
          x = "mat_stage", y = "b", fill = "mat_stage",
          xlab="",ylab="Taylor's exponents") +
  stat_pvalue_manual(dunn_matstage_Q1, hide.ns = FALSE,y.position = c(3.5,3.6,3.7))+
  scale_x_discrete(labels=c("immature","maturing","matured"))+
  theme(legend.position = "none",
        axis.text.y = element_text(size=rel(0.9),angle = 90),
        axis.text.x = element_text(size=rel(0.9)),
        axis.title=element_text(size=rel(0.9)))+
  ylim(1.5,3.8)

dev.off()

jpeg("./SizeAggregTend_data/output/fig/Fig_matstagebyQ_dunntest_Q3.jpeg", width=980.5, height=700, units = "px",res=300)

ggboxplot(sp_TL.result[which(sp_TL.result$quarter=="Q3"),],
          x = "mat_stage", y = "b", fill = "mat_stage",
          xlab="",ylab="Taylor's exponents") +
  stat_pvalue_manual(dunn_matstage_Q3, hide.ns = FALSE,y.position = c(3.5,3.6,3.7))+
  scale_x_discrete(labels=c("immature","maturing","matured"))+
  theme(legend.position = "none",
        axis.text.y = element_text(size=rel(0.9),angle = 90),
        axis.text.x = element_text(size=rel(0.9)),
        axis.title=element_text(size=rel(0.8)))+
  ylim(1.5,3.8)

dev.off()

#######
# examine the relationship in each maturity stage
#######

# Q1

lm1.g = sp_TL.result %>% filter(quarter=="Q1" & mat_stage==1) %>%
  with(gam(b~std_L+s(sp_ID,bs="re"),family = Gamma(link = "log")))
lm2.g = sp_TL.result %>% filter(quarter=="Q1" & mat_stage==2) %>%
  with(gam(b~std_L+s(sp_ID,std_L,bs="re")+s(sp_ID,bs="re"),family = Gamma(link = "log")))
lm3.g = sp_TL.result %>% filter(quarter=="Q1" & mat_stage==3) %>%
  with(gam(b~std_L+s(sp_ID,bs="re"),family = Gamma(link = "log")))

# Q3
lm1.3.g = sp_TL.result %>% filter(quarter=="Q3" & mat_stage==1) %>%
  with(gam(b~std_L+s(sp_ID,std_L,bs="re")+s(sp_ID,bs="re"),family = Gamma(link = "log")))
lm2.3.g = sp_TL.result %>% filter(quarter=="Q3" & mat_stage==2) %>%
  with(gam(b~std_L+s(sp_ID,std_L,bs="re")+s(sp_ID,bs="re"),family = Gamma(link = "log")))
lm3.3.g = sp_TL.result %>% filter(quarter=="Q3" & mat_stage==3) %>%
  with(gam(b~std_L,family = Gamma(link = "log")))

# bootstrap 999 times for model fitting and prediction
bs_matstage_lin_result_Q1 <- NULL
bs_matstage_lin_result_Q3 <- NULL

for (bs in 1:999){
  bs_TL_result <- cbind(TL_BSdata[,bs],sp_TL.result[,9:19])
  colnames(bs_TL_result)[1] <- "b"

  #Q1
  for(mat in 1:3){
    bs_glm_result <- bs_TL_result %>% filter(quarter=="Q1" & mat_stage==mat) %>%
      with(gam(b~std_L+s(sp_ID,std_L,bs="re")+s(sp_ID,bs="re"),family = Gamma(link = "log")))
    bs_matstage_lin_result_Q1 <- rbind(bs_matstage_lin_result_Q1,c(coef(bs_glm_result)[1:2],mat,1))
  }

  #Q3
  for(mat in 1:3){
    bs_glm_result <- bs_TL_result %>% filter(quarter=="Q3" & mat_stage==mat) %>%
      with(gam(b~std_L+s(sp_ID,std_L,bs="re")+s(sp_ID,bs="re"),family = Gamma(link = "log")))
    bs_matstage_lin_result_Q3 <- rbind(bs_matstage_lin_result_Q3,c(coef(bs_glm_result)[1:2],mat,3))
  }
  if(bs%%50==0){print(bs)}
}

bs_matstage_lin_result_Q1 <- as.data.frame(bs_matstage_lin_result_Q1)
bs_matstage_lin_result_Q3 <- as.data.frame(bs_matstage_lin_result_Q3)
colnames(bs_matstage_lin_result_Q1)[2:4] <- c("slope","mat_stage","quarter")
colnames(bs_matstage_lin_result_Q3)[2:4] <- c("slope","mat_stage","quarter")

write.csv(bs_matstage_lin_result_Q1,"./SizeAggregTend_data/output/1_size_TL/bs_lin_matstage_byQ_QART_1.csv")
write.csv(bs_matstage_lin_result_Q3,"./SizeAggregTend_data/output/1_size_TL/bs_lin_matstage_byQ_QART_3.csv")

bs_matstage_lin_result_Q1 <- read.csv("./SizeAggregTend_data/output/1_size_TL/bs_lin_matstage_byQ_QART_1.csv")
bs_matstage_lin_result_Q3 <- read.csv("./SizeAggregTend_data/output/1_size_TL/bs_lin_matstage_byQ_QART_3.csv")

# plot
add_eq_fuc = function(model){
  cf <- round(coef(model), 2)
  eq <- paste0(" log(y) = ", cf[1],ifelse(sign(cf[2])==1, " + ", " - "), abs(cf[2]), "x")
  return(eq)
}

library("coxed")
glm_fit_result <- list(lm1.g,lm2.g,lm3.g,lm1.3.g,lm2.3.g,lm3.3.g)
mat_stage_name <- c("immature","maturing","matured")

# Q1
jpeg("./SizeAggregTend_data/output/fig/Fig_relationship_in_each_matstagebyQ_Q1.jpeg", width=980.5, height=800, units = "px",res=300)
par(mfrow=c(1,3),mar=c(2,2,2,0),oma=c(3,3,3,1),cex.axis=1.2,cex.lab=0.8)

for(mat in 1:3){
  sp_TL.result %>% filter(quarter=="Q1" & mat_stage==mat) %>% with(plot(b~std_L,ylim=c(1,4),yaxt="n"))
  if(mat==1){axis(side = 2)}

  if(summary(glm_fit_result[[mat]])$p.table[2,4]<=0.05){
  lines(seq(-0.8,0.8,0.1),predict(glm_fit_result[[mat]],newdata = data.frame(expand.grid(std_L=seq(-0.8,0.8,0.1),sp_ID=1)),type = "response"))
  lm.g.eq <- add_eq_fuc(glm_fit_result[[mat]])
  lm.g.ci <- bs_matstage_lin_result_Q1 %>% filter(mat_stage==mat) %>% with(bca(slope)) %>% round(2)
  mtext(lm.g.eq, 3, line=-1.5,cex=0.35)
  mtext(paste0("CI=[",lm.g.ci[1],",",lm.g.ci[2],"]"), 3, line=-2.4,cex=0.35)
  }
  mtext(mat_stage_name[mat],3,line=1,cex = 0.8)
}
mtext("Standardized length",side=1,line=1,outer = T,cex = 0.8)
mtext("Taylor's exponents",side=2,line=1,outer = T,cex = 0.8)
mtext("(c)",side=3,line=1,outer = T,cex = 0.9,adj = 0)

dev.off()

# Q3
jpeg("./SizeAggregTend_data/output/fig/Fig_relationship_in_each_matstagebyQ_Q3.jpeg", width=980.5, height=800, units = "px",res=300)
par(mfrow=c(1,3),mar=c(2,2,2,0),oma=c(3,3,3,1),cex.axis=1.2,cex.lab=0.8)
for(mat in 1:3){
  sp_TL.result %>% filter(quarter=="Q3" & mat_stage==mat) %>% with(plot(b~std_L,ylim=c(0.5,4),yaxt="n"))
  if(mat==1){axis(side = 2)}

  if(summary(glm_fit_result[[mat+3]])$p.table[2,4]<=0.05){
    lines(seq(-0.8,0.8,0.1),predict(glm_fit_result[[mat+3]],newdata = data.frame(expand.grid(std_L=seq(-0.8,0.8,0.1),sp_ID=1)),type = "response"))
    lm.g.eq <- add_eq_fuc(glm_fit_result[[mat+3]])
    lm.g.ci <- bs_matstage_lin_result_Q3 %>% filter(mat_stage==mat) %>% with(bca(slope)) %>% round(2)
    mtext(lm.g.eq, 3, line=-1.5,cex=0.35)
    mtext(paste0("CI=[",lm.g.ci[1],",",lm.g.ci[2],"]"), 3, line=-2.2,cex=0.35)
  }
  mtext(mat_stage_name[mat],3,line=1,cex = 0.8)
}

mtext("Standardized length",side=1,line=1,outer = T,cex = 0.8)
mtext("Taylor's exponents",side=2,line=1,outer = T,cex = 0.8)
mtext("(d)",side=3,line=1,outer = T,cex = 0.9,adj = 0)

dev.off()


# PROVIDE ANNOTATION FOR GENES
AnnotateGenes <- function(genes){
  # Annotate genes.
  annotated_data <- cbind(genes, Annotation[rownames(genes),])
  return(annotated_data)
}

# CREATE GENE EXPRESSION FILE (.TXT) FOR GSEA
CreateGeneExpressionFile <- function(df_1, df_2, names){
  # Combine expression data of shared genes for two conditions, store in data frame and write to .txt file.
  shared_genes <- intersect(row.names(df_1), row.names(df_2))
  df_1 <- as.data.frame(df_1[row.names(df_1) %in% shared_genes,])
  df_2 <- as.data.frame(df_2[row.names(df_2) %in% shared_genes,])
  df <- cbind(shared_genes, NA, df_1, df_2, row.names=shared_genes)
  colnames(df) <- c('NAME', 'DESCRIPTION', names)
  write.table(df, file='Results/gsea_gene_expression.txt', row.names=F, quote=F, sep='\t')
}

# CREATE GENE SETS FILE (.GMX) FOR GSEA
CreateGeneSetsFile <- function(){
  max_nrow = 0
  # Load unique subclasses from Annotation, filter out duplicate/null values.
  subclasses <- as.character(unique(Annotation$subclass))
  subclasses <- subclasses[!(duplicated(tolower(subclasses)))]
  subclasses <- subclasses[subclasses != '']
  # Get corresponding genes per subclass, store in data frame and write to .gmx file.
  df <- data.frame(All=row.names(Annotation))
  for(index in 1:length(subclasses)){
    temp_subset <- subset(Annotation, Annotation$subclass==subclasses[index])['subclass']
    genes <- c(NA, row.names(temp_subset))
    df$col <- c(genes, rep('', nrow(df)-length(genes)))
    names(df)[index+1] = subclasses[index]
    if(nrow(temp_subset) > max_nrow){
      max_nrow = nrow(temp_subset)
    }
  }
  df <- subset(df, select = -c(All))
  df <- df[-c(max_nrow+2:nrow(df)), ]
  write.table(df, file='Results/gsea_gene_sets.gmx', row.names=F, quote=F, sep='\t')
}

# STORE EXPERIMENTAL CONDITIONS IN FACTOR NAMED GROUP
CreateGroup <- function(conditions){
  exp <- rep(conditions, each=2)
  group <- factor(exp)
  return(group)
}

# CREATE glmLRT MODEL
CreateModel <- function(strain, data, group){
  # Group samples by condition into design matrix.
  design <- model.matrix(~0+group, data=data$samples)
  colnames(design) <- levels(data$samples$group)
  # Create model for top differentially expressed genes.
  fit <- glmFit(data, design)
  if(strain == 'WCFS1'){
    mc <- makeContrasts(exp.r=WCFS1.glc-WCFS1.rib, levels=design)
  } else if(strain == 'NC8'){
    mc <- makeContrasts(exp.r=NC8.glc-NC8.rib, levels=design)
  }
  fit <- glmLRT(fit, contrast=mc)
  return(fit)
}

# PERFORM VARIOUS DATA PROCESSING TASKS
DataProcessing <- function(group, start, stop, cpm_filter){
  # Create DGEList object for storage of RNA-Seq data.
  y <- DGEList(counts=Counts[,start:stop], group=group)
  # Filter out genes below cpm_filter.
  keep.genes <- rowSums(cpm(y)>cpm_filter) >= 2
  y <- y[keep.genes,]
  y$samples$lib.size <- colSums(y$counts)
  # Determine scale factors using Trimmed Mean of M-values (TMM).
  y <- calcNormFactors(y, method='TMM')
  # Group samples by condition into design matrix.
  design <- model.matrix(~0+group, data=y$samples)
  colnames(design) <- levels(y$samples$group)
  # Estimate dispersions.
  y <- estimateGLMCommonDisp(y,design)
  y <- estimateGLMTrendedDisp(y,design, method='power')
  y <- estimateGLMTagwiseDisp(y,design)
  return(y)
}

# DETERMINE TOP DIFFERENTIALLY EXPRESSED GENES FOR A GIVEN LOGFC FILTER
DetermineDEGenes <- function(fit, filter_logFC){
  df <- topTags(fit, n=nrow(fit))
  df <- df$table
  df <- subset(df, abs(logFC) >= filter_logFC)
  return(df)
}

# DETERMINE OVERREPRESENTATION OF GENES IN KEGG PATHWAYS
DeterminePathwayOverrep <- function(fit, n_results){
  kegg_pathways <- kegga(fit, species.KEGG=KEGG_SPECIES)
  top_OR_pathways <- topKEGG(kegg_pathways, number=n_results)
  return(top_OR_pathways)
}

# GET KEGG PATHWAYS FOR GIVEN GENES
GetPathwaysForGenes <- function(genes){
  # Set up data frame.
  cols <- rownames(genes)
  n_pathways <- dbGetQuery(KEGG_dbconn(), 'SELECT COUNT(*) FROM pathway2name')[1,1]
  df <- data.frame(matrix(ncol=length(cols), nrow=n_pathways))
  colnames(df) <- cols
  # Store pathways per gene in data frame.
  max_n_pathways = 0
  for(index in 1:length(cols)){
    gene <- cols[index]
    try(query <- keggGet(c(paste('lpl:', gene, sep=''))), silent=T)
    if(exists('query')){
      pathways <- query[[1]]$PATHWAY
      if(!is.null(pathways)){
        for(index_2 in 1:length(pathways)){
          df[index_2, index] = pathways[index_2]
        }
        if(length(pathways) > max_n_pathways){
          max_n_pathways = length(pathways)
        }
      }
    }
  }
  df <- df[-c(max_n_pathways+1:nrow(df)), ]
  return(df)
}

# PLOT LOGFC VALUES OF GENES INTO A HEAT MAP
PlotHeatMap <- function(WCFS1_df, NC8_df, n_genes, ...){
  # Cuts data frames down to selected number of genes.
  WCFS1_df <- WCFS1_df[1:n_genes,]
  NC8_df <- NC8_df[1:n_genes,]
  shared_genes <- intersect(row.names(WCFS1_df), row.names(NC8_df))
  # Reduces data frames to only contain shared genes.
  WCFS1_df <- as.data.frame(WCFS1_df[row.names(WCFS1_df) %in% shared_genes,])
  NC8_df <- as.data.frame(NC8_df[row.names(NC8_df) %in% shared_genes,])
  # Combines data frames into single data frame and provides annotation.
  annotation_df <- as.data.frame(Annotation[row.names(Annotation) %in% shared_genes,])
  annotation_df <- subset(annotation_df, select=c('name', 'subclass'))
  df <- cbind(WCFS1_df['logFC'], NC8_df['logFC'], row.names=shared_genes)
  annotation_df <- cbind(df, annotation_df[rownames(df),], row.names=shared_genes)
  # Visualizes heat map and sets column and row names.
  rownames(df) <- paste(annotation_df[,'name'], annotation_df[,'subclass'], sep=' - ')
  colnames(df) <- c('WCFS1', 'NC8')
  color_palette <- colorRampPalette(c('green','blue'))(n = 64)
  heatmap.2(as.matrix(df),
            adjCol=c(NA, 0.5),
            cexCol=1.5,
            col=color_palette,
            Colv=F,
            dendrogram='none',
            density.info='none',
            margins=c(3,22),
            notecol='black',
            srtCol=0,
            trace='none')
}

# PLOT SAMPLE DISTANCES
PlotSampleDistances <- function(title, data, group, ...){
  # Set up colors and symbols for plot.
  if(length(levels(group)) == 4){
    colors <- rep(c('red', 'red', 'blue', 'blue'), 2)
  } else if(length(levels(group)) == 2){
    colors <- rep(c('red', 'blue'), 2)
  }
  par(mar=c(5.1, 4.1, 4.1, 8.1), xpd=TRUE)
  pch <- rep(c(PCH_1, PCH_2), length(levels(group)))
  pch_legend <- rep(c(16, 18), length(levels(group))/2)
  # Visualize plot.
  plotMDS(data, bg=colors[group], cex=2, col=1, pch=pch[group], xlab='Dimension 1', ylab='Dimension 2')
  title(title, line=0.5)
  legend('topright', col=colors, inset=c(-0.25,0), legend=levels(group), ncol=1, pch=pch_legend, title='Samples')
}

# PLOT A GIVEN KEGG PATHWAY WITH LOGFC VALUES OF GENES
PlotKEGGpathway <- function(df, pathway_id, pathway_name, fit, ...){
  # Select logFC values from genes in a specific pathway.
  matches <- vector('numeric')
  for(index in 1:ncol(df)){
    temp_vector <- df[,index]
    if(pathway_name %in% temp_vector){
      matches <- append(matches, colnames(df)[index])
    }
  }
  input_df <- subset(fit$table[row.names(fit$table) %in% matches,], select=logFC)
  input <- input_df[,length(input_df)]
  names(input) <- row.names(input_df)
  # Visualizes logFC values inside KEGG pathway.
  pathview(gene.data=input, species=KEGG_SPECIES, pathway=pathway_id, gene.idtype='KEGG')
}

# WRITE RESULTS TO EXCEL FILE
WriteResults <- function(file_name, annotated_results, sheet_name_1, or_pathways, sheet_name_2, pathways_de_genes, sheet_name_3){
  # Write results to sheets in Excel file.
  write.xlsx(annotated_results, file=file_name, sheetName=sheet_name_1, col.names=TRUE, row.names=TRUE, append=TRUE, showNA=TRUE)
  write.xlsx(or_pathways, file=file_name, sheetName=sheet_name_2, col.names=TRUE, row.names=TRUE, append=TRUE, showNA=TRUE)
  write.xlsx(pathways_de_genes, file=file_name, sheetName=sheet_name_3, col.names=TRUE, row.names=FALSE, append=TRUE, showNA=FALSE)
}


#==============================================================================
#	Test for ranger
#==============================================================================

source("tests.r")
iris2 <- iris
iris2$Species <- as.character(iris2$Species)

test.data <- list(
	call = list(
		substitute(
			ranger(Sepal.Length ~ ., data = iris, write.forest = TRUE)
		),
		substitute(ranger(Species ~ ., data = iris, write.forest = TRUE)),
		substitute(
			ranger(
				Species ~ ., data = iris2, write.forest = TRUE,
				probability = TRUE
			)
		)
	),
	formula = list(
		Sepal.Length ~ Sepal.Width + Petal.Length + Petal.Width + Species,
		Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width,
		Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width
	),
	model.type = list("regression", "classification", "classification")
)

test.model.adapter("ranger", iris, test.data)

rm(test.data)


statesInfo <- read.csv('stateData.csv')

subset(statesInfo, state.region == 1)
stateSubset <- statesInfo[statesInfo$illiteracy == 0.5, ]

dim(stateSubset)
str(stateSubset)

stateSubset


library(shiny)
library(ggplot2)
library(TTR)
library(httr)
library(dygraphs)
library(datasets)
library(xts)
library(plyr)

# sensor = "Node_383"
# channels = "accelerationx,accelerationy,accelerationz,air:temperature"
# time_start = "2014-11-23T07:56:48.006750000+0100"
# time_end = "2014-11-25T07:57:00.256750000+0100"
#
# url <- paste0("http://quader.igg.tu-berlin.de/istsos/bridgedemoservice?service=SOS&request=GetObservation&offering=temporary&procedure=",sensor,"&observedProperty=",channels,"&responseFormat=text/plain&version=1.0.0&",time_start,"/",time_end)
# dataset1 <- read.csv(file=url, header = TRUE)# read csv fil

dataset1<- read.csv(file="Node383.csv", header = TRUE, stringsAsFactors = F)  # read csv file
dataset2 <- read.csv(file="Node384.csv", header = TRUE, skip=16,stringsAsFactors = F )  # read csv file
dataset3 <- read.csv(file="Node573.csv", header = TRUE, skip=16,stringsAsFactors = F )  # read csv file
dataset4 <- read.csv(file="Node574.csv", header = TRUE, skip=15,stringsAsFactors = F)  # read csv file
#
#---------------------------------------------------------------------------------------------------------
#---------------------------------------------------------------------------------------------------------
dataset1$Timestamp..GMT. <- sub("\\.\\d*$","",dataset1$Timestamp..GMT.)
dataset2$Timestamp..GMT. <- sub("\\.\\d*$","",dataset2$Timestamp..GMT.)
dataset3$Timestamp..GMT. <- sub("\\.\\d*$","",dataset3$Timestamp..GMT.)
dataset4$Timestamp..GMT. <- sub("\\.\\d*$","",dataset4$Timestamp..GMT.)
#---------------------------------------------------------------------------------------------
#---------------------------------------------------------------------------------------------
dataset1.summary <- ddply(dataset1, "Timestamp..GMT.", summarise,
                          chan1 = (Channel.1),
                          chan2 = (Channel.2),
                          chan3 = (Channel.3),
                          chan4 = (Channel.4))

dataset2.summary <- ddply(dataset2, "Timestamp..GMT.", summarise,
                          chan1 = (Channel.1),
                          chan2 = (Channel.2),
                          chan3 = (Channel.3),
                          chan4 = (Channel.4))

dataset3.summary <- ddply(dataset3, "Timestamp..GMT.", summarise,
                          chan1 = (Channel.1),
                          chan2 = (Channel.2),
                          chan3 = (Channel.3),
                          chan8 = (Channel.8))

dataset4.summary <- ddply(dataset4, "Timestamp..GMT.", summarise,
                          chan1 = (Channel.1),
                          chan2 = (Channel.2),
                          chan8 = (Channel.8))
#--------------------------------------------------------------------------------------------

#--------------------------------------------------------------------------------------------
# Convert first column to ts:
z <- strptime(dataset1.summary$Timestamp..GMT., "%d/%m/%Y %H:%M:%OS")
dataset1.summary$Timestamp..GMT. <- z # replace data frame info

y <- strptime(dataset2.summary$Timestamp..GMT., "%d/%m/%Y %H:%M:%OS")
dataset2.summary$Timestamp..GMT. <- y # replace data frame info

x <- strptime(dataset3.summary$Timestamp..GMT., "%d/%m/%Y %H:%M:%OS")
dataset3.summary$Timestamp..GMT. <- x # replace data frame info

w <- strptime(dataset4.summary$Timestamp..GMT., "%d/%m/%Y %H:%M:%OS")
dataset4.summary$Timestamp..GMT. <- w # replace data frame info
#--------------------------------------------------------------------------------------------
#--------------------------------------------------------------------------------------------
# Make individual time series:
test1 <- xts(dataset1.summary$chan1, dataset1.summary$Timestamp..GMT.)
test2 <- xts(dataset1.summary$chan2, dataset1.summary$Timestamp..GMT.)
test3 <- xts(dataset1.summary$chan3, dataset1.summary$Timestamp..GMT.)
test4 <- xts(dataset1.summary$chan4, dataset1.summary$Timestamp..GMT.)

test21 <- xts(dataset2.summary$chan1, dataset2.summary$Timestamp..GMT.)
test22 <- xts(dataset2.summary$chan2, dataset2.summary$Timestamp..GMT.)
test23 <- xts(dataset2.summary$chan3, dataset2.summary$Timestamp..GMT.)
test24 <- xts(dataset2.summary$chan4, dataset2.summary$Timestamp..GMT.)

test31 <- xts(dataset3.summary$chan1, dataset3.summary$Timestamp..GMT.)
test32 <- xts(dataset3.summary$chan2, dataset3.summary$Timestamp..GMT.)
test33 <- xts(dataset3.summary$chan3, dataset3.summary$Timestamp..GMT.)
test34 <- xts(dataset3.summary$chan8, dataset3.summary$Timestamp..GMT.)

test41 <- xts(dataset4.summary$chan1, dataset4.summary$Timestamp..GMT.)
test42 <- xts(dataset4.summary$chan2, dataset4.summary$Timestamp..GMT.)
test48 <- xts(dataset4.summary$chan8, dataset4.summary$Timestamp..GMT.)

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

##---end of functions-------
## Define server logic required to generate and plot a random distribution
shinyServer(function(input,output) {

  ##---functions----------
  linear_regression <- function(x,y){
    plot(y ~ x, xlab="acceleration.x",ylab ="acceleration.y", main="linear regression plotting")
    model = lm(y ~ x)
    abline(lm(y ~ x),col=2,lwd=2)
    return (model)
 }

  #dygraph(test, main = "Node383",) %>%

#--datset chooseing--

dataset <- reactive({
  if(input$radio == "Node 383")
    #dataset1 <- cbind(test1,test2,test3,test4)
    data <- dataset1

  else if(input$radio == "Node 384")
   # dataset2<- cbind(test21,test22,test23,test24)
    data <- dataset2

  else if(input$radio == "Node 573")
    #dataset3<- cbind(test31,test32,test33,test34)
       data <- dataset3

  else if(input$radio == "Node 574")
    # dataset4 <- cbind(test41,test42,test43,test44)
      data <- dataset4

  else("Error selecting a Node")
      })
#----------------------------------------------------------------------------------------------------------
#----------------------------------------------------------------------------------------------------------
myData <- function(){
  if(input$radio == "Node 383"){
    test <- cbind(test1,test2,test3,test4)
  }
  else if(input$radio == "Node 384") {
    test <- cbind(test21,test22,test23,test24)
  }

  else if(input$radio == "Node 573")
    test <- cbind(test31,test32,test33,test34)

 else if(input$radio == "Node 574")
    test <- cbind(test41,test42)
  #else if

  else("Error selecting a Node")
}

#----------------------------------------------------------------------------------------------------------
#----------------------------------------------------------------------------------------------------------
time<- reactive({
  timestamp = dataset()[1:input$samplesize,1]
  date = as.character(lapply(strsplit(as.character(timestamp), split=" "), "[", 1))
  hms = as.character(lapply(strsplit(as.character(timestamp), split=" "), "[", 2))
  h = as.numeric(lapply(strsplit(hms, split=":"), "[", 1))
  m = as.numeric(lapply(strsplit(hms, split=":"), "[", 2))
  s = as.numeric(lapply(strsplit(hms, split=":"), "[", 3))

  time_sec = NULL
  for(i in 1:length(timestamp))
  {
    time_sec[i] = h[i]*3600 + m[i]*60 + s[i]
  }
  time_sec
#
#   date = as.character(lapply(strsplit(as.character(timestamp), split="T"), "[", 1))
#   hms = as.character(lapply(strsplit(as.character(timestamp), split="T"), "[", 2))
#   h = as.numeric(lapply(strsplit(hms, split=":"), "[", 1))
#   m = as.numeric(lapply(strsplit(hms, split=":"), "[", 2))
#   # s = as.numeric(lapply(strsplit(hms, split=":"), "[", 3)) # gave NAs introduced by coercion
#
#   # Cutting characters manually
#   s = as.numeric(substr(hms, 7, 15)) # characters 7 to 15
#
#   # Gets UTC component, also cut manually
#   utcComp = as.numeric(substr(hms, 17, 18))
#
#   h=h+utcComp # adding UTC to hours value
#
#   # Filling time vector
#   time_sec = NULL
#   for(i in 1:length(timestamp))
#   {
#     time_sec[i] = h[i]*3600 + m[i]*60 + s[i]
#   }
#   time_sec
})

channel1<- reactive({
 dataset()$Channel.1
})

channel2<- reactive({
  dataset()$Channel.2
})

channel3<- reactive({
  dataset()$Channel.3
})

channel4<- reactive({
  dataset()$Channel.4
})
#----datset---------
output$plot <- renderPlot(function(){

  p <- ggplot(dataset(),aes_string(x=input$x, y=input$y))+geom_point()

  if(input$color != 'None')
    p <- p + aes_string(color=input$color)

  if (input$shape != 'None')
    p <- p + aes_string(shape=input$shape)

  facets <- paste(input$facet_row, '~', input$facet_col)

  if (facets != '. ~ .')
    p <- p + facet_grid(facets)

  if (input$jitter)
    p <- p + geom_jitter()

  if (input$smooth)
    p <- p + geom_smooth()

  print(p)

})
#--------summary tab-----------------
output$dataname<- renderText({
  paste("summary of dataset", input$radio)
})

output$summary <- renderPrint({
  summary(dataset()[,3:6])
})

#-------end of summary-------------
#--------------------------------------------------------------------------------------------

#--------------------------------------------------------------------------------------------
#---------------------Plot Tab--------------------------
output$plot <- renderDygraph({
  print(summary(myData()))
  dygraph(myData()) %>%
    dyRoller(rollPeriod = 10)%>%
    dyOptions(drawPoints = TRUE, pointSize= 1.3  ,colors = RColorBrewer::brewer.pal(4, "Set2"),)%>%
    dyLegend(width= 600)%>%
    dySeries("..1", axis = "y" , label = "Accelation-x")%>%
    dySeries("..2", axis = "y" , label = "Accelation-y")%>%
    dySeries("..3", axis = "y" , label = "Accelation-z")%>%
    dySeries("..4", axis = "y2" , label = "Temperature")%>%
    dyAxis("y", label = "Accelation-x y, and z")%>%
    dyAxis("y2", label = "Temperature")%>%
    dyRangeSelector()
})

#output$plot1 <- renderDygraph({
#  test2 <- cbind(test21,test22,test23,test24)
#  dygraph(test2, main = "Node384",)%>%
#    dyRangeSelector()
#})

#output$plot2 <- renderDygraph({
#  test3 <- cbind(test31, test32)
#  dygraph(test3, main = "Sensor 3",) %>%
#    dyRangeSelector()
#})

#output$plot3 <- renderDygraph({
#  test4 <- cbind(test41, test42)
#  dygraph(test4, main = "Sensor 4",) %>%
 #   dyRangeSelector()
#})

#----------------- end of Plot Tab----------------------
#--------------------------------------------------------------------------------------------

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

#--------data tab----------------
output$datadf <- renderTable({
  dataset()
})
output$data <- renderTable({
  head(get(dataset()), n=input$samplesize)
})
#-----end of data------------------

#--------statistic tab----------------
output$samplesize<- renderText({
  paste(input$samplesize, "observations of dataset", input$radio)
})

output$stats <- renderPrint({
  summary(dataset()[input$samplesize,3:6])
})
#-----end of statistic------------------

#----similarity tab--------
output$plot_acf <- renderPlot({
data<-channel1()[1:input$samplesize]
 ac_res <- acf(data,length(data)/input$acf_lag, type = input$acf_options, na.action = na.pass, col="red") # type should be "correlation", "covariance", "partial"
})
#output$plot_acf <- renderDygraph({
 # data<-test1()[1:input$samplesize]
 # gygraph(ac_res <- acf(data,length(data)/input$acf_lag, type = input$acf_options, na.action = na.pass, col="red")) # type should be "correlation", "covariance", "partial"
#})

output$plot_pacf <- renderPlot({
 source('crossCorr_standAlone.r')
})

output$plot_ccf <- renderPlot({
data1= data.frame(time()[1:input$samplesize], channel1()[1:input$samplesize])
data2= data.frame(time()[1:input$samplesize], channel2()[1:input$samplesize])
source('crossCorr_function.r')
crossCorr_function(data1, data2, input$ccf_lag)
})

output$datadf <- renderTable({
  data1<- data.frame(time()[1:input$samplesize], dataset()$Channel.1[1:input$samplesize])
  data2<- data.frame(time()[1:input$samplesize], dataset()$Channel.2[1:input$samplesize])
  data1
})
#-----end of similarity tab----

##----test tab-------
output$info<- renderText({
  paste("Information",br(),
        "The selected sensor is",names(dataset()),"and the selected channel is",input$radio)
})
output$str <- renderPrint({
  channel1<-dataset()$Channel.1
  channel2<-dataset()$Channel.2
  a <- linear_regression(channel1,channel2)
  summary(a)
})
output$plot_lm <- renderPlot({
#   channel1<-dataset()$Channel.1[1:input$samplesize]
#   channel2<-dataset()$Channel.2[1:input$samplesize]
#   linear_regression(channel1,channel2)
  if(input$reg_options == "LM")
    source('REGRESSIONS/linearRegression_standalone.r')
  else if(input$reg_options == "PR2")
    source('REGRESSIONs/linearRegression_standalone.r')
  else if(input$reg_options == "PR3")
    source('REGRESSIONs/linearRegression_standalone.r')
  else if(input$reg_options == "PR4")
    source('REGRESSIONs/linearRegression_standalone.r')
  else if(input$reg_options == "PR5")
    source('REGRESSIONs/linearRegression_standalone.r')
  else if(input$reg_options == "PR6")
    source('REGRESSIONs/linearRegression_standalone.r')
  else if(input$reg_options == "PR7")
    source('REGRESSIONs/linearRegression_standalone.r')
  else if(input$reg_options == "PR8")
    source('REGRESSIONs/linearRegression_standalone.r')
  else if(input$reg_options == "PR9")
    source('REGRESSIONs/linearRegression_standalone.r')
  else if(input$reg_options == "PR10")
    source('REGRESSIONs/linearRegression_standalone.r')
})

st_test <- eventReactive(input$stat_check, {
  source('stationarity_standalone.r')
})

output$st_text <- renderText({
  st_test()
})
output$down <- downloadHandler(
  filename=function(){
    paste("untitled",".png",sep=" ")
  },
  content=function(file){
    png(file)
    plot(dataset()$Channel.1,dataset()$Channel.2)
    dev.off()
  })
#--------end of test tab

#------filter tab-----
output$plot_sma <- renderPlot({
  channel1<-dataset()$Channel.1[1:input$samplesize]
  channel2<-dataset()$Channel.2[1:input$samplesize]
  sma(channel1,10)
})

output$text = renderText({
 sensor = "NNode383"
 channels = "accelerationx,accelerationy,accelerationz,air:temperature"
 time_start = "2014-05-13T07:56:48.006750000+0100"
 time_end = "2014-05-13T07:57:00.256750000+0100"

 url <- paste0("http://quader.igg.tu-berlin.de/istsos/test?service=SOS&request=GetObservation&offering=temporary&procedure=",sensor,"&observedProperty=",channels,"&responseFormat=text/plain&version=1.0.0&",time_start,"/",time_end)

})

output$plot_ma <- renderPlot({

   source('movingAverage_standalone.r')#%>%
})
#---end of filter tab-----

##-------info tab--------
#output$text = renderText({paste("Function Definitions", "\n", "You have chosen a range that goes from", input$range[1], "to", input$range[2])})

#---------end of info tab--------
})

#source('sample.r')


ref <- sapply(
  tools::file_path_sans_ext(grep('20201103', gwloggeR.data::enumerate(partner = 'knmi'), value = TRUE)),
  function(name) {
    df.ref <- gwloggeR.data::read(name)$df
    list('x' = df.ref[!is.na(PRESSURE_VALUE), PRESSURE_VALUE],
         'timestamps' = df.ref[!is.na(PRESSURE_VALUE), TIMESTAMP_UTC])
  },
  simplify = FALSE, USE.NAMES = TRUE
)

# INBO Barometers --------------------------------------------------------------

sapply(
  grep('barometer', gwloggeR.data::enumerate(partner = 'inbo'), value = TRUE),
  function(f) {
    ROOT.PATH <- './tests/analytics/detect_drift/inbo/'

    df <- gwloggeR.data::read(f)$df
    df <- df[!is.na(TIMESTAMP_UTC),]
    df <- df[!is.na(PRESSURE_VALUE),]
    df <- df[order(TIMESTAMP_UTC),]

    if (nrow(df) == 0L) {
      warning(sprintf('Skipping %s: no valid data.', f), call. = FALSE, immediate. = TRUE)
      return(invisible(FALSE))
    }

    gwloggeR:::test.detect_function(
      fun = gwloggeR::detect_drift,
      x = df$PRESSURE_VALUE,
      timestamps = df$TIMESTAMP_UTC,
      reference = ref,
      apriori = gwloggeR::Apriori("air pressure", "cmH2O"),
      alpha = 1,
      verbose = TRUE,
      plot = TRUE,
      title = toupper(f),
      RESULT.PATH = paste0(ROOT.PATH, f, '.result'),
      ATTRIB.PATH = paste0(ROOT.PATH, f, '.attribs'),
      IMG.PATH = paste0(ROOT.PATH, f, '.png'),
      LOG.PATH = paste0(ROOT.PATH, f, '.log')
    )
  }
)


Portrait<-F                 # graphical output orientation

first.year<- 1963                #first year on plot, negative value means value defined by data
last.year<- 2100               #last year on plot

HindcastModel<-T; # plot values from the hindcast
ForecastModel<-F; # plot values from the scenarios

redefine.scenario.manually<-F  # Define the scenario dir used explecitely in this script or do it externally

op.dir<-data.path
if (ForecastModel==T & redefine.scenario.manually)  {
   scenario<-"Opti-2_HCR_4_stoch_penBlim_atAgeW__";
   output.dir<-data.path
   op.dir<-file.path(data.path,scenario)
} else if (ForecastModel==T ) {
   output.dir<-scenario.dir
   op.dir<-scenario.dir
}

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

my.dev<-'png'   # output device:  'screen', 'wmf', 'png', 'pdf'
#my.dev<-'screen'

cleanup()
file.name<-'summary'

nox<-3; noy<-1;
noxy<-nox*noy

ref<-Read.reference.points()

Init.function()

MSFD<-read.FLOP.MSFD.control(file=file.path(op.dir,"op_msfd.dat"),n.VPA=nsp-first.VPA+1,n.other.pred=first.VPA-1)

if (HindcastModel) {
  dat1<-subset(Read.summary.data(dir=data.path),Year<=last.year &Species.n>=first.VPA)
  if (first.year>0) dat1<-subset(dat1,Year>=first.year  )

  # mean weight in the sea and in tha catch
  w<-subset(dat1,select=c(Species.n,Year,Quarter,Age,weca,west, N,C.obs ))
  incl<-data.frame(Species.n=first.VPA:nsp,incl=c(MSFD@mean.weight.C.sp))
  w<-subset(merge(incl,w),incl==1)
  w[w$weca<-0,'weca']<-0
  w$N1<-w$N
  w[w$Age==0,'N1']<-0
  w$WC<-w$C.obs*w$weca
  w$WN<-w$N*w$west
  w$WN1<-w$N1*w$west

  w<-aggregate(cbind(WC,WN,WN1,N,N1,C.obs)~Species.n+Year,data=w,sum,na.rm=T)
  w$west<-w$WN/w$N
  w$west1<-w$WN1/w$N1
  w$weca<-w$WC/w$C.obs
  w<-subset(w,select=c( Species.n, Year, west,west1,weca))

  #Species average M2  and F
  mf<-subset(dat1,select=c(Species.n,Year,Quarter,Age, N.bar,M2,C.hat ))
  mf$deadM2<-mf$N.bar*mf$M2
  inclM<-data.frame(Species.n=first.VPA:nsp,faM=c(MSFD@M2.bar.ages[1,]),laM=c(MSFD@M2.bar.ages[2,]) )
  inclF<-data.frame(Species.n=first.VPA:nsp,faC=c(SMS.control@avg.F.ages[,1]),laC=c(SMS.control@avg.F.ages[,2]) )
  incl<-merge(inclM,inclF)
  mf<-merge(incl,mf)
  mf$inclF<-F
  mf$inclM<-F
  mf[mf$faM>=0 & mf$laM>=0 & mf$Age>=mf$faM & mf$Age<=mf$laM,'inclM']<-T
  mf[mf$faC>=0 & mf$laC>=0 & mf$Age>=mf$faC & mf$Age<=mf$laC,'inclF']<-T

  m<-droplevels(subset(mf,inclM==T))
  m$deadM2<-m$N.bar*m$M2
  m<-aggregate(deadM2~Species.n+Year+Age,sum,data=m)
  mn<-subset(dat1,(Age>0 & Quarter==1) | (Age==0 & Quarter==3),select=c(Species.n,Year,Age,N))
  mz<-aggregate(Z~Species.n+Year+Age,sum,data=dat1)
  mm<-merge(mn,mz)
  mm$N.bar<-mm$N*(1-exp(-mm$Z))/mm$Z
  m<-merge(mm,m)
  m$M2<- m$deadM2/m$N.bar
  m<-aggregate(M2~Species.n+Year,mean,data=m)

  f<-droplevels(subset(mf,inclF==T))
  f<-aggregate(C.hat~Species.n+Year+Age,sum,data=f)
  fn<-subset(dat1,(Age>0 & Quarter==1) | (Age==0 & Quarter==3),select=c(Species.n,Year,Age,N))
  fz<-aggregate(Z~Species.n+Year+Age,sum,data=dat1)
  ff<-merge(fn,fz)
  ff$N.bar<-ff$N*(1-exp(-ff$Z))/ff$Z
  f<-merge(ff,f)
  f$F<- f$C.hat/f$N.bar
  f<-aggregate(F~Species.n+Year,mean,data=f)

 fm<-merge(f,m,all=T)

  life.expectancy<-function(fa,la) {
    # life expectancy
    bio<-subset(dat1,select=c(Species.n,Year,Quarter,Age,Z))
    incl<-data.frame(Species.n=first.VPA:nsp,incl=c(MSFD@community.life.expectancy.options['first.age',]))
    incl<-NULL
    for (s in (first.VPA:nsp)) {
            fa.i<-fa[s-first.VPA+1]
            la.i<-la[s]
            if (la.i>=fa.i) incl<-rbind(incl,data.frame(Species.n=s,Age=seq(fa.i,la.i)))
     }
    bio<-merge(bio,incl)
  #  a<-data.frame(Species.n=first.VPA:nsp,w=c(MSFD@community.life.expectancy.options['weighting',]))
   # bio<-merge(bio,a)

    bio<-bio[order(bio$Species.n,bio$Year,bio$Age,bio$Quarter),]
    min.Year<-min(bio$Year)
    bio$first<- !duplicated(paste(bio$Species.n,bio$Year))

    a<-unique(subset(bio,first,select=c(Species.n,Age,Quarter)))
    a$ini.age<-a$Age+(a$Quarter-1)*0.25
    a<-subset(a,select=c(Species.n,ini.age))

    bio<-merge(bio,a)
    bio$sumZ<-bio$Z
    bio<-bio[order(bio$Species.n,bio$Year,bio$Age,bio$Quarter),]

    for (x in (1:dim(bio)[1])) {
     if (!bio[x,'first']) bio[x,'sumZ']<-bio[x,'sumZ']+(bio[x-1,'sumZ'])
    }
    bio$p<-exp(-bio$sumZ)

    a<-aggregate(p~Year+Species.n+ini.age,sum,na.rm=T,data=bio)
    a$Expectancy<-a$p/4 + a$ini.age+0.25/2  # to expected life in years (from quarters)
    a$p<-NULL
    a$ini.age<-NULL
    return(a)
  }
  a<-life.expectancy(fa=MSFD@community.life.expectancy.options['first.age',],la=SMS.control@species.info[,'last-age'])
  aa<-MSFD@community.life.expectancy.options['first.age',]
  aa[]<-1
  a1<-life.expectancy(fa=aa,la=SMS.control@species.info[,'last-age'])
  a1$Expectancy1<-a1$Expectancy
  a1$Expectancy<-NULL
  a<-merge(a,a1)
}

add.set<-strmacro(in1,in2,out,
   expr={
    if (HindcastModel & ForecastModel) out<-c(in1,in2) else if (HindcastModel) out<-c(in1)  else if (ForecastModel) out<-c(in2)
  } )

 ##  HER SKAL HISTORISKE DATA SAMLES MED SCENARIO DATA

a<-merge(a,w,all = T)
a<-merge(a,fm,all=T)
# a includes all data

a$Species<-sp.names[a$Species.n]

my.sp<-sort(unique(a$Species.n))

cleanup()
plotfile<-function(dev='screen',out) {
  if (dev=='screen') X11(width=8, height=12, pointsize=12)
  if (dev=='wmf') win.metafile(filename = paste(out,'.wmf',sep=''), width=8, height=10, pointsize=12)
  if (dev=='png') png(filename =paste(out,'.png',sep=''), width = 1000, height = 1400,units = "px", pointsize = 30, bg = "white")
  if (dev=='pdf') pdf(file =paste(out,'.pdf',sep=''), width = 8, height = 10,pointsize = 12,onefile=FALSE)
}

for (sp in my.sp) {
  #sp<-18
  Species<-sp.names[sp]
  b<-droplevels(subset(a,Species.n==sp))

  plotfile(dev=my.dev,out=file.path(op.dir,paste('Species_indicator',sp,sep='-')));
  par(mfcol=c(nox,noy))
  par(mar=c(3,4,3,2))  # bottom, left, top, right
  par(mar=c(2,4,3,5)+.1)  #bottom, left, top, right

  # F and M2
  min.d<-min(min(b$M2,na.rm=T),min(b$F,na.rm=T),na.rm=T)
  max.d<-max(max(b$M2,na.rm=T),max(b$F,na.rm=T),na.rm=T)

   plot(b$Year,b$F, ylim=c(min.d,max.d),type='b',xlab='Year',ylab='',lty=1,pch='F',lwd=2,main=paste(Species,' Mean F and M2',sep=':'))
  lines(b$Year,b$M2,lty=2,pch='M',lwd=2,type='b',col=2)

   #  life.expect
     min.d<-min(min(b$Expectancy,na.rm=T),min(b$Expectancy1,na.rm=T),na.rm=T)
  max.d<-max(max(b$Expectancy,na.rm=T),max(b$Expectancy1,na.rm=T),na.rm=T)

  plot(b$Year,b$Expectancy,lty=1,pch='0',lwd=2,ylab='year',xlab=' ',type='b',col=1,ylim=c(min.d,max.d),main="Life expectancy for age 0 (third quarter) and age 1")
  lines(b$Year,b$Expectancy1,lty=2,pch='1',lwd=2,type='b',col=2)

  min.d<-min(min(b$west,na.rm=T),min(b$weca,na.rm=T),na.rm=T)
  max.d<-max(max(b$west,na.rm=T),max(b$weca,na.rm=T),na.rm=T)

  plot(b$Year,b$weca, ylim=c(min.d,max.d),type='b',xlab='Year',col='blue',ylab='kg',lty=1,pch='c',lwd=2,main=paste('Mean weight in the sea (for age>=0 and age>=1) and in the catch (c)',sep=':'))
  lines(b$Year,b$west,lty=2,pch='0',lwd=2,type='b',col=1)
   lines(b$Year,b$west1,lty=2,pch='1',lwd=2,type='b',col=2)

  if (my.dev %in% c('png','wmf','pdf')) dev.off()
}