# Makes histograms: region sizes, distance to gene_start, dREG scores
library(ggplot2)
library(grid)
library(scales)
source('vis_fns.r')

args<-commandArgs(TRUE)
#datapath<-args[1]
#datapath<-'/Users/stephanie/ll/results/40m_SVM/dREG_regions_confident_0.8.bed.gz'
datapath<-'/Users/stephanie/ll/data/creyghton/mine_in_creyghton.bed'
#datapath<-'/Users/stephanie/ll/results/40m_SVM/dREG_regions_preQC_0.8.bed.gz'
#datapath<-'/Users/stephanie/ll/results/40m_SVM/dREG_regions_maybe_0.5.bed.gz'
#datapath<-'/Users/stephanie/ll/data/known_enhancers/dREG_known.bed.gz'
#datapath<-'/Users/stephanie/ll/data/known_enhancers/dREG_known_active.bed.gz'
fakedatapath<-'/Users/stephanie/ll/results/fake/fake_marked.bed.gz'
#fakedatapath<-'/Users/stephanie/ll/results/40m_SVM/dREG_regions_confident_0.8.bed.gz'
data<-read.table(datapath,header=T,na.strings="NAN",as.is=TRUE)
fakedata<-read.table(fakedatapath,header=T,na.strings="NAN",as.is=TRUE)
n<-nrow(data)

# Timepoints (optionally from argument)
time_points<-c("X0","X2","X5","X12.5","X25","X50")
time_readable<-c("WT","2min","5min","12.5min","25min","50min")
time_thresh<-list("X0"=0,"X2"=0,"X5"=0,"X12.5"=7000,"X25"=30000,"X50"=100000)

# ChIP-seq mods (eg on histones, but could be TFs)
mods<-c("H3K4me1","H3K4me3","H3K27ac")
norms<-list("H3K4me1"=4935147/1e06,"H3K4me3"=8046120/1e06,"H3K27ac"=21839696/1e06)

# General style thing
mytheme<-theme(plot.margin=unit(c(2,2,2,2),"cm"),axis.title.x=element_text(vjust=-0.2),axis.title.y=element_text(angle=90,vjust=0.2),plot.title=element_text(size=15,vjust=1.4))+theme_bw()

#Quick check: how many multiply-assigned regions do we have?
double_regions<-sum((data$gene_start+1*(data$gene_body!=0)+data$non_gene)==2)
triple_regions<-sum((data$gene_start+1*(data$gene_body!=0)+data$non_gene)==3)
cat("visualisation.r: There are",double_regions,"doubly-assigned and",triple_regions,"triply-assigned elements.\n")

# Condense regions
regions<-ifelse(data$gene_start==1,"gene_start",ifelse(data$gene_body!=0,"gene_body","non_gene"))
regions<-factor(regions,c("gene_start","gene_body","non_gene"))
data<-cbind(data,regions)
region_cols<-c("firebrick1","orange1","turquoise3","gray")
#region_cols<-c("orange1","turquoise3","gray")

# --- distribution of hits etc. ---
gs<-sum(regions=="gene_start")
gb<-sum(regions=="gene_body")
ng<-sum(regions=="non_gene")
cc<-c(gs,gb,ng)
ggplot(data,aes(x=regions,fill=regions))+geom_histogram()+mytheme+scale_fill_manual(values=region_cols)+stat_bin(aes(label=..count..,y=..count..-400),geom="text")+xlab("Genomic region")

# First appearances
first_appearance<-time_points[apply(data[,time_points],1,function(x) which(x==1)[1])]
first_appearance<-factor(first_appearance,time_points)
data<-cbind(data,first_appearance)

# How often are the regions seen? (aross timepoints)
cat("visualisation.r: How often is each element seen?\n")
howmany_prefac<-rowSums(data[,time_points])
howmany<-factor(howmany_prefac,c(1,2,3,4,5,6))
data_howfreq<-data.frame(regions,howmany,first_appearance)
ggplot(data_howfreq,aes(x=howmany,fill=regions))+geom_histogram(position="dodge")+scale_fill_manual(values=region_cols)+mytheme+ggtitle("How many timepoints do hits occur in?")+xlab("Number of timepoints")+facet_grid(~regions,margins=FALSE)
ggsave("../pdfs/repetition_regions.pdf",width=10)

#How consistent are they?
cat("visualisation.r: When do consistent elements appear?\n")
viol_prefac<-get_violations(data[,time_points])
consistent<-viol_prefac==0
consistent<-factor(consistent,c(TRUE,FALSE))
data_consistent<-data.frame(regions,consistent,first_appearance)
ggplot(data_consistent,aes(x=first_appearance,fill=consistent))+facet_grid(consistent~regions)+geom_histogram(position="dodge")+mytheme+scale_fill_manual(values=c("darkorchid1","grey60"))+ggtitle("When do consistent elements appear? (consistent meaning that once they appear, they do not disappear)")
ggsave("../pdfs/consistent_elements.pdf",width=10)

# How many violations? (e.g. disappearance after appearance)
cat("visualisation.r: violations\n")
violations<-factor(viol_prefac,c(0,1,2,3,4,5))
data_viol<-data.frame(regions,violations)
ggplot(data_viol,aes(x=violations,fill=regions))+geom_histogram(position="dodge")+scale_fill_manual(values=region_cols)+mytheme+facet_grid(~regions,margins=TRUE)
ggsave("../pdfs/violations_regions.pdf",width=10)

# Now, are they earlier (<12.5) or later(>12.5)? (do this better!) (STRICTLY early v. STRICTLY late...)
cat("visualisation.r: elements only appearing in early/late timepoints?\n")
early<-rowMeans(data[,c("X12.5","X25","X50")])==0
late<-rowMeans(data[,c("X0","X2","X5")])==0
all<-rowMeans(data[,time_points])==1
when_restricted<-ifelse(all,"all",ifelse(early,"early only",ifelse(late,"late only","mixed")))
when_restricted<-factor(when_restricted,c("all","early only","late only","mixed"))
data_whenrestricted<-data.frame(regions,when_restricted)
ggplot(data_whenrestricted,aes(x=when_restricted,fill=regions))+geom_histogram(position="dodge")+mytheme+scale_fill_manual(values=c(region_cols))+xlab("Only appears when...")+ggtitle("Many elements are only seen at early timepoints (WT,2min,5min)")
ggsave("../pdfs/earlylate_elements.pdf",width=10)

# Expand elements - this is a giant dataframe with duplicated entries whenever elements appear in multiple timepoints - the purpose is to be able to simultaneously plot not just new points but all points at a time, acces times via 'when'
data_exp<-data.frame()
for (time in time_points){
    #time_data<-data[data[,time]==1,-which(names(data)%in%time_points)]
    time_data<-data[data[,time]==1,]
    en<-nrow(time_data)
    when<-rep(time,en)
    t_d<-data.frame(time_data,when)
    data_exp<-rbind(data_exp,t_d)
}

# For elements that are only seen once... when are they seen?
#cat("visualisation.r: Loner elements\n")
#data_loners<-data_howfreq[howmany_prefac==1,]
#ggplot(data_loners,aes(x=first_appearance,fill=regions))+geom_histogram(position="dodge")+scale_fill_manual(values=region_cols)+mytheme+xlab("Timepoint")+ggtitle("For elements appearing only once, when was it?")+facet_grid(~regions)
#ggsave("../pdfs/loner_regions.pdf",width=10)

# When do the regions first appear? (note, they may disappear and reappear - this takes very first appearance)
cat("visualisation.r: First appearance of elements!\n")
ggplot(data,aes(x=first_appearance,fill=regions))+geom_bar(position="dodge")+scale_fill_manual(values=region_cols)+mytheme+facet_grid(~regions)
ggsave("../pdfs/first_appearance.pdf",width=10)

# What fraction of the elements appear for the first time at this timepoint?
new_bool<-data_exp$when==data_exp$first_appearance
new<-ifelse(new_bool,ifelse(data_exp$regions=="gene_start", "new (gene_start)", ifelse(data_exp$regions=="gene_body", "new (gene body)", "new (non gene)")),"old")
new<-factor(new,c("new (gene_start)","new (gene body)","new (non gene)","old"))
new_cols<-c(region_cols[1:3],"grey90")
data_new<-cbind(data_exp,new)
ggplot(data_new,aes(x=when,fill=new))+geom_bar(position="fill")+scale_fill_manual(values=new_cols)+mytheme+facet_grid(~regions)+ylab("Fraction of elements which are new at this timepoint")+xlab("Timepoint")+ggtitle("Does time after flavopiridol treatment aid discovery of intragenic elements?")
ggsave("../pdfs/fraction_new.pdf",width=10)

new<-ifelse(new_bool,ifelse(data_exp$regions=="gene_start", "new (gene_start)", ifelse(data_exp$regions=="gene_body", "new (gene body)", "new (non gene)")),ifelse(data_exp$regions=="gene_start", "old (gene_start)", ifelse(data_exp$regions=="gene_body", "old (gene body)","old (non gene)")))
new<-factor(new,c("new (gene_start)","old (gene_start)","new (gene body)","old (gene body)", "new (non gene)", "old (non gene)"))
data_new<-cbind(data_exp,new)
new_cols<-c(region_cols[1],"firebrick4",region_cols[2],"orange3",region_cols[3],"turquoise4")
#new_cols<-c(region_cols[1],"orange3",region_cols[2],"turquoise4")
ggplot(data_new,aes(x=when,fill=new))+geom_bar(position="stack")+scale_fill_manual(values=new_cols)+mytheme+facet_grid(~regions)+ylab("Number of elements  at this timepoint")+xlab("Timepoint")
ggsave("../pdfs/total_regions.pdf",width=10)

new_gb<-subset(data_new,new=="new (gene body)")
old_gb<-subset(data_new,new=="old (gene body)")
old_gs<-subset(data_new,new=="old (gene_start)")
new_gs<-subset(data_new,new=="new (gene_start)")
old_ng<-subset(data_new,new=="old (non gene)")
new_ng<-subset(data_new,new=="new (non gene)")

# Element sizes
cat("visualisation.r: Element sizes!\n")
sizes<-data$end-data$start
size_dat<-data.frame(sizes,regions)
ggplot(size_dat,aes(x=sizes,fill=regions))+geom_histogram(binwidth=50)+mytheme+xlim(0,2000)+scale_fill_manual(values=region_cols)+ggtitle("dREG Element sizes")+xlab("Size of dREG element (bp)")+ylab("Counts")+facet_grid(~regions,margins=FALSE,scales="free")
ggsave("../pdfs/region_sizes.pdf",width=10)
ggplot(size_dat,aes(x=sizes))+geom_histogram(binwidth=50,fill="gray")+mytheme+xlim(0,2000)+ggtitle("dREG Element sizes (all)")+xlab("Size of dREG element (bp)")+ylab("Counts")
ggsave("../pdfs/all_sizes.pdf")

# Inflation factor
cat("visualisation.r: Inflation!\n")
inflation<-data$inflation
inf_dat<-data.frame(inflation,regions,first_appearance)
ggplot(inf_dat,aes(x=inflation,fill=regions))+geom_histogram(binwidth=0.5)+mytheme+scale_fill_manual(values=region_cols)+ggtitle("Ratio by which smallest contributing element was embiggened")+xlab("Inflation factor")+ylab("Counts")+facet_grid(~regions)+xlim(1,20)
#+facet_grid(first_appearance~regions,margins=FALSE,scales="free")+xlim(0,7.5)
ggsave("../pdfs/region_inflation.pdf",width=10)
ggplot(inf_dat,aes(x=inflation))+geom_histogram(binwidth=0.5,fill="gray")+mytheme+ggtitle("Ratio by which smallest contributing element was embiggened (all)")+xlab("Inflation factor")+ylab("Counts")+xlim(0,20)
ggsave("../pdfs/all_inflation.pdf")

# Distance to closest gene_start
cat("visualisation.r: Distance to closest gene_start!\n")
distance<-data_exp$distance
regions_exp<-data_exp$regions
when<-data_exp$when
dist_dat<-data.frame(distance,regions_exp,when,new_bool)
affected<-dist_dat$distance<time_thresh[dist_dat$when]
thresh<-ifelse(affected,ifelse(dist_dat$regions_exp=="gene_body", "area cleared by FP treatment", "unaffected (non gene)"), ifelse(dist_dat$regions_exp=="gene_body","unaffected (gene body)","unaffected (non gene)"))
thresh_cols<-c("darkorchid1",region_cols[2],region_cols[3])
dist_dat<-cbind(dist_dat,thresh)
names(dist_dat)<-c("distance","regions","when","new","thresh")
dist_dat<-subset(dist_dat,regions!="gene_start")
dist_dat<-subset(dist_dat,distance>0)
#cat("Specifying dist_dat to only new hits...\n")
#dist_dat<-subset(dist_dat,new_bool)

ggplot(dist_dat,aes(x=distance,fill=thresh))+geom_histogram(binwidth=250)+mytheme+scale_fill_manual(values=thresh_cols)+ggtitle("Distance to closest gene_start (either direction)")+xlab("Distance (bp)")+ylab("Counts")+facet_grid(when~regions,margins=FALSE,scale="free")+xlim(0,25000)
ggsave("../pdfs/region_distance.pdf",width=10)
ggplot(dist_dat,aes(x=distance,fill=thresh))+geom_histogram(binwidth=250)+mytheme+scale_fill_manual(values=thresh_cols)+ggtitle("Distance to closest gene_start (either direction)")+xlab("Distance (bp)")+ylab("Counts")+facet_grid(when~regions,margins=FALSE,scale="free")+xlim(5000,100000)
ggsave("../pdfs/region_distance_5kon.pdf",width=10)
ggplot(subset(dist_dat,regions_exp=="gene_body"),aes(x=distance))+geom_histogram(fill="gray",binwidth=500)+mytheme+ggtitle("Distance from gene start to gene-body (possible) enhancer (mESC)")+xlab("Distance")+ylab("Counts")+xlim(0,25000)
#ggplot(subset(dist_dat,regions_exp=="gene_body"),aes(x=distance))+geom_histogram(fill="gray",binwidth=500)+mytheme+ggtitle("Distance to closest gene_start (either direction) (gene body and non-gene)")+xlab("Distance")+ylab("Counts")+xlim(0,25000)
ggsave("../pdfs/all_distance.pdf",width=10)

# Gene-focused analysis
#gene_only_hits<-read.table('/Users/stephanie/ll/data/genes/lists/dREG_IDs_onlybody.txt')
#data_geneonly<-data.frame(regions,howmany,first_appearance)
#data_geneonly<-data_geneonly[data$"dREG_id"%in%gene_only_hits[,1],]
#ggplot(data_geneonly,aes(x=first_appearance,fill=regions))+geom_histogram(position="dodge")+scale_fill_manual(values=region_cols)+mytheme+ggtitle("When do the hits inside gene bodies (only) occur?")+xlab("Timepoint")+facet_grid(~regions,margins=TRUE)
#ggsave("../pdfs/gene_only_when.pdf",width=10)

#  Histone modifications! (have to make long form)
counts_per_region<-function(start,stop,counts,norm){
    size<-stop-start
    norm_counts<-counts/(size*norm)
    return(norm_counts)
}
#  Question: how to normalise?!
cat("visualisation.r: Histone modifications!\n")
long_counts<-vector()
for (mod in mods){
    mod_norm<-as.numeric(norms[mod])
    long_counts<-c(long_counts,counts_per_region(data$start,data$end,as.numeric(data[,mod]),mod_norm))
}
n_mods<-length(mods)
mod_names<-rep(mods,each=n)
long_regions<-rep(regions,n_mods)
long_first_appearance<-rep(first_appearance,n_mods)
long_IDs<-rep(data$dREG_id,n_mods)
mod_dat<-data.frame(long_IDs,mod_names,long_counts,long_regions,long_first_appearance)
# Remove NaNs (no mapped regions)
mod_dat<-mod_dat[is.finite(mod_dat$long_counts),]
# Remove that one crazy high point in the H3K4me1 data
mod_dat<-mod_dat[mod_dat$long_counts<7,]
# set up the names etc.
names(mod_dat)<-c("dREG_id","mods","counts","regions","first_appearance")
ggplot(mod_dat,aes(x=regions,y=counts,fill=regions))+geom_boxplot(position="dodge",notch=FALSE)+facet_wrap(~mods,scales="free_y")+mytheme+ylab("Histone marks per base (per million read) : log2")+xlab("Marks and genomic regions")+scale_fill_manual(values=c(region_cols,region_cols[4],region_cols[4]))+scale_y_continuous(trans=log2_trans(),labels=trans_format("log2",math_format(2^.x)),breaks=2**seq(-10,1))
ggsave("../pdfs/histone_regions.pdf",width=10)

# now do it all again for the fake data
fake_long_counts<-vector()
for (mod in mods){
    mod_norm<-as.numeric(norms[mod])
    fake_long_counts<-c(fake_long_counts,counts_per_region(fakedata$start,fakedata$end,as.numeric(fakedata[,mod]),mod_norm))
}
fake_n_mods<-length(mods)
fake_mod_names<-rep(mods,each=nrow(fakedata))
fake_regions<-ifelse(fakedata$gene_start==1,"gene_start",ifelse(fakedata$gene_body!=0,"gene_body","non_gene"))
fake_regions<-factor(fake_regions,c("gene_start","gene_body","non_gene"))
fake_long_regions<-rep(fake_regions,fake_n_mods)
fake_first_appearance<-time_points[apply(fakedata[,time_points],1,function(x) which(x==1)[1])]
fake_first_appearance<-factor(fake_first_appearance,time_points)
fake_long_first_appearance<-rep(fake_first_appearance,fake_n_mods)
fake_long_IDs<-rep(fakedata$dREG_id,fake_n_mods)
fake_mod_dat<-data.frame(fake_long_IDs,fake_mod_names,fake_long_counts,fake_long_regions,fake_long_first_appearance)
# Remove NaNs (no mapped regions)
fake_mod_dat<-fake_mod_dat[is.finite(fake_mod_dat$fake_long_counts),]
names(fake_mod_dat)<-c("dREG_id","mods","counts","regions","first_appearance")

# Combinate both of these
regions_both<-c(as.character(mod_dat$regions),paste(as.character(fake_mod_dat$regions),"(bg)"))
regions_both<-factor(regions_both,c("gene_start","gene_body","non_gene","gene_start (bg)","gene_body (bg)","non_gene (bg)"))
mod_both<-rbind(mod_dat,fake_mod_dat)
mod_both<-cbind(mod_both,regions_both)
ggplot(mod_both,aes(x=regions,y=counts,fill=regions_both))+geom_boxplot(position="dodge",notch=FALSE)+facet_wrap(~mods,scales="free_y")+mytheme+ylab("Histone marks per base (per million read) : log2")+xlab("Marks and genomic regions")+scale_fill_manual(values=c(region_cols,region_cols[4],region_cols[4]))+scale_y_continuous(trans=log2_trans(),labels=trans_format("log2",math_format(2^.x)),breaks=2**seq(-10,1))
ggsave("../pdfs/histone_regions_withbg.pdf",width=13)


dyn.load('/Library/Java/JavaVirtualMachines/jdk1.8.0_131.jdk/Contents/Home/jre/lib/server/libjvm.dylib')

setwd("/Users/mengmengjiang/all datas/conductivity")
library(xlsx)

# liquid-1
fpm1_18<-c(3,3.5,3)
fvc1_18<-c(0.5,0.5,0.7)
fpm1_180<-c(0.1,2,4)
fvc1_180<-c(0.3,0.5,0.7)

# voltage: 1.8kv,1.9kv,2kv

v<-c(1.8,1.9,2)

# liquid-2
fpm2_18<-c(3,1.7,2)
fvc2_18<-c(1,1,1)
fpm2_180<-c(3,1.5,1.5)
fvc2_180<-c(1,0.7,0.7)

yan<-c("red","blue","black","green3")
pcc<-c(0,1,2,5)

par(mfrow = c(2,2), mar = c(2,2.4,0.8,1), oma = c(1,1,1,1))
layout(matrix(c(1,2),2,1,byrow=TRUE))

plot(v,fvc1_18, col=0,xlab = expression(italic(V) (Kv)),
          ylab = expression(italic(f["vc"])(KHz)), mgp=c(1.1, 0, 0),tck=0.02,
               main = "", xlim = c(1.8,2),ylim=c(0,2))

               mtext("fvc",3,line=-1.2,font=2,cex=1)

 #axis(side=1,at=1:3,tck=-0.2,labels=c("1.8kv","1.9kv","2kv"))

 lines(v,fvc1_18,col=yan[1],pch=pcc[1],lwd=1.5,type="b",lty=2)
 lines(v,fvc1_180,col=yan[2],pch=pcc[2],lwd=1.5,type="b",lty=2)
  lines(v,fvc2_18,col=yan[3],pch=pcc[3],lwd=1.5,type="b",lty=2)
  lines(v,fvc2_180,col=yan[4],pch=pcc[4],lwd=1.5,type="b",lty=2)

   leg<-c("Gly1-18nl/min","Gly1-180nl/min","Gly2-18ml/min","Gly2-180nl/min")
   legend("topright",legend=leg,col=yan,pch=pcc,lwd=1.5,lty=2,inset = .01,bty
          = "n",cex=0.8)

plot(v,fpm1_18, col=0,xlab = expression(italic(V) (Kv)),
          ylab = expression(italic(f["pmax"])(KHz)), mgp=c(1.1, 0, 0),tck=0.02,
               main = "", xlim = c(1.8,2),ylim=c(0,4))

               mtext("fpmax",3,line=-1.2,font=2,cex=1)

 #axis(side=1,at=1:3,tck=-0.2,labels=c("1.8kv","1.9kv","2kv"))

 lines(v,fpm1_18,col=yan[1],pch=pcc[1],lwd=1.5,type="b",lty=2)
 lines(v,fpm1_180,col=yan[2],pch=pcc[2],lwd=1.5,type="b",lty=2)
  lines(v,fpm2_18,col=yan[3],pch=pcc[3],lwd=1.5,type="b",lty=2)
  lines(v,fpm2_180,col=yan[4],pch=pcc[4],lwd=1.5,type="b",lty=2)

   leg<-c("Gly1-18nl/min","Gly1-180nl/min","Gly2-18ml/min","Gly2-180nl/min")
   legend("bottomright",legend=leg,col=yan,pch=pcc,lwd=1.5,lty=2,inset = .01,bty
          = "n",cex=0.8)


#' Save EWAS effect estimates to bedgraph file
#'
#' Saves EWAS effect estimates  to a bedgraph file
#' for viewing on a genome browser.
#' More file format details can be found here:
#' https://genome.ucsc.edu/goldenPath/help/bedgraph.html
#'
#' @param ewas.object Object returned by \code{\link{meffil.ewas()}}.
#' @param filename Filename for output, typically with a 'bed' extension.
#' @param analysis The particular EWAS analysis from which to obtain summary statistics.
#' This should be one of \code{names(ewas.object$analyses)}.
#' @param name Text name to be included in the bedgraph header.
#' @param description Text description to be included in the bedgraph header.
#' @param header Bedgraph header. The default header uses the name and description provided.
#' @export
meffil.ewas.bedgraph <- function(ewas.object,
                                 filename,
                                 analysis,
                                 name,
                                 description,
                                 header) {
    stopifnot(is.ewas.object(ewas.object))
    if (!analysis %in% names(ewas.object$analyses))
        stop("'analysis' should be one of: ", paste(names(ewas.object$analyses), collapse=", "))

    x <- ewas.object$analyses[[analysis]]$table
    x$start <- x$end <- x$position
    x$chr <- as.character(x$chr)
    x <- x[which(!is.na(x$chr) & nchar(x$chr) > 0),]
    x <- x[order(x$chr, x$start, decreasing=F),]

    if (missing(name))
        name <- basename(filename)
    if (missing(description))
        description <- name
    if (missing(header))
        header <- paste("track type=bedGraph name='", name, "' description='", description,"'", sep="")

    writeLines(c(header,
                 paste(x$chr,
                       " ", format(x$start, scientific=F,trim=T,digits=5),
                       " ", format(x$end, scientific=F, trim=T,digits=5),
                       if ("name" %in% colnames(x)) x$name else "",
                       " ", format(x$coefficient, scientific=F, trim=T,digits=5), sep="")),
               con=filename)
}


library(treemap)

# Create data
# group = c('1', '2', '3', '4', '5', '6', '7', '8', '9', '10', '11', '12', '13', '14', '15', '16', '17', '18', '19', '20', '21', '22', '23', '24', '25', '26', '27', '28', '29', '30', '31', '32', '33', '34', '35', '36', '37', '38', '39', '40', '41', '42', '43', '44', '45', '46', '47', '48', '49', '50', '51', '52', '53', '54', '55', '56', '57', '58', '59', '60', '61', '62', '63', '64', '65', '66', '67', '68', '69', '70', '71', '72', '73', '74', '75', '76', '77', '78', '79', '80', '81', '82', '83', '84', '85', '86', '87', '88', '89', '90', '91', '92', '93', '94', '95', '96', '97', '98', '99', '100')
# value = c(1071, 483, 488, 434, 410, 389, 399, 364, 366, 369, 303, 321, 294, 301, 281, 253, 259, 252, 243, 290, 266, 248, 259, 231, 250, 244, 245, 259, 259, 234, 233, 243, 232, 233, 249, 245, 246, 244, 244, 233, 239, 261, 239, 250, 230, 233, 229, 235, 221, 244, 258, 266, 238, 279, 243, 245, 248, 260, 226, 249, 250, 251, 252, 257, 238, 236, 258, 246, 233, 246, 281, 267, 219, 236, 256, 245, 233, 250, 233, 222, 261, 255, 235, 260, 219, 268, 251, 259, 237, 235, 358, 320, 290, 278, 253, 248, 261, 229, 209, 166)
# data = data.frame(group,value)

key = c('1', '2', '3', '4', '5', '6', '7', '8', '9', '10', '11', '12', '13', '14', '15', '16', '17', '18', '19', '20', '21', '22', '23', '24', '25', '26', '27', '28', '29', '30', '31', '32', '33', '34', '35', '36', '37', '38', '39', '40', '41', '42', '43', '44', '45', '46', '47', '48', '49', '50', '51', '52', '53', '54', '55', '56', '57', '58', '59', '60', '61', '62', '63', '64', '65', '66', '67', '68', '69', '70', '71', '72', '73', '74', '75', '76', '77', '78', '79', '80', '81', '82', '83', '84', '85', '86', '87')
value = c(1744, 1441, 1314, 1322, 1392, 1527, 1538, 1559, 1384, 1242, 1239, 1092, 1050, 1011, 899, 838, 685, 672, 558, 2215, 430, 350, 278, 210, 205, 166, 137, 111, 93, 87, 66, 56, 48, 38, 30, 40, 23, 21, 41, 23, 20, 22, 16, 12, 12, 8, 9, 11, 7, 6, 5, 13, 8, 5, 4, 5, 4, 3, 2, 2, 1, 2, 0, 1, 2, 0, 0, 2, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1)
data = data.frame(key, value)

# treemap
tree <- treemap(data, index='key', vSize='value', type='index')

print(tree)


filter.sites <- function(featureset, expr) {
    eval(substitute(meffil:::filter.features(featureset, expr & target == "methylation")))$name
}

is.autosomal <- function(chr) chr %in% paste0("chr",1:22)
is.chromosome <- function(chr) chr %in% paste0("chr",c(1:22,"X","Y"))

#' Get names of CpG sites corresponding to Infinium Type II probes
#' in the feature set.
#'
#' @export
meffil.get.typeii.sites <- function(featureset="450k") {
    filter.sites(featureset, type=="ii")
}

#' Get names of autosomal CpG sites in the feature set.
#'
#' @export
meffil.get.autosomal.sites <- function(featureset="450k") {
    filter.sites(featureset, is.autosomal(chromosome))
}

#' Get names of chromosome X CpG sites in the feature set.
#' @export
meffil.get.x.sites <- function(featureset="450k") {
    filter.sites(featureset, chromosome=="chrX")
}

#' Get names of chromosome Y CpG sites in the feature set.
#' @export
meffil.get.y.sites <- function(featureset="450k") {
    filter.sites(featureset, chromosome=="chrY")
}

#' Get names of all CpG sites in the feature set.
#' @export
meffil.get.sites <- function(featureset="450k") {
    filter.sites(featureset, !is.na(chromosome))
}

get.quantile.site.subsets <- function(featureset) {
    list(genomic.iG=filter.sites(featureset, type=="i" & meth.dye=="G"),
         genomic.iR=filter.sites(featureset, type=="i" & meth.dye=="R"),
         genomic.ii=filter.sites(featureset, type=="ii"),
         autosomal.iG=filter.sites(featureset, type=="i"&meth.dye=="G"&is.autosomal(chromosome)),
         autosomal.iR=filter.sites(featureset, type=="i"&meth.dye=="R"&is.autosomal(chromosome)),
         autosomal.ii=filter.sites(featureset, type=="ii" & is.autosomal(chromosome)),
         not.y.iG=filter.sites(featureset, type=="i" & meth.dye=="G" & chromosome != "chrY"),
         not.y.iR=filter.sites(featureset, type=="i" & meth.dye=="R" & chromosome != "chrY"),
         not.y.ii=filter.sites(featureset, type=="ii" & chromosome != "chrY"),
         sex=filter.sites(featureset, chromosome %in% c("chrX", "chrY")),
         chrx=filter.sites(featureset, chromosome=="chrX"),
         chry=filter.sites(featureset, chromosome=="chrY"))
}

get.island.site.subsets <- function(featureset) {
    list(island=filter.sites(featureset, relation.to.island=="Island"),
         shore=filter.sites(featureset, relation.to.island %in% c("N_Shore","S_Shore")),
         far=filter.sites(featureset, relation.to.island %in% c("N_Shelf","S_Shelf","OpenSea")))
}

is.valid.site.subset <- function(name) {
    name %in% c("genomic.iG",
                "genomic.iR",
                "genomic.ii",
                "autosomal.iG",
                "autosomal.iR",
                "autosomal.ii",
                "not.y.iG",
                "not.y.iR",
                "not.y.ii",
                "sex",
                "chry",
                "chrx")
}

is.sex.specific.subset <- function(name) {
    name %in% c("genomic.iG",
                "genomic.iR",
                "genomic.ii",
                "not.y.iG",
                "not.y.iR",
                "not.y.ii",
                "sex",
                "chry",
                "chrx")
}

applicable.quantile.site.subsets <- function(sex, both.sexes) {
    if (both.sexes && sex == "M") return(c("autosomal.iG","autosomal.iR","autosomal.ii","sex"))
    if (both.sexes && sex == "F") return(c("autosomal.iG","autosomal.iR","autosomal.ii","chrx","chry"))
    if (!both.sexes && sex == "M") return(c("genomic.iG", "genomic.iR", "genomic.ii"))
    if (!both.sexes && sex == "F") return(c("not.y.iG", "not.y.iR", "not.y.ii","chry"))
    stop("invalid input", "sex =", sex, "both.sexes =", both.sexes)
}


#Emera Tagging

project.library( 'aegis', 'bio.snowcrab')

dn = file.path(project.datadirectory("bio.snowcrab"),'data','tagging','Emera')

a = dir(dn)
b = a[grep('tags',a)]
a = a[grep('meta',a)]
a = read.csv(file.path(dn,a),header=T)
out = NULL
for(i in b) {
	 h = read.csv(file.path(dn,i),header=T)
	 out = rbind(h,out)
}

names(out) = tolower(names(out))
out$dt = strptime(out$datetime, format= "%d/%m/%Y %H:%M")

#N Animals detects
	b= unique(out$transmitter) #58

#N Detects per anmimal
	a = aggregate(detectedid~transmitter,data=out,FUN=length)

#each animal

with(out[which(out$transmitter==b[1]),])

for(i in 1:length(b)) {
	oo = out[which(out$transmitter==b[i]),]
	oo = oo[order(oo$dt),]
	ll = nrow(oo)
	oo$ms = c(0,oo$dt[2:(ll)]-oo$dt[1:(ll-1)])
  makeMap(xlim=c(-60.3,-60.1),ylim=c(46.5,46.6))
	with(oo,plot(lon,lat,type='l',lwd=0.4))
	title(paste(b[i],'N days =', round(as.numeric(max(oo$dt)-min(oo$dt)[1]),1)	))
	savePlot(file.path(dn,paste('tag',b[i],".pdf",sep=".")),type='pdf')
}


# 3. faza: Vizualizacija podatkov
library(rgdal)
library(rgeos)
library(mosaic)
library(maptools)
library(reshape2)
library(ggplot2)
library(munsell)

# Uvozimo zemljevid Sveta
zemljevid <- uvozi.zemljevid("https://www.naturalearthdata.com/http//www.naturalearthdata.com/download/50m/cultural/ne_50m_admin_0_countries.zip",
                             "ne_50m_admin_0_countries") %>%
  fortify()

# Zemljevid sveta skrčimo na zemljevid Evrope
Evropa <- filter(zemljevid, CONTINENT == "Europe" |NAME == "Turkey")
Evropa <- filter(Evropa, long < 55 & long > -45 & lat > 30 & lat < 85)

# Narišemo zemljevid Evrope
#dev.off()
#ggplot() + geom_polygon(data = Evropa, aes(x=long, y=lat, group=group,fill=id)) +
#  theme(legend.position="none")

# Drzave v zemljevidu Evrope
drzave <- unique(Evropa$NAME)
drzave <- as.data.frame(drzave, stringsAsFactors=FALSE)
names(drzave) <- "Country"

# Da bom lahko povezoval zemljevid evrope z mojimi tabelami moram nekatere vrstice preimenovati v mojih tabelah

# Ker je držav preveč je legenda nesmiselna, Dodam omejitev da imam samo Evropo na manjšem zemljevidu
ggplot(Evropa, aes(x=long, y=lat, group=group, fill=NAME)) +
  geom_polygon() +
  labs(title="Evropa - osnovna slika") +
  theme(legend.position="none")

# Da bom lahko povezoval zemljevid evrope z mojimi tabelami moram nekatere vrstice preimenovati v tabeli st.igralcev
# Naredim novo tabelo, da ne bo prihajalo do težav kasneje
st.igralcev.eu <- st.igralcev
st.igralcev.eu <- as.data.frame(st.igralcev.eu, stringsAsFactors=FALSE)
st.igralcev.eu[,1] <- as.character(st.igralcev.eu[,1])
colnames(st.igralcev.eu) <- c("Country", "Players")
st.igralcev.eu[2,1] <- "Bosnia and Herz."
st.igralcev.eu[4,1] <- "Czechia"

ujemanje <- left_join(drzave, st.igralcev.eu, by="Country")
ujemanje$Players[is.na(ujemanje$Players)]<- 0

# Izrišem zemljevid Evrope, v katerem bo vsaka država pobarvana glede št. igralcev v ligi NBA
ggplot() + geom_polygon(data=left_join(Evropa, ujemanje, by=c("NAME"="Country")),
                        aes(x=long, y=lat, group=group, fill=Players)) +
  ggtitle("Števila NBA igralcev v posamezni evropski državi") + xlab("") + ylab("") +
  guides(fill=guide_colorbar(title="Število igralcev"))

# Fiba lestvica: Europe rank vs players vs population per 10 mills

fiba.lestvica.plot <- fiba.lestvica[,c(1,4,5,6)]
fiba.lestvica.plot[3] <- fiba.lestvica.plot[3] / 10000000

plot2.tidy <- melt(fiba.lestvica.plot, id.vars="Country", measure.vars=colnames(fiba.lestvica.plot)[-1])

ggplot(data=plot2.tidy %>% filter(variable == "Europerank") %>%
         transmute(Country, Europerank=value) %>%
         inner_join(plot2.tidy %>%
                      filter(variable %in% c("Population", "Players"))),
       aes(x=Europerank, y=value, colour=variable)) +
  geom_line() +
  labs(title="Primerjava populacije(/10 milijonov) in števila NBA igralcev")

# Izrišem graf, ki prikazuje povezavo plačo in odstotkom meta igralcev, glede na povprečje

povprecni.rang <- ((540*541)/2) / 540 # Logično: 270.5

library(tidyverse)

plot1 <- inner_join(zaupanje.evropejcem, ucinkovitost.evropejcev, by="Player")
plot1 <- plot1[,c(1,3,6,9,11)]

library(reshape2)
plot1.tidy <- melt(plot1, id.vars="Player", measure.vars=colnames(plot1)[-1])

ggplot(data=plot1.tidy %>% filter(variable == "Points.rank") %>%
         transmute(Player, Points.rank=value) %>%
         inner_join(plot1.tidy %>%
                      filter(variable %in% c("EffectiveFieldGoal.rank", "Salary.rank"))),
       aes(x=Points.rank, y=value, colour=variable)) +
  geom_point() +
  geom_hline(yintercept=povprecni.rang, colour="green") +
  labs(title="Rank plač in odstotka meta glede na povprečje")


library(tidyverse)
library(ggplot2)
library(dplyr)
library(ggrepel)
library(patchwork)
#Load data
main_data <- read_csv("conv.csv", na = "empty")

#changing percentage resistance into numeric class and rounding off
main_data$percent_resistant <- as.numeric(as.character
                                          (main_data$percent_resistant))

main_data$percent_resistant <- round(main_data$percent_resistant, digits = 2)

host_data <- main_data %>%
  group_by(host) %>%
  select("country",
         "farm_type",
         "antimicrobial_compound",
         "pathogen",
         "percent_resistant"

         )

##Cows and calves  plot

cows <- host_data %>%
  filter(host == "Cows and Calves") %>%
  select("country",
         "farm_type",
         "antimicrobial_compound",
         "pathogen",
         "percent_resistant"

         )

##Cows and calves bar plot

cows_plot <- ggplot(cows, aes(x = antimicrobial_compound,
                                  y = percent_resistant,
                                  fill = farm_type
)
) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(subtitle = "Cows and calves, E.coli",
       x = "Antimicrobial", y = "Percentage resistance",
       fill = "farm type") +
  theme_bw() +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
cows_plot

##Chicken  plot

chicken <- host_data %>%
  filter(host == "Chicken") %>%
  select("country",
         "farm_type",
         "antimicrobial_compound",
         "pathogen",
         "percent_resistant"

  )

##Chicken bar plot

chicken_plot <- ggplot(chicken, aes(x = antimicrobial_compound,
                              y = percent_resistant,
                              fill = farm_type
)
) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(subtitle = "Chicken",
       x = "Antimicrobial", y = "Percentage resistance",
       fill = "farm type") +
  facet_wrap(~country, nrow = 7)+
  theme_bw() +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
chicken_plot

##Chicken  plot

chicken <- host_data %>%
  filter(host == "Chicken") %>%
  select("country",
         "farm_type",
         "antimicrobial_compound",
         "pathogen",
         "percent_resistant"

  )

##Chicken bar plot

chicken1_plot <- ggplot(chicken, aes(x = antimicrobial_compound,
                                    y = percent_resistant,
                                    fill = farm_type
)
) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(subtitle = "Chicken",
       x = "Antimicrobial", y = "Percentage resistance",
       fill = "farm type") +
  theme_bw() +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
chicken1_plot

##Environment  plot

env <- host_data %>%
  filter(host == "Environment") %>%
  select("country",
         "farm_type",
         "antimicrobial_compound",
         "pathogen",
         "percent_resistant"

  )

##Environment bar plot

env_plot <- ggplot(env, aes(x = antimicrobial_compound,
                                    y = percent_resistant,
                                    fill = farm_type
)
) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(subtitle = "Environment, E.coli",
       x = "Antimicrobial", y = "Percentage resistance",
       fill = "farm type") +
  facet_wrap(~country)+
  theme_bw() +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
env_plot

##Environment  plot

env <- host_data %>%
  filter(host == "Environment") %>%
  select("country",
         "farm_type",
         "antimicrobial_compound",
         "pathogen",
         "percent_resistant"

  )

##Environment bar plot

env1_plot <- ggplot(env, aes(x = antimicrobial_compound,
                            y = percent_resistant,
                            fill = farm_type
)
) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(subtitle = "Environment, E.coli",
       x = "Antimicrobial", y = "Percentage resistance",
       fill = "farm type") +
  theme_bw() +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
env1_plot

##Pig plot

pig <- host_data %>%
  filter(host == "Pigs") %>%
  select("country",
         "farm_type",
         "antimicrobial_compound",
         "pathogen",
         "percent_resistant"

  )

##Pig bar plot

pig_plot <- ggplot(pig, aes(x = antimicrobial_compound,
                            y = percent_resistant,
                            fill = farm_type
)
) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(subtitle = "Pigs",
       x = "Antimicrobial", y = "Percentage resistance",
       fill = "farm type") +
  facet_wrap(~country, nrow = 3)+
  theme_bw() +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
pig_plot

##Pig plot

pig <- host_data %>%
  filter(host == "Pigs") %>%
  select("country",
         "farm_type",
         "antimicrobial_compound",
         "pathogen",
         "percent_resistant"

  )

##Pig bar plot

pig1_plot <- ggplot(pig, aes(x = antimicrobial_compound,
                            y = percent_resistant,
                            fill = farm_type
)
) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(subtitle = "Pigs",
       x = "Antimicrobial", y = "Percentage resistance",
       fill = "farm type") +
    theme_bw() +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
pig1_plot

##Turkey plot

turk <- host_data %>%
  filter(host == "Turkey") %>%
  select("country",
         "farm_type",
         "antimicrobial_compound",
         "pathogen",
         "percent_resistant"

  )

##Turkey bar plot

turk_plot <- ggplot(turk, aes(x = antimicrobial_compound,
                            y = percent_resistant,
                            fill = farm_type
)
) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(subtitle = "Turkey, campylobacter",
       x = "Antimicrobial", y = "Percentage resistance",
       fill = "farm type") +
  theme_bw() +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
turk_plot

##Cattle plot

cattle <- host_data %>%
  filter(host == "Cattle") %>%
  select("country",
         "farm_type",
         "antimicrobial_compound",
         "pathogen",
         "percent_resistant"

  )

##Cattle bar plot

cattle_plot <- ggplot(cattle, aes(x = antimicrobial_compound,
                            y = percent_resistant,
                            fill = farm_type
)
) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(subtitle = "Cattle",
       x = "Antimicrobial", y = "Percentage resistance",
       fill = "farm type") +
  facet_wrap(~country, nrow = 3)+
  theme_bw() +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
cattle_plot

##Cattle plot

cattle <- host_data %>%
  filter(host == "Cattle") %>%
  select("country",
         "farm_type",
         "antimicrobial_compound",
         "pathogen",
         "percent_resistant"

  )

##Cattle bar plot

cattle1_plot <- ggplot(cattle, aes(x = antimicrobial_compound,
                                  y = percent_resistant,
                                  fill = farm_type
)
) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(subtitle = "Cattle",
       x = "Antimicrobial", y = "Percentage resistance",
       fill = "farm type") +
  theme_bw() +
  theme_classic() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))
cattle1_plot

##marging plots using patchwork

host_plot <- (cows_plot | chicken1_plot) /
  (cattle1_plot | pig1_plot) /
  (env1_plot | turk_plot) +
  plot_layout(guides = "collect") +
  plot_annotation(tag_levels = "a", tag_prefix = "(",
                  tag_suffix = ")") &
  theme(plot.tag = element_text(face = "bold"))

host_plot


####script file found in /nas40t2/hwheeler/PrediXcan_CV/GTEx_2014-06013_release/
####by Heather E. Wheeler 20140602####
args <- commandArgs(trailingOnly=T)
date <- Sys.Date()
"%&%" = function(a,b) paste(a,b,sep="")
###############################################
### Directories & Variables
cri = T #on cri cluster?
if(cri) precri = "/group/dolan-lab/hwheeler/" else precri = '/'

tis <- "GTEx-NT"
k <- 10 ### k-fold CV
n <- 10 #number of k-fold CV replicates

my.dir <- precri %&% "nas40t2/hwheeler/PrediXcan_CV/GTEx_2014-06013_release/"
poly.dir <- precri %&% "nas40t2/hwheeler/PrediXcan_CV/Polyscore/hapmap2/transcriptome-" %&% tis %&% "/"
gencodefile <- my.dir %&% "gencode.v18.genes.patched_contigs.summary.protein." %&% args[1]
gencodeset <- args[1]

################################################
### Functions & Libraries

library(glmnet)

stderr <- function(x) sqrt(var(x,na.rm=TRUE)/length(x))
lower <- function(x) quantile(x,0.025,na.rm=TRUE)
upper <- function(x) quantile(x,0.975,na.rm=TRUE)

## fit betas by Vasa edited by Heather to get pvals
fit.betas <- function(G, Y) {
require(RcppGSL)
betas <- rep(NA, ncol(G))
stderrs <- rep(NA, ncol(G))
dfs <- rep(NA, ncol(G))
for (i in 1:ncol(G)) {
res <- fastLmPure(y=Y, X=matrix(G[,i]))
betas[i] <- res$coefficients
stderrs[i] <- res$stderr
dfs[i] <- res$df
}
t <- betas/stderrs
pvals <- 2*pt(-abs(t),df=dfs)
output <- cbind(betas,pvals)
return(output)
}

################################################
###input adjusted expression data###
expidfile <- my.dir %&% tis %&% ".exp.adj.15PEERfactors.3PCs.gender.ID.list"
expgenefile <- my.dir %&% tis %&% ".exp.adj.15PEERfactors.3PCs.gender.GENE.list"
expfile <- my.dir %&% tis %&% ".exp.adj.15PEERfactors.3PCs.gender.IDxGENE"

expidlist <- scan(expidfile,"character")
expgenelist <- scan(expgenefile,"character")
exp <- scan(expfile)
expdata <- matrix(exp, ncol=length(expgenelist), byrow=T)
rownames(expdata) <- expidlist
colnames(expdata) <- expgenelist

#gencodefile <- my.dir %&% "gencode.v18.genes.patched_contigs.summary.protein"
gencode <- read.table(gencodefile) ##split into 10 files, call each from run_1_CV_GTEx_polyscore_PrediXcan_subset*.sh
rownames(gencode) <- gencode[,5]
tissue.exp <- expdata[,intersect(colnames(expdata),rownames(gencode))] ###pull protein coding gene expression data

###input genotype data###
gtfile <- my.dir %&% "GTEx.IDxSNP.rds"

X <- readRDS(gtfile)
X <- X[expidlist,]

samplelist<-expidlist

bimfile <- my.dir %&% "GTEx_Analysis_2014-06-13.hapmapSnpsCEU.bim"
bim <- read.table(bimfile)
rownames(bim) <- bim$V2

exp.w.geno <- tissue.exp
explist <- colnames(exp.w.geno)

###create results array
resultsarray <- array(NA,c(n,6,length(explist)))
dimnames(resultsarray)[[3]] <- explist
finalresults <- matrix(NA,nrow=length(explist),ncol=7)
rownames(finalresults) <- explist
colnames(finalresults) <- c("gene","R2.mean","R2.se","R2.lci","R2.uci","mean.n.snps","P.mean")

###run polyscore CV

set.seed(1001)

for(j in 1:length(explist)){
    cat(j,"/",length(explist),"\n")
    gene <- explist[j]
    genename <- as.character(gencode[gene,6])
    geneinfo <- gencode[gene,]
    chr <- geneinfo[1]
    c <- substr(chr$V1,4,5)
    start <- geneinfo$V3 - 1e6 ### 1Mb lower bound for cis-eQTLS
    end <- geneinfo$V4 + 1e6 ### 1Mb upper bound for cis-eQTLs
    chrsnps <- subset(bim,bim[,1]==c) ### pull snps on same chr
    cissnps <- subset(chrsnps,chrsnps[,4]>=start & chrsnps[,4]<=end) ### pull cis-SNP info
    cisgenos <- X[,intersect(colnames(X),cissnps[,2])] ### pull cis-SNP genotypes
    cisgenos[cisgenos >= 3] <- NA ###.gds files have missing=3
    if(is.null(dim(cisgenos))){###effectively skips genes with <2 cis-SNPs
                finalresults[gene,1] <- genename
                finalresults[gene,2:6] <- rep(NA,5)
        }else{
              	minorsnps <- subset(colMeans(cisgenos), colMeans(cisgenos,na.rm=TRUE)>0) ###pull snps with at least 1 minor allele###
                minorsnps <- names(minorsnps)
                cisgenos <- cisgenos[,minorsnps]
                cisgenos <- scale(cisgenos, center=T, scale=T) ##need to scale for fastLmPure to work properly
                cisgenos[is.na(cisgenos)] <- 0
                if(is.null(dim(cisgenos)) | dim(cisgenos)[2] == 0){###effectively skips genes with <2 cis-SNPs after removing those with no minor alleles
                        finalresults[gene,1] <- genename
                        finalresults[gene,2:6] <- rep(NA,5)
                }else{
                      	exppheno <- exp.w.geno[,gene] ### pull expression data for gene
                        exppheno <- scale(exppheno, center=T, scale=T)
                        exppheno[is.na(exppheno)] <- 0
                        rownames(exppheno) <- rownames(exp.w.geno)
                        ### run k-fold CV n times
                        for(i in 1:n){
                                ###randomize samples into CV groups
                                samplelength <- length(exppheno)
                                g <- 1:k ##k-fold CV
                                groupid <- sample(g,samplelength,replace=T)
                                newiddata <- data.frame(groupid,samplelist)
                                ### create empty matrix to fill in with polyscore vals
                                cvset <- data.frame(samplelist,matrix(NA,samplelength,1),exppheno)
                                rownames(cvset) <- samplelist
                                names(cvset) <- c("ID","Pred","Exp")
                                for(idsubset in 1:k){
                                        trainset <- data.frame(newiddata$samplelist[newiddata$groupid != idsubset])
                                        testset <- data.frame(newiddata$samplelist[newiddata$groupid == idsubset])
                                        ### pull trainset genos and phenos
                                        traingenos <- cisgenos[intersect(trainset[,1],rownames(cisgenos)),]
                                        trainexp <- exppheno[match(trainset[,1],rownames(exppheno))]  ###if scaled, use rownames
                                        ### calculate betas and pvals from training set
                                        betares <- fit.betas(traingenos,trainexp) ###~30sec/gene
                                        rownames(betares) <- colnames(traingenos)
                                        topres <- subset(betares,betares[,2] < 0.05) ###pull snps with P<0.05
                                        betas <- topres[,1]
                                        if(length(betas) <= 1){
                                                names(betas) <- rownames(topres)
                                        }
                                        ### polyscore
                                        ### multiply betas by test genotypes and take sum
                                        testgenos <- cisgenos[intersect(testset[,1],rownames(cisgenos)),intersect(names(betas),colnames(cisgenos))]
                                        if(is.array(testgenos)=='FALSE'){ ### calcs polyscore if only one individual in test set, happens when expression sample size is low (<100)
                                                if(dim(testset)[1] < 2){ ### calcs polyscore if only one individual in test set, happens when expression sample size is low (<100)
                                                        pred.polyscore <- sum(testgenos * betas)
                                                        names(pred.polyscore)<-testset[,1]
                                                }else{ ### calcs polyscore if only one beta with p<0.05
                                                        pred.polyscore <- testgenos * betas
                                                }
                                                cvset$Pred[match(names(pred.polyscore),rownames(cvset))] <- pred.polyscore
                                        }else{
                                              	testsweep <- sweep(testgenos, 2, betas, "*")
                                                pred.polyscore <- as.vector(rowSums(testsweep))
                                                names(pred.polyscore) <- rownames(testsweep)
                                                ### add predictions to cvset
                                                cvset$Pred[match(names(pred.polyscore),rownames(cvset))] <- pred.polyscore
                                        }
                                }

                                ### calculate correlation between predicted and observed expression
                                res<-summary(lm(cvset$Pred~cvset$Exp))
                                resultsarray[i,1:4,gene] <- coef(res)[2,]
                                resultsarray[i,5,gene] <- res$r.squared
                                resultsarray[i,6,gene] <- length(betas)

                        }
                        finalresults[gene,1] <- genename
                        finalresults[gene,2] <- mean(resultsarray[,5,gene],na.rm=TRUE)
                        finalresults[gene,3] <- stderr(resultsarray[,5,gene])
                      	finalresults[gene,4] <- lower(resultsarray[,5,gene])
                        finalresults[gene,5] <- upper(resultsarray[,5,gene])
                        finalresults[gene,6] <- as.integer(mean(resultsarray[,6,gene],na.rm=TRUE))
                        finalresults[gene,7] <- mean(resultsarray[,4,gene],na.rm=TRUE)

                        ### output bestbetas for PrediXcan
                        allbetares <- fit.betas(cisgenos,exppheno) ###~30sec/gene
                        rownames(allbetares) <- colnames(cisgenos)
                        alltopres <- subset(allbetares,allbetares[,2] < 0.05) ###pull snps with P<0.05
                        allbetas <- alltopres[,1]
                        if(length(allbetas) <= 1){
                                names(allbetas) <- rownames(alltopres)
                        }
                        allbetalist <- names(allbetas)
                        allbetainfo <- bim[allbetalist,]
                        allbetatable <- as.matrix(cbind(allbetainfo,alltopres))
                        betafile <- cbind(allbetatable[,2],allbetatable[,6],allbetatable[,7],allbetatable[,8])
                        colnames(betafile) <- c("SNP","eff.allele","beta","p.value")
                        write.table(betafile, file=poly.dir %&% genename %&% "-" %&% tis %&% ".txt",quote=F,row.names=F,sep="\t")
                }
        }
}

date <- Sys.Date()

write.table(finalresults,file=tis %&% ".adj.exp." %&% k %&% "-fold.CV." %&% n %&% "-reps.polyscore.p0.05.PrediXcan.subset." %&% gencodeset %&% "."   %&% date %&% ".txt",quote=F)


# downtime graph

Sys.setlocale("LC_ALL", "C")

library(reshape2)
library(ggplot2)
library(scales)

downtime <- function(){
    DF <- read.table(text=iconv("ID    Equipment    Downtime     Running     Idle
    1    设备1    1.7    6.15    1
    2    设备2    1.0    6.6    0.5
    3    设备3    0.9    7.6    0
    4    设备4    1.8    6.6    1.5
    5    设备5    1.5    4.9    2
    6    设备6    0.45    5.55    1
    7    设备7    1.25    4.55    2","UTF-8","UTF-8"), header=TRUE)

    #print(DF)

    DF1 <- melt(DF, id.var=c("ID","Equipment"))

    #print(DF1)

    plt <- ggplot(DF1, aes(x = ID, y = value, fill = variable )) +   #, fill = variable

            geom_bar(stat = "identity", width=0.7,  alpha=0.7,   position="fill")   +

            #ggtitle(iconv("月停线时间","UTF-8","UTF-8")) + #iconv
            theme(plot.title = element_text(lineheight=3, face="bold", color="black", size=12) )+

            scale_x_continuous(breaks=DF1$ID, labels= DF1$Equipment)  +
            #scale_y_continuous(breaks=DF1$value) +
            ylab("时长百分比(%)") +
            scale_y_continuous(labels = percent) +

            scale_fill_manual(values=c("#FF4136", "#2ECC40", "#FFDC00"),
                        guide = guide_legend(title = "图例"))  +
            scale_alpha_manual(values = c(0.2,0.2, 0.2))+

            theme(axis.text.x = element_text(angle=30, vjust=0.1, size=7, color="#BBBFC2"),
                    axis.title.x=element_blank(),
                    axis.text.y = element_text(size=7,  color="#BBBFC2"),
                    axis.title.y = element_text(size=10,  color="#BBBFC2"),
                    panel.grid.major=element_line(color="#444444"),
                    panel.grid.minor=element_line(color="#444444"),
                    panel.background=element_blank(),
                    #panel.border=element_rect(color= "#1F1F1F"),
                    legend.title = element_text(size=7,  color="#BBBFC2"),
                    legend.text = element_text(size=7,  color="#BBBFC2"),
                    legend.background = element_rect(colour = '#1F1F1F', fill = '#1F1F1F'),
                    plot.background=element_rect(fill = "#1F1F1F", color = "#1F1F1F")
                    )

    ggsave("output/downtime1.png",width=6, height=2.5)

}

downtime()


rebol [
	title: "ImageCore ICO and BMP functions"
]

	readICONDIR: does [context[
		Width:        readUI8  ;Width of icon in pixels
		Height:       readUI8  ;Height of icon in pixels
		NumColors:    readUI8  ;Maximum number of colors - If the bitmap contains 256 or more colors the value of NumColors will be 0.
		Reserved:     readUI8  ;Not used (always 0)
		NumPlanes:    readUI16 ;Not used (always 0)
		BitsPerPixel: readUI16 ;Not used (always 0)
		DataSize:     readUI32 ;Length of icon bitmap in bytes
		DataOffset:   readUI32 ;Offset position of icon bitmap in file
	]]

	readBITMAPFILEHEADER: does[context[
		bfSize:    readUI32
		bfOffBits: (skipBytes 4 readUI32)
	]]
	readBITMAPINFOHEADER: does[context[
		biSize:          readUI32
		biWidth:         readUI32
		biHeight:        readUI32
		biPlanes:        readUI16
		biBitCount:      readUI16
		biCompression:   readUI32
		biSizeImage:     readUI32
		biXPelsPerMeter: readUI32
		biYPelsPerMeter: readUI32
		biClrUsed:       readUI32
		biClrImportant:  readUI32
	]]
	readICOBMP: func[icoDir /local buf icoBMP][
		buf: inBuffer
		inBuffer: at head inBuffer icoDir/DataOffset + 1
		bmpHeader: readBITMAPINFOHEADER
		;? bmpHeader
		bmpData:   copy/part inBuffer (icoDir/DataSize - bmpHeader/biSize)
		;? bmpData
		inBuffer: buf
		BMP2ARGB/withAlpha icoDir/width icoDir/height bmpHeader bmpData
	]
	readRGBATable: func[colors /local RGBATable][
		RGBATable: make block! colors
		loop colors [insert tail RGBATable reverse readBytes 4]
		RGBATable
	]
	readRGBTable: func[colors /local RGBTable][
		RGBTable: make block! colors
		loop colors [insert tail RGBTable reverse readBytes 3 skipByte]
		RGBTable
	]
	BMP2ARGB: func[
		width height bmpHeader bmpData
		/withAlpha
		/local buf pixels imageDataSize colorTable b c icXor icAnd bARGB width8 sk][
		;store previous stream buffer state
		buf: inBuffer
		inBuffer: bmpData
		pixels: width * height
		bARGB:  make binary! (pixels * 4)
		insert/dup bARGB #{FF} (pixels * 4)
		;? bmpHeader
		switch bmpHeader/biBitCount [
			4 [
				colorTable: readRGBATable either bmpHeader/biClrUsed = 0 [16][bmpHeader/biClrUsed]
				until [
					b: readUI8
					c: 1 + ((240 and b) / 16)
					bARGB: change bARGB colorTable/:c
					c: 1 + (15 and b)
					bARGB: change bARGB colorTable/:c
					tail? bARGB
				]
			]
			8 [
				colorTable: readRGBATable either bmpHeader/biClrUsed = 0 [256][bmpHeader/biClrUsed]
				until [
					bARGB: change bARGB head change colorTable/(1 + readUI8) #{FF}
					tail? bARGB
				]
			]
			16 [
				until [
					bARGB: change next bARGB to-binary short-to-rgb readUI16
					tail? bARGB
				]
			]
			24 [
				until [
					bARGB: change next bARGB reverse readBytes 3
					tail? bARGB
				]
			]
			32 [
				until [
					bARGB: change bARGB  reverse readBytes 4
					tail? bARGB
				]
			]
		]
		bARGB: head bARGB

		if all [withAlpha bmpHeader/biBitCount < 32] [
			width8: to-integer width / 8
			sk: width8 // 4
			until [
				loop width8 [
					b: readUI8
					loop 8 [
						change bARGB either 128 = (128 and b) [#{00}][#{FF}]
						bARGB: skip bARGB 4
						if tail? bARGB [break]
						b: b * 2
					]
				]
				skipBytes sk
				tail? bARGB
			]
		]

		make object! compose [
			size:   (as-pair width height)
			bARGB:  (flip-vertical head bARGB ( 4 * width))
			alpha?: (withAlpha)
		]
	]


# This code creates the seroprevalence
# map by city district for
# Seroprevalence of SARS-CoV-2 antibodies in Saint
# Petersburg, Russia paper (https://doi.org/10.1038/s41598-021-92206-y)
library(data.table)
library(ggplot2)
library(ggrepel)
library(scales)
library(ggthemes)
library(ggspatial)
library(sf)

# Declare working directory beforehand in an environment variable
# SPB_COVID_STUDY_PATH = "path_to_your_folder"
# with the aid of usethis::edit_r_environ()
# Restart R session for the changes to make effect
setwd(Sys.getenv('SPB_COVID_STUDY_PATH'))

# Load the per-group prevalence computed by estimate_prevalence_by_variable.r
load("estimates/wave1/prevalence_by_variable_level.rdata")

# Prevalence lower bounds that cross zero to zero
prevalence_by_variable_level[lowerbound < 0, lowerbound := 0 ]

# Keep only univariate prevalence from Abbott test
prevalence_by_district <- prevalence_by_variable_level[ prevalence_type == "univariate" & serotest == "IgG_testB" & variable == "district" & surveyweight == "no" & sensitivity != 1]
setnames(prevalence_by_district, "variable_level", "district")

# Load the district boundaries shapefile
# from NextGIS-processed OSM data
spb_boundaries <- st_read("data/spb_map/spb_district_boundaries.shp")

# Convert to metric coordinate reference system
# We will use Pulkovo 1995 / Gauss-Kruger zone 6 (https://epsg.io/20006)
spb_boundaries <- st_transform(spb_boundaries, crs = 20006)

# Translate district names
prevalence_by_district[ district == "Admiralteyskiy District", NAME := "Адмиралтейский район"]
prevalence_by_district[ district == "Frunzenskiy District", NAME := "Фрунзенский район"]
prevalence_by_district[ district == "Kalininskiy District", NAME := "Калининский район"]
prevalence_by_district[ district == "Kirovskiy District", NAME := "Кировский район"]
prevalence_by_district[ district == "Krasnogvardeyskiy District", NAME := "Красногвардейский район"]
prevalence_by_district[ district == "Moskovskiy District", NAME := "Московский район"]
prevalence_by_district[ district == "Nevskiy District", NAME := "Невский район"]
prevalence_by_district[ district == "Petrogradskiy District", NAME := "Петроградский район"]
prevalence_by_district[ district == "Primorskiy District", NAME := "Приморский район"]
prevalence_by_district[ district == "Tsentralniy District", NAME := "Центральный район"]
prevalence_by_district[ district == "Vasileostrovskiy District", NAME := "Василеостровский район"]
prevalence_by_district[ district == "Vyborgskiy District", NAME := "Выборгский район"]

# Add prevalence to the data
spb_boundaries <- merge(spb_boundaries, prevalence_by_district, by = "NAME", all.x = T, all.y = F)

# Test site location
test_site <- st_as_sf(data.table(lat = 59.9049557, lon = 30.3179625), coords = c("lon", "lat"), crs = 4326)
test_site <- st_transform(test_site, crs = 20006)

# Initiate the plot
theme_set(theme_bw())

prev_distr_plot <- ggplot(spb_boundaries) +
						geom_sf(aes(fill = pointest)) +
						scale_fill_viridis_c(na.value = "grey90", option = "magma", direction = -1) +
						geom_sf(data = test_site, size = 4, shape = 21, fill = "green") +
						geom_label_repel(data = spb_boundaries[!is.na(spb_boundaries$pointest),], aes(label = paste0(pointest, "\n(", lowerbound, "; ", upperbound, ")"), geometry = geometry), size = 2, stat = "sf_coordinates", min.segment.length = 0, segment.size = 0.25, segment.alpha = 0.8, max.iter = 5000) +
						xlab("") + ylab("") +
					    labs(title = "", caption = "", fill = "Prevalence, %") +
						annotation_scale(location = "bl", width_hint = 0.3) +
						theme(	panel.grid.major = element_blank(),
								panel.background = element_rect(fill = "white"),
								panel.border = element_blank(),
								axis.title.x = element_blank(),
								axis.text.x = element_blank(),
								axis.ticks.x = element_blank(),
								axis.title.y = element_blank(),
								axis.text.y = element_blank(),
								axis.ticks.y = element_blank(),
								legend.position = c(0.07,.2)
							)

#ggsave(prev_distr_plot, file = "media/wave1/prevalence_estimates_by_district.pdf", scale = 1)


# ==========================================================================
# Create U.S. map with url links for each state
# ==========================================================================
library(tidyverse)
library(tigris)
library(leaflet)
library(htmlwidgets)
library(leaflet.extras)

jsCode <- paste0('
 function(el, x, data) {
  var marker = document.getElementsByClassName("leaflet-interactive");
  for(var i=0; i < marker.length; i++){
    (function(){
      var v = data.win_url[i];
      marker[i].addEventListener("click", function() { window.open(v);}, false);
  }());
  }
 }
')

state <-
    states(
        cb = TRUE
    ) %>%
    filter(STUSPS %in% c('CA', 'WA', 'MD')) %>%
    mutate(win_url =
        case_when(
            STUSPS == 'CA' ~ 'https://shiny.demog.berkeley.edu/alexramiller/kqed-evictions/',
            STUSPS == 'WA' ~ 'https://evictions.study/washington/maps/summary.html',
            STUSPS == 'MD' ~ 'https://evictions.study/maryland/report/baltimore.html'))

map <-
leaflet(
  state,
  options = leafletOptions(zoomControl = FALSE, minZoom = 3.5, maxZoom = 3.5, dragging = FALSE)) %>%
    # suspendScroll() %>%
    setView(lat = 39.82, lng = -98.57, zoom = 3.5) %>%
    addMapPane(name = "polygons", zIndex = 410) %>%
    addMapPane(name = "maplabels", zIndex = 420) %>%
     addProviderTiles("CartoDB.PositronNoLabels") %>%
     addProviderTiles("CartoDB.PositronOnlyLabels",
                    options = leafletOptions(pane = "maplabels"),
                    group = "map labels") %>%
  addPolygons(
        fillOpacity = .5,
        color = 'Red',
        stroke = TRUE,
        label = ~NAME,
        weight = 1,
        opacity = .5,
        highlightOptions = highlightOptions(
                    color = "#ff4a4a",
                    weight = 5,
                    bringToFront = TRUE
                    )
        )  %>%
  htmlwidgets::onRender(jsCode, data=state)

map
saveWidget(map, '~/git/evictions-study.github.io/maps/us_map.html')


library(rstan)
library(data.table)
library(lubridate,warn.conflicts = FALSE)
library(gdata)
library(dplyr)
library(tidyr)
library(EnvStats)
library(scales)
library(stringr)
library(abind)
library(optparse)
library(ggplot2)
library(ggrepel)
library(gtable)
library(zoo)

# provide functions for pre and post processing
source("utils/arg-parser.r")
source('utils/read-data.r')
source('utils/read-interventions.r')
source('utils/process-covariates.r')

VERSION="v5"

# Commandline options and parsing
# Needs cleaning
parsedargs <- base_arg_parse()
DEBUG <- parsedargs[["DEBUG"]]
FULL_RUN <- parsedargs[["FULL"]]
StanModel <- parsedargs[["StanModel"]]
mobility_source <- parsedargs[["mobility_source"]]
formula_pooling <- parsedargs[["formula_pooling"]]
formula_partialpooling <- parsedargs[["formula_partialpooling"]]

# Read which countires to use
countries <- read.csv('data/regions.csv', stringsAsFactors = FALSE)
# Read deaths data for regions
d <- read_obs_data()
regions <- countries

# Read ifr
ifr.by.country <- read_ifr_data()

# Read google mobility, apple mobility, interventions, stringency
mobility <- read_mobility(mobility_source)

# Read interventions
interventions <- read_interventions('data/interventions.csv')

forecast <- 7 # increase to get correct number of days to simulate
# Maximum number of days to simulate
N2 <- (max(d$DateRep) - min(d$DateRep) + 1 + forecast)[[1]]

formula = as.formula(formula_pooling)
formula_partial = as.formula(formula_partialpooling)
processed_data <- process_covariates(
  regions = regions,
  mobility = mobility,
  intervention = interventions,
  d = d,
  ifr.by.country = ifr.by.country,
  N2 = N2,
  formula = formula,
  formula_partial = formula_partial
)

stan_data <- processed_data$stan_data
dates <- processed_data$dates
reported_deaths <- processed_data$deaths_by_country
reported_cases <- processed_data$reported_cases

options(mc.cores = parallel::detectCores())
rstan_options(auto_write = TRUE)
m = stan_model(paste0('stan-models/',StanModel,'.stan'))

if(DEBUG) {
  fit = sampling(m,data=stan_data,iter=40,warmup=20,chains=2)
} else if (FULL) {
  fit = sampling(m,data=stan_data,iter=2000,warmup=1500,chains=4,thin=1,control = list(adapt_delta = 0.95, max_treedepth = 15))
} else {
  fit = sampling(m,data=stan_data,iter=600,warmup=300,chains=4,thin=1,control = list(adapt_delta = 0.95, max_treedepth = 10))
}

out <- rstan::extract(fit)
estimated_cases_raw <- out$prediction
estimated_deaths_raw <- out$E_deaths
estimated_deaths_cf <- out$E_deaths0

JOBID = Sys.getenv("PBS_JOBID")
if(JOBID == "")
  JOBID = as.character(abs(round(rnorm(1) * 1000000)))
print(sprintf("Jobid = %s",JOBID))

countries <- countries$Regions
covariate_data = list(interventions, mobility)
save.image(paste0('results/',StanModel,'-',JOBID,'.Rdata'))
save(
  fit, prediction, dates,reported_cases,deaths_by_country,countries,
  estimated_deaths_raw, estimated_deaths_cf,
  out,interventions, VERSION,
  file=paste0('results/',StanModel,'-',JOBID,'-stanfit.Rdata'))

## Ensure that output directories exist
dir.create("results/", showWarnings = FALSE, recursive = TRUE)
dir.create("figures/", showWarnings = FALSE, recursive = TRUE)
dir.create("web/", showWarnings = FALSE, recursive = TRUE)
dir.create("web/data", showWarnings = FALSE, recursive = TRUE)

filename <- paste0(StanModel,'-',JOBID)

regions <- unique(d$country)

# This is a hack to get it to save
states = regions

covariate_data = list(interventions, mobility)

save(fit, dates, reported_cases, reported_deaths, regions, states, JOBID ,
     estimated_cases_raw, estimated_deaths_raw, estimated_deaths_cf, stan_data, covariate_data,
     file=paste0('results/',StanModel,'-',JOBID,'-stanfit.Rdata'))

source("utils/mobility/plotting/make-plots.r")
make_plots_all(paste0('results/', StanModel, '-', JOBID, '-stanfit.Rdata'),
               last_date_data = max(dates[[1]]))
source("utils/mobility/make-table.r")
# Prints attackrates to console
make_table(paste0('results/', StanModel, '-', JOBID, '-stanfit.Rdata'),
           date_till_percentage = max(dates[[1]]))

# code for scenarios runs only in full mode
if (FULL){
  source("utils/mobility/simulate-regional.r")
  len_forecast <- 8*7

  # Can make plots = TRUE if you want to see 3 panel plots for simulations and rt_plots
  simulate_scenarios(JOBID = JOBID,  StanModel, plots = TRUE, scenario_type = "increase-mob-current", len_forecast = len_forecast,
                     subdir='Italy',
                     simulate_code='Italy/code/stan-models/simulate.stan', mobility_vars=c(1,2,3),
                     mobility_increase = 40)
  simulate_scenarios(JOBID = JOBID,  StanModel, plots = TRUE, scenario_type = "increase-mob-current", len_forecast = len_forecast,
                     subdir='Italy',
                     simulate_code='Italy/code/stan-models/simulate.stan', mobility_vars=c(1,2,3),
                     mobility_increase = 20)
  simulate_scenarios(JOBID = JOBID,  StanModel, plots = TRUE, scenario_type = "constant-mob", len_forecast = len_forecast,
                     subdir='Italy',
                     simulate_code='Italy/code/stan-models/simulate.stan', mobility_vars=c(1,2,3),
                     mobility_increase = 0)

  source("utils/mobility/make-table.r")
  # Prints attack rates to console
  scenario_type = "constant-mob"
  mobility_increase = 0
  make_table_simulation(paste0('results/sim-', scenario_type, "-", StanModel, '-', len_forecast, '-', mobility_increase, '-', JOBID, '-stanfit.Rdata'),
                        date_till_percentage = max(dates[[1]]) + len_forecast)

  source("utils/mobility/plotting/make-scenario-plots-top7.r")

  make_scenario_comparison_plots_mobility(JOBID = JOBID, StanModel, len_forecast = len_forecast,
                                          last_date_data = max(dates[[1]]) + len_forecast, baseline = FALSE,
                                          mobility_increase = 20,top=7)
  make_scenario_comparison_plots_mobility(JOBID = JOBID, StanModel, len_forecast = len_forecast,
                                          last_date_data = max(dates[[1]]) + len_forecast, baseline = FALSE,
                                          mobility_increase = 40,top=7)
  make_scenario_comparison_plots_mobility(JOBID = JOBID, StanModel, len_forecast = len_forecast,
                                          last_date_data = max(dates[[1]]) + len_forecast, baseline = FALSE,
                                          mobility_increase = 20,top=8)
  make_scenario_comparison_plots_mobility(JOBID = JOBID, StanModel, len_forecast = len_forecast,
                                          last_date_data = max(dates[[1]]) + len_forecast, baseline = FALSE,
                                          mobility_increase = 40,top=8)
  make_scenario_comparison_plots_mobility(JOBID = JOBID, StanModel, len_forecast = len_forecast,
                                          last_date_data = max(dates[[1]]) + len_forecast, baseline = FALSE,
                                          mobility_increase = 20,top=9)
  make_scenario_comparison_plots_mobility(JOBID = JOBID, StanModel, len_forecast = len_forecast,
                                          last_date_data = max(dates[[1]]) + len_forecast, baseline = FALSE,
                                          mobility_increase = 40,top=9)
print("Generating covariate size effects plot")
covariate_size_effects_error <- system(paste0("Rscript covariate-size-effects.r ", filename,'-stanfit.Rdata'),intern=FALSE)
if(covariate_size_effects_error != 0){
  stop(sprintf("Error while plotting covariate size effects! Code: %d", covariate_size_effects_error))
}

mu = (as.matrix(out$mu))
colnames(mu) = countries
g = bayesplot::mcmc_intervals(mu,prob = .9)
ggplot2::ggsave(sprintf("results/%s-mu.png",filename),g,width=4,height=6)
tmp = lapply(1:length(countries), function(i) (out$Rt_adj[,stan_data$N[i],i]))
Rt_adj = do.call(cbind,tmp)
colnames(Rt_adj) = countries
g = bayesplot::mcmc_intervals(Rt_adj,prob = .9)
ggsave(sprintf("results/%s-final-rt.png",filename),g,width=4,height=6)

print("Generate 3-panel plots")
plot_3_panel_error <- system(paste0("Rscript plot-3-panel.r ", filename,'-stanfit.Rdata'),intern=FALSE)
if(plot_3_panel_error != 0){
  stop(sprintf("Generation of 3-panel plots failed! Code: %d", plot_3_panel_error))
}

print("Generate forecast plot")
plot_forecast_error <- system(paste0("Rscript plot-forecast.r ",filename,'-stanfit.Rdata'),intern=FALSE)
if(plot_forecast_error != 0) {
  stop(sprintf("Generation of forecast plot failed! Code: %d", plot_forecast_error))
}

print("Make forecast table")
make_table_error <- system(paste0("Rscript make-table.r results/",filename,'-stanfit.Rdata'),intern=FALSE)
if(make_table_error != 0){
  stop(sprintf("Generation of alpha covar table failed! Code: %d", make_table_error))
}

verify_result_error <- system(paste0("Rscript web-verify-output.r ", filename,'.Rdata'),intern=FALSE)
if(verify_result_error != 0){
  stop(sprintf("Verification of web output failed! Code: %d", verify_result_error))
}


library(httr)
library(jsonlite)

setClass("myDate")
setAs("character", "myDate", function(from) as.Date(from, format="%Y%m%d") )

# Helper functions
get_stock_data <- function (stock) {
  rawStats <- GET(paste('https://api.iextrading.com/1.0/stock/', stock, '/stats', sep=''))
  rawFinancials <- GET(paste('https://api.iextrading.com/1.0/stock/', stock, '/financials', sep=''))
  contentStats <- NULL
  contentFinancials <- NULL
  result = tryCatch({
    contentStats <- fromJSON(rawToChar(rawStats$content))
    contentFinancials <- fromJSON(rawToChar(rawFinancials$content))
  }, warning = function(w) {
  }, error = function(e) {
    return(NULL)
    stop()
  }, finally = {
  })
  return(c(contentStats, contentFinancials))
  Sys.sleep(1)
}

get_all_stock_data <- function (csv_file) {
  stocks <- c()
  data <- read.csv(csv_file, head=FALSE, stringsAsFactors=FALSE)
  for (i in data$V1) {
    stock_data <- get_stock_data(i)
    stocks[[i]] <- stock_data
  }
  return(stocks)
}

save_all_stock_data <- function (csv_file, R_filename) {
  stocks <- get_all_stock_data(csv_file)
  saveRDS(stocks, file=R_filename)
}

write_all_stock_data <- function () {
  setwd('./sectors/')
  for (i in list.files()) {
    if (i != 'rstockdata') {
      save_all_stock_data(i, paste('rstockdata/', i, '.rds', sep=''))
    }
  }
  setwd('..')
}

read_stock_data <- function (R_filename) {
  return(readRDS(file=R_filename))
}

# Market Share
# Percent of combined market cap company holds over past three years
#                                                   |-Change in market share

get_total_market_cap <- function (stock_data) {
  total <- 0
  for (i in stock_data) {
    total = total + i$marketcap
  }
  return(total)
}

# Financial Strength
get_average_roa <- function (stock_data) {
  sum <- 0
  count <- 0
  for (i in stock_data) {
    if (class(i$returnOnAssets) == 'numeric') {
      sum = sum + i$returnOnAssets
      count = count + 1
    }
  }
  return(sum/count)
}

get_average_debt_ratio <- function (stock_data) {
  sum <- 0
  count <- 0
  for (i in stock_data) {
    if (!(is.na(i$financials[1, 'totalDebt']) ||
          is.null(i$financials[1, 'totalDebt']) ||
          is.null(i$financials[1, 'totalAssets']) ||
          is.na(i$financials[1, 'totalAssets']))) {
      sum = sum + i$financials[1, 'totalDebt'] / i$financials[1, 'totalAssets']
      count = count + 1
    }
  }
  return(sum/count)
}

get_average_profit_margin <- function (stock_data) {
  sum <- 0
  count <- 0
  for (i in stock_data) {
    if (!(is.na(i$financials[1, 'netIncome']) ||
          is.null(i$financials[1, 'netIncome']) ||
          is.null(i$financials[1, 'totalRevenue']) ||
          is.na(i$financials[1, 'totalRevenue']))) {
      sum = sum + i$financials[1, 'netIncome'] / i$financials[1, 'totalRevenue']
      count = count + 1
    }
  }
  return(sum/count)
}

# Past Growth
get_average_cash_change <- function (stock) {
  mean(as.vector(diff(stock$financials[, 'currentCash'])/c(0, stock$financials[, 'currentCash'], 0))[2:4])
}

get_average_cash_change_sector <- function (stocks) {
  sum <- 0
  count <- 0
  for (stock in stocks) {
    averageCashChangeStock <- get_average_cash_change(stock)
    if (!(is.na(averageCashChangeStock) || is.null(averageCashChangeStock))) {
      sum <- sum + averageCashChangeStock
      count <- count + 1
    }
  }
  return(sum/count)
}

# Innovation
# Percent headlines mentioning company and "new"

get_average_rnd <- function (stock_data) {
  sum <- 0
  count <- 0
  for (i in stock_data) {
    if (!(is.na(i$financials[1, 'researchAndDevelopment']) ||
          is.null(i$financials[1, 'researchAndDevelopment']))) {
      sum = sum + i$financials[1, 'researchAndDevelopment']
      count = count + 1
    }
  }
  return(sum/count)
}

# Business model
# Rated by user for now

#### Prog

if (length(list.files('sectors/rstockdata')) == 0) {
  cat('Gathering stock data...')
  write_all_stock_data()
  cat('done')
}

stockScoresList <- data.frame("Symbol" = "NULL", "Score" = 1, "Industry" = "NULL", stringsAsFactors=FALSE)

for (i in list.files('./sectors/rstockdata')) {
  stocks <- read_stock_data(paste('./sectors/rstockdata/', i, sep=''))
  totalMarketCap <- get_total_market_cap(stocks)
  averageROA <- get_average_roa(stocks)
  averageDebtRatio <- get_average_debt_ratio(stocks)
  averageRnd <- get_average_rnd(stocks)
  averageCashChange <- get_average_cash_change_sector(stocks)
  averageProfitMargin <- get_average_profit_margin(stocks)

  for (stock in stocks) {
    mktShare <- stock$marketcap/totalMarketCap

    cashChange <- (get_average_cash_change(stock) - averageCashChange)/get_average_cash_change(stock)

    debtRatio <- stock$financials[1, 'totalDebt']/stock$financials[1, 'totalAssets']
    useDebt <- !(is.na(stock$financials[1, 'totalDebt']) || is.na(stock$financials[1, 'totalAssets']) || is.null(stock$financials[1, 'totalDebt']) || is.null(stock$financials[1, 'totalAssets']))

    useRnd <- !(is.na(stock$financials[1, 'researchAndDevelopment']) || is.null(stock$financials[1, 'researchAndDevelopment']))

    profitMarginDiff <- stock$financials[1, 'netIncome']/stock$financials[1, 'totalRevenue'] - averageProfitMargin

    if (useRnd && useDebt) {
      rnd <- (stock$financials[1, 'researchAndDevelopment'] - averageRnd)/stock$financials[1, 'researchAndDevelopment']
      roa <- (stock$returnOnAssets - averageROA)/stock$returnOnAssets
      score <- .2 * mktShare + .3 * roa + .1 * cashChange + .1 * debtRatio + .1 * rnd * .2 * profitMarginDiff
    } else if (useRnd && !is.na(profitMarginDiff) && !is.na(cashChange)) {
      rnd <- (stock$financials[1, 'researchAndDevelopment'] - averageRnd)/stock$financials[1, 'researchAndDevelopment']
      roa <- (stock$returnOnAssets - averageROA)/stock$returnOnAssets
      score <- .3 * mktShare + .35 * roa + .1 * cashChange + .1 * rnd + .15 * profitMarginDiff
    } else if (useDebt && !is.na(profitMarginDiff) && !is.na(cashChange)) {
      roa <- (stock$returnOnAssets - averageROA)/stock$returnOnAssets
      score <- .25 * mktShare + .35 * roa + .1 * cashChange + .15 * debtRatio + .15 * profitMarginDiff
    } else {
      score <- NA
      stock$symbol <- NULL
    }

    if (!is.na(score)) {
      listing <- list(stock$symbol, as.numeric(score), i)
      if (!stock$symbol %in% stockScoresList[, "Symbol"]) {
        stockScoresList <- rbind(stockScoresList, listing, stringsAsFactors=FALSE)
      }
    }
  }
}

stockScoresList <- stockScoresList[order(stockScoresList$Score, decreasing=TRUE),]
saveRDS(stockScoresList, file='./output/sortedstocks.RData')


library(dplyr)
library(shiny)
library(plotly)
library(ggplot2)
library(markdown)
library(datasets)

rownames(removes) <- c("2009", "2010", "2011", "2012", "2013", "2014", "2015")
removes[1, 1] = 250000
removes[2, 1] = 333567
removes[3, 1] = 399890
removes[4, 1] = 420033
removes[5, 1] = 345093
removes[6, 1] = 322983
removes[7, 1] = 395402

removes[1, 4] = 12000
removes[2, 4] = 11837
removes[3, 4] = 11272
removes[4, 4] = 11030
removes[5, 4] = 12320
removes[6, 4] = 12320
removes[7, 4] = 11320

rownames(returns) <- c("2009", "2010", "2011", "2012", "2013", "2014", "2015")
return <- read.csv("~/Desktop/Info201/immigration/data/returned.csv", stringsAsFactors = FALSE)
remove <- read.csv("~/Desktop/Info201/immigration/data/removed.csv", stringsAsFactors = FALSE)

return.updated2 <- return[-c(10),]
return.updated <- return.updated2[c(6:10),]

names(return.updated) <- c("Regions", "2009", "2010", "2011", "2012", "2013","2014", "2015")

remove.updated2 <- remove[-c(11),]
remove.updated <- remove.updated2[c(7:11),]
return.updated.year <- select(return.updated,"2009","2010","2011", "2012","2013","2014","2015")

remove.updated.year <- select(remove.updated,"X.9", "X.12","X.15","X.18","X.21","X.24","X.27")
names(remove.updated.year) <- c("2009", "2010", "2011", "2012", "2013", "2014", "2015")

<<<<<<< HEAD
setwd("~/Info201/Immigration")
returned <- read.csv("data/returned.csv", stringsAsFactors = FALSE)
removed <- read.csv("data/removed.csv", stringsAsFactors = FALSE)
colnames(removed)[1] <- "region"
=======
>>>>>>> 129161f28d8a24c8e38470525d6c80b18b4cddf0

##2009 Removed
africa.criminal.2009 <- 718
africa.noncriminal.2009 <- 1304

asia.criminal.2009 <- 1334
asia.noncriminal.2009 <- 4906

europe.criminal.2009 <- 1078
europe.noncriminal.2009 <- 3537

northamerica.criminal.2009 <- 125416
northamerica.noncriminal.2009 <- 240531

southamerica.criminal.2009 <- 3118
southamerica.noncriminal.2009 <- 8951

##2010 Removed
africa.criminal.2010 <- 666
africa.noncriminal.2010 <- 1220

asia.criminal.2010 <- 1559
asia.noncriminal.2010 <- 4665

europe.criminal.2010 <- 1266
europe.noncriminal.2010 <- 2741

northamerica.criminal.2010 <- 162443
northamerica.noncriminal.2010 <- 195649

southamerica.criminal.2010 <- 3500
southamerica.noncriminal.2010 <- 7511

##2011 Removed
africa.criminal.2011 <- 647
africa.noncriminal.2011 <- 1015

asia.criminal.2011 <- 1567
asia.noncriminal.2011 <- 3737

europe.criminal.2011 <- 1236
europe.noncriminal.2011 <- 1999

northamerica.criminal.2011 <- 181887
northamerica.noncriminal.2011 <- 184009

southamerica.criminal.2011 <- 3396
southamerica.noncriminal.2011 <- 5892

##2012 Removed
africa.criminal.2012 <- 673
africa.noncriminal.2012 <- 761

asia.criminal.2012 <- 1469
asia.noncriminal.2012 <- 2862

europe.criminal.2012 <- 1275
europe.noncriminal.2012 <- 1468

northamerica.criminal.2012 <- 193320
northamerica.noncriminal.2012 <- 206206

southamerica.criminal.2012 <- 3204
southamerica.noncriminal.2012 <- 4372

##2013 Removed
africa.criminal.2013 <- 599
africa.noncriminal.2013 <- 615

asia.criminal.2013 <- 1135
asia.noncriminal.2013 <- 2013

europe.criminal.2013 <- 1082
europe.noncriminal.2013 <- 988

northamerica.criminal.2013 <- 193235
northamerica.noncriminal.2013 <- 227223

southamerica.criminal.2013 <- 2721
southamerica.noncriminal.2013 <- 3153

##2014 Removed
africa.criminal.2014 <- 521
africa.noncriminal.2014 <- 745

asia.criminal.2014 <- 1080
asia.noncriminal.2014 <- 1729

europe.criminal.2014 <- 890
europe.noncriminal.2014 <- 827

northamerica.criminal.2014 <- 167622
northamerica.noncriminal.2014 <- 226738

southamerica.criminal.2014 <- 2433
southamerica.noncriminal.2014 <- 2751

##2015 Removed
africa.criminal.2015 <- 380
africa.noncriminal.2015 <- 986

asia.criminal.2015 <- 812
asia.noncriminal.2015 <- 1852

europe.criminal.2015 <- 726
europe.noncriminal.2015 <- 737

northamerica.criminal.2015 <- 135466
northamerica.noncriminal.2015 <- 180578

southamerica.criminal.2015 <- 2087
southamerica.noncriminal.2015 <- 3122

## Africa Returned
africa.return.2009 <- 3073
africa.return.2010 <- 3441
africa.return.2011 <- 2389
africa.return.2012 <- 2389
africa.return.2013 <- 1505
africa.return.2014 <- 1710
africa.return.2015 <- 2187

## Asia Returned
asia.return.2009 <- 53825
asia.return.2010 <- 57788
asia.return.2011 <- 56693
asia.return.2012 <- 46361
asia.return.2013 <- 44554
asia.return.2014 <- 46552
asia.return.2015 <- 45424

## Europe Returned
europe.return.2009 <- 19254
europe.return.2010 <- 18196
europe.return.2011 <- 17185
europe.return.2012 <- 13291
europe.return.2013 <- 12403
europe.return.2014 <- 12159
europe.return.2015 <- 11493

## North America Returned
northamerica.return.2009 <- 501532
northamerica.return.2010 <- 390678
northamerica.return.2011 <- 241927
northamerica.return.2012 <- 166038
northamerica.return.2013 <- 117288
northamerica.return.2014 <- 100139
northamerica.return.2015 <- 67232

## South America Returned
southhamerica.return.2009 <- 3640
southhamerica.return.2010 <- 3139
southhamerica.return.2011 <- 2961
southhamerica.return.2012 <- 2174
southhamerica.return.2013 <- 2222
southhamerica.return.2014 <- 1957
southhamerica.return.2015 <- 2315

## 2009 Graph

Regions <- c("Africa", "Asia", "Europe", "North America", "South America")
remove_criminal_2009 <- c(africa.criminal.2009, asia.criminal.2009, europe.criminal.2009, northamerica.criminal.2009,
                 southamerica.criminal.2009)
remove_noncriminal_2009 <- c(africa.noncriminal.2009, asia.noncriminal.2009, europe.noncriminal.2009,
                             northamerica.noncriminal.2009, southamerica.noncriminal.2009)
return_2009 <- c(africa.return.2009, asia.return.2009, europe.return.2009, northamerica.return.2009, southhamerica.return.2009)
data.2009 <- data.frame(Regions, remove_criminal_2009, remove_noncriminal_2009)

graph.2009 <- plot_ly(data.2009, x = ~Regions, y = ~remove_criminal_2009, type = 'bar', name = 'Removed_Criminals') %>%
  add_trace(y = ~return_2009, name = 'Returned') %>%
  add_trace(y = ~remove_noncriminal_2009, name = 'Removed_NonCriminals') %>%
  layout(title = "2009 Removal Criminal/Non Criminal and Returned", yaxis = list(title = 'Count'), barmode = 'group')
returns <- print(WorldPhones)
removes <- print(WorldPhones)
rownames(removes) <- c("2009", "2010", "2011", "2012", "2013", "2014", "2015")
removes[1, 1] = 250000
removes[2, 1] = 333567
removes[3, 1] = 399890
removes[4, 1] = 420033
removes[5, 1] = 345093
removes[6, 1] = 322983
removes[7, 1] = 395402

removes[1, 4] = 12000
removes[2, 4] = 11837
removes[3, 4] = 11272
removes[4, 4] = 11030
removes[5, 4] = 12320
removes[6, 4] = 12320
removes[7, 4] = 11320
## 2010 Graph

Regions <- c("Africa", "Asia", "Europe", "North America", "South America")
remove_criminal_2010 <- c(africa.criminal.2010, asia.criminal.2010, europe.criminal.2010, northamerica.criminal.2010,
                          southamerica.criminal.2010)
remove_noncriminal_2010 <- c(africa.noncriminal.2010, asia.noncriminal.2010, europe.noncriminal.2010,
                             northamerica.noncriminal.2010, southamerica.noncriminal.2010)
return_2010 <- c(africa.return.2010, asia.return.2010, europe.return.2010, northamerica.return.2010, southhamerica.return.2010)
data.2010 <- data.frame(Regions, remove_criminal_2010, remove_noncriminal_2010)

graph.2010 <- plot_ly(data.2010, x = ~Regions, y = ~remove_criminal_2010, type = 'bar', name = 'Removed_Criminals') %>%
  add_trace(y = ~return_2010, name = 'Returned') %>%
  add_trace(y = ~remove_noncriminal_2010, name = 'Removed_NonCriminals') %>%
  layout(title = "2010 Removal Criminal/Non Criminal and Returned", yaxis = list(title = 'Count'), barmode = 'group')

## 2011 Graph

Regions <- c("Africa", "Asia", "Europe", "North America", "South America")
remove_criminal_2011 <- c(africa.criminal.2011, asia.criminal.2011, europe.criminal.2011, northamerica.criminal.2011,
                          southamerica.criminal.2011)
remove_noncriminal_2011 <- c(africa.noncriminal.2011, asia.noncriminal.2011, europe.noncriminal.2011,
                             northamerica.noncriminal.2011, southamerica.noncriminal.2011)
return_2011 <- c(africa.return.2011, asia.return.2011, europe.return.2011, northamerica.return.2011, southhamerica.return.2011)
data.2011 <- data.frame(Regions, remove_criminal_2011, remove_noncriminal_2011)

graph.2011 <- plot_ly(data.2011, x = ~Regions, y = ~remove_criminal_2011, type = 'bar', name = 'Removed_Criminals') %>%
  add_trace(y = ~return_2011, name = 'Returned') %>%
  add_trace(y = ~remove_noncriminal_2011, name = 'Removed_NonCriminals') %>%
  layout(title = "2011 Removal Criminal/Non Criminal and Returned", yaxis = list(title = 'Count'), barmode = 'group')

## 2012 Graph

Regions <- c("Africa", "Asia", "Europe", "North America", "South America")
remove_criminal_2012 <- c(africa.criminal.2012, asia.criminal.2012, europe.criminal.2012, northamerica.criminal.2012,
                          southamerica.criminal.2012)
remove_noncriminal_2012 <- c(africa.noncriminal.2012, asia.noncriminal.2012, europe.noncriminal.2012,
                             northamerica.noncriminal.2012, southamerica.noncriminal.2012)
return_2012 <- c(africa.return.2012, asia.return.2012, europe.return.2012, northamerica.return.2012, southhamerica.return.2012)
data.2012 <- data.frame(Regions, remove_criminal_2012, remove_noncriminal_2012)

graph.2012 <- plot_ly(data.2012, x = ~Regions, y = ~remove_criminal_2012, type = 'bar', name = 'Removed_Criminals') %>%
  add_trace(y = ~return_2012, name = 'Returned') %>%
  add_trace(y = ~remove_noncriminal_2012, name = 'Removed_NonCriminals') %>%
  layout(title = "2012 Removal Criminal/Non Criminal and Returned", yaxis = list(title = 'Count'), barmode = 'group')

## 2013 Graph

Regions <- c("Africa", "Asia", "Europe", "North America", "South America")
remove_criminal_2013 <- c(africa.criminal.2013, asia.criminal.2013, europe.criminal.2013, northamerica.criminal.2013,
                          southamerica.criminal.2013)
remove_noncriminal_2013 <- c(africa.noncriminal.2013, asia.noncriminal.2013, europe.noncriminal.2013,
                             northamerica.noncriminal.2013, southamerica.noncriminal.2013)
return_2013 <- c(africa.return.2013, asia.return.2013, europe.return.2013, northamerica.return.2013, southhamerica.return.2013)
data.2013 <- data.frame(Regions, remove_criminal_2013, remove_noncriminal_2013)

graph.2013 <- plot_ly(data.2013, x = ~Regions, y = ~remove_criminal_2013, type = 'bar', name = 'Removed_Criminals') %>%
  add_trace(y = ~return_2013, name = 'Returned') %>%
  add_trace(y = ~remove_noncriminal_2013, name = 'Removed_NonCriminals') %>%
  layout(title = "2013 Removal Criminal/Non Criminal and Returned", yaxis = list(title = 'Count'), barmode = 'group')

## 2014 Graph

Regions <- c("Africa", "Asia", "Europe", "North America", "South America")
remove_criminal_2014 <- c(africa.criminal.2014, asia.criminal.2014, europe.criminal.2014, northamerica.criminal.2014,
                          southamerica.criminal.2014)
remove_noncriminal_2014 <- c(africa.noncriminal.2014, asia.noncriminal.2014, europe.noncriminal.2014,
                             northamerica.noncriminal.2014, southamerica.noncriminal.2014)
return_2014 <- c(africa.return.2014, asia.return.2014, europe.return.2014, northamerica.return.2014, southhamerica.return.2014)
data.2014 <- data.frame(Regions, remove_criminal_2014, remove_noncriminal_2014)

graph.2014 <- plot_ly(data.2014, x = ~Regions, y = ~remove_criminal_2014, type = 'bar', name = 'Removed_Criminals') %>%
  add_trace(y = ~return_2014, name = 'Returned') %>%
  add_trace(y = ~remove_noncriminal_2014, name = 'Removed_NonCriminals') %>%
  layout(title = "2014 Removal Criminal/Non Criminal and Returned", yaxis = list(title = 'Count'), barmode = 'group')

## 2015 Graph

Regions <- c("Africa", "Asia", "Europe", "North America", "South America")
remove_criminal_2015 <- c(africa.criminal.2015, asia.criminal.2015, europe.criminal.2015, northamerica.criminal.2015,
                          southamerica.criminal.2015)
remove_noncriminal_2015 <- c(africa.noncriminal.2015, asia.noncriminal.2015, europe.noncriminal.2015,
                             northamerica.noncriminal.2015, southamerica.noncriminal.2015)
return_2015 <- c(africa.return.2015, asia.return.2015, europe.return.2015, northamerica.return.2015, southhamerica.return.2015)
data.2015 <- data.frame(Regions, remove_criminal_2015, remove_noncriminal_2015)

graph.2015 <- plot_ly(data.2015, x = ~Regions, y = ~remove_criminal_2015, type = 'bar', name = 'Removed_Criminals') %>%
  add_trace(y = ~return_2015, name = 'Returned') %>%
  add_trace(y = ~remove_noncriminal_2015, name = 'Removed_NonCriminals') %>%
  layout(title = "2015 Removal Criminal/Non Criminal and Returned", yaxis = list(title = 'Count'), barmode = 'group')


# Plots Figure 1 (number of architecture-specific and architecture-independent builtins per project)

library(ggplot2)
library(reshape)
library(scales)

df1<-read.csv(file="../generated/unique_builtins_per_category.csv",header=TRUE,sep=";")
df1$occurrences <- "unique\noccurrences"
df2<-read.csv(file="../generated/builtins_per_category.csv",header=TRUE,sep=";")
df2$occurrences <- "non-unique\noccurrences"
df<-rbind(df1,df2)
p<-ggplot(df, aes(x=category, y=count)) + geom_boxplot() + scale_y_continuous(trans = 'log10',
                        breaks = trans_breaks('log10', function(x) 10^x),
                        labels = waiver()) + theme_bw() + theme(strip.background = element_blank(), axis.title.x = element_blank(), axis.text = element_text(size = 5), axis.title = element_text(size = 6), strip.text = element_text(size = 6)) + facet_grid(occurrences~., scales="fixed") +
                        coord_flip()
ggsave(filename="../generated/plots/boxplot_unique_cat.pdf", plot=p, width=8.45, height=5, units="cm")


library(plyr)
library(lubridate)
library(ggmap)

raw <- read.csv("data/paulist-chronicles/paulist-missions.csv",
                stringsAsFactors = FALSE)

# Location field for geocoding
raw$location <- paste(raw$city, raw$state)

# Year field
raw$year <- year(mdy(raw$start_date))

# Give approximations of the values "several" and "many"; replace NA with 0
raw$converts[raw$converts == "several"] <- 3
raw$converts[raw$converts == "many"]    <- 7
raw$converts <- as.integer(raw$converts)
raw$converts[is.na(raw$converts)]       <- 0

# Count converts and those left under instruction together
raw$under_instruction <- as.integer(raw$under_instruction)
raw$under_instruction[is.na(raw$under_instruction)]       <- 0
raw$converts_total <- raw$converts + raw$under_instruction

# Geocode
geocoded <- transform(raw, geo = geocode(location))

write.csv(geocoded, "data/paulist-chronicles/paulist-missions.geocoded.csv",
          row.names = FALSE)


# (11) ######### (skip this one)

print("Work on a matrix")
##
ct <- makeCluster(cores)
registerDoParallel(ct)
##
if(!exists("mymean")){mymean=0}
nt<-8
mymat<-matrix(nrow=nt,ncol=nt)
mymat[1:nt,]<-mymean

bsum<-foreach(ijk = 1:nt, .combine=cbind ) %dopar% {
	set.seed(ijk)
# note: the length for rnorm is ignored but needed or you get an error
	mymat[,ijk]<-rnorm(nt,mean=mymat[,ijk])
	junk<-c(length(mymat[,ijk]),sum(mymat[,ijk]))
}
print(bsum)
print(sum(mymat))

stopCluster(ct)
#readline(prompt = "NEXT>")


#!/usr/bin/env Rscript
# Preprocess ship metadata.
# Imputes missing data and derives new columns (e.g. Length, FlagNameBinned)
#
# usage:
#
# Rscript preprocess_metadata.r -i metadata-raw.csv -o metadata-imputed.csv --imputation_method 'rf'
#
library('optparse', warn.conflicts = F, quietly = T)

if(Sys.getenv('R_CLIMATE_TRACE_SHIPPING_HOME') == ''){
  stop('R_CLIMATE_TRACE_SHIPPING_HOME not in environment variables. Please add "R_CLIMATE_TRACE_SHIPPING_HOME=/path/to/r/climate/trace/shipping/repo" to the file .Renviron in your home directory. Read more about the .Renviron file here: https://support.rstudio.com/hc/en-us/articles/360047157094-Managing-R-with-Rprofile-Renviron-Rprofile-site-Renviron-site-rsession-conf-and-repos-conf')
}
CTHOME=Sys.getenv('R_CLIMATE_TRACE_SHIPPING_HOME')

set.seed(123456)

# Define and get commandline options
option_list <- list(
  make_option(c("-i", "--input"),
              help="Input metadata CSV. Must have IMO numbers in first column. [required]"),
  make_option(c("-o", "--output"),
              help = "Output metadata CSV [required]"),
  make_option(c("--imputation_method"), default='rf',
              help="Imputation method: quick (median/mode) or rf (much more accurate but very slow) [default \"%default\"]"),
  make_option(c("-v", "--verbose"), action="store_true", default=FALSE,
              help="Verbose output [default %default]")
)
opt <- parse_args(OptionParser(option_list=option_list))

# check that all required options are provided
required.opts <- c('input','output')
if(any(!(required.opts %in% names(opt)))){
  stop(sprintf('One or more of these required parameters is missing: %s.\n\n', paste(required.opts,collapse=', ')))
}

# Now load other code; waited till here to perform
# input validations first
source(paste(CTHOME,'/lib/load.r',sep=''))
if(opt$imputation_method == 'quick') library('randomForest')
# Create output directory
dir.create(dirname(opt$output),showWarnings = FALSE)

# Run imputation and preprocessing
m.post <- preprocess.ship.metadata(opt$input,
                                   metadata.output.filepath = opt$output,
                                   imputation.method = opt$imputation_method)


pal <- rev(colorRampPalette(RColorBrewer::brewer.pal(11, "Spectral"))(length(q)))

seis <- colorRampPalette(c("darkblue","blue3", "green", "yellow", "orange","red3", "darkred"), space = "Lab")

ocean.pal <- colorRampPalette(c("#000000", "#000413", "#000728", "#002650", "#005E8C",
 				"#0096C8", "#45BCBB", "#8AE2AE", "#BCF8B9", "#DBFBDC"))

land.pal <- colorRampPalette(c("#467832", "#887438", "#B19D48", "#DBC758", "#FAE769",
 				"#FAEB7E", "#FCED93", "#FCF1A7", "#FCF6C1", "#FDFAE0"))


source('amcatr.r')
source('amcat_getdata.r')
source('intermedia_lib.r')

#### WvA: DEZE DEMO WERKT VOLGENS MIJ NIET MEER, HITS/META ZIJN NU SAMEN IN AMCAT.HITS

##### INLOGGEN OP AMCAT #####
conn = amcat.connect('http://amcat.vu.nl') # AmCAT vraagt om je inloggegevens

##### DATA OPHALEN #####
articlesets = c(3321,3322) # hier alle articlesets invoeren: c(articleset1, articleset2, ...)
media = c(999,77,4,6)
from_date='2012-01-01'
to_date='2013-01-01'
queries = c('Frankrijk# frankrijk franse* fransman',
            'Duitsland# duitsland duitse*',
            'Spanje# spanje spanjaard* spaanse')
#queries = getCodebook(conn, codebook_id=157)$queries # Gebruik de queries uit een codebook (uitsluitend voor hippe mensen)

hits = amcat.getHits(conn, queries, articlesets)
meta = amcat.getMeta(conn, articlesets, media, from_date, to_date)

# DETERMINE PUBLICATION TIMES OF MEDIA
mediameta = data.frame(medium_id=unique(meta$medium), medium_string=amcat.getMediumString(unique(meta$medium)))
head(mediameta)
mediameta$pub_hour = c(20,18,6,6) # bepaal hier het uur waarin de artikelen van dit medium gepubliceerd worden. Als het medium geen vaste publicatietijden heeft, dan kan NA gebruikt worden. In dat geval wordt per artikel de publicatietijd zoals opgeslagen in amcat gebruikt.

# PREPARE DATA
intermedia.mediumXweekday(meta) # Als bepaalde media niet op bepaalde dagen vd week publiceren, overweeg dan deze dagen buiten beschouwing te laten middels skip_weekdays.
skip_weekdays = c(7) # Hiermee kun je dagen buiten beschouwing laten (1=maandag, 2=dinsdag, etc). De dag daarvoor wordt dan gebruikt om de lag te berekenen. Bijvoorbeeld, vaak publiceren media niet op zondag, dus deze kun je weglaten met c(7). Het nieuws van maandag wordt dan voorspeld adhv het nieuws op zaterdag.

day_lag = 1 # Aantal dagen lag
split_hours = c(12) # Op de gegeven uren wordt de dag gesplit, om binnen de 24-uursdynamiek intermedia invloed te meten. Bij c(12) wordt bijvoorbeeld de dag gesplit in 0u-12u en 12u-24u
skip_missingdays = TRUE # Als om andere reden nog dagen ontbreken, bijvoorbeeld door een zomerstop van tv of simpelweg gaten in de data, overweeg dan deze dagen uit de analyse weg te laten (met = TRUE) voor alle media.

d = intermedia.prepareData(hits, meta, day_lag=day_lag, split_hours=split_hours, skip_weekdays=skip_weekdays,
                skip_missingdays=skip_missingdays, mediameta=mediameta)

models = intermedia.runAnalysis(d, lag=1, b_digits=2, se_digits=2, random_intercepts=F, binomial=T)

models$models # Toon gegevens per model, inclusief model.fit en verbetering van model door de intermedia variabelen (model.improvement)
intermedia.getRegressionTable(models$coefficients) # Toon resultaten met variabelen in rijen en modellen in kolommen


source("./DataUtil.r")
source("./PlotUtil.r")
nCopies<-5

results <- fndfGetGiantData("./")
# Get fewer columns to work with, easier to see.
dat.shockallcopies <- as.data.frame(fndfGetShockData(results))
dat.shockall <- dat.shockallcopies[dat.shockallcopies$copies>=3
                & dat.shockallcopies$copies<=5,]
dat.shock5.3 <- dat.shockall[dat.shockall$copies==5
                            & dat.shockall$shockspan==3,
                            ]

trows <- dat.shock5.3

    trows50 <- trows[trows$shockimpact==50,]
    trows80 <- trows[trows$shockimpact==80,]
    trows100 <- trows[trows$shockimpact==100,]

    gp <- ggplot(data=NULL, mapping=aes(x=lifem, y=safe(mdmlosspct)))

    gp <- gp +
            geom_point(data=trows50,
                    color="green", size=8, shape=point.DOT) +
            geom_line(data=trows50,
                    linetype="solid", color="green", size=2)

    gp <- gp +
            geom_point(data=trows80,
                    color="blue", size=5, shape=point.TRIANGLE) +
            geom_line(data=trows80,
                    linetype="solid", color="blue", size=2)

    gp <- gp +
            geom_point(data=trows100,
                    color="red", size=3, shape=point.SQUARE) +
            geom_line(data=trows100,
                    linetype="solid", color="red", size=2)

p<-gp

    p <- fnPlotLogScales(p, x='yes', y='yes')

    p <- p + scale_colour_discrete(name="Impact\n(percent)", labels=c("50","80","100"))
    p <- p + geom_hline(yintercept=1.0, linetype="dashed")

    sParams <- sprintf("copies=%s",
                    nCopies)

    p <- fnPlotTitles(p, title=("Shocks " %+% sParams
                %+% ", freq=2yr, dur=1yr"
                %+% ", 50-80-100% G-B-R")
                ,titlesize=16
                ,xlabel="sector half-life (megahours)"
                ,ylabel="percent permanent document losses"
                ,labelsize=14
                )

 plot(p)
 fnPlotMakeFile(p, "Shock_compare_cop5_freq2yr_dur1yr_span3_50-80-100.png")