library(EpiEstim)
library(optparse)
library(gsubfn)
library(plyr)
library(data.table)
source("covidmap/read_data.r")
source("covidmap/utils.r")

epiestim_options = function(
  first_day_modelled   = NULL,
  last_day_modelled    = NULL,
  weeks_modelled       = NULL,
  days_ignored         = NULL,
  days_per_step        = 7,
  days_predicted       = 0,
  num_steps_forecasted = 3,

  num_samples        = 20,
  num_iterations     = 5000,
  num_chains         = 1,

  data_directory     = "data/",
  results_directory  = "fits/test",
  produce_plots      = FALSE,
  approximation      = "epiestim",
  area_index         = 0
) {
  as.list(environment())
}

epiestim_run = function(area_index = 0, opt = epiestim_options()) {
  if (area_index==0) {
    stop("Area index 0.")
  }

  print(opt)
  env = covidmap_read_data(environment())

  numiters = opt$iterations

  list[Nstep, Tstep, Tcond, Tlik, Tcur, Tignore] = process_dates_modelled(
    dates,
    first_day_modelled = opt$first_day_modelled,
    last_day_modelled  = opt$last_day_modelled,
    days_ignored       = opt$days_ignored,
    weeks_modelled     = opt$weeks_modelled,
    days_per_step      = opt$days_per_step
  )
  message("Nproj = ", opt$num_steps_forecasted)

  area = areas[area_index]
  message("Area = ",area)

  Nsample <- opt$num_samples

  # Count = unlist(AllCount[area,(Tcond):(Tcond+(Tstep*Nstep))], use.names = FALSE)
  # Note extra day at the start to allow epiestim to work, should be Tcond+1
  Count = AllCount[area,(Tcond):(Tcond+(Tstep*Nstep))]
  dates = colnames(Count)
  Count = transpose(Count)
  starts = seq(from=2,by=Tstep,length.out=Nstep)
  ends = seq(from=Tstep+1,by=Tstep,length.out=Nstep)

#   starts = seq(from=2,by=1,length.out=(Nstep*Tstep)-Tstep-1)
#   ends = seq(from=Tstep+1,by=1,length.out=(Nstep*Tstep)-Tstep-1)

  modified_infprofile = replicate(length(infprofile)+1, 0.0)
  modified_infprofile[2:(length(infprofile)+1)] = infprofile
  modified_infprofile = unlist(modified_infprofile)

  config = make_config(
    t_start = starts,
    t_end = ends,
    si_distr=modified_infprofile,
    mean_prior=1.0
  )

  fit = estimate_R(
    Count,
    method="non_parametric_si",
    config = config
  )
  wt = wallinga_teunis(
    Count,
    method="non_parametric_si",
    config = config
  )

  fit$dates = dates
  dir.create(paste(opt$results_directory,'/epiestim/fits',sep=''), recursive=TRUE)
  saveRDS(fit, paste(opt$results_directory, '/epiestim/fits/',area,'.rds',sep=''))

}

epiestim_combine = function(opt = epiestim_options()) {
  covidmap_read_data(environment())

    # work out days to be modelled
  list[Nstep, Tstep, Tcond, Tlik, Tcur, Tignore] = process_dates_modelled(
    dates,
    first_day_modelled = opt$first_day_modelled,
    last_day_modelled  = opt$last_day_modelled,
    days_ignored       = opt$days_ignored,
    weeks_modelled     = opt$weeks_modelled,
    days_per_step      = opt$days_per_step
  )

  area_date_dataframe <- function(areas,dates,provenance,data,data_names) {
    numareas <- length(areas)
    numdates <- length(dates)
    dates <- rep(dates,numareas)
    dim(dates) <- c(numareas*numdates)
    provenance <- rep(provenance,numareas)
    dim(provenance) <- c(numareas*numdates)
    areas <- rep(areas,numdates)
    dim(areas) <- c(numareas,numdates)
    areas <- t(areas)
    dim(areas) <- c(numareas*numdates)
    df <- data.frame(area=areas,Date=dates,data=data,provenance=provenance)
    colnames(df)[3:(ncol(df)-1)] <- data_names
    df
  }

  Nproj = opt$num_steps_forecasted
  Tproj = Nproj * Tstep
  Tpred = opt$days_predicted
  provenance <- c(rep('inferred',Tlik),rep('projected',Tproj))
  days_likelihood = dates[(Tcond+1):Tcur]
  days_all <- c(days_likelihood,seq(days_likelihood[Tlik]+1,by=1,length.out=Tproj))
  message("Nstep = ",Nstep)
  message("Nproj = ",Nproj)

  Count <- AllCount[, 1:Tcur]

  numiters <- opt$num_iterations
  Nsample <- opt$num_samples

  # Initialize dummy arrays
  Clatent_sample <- array(0, c(N, Tcur+Tproj, Nsample))
  Clatent_mean <- array(0, c(N, Tcur+Tproj))
  Clatent_median <- array(0, c(N, Tcur+Tproj))
  Crecon_sample <- array(0, c(N, Tcur, Nsample))
  Crecon_median <- array(0, c(N, Tcur))
  Clatent_mean[, 1:Tcond] <- as.matrix(Count[, 1:Tcond])
  Clatent_median[, 1:Tcond] <- as.matrix(Count[, 1:Tcond])
  for (i in 1:Nsample) {
    Clatent_sample[, 1:Tcond, i] <- as.matrix(Count[, 1:Tcond])
    Crecon_sample[, 1:Tcond, i] <- as.matrix(Count[, 1:Tcond])
  }
  logpred = array(0.0, c(N, Tpred))

  # C_percentiles = c(.025,.25,.5,.75,.975)
  # C_str_percentiles = c("2.5%","25%","50%","75%","97.5%")
  # num_C_percentiles = length(C_percentiles)

  # Initialise actual arrays
  normal_percentiles = c(.025,.1,.2,.25,.3,.4,.5,.6,.7,.75,.8,.9,.975)
  normal_str_percentiles = c("2.5%","10%","20%","25%","30%","40%","50%","60%","70%","75%","80%","90%","97.5%")
  num_normal_percentiles = length(normal_percentiles)
  percentiles = c(.025,.05,.25,.5,.75,.095,.975)
  str_percentiles = c("2.5%","5%","25%","50%","75%","95%","97.5%")
  num_percentiles = length(percentiles)
  epiestim_percentiles = c("Quantile.0.025(R)","Quantile.0.05(R)","Quantile.0.25(R)","Median(R)","Quantile.0.75(R)","Quantile.0.95(R)","Quantile.0.975(R)")
  # pad_percentiles = c("10%", "20%", "30%", "40%", "60%", "70%", "80%", "90%")
  pad_percentiles = c()
  num_samples = opt$num_iterations
  Rt_percentiles = array(0.0, c(N, Nstep+Nproj, num_percentiles + length(pad_percentiles)))
  Rt_samples = array(0.0, c(N, Nstep+Nproj, num_samples))

  Cpred = array(0.0, c(N, Nstep*Tstep, num_normal_percentiles))
  Cproj = array(0.0, c(N, Nproj*Tstep, num_normal_percentiles))

  rev_infprofile = rev(infprofile)
  L = length(infprofile)

  # Loop over areas, loading area RDS files and filling the arrays
  for (area_index in 1:N) {
    area <- areas[area_index]
    print(area)

    fit <- readRDS(paste(opt$results_directory, '/epiestim/fits/',area,'.rds',sep=''))
    for (p in 1:num_percentiles) {
      Rt_percentiles[area_index,1:Nstep, p] = fit$R[,epiestim_percentiles[p]]
      Rt_proj = fit$R[Nstep,epiestim_percentiles[p]]

      for (i in 1:Nproj) {
        Rt_percentiles[area_index,Nstep + i, p] = Rt_proj
      }
    }

    Rt_proj = sample_posterior_R(fit, n = opt$num_samples, window = Nstep)

    C = array(0.0, (Nstep+Nproj)*Tstep)
    C[1:(Nstep*Tstep)] = as.numeric(Count[area,(Tcond+1):(Tcond+(Tstep*Nstep))])
    C_samples = array(0.0, c((Nstep+Nproj)*Tstep, opt$num_samples))
    C_samples[1:(Nstep*Tstep),] = as.numeric(Count[area,(Tcond+1):(Tcond+(Tstep*Nstep))])

    for (t in 1:(Nproj*Tstep)) {
      C_samples[(Nstep*Tstep) + t,] = Rt_proj * colSums(C_samples[((Nstep*Tstep) + t - L) : ((Nstep*Tstep) + t - 1),] * rev_infprofile)
      for (i in 1:opt$num_samples) {
        C_samples[(Nstep*Tstep) + t, i] = rpois(1, C_samples[(Nstep*Tstep) + t, i])
      }
    }

    C_percentiles = t(apply(C_samples,1,quantile,
      probs=normal_percentiles
    ))

    Cpred[area_index,,] = C_percentiles[1:(Nstep*Tstep),]
    Cproj[area_index,,] = C_percentiles[((Nstep*Tstep)+1):((Nstep+Nproj)*Tstep),]
  }

  Xpred = Cpred
  Xproj = Cproj

  days <- colnames(Count)
  days_proj <- c(days,as.character(seq(days_likelihood[Tlik]+1,by=1,length.out=Tproj),format='%Y-%m-%d'))

  # Save real data
  Rt = Rt_percentiles[,rep(c(1:(Nstep+Nproj)),each=Tstep),]
  Rt = aperm(Rt, c(2,1,3))
  dim(Rt) <- c(N*(Nstep+Nproj)*Tstep, num_percentiles + length(pad_percentiles))
  Rt <- area_date_dataframe(
    quoted_areas,
    days_all,
    provenance,
    format(round(Rt,2),nsmall=2),
    c("Rt_2_5","Rt_5","Rt_25","Rt_50","Rt_75","Rt_95","Rt_97_5") #, "Rt_10", "Rt_20", "Rt_30", "Rt_40", "Rt_60", "Rt_70", "Rt_80", "Rt_90")
  )
  write.csv(Rt, paste(opt$results_directory, "/epiestim/Rt.csv", sep=""), quote=FALSE, row.names=FALSE)

  # Save dummy data
  thresholds = c(.8, .9, 1.0, 1.1, 1.2, 1.5, 2.0)
  numthresholds = length(thresholds)
  Pexceedance = array(0.0, dim=c(Nstep+Nproj,N,numthresholds))
  Pexceedance = Pexceedance[c(1:(Nstep+Nproj)),,]
  Pexceedance <- Pexceedance[sapply(1:(Nstep+Nproj),function(k)rep(k,Tstep)),,]
  dim(Pexceedance) <- c(Tstep*(Nstep+Nproj)*N,numthresholds)
  Pexceedance <- area_date_dataframe(
      quoted_areas,
      days_all,
      provenance,
      format(round(Pexceedance,2),nsmall=2),
      c("P_08","P_09","P_10","P_11","P_12","P_15","P_20")
  )
  write.csv(Pexceedance, paste(opt$results_directory, "/epiestim/Pexceed.csv", sep=""), quote=FALSE, row.names=FALSE)

  logpred = data.frame(area = areas, logpred = logpred, provenance=rep('inferred', length(areas)))
  for (i in 1:Tpred)
      colnames(logpred)[i+1] <- sprintf('logpred_day%d',i)
  write.csv(logpred, paste(opt$results_directory, "/epiestim/logpred.csv", sep=""), quote=FALSE, row.names=FALSE)

  Cweekly = array(0.0, c(N, (Nstep + Nproj), Tstep))
  actuals <- as.matrix(AllCount[,(Tcond+1):(Tcond+Tlik)])
  dim(actuals) <- c(N,Tstep,Nstep)
  actuals <- aperm(actuals, c(1,3,2))
  # preds = Cpred[,,3]
  # dim(preds) <- c(N, Nstep, Tstep)
  Cweekly[,1:Nstep,] = actuals
  Cweekly = apply(Cweekly, c(1,2), sum)
  Cweekly = Cweekly[,sapply(1:(Nstep+Nproj),function(k)rep(k,Tstep))]
  Cweekly = aperm(Cweekly, c(2,1))
  dim(Cweekly) <- c(N*(Nstep+Nproj)*Tstep)
  Cweekly <- area_date_dataframe(
    quoted_areas,
    days_all,
    provenance,
    Cweekly,
    c("C_weekly")
  )
  write.csv(Cweekly, paste(opt$results_directory, "/epiestim/Cweekly.csv", sep=""), quote=FALSE, row.names=FALSE)

  Cpred = aperm(Cpred, c(2,1,3))
  dim(Cpred) <- c(N*Nstep*Tstep, num_normal_percentiles)
  Cpred <- area_date_dataframe(
    quoted_areas,
    days_likelihood,
    rep('inferred',Nstep*Tstep),
    Cpred,
    c("C_025","C_10","C_20","C_25","C_30","C_40","C_50","C_60","C_70","C_75","C_80","C_90","C_975")
  )
  write.csv(Cpred, paste(opt$results_directory, "/epiestim/Cpred.csv", sep=""), quote=FALSE, row.names=FALSE)

  Cproj = aperm(Cproj, c(2,1,3))
  dim(Cproj) <- c(N*Nproj*Tstep, num_normal_percentiles)
  Cproj <- area_date_dataframe(
    quoted_areas,
    seq(days_likelihood[Tlik]+1,by=1,length.out=Tproj),
    rep('projected',Tproj),
    Cproj,
    c("C_025","C_10","C_20","C_25","C_30","C_40","C_50","C_60","C_70","C_75","C_80","C_90","C_975")
  )
  write.csv(Cproj, paste(opt$results_directory, "/epiestim/Cproj.csv", sep=""), quote=FALSE, row.names=FALSE)

  Xpred = aperm(Xpred, c(2,1,3))
  dim(Xpred) <- c(N*Nstep*Tstep, num_normal_percentiles)
  Xpred <- area_date_dataframe(
    quoted_areas,
    days_likelihood,
    rep('inferred',Nstep*Tstep),
    Xpred,
    c("X_025","X_10","X_20","X_25","X_30","X_40","X_50", "X_60", "X_70","X_75","X_80","X_90","X_975")
  )
  write.csv(Xpred, paste(opt$results_directory, "/epiestim/Xpred.csv", sep=""), quote=FALSE, row.names=FALSE)

  Xproj = aperm(Xproj, c(2,1,3))
  dim(Xproj) <- c(N*Nproj*Tstep, num_normal_percentiles)
  Xproj <- area_date_dataframe(
    quoted_areas,
    seq(days_likelihood[Tlik]+1,by=1,length.out=Tproj),
    rep('projected',Tproj),
    Xproj,
    c("X_025","X_10","X_20","X_25","X_30","X_40","X_50", "X_60", "X_70","X_75","X_80","X_90","X_975")
  )
  write.csv(Xproj, paste(opt$results_directory, "/epiestim/Xproj.csv", sep=""), quote=FALSE, row.names=FALSE)

}

epiestim_cmdline_options = function(opt = epiestim_options()) {
  list(
    make_option(
      c("--area_index"),
      type="integer",
      default=0,
      help="Area index (required argument)."
    ),
    make_option(
      c("--num_samples"),
      type="integer",
      default=opt$num_samples,
      help="Number of samples to output."
    ),
    make_option(
      c("--num_iterations"),
      type="integer",
      default=opt$num_iterations,
      help=paste("Number of MCMC iterations, default",opt$num_iterations)
    ),
    make_option(
      c("--first_day_modelled"),
      type="character",
      default=opt$first_day_modelled,
      help=paste("Date of first day to model; default =",opt$first_day_modelled)
    ),
    make_option(
      c("--weeks_modelled"),
      type="integer",
      default=opt$weeks_modelled,
      help=paste("Number of weeks to model; default =",opt$weeks_modelled)
    ),
    make_option(
      c("--last_day_modelled"),
      type="character",
      default=opt$last_day_modelled,
      help=paste("Date of last day to model; default =",opt$last_day_modelled)
    ),
    make_option(
      c("--days_ignored"),
      type="integer",
      default=opt$days_ignored,
      help=paste("Number of recent days ignored, default",opt$days_ignored)
    ),
    make_option(
      c("--days_per_step"),
      type="integer",
      default=opt$days_per_step,
      help=paste("Days per modelling step, default",opt$days_per_step)
    ),
    make_option(
      c("--days_predicted"),
      type="integer",
      default=opt$days_predicted,
      help=paste("Days predicted; default =",opt$days_predicted)
    ),
    make_option(
      c("--num_steps_forecasted"),
      type="integer",
      default=opt$num_steps_forecasted,
      help=paste("Number of steps to forecast, default",opt$num_steps_forecasted)
    ),
    make_option(
      c("--results_directory"),
      type="character",
      default=opt$results_directory,
      help=paste("Directory to put cleaned results in, default ",opt$results_directory)
    ),
    make_option(
      c("--data_directory"),
      type="character",
      default=opt$data_directory,
      help=paste("Directory to get data from, default ",opt$data_directory)
    ),
    make_option(
      c("--produce_plots"),
      type="logical",
      default=opt$produce_plots,
      help=paste("Whether to produce plots; default",opt$produce_plots)
    ),
    make_option(
      c("--limit_area"),
      type="character",
      default=opt$limit_area,
      help=paste("If not NULL, center the radius of regions on this region",opt$limit_area)
    ),
    make_option(
      c("--limit_radius"),
      type="double",
      default=opt$limit_radius,
      help=paste("If not NULL, the radius of regions to limit the data to; default",opt$limit_radius)
    )
  )
}

epiestim_get_cmdline_options = function(opt=epiestim_options()) {
  cmdline_opt = epiestim_cmdline_options(opt)
  opt_parser = OptionParser(option_list=cmdline_opt)
  parsed_opt = parse_args(opt_parser)
  for (o in names(parsed_opt)) {
    opt[o] = parsed_opt[o]
  }
  opt
}


# ----------------------------------------------------------------------
# Function: mapReduce
#   mapReduce pattern implemented on an R data structure
#   (array data.frame matrix)
#
# map: the map step evaluated on the data structure
# ...: The Reduce step can be one or more functions with optional names
#      evaluated on the split data.  name=function.
# data: the R data structure
# Returns a matrix or data.frame.
# ----------------------------------------------------------------------

mapReduce <- function( map, ..., data=NULL, apply=sapply ) {

    if( is.null(data) )
      stop( "You must explicitly provide data using the data argument" )

    m <- match.call( expand.dots=FALSE )
    map <- eval( m$map, data )

  # The dots will be the expression that gets evaluated.
    expr = m$`...`

  # Split data ... this is important since each of the features
  # will operate on the split data.  This is also the most time
  # consuming part of the process.
  # because split is a poor function
    if( class(data) == "list" ) {
      split.data <- data
    } else {
      split.data <- split( data, map )
    }

  # innerFun: Evaluates expression
    innerFun = function( entity.data, expr ) {
        eval( expr, entity.data )
    }

  # outerFun: Split data based on map
    outerFun = function( expr, split.data ) {
      sapply(
        # split( data, map ) ,
        split.data  ,
        innerFun ,
        expr
      )
    }

  # RETURN:
    ret=apply(
      expr ,  # Elimanates call
      outerFun ,  # Contains inner function
      split.data
    )

    # detach(data)
    return(ret)
}


library(reshape)
library(wordcloud)
library(RColorBrewer)

amcat.lda.addMeta <- function(m, meta){
  if('meta' %in% names(m)) {m$meta = meta[match(rownames(m$dtm), meta$id),]
  } else m = c(m, list(meta=meta[match(rownames(m$dtm), meta$id),]))
  m
}

## PLOTTING
amcat.plot.lda.alltopics <- function(m, time_var=m$meta$date, category_var=m$meta$medium, date_interval='day', path='/tmp/clouds/'){
  for(topic_nr in 1:nrow(m$document_sums)){
    print(paste('Plotting:',topic_nr))
    fn = paste(path, topic_nr, ".png", sep="")
    if (!is.null(fn)) png(fn, width=1280,height=800)
    amcat.plot.lda.topic(m, topic_nr, time_var, category_var, date_interval)
    if (!is.null(fn)) dev.off()
  }
  par(mfrow=c(1,1))
}

amcat.plot.lda.topic <- function(m, topic_nr, time_var=m$meta$date, category_var=m$meta$medium, date_interval='day', pct=F, value='total'){
  par(mar=c(4.5,3,2,1), cex.axis=1.7)
  layout(matrix(c(1,1,2,3), 2, 2, byrow = TRUE), widths=c(2.5,1.5), heights=c(1,2))
  amcat.plot.lda.time(m, topic_nr, time_var, date_interval, pct=pct, value=value)
  amcat.plot.lda.wordcloud(m, topic_nr)
  amcat.plot.lda.category(m, topic_nr, category_var, pct=pct, value=value)
  par(mfrow=c(1,1))
}

amcat.prepare.time.var <- function(time_var, date_interval){
  if(class(time_var) == 'Date'){
    if(date_interval == 'day') time_var = as.Date(format(time_var, '%Y-%m-%d'))
    if(date_interval == 'month') time_var = as.Date(paste(format(time_var, '%Y-%m'),'-01',sep=''))
    if(date_interval == 'week') time_var = as.Date(paste(format(time_var, '%Y-%W'),1), '%Y-%W %u')
    if(date_interval == 'year') time_var = as.Date(paste(format(time_var, '%Y'),'-01-01',sep=''))
  }
  time_var
}

amcat.fill.time.gaps <- function(d, date_interval){
  if(class(d$time) == 'numeric'){
    for(t in min(d$time):max(d$time))
      if(!t %in% d$time) d = rbind(d, data.frame(time=t, value=0))
  }
  if(class(d$time) == 'Date'){
    date_sequence = seq.Date(from=min(d$time), to=max(d$time), by=date_interval)
    for(i in 1:length(date_sequence)){
      t = date_sequence[i]
      if(!t %in% d$time) d = rbind(d, data.frame(time=t, value=0))
    }
  }
  d[order(d$time),]
}

amcat.prepare.plot.values <- function(m, break_var, topic_nr, pct=F, value='total'){
  d = data.frame(value=m$document_sums[topic_nr,], break_var=break_var)
  if(value == 'relative') d$value= d$value / colSums(m$document_sums)
  if(pct == T) d$value = d$value / sum(d$value)
  d = aggregate(d[,c('value')], by=list(break_var=d$break_var), FUN='sum')
  d
}

amcat.plot.lda.time <- function(m, topic_nr, time_var=m$meta$date, date_interval='day', pct=F, value='total'){
  par(mar=c(3,3,3,1))
  time_var = amcat.prepare.time.var(time_var, date_interval)
  d = amcat.prepare.plot.values(m, break_var=time_var, topic_nr=topic_nr, pct=pct, value=value)
  colnames(d) = c('time','value')
  d = amcat.fill.time.gaps(d, date_interval)
  plot(d$time, d$value, type='l', xlab='', main='', ylab='', xlim=c(min(d$time), max(d$time)), ylim=c(0, max(d$value)), bty='L', lwd=5, col='darkgrey')
  d
}

amcat.plot.lda.category <- function(m, topic_nr, category_var=m$meta$medium, pct=F, value='total'){
  par(mar=c(10,0,1,2))
  d = amcat.prepare.plot.values(m, break_var=category_var, topic_nr=topic_nr, pct=pct, value=value)
  colnames(d) = c('category','value')
  barplot(as.matrix(t(d[,c('value')])), main='', beside=TRUE,horiz=FALSE,
          density=NA,
          col='darkgrey',
          xlab='',
          ylab="",
          axes=T, names.arg=d$category, cex.names=1.5, cex.axis=1.5, adj=1, las=2)
  d
}

amcat.plot.lda.wordcloud <- function(m, topic_nr){
  x = m$topics[topic_nr,]
  x = sort(x[x>5], decreasing=T)[1:100]
  x = x[!is.na(x)]
  names = sub("/.*", "", names(x))
  freqs = x**.5
  pal <- brewer.pal(6,"YlGnBu")
  wordcloud(names, freqs, scale=c(6,.5), min.freq=1, max.words=Inf, random.order=FALSE, rot.per=.15, colors=pal)
}

## GRAPHS

amcat.ucmatrix.to.simmatrix<- function(ucmatrix, similarity.measure){
  if(similarity.measure=='pearson_cor') sim.matrix = cor(t(ucmatrix))
  if(similarity.measure=='spearman_cor') sim.matrix = cor(t(ucmatrix), method='spearman')
  if(similarity.measure=='hellinger_dist') {
    library(topicmodels)
    sim.matrix = distHellinger(as.matrix(ucmatrix))
  }
  if(similarity.measure=='cosine') {
    library(lsa)
    sim.matrix = cosine(t(as.matrix(ucmatrix)))
  }
  sim.matrix
}

amcat.simmatrix.to.simgraph <- function(m){
  m[lower.tri(m, diag=T)] = NA
  m.indices = which(!is.na(m),arr.ind=T)
  m.values = na.omit(as.vector(m))
  data.frame(node.X=m.indices[,1], node.Y=m.indices[,2], similarity=m.values)
}

amcat.ucmatrix.to.simgraph <- function(ucmatrix, similarity.measure='pearson_cor'){
  sim = amcat.ucmatrix.to.simmatrix(ucmatrix, similarity.measure)
  amcat.simmatrix.to.simgraph(sim)
}

amcat.unit.similarity.graph <- function(ucmatrix, unit.id.list, similarity.measure='pearson_cor'){
  d = aggregate(ucmatrix, by=unit.id.list, FUN='sum')
  ucmatrix = d[,(length(unit.id.list)+1):ncol(d)]
  simgraph = amcat.ucmatrix.to.simgraph(ucmatrix, similarity.measure)

  meta = as.data.frame(d[,names(unit.id.list)], stringsAsFactors=F)
  colnames(meta) = names(unit.id.list)
  meta = cbind(id=1:nrow(meta), meta)
  meta$topic_totals = rowSums(ucmatrix)

  list(graph_df=simgraph, meta=meta)
}

amcat.lda.similarity.graph <- function(m, unit.id.list, vertex_label=names(unit.id.list)[1], similarity.measure='pearson_cor'){
  library(igraph)
  doc_topic_matrix = t(m$document_sums)
  unit.similarity = amcat.unit.similarity.graph(doc_topic_matrix, unit.id.list, similarity.measure)
  g = graph.data.frame(unit.similarity$graph_df, directed=F, vertices=unit.similarity$meta)
  E(g)$weight = E(g)$similarity
  g
}


#' Extract the information from the simulation data frame to analyse the naive causal effects
#'
#' @param allsim dataset with all simulations values
#' @param dataset dataset with all variables
#' @param exposures a vector with exposures
#' @param delta a vector with two values
#' @param ic_dis choose between ic (interval confidences) and dis (distribution)
#' @param st summary table from general function
#' @return a data frame with naive ace and confident intervals
#' @examples
#' data(expose_data)
#' data(simu)
#' data(gen)
#' delta=c(1,0)
#' Exposures<- c('Var1','Var2','Var3','Var4','Var5')
#' summary_table_lines <- gen[[2]]
#' ace.df.g <- naive_ace (allsim = simu[[1]], dataset = expose_data,
#' ic_dis = 'IC', st = summary_table_lines,
#' exposures = Exposures, delta = delta)
#' @export

naive_ace <- function(allsim, dataset, exposures, delta = c(0, 1), ic_dis = "IC", st) {
  dataset <- data.frame(dataset)
    len_exp <- length(exposures)
    df_ace <- data.frame(matrix(NA, len_exp, 4))
    names(df_ace) <- c("Group", "Mean", "ICa", "ICb")
    h <- 0
    for (ex in 1:len_exp) {
        h <- h + 1
        df_ace[h, "Group"] <- paste0(exposures[ex])
        stp <- st[st$Group == "ACE" & st$Case == exposures[ex], c(4, 5)]
        from <- as.numeric(stp[1, 1])
        to <- as.numeric(stp[2, 2])
        mdata <- allsim[from:to, ]
        b <- naive_ace_ind(allsim = mdata, dataset = dataset, ic_dis = "IC")
        df_ace[h, "Mean"] <- b[[1]]
        df_ace[h, "ICa"] <- b[[2]]
        df_ace[h, "ICb"] <- b[[3]]
    }
    return(df_ace)
}


library(tidyverse)

e <- rnorm(200)
f <- rnorm(200, e)
dat <- data_frame(e,f) %>%
  mutate(sp = paste0("sp", rep(1:20, each = 10)))

write.csv(dat, "data3.csv", row.names = F)


print("--------------- File plot-explore.r")

# load environment from all-IL run, post-simulation
# manual stuff
# load("../modelOutput/results/run_2/us_base-488236.Rdata") # -> prev - 4000 iterations
# load("../modelOutput/results/big_sim/us_base-2225348.Rdata") # -> prev - 8000 iterations ("big sim")
# load("../modelOutput/results/five_county_big/us_base-1028756.Rdata") # -> 24K iterations on 5 counties with most data
# load("../modelOutput/results/nine_county_big/us_base-606037.Rdata") # -> 24K iterations on 9 counties with most data

# automating ..
args <- commandArgs(trailingOnly = TRUE)
filename2 <- args[1]
load(paste0("../modelOutput/results/", filename2))

exploreNames <- c(
  "County",

  "Rt",
  "R0",
  "Prop_Reduction_in_Rt", # (R0 - Rt) / R0

  "Modeled_Cases",
  "Reported_Cases",

  "Modeled_Deaths",
  "Reported_Deaths"
)

explore <- data.frame(matrix(0, ncol = length(exploreNames)))
colnames(explore) <- exploreNames

for (i in 1:length(countries)) {
  N <- length(dates[[i]])

  country <- countries[[i]]

  dimensions <- dim(out$Rt)
  Rt <- mean(out$Rt[, dimensions[2], i])
  R0 <- mean(out$mu[, i])

  total_predicted_cases <- sum(colMeans(prediction[, 1:N, i]))
  total_predicted_cases_cf <- sum(colMeans(out$prediction0[, 1:N, i]))
  total_reported_cases <- sum(reported_cases[[i]])

  total_estimated_deaths <- sum(colMeans(estimated.deaths[, 1:N, i]))
  total_estimated_deaths_cf <- sum(colMeans(estimated.deaths.cf[, 1:N, i]))
  total_reported_deaths <- sum(deaths_by_country[[i]])

  countyStats <- c(
    country,
    Rt,
    R0,
    (R0 - Rt) / R0,
    log(total_predicted_cases),
    log(total_reported_cases),
    log(total_estimated_deaths),
    log(total_reported_deaths)
  )

  explore <- rbind(explore, countyStats)
}

# take away initial row which is just a zero vector placeholder
explore <- explore[-1, ]

# separate df without cook county
# here -> watch this
exploreNoCook <- explore[explore$County != "84017031", ]

# remove county column (it's not a variable)
explore$County <- NULL
exploreNoCook$County <- NULL

## plots -> save them, name them, easily readable axes

# look at everything
png(filename = "../modelOutput/explorePlots/exploreVars.png", width = 1600, height = 1600, units = "px", pointsize = 36)
# todo: fix this manual toggling
# plot(exploreNoCook)
plot(explore)
dev.off()

# NOTE: make it clear in each diagram if cook county is included or not
# assume cook county is included
# if exluded - explicitly state this in the title
# NOTE: I haven't done this yet

# td: REALLY gotta fix the manual toggling between including or not including cook county in these plots

#### distributions of interest

# Rt
png(filename = "../modelOutput/explorePlots/freq_Rt.png", width = 1600, height = 1600, units = "px", pointsize = 36)
hist(as.numeric(explore$Rt), breaks = 8, main = "Rt", xlab = "Rt")
dev.off()
png(filename = "../modelOutput/explorePlots/freq_R0.png", width = 1600, height = 1600, units = "px", pointsize = 36)
hist(as.numeric(explore$R0), breaks = 8, main = "R0", xlab = "R0")
dev.off()
png(filename = "../modelOutput/explorePlots/freq_ReductionInRt.png", width = 1600, height = 1600, units = "px", pointsize = 36)
hist(as.numeric(explore$Prop_Reduction_in_Rt), main = "Reduction in Rt", xlab = "Reduction in Rt")
dev.off()

# Reported Cases
png(filename = "../modelOutput/explorePlots/freq_ReportedCases_log.png", width = 1600, height = 1600, units = "px", pointsize = 36)
# hist(as.numeric(exploreNoCook$Reported_Cases), main="log(Reported Cases)", xlab="log(Reported Cases)")
hist(as.numeric(explore$Reported_Cases), main = "log(Reported Cases)", xlab = "log(Reported Cases)")
dev.off()
png(filename = "../modelOutput/explorePlots/freq_ReportedCases.png", width = 1600, height = 1600, units = "px", pointsize = 36)
# hist(exp(as.numeric(exploreNoCook$Reported_Cases)), main="Reported Cases", xlab="Reported Cases")
hist(exp(as.numeric(explore$Reported_Cases)), main = "Reported Cases", xlab = "Reported Cases")
dev.off()

# Reported Deaths
png(filename = "../modelOutput/explorePlots/freq_ReportedDeaths_log.png", width = 1600, height = 1600, units = "px", pointsize = 36)
# hist(as.numeric(exploreNoCook$Reported_Deaths), main="log(Reported Deaths)", xlab="log(Reported Deaths)")
hist(as.numeric(explore$Reported_Deaths), main = "log(Reported Deaths)", xlab = "log(Reported Deaths)")
dev.off()
png(filename = "../modelOutput/explorePlots/freq_ReportedDeaths.png", width = 1600, height = 1600, units = "px", pointsize = 36)
# hist(exp(as.numeric(exploreNoCook$Reported_Deaths)), main="Reported Deaths", xlab="Reported Deaths")
hist(exp(as.numeric(explore$Reported_Deaths)), main = "Reported Deaths", xlab = "Reported Deaths")
dev.off()

#### highlight some plots

# Reduction in Rt vs. Reported Deaths
png(filename = "../modelOutput/explorePlots/ReductionInRt_vs_ReportedDeaths.png", width = 1600, height = 1600, units = "px", pointsize = 36)
# plot(exp(as.numeric(exploreNoCook$Reported_Deaths)), exploreNoCook$Prop_Reduction_in_Rt,
#     main="Reduction in Rt vs. Reported Deaths",
#     xlab="Reported Deaths", ylab="Reduction in Rt")
plot(exp(as.numeric(explore$Reported_Deaths)), explore$Prop_Reduction_in_Rt,
  main = "Reduction in Rt vs. Reported Deaths",
  xlab = "Reported Deaths", ylab = "Reduction in Rt"
)
dev.off()

# Reported Deaths vs. Reported Cases
# y is reported deaths -> "x vs. y"
png(filename = "../modelOutput/explorePlots/ReportedDeaths_vs_ReportedCases.png", width = 1600, height = 1600, units = "px", pointsize = 36)
# plot(exploreNoCook$Reported_Cases, exploreNoCook$Reported_Deaths,
#     main="Reported Deaths vs. Reported Cases",
#     xlab="log(Reported Cases)", ylab="log(Reported Deaths)")
plot(explore$Reported_Cases, explore$Reported_Deaths,
  main = "Reported Deaths vs. Reported Cases",
  xlab = "log(Reported Cases)", ylab = "log(Reported Deaths)"
)
dev.off()

# Rt vs. Reported Deaths
png(filename = "../modelOutput/explorePlots/ReportedDeaths_vs_Rt.png", width = 1600, height = 1600, units = "px", pointsize = 36)
# plot(exploreNoCook$Rt, exploreNoCook$Reported_Deaths,
#     main="Reported Deaths vs. Rt",
#     xlab="Rt", ylab="log(Reported Deaths)")
plot(explore$Rt, explore$Reported_Deaths,
  main = "Reported Deaths vs. Rt",
  xlab = "Rt", ylab = "log(Reported Deaths)"
)
dev.off()

# R0 vs. Rt
png(filename = "../modelOutput/explorePlots/Rt_vs_R0.png", width = 1600, height = 1600, units = "px", pointsize = 36)
plot(explore$R0, explore$Rt, main = "Rt vs. R0", xlab = "R0", ylab = "Rt")
dev.off()

#### todo! : fetch soc-ec vars, pop dens, etc. -> plot reduction in Rt, and Rt, or whatever, against these other soc-ec vars by county


library(rbenchmark)
library(tau)
library(ngram)

x <- ngram::rcorpus(50000)

reps <- 15
cols <- c("test", "replications", "elapsed", "relative")

benchmark(tau=textcnt(x, n=3, split=" ", method="string"), ngram=get.phrasetable(ngram(x, n=3)), replications=reps, columns=cols)


##--------------------------------------------------
##
## LDA-link analysis of asthma patient
##
##--------------------------------------------------

##################################################
##
## data -1.simple_cor.r  data processing
##################################################

###the last one
wd = "" ###change here to data folder

setwd(wd)
####setwd("/ysm-gpfs/pi/gerstein/from_louise/sl2373/asthma/p152ds")

###exo.genus, genus level abundance of microbes
load("../exogenous/exo.genus.wRowName.rdata")

###clinical expression
load("../exogenous/ExoAsthma_humanGenes_clinical.RData")

###update Jan 31

load("counts.rpm.protein.rpkm.clinical.Rdata")

bulk=all.mats.protein$rpm
colnames(bulk)=gsub("\\.fq","", colnames(bulk))

exo<-exo.genus

colnames(exo)=gsub("\\.fq","", colnames(exo))
exo=exo[,colnames(bulk)]

bulk=apply(bulk, 2, function(x){ x[is.na(x)]=0.0; x;})

exo=apply(exo, 2, function(x){ x[is.na(x)]=0.0; x;})

exo=exo[-which(rowSums(exo)==0),]

##################################################
## get correlation
bce.cor=cor(t(bulk), t(exo))
bce.cor.vec=as.vector(bce.cor)

bce.cor.log2=cor(log2(t(bulk)+1), log2(t(exo)+1))
bce.corlog2.vec=as.vector(bce.cor.log2)
##17201 x  498

if (FALSE){
###Fig 4A
pdf("bulk_exo_cor_distr.pdf")
plot(density(as.vector(bce.cor)), xlab="correlation", ylab="density")
dev.off()
}

bulk.quant=apply(bulk,2, function(x){ y=rank(x); })
quartnum= floor(nrow(bulk)*0.5)

bulk.exprcnt= apply(bulk.quant, 1, function(x){ sum(x>quartnum);})
bulk.filt=bulk[which(bulk.exprcnt > 70), ]

bulk.quant2=apply(bulk,2, function(x){ y=rank(x); })
quartnum= floor(nrow(bulk)*0.5)
bulk.exprcnt2= apply(bulk.quant2, 1, function(x){ sum(x>quartnum);})

###filter exo data
exo.gt0 = apply(exo, 1, function(x){ sum(x>0);})
exo.filt=exo[which(exo.gt0>10),]   ##130x172
exo.filt2 = exo.filt[,which(colSums(exo.filt)>0)]  ##130x170

cutoff=30 ##for p152ds
bulk.filt2=bulk[which(bulk.exprcnt2 > cutoff), ]
###correlation
bce.corfilt2=cor(t(bulk.filt2), t(exo.filt))

b.cols=split(t(bulk.filt2), col(t(bulk.filt2)))
e.cols= split(t(exo.filt), col(t(exo.filt)))

be.cortest=outer(b.cols, e.cols,Vectorize(function(x,y){cor.test(x,y)$p.value;}))

cor.vec=as.vector(bce.corfilt2)
mx = "fdr"  ###can also try BH, hochberg, hommel etc
be.cor.padj_fdr = p.adjust(as.vector(be.cortest), method = mx)
#summary(be.cor.padj_fdr[which( abs(cor.vec)> 0.4)])
#     Min.   1st Qu.    Median      Mean   3rd Qu.      Max.
#0.000e+00 1.369e-07 3.203e-05 2.608e-04 3.756e-04 1.599e-03

div=10
data=ceiling(bulk.filt2/div)
data=as.matrix(t(data))
data[which(data>1000)]=1000

ntopic=10
library("topicmodels")
lda.bulk10= LDA(data, k = ntopic, method = "Gibbs")
#lda.d2t.bulkfilt2= lda.noCtrl.model@gamma

save(lda.bulk10, file="bulk_ldaout10.rdata")

fin="exo_signal2_ldad10.txt"
SEED=123
data = read.table(fin, sep="\t", header=T, row.names=1, stringsAsFactors=F)

data.matrix=as.matrix(data)

lda.exo10 = LDA(data, k = ntopic, method = "Gibbs", control = list(seed = SEED, burnin = 1000,
  thin = 100, iter = 1000))

save(lda.exo10, file="exo_ldaout10.rdata")

###this is the final version

bulk.ldaout="0rpmlogF_noCtrl/bulk.filt2.lda10.txt"
exo.ldaout="0rpmlogF_noCtrl/exo.filt2.lda10.txt"

load("bulk_ldaout10.rdata")
load("exo_ldaout10.rdata")

####################################################################################################
## exogerous
## lda.bulk10=lda.noCtrl.model from rpm1logF.rpm.10.expc10.log_FALSE1000.lda.model.rdata
##link from exogenous
load("ExoAsthma_humanGenes_clinical.RData")
sev = df[,c(1,46)]
lda.d2t.bulkfilt2= lda.bulk10@gamma
rownames(lda.d2t.bulkfilt2) = gsub("\\.", "-", lda.bulk10@documents)
sample.comm=intersect(rownames(lda.d2t.bulkfilt2), sev[,1])

sev=sev[which(sev[,1] %in% sample.comm),]
lda.d2t.bf2sev=lda.d2t.bulkfilt2[sev[,1],]

#sev = df[,c(1,46)]
lda.d2t.exofilt2= lda.exo10@gamma
rownames(lda.d2t.exofilt2) = gsub("\\.", "-", lda.exo10@documents)

lda.d2t.ef2sev=lda.d2t.exofilt2[sev[,1],]

###distribution of cor-  beta=log(prob) or ln(prob)
bulk.filt2.lda10 = lda.bulk10@beta
colnames(bulk.filt2.lda10) = lda.bulk10@terms
##write.table(bulk.filt2.lda10, file=bulk.ladout,sep="\t", quote=F, row.names=F, col.names=T)

##10x149
exo.filt2.lda10=lda.exo10@beta
colnames(exo.filt2.lda10)=lda.exo10@terms
##write.table(exo.filt2.lda10, file=exo.ldaout,sep="\t", quote=F, row.names=F, col.names=T)

###Fig 4D-F and Fig S6, S7

pdf("top20_bulk_gene2topic_dist.pdf", width=12,height=14)
par(mfrow=c(4,3))

par(cex=0.7)
par(lend=2)
par(tcl= -0.15)
par(mar=c(3,3,3,1)+0.1)
par(mgp=c(1.1, 0.15, 0))

for ( i in 1:10){

  i.order=order(bulk.filt2.lda10[i,], decreasing=T)
  yy=exp(bulk.filt2.lda10[i,i.order[1:20]])
  xx=gsub("\\.protein_coding","",colnames(bulk.filt2.lda10)[i.order[1:20]])

  xbar=barplot(yy, xaxt="n", xlab="", ylab="G2T Prob",main=paste("topic",i),col="#C0C0C0")

  axis(1, labels=xx, at=xbar,cex=0.5,las=2)

}
dev.off()

pdf("top10_exo_microbe2topic_dist.pdf", width=12,height=14)
par(mfrow=c(4,3))

par(cex=0.7)
par(lend=2)
#par(tcl= -0.15)
par(mar=c(7,3,3,1)+0.1)
#par(mgp=c(1.1, 0.15, 0))

for ( i in 1:10){

  i.order=order(exo.filt2.lda10[i,], decreasing=T)
  yy=exp(exo.filt2.lda10[i,i.order[1:10]])
  xx=gsub("X(\\d+)","",colnames(exo.filt2.lda10)[i.order[1:10]])

  xbar=barplot(yy, xaxt="n", xlab="", ylab="M2T Prob",main=paste("topic",i),col="#C0C0C0")

  axis(1, labels=xx, at=xbar,cex=0.5,las=2)

}
dev.off()

##########################################################################################
##                                      #
## randomForest
##########################################################################################
##define positive and negative based on correlation

##bulk.filt2.lda10=read.table(bulk.ldaout, sep="\t", header=T)
##exo.filt2.lda10=read.table(exo.ldaout, sep="\t", header=T)

cor.cut=0.4 #0.4, 0.5, 0.6, 0.7
###log2cor test #cor.cut=0.35

pos.idx =  which(abs(bce.corfilt2) > cor.cut)
pos.b= pos.idx %% nrow(bulk.filt2)
pos.b[which(pos.b == 0)] = nrow(bulk.filt2)
pos.e = ceiling(pos.idx /nrow(bulk.filt2))

neg.tmp.idx = which(abs(bce.corfilt2) < 0.05)
neg.tmp.b = neg.tmp.idx %% nrow(bulk.filt2)
neg.tmp.b[which(neg.tmp.b == 0 )] = nrow(bulk.filt2)

neg.tmp.e  = ceiling(neg.tmp.idx/ nrow(bulk.filt2))

neg.b = neg.tmp.b[which( !neg.tmp.b %in% pos.b & !neg.tmp.e %in% pos.e)]
neg.e = neg.tmp.e[which( !neg.tmp.b %in% pos.b & !neg.tmp.e %in% pos.e)]

#colnames(bce.corfilt2)=paste("X", colnames(bce.corfilt2),sep="")
neg.rand.idx = sample(length(neg.b), length(pos.b), rep=F)
pos.ds = cbind(   t(bulk.filt2.lda10[ , pos.b]) , t(exo.filt2.lda10[, pos.e]))
neg.ds = cbind( t(bulk.filt2.lda10 [, neg.b[neg.rand.idx]]) , t(exo.filt2.lda10[, neg.e[neg.rand.idx]]))

ds.xx = rbind(pos.ds, neg.ds)
ds.xx =cbind(data.frame(y=rep(c("pos","neg"), c(nrow(pos.ds), nrow(neg.ds)))), ds.xx)
ds.xx$y= as.factor(ds.xx$y)
colnames(ds.xx)[-1] = paste("X", colnames(ds.xx)[-1], sep="")

##################################################
####todo: here for cross-validation
##################################################

###where is the model for randomForest
###need to remove the overlapping idx
## pos.b unique, then remove pos.e dup, similar to negative set

pos.b.grp0=split(pos.b, as.factor(pos.e))
pos.b.grp = pos.b.grp0[sample(length(pos.b.grp0), length(pos.b.grp0), rep=F)]
pos.b.grplen= unlist(lapply(pos.b.grp, length))
pos.b.grpcumsum = cumsum(pos.b.grplen)

neg.b.grp0 = split(neg.b, as.factor(neg.e))
neg.b.grp = neg.b.grp0[sample(length(neg.b.grp0), length(neg.b.grp0),rep=F)]
neg.b.grplen =unlist(lapply(neg.b.grp, length))
neg.b.grpcumsum = cumsum(neg.b.grplen)

k0=10
psize = ceiling(sum(pos.b.grplen)/k0)
psize_neg = ceiling(sum(neg.b.grplen)/k0)

method="rf"
res = NULL
ntree=500
uprate=1
for (k in 1:k0){
  cat(k,'\r')
  ###positive
  cid = ((k-1)*psize+1):min(k*psize, sum(pos.b.grplen))
  start=which(pos.b.grpcumsum >= cid[1])[1]
  end = which(pos.b.grpcumsum <=cid[length(cid)])
  end = end[length(end)]

  pos.tmp = pos.b.grp[start:end]
  pos.b0id = unique(unlist(pos.tmp))
  pos.e0id = as.integer(names(pos.tmp))

  te.idx = which(pos.b %in% pos.b0id & pos.e %in% pos.e0id)
  tr.idx = which(!pos.b %in% pos.b0id & !pos.e %in% pos.e0id)

  pte = cbind ( t(bulk.filt2.lda10[ , pos.b[te.idx]]), t(exo.filt2.lda10[, pos.e[te.idx]]))
  ptr = cbind ( t(bulk.filt2.lda10[ , pos.b[tr.idx]]), t(exo.filt2.lda10[, pos.e[tr.idx]]))

  if(FALSE){
  te.idx = sample(length(neg.b), nrow(pte),rep=F)
  neg.b.trtmp = neg.b[-te.idx]
  neg.e.trtmp = neg.e[-te.idx]

  neg.b.trtmp0 = neg.b.trtmp[which(!neg.b.trtmp %in% neg.b[te.idx] & !neg.e.trtmp %in% neg.e[te.idx])]
  neg.e.trtmp0 = neg.e.trtmp[which(!neg.b.trtmp %in% neg.b[te.idx] & !neg.e.trtmp %in% neg.e[te.idx])]

  if (length(neg.b.trtmp0) < 1/2 * nrow(ptr)){
    next
  }
  tr.idx = sample(length(neg.b.trtmp0), nrow(ptr), rep=F)

  nte = cbind ( t(bulk.filt2.lda10[ , neg.b[te.idx]]), t(exo.filt2.lda10[, neg.e[te.idx]]))
  ntr = cbind ( t(bulk.filt2.lda10[ , neg.b[tr.idx]]), t(exo.filt2.lda10[, neg.e[tr.idx]]))
}

  ###neg
  cid = ((k-1)*psize_neg+1):min(k*psize_neg, sum(neg.b.grplen))
  start=which(neg.b.grpcumsum >= cid[1])[1]
  end = which(neg.b.grpcumsum <=cid[length(cid)])
  end = end[length(end)]

  neg.tmp = neg.b.grp[start:end]
  neg.b0id = unique(unlist(neg.tmp))
  neg.e0id = as.integer(names(neg.tmp))
  te.idx = which(neg.b %in% neg.b0id & neg.e %in% neg.e0id)
  tr.idx = which(!neg.b %in% neg.b0id & !neg.e %in% neg.e0id)

  nte = cbind ( t(bulk.filt2.lda10[ , neg.b[te.idx]]), t(exo.filt2.lda10[, neg.e[te.idx]]))
  ntr = cbind ( t(bulk.filt2.lda10[ , neg.b[tr.idx]]), t(exo.filt2.lda10[, neg.e[tr.idx]]))

  ptr = ptr[sample(nrow(ptr), ceiling(uprate*nrow(ntr)),rep=T),]
  pte = pte[sample(nrow(pte), ceiling(uprate*nrow(nte)),rep=T),]

  print(paste('nrow pte, nte', nrow(pte),nrow(nte), 'nrow ptr,ntr', nrow(ptr), nrow(ntr),'\r'))
  te = rbind(pte,nte)
  tr = rbind(ptr, ntr)
  colnames(te)=paste("X", 1:ncol(te),sep="")
  colnames(tr)=paste("X", 1:ncol(tr), sep="")

  te<-cbind(data.frame(y=rep(c(1,0), c(nrow(pte), nrow(nte)))), te)
  tr<-cbind(data.frame(y=rep(c(1,0), c(nrow(ptr), nrow(ntr)))), tr)

  te$y=as.factor(te$y)
  tr$y= as.factor(tr$y)

  tmp<-NULL
  if ( method=="rf"){
    ##stratify
    rfmodel<- randomForest(y~., data=tr, ntree=ntree) #,

  tmp<- predict(rfmodel, te[,-1],type="prob")
  tmp = data.frame(te[,1], tmp[,2])
  ##print(head(tmp))
}else if (method=="logit"){
  logist = glm(y~., data=tr, family=binomial(link='logit'))
  tmp= predict(logist, te[,-1], type="response")
  print(sum(tmp[1:nrow(pte)]>0.5)/nrow(pte))
  tmp = data.frame(te[,1], tmp)
}else if (method=="svm"){
  svm.model=svm(y~., data=tr,probability=TRUE, scale=F)
  tmp=predict(svm.model, newdata=te[,-1], probability = TRUE)
  tmp=data.frame(te[,1], attr(tmp,"probabilities")[,2])
}else if (method=="lasso"){

  las.model=glmnet(as.matrix(tr[,-1]), tr[,1], alpha=1, family="binomial", intercept=TRUE, lambda=lbd0)
  tmp=predict(las.model, newx=as.matrix(te[,-1]), type="response")
  tmp=data.frame(te[,1], tmp)

}else if (method=="svr"){
  svr.model=svm(y~., data=tr, scale=T)
  tmp=predict(svr.model, newdata=te[,-1])
  tmp=data.frame(te[,1], tmp)
}

res=rbind(res,tmp)

}
library("PRROC")
roc1=roc.curve(scores.class0=res[which(res[,1]==1),2], scores.class1=res[which(res[,1]==0),2])$auc
prc1=pr.curve(scores.class0=res[which(res[,1]==1),2], scores.class1=res[which(res[,1]==0),2])

roc1
prc1

library("randomForest")
library("glmnet")
library("e1071")

##################################################
##cross validation

rf.b2e = randomForest(y~., data=ds.xx)
rf.b2e.impt=importance(rf.b2e)

pdf("0rpmlogF_noCtrl/rf_varimp.pdf")
varImpPlot(rf.b2e)
dev.off()

summary(as.vector(b2e.prob))

test.p = c(1:length(bce.corfilt2)) %% nrow(bulk.filt2)
test.p[which(test.p==0)] = nrow(bulk.filt2)
test.e = ceiling(c(1:length(bce.corfilt2)) / nrow(bulk.filt2))

test.ds = cbind( t(bulk.filt2.lda10[, test.p]), t(exo.filt2.lda10[, test.e]))
test.ds = as.data.frame(test.ds)

colnames(test.ds)=colnames(ds.xx)[-1]
#test.pred = predict(rf.b2e, newdata=test.ds, type="prob")
##Error in z[keep, ] <- out.class.votes :
##  NAs are not allowed in subscripted assignments
test.pred=rbind(predict(rf.b2e, newdata=test.ds[c(1:1200000),], type="prob"), predict(rf.b2e, newdata=test.ds[-c(1:1200000),], type="prob"))
b2e.prob= matrix(test.pred[,2], nrow = nrow(bce.corfilt2), ncol=ncol(bce.corfilt2),byrow=F)
#b2e.prob=as.matrix(b2e.prob)

###todo: double check
prob.cut=0.9
#suf2="rpmlas1se"

suf2 = "corcut0.8.rpm.las1se"
b2e.links.idx=which(b2e.prob>prob.cut)  #0.95
###0.7 for lasso

b2e.links.p = b2e.links.idx %% nrow(bulk.filt2)
b2e.links.p[which(b2e.links.p ==0)]=nrow(bulk.filt2)

b2e.links.e = ceiling(b2e.links.idx / nrow(bulk.filt2))

length(unique(b2e.links.p))
length(unique(b2e.links.e))

b2e.links.c0.9=data.frame(gene=gsub("([^:]+):(.+)","\\1", rownames(bulk.filt2)[b2e.links.p]), exo=gsub("(\\d+)(.+)", "\\1:\\2", rownames(exo.filt2)[b2e.links.e]))

write.table(unique(gsub("([^:]+):(.+)","\\1", rownames(bulk.filt2)[b2e.links.p])), file=paste("0rpmlogF_noCtrl/b2e.links.c",prob.cut,"_",suf2, ".gene.txt",sep=""),sep="\t", quote=F, row.names=F, col.names=F)

write.table(b2e.links.c0.9, file=paste("0rpmlogF_noCtrl/b2e.links.probcut",prob.cut,"_",suf2,".txt",sep=""),sep="\t", quote=F, row.names=F, col.names=F)

save(list=ls(),file="rf.link.2ndRun.rdata")

###fig 4B

GAD.raw = read.table("fig4a_corlinks.gene.david.GAD.txt",
                     header=T,stringsAsFactors=F, sep="\t")

terms = c("Asthma", "Arrhythmias, Cardiac|Long QT Syndrome", "Celiac Disease|", "Atrial Fibrillation|",
          "respiratory syncytial virus bronchiolitis", "gastrointestinal symptoms", "Bone Density",
          "Asthma|Bronchial Hyperreactivity|Hypersensitivity, Immediate", "depression | long QT syndrome",
          "Long QT Syndrome|Sinus Tachycardia|Tachycardia, Sinus" , "Sudden Infant Death")
terms.id = rev(which(GAD.raw$Term %in% terms))

pdf("fig4B.pdf", height = 4, width = 6)
par(mar=c(3,22,1,1))
xbar=barplot(-log(GAD.raw[terms.id,"PValue"]),horiz=T,col="orange", xlim=c(2,6), xpd=FALSE)
axis(2, at=xbar, labels=GAD.raw[terms.id, "Term"], las=2)
dev.off()

pdf("Fig4c.pdf")

##x1-x10: bulk 10topic; x11-x20: exo 10topics
varImpPlot(rfmodel,type=2)
dev.off()

####tool for cross-validation
ctool<-function(pdata0, ndata0, k0,lbd0, kk=1, method=c("rf","logit","svm","lasso","softmax"), ntree=500){

require("randomForest")
require("e1071")
require("PRROC")
require("ROCR")
require("glmnet")
require("AUC")

na.p= apply(pdata0[,-1],1,function(x){ y=sum(is.na(x)); y;})
na.n= apply(ndata0[,-1],1,function(x){y=sum(is.na(x)); y;})

nap.idx= which(na.p==0)
nan.idx=which(na.n==0)
aucs=matrix(rep(0,kk*3),ncol=3);
prcs=matrix(rep(0,kk*3),ncol=3);

if (colnames(pdata0)[1] != "y" || colnames(ndata0)[1] != "y"){
print("The first colnames should be the target variable and named as y")
return;
}

if(sum(colnames(pdata0) == colnames(ndata0)) != ncol(pdata0) || ncol(pdata0) != ncol(ndata0)){
print("the pdata and ndata has different number of column")
return
}

xx.col=grep("^[1-9]", colnames(pdata0[,-1]))
if(length(xx.col)>0){
print("The colnames of input file should not start with a number, change it and try again");
return;
}
rocs=NULL

if(length(nap.idx)==0 | length(nan.idx)==0){

print("No data left after removing missing data")
return
}

pdata0=pdata0[nap.idx,]
ndata0=ndata0[nan.idx,]

psize=ceiling(nrow(pdata0)/k0)
nsize=ceiling(nrow(ndata0)/k0)

res.out=NULL
for(k1 in 1:kk){  ##n time

#pdata[,1]=as.factor(pdata[,1])
#ndata[,1]=factor(ndata[,1])
pdata=pdata0[sample(nrow(pdata0),rep=F),]
ndata=ndata0[sample(nrow(ndata0),rep=F),]

res=NULL

for (k in 1:k0){  ## n fold
cat(k,'\r')

cid =((k-1)*psize+1):min(k*psize, nrow(pdata))
ptr=pdata[-cid,]
pte=pdata[cid,]

cid=((k-1)*nsize+1):min(k*nsize, nrow(ndata))
ntr=ndata[-cid,]
nte=ndata[cid,]

tr=rbind(ptr,ntr)
te=rbind(pte,nte)
####
#tr$y=as.factor(as.character(tr$y))
#te$y=as.factor(as.character(te$y))
tmp<-NULL
if ( method=="rf"){
##stratify
rfmodel<- randomForest(y~., data=tr, ntree=ntree) #, sampsize=c(nrow(ptr), nrow(ptr)), strata=tr$y)

tmp<- predict(rfmodel, te[,-1],type="prob")
tmp = data.frame(te[,1], tmp[,2])
#print(head(tmp))
}else if (method=="logit"){
logist = glm(y~., data=tr, family=binomial(link='logit'))
tmp= predict(logist, te[,-1], type="response")
print(sum(tmp[1:nrow(pte)]>0.5)/nrow(pte))
tmp = data.frame(te[,1], tmp)
}else if (method=="svm"){
svm.model=svm(y~., data=tr,probability=TRUE, scale=F)
tmp=predict(svm.model, newdata=te[,-1], probability = TRUE)
tmp=data.frame(te[,1], attr(tmp,"probabilities")[,2])
}else if (method=="lasso"){

las.model=glmnet(as.matrix(tr[,-1]), tr[,1], alpha=1, family="binomial", intercept=TRUE, lambda=lbd0)
tmp=predict(las.model, newx=as.matrix(te[,-1]), type="response")
tmp=data.frame(te[,1], tmp)

}else if (method=="svr"){
svr.model=svm(y~., data=tr, scale=T)
tmp=predict(svr.model, newdata=te[,-1])
tmp=data.frame(te[,1], tmp)
}

res=rbind(res,tmp)

}

print(dim(res))

#print(AUC::auc(roc(res[,2], res[,1])))
###convert class as 1, 0 integer

res.out=rbind(res.out, cbind(res, data.frame(run=rep(k1,nrow(res)))))

}

out=list()
#out[["auc"]]=aucs
#out[["roc"]]=rocs

#out[["res"]]=res.out
#out
res.out
}

####end of to del


context("Test simOccData")

test_that("Test simOccData", {

  sink(file=ifelse(Sys.info()["sysname"] == "Windows",
                   "NUL",
                   "/dev/null"))
  set.seed(125)

  results <- simOccData(nvisit=200, nsite=10, nTP=5, psi=0.5, beta1=182, beta2=20,
                        beta3=100, JD_range = c(100,300))

  head_spp_vis<-structure(list(visit = c(1L, 2L, 3L, 4L, 5L, 6L), mysp = c(1L, 1L, 1L, 1L, 0L, 1L)),
                               .Names = c("visit", "mysp"), row.names = c(NA, 6L), class = "data.frame")

  head_occDetdata<-structure(list(visit = c(1L, 2L, 3L, 4L, 5L, 6L), site = c(1L, 10L, 7L, 4L, 1L, 7L),
                                  L = c(4, 1, 4, 2, 1, 2), TP = c(2L, 2L, 5L, 2L, 5L, 1L),
                                  Jul_date = c(171L, 283L, 299L, 133L, 280L, 298L)),
                             .Names = c("visit", "site", "L", "TP", "Jul_date"), row.names = c(NA, 6L), class = "data.frame")

  head_Z <-matrix(c(1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L), ncol = 5, nrow = 6)

  head_p <-c(0.9999603, 0.1705370, 0.9998911, 0.8201487, 0.2942406, 0.8923152)

  expect_identical(names(results), c('spp_vis','occDetdata','Z','p'))
  expect_equal(head(results$spp_vis), head_spp_vis)
  expect_equal(head(results$occDetdata), head_occDetdata)
  expect_equal(head(results$Z), head_Z)
  expect_equal(head(results$p), head_p, tolerance = 1e-7)

  # Test positive trend with unrestricted Julian date
  set.seed(125)
  resultsB<-simOccData(nvisit=200, nsite=10, nTP=5, psi=0.5, beta1=182, beta2=20,
                       beta3=100,trend = +0.2)

  head_spp_visB<-structure(list(visit = c(1L, 2L, 3L, 4L, 5L, 6L), mysp = c(1L, 1L, 1L, 1L, 0L, 1L)),
                          .Names = c("visit", "mysp"), row.names = c(NA, 6L), class = "data.frame")

  head_occDetdataB<-structure(list(visit = c(1L, 2L, 3L, 4L, 5L, 6L), site = c(1L, 10L, 7L, 4L, 1L, 7L),
                                  L = c(4, 1, 4, 2, 1, 2), TP = c(2L, 2L, 5L, 2L, 5L, 1L),
                                  Jul_date = c(72L, 184L, 200L, 290L, 199L, 91L)),
                             .Names = c("visit", "site", "L", "TP", "Jul_date"), row.names = c(NA, 6L), class = "data.frame")

  head_ZB <-matrix(c(1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 1L, 0L, 1L, 1L), ncol = 5, nrow = 6)

  head_pB <-c(0.9997792, 0.5993916, 0.9999712, 0.8050512, 0.6259862, 0.8923213)

  expect_equal(head(resultsB$spp_vis), head_spp_visB)
  expect_equal(head(resultsB$occDetdata), head_occDetdataB)
  expect_equal(head(resultsB$Z), head_ZB)
  expect_equal(head(resultsB$p), head_pB, tolerance = 1e-7)

  expect_error(results <- simOccData(nvisit=200, nsite=10, nTP=5, psi=0.5, beta1=182, beta2=20, beta3=100, JD_range = c(100,400)),
               'Invalid Julian date range')

  sink()
})


snowcrab.timeseries.db = function( DS="default", p=NULL, regions=c( "cfa4x", "cfanorth", "cfasouth", "cfaall" ), trim=0, vn=NULL, sdci=F ) {

  if (is.null(p)) p = bio.snowcrab::snowcrab_parameters()

  tsoutdir = file.path( p$project.outputdir, "timeseries" )
  dir.create(tsoutdir, showWarnings=FALSE, recursive=TRUE)

  if (DS == "default") return( snowcrab.timeseries.db( DS="biologicals", p=p) )

  if (DS == "biologicals.direct" ) {
    # \\ no saving .. just a direct one-off
    dat = snowcrab.db( DS ="set.biologicals", p=p )
    dat$year = as.character(dat$yr)

    if (is.null(vn)) vn = c( "R0.mass", "t", "R1.mass" )
    yrs = sort(unique(dat$yr))

    #area designations
    for (a in regions) {
      dat[,a] = NA
      ai = NULL
      ai = polygon_inside(dat, a)
      if (length(ai) > 0) dat[ai,a] = a
    }
    tsdata = expand.grid( region=regions, year=yrs, variable=vn, stringsAsFactors=FALSE, KEEP.OUT.ATTRS=FALSE )
    tsdata$year = as.character( tsdata$year)
    tsdata$mean = NA
    tsdata$se = NA
    tsdata$sd = NA
    tsdata$n = NA
    tsdata$ub = NA
    tsdata$lb = NA

    lookup.table = snowcrab.db( p=p, DS="data.transforms" )

    for (vi in 1:length(vn) ) {
      v = vn[vi]
      if ( !is.numeric( dat[,v] ) ) next()
      print( paste( vi, v) )
      XX = bio.snowcrab::variable.recode( dat[,v], v, direction="forward", lookup.table=lookup.table ) # transform variables where necessary
      for (r in regions) {
        ri = which( dat[,r] == r)
        if (length(ri)==0) next()
        XXmean = tapply( XX[ri], INDEX=dat$year[ri], FUN=mean, na.rm=TRUE )
        XXn =  tapply( XX[ri], INDEX=dat$year[ri], FUN=function(x) length(which(is.finite(x))) )
        XXse = tapply( XX[ri], INDEX=dat$year[ri], FUN=sd, na.rm=TRUE ) / XXn
        XXsd = tapply( XX[ri], INDEX=dat$year[ri], FUN=sd, na.rm=TRUE )
        tsi = which(tsdata$variable==v & tsdata$region==r)

        tsdata[ tsi,"mean"] = bio.snowcrab::variable.recode (XXmean[ tsdata[ tsi, "year"] ], v, direction="backward", lookup.table=lookup.table )
        tsdata[ tsi,"n"] = XXn[ tsdata[ tsi, "year"] ]
        tsdata[ tsi,"se"] = bio.snowcrab::variable.recode (XXse[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
        tsdata[ tsi,"sd"] = bio.snowcrab::variable.recode (XXsd[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
        XXlb = XXmean - XXse* 1.96
        XXub = XXmean + XXse* 1.96
        if(sdci){
          XXlb = XXmean - XXsd* 1.96
          XXub = XXmean + XXsd* 1.96
        }
        tsdata[ tsi,"lb"] = bio.snowcrab::variable.recode (XXlb[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
        tsdata[ tsi,"ub"] = bio.snowcrab::variable.recode (XXub[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
      }
    }
    tsdata$year = as.numeric( tsdata$year)
    return(tsdata)
  }

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

  if (DS %in% c( "biologicals", "biologicals.redo" ) ) {
    fn = file.path( tsoutdir, "snowcrab.timeseries.rdata" )
    if (DS=="biologicals") {
      tsdata = NULL
      if (file.exists( fn) ) load(fn)
      return(tsdata)
    }

    dat = snowcrab.db( DS ="set.biologicals", p=p )
    dat$year = as.character(dat$yr)

    if (is.null(vn)) vn = setdiff( colnames(dat), c("trip", "set", "set_type", "station", "lon1", "lat1", "towquality", "lon", "lat", "plon", "plat", "seabird_uid", "minilog_uid", "netmind_uid" ) )
    yrs = sort(unique(dat$yr))

    #area designations
    for (a in regions) {
      dat[,a] = NA
      ai = NULL
      ai = polygon_inside(dat, a)
      if (length(ai) > 0) dat[ai,a] = a
    }

    tsdata = expand.grid( region=regions, year=yrs, variable=vn, stringsAsFactors=FALSE, KEEP.OUT.ATTRS=FALSE )
    tsdata$year = as.character( tsdata$year)
    tsdata$mean = NA
    tsdata$se = NA
    tsdata$sd = NA
    tsdata$n = NA
    tsdata$ub = NA
    tsdata$lb = NA

    lookup.table = snowcrab.db( p=p, DS="data.transforms" )

    for (vi in 1:length(vn) ) {
      v = vn[vi]
      if ( !is.numeric( dat[,v] ) ) next()
      print( paste( vi, v) )
      XX = bio.snowcrab::variable.recode( dat[,v], v, direction="forward", lookup.table=lookup.table ) # transform variables where necessary
      for (r in regions) {
        ri = which( dat[,r] == r)
        if (length(ri)==0) next()
        XXmean = tapply( XX[ri], INDEX=dat$year[ri], FUN=mean, na.rm=TRUE )
        XXn =  tapply( XX[ri], INDEX=dat$year[ri], FUN=function(x) length(which(is.finite(x))) )
        XXse = tapply( XX[ri], INDEX=dat$year[ri], FUN=sd, na.rm=TRUE ) / XXn
        XXsd = tapply( XX[ri], INDEX=dat$year[ri], FUN=sd, na.rm=TRUE )
        tsi = which(tsdata$variable==v & tsdata$region==r)

        tsdata[ tsi,"mean"] = bio.snowcrab::variable.recode (XXmean[ tsdata[ tsi, "year"] ], v, direction="backward", lookup.table=lookup.table )
        tsdata[ tsi,"n"] = XXn[ tsdata[ tsi, "year"] ]
        tsdata[ tsi,"se"] = bio.snowcrab::variable.recode (XXse[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
        tsdata[ tsi,"sd"] = bio.snowcrab::variable.recode (XXsd[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
        XXlb = XXmean - XXse* 1.96
        XXub = XXmean + XXse* 1.96
        if(sdci){
          XXlb = XXmean - XXsd* 1.96 # confidence intervals for population instead of mean
          XXub = XXmean + XXsd* 1.96
        }
        tsdata[ tsi,"lb"] = bio.snowcrab::variable.recode (XXlb[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
        tsdata[ tsi,"ub"] = bio.snowcrab::variable.recode (XXub[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
      }
    }
    tsdata$year = as.numeric( tsdata$year)
    save( tsdata, file=fn, compress=TRUE )
    return( fn)
  }

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

  if (DS %in% c( "biologicals.2014", "biologicals.2014.redo" ) ) {
    #\\ "reduced" subset of stations found in 2014 ... to be comparable with smaller survey
    fn = file.path( tsoutdir, "snowcrab.timeseries.2014.rdata" )
    if (DS=="biologicals.2014") {
      tsdata = NULL
      if (file.exists( fn) ) load(fn)
      return(tsdata)
    }

    dat = snowcrab.db( DS ="set.biologicals", p=p )
    dat$year = as.character(dat$yr)
    stations.in.2014 = unique( dat$station[ which(dat$yr==2014) ] )
    dat = dat[ which(dat$station %in% stations.in.2014 ),]

    vn = setdiff( colnames(dat), c("trip", "set", "set_type", "station", "lon1", "lat1", "towquality",
                                   "lon", "lat", "plon", "plat", "seabird_uid", "minilog_uid", "netmind_uid" ) )
    yrs = sort(unique(dat$yr))

    print( "This will take a bit of time... " )
    print( paste( "There are", length(vn), "variables" ) )

    #area designations
    for (a in regions) {
      dat[,a] = NA
      ai = NULL
      ai = polygon_inside(dat, a)
      if (length(ai) > 0) dat[ai,a] = a
    }

    tsdata = expand.grid( region=regions, year=yrs, variable=vn, stringsAsFactors=FALSE, KEEP.OUT.ATTRS=FALSE )
    tsdata$year = as.character( tsdata$year)
    tsdata$mean = NA
    tsdata$se = NA
    tsdata$n = NA
    tsdata$ub = NA
    tsdata$lb = NA
    lookup.table = snowcrab.db( p=p, DS="data.transforms" )

    for (vi in 1:length(vn) ) {
      v = vn[vi]
      if ( !is.numeric( dat[,v] ) ) next()
      print( paste( vi, v) )
      XX = bio.snowcrab::variable.recode( dat[,v], v, direction="forward", lookup.table=lookup.table ) # transform variables where necessary
      for (r in regions) {
        ri = which( dat[,r] == r)
        if (length(ri)==0) next()
        XXmean = tapply( XX[ri], INDEX=dat$year[ri], FUN=mean, na.rm=TRUE )
        XXn =  tapply( XX[ri], INDEX=dat$year[ri], FUN=function(x) length(which(is.finite(x))) )
        XXse = tapply( XX[ri], INDEX=dat$year[ri], FUN=sd, na.rm=TRUE ) / XXn
        tsi = which(tsdata$variable==v & tsdata$region==r)

        tsdata[ tsi,"mean"] = bio.snowcrab::variable.recode (XXmean[ tsdata[ tsi, "year"] ], v, direction="backward", lookup.table=lookup.table )
        tsdata[ tsi,"n"] = XXn[ tsdata[ tsi, "year"] ]
        tsdata[ tsi,"se"] = bio.snowcrab::variable.recode (XXse[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
        XXlb = XXmean - XXse* 1.96
        XXub = XXmean + XXse* 1.96
        tsdata[ tsi,"lb"] = bio.snowcrab::variable.recode (XXlb[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
        tsdata[ tsi,"ub"] = bio.snowcrab::variable.recode (XXub[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
      }
    }
    tsdata$year = as.numeric( tsdata$year)
    save( tsdata, file=fn, compress=TRUE )
    return( fn)
  }

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

  if (DS %in% c( "observer", "observer.redo" ) ) {
    #\\ "reduced" subset of stations found in 2014 ... to be comparable with smaller survey
    fn = file.path( tsoutdir, "snowcrab.observer.timeseries.rdata" )
    if (DS=="observer") {
      tsdata = NULL
      if (file.exists( fn) ) load(fn)
      return(tsdata)
    }

    dat = observer.db( DS="odb" )
    dat$yr=dat$fishyr #Bz March 2019- We want the fishing year (2018/19= 2018), not the calendar year of catch
    dat$year = as.character(dat$yr)
    #dat = dat[ which( dat$cw >= 95),] #BZ March 2019- We want to keep all observed animals, not just cw>95
    vn = c( "cw", "totmass", "abdomen", "chela", "shell", "durometer",  "cpue.kg.trap", "mass", "mat" )
    yrs = sort(unique(dat$yr))

    # print( "This will take a bit of time... " )
    # print( paste( "There are", length(vn), "variables" ) )

    #area designations
    for (a in regions) {
      dat[,a] = NA
      ai = NULL
      ai = polygon_inside(dat, a)
      if (length(ai) > 0) dat[ai,a] = a
    }

    tsdata = expand.grid( region=regions, year=yrs, variable=vn, stringsAsFactors=FALSE, KEEP.OUT.ATTRS=FALSE )
    tsdata$mean = NA
    tsdata$se = NA
    tsdata$n = NA
    tsdata$ub = NA
    tsdata$lb = NA
    tsdata$year = as.character( tsdata$year)
    lookup.table = snowcrab.db( p=p, DS="data.transforms" )

    for (vi in 1:length(vn) ) {
      v = vn[vi]
      if ( !is.numeric( dat[,v] ) ) next()
      print( paste( vi, v) )
      XX = bio.snowcrab::variable.recode( dat[,v], v, direction="forward", lookup.table=lookup.table ) # transform variables where necessary
      for (r in regions) {
        ri = which( dat[,r] == r)
        if (length(ri)==0) next()
        XXmean = tapply( XX[ri], INDEX=dat$year[ri], FUN=mean, na.rm=TRUE )
        XXn =  tapply( XX[ri], INDEX=dat$year[ri], FUN=function(x) length(which(is.finite(x))) )
        XXse = tapply( XX[ri], INDEX=dat$year[ri], FUN=sd, na.rm=TRUE ) / XXn
        tsi = which(tsdata$variable==v & tsdata$region==r)

        tsdata[ tsi,"mean"] = bio.snowcrab::variable.recode (XXmean[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
        tsdata[ tsi,"n"] = XXn[ tsdata[ tsi, "year"] ]
        tsdata[ tsi,"se"] = bio.snowcrab::variable.recode (XXse[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
        XXlb = XXmean - XXse* 1.96
        XXub = XXmean + XXse* 1.96
        tsdata[ tsi,"lb"] = bio.snowcrab::variable.recode (XXlb[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
        tsdata[ tsi,"ub"] = bio.snowcrab::variable.recode (XXub[ tsdata[ tsi, "year"] ], v, direction="backward" , lookup.table=lookup.table)
      }
    }
    tsdata$year = as.numeric( tsdata$year)
    save( tsdata, file=fn, compress=TRUE )
    return( fn)
  }

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

  if (DS %in% c( "groundfish.t", "groundfish.t.redo" ) ) {
    #\\ "reduced" subset of stations found in 2014 ... to be comparable with smaller survey
    fn = file.path( tsoutdir, "groundfish.t.rdata" )
    if (DS=="groundfish.t") {
      tsdata = NULL
      if (file.exists( fn) ) load(fn)
      return(tsdata)
    }
    tsdata = data.frame(r=NA,yrs=NA,V3='t',meanval=NA,se=NA,n=NA,ub=NA,lb=NA)
    h = groundfish.db( DS='gshyd')
    g = groundfish.db(DS='gsinf')
    g = g[,c('id','sdate','lon','lat','bottom_temperature')]
    h = h[,c('id','temp')]
    names(h)[2] <- 'bottom_temperature'
    f <- merge(g,h,by='id',all.x=T)
    i <- which(is.na(f$bottom_temperature.x) & !is.na(f$bottom_temperature.y))
    f[i,'bottom_temperature.x'] <- f[i,'bottom_temperature.y']
    f$yr <- as.numeric(format(f$sdate,'%Y'))
    f <- fishing.area.designations(f)
    ar <- unique(f$cfa)
    yy <- unique(f$yr)
    yy <- yy[order(yy)]
    for (r in ar) {
      for (yrs in yy) {
        y = f[which(f$yr == yrs & f$cfa ==r & !is.na(f$bottom_temperature.x)),]
        if(nrow(y)>3) {
          ym <- min(y$bottom_temperature.x[y$bottom_temperature.x>0])
          q = log(y$bottom_temperature.x+ym)
          m =  mean (q, na.rm=T)
          n = length(q)
          se = sd(q, na.rm=T)/ sqrt(n-1)
          meanval = exp(m)-ym
          ub = exp(m+se*1.96)-ym
          lb = exp(m-se*1.96)-ym
          j = as.data.frame(cbind(r, yrs, 't',meanval, se, n, ub, lb))
          tsdata <- rbind(tsdata,j)
        }
      }
    }
    #browser()
    colnames(tsdata) = c("region", "year", "variable","mean", "se","n", "ub", "lb")
    numbers = c("year", "mean", "se", "n", "ub", "lb")
    tsdata = factor2number(tsdata, numbers)
    tsdata <- tsdata[!is.na(tsdata$year),]

    save(tsdata, file=fn, compress=T)
    return(fn)
  }

}


context("rep")

test_that("vector", {
    ref = rbind(1:2, 1:2)
    expect_equal(ref, rep(1:2, 2, along=1))
    expect_equal(ref, t(rep(1:2, 2, along=2)))
    expect_equal(ref, rrep(1:2, 2))
    expect_equal(ref, t(crep(1:2, 2)))
})

test_that("keep names", {
    x = setNames(1:2, letters[1:2])
    m = rep(x, 2, along=2)

    expect_equal(names(x), rownames(m))

    colnames(m) = LETTERS[1:2]
    expect_equal(rbind(m, m), rep(m, 2, along=1))
    expect_equal(rbind(m, m), rrep(m, 2))

    expect_equal(cbind(m, m), rep(m, 2, along=2))
    expect_equal(cbind(m, m), crep(m, 2))
})


#Plot the memory model, first argument is the upperbound, the the dataset containing the plotting data
#Load Data
args<-commandArgs(TRUE)
upperbound <- as.integer(args[1])
dataset <- read.csv(args[2])
filename = gsub(".csv", "", args[2])
fileNameEt <- paste(filename, "_AVG_B.png", sep="")
graphtitle1 <- "MEMORY BEFORE RESULT EN0-EN9"
graphtitle2 <- "MEMORY BEFORE AVG RESULT "
png(paste(fileNameEt), 1827, 1458)
png(paste(filename, "_AVG_B_THUMBNAIL.png"), 150, 121)

#upperbound <- max(cbind(dataset$MEMB0,dataset$MEMB1 ,dataset$MEMB2 ,dataset$MEMB3 ,dataset$MEMB4,dataset$MEMB5,dataset$MEMB6,dataset$MEMB7,dataset$MEMB8,dataset$MEMB9))
xmean <- rowMeans(cbind(dataset$MEMB0,dataset$MEMB1 ,dataset$MEMB2 ,dataset$MEMB3 ,dataset$MEMB4,dataset$MEMB5,dataset$MEMB6,dataset$MEMB7,dataset$MEMB8,dataset$MEMB9))
plotsummary = summary(xmean)

#Plot the AVG
plot(xmean ~ dataset$ENUM, type="l", col="brown", ylab = "memory B", xlab = "Events", yaxt="n", ylim=c(0,upperbound), ,axes=FALSE)
par(new=TRUE)

abline(h = mean(xmean), v = 0 , col = "gray60")
par(new=TRUE)
abline(h = mean(xmean[200:999]), v = 0, col = "red2")
par(new=TRUE)

#Better Axis
axis(1, at = seq(min(dataset$ENUM), max(dataset$ENUM)+1, by = 25))
axis(2, at = seq(0,  10 + (upperbound - upperbound %% 10), by = 10))

#Grid Behind
grid(nx = NULL, ny = NULL, col = "gray1", lty = "dotted",lwd = par("lwd"), equilogs = TRUE)

#Usefult informations
for(j in seq(1,6,1)){
  text(800, upperbound -(40*(j-1)), (paste(names(plotsummary)[j],as.vector(plotsummary)[j])) , cex = 1, adj = 0)
}
text(300, upperbound - 55, paste("Stationary Mean",mean(xmean[200:999])) , cex = 1, adj = 0)

title(graphtitle1,filename)

dev.off()


library(ggplot2)
library(data.table)

evec<-fread("../../Results/Genetic_pca/ADAPT_1000G_NoPalin_LDPrune_Euro_NoFins_ADAPTRef.pca.evec",header=T)
eval<-fread("../../Results/Genetic_pca/ADAPT_1000G_NoPalin_LDPrune_Euro_NoFins_ADAPTRef.pca.eval")
colnames(eval)<-c("Eigenvalue")
eval$gPC<-seq(1,nrow(eval),1)

scree<-ggplot(data=eval[which(eval$gPC<11),],aes(gPC,Eigenvalue))+
  geom_point()+
  geom_line()+
  theme_bw()+
  scale_x_continuous(breaks=seq(1,10))+
  ylim(c(1,4))

ggsave("../../Results/Genetic_pca/gPC_screeplot_1_10_09102018.pdf",scree,height=5,width=7)


#' Calculate percentage change between two years using Bayesian output
#'
#' Using the data returned from occDetModel/occDetFunc this function models a
#' trend between two years for each iteration of the models. Several options are
#' available for the method used to calculate the trend. This distribution of the results is used to
#' calculate the mean estimate and the 95% credibale intervals.
#'
#' @param bayesOut occDet object as returned from occDetModel or occDetFunc.
#' @param firstYear numeric, the first year over which the change is to be estimated. Defaults to the final year in the dataset
#' @param lastYear numeric, the last year over which the change is to be estimated. Defaults to the first year in the dataset
#' @param change A character string that specifies the type of change to be calculated, the default
#' is annual growth rate.  See details for options.
#' @param region A character string specifying the region name if change is to be determined regional estimates of occupancy.
#' Region names must match those in the model output.
#'
#'
#' @details \code{change} is used to specify which change measure to be calculated.
#' There are four options to choose from: difference, percentdif, growthrate and
#' lineargrowth.
#'
#' \code{difference} calculates the simple difference between the first and last year.
#'
#' \code{percentdif} calculates the percentage difference between the first and last year.
#'
#' \code{growthrate} calculates the annual growth rate across years.
#'
#' \code{lineargrowth} calculates the linear growth rate from a linear model.
#'
#' @return A list giving the mean, median, credible intervals and raw data from the
#' estimations.
#' @examples
#' \dontrun{
#'
#' #' # Create data
#' n <- 15000 #size of dataset
#' nyr <- 20 # number of years in data
#' nSamples <- 100 # set number of dates
#' nSites <- 50 # set number of sites
#'
#' # Create somes dates
#' first <- as.Date(strptime("1980/01/01", "%Y/%m/%d"))
#' last <- as.Date(strptime(paste(1980+(nyr-1),"/12/31", sep=''), "%Y/%m/%d"))
#' dt <- last-first
#' rDates <- first + (runif(nSamples)*dt)
#'
#' # taxa are set as random letters
#' taxa <- sample(letters, size = n, TRUE)
#'
#' # three sites are visited randomly
#' site <- sample(paste('A', 1:nSites, sep=''), size = n, TRUE)
#'
#' # the date of visit is selected at random from those created earlier
#' survey <- sample(rDates, size = n, TRUE)
#'
#' # run the model with these data for one species
#' results <- occDetModel(taxa = taxa,
#'                        site = site,
#'                        survey = survey,
#'                        species_list = c('a','m','g'),
#'                        write_results = FALSE,
#'                        n_iterations = 1000,
#'                        burnin = 10,
#'                        thinning = 2)
#'
#'  # estimate the change for one species
#'  change <- occurrenceChange(firstYear = 1990,
#'                             lastYear = 1999,
#'                             bayesOut = results$a)
#' }
#' @export

occurrenceChange <- function(bayesOut, firstYear=NULL, lastYear=NULL, change = 'growthrate', region = NULL){

  # error checks for years (or set to defaults)
  if(is.null(firstYear))
    firstYear <- bayesOut$min_year
  else
    if(!firstYear %in% bayesOut$min_year:bayesOut$max_year) stop('firstYear must be in the year range of the data')

  if(is.null(lastYear))
    lastYear <- bayesOut$max_year
  else
    if(!lastYear %in% bayesOut$min_year:bayesOut$max_year) stop('lastYear must be in the year range of the data')

  # error checks for change
  if(!class(change) == 'character') stop('Change must be a character string identifying the change metric.  Either: difference, percentdif, growthrate or lineargrowth')
  if(!change %in% c('difference', 'percentdif', 'growthrate', 'lineargrowth')) stop('The change metric must be one of the following: difference, percentdif, growthrate or lineargrowth')

  # error check for region
  if(!is.null(region)){
    if(!class(region) == 'character') stop('region must be a character string identifying the regional estimates that change is to be calculated for.')
    if(!region %in% bayesOut$regions) stop('region must match that used in the model output file, check spelling.')
  }

  # extract the sims list, if there is a region code, use the psi.fs for that region
  if(!is.null(region)){
    reg_code <- paste("psi.fs.r_", region, sep = "")

    occ_it <- bayesOut$BUGSoutput$sims.list
    occ_it <- occ_it[[grep(reg_code, names(occ_it))]]

  }else{
    occ_it <- bayesOut$BUGSoutput$sims.list$psi.fs

  }

  colnames(occ_it) <- bayesOut$min_year:bayesOut$max_year
  years <- firstYear:lastYear

  ## edit values that are 0 or 1 to prevent estimates of inf later on
  #occ_it[occ_it == 0] <- 0.0001
  #occ_it[occ_it == 1] <- 0.9999

  ### loops depend on which change metric has been specified

  if(change == 'lineargrowth'){
      prediction <- function(years, series){

      # cut data
      data_table <- data.frame(occ = series[as.character(years)], year = (years - min(years) + 1))

      # run model
      model <- glm(occ ~ year, data = data_table, family = 'quasibinomial')

      # create predicted values
      predicted <- plogis(predict(model))
      names(predicted) <- years

      # build results
      results <- data.frame(predicted[1], predicted[length(predicted)], row.names = NULL)
      colnames(results) <- as.character(c(min(years), max(years)))
      results$change = (results[,2] - results[,1]) / results[,1]

      return(results)

    }

    res_tab <- do.call(rbind, apply(X = occ_it, MARGIN = 1, years = years, FUN = prediction))

  } # end of loop for linear growth rate

  if(change == 'difference'){
    first <- years[1]
    last <- years[length(years)]
    res_tab <- data.frame(occ_it[, colnames(occ_it) == first],
                          occ_it[, colnames(occ_it) == last],
                          row.names = NULL)
    colnames(res_tab) <- as.character(c(min(years), max(years)))
    res_tab$change = res_tab[,2] - res_tab[,1]
  } # end of loop for simple difference

  if(change == 'percentdif'){
    first <- years[1]
    last <- years[length(years)]
    res_tab <- data.frame(occ_it[, colnames(occ_it) == first],
                          occ_it[, colnames(occ_it) == last],
                          row.names = NULL)

    ## edit 0 in the first year with some small value to prevent Infinite trends
    res_tab[,1][res_tab[,1] == 0] <- 0.0000001

    colnames(res_tab) <- as.character(c(min(years), max(years)))
    res_tab$change = ((res_tab[,2] - res_tab[,1])/res_tab[,1])*100
  } # end of loop for percentage difference

  if(change == 'growthrate'){
    nyr <- length(years)
    first <- years[1]
    last <- years[length(years)]
    res_tab <- data.frame(occ_it[, colnames(occ_it) == first],
                          occ_it[, colnames(occ_it) == last],
                          row.names = NULL)

    ## edit 0 in the first year with some small value to prevent Infinite trends
    res_tab[,1][res_tab[,1] == 0] <- 0.0000001

    colnames(res_tab) <- as.character(c(min(years), max(years)))
    res_tab$change = (((res_tab[,2]/res_tab[,1])^(1/nyr))-1)*100
  } # end of loop for growth rate

  # return the mean, quantiles, and the data
  return(list(mean = mean(res_tab$change),
              median = median(res_tab$change),
              CIs = quantile(res_tab$change, probs = c(0.025, 0.975)),
              data = res_tab))

}


# plotrocs_query200.r - plot ROCs for different methods on query200 data set
#
# Alex Stivala, March 2009
#
# Plot ROC curves for different methods on the query200 query set in
# ASTRAL SCOP 95% sequence nr data set
#
# Requires the ROCR package from CRAN (developed with version 1.0-2)
# (ROCR in turn requires gplots, gtools, gdata)
#
# Run this on the output of e.g. tsevalfn.py with the -l option,
# it is a table with one column of scores from classifier, and second
# column of true class label (0 or 1)
#
# The citation for the ROCR package is
#   Sing et al 2005 "ROCR: visualizing classifier performance in R"
#   Bioinformatics 21(20):3940-3941
#
#
# $Id: plotrocs_query200.r 2376 2009-05-14 01:40:32Z astivala $

library(ROCR)

#
# globals
#

colorvec=c('deepskyblue4','brown','red','turquoise','blue','purple','green','cyan','gray20','magenta','darkolivegreen2','midnightblue','magenta3','darkseagreen','violetred3','darkslategray3')
ltyvec=c(1,2,4,5,6,1,2,1,5,6,1,2,4,5,6,1,2)
namevec=c('QP tableau search (norm2)','VAST','SHEBA','TableauSearch (norm2)', 'TOPS')
slrtabs=c('query200/norm2/query200_roc.slrtab','../other_results/vast/vast_query200_res/vast_query200_roc.slrtab','../other_results/sheba/query200-pdbstyle-sel-gs-bib-95-1.73/sheba_query200_roc.slrtab','../other_results/TableauSearch/query200/norm2/tabsearch_query200_roc.slrtab','../other_results/tops/query200/tops_query200_roc.slrtab')

#
# functions
#

#
# Return the ROCR performance object for plotting ROC curve
#
# Parameters:
#   tab : data frame with score and label columns
#
# Return value:
#   ROCR performance object with FPR and TPR for plotting ROC curve
#
compute_perf <- function(tab)
{
    # tab is a data frame with score and label columns
    pred <- prediction(tab$score, tab$label)
    perfroc <- performance(pred, measure="tpr",x.measure="fpr")
    return(perfroc)
}

#
# main
#

# EPS suitable for inserting into LaTeX

postscript('rocs_query200.eps',
           onefile=FALSE,paper="special",horizontal=FALSE,
           width = 9, height = 6)
for (i in 1:length(slrtabs)) {
    tab <- read.table(slrtabs[i], header=TRUE)
    perfroc <- compute_perf(tab)
    plot(perfroc, lty=ltyvec[i], col=colorvec[i], add=(i>1),
         downsampling=0.5,
#         main='ROC for 200 queries in ASTRAL SCOP 95% sequence identity nonredundant data set' # no title since including in paper with caption
         )
}
legend('bottomright', col=colorvec, lty=ltyvec, legend=namevec)
#lines(c(0,1),c(0,1),type='l',lty=3)
dev.off()


sum.2.pos.number <- function(x, y){
  if(x > 0 & y > 0){
  z <- x + y
  return(z)
  }else{
    stop('at least one value is negative')
  }
}

{
  a <- 3
  b <- -2

  c <- sum.2.pos.number(a, b)
  print(c)

  d <- a + as.numeric(c)
  print(d)
}


# This file is Wei Wu's code in participating
# Kaggle "American Epilepsy Society Seizure Prediction Challenge" Competition
#
# Copyright (c) 2014, Wei Wu
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.

require(R.matlab)

read_one_matfile <- function (filename) {
	retval=list()
	a=readMat(filename)
	retval[["mat"]]=a[[1]][[1]]
	retval[["seconds"]]=as.numeric(a[[1]][[2]])
	retval[["freq"]]=as.numeric(a[[1]][[3]])
	retval[["labels"]]=unlist(a[[1]][[4]])
	if (length(a[[1]]) > 4) {
		retval[["seq"]]=as.numeric(a[[1]][[5]])
	} else {
		retval[["seq"]]=-1
	}
	rm(a);gc()
	retval
}

down_sampling <- function (data, factor = 1) {
	if (factor <= 1) {
		return(data)
	}
	not_multi=is.null(nrow(data))
	if (not_multi) {
		newlen=floor(length(data)/factor)
		if (newlen > 1) {
			newdata=sapply(1:newlen, FUN=function(i, d, f) { mean(d[round((i-1)*f+1):round(i*f)]) },
				d=data, f=factor)
		}
	} else {
		newlen=floor(ncol(data)/factor)
		if (newlen > 1) {
			newdata=sapply(1:newlen,
				FUN=function(i, d, f) {
					col_start=round((i-1)*factor+1);
					col_end=round(i*factor);
					if (col_end > col_start) {
						rowMeans(d[,col_start:col_end])
					} else {
						d[,col_start]
					}
				},
				d=data, f=factor)
		} else {
			newdata=data
		}
	}
	newdata
}

gen_features_onearray <- function (indata, pre, freqs) {
	feats=c()
	sumheads=c('Min','1stQrt','Med','Mean','3rdQrt','Max')
	sumindex=c(4,6)
	sumheads=sumheads[sumindex]
	a=summary(indata)[sumindex]
	heads=paste0(pre,"_",sumheads)
	feats[heads]=a
	feats[paste0(pre,"_","Sd")]=sd(abs(indata))
	a=summary(abs(indata))[sumindex]
	heads=paste0(pre, "Amp", "_",sumheads)
	feats[heads]=a
	feats[paste0(pre,"Amp_Sd")]=sd(abs(indata))
	freqs=freqs[1:length(indata)]
#	cat(paste("In gen_features_onearray(), before fft size is:",paste(dim(indata),collapse=','),"\n"))
#	flush.console()
#	b=Sys.time()
	if (dolog == 1) {
		myfft=log(abs(fft(indata))+1)
	} else {
		myfft=abs(fft(indata))
	}
	a=summary(myfft)[sumindex]
#	cat(paste("After fft, time used:",format(Sys.time()-b),"\n"));flush.console()
	heads=paste0(pre,"FFT_",sumheads)
	feats[heads]=a
	feats[paste0(pre,"FFT_","Sd")]=sd(myfft)
	feats[paste0(pre,"FFT_","MaxFreq")]=freqs[which.max(myfft)]
	if (addFFT == 1 || addFFT == 2) {
		if (addFFT == 2) {
			myfft=(myfft-mean(myfft))/sd(myfft)
		}
		myfft=myfft[1:round(FFTratio*length(myfft))]
		myfft=down_sampling(myfft, round(length(myfft)/FFTavglen))
		colnames=paste0(pre,"FFT_",sprintf("%02d",1:length(myfft)))
		feats[colnames]=myfft
	}
	feats
}

gen_features_oneseries <- function (indata, pre, freqs) {
	feats=c()
	indata=as.vector(indata)
	delta1=rep(0,length(indata))
	delta1[1:(length(indata)-1)]=indata[2:length(indata)]-indata[1:(length(indata)-1)]
	delta2=rep(0,length(indata))
	delta2[1:(length(delta1)-2)]=delta1[2:(length(delta1)-1)]-delta1[1:(length(delta1)-2)]
	feats=c(feats, gen_features_onearray(indata, paste0(pre,""), freqs))
	feats=c(feats, gen_features_onearray(delta1, paste0(pre,"Del1"), freqs))
	feats=c(feats, gen_features_onearray(delta2, paste0(pre,"Del2"), freqs))
	feats
}

gen_features_onefile <- function (indata, f, t) {
	b=Sys.time()
	feats=c()
	chans=nrow(indata)
	nc=ncol(indata)
	if (round(f*t) != nc) {
		stop(paste("Stop in gen_features_onefile(), f*t=",f*t,"!= number of data points,",nc))
	}
	freqs=(1:nc)*1/t
	for (i in 1:chans) {
		prename=paste0("chan",i)
		feats=c(feats,gen_features_oneseries (indata[i,], pre=prename, freqs))
	}
	fnames=names(feats)
#	cat(paste("Total number of features before global features",length(feats),format(Sys.time()-b),"\n"))
#	flush.console()
#	uniq_postfix=grep('^chan[0-9]*FFT_[0-9][0-9]',fnames,invert=T,value=T)
	uniq_postfix=fnames
	uniq_postfix=unique(gsub('^chan[0-9]*','',uniq_postfix))
	for (mypost in uniq_postfix) {
		pre=paste0("All",mypost)
		mynames=grep(paste0('^chan[0-9]*',mypost),fnames,value=T)
		mydata=feats[mynames]
		sumheads=c('Min','1stQrt','Med','Mean','3rdQrt','Max')
		sumindex=c(4,6)
		sumheads=sumheads[sumindex]
		a=summary(mydata)[sumindex]
		heads=paste0(pre, "_",sumheads)
		feats[heads]=a
		feats[paste0(pre,"_","Sd")]=sd(abs(mydata))
	}
#	cat(paste("Total number of features after AllCh features",length(feats),format(Sys.time()-b),"\n"))
#	flush.console()
	feats=c(feats,gen_features_oneseries (colMeans(indata), pre="chanAvg", freqs))
#	cat(paste("Total number of features after chAvg features",length(feats),format(Sys.time()-b),"\n"))
#	flush.console()
	mydata=indata
	for (del in 0:2) {
		if (del != 0) {
			mydata_tmp=matrix(rep(0,length(indata)), nrow=nrow(indata))
			mydata_tmp[,1:(ncol(mydata)-del)]=mydata[,2:(ncol(mydata)-del+1)]-mydata[,1:(ncol(mydata)-del)]
			mydata=mydata_tmp
			rm(mydata_tmp)
			pre=paste0("Del",del)
		} else {
			mydata=indata
			pre=""
		}
		cov=cov(t(mydata))
#		cat(paste("Size of data is:", paste(dim(mydata),collapse=','),
#			"Size of covar is:",paste(dim(cov),collapse=','),"\n"));flush.console()
		covarray=abs(cov[upper.tri(cov)])
		feats[paste0(pre,'CovMean')]=mean(covarray)
		feats[paste0(pre,'CovSd')]=sd(covarray)
		covarray=covarray[order(covarray,decreasing=T)]
		feats[paste0(pre,'CovMax')]=covarray[1]
		feats[paste0(pre,'Cov2nd')]=covarray[2]
		feats[paste0(pre,'Cov3rd')]=covarray[3]
#		cat(paste("Before FFT", format(Sys.time()-b),"\n"));flush.console()
		myfft=matrix(rep(0,length(mydata)),nrow=nrow(mydata))
		for (i in 1:chans) {
			if (dolog == 1) {
				myfft[i,]=log(abs(fft(mydata[i,]))+1)
			} else {
				myfft[i,]=abs(fft(mydata[i,]))
			}
		}
#		cat(paste("After FFT", format(Sys.time()-b),"\n"));flush.console()
		pre=paste0(pre,"FFT")
		cov=cov(t(myfft))
#		cat(paste("Size of FFT data is:", paste(dim(myfft),collapse=','),
#			"Size of FFT covar is:",paste(dim(cov),collapse=','),"\n"));flush.console()
		covarray=abs(cov[upper.tri(cov)])
		feats[paste0(pre,'CovMean')]=mean(covarray)
		feats[paste0(pre,'CovSd')]=sd(covarray)
		covarray=covarray[order(covarray,decreasing=T)]
		feats[paste0(pre,'CovMax')]=covarray[1]
		feats[paste0(pre,'Cov2nd')]=covarray[2]
		feats[paste0(pre,'Cov3rd')]=covarray[3]
#		gc()
#		cat(paste("Total number of features after Del",del,"covar features",length(feats),
#			format(Sys.time()-b),"\n"))
#		flush.console()
	}
#	cat(paste("Total number of features after covar features",length(feats),format(Sys.time()-b),"\n"))
	flush.console()
	feats
}

split_mat <- function (mymat, nsplit) {
	if (ncol(mymat) %% nsplit != 0) {
		stop(paste("In split_mat(), the nsplit",nsplit,"and column number",ncol(mymat),"do not match to even blocks."))
	}
	retdata=list()
	mysize=ncol(mymat) / nsplit
	for (i in 1:nsplit) {
		retdata[[i]]=mymat[,((i-1)*mysize+1):(i*mysize)]
	}
	retdata
}

types=c('Dog_1','Dog_2','Dog_3','Dog_4','Dog_5','Patient_1','Patient_2')
typenums=c(Dog_1=1,Dog_2=2,Dog_3=3,Dog_4=4,Dog_5=5,Patient_1=6,Patient_2=7)

nv=rep(NA,length(types)*1000)
summary_df=data.frame(fname=nv, second=nv,freq=nv,ch=nv,label=nv,seq=nv,datalen=nv, time1=nv,time2=nv)
fixfreq=0
fixfreq=200
dolog=1
addFFT=2
FFTratio=0.2
nsplit=10	# original clip is 10min=600sec, nsplit=10, new length=60sec, nsplit=20, newlength=30sec, nsplit=40 newlength=15sec
FFTavglen=24
do_holdout=1

inum=1
for (mytype in types) {
begTime0=Sys.time()
# datadir=paste0("Data/",mytype)
datadir=paste0("F:/Work/Kaggle/SeizurePrediction/Data/",mytype)
holdoutdir=paste0(datadir,"_holdout")

interfiles=dir(datadir, ".*_interictal_segment_.*.mat")
prefiles=dir(datadir, ".*_preictal_segment_.*.mat")
testfiles=dir(datadir, ".*_test_segment_.*.mat")
if (mytype %in% c("Dog_1","Dog_2","Dog_3","Dog_4") && do_holdout) {
    holdoutfiles=dir(holdoutdir, ".*_holdout_segment_.*.mat")
}

trainmat=NULL
begTime=Sys.time()
isub=1
for (myfile in interfiles) {
	begTime0=Sys.time()
	filename=paste0(datadir,"/",myfile)
	retval=read_one_matfile(filename)
	orimat=retval[["mat"]]
	seconds=retval[["seconds"]]
	freq=retval[["freq"]]
	labels=retval[["labels"]]
	seq=retval[["seq"]]
	if (fixfreq > 0 && fixfreq < freq) {
		orimat=down_sampling(orimat, freq/fixfreq)
		freq=fixfreq
	}
	newmats=split_mat(orimat, nsplit)
	for (mi in 1:nsplit) {
		mymat=newmats[[mi]]
		f=gen_features_onefile(mymat, freq, seconds/nsplit)
		f['seq']=seq
		f['flag']=0
		f['id']=typenums[mytype]*100000+isub*100+mi
		f['si']=mi
		if(is.null(trainmat)) {
			trainmat=f
		} else {
			trainmat=rbind(trainmat, f)
		}
	}
	endTime=Sys.time()
	time1=difftime(endTime, begTime0, units="secs")
	time2=difftime(endTime, begTime, units="secs")
	cat(paste(inum, myfile,retval[["seconds"]],retval[["freq"]],length(retval[["labels"]]),
		retval[["labels"]][1], retval[["seq"]],ncol(orimat), time1, time2,"\n"))
	summary_df[inum,]=c(myfile,retval[["seconds"]],retval[["freq"]],length(retval[["labels"]]),
				retval[["labels"]][1], retval[["seq"]],ncol(orimat), time1, time2)
	inum=inum+1
	isub=isub+1
	flush.console()
}

for (myfile in prefiles) {
	begTime0=Sys.time()
	filename=paste0(datadir,"/",myfile)
	retval=read_one_matfile(filename)
	orimat=retval[["mat"]]
	seconds=retval[["seconds"]]
	freq=retval[["freq"]]
	labels=retval[["labels"]]
	seq=retval[["seq"]]
	if (fixfreq > 0 && fixfreq < freq) {
		orimat=down_sampling(orimat, freq/fixfreq)
		freq=fixfreq
	}
	newmats=split_mat(orimat, nsplit)
	for (mi in 1:nsplit) {
		mymat=newmats[[mi]]
		f=gen_features_onefile(mymat, freq, seconds/nsplit)
		f['seq']=seq
		f['flag']=1
		f['id']=typenums[mytype]*100000+isub*100+mi
		f['si']=mi
		if(is.null(trainmat)) {
			trainmat=f
		} else {
			trainmat=rbind(trainmat, f)
		}
	}
	endTime=Sys.time()
	time1=difftime(endTime, begTime0, units="secs")
	time2=difftime(endTime, begTime, units="secs")
	cat(paste(inum, myfile,retval[["seconds"]],retval[["freq"]],length(retval[["labels"]]),retval[["labels"]][1],
			retval[["seq"]],ncol(orimat),time1, time2,"\n"))
	summary_df[inum,]=c(myfile,retval[["seconds"]],retval[["freq"]],length(retval[["labels"]]),
				retval[["labels"]][1], retval[["seq"]],ncol(orimat),time1, time2)
	inum=inum+1
	isub=isub+1
	flush.console()
}

testmat=NULL
for (myfile in testfiles) {
	begTime0=Sys.time()
	filename=paste0(datadir,"/",myfile)
	retval=read_one_matfile(filename)
	orimat=retval[["mat"]]
	seconds=retval[["seconds"]]
	freq=retval[["freq"]]
	labels=retval[["labels"]]
	seq=retval[["seq"]]
	if (fixfreq > 0 && fixfreq < freq) {
		orimat=down_sampling(orimat, freq/fixfreq)
		freq=fixfreq
	}
	newmats=split_mat(orimat, nsplit)
	for (mi in 1:nsplit) {
		mymat=newmats[[mi]]
		f=gen_features_onefile(mymat, freq, seconds/nsplit)
		f['id']=typenums[mytype]*100000+isub*100+mi
		f['si']=mi
		if(is.null(testmat)) {
			testmat=f
		} else {
			testmat=rbind(testmat, f)
		}
	}
	endTime=Sys.time()
	time1=difftime(endTime, begTime0, units="secs")
	time2=difftime(endTime, begTime, units="secs")
	cat(paste(inum, myfile,retval[["seconds"]],retval[["freq"]],length(retval[["labels"]]),retval[["labels"]][1],
		retval[["seq"]],ncol(orimat),time1, time2,"\n"))
	summary_df[inum,]=c(myfile,retval[["seconds"]],retval[["freq"]],length(retval[["labels"]]),
				retval[["labels"]][1], retval[["seq"]],ncol(orimat),time1, time2)
	inum=inum+1
	isub=isub+1
	flush.console()
}

if (mytype %in% c("Dog_1","Dog_2","Dog_3","Dog_4") && do_holdout) {
holdoutmat=NULL
for (myfile in holdoutfiles) {
	begTime0=Sys.time()
	filename=paste0(holdoutdir,"/",myfile)
	retval=read_one_matfile(filename)
	orimat=retval[["mat"]]
	seconds=retval[["seconds"]]
	freq=retval[["freq"]]
	labels=retval[["labels"]]
	seq=retval[["seq"]]
	if (fixfreq > 0 && fixfreq < freq) {
		orimat=down_sampling(orimat, freq/fixfreq)
		freq=fixfreq
	}
	newmats=split_mat(orimat, nsplit)
	for (mi in 1:nsplit) {
		mymat=newmats[[mi]]
		f=gen_features_onefile(mymat, freq, seconds/nsplit)
		f['id']=typenums[mytype]*100000+isub*100+mi
		f['si']=mi
		if(is.null(holdoutmat)) {
			holdoutmat=f
		} else {
			holdoutmat=rbind(holdoutmat, f)
		}
	}
	endTime=Sys.time()
	time1=difftime(endTime, begTime0, units="secs")
	time2=difftime(endTime, begTime, units="secs")
	cat(paste(inum, myfile,retval[["seconds"]],retval[["freq"]],length(retval[["labels"]]),retval[["labels"]][1],
		retval[["seq"]],ncol(orimat),time1, time2,"\n"))
	summary_df[inum,]=c(myfile,retval[["seconds"]],retval[["freq"]],length(retval[["labels"]]),
				retval[["labels"]][1], retval[["seq"]],ncol(orimat),time1, time2)
	inum=inum+1
	isub=isub+1
	flush.console()
}
}
# datadir=paste0("Data/",mytype)
datadir=paste0("F:/Work/Kaggle/SeizurePrediction/Kaggle-SeizureDetection-Official/Data/",mytype)
if (addFFT>=1) {
	freq=paste0(freq,"FFT",addFFT,"-",FFTratio)
}
filename=paste0(datadir,"/",mytype,"Split",nsplit,"_Freq",freq,ifelse(dolog==1,paste0("Log",dolog),""),".RData")
summary_df=summary_df[!is.na(summary_df$fname),]
if (mytype %in% c("Dog_1","Dog_2","Dog_3","Dog_4") && do_holdout) {
    save(trainmat, testmat, holdoutmat, summary_df, file=filename, compress='bzip2')
} else {
    save(trainmat, testmat, summary_df, file=filename, compress='bzip2')
}
endTime=Sys.time()
cat(paste("Total time used for",mytype,":",format(endTime-begTime0),"\n"))
cat(paste("File saved:",filename,"\n"))
flush.console()
}

summary_df=summary_df[!is.na(summary_df$fname),]

totaltime=(Sys.time()-begTime)
print(tail(summary_df, n=20))
print(totaltime)


# https://www.r-spatial.org/r/2018/10/25/ggplot2-sf.html
# https://covidtracking.com/api/
# https://covid.ourworldindata.org

library(rnaturalearth)
library(rnaturalearthdata)
library(rgeos)
library(data.table)
library(countrycode)
library(viridisLite)
library(gganimate)
library(gifski)
library(tidyverse)
library(lmtest)
library(WDI)
library(plotly)
library(USAboundaries)
library(sf)
library(fuzzyjoin)
library(tigris)

# install.packages('tigris')

# install.packages(c('tidyverse', 'data.table', 'rnaturalearth', 'rgeos',
#                    'WDI', 'lmtest', 'gifski', 'gganimate', 'viridisLite'))
# install.packages(c('plotly', 'rnaturalearthdata', 'USAboundaries', 'countrycode', 'quantmod'))
# install.packages("remotes")
# remotes::install_github("ropensci/USAboundariesData")

us_cities_shp = us_cities() %>%
  mutate(
    province_state_city = paste0(city, ', ', state_abbr)
  )

us_counties_shp = us_counties() %>%
  mutate(
    province_state_city = ifelse(state_abbr == 'LA', paste0(name, ' Parish, ', state_abbr), paste0(name, ' County, ', state_abbr))
  )
us_counties_shp$geometry[1]

county_shp = tigris::counties()

us_covid_data = read_csv('https://covidtracking.com/api/us/daily.csv') %>%
  mutate(
    date = as.Date(as.character(date), format = '%Y%m%d'),
    location = 'United States',
    location_type = 'country',
    data_source = 'covidtracking.com',
    location_key = paste(location, location_type, data_source, sep = '|')
  ) %>%
  rename(
    total_cases = positive,
    total_deaths = death,
    total_tests = total
  ) %>%
  mutate(
    new_cases = total_cases - lag(total_cases, 1),
    new_deaths = total_deaths - lag(total_deaths, 1)
  )

us_states_covid_data = read_csv('http://covidtracking.com/api/states/daily.csv') %>%
  mutate(
    date = as.Date(as.character(date), format = '%Y%m%d'),
    location_type = 'US State',
    data_source = 'covidtracking.com'
  ) %>%
  rename(
    total_cases = positive,
    total_deaths = death,
    total_tests = total,
    location = state
  ) %>%
  mutate(
    location_key = paste(location, location_type, data_source, sep = '|'),
    new_cases = total_cases - lag(total_cases, 1),
    new_deaths = total_deaths - lag(total_deaths, 1)
  )

all_covid_data_stacked = bind_rows(us_covid_data, us_states_covid_data) %>%
  arrange(location_key, date) %>%
  pivot_longer(cols = c('new_cases', 'new_deaths', 'total_cases', 'total_deaths'),
               names_to = c('measure'), values_to = 'value') %>%
  data.table()

# compute first differences, pct changes, etc.
all_covid_data_diffs =
  all_covid_data_stacked[, {
    lag_value = lag(value, 1)
    diff_value = value - lag_value
    pct_change_value = diff_value / lag_value

    lag_4_value = lag(value, 4)
    lag_5_value = lag(value, 5)
    lag_6_value = lag(value, 6)

    list(
      date = date,
      value = value,
      lag_value = lag_value,
      diff_value = diff_value,
      pct_change_value = pct_change_value,
      lag_4_value = lag_4_value,
      lag_5_value = lag_5_value,
      lag_6_value = lag_6_value,
      first_value = date[date == min(date)],
      last_value = date[date == max(date)],
      value_past_100 = min(date[value >= 100])
    )

  }, by = list(location_key, location, location_type, data_source, measure)] %>%
  pivot_wider(
    id_cols = c('location_key', 'location', 'location_type','data_source', 'date'),
    names_from = 'measure',
    values_from = c('value', 'lag_value', 'diff_value',
                    'pct_change_value', 'lag_4_value', 'lag_5_value',
                    'lag_6_value')
  )

case_100_dates = group_by(all_covid_data_diffs, location_key) %>%
  summarize(
    date_case_100 = min(date[value_total_cases >= 100])
  )

all_covid_data_diffs_dates = left_join(all_covid_data_diffs, case_100_dates) %>%
  filter(date >= date_case_100) %>%
  mutate(
    days_since_case_100 = as.numeric(date - date_case_100)
  )

daily_growth_stats = group_by(all_covid_data_diffs_dates, days_since_case_100) %>%
  summarize(
    n_countries = n_distinct(location),
    median_daily_change_cases = median(pct_change_value_total_cases, na.rm = T),
    mean_daily_change_cases = mean(pct_change_value_total_cases, na.rm = T),
    mean_daily_change_deaths = mean(pct_change_value_total_deaths, na.rm = T),
    median_daily_change_deaths = median(pct_change_value_total_deaths, na.rm = T)
  )

ggplot(all_covid_data_diffs_dates %>% filter(location_type == 'US State'), aes(days_since_case_100, pct_change_value_total_cases)) +
  geom_line(aes(alpha = days_since_case_100, group = location)) +
  geom_line(data = filter(all_covid_data_diffs_dates, location == 'United States', data_source == 'covidtracking.com'),
            colour = 'red', size = 1) +
  scale_y_continuous(limits = c(0, 1)) +
  # geom_line(data = daily_growth_stats %>% filter(n_countries >= 5), aes(x = days_since_case_100, y = median_daily_change_cases), size = 1, colour = 'blue')
  scale_alpha(range = c(0.1, 1))

ggplotly(a)

ggplot(all_covid_data_diffs_dates, aes(pct_change_value_total_cases)) +
  stat_density(position = 'identity')
summary(all_covid_data_diffs_dates$pct_change_value_total_cases)

# (7000/104)^(1/15) - 1

# are new cases just the first difference? mostly
with(all_covid_data_diffs, summary(diff_value_total_cases - value_new_cases))

top_countries =
  group_by(all_covid_data_diffs, location) %>%
  summarize(
    last_value_cases = tail(value_total_cases, 1)
  ) %>%
  arrange(-last_value_cases) %>% head(20)

all_covid_data_diffs_top = filter(all_covid_data_diffs_dates, location %in% top_countries$location)

a = ggplot(all_covid_data_diffs_top, aes(date, value_total_cases, colour = location)) +
  geom_line(size = 1) +
  geom_point()

ggplotly(a)
# estimate crude r0
crude_r0 = lm(value_total_cases ~ lag_5_value_total_cases, data = all_covid_data_diffs)
summary(crude_r0)

names(all_covid_data_diffs)
head(all_covid_data_diffs)
names(all_covid_data_diffs)
ggplot(all_covid_data_diffs, aes())

acf(all_covid_data_diffs$value_new_cases)
acf(all_covid_data_diffs$value_new_deaths)

ccf(all_covid_data_diffs$value_new_cases, all_covid_data_diffs$value_new_deaths)
ccf(all_covid_data_diffs$value_new_deaths, all_covid_data_diffs$value_new_cases)

ccfvalues = ccf(all_covid_data_diffs$value_new_cases, all_covid_data_diffs$value_new_deaths)
grangertest(value_new_deaths ~ value_new_cases, order = 10, data = all_covid_data_diffs)
grangertest(value_new_cases ~ value_new_deaths, order = 10, data = all_covid_data_diffs)

ggplot(all_covid_data_diffs %>% filter(location != 'World'), aes(value_new_cases, value_new_deaths)) +
  geom_point() +
  stat_smooth(method = 'lm')

ggplot(all_covid_data_diffs %>% filter(location == 'United States', date >= as.Date('2020-02-01')),
       aes(date, value)) +
  facet_wrap(~measure, scales = 'free_y') +
  geom_line()
  # geom_point() +
  # geom_linerange(aes(ymin = 0, ymax = pct_change_value))

setdiff(world$geounit, latest_data$location)
setdiff(latest_data$location, world$geounit)

head(all_data)

#### get world bank data on each country #####

#### map everything ####

world <- ne_countries(scale = "medium", returnclass = "sf")
ggplot(data = world) +
  geom_sf()


library(gdata)                   # load gdata package
library(ggplot2)
library(dplyr)

df <- read.csv("./benchmark.csv")
df <- df %>% mutate(time = timeNs / 1e9)

plotSubset <- function (vec, y_axis_scale = 1) {
  ggplot(df %>% filter(type %in% vec)) + scale_x_discrete() + geom_point(aes(x = input, y = time, col = type)) +
    scale_y_continuous(trans = "log10", labels = scales::comma) +
    labs(y = "Time in seconds", x = "Input ID")
  # theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))

}

plotSubset(c("naive", "qbf", "muser"))
plotSubset(c("naive", "muser"))
plotSubset(c("naive", "qbf"))
plotSubset(c("muser", "qbf"))