context("Matching groups")

set.seed(1410)
num <- matrix(sample(9, 10 * 10, replace = T), ncol = 10)
num_flat <- apply(num, 1, str_c, collapse = "")

phones <- str_c(
  "(", num[, 1], num[ ,2], num[, 3], ") ",
  num[, 4], num[, 5], num[, 6], " ",
  num[, 7], num[, 8], num[, 9], num[, 10])

test_that("special case are correct", {
  expect_equal(str_match(NA, "(a)"), matrix(NA_character_))
  expect_equal(str_match(character(), "(a)"), matrix(character(), 0, 1))
})

test_that("no matching cases returns 1 column matrix", {
  res <- str_match(c("a", "b"), ".")

  expect_equal(nrow(res), 2)
  expect_equal(ncol(res), 1)

  expect_equal(res[, 1], c("a", "b"))
})

test_that("single match works when all match", {
  matches <- str_match(phones, "\\(([0-9]{3})\\) ([0-9]{3}) ([0-9]{4})")

  expect_equal(nrow(matches), length(phones))
  expect_equal(ncol(matches), 4)

  expect_equal(matches[, 1], phones)

  matches_flat <- apply(matches[, -1], 1, str_c, collapse = "")
  expect_equal(matches_flat, num_flat)
})

test_that("match returns NA when some inputs don't match", {
  matches <- str_match(c(phones, "blah", NA),
    "\\(([0-9]{3})\\) ([0-9]{3}) ([0-9]{4})")

  expect_equal(nrow(matches), length(phones) + 2)
  expect_equal(ncol(matches), 4)

  expect_equal(matches[11, ], rep(NA_character_, 4))
  expect_equal(matches[12, ], rep(NA_character_, 4))
})

test_that("match returns NA when optional group doesn't match", {
  expect_equal(str_match(c("ab", "a"), "(a)(b)?")[,3], c("b", NA))
})

test_that("match_all returns NA when option group doesn't match",{
  expect_equal(str_match_all("a", "(a)(b)?")[[1]][1, ], c("a", "a", NA))
})

test_that("multiple match works", {
  phones_one <- str_c(phones, collapse = " ")
  multi_match <- str_match_all(phones_one,
    "\\(([0-9]{3})\\) ([0-9]{3}) ([0-9]{4})")
  single_matches <- str_match(phones,
    "\\(([0-9]{3})\\) ([0-9]{3}) ([0-9]{4})")

  expect_equal(multi_match[[1]], single_matches)
})


#' Removes the intercept term from a formula if it is included
#'
#' Often, we prefer not to have an intercept term in a model, but user-specified
#' formulas might have included the intercept term. In this case, we wish to
#' update the formula but without the intercept term. This is especially true in
#' numerous classification models, where errors and doom can occur if an
#' intercept is included in the model.
#'
#' @importFrom stats terms update
#' @param formula a model formula to remove its intercept term
#' @param data data frame
#' @return formula with no intercept term
#' @examples
#' iris_formula <- formula(Species ~ .)
#' sparsediscrim:::no_intercept(iris_formula, data = iris)
no_intercept <- function(formula, data) {
  # The 'terms' must be collected in case the dot (.) notation is used
  update(formula(terms(formula, data = data)), . ~ . - 1)
}


# combining Delgado and Ramirez covariate data
rm(list=ls())
source('NEFI_functions/crib_fun.r')
source("paths.r")
source("paths_fall2019.r")
library(runjags)

output.path <- delgado_ramirez_bahram_mapping.path

#### prep Ramirez et al. data ####
map.ram <- readRDS(ramirez_clean_map.path)
map.ram$source <- "Ramirez"
map.ram$study_id <- map.ram$dataset
#map.ram <- map.ram[which(map.ram$sequencing_platform != "454"),]
map.ram$pC <- map.ram$C
map.ram$pN <- map.ram$N
map.ram$cn <- map.ram$pC/map.ram$pN
map.ram$depth_max <- map.ram$depth_max.x

# prep delgado mapping data
map.del <- readRDS(delgado_metadata_spatial.path)
map.del$source <- "Delgado"
map.del$study_id <- "Delgado"
map.del$depth_max <- 7.5
map.del$pN <- map.del$soil_n
map.del$NPP.del <- map.del$NPP # keep delgado's original NPP values
map.del$NPP <- map.del$NPP_recent

# fill with NAs? or, only common columns?
common_cols <- intersect(colnames(map.ram), colnames(map.del))
master.map <- do.call(plyr::rbind.fill, list(map.ram, map.del))
master.map <- master.map[,colnames(master.map) %in% c(common_cols)]

# add some colors
# study_id <- levels(as.factor(master.map$study_id))
# pals <- distinctColorPalette(length(study_id))
# colors <- cbind(study_id, pals)
# master.map <- merge(master.map, colors)

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

# reduce map values
master.map$map <- master.map$map/1000
master.map$map_sd <- master.map$map_sd/1000

# save output
saveRDS(master.map, output.path)


#' @title clip_by_poly_generic
#' @description This function takes a dataframe and a polygon, and clips
#' the data to the extent of the polygon.  The polygon can be buffered as required to select nearby
#' data as well.
#' @param df default is \code{NULL}.  This is the dataframe to be clipped.
#' @param lat.field the default is \code{"LATITUDE"}. the name of the field holding latitude values
#' (in decimal degrees)
#' @param lon.field the default is \code{"LONGITUDE"}.  the name of the field holding longitude
#' values (in decimal degrees)
#' @param clip.poly default is \code{NULL}. This is the full path to a shapefile
#' that the data will be clipped by (including the '.shp' extension).
#' @param buffer.m default is \code{NULL}. This is the distance in meters to buffer the border of
#' \code{clip.poly}
#' @param return.spatial default is \code{FALSE}. If this is TRUE, a
#' SpatialPointsDataFrame will be returned. Otherwise it will return a df.
#' @param env This the the environment you want this function to work in.  The
#' default value is \code{.GlobalEnv}.
#' @return spatialPointsDataFrame
#' @family general_use
#' @author  Mike McMahon, \email{Mike.McMahon@@dfo-mpo.gc.ca}
#' @export
#' @note If the input polygon has no projection assigned, it will be assumed to be in Geographic,
#' WGS84. FYI, during buffering, the polygon is briefly converted to UTMZone20, and back again,
#' since the use of distances requires projecting the data.
clip_by_poly_generic <- function(df=NULL,
                         lat.field = "LATITUDE",
                         lon.field = "LONGITUDE",
                         clip.poly = NULL,
                         buffer.m = NULL,
                         return.spatial = FALSE,
                         env=.GlobalEnv){
  df=df_qc_spatial(df)
  df.sp = sp::SpatialPointsDataFrame(
    coords = df[, c(lon.field, lat.field)],
    data = df,
    proj4string = sp::CRS(SRS_string="EPSG:4326")
  )
  if (class(clip.poly)=="character"){
    #extract the full path and name of the shapefile
    ogrPath = dirname(clip.poly)
    ogrLayer = sub('\\.shp$', '', basename(clip.poly))
    clip.poly_this <- rgdal::readOGR(dsn = ogrPath, layer = ogrLayer, verbose = FALSE)
  }else if(class(clip.poly)=="SpatialPolygonsDataFrame"){
    clip.poly_this = clip.poly
  }

  if (is.na(sp::proj4string(clip.poly_this))) {
    cat('\nNo projection found for input shapefile - assuming geographic.')
    sp::proj4string(clip.poly_this) = sp::CRS(SRS_string="EPSG:4326")
  } else if (sp::proj4string(clip.poly_this)!="EPSG:4326") {
    clip.poly_this = suppressWarnings(sp::spTransform(clip.poly_this, sp::CRS(SRS_string="EPSG:4326")))
  }

  if (!is.null(buffer.m)){
    #if a buffer is specified, convert poly to UTM20N, apply buffer, and convert back
    clip.poly_this = suppressWarnings(sp::spTransform(clip.poly_this, sp::CRS(SRS_string="EPSG:2220")))
    clip.poly_this = rgeos::gBuffer(clip.poly_this, width=buffer.m)
    clip.poly_this = suppressWarnings(sp::spTransform(clip.poly_this, sp::CRS(SRS_string="EPSG:4326")))
  }
  if (NROW(df.sp[clip.poly_this, ]) ==0) {
    stop("\nNo data lies inside this polygon, aborting clip.")
  }
  df.sp_subset <- df.sp[clip.poly_this, ]

  if (!return.spatial){
    df.sp_subset = df.sp_subset@data
  }

  return(df.sp_subset)

}


#generate lineplots of counts of variables
#monthly counts by year
#total counts over whole study period

#plot groups of variables on one plot
# can't use count list because doesn't have variable names

# find correct folders

if(!require(rstudioapi)){install.packages("rstudioapi")}
library(rstudioapi)

projectFolder<-dirname(rstudioapi::getSourceEditorContext()$path)
setwd(projectFolder)
plotFolder_med<-paste0(projectFolder,"/g_intermediate/populations/MEDICINES/monthly_counts")
plotFolder_diag<-paste0(projectFolder,"/g_intermediate/populations/DIAGNOSES/monthly_counts")

#extract count files

count_names_diag<-list.files(plotFolder_diag, pattern="count")
count_names_med<-list.files(plotFolder_med, pattern="count")

count_files_diag<-lapply(paste0(plotFolder_diag,"/", count_names_diag), readRDS)
count_files_med<-lapply(paste0(plotFolder_med,"/", count_names_med), readRDS)

#masking

# mask<-T

# group_names<-c("alt_med", "contracep", "etc...")

# medicines

for(i in 1:length(count_names_med)){
  main_name<-substr(count_names_med[[i]], 1,nchar(count_names_med[[i]])-11)

  pdf((paste0(projectFolder, "/g_output/plots/", main_name, ".pdf")), width=8, height=4)

  var_counts<-count_files_med[[i]]$N
  if(mask==T){var_counts[(0<var_counts)&(var_counts<=5)]<-5}

  mycounts<-ts(var_counts, frequency = 12, start = 2009,end = 2020)
  mydates<-paste0(15,"-",count_files_med[[i]]$month, "-", count_files_med[[i]]$year)
  count_files_med[[i]]$date<-as.Date(mydates, "%d-%m-%y")

  plot(mycounts, xaxt="n", yaxt="n", xlab="", ylab="counts", main=main_name, lwd=2, cex.main=1.5)
  tsp = attributes(mycounts)$tsp
  dates = seq(as.Date("2009-01-01"), by = "month", along = mycounts)
  axis(1, at = seq(tsp[1], tsp[2], along = mycounts),las=2, labels = format(dates, "%Y-%m"))
  axis(2, seq(0:(max(count_files_med[[i]]$N)+1)))
  dev.off()

}

#diagnoses

for(i in 1:length(count_names_diag)){
  main_name<-substr(count_names_diag[[i]], 1,nchar(count_names_diag[[i]])-11)

  pdf((paste0(projectFolder, "/g_output/plots/", main_name, ".pdf")), width=8, height=4)

  var_counts<-count_files_diag[[i]]$N
  if(mask==T){var_counts[(0<var_counts)&(var_counts<=5)]<-5}

  mycounts<-ts(var_counts, frequency = 12, start = 2009,end = 2020)
  mydates<-paste0(15,"-",count_files_diag[[i]]$month, "-", count_files_diag[[i]]$year)
  count_files_diag[[i]]$date<-as.Date(mydates, "%d-%m-%y")

  plot(mycounts, xaxt="n", yaxt="n", xlab="", ylab="counts", main=main_name, lwd=2, cex.main=1.5)
  tsp = attributes(mycounts)$tsp
  dates = seq(as.Date("2009-01-01"), by = "month", along = mycounts)
  axis(1, at = seq(tsp[1], tsp[2], along = mycounts),las=2, labels = format(dates, "%Y-%m"))
  axis(2, seq(0:(max(count_files_diag[[i]]$N)+1)))
  dev.off()

}


#site_obs_aggregation.r
rm(list=ls())
source('paths.r')

site.out <- readRDS(site_level_data.path)

#get global means.
to_ag <- site.out[,c('map','mat','NPP','n.dep','dry.dep')]
 Mean <- apply(to_ag, 2, mean)
   SD <- apply(to_ag, 2,   sd)
preds <- colnames(to_ag)
glob.out <- data.frame(preds,Mean, SD)

#Get forest and conifer 0-1 assignments.
siteID <- c("ORNL", "CPER", "WOOD", "TALL", "JERC", "OSBS", "RMNP", "HARV", "BART", "STER", "SCBI", "DSNY", "UNDE")
forest <- c(1,0,0,1,0,1,1,1,1,0,1,0,1)
conifer <- c(1,0,0,1,0,1,1,1,1,0,0,1,1)
to_merge <- data.frame(siteID,forest,conifer)
site.out <- merge(site.out, to_merge, all.x=T)

#save output.
saveRDS(site.out, site_site.path)
saveRDS(glob.out, site_glob.path)


library(readr)
library(lubridate)
library(chron)
library(reshape2)
grupos_municipios_prex11 <- read_csv("~/Documentos/IMCO/Proyectos/MAGDA/Finales/indice-de-actividad-economica/data/cnbv/processed/grupos_municipios_prex11.csv",
                                     col_types = "ccdddd")
View(grupos_municipios_prex11)

cnbv_muns<-grupos_municipios_prex11
cnbv_muns$ENT<-substr(cnbv_muns$CVEMUN,start = 0,stop = 2)

cnbv_muns_edo<-cnbv_muns %>% group_by(ENT,fecha) %>% summarise(bancomer=sum(bancomer),
                                                           banamex=sum(banamex),
                                                           valor=sum(valor),
                                                           otros=sum(otros)) %>%
  filter(month(fecha)==12,year(fecha)>=2014)

ggplot(cnbv_muns_edo, aes(ENT, bancomer,color=ENT)) + geom_line()
ggplot(cnbv_muns_edo, aes(fecha, banamex,color=ENT)) + geom_line()
ggplot(cnbv_muns_edo, aes(fecha, valor,color=ENT)) + geom_line()
ggplot(cnbv_muns_edo, aes(fecha, otros,color=ENT)) + geom_line()

cnbv_edo_bancomer<-cnbv_muns_edo %>% select(ENT,fecha,bancomer) %>% dcast(ENT~fecha)
names(cnbv_edo_bancomer)<-c("CVEENT","bancomer_2014","bancomer_2015","bancomer_2016")

cnbv_edo_banamex<-cnbv_muns_edo %>% select(ENT,fecha,banamex) %>% dcast(ENT~fecha)
names(cnbv_edo_banamex)<-c("CVEENT","banamex_2014","banamex_2015","banamex_2016")

cnbv_edo_valor<-cnbv_muns_edo %>% select(ENT,fecha,valor) %>% dcast(ENT~fecha)
names(cnbv_edo_valor)<-c("CVEENT","valor_2014","valor_2015","valor_2016")

cnbv_edo_otros<-cnbv_muns_edo %>% select(ENT,fecha,otros) %>% dcast(ENT~fecha)
names(cnbv_edo_otros)<-c("CVEENT","otros_2014","otros_2015","otros_2016")

#Por municipios

cnbv_muns<-cnbv_muns %>% group_by(ENT,CVEMUN,fecha) %>% summarise(bancomer=sum(bancomer),
                                                               banamex=sum(banamex),
                                                               valor=sum(valor),
                                                               otros=sum(otros)) %>%
  filter(month(fecha)==12,year(fecha)>=2014)

cnbv_muns_bancomer<-cnbv_muns %>% select(ENT,CVEMUN,fecha,bancomer) %>% dcast(CVEMUN~fecha)
#names(cnbv_muns_bancomer)<-c("CVEENT","bancomer_2014","bancomer_2015","bancomer_2016")

cnbv_muns_banamex<-cnbv_muns %>% select(ENT,CVEMUN,fecha,banamex) %>% dcast(CVEMUN~fecha)
#names(cnbv_muns_banamex)<-c("CVEENT","banamex_2014","banamex_2015","banamex_2016")

cnbv_muns_valor<-cnbv_muns %>% select(ENT,CVEMUN,fecha,valor) %>% dcast(CVEMUN~fecha)
#names(cnbv_muns_valor)<-c("CVEENT","valor_2014","valor_2015","valor_2016")

cnbv_muns_otros<-cnbv_muns %>% select(ENT,CVEMUN,fecha,otros) %>% dcast(CVEMUN~fecha)
#names(cnbv_muns_otros)<-c("CVEENT","otros_2014","otros_2015","otros_2016")


source("R/Renviron.R")
source('R/load-outputs.R')
## source('R/write_summary.R')
source('R/visual-latent-space-plot.R')
source('R/visual-trace-plot.R')
## source('R/CIF_posm.R')
## source('R/CIF.R')


# Copyright (c) MAQ Software.  All rights reserved.

# Third Party Programs. This software enables you to obtain software applications from other sources.
# Those applications are offered and distributed by third parties under their own license terms.
# MAQ Software is not developing, distributing or licensing those applications to you, but instead,
# as a convenience, enables you to use this software to obtain those applications directly from
# the application providers.
# By using the software, you acknowledge and agree that you are obtaining the applications directly
# from the third party providers and under separate license terms, and that it is your responsibility to locate,
# understand and comply with those license terms.
# Microsoft grants you no license rights for third-party software or applications that is obtained using this software.

#
# WARNINGS:
#
# CREATION DATE: 06/12/2017
#
# LAST UPDATE: --/--/---
#
# VERSION: 3.0.0
#
# R VERSION TESTED: 3.4.2
#
# AUTHOR: MAQ Software

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

############### Library Declarations ###############
####################################################
#setting localization and language
Sys.setlocale("LC_ALL","English")
#graphics libraries
libraryRequireInstall("plotly")
#forecast libraries
libraryRequireInstall("forecast")

#Set seed for random number generation
set.seed (100)
#Remove screenshot feature from plotly utilities
disabledButtonsList <- list('toImage', 'sendDataToCloud')
###############################
tryCatch({

feature<-data.frame(Value)
tSeries<-data.frame(Category)
###############################
#forecast settings
forecastUnits<-10
if(exists("settings_units") && settings_units > 0)
{
    forecastUnits<-settings_units
}

decayRate<-0.009
if(exists("settings_decay") && settings_decay <= 1 && settings_decay >= 0)
{
    decayRate<-settings_decay
}
maxitr<-200
if(exists("settings_maxitr") && settings_maxitr > 0)
{
    maxitr<-settings_maxitr
}

hnodes<-20
if(exists("settings_size") && settings_size >0)
{
    hnodes<-settings_size
}

epochs<-8
if(exists("settings_epochs") && settings_epochs >0)
{
    epochs<-settings_epochs
}

confIntervals<- FALSE
if(exists("settings_confInterval"))
{
    confIntervals<-settings_confInterval
}

confLevels<- 0.80
if(exists("settings_confLevel") && settings_confLevel >= 0 && settings_confLevel <= 1)
{
    confLevels<-settings_confLevel
}

######################################
###########plot settings
plotColor<-"#FFFFFF"
if(exists("plotSettings_plotColor"))
{
    plotColor<-plotSettings_plotColor
}

forecastLineCol<-"#F2C80F"
if(exists("plotSettings_fline"))
{
    forecastLineCol<-plotSettings_fline
}

historyLineCol<-"#01B8AA"
if(exists("plotSettings_hline"))
{
    historyLineCol<-plotSettings_hline
}

forecastLineText<-"Predicted"
if(exists("plotSettings_flineText"))
{
    forecastLineText<-plotSettings_flineText
}

historyLineText<-"Observed"
if(exists("plotSettings_hlineText"))
{
    historyLineText<-plotSettings_hlineText
}

confCol<-"Gray95"
if(exists("plotSettings_confCol"))
{
    confCol<-plotSettings_confCol
}

ConfText<-"Confidence"
if(exists("plotSettings_confText"))
{
    ConfText<-plotSettings_confText
}
###############################
######### x axis settings######

xTitle<-names(tSeries)[1]
if(exists("xaxisSettings_xTitle") && xaxisSettings_xTitle!= '')
{
    xTitle<-xaxisSettings_xTitle
}

xZeroline<-TRUE
if(exists("xaxisSettings_xZeroline"))
{
    xZeroline<-xaxisSettings_xZeroline
}

xLabels<-TRUE
if(exists("xaxisSettings_xLabels"))
{
    xLabels<-xaxisSettings_xLabels
}

xGrid<-TRUE
if(exists("xaxisSettings_xGrid"))
{
    xGrid<-xaxisSettings_xGrid
}

xGridCol<-"#BFC4C5"
if(exists("xaxisSettings_xGridCol"))
{
    xGridCol<-xaxisSettings_xGridCol
}

xGridWidth<-0.1
if(exists("xaxisSettings_xGridWidth") && xaxisSettings_xGridWidth <= 5 && xaxisSettings_xGridWidth >= 0.1)
{
    xGridWidth<-xaxisSettings_xGridWidth
}

xAxisBaseLine<-TRUE
if(exists("xaxisSettings_xAxisBaseLine"))
{
    xAxisBaseLine<-xaxisSettings_xAxisBaseLine
}

xAxisBaseLineCol<-"#000000"
if(exists("xaxisSettings_xAxisBaseLineCol"))
{
    xAxisBaseLineCol<-xaxisSettings_xAxisBaseLineCol
}

xAxisBaseLineWidth<-4
if(exists("xaxisSettings_xAxisBaseLineWidth") && xaxisSettings_xAxisBaseLineWidth <= 11 && xaxisSettings_xAxisBaseLineWidth >= 1)
{
    xAxisBaseLineWidth<-xaxisSettings_xAxisBaseLineWidth
}

##############################
######y axis settings ########

yTitle<-names(feature)[1]
if(exists("yaxisSettings_yTitle") && yaxisSettings_yTitle!='')
{
    yTitle<-yaxisSettings_yTitle
}

yZeroline<-TRUE
if(exists("yaxisSettings_yZeroline"))
{
    yZeroline<-yaxisSettings_yZeroline
}

yLabels<-TRUE
if(exists("yaxisSettings_yLabels"))
{
    yLabels<-yaxisSettings_yLabels
}

yGrid<-TRUE
if(exists("yaxisSettings_yGrid"))
{
    yGrid<-yaxisSettings_yGrid
}

yGridCol<-"#BFC4C5"
if(exists("yaxisSettings_yGridCol"))
{
    yGridCol<-yaxisSettings_yGridCol
}

yGridWidth<-0.1
if(exists("yaxisSettings_yGridWidth") && yaxisSettings_yGridWidth <= 5 && yaxisSettings_yGridWidth >= 0.1)
{
    yGridWidth<-yaxisSettings_yGridWidth
}

yAxisBaseLine<-TRUE
if(exists("yaxisSettings_yAxisBaseLine"))
{
    yAxisBaseLine<-yaxisSettings_yAxisBaseLine
}

yAxisBaseLineCol<-"#000000"
if(exists("yaxisSettings_yAxisBaseLineCol"))
{
    yAxisBaseLineCol<-yaxisSettings_yAxisBaseLineCol
}

yAxisBaseLineWidth<-4
if(exists("yaxisSettings_yAxisBaseLineWidth") && yaxisSettings_yAxisBaseLineWidth <= 11 && yaxisSettings_yAxisBaseLineWidth >= 1)
{
    yAxisBaseLineWidth<-yaxisSettings_yAxisBaseLineWidth
}

#################################
###############################
###############################
#prepare dataset

tsStart<-tSeries[1,]
rows<-NROW(tSeries)
tsEnd<-tSeries[rows,]
tsSeries<-0
h<-forecastUnits
##creating list of plot settings#############

xAesthetics <- list(
     title = xTitle,
     zeroline = xZeroline,
     showticklabels = xLabels,
     showgrid = xGrid,
     gridcolor = toRGB(xGridCol),
     gridwidth = xGridWidth,
     showline = xAxisBaseLine,
      linecolor=toRGB(xAxisBaseLineCol),
      linewidth=xAxisBaseLineWidth
     )
     yAesthetics <- list(
     title = yTitle,
     zeroline = yZeroline,
     showticklabels = yLabels,
     showgrid = yGrid,
     gridcolor = toRGB(yGridCol),
     gridwidth = yGridWidth,
     showline = yAxisBaseLine,
      linecolor=toRGB(yAxisBaseLineCol),
      linewidth=yAxisBaseLineWidth
     )

##############initiating try catch###############

tryCatch({
#form a time series
tsSeries<-ts(data=feature, end = tsEnd, start=tsStart, frequency = 1)
#initating procedure to coerce non date time data into series

pretsSeries<-data.frame(Category,Value)
                        colnames(pretsSeries)<-c("seriesStamps","dataValues")
                        x<-(pretsSeries$seriesStamps)

                        tsSeries<-structure(list(y=c(pretsSeries$dataValues), date=c(x)))

## arguments can be passed to nnet()
fit <- nnetar(tsSeries$y, lambda=0.5)
if(exists('settings_parameterSettings') && (settings_parameterSettings == 'Manual'))
{
fit <- nnetar(tsSeries$y, decay=decayRate, maxit=maxitr, repeats = epochs, size=hnodes, lambda=0.5)
}

#creating sequence
forecastedDates <- seq((tsSeries$date[length(tsSeries$date)]),
                  by=(tsSeries$date[length(tsSeries$date)] - tsSeries$date[length(tsSeries$date)-1]), len=h+1)

forecastedDates<-forecastedDates[-1]
forecastedValues<-forecast(fit,h,PI=confIntervals, level=confLevels)

segStartx<-tsSeries$date[NROW(tsSeries$date)]
segEndx<-forecastedDates[1]
segStarty<-tsSeries$y[NROW(tsSeries$y)]
segEndy<-forecastedValues$mean[1]

###############################
###############################
# plotting for confidence intervals
if(confIntervals==TRUE)
{
    ribX<-c(segStartx,segEndx)
    ribYmin<-c(segStarty, forecastedValues$lower[1])
    ribYmax<-c(segStarty, forecastedValues$upper[1])

    ribbonFrame<-data.frame(forecastedDates,forecastedValues$lower,forecastedValues$upper)
    colnames(ribbonFrame)<-c("xValues","yMin","yMax")

plotOutput <- plot_ly() %>%
  add_lines(x = (tsSeries$date), y = tsSeries$y,
            color = I(historyLineCol),
            name = historyLineText
            ) %>%
            add_ribbons(x = ribX, ymin = ribYmin, ymax = ribYmax,color = I(confCol), name = ConfText)%>%
  add_ribbons(x = ribbonFrame$xValues, ymin = ribbonFrame$yMin, ymax = ribbonFrame$yMax, color = I(confCol), name = ConfText)%>%
  add_segments(x = segStartx, xend = segEndx, y = segStarty, yend = segEndy, showlegend = FALSE, color = I(forecastLineCol)) %>%
  add_lines(x = forecastedDates, y = forecastedValues$mean, color = I(forecastLineCol), name = forecastLineText)%>%
  layout(title = '',
         xaxis = xAesthetics,
         yaxis = yAesthetics,
         margin = list(l = 50,
                       r=0,
                       t=50,
                       b=50),
         plot_bgcolor=plotColor,
         showlegend = FALSE
  )
}
else
{
#plotting without confidence intervals
plotOutput <- plot_ly() %>%
  add_lines(x = (tsSeries$date), y = tsSeries$y,
            color = I(historyLineCol),
            name = historyLineText
            ) %>%

           add_segments(x = segStartx, xend = segEndx, y = segStarty, yend = segEndy, showlegend = FALSE, color = I(forecastLineCol)) %>%
  add_lines(x = forecastedDates, y = forecastedValues$mean, color = I(forecastLineCol), name = forecastLineText)%>%
  layout(title = '',
         xaxis = xAesthetics,
         yaxis = yAesthetics,
         margin = list(l = 50,
                       r=0,
                       t=50,
                       b=50),
         plot_bgcolor=plotColor,
         showlegend = FALSE
  )
}

###############################
plotOutput$x$config$modeBarButtonsToRemove = disabledButtonsList
#rendering plot to visual device
internalSaveWidget(config(plotOutput, collaborate = FALSE, displaylogo=FALSE), 'out.html');
quit()

},
error=function(e)
{

 tryCatch({
     #initiating date time extraction
                        pretsSeries<-data.frame(Category,Value)
                        colnames(pretsSeries)<-c("seriesStamps","dataValues")
                        x<-as.POSIXct(pretsSeries$seriesStamps)

                        tsSeries<-structure(list(y=c(pretsSeries$dataValues), date=c(x)))

## arguments can be passed to nnet()
fit <- nnetar(tsSeries$y, lambda=0.5)
if(exists('settings_parameterSettings') && (settings_parameterSettings == 'Manual'))
{
fit <- nnetar(tsSeries$y, decay=decayRate, maxit=maxitr, repeats = epochs, size=hnodes, lambda=0.5)
}
#creating date time series for forecast length
forecastedDates <- seq(as.POSIXct(tsSeries$date[length(tsSeries$date)]),
                  by=(tsSeries$date[length(tsSeries$date)] - tsSeries$date[length(tsSeries$date)-1]), len=h+1)

                  forecastedDates<-forecastedDates[-1]

forecastedValues<-forecast(fit,h,PI=confIntervals, level=confLevels)

segStartx<-tsSeries$date[NROW(tsSeries$date)]
segEndx<-forecastedDates[1]
segStarty<-tsSeries$y[NROW(tsSeries$y)]
segEndy<-forecastedValues$mean[1]

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

#plotting with confidence intervals
if(confIntervals==TRUE)
{

    ribX<-c(segStartx,segEndx)
    ribYmin<-c(segStarty, forecastedValues$lower[1])
    ribYmax<-c(segStarty, forecastedValues$upper[1])

    ribbonFrame<-data.frame(forecastedDates,forecastedValues$lower,forecastedValues$upper)
    colnames(ribbonFrame)<-c("xValues","yMin","yMax")

plotOutput <- plot_ly() %>%
  add_lines(x = (tsSeries$date), y = tsSeries$y,
            color = I(historyLineCol),
            name = historyLineText
            ) %>%
            add_ribbons(x = ribX, ymin = ribYmin, ymax = ribYmax,color = I(confCol), name = ConfText)%>%
  add_ribbons(x = ribbonFrame$xValues, ymin = ribbonFrame$yMin, ymax = ribbonFrame$yMax, color = I(confCol), name = ConfText)%>%
   add_segments(x = segStartx, xend = segEndx, y = segStarty, yend = segEndy, showlegend = FALSE, color = I(forecastLineCol)) %>%
  add_lines(x = forecastedDates, y = forecastedValues$mean, color = I(forecastLineCol), name = forecastLineText)%>%
  layout(title = title,
         xaxis = xAesthetics,
         yaxis = yAesthetics,
         margin = list(l = 50,
                       r=0,
                       t=50,
                       b=50),
         plot_bgcolor=plotColor,
         showlegend = FALSE
  )
}
else
{
    #plotting without confidence intervals
plotOutput <- plot_ly() %>%
  add_lines(x = (tsSeries$date), y = tsSeries$y,
            color = I(historyLineCol),
            name = historyLineText
            ) %>%

  add_segments(x = segStartx, xend = segEndx, y = segStarty, yend = segEndy, showlegend = FALSE, color = I(forecastLineCol)) %>%
  add_lines(x = forecastedDates, y = forecastedValues$mean, color = I(forecastLineCol), name = forecastLineText)%>%
  layout(title = title,
         xaxis = xAesthetics,
         yaxis = yAesthetics,
         margin = list(l = 50,
                       r=0,
                       t=50,
                       b=50),
         plot_bgcolor=plotColor,
         showlegend = FALSE
  )
}

###############################
#Remove screenshot feature
disabledButtonsList <- list('toImage')
plotOutput$x$config$modeBarButtonsToRemove = disabledButtonsList

###############################
###############################
#rendering plot to visual device
internalSaveWidget(config(plotOutput, collaborate = FALSE, displaylogo=FALSE), 'out.html');
quit()

 },
error=function(e)
{
    #catching errors for date time instances
xAesthetics <- list(
     title = sprintf("%s Please enter suitable date time",e),
     zeroline = FALSE,
     showline = FALSE,
     showticklabels = FALSE,
     showgrid = FALSE
     )
     yAesthetics <- list(
     title = "",
     zeroline = FALSE,
     showline = FALSE,
     showticklabels = FALSE,
     showgrid = FALSE
     )
     plotOutput <- plot_ly() %>%
     layout(title = '',
                     xaxis = xAesthetics,
                     yaxis = yAesthetics)

     plotOutput$x$config$modeBarButtonsToRemove = disabledButtonsList
     internalSaveWidget(plotOutput, 'out.html');
     quit()
})

})

},
error=function(e)
{
    #catching error for invalid parameters and anything else
xAesthetics <- list(
     title = sprintf("%s Please use suitable values for input data and parameter",e),
     zeroline = FALSE,
     showline = FALSE,
     showticklabels = FALSE,
     showgrid = FALSE
     )
     yAesthetics <- list(
     title = "",
     zeroline = FALSE,
     showline = FALSE,
     showticklabels = FALSE,
     showgrid = FALSE
     )
     plotOutput <- plot_ly() %>%
     layout(title = '',
                     xaxis = xAesthetics,
                     yaxis = yAesthetics)

     plotOutput$x$config$modeBarButtonsToRemove = disabledButtonsList
     internalSaveWidget(plotOutput, 'out.html');
     quit()
}
)


suppressPackageStartupMessages({
    library(data.table)
    library(sf)
    library(ggplot2)
    library(RColorBrewer)
    library(rgdal)
})
options(scipen=100)

source('../../../functions.r')
source('../../../config.r')

load('../../generated/model/model-data-image.rdata', v=F)
load('../../../input-data/grid/grids.rdata')

eff.obs <- overlaps0[type == 'observed' & taxa == taxa[1],
                     .(fishery_group, grid_id, year, quarter, hooks)]

eff.tot <- overlaps0[type == 'total' & taxa == taxa[1],
                     .(fishery_group, grid_id, year, quarter, hooks)]

## ** Important fisheries
fgs <- eff.obs[, unique(fishery_group)]

eff.obs[, hooks := as.numeric(hooks)] # to avoid warning of sum(hooks) being too large for integers
eff.tot[, hooks := as.numeric(hooks)] # to avoid warning of sum(hooks) being too large for integers

eff.obs[, hooks := hooks / 1000]
eff.tot[, hooks := hooks / 1000]

## ** Annual average
eff.tot.yravg <- eff.tot[, .(hooks = sum(hooks) / length(YEARS_PRED)), .(fishery_group, quarter, grid_id)]

## *** All quarters
eff.tot <- rbind(eff.tot.yravg,
                 eff.tot.yravg[, .(quarter = 0, hooks = sum(hooks)), .(fishery_group, grid_id)],
                 fill = T)

## * Gridded distributions

pal <- c("#E3F2FD","#BBDEFB","#90CAF9","#64B5F6","#42A5F5","#2196F3","#1E88E5","#1976D2","#1565C0","#0D47A1")

efftype='tot'
plot_eff <- function(efftype) {
    cat('\n===', efftype, '\n')
    eff <- get(sprintf('eff.%s', efftype))
    fgs <- unique(eff$fishery_group)
    fg=fgs[1]
    for (fg in fgs) {
        cat('\t', fg, '\n')
        quart=0
        for (quart in 0:4) {
            cat(sprintf('\t\tquarter %s\n', ifelse(quart == 0, 'all', quart)))
            griddens <- eff[fishery_group == fg & quarter == quart, .(grid_id, hooks)]
            if (nrow(griddens)) {

                g <- map_grid_values(grid_values=griddens,
                                    sprintf("%s\n(x1000 hooks)",
                                            ifelse(efftype == 'tot', 'Mean annual\ntotal effort', 'Total\nobserved effort')),
                                    highlighted.lat=-30, leg.pos = c(0.91, 0.15), pal=pal, colourscale.trans='identity')
                ggsave(sprintf('../assets/map-effort_%s_%s_quarter%i.png',
                               efftype, slugify(fg), quart),
                       width = 7, height = 7, dpi=100)

            }
        }
    }
}

plot_eff('tot')


setwd('D:\\Pathway_prediction\\Co_expression_20180123')
dat = read.table("Cufflink_matrix_sample_name_20180123.txt", sep="\t", row.names=1,head=T,stringsAsFactors=F)
dat <- dat[,order(colnames(dat))]
#############################################################################
### mutation
### 2012_TFL
res_mutation_FPKM <- c()
subdat <- dat[,21:24]
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2014_rin_FUL1_2
subdat <- dat[,323:340]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2015_biosynthesis
subdat <- dat[,351:362]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2015_MSH1
subdat <- dat[,571:582]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2016_SlRBZ
subdat <- dat[,777:784]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2013_P450
subdat <- dat[,113:184]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2014_GLK
subdat <- dat[,198:265]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2015_AGO1
subdat <- dat[,341:344]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2015_ARF3
subdat <- dat[,347:350]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2016_CsMYBF1
subdat <- dat[,700:703]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2016_sulfurea
subdat <- dat[,785:792]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2017_ltm
subdat <- dat[,795:806]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2017_sldml2
subdat <- dat[,869:871]
colnames(subdat)
colnames(subdat)[1:2] <- substr(colnames(subdat)[1:2],1,nchar(colnames(subdat)[1:2])-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2017_ys
subdat <- dat[,896:901]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2014_leaf_dev
subdat <- dat[,c(266:271,290:292)]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

rownames(res_mutation_FPKM) <- rownames(dat)
write.table(res_mutation_FPKM,'Results_median_FPKM_for_mutation_Sly_20180125.txt',quote=F,sep='\t')

#############################################################################
### hormone
### 2013_ABA
res_hormone_FPKM <- c()
subdat <- dat[,25:31]
colnames(subdat)
colnames(subdat)[1] <- substr(colnames(subdat)[1],1,nchar(colnames(subdat)[1])-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,out)
		colnames(res_hormone_FPKM) <- col_name} else {
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,tem)
		colnames(res_hormone_FPKM) <- col_name}}

### 2013_cytokinin
subdat <- dat[,59:76]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-4)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,out)
		colnames(res_hormone_FPKM) <- col_name} else {
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,tem)
		colnames(res_hormone_FPKM) <- col_name}}

### 2013_cytokinin_auxin
subdat <- dat[,77:112]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-4)
colnames(subdat)[c(3,4,7,8,11,12,15,16,19,20,23,24,27,28,31,32,35,36)] <- substr(colnames(subdat)[c(3,4,7,8,11,12,15,16,19,20,23,24,27,28,31,32,35,36)],1,nchar(colnames(subdat)[c(3,4,7,8,11,12,15,16,19,20,23,24,27,28,31,32,35,36)])-1)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,out)
		colnames(res_hormone_FPKM) <- col_name} else {
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,tem)
		colnames(res_hormone_FPKM) <- col_name}}

### 2015_proGRAS
subdat <- dat[,593:600]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,out)
		colnames(res_hormone_FPKM) <- col_name} else {
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,tem)
		colnames(res_hormone_FPKM) <- col_name}}

### 2017_TIBA
subdat <- dat[,872:877]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,out)
		colnames(res_hormone_FPKM) <- col_name} else {
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,tem)
		colnames(res_hormone_FPKM) <- col_name}}

rownames(res_hormone_FPKM) <- rownames(dat)
write.table(res_hormone_FPKM,'Results_median_FPKM_for_hormone_Sly_20180125.txt',quote=F,sep='\t')

#############################################################################
### environmental, stress, non-stress
### 2013_bacterial
res_stress_FPKM <- c()
subdat <- dat[,32:58]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2014_pathogen
subdat <- dat[,296:322]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_cold
subdat <- dat[,448:450]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_DC3000
subdat <- dat[,451:462]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_fungal
subdat <- dat[,477:479]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2016_A2AS_heat
subdat <- dat[,672:679]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2016_shade_sun
subdat <- dat[,744:776]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2013_TYLCV
subdat <- dat[,185:188]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_light
subdat <- dat[,480:570]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_pollen_heat
subdat <- dat[,583:592]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_T3
subdat <- dat[,613:618]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2016_AvrPto_pathogen
subdat <- dat[,680:699]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2017_fungi
subdat <- dat[,793:794]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2017_pathosystem
subdat <- dat[,807:862]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2017_PSTVd
subdat <- dat[,863:868]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_circadian
subdat <- dat[,363:447]
colnames(subdat)
colnames(subdat) <- gsub('B', 'A', colnames(subdat))
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

rownames(res_stress_FPKM) <- rownames(dat)
write.table(res_stress_FPKM,'Results_median_FPKM_for_stress_Sly_20180125.txt',quote=F,sep='\t')

#############################################################################
### developmental
### 2015_circadian
### see in stress

### 2014_GLK
res_develop_FPKM <- c()
subdat <- dat[,198:265]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2015_fruit
subdat <- dat[,463:476]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2012_fruit_dev
subdat <- dat[,1:20]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2014_leaf_dev
subdat <- dat[,272:295]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2015_anther
subdat <- dat[,345:346]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2016_early_fruit
subdat <- dat[,704:719]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2014_ARF
subdat <- dat[,189:197]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2015_root
subdat <- dat[,601:612]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2015_time_course
subdat <- dat[,619:665]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2015_trichome
subdat <- dat[,666:671]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2016_inflorescence
subdat <- dat[,732:743]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2016_fruit_ripening
subdat <- dat[,720:731]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2017_yield
subdat <- dat[,878:895]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

rownames(res_develop_FPKM) <- rownames(dat)
write.table(res_develop_FPKM,'Results_median_FPKM_for_development_Sly_20180125.txt',quote=F,sep='\t')

res1 <- cbind(res_mutation_FPKM,res_hormone_FPKM)
res1 <- cbind(res1,res_stress_FPKM)
res1 <- cbind(res1,res_develop_FPKM)
write.table(res1,'Results_median_FPKM_for_all_Sly_20180125.txt',quote=F,sep='\t')


#' Parse Model
#'
#' @param mod formula
#'
#' @importFrom stats terms
#'
#'
parse_model <- function(mod) {
  full_var <- all.vars(mod)
  rhs <- attr(terms(mod), "term.labels")
  lhs <- full_var[!(full_var %in% rhs)]
  list(lhs = lhs, rhs = rhs)
}

#' Generate expanded version of basic model
#'
#' @param y a string vector with outcome variables
#' @param d a string of treatment variable
#'
#' @importFrom stats as.formula
#'
#'
expand_basic_mod <- function(y, d) {
  lapply(y, function(x) as.formula(paste0(x, "~", d)))
}

#' Generate List of Regression Models
#'
#' @param basemod list of baseline model.
#' Baseline model is specified by `y ~ d`
#' where `y` is outcome, and `d` is treatments.
#' @param xmod list of covariate model.
#' Covariate model is specified by one-sided formula like `~ x1 + x2`.
#' @param include_onlyd logical.
#' Whether to estimate a model without covariates.
#'
#' @importFrom fixest xpd
#' @importFrom stats update
#'
#'
genmod <- function(basemod, xmod = NULL, include_onlyd = TRUE) {
  # check list
  basemod <- if (!is.list(basemod)) list(basemod) else basemod
  xmod <- if (!is.null(xmod) & !is.list(xmod)) list(xmod) else xmod
  # length of lists
  num_base <- length(basemod)
  num_xmod <- length(xmod)
  # generate list of models
  modlist <- vector("list", num_base * (num_xmod + include_onlyd))
  for (i in seq_len(num_base)) {
    for (j in seq_len(num_xmod + include_onlyd)) {
      pos <- j + (num_xmod + include_onlyd) * (i - 1)
      if (j == 1 & include_onlyd) {
        modlist[[pos]] <- basemod[[i]]
      } else {
        mod <- update(basemod[[i]], ~ . + ..addx)
        modlist[[pos]] <- fixest::xpd(mod, ..addx = xmod[[j - include_onlyd]])
      }
    }
  }
  # output
  modlist
}


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

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

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

# Let's say we want to create a chart that shows how many diamonds of each size (small/medium/large) are in our data.
ggplot(diamonds, aes(x=size)) +
  geom_bar(stat="count", fill="blue") +
  labs(title="Diamond Size Distribution", x="Size Category", y="Number of Diamonds")

# save the chart
saveChart("sizes_barchart")

# Signal the end of the process
done()

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


# Data Wrangling in R
# Austin Water Quality Case Study

# Load in the libraries that we'll need
library(tidyverse)
library(stringr)
library(lubridate)

# Read in the dataset
water <- read_csv('http://594442.youcanlearnit.net/austinwater.csv')

# Let's take a look at what we have
glimpse(water)

# First, let's get rid of a lot of columns that we don't need
# I'm going to do that by building a new tibble with just
# siteName, siteType, parameter, result and unit

water <- tibble('siteName'=water$SITE_NAME,
                'siteType'=water$SITE_TYPE,
                'sampleTime'=water$SAMPLE_DATE,
                'parameterType'=water$PARAM_TYPE,
                'parameter'=water$PARAMETER,
                'result'=water$RESULT,
                'unit'=water$UNIT)

glimpse(water)

# Now let's start finding the rows that we need.
# First, we need pH.  I might start by trying to look at all unique parameter names

unique(water$parameter)

# but that's way too long... what if we try searching for names that contain PH?

unique(water[which(str_detect(water$parameter,'PH')),]$parameter)

# still a mess... let's backtrack and look at parameter types

unique(water$parameterType)

# OK, what if I filter this down to look only at parameter types of Alkalinity/Hardness/pH
# and Conventionals

filtered_water <- subset(water,(parameterType=='Alkalinity/Hardness/pH') |
                                  parameterType=='Conventionals')

# Notice that this is much smaller in size.  let's check what parameters we have now

unique(filtered_water$parameter)

# I want only two of these, (discuss PH and temp choices), so let's filter those

filtered_water <- subset(filtered_water, ((parameter=='PH') |
                                            (parameter=='WATER TEMPERATURE')))

glimpse(filtered_water)