#!/usr/bin/env Rscript
######################################################
## modified from https://github.com/4dn-dcic/pairsqc #
######################################################

args = commandArgs(TRUE)
RE_len = args[1] # either 4 or 6
if(length(args)>1) { report_dir = args[2] } else { report_dir = './report' }

rainbow_w_offset <- function(L, offset = NA){
    if(is.na(offset)) offset = floor(L/2)
    color = rainbow(L+ offset)[1:L]
    return( color )
}

# set libPath to pwd
pwd <- getwd()
pwd <- file.path(pwd, "lib")
dir.create(pwd)
.libPaths(c(pwd, .libPaths()))

# (this maybe a issue)
# both plotosaurus and interactive_multiline_d3prep is not test on multiple platforms
library(plotosaurus)
library(stringr)
source("https://raw.githubusercontent.com/SooLee/d3forNozzleR/master/interactive_multiline_d3prep.r") # for d3 integration

plot_orientation_proportion_vs_distance <- function(x, RE_len, xlim=c(2,5), no_xlabel=FALSE){
  matplot(x$distance,x[,c('proportion.Inner','proportion.Outer','proportion.Right','proportion.Left')],pch=19,type='o',xlab="", ylab="Proportion",lwd=1,lty=1, col=COLOR4(), axes=F, xlim=xlim)
  exp_axis(xlim,1)
  axis(2)
  box()
  if(no_xlabel==FALSE) mtext("distance",side=1,line=2.5)
  legend("topright",c('Inner','Outer','Right','Left'),col=COLOR4(),bty="n",pch=19,lwd=1,lty=1)
  if(RE_len==4) { abline(v=3.5, lty=2, col="grey") # 4-cutters at 3kb
  } else { abline(v=4.5, lty=2, col="grey") } # 6-cutters at 30kb
}

plot_orientation_log10count_vs_distance <- function(x, RE_len, xlim=c(2,5), no_xlabel=FALSE){
  ind = which(x$distance>=xlim[1] & x$distance<=xlim[2] & x$log10count.Inner!=-100 & x$log10count.Outer!=-100 & x$log10count.Right!=-100 & x$log10count.Left!=-100)
  ylim=range(x[ind,c('log10count.Inner','log10count.Outer','log10count.Right','log10count.Left')])
  matplot(x$distance,x[,c('log10count.Inner','log10count.Outer','log10count.Right','log10count.Left')],pch=19,type='o',xlab="", ylab="Contact frequency",lwd=1,lty=1,ylim=ylim, col=COLOR4(), axes=F, xlim=xlim)
  exp_axis(xlim,1)
  exp_axis(ylim,2)
  box()
  if(no_xlabel==FALSE) mtext("distance",side=1,line=2.5)
  legend("bottomright", c('Inner','Outer','Right','Left'), col=COLOR4(), bty="n", pch=19, lwd=1, lty=1)
  if(RE_len==4) { abline(v=3.5, lty=2, col="grey") # 4-cutters at 3kb
  } else { abline(v=4.5, lty=2, col="grey") } # 6-cutters at 30kb
}

plot_contact_probability_vs_distance <- function(x, xlim=c(3.2,8), no_xlabel=FALSE) {
  ylim=range(x$log10prob)
  plot(x$distance,x$log10prob,pch=19,type='o',xlab="", ylab="Contact probability",lwd=1,lty=1,ylim=ylim,axes=F,xlim=xlim)
  exp_axis(xlim,1)
  exp_axis(ylim,2)
  box()
  if(no_xlabel==FALSE) mtext("distance",side=1,line=2.5)

  abline(v=4, lty=2, col="grey80")
  abline(v=5.5, lty=2, col="grey80")

  # slope
  tad=which(x$distance>=4 & x$distance<=5.5)
  xx=x$distance[tad]
  yy=x$log10prob[tad]
  tad_slope=glm(yy~xx)$coefficients[2]
  tad_intercept=glm(yy~xx)$coefficients[1]
  spacing=abs(yy[1]*0.07)
  text(xx[1], yy[1]+spacing, paste("slope=",round(tad_slope,2),sep=' '), pos=4)
  abline(a=tad_intercept + spacing, b=tad_slope, lty=2)

  return(round(tad_slope,2));
}

# entropy
entropy<-function(xx)-sum(xx*log2(xx))
plot_entropy <- function(x, xlim=c(2,5), plt=c(0.2,0.95,0.2,0.95)){
  par(las=1,lend=2)
  par(plt=plt)
  entropies=apply(x[,c('proportion.Inner','proportion.Outer','proportion.Right','proportion.Left')],1,entropy)
  plot(x$distance, entropies,type='o',pch=19,ylab="entropy",xlab="distance",xlim=xlim,axes=F)
  exp_axis(xlim,1)
  axis(2)
}

plot_sd_with_cutoff <- function(x, xlim=c(2,5)){
  x=x[which(x$distance>=xlim[1] & x$distance<=xlim[2]),];
  sds=apply(x[,c('proportion.Inner','proportion.Outer','proportion.Right','proportion.Left')],1,sd)
  plot(x$distance, log10(sds), type='o',pch=19,ylab="sd",xlab="distance",xlim=xlim,axes=F, col=COLOR3B()[1])
  exp_axis(xlim,1)
  exp_axis(log10(sds), 2, 3)
  box()
  almost_converged = which(sds<0.02)
  well_converged = which(sds<0.005)
  points(x$distance[almost_converged], log10(sds[almost_converged]), col=COLOR3B()[2], pch=19)
  points(x$distance[well_converged], log10(sds[well_converged]), col=COLOR3B()[3], pch=19)
  abline(v=x[almost_converged[1] ,"distance"],col=COLOR3B()[2],lty=2)
  abline(v=x[well_converged[1] ,"distance"],col=COLOR3B()[3],lty=2)
  legend("topright",c("sd<0.02","sd<0.005"),col=COLOR3B()[2:3],pch=19,bty='n')

  ## determination for convergence
  if(RE_len==4) { conv_ind = which(x$distance>=3.5) } else { conv_ind = which(x$distance>=4.5) }
  if(length(setdiff(conv_ind, well_converged))==0) { return('Very Good');
  } else if(length(setdiff(conv_ind, almost_converged))==0) { return('Good');
  } else { return('Not converged'); }

}

plot_contact_frequency_vs_genomic_separation_per_chr <- function(x) {
  y=data.frame(x[,grep('log10prob_per_chr',colnames(x))])
  valid = which(x$distance > 3.5 & x$distance < 7)
  y=y[valid,]
  ylim = range(apply(y,2,function(xx){ ind =which(xx>-90); if(length(ind)==0) return(NA) else return( range(xx[ind])) }), na.rm=T)
  L = ncol(y)
  chrnames = sub("log10prob_per_chr.","",colnames(y))

  plt0 = par('plt', no.readonly=FALSE)
  plt1 = plt0; plt2= plt0
  pltx.plotend = (plt0[2] - plt0[1]) * 7/8 + plt0[1]
  pltx.legendstart = (plt0[2] - plt0[1]) * 29/32 + plt0[1]
  plt1[2] = pltx.plotend
  plt2[1] = pltx.legendstart
  par(plt=plt1)
  matplot(x$distance[valid],y,ylim=ylim, pch=19, type='l', lty=1, lwd=1, col=rainbow_w_offset(L), xlab="genomic separation", ylab="Contact frequency", axes=F)
  exp_axis(x$distance[valid], 1)
  exp_axis(ylim, 2)
  box()
  abline(v=4, lty=2, col="grey80")
  abline(v=5.5, lty=2, col="grey80")
  par(new=T, plt=plt2)
  plot.new(); plot.window(c(0,1),c(0,1), xaxs='i', yaxs='i')
  legend("topleft", chrnames, col = rainbow_w_offset(L), lty=1, lwd=1, bty='n' ,xpd=T, cex=0.8)
}

prep_plot_contact_frequency_vs_genomic_separation_per_chr_d3 <- function(x, sample_name, report_dir, xmin=3.5, xmax=7) {
  ycolumns = colnames(x)[grep('log10prob_per_chr',colnames(x))]
  y = data.frame(x[,ycolumns])
  valid = which(x$distance > xmin & x$distance < xmax)
  y=y[valid,]
  ylim = range(apply(y,2,function(xx){ ind =which(xx>-90); if(length(ind)==0) return(NA) else return( range(xx[ind])) }), na.rm=T)
  ymin= ylim[1]
  ymax = ylim[2]
  L = ncol(y)
  chrnames = sub("log10prob_per_chr.","",colnames(y))
  colors = substr(str_to_lower(rainbow_w_offset(L)),1,7)
  xlab = "log10 genomic separation"
  ylab = "log10 contact frequency"
  div_id = paste("d3div_contact_frequency_vs_genomic_separation_per_chr_", sample_name, "___", sep="")
  js_file_prefix = "distanceplot_perchr"
  tsvfile = paste("./", sample_name, ".plot_table.out", sep="")
  tsvcoldata = data.frame(columnx="distance", columny=ycolumns, color=colors, offcolor="#999999", name=chrnames, stringsAsFactors=FALSE)
  return( create_d3_js_for_interactive_multiline_plot(sample_name, xmin, xmax, ymin, ymax, div_id, xlab, ylab, report_dir, js_file_prefix, tsvfile, tsvcoldata) )
}

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

require( "Nozzle.R1" )

generate_pairsqc_report <- function ( sample_name = NA, d3_prep_res = NULL) {

  if(is.na(sample_name)) {
    report_title = "PairsQC Report"
  } else {
    report_title = paste("PairsQC Report for sample", sample_name, sep=" ")
  }

  # Phase 1: create report elements
  r <- newCustomReport( report_title );
  d3script <- newHtml (d3_prep_res[[1]]$html_common_script_tag);
  s1 <- newSection( "Summary table" );
  s2 <- newSection( "Proportion of read orientation versus genomic separation");
  s3 <- newSection( "Number of reads versus genomic separation, stratified by read orientation" );
  s4 <- newSection( "Contact probability versus genomic separation" );
  s5 <- newSection( "Contact probability versus genomic separation, per chromosome" );
  references <- newSection( "References" );

  # References
  refRao = newCitation( authors= 'Rao et al.', title= 'A 3D Map of the Human Genome at Kilobase Resolution Reveals Principles of Chromatin Looping', publication= 'Cell', issue= '159:7', pages='1665-1680', year='2014' )
  refSanborn = newCitation( authors= 'Sanborn et al.', title= 'Chromatin extrusion explains key features of loop and domain formation in wild-type and engineered genome', publication= 'Proc. Natl. Acad. Sci. USA', issue= '112:47', pages='E6456-E6465', year='2015' )
  refImakaev = newCitation( authors= 'Imakaev et al.', title= 'Iterative correction of Hi-C data reveals hallmarks of chromosome organization', publication= 'Nature Methods', issue= '9:10', pages='999-1003', year='2012' )

  # section 1
  table_files = list.files('.', pattern='*summary.out$')
  sample_names = sub('.?summary.out','',table_files, perl=T, fixed=F)
  tableData1 = do.call(data.frame, sapply(table_files, function(table_file){
    tableData=read.table(table_file,stringsAsFactors=F, header=F, sep="\t")
    colnames(tableData) = c('QC field','value')
    return(tableData)
  }, simplify=F))[,c(1,seq(2,2*length(table_files),2))]
  colnames(tableData1) = c('QC field', sample_names)

  t1 <- newTable( tableData1, significantDigits=0, exportId="TABLE_1", "Summary Table" );
  p1 <- newParagraph( "Cis-to-trans ratio is computed as the ratio of long-range cis reads (>20kb) to trans reads plus long-range cis reads. Typically, cis-to-trans ratio higher than 40% is required. Percentage of long-range cis reads is the ratio of long-range cis reads to total number of reads. Minimum 15% is required and 40% or higher suggests a good library", asReference( refRao ), ". Convergence is determined as standard deviation of proportions of four read orientations to be <0.002 (Very good) or <0.05 (Good) (See below section ", asStrong("Proportion of read orientation versus genomic separation"), "). The slope of log10 contact probability vs distance between 10kb ~ 300kb representing TAD is also provided as well. (See below section ", asStrong("Contact probability versus genomic separation"), ".)");

  # section 2
  # using sample_names from section 1 (same ordering)
  png2_files = paste('plots/', sample_names, '.proportion.png',sep='')
  pdf2_files = gsub('png$','pdf',png2_files)
  f2list <- mapply(function(png2, pdf2, sample_name) {
                       newFigure( png2, fileHighRes=pdf2, exportId=paste("FIGURE_2", sample_name, sep="."),
                                  paste("Proportion of read orientation versus genomic separation : ", asStrong(sample_name), sep=""));
                   }, png2_files, pdf2_files, sample_names, SIMPLIFY=FALSE)
  eq2a = '10^3.5'
  eq2b = '10^4.5'
  p2 <- newParagraph("Contact frequency (number of reads, left) and proportion of reads (right) are shown, stratified by read orientation. Good four-cutter and six-cutter samples would converge at ~3kb (", eq2a, ") and ~30kb (", eq2b, "), respectively", asReference( refRao ), ". Convergence is determined by the standard deviation of the proportions being less than 0.005.")

  # section 3
  #png3= 'plots/log10counts.png'
  #pdf3= 'plots/log10counts.pdf'
  #f3 <- newFigure( png3, fileHighRes=pdf3, exportId="FIGURE_3", "Number of reads versus genomic separation, stratified by read orientation");

  # section 4
  # using sample_names from section 1 (same ordering)
  png4_files = paste('plots/', sample_names, '.log10prob.png',sep='')
  pdf4_files = gsub('png$','pdf',png4_files)
  f4list <- mapply(function(png4, pdf4, sample_name) {
                       newFigure( png4, fileHighRes=pdf4,
                                  paste("Contact probability versus genomic separation : ", asStrong(sample_name), sep=""));
                   }, png4_files, pdf4_files, sample_names, SIMPLIFY=FALSE)
  p4 <- newParagraph( "Contact probability (number of reads, normalized by number of bins and bin size) is shown with respect to genomic separation between mates", asReference( refImakaev), asReference( refSanborn ), ". The slope between distance 10kb ~ 300kb (10^4 ~ 10^5.5) representing a TAD is calculated. A good mitotic sample would have a slope close to ~ -0.76", asReference( refSanborn ), "." );

  # section 5
  # this section has d3 elements
  ss5divlist <- mapply(function(sn, k) newHtml(paste("

Interactive Figure ",k,". Contact probability versus genomic separation, per chromosome : ", asStrong(sn), "

",d3_prep_res[[sn]]$html_script_tag, sep="")), sample_names, 1:length(sample_names), SIMPLIFY=FALSE);

  # Phase 2: assemble report structure bottom-up
  s1 <- addTo( s1, p1, t1);
  s2 <- addTo( s2, p2);
  for(f2 in f2list) { s2 <- addTo( s2, f2); }
  #s3 <- addTo( s3, f3);
  s4 <- addTo( s4, p4 );
  for(f4 in f4list) { s4 <- addTo( s4, f4); }
  # s5 <- addTo( s5, f5);
  for(i in 1:length(sample_names)) { s5 <- addTo( s5, ss5divlist[[i]] ); }
  references <- addTo( references, refRao, refImakaev, refSanborn )
  #r <- addTo( r, s1, s2, s3, s4, references );
  #r <- addTo( r, s1, s2, s4, s5, references );
  r <- addTo( r, d3script, s1, s2, s4, s5, references );

  # Phase 3: render report to file
  writeReport( r, filename="pairsqc_report" ); # w/o extension

}

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

cwd = getwd()
sample_names = gsub('.?plot_table.out$', '', list.files(report_dir, pattern='*.plot_table.out$'), perl=T, fixed=F)

plot_for_sample<-function(sample_name, report_dir) {
  setwd(cwd)
  plot_dir = paste(report_dir,"plots",sep="/")
  plot_table_file = paste(report_dir, "/", sample_name, ".plot_table.out", sep="")

  x=read.table(plot_table_file,sep="\t",stringsAsFactors=F,header=T)
  dir.create(plot_dir, showWarnings = FALSE, recursive = TRUE)
  setwd(plot_dir)
  res = pngpdf_preset( list(
      function() plot_orientation_log10count_vs_distance(x, RE_len),
      function() plot_orientation_proportion_vs_distance(x, RE_len, no_xlabel=T),
      function() plot_sd_with_cutoff(x)
    ), paste(sample_name, "proportion", sep="."), stylefunc0, get_preset(3), add.date=FALSE
  )
  convergence_determinant = res[[3]];

  # pngpdf_preset( list(
  #    function() plot_contact_probability_vs_distance(x),
  #    function() plot_contact_frequency_vs_genomic_separation_per_chr(x)
  #  ), paste(sample_name, "log10prob", sep="."), stylefunc0, get_preset(2,'h50'), add.date=FALSE
  #)

  res = pngpdf_preset( list(
      function() plot_contact_probability_vs_distance(x)
    ), paste(sample_name, "log10prob", sep="."), stylefunc0, get_preset(1), add.date=FALSE
  )
  slope = res[[1]]

  #pngpdf.nodate( function()plot_contact_probability_vs_distance(x) ,"log10prob")
  #pngpdf.nodate( function()plot_contact_frequency_vs_genomic_separation_per_chr(x), "log10prob_chr", height=5.5 )
  #pngpdf.nodate( function()plot_entropy(x), "entropy", height=4)

  # d3 plot
  setwd(cwd)
  d3plot_prep_res = prep_plot_contact_frequency_vs_genomic_separation_per_chr_d3(x, sample_name, report_dir)

  ## printing cis-trans stats and post-plot stats to summary.out
  res_all = as.data.frame(rbind(c("convergence",convergence_determinant), c("slope", slope)), stringsAsFactors=FALSE)
  colnames(res_all)=c('V1','V2')
  cis_file = paste(report_dir, '/', sample_name, ".cis_to_trans.out", sep="");
  res_file = paste(report_dir, '/', sample_name, ".summary.out", sep="");
  original_res = read.table(cis_file, stringsAsFactors=FALSE, header=FALSE, sep="\t");
  colnames(original_res)=c('V1','V2')
  res_all = rbind(original_res, res_all)
  write.table(res_all, res_file, quote=FALSE, col.names=FALSE, row.names=FALSE, sep="\t")
  setwd(plot_dir)

  return(d3plot_prep_res)
}

d3_prep_res = sapply(sample_names, plot_for_sample, report_dir = report_dir, simplify=FALSE)
print(d3_prep_res)

setwd(cwd)
setwd(report_dir)
generate_pairsqc_report(d3_prep_res = d3_prep_res)


devtools::load_all()
t1<-read_computed_matrix("data/cgi_sorted_mainchr_kate_chip.mtx.gz")
t1$metadata
t1$calculate_mean_coverage_each_sample()
t1$sample_mean_coverage
t1$calculate_total_coverage_each_region()
t1$region_total_coverage


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


library(rworldmap)
library(RColorBrewer)

d <- data.frame(
  country=c('Italy', 'Czech Republic', 'Usa', 'France', 'Netherlands', 'Ireland', 'Norway', 'Israel', 'Australia', 'Serbia And Montenegro', 'Iceland', 'Slovenia', 'Germany', 'Armenia', 'Belgium', 'Spain', 'Canada', 'Chile', 'Denmark', 'Poland', 'Finland', 'Sweden', 'Croatia', 'Japan', 'Switzerland', 'New Zealand', 'Russia', 'Romania', 'Portugal', 'United Kingdom', 'Austria', 'Greece', 'Hungary', 'South Korea'),
  value=c(111, 24.8, 113.8, 28.1, 50.1, 83.5, 28.5, 111.3, 81.7, 29.7, 50.5, 101.9, 77.4, 44.6, 56, 56.5, 107, 22.6, 42.9, 25.4, 54.8, 59.5, 48.2, 73.7, 111.7, 126.4, 25.9, 23.7, 61.8, 112.2, 55, 131.1, 38, 32.5))

n <- joinCountryData2Map(d, joinCode="NAME", nameJoinColumn="country")

mapCountryData(n, nameColumnToPlot="value", mapTitle="Inspire data mining, UG Europe",
  xlim=c(2, 10), ylim=c(35, 66),
  colourPalette=c("moccasin","brown3"),
  addLegend=TRUE,
  oceanCol="blue", missingCountryCol="antiquewhite", lwd="1.0", borderCol
="black")


audio-init: false

; TODO: Add support for importing/exporting
;       different formats like MIDI, LRC, Tab
audio: func [
    notes [block!]
    /lyrics [text!]
    /volume [integer!]
    /delay [integer!]
    /onend [text!]
    /octave [integer!]
    /key [text!]
    /sig [pair!]
    /bpm [integer!]
][
    lyrics: default [_]
    volume: default [100]
    delay: default [0]
    onend: default [_]
    octave: default [4]
    key: default ["C"]
    sig: default [4x4]
    bpm: default [120]

    ; Octave 4
    frequency: mutable [
        "A"  440.00
        "A#" 466.16
        "Bb" 466.16
        "B"  493.88
        "C"  523.25
        "C#" 554.37
        "Db" 554.37
        "D"  587.33
        "D#" 622.25
        "Eb" 622.25
        "E"  659.26
        "F"  698.46
        "F#" 739.99
        "Gb" 739.99
        "G"  783.99
        "G#" 830.61
        "Ab" 830.61
        "R"  000.00 ; rest
    ]

    if all [octave != 4 octave > 0] [
        while [not tail? frequency] [
            either octave < 4 [
                frequency/2: me / ((4 - octave) * 2)
            ][
                frequency/2: me * ((octave - 4) * 2)
            ]

            frequency: next next frequency
        ]

        frequency: head frequency
    ]

    ; major scales
    ; TODO: Calculate these scales mathematically
    ;       If that is not possible then create some lookup tables
    ;       and compose new blocks as suggested by @hostilefork
    ;       https://github.com/BrianOtto/replpad-media/commit/
    ;       c99f42b1f651c5f92224eaf7385dd6c2a496cfcd#r33421860
    switch key [
        "A"  [
            change next find frequency "A" select frequency "F#"
            change next find frequency "B" select frequency "G#"
            change next find frequency "C" select frequency "A"
            change next find frequency "D" select frequency "B"
            change next find frequency "E" select frequency "C#"
            change next find frequency "F" select frequency "D"
            change next find frequency "G" select frequency "E"
        ]

        "Bb" [
            change next find frequency "A" select frequency "G"
            change next find frequency "B" select frequency "A"
            change next find frequency "C" select frequency "Bb"
            change next find frequency "D" select frequency "C"
            change next find frequency "E" select frequency "D"
            change next find frequency "F" select frequency "Eb"
            change next find frequency "G" select frequency "F"
        ]

        "B"  [
            change next find frequency "A" select frequency "G#"
            change next find frequency "B" select frequency "A#"
            change next find frequency "C" select frequency "B"
            change next find frequency "D" select frequency "C#"
            change next find frequency "E" select frequency "D#"
            change next find frequency "F" select frequency "E"
            change next find frequency "G" select frequency "F#"
        ]

        "Db" [
            change next find frequency "A" select frequency "Bb"
            change next find frequency "B" select frequency "C"
            change next find frequency "C" select frequency "Db"
            change next find frequency "D" select frequency "Eb"
            change next find frequency "E" select frequency "F"
            change next find frequency "F" select frequency "Gb"
            change next find frequency "G" select frequency "Ab"
        ]

        "D"  [
            change next find frequency "A" select frequency "B"
            change next find frequency "B" select frequency "C#"
            change next find frequency "C" select frequency "D"
            change next find frequency "D" select frequency "E"
            change next find frequency "E" select frequency "F#"
            change next find frequency "F" select frequency "G"
            change next find frequency "G" select frequency "A"
        ]

        "Eb" [
            change next find frequency "A" select frequency "C"
            change next find frequency "B" select frequency "D"
            change next find frequency "C" select frequency "Eb"
            change next find frequency "D" select frequency "F"
            change next find frequency "E" select frequency "G"
            change next find frequency "F" select frequency "Ab"
            change next find frequency "G" select frequency "Bb"
        ]

        "E"  [
            change next find frequency "A" select frequency "C#"
            change next find frequency "B" select frequency "D#"
            change next find frequency "C" select frequency "E"
            change next find frequency "D" select frequency "F#"
            change next find frequency "E" select frequency "G#"
            change next find frequency "F" select frequency "A"
            change next find frequency "G" select frequency "B"
        ]

        "F"  [
            change next find frequency "A" select frequency "D"
            change next find frequency "B" select frequency "E"
            change next find frequency "C" select frequency "F"
            change next find frequency "D" select frequency "G"
            change next find frequency "E" select frequency "A"
            change next find frequency "F" select frequency "Bb"
            change next find frequency "G" select frequency "C"
        ]

        "F#" [
            change next find frequency "A" select frequency "D#"
            change next find frequency "B" select frequency "E#"
            change next find frequency "C" select frequency "F#"
            change next find frequency "D" select frequency "G#"
            change next find frequency "E" select frequency "A#"
            change next find frequency "F" select frequency "B"
            change next find frequency "G" select frequency "C#"
        ]

        "G"  [
            change next find frequency "A" select frequency "E"
            change next find frequency "B" select frequency "F#"
            change next find frequency "C" select frequency "G"
            change next find frequency "D" select frequency "A"
            change next find frequency "E" select frequency "B"
            change next find frequency "F" select frequency "C"
            change next find frequency "G" select frequency "D"
        ]

        "Ab" [
            change next find frequency "A" select frequency "F"
            change next find frequency "B" select frequency "G"
            change next find frequency "C" select frequency "Ab"
            change next find frequency "D" select frequency "Bb"
            change next find frequency "E" select frequency "C"
            change next find frequency "F" select frequency "Db"
            change next find frequency "G" select frequency "Eb"
        ]
    ]

    if not audio-init [
        audio-init: true

        js-do {
            var rpAudio = (function() {
                var ac = null
                var acTime = null

                return {
                    init: function(start) {
                        ac = new AudioContext()

                        if (!start) {
                            acTime = parseFloat(ac.currentTime)
                        } else {
                            acTime = parseFloat(start)
                        }

                        acTime = acTime.toFixed(2)

                        console.info('rpAudio - Initialized to start in '
                                     + acTime + ' seconds')
                    },

                    play: function(frequency, duration, volume) {
                        if (ac == null) { return }

                        frequency = frequency.toFixed(2)

                        var duration = parseFloat(duration) / 1000
                        duration = duration.toFixed(2)

                        var gain = ac.createGain()
                        gain.connect(ac.destination)
                        gain.gain.value = volume / 100

                        var oscillator = ac.createOscillator()
                        oscillator.connect(gain)
                        oscillator.type = 'square'

                        // TODO: Add support for other waveform types
                        // A sine wave is more natural sounding, but it requires
                        // a higher gain and has clipping / distortion issues.
                        // We might be able to prevent this by ramping up the
                        // gain slowly by using linearRampToValueAtTime().
                        // oscillator.type = 'sine'

                        oscillator.frequency.setValueAtTime(frequency, acTime)

                        console.info('rpAudio - Playing ' + frequency + ' Hz at '
                                     + acTime + ' for ' + duration + ' seconds')

                        oscillator.start(acTime)

                        acTime = parseFloat(acTime) + parseFloat(duration)
                        acTime = acTime.toFixed(2)

                        oscillator.stop(acTime)
                    },

                    exit: function(cb) {
                        if (ac == null) { return }

                        if (ac.currentTime >= acTime) {
                            if (typeof cb == 'function') {
                                ac.close().then(cb)
                            } else {
                                ac.close()
                            }

                            console.info('rpAudio - Exit')
                        } else {
                            setTimeout(function() { rpAudio.exit(cb) }, 100)
                        }
                    }
                }
            })()
        }
    ]

    js-do unspaced [
        "rpAudio.init(" delay ")"
    ]

    js-do unspaced [
        "console.info('rpAudio - Playing in the key of " key
        " and using octave " octave "')"
    ]

    ; TODO: Add support for chords, e.g. audio [ chord [ A E ] 1x8 ]
    while [not tail? notes] [
        note: to text! notes/1
        duration: notes/2

        ; TODO: Get lyrics queued up in a <div id="lyrics">
        ;       and highlight them as the notes play
        either lyrics [
            lyric: notes/3
            notes: next next next notes
        ][
            notes: next next notes
        ]

        if pair? duration [
            ; 120 bpm = 2 beats per second = 0.5 seconds per beat
            seconds-per-beat: 1 / (bpm / 60)

            ; 1x2 = half note = 0.5
            duration-as-decimal: duration/1 / duration/2

            ; 4x4 = quarter note is 1 beat = 0.25
            sig-as-decimal: 1 / sig/2

            ; 0.5 / 0.25 = 2 beats
            beats: duration-as-decimal / sig-as-decimal

            ; 2 beats * 0.5 seconds = 1 second for a half note
            duration: beats * seconds-per-beat

            duration: me * 1000
        ]

        js-do unspaced [
            "rpAudio.play(" select frequency note ", " duration ", " volume ")"
        ]
    ]

    js-do unspaced [
        "rpAudio.exit(" onend ")"
    ]
]

audio-player: func [
    url [file! url!]
    /id [text!]
    /nocontrols
    /autoplay
    /muted
    /loop
    /type [text!]
][
    id: default [copy next find-last url {/}]
    type: default [unspaced [{audio/} next find-last url {.}]]

    trim/with id unspaced [{.} type]

    print/html unspaced [
        {<audio id="} id {"} spaced [
            if not nocontrols '{controls}
            if autoplay '{autoplay}
            if muted '{muted}
            if loop '{loop}
        ] {>}

        {<source src="} url {" type="} type {">}

        {</audio>}
    ]

    player: media-object
    player/id: id

    player
]


if(!require(lubridate)) install.packages("lubridate");require(lubridate)
if(!require(dygraphs)) install.packages("dygraphs");require(dygraphs)
if(!require(dplyr)) install.packages("dplyr");require(dplyr)
if(!require(htmlwidgets)) install.packages("htmlwidgets");require(htmlwidgets)

HWdata <- function(dfGrande,tempoPrevisto)
{
  if(tempoPrevisto <= 0)
    tempoPrevisto = 36;

  df <- dfGrande
  df <- df %>%    #Limpeza de dados
    mutate_all(~ifelse(. %in% c("N/A", "null",""), NA, .)) %>%
    na.omit()
  df <- df[,c("Doc..Date","Order.qty")]
  df[,1] <- as.Date(df[,1])   #Formatação da data
  df <- aggregate(df$Order.qty, by=list(Category=df$Doc..Date), FUN=sum)
  df <- df[df$x >= 25,]
  df$Category <- ymd(date(df$Category))

  df$Category <- strptime(df$Category, "%Y-%m-%d" )
  df$Category <- as.POSIXct(df$Category)

  df$x <- as.numeric(df$x)
  df <- mutate(df, MonthYear = paste(year(Category),formatC(month(Category), width = 2, flag = "0")))

  df <- select(df,-Category,-MonthYear)

  dfTs <- ts(df,frequency = 12) #TS em séries de 1 mês

  #formação do gráfico
  hw <- HoltWinters(dfTs)
  hwPredict <- predict(hw, n.ahead = tempoPrevisto, prediction.interval = TRUE) #n.head número de meses para ser previsto
  all <- cbind(dfTs, hwPredict)

  PlotHW <- dygraph(all, "Previsao de Demanda") %>%
    dySeries("dfTs", label = "Atual") %>%
    dySeries(c("hwPredict.fit", "hwPredict.upr", "hwPredict.lwr"), label = "Previsto")

  saveWidget(PlotHW,"temp.html", selfcontained = FALSE)

  return(PlotHW)
}


#' Algae N:P use, thanks to Thomas Fuß
site_by_species = read.csv(file.path("data-raw", "algae", "spec_cs.csv"), row.names = 1)
site_by_env = read.csv(file.path("data-raw", "algae", "env_cs.csv"), row.names = 1)
catch_area = site_by_env$catch
site_by_species = as.matrix(site_by_species)
adj = read.csv(file.path("data-raw", "algae", "bodingbach.csv"), sep = ";", row.names = 1)
colnames(adj) = rownames(adj)
adj = as.matrix(adj)
nsites = nrow(site_by_env)

# we also define a layout to make plotting nice
layout = matrix(c(0, 0,   2, 3,   1, 3,   -5, 1.5,   -5, 2.5,   -6, 2.5,   -5, 3,   -4, 2,
	-3, 2,   -2, 2.5,   -2, 2,   -1, 2,   1, 2,   -2, 1,   -1, 1.5,   -1, 1,   0, 1),
    byrow = TRUE, nrow = nsites)

## we need the discharge at every node
#for now I choose catchment area, scaled from Raymond paper (see watershed package)
library(units)
# in cubic kilometers per day
Q = exp(-11.9749609 + 0.78 * log(catch_area / (1000^2)))
units(Q) = "km^3 / day"
# convert to m^3/s
Q = set_units(Q, "m^3/s")

z = set_units(exp(-0.895 +  0.294 * log(drop_units(Q))), "m")
w = set_units(exp(2.56 + 0.423 * log(drop_units(Q))), "m")
cs_area = z * w

rn = river_network(adjacency = adj, discharge = drop_units(Q), area = drop_units(cs_area),
	layout = layout, site_names = rownames(adj))

# and we need starting resource concentrations and species distributions
r0 = as.matrix(site_by_env[, c("N_mean", "P_mean")])

# niche_loc is the "optimal" N:P ratio for a species; mean of N:P at all sites where sp is found
ntop = matrix((r0[,1]/r0[,2]), ncol=1)
niche_loc = (t(site_by_species) %*% ntop) / colSums(site_by_species)
colnames(niche_loc) = "N:P"

# niche_breadth is the breadth of the niche; we use sd, could also use the range, CV etc
niche_breadth = sweep(site_by_species, 1, ntop, FUN = `*`)
niche_breadth[niche_breadth == 0] = NA
niche_breadth = apply(niche_breadth, 2, sd, na.rm = TRUE)

niches = data.frame(species = rownames(niche_loc), location = niche_loc[,1],
	breadth = niche_breadth)

nopts = list(location = niches$location, breadth = niches$breadth, ratio = c(1, 2))
mc = metacommunity(nsp = nrow(niches), nr = 2, niches = niches_custom, niche_args = nopts,
  sp_names = niches$species, r_names = c("N", "P"))

alg_flume = flume(mc, rn, sp0 = site_by_species, st0 = r0)

algae = list(niches = niches, adjacency = adj, discharge = Q, cs_area = cs_area, layout = layout,
	network = rn, r0 = r0, sp0 = site_by_species, metacommunity = mc)

usethis::use_data(algae, overwrite = TRUE)

# TODO: add something like this legend to my own plot functions
# plot(network, variable = "N:P", edge.arrow.size = 0.2, edge.width = 20)
# col = scales::col_numeric("PuBu", c(0,1))(seq(0, 1, 0.1))
# legend("bottomleft", legend=seq(14, 660, 70), fill=col, bty='n', cex=0.7, title="N:P")


#Tutorial and Tips for Numerai

#***
#The stock market is the hardest data science problem in the world.
#If it seems easy, you're doing it wrong.
#We don't know how to solve this problem. But here is what we know.
#We need your help. You take it from here.
#***
library(Metrics)
library(gbm)
library(randomForest)

# for automatic download of data and upload of submissions have a look at the package Rnumerai
# for the latest development release use devtools::install_github("Omni-Analytics-Group/Rnumerai") or pak::pkg_install("Omni-Analytics-Group/Rnumerai")
# for the CRAN version use install.packages("Rnumerai")

print("THIS SCRIPT DOWNSAMPLES DATA AND WILL LIKELY UNDERPERFORM THE example_predictions.csv")

#the training data is used to train your model how to predict the targets
training_data<-read.csv("numerai_training_data.csv", header=T)
#the tournament data is the data that Numerai uses to evaluate your model
tournament<-read.csv("numerai_tournament_data.csv", header=T)
#the tournament data contains validation data, test data and live data
#validation is a hold out set out of sample and further in time (higher eras) than the training data
validation<-tournament[tournament$data_type=="validation",]

benchmark<-0.002
consistency<-function(data_with_probs, target_name){
  unique_eras<-unique(data_with_probs$era)
  era_correlation<-vector()
  i<-1
  while(i<=length(unique_eras)){
    this_data<-data_with_probs[data_with_probs$era==unique_eras[i],]
    era_correlation[i]<-cor(this_data[,names(this_data)==target_name], this_data$prediction, method="spearman")
    i<-i+1
  }
  consistency<-sum(era_correlation>benchmark)/length(era_correlation)
  consistency
}

#the training data is large so we reduce it by 10x in order to speed up this script
#NB reducing the training data like this is not recommended for a production ready model
nrow(training_data)
set.seed(10)
#remove the following line to not downsample. Note: it will take much longer to run
sample_rows<-sample(1:nrow(training_data), ceiling(nrow(training_data)/10))
train<-training_data[sample_rows,]

#we remove the id, era, and data_type columns for now
train<-train[,-c(1:3)]
nrow(train)

#there are a large number of features
ncol(train)
#features are a number of feature groups of different sizes (intelligence, charisma, strength, dexterity, constitution, wisdom)
#Numerai does not disclose what the features or feature groups mean; they are abstract and obfuscated
#however, features within feature groups tend to be related in some way
#models which have large feature importance in one group tend to do badly for long stretches of time (eras).
head(names(train),20)

#the target variable has 5 ordinal outcomes (0,0.25,0.5,0.75,1)
#we train a model on the features to predict this target
summary(train$target)

#on this dataset, feature importance analysis is very important
#we build a random forest to understand which features tend to improve the model out of bag
#because stocks within eras are not independent, we use small bag sizes (sampsize=10%) so the out of bag estimate is meaningful
#we use a small subset of features for each tree to build a more feature balanced forest (mtry=10%)
set.seed(10)
forest<-randomForest(target~., data=train, ntree=50, mtry=ceiling(0.1*ncol(train)-1), sampsize=ceiling(0.1*nrow(train)), importance=T, maxnodes=5)
#a good model might drop the bad features according to the forest before training a final model
#if a feature group or feature is too good, it might also be a good idea to drop to improve the feature balance and improve consistency of the model
imp<-importance(forest)
imp<-imp[order(imp[,1], decreasing = FALSE),]
head(imp)

#based on the forest we can generate predictions on the validation set
#the validation set contains eras further in time than the training set
#the validation set is not "representative of the live data"; no one knows how the live data will behave
#usually train performance < validation performance < live performance because live data is many eras into the future from the training data
predictions<-predict(forest, validation)
head(predictions)
#Numerai measures performance based on Rank Correlation between your predictions and the true targets
cor(validation$target, predictions, method="spearman")
val<-validation
val$prediction<-predictions
#consistency is the fraction of months where the model achieves better correlation with the targets than the benchmark
consistency(val, "target")

#we try a gbm model; we also choose a low bag fraction of 10% as a strategy to deal with within-era non-independence (which is a property of this data)
#(if you take a sample from one era and a different sample from the same era that sample is not really out of sample because the observations occured in the same era)
#having small bags also improves the out of bag estimate for the optimal number of trees
set.seed(10)
model<-gbm(target~., data=train, n.trees=50, shrinkage=0.01, interaction.depth=5, train.fraction=1, bag.fraction=0.1, verbose=T)
#looking at the relative importance of the features we can see the model relies more on some features than others
head(summary(model))
best.iter <- gbm.perf(model, method="OOB")
best.iter

#we check performance of the gbm model on the out of sample validation data
predictions<-predict.gbm(model, validation, n.trees=best.iter, type="response")
head(predictions)
cor(validation$target, predictions, method="spearman")
val<-validation
val$prediction<-predictions
consistency(val, "target")

#the gbm model and random forest model have the same consistency (number of eras where correlation > benchmark) even though correlation are different
#improving consistency can be more important than improving standard machine learning metrics like RMSE
#good models might train in such a way as to minimize the error across eras (improve consistency) not just reduce the error on each training example

#so far we have ignored eras for training
#eras are in order of time; for example, era4 is before era5
#the reason to use eras is that cross validation on rows will tend to overfit (rows within eras are not independent)
#so it's much better to cross validate within eras for example: take a subset of eras, build a model and test on the out of sample subset of eras
#this will give a better estimate of how well your model will generalize
#the validation set is not special; it is just an out of sample set of eras greater than the training set
#some users might choose to train on the validation set as well

#to give you a sense of how to use eras we train a model on the first half of the eras and test it on the second half
#we take another 10x smaller sample of data to speed up the script
ordered_eras<-unique(training_data$era)
train<-training_data[sample_rows,]
first_half<-train[train$era%in%ordered_eras[1:ceiling(length(ordered_eras)/2)],]
second_half<-train[!(train$id%in%first_half$id),]

#we remove id, era, data_type column and train a gbm model on the first half of the data
set.seed(10)
model<-gbm(target~., data=first_half[,-c(1:3)], n.trees=100, shrinkage=0.01, interaction.depth=5, train.fraction=1, bag.fraction=0.1, verbose=T)
best.iter <- gbm.perf(model, method="OOB")
best.iter

predictions<-predict.gbm(model, second_half, n.trees=best.iter, type="response")
#our correlation score is good; what we appeared to learn generalizes well on the second half of the eras
0.5+cor(second_half$target, predictions, method="spearman")
sec<-second_half
sec$prediction<-predictions
#consistency is the fraction of months where the model achieves better correlation with the targets than the benchmark
consistency(sec, "target")

#but now we try build a model on the second half of the eras and predict on the first half
set.seed(10)
model<-gbm(target~., data=second_half[,-c(1:3)], n.trees=100, shrinkage=0.01, interaction.depth=5, train.fraction=1, bag.fraction=0.1, verbose=T)
best.iter <- gbm.perf(model, method="OOB")
best.iter

predictions<-predict.gbm(model, first_half, n.trees=best.iter, type="response")
#our correlation score is surprisingly low and surprisingly different from when we trained on the first half
#this means our model is not very consistent, and it's possible that we will see unexpectedly low performance on the test set or live set
#it also shows that our validation performance is likely to greatly overestimate our performance--this era-wise cross validation is more valuable
#a model whose performance when training on the first half is the same as training on the second half would likely be more consistent
#and would likely perform better on the tournament data and the live data
cor(first_half$target, predictions, method="spearman")
fir<-first_half
fir$prediction<-predictions
#consistency is the fraction of months where the model achieves better correlation with the targets than the benchmark
consistency(fir, "target")

#Numerai only pays models with correlations that beat the benchmark on the live portion of the tournament data
#to submit predictions from your model to Numerai, predict on the entire tournament data
#we choose use our original forest model for our final submission
tournament$prediction<-predict(forest, tournament)

#create your submission
submission<-subset(tournament, select=c(id, prediction))
head(submission)

#save your submission and now upload it to https://numer.ai
write.csv(submission, file="submission.csv", row.names=F)


data <- read.csv("excess.csv")

popTable <- read.csv("nst-est2019-alldata.csv")

library(dplyr)

library(rbenchmark)

benchmark("r" = {
            data$Excess <- data$ObservedNumber - data$AverageExpectedCount
            data$WeekEndingDate <- as.Date(data$WeekEndingDate, format="%Y-%m-%d")

            excessTable <- data |> filter(Type=='Unweighted' & Outcome=='Allcauses' & WeekEndingDate < '2021-11-13' & WeekEndingDate > '2020-03-13') |> group_by(State) |> summarise(Excess = sum(Excess))

            joined <- merge(x = excessTable, y = popTable, by.x = 'State', by.y = 'NAME')

            joined$ExcessPP <- joined$Excess / joined$POPESTIMATE2019

            select(joined, State, ExcessPP) |> arrange(desc(ExcessPP))
          },
          replications=100
          )


library(rstan)
library(data.table)
library(lubridate)
library(gdata)
library(dplyr)
library(tidyr)
library(EnvStats)
library(scales)
library(stringr)
library(abind)

process_covariates <- function(
  regions,
  mobility,
  interventions,
  d,
  ifr.by.country,
  N2,
  formula,
  formula_partial
){
  interventions$Country <- factor(interventions$Country)

  serial.interval = read.csv("data/serial_interval.csv")
  # Pads serial interval with 0 if N2 is greater than the length of the serial
  # interval array
  if (N2 > length(serial.interval$fit)) {
    pad_serial.interval <- data.frame(
      "X"=(length(serial.interval$fit)+1):N2,
      "fit"=rep(1e-17, max(N2-length(serial.interval$fit), 0 ))
    )
    serial.interval = rbind(serial.interval, pad_serial.interval)
  }
  # various distributions required for modeling
  mean1 <- 5.1; cv1 <- 0.86; # infection to onset
  mean2 <- 18.8; cv2 <- 0.45 # onset to death
  x1 <- rgammaAlt(1e6,mean1,cv1) # infection-to-onset distribution
  x2 <- rgammaAlt(1e6,mean2,cv2) # onset-to-death distribution

  ecdf.saved <- ecdf(x1+x2)
  forecast <- 0
  dates <- list()
  reported_cases <- list()
  stan_data <- list(M=length(regions),N=NULL,deaths=NULL,f=NULL,
                    N0=6,cases=NULL,SI=serial.interval$fit[1:N2],
                    EpidemicStart = NULL, pop = NULL)
  deaths_by_country <- list()
  intervention_length <- length(colnames(interventions))
  mobility_length <- length(colnames(mobility))

  covariate_list <- list()
  covariate_list_partial <- list()
  k=1

  # going over each region
  for (Country in regions){
    IFR <- ifr.by.country$ifr[ifr.by.country$country == Country]

    mobility1 <- mobility[mobility$country==Country,]
    mobility1$date<-ymd(mobility1$date)
    mobility1<-na.locf(mobility1)
    mobility1 <- mobility1[order(mobility1$date),]  # ensure date ordering

    region_pop <- ifr.by.country[ifr.by.country$country==Country,]
    region <- d[d$country==Country,]
    region$DateRep <-region$DateRep
    region <-region[order(as.Date(region$DateRep)),]  # ensure date ordering

    # padding in raw data backwards ex. portugal
    date_min <- dmy('31/12/2019')
    if (region$DateRep[1] > date_min){
      print(paste(Country,'In padding ECDC data'))
      pad_days <-region$DateRep[1] - date_min
      pad_dates <- date_min + days(1:pad_days[[1]]-1)
      padded_data <- data.frame("country" = rep(Country, pad_days),
                                "DateRep" = as.Date(pad_dates,format="%Y-%m-%d"),
                                "Cases" = as.integer(rep(0, pad_days)),
                                "Deaths" = as.integer(rep(0, pad_days)),
                                stringsAsFactors=F)

     region <- bind_rows(padded_data,region)
    }

    # replace NA in mobility data
    mobility1$grocery.pharmacy <- na.locf(mobility1$grocery.pharmacy)
    mobility1$residential <- na.locf(mobility1$residential)
    mobility1$parks <- na.locf(mobility1$parks)
    mobility1$workplace <- na.locf(mobility1$workplace)
    mobility1$retail.recreation <- na.locf(mobility1$retail.recreation)
    mobility1$transitstations <- na.locf(mobility1$transitstations)

    # Padding in mobility data for dates before first time data exists
    if (mobility1$date[1] > date_min){
      print(paste(Country,'In padding mobility backwards'))
      pad_days <- mobility1$date[1] - date_min
      pad_dates <- date_min + days(1:pad_days[[1]]-1)
      PAD = rep(0,pad_days)
      if (mobility_length==8){
        padded_data <- data.frame("country" = rep(Country, pad_days),
                                  "date" = pad_dates,
                                  "grocery.pharmacy" = PAD, #rep(mobility1$grocery.pharmacy[1],pad_days),
                                  "parks" = PAD, #rep(mobility1$parks[1],pad_days),
                                  "residential" = PAD, #rep(mobility1$residential[1],pad_days),
                                  "retail.recreation" =PAD, #rep(mobility1$retail.recreation[1],pad_days),
                                  "transitstations" = PAD, #rep(mobility1$transitstations[1],pad_days),
                                  "workplace" = PAD, #rep(mobility1$workplace[1],pad_days),
                                  stringsAsFactors=F)
      }
      mobility1 <- bind_rows(padded_data, mobility1)
    }
    mobility1 = mobility1[order(mobility1$date),]  # ensure date ordering

    # forecasting mobility data
    date_max = max(region$DateRep)
    date_mobility_max = max(mobility1$date)

    if (date_mobility_max < date_max){
      print(paste(Country,'In padding mobility forward'))
      forecast_days <- date_max - date_mobility_max
      forecast_dates <- date_mobility_max + days(1:forecast_days[[1]])
      forecast_data <- data.frame("country"=rep(Country,forecast_days[[1]]),"date" = as.Date(forecast_dates,format="%Y-%m-%d"))
      fore<-list()

      for(i in 3:mobility_length){
        mob<- mobility1 %>% select(date,colnames(mobility[i]))

        # impute last week
        #fore[[i]] <- c(0:(as.numeric(forecast_days)-1)) %>% map(function(s) ts[length(ts)-6+mod(s,7)])
        f <- c(0:(as.numeric(forecast_days)-1)) %>% map(function(s) mob[nrow(mob)-6+mod(s,7),]) %>% bind_rows()
        fore[[i]]<-f[,2]
      }

      padded_data <- data.frame("country" = rep(Country, forecast_days[[1]]),
                                "date" = forecast_dates,
                                "grocery.pharmacy" = fore[[3]],
                                "parks" = fore[[4]],
                                "residential" = fore[[5]],
                                "retail.recreation" = fore[[6]],
                                "transitstations" = fore[[7]],
                                "workplace" = fore[[8]],
                                stringsAsFactors=F)
      mobility1 <- bind_rows(mobility1,padded_data)
    }
    mobility1 = mobility1[order(mobility1$date),]  # ensure date ordering
    mobility1<-na.locf(mobility1)

    index = which(region$Cases>0)[1]
    index1 = which(cumsum(region$Deaths)>=10)[1] # also 5
    index2 = index1-30

    print(sprintf("First non-zero cases is on day %d, and 30 days before 10 deaths is day %d",index,index2))
    region=region[index2:nrow(region),]
    stan_data$EpidemicStart = c(stan_data$EpidemicStart,index1+1-index2)
    stan_data$pop = c(stan_data$pop,region_pop$popt)
    mobility1 = mobility1[index2:nrow(mobility1),]
    # NPI interventionss are being used
    interventions_region <- interventions[interventions$Country == Country, c(2,3,4,5,6)] # school, self-isolation, public, lockdown, social-distancing
    for (ii in 1:ncol(interventions_region)) {
      covariate = names(interventions_region)[ii]
      region[covariate] <- (region$DateRep >= as.data.frame(interventions_region)[1,covariate])*1  # should this be > or >=?
    }

    dates[[Country]] =region$DateRep
    # hazard estimation
    N = length(region$Cases)
    print(sprintf("%s has %d days of data",Country,N))
    forecast = N2 - N
    # IFR is the overall probability of dying given infection
    convolution = function(u) (IFR * ecdf.saved(u))

    f = rep(0,N2) # f is the probability of dying on day i given infection
    f[1] = (convolution(1.5) - convolution(0))
    for(i in 2:N2) {
      f[i] = (convolution(i+.5) - convolution(i-.5))
    }
    reported_cases[[Country]] = as.vector(as.numeric(region$Cases))
    deaths=c(as.vector(as.numeric(region$Deaths)),rep(-1,forecast))
    cases=c(as.vector(as.numeric(region$Cases)),rep(-1,forecast))
    deaths_by_country[[Country]] = as.vector(as.numeric(region$Deaths))
    region_intervention <- as.data.frame(region[, colnames(interventions_region)])
    region_intervention[N:(N+forecast),] <- region_intervention[N,]
    mobility1[N:(N+forecast),] <- mobility1[N,]
    ## append data
    stan_data$N = c(stan_data$N,N)
    # stan_data$x = cbind(stan_data$x,x)
    stan_data$f = cbind(stan_data$f,f)
    stan_data$deaths = cbind(stan_data$deaths,deaths)
    stan_data$cases = cbind(stan_data$cases,cases)

    stan_data$N2=N2
    stan_data$x=1:N2
    if(length(stan_data$N) == 1) {
      stan_data$N = as.array(stan_data$N)
    }
    #parsing features
    df_features <- data.frame('schools_universities' = region_intervention$schools_universities,
                              'self_isolating_if_ill' = region_intervention$self_isolating_if_ill,
                              'social_distancing_encouraged' = region_intervention$social_distancing_encouraged,
                              'public_events' = region_intervention$public_events,
                              'lockdown' = region_intervention$lockdown,
                              'first' = 1*((region_intervention$schools_universities+
                                              region_intervention$self_isolating_if_ill+
                                              region_intervention$social_distancing_encouraged+
                                              region_intervention$public_events+
                                              region_intervention$lockdown) >= 1),
                              'residential' = mobility1$residential,
                              'transit' = mobility1$transitstations,
                              'grocery' = mobility1$grocery.pharmacy,
                              'parks' = mobility1$parks,
                              'retail' = mobility1$retail.recreation,
                              'workplace' = mobility1$workplace,
                              'averageMobility' = (mobility1$grocery.pharmacy + mobility1$parks +
                                                     mobility1$retail.recreation + mobility1$workplace)/4)
    features <- model.matrix(formula, df_features)
    features_partial <- model.matrix(formula_partial, df_features)

    covariate_list[[k]] <- features
    covariate_list_partial[[k]] <- features_partial
    k <- k+1
  }

  stan_data$P = dim(features)[2]
  stan_data$X = array(NA, dim = c(stan_data$M , stan_data$N2 ,stan_data$P ))
  stan_data$P_partial = dim(features_partial)[2]
  # If there is no partial pooling of variables set of dim 1 to avoid overflows
  if(stan_data$P_partial==0){
    stan_data$X_partial = array(0, dim = c(stan_data$M , stan_data$N2, 1))
  }
  # If there partial pooling of variables set X_partial to the correct size:
  # (countries or regions)* N2 * P_partial
  else{
    stan_data$X_partial = array(NA, dim = c(stan_data$M , stan_data$N2 ,stan_data$P_partial))
  }
  # Unpack covariates and partial covariates to pass to stan model
  for (i in 1:stan_data$M){
    stan_data$X[i,,] = covariate_list[[i]]
    if(stan_data$P_partial != 0)
      stan_data$X_partial[i,,] = covariate_list_partial[[i]]
  }
  if(stan_data$P_partial == 0) # special case when ther are no partial covariates
    stan_data$P_partial = 1

  # Normalise positive covariate effects to be between 0 and 1
  stan_data$X=normalise_covariate_array(stan_data$X)
  # Normalise positive pooled covariate effects to be between 0 and 1
  stan_data$X_partial=normalise_covariate_array(stan_data$X_partial)

  return(list("stan_data" = stan_data, "dates" = dates, "reported_cases"=reported_cases, "deaths_by_country" = deaths_by_country))
}

normalise_covariate_array <- function(covariate_array){
  # Normalise positive covariate effects to be between 0 and 1
  dm=dim(covariate_array)
  for(j in 1:dm[3]){ # for covariates
    for(i in 1:dm[1]){ # countries
      raw=covariate_array[i,,j]
      if(all(raw!=0)){
        top = raw[raw>=0]
        bottom = raw[raw<=0]
        adjusted=raw
        # only act on real valued covariates (not the discrete interventions)
        if(sum(top==1)!=length(top)){
          top=rescale(top,to=c(0,1))
          adjusted[raw>=0]=top
        }
        covariate_array[i,,j] = adjusted
      }
    }
  }
  return(covariate_array)
}


apply.qntMethod <- function(qntMethod,
                            p.score,
                            n.score,
                            test,
                            TprFpr = NULL,
                            thr = NULL,
                            measure="hellinger",
                            train = NULL,
                            dts_id,
                            db_te){

  if(qntMethod == "CC")
    return(mlquantify::CC(test))

  if(qntMethod == "PCC")
    return(mlquantify::PCC(test))

  if(qntMethod == "ACC")
    return(mlquantify::ACC(test, TprFpr))

  if(qntMethod == "PACC")
    return(mlquantify::PACC(test, TprFpr))

  if(qntMethod == "HDy-LP")
    return(mlquantify::HDy_LP(p.score, n.score, test))

  if(qntMethod == "DyS")
    return(mlquantify::DyS(p.score, n.score, test, measure = measure))

  if(qntMethod == "SORD")
    return(mlquantify::SORD(p.score, n.score, test))

  if(qntMethod == "DySyn")
    return(DySyn(test, measure)[[1]])

  if(qntMethod == "MS")
    return(mlquantify::MS(test, TprFpr))

  if(qntMethod == "MS2")
    return(mlquantify::MS2(test = test, TprFpr = TprFpr))

  if(qntMethod == "T50")
    return(mlquantify::T50(test, TprFpr))

  if(qntMethod == "X")
    return(mlquantify::X(test, TprFpr))

  if(qntMethod == "MAX")
    return(mlquantify::MAX(test, TprFpr))

  if(qntMethod == "EMQ"){
    test <- as.data.frame(cbind(test,1-test))
    names(test) <- c("1", "2")
    return(mlquantify::EMQ(train = train, test = test))
  }
  if(qntMethod == "SMM")
    return(mlquantify::SMM(p.score = p.score, n.score = n.score, test = test))

  if(qntMethod == "QT"){

    #db_te$class <- as.factor(db_te$class)
    nn <- names(db_te)
    nn <- c(nn[-1], nn[1])
    db_te <- cbind(db_te[,-1], db_te[,1])
    names(db_te) <- nn
    db_te$class <- factor(db_te$class, levels=sort(unique(train$class)))

    write.arff(db_te, paste0("./test_QT/test_set_", dts_id,".arff"))
    command <- paste0("java  -Xmx5G -cp quantify.jar:weka.jar:. weka.classifiers.trees.RandomForest -l ./models_train_test/",dts_id, "/", paste0("classifier_RF_QT"),
                      " -T ", "./test_QT/test_set_", dts_id,".arff")
    system(paste0(command," > ", "./test_QT/re_", dts_id,".txt"))
    x <- read.delim(paste0("./test_QT/re_", dts_id,".txt"))

    pos <- as.vector(na.omit(as.numeric(strsplit(as.character(x[4,])," ")[[1]])))[1]
    pos <- pos + as.vector(na.omit(as.numeric(strsplit(as.character(x[5,])," ")[[1]])))[1]
    pos <- pos/nrow(db_te)
    freq_PRE <- as.data.frame(round(cbind(pos, 1-pos),2))
    names(freq_PRE) <- c("1", "2")
    return(freq_PRE)
  }

  print("ERROR - Quantification method was not applied!")
  return(NULL)
}

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


# Copyright 2014-2019 Arnaud Poret
# This work is licensed under the BSD 2-Clause License.
# To view a copy of this license, visit https://opensource.org/licenses/BSD-2-Clause

#### HOWTO #####################################################################

# 1) read my article, freely available at https://arxiv.org/abs/1407.1135
# 2) in addition to the present file (example.r), open the following ones:
#     * edge.r (contains code related to edges)
#     * node.r (contains code related to nodes)
# 3) read these files (edge.r, node.r and example.r)
# 4) replace their content with your own stuff
# 5) launch R
# 6) run ``source("example.r")''

# Plotted results produced by the present example are available in the file example_plot.svg.

# Tested with R version 3.5.0 under Arch Linux.

# This example is a tiny sample of the epidermal growth factor receptor signaling pathway taken from [1].

# [1] Melody K Morris, Julio Saez-Rodriguez, Peter K Sorger, Douglas A Lauffenburger (2010) Logic-based models for the analysis of cell signaling networks. Biochemistry, 49(15):3216-3224.

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

# close pre-existing plots
for(i in dev.list()) {
    dev.off(i)
}

# delete pre-existing variables
rm(list=ls())

# number of iterations to perform during a simulation
kend<-100

# if all the nodes should be automatically plotted
plotall<-TRUE

# if all the plots should be automatically saved
# only relevant if plotall=TRUE
# here the SVG file format is used
printall<-FALSE

# read edge data required for the simulation
# see the corresponding file for details
source("edge.r")

# read node data required for the simulation
# see the corresponding file for details
source("node.r")

# read other data required for the simulation
# see the corresponding file for details
source("lib.r")

# execute the simulation and return node states
node<-dothejob(node0,r,w,kend,nedge,nnode,nodelab,plotall,printall)


library(plyr)
library(ggplot2)
library(reshape2)

snvFiles <- Sys.glob("*-snvs-*.out")
snvs <- data.frame()

for (f in snvFiles) {
  x <- read.table(f, head=T, sep="\t")
  snvs <- rbind(snvs, x)
}

modelSummary <- read.table("model-summary.txt", head=T, sep="\t")
df <- join(snvs, modelSummary, by="build_id")

snvFilters <- c("FalsePositive", "FalsePositiveVcf","PASS", "VarFilterSnv")
df$Total <- rowSums(df[,snvFilters])

t <- df[,snvFilters]/df$Total
colnames(t) <- sprintf("%sRatio", colnames(t))
df <- cbind(df,t)

df$read_len <- factor(df$read_len)
ord <- unique(df[order(df$read_len), 'build_id'])
df$build_id  <- factor(df$build_id, levels=ord)

p <- ggplot(df, aes(x=build_id, y=PASSRatio, fill=read_len)) +
     geom_bar(stat="identity", pos="dodge")

mdf <- melt(df, measure.vars=snvFilters)

p2 <- ggplot(mdf[mdf$variable!="PASS",],
             aes(x=build_id, y=value, fill=variable)) +
      geom_bar(stat="identity", pos="dodge")

PP <- p2 + facet_grid(.~read_len, scales="free") +
           theme(axis.text.x=element_blank(), axis.ticks.x=element_blank())


  ## Goal: prepare tidy data that can be used for later analysis about wearables.
  #
  # Steps:
  # 1. Merges the training and the test sets to create one data set.
  # 2. Extracts only the measurements on the mean and standard deviation for each measurement.
  # 3. Uses descriptive activity names to name the activities in the data set
  # 4. Appropriately labels the data set with descriptive variable names.
  # 5. From the data set in step 4, *creates a second, independent tidy data set
  #    with the average of each variable for each activity and each subject.*
  #
  ## Submit:
  # tidy data set created in step 5 as txt file

  library (dplyr)

    # 0. Read all the files into appropriate data frames

    ## set the working directory (assume the folder with the data sets is in the same directory as this script)
  setwd("./UCI HAR Dataset")

    ## check if file exists (ignore the inertial folders)
  if (!file.exists("activity_labels.txt") | !file.exists("features.txt")) {
    stop("invalid directory")
  }

    ## read files and load datasets
  act  <- read.table("activity_labels.txt")
      ### act has 6 obs. of 2 variables (1...6 as code and its label)
  features  <- read.table("features.txt", col.names=c("ID","name"))
      ### features has 561 obs. of 2 variables (1...n and its label)

  setwd("./test")
  testSub <- read.table("subject_test.txt")
     ### Sub has 2947 obs. of 1 variable (=int 1...30)
  testX <- read.table("X_test.txt")
     ### testX has 2947 obs. of 561 variables (see features above)
  testY <- read.table("y_test.txt")
     ### testY has 2947 obs. of 1 variable (the activity label)

  setwd("../train")
  trainSub <- read.table("subject_train.txt")
     ### trainSub has 7352 obs of 1 variable
  trainX <- read.table("X_train.txt")
     ### trainX has 7352 obs. of 561 variables
  trainY <- read.table("y_train.txt")
     ### trainY has 7352 obs. of 1 variable

  # 1. Merge the training and the test sets to create one data set.
  allX <- merge(testX, trainX, all=TRUE)
  allSub <- merge(testSub, trainSub, all=TRUE)
  allY <- rbind(testY, trainY) # alternative merge using rbind()

  # 2. Uses descriptive activity names to name the activities in the data set
   ## first extract the column names from file features.txt
  #featuresNames <- as.vector(features[["name"]])
   ## then change the column names of the X data set
  colnames(allX) <- as.vector(features[["name"]])
  # now keep only columns where the name has mean or std inside (use regex)

  # 3. Extracts only the measurements on the mean and standard deviation for each measurement.
  allX <- allX[, grepl("mean|Mean|std", names(allX))]

  # 4. Appropriately labels the data set with descriptive variable names.
   ## features have already correct name

   ## change variable name of unique column of data frame allSub into "Subject"
  colnames(allSub) <- c("Subject")
   ## and add it the main data frame
  allX <- cbind(allX, allSub)
   ## same for allY: add it to main data frame as extra column but first map activity label to activity code
  Activity <- act$V2[match(allY$V1, act$V1)]
  allX <- cbind(allX, Activity)

  # 5. From the data set in step 4, *creates a second, independent tidy data set
  #    with the average of each variable for each activity and each subject.*
   ## 30 subjects * 6 activities = 180 observations (lines)
   ## Subject + Activity + 86 features = 88 variables (columns)

   ## group by Subject and Activity; then calculate the mean for each group resulted. new data set = tidy
  tidy <- allX %>% group_by(Subject, Activity) %>% summarise_each(funs(mean))

  # 6. Last, create the final tidy data set to be uploaded
  setwd("../..")
  fileName = "tiny_data.txt"
  write.table(tidy, fileName, row.name=FALSE)


[D, A -> D (3)]
[B, E -> B (1)]
[E, D -> E (2)]
[F, D -> F (6)]
[C, B -> C (4)]
[G, E -> G (1)]


# Copyright (c) Microsoft Corporation.  All rights reserved.

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

#
# WARNINGS:
#
# CREATION DATE: 06/01/2017
#
# LAST UPDATE: 08/12/2017
#
# VERSION: 1.0.0
#
# R VERSION TESTED: 3.4.0, 3.3.4, MRO 3.2.2
#
# AUTHOR: pbicvsupport@microsoft.com
#
# REFERENCES: https://robjhyndman.com/papers/ComplexSeasonality.pdf

Sys.setlocale("LC_ALL","English") # Internationalization

############ User Parameters #########

whichInfo = "none"
if(exists("settings_info_params_whichInfo"))
  whichInfo = settings_info_params_whichInfo

##PBI_PARAM: Show cumulative value inside shown period (actual + predicted)?
#Type:logical, Default:FALSE, Range:NA, PossibleValues:NA, Remarks: NA
showInfoCumSum = FALSE

##PBI_PARAM: Show TBATS method selected
#Type:logical, Default:FALSE, Range:NA, PossibleValues:NA, Remarks: NA
showInfoMethodTBATS = FALSE

##PBI_PARAM: Show information criterion of the found model
#Type:logical, Default:FALSE, Range:NA, PossibleValues:NA, Remarks: NA
showInfoCriterion = FALSE

if(whichInfo == "AIC")
{
  showInfoCriterion = TRUE
}else{
  if(whichInfo == "cumulative")
    showInfoCumSum = TRUE
  else
    if(whichInfo == "method")
      showInfoMethodTBATS = TRUE}

##PBI_PARAM: Forecast length
#Type:integer, Default:500, Range:NA, PossibleValues:NA, Remarks: NULL means choose forecast length automatically
forecastLength=500
if(exists("settings_forecastPlot_params_forecastLength"))
{
  forecastLength = as.numeric(settings_forecastPlot_params_forecastLength)
  if(is.na(forecastLength))
    forecastLength = 10
  forecastLength = round(max(min(forecastLength,1e+6),1))
}

##PBI_PARAM: Seasonal factor #1
#Type:enum, Default:"none", Range:NA, PossibleValues:none,manual, hour, day,...,year
targetSeason1 = "none"
if(exists("settings_forecastPlot_params_targetSeason1"))
{
  targetSeason1 = settings_forecastPlot_params_targetSeason1
}

##PBI_PARAM: Seasonal factor #2
#Type:enum, Default:"none", Range:NA, PossibleValues:none,manual, hour, day,...,year
targetSeason2 = "none"
if(exists("settings_forecastPlot_params_targetSeason2"))
{
  targetSeason2 = settings_forecastPlot_params_targetSeason2
}

##PBI_PARAM: Number of data points in smaller season period
#Type:integer, Default:1, Range:NA, PossibleValues:NA,
freq1=1
if(exists("settings_forecastPlot_params_freq1"))
{
  freq1 = as.numeric(settings_forecastPlot_params_freq1)
  if(is.na(freq1))
    freq1 = 1
  freq1 = round(max(min(freq1,1e+6),1))
}

##PBI_PARAM: Number of data points in larger season period
#Type:integer, Default:1, Range:NA, PossibleValues:NA,
freq2=1
if(exists("settings_forecastPlot_params_freq2"))
{
  freq2 = as.numeric(settings_forecastPlot_params_freq2)
  if(is.na(freq2))
    freq2 = 1
  freq2 = round(max(min(freq2,1e+6),1))
}

##PBI_PARAM: Confidence level
#Type:number, Default:0.5, Range:[0,1], PossibleValues:NA,
confInterval1 = 0.5
if (exists("settings_conf_params_confInterval1"))
{
  confInterval1 = as.numeric(settings_conf_params_confInterval1)
  if(is.na(confInterval1))
    confInterval1 = 0.5
}

##PBI_PARAM: Confidence level
#Type:number, Default:0.995, Range:[0,1], PossibleValues:NA,
confInterval2 = 0.995
if (exists("settings_conf_params_confInterval2"))
{
  confInterval2 = as.numeric(settings_conf_params_confInterval2)
  if(is.na(confInterval2))
    confInterval1 = 0.995
}
#swap if required
if(confInterval1>confInterval2)
{
  temp = confInterval2
  confInterval2 = confInterval1
  confInterval1 = temp
}

lowerConfInterval = confInterval1
upperConfInterval = confInterval2

##PBI_PARAM: Show period
#Type:string, Default:"all", Range:NA, PossibleValues:('all','hour','mday','week','mon','year')
showFromTo = "all"
if(exists("settings_graph_params_showFromTo"))
  showFromTo = settings_graph_params_showFromTo

possibleFromTo = c('all','hour','mday','week','mon','year')
if(!(showFromTo %in% possibleFromTo))
  showFromTo = possibleFromTo[1]

##PBI_PARAM: Shift period (for example 24 to start week at monday)
#Type:number, Default:0, Range:NA, PossibleValues:NA
refPointShift = 0
if(exists("settings_graph_params_refPointShift"))
  refPointShift = settings_graph_params_refPointShift

##PBI_PARAM: Show fitted
#Type:bool, Default:"F", Range:NA, PossibleValues:NA
showInPlotFitted = FALSE
if(exists("settings_graph_params_showInPlotFitted"))
  showInPlotFitted = settings_graph_params_showInPlotFitted

##PBI_PARAM: Show fitted
#Type:bool, Default:"F", Range:NA, PossibleValues:NA
valuesNonNegative = FALSE
if(exists("settings_additional_params_valuesNonNegative"))
  valuesNonNegative = settings_additional_params_valuesNonNegative

##PBI_PARAM: Use par. processing
#Type:bool, Default:"F", Range:NA, PossibleValues:NA
useParProc = FALSE
if(exists("settings_additional_params_useParProc"))
  useParProc = settings_additional_params_useParProc

##PBI_PARAM: fast algo?
#Type:bool, Default:"F", Range:NA, PossibleValues:NA
algModeFast = TRUE
if(exists("settings_additional_params_algModeFast"))
  algModeFast = settings_additional_params_algModeFast

##PBI_PARAM: Enables user to force certain type of X-ticks formats
#Type:string, Default:"auto", Range:NA, PossibleValues:
userFormatX = "auto" #
if(exists("settings_axes_params_userFormatX"))
  userFormatX = settings_axes_params_userFormatX

##PBI_PARAM: Y axis numbers format
#Type:bool, Default:"F", Range:NA, PossibleValues:NA
showScientificY = FALSE
if(exists("settings_axes_params_showScientificY"))
  showScientificY = settings_axes_params_showScientificY

##PBI_PARAM: Y axis label col
#Type:string, Default:"black", Range:NA, PossibleValues:NA
labelsTextCol = "black"
if(exists("settings_axes_params_labelsTextCol"))
  labelsTextCol = settings_axes_params_labelsTextCol

##PBI_PARAM: labels text size
#Type:number, Default:1.2, Range:[8,50]/12, PossibleValues:NA
sizeLabel = 12
if(exists("settings_axes_params_textSize"))
  sizeLabel = as.numeric(settings_axes_params_textSize)

##PBI_PARAM Color of time series line
#Type:string, Default:"orange", Range:NA, PossibleValues:"orange","blue","green","black"
pointsCol = "orange"
if(exists("settings_graph_params_dataCol"))
  pointsCol = settings_graph_params_dataCol

##PBI_PARAM Color of forecast line
#Type:string, Default:"red", Range:NA, PossibleValues:"red","blue","green","black"
forecastCol = "red"
if(exists("settings_graph_params_forecastCol"))
  forecastCol = settings_graph_params_forecastCol

fittedCol = "green"
if(exists("settings_graph_params_fittedCol"))
  fittedCol = settings_graph_params_fittedCol

#PBI_PARAM Transparency of scatterplot points
#Type:numeric, Default:0.4, Range:[0,1], PossibleValues:NA, Remarks: NA
transparency = 1
if(exists("settings_graph_params_percentile"))
  transparency = as.numeric(settings_graph_params_percentile)/100

#PBI_PARAM Size of points on the plot
#Type:numeric, Default: 1 , Range:[0.1,5], PossibleValues:NA, Remarks: NA
pointCex = 1
if(exists("settings_graph_params_weight"))
  pointCex = as.numeric(settings_graph_params_weight)/10

#PBI_PARAM Size of subtitle on the plot
#Type:numeric, Default: 0.75 , Range:[0.1,5], PossibleValues:NA, Remarks: NA
cexSub = 0.75
if(exists("settings_info_params_textSize"))
  cexSub = as.numeric(settings_info_params_textSize)/12

numDigitsInfo = 0
if(exists("settings_info_params_numDigitsInfo"))
  numDigitsInfo = as.numeric(settings_info_params_numDigitsInfo)

##PBI_PARAM Color of info text
#Type:string, Default:"red", Range:NA, PossibleValues:"red","blue","green","black"
infoTextCol = "gray50"
if(exists("settings_info_params_infoTextCol"))
  infoTextCol = settings_info_params_infoTextCol

##PBI_PARAM: export out data to HTML?
#Type:logical, Default:FALSE, Range:NA, PossibleValues:NA, Remarks: NA
keepOutData = FALSE
if(exists("settings_export_params_show"))
  keepOutData = settings_export_params_show

##PBI_PARAM: method of export interface
#Type: string , Default:"copy",  Range:NA, PossibleValues:"copy", "download",  Remarks: NA
exportMethod = "copy"
if(exists("settings_export_params_method"))
  exportMethod = settings_export_params_method

##PBI_PARAM: limit the out table exported
#Type: string , Default:1000,  Range:NA, PossibleValues:"1000", "10000", Inf,  Remarks: NA
limitExportSize = 10000
if(exists("settings_export_params_limitExportSize"))
  limitExportSize = as.numeric(settings_export_params_limitExportSize)

###############Internal parameters definitions#################

#PBI_PARAM Minimal number of points
#Type:integer, Default:15, Range:[5,50], PossibleValues:NA, Remarks: NA
minPoints = 15

#PBI_PARAM Shaded band for confidence interval
#Type:logical, Default:TRUE, Range:NA, PossibleValues:NA, Remarks: NA
fillConfidenceLevels=TRUE

#PBI_PARAM Size of warnings font
#Type:numeric , Default:cexSub*12, Range:NA, PossibleValues:[1,50], Remarks: NA
sizeWarn = cexSub * 12

#PBI_PARAM Size of ticks on axes
#Type:numeric , Default:8, Range:NA, PossibleValues:[1,50], Remarks: NA
sizeTicks = 8

##PBI_PARAM: Should warnings text be displayed?
#Type:logical, Default:TRUE, Range:NA, PossibleValues:NA, Remarks: NA
showWarnings = TRUE

#PBI_PARAM opacity of conf interval color
transparencyConfInterval = 0.3

###############Library Declarations###############
###############Internal functions definitions#################

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

libraryRequireInstall("plotly")
libraryRequireInstall("caTools")

###############Upfront input correctness validations (where possible)#################

pbiWarning = NULL
useParallel = useParProc
showInfo = any(c(showInfoCumSum, showInfoCriterion, showInfoMethodTBATS))

if(!exists("Date") || !exists("Value"))
{
  dataset=data.frame()
  pbiWarning  = cutStr2Show("Both 'Date' and 'Value' fields are required.", strCex = 0.85)
  timeSeries = ts()
  showWarnings = TRUE
}else{
  dataset = cbind(Date,Value)
  dataset <- dataset[complete.cases(dataset),] #remove corrupted rows
  labTime = "Time"
  labValue = names(dataset)[ncol(dataset)]

  dataset[,2] = as.numeric(dataset[,2])
  N = nrow(dataset)

  if(N == 0 && exists("Date") && nrow(Date) > 0 &&  exists("Value")){
    pbiWarning1  = cutStr2Show("Wrong date type. Only 'Date', 'Time', 'Date/Time' are allowed without hierarchy", strCex = 0.85)
    pbiWarning = paste(pbiWarning1, pbiWarning, sep ="\n")
    timeSeries = ts()
    showWarnings = TRUE
  }else {
    dataset = dataset[order(dataset[,1]),]
    parsed_dates = strptime(dataset[,1], "%Y-%m-%dT%H:%M:%S", tz="UTC")
    labTime = names(Date)[1]

    if((any(is.na(parsed_dates))))
    {
      pbiWarning1  = cutStr2Show("Wrong or corrupted 'Date'.", strCex = 0.85)
      pbiWarning2  = cutStr2Show("Only 'Date', 'Time', 'Date/Time' types are allowed without hierarchy", strCex = 0.85)
      pbiWarning = paste(pbiWarning1, pbiWarning2, pbiWarning, sep ="\n")
      timeSeries=ts()
      showWarnings=TRUE
    }
    else
    {
      interval = difftime(parsed_dates[length(parsed_dates)],parsed_dates[1])/(length(parsed_dates)-1) # force equal spacing
      myFreq1 = getFrequency1(parsed_dates = parsed_dates, values = dataset[,2],
                              tS = targetSeason1, f = freq1)
      myFreq2 = getFrequency1(parsed_dates = parsed_dates, values = dataset[,2],
                              tS = targetSeason2, f = freq2)
      timeSeries=ts(data = dataset[,2], start=1, frequency = round(myFreq1))
    }
  }
}

##############Main Visualization script###########

pbiInfo = NULL

gooodpd = goodPlotDimension(3.25, 2.5)

if(length(timeSeries) >= minPoints && gooodpd) {

  # compute part of dates to show
  actTimes = as.POSIXlt(seq(from=parsed_dates[1], to = parsed_dates[length(parsed_dates)], length.out = length(parsed_dates)))
  allTimes = as.POSIXlt(seq(from=parsed_dates[1], to = (parsed_dates[length(parsed_dates)]+interval*(forecastLength)), length.out = length(parsed_dates)+forecastLength))
  fFromTo = indexShowFromTo(showFromTo,actTimes, allTimes, refPointShift)
  myInclude = length(actTimes) - fFromTo[1] + 1
  myForecastLength = min(forecastLength,fFromTo[2] - length(actTimes))

  if(myForecastLength == 0)# need to forecast next day/week/etc
  {
    myForecastLength = myInclude
    fFromTo = c(length(actTimes)+1,length(actTimes)+ myForecastLength)
    myInclude = 0
    myForecastLength = min(forecastLength,myForecastLength)
  }

  freqs = joinFreq(myFreq1, myFreq2)
  timeSeries = msts(dataset[,2], seasonal.periods=freqs, start= (-N+myInclude ) / max(freqs) )#

  if(algModeFast)# mode with preselected parameters
    fit <- tbats(timeSeries, use.box.cox = FALSE, use.trend = FALSE, use.damped.trend = FALSE,
                 use.arma.errors = FALSE, max.p= 2, max.q = 2,
                 max.P = 1, max.Q = 1, max.order= 3, max.d = 1, max.D = 0, use.parallel = useParallel )
  else
    fit <- tbats(timeSeries, use.parallel = useParallel)

  #TODO: add user mode with all tbats params from GUI

  if(lowerConfInterval == 0)
    lowerConfInterval = NULL;

  if (is.null(forecastLength))
    prediction = forecast(fit, level=c(lowerConfInterval, upperConfInterval))
  else
    prediction = forecast(fit, level=c(lowerConfInterval, upperConfInterval), h = myForecastLength)

  if(valuesNonNegative)
  {
    prediction$mean[prediction$mean < 0] = 0
    prediction$upper[prediction$upper < 0] = 0
    prediction$lower[prediction$lower < 0] = 0
    prediction$fitted[prediction$fitted < 0] = 0
  }

  inI = seq(from = fFromTo[1],length.out = myInclude)

  #calculate cumulative forecast
  tempVal = sum(dataset[inI, 2])
  if(is.na(tempVal))
    tempVal = 0
  myCumSum = sum(prediction$mean) + tempVal

  if(showInfo && showInfoMethodTBATS)
    pbiInfo=paste(pbiInfo,"", prediction$method, "", sep="")

  if(showInfoCumSum)
    pbiInfo=paste(pbiInfo, "Cumulative forecast: ", format(myCumSum, digits=4, nsmall = numDigitsInfo, scientific = F,  big.mark       = ","),"", sep="")

  if(showInfoCriterion)
    pbiInfo=paste(pbiInfo, "AIC: ", format(fit$AIC, digits=4, nsmall = numDigitsInfo, scientific = F,  big.mark   = ","), "", sep="")

  pbiInfo = cutStr2Show(pbiInfo,strCex = cexSub,isH = TRUE, maxChar = 5, partAvailable = 0.9)

  #axes labels
  labTimeShort = cutStr2Show(labTime, strCex = sizeLabel / 6, isH = TRUE, partAvailable = 0.8)
  labValueShort = cutStr2Show(labValue, strCex = sizeLabel / 6, isH = FALSE, partAvailable = 0.75)

  NpF = myInclude + myForecastLength

  par(mar = c(5+showInfo,6 + (1 - showScientificY) , 1, 2))

  #format  x_with_f
  numTicks = FindTicksNum1(NpF, max(freqs)) # find based on plot size
  numTicks = min(numTicks, NpF)

  fromDate = allTimes[fFromTo[1]]
  toDate = allTimes[fFromTo[2]]

  x_with_f_exist = as.POSIXlt(seq(from=fromDate, to = toDate, by = interval))
  iii = unique(round(seq(from = 1, to = length(x_with_f_exist), length.out = numTicks)))
  x_with_f = x_with_f_exist[iii]

  if(userFormatX == "auto")
    userFormatX = NULL;

  x_with_forcast_formatted = flexFormat(dates = x_with_f, orig_dates = parsed_dates, freq = max(freqs), myformat = userFormatX)

  #format
  f_full = as.POSIXlt(seq(from=tail(parsed_dates,1), to = (tail(parsed_dates,1)+interval*(forecastLength)), length.out = forecastLength+1))

  #historical data
  x1 = seq(0,length.out = length(prediction$x[inI]))
  y1 = as.numeric(prediction$x[inI])

  #forecast
  x2 = seq(length(prediction$x[inI]),length.out = length(prediction$mean))
  y2 = as.numeric(prediction$mean)

  #fitted data
  y3 = as.numeric(prediction$fitted[inI])

  # ggplot construction
  p1a <- ggplot(data = NULL,aes(x = x1, y = y1) )

  if(sum(!is.na(y1)) > 1)
    p1a<-p1a+geom_line(col = alpha(pointsCol, transparency), lwd = pointCex)
  else
    p1a<-p1a+geom_point(col = alpha(pointsCol, transparency), size = pointCex)

  if(showInPlotFitted)
  {
    if(sum(!is.na(y3))>1)
      p1a <- p1a + geom_line(inherit.aes = FALSE ,data = NULL, mapping = aes(x = x1, y = y3), col=alpha(fittedCol,transparency), lty = 2,  lwd = pointCex * 0.75)
    else
      p1a <- p1a + geom_point(inherit.aes = FALSE ,data = NULL, mapping = aes(x = x1, y = y3), col=alpha(fittedCol,transparency), size = pointCex)
  }

  if(length(y2)>1)
    p1a <- p1a + geom_line(inherit.aes = FALSE ,data = NULL, mapping = aes(x = x2, y = y2), col=alpha(forecastCol,transparency), lwd = pointCex)
  else
    p1a <- p1a + geom_point(inherit.aes = FALSE ,data = NULL, mapping = aes(x = x2, y = y2), col=alpha(forecastCol,transparency), size = pointCex)

  #conf intervals
  if(!is.null(lowerConfInterval))
  {
    lower2 = lower1 = as.numeric(prediction$lower[,1])
    upper2 = upper1 = as.numeric(prediction$upper[,1])
    id = x2
    cf_full = as.character(f_full)
    p1a <- p1a + geom_ribbon( inherit.aes = FALSE , mapping = aes(x = id, ymin = lower1 , ymax = upper1), fill = "blue4", alpha = 0.25)
  }

  if(upperConfInterval>0.01)
  {
    if(!is.null(lowerConfInterval))
    {
      lower2 = as.numeric(prediction$lower[,2])
      upper2 = as.numeric(prediction$upper[,2])
    }
    else
    {
      lower1 = lower2 = as.numeric(prediction$lower[,1])
      upper1 = upper2 = as.numeric(prediction$upper[,1])
    }

    id = x2
    names(lower2) = names(upper2) = names(lower1) = names(upper1)=  names(f_full) = id
    cf_full = as.character(f_full)
    p1a <- p1a + geom_ribbon( inherit.aes = FALSE , mapping = aes(x = id, ymin = lower2, ymax = upper2), fill = "gray50", alpha = 0.25)
  }

  #design
  p1a <- p1a + labs (title = pbiInfo, caption = NULL) + theme_bw()
  p1a <- p1a + xlab(labTimeShort) + ylab(labValueShort)
  p1a <- p1a + scale_x_continuous(breaks = seq(0,length(prediction$x[inI]) + length(prediction$mean)-1, length.out = numTicks), labels = x_with_forcast_formatted)
  p1a <- p1a +  theme(axis.text.x  = element_text(angle = getAngleXlabels1(x_with_forcast_formatted),
                                                  hjust=1, size = sizeTicks, colour = "gray60"),
                      axis.text.y  = element_text(vjust = 0.5, size = sizeTicks, colour = "gray60"),
                      plot.title  = element_text(hjust = 0.5, size = sizeWarn, colour = infoTextCol),
                      axis.title=element_text(size =  sizeLabel, colour = labelsTextCol),
                      axis.text=element_text(size =  sizeTicks,  colour = labelsTextCol),
                      panel.border = element_blank())

} else{ #empty plot

  #empty plot
  showWarnings = TRUE
  if(gooodpd)
    pbiWarning1  = cutStr2Show("Not enough data points", strCex = sizeWarn / 6, partAvailable = 0.85)
  else
  {
    pbiWarning1 = "Visual is "
    pbiWarning1 = cutStr2Show(pbiWarning1, strCex = sizeWarn / 6, partAvailable = 0.9)
    pbiWarning2 = "too small "
    pbiWarning2 = cutStr2Show(pbiWarning2, strCex = sizeWarn / 6, partAvailable = 0.9)
    pbiWarning1 <- paste(pbiWarning1, "
", pbiWarning2, sep="")
    sizeWarn = 7 #smaller
  }
  pbiWarning<-paste(pbiWarning, pbiWarning1 , sep="
")

}
#add warning as subtitle (or upper title since plotly has bug)
if(showWarnings && !is.null(pbiWarning))
{
  p1a = ggplot() + labs (title = pbiWarning, caption = NULL) + theme_bw() +
    theme(plot.title  = element_text(hjust = 0.5, size = sizeWarn),
          axis.title = element_text(size =  sizeLabel),
          axis.text = element_text(size =  sizeTicks),
          panel.border = element_blank())
}
ggp <- plotly_build(p1a)

if(!(showWarnings && !is.null(pbiWarning)))
{#design plotly

  if(myInclude > 0)
  {
    indHistData = 1
    indFitted = 0
    indForcData = 2
    indLow = 3
    indHigh = 4

    if(showInPlotFitted)
    {
      indFitted = 2
      indForcData = 3
      indLow = 4
      indHigh = 5
    }
  }
  else
  {
    indHistData = 0
    indFitted = 0
    indForcData = 2
    indLow = 3
    indHigh = 4

    if(showInPlotFitted)
    {
      indForcData = 1
      indLow = 2
      indHigh = 3
    }

  }

  if(indHistData)
    ggp$x$data[[indHistData]]$text = paste("Historical data:
", labTime, ": ", allTimes[fFromTo[1]:N], "
", labValue, ": ", round(y1,2) , sep ="" )

  if(indForcData)
    ggp$x$data[[indForcData]]$text = paste("Forecast data:
",labTime, ": ", allTimes[(N+1):fFromTo[2]], "
", labValue, ": ", round(y2,2) , sep ="" )

  if(indFitted)
    ggp$x$data[[indFitted]]$text = paste("Fitted data:
",labTime, ": ", allTimes[fFromTo[1]:N], "
", labValue, ": ", round(y3,2) , sep ="" )

  if(length(ggp$x$data)>=indLow && indLow)
  {
    iii =  as.character(ggp$x$data[[indLow]]$x)
    ddd = as.character(allTimes[(N + 1) : fFromTo[2]])
    names(ddd) = as.character(x2)
    ddd1 = ddd[iii]
    ggp$x$data[[indLow]]$text = paste("Conf. interval1:
", labTime, ": ", ddd1, "
 lower: ", lower1[iii],"
 upper: ", upper1[iii], sep ="" )
  }

  if(length(ggp$x$data)>=indHigh)
  {
    iii =  as.character(ggp$x$data[[indHigh]]$x)
    ddd = as.character(allTimes[(N+1):fFromTo[2]])
    names(ddd) = as.character(x2)
    ddd1 = ddd[iii]
    ggp$x$data[[indHigh]]$text = paste("Conf. interval2:
", labTime, ": ", ddd1, "
 lower: ", lower2[iii],"
 upper: ", upper2[iii], sep ="" )
  }

  ggp$x$layout$margin$l = ggp$x$layout$margin$l+10

  if(ggp$x$layout$xaxis$tickangle < -40)
    ggp$x$layout$margin$b = ggp$x$layout$margin$b+40

}

############# Create and save widget ###############

p <- ggp

disabledButtonsList <- list('toImage', 'sendDataToCloud', 'zoom2d', 'pan', 'pan2d', 'select2d', 'lasso2d', 'hoverClosestCartesian', 'hoverCompareCartesian')
p$x$config$modeBarButtonsToRemove = disabledButtonsList

p <- config(p, staticPlot = FALSE, editable = FALSE, sendData = FALSE, showLink = FALSE,
            displaylogo = FALSE,  collaborate = FALSE, cloud=FALSE, sizingPolicy = htmlwidgets::sizingPolicy(
              browser.padding = 0
            ))

internalSaveWidget(p, 'out.html')

if(keepOutData)
{
  padNA1 = rep(NA,length(x1))
  padNA2 = rep(NA,length(x2))
  if(!exists("lower1"))
    lower1 = lower2 = upper1 = upper2 = padNA2;

  lower1 = c(padNA1,lower1)
  lower2 = c(padNA1,lower2)
  upper1 = c(padNA1,upper1)
  upper2 = c(padNA1,upper2)

  exportDF = data.frame(Date = as.character(x_with_f_exist),Value = c(y1,y2),Fitted = c(y3,padNA2),
                        lower1 = lower1,
                        lower2 = lower2,
                        upper1 = upper1,
                        upper2 = upper2)

  colnames(exportDF)[c(1,2)] = c(labTime,labValue)

  KeepOutDataInHTML(df = exportDF, htmlFile = 'out.html', exportMethod = exportMethod, limitExportSize = limitExportSize)
}


library(stringr)
library(leaflet)
library(dplyr)

names(providers)[c(1:5)] #Shows first 5 in provider list

filter = str_detect(names(providers), "Esri") #Creates filter
names(providers)[filter] #Filters Esri maps

leaflet() %>%
  addProviderTiles("Esri")

#Enter longitude and latitude
long = -76.948270
lat = 38.983640
# Creat map
leaflet() %>%
  addProviderTiles("CartoDB") %>%
  addMarkers(lng = long, lat = lat, popup = 'SPP')

url = "https://assets.datacamp.com/production/repositories/1942/datasets/18a000cf70d2fe999c6a6f2b28a7dc9813730e74/ipeds.csv"
ipeds = read.csv(url)
ipeds %>% head(3)

map = leaflet() %>%
addProviderTiles("CartoDB") %>%
addCircleMarkers(data=ipeds,
                   radius = 2, color = "red", popup=~name)
map

map2 <- map %>%
  clearMarkers() %>%
  clearBounds()
map2 %>%
  addCircleMarkers(data = ipeds, radius = 2,
                   popup = ~paste0(name, "
","
", sector_label))

# Make a color palette called pal for the values of `sector_label` using `colorFactor()`
# Colors should be: "red", "blue", and "#9b4a11" for "Public", "Private", and "For-Profit" colleges, respectively
pal <- colorFactor(palette = c("red", "blue", "#9b4a11"),
                   levels = c("Public", "Private", "For-Profit"))

# Add circle markers that color colleges using pal() and the values of sector_label
map2 <-
    map %>%
        addCircleMarkers(data = ipeds, radius = 2,
                         color = ~pal(sector_label),
                         label = ~paste0(name, " (", sector_label, ")"))%>%
    addLegend(pal = pal,
              values = c("Public", "Private", "For-Profit"))

# Print map2
map2

library(leaflet.extras)
library(htmltools)

# Create data frame called public with only public colleges
public <- ipeds %>% filter(sector_label == "Public")
profit <- ipeds %>%filter(sector_label == "For-Profit")
private <- ipeds %>% filter(sector_label == "Private")

m4 <- leaflet() %>%

#Adding three sep maps part 1
        addTiles(group = "OSM") %>%
        addProviderTiles("CartoDB", group = "Carto") %>%
        addProviderTiles("Esri", group = "Esri")

m4  = m4 %>% addCircleMarkers(data = public, radius = 2, label = ~htmlEscape(name),
                         color = ~pal(sector_label), group = "Public") %>% #Public

        addCircleMarkers(data = private, radius = 2, label = ~htmlEscape(name),
                           color = ~pal(sector_label), group = "Private")  %>% #Private

        addCircleMarkers(data = profit, radius = 2, label = ~htmlEscape(name),
                         color = ~pal(sector_label), group = "For-Profit") #For profit

m4 = m4 %>% addLayersControl(baseGroups = c("OSM", "Carto", "Esri"),
                         overlayGroups = c("Public", "Private", "For-Profit")) %>%
        setView(lat = 39.8282, lng = -98.5795, zoom = 4)
m4

# Make each sector of colleges searchable
m4_search <- m4  %>%
        addSearchFeatures(
            targetGroups = c("Public", "Private", "For-Profit"),
            # Set the search zoom level to 18
            options = searchFeaturesOptions(zoom = 18))

# Try searching the map for a college
m4_search

ipeds %>%
    leaflet() %>%
        addTiles() %>%
        # Sanitize any html in our labels
        addCircleMarkers(radius = 2, label = ~htmlEscape(name),
                         # Color code colleges by sector using the `pal` color palette
                         color = ~pal(sector_label),
                         # Cluster all colleges using `clusterOptions`
                         clusterOptions = markerClusterOptions())

suppressMessages(library(ggmap))
library(maps)
library(mapproj)

#THIS WILL NOT WORK UNLESS YOU INPUT AN API KEY!!!!!
api_key = 'YOURAPIKEY'
register_google(api_key)

#Coordinates
spp = c(long = -76.948270, lat = 38.983640)
# Get map
map = get_map(spp, zoom = 15, scale = 1)
# Plot map
ggmap(map)

dfworldmap = map_data("world")
dfworldmap %>%  head(2)

dfworldmap %>% filter(region=='Indonesia') %>% head(2)

us = map_data("state")
us %>% head(3)

data("USArrests")
arrest = USArrests %>% #create new df
  add_rownames("region") %>% # add a new var region
  #format data to work
  mutate(region=tolower(region)) #make it all lowercase

head(arrest) #check that we have our new var!

g = ggplot()
g = g + geom_map(data=us, map=us,
                    aes(x=long, y=lat, map_id=region),
                    fill="#ffffff", color="#ffffff", size=0.15)
g = g + geom_map(data=arrest, map=us,
                    aes(fill=Murder, map_id=region),
                    color="#ffffff", size=0.15)
g

library(lubridate) # date operations
library(gridExtra)

head(mtcars, 5)

ggplot(mtcars, aes(x = mpg, y = wt)) +
geom_point()

ggplot(mtcars, aes(x = mpg, y = wt)) +
geom_point()+
ggtitle('Look mom I can scatter plot')+ theme(plot.title = element_text(hjust = 0.5)) #title

ggplot(mtcars, aes(x = mpg, y = wt)) +
geom_point(alpha=.5, color='red')

url = 'https://raw.githubusercontent.com/corybaird/PLCY_610_public/master/Reference_materials/Tutorials_R_Stata_Python/R/W3_ggplot/global_covid.csv'
df = read.csv(url)
head(df,3)

ggplot(df%>%filter(confirm>10000), aes(x=name, y=confirm)) +
geom_bar(stat="identity", width=.5, fill='red',color='blue')+
theme(axis.text.x = element_text(angle=65, vjust=0.6))

ggplot(df%>%arrange(desc(confirm))%>%filter(confirm>10000), aes(x=reorder(name, confirm), y=confirm)) +
geom_bar(stat="identity", fill='blue')+
theme(axis.text.x = element_text(angle=65, vjust=0.6))

url = 'https://raw.githubusercontent.com/corybaird/PLCY_610_public/master/Reference_materials/Tutorials_R_Stata_Python/R/W3_ggplot/Covid_TS_global.csv'
df = read.csv(url)
df$date = as.Date(df$date)
head(df, 2)

japan = df %>% filter(country=='Japan')
head(japan,2)

japan %>%
ggplot(aes(x=date, y=confirmed)) + geom_line(alpha=0.5)

df %>% filter(country=='Italy'| country=="US") %>%
ggplot(aes(x=date, y=confirmed)) + geom_line(aes(color=country))+
theme(axis.title.x=element_blank())

plot1 = df %>% filter(confirmed>1000)  %>%  filter(country=='Italy'| country=="US") %>%
ggplot(aes(x=date, y=confirmed)) + geom_line(aes(color=country))+
theme(axis.title.x=element_blank())+
xlab('') + ylab('Count') + labs(title='Current Confirmed Cases') + theme(axis.text.x=element_text(angle=45, hjust=1))

plot2 = df %>% filter(deaths>100) %>%filter(country=='Italy'| country=="US") %>%
ggplot(aes(x=date, y=deaths)) + geom_line(aes(color=country))+
theme(axis.title.x=element_blank())+
xlab('') + ylab('Count') + labs(title='Current Deaths') + theme(axis.text.x=element_text(angle=45, hjust=1))

grid.arrange(plot1, plot2, ncol=2)


LC_Pull_Out_Data_Every_10M30M1H2H3H <- function(Input_FileName) {

# R Functions to process dataset from Load Cell Array
# It pulls data based on time intervals
#
# Author : Kuo-Hsine Chang, Ph.D. Dept. of Plant Agricuture, University of Guelph
# Contact: changks.github.io
# Version: 04162018

  # load library
    library(zoo)
    library(data.table)

  # read the csv file
    dt = fread(Input_FileName, header = T, sep = ',');

  # timestamp should be POSIXct
    dt[, Time := as.POSIXct(Time)];

  # filter for entries every 10 mins
   dt_10m <- subset(dt, format(Time,'%M') %in% c('00','10','20','30','40','50'))

  # filter for entries every 30 mins
   dt_30m <- subset(dt, format(Time,'%M') %in% c('00','30'))

  # filter for entries where the time is half past -- every 1 hour
    dt_1h <- dt[format(Time, "%M") == 30];

  # filter for entries where the time is half past -- every 2 hour
    dt_2h <- subset(dt_1h, strftime(Time, "%H", tz="Canada/Eastern") %in% c('01','03','05','07','09','11','13','15','17','19','21','23'));

  # filter for entries where the time is half past -- every 3 hour
    dt_3h <- subset(dt_1h, strftime(Time, "%H", tz="Canada/Eastern") %in% c('01','04','07','10','13','16','19','22'));

  # export to a csv file
    write.table(dt_10m, paste0(tools::file_path_sans_ext(Input_FileName),"_10M.csv"), row.names=FALSE, col.names=TRUE, sep=",")
    write.table(dt_30m, paste0(tools::file_path_sans_ext(Input_FileName),"_30M.csv"), row.names=FALSE, col.names=TRUE, sep=",")
    write.table(dt_1h, paste0(tools::file_path_sans_ext(Input_FileName),"_1H.csv"), row.names=FALSE, col.names=TRUE, sep=",")
    write.table(dt_2h, paste0(tools::file_path_sans_ext(Input_FileName),"_2H.csv"), row.names=FALSE, col.names=TRUE, sep=",")
    write.table(dt_3h, paste0(tools::file_path_sans_ext(Input_FileName),"_3H.csv"), row.names=FALSE, col.names=TRUE, sep=",")

}


library(compiler)

source("/share/apps/gapit/20180818/emma.txt")
source("/share/apps/gapit/20180818/gapit_functions.txt")

# phenotype data, missing data -> NaN or NA
pheno.file <- "mdp_traits.txt"

# genotype data in HapMap format
geno.file <- "mdp_genotype_test.hmp.txt"

# covariate data, STRUCTURE or PCA or none

# structure file, disable = ""
structure.Q.file <- ""

# number of PCs, disable = 0
my.PCA.total <- 10

# DO NOT EDIT

my.Y <- read.table(pheno.file, header=TRUE)
my.G <- read.table(geno.file, header=FALSE)

my.CV <- NULL
if (structure.Q.file != "")
    my.CV <- read.table(structure.Q.file, header=TRUE)

GAPIT(Y=my.Y, G=my.G, CV=my.CV, model="MLM", PCA.total=my.PCA.total)


pdf_file<-"pdf/maps_europe_choropleth_countries_2x2.pdf"
cairo_pdf(bg="grey98", pdf_file,width=13,height=11)

par(omi=c(0.5,0,0.5,0),mai=c(0,0,0,0))
par(mfcol=c(2,2),family="Lato Light")
library(maptools)
library(RColorBrewer)
library(sp)
library(rgdal)
library(gdata)

# Import data, prepare and create graphic

myplotFile<-"scripts/inc_plot_maps_europe_choropleth_countries.r"

mySelection<-"v84"
myClasses<-c(0,1.5,2,2.5,3)
myClass_des<-c("0 to 1.5","1.5 to 2","2 to 2.5","2.5 to 3")
myColourPalette<-brewer.pal(4,"Reds")
source(myplotFile)
mtext("V84: QA1",at=-1300000,adj=0,line=-3)
mtext("LIFE SATISFACTION",at=-1300000,adj=0,line=-4.5)

mySelection<-"v85"
myClasses<-c(0,1.5,2,2.5,3)
myClass_des<-c("0 to 1.5","1.5 to 2","2 to 2.5","2.5 to 3")
myColourPalette<-brewer.pal(4,"Greens")
source(myplotFile)
mtext("V85: QA2 SITUATION:",at=-1300000,adj=0,line=-3)
mtext("AREA YOU LIVE IN",at=-1300000,adj=0,line=-4.5)

mySelection<-"v100"
myClasses<-c(-0.1,0,0.1,0.2,0.3)
myClass_des<-c("-0.1 to 0","0 to 0.1","0.1 to 0.2","0.2 to 0.3")
myColourPalette<-brewer.pal(4,"Blues")
source(myplotFile)
mtext("V100: QA3 EXPECTATIONS:",at=-1300000,adj=0,line=-3)
mtext("AREA YOU LIVE IN",at=-1300000,adj=0,line=-4.5)

mySelection<-"v114"
myClasses<-c(-0.6,-0.4,0,0.2,0.4)
myClass_des<-c("-0.6 to -0.4","-0.4 to 0","0 to 0.2","0.2 to 0.4")
myColourPalette<-brewer.pal(4,"Purples")
source(myplotFile)
mtext("V114: QA4 CHANGE 5 YRS:",at=-1300000,adj=0,line=-3)
mtext("LIFE IN GENERAL",at=-1300000,adj=0,line=-4.5)

# Titling

mtext(side=3,"Life Satisfaction in Europe",adj=0.05,outer=T,line=0.5,cex=2.25,family="Lato Black")
mtext(side=1,"Mean values. V84, V85: Low values are better.V100, V114: High values are better. Source: Eurobarometer 71.2, doi:10.4232/1.10990",adj=0.95,outer=T,line=1,font=3)
dev.off()


plot(rnorm(100), rnorm(100))
clip(-1, 1, -1, 1)
points(rnorm(100), rnorm(100), col = 'red')


suppressPackageStartupMessages(library(ggplot2))
for (j in 1:2) {
  # ggplot2 has been loaded previously
  print(qplot(rnorm(30), runif(30)))
}


#' F2C
#'
#' Converts temperature from Fahrenheit degree (degF)  to Celsius degree (degC).
#'
#' @param F numeric Temperature in Fahrenheit degrees (degF)
#' @return Celsius degrees
#'
#' @author    Istituto per la Bioeconomia CNR Firenze Italy  Alfonso Crisci \email{alfonso.crisci@@ibe.cnr.it}
#' @keywords  F2C
#'
#' @export
#'
#'
#'
#'

F2C=function(F) {
                         ct$assign("F", as.array(F))
                         ct$eval("var res=[]; for(var i=0, len=F.length; i < len; i++){ res[i]=F2C(F[i])};")
                          res=ct$get("res")
                         return(ifelse(res==9999,NA,res))
}