##' Generates a chromosome plot for the selected score or the number of affected samples.
##' @params geneLocs the data.frame returned by sortGenesByLocation()
##' @params results either tcgaResults or ccleResults
##' @params cancType the selected four letter cancer code
##' @params scoreType which score was selected; one of "OG", "TS", "CO"
##' @return a list with two plotting objects, "score" the actual score and "affected" the percentage of affected samples
##' @author Andreas Schlicker (a.schlicker@nki.nl)
getScoreHeatmap = function(geneLocs, results, cancType, scoreType) {
	scoreType = match.arg(scoreType, c("TS", "OG", "CO"))

	# Get the score vector
	score = results[[cancType]]$prioritize.combined[geneLocs[, "hgnc_symbol"], "og.score"]
	if (scoreType == "TS") {
		score = results[[cancType]]$prioritize.combined[geneLocs[, "hgnc_symbol"], "ts.score"]
		cols = colorpanel(29, low="white", high="#034b87")
		brks=seq(0, max(sortedScores, na.rm=TRUE), length.out=30)
	} else if (scoreType == "OG") {
		score = results[[cancType]]$prioritize.combined[geneLocs[, "hgnc_symbol"], "og.score"]
		cols = colorpanel(29, low="white", high="#880000")
		brks=seq(0, max(sortedScores, na.rm=TRUE), length.out=30)
	} else {
		score = results[[cancType]]$prioritize.combined[geneLocs[, "hgnc_symbol"], "combined.score"]

		cols = colorpanel(29, low="#034b87", mid="white", high="#880000")
		ext = max(abs(min(sortedScores, na.rm=TRUE)), max(sortedScores, na.rm=TRUE))
		#brks=seq(-1*ext, ext, length.out=30)
		brks = 0
	}

	matDim = ceil(sqrt(length(score)))
	sortedScores = matrix(c(score, rep(0, times=(matDim^2)-length(sortedGenes))), nrow=matDim, byrow=FALSE)[, 1:(matDim-1)]

	aheatmap(sortedScores,
		 color=cols,
		 breaks=brks,
		 scale="none",
		 Rowv=NA, Colv=NA,
		 cexRow=0, cexCol=0)

	#system(paste("composite ", paste(n, "_", sc, "_heatmap.png", sep=""), " -compose Multiply chrom_contours.png ", paste(n, "_", sc, "_heatmap.png", sep=""), sep=""))
}

getScoreHeatmap2 = function(geneLocs, results, cancType, scoreType) {
  scoreType = match.arg(scoreType, c("TS", "OG", "CO"))

  # Get the score vector
  score = results[[cancType]][geneLocs[, "hgnc_symbol"], "og.score"]
  if (scoreType == "TS") {
    score = results[[cancType]][geneLocs[, "hgnc_symbol"], "ts.score"]
    cols = colorpanel(29, low="white", high="#034b87")
    brks=seq(0, max(score, na.rm=TRUE), length.out=30)
  } else if (scoreType == "OG") {
    score = results[[cancType]][geneLocs[, "hgnc_symbol"], "og.score"]
    cols = colorpanel(29, low="white", high="#880000")
    brks=seq(0, max(score, na.rm=TRUE), length.out=30)
  } else {
    score = results[[cancType]][geneLocs[, "hgnc_symbol"], "combined.score"]
    cols = colorpanel(29, low="#034b87", mid="white", high="#880000")
    ext = max(abs(min(score, na.rm=TRUE)), max(score, na.rm=TRUE))
    #brks=seq(-1*ext, ext, length.out=30)
    brks = 0
  }

  matDim = ceiling(sqrt(length(score)))
  sortedScores = matrix(c(score, rep(0, times=(matDim^2)-length(score))), nrow=matDim, byrow=FALSE)[, 1:(matDim-1)]

  aheatmap(sortedScores,
           color=cols,
           breaks=brks,
           scale="none",
           Rowv=NA, Colv=NA,
           cexRow=0, cexCol=0,filename="chrdemo.png")

  #system(paste("composite ", paste(n, "_", sc, "_heatmap.png", sep=""), " -compose Multiply chrom_contours.png ", paste(n, "_", sc, "_heatmap.png", sep=""), sep=""))
}


#' @title Generate a nested case-control study
#'
#' @description
#' \code{ncc_sample} generates a nested case-control study dataset from a
#' cohort study dataset. Given time of entry, time of exit, and exit status,
#' risk sets are computed at each failure time. Controls are randomly sampled
#' from these risk sets. If matching variables are specified, \code{ncc_sample}
#' creates a matched or stratified nested case control study, in which risk
#' sets are computed separately within matching strata. \code{ncc_sample} is
#' similar to \code{ccwc} from the 'Epi' package, but differs in several small
#' but important ways (see details).
#'
#' @param entry time of entry to follow-up
#' @param exit time of exit from follow-up
#' @param fail indicator of status on exit from follow-up (censored=0, fail=1)
#' @param origin the origin of the analysis time-scale. For instance, date of
#' birth, if age is the desired time-scale.
#' @param controls the number of controls to sample for each failure
#' @param match a list of categorical variables for matching cases and controls
#' @param include a list of variables from the cohort dataset to be carried
#' accross the the nested case-control dataset
#' @param data a \code{\link{data.frame}} which contains the follow-up,
#' matching, and included variables.
#' @param keep_all if \code{TRUE}, does not sample from the risk sets, but
#' returns the probability of selection for each observation that is eligible
#' to be selected for any case in \code{data}. Defaults to \code{FALSE}.
#' @param silent if \code{FALSE}, provides entertainment by echoing a fullstop
#' to the screen as each risk set is generated. If TRUE, output to the
#' console is suppressed.
#'
#' @details
#' Given follow-up information from a cohort study, \code{ncc_sample} generates
#' risk sets at each observed failure time, and randomly samples controls from
#' these risk sets without replacement. Functionality is much the same as
#' \code{ccwc}  from the 'Epi' package, with two minor differences. Firstly,
#' \code{ncc_sample} also computes and returns the total number of eligible
#' controls for each risk set, as well as the probability of selection in to
#' the sample for every selected case and control. The latter is calculated
#' according to the formula given by Samuelsen (1997). Secondly,
#' \code{ncc_sample} splits tied failure times at random, whereas \code{ccwc}
#' preserves the ties and returns a multi-case case-control set.
#'
#' Random sampling of controls within risk sets is performed using \R's
#' pseudo-random number facilities. It is therefore important to set the seed
#' (\code{\link{set.seed}}) to ensure reproducibility.
#'
#' @return
#' A \code{data.frame} comprising:
#' \item{ncc_set}{a case-control set identifier}
#' \item{ncc_id}{a unique individual identifier}
#' \item{ncc_fail}{case identifier (0=control, 1=case)}
#' \item{ncc_elig_co}{a count of the number of controls eligible for selection
#' in the set}
#' \item{ncc_time}{failure time of the case in the set}
#' \item{ncc_pr}{the probability of being selected in the nested
#' case-control sample}
#'
#' followed by the variables specified in the \code{match} and \code{include}
#' lists.
#'
#' @author David C Muller
#'
#' @references
#' Samuelsen S. O. (1997). A psudolikelihood approach to analysis of nested
#' case-control studies. Biometrika, 84(2), 379-394. doi:10.1093/biomet/84.2.379
#'
#' @import data.table
#' @export
#'
ncc_sample <- function(entry = 0, exit, fail, origin = 0, controls = 1,
                       match = list(), include = list(), data = NULL,
                       keep_all = FALSE, silent = FALSE) {
  entry <- eval(substitute(entry), data)
  exit <- eval(substitute(exit), data)
  fail <- eval(substitute(fail), data)
  origin <- eval(substitute(origin), data)
  n <- length(fail)
# individual id for identifying sets of split records
  ncc_id <- 1:n
# add this id to the supplied data frame for later merging
  data <- data.table(data)
  data[, "ncc_id" := ncc_id]
  if (length(exit) != n) {
    stop("All vectors must have length")
  }
  if (length(entry) == 1) {
    entry <- rep(entry, n)
  }
  else {
    if (length(entry) != n) {
      stop("All vectors must have same length")
    }
  }
  if (length(origin) == 1) {
    origin <- rep(origin, n)
  }
  else {
    if (length(origin) != n)
      stop("All vectors must have same length")
  }
  t_entry <- as.numeric(entry - origin)
  t_exit <- as.numeric(exit - origin)

  # process matching vectors
  arg_match <- substitute(match)
  match <- lapply(arg_match, eval, data)
  names(match) <- as.character(arg_match)
  if (names(match[1]) == "list" && class(match[[1]]) == "function") {
    match[1] <- NULL
  }
  match_names <- names(match)

  # process 'included' vectors
  arg_inc <- substitute(include)
  include <- lapply(arg_inc, eval, data)
  names(include) <- as.character(arg_inc)
  if (names(include[1]) == "list" && class(include[[1]]) == "function") {
    include[1] <- NULL
  }
  inc_names <- names(include)

  grp <- rep(1, n)
  if (length(match) > 0) {
    grp <- as.numeric(factor(do.call(paste0, match)))
  }
  if (!silent) {
    cat("\nGenerating risk sets:\n")
  }
  fg <- unique(grp[fail != 0])
  gresult <- vector("list", length(fg))
  # index for groups
  gii <- 0
  set <- 0
  ties <- 0
  for (g in fg) {
    gii <- gii + 1
    ft <- unique(t_exit[(grp == g) & (fail != 0)])
    ft <- ft[order(ft)]
    tresult <- vector("list", length(ft))

    # index for times
    for (tii in 1:length(ft)) {
      t_end <- ft[tii]
      case <- (grp == g) & (t_exit == t_end) & (fail != 0)
      ncase <- sum(case)
      if (ncase > 1) {
        ties <- ties + 1
      }
      # split tied failures
      sresult <- vector("list", ncase)
      case_index <- cumsum(case)*case
      for (tjj in 1:ncase) {
        set <- set + 1
        if (!silent) {
          dots <- ifelse((set %% 50 == 0), ". 50\n", ".")
          cat(dots)
        }
        failure <- case & case_index==tjj
        noncase <- (grp == g) & (t_entry <= t_end) & (t_exit >= t_end) & !failure
        n_eligible <- sum(noncase)
        ineligible <- !failure & !noncase
        df <- data.frame(ncc_id   = ncc_id,
                         ncc_set  = set,
                         ncc_fail = failure,
                         nfail    = rep(sum(failure), length(failure)),
                         ncc_elig_co = rep(n_eligible, length(failure)),
                         ncc_time     = rep(t_end, length(failure)),
                         ineligible   = ineligible)
        sresult[[tjj]] <- df[!ineligible, ]
      }
      tresult[[tii]] <- rbindlist(sresult)
    }
    gresult[[gii]] <- rbindlist(tresult)
    rm(tresult)
  }
  tsplit <- rbindlist(gresult)

# Calculate probability of inclusion
# (Samuelsen, Biometrika, 1997, 84(2) p379)
  tsplit[, "pr_not" := 1 - ((nfail * controls) / ncc_elig_co)]
  tsplit[, "ncc_pr" := 1- prod(pr_not), by=ncc_id]
  tsplit[, "pr_not" := NULL]
# cases have probability of inclusion of 1 (comment this out, we still want
# the probability that they were ever included as a control)
#  tsplit[ncc_fail==TRUE, ncc_pr := 1]
  # if risk sets are smaller than requested number of cases, the calculated
# probability will be greater than 1. The correct value is 1.
  tsplit[ncc_pr > 1, ncc_pr := 1]
  # we no longer need the number of failures per set
  #tsplit[, nfail := NULL]

# sample controls from risk sets
  if (!silent) {
    cat("\nSampling from risk sets:\n")
  }
#   browser()
  tsplit[, "r1" := runif(nrow(tsplit))]
  tsplit[, "r2" := runif(nrow(tsplit))]
  tsplit[, ncc_no_fail := !ncc_fail]
  setkey(tsplit, ncc_set, ncc_no_fail, r1, r2)
  # calculate conditions that should trigger warnings (incomplete sets, etc)
  tsplit[, c("nca", "nel") := list(nca = sum(ncc_fail),
                                   nel = sum(!ncc_fail)),
         by = ncc_set]
  tsplit[, nco := controls*nca]
  incomplete <- sum(tsplit[, sum(nel < nco), by = ncc_set][,V1]>0)
  nomatch <- sum(tsplit[, sum(nel == 0), by = ncc_set][,V1]>0)
  # return either the whole dataset (one record per person), or
  # just the ncc sample, depending on option keep_all
  if (!keep_all) {
  ncc_frame <- tsplit[,
                 head(.SD, nca[1] + nco[1]),
                 by = list(ncc_set)]
  }
  else {
    ncc_frame <- tsplit[, head(.SD, 1), by = list(ncc_id)]
  }

  # coerce failure flag to numeric
  # (logical var for case status might confuse people)
  ncc_frame[, ncc_fail := as.numeric(ncc_fail)]
  # get rid of the interim variables
  ncc_frame[, c("r1", "r2", "ncc_no_fail",
                "nca", "nel", "nco") := NULL]

  # merge ncc frame with original data
  setkey(ncc_frame, ncc_id)
  setkey(data, ncc_id)
  res <- data[ncc_frame]
  res <- res[, c(names(ncc_frame), match_names, inc_names), with=FALSE]
  res <- res[order(ncc_set,-ncc_fail), ]
  setkey(res, ncc_set)

  # display warnings and return the frame
  if (incomplete > 0) {
    warning(paste(incomplete, "case-control sets are incomplete"))
  }
  if (nomatch > 0) {
    warning(paste(nomatch, "cases could not be matched"))
  }
  if (ties > 0) {
    warning(paste("There", ifelse(ties == 1, "was", "were"), ties,
                  ifelse(ties == 1, "set of", "sets of"),
                  "tied failure times"))
  }
  return(res)
}


##' Produce a table of prevalence ratios in counties
##'
##' @importFrom dplyr mutate select arrange
##' @importFrom kableExtra kable add_header_above save_kable
##' @importFrom tools file_ext
##' @param file file name to save the table to (pdf)
##' @return NULL (invisibly)
##' @export
county_table <- function(file = NULL) {

  ms.R <- regression()$covariates

  options(knitr.kable.NA = "")

  print_table <- ms.R %>%
    mutate(pilot_prev = round(positive_1 / attendance_1 * 100, 2),
           round2_prev = round(positive_2 / attendance_2 * 100, 2),
           round3_prev = round(positive_3 / attendance_3 * 100, 2),
           R = round(R, 1)) %>%
    select(county, region, pop, R,
           ends_with("_1"), pilot_prev,
           ends_with("_2"), round2_prev,
           ends_with("_3"), round3_prev) %>%
    arrange(county)

  if (!is.null(file)) {
    col.names <-
      c("County", "Region", "Population", "R",
        rep(c("Positive", "Attendance", "%"), times = 3))

    if (file_ext(file) == "pdf") {
      format <- "latex"
    } else if (file_ext(file) == "html") {
      format <- "html"
    }

    k <- kable(print_table,
               format = format,
               col.names = col.names,
               align = c('l', 'l', 'r', 'r', rep('r', 3), 'r',
                         rep('r', 2), 'r', rep('r', 2)),
               booktabs = TRUE)

    k <-
      add_header_above(k, c(" " = 4, "Pilot" =  3,
                            "Round 1" = 3, "Round 2" = 3))

    save_kable(k, file)
    invisible(NULL)
  } else {
    return(print_table)
  }
}


library(ggplot2)
library(ggthemes)
library(scales)

rmse_gauss <- as.matrix(read.csv("out/rmse_t_gauss.csv"))

rmse_pearson <- as.matrix(read.csv("out/rmse_t_pearson.csv"))

steps <- 1000

dist <- c(rep("Gaussian Distributions", 8*steps),
          rep("Pearson Type IV Distributions", 8*steps))

comp <- rep(c(rep("Position RMSE (m)",   steps),
              rep("Velocity RMSE (m/s)", steps)), 8)

Filter <- rep(c(rep("HOUSE", 2*steps),
                rep("UKF",   2*steps),
                rep("CUT-4", 2*steps),
                rep("CUT-6", 2*steps)), 2)

rmse_gauss   <- as.matrix(read.csv("out/rmse_t_gauss.csv"))
rmse_pearson <- as.matrix(read.csv("out/rmse_t_pearson.csv"))

t <- rep(rmse_gauss[,1], 16)

RMSE <- c(c(rmse_gauss[,2:9]),
          c(rmse_pearson[,2:9]))

filter <- c("HOUSE", "UKF", "CUT-4", "CUT-6")

data <- data.frame(t, RMSE, Filter, comp, dist)

data$Filter <- factor(data$Filter, levels=filter)

colors <- c("#cc3311", "#0077bb", "#ee7733", "#009988", "#ee3377")
dashes <- c("solid", "dotted", "dotdash", "longdash", "twodash")

ggplot(data, aes(x=t, y=RMSE)) + geom_line(aes(col=Filter, linetype=Filter)) +
    scale_color_manual(values=colors) +
    facet_grid(rows=vars(comp), cols=vars(dist),
        scales="free_y", switch="y", shrink=FALSE) +
    theme_bw(base_size = 9) +
    theme(panel.grid.major = element_line(),
          legend.title=element_blank()) +
    xlab("Time-of-Flight (%)") + ylab(NULL) +
    scale_y_log10(breaks = 10^(-10:10),
                  labels = trans_format("log10", math_format(10^.x)))

ggsave("proj_rmse.eps", width=6, height=4.5, units="in")


#Public_COVID-19_Canada
#library(googlesheets)
library(gsheet)
library(tidyverse)
library(janitor)
library(viridis)
library(ggrepel)
library(gganimate)
library(feather)
library(sqldf)
library(gifski)
library(scales)
library(cowplot)
#gs_auth(new_user = TRUE)

###############################333
# Split U of T Age Column up into min max
split_age <- function(df){
  df <-
    df %>% separate("age", into = c( "min_age", "max_age"), remove = FALSE) %>%
    mutate(min_age = as.integer(min_age),
           max_age = as.integer(max_age)) %>%
    mutate(min_age = ifelse(is.na(min_age), 0, min_age)) %>%
    mutate(max_age = ifelse(is.na(max_age), ifelse(as.numeric(age), age, NA), max_age)) %>%
    mutate(max_age = as.integer(max_age)) %>%
    mutate(age = fct_reorder(age, min_age))  #%>% df %>% count(age, min_age, max_age)

  df
  #df %>% count(age, min_age, max_age)
}

############################################
# Gte the recommended citation
get_covid_19_UT_citation <- function(dt = Sys.Date()){
  recomended_citation = paste0("COVID-19 Canada Open Data Working Group. Epidemiological Data from the COVID-19 Outbreak in Canada. https://github.com/ishaberry/Covid19Canada. (" ,
                               as.character(dt), ").")
  return(recomended_citation)
}

###################################33
# Download the spreadshee and format it a bit
get_covid_19_UT_data_download <- function(){
  #df_raw <- gsheet2tbl('https://docs.google.com/spreadsheets/d/1D6okqtBS3S2NRC7GFVHzaZ67DuTw7LX49-fqSLwJyeo/htmlview?sle=true#')
  df_raw <-  gsheet2tbl("https://docs.google.com/spreadsheets/d/1D6okqtBS3S2NRC7GFVHzaZ67DuTw7LX49-fqSLwJyeo/htmlview?sle=true#gid=942958991")
  df_names <- df_raw %>% slice(2) %>% unlist(., use.names=FALSE)

  df <- df_raw[3:nrow(df_raw),]

  colnames(df) <- df_names
  df <- df %>% clean_names()

  df <- df %>% split_age()
  df <-
    df %>%
    mutate(date_report = as.Date(date_report, format = "%d-%m-%Y")) %>%
    mutate(report_week = as.Date(report_week, format = "%d-%m-%Y"))
  return(df)
}

############################
# cace the spreadsheet
cache_covid_19_UT_data <- function(){
  df <- get_covid_19_UT_data()
  df %>% write_feather("covid_19_UT_data.feather")
}

##############################
# read from file
read_covid_19_UT_data <- function(){
  df <- read_feather("covid_19_UT_data.feather")
  df
}

#############################
# Make an age histogram
get_age_hist <- function()
{
  df <- read_covid_19_UT_data()
  df$fake_age <- mapply(function(x, y) sample(seq(x, y), 1),
                             df$min_age, ifelse(is.na(df$max_age), 0 ,df$max_age))

  df$fake_age <- ifelse(df$age == "Not Reported", NA, df$fake_age)
  df$ALL_TRUE <- 1
  df <- df %>% mutate(Age_is_reported = ifelse(is.na(fake_age),"Not Reported","Repoted"))
  df %>% count(age)
  bins <- tibble(min_bin = seq(0,120, 10), max_bin = seq(10,130, 10))

  df_p<- sqldf ("
SELECT b.* , df.*
FROM bins AS b
LEFT JOIN df  ON
    b.min_bin <= df.fake_age AND
    b.max_bin > df.fake_age
") %>%
    mutate(bin_lbl = paste0(min_bin, "-", max_bin)) %>%
    mutate(bin_lbl = fct_reorder(bin_lbl, min_bin)) %>%
    filter(!is.na(ALL_TRUE)) %>%
    as_tibble()

    max_date <- df_p$date_report %>% max() %>% as.character()
    p <- df_p %>% ggplot(aes(x = bin_lbl, fill = sex)) +
      geom_histogram(alpha = 0.5, stat="count", color = "black") +
      coord_flip() +
      facet_grid(cols = vars(sex)) +
      #scale_color_manual(values=c("#ffc0cb", "#add8e6", "#808080")) +
      scale_fill_manual(values=c("#ffc0cb", "#add8e6", "#808080"))
    p + labs(title = paste0("Covid-19 age histogram for Canada" , "\nLast date of data = ", max_date),
             x = "age bin",
             y = "count",
             caption = get_covid_19_UT_citation())
    p

}

##############################
# TODO :Get a Pie of the not reported Ages
get_age_reported_pie <- function(){
  df <- read_covid_19_UT_data()
  df$fake_age <- mapply(function(x, y) sample(seq(x, y), 1),
                        df$min_age, ifelse(is.na(df$max_age), 0 ,df$max_age))

  df$fake_age <- ifelse(df$age == "Not Reported", NA, df$fake_age)
  df$ALL_TRUE <- 1
  df <- df %>% mutate(Age_is_reported = ifelse(is.na(fake_age),"Not Reported","Repoted"))
  #ggplot(aes(x=Tests/2, y = value, fill = name, width = Tests)) +
  p <-
    df %>%
    count(Age_is_reported, sex) %>%
    group_by(sex) %>% mutate(N_sex = sum(n)) %>% ungroup() %>%
    ggplot(aes(x=N_sex/2, y=n, fill=Age_is_reported, color=Age_is_reported )) +
      geom_col() + coord_polar("y", start=0) + theme_void() +
      geom_text(aes(y = n/3 + c(0, cumsum(n)[-length(n)]),
                    label = n), size=5) +
      facet_grid(cols = vars(sex))
      labs(title = paste0("Reporting of age for Covid-19 in Canada","\nLast date of data = ", max_date),
           fill = "",
           caption = get_covid_19_UT_citation()) +
      theme(legend.position="bottom")
    p
}

#TODO Make the pie and the hisogram go togeather
#plot_grid(get_age_reported_pie() + labs(title = ""), get_age_hist(), labels = c("Age of Covid-19 victims in Canada, ", ""))
    # anim <- p +
    #   transition_reveal(date_repor)
    #
    # animate(anim, nframes = 200, renderer = gifski_renderer("covid_19_age_hist.gif", width = 1024, height = 768), end_pause = 100)
    #


pander_anova = function(anova_model_name){

  #'  Create a cleaner ANOVA model output with pander.
  #'
  #'  Parameters
  #'  ----------
  #'  anova_model_name : ANOVA model
  #'     Model whose output will be cleaned.
  #'
  #'  Output
  #'  ------
  #'  neat_output : pander table
  #'     Cleaned ANOVA model output.

  # load in pander
  require(pander)
  require(plyr)

  # disable scientific notation
  options(scipen = 999)

  # convert the model summary to a dataframe and rename variables
  neat_output = data.frame(anova_model_name)

  # round p-values (using Psychological Science's recommendations)
  neat_output$p = neat_output$Pr..Chisq.
  neat_output$p[is.na(neat_output$p)] = 0
  neat_output$p[neat_output$p < .0005] = round(neat_output$p[neat_output$p < .0005],4)
  neat_output$p[neat_output$p >= .0005] = round(neat_output$p[neat_output$p >= .0005],3)
  neat_output$p[neat_output$p >= .25] = round(neat_output$p[neat_output$p >= .25],2)

  # create significance and trending markers
  neat_output$sig = ' '
  neat_output$sig[neat_output$p < .15] = '.'
  neat_output$sig[neat_output$p < .05] = '*'
  neat_output$sig[neat_output$p < .01] = '**'
  neat_output$sig[neat_output$p < .001] = '***'

  # re-create blank spaces from original anova output
  neat_output$p[is.na(neat_output$Pr..Chisq.)] = ' '
  neat_output$sig[is.na(neat_output$Pr..Chisq.)] = ' '
  neat_output = replace(neat_output,is.na(neat_output),' ')

  # rename variables
  neat_output = plyr::rename(neat_output, replace = c('Df' = 'DF',
                                                      'logLik' = 'Log Likelihood',
                                                      'Chisq' = "Chi Sq.",
                                                      'Chi.Df' = "Chi Sq. DF"))
  neat_output = subset(neat_output, select = -c(Pr..Chisq.))

  # return the neatened table
  return(pander(neat_output, style="rmarkdown",split.table = Inf))
}


project.library( "aegis", "aegis" )

# load data of interest (annual time-series)
# .. an example dataset from the Eastern Scotian Shelf
data( "ess.data" )

# choose subset of data of interest and scale/center
rownames( ess.data ) = ess.data$yr  # the rownames must be set
ess.data$yr = NULL                  # remove year as we do not want to use it as a variable
ess.data.scaled = scale( ess.data, center=T, scale=T )

# final call for analysis
ess.pca.stats = pca.analyse.data( ess.data.scaled, plotdata=FALSE, scaledata=FALSE ) # look in work directory for figures and data outputs
str( ess.pca.stats ) # look at contents of the variable


# Identify the dataset
names(dat) = normVarNames(names(dat))
# Lower case variable names.
vars = names(dat)
target = "rain_tomorrow"
risk = "risk_mm"
id = c("date", "location")

# Ignore the IDs and the risk variable.
ignore = c(id, if (exists("risk")) risk)

# Ignore variables which are completely missing.
mvc = sapply(dat[vars], function(x) sum(is.na(x)))
mvn = names(which(mvc == nrow(dat)))
ignore = union(ignore, mvn)

# Initialise the variables
vars = setdiff(vars, ignore)

# Variable roles.
inputs = setdiff(vars, target)
numi = which(sapply(dat[inputs], is.numeric))
numc = names(numi)
cati = which(sapply(dat[inputs], is.factor))
catc = names(cati)

# Remove all observations with a missing target.
dat = dat[!is.na(dat[target]),]

# Impute missing values needed for randomForest().
if (sum(is.na(dat[vars]))) dat[vars] = na.roughfix(dat[vars])

# Ensure the target is categoric.
dat[target] = as.factor(dat[[target]])

# Number of observations.
nobs = nrow(dat)

# Detect skews in the data
require(e1071)
apply(dat, 2, skewness)


library(dplyr)
library(lubridate)
source("Subnational_Analysis/code/plotting/format_data_plotting.R")

make_scenario_comparison_plots_compliance <- function(JOBID, StanModel, len_forecast, last_date_data,
                                                    baseline, compliance_decrease = 20){
  print(paste0("Making scenario comparision plots for ", compliance_decrease , "%"))
  load(paste0('Subnational_Analysis/results/sim-constant-com-', StanModel, '-', len_forecast, '-0-', JOBID, '-stanfit.Rdata'))
  out <- rstan::extract(fit)

  com_data <- NULL
  for (i in 1:length(countries)){
    data_state_plot <- format_data(i = i, dates = dates, countries = countries,
                                   estimated_cases_raw = estimated_cases_raw,
                                   estimated_deaths_raw = estimated_deaths_raw,
                                   reported_cases = reported_cases,
                                   reported_deaths = reported_deaths,
                                   out = out, forecast = 0, SIM = TRUE)
    # Cuts data on last_data_date
    data_state_plot <- data_state_plot[which(data_state_plot$date <= last_date_data),]

    subset_data <- select(data_state_plot, country, date, reported_deaths, estimated_deaths,
                          deaths_min, deaths_max)
    subset_data$key <- rep("Constant compliance", length(subset_data$country))
    com_data <- rbind(com_data, subset_data)
  }

  if (baseline == TRUE){
    load(paste0('Subnational_Analysis/results/sim-decrease-com-baseline-', StanModel, '-', len_forecast, '-', compliance_decrease, '-', JOBID, '-stanfit.Rdata'))
  } else {
    load(paste0('Subnational_Analysis/results/sim-decrease-com-current-', StanModel, '-', len_forecast, '-', compliance_decrease, '-', JOBID, '-stanfit.Rdata'))
  }
  out <- rstan::extract(fit)

  for (i in 1:length(countries)){
    data_state_plot <- format_data(i = i, dates = dates, countries = countries,
                                   estimated_cases_raw = estimated_cases_raw,
                                   estimated_deaths_raw = estimated_deaths_raw,
                                   reported_cases = reported_cases,
                                   reported_deaths = reported_deaths,
                                   out = out, forecast = 0, SIM = TRUE)
    # Cuts data on last_data_date
    data_state_plot <- data_state_plot[which(data_state_plot$date <= last_date_data),]
    subset_data <- select(data_state_plot, country, date, reported_deaths, estimated_deaths,
                          deaths_min, deaths_max)
    subset_data$key <- rep("decreased compliance", length(subset_data$country))
    com_data <- rbind(com_data, subset_data)
  }

  data_half <- com_data[which(com_data$key == "decreased compliance"),]
  com_data$key <- factor(com_data$key)
  data_half$key <- factor(data_half$key)

  nametrans <- read.csv("Subnational_Analysis/Italy/province_name_translation.csv")

  com_data <- com_data %>% filter(!(country %in% c("Lombardia","Marche","Veneto","Toscana","Piemonte","Emilia-Romagna","Liguria"))) %>%
                            droplevels()

  com_data$country<-recode(com_data$country, Lombardia="Lombardy",Piemonte="Piedmont",Toscana="Tuscany",P.A._Bolzano="Bolzano",
                           P.A._Trento="Trento",Puglia="Apulia",Sardegna="Sardinia",Sicilia="Sicily",Valle_dAosta="Aosta")

  data_half <- data_half %>% filter(!(country %in% c("Lombardia","Marche","Veneto","Toscana","Piemonte","Emilia-Romagna","Liguria"))) %>%
                              droplevels()

  data_half$country<-recode(data_half$country, Lombardia="Lombardy",Piemonte="Piedmont",Toscana="Tuscany",P.A._Bolzano="Bolzano",
                            P.A._Trento="Trento",Puglia="Apulia",Sardegna="Sardinia",Sicilia="Sicily",Valle_dAosta="Aosta")

  last_date_data<-com_data$date[nrow(com_data)]

  p <- ggplot(com_data) +
    geom_bar(data = data_half, aes(x = date, y = reported_deaths), stat='identity') +
    geom_ribbon(aes(x = date, ymin = deaths_min, ymax = deaths_max, group = key, fill = key), alpha = 0.5) +
    #geom_line(aes(date,deaths_max),color="black",size=0.2)+
    #geom_line(aes(date,deaths_min),color="black",size=0.2)+
    #geom_line(aes(date,estimated_deaths),color="black",size=0.3)+
    #geom_ribbon(aes(x = date, ymin = deaths_min, ymax = deaths_max, fill = "ICL"), alpha = 0.5) +
    scale_fill_manual(name = "", values = c("pink", "skyblue")) +
    scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b"), limits = c(as.Date("2020-03-02"), last_date_data)) +
    facet_wrap(~country, scales = "free") +
    xlab("") + ylab("Daily number of deaths") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1,size = 14), axis.title = element_text( size = 14 ),axis.text = element_text( size = 14 ),
          legend.position = "right",strip.text = element_text(size = 14),legend.text=element_text(size=14))

  ggsave(paste0("Subnational_Analysis/figures/scenarios_decrease_baseline-", len_forecast, '-', compliance_decrease, '-', JOBID, "top_7.pdf"), p, height = 15, width = 20)

  if (baseline == TRUE){
    ggsave(paste0("Subnational_Analysis/figures/scenarios_decrease_baseline-", len_forecast, '-', compliance_decrease, '-', JOBID, ".pdf"), p, height = 15, width = 20)
  } else {
    ggsave(paste0("Subnational_Analysis/figures/scenarios_decrease_current-", len_forecast, '-', compliance_decrease, '-', JOBID, ".pdf"), p, height = 15, width = 20)
  }
}


# Uvoz s spletne strani

library(XML)

# Najprej za moške, to je tabela podatkov o povprečnem številu delovnih ur na teden
# Vrne vektor nizov z odstranjenimi začetnimi in končnimi "prazninami" (whitespace)
# iz vozlišč, ki ustrezajo podani poti.
stripByPath <- function(x, path) {
  unlist(xpathApply(x, path,
                    function(y) gsub("^\\s*(.*?)\\s*$", "\\1", xmlValue(y))))
}

uvozi.podatkim <- function() {
  url.podatkim <- "podatki/Povprecnodelo_moski.html"
  doc.podatkim <- htmlTreeParse(url.podatkim, useInternalNodes=TRUE)

  # Poiščemo vse tabele v dokumentu
  tabelem <- getNodeSet(doc.podatkim, "//table")

  # Iz druge tabele dobimo seznam vrstic (<tr>) neposredno pod
  # trenutnim vozliščem
  vrsticem <- getNodeSet(tabelem[[1]], ".//tr")

  # Seznam vrstic pretvorimo v seznam (znakovnih) vektorjev
  # s porezanimi vsebinami celic (<td>) neposredno pod trenutnim vozliščem
  seznamm <- lapply(vrsticem[1:length(vrsticem)-1], stripByPath, "./td")

  # Iz seznama vrstic naredimo matriko
  matrikam <- matrix(unlist(seznamm), nrow=length(seznamm), byrow=TRUE)

  # Imena stolpcev matrike dobimo iz celic (<th>) glave (prve vrstice) prve tabele
  colnames(matrikam) <- gsub("\n", " ", stripByPath(vrsticem[[length(vrsticem)]], ".//th"))

  # Podatke iz matrike spravimo v razpredelnico
  return(data.frame(apply(gsub("\\(.*$", "",matrikam[,2:7]),
                          2, as.numeric), row.names=matrikam[,1]))
}

#Še za ženske:
uvozi.podatkiz <- function() {
  url.podatkiz <- "podatki/Povprecnodelo_zenske.html"
  doc.podatkiz <- htmlTreeParse(url.podatkiz, useInternalNodes=TRUE)
  tabelez <- getNodeSet(doc.podatkiz, "//table")
  vrsticez <- getNodeSet(tabelez[[1]], ".//tr")
  seznamz <- lapply(vrsticez[1:length(vrsticez)-1], stripByPath, "./td")
  matrikaz <- matrix(unlist(seznamz), nrow=length(seznamz), byrow=TRUE)
  colnames(matrikaz) <- gsub("\n", " ", stripByPath(vrsticez[[length(vrsticez)]], ".//th"))
  return(data.frame(apply(gsub("\\(.*$", "",matrikaz[,2:7]),
                          2, as.numeric), row.names=matrikaz[,1]))
}


extract.controls <- function(rg, probes, verbose=F) {
    stopifnot(is.rg(rg))

    x.mean <- function(x, na.rm=T) {
        if (length(x) <= 1)
            stop("It seems that the IDAT files do not match the supplied chip annotation.")
        mean(x,na.rm=na.rm)
    }
    x.which <- function(x) {
        i <- which(x)
        if (length(i) == 0)
            stop("It seems that the IDAT files do not match the supplied chip annotation")
        i
    }

    msg(verbose=verbose)

    probes.G <- probes[x.which(probes$dye == "G"),]
    probes.R <- probes[x.which(probes$dye == "R"),]
    rg$R <- rg$R[match(probes.R$address, rownames(rg$R)),]
    rg$G <- rg$G[match(probes.G$address, rownames(rg$G)),]

    bisulfite2 <- x.mean(rg$R[x.which(probes.R$target == "BISULFITE CONVERSION II"), "Mean"])

    bisulfite1.G <- rg$G[x.which(probes.G$target == "BISULFITE CONVERSION I"
                               & probes.G$name
                               %in% sprintf("BS Conversion I%sC%s", c(" ", "-", "-"), 1:3)),"Mean"]
    bisulfite1.R <- rg$R[x.which(probes.R$target == "BISULFITE CONVERSION I"
                               & probes.R$name %in% sprintf("BS Conversion I-C%s", 4:6)),"Mean"]
    bisulfite1 <- x.mean(bisulfite1.G + bisulfite1.R)

    stain.G <- rg$G[x.which(probes.G$target == "STAINING" & probes.G$name == "Biotin (High)"),"Mean"]

    stain.R <- rg$R[x.which(probes.R$target == "STAINING" & probes.R$name == "DNP (High)"),"Mean"]

    extension.R <- rg$R[x.which(probes.R$target == "EXTENSION"
                              & probes.R$name %in% sprintf("Extension (%s)", c("A", "T"))),"Mean"]
    extension.G <- rg$G[x.which(probes.G$target == "EXTENSION"
                              & probes.G$name %in% sprintf("Extension (%s)", c("C", "G"))),"Mean"]

    hybe <- rg$G[x.which(probes.G$target == "HYBRIDIZATION"),"Mean"]

    targetrem <- rg$G[x.which(probes.G$target %in% "TARGET REMOVAL"),"Mean"]

    nonpoly.R <- rg$R[x.which(probes.R$target == "NON-POLYMORPHIC"
                            & probes.R$name %in% sprintf("NP (%s)", c("A", "T"))),"Mean"]

    nonpoly.G <- rg$G[x.which(probes.G$target == "NON-POLYMORPHIC"
                            & probes.G$name %in% sprintf("NP (%s)", c("C", "G"))),"Mean"]

    spec2.G <- rg$G[x.which(probes.G$target == "SPECIFICITY II"),"Mean"]
    spec2.R <- rg$R[x.which(probes.R$target == "SPECIFICITY II"),"Mean"]
    spec2.ratio <- x.mean(spec2.G,na.rm=T)/x.mean(spec2.R,na.rm=T)

    name <- sprintf("GT Mismatch %s (PM)", 1:3)
    spec1.G <- rg$G[x.which(probes.G$target == "SPECIFICITY I" & probes.G$name %in% name),"Mean"]
    spec1.Rp <- rg$R[x.which(probes.R$target == "SPECIFICITY I" & probes.R$name %in% name),"Mean"]
    spec1.ratio1 <- x.mean(spec1.Rp,na.rm=T)/x.mean(spec1.G,na.rm=T)

    name <- sprintf("GT Mismatch %s (PM)", 4:6)
    spec1.Gp <- rg$G[x.which(probes.G$target == "SPECIFICITY I" & probes.G$name %in% name),"Mean"]
    spec1.R <- rg$R[x.which(probes.R$target == "SPECIFICITY I" & probes.R$name %in% name),"Mean"]
    spec1.ratio2 <- x.mean(spec1.Gp,na.rm=T)/x.mean(spec1.R,na.rm=T)

    spec1.ratio <- (spec1.ratio1 + spec1.ratio2)/2

    normA <- x.mean(rg$R[x.which(probes.R$target == "NORM_A"),"Mean"], na.rm = TRUE)
    normT <- x.mean(rg$R[x.which(probes.R$target == "NORM_T"),"Mean"], na.rm = TRUE)
    normC <- x.mean(rg$G[x.which(probes.G$target == "NORM_C"),"Mean"], na.rm = TRUE)
    normG <- x.mean(rg$G[x.which(probes.G$target == "NORM_G"),"Mean"], na.rm = TRUE)

    dye.bias <- (normC + normG)/(normA + normT)

    probs <- c(0.01, 0.5, 0.99)
    oob.G <- quantile(rg$G[with(probes.G, x.which(target == "OOB")),"Mean"], na.rm=T, probs=probs)
    oob.R <- quantile(rg$R[with(probes.R, x.which(target == "OOB")),"Mean"], na.rm=T, probs=probs)

    if (oob.R[["50%"]] < 1)
        oob.R[["50%"]] <- 1

    oob.ratio <- oob.G[["50%"]]/oob.R[["50%"]]

    c(bisulfite1=bisulfite1,
      bisulfite2=bisulfite2,
      extension.G=extension.G,
      extension.R=extension.R,
      hybe=hybe,
      stain.G=stain.G,
      stain.R=stain.R,
      nonpoly.G=nonpoly.G,
      nonpoly.R=nonpoly.R,
      targetrem=targetrem,
      spec1.G=spec1.G,
      spec1.R=spec1.R,
      spec2.G=spec2.G,
      spec2.R=spec2.R,
      spec1.ratio1=spec1.ratio1,
      spec1.ratio=spec1.ratio,
      spec2.ratio=spec2.ratio,
      spec1.ratio2=spec1.ratio2,
      normA=normA,
      normC=normC,
      normT=normT,
      normG=normG,
      dye.bias=dye.bias,
      oob.G=oob.G,
      oob.ratio=oob.ratio)
}


context("functional sequences")

test_that("fseq functions work", {
  a <- . %>% cos %>% sin %>% tan

  b <- function(x) tan(sin(cos(x)))

  expect_that(a(1:10), is_identical_to(b(1:10)))
})


cleanup()

#w<-Read.summary.data() #historical
#w<-Read.mean.weights() # forecast
w<-Read.mean.weights.OP(dir=file.path(data.path,scenario))    # OP forecast
#w<-Read.mean.weights.OP()    # OP forecast

Clupeids<-c(2,3)    # herring and sprat

w2<-droplevels(subset(w,west>0 & Quarter==1 & Species.n %in% Clupeids))
head(w2)
clupeid_N<-aggregate(N~Year,data=w2,sum)

trellis.device(height=10,width=8,pointsize=8)
print(xyplot(N/1000000~Year ,data=clupeid_N,ylab="Clupeid abundance (10^9)",type='b'))

w2<-droplevels(subset(w,west>0 & (Quarter==1 & Age<=9) |(Quarter==3 & Age==0) ))
by(w2,w2$Species.n,function(dat) {
  trellis.device(height=10,width=8,pointsize=8)
  tit<-paste(dat[1,'Species'],"Q1")
  ylab<-'Weight in the stock (kg)'
  maxW<-max(dat$west)
  if (maxW <1) {
   ylab<-'Weight in the stock (gram)'
   dat$west<-dat$west*1000
  }
  print(xyplot(west~Year| paste("Age:",Age," Q",Quarter,sep='') ,data=dat,layout = c(3, 3),
    scales = list(y="free"),
    main=tit, ylab=ylab,
     panel=function(x,y) {
      panel.xyplot(x,y,col=1 ,pch=1,type='l')
      #panel.loess(x,y, span=1)
      #panel.lmline(x,y,col=2)
    }
  ))
})

w2<-droplevels(subset(w,west>0 & Age<9 ))
w2$Age<-w2$Age+(w2$Quarter-1)*0.25
w2<-subset(w2,select=c(west,Age,Year,Species.n,Species))
w2<-w2[order(w2$Species.n,w2$Year,w2$Age),]
#cleanup()
trellis.device(height=10,width=8,pointsize=8)
print(xyplot(1000*west~Age|paste(Species),data=w2,layout = c(1, 3),
  scales = list(y="free"),group=Year, type='l',
  ylab='Weight in the stock (g)'
))

maxY<-max(w$Year)
minY<-min(w$Year)
w2<-droplevels(subset(w,west>0 & Age<9 & (Year==maxY | Year==minY) ))

w2$Age<-w2$Age+(w2$Quarter-1)*0.25
w2<-subset(w2,select=c(west,Age,Year,Species.n,Species))
w2<-w2[order(w2$Species.n,w2$Year,w2$Age),]
#cleanup()
trellis.device(height=10,width=8,pointsize=8)
print(xyplot(1000*west~Age|paste(Species),data=w2,layout = c(1, 3),
  scales = list(y="free"),group=Year, type='l',
  ylab='Weight in the stock (g)',main='Weights in first and last year'
))


digest("The quick brown fox jumps over the lazy dog","crc32", serialize=F)


context("Test createWeights")

#small dataset
library(sp)
library(reshape2)
set.seed(seed = 128)
n <- 10 #number of sites
sites <- paste('A',1:n, sep='')
locations <- data.frame(sites, x = runif(n, min=0, max=1000), y = runif(n, min=0, max=1000))
x <- as.matrix(locations[c('x','y')])
dist <- spDists(x, y=x,longlat=FALSE)
row.names(dist) <- locations$site
colnames(dist) <- locations$site
dist <- melt(dist)
sim <- data.frame(SQ_SQUARE = sites)
sim[,2:11] <- runif(n*10, min=0, max=10)

temp <- capture.output(weights <- createWeights(dist, sim, dist_sub = 5, sim_sub = 3, verbose = FALSE))

test_that("Test errors and warnings", {

  expect_warning(createWeights(dist, sim[1:5,], dist_sub = 5, sim_sub = 3,
                               verbose = FALSE),
                 "The following sites were in only one of 'attributes' and 'distances' and so have been excluded from the weights file")
  expect_error(createWeights(head(dist, -1), sim, dist_sub = 5, sim_sub = 3,
                             verbose = FALSE),
               'dist table does not include all possible combinations of sites')
  expect_error(createWeights(dist, sim, dist_sub = 5, sim_sub = 5, verbose = FALSE),
               "dist_sub' cannot be smaller than or equal to 'sim_sub'")
  expect_error(createWeights(dist, sim, dist_sub = 5, sim_sub = 10, verbose = FALSE),
               "dist_sub' cannot be smaller than or equal to 'sim_sub'")
  expect_error(createWeights(TRUE, sim, dist_sub = 5, sim_sub = 3, verbose = FALSE),
               "dist must be a data.frame")
  expect_error(createWeights(dist, 'Tom', dist_sub = 5, sim_sub = 3, verbose = FALSE),
               "sim must be a data.frame")
  expect_error(createWeights(cbind(dist, 1:nrow(dist)), sim, dist_sub = 5,
                             sim_sub = 3, verbose = FALSE),
               "dist must have three columns")
  expect_error(createWeights(cbind(dist[,1:2], as.character(dist[,3])), sim,
                             dist_sub = 5, sim_sub = 3, verbose = FALSE),
               "the value column in dist must be an integer or numeric")
  expect_error(createWeights(dist, cbind(sim[1:10], as.character(sim[,11])),
                             dist_sub = 5, sim_sub = 3, verbose = FALSE),
               'the values in sim must be integers or numeric')

})

test_that("Test createWeights functionality", {

  expect_equal(nrow(weights), 3 * length(sites))
  expect_true(all(weights$weight[weights$target == weights$neighbour] == 1))

})


#Objetivo : pasar los campos de fechas absolutas a fechas relativas

#paso los campos fecha a la cantidad de dias de la foto

#source("~/cloud/cloud1/codigoR/FeatureEngineering/fechas_relativas.r")

#limpio la memoria
rm(list=ls())
gc()

library("data.table")
library("dplyr")

kcarpeta_datasets        <-  "~/cloud/cloud1/datasets/"

kcampos_separador        <-  "\t"
karchivo_entrada_zip     <-  "paquete_premium.zip"

kcampo_foto              <- "foto_mes"

karchivo_salida_prefijo  <-  "./dias/"
karchivo_salida_sufijo   <-  "_dias.txt"

#------------------------------------------------------
#Esta funcion calcula la cantidad de dias entre la foto_mes y la fecha
#la foto_mes 201804 se interpreta como la fecha "20180501 00:00:00"

fdias_entre  = function(pfoto_mes, pfecha)
{

  foto_mes       <- as.POSIXlt(as.Date( paste(pfoto_mes, "01", sep=""), format='%Y%m%d' ))
  foto_mes$mon   <- foto_mes$mon +1

  fecha         <-  as.Date( as.character(pfecha), format='%Y%m%d' )

  return(as.numeric(difftime(foto_mes, fecha, units = c("days"))))
}
#------------------------------------------------------
#guarda el archivo de un mes

fguardar_foto  = function(pfoto_mes, pdataset)
{

  dataset_mes   <-   pdataset %>% filter(get(kcampo_foto) == pfoto_mes)

  archivo_salida_mes <- paste(karchivo_salida_prefijo,  pfoto_mes,  karchivo_salida_sufijo, sep="")

  fwrite( dataset_mes, file=archivo_salida_mes , sep=kcampos_separador, na="", row.names=FALSE)
}
#------------------------------------------------------

setwd(kcarpeta_datasets)

#lectura rapida del dataset  usando fread  de la libreria  data.table
dataset <- fread( cmd=paste("gunzip -cq", karchivo_entrada_zip), header=TRUE, sep=kcampos_separador)

nrow(dataset)
ncol(dataset)

#paso los campos fecha a dias relativos

dataset  <- mutate(dataset,
                    Master_Fvencimiento    = fdias_entre(get(kcampo_foto), Master_Fvencimiento),
                    Master_Finiciomora     = fdias_entre(get(kcampo_foto), Master_Finiciomora),
                    Master_fultimo_cierre  = fdias_entre(get(kcampo_foto), Master_fultimo_cierre),
                    Master_fechaalta       = fdias_entre(get(kcampo_foto), Master_fechaalta),
                    Visa_Fvencimiento      = fdias_entre(get(kcampo_foto), Visa_Fvencimiento),
                    Visa_Finiciomora       = fdias_entre(get(kcampo_foto), Visa_Finiciomora),
                    Visa_fultimo_cierre    = fdias_entre(get(kcampo_foto), Visa_fultimo_cierre),
                    Visa_fechaalta         = fdias_entre(get(kcampo_foto), Visa_fechaalta)
                 )

#ordeno el dataset
dataset   <- as.data.table( dataset %>% arrange( foto_mes, numero_de_cliente) )

#obtengo todas las foto_mes distintas que hay en el dataset grande
fotos_distintas <-   dataset %>% distinct(get(kcampo_foto)) %>% pull()

#grabo los archivos de cada mes
lapply( fotos_distintas,  fguardar_foto,  pdataset=dataset)

#grabo el archivo completo
fwrite( dataset,  file="~/cloud/cloud1/datasets/paquete_premium_dias.txt", sep=kcampos_separador, na="", row.names=FALSE)

#limpio la memoria

rm(list=ls())
gc()

quit(save="no")


#' ## START MODULE 2.4
#' Objective: Edit extent, projection, dimension, resolution of raster layers or shapefiles
#'
#' tested on R versions 3.1.X, 3.2.X
#'
#' Load packages and set working directory
#+ load packages
   library(rgdal)     # fxns: readOGR, writeOGR
   library(raster)    # fxns: crop, mask
#  set path
   path.root <- "~/Documents/Intro-Spatial-R/"
   path.mod <- paste(path.root, "module2", sep = "")
   setwd(path.mod)
#'
#' ### Crop a polygon file to another polygon
#' Import shapefile to be altered
#'
#+ import shapefile
#  CP study area; the "mask" for cropping
   cp.region <- readOGR(dsn = "data", layer = "COP_boundpoly_aea")
   class(cp.region)  # examine class

#  North American states/provinces to be altered
   states <- readOGR(dsn = "data", layer = "na_states_aea")
   class(states)  # examine class
#'
#' Subset states (UT, AZ, CO, NM) in Colorado Plateau region
#'  - NOTE: str() to determine shapefile characteristics
#'     here, states$CODE returns all state-based codes
#'  - NOTE: rgdal can be squirrelly, requiring NAs to be excluded, it crashes if NA present
#'
#+ subset states
   head(states@data)  # examine shapepoly data
   states$CODE  # state codes
   cp.states <- states[states$CODE == "UT" | states$CODE == "CO" |
                             states$CODE == "NM" | states$CODE == "AZ", ]

#    cp.states <- states[states$CODE == "UT" & !is.na(states$CODE) |
#                        states$CODE == "CO" & !is.na(states$CODE) |
#                        states$CODE == "NM" & !is.na(states$CODE) |
# 	                   states$CODE == "AZ" & !is.na(states$CODE), ]
   cp.states@data  # examine subsetted states
#'
#+ giggle plots
   plot(states)# all of North America
   plot(cp.states, add = T, col = "blue")# the subsetted states
   plot(cp.region, add = T, col = "red")# the study region, taking long time
#'
#' Crop states to the CP region
#'
#+ crop states
   cp.statesCROP <- crop(cp.states,cp.region)
   plot(cp.states)  # giggle plot
## output shapefile if desired; examine in ArcGIS if desired
   # writeOGR(cp.statesCROP, dsn = "./outdata", layer = "cp.statesCROP",
   # morphToESRI = T, driver = "ESRI Shapefile")
#'
#' ### Polygon crop of raster
#' This is a 2-step process that is easy to construct as function if desired.
#'
#+ import raster
   tave <- raster("data/tave_yr_av.img")
   tave  # examine raster
   summary(cp.region)  # examine crop polygon (from above)
#'
#' Note the different projections; must convert 1 to match other (see Module 2.2)
#'
#+ transform to match projections
   cp.regionWGS <- spTransform(cp.region, CRS = CRS(projection(tave)))
   cp.regionWGS  # now same projection as tave

## giggle plots; goal is crop of tave to match red in plot
   plot(tave)
   plot(cp.regionWGS, add = T, col = "red")
#'
#' Step #1; `mask()` function w/CP polygon as the mask applied to tave
#'
#+ mask tave
   taveCROP.1 <- mask(tave, cp.regionWGS)

## giggle plots; LOL here .....
   plot(taveCROP.1)# NOTE extent is extent of tave
   plot(extent(taveCROP.1), add = T)
#'
#' Step #2; `crop()` function to subset the masked tave to the extent of the CP region
#'
#+ crop tave to CP region
   taveCROP.2 <- crop(taveCROP.1, cp.regionWGS)

## giggle plots ...
   plot(taveCROP.2)
   plot(cp.regionWGS, add = T)

## outfile cropped raster if desired
   #writeRaster(taveCROP.2, filename = "outdata/cp.taveCROP2.img", format = "HFA")
#'
#' ### Crop raster using another raster
#' Assume raster of region to serve as crop; here cp.rast (see Module 2.2)
#'
#+ crop raster by raster
   ext.rast <- raster(resolution = 0.008333333, extent(cp.regionWGS))
   cp.rast <- rasterize(cp.regionWGS, field = "Id", ext.rast)
   cp.rast  # examine

## raster to be cropped
## same projection/resolution as cp.rast?  if not see Module 2.3
   tave  # examine

## some giggle plots; crop goal is red
   plot(tave)
   plot(cp.rast, add = T, col = "red")

## crop tave raster w/cp.rast raster
   taveCROP.3 <- crop(tave, cp.rast)

## write out file of cropped raster if desired
   #writeRaster(taveCROP.3, filename = "outdata/cp.taveCROP3.img", format = "HFA")

## giggle plots; NOTE that crop is the cp.rast extent, not just CP region
   plot(taveCROP.3)
   plot(cp.rast, add = T, col = "red")

## giggle plots
   par(mfrow = c(1, 2))
   plot(taveCROP.3)
   plot(cp.regionWGS, add = T, border = "black")

## outfile cropped raster if desired
   #writeRaster(taveCROP.3, filename = "outdata/cp.taveCROP3.img", format = "HFA")
#'
#' Crop a polygon to a raster
#'
#+ load shapefile
   soil <- readOGR(dsn = "data", layer = "soils")  # be patient here ... ~3 min runtime
   soil # examine polygon
   cp.rast # examine raster; both have same projection?  if not see Module 2.2/2.3

## crop polygon w/extent of raster
   soilCROP.1 <- crop(soil,extent(cp.rast))
## giggle plots
   par(mfrow = c(1, 2))
   plot(soil)
   plot(cp.regionWGS, add = T, col = "red")
   plot(soilCROP.1)
   plot(cp.rast, add = T, col = "red")
#'
#' ## END MODULE 2.4
#'
#' Create R markdown file from R script
#+
   knitr::spin("Rscripts/M2.4-alterextent_shapefileraster.r", knit = F, format = "Rmd")


test_that("surv_cluster clusterizes", {

  aj <- surv_aj("x", surv_fake)

  res <- surv_cluster(aj, 2)
  expec <- data.frame(
    id = c("grupo1", "grupo2", "grupo3", "grupo4"),
    idCluster = factor(c("A", "A", "B", "B"))
  )

  expect_equal(res, expec)
})

test_that("add_cluster works", {

  aj <- surv_aj("x", surv_fake)

  cluster_res <- surv_cluster(aj, 2)
  res <- add_cluster(surv_fake, cluster_res, id = "x")

  expec <- surv_fake
  expec$xCluster[which(expec$x %in% cluster_res$id[cluster_res$idCluster == "A"])] <- "A"
  expec$xCluster[which(expec$x %in% cluster_res$id[cluster_res$idCluster == "B"])] <- "B"
  expec$xCluster <- factor(expec$xCluster)

  expect_equal(res, expec)
})


library(ggplot2)

base_size <- 10

p <-
ggplot(mtcars, aes(wt,mpg)) +
geom_point() +
theme_classic(base_size=base_size)

###

p1 <- p +
theme(
line = element_line(lineend="square"),
axis.text = element_text(size=rel(0.8), color="black"),
axis.ticks = element_line(color="black")
)

#ggsave("p1.pdf", p1, width=6, height=5, units="cm")
ggsave("p1.tiff", p1, width=6, height=5, units="cm", compression="lzw")

###

p2 <- p +
theme(
line = element_line(lineend="square"),
axis.text = element_text(size=rel(0.8), color="black"),
axis.ticks = element_line(color="black"),
axis.ticks.length = unit(-base_size/4,"pt"),
axis.text.x = element_text(margin=margin(t=base_size/2)),
axis.text.y = element_text(margin=margin(r=base_size/2))
)

#ggsave("p2.pdf", p2, width=6, height=5, units="cm")
ggsave("p2.tiff", p2, width=6, height=5, units="cm", compression="lzw")

###

p3 <- p1 +
expand_limits(x=c(0,6),y=c(0,36))

#ggsave("p3.pdf", p3, width=6, height=5, units="cm")
ggsave("p3.tiff", p3, width=6, height=5, units="cm", compression="lzw")

###

p4 <- p3 +
scale_x_continuous(expand=expand_scale(mult=c(0,0.05))) +
scale_y_continuous(expand=expand_scale(mult=c(0,0.05)))

#ggsave("p4.pdf", p4, width=6, height=5, units="cm")
ggsave("p4.tiff", p4, width=6, height=5, units="cm", compression="lzw")


print(paste0(Sys.time(), " --- Prop species describing <=N species"))

taxonomic_effort$N_real_describers.1.prop <- taxonomic_effort$N_real_describers.1 / taxonomic_effort$N_real_describers * 100
taxonomic_effort$N_real_describers.2.prop <- taxonomic_effort$N_real_describers.2 / taxonomic_effort$N_real_describers * 100
taxonomic_effort$N_real_describers.3.prop <- taxonomic_effort$N_real_describers.3 / taxonomic_effort$N_real_describers * 100
taxonomic_effort$N_real_describers.4.prop <- taxonomic_effort$N_real_describers.4 / taxonomic_effort$N_real_describers * 100
taxonomic_effort$N_real_describers.5.prop <- taxonomic_effort$N_real_describers.5 / taxonomic_effort$N_real_describers * 100
taxonomic_effort$N_real_describers.6.prop <- taxonomic_effort$N_real_describers.6 / taxonomic_effort$N_real_describers * 100
taxonomic_effort$N_real_describers.7.prop <- taxonomic_effort$N_real_describers.7 / taxonomic_effort$N_real_describers * 100
taxonomic_effort$N_real_describers.8.prop <- taxonomic_effort$N_real_describers.8 / taxonomic_effort$N_real_describers * 100
taxonomic_effort$N_real_describers.9.prop <- taxonomic_effort$N_real_describers.9 / taxonomic_effort$N_real_describers * 100
taxonomic_effort$N_real_describers.10.prop <- taxonomic_effort$N_real_describers.10 / taxonomic_effort$N_real_describers * 100

taxonomic_effort$N_real_describers.1.prop_roll <- rollmean(taxonomic_effort$N_real_describers.1.prop, 10, fill = list(NA, NULL, NA))
taxonomic_effort$N_real_describers.2.prop_roll <- rollmean(taxonomic_effort$N_real_describers.2.prop, 10, fill = list(NA, NULL, NA))
taxonomic_effort$N_real_describers.3.prop_roll <- rollmean(taxonomic_effort$N_real_describers.3.prop, 10, fill = list(NA, NULL, NA))
taxonomic_effort$N_real_describers.4.prop_roll <- rollmean(taxonomic_effort$N_real_describers.4.prop, 10, fill = list(NA, NULL, NA))
taxonomic_effort$N_real_describers.5.prop_roll <- rollmean(taxonomic_effort$N_real_describers.5.prop, 10, fill = list(NA, NULL, NA))
taxonomic_effort$N_real_describers.6.prop_roll <- rollmean(taxonomic_effort$N_real_describers.6.prop, 10, fill = list(NA, NULL, NA))
taxonomic_effort$N_real_describers.7.prop_roll <- rollmean(taxonomic_effort$N_real_describers.7.prop, 10, fill = list(NA, NULL, NA))
taxonomic_effort$N_real_describers.8.prop_roll <- rollmean(taxonomic_effort$N_real_describers.8.prop, 10, fill = list(NA, NULL, NA))
taxonomic_effort$N_real_describers.9.prop_roll <- rollmean(taxonomic_effort$N_real_describers.9.prop, 10, fill = list(NA, NULL, NA))
taxonomic_effort$N_real_describers.10.prop_roll <- rollmean(taxonomic_effort$N_real_describers.10.prop, 10, fill = list(NA, NULL, NA))

cols <- names(taxonomic_effort)[grepl(".prop", names(taxonomic_effort))]
cols <- c("years", cols)
des_y <- melt(taxonomic_effort[, ..cols], id.vars="years")

cols <- names(taxonomic_effort)[grepl(".prop_roll", names(taxonomic_effort))]
cols <- c("years", cols)
des_y_roll <- melt(taxonomic_effort[, ..cols], id.vars="years")
des_y_roll$variable <- gsub("_roll", "", des_y_roll$variable)

des_y <- merge(des_y, des_y_roll, by=c("years", "variable"), suffixes=c("", "_roll"))

# Trend analysis
cols <- names(taxonomic_effort)[grepl(".prop_roll", names(taxonomic_effort))]
cols <- c("years", cols)
te_trend <- taxonomic_effort[, ..cols]

results_p <- c()
results_tau <- c()
for (i in 1:10) {
  name <- paste0("N_real_describers.", i, ".prop_roll")
  print(paste0("ANALYSING FOR ", name))
  trend <- te_trend[, get(name)]
  plot(trend)
  res <- MannKendall(trend)
  # summary(res)
  # print(res$tau>0)
  print(round(as.numeric(res$tau), 2))
  print(round(as.numeric(res$sl), 2))
  results_p <- c(results_p, round(as.numeric(res$sl),2))
  results_tau <- c(results_tau, round(as.numeric(res$tau),2))
  print("----------------------")
  print("----------------------")
}

which(results_p > 0.05)
sum(results_p <= 0.05)
results_tau
results_p

res <- MannKendall(taxonomic_effort$N_real_describers.6.prop_roll)
summary(res)
res <- MannKendall(taxonomic_effort$N_real_describers.7.prop_roll)
summary(res)

formatstr <- function(string) {
  string <- gsub("N_real_describers.", "", string)
  string <- gsub(".prop", "", string)
  string <- ifelse(string=="1", paste0(string, " species"), paste0("<=", string, " species"))
}

des_y$variable <- factor(des_y$variable, levels=paste0("N_real_describers.", 1:10, ".prop"))

plot_tax <- ggplot(des_y, aes(x=years, y=value, group=variable)) +
    geom_line(size=.5, colour="grey", linetype='dashed') +
    geom_point(size=.5, color='grey') +
    geom_smooth(size=1, colour="black") +
    geom_line(size=.7, aes(y=value_roll), color='grey50') +
    xlab("Year") + ylab("Proportion of PTEs describing <= N species (%)\n") +
    facet_wrap(. ~variable, ncol=2, labeller=labeller(variable=formatstr), dir="v") +
    scale_y_continuous(limits=c(0, 50), breaks=seq(0,50,10)) +
    theme

ggsave(paste0(dir_plot, 'fig-4.png'), plot_tax, units="cm", width=15, height=9, dpi=300)


#library(semnet)

test_that("Document cooccurence", {
  ## DTM BASED COOCCURENCE ##
  data(simple_dtm, package='semnet')

  ## coOccurence freq
  g = coOccurenceNetwork(dtm)
  expect_equal(get.data.frame(g)$from, c("nuclear", "nuclear", "nuclear", "waste", "weapons", "weapons", "bad", "energy"))
  ## coOccurence cosine
  g = coOccurenceNetwork(dtm, 'cosine')
  expect_equal(round(E(g)$weight, 3), round(c(0.4082483, 0.4082483, 0.4082483, 0.5000000, 0.5000000, 0.7071068, 0.7071068, 0.7071068),3))
})

test_that("Windowed cooccurence", {
  ## TOKENLIST BASED COOCCURENCE WITH SLIDING WINDOW ##
  data(sotu_tokenlist, package='semnet')
  sotu.tokens = sotu.tokens[sotu.tokens$pos1 %in% c('N','M','A'),]
  sotu.tokens = sotu.tokens[sample(1:nrow(sotu.tokens)),]

  ## windowed cooccurence (using non-default columnnames)
  g = windowedCoOccurenceNetwork(sotu.tokens,
                                 window.size=20,
                                 doc.col='aid',
                                 position.col = 'id',
                                 word.col = 'lemma')
  expect_equal(get.data.frame(g)$from[1:10], c("task","basic","bargain","country","idea","people","sure","business","work","Congress"))
  expect_equal(E(g)$weight[1:10], c(3,1,1,2,1,1,1,2,1,1))

  ## NETWORK ANALYSIS AND VISUALIZATION ##

  ## backbone extraction
  g_backbone = getBackboneNetwork(g, alpha=0.0001, max.vertices=100)
  expect_equal(ecount(g_backbone), 253)

  ## pretty plotting
  gs = plot_semnet(g_backbone)
  expect_equal(unique(V(gs)$color)[1:3], c("#FF6666","#FFB366", "#FF8C66"))
  expect_equal(round(V(gs)$size[1:10],3), c(11.456, 13.544, 15.000,  9.071,  8.303,  9.471,  7.194,  7.637, 12.072,  5.673))
})


############################################################
# For macaque paper, 08.19
# Makes length histograms for human and macaque SVs
# Gregg Thomas
############################################################

binSVs <- function(svs){
# Function to pre-bin SVs by length
  binned_svs = data.frame("bin"=seq(from=0,to=5000,by=100), count=0)
  for(i in 1:nrow(svs)) {
    row <- svs[i,]
    bin = floor(row$Length/100)*100
    binned_svs[binned_svs$bin==bin,]$count = binned_svs[binned_svs$bin==bin,]$count + 1
  }
  return(binned_svs)
}

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

this.dir <- dirname(parent.frame(2)$ofile)
setwd(this.dir)

library(ggplot2)
library(reshape2)
library(cowplot)
library(ggridges)
library(OneR)
library(ggforce)
library(ggbeeswarm)

source("../lib/read_svs.r")
source("../lib/filter_svs.r")
source("../lib/subset_svs.r")
source("../lib/design.r")

cat("----------\n")

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

savefiles = T
color_plots = F
rm_alus = T
# Run options

minlen = F
maxlen = 5000
# CNV length cutoffs

baseout = "fig2"
human_full = F
macaque_filter = T
figs4_opt = F
figs5_opt = F
if(figs4_opt){
  human_full = T
  baseout = paste(baseout, "_S4", sep="")
}else if(figs5_opt){
  macaque_filter = F
  baseout = paste(baseout, "_S5", sep="")
}

if(rm_alus){
  baseout = paste(baseout, "_noalu", sep="")
}
# Supplemental figure options

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

sv_list = readSVs()
mq_events = sv_list[[1]]; hu_events = sv_list[[2]];
sv_list = filterSVs(sv_list, minlen, maxlen, human_full, macaque_filter)
mq_events = sv_list[[1]]; hu_events = sv_list[[2]];
# Read and filter data

cat("----------\nSubsetting macaque data...\n")
mqr = subsetSVs(mq_events)
mq_svs = mqr[[4]]
mq_svs = subset(mq_svs, Length <= maxlen)

cat("----------\nSubsetting human data...\n")
hur = subsetSVs(hu_events)
hu_svs = hur[[4]]
hu_svs = subset(hu_svs, Length <= maxlen)
# Subset data

if(rm_alus){
  hu_svs = subset(hu_svs, Length < 275 | Length > 325)
  if(!figs5_opt){
    mq_svs = subset(mq_svs, Length < 275 | Length > 325)
  }
}
# For Alu stuff

sv_alleles = rbind(hu_svs, mq_svs)
# Combine the two datasets

#test_count = mq_events %>% group_by(Individual) %>% count(Individual)
# Count number of events per individual
######################

######################
# SV length histogram -- Fig 2A
cat("SV length distribution...\n")

fig2a = ggplot(sv_alleles, aes(x=Length, fill=Species, color=Species)) +
  geom_histogram(alpha=0.8, position="identity", bins=50, size=0.5) +
  #geom_density(alpha=0.3) +
  scale_y_continuous(expand = c(0, 0)) +
  labs(x="CNV length", y="# CNVs") +
  bartheme()
if(color_plots){
  fig2a = fig2a + scale_fill_manual(name="", values=c("Macaque"='#490092',"Human"='#920000'))
}else{
  fig2a = fig2a + scale_fill_manual(name="", values=c("Macaque"='#5c5c5c',"Human"=NA))
  }
fig2a = fig2a + scale_color_manual(name="", values=c("Macaque"=NA,"Human"='#000000'))
print(fig2a)
# Full length histogram

#if(savefiles){
#  outfile = "fig2a.pdf"
#  cat(" -> ", outfile, "\n")
#  ggsave(filename=outfile, fig2a, width=6, height=4, units="in")
#}

fig2a_box = ggplot(sv_alleles, aes(x=Species, y=Length, fill=Species)) +
  geom_quasirandom(size=2, alpha=0.7, width=0.25, color="#d3d3d3") +
  geom_boxplot(outlier.shape=NA, alpha=0.3, width=0.5, color="#000000") +
  labs(y="CNV Length", x="All CNVs") +
  bartheme() +
  theme(legend.position="none")
if(color_plots){
  fig2a_box = fig2a_box + scale_fill_manual(name="", values=c("Macaque"='#490092', "Human"='#920000'))
}else{
  fig2a_box = fig2a_box + scale_fill_manual(name="", values=c("Macaque"='#5c5c5c', "Human"=NA))
}
print(fig2a_box)
# Full lenght boxplot
#ggsave(filename="figS3.png", fig2a, width=6, height=4, units="in")

cat(" -> SV length KS test...\n")
length_ks = ks.test(hu_svs$Length, mq_svs$Length)
print(length_ks)
# Full length KS test
######################

######################
# SV deletion length histogram
cat("SV deletion length distribution...\n")
mq_dels = subset(mq_svs, Type=="<DEL>")
hu_dels = subset(hu_svs, Type=="<DEL>")
sv_dels = rbind(hu_dels, mq_dels)

fig2b = ggplot(sv_dels, aes(x=Length, fill=Species, color=Species)) +
  geom_histogram(alpha=0.8, position="identity", bins=50, size=0.5) +
  scale_y_continuous(expand = c(0, 0)) +
  labs(x="Deletion length", y="# Deletions") +
  bartheme()
if(color_plots){
  fig2b = fig2b + scale_fill_manual(name="", values=c("Macaque"='#490092',"Human"='#920000'))
}else{
  #fig2b = fig2b + scale_fill_grey(name="", labels=c("Human","Macaque"))
  fig2b = fig2b + scale_fill_manual(name="", values=c("Macaque"='#5c5c5c',"Human"=NA))
}
fig2b = fig2b + scale_color_manual(name="", values=c("Macaque"=NA,"Human"='#000000'))
print(fig2b)
# Deletion length histogram

#if(savefiles){
#  outfile = "fig2b.pdf"
#  ggsave(filename=outfile, fig2b, width=6, height=4, units="in")
#}

fig2b_box = ggplot(sv_dels, aes(x=Species, y=Length, fill=Species)) +
  geom_quasirandom(size=2, alpha=0.7, width=0.25, color="#d3d3d3") +
  geom_boxplot(outlier.shape=NA, alpha=0.3, width=0.5, color="#000000") +
  labs(y="CNV Length", x="Deletions") +
  bartheme() +
  theme(legend.position="none")
if(color_plots){
  fig2b_box = fig2b_box + scale_fill_manual(name="", values=c("Macaque"='#490092', "Human"='#920000'))
}else{
  fig2b_box = fig2b_box + scale_fill_manual(name="", values=c("Macaque"='#5c5c5c', "Human"=NA))
}
print(fig2b_box)
# Deletion length boxplot

cat(" -> SV deletion length KS test...\n")
del_ks = ks.test(mq_dels$Length, hu_dels$Length)
print(del_ks)
# Deletion length KS test
######################

######################
# SV duplication length histogram
cat("SV deletion length distribution...\n")
mq_dups = subset(mq_svs, Type=="<DUP>")
hu_dups = subset(hu_svs, Type=="<DUP>")
sv_dups = rbind(hu_dups, mq_dups)

fig2c = ggplot(sv_dups, aes(x=Length, fill=Species, color=Species)) +
  geom_histogram(alpha=0.8, position="identity", bins=50, size=0.5) +
  #scale_fill_manual(name="", labels=c("Macaque","Human"), values=c("#006ddb","#db6d00")) +
  scale_y_continuous(expand = c(0, 0)) +
  labs(x="Duplication length", y="# Duplications") +
  bartheme()
if(color_plots){
  fig2c = fig2c + scale_fill_manual(name="", values=c("Macaque"='#490092',"Human"='#920000'))
}else{
  fig2c = fig2c + scale_fill_manual(name="", values=c("Macaque"='#5c5c5c',"Human"=NA))
}
fig2c = fig2c + scale_color_manual(name="", values=c("Macaque"=NA,"Human"='#000000'))
print(fig2c)
# Duplication length histogram

#if(savefiles){
#  outfile = "fig2c.pdf"
#  ggsave(filename=outfile, fig2c, width=6, height=4, units="in")
#}
# SV del length plot

fig2c_box = ggplot(sv_dups, aes(x=Species, y=Length, fill=Species)) +
  geom_quasirandom(size=2, alpha=0.7, width=0.25, color="#d3d3d3") +
  geom_boxplot(outlier.shape=NA, alpha=0.3, width=0.5, color="#000000") +
  labs(y="CNV Length", x="Duplications") +
  bartheme() +
  theme(legend.position="none")
if(color_plots){
  fig2c_box = fig2c_box + scale_fill_manual(name="", values=c("Macaque"='#490092', "Human"='#920000'))
}else{
  fig2c_box = fig2c_box + scale_fill_manual(name="", values=c("Macaque"='#5c5c5c', "Human"=NA))
}
print(fig2c_box)
# Duplication length boxplot

cat(" -> SV duplication length KS test...\n")
dup_ks = ks.test(mq_dups$Length, hu_dups$Length)
print(dup_ks)
# Duplication length KS test
######################

######################
# Combine plots for figure

cat("Combining histograms...\n")
prow = plot_grid(fig2b + theme(legend.position="none"),
                 fig2c + theme(legend.position="none"),
                 align = 'vh',
                 labels = c("B", "C"),
                 label_size = 24,
                 hjust = -1,
                 nrow = 1)
# Combine panels B and C

pcombo = plot_grid(fig2a + theme(legend.position="none"), prow, nrow=2, labels=c("A","",""), label_size=24, rel_heights=c(1,0.8))
# Add panel A

legend_b = get_legend(fig2b + theme(legend.direction="horizontal", legend.justification="center", legend.box.just="bottom"))
# Extract the legend from one of the plots

p = plot_grid(pcombo, legend_b, ncol=1, rel_heights=c(1, 0.1))
# Add the legend underneath the row we made earlier with 10% of the height of the row.
print(p)

cat("Combining boxplots...\n")
p_box = plot_grid(fig2a_box, fig2b_box, fig2c_box, nrow=1,
                 align = 'vh',
                 labels = c("A", "B", "C"),
                 label_size = 24,
                 hjust = -1)
# Combine boxplots

if(savefiles){
  if(color_plots){
    outfile = paste(baseout, ".pdf", sep="")
    outfile_box = paste(baseout, "-box.pdf", sep="")
  }else{
    outfile = paste(baseout, "-grey.pdf", sep="")
    outfile_box = paste(baseout, "-box-grey.pdf", sep="")
  }
  cat(" -> ", outfile, "\n")
  ggsave(filename=outfile, p, width=10, height=10, units="in")
  ggsave(filename=outfile_box, p_box, width=10, height=4, units="in")
}
# Save the figure
######################
stop("End of plots.")

######################
# SV macaque deletion vs. duplication length histogram
fig2a = ggplot(mq_svs, aes(x=Length, fill=Type, color=Type)) +
  geom_histogram(alpha=0.8, position="identity", bins=50) +
  #geom_density(alpha=0.3) +
  scale_y_continuous(expand = c(0, 0)) +
  labs(x="CNV length", y="Count") +
  theme_classic() +
  theme(axis.text=element_text(size=12),
        axis.title=element_text(size=16),
        axis.title.y=element_text(margin=margin(t=0,r=10,b=0,l=0),color="black"),
        axis.title.x=element_text(margin=margin(t=10,r=0,b=0,l=0),color="black"),
        axis.line=element_line(colour='#595959',size=0.75),
        axis.ticks=element_line(colour="#595959",size = 1),
        axis.ticks.length=unit(0.2,"cm"),
        legend.position="right",
        legend.key.width = unit(0.75,  unit = "cm"),
        legend.spacing.x = unit(0.25, 'cm'),
        legend.title = element_blank(),
        legend.text=element_text(size=12),
        plot.title = element_text(hjust=0.5, size=20),
        plot.margin = unit(c(1,1,1,1), "cm")
  )

if(color_plots){
  fig2a = fig2a + scale_fill_manual(name="", values=c("<DEL>"='#490092',"<DUP>"='#920000'))
}else{
  #fig2a = fig2a + scale_fill_grey(name="", labels=c("Human","Macaque"))
  #fig2a = fig2a + scale_fill_manual(name="", values=c("Macaque"='#d6d6d6',"Human"='#5c5c5c'))
  fig2a = fig2a + scale_fill_manual(name="", values=c("<DEL>"='#5c5c5c',"<DUP>"=NA))
}
fig2a = fig2a + scale_color_manual(name="", values=c("<DEL>"=NA,"<DUP>"='#000000'))

print(fig2a)

cat(" -> SV macaque deletion vs. duplication length KS test...\n")
mq_ks = ks.test(mq_dels$Length, mq_dups$Length)
print(mq_ks)
# SV del length KS test
# SV macaque deletion vs. duplication length histogram
######################

######################
# Some experimenting with other types of plots.

fig2a = ggplot(sv_alleles, aes(x=Species, y=Length)) +
  geom_violin(fill="#999999") +
  #geom_sina(size=0.5) +
  labs(x="", y="CNV length") +
  theme_classic() +
  theme(axis.text=element_text(size=12),
        axis.title=element_text(size=16),
        axis.title.y=element_text(margin=margin(t=0,r=10,b=0,l=0),color="black"),
        axis.title.x=element_text(margin=margin(t=10,r=0,b=0,l=0),color="black"),
        axis.line=element_line(colour='#595959',size=0.75),
        axis.ticks=element_line(colour="#595959",size = 1),
        axis.ticks.length=unit(0.2,"cm"),
        legend.position="right",
        legend.key.width = unit(0.75,  unit = "cm"),
        legend.spacing.x = unit(0.25, 'cm'),
        legend.title = element_blank(),
        legend.text=element_text(size=12),
        plot.title = element_text(hjust=0.5, size=20),
        plot.margin = unit(c(1,1,1,1), "cm")
  )

print(fig2a)
## Violin plot

#cat("----------\nPre-binning macaque data...\n")
#mq_bins = binSVs(mq_svs)
#mq_bins$Species = "Macaque"
#mq_bins$count = -mq_bins$count

#cat("----------\nPre-binning human data...\n")
#hu_bins = binSVs(hu_svs)
#hu_bins$Species = "Human"
#sv_bins = rbind(hu_bins, mq_bins)

#fig2a = ggplot(sv_bins, aes(x=bin, y=count, fill=Species)) +
fig2a = ggplot(sv_bins, aes(x = bin, y = ifelse(Species == "Macaque",-1, 1)*count, fill = Species)) +
  geom_col() +
  scale_x_continuous(name = "CNV length", limits = c(0, 5000), expand = c(0, 0)) +
  scale_y_continuous(name = "Count", limits=c(-3000,3500), breaks = 1000*(-2:3), labels=c("2000","1000","0","1000","2000","3000")) +
  #scale_fill_manual(values = c("#D55E00", "#0072B2"), guide = "none") +
  #draw_text(x = 70, y = -39, "male", hjust = 0) +
  #draw_text(x = 70, y = 21, "female", hjust = 0) +
  #coord_flip() +
  theme_minimal_grid() +
  theme(axis.text=element_text(size=12),
        axis.title=element_text(size=16),
        axis.title.y=element_text(margin=margin(t=0,r=10,b=0,l=0),color="black"),
        axis.title.x=element_text(margin=margin(t=10,r=0,b=0,l=0),color="black"),
        axis.line=element_line(colour='#595959',size=0.75),
        #axis.ticks=element_line(colour="#595959",size = 1),
        #axis.ticks.length=unit(0.2,"cm"),
        legend.position="right",
        legend.key.width = unit(0.75,  unit = "cm"),
        legend.spacing.x = unit(0.25, 'cm'),
        legend.title = element_blank(),
        legend.text=element_text(size=12),
        plot.title = element_text(hjust=0.5, size=20),
        plot.margin = unit(c(1,1,1,1), "cm")
  )

if(color_plots){
  fig2a = fig2a + scale_fill_manual(name="", values=c("Macaque"='#490092',"Human"='#920000'))
}else{
  #fig2a = fig2a + scale_fill_grey(name="", labels=c("Human","Macaque"))
  #fig2a = fig2a + scale_fill_manual(name="", values=c("Macaque"='#d6d6d6',"Human"='#5c5c5c'))
  fig2a = fig2a + scale_fill_manual(name="", values=c("Macaque"='#5c5c5c',"Human"=NA))
}
fig2a = fig2a + scale_color_manual(name="", values=c("Macaque"=NA,"Human"='#000000'))

print(fig2a)
# Top and bottom plot.

raincloud_theme <- theme(
  text = element_text(size = 10),
  axis.title.x = element_text(size = 16),
  axis.title.y = element_text(size = 16),
  axis.text = element_text(size = 14),
  axis.text.x = element_text(angle = 45, vjust = 0.5),
  legend.title = element_text(size = 16),
  legend.text = element_text(size = 16),
  legend.position = "right",
  plot.title = element_text(lineheight = .8, face = "bold", size = 16),
  panel.border = element_blank(),
  panel.grid.minor = element_blank(),
  panel.grid.major = element_blank(),
  axis.line.x = element_line(colour = "black", size = 0.5, linetype = "solid"),
  axis.line.y = element_line(colour = "black", size = 0.5, linetype = "solid"))

test = ggplot(data = sv_alleles, aes(x=Species, y=Length, fill=Species)) +
  geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .6) +
  geom_point(aes(y = Length, color = Species),
             position = position_jitter(width = .15), size = .25, alpha = 0.3) +
  stat_boxplot(geom ='errorbar', width=0.1) +
  geom_boxplot(width = .1, outlier.shape = NA, alpha = 0.8, lwd=1) +
  expand_limits(x =c(1.5,2)) +
  guides(fill = FALSE) +
  guides(color = FALSE) +
  scale_color_manual(name="", values=c("Macaque"='#490092',"Human"='#920000')) +
  scale_fill_manual(name="", values=c("Macaque"='#490092',"Human"='#920000')) +
  coord_flip() +
  theme_bw()
raincloud_theme

devtools::source_gist("2a1bb0133ff568cbe28d",
                      filename = "geom_flat_violin.R")
## sourced from github "dgrtwo/geom_flat_violin.R
test = ggplot(data = sv_alleles,
              mapping = aes(x = Species,
                            y = Length,
                            fill = Species)) +
  geom_flat_violin(scale = "count",
                   trim = FALSE) +
  stat_summary(fun.data = mean_sdl,
               fun.args = list(mult = 1),
               geom = "pointrange",
               position = position_nudge(0.05)) +
  geom_dotplot(binaxis = "y",
               dotsize = 0.5,
               stackdir = "down",
               binwidth = 15,
               position = position_nudge(-0.025)) +
  scale_color_manual(name="", values=c("Macaque"='#490092',"Human"='#920000')) +
  scale_fill_manual(name="", values=c("Macaque"='#490092',"Human"='#920000')) +
  theme_bw() +
  coord_flip() +
  theme(legend.position = "none")

print(test)
# Raincould plot


# generate sample data files for development

library(detourr)
library(geozoo)
library(tidyverse)

set.seed(1)

p <- detour(tourr::flea, tour_aes(projection = where(is.numeric), color = species, label = species)) |>
  show_scatter()

writeLines(
  jsonlite::toJSON(unclass(p$x), auto_unbox = TRUE, null = "null"),
  "../dev/show_scatter_2d/static/sample_data.json"
)

set.seed(1)

p <- detour(tourr::flea, tour_aes(projection = where(is.numeric), color = species, label = species)) |>
  tour_path(grand_tour(3)) |>
  show_scatter()

writeLines(
  jsonlite::toJSON(unclass(p$x), auto_unbox = TRUE, null = "null"),
  "../dev/show_scatter_3d/static/sample_data.json"
)

set.seed(1)

p <- detour(tourr::flea, tour_aes(projection = where(is.numeric), color = species, label = species)) |>
  show_sage()

writeLines(
  jsonlite::toJSON(unclass(p$x), auto_unbox = TRUE, null = "null"),
  "../dev/show_sage_2d/static/sample_data.json"
)

set.seed(1)

p <- detour(tourr::flea, tour_aes(projection = where(is.numeric), color = species, label = species)) |>
  tour_path(grand_tour(3)) |>
  show_sage()

writeLines(
  jsonlite::toJSON(unclass(p$x), auto_unbox = TRUE, null = "null"),
  "../dev/show_sage_3d/static/sample_data.json"
)

set.seed(1)

x <- geozoo::roman.surface(n = 200)$points |>
  as_tibble(.name_repair = "unique")

p <- detour(x, tour_aes(projection = everything())) |>
  tour_path(grand_tour(2), max_bases = 10) |>
  show_slice(slice_relative_volume = 0.1)

writeLines(
  jsonlite::toJSON(unclass(p$x), auto_unbox = TRUE, null = "null"),
  "../dev/show_slice_2d/static/sample_data.json"
)

set.seed(1)

x <- geozoo::sphere.hollow(p = 4, n = 200)$points |>
  as_tibble(.name_repair = "unique")

p <- detour(x, tour_aes(projection = everything())) |>
  tour_path(grand_tour(3)) |>
  show_slice(slice_relative_volume = 0.3)

writeLines(
  jsonlite::toJSON(unclass(p$x), auto_unbox = TRUE, null = "null"),
  "../dev/show_slice_3d/static/sample_data.json"
)


suppressPackageStartupMessages({
    library(data.table)
    library(colorspace)
})
source('../../../functions.r')
load('../../../input-data/grid/grids.rdata')

dens <- fread('../../generated/gridded-distribution-by-species.csv')

spp <- fread('../../acap-species-list.csv')[base_species == T]

pal <- sequential_hcl(10, 'Purples 3', rev=T)

sp='DIM'
for (sp in spp$code.sra) {
    cat(sp, '\n')
    d <- dens[code.sra == sp, .(value = sum(density)), .(grid_id)]
    g <- map_grid_values(grid_values=d, legend.title = 'Birds / km^2', pal=pal, colourscale.trans='identity')
    ggsave(sprintf('../assets/distribution-%s.png', sp), g, width = 7, height = 7, dpi=100)

}


###### 21. COMPARE PSV ACROSS STRATEGIES (COMPLETE ONLY) ########
#### DO STEPS 1-4 AND 12 FOR EACH TREE, THEN PROCEED
iden <- which(rowSums(prPAM_g2[,-c(1:2)]) > 5)
ssp<-coordinates(prPAM_g2[iden,1:2])
f <- clean_coordinates(as.data.frame(ssp), lon = "LON",lat = "LAT",
                       tests="seas",species=NULL,value="flagged",seas_scale=110)

iden <- which(rowSums(prPAM_g2[,-c(1:2)]) > 5)
psvSA <- psv(samp = prPAM_g2[iden,-c(1:2)],tree = tre.pruned); psvSA <- psvSA$PSVs[iden];psvSA <- psvSA[f]
psvSB <- psv(samp = prPAM_g2[iden,-c(1:2)],tree = tre.pruned); psvSB <- psvSB$PSVs[iden]; psvSB <- psvSB[f]
psvSD <- psv(samp = prPAM_g2[iden,-c(1:2)],tree = tre.pruned); psvSD <- psvSD$PSVs[iden]; psvSD <- psvSD[f]

ruta_write<-"~/Desktop/NATURE_rev/RES_SAcomplete_v3/"
load(paste(ruta_write,"PSV_random_rich.Rdata",sep=""))
PSV_random_rich_SA <- PSV_random_rich
load(paste(ruta_write,"PSV_random_freq.Rdata",sep=""))
PSV_random_freq_SA <- PSV_random_freq
ruta_write<-"~/Desktop/NATURE_rev/RES_SBcomplete_v3/"
load(paste(ruta_write,"PSV_random_rich.Rdata",sep=""))
PSV_random_rich_SB <- PSV_random_rich
load(paste(ruta_write,"PSV_random_freq.Rdata",sep=""))
PSV_random_freq_SB <- PSV_random_freq
ruta_write<-"~/Desktop/NATURE_rev/RES_SDcomplete_v3/"
load(paste(ruta_write,"PSV_random_rich.Rdata",sep=""))
PSV_random_rich_SD <- PSV_random_rich
load(paste(ruta_write,"PSV_random_freq.Rdata",sep=""))
PSV_random_freq_SD <- PSV_random_freq

SESnull1_psvSA <- (psvSA - apply(PSV_random_rich_SA[f,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(PSV_random_rich_SA[f,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))
SESnull1_psvSB <- (psvSB - apply(PSV_random_rich_SB[f,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(PSV_random_rich_SB[f,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))
SESnull1_psvSD <- (psvSD - apply(PSV_random_rich_SD[f,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(PSV_random_rich_SD[f,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))

SESnull2_psvSA <- (psvSA - apply(PSV_random_freq_SA[f,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(PSV_random_freq_SA[f,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))
SESnull2_psvSB <- (psvSB - apply(PSV_random_freq_SB[f,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(PSV_random_freq_SB[f,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))
SESnull2_psvSD <- (psvSD - apply(PSV_random_freq_SD[f,-c(1:2)],MARGIN=1,FUN=mean,na.rm=T))/(apply(PSV_random_freq_SD[f,-c(1:2)],MARGIN=1,FUN=sd,na.rm=T))

pdf("~/Desktop/NATURE_rev/2.PSV_nulls_comparison_strategies.pdf",useDingbats = F)
plot(psvSB,psvSA,xlim=c(0.5,1),ylim=c(0.5,1),type="n",xlab="Relaxed Calibration (RC)",ylab="Constrained Calibration (CC)")
abline(a=0,b=1)
points(psvSB,psvSA,pch=21,bg="red",cex=0.8)
title("PSV")
plot(psvSB,psvSD,xlim=c(0.5,1),ylim=c(0.5,1),type="n",xlab="Relaxed Calibration (RC)",ylab="Unconstrained Calibration (CC)")
abline(a=0,b=1)
points(psvSB,psvSD,pch=21,bg="red",cex=0.8)
title("PSV")

plot(SESnull1_psvSB,SESnull1_psvSA,xlim=c(-20,20),ylim=c(-20,20),type="n",xlab="Relaxed Calibration (RC)",ylab="Constrained Calibration (CC)")
abline(a=0,b=1)
points(SESnull1_psvSB,SESnull1_psvSA,pch=21,bg="red",cex=0.8)
title("SES PSV (null 1")
plot(SESnull1_psvSB,SESnull1_psvSD,xlim=c(-20,20),ylim=c(-20,20),type="n",xlab="Relaxed Calibration (RC)",ylab="Unconstrained Calibration (CC)")
abline(a=0,b=1)
points(SESnull1_psvSB,SESnull1_psvSD,pch=21,bg="red",cex=0.8)
title("SES PSV (null 1")

plot(SESnull2_psvSB,SESnull2_psvSA,xlim=c(-20,20),ylim=c(-20,20),type="n",xlab="Relaxed Calibration (RC)",ylab="Constrained Calibration (CC)")
abline(a=0,b=1)
points(SESnull2_psvSB,SESnull2_psvSA,pch=21,bg="red",cex=0.8)
title("SES PSV (null 2")
plot(SESnull2_psvSB,SESnull2_psvSD,xlim=c(-20,20),ylim=c(-20,20),type="n",xlab="Relaxed Calibration (RC)",ylab="Unconstrained Calibration (CC)")
abline(a=0,b=1)
points(SESnull2_psvSB,SESnull2_psvSD,pch=21,bg="red",cex=0.8)
title("SES PSV (null 2")
dev.off()


#!/usr/bin/env Rscript

# ---------- Load R environment ----------
# Setup R error handling to go to stderr
options(show.error.messages=F, error=function() { cat(geterrmessage(), file=stderr()); q("no",1,F) } )

# Set proper locale
#loc <- Sys.setlocale("LC_MESSAGES", "en_US.UTF-8")
#loc <- Sys.setlocale(category="LC_ALL", locale="C")

# Set options
#options(encoding="UTF-8")
options(stringAsfactors=FALSE, useFancyQuotes=FALSE)

# Take in trailing command line arguments
args <- commandArgs(trailingOnly=TRUE)
if (length(args) < 2) {
	print("Error! No or not enough arguments given.")
	print("Usage: $0 feat_list.tsv feat_list_log.tsv")
	quit(save="no", status=1, runLast=FALSE)
}

# Load libraries
library(mixOmics)
library(ape)
library(pvclust)
library(dendextend)
library(cba)
library(phangorn)

# Import Feature list
feat_list <- read.table(file=args[1], header=TRUE, quote="\"", sep="\t")

# Log-Transformation
feat_list_log <- log(feat_list)
for (i in 1:ncol(feat_list_log)) {
	feat_list_log[which(feat_list_log[,i] == -Inf), i] <- 0
}
feat_list_log[is.na(feat_list_log)] <- 0

# Export log-transformed Feature List
write.table(x=feat_list_log, file=args[2], sep="\t", quote=TRUE, row.names=FALSE, dec=".")


require(lattice)
output_file_prefix <- "basemodel2_a135"

A = NULL
rep <- 0
force <- c(1, 3, 7, 10, 14, 16)
for ( i in seq(6) )
{
    rep = rep + 1
    cat("\n ***********run********* ", rep, "\n")
    FolderName <- paste("case_", output_file_prefix, "_", as.character(rep), "/out/", sep='')
    cmd = paste("ls ", FolderName, "stat* > ", FolderName, "filelist.txt", sep='')
    system(cmd)
    fileList <- readLines(paste(FolderName, "filelist.txt", sep=''))
    for ( fileid in fileList )
    {
        FileName <- fileid
        stat <- read.csv(file=FileName, header=FALSE)
        L <- length(stat[,1])
        if ( L > 200 )
        {
            A <- rbind(A, c(force[rep], stat[L,10]))
        }
        cat(L, " ")
    }
    cat("\n")
}
plot(A[,1], A[,2])

## colList <- c("red", "blue", "black", "green", "cyan")
## colList <- rep(colList, 5)
## png(paste("output_", output_file_prefix, ".png", sep=''), height=600, width=1200)
## par(mar=c(5,6,4,4))
## plot(0, 0, type='n', xlim=c(0, 2000),
##      ##ylim=c(-10, 10),
##      ylim=c(-1, 0),
##      xlab="number of divisions", ylab="deviation X(t)",
##      cex.axis=1.5, cex.lab=1.5)
## abline(h=c(0, -5, 5),col='blue')
## dev.off()

## hist(atan(abs(sin(totalDividingAngleList)/cos(totalDividingAngleList))))

## png('AspectRatio.png', height=600, width=600)
## ##par(mfrow=c(1,2))
## ##angle <- angle + rnorm(length(angle), 0, pi*15.37/180)
## angle=atan(abs(sin(angle)/cos(angle)))*180/pi
## t = hist(angle, breaks=c(0, 30, 60, 90), plot=F)
## barplot(t$counts/sum(t$counts), ylim=c(0, 1))
## ##t = hist(angle[braf==1], breaks=c(0, 30, 60, 90))
## #tt = hist(angle[braf==0], breaks=c(0, 30, 60, 90))
## #d1 = t$density/sum(t$density)
## #d0 = tt$density/sum(tt$density)
## dev.off()

## write.table(t$counts/sum(t$counts), file="as.csv", sep=',')

## cat('Fcal: ', var(Fcal, na.rm=T), '\n')
## cat('Gcal: ', var(Gcal, na.rm=T), '\n')

## pdf("p1.pdf")
## ##png("p1.png")
## par(mar=c(5,6,4,4))
## plot(0, 0, type='n', xlim=c(0, 2000), ylim=c(0, 1),
##      xlab="time", ylab="percentage of elongated cells",
##      cex.axis=1.5, cex.lab=2)
## abline(h=c(0.37), col='black', lwd=4, lty=2)
## rep = rep0
## n0 = 600
## n <- 0
## for ( i in seq(5) )
## {
##     rep = rep + 1
##     cat("\n ***********run********* ", rep, "\n")
##     FolderName <- paste("case",as.character(rep), "/out/", sep='')
##     cmd = paste("ls ", FolderName, "stat* > ", FolderName, "filelist.txt", sep='')
##     system(cmd)
##     fileList <- readLines(paste(FolderName, "filelist.txt", sep=''))
##     for ( fileid in fileList )
##     {
##         n <- n + 1
##         FileName <- fileid
##         A <- read.csv(file=FileName, header=FALSE)
##         if ( length(A[,10])/10 >= Nsample )
##         {
##             ##lines(A[,10], col=colList[i])
##             lines(A[,10], col='red')
##         }
##     }
## }

## rep = 20
## n0 = 600
## n <- 0
## for ( i in seq(10) )
## {
##     rep = rep + 1
##     cat("\n ***********run********* ", rep, "\n")
##     FolderName <- paste("../360_InitialStates_CellModel_MitotiSpindle/case",as.character(rep), "/out/", sep='')
##     cmd = paste("ls ", FolderName, "stat* > ", FolderName, "filelist.txt", sep='')
##     system(cmd)
##     fileList <- readLines(paste(FolderName, "filelist.txt", sep=''))
##     for ( fileid in fileList )
##     {
##         n <- n + 1
##         FileName <- fileid
##         A <- read.csv(file=FileName, header=FALSE)
##         if ( length(A[,10])/10 >= Nsample )
##         {
##             ##lines(A[,10], col=colList[i])
##             lines(A[,10], col='blue')
##         }
##     }
## }
## dev.off()

## plot(0, 0, type='n', xlim=c(0, 1000), ylim=c(0, 1),
##      xlab="number of divisions", ylab="p",
##      cex.axis=1.5, cex.lab=1.5)
## abline(h=c(0, 0.37),col='blue')

## rep = rep0
## n0 = 1
## Fcal <- NULL
## n <- 0
## for ( i in seq(10) )
## ##for ( i in 10 )
## {
##     rep = rep + 1
##     cat("\n ***********run********* ", rep, "\n")
##     FolderName <- paste("case",as.character(rep), "/out/", sep='')
##     cmd = paste("ls ", FolderName, "stat* > ", FolderName, "filelist.txt", sep='')
##     system(cmd)
##     fileList <- readLines(paste(FolderName, "filelist.txt", sep=''))
##     for ( fileid in fileList )
##     {
##         n <- n + 1
##         FileName <- fileid
##         stat <- read.csv(file=FileName, header=FALSE)
##         z <- 100*(stat[n0:dim(stat)[1],9] - 0.37)
##         ##z <- z - 0.1*seq(length(z))
##         ##lines(stat[,8], type='o', col=colList[i])
##         lines(z, col='green')
##     }
## }

## rep = rep0
## plot(0, 0, type='n', xlim=c(0, 200), ylim=c(-15, 15))
## abline(h=c(0, -5, 5),col='blue')
## n0 = 1
## Fcal <- NULL
## for ( i in seq(40) ) {
##   rep = rep + 1
##   cat("\n ***********run********* ", rep, "\n")
##   FolderName <- gsub("(\ )", "", paste("case",as.character(rep)))
##   FileName <- paste(FolderName, "/out/statistics.txt", sep='')
##   stat <- read.csv(file=FileName, header=FALSE)
##   z <- stat[n0:dim(stat)[1],7] - stat[n0,7]
##   z <- z - 0.0*seq(length(z))
##   ##lines(stat[,8], type='o', col=colList[i])
##   lines(z, col=colList[i])
##   if ( length(z) >= Nsample )
##   {
##       Fcal[i] <- z[Nsample]
##   }
##   else
##     {
##         Fcal[i] <- NA
##     }
##   ##lines(15*(z[,8]-0.37), col=colList[i])
## }

##legend("bottomleft", c("random", "model"), lwd=1, col=c('green', 'blue'), cex=1.5)

##dev.off()

## plot(0, 0, type='n', xlim=c(0, 200), ylim=c(0, 1))
## abline(h=0.37,col='blue')
## rep = rep0
## n0 = 1
## for ( i in seq(10) ) {
##   rep = rep + 1
##   cat("\n ***********run********* ", rep, "\n")
##   FolderName <- gsub("(\ )", "", paste("case",as.character(rep)))
##   FileName <- paste(FolderName, "/out/statistics.txt", sep='')
##   stat <- read.csv(file=FileName, header=FALSE)
##   ## z <- stat[n0:dim(stat)[1],9] - stat[n0,7]
##   ## z <- z + 0.02*seq(length(z))
##   lines(stat[,9], col=colList[i])
##   ##lines(15*(z[,8]-0.37), col=colList[i])
## }


require("shiny")
#require("reshape")
#require("ggplot2")
#require("plotly")

#1. use require instead of library
#2. four functions: name.tabPanel
#                   name.siderbarPanel
#                   name.prepareData
#                   name.preparePlot
#3. profile to pass parameters for specific data
#4. function fileLocate to locate the date in selected folder
#5. In prepareData, use <<- instead of <- or == to bring the reactive variable out
#6. name each variables with prefix to aviod name conflict
#7  global data frame sampleInfo as the sample profiles
#8. touch server.R to enforce the update
#9. use conditionalPanel in sidebarPanel
#10. global data frame all_parameters to get folder specific parameters
#11. reactive data is shareable
#12. To use the module for one data, put "tools	toolname" in main.profile in the folder
#13. To add parameter for a module for a folder, put "key	value" in toolname in the folder

Tests.tabPanel<-function(profile){
	tabPanel("Statistic tests",verbatimTextOutput("Tests.print"))
}

Tests.sidebarPanel<-function(profile,input,session){
  conditionalPanel(condition = "input.tabs1 == 'Statistic tests'",
                   selectInput("Tests.type","Select a statistic test",c("T-test","Wilcoxon Test","ANOVA"))
	)
}

#Tests.preparePlot<-function(input,output){
  output$Tests.print <- renderPrint({
	singleformula=paste("value ~",input$group_by,sep=" ")
	multformula=paste("value ~", paste(colnames(sampleInfo)[-1],collapse="*"),sep=" ")
	if(input$Tests.type=="T-test"){
		t.test(as.formula(singleformula),share.filteredData())
	}
	else if(input$Tests.type=="Wilcoxon Test"){
		wilcox.test(as.formula(singleformula),share.filteredData(),exact=FALSE)
	}
	else if(input$Tests.type=="ANOVA"){
		summary(aov(as.formula(multformula),data=share.filteredData()))
	}
  })
#}