library(dplyr)

al <- matrix(c(
"A", "AT", "AT", "A",
"A", "AT", "A", "AT",
"A", "AT", "D", "I",
"A", "AT", "I", "D",
"AT", "A", "D", "I",
"AT", "A", "I", "D",
"D", "I", "AT", "A",
"D", "I", "A", "AT",
"I", "D", "AT", "A",
"I", "D", "A", "AT",
"I", "D", "AT", "AT",
"I", "D", "D", "I"
), nrow=4) %>% t

recode_indels_22(al[,1], al[,2], al[,3], al[,4]) %>% cbind(al, .)
recode_indels_21(al[,1], al[,2], al[,3]) %>% cbind(al, .)
recode_indels_12(al[,1], al[,3], al[,4]) %>% cbind(al, .)

a <- extract_instruments(2)
b <- extract_outcome_data(a$SNP, 7)
ab <- harmonise_data(a,b)
mr(ab, method_list="mr_ivw")

a1 <- a
b1 <- b

a1$effect_allele.exposure[1] <- "GAAAA"
b1$other_allele.outcome[23] <- "GAAAA"

ab1 <- harmonise_data(a1,b1)
mr(ab1, method_list="mr_ivw")

a1 <- a
b1 <- b

a1$effect_allele.exposure[1] <- "GAAAA"
b1$other_allele.outcome[23] <- "I"
b1$effect_allele.outcome[23] <- "D"

ab1 <- harmonise_data(a1,b1)
mr(ab1, method_list="mr_ivw")

a1 <- a
b1 <- b

b1$other_allele.outcome <- NA

ab1 <- harmonise_data(a1,b1)
mr(ab1, method_list="mr_ivw")

a1 <- a
b1 <- b

a1$effect_allele.exposure[1] <- "GAAAA"
b1$other_allele.outcome[23] <- "I"
b1$effect_allele.outcome[23] <- "D"
b1$other_allele.outcome <- NA

ab1 <- harmonise_data(a1,b1)
mr(ab1, method_list="mr_ivw")

a1 <- a
b1 <- b

a1$effect_allele.exposure[1] <- "GAAAA"
b1$other_allele.outcome[23] <- "I"
b1$effect_allele.outcome[23] <- "D"
b1$other_allele.outcome <- NA

ab1 <- harmonise_data(a1,b1)
mr(ab1, method_list="mr_ivw")

x <- data.frame(
	SNP=c("a","b", "c", "d", "e", "f"),
	beta=1,
	se=1,
	effect_allele=c("D", "ACTG", "A", "G", "C", "TD"),
	other_allele=c("I", "F", "T", "C", "G", "A"),
	stringsAsFactors=FALSE
)

format_data(x)


## !/user/bin/env RStudio 1.1.423
## -*- coding: utf-8 -*-
## visualization of Shandong province budget

rm(list = ls())
gc()

library("plyr")
library("dplyr")
library("ggplot2")
library("rgdal")
library("Cairo")
library("RColorBrewer")
library("grid")
library("xlsx")
library("showtext")
library("magrittr")
font_add("myfont", "msyh.ttc")

####一、数据处理阶段####

####1.1 处理县级行政区划素材####

shandong_district_data <- read.csv(
  "G:/WorkPlace/R/R/Rstudy/shandong/District.csv",
  stringsAsFactors=FALSE
  )

#以上导入了山东省细化到县级的行政区划名称(所在市、县)、代码(国标统一编码)、以及中心经纬度
#City Country   Code     long      lat
#潍坊市  安丘市 370784 119.2069 36.42742

####################################################################################
#为了方便案例演示，我已经在shandong_district文件中创建了现成的县级行政区的经纬度数据
#如果你想要自己抓取各个县级行政区划的地址，可以利用以下代码进行操纵！
#shandong_district_data <- unite(shandong_district_data,address,City,Name,sep="")
#shandong_district_data <- transform(
#  shandong_district_data,
#  Address = paste0("山东省",address)
#  ) %>% select(c("Address","address","Code","long","lat"))
#shandong_district_data$Address <-  as.character(shandong_district_data$Address)

#library("jsonlite")
#library("httr")
#source("D:/R/web_city_adress.r",encoding = "utf-8")
#result <- GetJD(shandong_district$Address)
######################################################################################

#以下导入山东省各县级行政单位的预算数据：
shandong_zhibiao_data <- read.csv(
  "G:/WorkPlace/R/R/Rstudy/shandong/shddata2.csv",
  stringsAsFactors=FALSE
  )

###字段含义###
#BudgetScale  —— 按公共财政预算收入规模                   【单位（亿元）】
#BudgetGrowth —— 按公共财政预算收入增长幅度               【单位（%）】
#GDPScale     —— 按GDP规模                                【单位（亿元）】
#GDPGrowth    —— 按GDP增长幅度                            【单位（%）】
#PerGDPGrowth —— 按人均GDP                                【单位（万元）】
######

#  City     Address               Country       BudgetScale BudgetGrowth GDPScale GDPGrowth     PerGDPGrowth
#1 滨州市   山东省滨州市滨城区    滨城区        74.2        8.9          606       8.4          8.6
#  城市名称 所在县全程（方便定位）所在区（县）  预算规模    预算增速     GDP规模   GDP增速      人均GDP增速

#将预算指标数据与行政区划数据（含有行政区划坐标点）的数据合并：
shandong_district_data <- merge(
  shandong_district_data,
  shandong_zhibiao_data[,-2],
  by = c("City","Country"),
  all.x = TRUE
  )

#   City Country   Code     long      lat BudgetScale BudgetGrowth GDPScale GDPGrowth PerGDPGrowth
# 滨州市  滨城区 371602 118.0201 37.38484        74.2          8.9      606       8.4          8.6

###读入山东省县级行政区划地图素材：

mymap <- readOGR(
  "G:/WorkPlace/R/R/Rstudy/shandong/map.shp",
  stringsAsFactors= FALSE
  )

xs <- mymap@data %>%
  rename(Code = name) %>%
  mutate(ID=row.names(.)) %>%
  select(c("ID","id"))

shandong_district_map_data <- fortify(mymap) %>%
  left_join(xs,by = c("id" = "ID")) %>%
  rename(Code = id.y) %>% arrange(group,order) %>%
  left_join(shandong_district_data[,c(3,6:10)],by = c("Code"="Code"))

#及时清除不需要的中间缓存表
rm(mymap)
rm(xs)
#释放内存空间

###县级数据汇总：###
#1、shandong_district_data       —— 含行政区划名称、代码、中心经纬度、五个核心预算指标
#2、shandong_district_map_data   —— 含行政区划代码、行政区边界点经纬度数据、以及各区（县）指标

####1.2 处理市级行政区划素材####

#导入山东省市级行政区地图素材
shandong_city_map_data <- readOGR(
  "G:/WorkPlace/R/R/Rstudy/shandong/山东省.json",
  encoding = "utf-8",
  use_iconv = TRUE,
  stringsAsFactors=FALSE
  )

#提取素材中的市级行政区划信息
city_data <- shandong_city_map_data@data %>%
  mutate(id = row.names(.)) %>%
  select(c("id","adcode","name")) %>%
  rename(Code = adcode,City = name)

#将市级行政区划信息合并入市级边界点经纬度坐标数据中：
shandong_city_map_data <-  fortify(shandong_city_map_data) %>%
  merge(city_data,by = "id",all.x = TRUE)
rm(city_data)

##地级市预算指标：
shandongnewdata <- shandong_zhibiao_data %>%
  group_by(City) %>%
  summarize(
    SUM_BudgetScale=sum(BudgetScale),
    SUM_GDPScale=sum(GDPScale)
  )
rm(shandong_zhibiao_data) #后期不再使用，清除掉

#将预算指标合并入各市边界点经纬度数据中
shandong_city_map_data <- merge(
  shandong_city_map_data,
  shandongnewdata,
  by ="City"
  )
rm(shandongnewdata)

#导入各地级市行政区划数据：
shandong_city_data <- read.csv(
  "G:/WorkPlace/R/R/Rstudy/shandong/City.csv",
  stringsAsFactors=FALSE
)

###数据盘点：
#现在所有的数据已经整理完毕，我们一共得到了四个有用的数据集：

#市级地图数据——shandong_city_map_data（含城市指标及边界点经纬度数据）
#市级指标数据——shandong_city_data（含城市中心点经纬度）

#县级地图数据——shandong_district_map_data（含17个地级市指标及边界点经纬度）
#县级指标数据——shandong_district_data（含137个行政县指标及中心点经纬度和五个指标数据，GDP规模、GDP增速，人均GDP增速，预算规模、预算增速）。

#因为地级市数据限制，只有两个指标（GDP规模和预算规模），所以，最多只能制作两张地图。
#县级行政区数据比较齐全，这里计划的呈现的维度是GDP规模与GDP增速，GDP规模与人均GDP增速，GDP增速与人均GDP增速。预算规模和预算增速，合计一共四张图。

######1.3 山东省各地级市预算数据可视化######

####1.3.1 各市GDP分布：####

range(shandong_city_map_data$SUM_GDPScale)
ggplot(shandong_city_map_data,aes(SUM_GDPScale))+
  geom_histogram()
summary(shandong_city_map_data$SUM_GDPScale)
shandong_city_map_data <- shandong_city_map_data %>%
  mutate(
    FA_SUM_GDPScale = cut(
      SUM_GDPScale,
      breaks=c(0,1500,3000,4500,6000,10000),
      labels=c('0~1500','1500~3000','3000~4500','4500~6000','6000~10000'),
      order=TRUE
      )
 )

#CairoPNG(file="GDPScale.png",width=1200,height=640)
#showtext_begin()
ggplot()+
  geom_polygon(data=shandong_city_map_data,aes(x=long,y=lat,group=group,fill=FA_SUM_GDPScale),col="white",size=.2)+
  geom_text(data = shandong_city_data,aes(x=long,y=lat,label= City),family="myfont",fontface="plain",size=6)+
  scale_fill_brewer(palette="Greens")+
  coord_map("polyconic") +
  labs(title="山东省各地级市2016年GDP规模分布",subtitle="单位：（亿元）",caption="数据来源：山东省发展与改革委员会")+
  guides(fill=guide_legend(reverse=TRUE,title=NULL))+
  theme_void() %+replace%
  theme(
    title=element_text(family="myfont",size=18),
    plot.title=element_text(size=24),
    plot.subtitle=element_text(family="myfont",size=18),
    #plot.caption=element_text(family="myfont",size=18),
    legend.text.align=1,
    legend.text=element_text(hjust=-5,size=12),
    legend.position = c(0.08,0.8),
    plot.caption=element_text(hjust=0)
  )
#showtext_end()
#dev.off()

#####1.3.2 各市预算收入规模分布：####
##请根据1.3.1代码，完成山东省各市预算收入规模分布图
range(shandong_city_map_data$SUM_GDPScale)

shandong_city_map_data <- shandong_city_map_data %>%
  mutate(
    FA_SUM_GDPScale = cut(
      SUM_GDPScale,
      breaks=c(0,1500,3000,4500,6000,10000),
      labels=c('0~1500','1500~3000','3000~4500','4500~6000','6000~10000'),
      order=TRUE
    )
  )

#CairoPNG(file="GDPScale222.png",width=1200,height=640)
#showtext_begin()
ggplot()+
  geom_polygon(data=shandong_city_map_data,aes(x=long,y=lat,group=group,fill=FA_SUM_GDPScale),col="white",size=.2)+
  geom_text(data = shandong_city_data,aes(x=long,y=lat,label= City),family="myfont",fontface="plain",size=6)+
  scale_fill_brewer(palette="Greens")+
  coord_map("polyconic") +
  labs(title="山东省各地级市2016年GDP规模分布",subtitle="单位：（亿元）",caption="数据来源：山东省发展与改革委员会")+
  guides(fill=guide_legend(reverse=TRUE,title=NULL))+
  theme_void() %+replace%
  theme(
    title=element_text(family="myfont",size=18),
    plot.title=element_text(size=24),
    plot.subtitle=element_text(family="myfont",size=18),
    #plot.caption=element_text(family="myfont",size=18),
    legend.text.align=1,
    legend.text=element_text(hjust=-5,size=12),
    legend.position = c(0.08,0.8),
    plot.caption=element_text(hjust=0)
  )
#showtext_end()
#dev.off()

#以上是山东省地级市预算指标数据可视化两个维度的全部代码，
#通过2016GDP规模以公共预算支出的规模对比可以发现：
#山东省地区间经济发展水平差异比较大，其中青岛在两个指标上都遥遥领先，
#也是全国为数不多的地级市发展好于省会的城市之一。

######1.4 山东省各区（县）预算数据可视化######

######1.4.1 GDP规模&增速######

#查看下GDP的极差分布：
range(shandong_district_map_data$GDPScale,na.rm = TRUE)

ggplot(shandong_district_map_data,aes(GDPScale))+
  geom_histogram()

shandong_district_map_data$FA_GDPScale <- cut(
  shandong_district_map_data$GDPScale,
  breaks=c(0,300,600,900,1200,3000),
  labels=c('0~300','300~600','600~900','900~1200','1200~3000'),
  order=TRUE
  )
summary(shandong_district_map_data$FA_GDPScale)

text_data <- arrange(shandong_district_data,-GDPScale) %>%
  select(Country,long,lat,GDPScale) %>% top_n(10,GDPScale)

#CairoPNG(file="DistrictGDPScale.png",width=1200,height=640)
#showtext_begin()
ggplot()+
  geom_polygon(data=shandong_district_map_data,aes(x=long,y=lat,group=group,fill=FA_GDPScale),col="grey60",size=.2)+
  # geom_point(data=shandong_district_data,aes(x=long,y=lat,size=GDPGrowth),shape=21,fill="#FB832D",col="#ED7D31",alpha=.6)+ #ED7D31E02939
  # geom_text(data=text_data,aes(x=long,y=lat-.1,label=Country),family="myfont",fontface="plain",size=4)+
  scale_size(range=c(1,8),guide=FALSE)+
  scale_fill_brewer(palette="Greens")+
  coord_map("polyconic") +
  labs(
    title="山东省各行政县（包含县级市）2016年GDP规模&增速分布",
    subtitle="单位：（亿元）",
    caption="数据来源：山东省发展与改革委员会"
    )+
  guides(fill=guide_legend(reverse=TRUE,title=NULL))+
  theme_void() %+replace%
  theme(
    title=element_text(family="myfont",size=18,hjust = 0),
    plot.title=element_text(size=24),
    plot.subtitle=element_text(family="myfont",size=18,hjust = 0),
    #plot.caption=element_text(family="myfont",size=18,hjust = 0),
    legend.text.align=1,
    legend.text=element_text(hjust=0,size=12),
    legend.position = c(0.02,0.8),
    plot.caption=element_text(hjust=0)
  )
#showtext_end()
#dev.off()

######1.4.2 GDP规模&人均GDP增速（对应PDF文件第4张图）######
##请根据1.4.1代码，完成山东省各县区GDP规模&人均GDP增速热力填充图

ggplot()+
  geom_polygon(data=shandong_district_map_data,aes(x=long,y=lat,group=group,fill=FA_GDPScale),col="grey60",size=.2)+
  geom_point(data=shandong_district_data,aes(x=long,y=lat,size=PerGDPGrowth),shape=21,fill="#098154",col="#ED7D31",alpha=.6)+ #ED7D31E02939
  scale_size(range=c(1,8),guide=FALSE)+
  scale_fill_brewer(palette="OrRd")+
  coord_map("polyconic") +
  labs(title="山东省各行政县（包含县级市）2016年GDP规模&人均GDP增速分布",subtitle="单位：（亿元）",caption="数据来源：山东省发展与改革委员会")+
  guides(fill=guide_legend(reverse=TRUE,title=NULL))+
  geom_text(data=text_data,aes(x=long,y=lat-.1,label=Country),family="myfont",fontface="plain",size=4)+
  theme_void() %+replace%
  theme(
    title=element_text(family="myfont",size=18,hjust = 0),
    plot.title=element_text(size=24),
    plot.subtitle=element_text(family="myfont",size=18),
    #plot.caption=element_text(family="myfont",size=18),
    legend.text.align=1,
    legend.text=element_text(hjust=-5,size=12),
    legend.position = c(0.05,0.8),
    plot.caption=element_text(hjust=0)
  )

#####1.4.3 公共预算收入规模&增速(公共预算增速)分布（对应PDF文件第7张图）#####
##请根据1.4.1代码，完成山东省各县区GDP规模&人均GDP增速热力填充图

summary(shandong_district_map_data$BudgetScale)

shandong_district_map_data$FA_BudgetScale <- cut(
  shandong_district_map_data$BudgetScale,
  breaks=c(0,40,80,120,160,240),
  labels=c('0~50','50~100','100~150','150~200','200~250'),
  order=TRUE
)

summary(shandong_district_map_data$FA_BudgetScale)

text1_data <-arrange(shandong_district_data,-BudgetScale) %>%
  select(Country,long,lat,BudgetScale) %>%
  top_n(10,BudgetScale)

summary(shandong_district_data$BudgetGrowth)

ggplot()+
  geom_polygon(data=shandong_district_map_data,aes(x=long,y=lat,group=group,fill=FA_BudgetScale),col="grey60",size=.2)+
  geom_point(data=shandong_district_data,aes(x=long,y=lat,size=abs(BudgetGrowth)),shape=21,fill=ifelse(shandong_district_data$BudgetGrowth>0,"#FB832D","#014D64"),col="#ED7D31",alpha=.6)+
  geom_text(data=text1_data,aes(x=long,y=lat-.1,label=Country),family="myfont",fontface="plain",size=4)+
  scale_size(range=c(1,8),guide=FALSE)+
  scale_fill_brewer(palette="Greens")+
  coord_map("polyconic") +
  labs(
    title="山东省各行政县（包含县级市）2016年公共预算收入规模&增速分布",
    subtitle="单位：（亿元）",
    caption="数据来源：山东省发展与改革委员会"
  )+
  guides(fill=guide_legend(reverse=TRUE,title=NULL))+
  theme_void() %+replace%
  theme(
    title=element_text(family="myfont",size=18,hjust = 0),
    plot.title=element_text(size=24),
    plot.subtitle=element_text(family="myfont",size=18),
    #plot.caption=element_text(family="myfont",size=18),
    legend.text.align=1,
    legend.text=element_text(hjust=-5,size=12),
    panel.grid = element_blank(),
    legend.position = c(0.02,0.8),
    plot.caption=element_text(hjust=0)
  )

#以上三个维度分别展示了山东省各县GDP规模与增速指标、
#GDP规模与人均GDP增速指标、财政公共预算收入与增速指标的分布情况

####1.4.4 各县GDP规模&公共预算收入规模的分布情况（对应PDF文件第6张图）####
#对于每一个点：点的大小表示GDP规模，点的颜色深浅表示公共预算收入

#CairoPNG(file="DistrictGDP&Budget.png",width=1200,height=640)
#showtext_begin()
ggplot()+
  geom_polygon(data=shandong_district_map_data,aes(x=long,y=lat,group=group),col="grey60",fill="white",size=.2)+
  geom_point(data=shandong_district_data,aes(x=long,y=lat,size=GDPScale,fill=BudgetScale),shape=21,col="grey60",alpha=.8)+
  scale_size_area(max_size = 12)+
  scale_fill_gradient2(low="#014D64",mid="grey",high="#C72E29",midpoint=70)+
  coord_map("polyconic") +
  labs(
    title="山东省各行政县（包含县级市）2016年GDP规模&公共预算收入分布",
    subtitle="单位：（亿元）",
    caption="数据来源：山东省发展与改革委员会"
  )+
  annotate("text", x=114.3, y=36.8, label="● 高（预算）", color= "#C72E29", size=6) +
  annotate("text", x=114.3, y=36.6, label="● 低（预算）", color= "#014D64", size=6) +
  theme_void() %+replace%
  theme(
    title=element_text(family="myfont",size=18,hjust = 0),
    plot.title=element_text(size=24),
    plot.subtitle=element_text(family="myfont",size=18),
    #plot.caption=element_text(family="myfont",size=18),
    legend.position = c(0.06,0.8),
    plot.caption=element_text(hjust=0)
  )
#showtext_end()
#dev.off()

####第12章结束######
##################################################################


library(tictoc)
tic() #119.4 sec elapsed
require( gdxrrw )
require( tidyverse )
require(ggplot2)
library(gridExtra)
library(broom)
require( rgdal )
library(rgeos)

# Location of input data, uncomment
# setwd( '' )

# Local location of indus ix model - MAKE SURE TO ADD TO SYSTEM ENVIRONMENT VARIABLES
indus_ix_path = Sys.getenv("INDUS_IX_PATH")
setwd(indus_ix_path)

if (!exists('shiny_mode')) shiny_mode = F

if (shiny_mode){} else {
  dir.create(file.path(indus_ix_path,paste0('plots_',sc)),showWarnings = F )
  setwd(paste0(indus_ix_path,'/plots_',sc))

} #endif

# Basin analyzed
basin = 'Indus'

# Get the relevant data from the gdx output files
scname = c('baseline','multiple_SDG','SDG2','SDG6','SDG7','SDG13')
scen_chk = sapply( scname, function( sss ){ paste( 	'MSGoutput_', sss, '.gdx', sep = '' ) } )

upath = paste( indus_ix_path, '/model/output/', sep='')

# Import results from gdx
igdx( gams_path )
res.list = lapply( scen_chk, function(fpath){ # 65.97 sec elapsed
  vars = c( 'demand_fixed', 'DEMAND', 'CAP_NEW', 'CAP','historical_new_capacity', 'ACT', 'input', 'output', 'inv_cost', 'fix_cost', 'var_cost','EMISS',
            'STORAGE','STORAGE_CHG', 'bound_storage_up','bound_storage_lo')
  gdx_res = lapply( vars, function( vv ){
    tmp = rgdx( paste( upath, fpath, sep = '' ), list( name = vv, form = "sparse" ) )
    names(tmp$uels) = tmp$domains
    rs = data.frame( tmp$val )
    names(rs) = c( unlist( tmp$domains ), 'value' )
    rs[ , which( names(rs) != 'value' ) ] = do.call( cbind, lapply( names( rs )[ which( names(rs) != 'value' ) ], function( cc ){ sapply( unlist( rs[ , cc ] ) , function(ii){ return( tmp$uels[[ cc ]][ ii ] ) } ) } ) )
    return(rs)
  } )
  names(gdx_res) = vars
  return(gdx_res)
} )
names( res.list ) = scen_chk

print('Variables loaded from gdxs')

shiny_vars = c( 'demand_fixed', 'CAP_NEW', 'CAP', 'ACT', 'input', 'output', 'inv_cost', 'EMISS','STORAGE' )

for (vari in shiny_vars){
  assign(paste0(vari,'.shiny'),bind_rows( lapply( scen_chk, function( sc ){

    tmp.df = res.list[[ sc ]][[ paste0(vari) ]]
    tmp.df$scenario = paste0(sc)
    return(tmp.df)
  } ) ) )
}

# run diagnostic first, with 'baseline' and 'multiple_SDG_rxp60
country_sel = c('IND','PAK')
# country_sel = c('AFG','CHN')

g_legend <- function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)}

# specific plots

# Costs
df_cost = df_cost %>%
  mutate(scenario = if_else(scenario == 'multiple_SDG_rcp60','multiple SDG',scenario))
V_ind_pak = ggplot(df_cost %>% filter(country %in% c('IND','PAK') ),aes(x = scenario,y = value,fill = type))+
  geom_bar( stat = "identity", position = "stack", color = 'grey40',size = 0.1) +
  facet_wrap(country~cost,nrow = 1)+ylab('Billion USD per year')+
  scale_fill_manual(values = cost_col)+
  theme_bw()+ theme(axis.title.x = element_blank(),
                    legend.position = 'none')

V_afg = ggplot(df_cost %>% filter(country %in% c('AFG')) %>% mutate(value = 1000*value) ,aes(x = scenario,y = value,fill = type))+
  geom_bar( stat = "identity", position = "stack", color = 'grey40',size = 0.1) +
  facet_wrap(country~cost,nrow = 1)+ylab('Million USD per year')+
  scale_fill_manual(values = cost_col)+
  theme_bw()+ theme(axis.title.x = element_blank(),
                    legend.position = 'none')

V_chn = ggplot(df_cost %>% filter(country %in% c('CHN') ) %>% mutate(value = 1000*value),aes(x = scenario,y = value,fill = type))+
  geom_bar( stat = "identity", position = "stack", color = 'grey40',size = 0.1) +
  facet_wrap(country~cost)+ylab('Million USD per year')+
  scale_fill_manual(values = cost_col)+
  theme_bw()+ theme(axis.title = element_blank(),
                    legend.position = 'none')

V_indus = ggplot(df_cost %>% filter(country %in% c('Indus') ),aes(x = scenario,y = value,fill = type))+
  geom_bar( stat = "identity", position = "stack", color = 'grey40',size = 0.1) +
  facet_wrap(country~cost)+
  scale_fill_manual(values = cost_col)+
  theme_bw()+ theme(axis.title = element_blank())

leg = g_legend(V_indus)
V_indus = V_indus+theme(legend.position = 'none')
grid.arrange(V_ind_pak,V_afg,V_chn,V_indus,leg,
             layout_matrix = rbind(c(1,1,4),c(2,3,5)))

# Land
small_leg_theme =   theme(axis.title.x = element_blank(),
                          legend.position = 'none',
                          line = element_line(size = 0.2),
                          rect = element_rect(size = 0.2),
                          text = element_text(size = 9),
                          axis.text = element_text(size = 8),
                          title = element_text(size = 10),
                          strip.text = element_text(size = 8),
                          legend.key.size = unit(0.5,"lines"))

crop_area_plot_year_IP = crop_area_plot_year %>% filter(country %in% country_sel)
  # mutate(scenario = if_else(scenario == 'MSGoutput_Emission_rcp60.gdx','SDG13',scenario))
maxy = max((crop_area_plot_year_IP %>% group_by(country,year,scenario) %>% summarise(value = sum(value)) %>% ungroup())$value)

for (i in seq_along(scen_chk) )  {

  plist[[i]] = ggplot(crop_area_plot_year_IP %>% filter(scenario == scen_chk[i]),
                      aes(x = year,y = value,fill = factor(type , levels = crop_order$type),alpha = method))+
    geom_bar( stat = "identity", position = "stack") +
    facet_wrap(~country)+ylim(0,maxy)+ylab('Mha')+
    scale_fill_manual(name = 'crop',values = crop_col)+
    scale_alpha_manual(values = c(irrigated = 1,rainfed = 0.5))+
    theme_bw()+ ggtitle(paste0(scname[i]))+
    small_leg_theme

}

for_leg = ggplot(crop_area_plot_year_IP %>% filter(scenario == scen_chk[2]),
                 aes(x = year,y = value,fill = factor(type , levels = crop_order$type),alpha = method))+
  geom_bar( stat = "identity", position = "stack") +
  facet_wrap(~country)+ylim(0,maxy)+ylab('Mha')+
  scale_fill_manual(name = 'crop',values = crop_col)+
  scale_alpha_manual(values = c(irrigated = 1,rainfed = 0.5))+
  theme_bw()+ ggtitle(paste0(scname[i]))+
  small_leg_theme+theme(legend.position = 'bottom')

leg_land = g_legend(for_leg)
V1 = grid.arrange(grobs=plist, ncol = 1)
grid.arrange(V1,leg_land, ncol = 1, heights = c(0.95,0.05))
# save 13x4

# water source,

water_by_source_plot_year_IP = water_by_source_plot_year %>% filter(country %in% country_sel)
  # mutate(scenario = if_else(scenario == 'MSGoutput_Emission_rcp60.gdx','SDG13',scenario))

maxy1 = max((water_by_source_plot_year_IP %>%
               group_by(country,year,scenario) %>% summarise(value = sum(value)) %>% ungroup())$value)

for (i in seq_along(scen_chk) )  {
  plist1[[i]]= ggplot(water_by_source_plot_year_IP %>% filter(scenario == scen_chk[i]),aes(x = year,y = value,fill = type))+
    geom_bar( stat = "identity", position = "stack") +
    facet_wrap(~country)+ylim(0,maxy1)+ylab('MCM')+
    scale_fill_manual(name = 'type',values = water_source_col)+
    theme_bw()+ ggtitle(paste0(scname[i]))+
    theme(axis.title.x = element_blank())+small_leg_theme
}
for_leg =  ggplot(water_by_source_plot_year_IP %>% filter(scenario == scen_chk[2]),aes(x = year,y = value,fill = type))+
  geom_bar( stat = "identity", position = "stack") +
  facet_wrap(~country)+ylim(0,maxy1)+ylab('MCM')+
  scale_fill_manual(name = 'type',values = water_source_col)+
  theme_bw()+ ggtitle(paste0(scname[i]))+
  theme(axis.title.x = element_blank())+small_leg_theme+theme(legend.position = 'bottom')

leg = g_legend(for_leg)
V1 = grid.arrange(grobs=plist1, ncol = 1)
grid.arrange(V1,leg, ncol = 1, heights = c(0.95,0.05))

# energy mix
en_mix_plot_IP = en_mix_plot %>% filter(country %in% country_sel)

maxy = max((en_mix_plot_IP %>% group_by(country,year,scenario) %>%
              summarise(value = sum(value)) %>% ungroup())$value)

for (i in seq_along(scen_chk) )  {
  plist2[[i]] =  ggplot(en_mix_plot_IP %>% filter(scenario == scen_chk[i]) %>%
               group_by(year,type,scenario,country) %>% summarise(value = sum(value)),
             aes(x = year,y = value,fill = factor(type , levels = en_source_order$type)))+
  geom_bar( stat = "identity", position = "stack") +ylab('TWh')+
  facet_wrap(~country)+
  scale_fill_manual(name = 'technology',values = en_source_col)+
  scale_y_continuous(limits = c(0,maxy))+
  theme_bw()+ ggtitle(paste0(scname[i]) )+
  small_leg_theme
}

V2 = ggplot(en_mix_plot_IP %>% filter(scenario == scen_chk[2]) %>%
              group_by(year,type,scenario,country) %>% summarise(value = sum(value)),
            aes(x = year,y = value,fill = factor(type , levels = en_source_order$type)))+
  geom_bar( stat = "identity", position = "stack") +ylab('TWh')+
  facet_wrap(~country)+
  scale_fill_manual(name = 'technology',values = en_source_col)+
  scale_y_continuous(limits = c(0,maxy))+
  theme_bw()+ ggtitle(paste0(scname[2]) )+
  small_leg_theme+theme(legend.position = 'bottom')

leg = g_legend(V2)
V2 = grid.arrange(grobs=plist2, ncol = 1)
grid.arrange(V2,leg, ncol = 1, heights = c(0.95,0.05))


#####################################################################################################
#################### Aim: make a scatterplot of weights
#####################################################################################################
rm(list=ls())
library(tidyr)
library(dplyr)
library(ggplot2)
library(ggrepel)
library(Rcpp)
library(ggpubr)

data.dir <- "C:\\Users\\Magdalena\\demography\\happyindex\\data\\SILC"
setwd(data.dir)

########################################################################################################
#####average weights by country
########################################################################################################
chronicallw <- read.table(file="chronicweights.csv", sep=",", header=TRUE)
selfweights <- read.table(file="selfweights.csv", sep=",", header=TRUE)
GALIallw <- read.table(file="GALIweights.csv", sep=",", header=TRUE)
multiweights <- read.table(file="multiweights.csv", sep=",", header=TRUE)

#average by country
bycountrysr <-  selfweights %>%
  pivot_longer(cols =  SR2:SR5,
               names_to = "sr", values_to = "weight") %>%
  group_by(country,sr) %>%
  summarise(avg = mean(weight)) %>%
  pivot_wider(names_from = sr,
              values_from = avg)

bycountrychr <-  chronicallw %>%
  group_by(country) %>%
  summarise(chr = mean(chronic))

bycountryGALI <-  GALIallw %>%
  pivot_longer(cols = GALI1:GALI2,
               names_to = "GALI", values_to = "weight") %>%
  group_by(country,GALI) %>%
  summarise(avg = mean(weight)) %>%
  pivot_wider(names_from = GALI,
              values_from = avg)

bycountryall <- cbind(bycountrychr,bycountryGALI[,-1],bycountrysr[,-1])
write.table(bycountryall, file="allweightsaver.csv", sep=",")

bycountrymul <-  multiweights %>%
  group_by(country,level) %>%
  summarise(avg = mean(weight)) %>%
  pivot_wider(names_from = level,
              values_from = avg)
write.table(bycountrymul, file="bycountrymul.csv", sep=",")

##############################################################################################
######## plots for average by country
##############################################################################################
allweights <- read.table(file="allweightsaver.csv", sep=",", header=TRUE)

multiw <- read.table(file="bycountrymul.csv", sep=",", header=TRUE)
multiw[multiw <0] <- NA
sellevels <- c("country","X12","X123")
multiw2 <- multiw %>%
  select(sellevels)

allweights <- cbind(allweights,multiw2[,-1])

bycountry <-  allweights %>%
  pivot_longer(cols = c(3:ncol(allweights)),
               names_to = "health", values_to = "weight")

p1 <- ggplot(subset(bycountry, (health=="GALI1"| health=="GALI2")) , aes(chr, weight,col=health, label=country))
p2 <- ggplot(subset(bycountry, (health=="SR2" | health=="SR3")) , aes(chr, weight,col=health, label=country))
p3 <- ggplot(subset(bycountry, (health=="SR4" | health=="SR5")) , aes(chr, weight,col=health, label=country))
p4 <- ggplot(subset(bycountry, (health %in% sellevels)) , aes(chr, weight,col=health, label=country))

dev.off()
pdf(file = "C:/Users/Magdalena/demography/happyindex/figures/weightsc.pdf", width = 10, height = 9)

ggarrange(
  p2 + geom_point()+ # cor1=0.10, cor2=0.37**
      theme(
      panel.background = element_rect(fill = "transparent",colour = NA),
      plot.background = element_rect(fill = "transparent",colour = NA),
      axis.line = element_line(colour = "black", size = 0.5, linetype = "solid"),
  #   legend.title = element_blank(),
      legend.key=element_blank(), legend.position = "top",  legend.background = element_rect(linetype = 1, size = 0.5, colour = 1))+
      scale_color_manual("Self-rated Health",values=c("black", "grey70"), labels=c("Very Good","Good"))+
      xlab("Chronic Diseases Weights")+ xlim(0.78,0.93)+
      scale_y_continuous(name="Self-rated Health Weights", breaks=seq(0.35,0.95,0.2), labels=waiver(), limits=c(0.33,0.95))+
      stat_cor(method="pearson", cor.coef.name="r", r.accuracy=0.01, label.x.npc=0.5, label.y.npc=0.2),

  p3 + geom_point()+ #cor1=0.47**, cor2=0.44**
      theme(
      panel.background = element_rect(fill = "transparent",colour = NA),
      plot.background = element_rect(fill = "transparent",colour = NA),
      axis.line = element_line(colour = "black", size = 0.5, linetype = "solid"),
      legend.key=element_blank(),legend.position = "top", legend.background = element_rect(linetype = 1, size = 0.5, colour = 1))+
      scale_color_manual("Self-rated Health", values=c("black", "grey70"), labels=c("Fair", "Poor"))+
      xlab("Chronic Diseases Weights")+ xlim(0.78,0.93)+
      scale_y_continuous(name="Self-rated Health Weights", breaks=seq(0.35,0.95,0.2), labels=waiver(), limits=c(0.33,0.95))+
      stat_cor(method="pearson", cor.coef.name="r", r.accuracy=0.01, label.x.npc=0.5, label.y.npc=0.95),

  p1 + geom_point()+ #cor1=0.57***, cor2=0.68***
      theme(
      panel.background = element_rect(fill = "transparent",colour = NA),
      plot.background = element_rect(fill = "transparent",colour = NA),
      axis.line = element_line(colour = "black", size = 0.5, linetype = "solid"),
      legend.key=element_blank(), legend.position = "top", legend.background = element_rect(linetype = 1, size = 0.5, colour = 1))+
    scale_color_manual("GALI", values=c("black", "grey70"), labels=c("Moderately Limited", "Severely Limited"))+
    xlab("Chronic Diseases Weights")+ xlim(0.78,0.93)+
    scale_y_continuous(name="GALI Weights", breaks=seq(0.35,0.95,0.2), labels=waiver(), limits=c(0.33,0.95))+
    stat_cor(method="pearson", cor.coef.name="r", r.accuracy=0.01, label.x.npc=0.5, label.y.npc=0.2),

  p4 + geom_point()+ # cor=0.15, cor=0.48**
    theme(
      panel.background = element_rect(fill = "transparent",colour = NA),
      plot.background = element_rect(fill = "transparent",colour = NA),
      axis.line = element_line(colour = "black", size = 0.5, linetype = "solid"),
      legend.key=element_blank(), legend.position = "top", legend.background = element_rect(linetype = 1, size = 0.5, colour = 1))+
    scale_color_manual("Dimensions' Levels:", values=c("black", "grey70"), labels=c("No,Not,Very Good", "Yes,Moderately,Good"))+
    xlab("Chronic Diseases Weights")+ xlim(0.78,0.93)+
    scale_y_continuous(name="Multiple Dimensions Weights", breaks=seq(0.35,0.95,0.2), labels=waiver(), limits=c(0.33,0.95))+
    stat_cor(method="pearson", cor.coef.name="r", r.accuracy=0.01, label.x.npc=0.5, label.y.npc=0.2),
  ncol = 2, nrow = 2)

dev.off()

########################################################################################################
#average by sex - not in tables/graphs
bysexsr <-  selfweights %>%
  pivot_longer(cols = SR2:SR5,
               names_to = "sr", values_to = "weight") %>%
  group_by(sex,sr) %>%
  summarise(avg = mean(weight)) %>%
  pivot_wider(names_from = sr,
              values_from = avg)

bysexchr <-  chronicallw %>%
  group_by(sex) %>%
  summarise(avg = mean(chronic))

bysexGALI <-  GALIallw %>%
  pivot_longer(cols = GALI1:GALI2,
               names_to = "GALI", values_to = "weight") %>%
  group_by(sex,GALI) %>%
  summarise(avg = mean(weight)) %>%
  pivot_wider(names_from = GALI,
              values_from = avg)

bysexmul <-  multiweights %>%
  group_by(sex,level) %>%
  summarise(avg = mean(weight)) %>%
  pivot_wider(names_from = level,
              values_from = avg)


rm(list=ls())
outFile='scRNA_6383'
parSampleFile1='fileList1.txt'
parSampleFile2=''
parSampleFile3=''
parFile1='C:/projects/scratch/cqs/shengq2/annet_kirabo_projects/20210809_6383_scRNA_human/seurat_rawdata/result/scRNA_6383.rawobj.rds'
parFile2=''
parFile3=''

setwd('C:/projects/scratch/cqs/shengq2/annet_kirabo_projects/20210809_6383_scRNA_human/seurat_harmony/result')

source("scRNA_func.r")

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

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

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

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

prefix<-outFile

has_batch_file<-file.exists(parSampleFile2)
npcs<-as.numeric(myoptions$pca_dims)
pca_dims<-1:npcs

rawobj<-readRDS(parFile1)

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

objs<-SplitObject(object = rawobj, split.by = "sample")
rm(rawobj)

obj=do_harmony(objs, by_sctransform, npcs, parSampleFile2)
reduction="harmony"
rm(objs)

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

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

finalList$obj<-obj

finalListFile<-paste0(outFile, ".final.rds")
saveRDS(finalList, file=finalListFile)

output_integraion_dimplot(obj, outFile, has_batch_file)


#' ral_unacclimatized
#'
#' Calculate treshshold of risk realated to wbgt index for unacclimatized people.
#'
#' @param met numeric Metabolic rate in Watt following level of ISO FDIS 7243.
#' @return RAL
#'
#' @author Istituto per la Bioeconomia CNR Firenze Italy  Alfonso Crisci \email{alfonso.crisci@@ibe.cnr.it}
#' @references  Ergonomics of the thermal environment – Assessment of heat stress using the WBGT (wet bulb globe temperature)   index, ISO FDIS 7243 (2016)
#' @keywords  RAL
#' @export
#'
#'
#'
#'

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


# change labels!!!:
# d$orderedFreq = factor(x=freq,c(levels(freq)[2], levels(freq[3], levels(freq)[1]))

theme_set(theme_bw(18))

setwd("/home/caroline/cocolab/overinformativeness/models/basic_level_reference/modelExploration/rscripts")
#setwd("~/cogsci/projects/stanford/projects/overinformativeness/models/basic_level_reference/modelExploration/rscripts")

source("helpers.R")

freqData = read.table(file="../speakerOutput_manipulate_Freq_global.csv",sep=",", header=T, quote="")
head(freqData)
nrow(freqData)

# Add variable with combined freqs of (jeweils) 2 levels: (only looking at those cases where these levels have same freqs)

freqData$freq_basicSuper = ifelse(freqData$freq_basic == freqData$freq_super, freqData$freq_basic, "NaN")
head(freqData)
freqData$freq_subSuper = ifelse(freqData$freq_sub == freqData$freq_super, freqData$freq_sub, "NaN")
head(freqData)
freqData$freq_subBasic = ifelse(freqData$freq_basic == freqData$freq_sub, freqData$freq_basic, "NaN")
head(freqData)

#make new freq datasets where rows are excluded in which the respective 2 levels are not the same
freqDataCombBasicSuper = droplevels(subset(freqData, freq_basicSuper != "NaN"))
head(freqDataCombBasicSuper)
nrow(freqDataCombBasicSuper)

freqDataCombSubSuper = droplevels(subset(freqData, freq_subSuper != "NaN"))
head(freqDataCombSubSuper)
nrow(freqDataCombSubSuper)

freqDataCombSubBasic = droplevels(subset(freqData, freq_subBasic != "NaN"))
head(freqDataCombSubBasic)
nrow(freqDataCombSubBasic)

#freq analysis: freqDataCombBasicSuper

agr = freqDataCombBasicSuper %>%
  select(p_s_sub, p_s_basic, p_s_super, condition, freq_sub, freq_basicSuper) %>%
  gather(Utterance,Mentioned,-condition, -freq_sub, -freq_basicSuper) %>%
  group_by(Utterance,condition, freq_sub, freq_basicSuper) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high
head(agr)

ggplot(agr, aes(x=freq_sub,y=Probability, color=freq_basicSuper, group=freq_basicSuper)) +
  geom_point() +
  geom_line() +
  facet_grid(condition~Utterance)
  theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
ggsave("../graphs/freqExploration_speakerProb_by_condition_by_freq_sub_by_CombBasicSuperfreq.pdf",width=10,height=10)

#freq analysis: freqDataCombSubSuper

agr = freqDataCombSubSuper %>%
  select(p_s_sub, p_s_basic, p_s_super, condition, freq_basic, freq_subSuper) %>%
  gather(Utterance,Mentioned,-condition, -freq_basic, -freq_subSuper) %>%
  group_by(Utterance,condition, freq_basic, freq_subSuper) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high
head(agr)

ggplot(agr, aes(x=freq_basic,y=Probability, color=freq_subSuper, group=freq_subSuper)) +
  geom_point() +
  geom_line() +
  facet_grid(condition~Utterance)
theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
ggsave("../graphs/freqExploration_speakerProb_by_condition_by_freq_basic_by_CombSubSuperfreq.pdf",width=10,height=10)

#freq analysis: freqDataCombSubBasic

agr = freqDataCombSubBasic %>%
  select(p_s_sub, p_s_basic, p_s_super, condition, freq_super, freq_subBasic) %>%
  gather(Utterance,Mentioned,-condition, -freq_super, -freq_subBasic) %>%
  group_by(Utterance,condition, freq_super, freq_subBasic) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high
head(agr)

ggplot(agr, aes(x=freq_super,y=Probability, color=freq_subBasic, group=freq_subBasic)) +
  geom_point() +
  geom_line() +
  facet_grid(condition~Utterance)
theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
ggsave("../graphs/freqExploration_speakerProb_by_condition_by_freq_super_by_CombSubBasicfreq.pdf",width=10,height=10)


# takes g_inputdir,g_filetable and g_outputdir
##
# return sample size plot

message("starting samplesize.r")
count= id_table[,c(1,2)]
for (i in c(1:nrow(id_table))) {
	count [i,3] = 1
}

n <- tapply(count[,3],count$group, sum, na.rm=T)
n <- as.matrix (n)
n <- t(n)

barplot(n, main = "samplesize")


#####################################################################
#						PACOTES/BIBLIOTECAS							#
#####################################################################
install.packages("RColorBrewer")
require("RColorBrewer")
library(ggplot2)
#---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------#
#####################################################################
#								DEFAULT								#
#####################################################################
options(scipen=10)
#---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------#
#####################################################################
#								BANCO								#
#####################################################################
#Carregando o banco e guardando-o na variável “terrorismo”
#Trocar o endereço pela localização do banco no seu respectivo computador
terrorism <- read.csv("C:/Users/ricar/Google Drive/BK_PC/EACH-MQAAE1/MQA_Trabalho/globalterrorismdb_0718dist.csv", header=FALSE)
#---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------#
#####################################################################
#							MISSING DATA							#
#####################################################################

#---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------#
#####################################################################
#						ANÁLISES POR VARIÁVEL						#
#####################################################################
#-------------------------------------------------------------------#
#																	#
#>>>>>>>>>>>>>>>>>>>>		Regiões Atacadas	<<<<<<<<<<<<<<<<<<<<#
#																	#
#-------------------------------------------------------------------#
#-------------------------Grafico de Barras-------------------------#
#-------------------------------------------------------------------#
#Capturando a coluna 11 do banco, criando um sumário da mesma, e delimitando um número máximo de elementos para o sumário
regioes <- summary(terrorism$V11[-1], maxsum = 10)
#Criando um gráfico de barras a partir dos dados da variável “regioes", especificando o título, e as cores de cada barra (delimitadas em um vetor)
barplot(
	regioes,
	main = "Barplot de Atentados Terroristas por Região (1970-2017)",
	las = 2,
	col = c("darkred", "darkblue", "darkgreen", "darkgrey", "saddlebrown", "gold", "darkorange2", "darkorchid", "darkturquoise", "white"),
	names.arg = ""
)
#Criando uma legenda para o gráfico, definindo a posição dela no gráfico, passando os nomes dos elementos do gráfico, e logo após as respectivas cores de cada elemento (delimitadas em um vetor). Também foi especificada a largura da legenda (3), e o tamanho da fonte (0.8)
legend(
	"topright",
	names(regioes),
	fill = c("darkred", "darkblue", "darkgreen", "darkgrey", "saddlebrown", "gold", "darkorange2", "darkorchid", "darkturquoise", "white"),
	text.width = 3,
	cex = 0.8
)
#-------------------------------------------------------------------#
#-------------------------Gráfico de Pizza--------------------------#
#-------------------------------------------------------------------#
pie(
	regioes,
	main = "Gráfico de Setores de Atentados Terroristas por Região (1970-2017)",
	col = c("darkred", "darkblue", "darkgreen", "darkgrey", "saddlebrown", "gold", "darkorange2", "darkorchid", "darkturquoise", "white")
)

#-------------------------------------------------------------------#
#------------------------------Boxplot------------------------------#
#-------------------------------------------------------------------#
regioes <- summary(terrorism$V11[-1])[-8]

boxplot(
	regioes,
	main = "Boxplot de Atentados Terroristas por Região (1970-2017)",
	las = 2
)
#-------------------------------------------------------------------#
#---------Mínimo-1ºQuartil-Mediana-Média-3ºQuartil-Máximo-----------#
#-------------------------------------------------------------------#
summary(
	regioes
)
#-------------------------------------------------------------------#
#--------------------Variancia-Desvio Padrão------------------------#
#-------------------------------------------------------------------#
writeLines(
	paste(
		"Variancia: ", var(regioes),
		"\nDesvio Padrão: ", sd(regioes)
	)
)
#------------------------------------------------------------------------------------------------#
#-------------------------------------------------------------------#
#																	#
#>>>>>>>>>>>>>>>>>>		Atentados por Ano		<<<<<<<<<<<<<<<<<<<<#
#																	#
#-------------------------------------------------------------------#
#-------------------------Grafico de Barras-------------------------#
#-------------------------------------------------------------------#
anos <- summary(terrorism$V2)[-48]
cores <- c()
gerar_grad <- colorRampPalette(c("darkgreen", "gold3", "gold4", "red4", "darkred"))
gradiente <- gerar_grad(47)

for (i in 1:47){
	cores[i] = gradiente[(47/anos["2014"])*anos[i]]
}

barplot(
	anos,
	main = "Barplot de Atentados Terroristas por Ano (1970-2017)",
	las = 2,
	col = cores
)
#-------------------------------------------------------------------#
#-------------------------Gráfico de Pizza--------------------------#
#-------------------------------------------------------------------#
pie(
	anos,
	main = "Gráfico de Setores de Atentados Terroristas por Ano (1970-2017)",
	col = c("darkred", "darkblue", "darkgreen", "darkgrey", "saddlebrown", "gold", "darkorange2", "darkorchid", "darkturquoise", "white")
)
#-------------------------------------------------------------------#
#------------------------------Boxplot------------------------------#
#-------------------------------------------------------------------#
boxplot(
	anos,
	main = "Boxplot de Atentados Terroristas por Ano (1970-2017)",
	las = 2
)
#-------------------------------------------------------------------#
#---------Mínimo-1ºQuartil-Mediana-Média-3ºQuartil-Máximo-----------#
#-------------------------------------------------------------------#
summary(
	anos
)
#-------------------------------------------------------------------#
#--------------------Variancia-Desvio Padrão------------------------#
#-------------------------------------------------------------------#
writeLines(
	paste(
		"Variancia: ", var(anos),
		"\nDesvio Padrão: ", sd(anos)
	)
)
#------------------------------------------------------------------------------------------------#
#-------------------------------------------------------------------#
#																	#
#>>>>>>>>>>>>>>>>>>		Métodos Usados		<<<<<<<<<<<<<<<<<<<<<<<<#
#																	#
#-------------------------------------------------------------------#
#-------------------------Grafico de Barras-------------------------#
#-------------------------------------------------------------------#
metodos <- summary((terrorism[-1,])$V30, maxsum=7)

barplot(
	metodos,
	main = "Barplot de Métodos de Ataque (1970-2017)",
	las = 2,
	col = brewer.pal(n=7, name="Set1"),
	names.arg = ""
)
legend(
	"topright",
	names(metodos),
	fill = brewer.pal(n=7, name="Set1"),
	text.width = 3,
	cex = 1
)

#-------------------------------------------------------------------#
#-------------------------Gráfico de Pizza--------------------------#
#-------------------------------------------------------------------#
pie(
	metodos,
	main = "Gráfico de Setores de Métodos de Ataque (1970-2017)",
	col = brewer.pal(n=7, name="Set1")
)
#-------------------------------------------------------------------#
#------------------------------Boxplot------------------------------#
#-------------------------------------------------------------------#
metodos <- summary((terrorism[-1,])$V30)[-3]

boxplot(
	metodos,
	main = "Boxplot de Métodos de Ataque (1970-2017)",
	las = 2
)
#-------------------------------------------------------------------#
#---------Mínimo-1ºQuartil-Mediana-Média-3ºQuartil-Máximo-----------#
#-------------------------------------------------------------------#
summary(
	metodos
)
#-------------------------------------------------------------------#
#--------------------Variancia-Desvio Padrão------------------------#
#-------------------------------------------------------------------#
writeLines(
	paste(
		"Variancia: ", var(metodos),
		"\nDesvio Padrão: ", sd(metodos)
	)
)
#------------------------------------------------------------------------------------------------#
#-------------------------------------------------------------------#
#																	#
#>>>>>>>>>>>>>>>>>>>>		Objetivos		<<<<<<<<<<<<<<<<<<<<<<<<#
#																	#
#-------------------------------------------------------------------#
#-------------------------Grafico de Barras-------------------------#
#-------------------------------------------------------------------#
objetivos <- summary((terrorism[-1,])$V36, maxsum=14)

barplot(
	objetivos[1:7],
	main = "Barplot dos 7 Maiores Objetivos dos Atentados (1970-2017)",
	las = 2,
	col = brewer.pal(n=7, name="Paired"),
	names.arg = ""
)
legend(
	"topright",
	names(objetivos[1:7]),
	fill = brewer.pal(n=7, name="Paired"),
	text.width = 1.5,
	cex = 1
)

barplot(
	c(objetivos[1],objetivos[8:14]),
	main = "Barplot de Outros Objetivos dos Atentados Comparados ao Maior Objetivo (1970-2017)",
	las = 2,
	col = brewer.pal(n=8, name="Paired"),
	names.arg = ""
)
legend(
	"topright",
	names(c(objetivos[1],objetivos[8:14])),
	fill = brewer.pal(n=8, name="Paired"),
	text.width = 2	,
	cex = 1
)

#-------------------------------------------------------------------#
#-------------------------Gráfico de Pizza--------------------------#
#-------------------------------------------------------------------#
pie(
	c(objetivos[1],objetivos[8:14]),
	main = "Gráfico de Setores de Outros Objetivos dos Atentados Comparados ao Maior Objetivo (1970-2017)",
	col = brewer.pal(n=8, name="Set1")
)
#-------------------------------------------------------------------#
#------------------------------Boxplot------------------------------#
#-------------------------------------------------------------------#
objetivos <- summary((terrorism[-1,])$V36)[-16]

boxplot(
	objetivos,
	main = "Boxplot dos Objetivos dos Ataques (1970-2017)",
	las = 2
)
#-------------------------------------------------------------------#
#---------Mínimo-1ºQuartil-Mediana-Média-3ºQuartil-Máximo-----------#
#-------------------------------------------------------------------#
summary(
	objetivos
)
#-------------------------------------------------------------------#
#--------------------Variancia-Desvio Padrão------------------------#
#-------------------------------------------------------------------#
writeLines(
	paste(
		"Variancia: ", var(objetivos),
		"\nDesvio Padrão: ", sd(objetivos)
	)
)
#------------------------------------------------------------------------------------------------#
#-------------------------------------------------------------------#
#																	#
#>>>>>>>>>>>>>>>>>>>		Mortes por Ano		<<<<<<<<<<<<<<<<<<<<#
#																	#
#-------------------------------------------------------------------#
#-------------------------Grafico de Barras-------------------------#
#-------------------------------------------------------------------#
mortesAno <- c()

for(i in 1970:2017){
    mortesAno[i] = sum(as.numeric(terrorism[terrorism$V2==i,]$V99))
}

cores <- c()
gerar_grad <- colorRampPalette(c("darkgreen", "gold3", "gold4", "red4", "darkred"))
gradiente <- gerar_grad(48)

for (i in 1:48){
	set = ceiling((48/mortesAno[2014])*mortesAno[(i+1969)])
	if (set != 0){
		cores[i] = gradiente[set]
	}
}

barplot(
    mortesAno[1970:2017],
    main = "Barplot de Mortes por Ano (1970-2017)",
    las = 2,
    col = cores,
    names.arg = 1970:2017
)

#-------------------------------------------------------------------#
#------------------------------Grafico------------------------------#
#-------------------------------------------------------------------#
plot(
	mortesAno,
	main = "Gráfico de Mortes por Ano (1970-2017)",
	las = 2,
	xlim = c(1970,2017),
	ylab = "",
	xlab = "",
	type = "l",
	lwd = 2
)

#-------------------------------------------------------------------#
#------------------------------Boxplot------------------------------#
#-------------------------------------------------------------------#
boxplot(
	mortesAno[1970:2017],
	main = "Boxplot de Mortes por Ano (1970-2017)",
	las = 2
)
#-------------------------------------------------------------------#
#---------Mínimo-1ºQuartil-Mediana-Média-3ºQuartil-Máximo-----------#
#-------------------------------------------------------------------#
summary(
	mortesAno[1970:2017]
)
#-------------------------------------------------------------------#
#--------------------Variancia-Desvio Padrão------------------------#
#-------------------------------------------------------------------#
writeLines(
	paste(
		"Variancia: ", var(mortesAno[1970:2017]),
		"\nDesvio Padrão: ", sd(mortesAno[1970:2017])
	)
)
#------------------------------------------------------------------------------------------------#
#-------------------------------------------------------------------#
#																	#
#>>>>>>>>>>>>		Ataques(mult, indiv, suc, doub)		<<<<<<<<<<<<#
#																	#
#-------------------------------------------------------------------#
#-------------------------Graficos de Pizza-------------------------#
#-------------------------------------------------------------------#
atkMult <- summary(terrorism$V26[-1])[-1]

pie(
    atkMult,
    main = "Gráfico de Setores de Atentados Conectados X Atentados Não Conectados (1970-2017)",
    col = c("red3", "green4"),
    labels = c(
    			paste(
    				"Não Conectados: ",
    				round(
    					atkMult[1]/(sum(atkMult[1],atkMult[2]))*100
					), "%"
				),
               paste(
               		"Conectados: ",
                    round(
                    	atkMult[2]/(sum(atkMult[1],atkMult[2]))*100
                	), "%"
               )
          )
)

atkIndiv <- summary(terrorism$V69[-1])

pie(
    atkIndiv,
    main = "Gráfico de Setores de Atentados Individuais X Atentados Coletivos (1970-2017)",
    col = c("red3", "green4"),
    labels = c(
    			paste(
    				"Coletivos: ",
    				round(
    					atkIndiv[1]/(sum(atkIndiv[1],atkIndiv[2]))*100, 3
					), "%"
				),
               paste(
               		"Individuais: ",
                    round(
                    	atkIndiv[2]/(sum(atkIndiv[1],atkIndiv[2]))*100, 3
                	), "%"
               )
          )
)

atkSuc <- summary(terrorism$V27[-1])

pie(
    atkSuc,
    main = "Gráfico de Setores de Atentados Bem Sucedidos X Atentados Mal Sucedidos (1970-2017)",
    col = c("red3", "green4"),
    labels = c(
    			paste(
    				"Mal Sucedidos: ",
    				round(
    					atkSuc[1]/(sum(atkSuc[1],atkSuc[2]))*100
					), "%"
				),
               paste(
               		"Bem Sucedidos: ",
                    round(
                    	atkSuc[2]/(sum(atkSuc[1],atkSuc[2]))*100
                	), "%"
               )
          )
)

atkDoub <- summary(terrorism$V23[-1])[-1]

pie(
    atkDoub,
    main = "Gráfico de Setores de Atentados Duvidosos de Serem Terrorismo (1970-2017)",
    col = c("grey", "red3", "green4"),
    labels = c(
    			paste(
    				"Não Avaliados: ",
    				round(
    					atkDoub[1]/(sum(atkDoub[1],atkDoub[2],atkDoub[3]))*100
					), "%"
				),
    			paste(
    				"Não há Dúvidas: ",
    				round(
    					atkDoub[2]/(sum(atkDoub[1],atkDoub[2],atkDoub[3]))*100
					), "%"
				),
               paste(
               		"Há Dúvidas: ",
                    round(
                    	atkDoub[3]/(sum(atkDoub[1],atkDoub[2],atkDoub[3]))*100
                	), "%"
               )
          )
)
#------------------------------------------------------------------------------------------------#
#-------------------------------------------------------------------#
#																	#
#>>>>>>>>>>>>>>>		Nacionalidade dos Alvos		<<<<<<<<<<<<<<<<#
#																	#
#-------------------------------------------------------------------#
#-------------------------Grafico de Barras-------------------------#
#-------------------------------------------------------------------#
natAlvos <- summary((terrorism[-1,])$V42, maxsum=9)[-9]

barplot(
	natAlvos,
	main = "Barplot das 8 Maiores Nacionalidades Alvos de Atentados (1970-2017)",
	las = 2,
	col = brewer.pal(n=8, name="Dark2"),
	names.arg = ""
)
legend(
	"topright",
	names(natAlvos),
	fill = brewer.pal(n=8, name="Dark2"),
	text.width = 3,
	cex = 0.85
)

#-------------------------------------------------------------------#
#-------------------------Gráfico de Pizza--------------------------#
#-------------------------------------------------------------------#
pie(
	natAlvos,
	main = "Gráfico de Setores das 8 Maiores Nacionalidades dos Alvos de Atentados (1970-2017)",
	col = brewer.pal(n=8, name="Dark2")
)
#-------------------------------------------------------------------#
#------------------------------Boxplot------------------------------#
#-------------------------------------------------------------------#
natAlvos <- summary((terrorism[-1,])$V42, maxsum=220)[-131]

boxplot(
	natAlvos,
	main = "Boxplot das Nacionalidades dos Alvos de Atentados (1970-2017)",
	las = 2
)
#-------------------------------------------------------------------#
#---------Mínimo-1ºQuartil-Mediana-Média-3ºQuartil-Máximo-----------#
#-------------------------------------------------------------------#
summary(
	natAlvos
)
#-------------------------------------------------------------------#
#--------------------Variancia-Desvio Padrão------------------------#
#-------------------------------------------------------------------#
writeLines(
	paste(
		"Variancia: ", var(natAlvos),
		"\nDesvio Padrão: ", sd(natAlvos)
	)
)
#------------------------------------------------------------------------------------------------#
#-------------------------------------------------------------------#
#																	#
#>>>>>>>>>>>>>>>>>>		Grupos Responsáveis		<<<<<<<<<<<<<<<<<<<<#
#																	#
#-------------------------------------------------------------------#
#-------------------------Grafico de Barras-------------------------#
#-------------------------------------------------------------------#
grupos <- sort(summary((terrorism[-1,])$V59, maxsum=4000), decreasing=TRUE)[1:8]

barplot(
	grupos,
	main = "Barplot dos Grupos Responsáveis pelos Atentados (1970-2017)",
	las = 2,
	col = brewer.pal(n=8, name="Dark2"),
	names.arg = ""
)
legend(
	"topright",
	names(grupos),
	fill = brewer.pal(n=8, name="Dark2"),
	text.width = 3,
	cex = 0.85
)

#-------------------------------------------------------------------#
#-------------------------Gráfico de Pizza--------------------------#
#-------------------------------------------------------------------#
grupos <- sort(summary((terrorism[-1,])$V59, maxsum=4000), decreasing=TRUE)[-3538]

pie(
	grupos,
	main = "Gráfico de Setores dos Grupos Responsáveis pelos Atentados (1970-2017)",
	col = brewer.pal(n=10, name="Paired")
)
#-------------------------------------------------------------------#
#------------------------------Boxplot------------------------------#
#-------------------------------------------------------------------#
boxplot(
	grupos,
	main = "Boxplot dos Grupos Responsáveis pelos Atentados (1970-2017)",
	las = 2
)
#-------------------------------------------------------------------#
#---------Mínimo-1ºQuartil-Mediana-Média-3ºQuartil-Máximo-----------#
#-------------------------------------------------------------------#
summary(
	grupos
)
#-------------------------------------------------------------------#
#--------------------Variancia-Desvio Padrão------------------------#
#-------------------------------------------------------------------#
writeLines(
	paste(
		"Variancia: ", var(grupos),
		"\nDesvio Padrão: ", sd(grupos)
	)
)
#------------------------------------------------------------------------------------------------#
#-------------------------------------------------------------------#
#																	#
#>>>>>>>>>>>>>>>>>>>		Tipos de Armas		<<<<<<<<<<<<<<<<<<<<#
#																	#
#-------------------------------------------------------------------#
#-------------------------Grafico de Barras-------------------------#
#-------------------------------------------------------------------#
armas <- sort(summary((terrorism[-1,])$V83), decreasing=TRUE)[-13]

barplot(
	armas,
	main = "Barplot dos Tipos de Armas Usadas (1970-2017)",
	las = 2,
	col = c(brewer.pal(n=10, name="Accent"),"orange","red"),
	names.arg = ""
)
legend(
	"topright",
	names(armas),
	fill = c(brewer.pal(n=10, name="Accent"),"orange","red"),
	text.width = 5.5,
	cex = 0.8
)

#-------------------------------------------------------------------#
#-------------------------Gráfico de Pizza--------------------------#
#-------------------------------------------------------------------#
pie(
	armas,
	main = "Gráfico de Setores dos Tipos de Armas Usadas (1970-2017)",
	col = c(brewer.pal(n=10, name="Accent"),"orange","red")
)
#-------------------------------------------------------------------#
#------------------------------Boxplot------------------------------#
#-------------------------------------------------------------------#
boxplot(
	armas,
	main = "Boxplot dos Tipos de Armas Usadas (1970-2017)",
	las = 2
)
#-------------------------------------------------------------------#
#---------Mínimo-1ºQuartil-Mediana-Média-3ºQuartil-Máximo-----------#
#-------------------------------------------------------------------#
summary(
	armas
)
#-------------------------------------------------------------------#
#--------------------Variancia-Desvio Padrão------------------------#
#-------------------------------------------------------------------#
writeLines(
	paste(
		"Variancia: ", var(armas),
		"\nDesvio Padrão: ", sd(armas)
	)
)
#------------------------------------------------------------------------------------------------#
#-------------------------------------------------------------------#
#																	#
#>>>>>>>>>>>		Mortes/Ano por Atentados/Ano		<<<<<<<<<<<<#
#																	#
#-------------------------------------------------------------------#
#------------------------Grafico de Dispersão-----------------------#
#-------------------------------------------------------------------#
anos <- summary(terrorism$V2)[-48]
anos2[1970:2017] = c(anos[1:33],0,anos[34:47]);

mortesAno <- c()
for(i in 1970:2017){
    mortesAno[i] = sum(as.numeric(terrorism[terrorism$V2==i,]$V99))
}

plot(
	anos2[1970:2017],
	mortesAno[1970:2017],
	ylab = "Mortes por Ano",
	xlab = "Atentados por Ano",
	main = "Gráfico de Dispersão de Mortes/Anos por Atentados/Ano"
)


# Download the ESRI format data
# from http://www.abs.gov.au/AUSSTATS/abs@.nsf/DetailsPage/1270.0.55.003July%202011?OpenDocument
# (Postal Areas ASGS Non ABS Structures Ed 2011 Digital Boundaries in ESRI Shapefile Format )
#   Unzip and rename the folder AUST_postcodes
# (State Suburbs ASGS Non ABS Structures Ed 2011 Digital Boundaries in ESRI Shapefile Format )
#   Unzip and rename AUST_suburbs

library(tidyverse)
library(rgdal)
library(rgeos)

postcode_shapes <- readOGR(dsn="AUST_postcodes", layer="POA_2011_AUST")
suburb_shapes <- readOGR(dsn="AUST_suburbs", layer="SSC_2011_AUST")

# Shrink suburb shapes slightly, so we don't count small overlaps
# angle of 200m [at the equator]
0.2 / (40075/360)
shrunk <- gBuffer(suburb_shapes, byid=TRUE, width=-0.0018)

result <- gIntersects(postcode_shapes, shrunk, byid=TRUE, returnDense=FALSE)

links <- data_frame(postcode_row=seq_along(result), suburb_row=result) %>%
    unnest() %>%
    mutate(
        postcode = postcode_shapes@data$POA_CODE[postcode_row],
        suburb = shrunk@data$SSC_NAME[suburb_row]) %>%
    select(postcode, suburb)

write_csv(links, "postcode_suburb.csv")

# It will also be useful to have an outline of Australia

# Between suburbs and postcodes we appear to cover Australia
boundary <- gUnion(suburb_shapes, postcode_shapes)
sboundary <- gSimplify(boundary, tol=0.01)
fortify(sboundary) %>% filter(long >= 110, long <= 155) %>%
    select(piece, long, lat) %>%
    write_csv("australia_map.csv")

map <- fortify(sboundary)


file<-file.path(data.path,'summary_table_raw.out')
a<-read.table(file,header=TRUE)

        #  NEW                                                   COD WHG HAD POK HER NSA SSA NOP SPR PLE SOL
        #  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,
        #  old                                               COD WHG HAD POK HER SAN NOP SPR PLE SOL
        #  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,
old.new<-c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 17, 18, 19, 20, 21, 99, 24 ,25, 26, 27)

a$Species.n<- old.new[a$Species.n]

write.table(a,file=file,row.names=F)


#' @importFrom dplyr %>%
#' @importFrom raster crop getData merge subset xmax xmin ymin
#' @importFrom utils globalVariables
#' @export
get_bioclim <-
  function(layer, extent, var = "bio") {
    lapply(
      c(xmin, xmax),
      function(x) {
        getData(
          "worldclim",
          var = var,
          res = 0.5,
          lon = do.call(x, list(extent)),
          lat = ymin(extent)
        ) %>%
          crop(extent, snap = "out")
      }
    ) %>%
    do.call(merge, .) %>%
    subset(layer)
  }

globalVariables(".")


## 13022020 CKR
#Figure 1B
library(vegan)
library(ggsci)
library(tidyr)
library(dplyr)
library(stringr)
library(ggplot2)
library(ggpubr)
library(ggsci)

Canada=read.table("../Data/Suppl1_CA_Final.txt",sep="\t",head=T,row.names=1) #read abundances
Canada=t(Canada)
label = read.table("../Data/TariniLabels_edit.txt",sep="\t",h=T) #read labels
label=filter(label,Country=="CA") %>% filter(str_detect(ID,"E90")|Status=="C") #filter for CA subjects, controls and post-treatment cases
Canada=select(data.frame(Canada),as.character(label$ID)) #filter for abundances of subject of interest
#calculate distance and PCoA
dist.mat=vegdist(t(Canada),method="euclidean")
cmds <- cmdscale(dist.mat, k=3, eig=TRUE)
eigen <- cmds$eig / sum(cmds$eig) * 100
data=data.frame(cmds$points,labels=rownames(data.frame(cmds$points)))
#annotate points on PCoA plot
C=as.character(filter(label,Status=="C")$ID)
R=as.character(filter(label,Status=="R")$ID)
N=as.character(filter(label,Status=="NR")$ID)
dat.merged=mutate(data,status=ifelse(labels%in%C,"C",ifelse(labels%in%N,"N","R")))

#plot
ggplot(dat.merged%>%arrange(status), aes(x=-X1, y=X2,col=status), lwd=2) +
    geom_point(size=5,shape=18)+
    labs(x=paste0('PC1 (',round(eigen[1], 1),'%)'),
    y=paste0('PC2 (',round(eigen[2], 1),'%)')) +
    scale_color_manual(values=c("lightblue","red","green"))+
    theme_classic()+border()


library(jsonlite)
library(httr)
library(tidyverse)
library(dplyr)
library(zoo)
library(RcppRoll)

# Read price data from CSV files
df_aapl <- read_csv("./data/aapl.csv", col_names=
                      c("date",
                        "aapl_close",
                        "aapl_high",
                        "aapl_low",
                        "aapl_vol",
                        "aapl_change"), col_types=
                      list(col_date(format="%Y-%m-%d"),
                           col_double(),
                           col_double(),
                           col_double(),
                           col_double(),
                           col_double()), skip=1)

df_cone <- read_csv("./data/cone.csv", col_names=
                      c("date",
                        "cone_close",
                        "cone_high",
                        "cone_low",
                        "cone_vol",
                        "cone_change"), col_types=
                      list(col_date(format="%Y-%m-%d"),
                           col_double(),
                           col_double(),
                           col_double(),
                           col_double(),
                           col_double()), skip=1)

df_fb <- read_csv("./data/fb.csv", col_names=
                      c("date",
                        "fb_close",
                        "fb_high",
                        "fb_low",
                        "fb_vol",
                        "fb_change"), col_types=
                      list(col_date(format="%Y-%m-%d"),
                           col_double(),
                           col_double(),
                           col_double(),
                           col_double(),
                           col_double()), skip=1)

df_goog <- read_csv("./data/goog.csv", col_names=
                      c("date",
                        "goog_close",
                        "goog_high",
                        "goog_low",
                        "goog_vol",
                        "goog_change"), col_types=
                      list(col_date(format="%Y-%m-%d"),
                           col_double(),
                           col_double(),
                           col_double(),
                           col_double(),
                           col_double()), skip=1)

df_govt <- read_csv("./data/govt.csv", col_names=
                      c("date",
                        "govt_close",
                        "govt_high",
                        "govt_low",
                        "govt_vol",
                        "govt_change"), col_types=
                      list(col_date(format="%Y-%m-%d"),
                           col_double(),
                           col_double(),
                           col_double(),
                           col_double(),
                           col_double()), skip=1)

df_vz <- read_csv("./data/vz.csv", col_names=
                      c("date",
                        "vz_close",
                        "vz_high",
                        "vz_low",
                        "vz_vol",
                        "vz_change"), col_types=
                      list(col_date(format="%Y-%m-%d"),
                           col_double(),
                           col_double(),
                           col_double(),
                           col_double(),
                           col_double()), skip=1)

# Read balance sheet data from CSVs
df_aapl_b <- read_csv("./data/AAPL_bsheet.csv", col_names=
                      c("date",
                        "aapl_book",
                        "aapl_outS"), col_types=
                      list(col_date(format="%m/%d/%Y"),
                           col_double(),
                           col_guess()), skip=1)

df_cone_b <- read_csv("./data/CONE_bsheet.csv", col_names=
                      c("date",
                        "cone_book",
                        "cone_outS"), col_types=
                      list(col_date(format="%m/%d/%Y"),
                           col_guess(),
                           col_guess()), skip=1)

df_fb_b <- read_csv("./data/FB_bsheet.csv", col_names=
                      c("date",
                        "fb_book",
                        "fb_outS"), col_types=
                      list(col_date(format="%m/%d/%Y"),
                           col_guess(),
                           col_guess()), skip=1)

df_goog_b <- read_csv("./data/GOOG_bsheet.csv", col_names=
                      c("date",
                        "goog_book",
                        "goog_outS"), col_types=
                      list(col_date(format="%m/%d/%Y"),
                           col_guess(),
                           col_guess()), skip=1)

df_vz_b <- read_csv("./data/VZ_bsheet.csv", col_names=
                      c("date",
                        "vz_book",
                        "vz_outS"), col_types=
                      list(col_date(format="%m/%d/%Y"),
                           col_guess(),
                           col_guess()), skip=1)

# Joining our data into a single dateframe and adding the earliest book
# and outstanding shares data from the balance sheet dataframes
# For convenience, we also simplify our attribute names.
# Lastly, we sort by ascending date

df_aapl <- df_aapl %>%
  full_join(df_aapl_b, by="date") %>%
  dplyr::rename("close"=2, "high"=3, "low"=4, "vol"=5, "change"=6, "book"=7,
                "outS"=8) %>%
  arrange(date)

df_cone <- df_cone %>%
  full_join(df_cone_b, by="date") %>%
  dplyr::rename("close"=2, "high"=3, "low"=4, "vol"=5, "change"=6, "book"=7,
                "outS"=8) %>%
  arrange(date)

df_fb <- df_fb %>%
  full_join(df_fb_b, by="date") %>%
  dplyr::rename("close"=2, "high"=3, "low"=4, "vol"=5, "change"=6, "book"=7,
                "outS"=8) %>%
  arrange(date)

df_goog <- df_goog %>%
  full_join(df_goog_b, by="date") %>%
  dplyr::rename("close"=2, "high"=3, "low"=4, "vol"=5, "change"=6, "book"=7,
                "outS"=8) %>%
  arrange(date)

df_vz <- df_vz %>%
  full_join(df_vz_b, by="date") %>%
  dplyr::rename("close"=2, "high"=3, "low"=4, "vol"=5, "change"=6, "book"=7,
                "outS"=8) %>%
  arrange(date)

# Remove extraneous variables from our workspace
rm(df_aapl_b, df_cone_b, df_fb_b, df_goog_b, df_vz_b)

# Remove all but the change and date for df_govt since we only care about
# its change
df_govt <- df_govt %>%
  select(date, change="govt_change", close="govt_close")

# Replace NA values in the "Book" and "Outstanding Shares" attributes
# with last non-NA value
df_aapl$book <- na.locf(df_aapl$book)
df_aapl$outS <- na.locf(df_aapl$outS)

df_cone$book <- na.locf(df_cone$book)
df_cone$outS <- na.locf(df_cone$outS)

df_fb$book <- na.locf(df_fb$book)
df_fb$outS <- na.locf(df_fb$outS)

df_goog$book <- na.locf(df_goog$book)
df_goog$outS <- na.locf(df_goog$outS)

df_vz$book <- na.locf(df_vz$book)
df_vz$outS <- na.locf(df_vz$outS)

# Since earning reports don't always correspond to trading days, remove
# dates that aren't trading days
df_aapl <- filter(df_aapl, !is.na(close))

df_cone <- filter(df_cone, !is.na(close))

df_fb <- filter(df_fb, !is.na(close))

df_goog <- filter(df_goog, !is.na(close))

df_vz <- filter(df_vz, !is.na(close))

# Calculate our factors
  # Calculate market portfolio of returns and date
df_market <- df_aapl %>%
  select(date, cl_aapl=close, ch_aapl=change) %>%
  right_join(df_cone, by="date") %>%
  select(date, cl_aapl, ch_aapl,
         cl_cone=close, ch_cone=change) %>%
  right_join(df_fb, by="date") %>%
  select(date, cl_aapl, ch_aapl,
         cl_cone, ch_cone,
         cl_fb=close, ch_fb=change) %>%
  right_join(df_goog, by="date") %>%
  select(date, cl_aapl, ch_aapl,
         cl_cone, ch_cone,
         cl_fb, ch_fb,
         cl_goog=close, ch_goog=change) %>%
  right_join(df_vz, by="date") %>%
  select(date, cl_aapl, ch_aapl,
         cl_cone, ch_cone,
         cl_fb, ch_fb,
         cl_goog, ch_goog,
         cl_vz=close, ch_vz=change)

df_market <- df_market %>%
  mutate(cl_market=cl_aapl+cl_cone+cl_fb+cl_goog+cl_vz) %>%
  mutate(w_aapl=cl_aapl/cl_market,
         w_cone=cl_cone/cl_market,
         w_fb=cl_fb/cl_market,
         w_goog=cl_goog/cl_market,
         w_vz=cl_vz/cl_market) %>%
  mutate(ch_market=w_aapl*ch_aapl+
           w_cone*ch_cone+
           w_fb*ch_fb+
           w_goog*ch_goog+
           w_vz*ch_vz) %>%
  mutate(r_market=ch_market/lag(cl_market, 1)) %>%
  select(date, r_market)

# Calculate the daily returns on our risk-free rate (govt)
df_govt <- df_govt %>%
  mutate(r=change/lag(close, 1))

# Calculate the return and excess return for each asset,
# including the market portfolio
get_returns <- function(df) {
  df <- df %>%
    mutate(r=change/lag(close, 1)) %>%
    mutate(r_excess = r-df_govt$r)

}

df_aapl <- get_returns(df_aapl)
df_cone <- get_returns(df_cone)
df_fb <- get_returns(df_fb)
df_goog <- get_returns(df_goog)
df_vz <- get_returns(df_vz)

df_market <- df_market %>%
  mutate(r_excess_market = r_market-df_govt$r)

# Calculate VLVR

get_vlvr <- function(df) {
  df <- df %>%
    right_join(df_market, by="date") %>%
    select(-r_market)
  # Run the regression for the beta
  df_fit <- lm(r_excess~r_excess_market,
               filter(df, date<"2017-01-03"))
  # Fit residual return
  beta <- ((broom::tidy(df_fit))["estimate"])[[1, 1]]
  df <- df %>%
    mutate(r_resid=r_excess-(beta*r_excess_market)) %>%
    select(-r_excess_market)

  # Calculate annual standard deviation of residual returns
  # Calculate rolling annual volume and monthly close
  #   Note that we use a window of 252+1
  # Calculate VLVR
  df <- df %>%
    mutate(r_resid_sd=roll_sdr(r_resid, n=253, fill=NA)) %>%
    mutate(VLVR=log10((roll_sumr(vol, 21)*lag(close, 21)+
                   roll_sumr(lag(vol, 21), 21)*lag(close, 21*2)+
                   roll_sumr(lag(vol, 21*2), 21)*lag(close, 21*3)+
                   roll_sumr(lag(vol, 21*3), 21)*lag(close, 21*4)+
                   roll_sumr(lag(vol, 21*4), 21)*lag(close, 21*5)+
                   roll_sumr(lag(vol, 21*5), 21)*lag(close, 21*6)+
                   roll_sumr(lag(vol, 21*6), 21)*lag(close, 21*7)+
                   roll_sumr(lag(vol, 21*7), 21)*lag(close, 21*8)+
                   roll_sumr(lag(vol, 21*8), 21)*lag(close, 21*9)+
                   roll_sumr(lag(vol, 21*9), 21)*lag(close, 21*10)+
                   roll_sumr(lag(vol, 21*10), 21)*lag(close, 21*11)+
                   roll_sumr(lag(vol, 21*11), 21)*lag(close, 21*12))/r_resid_sd)) %>%
    select(-r_resid, -r_resid_sd)
}

df_aapl <- get_vlvr(df_aapl)
df_cone <- get_vlvr(df_cone)
df_fb <- get_vlvr(df_fb)
df_goog <- get_vlvr(df_goog)
df_vz <- get_vlvr(df_vz)

get_hilo <- function(df) {
  # Calculate HILO factor

    # Calculate lowest and highest price for past trading month for every
    # trading day

  df$m_high <- df %>%
    select(high) %>%
    rollmax(k = 22, na.pad = TRUE, align = "right")

  df$m_low <- df %>%
    select(low) %>%
    mutate(low=-low) %>%
    rollmax(k = 22, na.pad = TRUE, align = "right") * -1

  # Calculate the HILO
  df <- df %>%
    mutate(HILO = log10(m_high/m_low)) %>%
    select(-m_high, -m_low)
}

df_aapl <- get_hilo(df_aapl)
df_cone <- get_hilo(df_cone)
df_fb <- get_hilo(df_fb)
df_goog <- get_hilo(df_goog)
df_vz <- get_hilo(df_vz)

# Calculate RSTR

get_rstr <- function(df) {
  df <- df %>%
     mutate(RSTR_l=
           log10(1+(roll_sumr(change, 21)/lag(close, 21)))+
           log10(1+(roll_sumr(lag(change, 21), 21)/lag(close, 21*2)))+
           log10(1+(roll_sumr(lag(change, 21), 21*2)/lag(close, 21*3)))+
           log10(1+(roll_sumr(lag(change, 21), 21*3)/lag(close, 21*4)))+
           log10(1+(roll_sumr(lag(change, 21), 21*4)/lag(close, 21*5)))+
           log10(1+(roll_sumr(lag(change, 21), 21*5)/lag(close, 21*6)))+
           log10(1+(roll_sumr(lag(change, 21), 21*6)/lag(close, 21*7)))+
           log10(1+(roll_sumr(lag(change, 21), 21*7)/lag(close, 21*8)))+
           log10(1+(roll_sumr(lag(change, 21), 21*8)/lag(close, 21*9)))+
           log10(1+(roll_sumr(lag(change, 21), 21*9)/lag(close, 21*10)))+
           log10(1+(roll_sumr(lag(change, 21), 21*10)/lag(close, 21*11)))+
           log10(1+(roll_sumr(lag(change, 21), 21*11)/lag(close, 21*12)))) %>%
      mutate(RSTR_r=
           log10(1+(roll_sumr(df_govt$change, 21)/lag(df_govt$close, 21)))+
           log10(1+(roll_sumr(lag(df_govt$change, 21), 21)/lag(df_govt$close, 21*2)))+
           log10(1+(roll_sumr(lag(df_govt$change, 21), 21*2)/lag(df_govt$close, 21*3)))+
           log10(1+(roll_sumr(lag(df_govt$change, 21), 21*3)/lag(df_govt$close, 21*4)))+
           log10(1+(roll_sumr(lag(df_govt$change, 21), 21*4)/lag(df_govt$close, 21*5)))+
           log10(1+(roll_sumr(lag(df_govt$change, 21), 21*5)/lag(df_govt$close, 21*6)))+
           log10(1+(roll_sumr(lag(df_govt$change, 21), 21*6)/lag(df_govt$close, 21*7)))+
           log10(1+(roll_sumr(lag(df_govt$change, 21), 21*7)/lag(df_govt$close, 21*8)))+
           log10(1+(roll_sumr(lag(df_govt$change, 21), 21*8)/lag(df_govt$close, 21*9)))+
           log10(1+(roll_sumr(lag(df_govt$change, 21), 21*9)/lag(df_govt$close, 21*10)))+
           log10(1+(roll_sumr(lag(df_govt$change, 21), 21*10)/lag(df_govt$close, 21*11)))+
           log10(1+(roll_sumr(lag(df_govt$change, 21), 21*11)/lag(df_govt$close, 21*12)))) %>%
      mutate(RSTR=RSTR_l-RSTR_r) %>%
      select(-RSTR_l, -RSTR_r)
}

df_aapl <- get_rstr(df_aapl)
df_cone <- get_rstr(df_cone)
df_fb <- get_rstr(df_fb)
df_goog <- get_rstr(df_goog)
df_vz <- get_rstr(df_vz)

# Calculate LNCAP
get_lncap <- function(df) {
  df <- df %>%
    mutate(LNCAP=log10(outS*lag(close, 1)))
}

df_aapl <- get_lncap(df_aapl)
df_cone <- get_lncap(df_cone)
df_fb <- get_lncap(df_fb)
df_goog <- get_lncap(df_goog)
df_vz <- get_lncap(df_vz)

# Calculate LCAPCB
get_lcapcb <- function(df) {
  df <- df %>%
    mutate(LCAPCB=(log10(outS*lag(close, 1)))^(1/3))
}

df_aapl <- get_lcapcb(df_aapl)
df_cone <- get_lcapcb(df_cone)
df_fb <- get_lcapcb(df_fb)
df_goog <- get_lcapcb(df_goog)
df_vz <- get_lcapcb(df_vz)

# Calculate BTOP
get_btop <- function(df) {
  df <- df %>%
    mutate(BTOP=book/(outS*lag(close, 1)))
}

df_aapl <- get_btop(df_aapl)
df_cone <- get_btop(df_cone)
df_fb <- get_btop(df_fb)
df_goog <- get_btop(df_goog)
df_vz <- get_btop(df_vz)

# Approximate Risk-free rate for the day

r_f <- mean((filter(df_govt, date<"2017-01-03"))$r, na.rm=TRUE)

# Trim data and make amenable to regression (get residual factor values)
trim_dat <- function(df) {
  df <- df %>%
    filter(!is.na(VLVR)) %>%
    mutate(VLVR=VLVR-r_f,
           HILO=HILO-r_f,
           RSTR=RSTR-r_f,
           LNCAP=LNCAP-r_f,
           LCAPCB=LCAPCB-r_f,
           BTOP=BTOP-r_f)
}

df_aapl <- trim_dat(df_aapl)
df_cone <- trim_dat(df_cone)
df_fb <- trim_dat(df_fb)
df_goog <- trim_dat(df_goog)
df_vz <- trim_dat(df_vz)

# Create our training and test sets

train_aapl <- filter(df_aapl, date<"2017-01-03")
test_aapl <- filter(df_aapl, date>="2017-01-03")

train_cone <- filter(df_cone, date<"2017-01-03")
test_cone <- filter(df_cone, date>="2017-01-03")

train_fb <- filter(df_fb, date<"2017-01-03")
test_fb <- filter(df_fb, date>="2017-01-03")

train_goog <- filter(df_goog, date<"2017-01-03")
test_goog <- filter(df_goog, date>="2017-01-03")

train_vz <- filter(df_vz, date<"2017-01-03")
test_vz <- filter(df_vz, date>="2017-01-03")

# Fit the results of our regression on the training data onto
# the test dataset
fit_dat <- function(df) {
  md <- broom::tidy(lm(r~VLVR+HILO+RSTR+LNCAP+LCAPCB+BTOP, data=train_fb))
  df$r_pred <- md[[1,2]]+md[[2,2]]*df$VLVR+
    md[[3,2]]*df$HILO+md[[4,2]]*df$RSTR+
    md[[5,2]]*df$LNCAP+md[[6,2]]*df$LCAPCB+
    md[[7,2]]*df$BTOP
  df
}

test_aapl <- fit_dat(test_aapl)
test_cone <- fit_dat(test_cone)
test_fb <- fit_dat(test_fb)
test_goog <- fit_dat(test_goog)
test_vz <- fit_dat(test_vz)

# Remove extraneous variables
rm(train_aapl, train_cone, train_fb, train_goog, train_vz,
   df_aapl, df_cone, df_fb, df_goog, df_govt, df_vz)

# Prune data
test_aapl <- test_aapl %>%
  select(date, "aapl_c"=close, "aapl_r"=r, "aapl_p"=r_pred)
test_cone <- test_cone %>%
  select(date, "cone_c"=close, "cone_r"=r, "cone_p"=r_pred)
test_fb <- test_fb %>%
  select(date, "fb_c"=close, "fb_r"=r, "fb_p"=r_pred)
test_goog <- test_goog %>%
  select(date, "goog_c"=close, "goog_r"=r, "goog_p"=r_pred)
test_vz <- test_vz %>%
  select(date, "vz_c"=close, "vz_r"=r, "vz_p"=r_pred)

# Create portfolio
pfolio <- test_aapl %>%
  right_join(test_cone, by="date") %>%
  right_join(test_fb, by="date") %>%
  right_join(test_goog, by="date") %>%
  right_join(test_vz, by="date") %>%
  slice(seq(1, nrow(test_cone), by=5))

pfolio$val <- NA
pfolio$val[1] <- 1000000
for (i in seq(1, nrow(pfolio)-1)) {
  max_pred=max(pfolio[[i,4]],
               pfolio[[i,7]],
               pfolio[[i,10]],
               pfolio[[i,13]],
               pfolio[[i,16]])
  # AAPL is the max prediction
  if (max_pred==pfolio[[i,4]]) {
    pfolio$val[i+1]=(pfolio$val[i]/pfolio[[i,2]])*pfolio[[i+1,2]]
  } else if (max_pred==pfolio[[i,7]]) {
    pfolio$val[i+1]=(pfolio$val[i]/pfolio[[i,5]])*pfolio[[i+1,5]]
  } else if (max_pred==pfolio[[i,10]]) {
    pfolio$val[i+1]=(pfolio$val[i]/pfolio[[i,8]])*pfolio[[i+1,8]]
  } else if (max_pred==pfolio[[i,13]]) {
    pfolio$val[i+1]=(pfolio$val[i]/pfolio[[i,11]])*pfolio[[i+1,11]]
  } else if (max_pred==pfolio[[i,16]]) {
    pfolio$val[i+1]=(pfolio$val[i]/pfolio[[i,14]])*pfolio[[i+1,14]]
  }
}


dd <- fallRunDSM::params
habitats <- list(
 spawning_habitat = dd$spawning_habitat,
 inchannel_habitat_fry = dd$inchannel_habitat_fry,
 inchannel_habitat_juvenile = dd$inchannel_habitat_juvenile,
 floodplain_habitat = dd$floodplain_habitat,
 weeks_flooded = dd$weeks_flooded
)

x <- load_scenario(scenario = DSMscenario::scenarios$SEVEN, species = 'fr',
                   habitat_inputs = habitats,
                   stochastic = FALSE)

y <- load_scenario(scenario = DSMscenario::scenarios$SEVEN, species = 'fr', habitat_inputs = habitats,
                   stochastic = FALSE)

which(x$floodplain_habitat != y$floodplain_habitat)
which(x$inchannel_habitat_fry != y$inchannel_habitat_fry)


args=commandArgs(T)
cutOff_enhanced<-as.numeric(args[1])
cutOff_coaccess<-as.numeric(args[2])

library(Matrix)
library(parallel)
buenrostro2018Data<-readRDS(paste0("../output/buenrostro2018-snap-full_enh",cutOff_enhanced,".rds"))
labels<-read.table("../input/metadata_buenrostro2018_sorted.tsv",header = TRUE,sep = "\t",check.names = FALSE)
labels<-labels[labels$barcode %in% rownames(buenrostro2018Data),]
crn<-readRDS("../input/conns_buenrostro2018.rds")

positive_crn<-na.omit(crn[crn$coaccess>=cutOff_coaccess,])

func<-function(label){
    barcode<-labels[labels$label == label,]$barcode
    cell_data<-buenrostro2018Data[rownames(buenrostro2018Data) %in% barcode,]
    nonZeroColumnList_cell<-diff(cell_data@p)/nrow(cell_data)
    nonZeroColumnList_cell<-t(as.data.frame(nonZeroColumnList_cell))
    colnames(nonZeroColumnList_cell)<-buenrostro2018Data@Dimnames[[2]]
    for(i in 1:length(positive_crn$coaccess)){
        peak1<-positive_crn$Peak1[i]
        peak2<-as.character(positive_crn$Peak2[i])
        peak1_split<-strsplit(peak1,split = "_")[[1]]
        peak1_left<-as.integer(as.integer(peak1_split[2])/5000)*5000+1
        peak1_right<-as.integer(as.integer(peak1_split[2])/5000)*5000+5000
        peak1<-paste0(peak1_split[1],":",peak1_left,"-",peak1_right)
#         print(peak1)
        peak2_split<-strsplit(peak2,split = "_")[[1]]
        peak2_left<-as.integer(as.integer(peak2_split[2])/5000)*5000+1
        peak2_right<-as.integer(as.integer(peak2_split[2])/5000)*5000+5000
        peak2<-paste0(peak2_split[1],":",peak2_left,"-",peak2_right)
        if(! peak1 %in% buenrostro2018Data@Dimnames[[2]]){
            next
        }
        if(! peak2 %in% buenrostro2018Data@Dimnames[[2]]){
                next
        }
        if(nonZeroColumnList_cell[,peak1]>=cutOff_enhanced){
            cell_data[,peak2] = 1
        }
        if(nonZeroColumnList_cell[,peak2]>=cutOff_enhanced){
            cell_data[,peak1] = 1
        }
    }
    return(cell_data)
}

cl.cores <- detectCores()
cl <- makeCluster(cl.cores-1,type = "FORK")
results <- parLapply(cl, levels(labels$label),  func)
integrated_buenrostro2018Data<-do.call('rbind',results)
stopCluster(cl)

integrated_buenrostro2018Data<-integrated_buenrostro2018Data[order(rownames(integrated_buenrostro2018Data)),]
saveRDS(integrated_buenrostro2018Data,file =paste0('../output/buenrostro2018-snap-full_enh',cutOff_enhanced,"_int",cutOff_coaccess,'.rds'))

print(paste0('enh ',cutOff_enhanced,' and int ',cutOff_coaccess,' is finished!'))


extract.clade.label <- function(tree, node){
  if(!is.vector(node, mode = "character") | length(node) > 1)
    stop("'node' parameter must be a character vector of length 1")

  if(sum(node %in% tree$node.label) == 0)
    stop("tree has not node labels defined in 'node' parameter")

  if(!is.rooted(tree))
    stop("tree must be rooted")

  if(!is.null(tree$edge.length))
    stop("tree must not have edge length")

  # Solve bug reading newick in phytools 0.6
  if(tree$Nnode > length(tree$node.label))
    tree$node.label <- c(tree$node.label, rep('', tree$Nnode - length(tree$node.label)))

  # Reorder tree
  tree <- reorder(tree)

  # number of tips
  not <- length(tree$tip.label)
  # node number
  nn <- which(tree$node.label %in% node) + not

  edge <- tree$edge

  # nodes descendants
  nd <- tmp <- edge[edge[ ,1] %in% nn , 2]
  while(length(tmp) > 0){
    tmp <- edge[edge[ ,1] %in% tmp , 2]
    if(length(tmp) > 0) nd <- c(nd, tmp)
  }
  # tips desdendants
  td <- nd[nd <= not]
  # only nodes descendats
  nd <- nd[nd > not]

  # New tips positions
  newt <- matrix(NA, nrow = not, ncol = 2,
                 dimnames = list(1:not, c('tips', 'new')))
  newt[ ,1] <- 1:not
  newt <- newt[newt[ ,1] %in% td, ]
  newt[ ,2] <- rank(newt[ ,1])

  # New nodes positions
  newn <- matrix(NA, nrow = tree$Nnode, ncol = 2,
                 dimnames = list(1:tree$Nnode, c('nodes', 'new')))
  newn [ ,1] <- 1:tree$Nnode + not
  newn <- newn[newn[ ,1] %in% c(nd, nn), ]
  if(!is.matrix(newn))
    newn <- matrix(newn, nrow = 1, dimnames = list(1, names(newn)))
  newn[ ,2] <- rank(newn[ ,1]) + length(td)

  # Reference table to new nodes positions
  refedge <- rbind(newt, newn)

  newedge <- edge[edge[ ,1] %in% c(nd, nn), ]
  newedge[ ,1] <- refedge[match(newedge[ ,1], refedge[ ,1]) ,2]
  newedge[ ,2] <- refedge[match(newedge[ ,2], refedge[ ,1]) ,2]

  # Update tree
  tree$edge <- newedge
  tree$tip.label <- tree$tip.label[newt[ ,1]]
  tree$node.label <- tree$node.label[newn[ ,1] - not]
  tree$Nnode <- length(tree$node.label)

  return(tree)
}


## Data Tables
# Display your matrices or data.tables in sorting
# and filtering format
install.packages('DT')
library('DT')
datatable(iris, options = list(pageLength = 7))

## Time-series Line Graph
install.packages('dygraphs')
library('dygraphs')
dygraph(nhtemp, main = "New Haven Temperatures") %>%
  dyRangeSelector(dateWindow = c("1926-01-01", "1970-01-01"))

## Scatterplot
devtools::install_github('hrbrmstr/metricsgraphics')
library('metricsgraphics')
mjs_plot(mtcars, x=wt, y=mpg) %>%
  mjs_point(color_accessor=carb, size_accessor=carb) %>%
  mjs_labs(x="Weight of Car", y="Miles per Gallon")

## Network Graph
install.packages('networkD3')
library('networkD3')
data(MisLinks, MisNodes)
forceNetwork(Links = MisLinks, Nodes = MisNodes, Source = "source",
             Target = "target", Value = "value", NodeID = "name",
             Group = "group", opacity = 0.4)

## ThreeJS
install.packages('threejs')
library('threejs')
z <- seq(-10, 10, 0.01)
x <- cos(z*4)
y <- sin(z*4)
scatterplot3js(x,y,z, color=rainbow(length(z)))

## Diagrams and Flowcharts
install.packages('DiagrammeR')
library('DiagrammeR')

grViz("
  digraph {
    layout = twopi
    node [shape = circle]
    A -> {B C D}
  }")


source('topics.r')

library('topicmodels')

print( commandArgs(trailingOnly=TRUE) )

for( path in commandArgs(trailingOnly=TRUE) ) {

  print( paste( path , 'best.rdata', sep ='' )  )

  ## load( paste( path , 'best.rdata', sep ='' ) )
  load( path )
  ls()
  write.csv( topics( model, 1 ), file = paste( path , 'topic_assigments.csv', sep ='' ) )

}


library("quantmod")
library("ggplot2")
library("RColorBrewer")
library("reshape2")
library("plyr")
library("scales")
library("reshape")
args <- commandArgs()

#throughput
mydata = read.csv(args[5], check.names="FALSE",sep=",",header=T)
nc=ncol(mydata)
mydata<-mydata[,1:nc-1]
colnames(mydata)[1] <- "updates"
dat<-melt(mydata,id=c("updates"),variable_name="S")
dat$experiment<-apply(dat,1,function(row) "Throughput")
dat <- transform(dat, value = value /100)
dat$val2=dat$value

#scalability
mydata2 = read.csv(args[6], check.names="FALSE",sep=",",header=T)
nc=ncol(mydata2)
mydata2<-mydata2[,1:nc-1]
colnames(mydata2)[1] <- "updates"
dat2<-melt(mydata2,id=c("updates"),variable_name="S")
dat2$experiment<-apply(dat2,1,function(row) "Scalability")
dat2$val2=dat2$value

#get latency
mydata3 = read.csv(args[7], check.names="FALSE",sep=",",header=T)
nc=ncol(mydata3)
mydata3<-mydata3[,1:nc-1]
colnames(mydata3)[1] <- "updates"
dat3<-melt(mydata3,id=c("updates"),variable_name="S")
dat3$experiment<-apply(dat3,1,function(row) "Get Lat.")
dat3$val2=1/dat3$value

#put latency
mydata4 = read.csv(args[8], check.names="FALSE",sep=",",header=T)
nc=ncol(mydata4)
mydata4<-mydata4[,1:nc-1]
colnames(mydata4)[1] <- "updates"
dat4<-melt(mydata4,id=c("updates"),variable_name="S")
dat4$experiment<-apply(dat4,1,function(row) "Put Lat.")
dat4$val2=1/dat4$value

#rem latency
mydata5 = read.csv(args[9], check.names="FALSE",sep=",",header=T)
nc=ncol(mydata5)
mydata5<-mydata5[,1:nc-1]
colnames(mydata5)[1] <- "updates"
dat5<-melt(mydata5,id=c("updates"),variable_name="S")
dat5$experiment<-apply(dat5,1,function(row) "Rem Lat.")
dat5$val2=1/dat5$value

total <- rbind(dat5, dat4, dat3, dat2, dat)

myBreaks=c(0, 0.33, 0.50, 0.75, 0.85, 0.97, 1.03, 1.1, 1.3, 1.5, 2, Inf)
col = brewer.pal(11,"RdYlGn")
total$rat3=findInterval(total$val2, myBreaks, all.inside = TRUE)
print(args[10])
print(total)
label_text <- rollapply(round(myBreaks, 2), width = 2, by = 1, FUN = function(i) paste(i, collapse = " : "))

pdf(args[10], height=5, width=15)
myplot <- ggplot(total, aes(factor(S), factor(updates), fill = factor(rat3,levels=c("1","2","3","4","5","6","7","8","9","10","11")))) +
  geom_tile(colour = "white") +
#geom_text(size=3,aes(fill=factor(total$rat3,levels=c("1","2","3","4","5","6","7","8","9","10","11")), label = round(total$val2,2))) +
  facet_grid(.~experiment) +
  scale_fill_manual(values = col, name="Ratios", labels = label_text, drop=FALSE) +
  labs(title = args[11]) +
  xlab("cores") +
  ylab("update ratio")

print(myplot)
dev.off()


# svmperf

  if (length(unique(Multi_datainput_m$groupingvar)) == 3) { # case of 3 groups

    source ("Rcode/svm3groups.r") # this one filter the data for 2 groups and run the svm on these 2 groups, then give 2x2 differences (3 results as there are 3 couples possible).
    # returns p1, p2, p3

  } else if(length(unique(Multi_datainput_m$groupingvar)) == 2){   # case of 2 groups
    source ("Rcode/multidimensional_analysis_svm.r") # returns Accuracy (text), Accuracyreal = kappa of result of svm prediction on the test data

    source ("Rcode/multidimensional_analysis_perm_svm.r") # returns Acc_sampled
  } else {print ("something strange happen, is there only one group?") # more than 3 groups should make this code not run.
  }


#' Get the most abundant taxa from a phyloseq object (https://rdrr.io/github/gmteunisse/Fantaxtic/src/R/get_top_taxa.R)
#'
#' This function subsets a phyloseq object to the top \eqn{n} most abundant
#' taxa. Users can choose whether to select by absolute counts or relative
#' counts, and whether to discard or collapse remaining taxa.
#'
#' @param physeq_obj A phyloseq object with an \code{otu_table} and a
#' \code{tax_table}.
#' @param n The number of top taxa to subset to.
#' @param relative Select taxa based on relative abundance?
#' (default = \code{TRUE})
#' @param discard_other Discard remainig taxa? (default = \code{FALSE})
#' @param other_label Label to give to collapsed taxa.
#' @return A phyloseq object
#' @examples
#' data(GlobalPatterns)
#' get_top_taxa(GlobalPatterns, 10)
#' get_top_taxa(GlobalPatterns, 10, relative = FALSE)
#' get_top_taxa(GlobalPatterns, 10, relative = TRUE, discard_other = TRUE)
#' get_top_taxa(GlobalPatterns, 10, relative = TRUE, other_label = "Non-abundant taxa")
#' @export
get_top_taxa <- function(physeq_obj, n, relative = TRUE, discard_other = FALSE, other_label = "Other"){

  #Define a temporary physeq object
  ps_tmp <- physeq_obj

  #Check for 0 entries
  smpl_sms <- phyloseq::sample_sums(ps_tmp)
  if (0 %in% smpl_sms){
    stop("Error: some samples contain 0 reads. These have to be removed to avoid
            downstream problems.")
  }

  #Extract the otu_table as a data.frame
  otu_tbl <- phyloseq::otu_table(ps_tmp)
  if (!phyloseq::taxa_are_rows(ps_tmp)){
    otu_tbl <- t(otu_tbl)
  }

  #Use relative abundances if requested
  if (relative){
    otu_tbl <- apply(otu_tbl, 2, function(x){
      x / sum (x)
    })
  }

  #Update the phyloseq object
  phyloseq::otu_table(ps_tmp) <- phyloseq::otu_table(otu_tbl, taxa_are_rows = T)

  #Get the top taxa names and discard or merge other taxa
  abun_taxa <- names(sort(phyloseq::taxa_sums(ps_tmp), decreasing = TRUE)[1:n])
  if (discard_other){
    physeq_obj <- phyloseq::prune_taxa(abun_taxa, physeq_obj)
  } else {
    to_merge <- phyloseq::taxa_names(physeq_obj)
    to_merge <- to_merge[!(to_merge %in% abun_taxa)]
    physeq_obj <- merge_taxa(physeq_obj, to_merge)
    tax_tbl <- phyloseq::tax_table(physeq_obj)
    indx <- which(row.names(tax_tbl) %in% to_merge)
    tax_tbl[indx,] <- other_label
    phyloseq::tax_table(physeq_obj) <- tax_tbl
  }
  return(physeq_obj)
}


runtime <- "201303242306"

library(chron)
library(zoo)
png(paste("AAPL_plot_", runtime, ".png", sep=""), width=5000, height=1024)
prices <- read.table(paste("AAPL_series_", runtime, ".csv", sep=""), header=T, sep=",")
trades <- read.table(paste("AAPL_trades_", runtime, ".csv", sep=""), header=T, sep=",")
zooPrices <- read.zoo(paste("AAPL_series_", runtime, ".csv", sep=""), header = TRUE, sep = ",", FUN=as.chron)
indexes = 1:nrow(prices)
prices$Index <- indexes

library(zoo)
coreZooPrices <- zoo(coredata(zooPrices))
plot(prices$Index, prices$Price, type="l", xlab="Date", ylab="Price", xaxt="n")
ind <- seq(1, length(zooPrices), by=240)
axis(1, time(coreZooPrices)[ind], lab = format(time(zooPrices))[ind], tcl = 0.3)

rectColors = ifelse(trades$Profit > 0, rgb(0,1,0,0.2), rgb(1,0,0,0.2))

rect(xleft=trades$OpenIndex, xright=trades$CloseIndex, ytop=10000000, ybottom=-10000000, col=rectColors, border=NA)

texty = min(prices$Price) + (max(prices$Price)-min(prices$Price))/2
tradeLabels = sprintf("%s - %s, %.2f - %.2f: $%.2f", trades$Open, trades$Close, trades$OpenPrice, trades$ClosePrice, trades$Profit);
text(trades$OpenIndex + (trades$CloseIndex-trades$OpenIndex)/2, texty, labels=tradeLabels, srt=90, col='blue')

dev.off()


needed_packages <- c(
  "tidyverse"
  , "lubridate"
  , "EpiEstim"
  , "incidence"
  , "projections"
  , "epitrix"
  , "distcrete")

lapply(needed_packages, function(x) { if(!require(x,character.only = TRUE)) install.packages(x)} )

# Datos de Casos de Gobierno Nacional
#

csv_fname1 <- "Data/Covid19Casos.csv"

url <- "https://sisa.msal.gov.ar/datos/descargas/covid-19/files/Covid19Casos.csv"

if( Sys.which("wget")!="" ) {
  setwd("Data")
  system(paste("wget -q -N", url))
  setwd("..")
} else {
  download.file(url, destfile = csv_fname1)
}
cor <- read.csv(csv_fname1,stringsAsFactors = FALSE,fileEncoding = "ISO-8859-1",skipNul = TRUE)
names(cor)
corConf <- cor %>% filter(clasificacion_resumen=="Confirmado") %>% mutate_at(vars(starts_with("fecha")),ymd) %>% mutate( hospitalizado=!is.na(fecha_internacion))

str(corConf)
unique(cor$clasificacion_resumen)
unique(cor$clasificacion)
unique(cor$residencia_provincia_nombre)
unique(cor$residencia_provincia_id)

CABA <- corConf %>% filter(carga_provincia_nombre=="CABA") %>% mutate(dias_hosp = fecha_internacion-fecha_inicio_sintomas, hospitalizado= !is.na(fecha_internacion) )

(corConf %>% filter(hospitalizado) %>% group_by(carga_provincia_nombre,fallecido) %>% summarise(edad=median(edad, na.rm = TRUE),n=n()) %>%mutate(freq = n / sum(n) * 100))

(corConf %>% group_by(carga_provincia_nombre,hospitalizado) %>% summarise(n=n()) %>%mutate(freq = n / sum(n) * 100)) %>% filter(hospitalizado)

corConf %>% filter(hospitalizado) %>% group_by(carga_provincia_nombre, cuidado_intensivo) %>% summarise(n=n()) %>%mutate(freq = n / sum(n) * 100)

#%>% mutate( importado=grepl("VIAJE", antecedente_epidemiologico)) %>% mutate(group=if_else(importado,"imported","local"))

cor_incidence_obj <- corConf  %>% select(group,fecha)

cor_incidence_obj <- incidence::incidence(cor_incidence_obj$fecha,groups=cor_incidence_obj$group, last_date=max(cor$ultima_actualizacion))

estima_Re_from_df(cor_incidence_obj,"TDF")


#' @export
print.strata <- function (x, ...) {
    out.table <- matrix(nrow = length(x$Wh), ncol = 7, dimnames = list(NULL,
        c("Strata", "Sets", "Wh", "Mean", "Std. Err.", "RE(%)","Sets.w.Spec")))
    out.table[, 1] <- sort(unique(x$Strata))
    out.table[, 2] <- x$nh
    out.table[, 3] <- x$Wh
    out.table[, 4] <- as.vector(sapply(x$yhi, mean))
    out.table[, 5] <- sqrt(as.vector(sapply(x$yhi, var))/x$nh)
    out.table[, 6] <- 'Not.Est'#(100 * out.table[, 5])/out.table[, 4] #turned off relative efficiency
    out.table[, 7] <- x$nhws
    options(digits = 4)
    print(out.table)
    invisible(out.table)
}