dataread.c <- function() {
  name <- tclvalue(tkgetOpenFile(
    filetypes = "{ {XLSX Files} {.xlsx} } { {All Files} * }"))
  if (name == "")
    return(data.frame()) # Return an empty data frame if no file was selected

  data <- read_xlsx(name,sheet = 2)
  assign("data", data, envir = .GlobalEnv)
  assign("name",name, envir = .GlobalEnv)
  cat("The lookup data was imported successfully.\n
      Please close the file selection by pressing the OK Button")
}

# function to create an plot object usable in grid.arrange without using ggplot
# use via grab_grob() in line after plot was created

grab_grob <- function(){
  grid.echo()
  grid.grab()
}

##plotting 24h data
theme.mr <- theme (axis.title = element_text(size=11,face="bold"),
                   axis.line.x = element_line(colour = "black"),
                   axis.line.y = element_line(colour = "black"),
                   plot.title = element_text(size=18),
                   axis.text.y = element_text(angle=0, hjust=-0.25),
                   axis.text.x = element_text(angle=0, hjust=1), #inclination of text of X axis
                   legend.title = element_blank(),
                   legend.text =element_text(size=11))

plot24h <- function (data_d, Title, hour.info2= hour.info, datalenght=12){
  data_d %>%
    ggplot(aes(x=Bin.dark, y=avg, group=treatment, color= genotype)) +
    geom_rect( aes(xmin = 0, xmax = datalenght, ymin = 0, ymax = Inf), fill = 'lightgrey', alpha = .05)+
    #geom_vline(xintercept=max(hour.info2[,1]),linetype = "dotted")+
    #geom_vline(xintercept=min(hour.info2[,2]),linetype = "dotted")+
    geom_point (aes (colour=(genotype), shape=(treatment)), size=2)+
    #geom_line(aes(colour=(genotype)))+
    #facet_grid( genotype~, switch="x") +
    geom_errorbar(aes(ymin=avg, ymax=avg+sd, colour=(genotype),linetype=(treatment) ), width=0, position=position_dodge(0.05))+
    labs(x="time of day",y="%time or meters", title = Title)+
    theme_classic() +
    #scale_colour_manual(values = cols)+ ###Stop here if want to save as pdf
    theme.mr
}

## tune the svm over different kernels

tune.svm2 <- function(trainset,groupingvar){
  objS <- tune.svm(groupingvar~., data = trainset, gamma = 4^(-5:5), cost = 4^(-5:5),
                   tune.control(sampling = "cross"),kernel = "sigmoid")
  S=min(objS$performances$error)

  objR <- tune.svm(groupingvar~., data = trainset, gamma = 4^(-5:5), cost = 4^(-5:5),
                   tune.control(sampling = "cross"),kernel = "radial")
  R=min(objR$performances$error)

  objP <- tune.svm(groupingvar~., data = trainset, gamma = 4^(-5:5), cost = 4^(-5:5),
                   tune.control(sampling = "cross"),kernel = "polynomial")
  P=min(objP$performances$error)

  objL <- tune.svm(groupingvar~., data = trainset, gamma = 4^(-5:5), cost = 4^(-5:5),
                   tune.control(sampling = "cross"),kernel = "linear")
  L=min(objL$performances$error)

  choice=data.frame ("S"=S, "R"=R, "P"=P, "L"=L)
  Min =choice %>% transmute (C=min(S,R,P,L))
  choice=cbind(data.frame (t(choice)), kernel=c("sigmoid","radial","polynomial","linear"))

  #choice %>% filter (t.choice. ==Min [1,1])
  KERNEL=as.character(choice [choice$t.choice ==Min [1,1],2])[1]
  obj=NA
  obj= ifelse (KERNEL == "sigmoid",objS, obj)
  obj= ifelse (KERNEL == "radial",objR, obj)
  obj= ifelse (KERNEL == "polynomial",objP, obj)
  obj= ifelse (KERNEL == "linear",objL, obj)
  return (c(KERNEL,obj))
}

permutate_trainset <- function(LIST) {
  # list must be a list of factors, with 2 levels

  #get combination of n/2 number in a list of n
  n= length(LIST)

  x=combn (n,n/2)
  x=x[,1:(ncol(x)/2)]

  # create initial list with all elements of first level
  P = rep(levels (LIST)[1], n)
  # for each permutation, change the element of position x to the element of second level
  perm= c()
  for (i in c(1:ncol(x))){
    Px= P
    Px[x[,i]]= levels (LIST)[2]
    perm= rbind(perm,Px)
  }
  perm
}

tune.svm3 <- function(trainset,groupingvar){

  objR <- tune.svm(groupingvar~., data = trainset, gamma = 4^(-5:5), cost = 4^(-5:5),
                   tune.control(sampling = "cross"),kernel = "radial")

  objL <- tune.svm(groupingvar~., data = trainset, gamma = 4^(-5:5), cost = 4^(-5:5),
                   tune.control(sampling = "cross"),kernel = "linear")

  return (c("radial",objR,"linear",objL))
}

#set transformation for %age time data (i.e. not distance traveled, all the other)
#we cannot use log (too many 0), the Arcsin is also not usable since we will do regressions afterwards.
calcul = function (x){
  sqrt(mean (x)/60)
}
calcul_text = "data (%age of time spent doing the behavior) transformed using the square root method."

## use calcul fonction and get values for one window:
get_windowsummary <- function(windowdata,i) {
  temp1= windowdata %>% group_by(ID) %>%
    #summarise_if(is.numeric,funs(mean)) %>%   # we take the mean and not the sum, to account for different window size
    summarise_at(vars(Distance_traveled),funs(mean))

  temp2= windowdata %>% group_by(ID) %>%
    select (- Bin, -bintodark, -Distance_traveled) %>%
    summarise_if(is.numeric,funs(calcul))   # we take the mean and not the sum, to account for different window size
  #summarise_at(vars(Distance_traveled),funs(mean)) %>%

  temp = inner_join(temp1,temp2)
  names (temp)[-1]= paste0(names (temp)[-1],i)
  return(temp)
}

## function to work with hourly summary files: transform it into minute summary file by dividing scores by 60
xx_to_min <- function(behav_data,min_in_x=60){
  temp= behav_data %>% select (-Bin) %>%
  mutate_all(funs(. /min_in_x))
  temp=temp[rep(seq_len(nrow(temp)), each=min_in_x),]
  result =cbind (Bin=seq(1:(nrow(behav_data)*min_in_x)),
                               temp)
  return(result)
}

## function to create min summary file from the mbr file, note that we had an unknown behavior for the first time with no data,
## while the HCS export function do not integrate it at all

min_from_mbr <- function(rawdata,fpersec,Behav_code) {
  #-- get rid of last row (distance traveled)
  rawdata=rawdata [-nrow(rawdata),]
  #-- get comon names
  names (rawdata)= c("start", "end", "behavior")

  #-- change behavior code to 2 digit
  rawdata= rawdata %>% mutate (behavior = behavior-round(behavior, digits = -2))

  #-- pool elements with same name
  rawdata$behavior [rawdata$behavior== 14] <- 13
  rawdata$behavior [rawdata$behavior== 18] <- 17
  rawdata$behavior [rawdata$behavior== 31] <- 30

  #-- add first line with no data
  fline= c(0,rawdata$start[1], 44 )
  rawdata =rbind(fline, rawdata)

  #Create summary (will be a function), note that bin is in frames, 25 frames per sec.
  fpermin= 60*fpersec

  Binned_data = data.frame()

  MAXbin=trunc(rawdata$end [length(rawdata$end)]/fpermin)
  for (bin in seq(1:MAXbin)){
    starttime = (bin-1)*fpermin
    endtime = bin*fpermin

    subset_data = rawdata %>% filter (start < endtime & end >starttime)
    subset_data$start [1]=starttime
    subset_data$end [length(subset_data$end)]=endtime

    temp=subset_data %>% transmute (duration = end-start, behavior = behavior)
    temp=  temp %>%
      group_by(behavior) %>%
      dplyr::summarize (sum(duration), .groups = "keep")

    temp2 =left_join(Behav_code, temp, by = "behavior")
    #replace NA with 0
    temp2$`sum(duration)` = replace(temp2$`sum(duration)`,is.na(temp2$`sum(duration)`), 0)
    temp2 = na.omit(temp2)

    result = c(bin,temp2$`sum(duration)`/fpersec)
    Binned_data= rbind(Binned_data,result)

  }

  names(Binned_data)= c("Bin",na.omit(Behav_code$beh_name))
  return(Binned_data)
}

rawd_from_mbr <- function(rawdata,fpersec,Behav_code) {
  #-- get rid of last row (distance traveled)
  rawdata=rawdata [-nrow(rawdata),]
  #-- get comon names
  names (rawdata)= c("start", "end", "behavior")

  #-- change behavior code to 2 digit
  rawdata= rawdata %>% mutate (behavior = behavior-round(behavior, digits = -2))

  #-- pool elements with same name
  rawdata$behavior [rawdata$behavior== 14] <- 13
  rawdata$behavior [rawdata$behavior== 18] <- 17
  rawdata$behavior [rawdata$behavior== 31] <- 30

  #-- add first line with no data
  fline= c(0,rawdata$start[1], 44 )
  rawdata =rbind(fline, rawdata)
  left_join(rawdata, Behav_code, by = "behavior")

  return(rawdata)
}


## compare RT variance between multiple alignment with STAN,
# and reference experiment method

library('readr')
library('MASS')

# reference experiment method -------

fix.evidence.v2('dat/evidence.txt', 'dat/ev.ed.txt')
find.ref.exp('dat/ev.ed.txt', 'dat/ref.picks.txt')
ref.exp <- "160712A_NC_19B_targeted"
make.lib('dat/ev.ed.txt', 'dat/RT.lib.txt','dat/shift.coeffs.txt', ref.exp)
dRT('dat/RT.lib.txt','dat/shift.coeffs.txt','dat/evidence.txt','dat/evidence+dRT.txt')

# reference experiment method - elite only -------

fix.evidence.elite('dat/evidence.txt', 'dat/ev.ed.elite.txt')
find.ref.exp('dat/ev.ed.elite.txt', 'dat/ref.picks.elite.txt')
ref.exp.elite <- "160712A_NC_19B_targeted"
make.lib('dat/ev.ed.elite.txt', 'dat/RT.lib.elite.txt',
         'dat/shift.coeffs.elite.txt', ref.exp.elite)
dRT('dat/RT.lib.elite.txt','dat/shift.coeffs.elite.txt',
    'dat/evidence.txt','dat/evidence+dRT.elite.txt')

## analyze ref experiment method -------

ev <- read_tsv('dat/evidence+dRT.txt')
ev.f <- ev[ev$PEP < 0.05,c('Raw.file','Sequence','PEP', 'Retention.time',
                           'RT.lib','RT.corrected','dRT', 'PEP.new')]
ev.f <- ev.f[order(ev.f$Sequence),]
rt.var <- aggregate(RT.corrected ~ Sequence, data=ev.f, FUN=var)
with(rt.var, hist(RT.corrected[RT.corrected<10],
                  breaks=seq(0,10,by=0.1),
                  main=paste('dRT Ref Exp Method - RT Variance\n',
                             '# Peptides > 10:',sum(RT.corrected>10, na.rm=TRUE),
                             '(',formatC(sum(RT.corrected>10, na.rm=TRUE)/
                                           length(RT.corrected)*100, digits=4),'% )'),
                  xlab='RT Variance'
))

# elite
ev.elite <- read_tsv('dat/evidence+dRT.elite.txt')
ev.elite.f <- ev.elite[ev.elite$PEP < 0.05,]
rt.var.elite <- aggregate(RT.corrected ~ Sequence, data=ev.elite.f, FUN=var, na.action = na.omit, na.rm=TRUE)
with(rt.var.elite, hist(RT.corrected[RT.corrected<10],
                  breaks=seq(0,10,by=0.1),
                  main=paste('dRT Ref Exp Method - RT Variance - Elite Only\n',
                             '# Peptides > 10:',sum(RT.corrected>10, na.rm=TRUE),
                             '(',formatC(sum(RT.corrected>10, na.rm=TRUE)/
                                           length(RT.corrected)*100, digits=4),'% )'),
                  xlab='RT Variance'
))

## analyze multiple alignment method -----

# load evidence, and extract peptide_ids and experiment_ids
evidence <- read_tsv("dat/evidence.txt")
subEvidence <- evidence[evidence$PEP < 0.05, c("Peptide ID", "Raw file", "Retention time")]

true_peptide_id <- subEvidence[["Peptide ID"]]
peptide_id <- as.numeric(as.factor(subEvidence[["Peptide ID"]]))

peptideCounts <- as.data.frame(sort(table(peptide_id), decreasing=TRUE))

# load STAN params
params <- load('dat/params.RData')

# load standard deviations
ma.rt.var <- pars[grep('sigma', names(pars))]
hist(as.numeric(ma.rt.var[ma.rt.var < 10]),
     breaks=seq(0,10,by=0.1),
     main=paste('Multiple Alignment (STAN) - RT Variance\n',
                '# Peptides > 10:', sum(ma.rt.var>10), '(',
                formatC(sum(ma.rt.var>10)/length(ma.rt.var)*100, digits=4),'% )'),
     xlab='RT Variance')

# STAN w/ Elite only
subEvidence <- evidence[evidence$PEP < 0.05, c("Peptide ID", "Raw file", "Retention time")]
subEvidence <- subEvidence[grep('[0-9]{6}?A', subEvidence$`Raw file`),]

params <- load('dat/params_elite.RData')
ma.rt.var.elite <- pars[grep('sigma', names(pars))]
hist(as.numeric(ma.rt.var.elite[ma.rt.var.elite < 10]),
     breaks=seq(0,10,by=0.1),
     main=paste('Multiple Alignment (STAN) - RT Variance\nElite Only\n',
                '# Peptides > 10:', sum(ma.rt.var.elite>10), '(',
                formatC(sum(ma.rt.var.elite>10)/length(ma.rt.var.elite)*100, digits=4),'% )'),
     xlab='RT Variance')

## plot RT variances of both methods against each other -----

subEvidence <- evidence[evidence$PEP < 0.05, c("Sequence", "Peptide ID", "Raw file", "Retention time")]
true_peptide_id <- subEvidence[["Peptide ID"]]
peptide_id <- as.numeric(as.factor(subEvidence[["Peptide ID"]]))

peptideCounts <- sort(table(peptide_id), decreasing=TRUE)

# map RT variance (sigma) to peptide ID
c <- data.frame(
  Sequence=as.character(rep(NA, length(peptideCounts))),
  RTVar=as.numeric(rep(NA, length(peptideCounts))),
  Peptide.ID=as.integer(rep(NA, length(peptideCounts))),
  True.Peptide.ID=as.integer(rep(NA, length(peptideCounts)))
)

c$Peptide.ID <- seq(1, length(peptideCounts), by=1)
c$RTVar <- pars[sprintf('sigma[%i]', c$Peptide.ID)]
# map true_peptide_id to peptide_id
c$True.Peptide.ID <- true_peptide_id[match(c$Peptide.ID, peptide_id)]
# map sequence to true_peptide_id
c$Sequence <- subEvidence[match(c$True.Peptide.ID, subEvidence$`Peptide ID`),]$Sequence
# remove peptides with 1 PSM from MA-STAN method results
#c <- c[c$Num.PSMs > 1,]

# remove peptides with 1 PSM (and no RT variance) from dRT method results, or
# peptides with 0 variance
rt.var.f <- rt.var[!is.na(rt.var$RT.corrected) & rt.var$RT.corrected > 0,]
rownames(rt.var.f) <- NULL
# get matching sequences from MA-STAN results
c.f <- c[match(rt.var.f$Sequence, c$Sequence),]
rownames(c.f) <- NULL

# scatterplot RT variances
rt.var.all <- cbind(rt.var.f, c.f$RTVar)
names(rt.var.all) <- c('Sequence', 'dRT.var', 'MA.var')
ggplot(rt.var.all, aes(dRT.var, MA.var)) +
  geom_point(alpha=0.1, colour='black') +
  geom_abline(intercept=0,slope=45) +
  scale_x_log10() + scale_y_log10()


#functions used to calculate differentiation between two populations or diversity statistics within populations
# make sure the output file is already written in format (header):
# population1	population2	statistic	chromosome	start	end	number_sites	number_variable_sites	calculated_stat
# e.g., write(c("pop1", "pop2", "stat", "chr", "start", "end", "number_sites", "number_variable_sites", "calculated_stat"), ncolumns=9, file=outname, sep="\t")

# input is simplified vcf (entire vcf) and 3-column popmap (ordered the same as the vcf) and output file name
# and the input simple vcf file name that contains the chr and start and end information
# only calculate for invariant sites and biallelic snps
heterozygosity <- function(xxx, popmap, outname, filename) {
	options(scipen=999)
	xxx <- xxx[nchar(xxx[,2]) == 1 & nchar(xxx[,3]) == 1, ]
	for(a in 1:nrow(popmap)) {
		output_rep <- c(popmap[a,1], "none", "heterozygosity", strsplit(filename, ":")[[1]][1],
			as.numeric(strsplit(strsplit(filename, ":")[[1]][2], "-")[[1]][1]),
			as.numeric(strsplit(strsplit(filename, "-")[[1]][2], ".simple")[[1]][1]))
		# select this individual
		a_rep <- xxx[,a+3]
		# remove missing genotypes
		a_rep <- a_rep[a_rep != "./."]
		# count number of sites
		a_total <- length(a_rep)
		# remove phasing information
		a_rep <- gsub("\\|", "/", a_rep)
		# find number of heterozygous sites
		a_het <- length(a_rep[a_rep == "0/1"])
		# add to output
		output_rep <- c(output_rep, a_total, a_het, a_het/a_total)
		write(output_rep, file=outname, append=T, ncolumns=9, sep="\t")
	}
}

# function to determine if a site is only missing data for a population (used across rows of vcf)
# used in differentiation function
total_missing <- function(xxx) {
	return(length(xxx[xxx != "./."]) > 0)
}
# function to determine if a site has any missing data (used across rows of vcf)
any_missing <- function(xxx) {
	return(length(xxx[xxx == "./."]) > 0)
}
# function to determine if a site is polymorphic (to be applied across rows) after removing missing
# used in differentiation function
polymorphic_function2 <- function(xxx) {
	xxx <- xxx[xxx != "./."]
	return(length(unique(xxx)))
}

# input is two simplified vcfs (subsampled to single population), already filtered for invariant/biallelic SNPs,
# the names of the populations, and output file name
# and the input simple vcf file name that contains the chr and start and end information
# only calculate for invariant sites and biallelic snps
# fst is calculation of Reich et al. 2009
# fst is the reich et al. 2009 estimator for small sample sizes
# equation presented nicer in Willing et al. 2012 page 9

differentiation <- function(xxx1, xxx2, popname1, popname2, outname, filename) {
	# remove phasing information
	for(a in 1:ncol(xxx1)) {
		xxx1[,a] <- gsub("\\|", "/", xxx1[,a])
	}
	for(a in 1:ncol(xxx2)) {
		xxx2[,a] <- gsub("\\|", "/", xxx2[,a])
	}

	# remove sites that are completely missing from either population
	keep1 <- apply(xxx1, 1, total_missing)
	keep2 <- apply(xxx2, 1, total_missing)
	xxx1 <- xxx1[keep1 == TRUE & keep2 == TRUE, ]
	if(is.null(dim(xxx1))) { xxx1 <- as.matrix(xxx1) }
	xxx2 <- xxx2[keep1 == TRUE & keep2 == TRUE, ]
	if(is.null(dim(xxx2))) { xxx2 <- as.matrix(xxx2) }

	# count the total number of included genotyped sites at this point
	n_sites <- nrow(xxx1)

	# combine the two matrices to find sites that are variant w/in and between the two pops
	xxx_combined <- cbind(xxx1, xxx2)
	variant_sites <- apply(xxx_combined, 1, polymorphic_function2)

	# keep only variant sites
	xxx1_variant <- xxx1[variant_sites > 1, ]
	if(is.null(dim(xxx1_variant))) { xxx1_variant <- as.matrix(xxx1_variant) }
	xxx2_variant <- xxx2[variant_sites > 1, ]
	if(is.null(dim(xxx2_variant))) { xxx2_variant <- as.matrix(xxx2_variant) }

	# count the number of variant sites
	n_variant_sites <- nrow(xxx1_variant)

	# loop for each polymorphic site to calculate dxy
	dxy_all <- list()
	for(a in 1:nrow(xxx1_variant)) {
		a_rep1 <- as.character(xxx1_variant[a,])
		a_rep2 <- as.character(xxx2_variant[a,])

		# remove missing
		a_rep1 <- a_rep1[a_rep1 != "./."]
		a_rep2 <- a_rep2[a_rep2 != "./."]

		# measure proportion of reference allele
		a_ref1 <- (length(a_rep1[a_rep1 == "0/0"]) * 2 + length(a_rep1[a_rep1 == "0/1"]) * 1) / (length(a_rep1) * 2)
		a_ref2 <- (length(a_rep2[a_rep2 == "0/0"]) * 2 + length(a_rep2[a_rep2 == "0/1"]) * 1) / (length(a_rep2) * 2)

		# calc dxy
		dxy_all[[a]] <- a_ref1 * (1 - a_ref2) + a_ref2 * (1 - a_ref1)
	}
	dxy_all <- sum(unlist(dxy_all)) / n_sites

	# loop for each polymorphic site to calculate fst
	numerator_all <- list()
	denominator_all <- list()
	for(a in 1:nrow(xxx1_variant)) {
		a_rep1 <- as.character(xxx1_variant[a,])
		a_rep2 <- as.character(xxx2_variant[a,])

		# remove missing
		a_rep1 <- a_rep1[a_rep1 != "./."]
		a_rep2 <- a_rep2[a_rep2 != "./."]

		# number of individuals per population
		pop1_ind_count <- length(a_rep1)
		pop2_ind_count <- length(a_rep2)

		# non-reference allele counts
		alt_allele_count1 <- (2 * length(a_rep1[a_rep1 == "1/1"]) + 1 * length(a_rep1[a_rep1 == "0/1"]))
		alt_allele_count2 <- (2 * length(a_rep2[a_rep2 == "1/1"]) + 1 * length(a_rep2[a_rep2 == "0/1"]))

		# total allele counts
		all_allele_count1 <- 2 * length(a_rep1)
		all_allele_count2 <- 2 * length(a_rep2)

		# expected heterozygosity for each population
		expected_het1 <- (alt_allele_count1 * (all_allele_count1 - alt_allele_count1)) /
			(all_allele_count1 * (all_allele_count1 - 1))
		expected_het2 <- (alt_allele_count2 * (all_allele_count2 - alt_allele_count2)) /
			(all_allele_count2 * (all_allele_count2 - 1))

		# find the fst numerator and denominator values for this snp (they all get summed and divided for
		# the final estimate)
		numerator_all[[a]] <- (alt_allele_count1 / (2 * pop1_ind_count) -
			alt_allele_count2 / (2 * pop2_ind_count))^2 - (expected_het1 / (2 * pop1_ind_count)) -
			(expected_het2 / (2 * pop2_ind_count))
		denominator_all[[a]] <- numerator_all[[a]] + expected_het1 + expected_het2
	}
	# calculate total fst for this window
	fst_all <- sum(unlist(numerator_all)) / sum(unlist(denominator_all))

	# write to output for dxy and fst
	output_rep1 <- c(popname1, popname2, "Dxy", strsplit(filename, ":")[[1]][1],
				as.numeric(strsplit(strsplit(filename, ":")[[1]][2], "-")[[1]][1]),
				as.numeric(strsplit(strsplit(filename, "-")[[1]][2], ".simple")[[1]][1]),
				n_sites, n_variant_sites, dxy_all)
	output_rep2 <- c(popname1, popname2, "Fst", strsplit(filename, ":")[[1]][1],
				as.numeric(strsplit(strsplit(filename, ":")[[1]][2], "-")[[1]][1]),
				as.numeric(strsplit(strsplit(filename, "-")[[1]][2], ".simple")[[1]][1]),
				n_sites, n_variant_sites, fst_all)
	write(output_rep1, file=outname, append=T, ncolumns=9, sep="\t")
	write(output_rep2, file=outname, append=T, ncolumns=9, sep="\t")

}


#clean
rm(list=ls())

# load lib
library(doParallel)
library(raster)

# load params
pars <- read.table("./pars/GenSA_rf_all_2_5y_rep1.txt",row.names=1)

# list landscape
clim_files <- list.files("data/futClimGrid/stmClim",full.names=TRUE)

# source res analytics function
source('./lib/resAnalytics.r')
source('./lib/convertStates.r')

# create output dir
system('mkdir -p ./data/futStatesGrid/probs')
system('mkdir -p ./data/futStatesGrid/stm100')
system('mkdir -p ./data/futStatesGrid/stm1000')

# open cluster
cl <- makeCluster(35)
registerDoParallel(cl)

###### PROBS

# foreach(i=1:length(clim_files),.packages=c('raster','rgdal'))%dopar%{
#
#   ### READ
#   climGrid <- read.csv(clim_files[i],header=TRUE,stringsAsFactors=FALSE)
#   names(climGrid)[4:5] <- c("tp","pp")
#
#   # set NA in order to solve
#   climGrid$tp[which(climGrid$tp == -9999)] <- NA
#   climGrid$pp[which(climGrid$pp == -9999)] <- NA
#
#   #### SOLVE
#   probsGrid <- solve_stm(climGrid_scale,pars)
#   probsGrid  <- data.frame(x=climGrid$x,y=climGrid$y,probsGrid,stringsAsFactors=FALSE)
#
#   # get metadata
#   filename <- strsplit(clim_files[i],"[/.]")[[1]][4]
#
#   # write
#   write.csv(probsGrid,file=paste0("./data/futStatesGrid/probs/",filename,".csv"),row.names=FALSE)
#
# }

###### STATES

probs_files <- list.files("./data/futStatesGrid/probs",full.names=TRUE,pattern="1985-2000")

#load raster ref
ref_rs100 <- readRDS("data/futClimGrid/rasterClim/res100/rcp85-ACCESS1_0-1985-2000.rda")
ref_rs1000 <- readRDS("data/futClimGrid/rasterClim/res1000/rcp85-ACCESS1_0-1985-2000.rda")

foreach(i=1:length(probs_files),.packages=c('raster','rgdal'))%dopar%{

  probsGrid <- read.csv(probs_files[i])

  states <- character(0)

  for(r in 1:nrow(probsGrid)){
      if(any(is.na(probsGrid[r,3:5]))){
        states <- append(states,NA)
      } else {
        states <- append(states,names(which.max(probsGrid[r,3:5])))
      }
  }

  stmGrid <- data.frame(coordinates(ref_rs1000),state=stateToId(states),stringsAsFactors=FALSE)

  # turn into raster using clim rs
  rs_stmGrid <- stmGrid
  coordinates(rs_stmGrid) <- ~ x + y
  gridded(rs_stmGrid) <- TRUE
  rs_stmGrid <-  raster(rs_stmGrid)
  projection(rs_stmGrid) <- projection(ref_rs1000)

  ########## CREATE RES 1000
  df_stmGrid_1000 <- as.data.frame(rs_stmGrid,xy=TRUE)

  # turn coord into facteur
  df_stmGrid_1000$x <- as.numeric(as.factor(df_stmGrid_1000$x)) - 1
  df_stmGrid_1000$y <- as.numeric(as.factor(df_stmGrid_1000$y)) - 1
  df_stmGrid_1000$state <- idToState(df_stmGrid_1000$state)
  df_stmGrid_1000[is.na(df_stmGrid_1000$state),"state"] <- 0

  ########## CREATE RES 100
  # reample using ref_rs100
  rs_stmGrid_100 <- resample(rs_stmGrid,ref_rs100,method="ngb")
  df_stmGrid_100 <- as.data.frame(rs_stmGrid_100,xy=TRUE)

  # get metadata
  filename <- strsplit(probs_files[i],"[/.]")[[1]][6]
  filename <- paste(strsplit(filename,"[-]")[[1]][c(1,2,4)],collapse="-")

  # turn coord into facteur
  df_stmGrid_100$x <- as.numeric(as.factor(df_stmGrid_100$x)) - 1
  df_stmGrid_100$y <- as.numeric(as.factor(df_stmGrid_100$y)) - 1
  df_stmGrid_100$state <- idToState(df_stmGrid_100$state)
  df_stmGrid_100[is.na(df_stmGrid_100$state),"state"] <- 0

  # save for stm input
  write.table(df_stmGrid_100,file=paste0("./data/futStatesGrid/stm100/",filename,".stm"),quote=FALSE,row.names=FALSE,col.names=FALSE,sep=",")
  write.table(df_stmGrid_1000,file=paste0("./data/futStatesGrid/stm1000/",filename,".stm"),quote=FALSE,row.names=FALSE,col.names=FALSE,sep=",")

}


#' Plot index at age consistency
#'
#' Lattice style plot of index catch at age X vs age Y with each point a cohort for each fleet. Computed for both input and predicted index catch at age.
#' @param asap name of the variable that read in the asap.rdat file
#' @param index.names names of indices
#' @param save.plots save individual plots
#' @param od output directory for plots and csv files
#' @param plotf type of plot to save
#' @return list with correlation matrices for input and predicted catch at age matrices for each fleet
#' @export

PlotIndexAtAgeConsistency <- function(asap,index.names,save.plots,od,plotf){
  # first check to see if any West Coast style indices
  if(sum(asap$control.parms$index.age.comp.flag) == 0){
    return(list())
  }

  # now loop through indices, check to make sure actually estimating proportions at age
  # also need to use only the age range selected in the proportions

  index.corr <- list()

  # convert the west coast style indices to catch at age matrices
  index.mats <- ConvertSurveyToAtAge(asap)

  # loop through all the indices
  for (ind in 1:asap$parms$nindices){
    if (asap$control.parms$index.age.comp.flag[ind] == 1){  # used age composition for the index
      title1 <- paste0("Index ",ind," (",index.names[ind],")")

      # replace zeros with NA and take logs
      iob <- rep0log(index.mats$ob[[ind]])
      ipr <- rep0log(index.mats$pr[[ind]])

      # make cohorts
      iob.coh <- makecohorts(iob)
      ipr.coh <- makecohorts(ipr)

      # get age range for index
      age.min <- asap$control.parms$index.sel.start.age[ind]
      age.max <- asap$control.parms$index.sel.end.age[ind]

      # make the plots
      iob.cor <- PlotCoh(iob.coh,save.plots,od,plotf,mytitle=paste0(title1," Observed"),mylabels=paste0("age-",seq(age.min,age.max)))
      ipr.cor <- PlotCoh(ipr.coh,save.plots,od,plotf,mytitle=paste0(title1," Predicted"),mylabels=paste0("age-",seq(age.min,age.max)))
      index.corr[[ind]] <- list(iob.cor,ipr.cor)
    }
  }
  return(index.corr)
}


rm(list = ls())

### Will help in answering popularity of tags, most enquired topics
library(readr)
library(dplyr)
library(lubridate)

## Changing the path to working directory
setwd('/home/akanksha/Desktop/Sem III/ML/Course Project/Dataset/pythonquestions')

## Reading the files
questions <- read_csv('Questions.csv')
answers <- read_csv('Answers.csv')
tags <- read_csv('Tags.csv')

## Filtering out the questions of 2008 year
questions_2008 <- filter(questions, year(CreationDate) == "2008")
answers_2008 <- filter(answers, year(CreationDate) == "2008")
merged_df_ques <- left_join(questions_2008, tags, by = "Id")
# change the column name of answers_2008 data frame to avoid duplication while merging
names(answers_2008)[names(answers_2008) == 'Id'] <- 'AnswerId'
merged_df_ans <- merge(merged_df_ques, answers_2008, by.x = "Id", by.y = "ParentId", all.x = TRUE)

## Count the popularity of each tag
## MOST ENQUIRED TAGS/TOPICS
pop_tags_2008 <- merged_df_ques %>% select(Id,Tag) %>% count(Tag,sort=TRUE) %>% mutate(freq=paste0(round(100*n/sum(n),2),"%"))

## MOST VOTED QUESTIONS/ANSWERS/TAGS
# Which tags tend to have higher/lower score?
summary(questions_2008$Score)

# Calculate average score for each tag
# Tags ordered on the basis of most questions asked
score_tags_2008_ordered_questions <- merged_df_ques %>% select(Score, Tag) %>% group_by(Tag) %>% summarize(score_avg = mean(Score), n_questions = n()) %>% arrange(desc(n_questions))

# Tags ordered on the basis of decreasing average score
score_tags_2008_ordered_score <- merged_df_ques %>% select(Score, Tag) %>% group_by(Tag) %>% summarize(score_avg = mean(Score), n_questions = n()) %>% arrange(desc(score_avg))

# From the average score values, there seem to be a higher tendency to upvote/downvote questions

# Top 10 scored 'python' questions
merged_df_ques %>% filter(Tag == 'python') %>% arrange(desc(Score)) %>% select(Title) %>% head(10)

# Popular users
# number of users answered for each tag arranged in descending order
pop_users_tags <- merged_df_ans %>% select(OwnerUserId.y, Tag) %>% group_by(Tag) %>% summarize(n_users = n()) %>% arrange(desc(n_users))

# popular users who answered most questions
pop_users_ans <- merged_df_ans %>% filter(Tag == 'python') %>% select(OwnerUserId.y, AnswerId) %>% group_by(OwnerUserId.y) %>% summarize(n_ans = n()) %>% arrange(desc(n_ans))

# popular users who achieved highest scores
pop_users_score <- merged_df_ans %>% filter(Tag == 'python') %>% select(OwnerUserId.y, Score.y) %>% group_by(OwnerUserId.y) %>% summarize(score_avg = sum(Score.y)) %>% arrange(desc(score_avg))


library(ggvis)
library(dplyr)
library(here)
library(tidyr)
library(stringr)
library(stringi)
library(tictoc)
library(data.table)
library(purrr)
library(readr)
library(lubridate)
library(VIM)
library(ggplot2)
library(plotly)
library(shiny)
library(shinydashboard)
library(reshape2)
library(DT)
library(shinycssloaders)
library(readxl)

# For dropdown menu
actionLink <- function(inputId, ...) {
  tags$a(href = 'javascript:void',
         id = inputId,
         class = 'action-button',
         ...)
}

dashboardPage(
  dashboardHeader(title = "Previne results: First glance"),

  # titlePanel("Previne Analysis"),

  #Sidebar####
  dashboardSidebar(

             h4("Filtros"),

             sliderInput("popsize", "1. População do Município (Pop. size)",
                         784, 12252023,
                         value = c(784, 12252023), sep = ",", step = 100),

             selectInput("xvar", "2. Eixo-X (x-axis)", axis_vars, selected = "UF"),
             selectInput("yvar", "3. Eixo-Y (y-axis)", axis_vars_numeric, selected = "dif_relative"),

             selectInput("region", "4. Região (Region)",
                       c("All", "Centro-oeste", "Norte", "Nordeste",
                         "Sul", "Sudeste") ),
             textInput("estado",
                       "5. Nome do Estado (name of state) (e.g., `Toc`)"),
             textInput("municipio",
                       "6. Nome do Município (name of Mun.)  (e.g., `Paulo`)"),

             selectInput("group", "7.Grupo (group)",
                         c("All", "Grande Acrescimo", "Acrescimo", "Decrescimo",
                           "Grande Decrescimo") ),

             selectInput("tipologia", "8. Tipologia (type)",
                         c("All", "IntermediarioAdjacente",
                           "IntermediarioRemoto","RuralAdjacente",
                           "RuralRemoto","Urbano")),

             selectInput("porte", "9. Porte (size)",
                         c("All", "P.Ate_20mil", "P.De20_49mil", "P.De50_100mil",
                           "P.De100_300mil", "P.Mais_de_300mil") ),

             selectInput("capital", "10. Capital (Main city)",
                       c("All", "Yes", "No") ),

             selectInput("group_transicao", "11. Resultados com/sem repasses de transição?", c("Com Transição", "Sem Transição") ),

             selectInput("fns_65584", "12. Recebe Per Capita de Transição (65584)?",
                       c("All", "Yes", "No") ),
             selectInput("fns_65586", "13. Recebe Fator Comp. de Transição (65586)?",
                         c("All", "Yes", "No") ),

             tags$small(paste0(
               "Nota: Esse app foi construido para facilitar a exploração dos dados do Previne Brasil. Para melhor compreender as variaveis usadas consulte a aba 'Dicionário'.")),
             tags$small(paste0(
               "Note: This app is meant for exploration only. Please refer to the dataset's dictionary to better understand each variable displayed."))
             #)
    ),#sidebar

  ##Body####
    dashboardBody(
        tabsetPanel(
    ###TAB 1 - Overview####
                  tabPanel("Overview",
                       h4("Acrescimo and Decrescimo"),
                       HTML(" Use the x-axis and y-axis
                                  filters to customize the graph.

 Tip: Use the mouse to see the
                            Municipality details. "),

                       wellPanel(
                                  HTML("
Sobre o Previne Brasil

 A portaria nº 2.979, de 12 de novembro de 2019, instituiu o Programa Previne Brasil (PB), que estabelece novo modelo de financiamento de custeio da Atenção Primária à Saúde no âmbito do Sistema Único de Saúde (SUS). De acordo com o Ministério da Saúde, '[a] proposta tem como princípio a estruturação de um modelo de financiamento focado em aumentar o acesso das pessoas aos serviços da Atenção Primária e o vínculo entre população e equipe, com base em mecanismos que induzem à responsabilização dos gestores e dos profissionais pelas pessoas que assistem'. O novo modelo de transferências federais busca incentivar o aumento da cobertura (cadastro) da Atenção Primária à Saúde (APS), principalmente entre as populações vulneráveis, assim como, melhorar os resultados de saúde da população (desempenho da APS). Logo o Previne Brasil simplifica as transferências da APS em um modelo misto de financiamento: (I) Capitação ponderada, (II) Pagamento por desempenho , e (III) incentivos a programas específicos/estratégicos.

 Apesar de haver simulações sobre o possível impacto do Previne Brasil, ainda não se sabe de fato os resultados alcançados pelo novo modelo de financiamento em seu primeiro ano de implementação. Importantes questionamentos surgem com o intuito de assegurar que o Previne Brasil está logrando os resultados almejados.

Esse painel explorativo dispõe de graficos para ajudarem a melhor entender os resultados preliminares do PB.
"),
                                  HTML("

 Número de Municípios selecionados:"),
                                  textOutput("n_mun") %>%
                                    withSpinner(color = "#0dc5c1"),
                                  textOutput("groups_txt"),
                                  textOutput("GA_txt"),
                                  textOutput("A_txt"),
                                  textOutput("D_txt"),
                                  textOutput("GD_txt")
                                        ), #wellPanel
                       column(12,
                       div(style = "width:600px;",

                           HTML(" Graph 1: Municipalities by groups "),
                                    ggvisOutput("plot1"),
                           HTML("Filtros selecionados: "),
                           textOutput("displayfilter")))

                             ), #Tab 1

    ###TAB 2 - Grupos: Acréscimo X Decréscimo####
                  tabPanel("Grupos: Acréscimo X Decréscimo",
                           h4("Observing differences between groups"),
                           HTML(" Mean displayed at the center.

Tip: Use the mouse to see summary statistics,
                                click and drag to zoom in. "),
                           HTML("
  Graphs 2 and 3: Municipalities
                                by Acrescimo and Grande Acrescimo "),
                           splitLayout(plotlyOutput("Acrescimo") %>%
                                         withSpinner(color = "#0dc5c1"),
                            plotlyOutput("GrandeAcrescimo") %>%
                                       withSpinner(color = "#0dc5c1")),
                           HTML(" Graphs 4 and 5: Municipalities
                                by Decrescimo and Grande Decrescimo "),
                           splitLayout(plotlyOutput("Decrescimo") %>%
                                         withSpinner(color = "#0dc5c1"),
                                        plotlyOutput("GrandeDecrescimo") %>%
                                         withSpinner(color = "#0dc5c1") )
                          ), #Tab 2

    ###TAB 3-  Proportions####
                  tabPanel("Proportions by Region and Porte",
                            h4("Graph 6: Differences by Region"),
                           HTML(" Pre-defined graphs to show proportions.
                                Y-Axis selection is disabled. "),
                          plotlyOutput("Prev_prop") %>%
                                         withSpinner(color = "#0dc5c1"),

                          HTML(" Graph 7: Registrations (red) and
                                Declared eSF Coverage (blue)"),
                          plotlyOutput("Cad_Cob") %>%
                                         withSpinner(color = "#0dc5c1")

                           ),#Tab 3

    #TAB 4 - Repasses####
    tabPanel("Repasses",
             h4("Evolução dos Repasses segundo as categorias do Previne"),

             HTML(" Por enquanto só é possivel calcular a evolução da Capitação Ponderada. "),
             plotlyOutput("EvolucaoRepasses") %>%
               withSpinner(color = "#0dc5c1")

    ), #TAB 4

    #TAB 5 - Dictionary####
                  tabPanel("Variable Dictionary",
                           h4("Description of variables"),
                           HTML(" Use the search bar to find the details
                                on the variable of interest. "),
                           DTOutput("dict") %>%
                             withSpinner(color = "#0dc5c1")

    ), #TAB 5

    #TAB 6 - Contato####
    tabPanel("Contato",
             h3("Contato "),
             HTML("Mario Saraiva - s.mario@columbia.edu"),
             HTML("
Disclaimer: The views expressed in this app are the
                  responsibility of the author.
")

             ) #TAB 6
    ),#TabPannels
    tags$head(
      tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: #7796AF}")),
      tags$style("#group ~ .selectize-control .option:nth-child(odd) {
                 background-color: #CACCCD;" ),

      tags$style("#xvar ~ .selectize-control .option:nth-child(odd) {
                 background-color: #CACCCD;" ),

      tags$style("#yvar ~ .selectize-control .option:nth-child(odd) {
                 background-color: #CACCCD;" ),

      tags$style("#region ~ .selectize-control .option:nth-child(odd) {
                 background-color: #CACCCD;" ),

      tags$style("#Tipologia ~ .selectize-control .option:nth-child(odd) {
                 background-color: #CACCCD;" ),

      tags$style(" #capital ~ .selectize-control .option:nth-child(odd) {
                 background-color: #CACCCD;" ),

      tags$style(" #fns_65584 ~ .selectize-control .option:nth-child(odd) {
                 background-color: #CACCCD;" ),

      tags$style(" #fns_65586 ~ .selectize-control .option:nth-child(odd) {
                 background-color: #CACCCD;" )
      ) #HeadTags

    ) #body

  ) # page


###################################################################################################################
# R script to simulate rna-seq reads from hg38 transcriptome reference using polyester simulator                  #
###################################################################################################################
# Usage: R < polyester.r --no-save
# For hg38 transcriptome, needs ~ 16G memory
# Output fa files ~20G (unzipped)

library(Biostrings)
library(polyester)

#Set number of repeats to simulate
num_repeats = 5

#Set a seed
the_seed = 1

# Path to cdna file.
# Used gffread and gtf reference found at /sudlab1/.../annotations/hg38_noalt_ensembl85/ensembl.dir/ to produce "transcripts.fa"
fastapath <-  '../../refiles/transcripts.fa'

# Read transcripts reference file into a variable, transcripts
transcripts = readDNAStringSet(fastapath)

# Split the fasta into chunks (to help with memory issues).
chunks = 50
transcript_count = length(transcripts)
assignment = rep(1:chunks, each=ceiling(transcript_count/chunks))[1:transcript_count]

# Create a loop that loops from 1 -> Chunks
for(i in 1:chunks){

      # Creating a "sub" fasta file containing the transcripts needed for the chunk
      fasta_sub = transcripts[assignment==i]
      writeXStringSet(fasta_sub, 'fasta_sub.fasta')

      # set number of reads as a function of the length of the transcript * a fold a coverage
      readspertx = round(20 * width(fasta_sub) / 100)

      # adding gc_bias to sample
      # Count the number of transcripts in the sub_fasta chunk
      numtx = count_transcripts('fasta_sub.fasta')

      # Create a "readmatrix" that will hold the read counts for all the transcripts and for each sample
      # Assign initial values as readspertx (set above)
      readmat = matrix(readspertx, ncol=num_repeats, nrow=numtx)

      # Set the seed as the number given before the loop. This ensures each sample recieves the same GC-bias model
      set.seed(the_seed)

      # Assign a number between 0-7 which corresponds to a built-in GC-bias model
      biases = sample(0:7, num_repeats, replace=TRUE)

      #Assign GC-bias models to readcounts using add_gc_bias function to the readmatrix created above
      readmat_biased = add_gc_bias(readmat, as.list(biases), fasta_sub)

      # Remove any values which were very small (0 reads) or were "N/A" in the readmatrix, as this causes
      # errors later on. Assign very small read counts to these transcripts (0.000000001)
      readmat_biased[readmat_biased<=0] <- 0.000000001
      readmat_biased[is.numeric(readmat_biased) & is.na(readmat_biased)] <- 0.000000001

      # Output the read counts for the chunk to a tab seperated file
      write.table(readmat_biased, file=paste0('simulated_reads/chunk_',i,'_readmatrix.txt'), row.names=FALSE, col.names=FALSE)

      # Run the read_simulator to output reads for each sample. Reads are saved in seperate "chunk" folders to be cat'ed
      # together after the simulations
      simulate_experiment_countmat(fasta='fasta_sub.fasta',
			  paired=TRUE,
			  readmat=readmat_biased,
			  num_reps=c(num_repeats),
			  outdir=paste0('simulated_reads/chunk_', i))
}


# Compile panel data set of indicators from:
    # Legatum Institute, Legatum Prosperity Index
    # Heritage Foundation, Index of Economic Freedom
    # World Bank, World Development Indicators (WDI)
    # BEA, United States FDI

# Set up libraries and paths --------------------------------------------------------

library(haven)
library(tidyverse)
library(plyr)
library(dplyr)
library(readxl)

# Change to your local drive
drive <- "S:\\"
ESDB  <- sprintf("%sESDB\\Database\\", drive)
Req   <- sprintf("%sEADS Requests\\2020_03_31 Michael Nicholson - Africa Poverty Research\\", drive)

# Import files -------------------------------------------------------------
# Get master ESDB files
series <- read_sas(sprintf("%sseries.sas7bdat", ESDB))
sources <- read_sas(sprintf("%ssources.sas7bdat", ESDB))

# Series and Country List
series_list <- read_xlsx(sprintf("%sEdited data\\series_list.xlsx", Req))
countries_list <- read_xlsx(sprintf("%sEdited data\\countries_list.xlsx", Req))

# Import ESDB Data --------------------------------------------------------

# Turn source_ids into sas dataset names
series_list$file <- ifelse(series_list$source_id <100,
                       str_c(ESDB,"_0",series_list$source_id,"data.sas7bdat"),
                       str_c(ESDB,"_",series_list$source_id,"data.sas7bdat"))

# Create lists of sources and series that we need
esdb_sources_needed = unique(series_list$file)
esdb_series_needed = series_list$series_id

# Create a function that will pull the data for the series and sources you need from the ESDB
# This function has three inputs:
  # x - sources
  # s - series
  # y - years
# It will look through the sas datasets and filter each for the series and years that you need.
pull_ESDB <- function(x, s, y){
  read_sas(x) %>%
    filter(series_id %in% s & year >=y) %>%
    select(country_id, series_id, year, value_start)
}

# Use the lists to pull ESDB data. The following will apply the list 'esdb_sources_needed' to the pull_ESDB function
# and return all of the datasets together as a dataframe 'ctd_esdb'
data_esdb <- ldply(.fun = pull_ESDB, .data = esdb_sources_needed, esdb_series_needed, 2009, .progress = progress_text())

# Format as panel data set ------------------------------------------------

data1 <- data_esdb %>%
  left_join(countries_list, by = "country_id") %>% # map in the countries wanted
  filter(country_name != "drop") %>%  # remove the extra countries
  left_join(series_list, by = "series_id") %>% # join in the series names
  select(country_id, country_name, code, year, value_start) %>% # drop unneccessary columns
  spread(code, value_start, fill = NA) %>%  # spread it to wide format
  mutate(fdi = ifelse(fdi == 88888888, NA, fdi),
         ln_gdp = log(gdp),  # take the natural log of these indicators
         ln_fdi = log(fdi))

write_csv(data1, sprintf("%sFinal data\\individual_african_countries.csv", Req), na = "")

# Compile Metadata --------------------------------------------------------

metadata <- series_list %>%
  left_join(sources, by = "source_id") %>%
  left_join(series, by = "series_id") %>%
  select(code, series_name.x, source_name, source_url, series_definition)

write_csv(metadata, sprintf("%sFinal data\\metadata.csv", Req), na = "")


13 + 4
-7
print(
1
)


# INSTALL/LOAD REQUIRED LIBRARIES
source('http://bioconductor.org/biocLite.R')
if(is.element('biocLite', installed.packages()[,1])==FALSE){
  biocLite()
}
required_libraries <- c('DBI', 'edgeR', 'gplots', 'KEGGREST', 'KEGG.db', 'pathview', 'RColorBrewer', 'xlsx')
for(library in required_libraries){
  if(is.element(library, installed.packages()[,1])==FALSE){
    biocLite(pkgs=library)
  }
}
library('DBI')
library('edgeR')
library('gplots')
library('KEGGREST')
library('KEGG.db')
library('pathview')
library('RColorBrewer')
library('xlsx')

# LOAD FUNCTIONS
source('data-analysis-functions.r')

# LOAD DATA
Counts <- read.delim(file.choose(), header=TRUE, skip=1, row.names=1)
Annotation <- read.delim(file.choose(), header=TRUE, skip=1, row.names=1)

# SET GLOBAL VARIABLES
CPM = 10
PCH_1 = 21
PCH_2 = 23
LOGFC_FILTER = 2
KEGG_SPECIES = 'lpl'

# VISUALIZE AND CHECK SEPARATION OF SAMPLES ON GROWTH MEDIUM AND STRAIN
All_group <- CreateGroup(c('WCFS1.glc', 'WCFS1.rib', 'NC8.glc', 'NC8.rib'))
All_data <- DataProcessing(All_group, 1, 8, CPM)
PlotSampleDistances('Distances between RNA-Seq samples', All_data, All_group)

# PROCESS DATA FOR WCFS1
WCFS1_group <- CreateGroup(c('WCFS1.glc', 'WCFS1.rib'))
WCFS1_data <- DataProcessing(WCFS1_group, 1, 4, CPM)
WCFS1_fit <- CreateModel('WCFS1', WCFS1_data, WCFS1_group)

# PROCESS DATA FOR NC8
NC8_group <- CreateGroup(c('NC8.glc', 'NC8.rib'))
NC8_data <- DataProcessing(NC8_group, 5, 8, CPM)
NC8_fit <- CreateModel('NC8', NC8_data, NC8_group)

# DETERMINE DE GENES
WCFS1_de_genes <- DetermineDEGenes(WCFS1_fit, LOGFC_FILTER)
NC8_de_genes <- DetermineDEGenes(NC8_fit, LOGFC_FILTER)

# DETERMINE PATHWAYS FOR ALL GENES (TURNED OFF BY DEFAULT)
# WCFS1_pathways_genes <- GetPathwaysForGenes(WCFS1_fit$table)
# NC8_pathways_genes <- GetPathwaysForGenes(NC8_fit$table)

# DETERMINE PATHWAYS FOR DE GENES
WCFS1_pathways_de_genes <- GetPathwaysForGenes(WCFS1_de_genes)
NC8_pathways_de_genes <- GetPathwaysForGenes(NC8_de_genes)

# VALIDATE RESULTS FOR WCFS1
WCFS1_overrep_pathways <- DeterminePathwayOverrep(WCFS1_fit, Inf)
WCFS1_annotated_results <- AnnotateGenes(WCFS1_fit$table)

# VALIDATE RESULTS FOR NC8
NC8_overrep_pathways <- DeterminePathwayOverrep(NC8_fit, Inf)
NC8_annotated_results <- AnnotateGenes(NC8_fit$table)

# PLOT DATA
PlotSampleDistances('Distances between WCFS1 RNA-Seq samples', WCFS1_data, WCFS1_group)
PlotSampleDistances('Distances between NC8 RNA-Seq samples', NC8_data, NC8_group)
PlotHeatMap(WCFS1_de_genes, NC8_de_genes, 50)
PlotKEGGpathway(WCFS1_pathways_de_genes, 'lpl00620', 'Pyruvate metabolism', WCFS1_fit)
PlotKEGGpathway(NC8_pathways_de_genes, 'lpl00620', 'Pyruvate metabolism', NC8_fit)

# EXPORT RESULTS
WriteResults('Results/RNA_Seq_analysis_results.xlsx', WCFS1_annotated_results, 'WCFS1 DE genes', WCFS1_overrep_pathways, 'WCFS1 Overrep pathways', WCFS1_pathways_de_genes, 'WCFS1 DE genes pathways')
WriteResults('Results/RNA_Seq_analysis_results.xlsx', NC8_annotated_results, 'NC8 DE genes', NC8_overrep_pathways, 'NC8 Overrep pathways', NC8_pathways_de_genes, 'NC8 DE genes pathways')

# CREATE GSEA INPUT FILES
CreateGeneSetsFile()
CreateGeneExpressionFile(WCFS1_de_genes['logFC'], NC8_de_genes['logFC'], c('WCFS1', 'NC8'))


library(rwebppl)
library(tidyverse)
library(ggthemes)
library(plyr)

states = c("X", "X,Y");
utterances = c('X', 'XorY', 'XandY', 'Z');

f <- data.frame(utterance=character(),
                state=character(),
                prob=integer(),
                stringsAsFactors=FALSE)

for (state in states){
  for (utt in utterances){
    d <- data.frame(u=character(),s=character())
    d <- rbind(d, data.frame(s = state, u = utt))
    f <- rbind(f, data.frame(s = state, u = utt, prob = webppl(program_file = "code_forgraphs.webppl", data = d, data_var = "input")))
  }
}

f$s <- revalue(f$s, c("X"="s = Cat on card", "X,Y"="s = Cat and dog on card"))
f$u <- revalue(f$u, c("X"="u = 'Cat'", "XorY" = "u = 'Cat or dog'", "XandY" = "u = 'Cat and dog'", "Z" = "u = 'Elephant'"))

f %>%
  ggplot(aes(x=u, y=prob)) +
  geom_bar(stat = "identity", position="dodge", width = 0.6) +
  facet_wrap(~s) +
  labs(x="", y="RSA speaker probability S(u|s)")+
  theme_few() +
  theme(text = element_text(size=12), axis.text.x = element_text(angle = 45, hjust = 1))
  scale_fill_manual(values = c("red4", "springgreen3"), guide=FALSE)


theme_set(theme_bw(18))
setwd("/Users/titlis/cogsci/projects/stanford/projects/overinformativeness/experiments/7_overinf_basiclevel_biggersample/results")
source("rscripts/helpers.r")

d = read.table(file="data/colsizeCor_manModified.csv",sep=",", header=T, quote="")
dd = read.table(file="data/colsize_manModified.csv",sep=",", header=T, quote="") # this is the dataset without exclusion of cases where listener chose wrongly, of which there are 33 -- some seem like isolated errors, but at least one pair looks like the listener is just randomly choosing
nrow(d)
nrow(dd)

d$Half = as.factor(ifelse(d$roundNum < 37, "first","second"))
d$Quarter = as.factor(ifelse(d$roundNum < 19, "first",ifelse(d$roundNum < 37,"second", ifelse(d$roundNum < 55, "third","fourth"))))
head(d)
nrow(d) # 2138 cases
unique(d$listenerMessages)

summary(d)
totalnrow = nrow(d)
totalnrow
d$TypeMentioned = d$typeMentioned
d[is.na(d$otherFeatureMentioned),]$otherFeatureMentioned = FALSE

# look at turker comments
comments = read.table(file="../mturk/overinf.csv",sep=",", header=T, quote="")

unique(comments$comments)

ggplot(comments, aes(ratePartner)) +
  geom_histogram()

ggplot(comments, aes(thinksHuman)) +
  geom_histogram()

ggplot(comments, aes(nativeEnglish)) +
  geom_histogram()

ggplot(comments, aes(totalLength)) +
  geom_histogram()

# first figure out how often target was chosen -- exclude trials where it wasn't?
table(d$condition,d$targetStatusClickedObj)
# prop.table(table(d$condition,d$targetStatusClickedObj),mar=c(1)) # it appears that in the size-only condition, there's twice as many distractor choices (13% vs 7%)
# chisq.test(table(d$condition,d$targetStatusClickedObj))

# how many unique pairs?
length(levels(d$gameid)) # 64

table(d$condition,d$TypeMentioned)
table(d$condition,d$sizeMentioned)
table(d$condition,d$colorMentioned)

### ANALYZE ONLY TRIALS WHERE COLOR/SIZE/NUMDISTRACTORS WAS MANIPULATED
# exclude pair where listener always seemed to click something completely different
d$SufficientProperty = as.factor(ifelse(d$condition %in% c("size21", "size22", "size31", "size32", "size33", "size41", "size42", "size43", "size44"), "size", "color"))
d$NumDistractors = ifelse(d$condition %in% c("size21","size22","color21","color22"), 2, ifelse(d$condition %in% c("size31","size32","size33","color31","color32","color33"),3,4))
d$NumDiffDistractors = ifelse(d$condition %in% c("size22","color22","size33","color33","size44","color44"), 0, ifelse(d$condition %in% c("size21","color21","size32","color32","size43","color43"), 1, ifelse(d$condition %in% c("size31","color31","size42","color42"),2,ifelse(d$condition %in% c("size41","color41"),3, 4))))
d$NumSameDistractors = ifelse(d$condition %in% c("size21","size31","size41","color21","color31","color41"), 1, ifelse(d$condition %in% c("size22","size32","size42","color22","color32","color42"), 2, ifelse(d$condition %in% c("size33","color33","size43","color43"),3,ifelse(d$condition %in% c("size44","color44"),4,NA))))

# add typicality norms for color ("how typical is this color for a stapler?" wording)
typicalities = read.table("/Users/titlis/cogsci/projects/stanford/projects/overinformativeness/experiments/8_norming_colorSize_typicality/results/data/typicalities.txt",header=T)
head(typicalities)
typicalities = typicalities %>%
  group_by(Item) %>%
  mutate(OtherTypicality = c(Typicality[2],Typicality[1]),OtherColor = c(as.character(Color[2]),as.character(Color[1])))
typicalities = as.data.frame(typicalities)
row.names(typicalities) = paste(typicalities$Item,typicalities$Color)
d$ColorTypicality = typicalities[paste(d$clickedType,d$clickedColor),]$Typicality
d$OtherColorTypicality = typicalities[paste(d$clickedType,d$clickedColor),]$OtherTypicality
d$OtherColor = typicalities[paste(d$clickedType,d$clickedColor),]$OtherColor
d$TypicalityDiff = d$ColorTypicality-d$OtherColorTypicality
d$normTypicality = d$ColorTypicality/(d$ColorTypicality+d$OtherColorTypicality)

# add typicality norms for color -- modified and unmodified ("how typical is this for a stapler?" vs "how typical is this for a red stapler?" wording)
typs = read.table("/Users/titlis/cogsci/projects/stanford/projects/overinformativeness/experiments/9_norming_colordescription_typicality/results/data/typicalities.txt",header=T)
head(typs)
typs = typs %>%
  group_by(Item) %>%
  mutate(OtherTypicality = c(Typicality[3],Typicality[4],Typicality[1],Typicality[2]))
typs = as.data.frame(typs)
row.names(typs) = paste(typs$Item,typs$Color,typs$Modification)
d$ColorTypicalityModified = typs[paste(d$clickedType,d$clickedColor,"modified"),]$Typicality
d$OtherColorTypicalityModified = typs[paste(d$clickedType,d$clickedColor,"modified"),]$OtherTypicality
d$TypicalityDiffModified = d$ColorTypicalityModified-d$OtherColorTypicalityModified
d$normTypicalityModified = d$ColorTypicalityModified/(d$ColorTypicalityModified+d$OtherColorTypicalityModified)
d$ColorTypicalityUnModified = typs[paste(d$clickedType,d$clickedColor,"unmodified"),]$Typicality
d$OtherColorTypicalityUnModified = typs[paste(d$clickedType,d$clickedColor,"unmodified"),]$OtherTypicality
d$TypicalityDiffUnModified = d$ColorTypicalityUnModified-d$OtherColorTypicalityUnModified
d$normTypicalityUnModified = d$ColorTypicalityUnModified/(d$ColorTypicalityUnModified+d$OtherColorTypicalityUnModified)

summary(d)

targets = d
nrow(targets) # 2138 cases
targets$UtteranceType = as.factor(ifelse(targets$sizeMentioned & targets$colorMentioned, "size and color", ifelse(targets$sizeMentioned, "size", ifelse(targets$colorMentioned, "color","OTHER"))))

#targets = droplevels(targets[!is.na(targets$UtteranceType),])
targets[targets$UtteranceType == "OTHER",c("gameid","refExp","condition")]
table(targets[targets$UtteranceType == "OTHER",]$gameid)
targets$Color = ifelse(targets$UtteranceType == "color",1,0)
targets$Size = ifelse(targets$UtteranceType == "size",1,0)
targets$SizeAndColor = ifelse(targets$UtteranceType == "size and color",1,0)
targets$Other = ifelse(targets$UtteranceType == "OTHER",1,0)
targets$Item = sapply(strsplit(as.character(targets$nameClickedObj),"_"), "[", 3)
targets$redUtterance = as.factor(ifelse(targets$UtteranceType == "size and color","redundant",ifelse(targets$UtteranceType == "size" & targets$SufficientProperty == "size", "minimal", ifelse(targets$UtteranceType == "color" & targets$SufficientProperty == "color", "minimal", "other"))))
targets$RatioOfDiffToSame = targets$NumDiffDistractors/targets$NumSameDistractors
targets$DiffMinusSame = targets$NumDiffDistractors-targets$NumSameDistractors

# plot histogram of mentioned features by condition
agr = targets %>%
  select(sizeMentioned,colorMentioned,typeMentioned,condition) %>%
  gather(Feature,Mentioned,-condition)
agr$Feature = gsub("Mentioned","",as.character(agr$Feature))
agr = droplevels(subset(agr,Mentioned == "TRUE"))
head(agr)

ggplot(agr, aes(x=Feature)) +
  geom_histogram() +
  facet_wrap(~condition)
ggsave("graphs_numdistractors/mentioned_features_by_condition.pdf",width=8,height=3.5)

# plot utterance choice proportions with error bars
agr = targets %>%
  select(Color,Size,SizeAndColor,Other,condition) %>%
  gather(Utterance,Mentioned,-condition) %>%
  group_by(Utterance,condition) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high

ggplot(agr, aes(x=Utterance,y=Probability)) +
  geom_bar(stat="identity") +
  geom_errorbar(aes(ymin=YMin,ymax=YMax),width=.25) +
  facet_wrap(~condition)
ggsave("graphs_numdistractors/mentioned_features_by_condition_other.pdf",width=10,height=3.5)

# plot by number of distractors etc
agr = targets %>%
  select(Color,Size,SizeAndColor,Other,SufficientProperty,NumDistractors,NumDiffDistractors) %>%
  gather(Utterance,Mentioned,-SufficientProperty,-NumDistractors,-NumDiffDistractors) %>%
  group_by(Utterance,SufficientProperty,NumDistractors,NumDiffDistractors) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high

ggplot(agr, aes(x=NumDiffDistractors,y=Probability,color=as.factor(NumDistractors))) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  facet_grid(SufficientProperty~Utterance)
ggsave("graphs_numdistractors/utterancetype_by_condition_diff.pdf",width=9,height=3.5)

agr = targets %>%
  select(Color,Size,SizeAndColor,Other,SufficientProperty,NumDistractors,NumSameDistractors) %>%
  gather(Utterance,Mentioned,-SufficientProperty,-NumDistractors,-NumSameDistractors) %>%
  group_by(Utterance,SufficientProperty,NumDistractors,NumSameDistractors) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high

ggplot(agr, aes(x=NumSameDistractors,y=Probability,color=as.factor(NumDistractors))) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  facet_grid(SufficientProperty~Utterance)
ggsave("graphs_numdistractors/utterancetype_by_condition_same.pdf",width=9,height=4)

# plot by ratio and numdistractors
agr = targets %>%
  select(Color,Size,SizeAndColor,Other,SufficientProperty,NumDistractors,RatioOfDiffToSame) %>%
  gather(Utterance,Mentioned,-SufficientProperty,-NumDistractors,-RatioOfDiffToSame) %>%
  group_by(Utterance,SufficientProperty,NumDistractors,RatioOfDiffToSame) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high

ggplot(agr, aes(x=RatioOfDiffToSame,y=Probability,color=as.factor(NumDistractors))) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  facet_grid(SufficientProperty~Utterance)
ggsave("graphs_numdistractors/utterancetype_by_condition_ratio.pdf",width=9,height=4)

head(agr)
#agr$CorrectProprty = ifelse((agr$Utterance %in% c("Color","SizeAndColor") & agr$SufficientProperty == "color") | (agr$Utterance %in% c("Size","SizeAndColor") & agr$SufficientProperty == "size"), "correct","incorrect")

# plot by ratio and numdistractors, only for 'correct' properties
targets$redUtterance = as.factor(as.character(targets$redUtterance))
targets$CorrectProperty = ifelse(targets$SufficientProperty == "color" & (targets$Color == 1 | targets$SizeAndColor == 1), 1, ifelse(targets$SufficientProperty == "size" & (targets$Size == 1 | targets$SizeAndColor == 1), 1, 0)) # 20 cases of incorrect property mention
targets$minimal = ifelse(targets$SizeAndColor == 0 & targets$UtteranceType != "OTHER", 1, 0)
targets$redundant = ifelse(targets$SizeAndColor == 1, 1, 0)
targets$BDAUtterance = "size"#as.character(targets$clickedSize)
targets[targets$Color == 1,]$BDAUtterance = as.character(targets[targets$Color == 1,]$clickedColor)
targets[targets$SizeAndColor == 1,]$BDAUtterance = paste("size",targets[targets$SizeAndColor == 1,]$clickedColor,sep="_")
#targets[targets$SizeAndColor == 1,]$BDAUtterance = paste(targets[targets$SizeAndColor == 1,]$clickedSize,targets[targets$SizeAndColor == 1,]$clickedColor,sep="_")
targets$redBDAUtterance = "size_color"
targets[targets$Color == 1,]$redBDAUtterance = "color"
targets[targets$Size == 1,]$redBDAUtterance = "size"
targets[targets$Other == 1,]$redBDAUtterance = "other"
targets$BDASize = "size"
targets$BDAColor = "color"
targets$BDAFullColor = targets$clickedColor
targets$BDAOtherColor = "othercolor"
targets$BDAItem = "item"

targets[targets$UtteranceType == "OTHER",]$refExp
# exclude non-sensical and "closest"/"Farthest" cases
targets[targets$redBDAUtterance != "other" & targets$CorrectProperty == 0,c("gameid","condition","nameClickedObj","refExp")]
targets$WeirdCases = FALSE
targets[targets$redBDAUtterance != "other" & targets$CorrectProperty == 0  & !targets$gameid %in% c("3791-8","7569-e"),]$WeirdCases = TRUE

# full conditions
write.csv(targets[c("gameid","roundNum","condition","BDASize","clickedColor","OtherColor","Item","BDAUtterance")],file="data/data_bda_modifiers.csv",quote=F,row.names=F)
write.csv(unique(targets[,c("BDAFullColor","BDASize","condition","OtherColor","Item")]),file="data/unique_conditions_modifiers.csv",quote=F,row.names=F)

# reduced conditions
write.csv(targets[,c("gameid","roundNum","condition","BDASize","BDAColor","BDAOtherColor","BDAItem","redBDAUtterance")],file="data/data_bda_modifiers_reduced.csv",quote=F,row.names=F)
write.csv(unique(targets[,c("BDAColor","BDASize","condition","BDAOtherColor","BDAItem")]),file="data/unique_conditions_modifiers_reduced.csv",quote=F,row.names=F)

## only condition on non-"other" cases!! -- these are the files you'll use for bda
write.csv(targets[targets$redBDAUtterance != "other" & targets$WeirdCases == FALSE,c("gameid","roundNum","condition","BDASize","BDAColor","BDAOtherColor","BDAItem","redBDAUtterance")],file="data/data_bda_modifiers_reduced_noother.csv",quote=F,row.names=F)
write.csv(unique(targets[targets$redBDAUtterance != "other" & targets$WeirdCases == FALSE,c("BDAColor","BDASize","condition","BDAOtherColor","BDAItem")]),file="data/unique_conditions_modifiers_reduced_noother.csv",quote=F,row.names=F)

write.csv(targets[targets$redBDAUtterance != "other" & targets$WeirdCases == FALSE,c("gameid","roundNum","condition","BDASize","clickedColor","OtherColor","Item","BDAUtterance")],file="data/data_bda_modifiers_noother.csv",quote=F,row.names=F)
write.csv(unique(targets[targets$redBDAUtterance != "other" & targets$WeirdCases == FALSE,c("BDAFullColor","BDASize","condition","OtherColor","Item")]),file="data/unique_conditions_modifiers_noother.csv",quote=F,row.names=F)

# only use maxdiff typicality cases for small typicality bda
write.csv(targets[targets$redBDAUtterance != "other" & targets$WeirdCases == FALSE & targets$Item %in% c("golfball","chair","stapler","weddingcake"),c("gameid","roundNum","condition","BDASize","clickedColor","OtherColor","Item","BDAUtterance")],file="data/data_bda_modifiers_maxdifftypicality.csv",quote=F,row.names=F)
write.csv(unique(targets[targets$redBDAUtterance != "other" & targets$WeirdCases == FALSE & targets$Item %in% c("golfball","chair","stapler","weddingcake"),c("BDAFullColor","BDASize","condition","OtherColor","Item")]),file="data/unique_conditions_modifiers_maxdifftypicality.csv",quote=F,row.names=F)

# write file for regression analaysis (this includes the 6 cases where the insufficient dimension was underinformatively mentioned, so you need to exclude those still)
write.csv(targets[targets$redBDAUtterance != "other" & targets$WeirdCases == FALSE,], file="data/results_for_regression.csv",quote=F,row.names=F)

# total number of cases in analysis
nrow(targets[targets$redBDAUtterance != "other" & targets$WeirdCases == FALSE,])

# get reduced set of conditions and contexts
agr = targets[targets$CorrectProperty == 1,] %>%
  select(redundant,SufficientProperty,NumDistractors,RatioOfDiffToSame) %>%
  gather(Utterance,Mentioned,-SufficientProperty,-NumDistractors,-RatioOfDiffToSame) %>%
  group_by(Utterance,SufficientProperty,NumDistractors,RatioOfDiffToSame) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high
agr$Distractors = as.factor(agr$NumDistractors)
agr$RedundantProperty = ifelse(agr$SufficientProperty == 'color',"size redundant","color redundant")
ggplot(agr, aes(x=RatioOfDiffToSame,y=Probability,color=Distractors,group=1)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  xlab("Ratio of different to same (other) feature values") +
  ylab("Probability of redundancy") +
#  geom_smooth(method="lm") +
  facet_wrap(~RedundantProperty)
ggsave("graphs_numdistractors/utterancetype_by_condition_ratio_correctonly.pdf",width=7,height=3.2)

## add model predictions
load("/Users/titlis/cogsci/projects/stanford/projects/overinformativeness/models/2_number_of_distractors/results/parsed/r-moreconditions.RData")
# you can play with the values in the next statment to get different model predictions
toplot = r[r$object == "o1" & r$color_fidelity == .999 & r$size_fidelity == .8  & r$color_cost == .1 & r$size_cost == .1 & as.numeric(as.character(r$speaker.opt)  == 15),]
toplot$RatioOfDiffToSame = toplot$differentcolor/toplot$samecolor
toplot[toplot$sufficientproperty == "color",]$RatioOfDiffToSame = toplot[toplot$sufficientproperty == "color",]$differentsize/toplot[toplot$sufficientproperty == "color",]$samesize
toplot$Distractors = as.factor(toplot$numdistractors)
toplot$redundant = ifelse(toplot$Utterance %in% c("big_red","small_yellow","big_yellow","small_red"),1,0)
toplot$correctproperty = ifelse(toplot$Utterance == "big_red" | toplot$sufficientproperty == "color" & toplot$Utterance == "red" | toplot$sufficientproperty == "size" & toplot$Utterance == "big", 1, 0)
toplot$SufficientProperty = toplot$sufficientproperty
toplot$DataType = "model"

agr = toplot[toplot$correctproperty == 1 & toplot$redundant == 1,] %>%
  #select(redundant,sufficientproperty,Distractors,RatioOfDiffToSame) %>%
  #gather(Utterance,Mentioned,-sufficientproperty,-Distractors,-RatioOfDiffToSame) %>%
  group_by(SufficientProperty,Distractors,RatioOfDiffToSame) %>%
  summarise(Probability=Probability)
agr = as.data.frame(agr)
agr$RedundantProperty = ifelse(agr$SufficientProperty == "color","size redundant","color redundant")
agr$Data = "model"
magr = agr

ggplot(agr, aes(x=RatioOfDiffToSame,y=Probability,color=Distractors,group=1)) +
  geom_point(size=4,alpha=.5) +
  ylab("Probability of redundancy") +
  xlab("Ratio of distractors with different to same insufficient feature value") +
  ylim(c(0,1)) +
  facet_wrap(~RedundantProperty)
#ggsave("/Users/titlis/cogsci/projects/stanford/projects/overinformativeness/talks/2016/edinburgh/model-empirical.pdf",width=8,height=3.5)

agr = targets[targets$CorrectProperty == 1,] %>%
  select(redundant,SufficientProperty,NumDistractors,RatioOfDiffToSame) %>%
  gather(Utterance,Mentioned,-SufficientProperty,-NumDistractors,-RatioOfDiffToSame) %>%
  group_by(Utterance,SufficientProperty,NumDistractors,RatioOfDiffToSame) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high
agr$Distractors = as.factor(agr$NumDistractors)
agr$RedundantProperty = ifelse(agr$SufficientProperty == "color","size redundant","color redundant")
agr$Data = "empirical"
eagr = agr

agr = merge(magr,agr,all=T)
agr$DType = factor(x=as.character(agr$Data),levels=c("model","empirical"))

ggplot(agr, aes(x=RatioOfDiffToSame,y=Probability,color=Distractors,group=1)) +
  geom_point(size=4,alpha=.5) +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  facet_grid(DType~RedundantProperty) +
  xlab("Scene variation") +
  ylab("Probability of redundancy")
ggsave("graphs_numdistractors/model-empirical_correctonly.pdf",width=7.5,height=5)
ggsave("/Users/titlis/cogsci/projects/stanford/projects/overinformativeness/writing/2016/theory/pics/model-empirical.pdf",width=9,height=6)
#ggsave("/Users/titlis/cogsci/projects/stanford/projects/overinformativeness/talks/2016/edinburgh/model-and-empirical.pdf",width=7.5,height=5)

# plot by ratio only
agr = targets %>%
  select(Color,Size,SizeAndColor,Other,SufficientProperty,RatioOfDiffToSame) %>%
  gather(Utterance,Mentioned,-SufficientProperty,-RatioOfDiffToSame) %>%
  group_by(Utterance,SufficientProperty,RatioOfDiffToSame) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high

ggplot(agr, aes(x=RatioOfDiffToSame,y=Probability)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  facet_grid(SufficientProperty~Utterance)
ggsave("graphs_numdistractors/utterancetype_by_condition_ratioonly.pdf",width=9,height=4)

# plot by color typicality only "size sufficient" condition
agr = targets %>%
  filter(SufficientProperty == "size") %>%
  select(Color,Size,SizeAndColor,Other,ColorTypicality) %>%
  gather(Utterance,Mentioned,-ColorTypicality) %>%
  group_by(Utterance,ColorTypicality) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high
size = droplevels(agr[agr$Utterance == "SizeAndColor",])

ggplot(size, aes(x=ColorTypicality,y=Probability)) +
  geom_point() +
  geom_smooth(method="lm") +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  scale_x_continuous(limits=c(0,1),breaks=seq(0,1,by=.25))
ggsave("graphs_numdistractors/utterancetype_bytypicality_sizesufficient.pdf",width=6,height=4)

# plot by normalized color typicality only "size sufficient" condition
agr = targets %>%
  filter(SufficientProperty == "size") %>%
  select(Color,Size,SizeAndColor,Other,normTypicality) %>%
  gather(Utterance,Mentioned,-normTypicality) %>%
  group_by(Utterance,normTypicality) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high
size = droplevels(agr[agr$Utterance == "SizeAndColor",])

ggplot(size, aes(x=normTypicality,y=Probability)) +
  geom_point() +
  geom_smooth(method="lm") +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  scale_x_continuous(limits=c(0,1),breaks=seq(0,1,by=.25))
ggsave("graphs_numdistractors/utterancetype_bynormtypicality_sizesufficient.pdf",width=6,height=4)

# plot by color typicality diff only "size sufficient" condition
agr = targets %>%
  filter(SufficientProperty == "size") %>%
  select(Color,Size,SizeAndColor,Other,TypicalityDiff) %>%
  gather(Utterance,Mentioned,-TypicalityDiff) %>%
  group_by(Utterance,TypicalityDiff) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high
size = droplevels(agr[agr$Utterance == "SizeAndColor",])

ggplot(size, aes(x=TypicalityDiff,y=Probability)) +
  geom_point() +
  geom_smooth(method="lm") +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) #+
  #scale_x_continuous(limits=c(0,1),breaks=seq(0,1,by=.25))
ggsave("graphs_numdistractors/utterancetype_bytypicalitydiff_sizesufficient.pdf",width=6,height=4)

# plot by color typicality only "size sufficient" condition by scene variation condition
agr = targets %>%
  select(Color,Size,SizeAndColor,Other,SufficientProperty,RatioOfDiffToSame,ColorTypicality) %>%
  gather(Utterance,Mentioned,-SufficientProperty,-RatioOfDiffToSame,-ColorTypicality) %>%
  group_by(Utterance,SufficientProperty,RatioOfDiffToSame,ColorTypicality) %>%
  summarise(Probability=mean(Mentioned),ci.low=ci.low(Mentioned),ci.high=ci.high(Mentioned))
agr = as.data.frame(agr)
agr$YMin = agr$Probability - agr$ci.low
agr$YMax = agr$Probability + agr$ci.high
size = droplevels(agr[agr$SufficientProperty == "size" & agr$Utterance == "SizeAndColor",])

ggplot(size, aes(x=ColorTypicality,y=Probability)) +
  geom_point() +
  geom_smooth(method="lm") +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  facet_wrap(~RatioOfDiffToSame)
ggsave("graphs_numdistractors/utterancetype_bytypicality_byvariation_sizesufficient.pdf",width=11,height=7)


# Set up plotting basics
source("PlotSetUp.r")
# Create a dataframe for a union set of DMR collected from all pairs of collections.
## Merge all samples d30
combined_dmr <- read.table("Combined_DMRs_d30_p0.01.txt",sep = "\t", header = F, stringsAsFactors = F)
## Plot DMR size distribution
combined_dmr$size <- combined_dmr$V3-combined_dmr$V2
hist(combined_dmr$size,breaks = 1000, xlim = c(0,2000),xlab = "DMR Size", main = "Combined DMR size distribution (d30)", col = "grey")
## Read DMR files
cDMR15v24_d30_p0.01 <- read.table("Combined_DMR15v24_d30_p0.01_wSMOOTHING.txt",sep = "\t", header = F, stringsAsFactors = F)
cDMR24vMel_d30_p0.01 <- read.table("Combined_DMR24vMel_d30_p0.01_wSMOOTHING.txt",sep = "\t", header = F, stringsAsFactors = F)
cDMR24vIri_d30_p0.01 <- read.table("Combined_DMR24vIri_d30_p0.01_wSMOOTHING.txt",sep = "\t", header = F, stringsAsFactors = F)
cDMRMelvIri_d30_p0.01 <- read.table("Combined_DMRMelvIri_d30_p0.01_wSMOOTHING.txt",sep = "\t", header = F, stringsAsFactors = F)
## Add a chromosome position column, like chr1:12345-67890
cDMR15v24_d30_p0.01$chrompos<- paste(cDMR15v24_d30_p0.01$V1,":",cDMR15v24_d30_p0.01$V2,"-",cDMR15v24_d30_p0.01$V3,sep = "")
cDMR24vMel_d30_p0.01$chrompos<- paste(cDMR24vMel_d30_p0.01$V1,":",cDMR24vMel_d30_p0.01$V2,"-",cDMR24vMel_d30_p0.01$V3,sep = "")
cDMR24vIri_d30_p0.01$chrompos<- paste(cDMR24vIri_d30_p0.01$V1,":",cDMR24vIri_d30_p0.01$V2,"-",cDMR24vIri_d30_p0.01$V3,sep = "")
cDMRMelvIri_d30_p0.01$chrompos<- paste(cDMRMelvIri_d30_p0.01$V1,":",cDMRMelvIri_d30_p0.01$V2,"-",cDMRMelvIri_d30_p0.01$V3,sep = "")
## Merge DMR files
combined_dmr_wInfo <-Reduce(function(x, y) merge(x, y, by=c("chrompos"), all = T), list(cDMR15v24_d30_p0.01[,c("V1","V2","V3","chrompos","V11","V12")],cDMR24vMel_d30_p0.01[,c("chrompos","V11","V12")],cDMR24vIri_d30_p0.01[,c("chrompos","V11","V12")],cDMRMelvIri_d30_p0.01[,c("chrompos","V11","V12")]))
### Change column names to match the data
colnames(combined_dmr_wInfo) <- c("chrompos","chr","start","end","s15vs24","s24vMel","s24vIri","MelvsIri")
### Calculate region sizes
combined_dmr_wInfo$size <- combined_dmr_wInfo$end-combined_dmr_wInfo$start
### Replace "." which stands for no data with 0
combined_dmr_wInfo[combined_dmr_wInfo == "."] <- 0
### Change data type to numeric
combined_dmr_wInfo$s15vs24 <- as.numeric(combined_dmr_wInfo$s15vs24)
combined_dmr_wInfo$s24vMel <- as.numeric(combined_dmr_wInfo$s24vMel)
combined_dmr_wInfo$s24vIri <- as.numeric(combined_dmr_wInfo$s24vIri)
combined_dmr_wInfo$MelvsIri <- as.numeric(combined_dmr_wInfo$MelvsIri)

## Remove duplicated regions from the data frame.
combined_dmr_wInfo <- combined_dmr_wInfo[!duplicated(combined_dmr_wInfo$chrompos),]
write.table(combined_dmr_wInfo, "Combined_DMRs_d30_p0.01_wINFO.bed", row.names = F, col.names = F, sep = "\t",quote =F)

# Plot methylation differences and also correlation in shared DMRs
## Extract sample-associated DMR sets
s24 <-combined_dmr_wInfo[combined_dmr_wInfo$s15vs24 !=0,]
M<-combined_dmr_wInfo[combined_dmr_wInfo$s24vMel !=0,]
I<- combined_dmr_wInfo[combined_dmr_wInfo$s24vIri !=0,]
MI <-combined_dmr_wInfo[combined_dmr_wInfo$MelvsIri !=0,]
## Density plot for methylation change distribution
ps24 <-ggplot(s24, aes(s15vs24)) + geom_density(alpha = 0.5,adjust =0.15,color = mypalette[3],fill = mypalette[3])+ggtitle(paste("DMR methylation change from 15somite to 24hpf"))+theme(plot.title = element_text(hjust = 0.5, face = "bold",size = 16), axis.title=element_text(size=12,face = "bold"),axis.text.x = element_text(face = "bold",size = 12),axis.text.y = element_text(face = "bold",size = 12))+
      labs(x = "Methylation change", y = "Density")+ theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + theme(panel.background = element_rect(fill = 'white',colour = 'black'))+ theme(legend.position="none")
ps24
pM <-ggplot(M, aes(s24vMel)) + geom_density(alpha = 0.5,adjust =1,color = mypalette[5],fill = mypalette[5])+ggtitle(paste("DMR methylation change from 24hpf to Melanophore"))+theme(plot.title = element_text(hjust = 0.5, face = "bold",size = 16), axis.title=element_text(size=12,face = "bold"),axis.text.x = element_text(face = "bold",size = 12),axis.text.y = element_text(face = "bold",size = 12))+
      labs(x = "Methylation change", y = "Density")+ theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + theme(panel.background = element_rect(fill = 'white',colour = 'black'))+ theme(legend.position="none")
pM
pI <-ggplot(I, aes(s24vIri)) + geom_density(alpha = 0.5,adjust =1,color = mypalette[7],fill = mypalette[7])+ggtitle(paste("DMR methylation change from 24hpf to Iridophore"))+theme(plot.title = element_text(hjust = 0.5, face = "bold",size = 16), axis.title=element_text(size=12,face = "bold"),axis.text.x = element_text(face = "bold",size = 12),axis.text.y = element_text(face = "bold",size = 12))+
      labs(x = "Methylation change", y = "Density")+ theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + theme(panel.background = element_rect(fill = 'white',colour = 'black'))+ theme(legend.position="none")
pI
pMI <-ggplot(MI, aes(MelvsIri)) + geom_density(alpha = 0.5,adjust =1,color = mypalette[9],fill = mypalette[9])+ggtitle(paste("DMR methylation change from Melanophore to Iridophore"))+theme(plot.title = element_text(hjust = 0.5, face = "bold",size = 16), axis.title=element_text(size=12,face = "bold"),axis.text.x = element_text(face = "bold",size = 12),axis.text.y = element_text(face = "bold",size = 12))+
      labs(x = "Methylation change", y = "Density")+ theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + theme(panel.background = element_rect(fill = 'white',colour = 'black'))+ theme(legend.position="none")
pMI
multiplot(ps24,pI,pM,pMI, cols = 2)

# DMR size distribution
ps24 <-ggplot(s24, aes(size)) + geom_density(alpha = 0.5,adjust =0.4,color = mypalette[4],fill = mypalette[4])+ggtitle(paste("DMR size distribution\n(15somite vs 24hpf)"))+theme(plot.title = element_text(hjust = 0.5, face = "bold",size = 16), axis.title=element_text(size=12,face = "bold"),axis.text.x = element_text(face = "bold",size = 12),axis.text.y = element_text(face = "bold",size = 12))+
      labs(x = "DMR size", y = "Density")+scale_x_continuous(lim = c(0,2000))+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + theme(panel.background = element_rect(fill = 'white',colour = 'black'))+ theme(legend.position="none")
pM <-ggplot(M, aes(size)) + geom_density(alpha = 0.5,adjust =0.4,color = mypalette[6],fill = mypalette[6])+ggtitle(paste("DMR size distribution\n(24hpf vs Melanophore)"))+theme(plot.title = element_text(hjust = 0.5, face = "bold",size = 16), axis.title=element_text(size=12,face = "bold"),axis.text.x = element_text(face = "bold",size = 12),axis.text.y = element_text(face = "bold",size = 12))+
    labs(x = "DMR size", y = "Density")+scale_x_continuous(lim = c(0,2000))+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + theme(panel.background = element_rect(fill = 'white',colour = 'black'))+ theme(legend.position="none")
pI <-ggplot(I, aes(size)) + geom_density(alpha = 0.5,adjust =0.4,color = mypalette[8],fill = mypalette[8])+ggtitle(paste("DMR size distribution\n(24hpf vs Iridophore)"))+theme(plot.title = element_text(hjust = 0.5, face = "bold",size = 16), axis.title=element_text(size=12,face = "bold"),axis.text.x = element_text(face = "bold",size = 12),axis.text.y = element_text(face = "bold",size = 12))+
    labs(x = "DMR size", y = "Density")+scale_x_continuous(lim = c(0,2000))+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + theme(panel.background = element_rect(fill = 'white',colour = 'black'))+ theme(legend.position="none")
pMI <-ggplot(MI, aes(size)) + geom_density(alpha = 0.5,adjust =0.4,color = mypalette[10],fill = mypalette[10])+ggtitle(paste("DMR size distribution\n(Melanophore vs Iridophore)"))+theme(plot.title = element_text(hjust = 0.5, face = "bold",size = 16), axis.title=element_text(size=12,face = "bold"),axis.text.x = element_text(face = "bold",size = 12),axis.text.y = element_text(face = "bold",size = 12))+
    labs(x = "DMR size", y = "Density")+scale_x_continuous(lim = c(0,2000))+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + theme(panel.background = element_rect(fill = 'white',colour = 'black'))+ theme(legend.position="none")
multiplot(ps24,pI,pM,pMI, cols = 2)
# Features of shared and cell type-specific DMRs
## Pull out melanophore-specific
Mel_specific_hyperDMR <- combined_dmr_wInfo[combined_dmr_wInfo$s24vMel <0 & combined_dmr_wInfo$s24vIri >=0,]
Mel_specific_hypoDMR <- combined_dmr_wInfo[combined_dmr_wInfo$s24vMel >0 & combined_dmr_wInfo$s24vIri <=0,]
## Using more strigent way to call Mel hypoDMR
Mel_specific_hypoDMR_stringent <- combined_dmr_wInfo[combined_dmr_wInfo$s24vMel >0 & combined_dmr_wInfo$s24vIri <=0 & combined_dmr_wInfo$MelvsIri <0,]
## Pull out iridophore-specific
Iri_specific_hyperDMR <- combined_dmr_wInfo[combined_dmr_wInfo$s24vMel >=0 & combined_dmr_wInfo$s24vIri <0,]
Iri_specific_hypoDMR <- combined_dmr_wInfo[combined_dmr_wInfo$s24vMel <=0 & combined_dmr_wInfo$s24vIri >0,]
# Using more strigent way to call Iri hypoDMR
Iri_specific_hypoDMR_stringent <- combined_dmr_wInfo[combined_dmr_wInfo$s24vMel <=0 & combined_dmr_wInfo$s24vIri >0 & combined_dmr_wInfo$MelvsIri >0,]
## Pull out shared DMRs
Mel_Iri_shared_hyperDMR <- combined_dmr_wInfo[combined_dmr_wInfo$s24vMel <0 & combined_dmr_wInfo$s24vIri <0,]
Mel_Iri_shared_hypoDMR <- combined_dmr_wInfo[combined_dmr_wInfo$s24vMel >0 & combined_dmr_wInfo$s24vIri >0,]

## Write hypo DMRs to files
write.table(Mel_specific_hyperDMR, "Mel_specific_hyperDMR_d30_p0.01.bed", row.names = F, col.names = F, sep = "\t",quote =F)
write.table(Mel_specific_hypoDMR, "Mel_specific_hypoDMR_d30_p0.01.bed", row.names = F, col.names = F, sep = "\t",quote =F)
write.table(Mel_specific_hypoDMR_stringent, "Mel_specific_hypoDMR_d30_p0.01_stringent.bed", row.names = F, col.names = F, sep = "\t",quote =F)

write.table(Iri_specific_hyperDMR, "Iri_specific_hyperDMR_d30_p0.01.bed", row.names = F, col.names = F, sep = "\t",quote =F)
write.table(Iri_specific_hypoDMR, "Iri_specific_hypoDMR_d30_p0.01.bed", row.names = F, col.names = F, sep = "\t",quote =F)
write.table(Iri_specific_hypoDMR_stringent, "Iri_specific_hypoDMR_d30_p0.01_stringent.bed", row.names = F, col.names = F, sep = "\t",quote =F)

write.table(Mel_Iri_shared_hyperDMR , "Mel_Iri_shared_hyperDMR _d30_p0.01.bed", row.names = F, col.names = F, sep = "\t",quote =F)
write.table(Mel_Iri_shared_hypoDMR, "Mel_Iri_shared_hypoDMR_d30_p0.01.bed", row.names = F, col.names = F, sep = "\t",quote =F)

## Plot DMR methylation change comparison
Mel_Iri_shared_hyperDMR$Type <- "Shared HyperDMR"
Mel_Iri_shared_hypoDMR$Type <- "Shared HypoDMR"
Mel_specific_hyperDMR$Type <- "Mel-specific HyperDMR"
Mel_specific_hypoDMR$Type <- "Mel-specific HypoDMR"
Iri_specific_hyperDMR$Type <- "Iri-specific HyperDMR"
Iri_specific_hypoDMR$Type <- "Iri-specific HypoDMR"

shared <- rbind(Mel_Iri_shared_hyperDMR,Mel_Iri_shared_hypoDMR,Mel_specific_hyperDMR,Mel_specific_hypoDMR[Mel_specific_hypoDMR$s24vMel > 0.2 | Mel_specific_hypoDMR$s24vMel < -0.2,],Iri_specific_hyperDMR,Iri_specific_hypoDMR)
ggplot(shared[shared$type == "Shared hyperDMR" | shared$type == "Shared hypoDMR",], aes(x=s24vMel, y=s24vIri,fill=Type,color=Type)) +
  geom_point(size = 0.2) + geom_jitter(data = shared[shared$type != "Shared hyperDMR" | shared$type != "Shared hypoDMR",],aes(x=s24vMel, y=s24vIri,fill=Type,color=Type),width = 0.01, height = 0.01,size = 0.2)+
  ggtitle(paste("DMR methylation change comparison from 24hpf to Pigment cells"))+theme(plot.title = element_text(hjust = 0.5, face = "bold",size = 20), axis.title=element_text(size=12,face = "bold"),axis.text.x = element_text(face = "bold",size = 12),axis.text.y = element_text(face = "bold",size = 12))+
      scale_fill_manual(values = mypalette3)+scale_color_manual(values=mypalette3)+labs(x = "Methylaton change from 24hpf to Melanophore", y = "Methylaton change from 24hpf to Iridophore")+ theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + theme(panel.background = element_rect(fill = 'white',colour = 'black'))+ theme(legend.title = element_text(size = 12, face = "bold"),legend.text = element_text(size = 10, face = "bold"))+ theme(legend.position="top")+ guides(color=guide_legend(override.aes=list(fill=NA,size = 6)))+ theme(legend.key=element_blank())


require(ggplot2)
require(xtable)

#Arbeitspfad setzen
setwd("/Volumes/cracker/data/nfs/thomas/experiments/indoor-noise-17.07.2011-nosync-noise0-cca62-ofdm1-ch6/data/merged-trace/aggregation")

#Einlesen
noise_ts <- read.csv(file = "tel-16-1-10-sec-aggregation.csv", header = T , sep = ",")
noise_ts <- subset(noise_ts, mean > -120 & !as.character(node) %in% as.character("en"))

#spezielle node auswaehlen
node_noise_ts <- subset(noise_ts, as.character(node) %in% as.character("af"))

#facelabels modified
mf_labeller <- function(var, value){
  value <- as.character(value)
  if (var=="sex") {
    value[value=="high"] <- "CS using energie detection & preamble correlation"
    value[value=="low"]   <- "CS using only energie detection"
  }
  return(value)
}

#boxplots over time
print(
  ggplot(data = noise_ts, aes(x = timestamp/3600, y = median)) +
    #geom_point(aes(y = median),size=0.9, alpha=0.2, colour = "blue") +
    #geom_smooth(aes(x = timestamp/3600, y = max), size=0.9, alpha=0.2, colour = "red") +
    #geom_smooth(aes(x = timestamp/3600, y = min), size=0.9, alpha=0.2, colour = "green") +
    #coord_cartesian(ylim = c(-105,-95))
    geom_boxplot(aes(group = round_any(timestamp, 1800, floor)), outlier.colour = "red", outlier.size = 1, alpha=0.3) +
    #stat_summary(fun.data = "mean_cl_boot", geom = "crossbar", colour = "red", width = 0.3) +
    geom_smooth(stat = "smooth", colour="blue") +
    #scale_y_continuous(breaks = seq(-120, -60, by = 2)) +
    scale_x_continuous(breaks = c(1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35),
    labels=c("22:00", "24:00", "2:00", "4:00", "6:00", "8:00", "10:00", "12:00", "14:00", "16:00", "18:00", "20:00",
             "22:00", "24:00", "2:00", "4:00", "6:00", "8:00")) +
    coord_cartesian(xlim = c(0,36)) +
    labs(x = "hour of the day [hh:mm]", y = "noisefloor [dB]") +
    opts(axis.text.y = theme_text(hjust = 1, size = 8, colour = "black"),
              axis.text.x = theme_text(hjust = 0.5, size = 8, colour = "black"),
              axis.title.y = theme_text(angle = 90, vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              axis.title.x = theme_text(vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              legend.position="none",
              title ="Noisefloor distribution in 36h on channel 6 - BOWL indoor",
              plot.title=theme_text(colour="black", size=12, vjust = 1.5, hjust = 0.5),
              strip.text.x = theme_text(size=10, face='bold'),
              strip.background = theme_rect(colour='darkgray', fill='lightgray')) +
      facet_wrap(~ node, ncol=2, scales = "free_y")
)

#TEST boxplots over time
ggplot(data = noise_ts, aes(x = round_any(timestamp,1800,floor), y = mean[mean >-110])) +
  geom_point(size=0.9, alpha=0.4) +
  stat_summary(fun.data = "mean_cl_boot", geom = "crossbar", colour = "red", width = 0.3) +
  geom_smooth(stat = "smooth", colour="blue")

  layer(mapping = aes(x = timestamp/3600, y = mean[mean >-110], group = round_any(timestamp, 1800, floor)),
        geom = "boxplot", alpha = 0.3 ) +
  layer(mapping = aes(x = timestamp/3600, y = max[max >-110]),
        geom = "line", stat = "smooth", color="red", alpha = 0.5) +
  layer(mapping = aes(x = timestamp/3600, y = min[min >-110]),
        geom = "smooth", color="green", alpha = 0.5) +
    scale_y_continuous(breaks = seq(-120, -60, by = 10)) +
    scale_x_continuous(breaks = c(1,3,5,7,9,11,13,15,17,19,21,23),
      labels=c("24:00", "2:00", "4:00", "6:00", "8:00", "10:00", "12:00", "14:00", "16:00", "18:00", "20:00", "22:00")) +
    coord_cartesian(ylim = c(-105,-80), xlim = c(0,24)) +
      labs(x = "hour of the day [hh:mm]",
           y = "noisefloor [dB]") +
        opts(axis.text.y = theme_text(hjust = 1, size = 10, colour = "black"),
              axis.text.x = theme_text(hjust = 0.5, size = 10, colour = "black"),
              axis.title.y = theme_text(angle = 90, vjust = 0.2, hjust = 0.5, size = 17, colour = "black"),
              axis.title.x = theme_text(vjust = 0.2, hjust = 0.5, size = 17, colour = "black"),
              #legend.position="none",
              title ="Noisefloor distribution over 24h",
              plot.title=theme_text(colour="black", size=20, vjust = 1.5, hjust = 0.5),
              strip.text.x = theme_text(size=12, face='bold'),
              strip.background = theme_rect(colour='darkgray', fill='lightgray'))

+
      facet_wrap(~ node, ncol=3, scales = "free_y")

m <- ggplot(data = af_register, aes(x = timestamp/3600, y = mean[mean >-110]))
m + geom_smooth(stat="identity")
m + stat_smooth() + geom_point(alpha=I(0.2))

#test
af_register$disp_mean <- round_any(af_register$mean, 1800, ceiling)
p <- ggplot(data = af_register, mapping = aes(x = timestamp, y = mean[mean >-110] ), geom = "line", colour="red")
p  + facet_wrap(. ~ af_register$disp_mean, nrow = 1)

ggplot() +
layer(
 data = af_register, mapping = aes(x = timestamp, y = mean[mean >-110] ),
 geom = "point", stat = "identity", alpha = 0.1
) +
layer(
 data = af_register, mapping = aes(x = timestamp, y = mean[mean >-110] ),
 geom = "smooth", stat = "smooth", color = "yellow"
) +
layer(
 data = af_register, mapping = aes(x = timestamp, y = max[max >-110]),
 geom = "line", stat = "identity", color="red", alpha = 0.1
) +
layer(
 data = af_register, mapping = aes(x = timestamp[min >-110], y = min[min >-110]),
 geom = "line", stat = "identity", color="green", alpha = 0.1
) +
layer(data = ma_register, mapping = aes(x = timestamp, y = std - 110),
 geom = "line", stat = "identity", color="blue"
)

#testing

ggplot(data = noise_ts) +
layer(
 mapping = aes(x = timestamp, y = mean[mean >-110], colour=node ),
 geom = "smooth", stat = "smooth"
) +
layer(
 data = ma_register, mapping = aes(x = timestamp, y = mean[mean >-110] ),
 geom = "smooth", stat = "smooth", color = "coral"
) +
layer(
 data = eb_register, mapping = aes(x = timestamp, y = mean[mean >-110] ),
 geom = "smooth", stat = "smooth", color = "cyan"
) +
layer(
 data = tc_register, mapping = aes(x = timestamp, y = mean[mean >-110] ),
 geom = "smooth", stat = "smooth", color = "darkblue"
) +
layer(
 data = c_register, mapping = aes(x = timestamp, y = mean[mean >-110] ),
 geom = "smooth", stat = "smooth", color = "darkgreen"
) +
layer(
 data = en_register, mapping = aes(x = timestamp, y = mean[mean >-110] ),
 geom = "smooth", stat = "smooth", color = "brown"
)+
layer(
 data = a_register, mapping = aes(x = timestamp, y = mean[mean >-110] ),
 geom = "smooth", stat = "smooth", color = "blueviolet"
) +
layer(
 data = af_register, mapping = aes(x = timestamp, y = mean[mean >-110] ),
 geom = "line", stat = "smooth", color = "aquamarine"
) +
layer(
 data = vws_register, mapping = aes(x = timestamp, y = mean[mean >-110] ),
 geom = "smooth", stat = "smooth", color = "darkgoldenrod1"
)