setwd('D:\\Pathway_prediction\\Co_expression_20180123')
dat = read.table("Cufflink_matrix_sample_name_20180123.txt", sep="\t", row.names=1,head=T,stringsAsFactors=F)
dat <- dat[,order(colnames(dat))]
#############################################################################
### mutation
### 2012_TFL
res_mutation_FPKM <- c()
subdat <- dat[,21:24]
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2014_rin_FUL1_2
subdat <- dat[,323:340]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2015_biosynthesis
subdat <- dat[,351:362]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2015_MSH1
subdat <- dat[,571:582]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2016_SlRBZ
subdat <- dat[,777:784]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2013_P450
subdat <- dat[,113:184]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2014_GLK
subdat <- dat[,198:265]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2015_AGO1
subdat <- dat[,341:344]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2015_ARF3
subdat <- dat[,347:350]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2016_CsMYBF1
subdat <- dat[,700:703]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2016_sulfurea
subdat <- dat[,785:792]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2017_ltm
subdat <- dat[,795:806]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2017_sldml2
subdat <- dat[,869:871]
colnames(subdat)
colnames(subdat)[1:2] <- substr(colnames(subdat)[1:2],1,nchar(colnames(subdat)[1:2])-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2017_ys
subdat <- dat[,896:901]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

### 2014_leaf_dev
subdat <- dat[,c(266:271,290:292)]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,out)
		colnames(res_mutation_FPKM) <- col_name} else {
		col_name <- c(colnames(res_mutation_FPKM),sam[i])
		res_mutation_FPKM <- cbind(res_mutation_FPKM,tem)
		colnames(res_mutation_FPKM) <- col_name}}

rownames(res_mutation_FPKM) <- rownames(dat)
write.table(res_mutation_FPKM,'Results_median_FPKM_for_mutation_Sly_20180125.txt',quote=F,sep='\t')

#############################################################################
### hormone
### 2013_ABA
res_hormone_FPKM <- c()
subdat <- dat[,25:31]
colnames(subdat)
colnames(subdat)[1] <- substr(colnames(subdat)[1],1,nchar(colnames(subdat)[1])-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,out)
		colnames(res_hormone_FPKM) <- col_name} else {
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,tem)
		colnames(res_hormone_FPKM) <- col_name}}

### 2013_cytokinin
subdat <- dat[,59:76]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-4)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,out)
		colnames(res_hormone_FPKM) <- col_name} else {
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,tem)
		colnames(res_hormone_FPKM) <- col_name}}

### 2013_cytokinin_auxin
subdat <- dat[,77:112]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-4)
colnames(subdat)[c(3,4,7,8,11,12,15,16,19,20,23,24,27,28,31,32,35,36)] <- substr(colnames(subdat)[c(3,4,7,8,11,12,15,16,19,20,23,24,27,28,31,32,35,36)],1,nchar(colnames(subdat)[c(3,4,7,8,11,12,15,16,19,20,23,24,27,28,31,32,35,36)])-1)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,out)
		colnames(res_hormone_FPKM) <- col_name} else {
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,tem)
		colnames(res_hormone_FPKM) <- col_name}}

### 2015_proGRAS
subdat <- dat[,593:600]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,out)
		colnames(res_hormone_FPKM) <- col_name} else {
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,tem)
		colnames(res_hormone_FPKM) <- col_name}}

### 2017_TIBA
subdat <- dat[,872:877]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,out)
		colnames(res_hormone_FPKM) <- col_name} else {
		col_name <- c(colnames(res_hormone_FPKM),sam[i])
		res_hormone_FPKM <- cbind(res_hormone_FPKM,tem)
		colnames(res_hormone_FPKM) <- col_name}}

rownames(res_hormone_FPKM) <- rownames(dat)
write.table(res_hormone_FPKM,'Results_median_FPKM_for_hormone_Sly_20180125.txt',quote=F,sep='\t')

#############################################################################
### environmental, stress, non-stress
### 2013_bacterial
res_stress_FPKM <- c()
subdat <- dat[,32:58]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2014_pathogen
subdat <- dat[,296:322]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_cold
subdat <- dat[,448:450]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_DC3000
subdat <- dat[,451:462]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_fungal
subdat <- dat[,477:479]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2016_A2AS_heat
subdat <- dat[,672:679]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2016_shade_sun
subdat <- dat[,744:776]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2013_TYLCV
subdat <- dat[,185:188]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_light
subdat <- dat[,480:570]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_pollen_heat
subdat <- dat[,583:592]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_T3
subdat <- dat[,613:618]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2016_AvrPto_pathogen
subdat <- dat[,680:699]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2017_fungi
subdat <- dat[,793:794]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2017_pathosystem
subdat <- dat[,807:862]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2017_PSTVd
subdat <- dat[,863:868]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

### 2015_circadian
subdat <- dat[,363:447]
colnames(subdat)
colnames(subdat) <- gsub('B', 'A', colnames(subdat))
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,out)
		colnames(res_stress_FPKM) <- col_name} else {
		col_name <- c(colnames(res_stress_FPKM),sam[i])
		res_stress_FPKM <- cbind(res_stress_FPKM,tem)
		colnames(res_stress_FPKM) <- col_name}}

rownames(res_stress_FPKM) <- rownames(dat)
write.table(res_stress_FPKM,'Results_median_FPKM_for_stress_Sly_20180125.txt',quote=F,sep='\t')

#############################################################################
### developmental
### 2015_circadian
### see in stress

### 2014_GLK
res_develop_FPKM <- c()
subdat <- dat[,198:265]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2015_fruit
subdat <- dat[,463:476]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2012_fruit_dev
subdat <- dat[,1:20]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2014_leaf_dev
subdat <- dat[,272:295]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2015_anther
subdat <- dat[,345:346]
colnames(subdat)
#colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2016_early_fruit
subdat <- dat[,704:719]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2014_ARF
subdat <- dat[,189:197]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2015_root
subdat <- dat[,601:612]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2015_time_course
subdat <- dat[,619:665]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2015_trichome
subdat <- dat[,666:671]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2016_inflorescence
subdat <- dat[,732:743]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2016_fruit_ripening
subdat <- dat[,720:731]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

### 2017_yield
subdat <- dat[,878:895]
colnames(subdat)
colnames(subdat) <- substr(colnames(subdat),1,nchar(colnames(subdat))-2)
colnames(subdat)
sam <- unique(colnames(subdat))
for(i in 1:length(sam)){
	tem <- subdat[,colnames(subdat)==sam[i]]
	out <- c()
	if(length(tem) < 100){
		for(j in 1:nrow(tem)){
			out <- c(out,median(as.numeric(tem[j,])))}
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,out)
		colnames(res_develop_FPKM) <- col_name} else {
		col_name <- c(colnames(res_develop_FPKM),sam[i])
		res_develop_FPKM <- cbind(res_develop_FPKM,tem)
		colnames(res_develop_FPKM) <- col_name}}

rownames(res_develop_FPKM) <- rownames(dat)
write.table(res_develop_FPKM,'Results_median_FPKM_for_development_Sly_20180125.txt',quote=F,sep='\t')

res1 <- cbind(res_mutation_FPKM,res_hormone_FPKM)
res1 <- cbind(res1,res_stress_FPKM)
res1 <- cbind(res1,res_develop_FPKM)
write.table(res1,'Results_median_FPKM_for_all_Sly_20180125.txt',quote=F,sep='\t')


##Shape=vector
##Rinde=field Shape
##output_plots_to_html
##showplots

myshp <- as_Spatial(Shape)
hist(na.omit(myshp@data[,Rinde]),xlab = "Rendimiento", ylab="Frecuencia",main="Histograma datos rendimiento",breaks=25,cex.lab=1.5,cex.axis=1.5,cex.main=1.5)


# run tarjan with igraph
# this part detects proper dead-ends and writes a CSV with the component identity for each edge
# dead-ending segments have component = -1

# name of the region/city table
city = 'helsinki'

modes = c('car','bike','foot')

# connect to database
library("RPostgreSQL")
driver <- dbDriver("PostgreSQL")
connection <- dbConnect(driver, dbname="", password="", user="", host="")

# load the graph library
library('igraph')

# run for each mode
for(mode in modes){

	print(paste('constructing the',city,mode,'graph...'))

	# data goes here
	output_file = paste0('~/AAG2016/data/out/',city,'_',mode,'_out.csv')

	# get only the edges for the current mode
	if(mode=='car'){
		where_statement = 'WHERE flags % 2 = 1;'
	}else if(mode=='bike'){
		where_statement = "WHERE flags IN (2,3,6,7);"
	}else if(mode=='foot'){
		where_statement = "WHERE flags >= 4;"
	}

	# get the relevant edges
	d <- dbGetQuery(connection,
		paste0(
			"SELECT source, target, km AS weight ",
			"FROM ",city," ",
			where_statement
		)
	)

	# turn into a matrix
	m = as.matrix(d[,1:2])
	# turn into a vector
	vd = c(t(m))

	# make the graph
	g = make_graph(vd,directed=F)
	# add weights to the edges, for later
	#E(g)$weight = d$weight

	# clean up vars to save space in RAM
	d = m = vd = NULL

	# run the big time-consuming function
	print(paste('traversing the',city,mode,'graph...'))
	bc = biconnected_components(g)

	# select only components with more than 100 edges
	mc = bc$component_edges[lengths(bc$component_edges)>100]

	# give each edge a component attribute defaulting to -1
	E(g)$component = -1

	# loop over major connected components
	# assinging real component id's to major connected components
	for(i in 1:length(mc)){
		# as.vector(mc[[i]]) returns the ids/keys of the edges
		E(g)[as.vector(mc[[i]])]$component = i
	}

	# convert the graph to a dataframe of edges and attributes
	results_table = get.data.frame(g)
	# ignore the weights field
	results_table = results_table[,c('from','to','component')]
	# output the results
	write.csv(results_table,output_file)

} # for each mode

dbDisconnect(connection)


library(magrittr)
server <- function(input, output) {
    shinyjs::disable("go_bmr")
    shinyjs::disable("go_maxent")
    shinyjs::disable("go_profile")
    shinyjs::disable("go_dl")

    data("wrld_simpl", package = "maptools")

    v <-
        reactiveValues(data = NULL,
                       bmr = NULL,
                       partitioning_type = NULL)

    observeEvent(input$go_custom, {
        if (input$custom_data == TRUE) {
            tryCatch({
                df <- read.csv(input$file1$datapath)
            },

            error = function(e) {
                # catch parsing error
                stop(safeError(e))
            })
            data <- list(NULL, df_data = df)
            v$data <- data
            v$partitioning_type <- input$data_partitioning_type

            shinyjs::enable("go_bmr")
            showNotification("Custom data parsed")
        } else {
            showNotification("Data format error")
        }
    })

    observeEvent(input$go, {
        req(input$text)

        progress <- shiny::Progress$new()

        progress$set(message = "Status", value = 0)
        progress$inc(1 / 4,
                     detail = "Downloading species occurence data and climate
            variables...")

        benchmarking_data <- sdmbench::get_benchmarking_data(
            scientific_name = input$text,
            limit = input$limit,
            climate_type = input$climate_type,
            climate_resolution = input$climate_resolution,
            projected_model = input$projected_model,
            rcp = input$rcp,
            year = input$years
        )

        progress$inc(1 / 4, detail = "Processing data...")

        benchmarking_data$df_data <- sdmbench::partition_data(
            dataset_raster = benchmarking_data$raster_data,
            dataset = benchmarking_data$df_data,
            env = benchmarking_data$raster_data$climate_variables,
            method = input$data_partitioning_type
        )

        progress$inc(1 / 4, detail = "Plotting map...")

        output$table <-
            renderTable(head(benchmarking_data$df_data))
        output$species_name <- renderText(input$text)

        output$occ_map <- leaflet::renderLeaflet({
            leaflet::leaflet(data = benchmarking_data$raster_data$coords_presence) %>%
                leaflet::addTiles() %>%
                leaflet::addCircleMarkers( ~ x, ~ y, fillOpacity = 0.3)
        })

        progress$inc(1 / 4, detail = "Finished")
        progress$close()

        v$data <- benchmarking_data
        v$partitioning_type <- input$data_partitioning_type

        shinyjs::enable("go_bmr")
        shinyjs::enable("go_maxent")
        shinyjs::enable("go_profile")
        shinyjs::enable("go_dl")

    })

    observeEvent(input$go_bmr, {
        benchmarking_data <- v$data
        partitioning_type <- v$partitioning_type

        progress_bmr <- shiny::Progress$new()
        progress_bmr$set(message = "Status", value = 0)
        progress_bmr$inc(1 / 3, detail = "Benchmarking...")

        learners_list <- input$checkGroup
        learners <- list()
        for (i in seq_along(learners_list)) {
            learners[[i]] <- mlr::makeLearner(learners_list[[i]],
                                              predict.type = "prob")
        }

        benchmarking_data$df_data <-
            na.omit(benchmarking_data$df_data)
        bmr <-
            sdmbench::benchmark_sdm(
                benchmarking_data = benchmarking_data$df_data,
                learners = learners,
                dataset_type =  partitioning_type,
                sample = input$sample
            )

        progress_bmr$inc(1 / 3, detail = "Plotting benchmark results...")
        output$bmr_plot1 <-
            renderPlot(plotBMRBoxplots(bmr, measure = mlr::auc))
        output$bmr_results <-
            renderTable(sdmbench::get_best_model_results(bmr))

        bmr_models <- mlr::getBMRModels(bmr)
        best_results <- sdmbench::get_best_model_results(bmr)

        output$model_map_1 <- leaflet::renderLeaflet(
            sdmbench::plot_sdm_map(
                raster_data = benchmarking_data$raster_data,
                bmr_models = bmr_models,
                model_id = best_results$learner.id[1],
                model_iteration = best_results$iter[1],
                map_type = "interactive"
            )
        )

        output$model_map_2 <- leaflet::renderLeaflet(
            sdmbench::plot_sdm_map(
                raster_data = benchmarking_data$raster_data,
                bmr_models = bmr_models,
                model_id = best_results$learner.id[2],
                model_iteration = best_results$iter[2],
                map_type = "interactive"
            )
        )

        output$model_map_3 <- leaflet::renderLeaflet(
            sdmbench::plot_sdm_map(
                raster_data = benchmarking_data$raster_data,
                bmr_models = bmr_models,
                model_id = best_results$learner.id[3],
                model_iteration = best_results$iter[3],
                map_type = "interactive"
            )
        )

        output$model_map_4 <- leaflet::renderLeaflet(
            sdmbench::plot_sdm_map(
                raster_data = benchmarking_data$raster_data,
                bmr_models = bmr_models,
                model_id = best_results$learner.id[4],
                model_iteration = best_results$iter[4],
                map_type = "interactive"
            )
        )

        output$model_map_5 <- leaflet::renderLeaflet(
            sdmbench::plot_sdm_map(
                raster_data = benchmarking_data$raster_data,
                bmr_models = bmr_models,
                model_id = best_results$learner.id[5],
                model_iteration = best_results$iter[5],
                map_type = "interactive"
            )
        )

        output$model_map_6 <- leaflet::renderLeaflet(
            sdmbench::plot_sdm_map(
                raster_data = benchmarking_data$raster_data,
                bmr_models = bmr_models,
                model_id = best_results$learner.id[6],
                model_iteration = best_results$iter[6],
                map_type = "interactive"
            )
        )

        output$model_map_7 <- leaflet::renderLeaflet(
            sdmbench::plot_sdm_map(
                raster_data = benchmarking_data$raster_data,
                bmr_models = bmr_models,
                model_id = best_results$learner.id[7],
                model_iteration = best_results$iter[7],
                map_type = "interactive"
            )
        )

        output$model_map_8 <- leaflet::renderLeaflet(
            sdmbench::plot_sdm_map(
                raster_data = benchmarking_data$raster_data,
                bmr_models = bmr_models,
                model_id = best_results$learner.id[8],
                model_iteration = best_results$iter[8],
                map_type = "interactive"
            )
        )

        output$model_map_9 <- leaflet::renderLeaflet(
            sdmbench::plot_sdm_map(
                raster_data = benchmarking_data$raster_data,
                bmr_models = bmr_models,
                model_id = best_results$learner.id[9],
                model_iteration = best_results$iter[9],
                map_type = "interactive"
            )
        )

        output$model_map_10 <- leaflet::renderLeaflet(
            sdmbench::plot_sdm_map(
                raster_data = benchmarking_data$raster_data,
                bmr_models = bmr_models,
                model_id = best_results$learner.id[10],
                model_iteration = best_results$iter[10],
                map_type = "interactive"
            )
        )

        progress_bmr$inc(1 / 3, detail = "Done!")
        progress_bmr$close()

    })

    observeEvent(input$go_maxent, {
        if (v$partitioning_type %in%
            c("block", "checkerboard1", "checkerboard2")) {
            data("wrld_simpl", package = "maptools")
            progress_meeval <- shiny::Progress$new()
            progress_meeval$set(message = "Status", value = 0)
            progress_meeval$inc(1 / 3, detail = "Evaluating MaxEnt...")

            maxent_results <-
                sdmbench::evaluate_maxent(
                    raster_data = v$data$raster_data,
                    method = v$partitioning_type
                )

            progress_meeval$inc(1 / 3, detail = "Plotting MaxEnt map")

            output$maxent_auc <- renderText(maxent_results$best_auc)

            pal <- leaflet::colorNumeric(
                c("#ffdbe2", "#fff56b", "#58ff32"),
                raster::values(maxent_results$best_model_pr),
                na.color = "transparent"
            )

            output$maxent_map <- leaflet::renderLeaflet(
                leaflet::leaflet(data = v$data$raster_data$coords_presence) %>%
                    leaflet::addTiles() %>%
                    leaflet::addRasterImage(
                        maxent_results$best_model_pr,
                        colors = pal,
                        opacity = 0.5
                    ) %>%
                    leaflet::addLegend(
                        title = "Habitat Suitability",
                        pal = pal,
                        values = raster::values(maxent_results$best_model_pr),
                        opacity = 1
                    )

            )

            progress_meeval$inc(1 / 3, detail = "Finished")
            progress_meeval$close()

        } else {
            output$maxent_auc <- renderText("Select a partitioning method
                                            (current is default).")
        }
    })

    observeEvent(input$go_dl, {
        progress_dl <- shiny::Progress$new()
        progress_dl$set(message = "Status", value = 0)
        progress_dl$inc(1 / 3, detail = "Preparing training data...")

        df_data <- v$data$df_data

        benchmarking_data_dl <- sdmbench::prepare_dl_data(input_data = df_data,
                                                          partitioning_type = v$partitioning_type)
        progress_dl$inc(1 / 3, detail = "Training network...")
        keras_results <- sdmbench::train_dl(benchmarking_data_dl)
        keras_evaluation <-
            sdmbench::evaluate_dl(model_keras = keras_results$model,
                                  input_data = benchmarking_data_dl)

        temp_fun <- function(model, input_data) {
            input_data <- tibble::as_tibble(input_data)
            data <- recipes::bake(benchmarking_data_dl$rec_obj,
                                  new_data = input_data)

            v <-
                keras::predict_proba(object = model, x = as.matrix(data))
            as.vector(v)
        }

        output$dl_auc <- renderText(paste("AUC: ",
                                          sdmbench::get_dl_auc(keras_evaluation)))
        output$dl_map <- leaflet::renderLeaflet(
            sdmbench::plot_dl_map(
                raster_data = v$data$raster_data,
                keras_model = keras_results$model,
                custom_fun = temp_fun,
                map_type = "interactive"
            )
        )
        output$dl_history <- renderPlot(plot(keras_results$history))

        progress_dl$inc(1 / 3, detail = "Finished!")
        progress_dl$close()
    })

}


#
# Exemplo 2
#

# While - loop
x <- -2
valor <- 2
# enquanto o valor for diferente de 0
while (valor != 0) {
    valor <- x^2
    raiz <- x
    x <- x + 1
}
cat("A raiz da funcao e x = ", raiz, "\n")


library(ggvis)
library(dplyr) # For arrange function

set.seed(1780)
df <- data.frame(x = runif(12), y = runif(12), z = gl(3, 4))

df %>% ggvis(x = ~x, y = ~y) %>% layer_paths()

# Grouping, manually specified
df %>% group_by(z) %>%
  ggvis(x = ~x, y = ~y, stroke = ~z, fill := NA) %>%
  layer_paths() %>%
  layer_points()

# Grouping can happen after ggvis() call
df %>%
  ggvis(x = ~x, y = ~y, stroke = ~z, fill := NA) %>%
  group_by(z) %>%
  layer_paths() %>%
  layer_points()

# Data sorted by x
df %>% ggvis(x = ~x, y = ~y) %>%
  arrange(x) %>%
  layer_paths() %>%
  layer_points()

# layer_lines sorts and adds a mark_path
df %>% ggvis(x = ~x, y = ~y) %>%
  layer_lines() %>%
  layer_points()

# Data sorted by y
df %>% ggvis(x = ~x, y = ~y) %>%
  arrange(y) %>%
  layer_paths() %>%
  layer_points()

# Grouping with auto_group, and sorted
df %>% ggvis(x = ~x, y = ~y, stroke = ~z, fill := NA) %>%
  auto_group() %>%
  arrange(x) %>%
  layer_paths() %>%
  layer_points()

# Using layer_lines, which sorts the data
df %>% ggvis(x = ~x, y = ~y, stroke = ~z, fill := NA) %>%
  layer_lines() %>%
  layer_points()

# Dashed lines
dat <- data.frame(x = rep(c(0, 1), 6), g = gl(6, 2))
dat %>% group_by(g) %>%
  ggvis(x = ~x, y = ~g) %>%
  layer_paths(strokeDash = ~g) %>%
  add_axis("y", grid = FALSE) %>%
  add_axis("x", grid = FALSE, title = "", tick_size_major = 0, ticks = 0)


#===============================================================================
#  File:    02-main-results.R
#  Date:    Feb 3, 2021
#  Purpose: replicate Figs 3+4 and paper results re: impact of encouragement on
#            key outcome variables
#  Data In:
#           ./data/survey_data.csv
#           ./data/daily_pulse_data.csv
#===============================================================================

# PACKAGES
#===============================================================================
library(dplyr)
library(readr)
library(estimatr)
library(glmnet)
library(reshape2)
library(ggplot2)
library(cowplot)
library(stringr)
source('code/functions.r')

# DATA
#===============================================================================
pulse <- read_csv("data/daily_pulse_data.csv")
svy <- read_csv("data/survey_data.csv")

# SAMPLE SIZE
#===============================================================================
# respondents who received the encouragement and consented to wave 4
sum(!is.na(svy$W3_PATA306_treatment_w3) & !is.na(svy$W4_consent))
# Dropping observations where treatment is missing
svy <- svy[!is.na(svy$W3_PATA306_treatment_w3),]

# FIGURE 4
#===============================================================================
# creating affective polarization variable
svy <- svy %>%
  mutate(affpol_out = case_when(
    party7 < 4 ~ as.integer(W4_PATA450a)-as.integer(W4_PATA450b),
    party7 > 4 & party7 < 8 ~ as.integer(W4_PATA450b)-as.integer(W4_PATA450a),
    TRUE ~ NA_integer_),
         affpol_pre = case_when(
           party7 < 4 ~ as.integer(W2_PATA2_3_Dem)-as.integer(W2_PATA2_3_Rep),
    party7 > 4 & party7 < 8 ~ as.integer(W2_PATA2_3_Rep)-as.integer(W2_PATA2_3_Dem),
    TRUE ~ NA_integer_))

# standardize DVs
svy$trust <- svy$trust/sd(svy$trust[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)
svy$issue_scale <- svy$issue_scale/sd(svy$issue_scale[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)
svy$imm_issue_scale <- svy$imm_issue_scale/sd(svy$imm_issue_scale[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)
svy$W4_PATA450b <- svy$W4_PATA450b/sd(svy$W4_PATA450b[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)
svy$W4_PATA450a <- svy$W4_PATA450a/sd(svy$W4_PATA450a[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)
svy$affpol_out <- svy$affpol_out/sd(svy$affpol_out[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)
svy$vote_after <- svy$vote_after/sd(svy$vote_after[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)
svy$ppol <- svy$ppol/sd(svy$ppol[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)
svy$agenda_lean <- svy$agenda_lean/sd(svy$agenda_lean[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)

svy$trump_approve_num <- as.numeric(svy$trump_approve)
svy$cong_dem_approve_num <- as.numeric(svy$cong_dem_approve)
svy$cong_rep_approve_num <- as.numeric(svy$cong_rep_approve)

svy$trump_approve_num <- svy$trump_approve_num/sd(svy$trump_approve_num[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)
svy$cong_dem_approve_num <- svy$cong_dem_approve_num/sd(svy$cong_dem_approve_num[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)
svy$cong_rep_approve_num <- svy$cong_rep_approve_num/sd(svy$cong_rep_approve_num[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)

# potential control variables across all models
vars <- c("party7", "age", "agesq", "female", "raceeth", "educ",
          "ideo", "income", "employ", "state", "polint", "freq_tv", "freq_np",
          "freq_rad", "freq_net", "freq_disc", "log_news_pre", "diet_mean_pre")

ests <- NULL

########################################################
### Issue H1: issue opinions, Fox News treatment
########################################################

trt <- "FoxNews"
dv <- "issue_scale"
dv_pre <- "issue_scale_pre"
D <- "comp_fn"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)

## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_fn") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Issue scale (conservatism)"
dat0$trt <- "Fox News"
dat$outcome <- "Issue scale (conservatism)"
dat$trt <- "Fox News"

ests <- rbind(ests, dat, dat0)

########################################################
### Issue H2: issue opinions, HuffPost treatment
########################################################

trt <- "HuffPost"
dv <- "issue_scale"
dv_pre <- "issue_scale_pre"
D <- "comp_hp"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)

## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_hp") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Issue scale (conservatism)"
dat0$trt <- "HuffPost"
dat$outcome <- "Issue scale (conservatism)"
dat$trt <- "HuffPost"
ests <- rbind(ests, dat, dat0)

########################################################
### Turnout RQ1a: Fox News
########################################################

trt <- "FoxNews"
dv <- "vote_after"
dv_pre <- "vote_pre"
D <- "comp_fn"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)

## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_fn") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Self-reported vote turnout"
dat0$trt <- "Fox News"
dat$outcome <- "Self-reported vote turnout"
dat$trt <- "Fox News"
ests <- rbind(ests, dat, dat0)

########################################################
### Turnout RQ1a: Huff Post
########################################################

trt <- "HuffPost"
dv <- "vote_after"
dv_pre <- "vote_pre"
D <- "comp_hp"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)

## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_hp") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Self-reported vote turnout"
dat0$trt <- "HuffPost"
dat$outcome <- "Self-reported vote turnout"
dat$trt <- "HuffPost"
ests <- rbind(ests, dat, dat0)

########################################################
### Affective H1b: HuffPost treatment
########################################################

trt <- "HuffPost"
dv <- "affpol_out"
dv_pre <- "affpol_pre"
D <- "comp_hp"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)

## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_hp") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Affective polarization"
dat0$trt <- "HuffPost"
dat$outcome <- "Affective polarization"
dat$trt <- "HuffPost"
ests <- rbind(ests, dat, dat0)

########################################################
### Affective H2a: FoxNews treatment
########################################################

trt <- "FoxNews"
dv <- "affpol_out"
dv_pre <- "affpol_pre"
D <- "comp_fn"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)

## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_fn") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Affective polarization"
dat0$trt <- "Fox News"
dat$outcome <- "Affective polarization"
dat$trt <- "Fox News"
ests <- rbind(ests, dat, dat0)

########################################################
### Media Trust H4a: Media trust for FN group
########################################################

trt <- "FoxNews"
dv <- "trust"
D <- "comp_fn"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, trt = trt)

## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_fn") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Media trust"
dat0$trt <- "Fox News"
dat$outcome <- "Media trust"
dat$trt <- "Fox News"
ests <- rbind(ests, dat, dat0)

########################################################
### Media Trust H4b: Media trust for HP group
########################################################

trt <- "HuffPost"
dv <- "trust"
D <- "comp_hp"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, trt = trt)

## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_hp") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Media trust"
dat0$trt <- "HuffPost"
dat$outcome <- "Media trust"
dat$trt <- "HuffPost"
ests <- rbind(ests, dat, dat0)

########################################################
### Issue H3: immigration attitudes, FoxNews treatment
########################################################

trt <- "FoxNews"
dv <- "imm_issue_scale"
dv_pre <- "issue_scale_pre"
D <- "comp_fn"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt, more_vars = "policy14_imm_pre")

## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_fn") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Pro-immigration attitudes"
dat0$trt <- "Fox News"
dat$outcome <- "Pro-immigration attitudes"
dat$trt <- "Fox News"
ests <- rbind(ests, dat, dat0)

########################################################
### Issue H4: immigration attitudes, HuffPost treatment
########################################################

trt <- "HuffPost"
dv <- "imm_issue_scale"
dv_pre <- "issue_scale_pre"
D <- "comp_hp"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt, more_vars = "policy14_imm_pre")

## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_hp") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Pro-immigration attitudes"
dat0$trt <- "HuffPost"
dat$outcome <- "Pro-immigration attitudes"
dat$trt <- "HuffPost"
ests <- rbind(ests, dat, dat0)

########################################################
### Perceived H1a: FoxNews treatment
########################################################

trt <- "FoxNews"
dv <- "ppol"
D <- "comp_fn"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_fn") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Perceived polarization"
dat0$trt <- "Fox News"
dat$outcome <- "Perceived polarization"
dat$trt <- "Fox News"
ests <- rbind(ests, dat, dat0)

########################################################
### Perceived H1b: HuffPost treatment
########################################################

trt <- "HuffPost"
dv <- "ppol"
D <- "comp_hp"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_hp") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Perceived polarization"
dat0$trt <- "HuffPost"
dat$outcome <- "Perceived polarization"
dat$trt <- "HuffPost"
ests <- rbind(ests, dat, dat0)

########################################################
### Agenda H1: FoxNews treatment
########################################################

trt <- "FoxNews"
dv <- "agenda_lean"
dv_pre <- "agenda_lean_pre"
D <- "comp_fn"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_fn") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Agenda setting"
dat0$trt <- "Fox News"
dat$outcome <- "Agenda setting"
dat$trt <- "Fox News"
ests <- rbind(ests, dat, dat0)

########################################################
### Agenda H2: HuffPost treatment
########################################################

trt <- "HuffPost"
dv <- "agenda_lean"
dv_pre <- "agenda_lean_pre"
D <- "comp_hp"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_hp") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Agenda setting"
dat0$trt <- "HuffPost"
dat$outcome <- "Agenda setting"
dat$trt <- "HuffPost"
ests <- rbind(ests, dat, dat0)

########################################################
### Approval H1a: President
########################################################

# creating numeric dvs to avoid labelled error
# svy$trump_approve_num <- as.numeric(svy$trump_approve)
svy$trump_approve_pre_num <- as.numeric(svy$trump_approve_pre)

trt <- "FoxNews"
dv <- "trump_approve_num"
dv_pre <- "trump_approve_pre_num"
D <- "comp_fn"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_fn") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Approval: President"
dat0$trt <- "Fox News"
dat$outcome <- "Approval: President"
dat$trt <- "Fox News"
ests <- rbind(ests, dat, dat0)

########################################################
### Approval H1b: Republicans in Congress [Congress control preference]
########################################################

# creating numeric dvs to avoid labelled error
# svy$cong_rep_approve_num <- as.numeric(svy$cong_rep_approve)
svy$cong_rep_approve_pre_num <- as.numeric(svy$cong_rep_approve_pre)

trt <- "FoxNews"
dv <- "cong_rep_approve_num"
dv_pre <- "cong_rep_approve_pre_num"
D <- "comp_fn"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_fn") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Approval: Reps in Congress"
dat0$trt <- "Fox News"
dat$outcome <- "Approval: Reps in Congress"
dat$trt <- "Fox News"
ests <- rbind(ests, dat, dat0)

########################################################
### Approval H1c: Democrats in Congress [Congress control preference]
########################################################

# creating numeric dvs to avoid labelled error
# svy$cong_dem_approve_num <- as.numeric(svy$cong_dem_approve)
svy$cong_dem_approve_pre_num <- as.numeric(svy$cong_dem_approve_pre)

trt <- "FoxNews"
dv <- "cong_dem_approve_num"
dv_pre <- "cong_dem_approve_pre_num"
D <- "comp_fn"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_fn") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Approval: Dems in Congress"
dat0$trt <- "Fox News"
dat$outcome <- "Approval: Dems in Congress"
dat$trt <- "Fox News"
ests <- rbind(ests, dat, dat0)

########################################################
### Approval H2a: President
########################################################

# creating numeric dvs to avoid labelled error
# svy$trump_approve_num <- as.numeric(svy$trump_approve)
svy$trump_approve_pre_num <- as.numeric(svy$trump_approve_pre)

trt <- "HuffPost"
dv <- "trump_approve_num"
dv_pre <- "trump_approve_pre_num"
D <- "comp_hp"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_hp") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Approval: President"
dat0$trt <- "HuffPost"
dat$outcome <- "Approval: President"
dat$trt <- "HuffPost"
ests <- rbind(ests, dat, dat0)

########################################################
### Approval H2b: Republicans in Congress [Congress control preference]
########################################################

# creating numeric dvs to avoid labelled error
# svy$cong_rep_approve_num <- as.numeric(svy$cong_rep_approve)
svy$cong_rep_approve_pre_num <- as.numeric(svy$cong_rep_approve_pre)

trt <- "HuffPost"
dv <- "cong_rep_approve_num"
dv_pre <- "cong_rep_approve_pre_num"
D <- "comp_hp"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_hp") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value)
dat <- dat %>% mutate(estimand = "CACE")
dat0$outcome <- "Approval: Reps in Congress"
dat0$trt <- "HuffPost"
dat$outcome <- "Approval: Reps in Congress"
dat$trt <- "HuffPost"
ests <- rbind(ests, dat, dat0)

########################################################
### Approval H2c: Democrats in Congress [Congress control preference]
########################################################

# creating numeric dvs to avoid labelled error
# svy$cong_dem_approve_num <- as.numeric(svy$cong_dem_approve)
svy$cong_dem_approve_pre_num <- as.numeric(svy$cong_dem_approve_pre)

trt <- "HuffPost"
dv <- "cong_dem_approve"
dv_pre <- "cong_dem_approve_pre"
D <- "comp_hp"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, dv_pre = dv_pre, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)

dat0 <- itt[[1]] %>% tidy() %>% slice(2) %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "ITT")
dat <- cace %>% tidy() %>% filter(term == "comp_hp") %>% dplyr::select(estimate, conf.low, conf.high, std.error, p.value) %>%
  mutate(estimand = "CACE")
dat0$outcome <- "Approval: Dems in Congress"
dat0$trt <- "HuffPost"
dat$outcome <- "Approval: Dems in Congress"
dat$trt <- "HuffPost"
ests <- rbind(ests, dat, dat0)

ests$outcome[grep("immig", ests$outcome)] <- "Immigration issue scale"
ests$study <- "Study 1"
ests$study[13:16] <- "Study 2"
ests$outcome_factor <- factor(ests$outcome, levels=rev(unique(ests$outcome)))

########################################################
### Creating figure in paper
########################################################

g <- ggplot(data = filter(ests, estimand == "CACE"), aes(y=estimate, x=outcome_factor, color=trt)) +
  facet_grid(rows = vars(study), space = "free", scales = "free") +
  geom_hline(yintercept = 0, colour = gray(1/2), lty = 2) +
  geom_pointrange(aes(y = estimate,
                      ymin = conf.low,
                      ymax = conf.high), position=position_dodge(width=-.5))+
  scale_color_manual("Treatment", values=c("red", "blue")) +
  ylim(c(-1.33, 1.33)) +
  xlab("") + ylab("") +
  coord_flip() + theme_minimal() + theme(legend.position = "bottom")
g

ggsave(g, file = "graphs/main-fig4.pdf", width = 6, height = 8)
ggsave(g, file = "graphs/main-fig4.png", width = 6, height = 8)

# results highlighted in manuscript
ests %>% filter(estimand == "CACE" & outcome_factor == "Media trust")

# Long-term effects
#===============================================================================

svy$trust_w7 <- svy$trust_w7/sd(svy$trust_w7[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)

########################################################
### Media Trust H4a: Media trust for FN group (w7)
########################################################

trt <- "FoxNews"
dv <- "trust_w7"
D <- "comp_fn"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, trt = trt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)
cace$coefficients[D]
cace$p.value[D]

########################################################
### Media Trust H4b: Media trust for HP group (w7)
########################################################

trt <- "HuffPost"
dv <- "trust_w7"
D <- "comp_hp"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)
cace$coefficients[D]
cace$p.value[D]

########################################################
### Media Trust H4a: Media trust for FN group (w8)
########################################################

svy$trust_w8 <- svy$trust_w8/sd(svy$trust_w8[which(svy$W3_PATA306_treatment_w3 == "Control")], na.rm = TRUE)

trt <- "FoxNews"
dv <- "trust_w8"
D <- "comp_fn"

# resetting after het fx analysis
vars <- c("party7", "age", "agesq", "female", "raceeth", "educ",
          "ideo", "income", "employ", "state", "polint", "freq_tv", "freq_np",
          "freq_rad", "freq_net", "freq_disc", "log_news_pre", "diet_mean_pre")

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)
cace$coefficients[D]
cace$p.value[D]

########################################################
### Media Trust H4b: Media trust for HP group (w8)
########################################################

trt <- "HuffPost"
dv <- "trust_w8"
D <- "comp_hp"

## DIM
(dim <- difference_in_means(formula(paste0(dv, " ~ W3_PATA306_treatment_w3")),
                            blocks = W3_Browser_treatment_w3,
                            data = svy,
                            condition1 = "Control",
                            condition2 = trt))
## ITT, with Lin's covariate adjustment
itt <- run_model(dv = dv, trt = trt)
compute_proportion_missing_covars(itt)
## CACE
cace <- estimate_cace(Y=dv, D = D, Z = "W3_PATA306_treatment_w3",
                      X = extract_covariates(itt), trt=trt)
cace$coefficients[D]
cace$p.value[D]

# substantive magnitude?
svy %>% mutate(ideo2 = case_when(
  ideo %in% c(1, 2) ~ 'Liberals',
  ideo %in% c(4, 5) ~ 'Conservatives')) %>%
  group_by(ideo2) %>%
  summarize(avg_trust = mean(trust, na.rm = TRUE))
# difference:
3.33 - 1.91 # = 1.42
.55 / 1.42


#####################################################
### Main file for running "weight restrictions"   ###
### simulations (Section 4.1 of paper )           ###
### For parameters used see "SimWR.r"             ###
### Ian Durbach, indurbach@gmail.com              ###
### last updated: 2015-09-04                      ###
#####################################################

library(hitandrun)
library(smaa)

# remember to setwd
source('ApplyErrors.r')
source('ApplyMAUT.r')
source('Generate.r')
source('OutputMeasures.r')
source('SMAA-Boot.r')
source('SMAA1.r')
source('SMAA2.r')
source('SMAA3.r')
source('SMAA4.r')
source('Weights.r')
source('SimWR.r')

# To simulate provision of wt information in decreasing order of importance
# remove comments from two files below
#source('ApplyMAUT_incr_order.r')
#source('Weights_incr_order.r')

###################################################################
# k is number of "scenarios" used in generation of attribute values
# runs is number of SMAA runs
# sims is number of simulations run at each combination of parameter values

K <<- 15000
nd <<- "T"
runs <<- 10000
sims <<- 500
simname <<- date()
identifier <<- "run_sim_WR_inc"
u_c <<- 0
thin.f = 100

runsimWR(K=K,nd=nd,runs=runs,sims=sims,simname=simname,identifier=identifier)


#required packages
library("openxlsx")
library("stringr")
library(ComplexHeatmap)
library(circlize)
library(colorspace)
library(GetoptLong)
library(ggplot2)
library(gplots)
library(survival)
require("survival")
# install.packages("svglite")
library(survminer)
library(reticulate)

#set the project path
project_path = "./project/"

#load patient data (include survival info)
study_cohort = read.xlsx(paste(project_path, "data/tcga/study_cohort.xlsx",sep=""), sheet = 1, colNames = TRUE)
entire_cohort = read.xlsx(paste(project_path, "data/tcga/entire_cohort.xlsx",sep=""), sheet = 1, colNames = TRUE)

length(rownames(study_cohort))

length(rownames(entire_cohort))

median(entire_cohort$ENSG00000206567.8)

#To build a risk score system based on lncRNA signature, we first estimate the coef of the signature
fit = coxph(Surv(OS, Censor) ~

ENSG00000187185.4+
ENSG00000259641.4+
ENSG00000218510.5 +
ENSG00000257989.1+
ENSG00000206567.8
, data=study_cohort)

# summary(fit)

HR <- exp(coef(fit))
CI <- exp(confint(fit))
P <- round(coef(summary(fit))[,5],8)
COEF <- coef(fit)

colnames(CI) <- c("Lower", "Higher")

table2 <- as.data.frame(cbind(HR, CI,COEF, P))
table2

#calculate the risk score based on expression and coef of the signature
#use coef (estimated in the study cohort) in above table
entire_cohort$risk_lnc = (
    entire_cohort$ENSG00000187185.4   * table2[1,4] +
    entire_cohort$ENSG00000259641.4 * table2[2,4]+
    entire_cohort$ENSG00000218510.5 * table2[3,4] +
    entire_cohort$ENSG00000257989.1 * table2[4,4] +
    entire_cohort$ENSG00000206567.8 * table2[5,4] )

#calculate hazard ratio
fit1 = coxph(Surv(OS, Censor) ~

risk_lnc
, data=entire_cohort)

# summary(fit)

HR <- exp(coef(fit1))
CI <- exp(confint(fit1))
P <- coef(summary(fit1))[,5]
COEF <- coef(fit1)

colnames(CI) <- c("Lower", "Higher")

table22 <- as.data.frame(cbind(HR, CI,COEF, P))
table22

#calculate the time-dependent roc (lncrna signature on entire tcga cohort)
library(timeROC)
ROC<-timeROC(T=entire_cohort$OS,# survival time

delta=entire_cohort$Censor,# results, alive or death

marker=entire_cohort$risk_lnc,# variables

cause=1,

weighting="marginal",

times=c(365*3, 365*5, 365*10),# time, survival 3,5,10 years

ROC = TRUE,

iid = TRUE)
ROC

#the time-dependent roc/auc shown above result and confidence interval shown below
#the lncrna signature performance on entire TCGA dataset
confint(ROC)$CB_AUC

#To build a risk score system based on lncRNA signature + 3 clinical factors,
#we first estimate the coef of the signature and 3 clinical factors

fit = coxph(Surv(OS, Censor) ~ stage + gender + age_at_diagnosis +

ENSG00000187185.4+
ENSG00000259641.4+
ENSG00000218510.5 +
ENSG00000257989.1+
ENSG00000206567.8
, data=study_cohort)

# summary(fit)

HR <- exp(coef(fit))
CI <- exp(confint(fit))
P <- round(coef(summary(fit))[,5],8)
COEF <- coef(fit)

colnames(CI) <- c("Lower", "Higher")

table2 <- as.data.frame(cbind(HR, CI,COEF, P))
table2

#calculate the risk score based on expression and coef of the signature and 3 clinical factors
#use coef (estimated in the study cohort) in above table
entire_cohort$risk_lncClinical = (
    entire_cohort$stage   *         table2[1,4]+
    entire_cohort$gender    *       table2[2,4]+
    entire_cohort$age_at_diagnosis   * table2[3,4] +
    entire_cohort$ENSG00000187185.4   * table2[4,4] +
    entire_cohort$ENSG00000259641.4 * table2[5,4]+
    entire_cohort$ENSG00000218510.5 * table2[6,4] +
    entire_cohort$ENSG00000257989.1 * table2[7,4] +
    entire_cohort$ENSG00000206567.8 * table2[8,4] )

#calculate the time-dependent roc (lncrna signature + 3 clinical factors on entire cohort)
library(timeROC)
ROCAll<-timeROC(T=entire_cohort$OS,# survival time

delta=entire_cohort$Censor,# results, alive or death

marker=entire_cohort$risk_lncClinical,

cause=1,# positive results

weighting="marginal",

times=c(365*3, 365*5, 365*10),# time, survival 3,5,10 years

ROC = TRUE,

iid = TRUE)
ROCAll

#the time-dependent roc/auc is shown above and confidence interval shown below
#the lncrna signature + 3 clinical factors performance on entire dataset
confint(ROCAll)$CB_AUC

title = paste(project_path,"results/tcga_time-dependent-roc", ".pdf", sep="")

# pdf(title)

#(95% CI: 0.6328-0.6835), lncrna, 5 years
#(95% CI: 0.6771-0.7596), lncrna + 3 clinical factors, 10 years

#plot the time-dependent roc
plot(ROC,time=365*3,col = "red", lty=2,add =FALSE, title="")
plot(ROC,time=365*5,col = "red",lwd=2, add =TRUE)
plot(ROC,time=365*10,col = "red",lty=3, add =TRUE)

plot(ROCAll,time=365*3,col = "blue",lty=2,add =TRUE)
plot(ROCAll,time=365*5,col = "blue",lty=3,add =TRUE)
plot(ROCAll,time=365*10,col = "blue",lwd=2,add =TRUE)
legend("bottomright", c("5-lncRNA at 3 years (AUC = 0.64)","5-lncRNA at 5 years (AUC = 0.66)","5-lncRNA at 10 years (AUC = 0.63)", "5-lncRNA + 3 clinical factors at 3 years (AUC= 0.68)","5-lncRNA + 3 clinical factors at 5 years (AUC= 0.67)", "5-lncRNA + 3 clinical factors 10 years (AUC= 0.72)"), lty=c(2,1,3,2,3,1), lwd=c(1,2,1,1,1,2), col = c("red","red","red","blue","blue", "blue"), bty="n")

# dev.off()

#calculate the median risk score (lncrna signature)
mediam_risk_score = median(as.numeric(as.vector(entire_cohort$risk_lnc)))
entire_cohort$risk_cluster <- 1
entire_cohort$risk_cluster[which(entire_cohort$risk_lnc <= mediam_risk_score)] <- 0
mediam_risk_score

#calculate the surviva different of the high- and low-risk score groups (lncrna signature)
survdiff(Surv(OS, Censor) ~risk_cluster, data = entire_cohort)

#plot the survival difference
library(survival)
require("survival")
# install.packages("svglite")
library(survminer)

dif = survdiff(Surv(OS, Censor) ~risk_cluster, data = entire_cohort)
pv = pchisq(dif$chisq, length(dif$n)-1, lower.tail = FALSE)
pv = formatC(pv, format = "e", digits = 2)
ret = c("Log-rank\r\np = ",pv)
pvalue=paste(ret[1],ret[2], sep="")

fit<- survfit(Surv(OS, Censor) ~ risk_cluster, data = entire_cohort)

p <- ggsurvplot(fit, data=entire_cohort,risk.table = TRUE,tables.theme = theme_cleantable(),palette = c("#E7B890", "#2E9FCF"), ggtheme = theme_bw(),surv.median.line = "hv",legend.title = "Risk Score", legend.labs = c("Low", "High"), xlab='Time (days)', conf.int = TRUE,pval = pvalue,pval.method=TRUE,conf.int.style='ribbon', conf.int.alpha=0.1)

p = p + theme_survminer( font.main = c(16, "bold", "darkblue"), font.submain = c(15, "bold", "purple"), font.caption = c(14, "plain", "orange"), font.x = c(14, "bold"), font.y = c(14, "bold"), font.tickslab = c(12, "plain") )

p

#save the results
title = paste(project_path, "results/RiskScore-Survival-TCGA.tiff", sep="")
tiff(title, width=480*7, height=480*7, units="px", res=96*6, compression = "lzw")
print(p, newpage = FALSE)
dev.off()

# let's see the median survival time between high- and low-risk groups
# risk_cluster=0, low-risk score group (low risk), longer survival time
#risk_cluster=1, high-risk score group (high risk), shorter survival time
print(fit)

#we need to drop patients without age_at_diagnosis or OS info
validPatients = entire_cohort[!is.na(entire_cohort$OS),]
validPatients = validPatients[!is.na(validPatients$age_at_diagnosis),]
mediam_risk_score_lncClinical = median(as.numeric(as.vector(validPatients$risk_lncClinical)))
#stratified into two groups based on median risk score
validPatients$risk_cluster1 <- 1
validPatients$risk_cluster1[which(validPatients$risk_lncClinical <= mediam_risk_score_lncClinical)] <- 0
mediam_risk_score_lncClinical

#calculate the survival difference
#risk_cluster1=0, low-risk score group (low risk), longer survival time
#risk_cluster1=1, high-risk score group (high risk), shorter survival time
fit<- survfit(Surv(OS, Censor) ~ risk_cluster1, data = validPatients)
fit

dif = survdiff(Surv(OS, Censor) ~risk_cluster1, data = validPatients)
pv = pchisq(dif$chisq, length(dif$n)-1, lower.tail = FALSE)
pv = formatC(pv, format = "e", digits = 2)
pv # p-value


##' Regression analysis of prevalence reduction
##'
##' @return the result of a \code{glm} call
##' @importFrom dplyr mutate group_by summarise ungroup left_join select rename
##' @importFrom tidyr pivot_longer separate pivot_wider
##' @importFrom stats glm quasipoisson offset confint
##' @importFrom kableExtra kable add_header_above save_kable
##' @param file a file name to save the table of covariates to, if desired
##' @export
regression <- function(file = NULL) {
  ## convert county names to simple names for merging with Rt
  ms.R <- ms.tst %>%
    mutate(pop = round(pop)) %>%
    simplify_names() %>%
    mutate(region = if_else(grepl("Košice", county), "Košice kraj", region)) %>%
    mutate(region = sub(" kraj$", "", region)) %>%
    left_join(Rt.county %>% rename(simple_name = county), by = "simple_name") %>%
    mutate(pilot =
             if_else(simple_name %in%
                     c("tvrdosin", "namestovo", "dolny_kubin", "bardejov"),
                     "pilot", "non-pilot")) %>%
    select(county, pilot, pop, region, positive_2, attendance_2, positive_3, attendance_3, R) %>%
    mutate(round2_prev = positive_2/attendance_2,
           round2_att = attendance_2/pop,
           round2_mean_prev = mean(round2_prev, na.rm = TRUE),
           round2_mean_att = mean(round2_att, na.rm = TRUE),
           mean_R = mean(R))

  options(knitr.kable.NA = "")

  if (!is.null(file)) {
    col.names <-
      c("County", "Region", "Population", "R",
        rep(c("Positive", "Attendance", "%"), times = 2))

    k <- kable(ms.R %>%
               mutate(round2_prev = round(round2_prev * 100, 2),
                      round3_prev = round(positive_3 / attendance_3 * 100, 2),
                      R = round(R, 1)) %>%
               select(county, region, pop, R,
                      ends_with("_2"), round2_prev,
                      ends_with("_3"), round3_prev) %>%
               arrange(county),
               format = "latex",
               col.names = col.names,
               align=c('l|', 'l|', 'r|', 'r|', rep('r', 3), '|r', rep('r', 2)),
               booktabs = TRUE)

    k <-
      add_header_above(k, c(" " = 4,
                            "Round 1" = 3, "Round 2" = 3))

    save_kable(k, file)
  }

  reg_data <- ms.R %>%
    filter(!is.na(attendance_3)) %>%
    pivot_longer(c(-county, -pilot, -pop, -region,
                   -starts_with("round2_"), -R, -mean_R)) %>%
    mutate(name = sub("^(.+)_([[:digit:]]+)$", "\\1|\\2", name)) %>%
    separate(name, c("name", "round"), "\\|") %>%
    pivot_wider() %>%
    mutate(prop_attend = attendance / pop,
           round = as.integer(round) - 2, # make integer indicator variable for rd 3
           round_rd2att = ifelse(round > 0, # centre and stadardise
           (round2_att - round2_mean_att) / round2_mean_att,
           0),
           round_rd2pos = ifelse(round > 0, #centre and stadardise
           (round2_prev - round2_mean_prev) / round2_mean_prev,
           0),
           round_R = ifelse(round > 0, #centre and stadardise
           (R - mean_R) / mean_R,
           0))

  glm(positive ~ 0 + round + round_rd2att + round_rd2pos + round_R + round:region + county + offset(log(attendance)),
      family = quasipoisson,
      data = reg_data) -> mod

  round_coeff <- mod$coefficients["round"] %>% exp %>% {1-.} %>% round(2)
  round_coeff_confint <- mod %>% confint("round") %>% exp %>% {1-.} %>% round(2)

  return(list(res = mod, round = c(round_coeff, round_coeff_confint)))
}


#' PMV_custom
#'
#'  Calculate Predicted Mean Vote (PMV) following ISO 7730 customizing some individual features.
#'
#' @param t numeric    Air temperature in degC.
#' @param rh numeric   Relative humidity in percentage.
#' @param wind numeric Windspeed in meter per second.
#' @param tr numeric Mean radiant temperature in degC.
#' @param clo numeric  Available basic clothing insulation in clo.
#' @param age numeric Age in years.
#' @param mbody numeric   Body Mass in kg.
#' @param ht numeric Heigth of subject in meters.
#' @param gender character Sex of the subject. Default is "male".
#' @return Predicted Mean Vote customized
#'
#'
#' @author  Istituto per la Bioeconomia CNR Firenze Italy  Alfonso Crisci \email{alfonso.crisci@@ibe.cnr.it}
#' @keywords PMV_custom
#'
#' @export
#'
#'
#'
#'

PMV_custom=function(t,rh,wind,tr,clo,age,mbody,ht,gender="male") {
                         ct$assign("t", as.array(t))
                         ct$assign("rh", as.array(rh))
                         ct$assign("wind", as.array(wind))
                         ct$assign("mtrad", as.array(tr))
                         ct$assign("iclo", as.array(clo))
                         ct$assign("age", as.array(age))
                         ct$assign("mbody", as.array(mbody))
                         ct$assign("ht", as.array(ht))
                         ct$assign("gender", as.array(gender))
                         ct$eval("var res=[]; for(var i=0, len=t.length; i < len; i++){ res[i]=PMV_custom(t[i],rh[i],wind[i],mtrad[i],iclo[0],age[0],mbody[0],ht[0],gender[0])};")
                         res=ct$get("res")
                         return(ifelse(res==9999,NA,res))
}


suppressMessages(require('randomForest'))

args <- commandArgs(trailingOnly = TRUE)
trainingFile = args[1] #paste(args[1], "data/trainingSet/", args[2], sep='')
testingFile = args[2]
writingFile = args[3]

t = read.table(trainingFile,header = TRUE)
t1 = read.table(testingFile,header = TRUE)

if (args[2] == 'genericAll.txt'){
  x = cbind(t[1],t[3],t[4],t[5])
  x1 = cbind(t1[1],t1[3],t1[4],t1[5])
}else{
  x = cbind(t[1],t[2],t[3],t[4],t[5])
  x1 = cbind(t1[1],t1[2],t1[3],t1[4],t1[5])
}

y = t$status
r = suppressWarnings(randomForest(x,y))
p = predict(r,x1)

out = p #cbind(p,t1$status)
write.table(out,file = writingFile,row.names = FALSE,col.names=FALSE,append=FALSE,sep='\t')