# ' Functions for the detection of fixations in raw eye-tracking data.
# '
# ' Offers a function for detecting fixations in a stream of eye
# ' positions recorded by an eye-tracker.  The detection is done using
# ' an algorithm for saccade detection proposed by Ralf Engbert and
# ' Reinhold Kliegl (see reference below).  Anything that happens
# ' between two saccades is considered to be a fixation.  This software
# ' is therefore not suited for data sets with smooth-pursuit eye
# ' movements.
#'
#' @name saccades
#' @docType package
#' @title Detection of Fixations in Raw Eye-Tracking Data
#' @author Titus von der Malsburg \email{malsburg@@posteo.de}
#' @references
#' Ralf Engbert, Reinhold Kliegl: Microsaccades uncover the
#' orientation of covert attention, Vision Research, 2003.
#' @importFrom zoom zm
#' @keywords manip ts classif
#' @seealso \code{\link{detect.fixations}},
#' \code{\link{diagnostic.plot}}, \code{\link{calculate.summary}}

NULL

#' Samples of eye positions as recorded with an iViewX eye-tracker
#' recording at approx. 250 Hz.  The data quality is low on purpose
#' and contains episodes of track-loss and blinks.
#'
#' @name samples
#' @title Samples of Eye Positions as Recorded with an Eye-Tracker
#' @docType data
#' @usage samples
#' @format a data frame containing one line per sample.  The samples
#' are sorted in chronological order.  Time is given in milliseconds,
#' x- and y-coordinates in screen pixels.
#' @source Recorded with an iViewX Eye-Tracker by SMI at approximately
#' 250 Hz.
#' @author Titus von der Malsburg \email{malsburg@@posteo.de}

NULL

#' Fixations detected in a stream of raw eye positions.  The
#' corresponding raw eye positions samples are found in the data frame
#' \code{\link{samples}} also part of this package.
#'
#' @name fixations
#' @title Fixations Detected in a Stream of Raw Positions
#' @docType data
#' @usage fixations
#' @format a data frame containing one line per fixation.  The
#' fixations are sorted in chronological order.  Time is given in
#' milliseconds, x- and y-coordinates in screen pixels.
#' @source Recorded with an iViewX Eye-Tracker by SMI at approximately
#' 250 Hz.
#' @author Titus von der Malsburg \email{malsburg@@posteo.de}

NULL

#' Takes a data frame containing raw eye-tracking samples and returns a
#' data frame containing fixations.
#'
#' @title Detect Fixations in a Stream of Raw Eye-Tracking Samples
# ' @param samples a data frame containing the raw samples as recorded
# ' by the eye-tracker.  This data frame has four columns:
# ' \describe{
# '  \item{time:}{the time at which the sample was recorded}
# '  \item{trial:}{the trial to which the sample belongs}
# '  \item{x:}{the x-coordinate of the sample}
# '  \item{y:}{the y-coordinate of the sample}
# ' }
# ' Samples have to be listed in chronological order.  The velocity
# ' calculations assume that the sampling frequency is constant.
# ' @param lambda a parameter for tuning the saccade
# ' detection.  It specifies which multiple of the standard deviation
# ' of the velocity distribution should be used as the detection
# ' threshold.
# ' @param smooth.coordinates logical. If true the x- and y-coordinates will be
# ' smoothed using a moving average with window size 3 prior to saccade
# ' detection.
# ' @param smooth.saccades logical.  If true, consecutive saccades that
# ' are separated only by a few samples will be joined.  This avoids
# ' the situation where swing-backs at the end of longer saccades are
# ' recognized as separate saccades.  Whether this works well, depends
# ' to some degree on the sampling rate of the eye-tracker.  If the
# ' sampling rate is very high, the gaps between the main saccade and
# ' the swing-back might become too large and look like genuine
# ' fixations.  Likewise, if the sampling frequency is very low,
# ' genuine fixations may be regarded as spurious.  Both cases are
# ' unlikely to occur with current eye-trackers.
#' @section Details: This function uses a velocity-based detection
#' algorithm for saccades proposed by Engbert and Kliegl.  Anything
#' between two saccades is considered to be a fixation.  Thus, the
#' algorithm is not suitable for data sets containing episodes of
#' smooth pursuit eye movements.
#' @return a data frame containing the detected fixations.  This data
#' frame has the following columns:
#'  \item{trial}{the trial to which the fixation belongs}
#'  \item{start}{the time at which the fixation started}
#'  \item{end}{the time at which the fixation ended}
#'  \item{x}{the x-coordinate of the fixation}
#'  \item{y}{the y-coordinate of the fixation}
#'  \item{mad.x}{the standard deviation of the sample x-coordinates within the fixation}
#'  \item{mad.y}{the standard deviation of the sample y-coordinates within the fixation}
#'  \item{peak.vx}{the horizontal peak velocity that was reached within the fixation}
#'  \item{peak.vy}{the vertical peak velocity that was reached within the fixation}
#'  \item{dur}{the duration of the fixation}
#'  \item{event}{the type of event, which could be 'fixation',
#'   'blink', or artifacts which are labeled 'too dispersed' and 'too
#'   short'.  Classification is based on simple heuristics that
#'   identify outliers with respect to dispersion and duration.}
#' @author Titus von der Malsburg \email{malsburg@@posteo.de}
#' @references
#' Ralf Engbert, Reinhold Kliegl: Microsaccades uncover the
#' orientation of covert attention, Vision Research, 2003.
#' @keywords manip ts classif
#' @seealso \code{\link{diagnostic.plot}},
#' \code{\link{calculate.summary}}
#' @export
#' @examples
#' data(samples)
#' head(samples)
#' fixations <- detect.fixations(samples)
#' head(fixations)
#' \dontrun{
#' first.trial <- samples$trial[1]
#' first.trial.samples <- subset(samples, trial==first.trial)
#' first.trial.fixations <- subset(fixations, trial==first.trial)
#' with(first.trial.samples, plot(x, y, pch=20, cex=0.2, col="red"))
#' with(first.trial.fixations, points(x, y, cex=1+sqrt(dur/10000)))
#' }
detect.fixations <- function(samples, lambda=6, smooth.coordinates=FALSE, smooth.saccades=TRUE) {

  if (! all(c("x", "y", "trial", "time") %in% colnames(samples)))
    stop("Input data frame needs columns 'x', 'y', 'trial', and 'time'.")

  if (! all(with(samples, tapply(time, trial, function(x) all(diff(x) > 0)))))
    stop("Samples need to be in chronological order within trial.")

  # Discard unnecessary columns:
  samples <- samples[c("x", "y", "trial", "time")]

  if (smooth.coordinates) {
    # Keep and reuse original first and last coordinates as they can't
    # be smoothed:
    x <- samples$x[c(1,nrow(samples))]
    y <- samples$y[c(1,nrow(samples))]
    kernel <- rep(1/3, 3)
    samples$x <- stats::filter(samples$x, kernel)
    samples$y <- stats::filter(samples$y, kernel)
    # Plug in the original values:
    samples$x[c(1,nrow(samples))] <- x
    samples$y[c(1,nrow(samples))] <- y
  }

  samples <- detect.saccades(samples, lambda, smooth.saccades)

  if (all(!samples$saccade))
    stop("No saccades were detected.  Something went wrong.")

  fixations <- aggregate.fixations(samples)

  fixations$event <- label.blinks.artifacts(fixations)

  fixations

}

# EXPERIMENTAL: This function tries to detect blinks and artifacts
# based on x- and y-dispersion and duration of fixations.
label.blinks.artifacts <- function(fixations) {

  # Blink and artifact detection based on dispersion:
  lsdx <- log10(fixations$mad.x)
  lsdy <- log10(fixations$mad.y)
  median.lsdx <- stats::median(lsdx, na.rm=TRUE)
  median.lsdy <- stats::median(lsdy, na.rm=TRUE)
  mad.lsdx <- stats::mad(lsdx, na.rm=TRUE)
  mad.lsdy <- stats::mad(lsdy, na.rm=TRUE)

  # Dispersion too low -> blink:
  threshold.lsdx <- median.lsdx - 4 * mad.lsdx
  threshold.lsdy <- median.lsdy - 4 * mad.lsdy
  event <- ifelse((!is.na(lsdx) & lsdx < threshold.lsdx) &
                  (!is.na(lsdy) & lsdy < threshold.lsdy),
                  "blink", "fixation")

  # Dispersion too high -> artifact:
  threshold.lsdx <- median.lsdx + 4 * mad.lsdx
  threshold.lsdy <- median.lsdy + 4 * mad.lsdy
  event <- ifelse((!is.na(lsdx) & lsdx > threshold.lsdx) &
                  (!is.na(lsdy) & lsdy > threshold.lsdy),
                  "too dispersed", event)

  # Artifact detection based on duration:
  dur <- 1/fixations$dur
  median.dur <- stats::median(dur, na.rm=TRUE)
  mad.dur <- stats::mad(dur, na.rm=TRUE)

  # Duration too short -> artifact:
  threshold.dur <- median.dur + mad.dur * 5
  event <- ifelse(event!="blink" & dur > threshold.dur, "too short", event)

  factor(event, levels=c("fixation", "blink", "too dispersed", "too short"))
}

# This function takes a data frame of the samples and aggregates the
# samples into fixations.  This requires that the samples have been
# annotated using the function detect.saccades.
aggregate.fixations <- function(samples) {

  # In saccade.events a 1 marks the start of a saccade and a -1 the
  # start of a fixation.

  saccade.events <- sign(c(0, diff(samples$saccade)))

  trial.numeric  <- as.integer(factor(samples$trial))
  trial.events   <- sign(c(0, diff(trial.numeric)))

  # New fixations start either when a saccade ends or when a trial
  # ends:
  samples$fixation.id <- cumsum(saccade.events==-1|trial.events==1)
  samples$t2 <- samples$time
  samples$t2 <- ifelse(trial.events==1, NA, samples$t2)
  samples$t2 <- samples$t2[2:(nrow(samples)+1)]
  # Set last t2 value in a trial to last time value to avoid -Inf dur
  # and end values when the last event has just one sample (see #13 on
  # Github).  May produce zero-duration events but zero simply is our
  # most conservative guess in this case.
  samples$t2 <- with(samples, ifelse(is.na(t2), time, t2))

  # Discard samples that occurred during saccades:
  samples <- samples[!samples$saccade,,drop=FALSE]

  fixations <- with(samples, data.frame(
    trial   = tapply(trial, fixation.id, function(x) x[1]),
    start   = tapply(time,  fixation.id, min),
    end     = tapply(t2,    fixation.id, function(x) max(x, na.rm=TRUE)),
    x       = tapply(x,     fixation.id, stats::median),
    y       = tapply(y,     fixation.id, stats::median),
    mad.x   = tapply(x,     fixation.id, stats::mad),
    mad.y   = tapply(y,     fixation.id, stats::mad),
    peak.vx = tapply(vx,    fixation.id, function(x) x[which.max(abs(x))]),
    peak.vy = tapply(vy,    fixation.id, function(x) x[which.max(abs(x))]),
    stringsAsFactors=FALSE))

  fixations$dur <- fixations$end - fixations$start

  fixations

}

# Implementation of the Engbert & Kliegl algorithm for the
# detection of saccades.  This function takes a data frame of the
# samples and adds three columns:
#
# - A column named "saccade" which contains booleans indicating
#   whether the sample occurred during a saccade or not.
# - Columns named vx and vy which indicate the horizontal and vertical
#   speed.
detect.saccades <- function(samples, lambda, smooth.saccades) {

  # Calculate horizontal and vertical velocities:
  vx <- stats::filter(samples$x, -1:1/2)
  vy <- stats::filter(samples$y, -1:1/2)

  # We don't want NAs, as they make our life difficult later
  # on.  Therefore, fill in missing values:
  vx[1] <- vx[2]
  vy[1] <- vy[2]
  vx[length(vx)] <- vx[length(vx)-1]
  vy[length(vy)] <- vy[length(vy)-1]

  msdx <- sqrt(stats::median(vx**2, na.rm=TRUE) - stats::median(vx, na.rm=TRUE)**2)
  msdy <- sqrt(stats::median(vy**2, na.rm=TRUE) - stats::median(vy, na.rm=TRUE)**2)

  radiusx <- msdx * lambda
  radiusy <- msdy * lambda

  sacc <- ((vx/radiusx)**2 + (vy/radiusy)**2) > 1
  if (smooth.saccades) {
    sacc <- stats::filter(sacc, rep(1/3, 3))
    sacc <- as.logical(round(sacc))
  }
  samples$saccade <- ifelse(is.na(sacc), FALSE, sacc)
  samples$vx <- vx
  samples$vy <- vy

  samples

}


library(parallel)
library(caret)
library(MASS)
library(xgboost)

library(OptimalCutpoints)
library(pROC)
library(ROCR)

library(ggplot2)
library(cowplot)
library(gridExtra)
library(viridis)

library(survival)
library(survminer)

setwd("/media/yuri/Data/home1/GNI_data/infection/ModelsSciRep")
load('COVID19_Ensemble.Rdat')
XGB_model_bst <- xgb.load('COVID19_Ensemble.model')
XGB_model_ntree <- XGB_model_bst$best_iteration

# create xgb.DMatrix
dtrain0 <- xgb.DMatrix(data = as.matrix(trn_x[,-1]), label = trn_y)
dvalid  <- xgb.DMatrix(data = as.matrix(val_x[,-1]), label = val_y)

# predict discovery and validation cohorts (probs)
Ytrain_prob <- predict(XGB_model_bst, dtrain0, ntree = XGB_model_ntree, outputmargin=TRUE)
Yvalid_prob <- predict(XGB_model_bst, val_x[,-1],  ntree = XGB_model_ntree, outputmargin=TRUE)

################################################################################
# Find optimal cutpoint from the ROC curve maximizing the product of Sensitivity and Specificity
p_cut <- optimal.cutpoints(y~x, status=trn_y, tag.healthy = 0, data= data.frame(y=Ytrain_prob, x = trn_y),
methods="MaxProdSpSe", ci.fit=TRUE, control = control.cutpoints(ci.SeSp = "AgrestiCoull", ci.PV = "AgrestiCoull") )
cutoff <- p_cut$MaxProdSpSe$Global$optimal.cutoff$cutoff[1]

# predict discovery and validation cohorts (classes)
p_train_class  <- factor(as.numeric(ifelse(Ytrain_prob <= cutoff, 0, 1)), levels = c(0,1))
p_valid_class  <- factor(as.numeric(ifelse(Yvalid_prob  <= cutoff, 0, 1)), levels = c(0,1))

# Model summary bACC - balanced accuracy, Sensitivity, Specificity
conf_train  <- confusionMatrix(p_train_class, factor(trn_y), "1")
conf_valid  <- confusionMatrix(p_valid_class, factor(val_y), "1")

conf_table <- data.frame( bACC = c( conf_train$byClass[[11]], conf_valid$byClass[[11]] ),
Sensitivity = c( conf_train$byClass[[1]], conf_valid$byClass[[1]] ),
Specificity = c( conf_train$byClass[[2]], conf_valid$byClass[[2]] )
)
conf_table <- t(conf_table)
colnames(conf_table) <- c("discovery", "validation")
conf_table <- round(conf_table, 3)

################################################################################
# Variable importance

var_imp <- xgb.importance(dimnames(dtrain0)[[2]], model = XGB_model_bst)
var_imp <- var_imp[order(var_imp$Gain, decreasing=T),][c(1,3,5,7,8,10,11,13:15),]
var_imp <- as.data.frame(var_imp)
rownames(var_imp) <- var_imp[,1]
var_imp <- var_imp[,-1]

var_imp <- var_imp[order(var_imp$Gain, decreasing=F),]

################################################################################
# ROC analysis
Train_roc <- roc(trn_y, Ytrain_prob)
Train_auc <- lapply(pROC::ci(trn_y, Ytrain_prob), function(x) round(x, 3))

Valid_roc <- roc(val_y, Yvalid_prob)
Valid_auc <- lapply(pROC::ci(val_y, Yvalid_prob), function(x) round(x, 3))

All_roc <- roc(c(trn_y, val_y), c(Ytrain_prob, Yvalid_prob))
All_auc <- lapply(pROC::ci(c(trn_y, val_y), c(Ytrain_prob, Yvalid_prob)), function(x) round(x, 3))

################################################################################
setwd("/media/yuri/Data/home1/GNI_data/infection/ResultsSciRep/Figures/")
pdf("Figure6D.pdf", width=6, height=3.5)

par(mar=c(4,16,1,0.5))
barplot(var_imp[,1], horiz = T, names.arg = rownames(var_imp),
      xlab = "Gain", main = "variable importance",las=1, cex.axis=0.7, cex.names = 0.7)

dev.off()
################################################################################
pdf("Figure6C.pdf", width=6, height=6)

plot(Train_roc, lty = 1, lwd = 2, col=4, type="s")
plot(Valid_roc, add=TRUE, lty = 1, lwd = 2, col=2, type="s")
legend("bottomright", legend =
  c(paste("discovery cohort: AUC = ", Train_auc[[2]], " (", Train_auc[[1]], ", ", Train_auc[[3]], ")", sep=""),
    paste("validation cohort: AUC = ", Valid_auc[[2]], " (", Valid_auc[[1]], ", ", Valid_auc[[3]], ")", sep="")),
lty=1, lwd=2, col=c(2,4), bty="n")

dev.off()
################################################################################

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

trn_res <- data.frame(trueY = trn_y, Yhat = p_train_class, Yp = Ytrain_prob,
  Acc = as.numeric(trn_y == p_train_class), hfd = COVID_pheno$HFD45[train_idx],
  cohort = "discovery")
val_res <- data.frame(trueY = val_y, Yhat = p_valid_class, Yp = Yvalid_prob,
  Acc = as.numeric(val_y == p_valid_class), hfd = COVID_pheno$HFD45[test_idx],
  cohort = "validation")

plot_res <- rbind(trn_res, val_res)
plot_res$shape <- paste0(plot_res$cohort, plot_res$Acc)

p1 <- ggplot(plot_res, aes(y=Yp, x = as.factor(trueY) )) + geom_boxplot(aes(color = as.factor(trueY)), outlier.size=-1) +
geom_hline(yintercept=cutoff) +
geom_jitter(aes(color = as.factor(trueY), shape = shape), size=3, width = 0.1) +
scale_shape_manual(values = c(3,2,4,17)) +
scale_color_manual(values = c("#4591cc", "#21a883")) +
xlab("") + ylab("model score") +
theme_bw() +
theme(text = element_text(size=12),
        axis.text.y = element_text(size=12))

setwd("/media/yuri/Data/home1/GNI_data/infection/ResultsSciRep/Figures/")
ggsave("FigureS12Aleft.pdf", p1, width=4, height=6)


rgbsum <- c(0,0)
resget <- c(0,0)

for(i in 1:num) {
print(i)
a = 0
orgpic=readJPEG(v[i])
		for(j in 1:num) {
		v4rgb <- orgpic[res4a[j],res4b[j],]
		print(v4rgb)
		rgbsum[j] = (v4rgb[1]+v4rgb[2]+v4rgb[3])/3
		print (rgbsum[j])
		print("__")
		a = a+rgbsum[j]
		}
print(a)
resget[i]=a
print("____________")
}

picfun <- function(x){
  for(i in 1:x) {
	print(resget[i])
  }
}

picfun(num)
print("____________")


library(GEOquery)

# get the data from GEO ( GSE matrix & annotation GPL)
# define destination to save data, SO didn't need load data each time
series = "GSE34670"
platform = "GPL96"
gset = getGEO(series, GSEMatrix =TRUE, AnnotGPL=TRUE, destdir = "Data/")
# if the data have several platforms, choose the certain platform
if (length(gset) > 1) idx <- grep(platform, attr(gset, "names")) else idx <- 1
gset = gset[[idx]]

# define groups for samples
gr = c(rep("cALL_BM", 5) , "cALL_PB" ,rep("cALL_BM", 19), "CL_cALL2" , "CL_697" , "CL_NALM6" , rep("CD10", 6), rep("CD10_pool" , 3) )
# elicit expression matrix from data
ex = exprs(gset)

# log2 transformation
ex = log2(ex + 1 )
exprs(gset) = ex

#QC

# normalization check
#boxplot
jpeg("Results/boxplot.jpg")
boxplot(ex)
dev.off()


######### citn07 analysis: look at immune cell gene expressions vs. time and cohort, and perform differential expression analyses

rm(list=ls())
library(ggplot2)
library(pheatmap)
source("source_volcplot.r")

# coloring function
fadecols = function(cols,fade=.5)
{
  fcols = c()
  for(i in 1:length(cols))
  {
    tmp = as.vector(col2rgb(cols[i])/256)
    fcols[i] = rgb(tmp[1],tmp[2],tmp[3],fade)
  }

  return(fcols)
}

#### load normalized data and sample annotation: ####
load("data/CITN07 data ready for analysis October2018.RData")

# use the log-transformed data:
norm = log2norm; rm(log2norm)  #log2(pmax(norm, 1))
#### screen out low-signal genes:
low.expression = names(which(max.counts < 25))
norm = norm[, setdiff(colnames(norm), low.expression)]

### load the module-rene relationships, and format as a gene annotation matrix:
#modules = read.csv("CITN_nano_mod_Gen2_NoHK[3].csv", row.names = 1, stringsAsFactors = F)
#gannot = matrix(0, ncol(norm), length(unique(modules$Function)), dimnames = list(colnames(norm), unique(modules$Function)))
## fill it in:
#for (m in unique(modules$Function)){
#  modgenes = modules$Symbol[modules$Function == m]
#  gannot[is.element(rownames(gannot), modgenes), m] = 1
#}
## remove modules with too few genes to be useful:
#gannot = gannot[, colSums(gannot) >= 10]

##### reformat the gene annotation matrix:
gannot = gannot[match(colnames(norm), rownames(gannot)), ]
gannot = replace(gannot, is.na(gannot), 0)
rownames(gannot) = colnames(norm)

# load additional gene sets:
genesets = read.csv("gene sets.csv", stringsAsFactors = F)
gannot2 = matrix(0, ncol(norm), length(unique(genesets$sig)), dimnames = list(colnames(norm), unique(genesets$sig)))
# fill it in:
for (m in unique(genesets$sig)){
  modgenes = genesets$gene[genesets$sig == m]
  gannot2[is.element(rownames(gannot2), modgenes), m] = 1
}
# remove modules with too few genes to be useful:
gannot2 = gannot2[, colSums(gannot2) >= 3]

gannot = cbind(gannot, gannot2)

######################################
#### calculate cell type signatures: ####
######################################
cellmarkers = read.csv("data/cell type markers.csv",row.names = 1)
# function to calc cell scores from data and marker list:
calc.cellscores = function(e,markers)
{
  cellscores = c()
  cells = unique(markers[,"Cell.Type"])
  for(cell in cells)
  {
    tempgenes = intersect(colnames(e),rownames(markers)[markers[,"Cell.Type"]==cell])
    lostgenes = setdiff(rownames(markers)[markers[,"Cell.Type"]==cell],colnames(e))
    if(length(lostgenes)>0){print(paste0(cell," genes missing:"));print(lostgenes)}
    if(length(tempgenes)>0)
    {
      cellscores = cbind(cellscores,rowMeans(e[,tempgenes,drop=F]))
      colnames(cellscores)[ncol(cellscores)]=cell
    }
  }
  return(cellscores)
}
cellscores = calc.cellscores(norm,cellmarkers)

######################################
#### further transformations of data:
# 1. get mean and se of expression/cell score within each cohort/time
# 2. reformat expression/score matrices as deltas from baselines
# 3. get mean and se of expression/score deltas within each cohort/time
######################################

## combined genes/scores data matrix:
normpluscells = cbind(cellscores, norm)
is.cellscore = c(rep(TRUE, ncol(cellscores)), rep(FALSE, ncol(norm)))

## timepoint/cohort variables:
#timepoints = c("Pre-Tx","C1D22","C3D01","C4D01","FUW04","FUW12")
timepoints = levels(annot$time)
txtimes = paste0(rep(c("cohort1","cohort2"), each=length(timepoints))," ",rep(timepoints,2))
txtimes = setdiff(txtimes, "cohort2 C1D01")
annot$txtime2 = paste0("cohort",annot$cohort," ",annot$time)

# 1. get mean and se of expression/cell score within each time point
# means within each timepoint/cohort
means = matrix(NA,length(txtimes),ncol(normpluscells),dimnames = list(txtimes,colnames(normpluscells)))
for(txtime in txtimes)
{
  means[txtime,] = colMeans(normpluscells[annot$txtime2==txtime,])
}
# ses within each timepoint/cohort:
getse = function(x){return(sd(x,na.rm=T)/sqrt(sum(!is.na(x))))}
ses = matrix(NA, length(txtimes), ncol(normpluscells), dimnames = list(txtimes, colnames(normpluscells)))
for(txtime in txtimes)
{
  ses[txtime,] = apply(normpluscells[annot$txtime2==txtime, ], 2, getse)
}

# 2. define a matrix of each patients' gene expression deltas from baseline:
deltas = normpluscells*NA
for(tp in timepoints)
{
  # only look at the current timepoint's data:
  use = which(annot$time==tp)
  # for each observation, get the mean expression vector of the patient's time0 samples:
  for(i in use)
  {
    pt = annot$patient[i]
    baseline = which((annot$patient==pt)&(annot$time=="baseline"))
    if(length(baseline) > 0){
      deltas[i,] = normpluscells[i,] - colMeans(normpluscells[baseline,,drop=F],na.rm=T)
    }
  }
}

# 3. get the avg (and se) delta from pre-tx within each cohort*time:
meandeltas = matrix(NA, length(txtimes), ncol(normpluscells), dimnames = list(txtimes, colnames(normpluscells)))
for(txtime in txtimes)
{
  meandeltas[txtime,] = colMeans(deltas[annot$txtime2==txtime,],na.rm=T)
}

# and ses of deltas:
sedeltas = matrix(NA,length(txtimes),ncol(normpluscells),dimnames = list(txtimes,colnames(normpluscells)))
for(txtime in txtimes)
{
  sedeltas[txtime,] = apply(deltas[annot$txtime2==txtime,],2,getse)
}

# get indices of cohorts:
inc1 = grepl("cohort1", rownames(means))
inc2 = grepl("cohort2", rownames(means))

######################################
#### trend plot of cells over time:
######################################

#cells = c("B-cells","CD8 T cells","T-cells","Cytotoxic cells","DC","Macrophages","NK cells","Th1 cells","Treg")
#cells = c("B-cells","CD8 T cells","T-cells","Cytotoxic cells","Macrophages","NK cells","Th1 cells","Treg")
#cells = colnames(cellscores)
#cellcols = c("darkblue","orange","gold","chartreuse3","purple","blue","forestgreen","cornflowerblue","red","firebrick","grey50","lightblue","pink","green")[1:length(cells)]
cells = setdiff(colnames(cellscores), "CD45")
cellcols = c("darkblue","orange","chartreuse3","purple","blue","forestgreen","cornflowerblue","red","firebrick","grey50","lightblue","pink","green")[1:length(cells)]
names(cellcols)=cells

svg("manuscript - cells over time v1.svg",width=10)
nudge = 2
#layout(matrix(1:2, nrow = 1), width = c(4,4))
par(mar = c(5.5,4.5,2,1))
par(mfrow = c(1,2))
plot(0,0,xlim=c(1,sum(inc1)+1.5) + c(0,nudge),ylim=range(meandeltas[,cells]), xaxt="n",xlab="",
     ylab="Mean log2 fold-change from baseline",main="cohort1", cex.lab = 1.5)
abline(h=0,col = "grey20", lty = 3, lwd = 2)
axis(1,1:sum(inc1),timepoints,las=2, cex.axis = 1.5)
for(cell in cells)
{
  lines(1:sum(inc1),meandeltas[inc1,cell],col=cellcols[cell],lwd=2)
  text(sum(inc1)+0.5,meandeltas[max(which(inc1)),cell],cell,col=cellcols[cell],cex=1.25)
  # points for changes sig at p=0.05:
  is.sig = (meandeltas[(inc1),cell] - 2*sedeltas[(inc1),cell] > 0)|(meandeltas[(inc1),cell] + 2*sedeltas[(inc1),cell] < 0)
  points((1:sum(inc1))[is.sig],meandeltas[which(inc1)[is.sig],cell],col=cellcols[cell],pch=16,cex=1.5)
}

names(cellcols)=cells
plot(0,0,xlim=c(1,sum(inc2)+1.5) + c(0,nudge),ylim=range(meandeltas[,cells]),xaxt="n",xlab="",
     ylab="",main="cohort2", cex.lab = 1.5)
abline(h=0,col = "grey20", lty = 3, lwd = 2)
axis(1,1:sum(inc2),setdiff(timepoints, "C1D01"),las=2, cex.axis = 1.5)
for(cell in cells)
{
  lines(1:sum(inc2),meandeltas[inc2,cell],col=cellcols[cell],lwd=2)
  text(sum(inc2)+0.5,meandeltas[max(which(inc2)),cell],cell,col=cellcols[cell],cex=1.25)
  # points for changes sig at p=0.05:
  is.sig = (meandeltas[(inc2),cell] - 2*sedeltas[(inc2),cell] > 0)|(meandeltas[(inc2),cell] + 2*sedeltas[(inc2),cell] < 0)
  points((1:sum(inc2))[is.sig],meandeltas[which(inc2)[is.sig],cell],col=cellcols[cell],pch=16,cex=1.5)
}

dev.off()

svg("manuscript - cells over time v2.svg", width=9, height = 6)
par(mar = c(5.6,4.5,2,1))
layout(matrix(1:3, 1, 3), width = c(4,4,3))
plot(0,0,xlim=c(1,sum(inc1)),ylim=range(meandeltas[,cells]), xaxt="n",xlab="",
     ylab="Mean log2 fold-change from baseline",main="cohort1", cex.lab = 1.8)
abline(h=0,col = "grey20", lty = 3, lwd = 2)
axis(1,1:sum(inc1),timepoints,las=2, cex.axis = 1.5)
for(cell in cells)
{
  lines(1:sum(inc1),meandeltas[inc1,cell],col=cellcols[cell],lwd=2)
  #text(sum(inc1)+0.5,meandeltas[max(which(inc1)),cell],cell,col=cellcols[cell],cex=1.25)
  # points for changes sig at p=0.05:
  is.sig = (meandeltas[(inc1),cell] - 2*sedeltas[(inc1),cell] > 0)|(meandeltas[(inc1),cell] + 2*sedeltas[(inc1),cell] < 0)
  points((1:sum(inc1))[is.sig],meandeltas[which(inc1)[is.sig],cell],col=cellcols[cell],pch=16,cex=1.5)
}

names(cellcols)=cells
plot(0,0,xlim=c(1,sum(inc2)),ylim=range(meandeltas[,cells]),xaxt="n",xlab="",
     ylab="",main="cohort2", cex.lab = 1.5)
abline(h=0,col = "grey20", lty = 3, lwd = 2)
axis(1,1:sum(inc2),setdiff(timepoints, "C1D01"),las=2, cex.axis = 1.5)
for(cell in cells)
{
  lines(1:sum(inc2),meandeltas[inc2,cell],col=cellcols[cell],lwd=2)
  #text(sum(inc2)+0.5,meandeltas[max(which(inc2)),cell],cell,col=cellcols[cell],cex=1.25)
  # points for changes sig at p=0.05:
  is.sig = (meandeltas[(inc2),cell] - 2*sedeltas[(inc2),cell] > 0)|(meandeltas[(inc2),cell] + 2*sedeltas[(inc2),cell] < 0)
  points((1:sum(inc2))[is.sig],meandeltas[which(inc2)[is.sig],cell],col=cellcols[cell],pch=16,cex=1.5)
}
par(mar = c(5.6,0,0,0))
frame()
o.legend = order(meandeltas[3,names(cellcols)], decreasing = T)
legend("center", col = c("black", "black", NA, cellcols[o.legend]),
       legend = c("p > 0.05", "p < 0.05", "", names(cellcols)[o.legend]),
       lty = 1, pch = c(NA, 16, NA, rep(NA, length(o.legend))), lwd = 3, bty = "n", cex = 1.5)
dev.off()

### table of cell type results:
#times = as.character(unique(annot$time))
celltable = cbind(cells,
                  paste0(round(meandeltas["cohort1 C1D08", cells], 2),
                 " (",
                  round(sedeltas["cohort1 C1D08", cells], 2),
                  ")"),
                  paste0(round(meandeltas["cohort2 C1D08", cells], 2),
                  " (",
                  round(sedeltas["cohort2 C1D08", cells], 2),
                  ")"))[o.legend, ]
colnames(celltable) = c("Cell score", "Cohort 1 C1D08 log2 fold change from baseline", "Cohort 2 C1D08 log2 fold change from baseline")
write.csv(celltable, file = "cell scores C1D08 results.csv", row.names = F)

#### perform differential expression analyses ####

######
# model delta from baseline within cohort 1
######

# initialize results matrices: e for estimated log2 fold-change; p for p-values:
e = se = p = matrix(NA,ncol(norm),length(levels(annot$time))-1,
               dimnames=list(colnames(norm),setdiff(levels(annot$time),"baseline")))
# at each timepoint, run the model:
for(time in setdiff(levels(annot$time),"baseline"))
{
  use = (annot$cohort=="1")&(is.element(annot$time,c("baseline",time)))
  for(gene in colnames(norm))
  {
    # paired t-test:
    mod = t.test(deltas[(annot$cohort=="1")&(is.element(annot$time,time)),gene])
    e[gene,time] = mod$estimate  #mod[2,1]
    p[gene,time] = mod$p.value   #mod[2,4]
  }
}
# get fdrs:
f = p*NA
for(i in 1:ncol(p)){f[,i]=p.adjust(p[,i], method = "BH")}

# save results for C1D08:
e2 = e[,"C1D08"]
p2 = p[,"C1D08"]
f2 = f[,"C1D08"]
names(e2) = names(p2) = names(f2) = rownames(e)

tmp = cbind(e2,p2,f2)
colnames(tmp) = c("log2 fold-change from baseline","p-value","False Discovery Rate")
write.csv(tmp,file="DE results at C1D08.csv")

# summary of FDR (cohort 1):
table(rowSums(f < 0.05) > 0)
table(rowSums(f[, c("C3D01", "C4D01", "FUW04", "FUW12")] < 0.05) > 0)
table(rowSums(f[, c("C3D01", "C4D01", "FUW04", "FUW12")] < 0.50) > 0)
table(rowSums(p[, c("C3D01", "C4D01", "FUW04", "FUW12")] < 0.05) > 0)

######
# model delta from baseline within cohort 2
######

# initialize results matrices: e for estimated log2 fold-change; p for p-values:
e.c2 = se.c2 = p.c2 = matrix(NA,ncol(norm),length(levels(annot$time))-1,
                    dimnames=list(colnames(norm),setdiff(levels(annot$time),"baseline")))
# at each timepoint, run the model:
for(time in setdiff(levels(annot$time),c("baseline","C1D01")))
{
  use = (annot$cohort=="2")&(is.element(annot$time,c("baseline",time)))
  for(gene in colnames(norm))
  {
    # paired t-test:
    mod = t.test(deltas[(annot$cohort=="2")&(is.element(annot$time,time)),gene])
    e.c2[gene,time] = mod$estimate  #mod[2,1]
    p.c2[gene,time] = mod$p.value   #mod[2,4]
  }
}
# get fdrs:
f.c2 = p.c2*NA
for(i in 1:ncol(p.c2)){f.c2[,i]=p.adjust(p.c2[,i], method = "BH")}
# summary of FDR (cohort 1):
table(rowSums(f.c2 < 0.05, na.rm = T) > 0)

######
# for cohort 2 comparison, model delta from baseline at C1D08:
######
e2.c2 = p2.c2 = c()
for(gene in colnames(norm))
{
  # paired t-test:
  mod = t.test(deltas[(annot$cohort=="2")&(is.element(annot$time,"C1D08")),gene])
  e2.c2[gene] = mod$estimate
  p2.c2[gene] = mod$p.value
}
f2.c2 = p.adjust(p2.c2, method = "BH")
## and exceprt top genes for main body of paper:
top.up = rownames(tmp)[order(-log(p2) * (e2 > 0), decreasing = T)[1:10]]
top.dn = rownames(tmp)[order(-log(p2) * (e2 < 0), decreasing = T)[1:10]]
# calc mean and SE of change from baseline at C1D08:
tempc1 = deltas[(annot$cohort=="1")&(is.element(annot$time,"C1D08")), c(top.up, top.dn)]
tempc2 = deltas[(annot$cohort=="2")&(is.element(annot$time,"C1D08")), c(top.up, top.dn)]

countnotna = function(x) sum(!is.na(x))
genetable = cbind(
  colnames(tempc1),
  paste0(round(colMeans(tempc1, na.rm=T),2 ), " (",
         round(apply(tempc1, 2, sd, na.rm=T) / sqrt(apply(tempc1, 2, countnotna)), 2),
         ")"),
  paste0(round(colMeans(tempc2, na.rm=T),2 ), " (",
         round(apply(tempc2, 2, sd, na.rm=T) / sqrt(apply(tempc2, 2, countnotna)), 2),
         ")")
)
# version with standard errors:
colnames(genetable) = c("Gene", "Cohort 1 C1D08 log2 fold-change from baseline", "Cohort 2 C1D08 log2 fold-change from baseline")
write.csv(genetable, file = "top genes C1D08 results.csv", row.names = F)
# version with p-values:
ttestpval = function(x) {
  mod = t.test(x)
  return(mod$p.value)
}
genetable.p = cbind(
  colnames(tempc1),
  paste0(round(colMeans(tempc1, na.rm=T),2 ), " (p = ",
         signif(apply(tempc1, 2, ttestpval), 2),
         ")"),
  paste0(round(colMeans(tempc2, na.rm=T),2 ), " (p = ",
         signif(apply(tempc2, 2, ttestpval), 2),
         ")")
)
colnames(genetable.p) = c("Gene",
                         "Cohort 1 C1D08 log2 fold-change from baseline (p-value)",
                         "Cohort 2 C1D08 log2 fold-change from baseline (p-value)")
write.csv(genetable.p, file = "top genes C1D08 results with p-value.csv", row.names = F)
# volc plot:
#svg("volcanos - cohort 1 timepoints.svg",height=4*ncol(e),width=7)
#drawvolc(estmat=e,pvalmat=p,fdrmat=f,genesets=gannot,is.score = FALSE)
#dev.off()

svg("C1D08 volcano plot.svg", width = 10)
par(mfrow = c(1,2))
par(mar = c(14,4.5,2,0))
# genes to highlight: FDR < 0.05
top = f2<0.05
show.text = f2<0.05

plot(e2, -log10(p2),pch=16, cex = 0.5,col=c(rgb(0,0,0,.5),"white")[1 + show.text],
     xlab=paste0("  \n\nlog2 fold-change\nC1D08 vs. Pre-treatment"),
     ylab = "-log10(p-value)",cex.lab=1.2)
     #main="cohort 1: C1D08 vs. baseline",ylab="-log10(p-value)",cex.lab=1.5)
# text for top 50:
text(e2[show.text],-log10(p2[show.text]),colnames(norm)[show.text],cex=.5,col=c("darkblue","firebrick")[1+(e2[show.text]>0)])  #aquamarine4
# draw lines for FDR cutoffs:
fdr.cutoff = 0.05 #c(0.5,0.1,0.05)
abline(h=-log10(max(p2[f2<fdr.cutoff])),lty=2)
abline(h=-log10(max(p2[f2<0.5])),lty=3)
legend("bottomright",lty=2:3,legend = paste0("FDR = ",c(fdr.cutoff, 0.5)))
#legend("bottomright",lty=1:length(fdr.cutoffs),legend = paste0("FDR = ",fdr.cutoffs))

## now run gene set analysis:
genesets = gannot
# summary stat for each gene set: mean -log10(pval)
genesetscore = c()
for(geneset in colnames(genesets))
{
  tempgenes = intersect(rownames(genesets)[genesets[,geneset]==1],colnames(norm))
  genesetscore[geneset] = mean(-log10(p2[tempgenes]))
}
# identify the top 5 gene sets:
#top5 = names(genesetscore)[order(genesetscore,decreasing = T)[1:30]]
## selected gene set scores based on biological interest:
top5 = c("MHC2","APM","immunoproteasome","TLR","Cytokines","Myleoid.inflam","IFN.downstream","myleoid","lymphoid","NK.Cell.Functions","T.Cell.Functions")
top5.altnames = top5; names(top5.altnames) = top5
top5.altnames["MHC2"] = "Antigen processing by MHC2"
top5.altnames["APM"] = "Antigen processing by MHC1"
top5.altnames["immunoproteasome"] = "Immunoproteasome"
top5.altnames["myleoid"] = "Myeloid compartment"
top5.altnames["lymphoid"] = "Lymphoid compartment"
top5.altnames["TLR"] = "Toll Like Receptors"
top5.altnames["IR.Innate"] = "Innate immunity"
top5.altnames["Cytokines"] = "Cytokines"
top5.altnames["Myleoid.inflam"] = "Myeloid inflammatory"
top5.altnames["IFN.downstream"] = "Interferon downstream"
top5.altnames["NK.Cell.Functions"] = "NK cell functions"
top5.altnames["T.Cell.Functions"] = "T cell functions"

# now plot the gene sets' -log10 pvals:
par(mar = c(14,1,2,1))
plot(c(0,0),col=0,xlim=c(0.5,length(top5)+0.5),ylim=range(-log10(p2)),xaxt="n",xlab="", yaxt="n", ylab = "")#,ylab="-log10(p-value)", cex.lab = 1.2)
bp = 1:length(top5)
#bp = barplot(genesetscore[top5],col=rgb(0,0,0,.1),ylim=ylim,xaxt="n",xlab="",ylab="-log10(p-value)",border = F,main="Gene set results")
axis(1,at = bp,labels = top5.altnames[top5],las=2)
abline(h=-log10(max(p2[f2<fdr.cutoff])),lty=2)
abline(h=-log10(max(p2[f2<0.5])),lty=3)

abline(v = bp,col="grey80")
for(i in 1:length(top5))
{
  geneset = top5[i]
  rect(bp[i]-.4,0,bp[i]+.4,genesetscore[geneset],col=rgb(0,0,0,.5),border = F)
  tempgenes = intersect(rownames(genesets)[genesets[,geneset]==1],names(p2))
  text(rep(bp[i],length(tempgenes)),-log10(p2[tempgenes]),tempgenes,cex=0.5,
       col = c("darkblue","firebrick")[1+(e2[tempgenes]>0)])
  #col = c(rgb(0,0,1,0.7),rgb(1,0,0,0.7))[1+(e2[tempgenes]>0)])
}
dev.off()

#### heatmap of cohort 1 DE results:

# data to show: estimated fold-changes, but only where fdr< 0.5
mat = e*(p<0.05)
#mat = cbind(0, mat)
#colnames(mat)[1] = "Pre-tx"
mat = mat[rowSums(abs(mat))>0, ]
clust = hclust(dist(mat))
svg("DE heatmaps sideways.svg", height = 3, width = 6, onefile = F)
#pheatmap(mat[order(mat[,"C1D08"]), ], cluster_cols = F, cluster_rows = F,
pheatmap(t(mat[as.character(clust$labels[clust$order]), ]), cluster_cols = F, cluster_rows = F,
         color = colorRampPalette(c("blue","white","red"))(101),
         breaks = seq(-max(abs(mat)),max(abs(mat)),length.out = 100),
         show_colnames = F, main = "Mean log2 fold-changes from baseline, cohort 1")
dev.off()
svg("DE heatmaps.svg", height = 8, width = 4, onefile = F)
pheatmap(mat[as.character(clust$labels[clust$order]), ], cluster_cols = F, cluster_rows = F,
         color = colorRampPalette(c("blue","white","red"))(101),
         breaks = seq(-max(abs(mat)),max(abs(mat)),length.out = 100),
         show_rownames = F) #, main = "Mean log2 fold-changes from baseline, cohort 1")
#gannot.show = c("MHC2","myleoid","lymphoid")
#pheatmap(gannot[clust$labels[clust$order], gannot.show], cluster_cols = F, cluster_rows = F,
#         show_rownames = F, col = c("white","darkblue"))
dev.off()

####  trendplots:
# individual genes: CD74, HLA-DRA, HLA-DPB1, FLT3LG, FLT3, CD1D
# signatures: MHC2, TLRs

### calculate scores:
#scores = data.frame(rowMeans(norm[, rownames(gannot)[gannot[, "MHC2"]==1]]))
scores = data.frame(rowMeans(norm[, setdiff(rownames(gannot)[gannot[, "MHC2"]==1], "HLA-DQB1")]))
colnames(scores)[1] = "MHC2"
scores$APM = rowMeans(norm[, rownames(gannot)[gannot[, "APM"]==1]])
scores$TLR = rowMeans(norm[, rownames(gannot)[gannot[, "TLR"]==1]])

svg("spaghetti plots.svg", width = 10, height = 10)
# genes:
par(mfrow=c(3,3))
name = "HLA-DMA";trendplot(x=norm[,name],ylab=name,patient=annot$patient,groups=annot$time,pointcols=annot$cohortcol)
#name = "IFI27";trendplot(x=norm[,name],ylab=name,patient=annot$patient,groups=annot$time,pointcols=annot$cohortcol)
name = "IL13RA1";trendplot(x=norm[,name],ylab=name,patient=annot$patient,groups=annot$time,pointcols=annot$cohortcol)
name = "CD74";trendplot(x=norm[,name],ylab=name,patient=annot$patient,groups=annot$time,pointcols=annot$cohortcol)
name = "FLT3LG";trendplot(x=norm[,name],ylab=name,patient=annot$patient,groups=annot$time,pointcols=annot$cohortcol)
name = "FLT3";trendplot(x=norm[,name],ylab=name,patient=annot$patient,groups=annot$time,pointcols=annot$cohortcol)
name = "SIGLEC1";trendplot(x=norm[,name],ylab=name,patient=annot$patient,groups=annot$time,pointcols=annot$cohortcol)
name = "CD1C";trendplot(x=norm[,name],ylab=name,patient=annot$patient,groups=annot$time,pointcols=annot$cohortcol)
name = "CD1D";trendplot(x=norm[,name],ylab=name,patient=annot$patient,groups=annot$time,pointcols=annot$cohortcol)

# scores:

name = "MHC2";trendplot(x=scores[,name],ylab="mean of HLA-DRA, -DPB1, -DMA, -DPA1",
                        patient=annot$patient,groups=annot$time,pointcols=annot$cohortcol)
#name = "APM";trendplot(x=scores[,name],ylab=top5.altnames[name],patient=annot$patient,groups=annot$time,pointcols=annot$cohortcol)
#name = "TLR";trendplot(x=scores[,name],ylab=top5.altnames[name],patient=annot$patient,groups=annot$time,pointcols=annot$cohortcol)
dev.off()

NanoString_cell_scores_and_differential_expression/cell_scores_and_differential_expression - old version.r


options(warn = -1) #ignore warnings

# IMPORTANT: This assumes that all packages in "Rstart.R" are installed,
# and the fonts "Source Sans Pro" and "Open Sans Condensed Bold" are installed
# via extrafont. If ggplot2 charts fail to render, you may need to change/remove the theme call.

source("Rstart.R")
library(ggmap)

sessionInfo()

#CDC information FLU
#devtools::install_github("hrbrmstr/cdcfluview")

library(cdcfluview)
library(statebins)
# current verison
# packageVersion("cdcfluview")

#df.flu <- get_flu_data(region = "census", sub_region = 1:9, data_source = "all", years = 2008:2015)
#df.flu.census <- get_flu_data(region = "census", sub_region = 1:10, data_source = "ilinet", years = 2008:2015)

# I am looking at the ILI activity
df.state <- get_state_data(years=2010:2015)

#display the data
#df.flu %>% head(10)
#sprintf("# of Rows in Dataframe: %s", nrow(df.flu))
#sprintf("Dataframe Size: %s", format(object.size(df.flu), units = "MB"))

#display the data
df.state %>% head(10)
sprintf("# of Rows in Dataframe: %s", nrow(df.state))
sprintf("Dataframe Size: %s", format(object.size(df.state), units = "MB"))

#display the data
#df.flu.census %>% head(10)
#sprintf("# of Rows in Dataframe: %s", nrow(df.flu.census))
#sprintf("Dataframe Size: %s", format(object.size(df.flu.census), units = "MB"))

#columns = c("REGION TYPE","REGION","YEAR","WEEK","AGE 0-4","AGE 25-49","AGE 25-64","AGE 5-24","AGE 50-64","AGE 65","ILITOTAL","TOTAL PATIENTS")

columns = c("statename","activity_level","activity_level_label","weekend", "season", "weeknumber")

# select() require column indices that we find trough which()

df <- df.state %>% select(which(names(df.state) %in% columns))

df %>% head(10)
sprintf("# of Rows in Dataframe: %s", nrow(df))
sprintf("Dataframe Size: %s", format(object.size(df), units = "MB"))

proper_case <- function(x) {
    return (gsub("\\b([A-Z])([A-Z]+)", "\\U\\1\\L\\2" , x, perl = TRUE))
}

file <- "data/state-lat-long.csv"
df_state_location <- read_csv(file)
colnames(df_state_location)[1] <- 'statename'

df.location <- tbl_df(df_state_location)

df <- right_join(df,df_state_location) #join the dataframe yeah

#save the dataframe
write_csv(df, path = "data/train.csv")

df %>% head(10)
sprintf("# of Rows in Dataframe: %s", nrow(df))

# grepl() is the best way to do in-text search
#df_flu <- df %>% filter(grepl("Local Activity", ACTIVITYESTIMATE))

df.flu.activity <- df %>% filter(activity_level > 0)
df.flu.activity %>% head(10)
sprintf("# of Rows in Dataframe: %s", nrow(df.flu.activity))
sprintf("Dataframe Size: %s", format(object.size(df.flu.activity), units = "MB"))

 as.Date("May-17-2014","%b-%d-%Y")

df.flu.weekend <-   df.flu.activity %>%
                    mutate(weekend = as.Date(weekend,"%b-%d-%Y")) %>% #convert to proper date for analysis
                    group_by(weekend) %>%
                    summarize(count = n()) %>%
                    arrange(weekend)

df.flu.weekend %>% head(10)

plot <- ggplot(df.flu.weekend, aes(x = weekend, y = count)) +
    geom_line(color = "#F2CA27", size = 0.1) +
    geom_smooth(color = "#1A1A1A") +
    fte_theme() +
    scale_x_date(breaks = date_breaks("2 years"), labels = date_format("%Y")) +
    labs(x = "Weekend of the obseration", y = "Count of weekly activity > 0 "
         , title = "Weekly ILI Activity in the US from 2015 - 2017")

max_save(plot, "US-ILI-when-1", "US CDC Fluview Data")

# Returns the numeric hour component of a string formatted "HH:MM", e.g. "09:40" input returns 9
get_month <- function(x) {
    date <- as.Date(x, "%b-%d-%Y") #format the data to date
    month <- format(date, "%b") # return the month
    return (month)
}

df.flu.time <- df.flu.activity %>%
                    mutate(month = sapply(weekend, get_month)) %>%
                    group_by(month, season) %>%
                    summarize(count = n())

df.flu.time %>% head(10)
sprintf("# of Rows in Dataframe: %s", nrow(df.flu.time))
sprintf("Dataframe Size: %s", format(object.size(df.flu.time), units = "MB"))

month_format <- c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")
season_format <- c("2010-11","2011-12","2012-13","2013-14","2014-15","2015-16")

df.flu.time$month <- factor(df.flu.time$month, level = rev(month_format))
df.flu.time$season <- factor(df.flu.time$season, level = rev(season_format))

df.flu.time %>% head(10)

plot <- ggplot(df.flu.time, aes(x = month, y = season, fill = count)) +
    geom_tile() +
    fte_theme() +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.6),
          legend.title = element_blank(), legend.position="top",
          legend.direction="horizontal", legend.key.width=unit(2, "cm"),
          legend.key.height=unit(0.25, "cm"), legend.margin=unit(0.1,"cm"),
          panel.margin=element_blank()) +
    labs(x = "Season of ILI activity ", y = "Month",
         title = "# of ILI activity in U.S. from 2010 - 2015, by Season") +
    scale_fill_gradient(low = "white", high = "#27AE60", labels = comma)

max_save(plot, "US-ILI-when-2", "US CDC Fluview Data", w=6)

df.flu.type <- df.flu.activity %>%
                    group_by(activity_level_label) %>%
                    summarize(count = n()) %>%
                    arrange(desc(count))

df.flu.type %>% head(20)
sprintf("# of Rows in Dataframe: %s", nrow(df.flu.type))


# Plot traffic data

mainpath = "D:/Dropbox/GitBit/recurrency-modelling2/dat/UKTraffic/"

getdata <- function(flnm){
  data <- read.csv(flnm, header = FALSE, sep = ",")
  colnames(data) <- c("Date","Traffic")
  data
}
#dat = getdata(paste(mainpath, "internet-traffic-data-in-bits-5min.csv", sep=""))
#mt <- read.table("D:/DATASETS/UKTraffic/labels.txt", header = TRUE, sep = ",")
#abline(v = mt$ID, col = "red")

#changes = read.table(paste(mainpath, "TrueChanges.txt", sep = ""), header = FALSE)$V1

pdf(file = "D:/_tmp/20150423/TrafficData.pdf", width = 2 * 5, height = 5)
par(mfrow = c(2,1))
par(mar = c(2, 4, 0.5, 2))
plot(dat$Traffic, cex = 0.7, type = 'l',
     #xlab = "Time in time units (1 time unit == 5 min)",
     cex.main = 0.8, cex.lab = 0.7, cex.axis = 0.7, ann = FALSE)
#mtext(side = 1, text = "Time", line = 2)
mtext(side = 2, text = "Traffic in bits", line = 2, cex = 2)
#mtext(side = 3, text = "Aggregated traffic in the United Kingdom academic network backbone.", line = 1, cex = 1.5)
abline(v = changes, lty = 2)

par(mar = c(5, 4, 1, 2))
plot(dat$Traffic, xlim = c(5000, 1000), cex = 0.7, type = 'l',
     cex.main = 0.8, cex.lab = 0.7, cex.axis = 0.7, ann = FALSE)
mtext(side = 1, text = "Time (1 time unit == 5 min)", line = 3, cex = 2)
mtext(side = 2, text = "Traffic in bits", line = 2, cex = 2)
abline(v = changes, lty = 2)
dev.off()


##############################################################################
# Create figures
##############################################################################
nrsq <- expression(
	paste("Fraction of variance explained (Nagelkerke ", R^2, ")", sep=""))

# Define common theme for Nagelkerke R^2 plots
theme_nrsq <- function(base_size = 12, base_family = ""){
  theme_bw(base_size = base_size) %+replace%
  theme(legend.text=element_text(size=14),
    axis.title.x=element_blank(),
    axis.title.y=element_text(size=16, angle=90),
    axis.text.x=element_blank(),
    axis.text.y=element_text(size=14))
}

rsq_full_dat <- combineddat %>%
  # filter(mod %in% mod[1:5])
	filter(mod %in% mod[1:6])

rsq_full_dat <- combineddat[1:6,]

Lv7v5v3_full <- ggplot(rsq_full_dat, aes(x=category, y=rsq, fill=mod))+
  geom_bar(stat="identity", position="dodge")+
	# scale_fill_manual("Model", values=c(iwhPalette[c(1,3,4,5,9)]))+
	scale_fill_manual("Model", values=c(iwhPalette[c(1,3,4,5,9,10)]))+
	theme_nrsq()+
	ylab(nrsq)
# ggsave(paste0(parentdir, "/images/Lv7v5v3_rsq_full.png"), width=4, height=6)

fd2 <- fulldat %>%
	filter(mod %in% paste0("logmod", c(3,5,7,"L")))

fd3 <- fd2 %>%
	dplyr::select(-aic) %>%
	spread(mod, rsq)

fd3$fold<-fd3[,5]/fd3[,4]
fd3$fold2<-fd3[,5]/fd3[,3]

buildSegmentData <- function(){
	ngroups <- 9
	nmodels <- 4
	nbars <- ngroups*nmodels

	st_once <- c(seq(1, nbars, nmodels), seq(nmodels, nbars, nmodels))
	st_twice <- setdiff(1:nbars, st_once)
	st_selection <- sort(c(st_once, rep(st_twice, each=2)))

	end_none <- seq(1, nbars, nmodels)
	end_twice <- setdiff(1:nbars, end_none)
	end_selection <- sort(c(rep(end_twice, each=2)))

	vertst <- sort(c(rep(c(1:ngroups-1/9), each=2),
		rep(c(1:ngroups+1/9), each=2),
		c(1:ngroups+1/3),
		c(1:ngroups-1/3)))
	vertend <- vertst

	horizst <- sort(c(
		c(1:ngroups-1/3),
		c(1:ngroups-1/9),
		c(1:ngroups+1/9)))
	horizend <- sort(c(
		c(1:ngroups-1/9),
		c(1:ngroups+1/9),
		c(1:ngroups+1/3)))

	# Build data for geom_segment call in plot
	corplot<-data.frame(
		xst=vertst,
	  xend=vertend,
	  yst=fd2$rsq[st_selection]+.001,
	  yend=fd2$rsq[end_selection]+.01)

	corplot2 <- data.frame(
		xst=horizst,
	  xend=horizend,
	  yst=fd2$rsq[unique(end_selection)]+.01,
	  yend=fd2$rsq[unique(end_selection)]+.01,
	  pval=signif(lrtestdat$pvals, 2))

	corplot2$pval <- ifelse(corplot2$pval<0.001, "***",
		ifelse(corplot2$pval<0.01, "**", ifelse(corplot2$pval<0.05, "*", " ")))

	out <- list()
	out$corplot <- corplot
	out$corplot2 <- corplot2
  return(out)
}

segment_data <- buildSegmentData()
corplot <- segment_data$corplot
corplot2 <- segment_data$corplot2

# Plot pseudo-r^2 for 7-mers vs 5-mers vs 3-mers
rsqdat <- fd2 %>%
  # fulldat %>%
  # filter(mod %in% c("7-mers", "5-mers", "3-mers", "7-mers+features")) %>%
  filter(group=="FULL") %>%
  mutate(Category =
      factor(plyr::mapvalues(category, orderedcats2, orderedcats2),
				levels=orderedcats2))

Lv7v5v3 <- ggplot(rsqdat)+
  geom_bar(aes(x=Category, y=rsq, fill=mod), stat="identity", position="dodge")+
  # scale_fill_manual("Model", values=cbbPalette[c(4,6,7,8)])+
	scale_fill_manual("Model", values=c(iwhPalette[c(3,4,5,9)]))+
  geom_segment(data=corplot, aes(x=xst, xend=xend, y=yst, yend=yend))+
  geom_segment(data=corplot2, aes(x=xst, xend=xend, y=yst, yend=yend))+
  geom_text(data=corplot2,
		aes(x=xst+1/9, y=yst+.005, label=pval, angle=90), size=6)+
  scale_y_continuous(limits=c(0,0.1))+
  theme_bw()+
  theme(legend.text=element_text(size=14),
    axis.title.x=element_text(size=16),
    axis.title.y=element_text(size=16),
    axis.text.x=element_text(size=14, angle=45, hjust=1, vjust=1),
    axis.text.y=element_text(size=14))+
  xlab("Mutation Type")+
  ylab(nrsq)
# ggsave(paste0(parentdir, "/images/Lv7v5v3_rsq.png"), width=12, height=6)

Lv7v5v3_full <- ggplotGrob(Lv7v5v3_full)
Lv7v5v3 <- ggplotGrob(Lv7v5v3)

g <- arrangeGrob(Lv7v5v3_full, Lv7v5v3, nrow=1, widths=c(1,2))
ggsave(paste0(parentdir, "/images/Lv7v5v3_rsq_combined.svg"),
	width=12, height=6, g)

# Plot pseudo-r^2 for 7-mers vs logit
rsqdatL <- fulldat %>%
  filter(mod=="7-mers" | mod=="7-mers+features") %>%
  filter(group=="FULL") %>%
  mutate(Category =
      factor(plyr::mapvalues(category, orderedcats2, orderedcats2),
				levels=orderedcats2))

ggplot(rsqdatL)+
  geom_bar(aes(x=Category, y=rsq, fill=mod),
		stat="identity", position="dodge")+
  scale_fill_manual("Model", values=cbbPalette[c(7,8)])+
	theme_nrsq()+
	ylab(nrsq)+
  xlab("Mutation Type")
ggsave(paste0(parentdir, "/images/7v5v3_rsqL.png"), width=12, height=6)

# Plot pseudo-r^2 for ERVs vs Common
rsqdatEC <- fulldat %>%
	filter(mod=="AV" | mod=="Common" | mod=="ERVs") %>%
  filter(group=="FULL") %>%
  mutate(Category =
      factor(plyr::mapvalues(category, orderedcats2, orderedcats2),
				levels=orderedcats2))
ggplot(rsqdatEC)+
	geom_bar(aes(x=Category, y=rsq, fill=mod),
		stat="identity", position="dodge")+
	scale_fill_manual("Model", values=c("grey30", cbbPalette[c(3,7)]))+
	theme_bw()+
	theme(legend.text=element_text(size=14),
		axis.title.x=element_text(size=16),
		axis.title.y=element_text(size=16),
		axis.text.x=element_text(size=14, angle=45, hjust=1, vjust=1),
		axis.text.y=element_text(size=14))+
	xlab("Mutation Type")+
  ylab(nrsq)
ggsave(paste0(parentdir, "/images/AvCvS_rsq.png"), width=12, height=6)

oldmodnames <- unique(fulldat$mod)

newmodnames <- c("3-mers", "5-mers", "7-mers", "7-mers+features",
	"7-mers (downsampled BRIDGES ERVs)",
	"7-mers (BRIDGES MAC10+ variants)",
	"7-mers (1KG EUR intergenic variants)")

newmodnamesord <- c("3-mers", "5-mers", "7-mers",
	"7-mers (downsampled BRIDGES ERVs)",
	"7-mers (BRIDGES MAC10+ variants)",
	"7-mers (1KG EUR intergenic variants)",
	"7-mers+features")

rsqdatFULL <- fulldat %>%
  filter(group=="FULL") %>%
  mutate(Category =
      factor(plyr::mapvalues(category, orderedcats2, orderedcats2),
				levels=orderedcats2)) %>%
	mutate(mod=
		factor(plyr::mapvalues(mod, oldmodnames, newmodnames),
			levels=newmodnamesord))

alldat <- combineddat[2:8,] %>%
	mutate(mod=factor(plyr::mapvalues(mod, oldmodnames, newmodnames),
		levels=newmodnamesord))

all_full <- ggplot(alldat)+
  geom_bar(aes(x=category, y=rsq, fill=mod),
		stat="identity", position="dodge")+
	scale_fill_manual("Model", values=c(iwhPalette[c(3:9)]))+
  theme_nrsq(legend.position="none")+
  ylab(nrsq)

all <- ggplot(rsqdatFULL)+
  geom_bar(aes(x=Category, y=rsq, fill=mod),
		stat="identity", position="dodge")+
	scale_fill_manual("Model", values=c(iwhPalette[c(3:9)]))+
  theme_bw()+
  theme(
      legend.text=element_text(size=14),
			legend.position=c(0.4,0.7),
			legend.background = element_rect(colour = "black"),
      axis.title.x=element_text(size=16),
      axis.title.y=element_text(size=16),
    axis.text.x=element_text(size=14, angle=45, hjust=1, vjust=1),
      axis.text.y=element_text(size=14))+
  xlab("Mutation Type")+
  ylab(nrsq)

all_full <- ggplotGrob(all_full)
all <- ggplotGrob(all)
g <- arrangeGrob(all_full, all, nrow=1, widths=c(1,2))
ggsave(paste0(parentdir, "/images/all_rsq_combined.png"), width=12, height=6, g)

evcdat <- rsqdatFULL %>%
	filter(grepl("BRIDGES", mod))
EvC <- ggplot(evcdat)+
  geom_bar(aes(x=Category, y=rsq, fill=mod),
		stat="identity", position="dodge")+
  # scale_fill_manual("Model", values=brewer.pal(8, "Set3")[5:6])+
	scale_fill_manual("Model",
		values=c(iwhPalette[c(6,7)]),
		guide = guide_legend(nrow=2))+
  theme_bw()+
  theme(
      legend.text=element_text(size=14),
			legend.position="bottom",
      axis.title.x=element_text(size=16),
      axis.title.y=element_text(size=16),
    axis.text.x=element_text(size=14, angle=45, hjust=1, vjust=1),
      axis.text.y=element_text(size=14))+
  xlab("Mutation Type")+
  ylab(nrsq)
# ggsave(paste0(parentdir, "/images/EvC_rsq.png"), width=12, height=6)

EvC_full_dat <- combineddat %>%
  # filter(mod=="AV" | mod=="Common" | mod=="ERVs") %>%
	filter(mod=="Common" | mod=="ERVs") %>%
	mutate(mod=plyr::mapvalues(mod, c("Common", "ERVs"),
		c("7-mers (BRIDGES MAC10+ variants)", "7-mers (downsampled BRIDGES ERVs)"))) %>%
# combineddat %>%
  # filter(mod=="AV" | mod=="Common" | mod=="ERVs") %>%
	# filter(mod=="Common" | mod=="ERVs") %>%
	mutate(mod=factor(plyr::mapvalues(mod, oldmodnames, newmodnames),
		levels=newmodnamesord)) %>%
	filter(grepl("BRIDGES", mod))

EvC_full <- ggplot(EvC_full_dat)+
  geom_bar(aes(x=category, y=rsq, fill=mod), stat="identity", position="dodge")+
  # scale_fill_manual("Model", values=brewer.pal(8, "Set3")[5:6])+
	scale_fill_manual("Model", values=c(iwhPalette[c(6,7)]))+
	theme_nrsq()+
  ylab(nrsq)
# ggsave(paste0(parentdir, "/images/EvC_rsq_full.png"), width=8, height=6)

EvC_full <- ggplotGrob(EvC_full)
EvC <- ggplotGrob(EvC)
g <- arrangeGrob(EvC_full, EvC, nrow=1, widths=c(1,2))
ggsave(paste0(parentdir, "/images/EvC_rsq_combined.png"), width=12, height=8, g)


pdf_file<-"pdf/tablecharts_symbol_signs.pdf"
cairo_pdf(bg="grey98",pdf_file,width=9,height=4)

par(omi=c(0.5,0.25,0.5,0.25),mai=c(0,0,0,0),family="Lato Light",cex=1.2)

# Import data

library(gdata)
myData<-read.xls("myData/leaking_pipeline.xlsx", encoding="latin1")
attach(myData)

# Create graphics

b1<-barplot(Men+75,horiz=T,xlim=c(-175,175),border=NA,col="gainsboro",axes=F)
barplot(-Women-75,horiz=T,border=NA,add=T,col="gainsboro",axes=F)
barplot(rep(75,5),horiz=T,border=par("bg"),add=T,col=par("bg"),axes=F)
barplot(rep(-75,5),horiz=T,border=par("bg"),add=T,col=par("bg"),axes=F)
abline(v=seq(-175,195,by=10),col=par("bg"))
text(0,b1,Level)

# Titling

mtext("The 'Leaky Pipeline' 2005",3,line=0.25,adj=0,cex=1.75,family="Lato Black",outer=T)
mtext("Source: Wissenschaftsrat, Drucksache Drs. 8036-07.",1,line=0.25,adj=1.0,cex=0.65,outer=T,font=3)

# Symbols

par(family="Symbol Signs")
for (i in 1:5)
{
MyMen_Number<-Men[i]
text(seq(10,10*round(MyMen_Number/10),by=10)+73.5,rep(b1[i],5),rep("M",MyMen_Number),
	cex=2.75,col="cornflowerblue")
MyWomen_Number<-Women[i]
text(-seq(10,10*round(MyWomen_Number/10),by=10)-68,rep(b1[i],5),rep("F",MyWomen_Number),
	cex=2.75,col="deeppink")
}

par(family="Lato Bold")
text(55,b1,paste(Men, "%", sep=" "))
text(-55,b1,paste(Women, "%", sep=" "))
dev.off()


tab <- read.table("../../d5/metaphlan2_unpair_merge_Species_d5.txt",sep="\t",header = T,row.names = 7)
tab <- tab[,-c(1:6)]

T_ID <- colnames(tab)[grep("T",colnames(tab))]
G_ID <- colnames(tab)[grep("G",colnames(tab))]

T_tab <- tab[,T_ID]
G_tab <- tab[,G_ID]

minus_tab <- (T_tab>0) - (G_tab>0)

plot_data <- data.frame(ID=gsub("T","",colnames(minus_tab)),Tongue=colSums(minus_tab==1),Fluid=colSums(minus_tab==-1),Both= colSums((T_tab>0) & (G_tab>0)))

library(ggplot2)
library(reshape2)

plot_data2 <- melt(plot_data)
colnames(plot_data2) <- c("ID","site","num")
plot_data2$site <- factor(plot_data2$site,levels = c("Tongue","Both","Fluid"))
ggplot(plot_data2,aes(ID,num))+
  geom_col(aes(fill=site), width = 0.75)+
  theme_bw()+
  scale_fill_manual(values=c("Tongue"="indianred1","Fluid"="cadetblue","Both"="darkolivegreen"))+
  theme(panel.grid=element_blank(),axis.text.x=element_text(angle = 90),text = element_text(size=20))+
  ggsave("richness_overlap_species_num_overlap_d5.pdf",width = 10,height = 6)

richness_overlap_tab <- plot_data
richness_overlap_tab$overlap_ratio_of_gastric <- plot_data$Both / (plot_data$Both + plot_data$Fluid)
write.table(richness_overlap_tab,file="richness_overlap_tab.txt",quote = F,sep = "\t",row.names = F)


pacman::p_load(
  tidyverse,
  tidymodels,
  here,
  ggthemes,
  lykkelib
)

# plot performance from short episodes
# source(here("markdown", "performance_short.r"))

# plot performance from all episodes
# source(here("markdown", "performance_all.r"))

all_metrics <- read_rds(here("data", "all_metrics_60.rds"))

# performance on all episode lengths --------------------------------------

plot_short <-
  all_metrics %>%
  filter(.metric != "accuracy") %>%
  replace_na(replace = list(.estimate = 0)) %>%
  mutate(
    model = fct_relevel(model, c("syed_cnn", "sunda_rf", "tree_no_temp", "tree_imp6", "tree_full", "cz_60", "heuristic")),
    .metric = fct_relevel(.metric, c("precision", "sensitivity", "f_meas")),
    model = fct_reorder(model, .estimate)
  ) %>%
  ggplot(aes(model, .estimate, fill = dataset)) +
  geom_col(
    width = .75,
    alpha = .8,
    # color = "grey50",
    position = position_dodge(width = .8)
  ) +
  geom_text(aes(model, .estimate + .05,
                label = round(.estimate, 2)
  ),
  size = 3,
  position = position_dodge(width = .8)
  ) +
  expand_limits(y = c(0, 1.2)) +
  scale_fill_manual(
    values = c("#E8C15F", "lightblue", "#7CB07C"),
    labels = c("Hip", "Thigh", "Wrist")
  ) +
  # lykkelib::scale_fill_lykke() +
  labs(
    title = NULL,
    x = NULL,
    y = NULL,
    fill = NULL,
  ) +
  facet_wrap(~.metric,
             labeller = labeller(.metric = c(
               precision = "Precision",
               sensitivity = "Sensitivity",
               accuracy = "Accuracy",
               f_meas = "F1 score"
             )),
             nrow = 4
  ) +
  theme_bw() +
  theme(
    panel.border = element_rect(linetype = 1, size = .3),
    # axis.text.x = element_text(angle = 45, vjust = .65),
    legend.position = "bottom",
    # panel.spacing = unit(1, "lines"),
    strip.text.x = element_text(size = 12),
    strip.text.y = element_blank(),
    strip.background = element_blank()
  )

# ggsave(filename = here("figures", "performance_all_episodes.tiff"), plot = p1, dpi = 600, height = 8, width = 12)
# ggsave(filename = here("figures", "performance_short_episodes.tiff"), plot = p1, dpi = 600, height = 8, width = 12)


city <- read.table("census-city.txt", sep = "|", stringsAsFactors = F, na = "X")

has_comma <- function(x) length(grep(",", x)) > 0
comma_cols <- sapply(city, has_comma)
strip_comma <- function(x) as.numeric(gsub(",", "", x))

city[comma_cols] <- lapply(city[comma_cols], strip_comma)
city$V3 <- as.numeric(city$V3)
city$V13 <- as.numeric(city$V13)

fields <- read.table("census-city.flds", sep = "|", stringsAsFactors = F)
names(city) <- fields$V2

firms <- grep("firms", names(city))
city[firms] <- lapply(city[firms], as.numeric)

write.table(city, "census-city.csv", sep=",", row=F)


##CTE534_Gráficos=group
##Imagen=raster
##Banda1=number 1
##Banda2=number 2
##Banda3=number 3
##Banda4=number 4
##showplots
par(mfrow =c(2,2))
plot(Imagen[[Banda1]], main = names(Imagen[[Banda1]]), col = gray(0:100 / 100))
plot(Imagen[[Banda2]], main = names(Imagen[[Banda2]]), col = gray(0:100 / 100))
plot(Imagen[[Banda3]], main = names(Imagen[[Banda3]]), col = gray(0:100 / 100))
plot(Imagen[[Banda4]], main = names(Imagen[[Banda4]]), col = gray(0:100 / 100))


library(dash)
library(dashCoreComponents)
library(dashHtmlComponents)
library(dashBootstrapComponents)
library(ggplot2)
library(plotly)

df = read.csv("data/Processed/HR_employee_Attrition_editted_processed.csv")

app = Dash$new(external_stylesheets = dbcThemes$BOOTSTRAP)
options(repr.plot.height = 200, repr.plot.width = 250)
p <- ggplot(df) +
  aes(x = Attrition,
      y = MonthlyIncome,
      fill = Attrition) +
  geom_boxplot(varwidth = TRUE) +
  theme_minimal(base_size = 16) +
  labs(y = 'Monthly Income', title = 'Monthly Income Distribution') +
  scale_y_continuous(labels = scales::label_dollar()) +
  coord_flip()

app$layout(dccGraph(figure = ggplotly(p)))

# app$layout(
#   dbcContainer(
#     htmlH1('Key Factors for Employee Attrition'),
#     list(
#       dccGraph(id='plot-area')
      # dccDropdown(
      #   id = 'depart-widget',
      #   options = purrr::map(df %>% colnames, function(col) list(label = col, value = col)),
      #   value='Sales')
    #   )
    #
    # ))
    # dbcRow(
    #   list(
    #     dbcCol(
    #       list(
    #         dccGraph(id='plot-area'),
    #         htmlLabel('Department'),
    #         dccDropdown(
    #           id = 'depart-widget',
    #           value = 'Sales'
    #           options = list(list(label = col, value = col),
    #                          list(label = "San Francisco", value = "SF")),
    #         )
    #         )
    #       ),
    #     )))))

# app$callback(
#   output('plot-area', 'figure'),
#   list(input('depart-widget', 'value')),
#
#   function(xcol) {
#     options(repr.plot.height = 200, repr.plot.width = 250)
#     p <- ggplot(df %>% filter(Department = !!sym(xcol))) +
#       aes(x = MonthlyIncome,
#           y = Attrition,
#           fill = Attrition) +
#       geom_boxplot(varwidth = TRUE) +
#       # theme_minimal(base_siz=16) +
#       labs(x = 'Monthly Income', title = 'Monthly Income Distribution') +
#       scale_x_continuous(labels = scales::label_dollar())
#     ggplotly(p)
#   }
# )

app$run_server(debug = T)


source("scRNA_func.r")

library(dplyr)
library(Seurat)
library(ggplot2)
library(ggpubr)
library(DT)
library(data.table)
library(cowplot)
library(scales)
library(stringr)
require(data.table)

options(future.globals.maxSize= 10779361280)
random.seed=20200107

options_table<-read.table(parSampleFile1, sep="\t", header=F, stringsAsFactors = F)
myoptions<-split(options_table$V1, options_table$V2)

by_sctransform<-ifelse(myoptions$by_sctransform == "0", FALSE, TRUE)
prefix<-outFile

species=myoptions$species

pca_dims<-1:as.numeric(myoptions$pca_dims)

finalListFile<-paste0(prefix, ".final.rds")

rawobj<-readRDS(parFile1)

finalList<-preprocessing_rawobj(rawobj, myoptions, prefix)
rawobj<-finalList$rawobj
finalList<-finalList[names(finalList) != "rawobj"]

if(by_sctransform){
  cat("performing SCTransform ...\n")
  nsamples=length(unique(rawobj$sample))
  if(nsamples > 1){
    objs<-SplitObject(object = rawobj, split.by = "sample")
    rm(rawobj)

    #perform sctransform
    objs<-lapply(objs, function(x){
      x <- SCTransform(x, verbose = FALSE)
      return(x)
    })
    obj <- merge(objs[[1]], y = unlist(objs[2:length(objs)]), project = "integrated")
    VariableFeatures(obj[["SCT"]]) <- rownames(obj[["SCT"]]@scale.data)
  }else{
    obj=rawobj
    rm(rawobj)
    obj<-SCTransform(obj, verbose = FALSE)
  }
  assay="SCT"
}else{
  cat("performing NormalizeData/FindVariableFeatures ...\n")
  #perform standard workflow
  obj <-rawobj
  rm(rawobj)
  obj<-NormalizeData(obj, verbose = FALSE)
  obj<-FindVariableFeatures(obj, selection.method = "vst", nfeatures = 2000, verbose = FALSE)
  obj<-ScaleData(obj)
  assay="RNA"
}

cat("run_pca ... \n")
obj <- RunPCA(object = obj, assay=assay, verbose=FALSE)

png(paste0(outFile, ".elbowplot.pca.png"), width=1500, height=1200, res=300)
p<-ElbowPlot(obj, ndims = 20, reduction = "pca")
print(p)
dev.off()

cat("run_umap ... \n")
obj <- RunUMAP(object = obj, dims=pca_dims, verbose = FALSE)

finalList$obj<-obj
saveRDS(finalList, file=finalListFile)

output_integraion_dimplot(obj, outFile, FALSE)


args = commandArgs(trailingOnly=TRUE)
if(length(args) < 3){
  stop("R --slave < this_code.r --args <gene-bc imputation h5/loom> <min_expressed_cell> <min_expressed_cell_average_expression>")
}
source("/home/yuanhao/single_cell/scripts/evaluation_pipeline/evaluation/generic_functions.r")
loom_path = args[1]
min_expressed_cell = as.integer(args[2])
min_expressed_cell_average_expression = as.numeric(args[3])
output_tsv = paste0(paste(delete_last_element(unlist(strsplit(loom_path, ".", fixed = T))), collapse = "/"), "_mc_", min_expressed_cell, "_mce_", min_expressed_cell_average_expression, "_hvg.tsv")
gene_bc_mat = t(h5read(loom_path, "matrix"))
colnames(gene_bc_mat) = h5read(loom_path, "col_attrs/CellID")
row.names(gene_bc_mat) = h5read(loom_path, "row_attrs/Gene")
expressed_cell = Matrix::rowSums(gene_bc_mat > 0)
gene_expression = Matrix::rowSums(gene_bc_mat)
gene_filter = expressed_cell >= min_expressed_cell & gene_expression > expressed_cell * min_expressed_cell_average_expression
hvf.info = FindVariableFeatures_vst_by_genes(gene_bc_mat[gene_filter, ])
hvg = rownames(hvf.info)[order(hvf.info$variance.standardized, decreasing = T)]
write.table(hvf.info[order(hvf.info$variance.standardized, decreasing = T), ], output_tsv, sep = "\t", quote = F, row.names = T, col.names = T)

reproducibility/Data Preparation, Imputation and Computational Resource Evaluation/Data Pre-processing/BRAIN_1.3M/4.grep_feature_genes.r


#------------------------------
# library
#------------------------------

library(Matrix)
library(magrittr)
library(data.table)
library(dtplyr)
library(dplyr)

#------------------------------
# functions
#------------------------------

remove_response <- function(data, dataset="train"){
	if(dataset != "train") return(data)
	select(data, -Response)
}

load_numeric <- function(data, dataset="train"){

	cat("==> Load", dataset, "numeric\n")
	fread(file.path(data_dir, paste0(dataset, "_numeric.csv")), data.table=FALSE) %>%

	# remove unneeded columns
	select(-Id) %>%
	remove_response(dataset=dataset) %>%

	# convert to sparse matrix
	data.matrix %>%
	replace(.==0, 1e-10) %>%
	replace(is.na(.), 0) %>%
	Matrix(sparse=TRUE)
}