# Dams storage capacity
# Source: Grand Database V1.1
# Unit million cubic meters

# ISWEL folder for data
setwd('P:/is-wel/indus/message_indus')

library(rgdal)
library(ncdf4)
library(chron)
library(raster)
library(tidyverse)
library(sp)

year = c( seq( 1990, 2010, by = 10  ), 2015, seq( 2020, 2060, by = 10 ) )

# Indus delineatiion
indus_basin.spdf = readOGR("P:/is-wel/indus/message_indus/input",'Indus_bcu')
proj4string(indus_basin.spdf)

## Grand Database V1.1
# million cubic meters
dam_capacity.spdf = readOGR("P:/is-wel/shared_data_sources/raw_data/grand_v1_1",'GRanD_dams_v1_1')
dam_capacity.spdf@proj4string
dam_capacity.spdf = spTransform( dam_capacity.spdf, crs(indus_basin.spdf) )
indus_dam_cam.spdf <- dam_capacity.spdf[indus_basin.spdf , ]
indus_dam_cam.spdf = indus_dam_cam.spdf[,c("DAM_NAME",'YEAR','CAP_REP','AREA_REP')]
names(indus_dam_cam.spdf) = c("DAM_NAME",'YEAR','Mm3','AREA_km2')
dams_no_cap <- indus_dam_cam.spdf@data %>%
  filter(Mm3 <= 0)
indus_dam_cam.spdf <- indus_dam_cam.spdf[indus_dam_cam.spdf@data$Mm3 >= 0,]

vol_area.spdf <- indus_dam_cam.spdf[indus_dam_cam.spdf@data$AREA_km2 >= 0,]
vol_area.spdf$AV_ratio = vol_area.spdf$AREA_km2 * 10^3 / (vol_area.spdf$Mm3 * 10^6) # result unit: 1/m

# planned plants with storage capacity
planned_projects.df = data.frame( read.csv( "P:/is-wel/indus/message_indus/input/powerplants/indus_future_hydro_projects.csv", stringsAsFactors = FALSE ) )
planned_projects.df = planned_projects.df %>%
  select("project.name",'opening','storage_km3','x','y') %>%
  mutate(storage_km3 = storage_km3 * 1000) %>%
  filter(storage_km3 > 0) %>%
  mutate()

planned_projects.spdf = planned_projects.df
names(planned_projects.spdf) = c("DAM_NAME", 'YEAR', 'Mm3','LONG_DD','LAT_DD' )
coordinates(planned_projects.spdf) = ~ LONG_DD + LAT_DD
proj4string(planned_projects.spdf) = proj4string(indus_basin.spdf)
planned_projects.spdf = spTransform( planned_projects.spdf, crs(indus_basin.spdf) )

library(tmap)
indus_dam_cam.spdf$DAM_NAME[indus_dam_cam.spdf$Mm3 <= 7000] = NA
tm_shape(indus_basin.spdf)+
  tm_borders(col = NA, lwd = 1.5, lty = "solid", alpha = 0.3)+
  tm_polygons(col = NA, lwd = 1, lty = "solid", alpha = 0.2)+
  tm_text('PID',size = 0.8,auto.placement = T)+
  tm_shape(indus_dam_cam.spdf)+
  tm_bubbles(size = 1, col = "Mm3",
             breaks = c(0,2000,4000,8000,12000,16000),
             border.col = "black", border.alpha = .5,
             title.col="Dam Storage Capacity [M m^3]")+
  tm_text('DAM_NAME',size = 1.2,col = 'chocolate',auto.placement = T)+
  tm_layout(legend.position = c("right","bottom"))

tm_shape(indus_basin.spdf)+
  tm_borders(col = NA, lwd = 1.5, lty = "solid", alpha = 0.3)+
  tm_polygons(col = NA, lwd = 1, lty = "solid", alpha = 0.2)+
  tm_text('PID',size = 0.8,auto.placement = T)+
  tm_shape(planned_projects.spdf)+
  tm_bubbles(size = 1, col = "Mm3",
             breaks = c(0,2000,4000,8000,12000,16000),
             border.col = "black", border.alpha = .5,
             title.col="Dam Storage Capacity [M m^3]")+
  tm_text('DAM_NAME',size = 1,col = 'chocolate',auto.placement = T)+
  tm_layout(legend.position = c("right","bottom"))

indus_dam_cam.spdf = indus_dam_cam.spdf + planned_projects.spdf
# gets pids
indus_dam_cam.spdf@data$PID <- as.character(over(indus_dam_cam.spdf,indus_basin.spdf[,"PID"])$PID)
a = indus_dam_cam.spdf@data
river.spdf = readOGR( paste( getwd(), 'input', sep = '/' ), paste( basin, 'bcu_river', sep = '_' ), verbose = FALSE )

map_storage_capacity <- tm_shape(indus_basin.spdf)+
  tm_borders(col = NA, lwd = 1.5, lty = "solid", alpha = 0.3)+
  tm_polygons(col = NA, lwd = 1, lty = "solid", alpha = 0.2)+
  tm_shape(river.spdf)+
    tm_lines(col = 'cyan3', lwd = 1.5, lty = "solid", alpha = 0.8)+
  tm_shape(indus_dam_cam.spdf)+
    tm_bubbles(size = 1, col = "Mm3",
               breaks = c(0,2000,4000,8000,12000,16000),
               border.col = "black", border.alpha = .5,
               title.col="Dam Storage Capacity [M m^3]")+
    tm_layout(legend.position = c("right","bottom"))

pdf("P:/is-wel/indus/message_indus/input/dam_storage_capacity_GRANDv1.1_M_m3.pdf")
map_storage_capacity
dev.off()

to_model <- indus_dam_cam.spdf@data %>%
  mutate(YEAR = as.numeric(if_else(YEAR == 'proposed', '2030',
                      if_else(as.numeric(YEAR) < 2020,'2020','2030')))) %>%
  group_by(PID,YEAR) %>%
  summarise(value = sum(Mm3)) %>% ungroup() %>%
  select(PID,YEAR,value) %>%
  group_by(PID) %>%
  mutate(value = cumsum(value))
#  mutate(value = if_else(YEAR == 2030,cumsum(value),value ))

#add all he years
to_model.out = bind_rows( lapply( year, function( yy ){
  bind_rows( lapply( unique(to_model$PID), function( nn ){
          data.frame( year = yy, node = nn, value = if (yy < 2030){
                      to_model$value[ to_model$PID == nn & to_model$YEAR == 2020 ]  } else {
                        max(to_model$value[ to_model$PID == nn & to_model$YEAR == 2020 ],
                            to_model$value[ to_model$PID == nn & to_model$YEAR == 2030 ])
                      } )
  } ) )
} ) )

write_csv(to_model.out, "P:/is-wel/indus/message_indus/input/storage/dam_storage_capacity_GRANDv1.1_M_m3_PID.csv")

if (basin == 'Indus'){
level_dams = read_csv("P:/is-wel/indus/message_indus/input/storage/wapda_indus_reservoir_levels.csv")
level_dams_avg = level_dams %>%
  summarise_all(mean)

# Volumnes and Areas from GRanD_Technical_Documentation_v1_1, V[Mm3] = 0.678 * ( A[km2] * h[m] )^0.9229
# water levels from WAPDA, those are NOT Dam heigt, so should not be used in the above formula
# the following approach works as we deal with a differences of h_max - h_avg
# to account for Volumes the h_dam to be used are: 470 ft Tarbela, 490 ft Mangla
avg_storage_calculation = data.frame(DAM_NAME = c('Tarbela','Mangla'),
                                     h_max = c(max(level_dams$TARBELA_LEVELS_FEET),max(level_dams$MANGLA_LEVELS_FEET)),
                                     h_avg = c(level_dams_avg$TARBELA_LEVELS_FEET,level_dams_avg$MANGLA_LEVELS_FEET),
                                     A_avg = c((dam_capacity.spdf@data %>% filter(DAM_NAME == 'Tarbela') %>% select(AREA_REP))[,1],
                                                (dam_capacity.spdf@data %>%  filter(DAM_NAME == 'Mangla') %>%  select(AREA_REP))[,1]),
                                     V_max = c((dam_capacity.spdf@data %>% filter(DAM_NAME == 'Tarbela') %>% select(CAP_REP))[,1],
                                               (dam_capacity.spdf@data %>%  filter(DAM_NAME == 'Mangla') %>%  select(CAP_REP))[,1]),
                                     stringsAsFactors = F) %>%
  mutate(h_diff = (h_max-h_avg)*0.3048) %>%
  mutate(V_diff = 0.678 * ( A_avg * h_diff )^0.9229) %>%
  mutate(avg_strg = 1 -(V_diff/V_max)) %>%
  left_join(a %>% select(DAM_NAME,PID)) %>% rename(node = PID)
other_pid_val = mean(avg_storage_calculation$avg_strg)
other_pid = indus_basin.spdf$PID[!(indus_basin.spdf$PID %in% avg_storage_calculation$node)]

#check/compare with SDIP Indus River report
b_check <- data.frame(DAM_NAME = c('Tarbela','Mangla'),
                      h_max = c(max(level_dams$TARBELA_LEVELS_FEET),max(level_dams$MANGLA_LEVELS_FEET))*0.3048,
                      h_avg = c(level_dams_avg$TARBELA_LEVELS_FEET,level_dams_avg$MANGLA_LEVELS_FEET)*0.3048,
                      disc_max = c(max(level_dams$`INDUS AT TARBELA OUTLFOW_1000cusecs`),
                                   max(level_dams$JHELUM_AT_MANGLA_OUTFLOW_1000cusecs))*0.3048^3*1000,
                      disc_min = c(min(level_dams$`INDUS AT TARBELA OUTLFOW_1000cusecs`),
                                   min(level_dams$JHELUM_AT_MANGLA_OUTFLOW_1000cusecs))*0.3048^3*1000
                      )
# numbers are consistent

multiplier = data.frame(node = other_pid, avg_strg = other_pid_val,stringsAsFactors = F) %>%
  bind_rows(avg_storage_calculation %>% select(node,avg_strg))

write_csv(multiplier, "P:/is-wel/indus/message_indus/input/storage/average_storage_multiplier.csv")

}

# evap

cwatm_wd = 'P:/watxene/CWATM_Indus'
# Get the climate model and scenario names
fls = list.files( cwatm_wd, pattern = '5min' )
#fls = fls[ which( !( grepl( 'historical', fls ) ) ) ]
climate_models = unique( unlist( strsplit( fls, '_' ) )[seq(2,by=4,4*length( fls ) ) ] )
climate_scenarios = unique( unlist( strsplit( fls, '_' ) )[seq(3,by=4,4*length( fls ) ) ] )

if( !file.exists( paste0( getwd(), '/input/daily_evaporation.csv') ) ){

  evap.df = bind_rows( lapply( climate_scenarios, function( climate_scenario ){

    bind_rows( lapply( climate_models, function( climate_model ){

      if( file.exists( paste0( 'input/hydroclimate_input/evap_metersperday_',climate_model,'_', climate_scenario, '.tif' ) ) )
      {

        EVref.stack = stack( paste0( 'input/hydroclimate_input/evap_metersperday_',climate_model,'_', climate_scenario, '.tif' ) )
        names(EVref.stack) = c( sapply( c(2010,2020,2030,2040,2050,2060), function(yy){ return( paste( yy, seq(1,12,by=1), sep='.') ) } ) )

        # Resample to match GAEZ data
        crop_folder = list.dirs(path = yeld_path)
        crop_folder = crop_folder[ grep( paste0('irr_', crop_names[1]), crop_folder)]
        crop_file = list.files(path = crop_folder,pattern = '.tif')
        tmp = crop( raster( paste0(crop_folder,'/',crop_file) ), extent(basin.spdf) )
        EVref.stack = resample( EVref.stack, tmp, method = 'bilinear' )

        # FAO equation for irrigation water requirement
        EVref.stack[ EVref.stack < 0 ] = 0
        st = EVref.stack
        # Get values for each basin PID
        lst = raster::extract( st, basin.spdf, byid=TRUE )
        yr = ( unlist( strsplit( names( st ), '[.]' ) )[seq(1,2*length(names(st)),by=2)] )
        yr = unlist( strsplit( yr, 'X' ) )[seq(2,2*length(yr),by=2)]
        mn = ( unlist( strsplit( names( st ), '[.]' ) )[seq(2,2*length(names(st)),by=2)] )
        df = bind_rows( lapply( 1:length( lst ), function( x ){
          data.frame( scenario = climate_scenario,
                      model = climate_model,
                      node = basin.spdf@data$PID[ x ],
                      year = yr,
                      time = mn,
                      unit = 'MCM_per_day',
                      value = 1e4 * sapply( 1:ncol( lst[[ x ]] ), function( jjj ){ mean( lst[[ x ]][ , jjj ], na.rm = TRUE ) } ) ) # 1e4 is conversion from meters per day
        } ) )
        df$value[ is.nan( df$value ) ] = 0

        return( df )

      }
    } ) )

  } ) )

  # Write to csv
  write.csv( evap.df, paste0( getwd(), '/input/daily_evaporation.csv'), row.names = FALSE )

} else{
  evap.df = read.csv(paste0( getwd(), '/input/daily_evaporation.csv'),stringsAsFactors=FALSE )

}

# gets pids
vol_area.spdf@data$PID <- as.character(over(vol_area.spdf,indus_basin.spdf[,"PID"])$PID)
vol_area.df = vol_area.spdf@data %>%
  rename(node = PID) %>%
  select(node,AV_ratio) %>%
  group_by(node) %>%
  summarise(AV_ratio = mean(AV_ratio))

avg_AV_ratio = mean(vol_area.df$AV_ratio)

# According to Liu et al. 2018, per unit volume evaporation factor = 0.5 * ev * AV_ratio
evap_factor.df = evap.df %>% left_join(vol_area.df) %>%
  mutate(AV_ratio = if_else(is.na(AV_ratio),avg_AV_ratio,AV_ratio)) %>%
  rename(ev = value) %>%
  mutate(value = 0.5*ev*AV_ratio) %>%
  mutate(unit = 'unitless')

write.csv( evap_factor.df, paste0( getwd(), '/input/storage/evapo_loss_reservoir_per_unit_volume.csv'), row.names = FALSE )

## rule curves

level_dams = read_csv("P:/is-wel/indus/message_indus/input/storage/wapda_indus_reservoir_levels.csv")

# from GRanD_Technical_Documentation_v1_1, V[Mm3] = 0.678 * ( A[km2] * h[m] )^0.9229
# maximum volumes from WAPDA
monthly_level = rbind(data.frame(month = level_dams$`PERIOD DATE 2017-18`,
                                 DAM_NAME = c('Tarbela'),
                                 node = 'PAK_8',
                                 h_max = c(max(level_dams$TARBELA_LEVELS_FEET)),
                                 h_avg = c(level_dams$TARBELA_LEVELS_FEET)/mean(c(level_dams$TARBELA_LEVELS_FEET))*470,
                                 A_avg = (dam_capacity.spdf@data %>% filter(DAM_NAME == 'Tarbela') %>% select(AREA_REP))[,1],
                                 V_max = (dam_capacity.spdf@data %>% filter(DAM_NAME == 'Tarbela') %>% select(CAP_REP))[,1],
                                 stringsAsFactors = F),
                      data.frame(month = level_dams$`PERIOD DATE 2017-18`,
                                 DAM_NAME = c('Mangla'),
                                 node = 'PAK_1',
                                 h_max = c(max(level_dams$MANGLA_LEVELS_FEET)),
                                 h_avg = c(level_dams$MANGLA_LEVELS_FEET)/mean(c(level_dams$MANGLA_LEVELS_FEET))*490,
                                 A_avg = (dam_capacity.spdf@data %>%  filter(DAM_NAME == 'Mangla') %>%  select(AREA_REP))[,1],
                                 V_max = (dam_capacity.spdf@data %>%  filter(DAM_NAME == 'Mangla') %>%  select(CAP_REP))[,1],
                                 stringsAsFactors = F) ) %>%
  mutate(h_avg2 = h_avg *0.3048) %>%
  mutate(V_avg = 0.678 * ( A_avg * h_avg2 )^0.9229) %>%
  mutate(V_avg2 = 30.684 * ( A_avg)^0.9578) %>%
  mutate(month = gsub('.*-','',month))

map_months = data.frame(month = c('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'),
                        time = seq(1,12,1) ,stringsAsFactors = F)

monthly_lvl_agg = monthly_level %>%
  left_join(map_months) %>% ungroup() %>%
  group_by(time,DAM_NAME,node) %>%
  summarise(h_avg2 = mean(h_avg2),V_max = mean(V_max),V_avg = mean(V_avg)) %>% ungroup() %>%
  group_by(DAM_NAME) %>% mutate(V_avg = V_avg - (max(V_avg) - V_max)) %>% ungroup()

ggplot(data = monthly_lvl_agg)+
  geom_line(aes(time,V_avg))+
  geom_line(aes(time,V_max),color = 'red',linetype="dashed")+
  facet_wrap(~DAM_NAME)+ylab('Mm^3')+xlab('month')+
  scale_x_continuous(expand = c(0,0),breaks=seq(1,12,1))+
  theme_bw()

# probably take the higher series to set upper constraint
monthly_variations = monthly_lvl_agg %>%
  mutate(ratio_avg_max = V_avg/V_max) %>%
  mutate(max_min = if_else(node == 'PAK_8','max','min')) %>%
  group_by(max_min) %>%
  arrange(time) %>%
  mutate(diff_on_max = (V_avg - lag(V_avg, default = first(V_avg)))/V_max ) %>%
  select(-node,-h_avg2)

ggplot()+
  geom_line(data = monthly_variations,aes(time, ratio_avg_max,color = max_min))+theme_bw()

write.csv( monthly_variations, paste0( getwd(), '/input/storage/rule_curves_values.csv'), row.names = FALSE )


### Matrix Span Processing Script ###
### Author: James Stone ###
### Version: 1.0 ###
### For use with the matrix span task available at http://www.cognitivetools.uk/ ###

#required library
library(stringr)

# Set the working directory of R to the folder that hosts the output files from the matrix span task #

### function that takes the data frame from an output file and returns that persons summary info ###

matrix_span_processing <- function(data.frame) {

	num.trials <- nrow(data.frame)

	fta.score <- 0
	for (i in 1:num.trials) {
		if (data.frame$trial.matrix_span.result[i] == "success") {
			fta.score <- fta.score + data.frame$trial.matrix_span.load[i]
		}
	}

	#highest load with a fully correct response
	if (length(data.frame$trial.matrix_span.load[data.frame$trial.matrix_span.result == "success"]) == 0) {
		#no successes
		max.span <- NA
	} else {
		max.span <- max(data.frame$trial.matrix_span.load[data.frame$trial.matrix_span.result == "success"])
	}

	#span two trials correct
	if (nrow(subset(data.frame, trial.matrix_span.load == 2)) == 0) {
		#then there were no span size 2 trials, therefore
		span.2.corr <- NA
	} else {
		span.2.corr <- sum(data.frame$trial.matrix_span.points[data.frame$trial.matrix_span.load == 2])
	}
	#span three trials correct
	if (nrow(subset(data.frame, trial.matrix_span.load == 3)) == 0) {
		#then there were no span size 3 trials, therefore
		span.3.corr <- NA
	} else {
		span.3.corr <- sum(data.frame$trial.matrix_span.points[data.frame$trial.matrix_span.load == 3])
	}
	#span four trials correct
	if (nrow(subset(data.frame, trial.matrix_span.load == 4)) == 0) {
		#then there were no span size 4 trials, therefore
		span.4.corr <- NA
	} else {
		span.4.corr <- sum(data.frame$trial.matrix_span.points[data.frame$trial.matrix_span.load == 4])
	}
	#span five trials correct
	if (nrow(subset(data.frame, trial.matrix_span.load == 5)) == 0) {
		#then there were no span size 5 trials, therefore
		span.5.corr <- NA
	} else {
		span.5.corr <- sum(data.frame$trial.matrix_span.points[data.frame$trial.matrix_span.load == 5])
	}
	#span six trials correct
	if (nrow(subset(data.frame, trial.matrix_span.load == 6)) == 0) {
		#then there were no span size 6 trials, therefore
		span.6.corr <- NA
	} else {
		span.6.corr <- sum(data.frame$trial.matrix_span.points[data.frame$trial.matrix_span.load == 6])
	}
	#span seven trials correct
	if (nrow(subset(data.frame, trial.matrix_span.load == 7)) == 0) {
		#then there were no span size 7 trials, therefore
		span.7.corr <- NA
	} else {
		span.7.corr <- sum(data.frame$trial.matrix_span.points[data.frame$trial.matrix_span.load == 7])
	}
	#span eight trials correct
	if (nrow(subset(data.frame, trial.matrix_span.load == 8)) == 0) {
		#then there were no span size 8 trials, therefore
		span.8.corr <- NA
	} else {
		span.8.corr <- sum(data.frame$trial.matrix_span.points[data.frame$trial.matrix_span.load == 8])
	}
	#span nine trials correct
	if (nrow(subset(data.frame, trial.matrix_span.load == 9)) == 0) {
		#then there were no span size 9 trials, therefore
		span.9.corr <- NA
	} else {
		span.9.corr <- sum(data.frame$trial.matrix_span.points[data.frame$trial.matrix_span.load == 9])
	}

	###finally, to get prop score, and number individual successes need to break down the recall
	###segment to a per element basis, not the per trial basis we get as output.

	#create a new data frame where every row is one response within a trial

	#number of rows will be the sum of the loads
	num.elements <- sum(data.frame$trial.matrix_span.load)

	ID <- numeric(num.elements)
	trial.no <- numeric(num.elements)
	load <- numeric(num.elements)
	question <- numeric(num.elements)
	response <- numeric(num.elements)
	success <- numeric(num.elements)
	counter <- 1

	for (i in 1:nrow(data.frame)) {

		num_elements <- data.frame$trial.matrix_span.load[i]
		tmp_question <- as.character(data.frame$trial.matrix_span.question[i])
		tmp_response <- as.character(data.frame$trial.matrix_span.response[i])
		q <- str_split_fixed(tmp_question,", ", num_elements)
		r <- str_split_fixed(tmp_response,", ", num_elements)

		if (nchar(q[1]) == 2) {
		  q[1] <- substr(q[1],2,2)
		} else if (nchar(q[1]) == 3) {
		  q[1] <- substr(q[1],2,3)
		}

		if (nchar(r[1]) == 2) {
		  r[1] <- substr(r[1],2,2)
		} else if (nchar(r[1]) == 3) {
		  r[1] <- substr(r[1],2,3)
		}

		if (nchar(q[num_elements]) == 2) {
		  q[num_elements] <- substr(q[num_elements],1,1)
		} else if (nchar(q[num_elements]) == 3) {
		  q[num_elements] <- substr(q[num_elements],1,2)
		} else if (nchar(q[num_elements]) == 4) {
		  q[num_elements] <- substr(q[num_elements],1,3)
		}

		if (nchar(r[num_elements]) == 2) {
		  r[num_elements] <- substr(r[num_elements],1,1)
		} else if (nchar(r[num_elements]) == 3) {
		  r[num_elements] <- substr(r[num_elements],1,2)
		} else if (nchar(r[num_elements]) == 4) {
		  r[num_elements] <- substr(r[num_elements],1,3)
		}

		q.vec <- as.numeric(q)
		r.vec <- as.numeric(r)

		for (j in 1:data.frame$trial.matrix_span.load[i]) {
			ID[counter] <- data.frame$user.yearOfBirth[1]
			trial.no[counter] <- data.frame$trial.matrix_span.trialNo[i]
			load[counter] <- data.frame$trial.matrix_span.load[i]
			question[counter] <- q.vec[j]
			response[counter] <- r.vec[j]
			success[counter] <- q.vec[j] == r.vec[j]
			counter <- counter + 1
		}
	}

	data.frame.indi <- as.data.frame(cbind(ID,trial.no,load,question,response,success))

	number.successes <- sum(data.frame.indi$success)

	props <- numeric(num.trials)

	for (i in 1:num.trials) {
		this.trial.load <- nrow(subset(data.frame.indi, trial.no == i))
		this.trial.successes <- sum(data.frame.indi$success[data.frame.indi$trial.no == i])
		props[i] <- this.trial.successes / this.trial.load
	}

	prop.score <- mean(props)

	p.summary <- c(fta.score, prop.score, number.successes,
	max.span, span.2.corr, span.3.corr, span.4.corr, span.5.corr, span.6.corr, span.7.corr, span.8.corr,
	span.9.corr)

	return(p.summary)

}

##now can use that function on all our data files for matrix span
#put all matrix span files into one folder and set that folder as working directory

compile_matrix_span_data <- function() {

	multiple.sessions <- character()
	filenames <- list.files()
	matrix.span.data <- matrix(nrow=length(filenames), ncol=12) #ncol needs to be number of values in p.summary above
	user <- character()

	for (i in 1:length(filenames)) {

		tmp.df <- read.csv(filenames[i])
		user[i] <- toString(tmp.df$user.name[1])

		if (length(unique(tmp.df$session.id)) > 1) {
			multiple.sessions[length(multiple.sessions) + 1] <- filenames[i]
		}

		tmp.matrix.summary <- matrix_span_processing(tmp.df)

		matrix.span.data[i, ] <- tmp.matrix.summary

	}

	matrix.span.data <- as.data.frame(matrix.span.data)
	matrix.span.data$user <- user

	matrix.names <- c("fta.score", "prop.score", "number.successes",
	"max.span", "span.2.corr", "span.3.corr", "span.4.corr", "span.5.corr", "span.6.corr", "span.7.corr", "span.8.corr",
	"span.9.corr", "user")

	names(matrix.span.data) <- matrix.names

	if (length(multiple.sessions > 0)) {
		cat("The following files contained trials with more than one session id: \n", multiple.sessions)
	}

	return(matrix.span.data)

}

matrix.span.data <- compile_matrix_span_data()

rm(compile_matrix_span_data, matrix_span_processing)


prefix=''

repetitions <- 30
#sum <- read.table(as.character(1))
for(i in 1:repetitions)
{
	#print(i)
	#a <- read.table(as.character(i))
	a <- read.table(paste(prefix,i,sep=""))
	#print(a)
	k <- length(a[,1])

	if(k == 2000)
	{
		write.table(a,paste("p",i,sep=""),row.names=F,col.names=F)
	}
	else
	{
		a[k,] <- c((k)*100-100,100001)
		x <- seq((k+1)*100-100,200000 -100,by=100)
		y <- as.data.frame(cbind(x,100001))
		names(y) <- c("x","y")
		names(a) <- c("x","y")
		completedata <- rbind(a,y)
		#print(completedata)

		write.table(completedata,file=paste("p",i,sep=""),row.names=F,col.names=F)
	}

}


# define string formatting
`%--%` <- function(x, y)
  # from stack exchange:
  # https://stackoverflow.com/questions/46085274/is-there-a-string-formatting-operator-in-r-similar-to-pythons
{
  do.call(sprintf, c(list(x), y))
}

results <- data.frame(matrix(0, ncol = 6, nrow = 4))
colnames(results) <- c("BART-Int", "BART-Int-se", "GPBQ", "GPBQ-se", "MI", "MI-se")
dims = c(1, 10, 20, 100)
l = 1
for (dim in dims) {
  bart = c()
  gp = c()
  mi = c()
  for (num_cv in 1:20) {
    df <- read.csv("results/genz/9/additive_gaussianDim%sNoSequentialUniform_%s.csv" %--% c(dim, num_cv))
    bart = c(bart, df$BARTMean)
    gp = c(gp, df$GPMean)
    mi = c(mi, df$MIMean)
  }
  results[l, 1] = signif(mean(abs(bart - df$actual) / df$actual), 3)
  results[l, 2] = signif(sd(abs(bart - df$actual) / df$actual) / sqrt(20), 3)
  results[l, 3] = signif(mean(abs(gp - df$actual) / df$actual), 3)
  results[l, 4] = signif(sd(abs(gp - df$actual) / df$actual) / sqrt(20), 3)
  results[l, 5] = signif(mean(abs(mi - df$actual) / df$actual), 3)
  results[l, 6] = signif(sd(abs(mi - df$actual) / df$actual) / sqrt(20),3)

  l = l+1
}
print(results)
write.csv(results, "results/genz/high_dimensionality.csv")


library(GenomicRanges)
library(SnapATAC)

metadata <- read.table('../input/metadata_corces2016_sorted.tsv',
                         header = TRUE,
                         stringsAsFactors=FALSE,quote="",row.names=1)
barcode_metadata <- read.table('../tmp/corces2016_barcode_metadata.tsv',
                        header = TRUE,
                        stringsAsFactors=FALSE,quote="",row.names=1)

x.sp = createSnap(
file="../output/corces2016.snap",
sample="corces2016",
do.par = TRUE,
num.cores=10)

showBinSizes("../output/corces2016.snap");
x.sp = addBmatToSnap(x.sp, bin.size=5000, num.cores=10);

x.sp = makeBinary(x.sp, mat="bmat");

# system("wget http://mitra.stanford.edu/kundaje/akundaje/release/blacklists/hg19-human/wgEncodeHg19ConsensusSignalArtifactRegions.bed.gz -O ../input/wgEncodeHg19ConsensusSignalArtifactRegions.bed.gz")

black_list = read.table('../input/wgEncodeHg19ConsensusSignalArtifactRegions.bed.gz')
black_list.gr = GRanges(black_list[,1], IRanges(black_list[,2], black_list[,3]));
idy1 = queryHits(findOverlaps(x.sp@feature, black_list.gr));
idy2 = grep("chrM|random", x.sp@feature);
idy = unique(c(idy1, idy2));
x.sp = x.sp[,-idy, mat="bmat"];

x.sp = filterBins(
x.sp,
low.threshold=-2,
high.threshold=2,
mat="bmat"
);

corces2016_bmat<-x.sp@bmat
colnames(corces2016_bmat)<-x.sp@feature@elementMetadata@listData$name

corces2016_fullRange<-read.table("../input/corces2016_5k_full.txt")

corces2016_bmat_full<-matrix(ncol = length(corces2016_fullRange$V1),nrow = nrow(corces2016_bmat))

rownames(corces2016_bmat_full)<-rownames(corces2016_bmat)
colnames(corces2016_bmat_full)<-corces2016_fullRange$V1

for(i in 1:length(corces2016_fullRange$V1)){
    range<-as.character(corces2016_fullRange$V1[i])
    if(range %in% colnames(corces2016_bmat)){
        corces2016_bmat_full[,range]<-corces2016_bmat[,range]
    } else{
        corces2016_bmat_full[,range]<-0
    }
}

saveRDS(corces2016_bmat,file="../output/corces2016-snap.rds")
saveRDS(corces2016_bmat_full,file="../output/corces2016-snap-full.rds")


#Usage:
#Rscript ~/RNASeqPipeline/RScripts/trim_data.r range
library("monocle")
library("reshape")
args <- commandArgs(trailingOnly=TRUE)
if(length(args)!=1)
{
	print("Usage: Rscript trim_data.r range")
}
HSMM <- readRDS('post_quality_control_data.rds')
#print(HSMM)
HSMM <- HSMM[, strtoi(unlist(strsplit(args[1],",")))]
saveRDS(HSMM,'post_quality_control_data.rds')
pData(HSMM)$Size_Factor <- NULL
rownames(pData(HSMM)) <- NULL
pData(HSMM)$Total_mRNAs <- Matrix::colSums(exprs(HSMM))
write.table(pData(HSMM), 'trim_table_after.txt', sep="\t",quote=FALSE)


library(jsonlite)
library(dplyr)
library(tidyr)
library(caTools)

rawdata <- fromJSON(txt="matches.json")

# Drop unused column
data <- rawdata[,c('match_id','radiant_win','radiant_team','dire_team')]

# Group winner, loser
data %>% mutate(winner = case_when(radiant_win ~ radiant_team, !radiant_win ~ dire_team),
               loser = case_when(!radiant_win ~ radiant_team, radiant_win ~ dire_team)) -> data

# Split heroes string
data %>% separate(loser, c('l1', 'l2','l3','l4','l5'), ',') -> data

#Split sample
sample <- sample.split(data$match_id, SplitRatio = 0.7)
train <- subset(data, sample == TRUE)
test <- subset(data, sample == FALSE)

# Unnest winner
train %>% transform(winner = strsplit(winner, ",")) %>% unnest(winner) -> train

# Split heroes string
test %>% separate(winner, c('w1', 'w2','w3','w4','w5'), ',') -> test

# Drop unused data
train <- train[,c('match_id','l1', 'l2','l3','l4','l5','winner')]
test <- test[,c('match_id','l1', 'l2','l3','l4','l5','winner')]


# Copyright 2020 The MuLT Authors. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# ==============================================================================

library(ggplot2)

df <- read.csv('data/output/pca_with_resp.csv')

p <- ggplot(df) + geom_point(aes(PCA1, PCA2, colour=as.factor(Greater18Months.Days.to.Progression))) +
  scale_colour_discrete(name = "Risk", labels=c('Hight', 'Low'))

ggsave('images/pca_all_vars.pdf', p, units='cm', width=16, height=10)

df <- read.csv('data/output/pca_with_resp_and_reduction.csv')

p <- ggplot(df) + geom_point(aes(PCA1, PCA2, colour=as.factor(Greater18Months.Days.to.Progression))) +
  scale_colour_discrete(name = "Risk", labels=c('Hight', 'Low'))

ggsave('images/pca_reduced_gens.pdf', p, units='cm', width=16, height=10)


#make yearly landcover mosaics
library(tidyverse)
library(gdalUtils)
library(raster)
dir.create("data/MCD12Q1_tifs/")
# getting the tifs

years<- 2016:2019

for(y in years){
  system(paste0("aws s3 sync s3://earthlab-natem/modis-burned-area/input/landcover/",y, " data/MCD12Q1/", y))
}

for(y in years){
lc_files <- list.files(file.path("data/MCD12Q1/",y), full.names = TRUE)
dir.create(paste0("data/MCD12Q1_tifs/",y))

for(f in lc_files){
  tile <- str_extract(f, "h\\d{2}v\\d{2}")
  out_file <- paste0("data/MCD12Q1_tifs/",y,"/",tile,".tif")
  sds <- f %>%
    gdalUtils::get_subdatasets()
  gdalUtils::gdal_translate(sds[1], dst_dataset = out_file)
 print(paste(tile))
}}

dir.create("data/MCD12Q1_mosaics")
library(raster)
for(y in years){
  ff <- list.files(file.path("data/MCD12Q1_tifs", y), full.names = TRUE)
  rr <- list()
  for(fff in ff){
    rr[[fff]] <- raster(fff)
  }
  names(rr) <- NULL
  rr$fun = mean
  rr$na.rm = TRUE
  xx <- do.call(mosaic,rr)
  writeRaster(xx,paste0("data/MCD12Q1_mosaics/","lc_mosaic_",y,".tif"))
}

system(paste0("aws s3 sync data/MCD12Q1_mosaics/ s3://earthlab-natem/modis-burned-area/input/landcover/MCD12Q1_mosaics"))


# Folder names

# Parameters
#############

# Model parameters

# sanity-check/
model_folder_names <- c("BGY-E1-C4-I20000-A0.9-T12-F25-V0")

######################## 2020-08-31-v2 data ####################################

# model_folder_names <- c( # best models
#     "BGY-E0-C4-I8000-A0.8-T12-F25-V0",
#     "BGY-E1-C4-I20000-A0.9-T12-F25-V0",
#     "BGY-E2-C4-I8000-A0.8-T12-F25-V0",

#     "FAM-E0-C4-I8000-A0.8-T12-F25-V0",
#     "FAM-E1-C4-I100000-A0.9-T12-F25-V0",
#     "FAM-E2-C4-I8000-A0.8-T12-F25-V0",

#     "LTY-E0-C4-I8000-A0.8-T12-F25-V0",
#     "LTY-E1-C4-I20000-A0.99-T12-F25-V0",
#     "LTY-E2-C4-I100000-A0.99-T12-F25-V0"
# )

######################## 2019-06-19-v1 data ####################################

# model_folder_names <- c( # best models
#     "BGN-E1-C4-I300000-A0.999-T15",
#     "BGY-E0-C4-I8000-A0.8-T12",
#     "BGY-E1-C4-I300000-A0.999-T15",
#     "FAM-E0-C4-I20000-A0.99-T12")

# model_folder_names <- c( # almost there
#     "BGN-E1-C4-I8000-A0.9-T12",
#     "BMY-E0-C4-I8000-A0.95-T12",
#     "BNN-E0-C4-I8000-A0.95-T12",
#     "BNN-E1-C4-I8000-A0.95-T12")

################# Models to run when starting ##################################

# model_folder_names <- c( # models to run
#     "BGY-E0-C4-I8000-A0.8-T12-F50-V50",
#     "BGY-E1-C4-I8000-A0.8-T12-F50-V50",
#     "BGY-E2-C4-I8000-A0.8-T12-F50-V50",

#     "BGY-E0-C4-I8000-A0.8-T12-F25-V0",
#     "BGY-E1-C4-I8000-A0.8-T12-F25-V0",
#     "BGY-E2-C4-I8000-A0.8-T12-F25-V0",

#     "BMY-E0-C4-I8000-A0.8-T12-F25-V0",
#     "FAM-E0-C4-I8000-A0.8-T12-F25-V0",
#     "HAL-E0-C4-I8000-A0.8-T12-F25-V0",
#     "LTY-E0-C4-I8000-A0.8-T12-F25-V0",

#     "BMY-E1-C4-I8000-A0.8-T12-F25-V0",
#     "FAM-E1-C4-I8000-A0.8-T12-F25-V0",
#     "HAL-E1-C4-I8000-A0.8-T12-F25-V0",
#     "LTY-E1-C4-I8000-A0.8-T12-F25-V0",

#     "BMY-E2-C4-I8000-A0.8-T12-F25-V0",
#     "FAM-E2-C4-I8000-A0.8-T12-F25-V0",
#     "HAL-E2-C4-I8000-A0.8-T12-F25-V0",
#     "LTY-E2-C4-I8000-A0.8-T12-F25-V0"
# )


pdf_file<-"pdf/timeseries_daily_weekly_symbols_3x1.pdf"
cairo_pdf(bg="grey98", pdf_file,width=9,height=8.27)

par(mfcol=c(3,1),cex.axis=1.4,omi=c(1,0.5,0.75,0.5),mai=c(0.1,0.2,0.1,0.2),family="Lato Light",las=1)

# Prepare chart and import data

library(gdata)

myCountry<-c("USA","GB","GER")
myCountryName<-c("USA","GB","GER")
for (i in 1:length(myCountry))
{
myFile<-paste("myData/Facebook Happiness Index-",myCountry[i],".csv",sep="")
myData<-read.csv(myFile,skip=1)
myData$x<-as.Date(myData$Date)
myData<-subset(myData,myData$x>"2010-10-01")

# Define chart and other elements

plot(myData$x,myData$GNH,type="n",axes=F,ylab="",ylim=c(-0.05,0.4))
points(myData$x,myData$GNH,type="l",col="darkblue")

myData$myYear<-as.numeric(format(myData$x,"%Y"))
myData$myCw<-as.numeric(format(myData$x,"%V"))
myNewData<-myData[order(myData$myYear,myData$myCw,myData$GNH),]
myDay<-NULL
myColour<-NULL
n<-nrow(myNewData)-1
for (j in 1:n)
{
if(myNewData$myCw[j+1] != myNewData$myCw[j])
{
	myDay<-c(myDay,as.character(myNewData$x[j]))
	myColour<-c(myColour,weekdays(myNewData$x[j]))
}
}
myColour<-as.numeric(as.factor(myColour))
points(as.Date(myDay),rep(-0.05,length(myDay)),pch=15,cex=1.5, col=myColour)

mtext(myCountryName[i],3,line=-3,adj=0,cex=1.3,font=3)
source("scripts/inc_daily_weeksymbols_datelabels.r")
}
axis(1,at=myData$x[c(1,length(myData$x))],labels=format(myData$x[c(1,length(myData$x))],"%d. %m. %Y "))
mtext("Happiest day in week:",1,line=3,adj=0,cex=0.9,font=3,outer=T)
legend(as.Date("2010-08-22"),-0.21,c("Mon","Tue","Wed","Thu","Fri","Sat","Sun"),pch=15,col=c(1,2,3,4,5,6,7),ncol=7,bty="n",xpd=NA,cex=1.5)

# Titling

mtext("Facebook Gross National Happiness Index 2010-2012",3,line=1,adj=0,cex=2,family="Lato Black",outer=T)
mtext("Daily values. Source: facebook.com",1,line=4.25,adj=1,cex=0.9,font=3,outer=T)
dev.off()


# Read car and truck values from tab-delimited autos.dat
data <- read.table("./products_ingredients.dat", header=T, sep="|")
#data <- read.table("./products_ingredients2.dat", header=T, sep="|")
#data <- read.table("./autos.dat", header=T, sep="\t")

# Compute the largest y value used in the data (or we could
# just use range again)
# http://stackoverflow.com/questions/77434/how-to-access-the-last-value-in-a-vector
max_x <- tail(data$inganz, n=1)
max_y <- max(data$anz)
med <- median(data$anz)

#print(max_x)
#print(max_y)

# http://stackoverflow.com/questions/14424565/how-to-fill-date-gaps-in-data-frame
#print(data)
#print(data$anz)
#print(data$inganz)
hh <- data.frame(i=seq(min(1), max(max_x), by=1))
#print(hh)
res <- merge(data,hh,by.x='inganz',by.y='i',all.x=T,all.y=T)
#print(res)
# Define colors to be used for cars, trucks, suvs
plot_colors <- c("red")

# Start PNG device driver to save output to figure.png
#png(filename="./products_ingredients.png", height=295, width=300,
png(filename="./products_ingredients.png")
#, height=500, width=500, bg="white")

# Graph autos using y axis that ranges from 0 to max_y.
# Turn off axes and annotations (axis labels) so we can
# specify them ourself
plot(res$anz, type="h", col=plot_colors[1],
   ylim=c(1,max_y), xlim=c(1,max_x), axes=FALSE, ann=FALSE)

#plot(data$anzahl, data$inganz)
#abline(lm(data$anzahl~data$inganz))

# Make x axis using Mon-Fri labels
#axis(1, at=1:5, lab=c("Mon", "Tue", "Wed", "Thu", "Fri"))
axis(1, las=1, at=1*0:max_x)

# Make y axis with horizontal labels that display ticks at
# every 4 marks. 4*0:max_y is equivalent to c(0,4,8,12).
axis(2, las=1, at=1*0:max_y)
# Create box around plot
#box()

# Graph trucks with red dashed line and square points
#lines(data$count, type="o", pch=22, lty=2,
#   col=plot_colors[1])

# Graph suvs with green dotted line and diamond points
#lines(data$suvs, type="o", pch=23, lty=3,
#   col=plot_colors[3])

# Create a title with a red, bold/italic font
desc = paste("Häufigkeiten der Zutatenanzahl in", sum(data$anz),
			 "Produkten", sep=" ")
title(main=desc)

# Label the x and y axes with dark green text
title(xlab="Anzahl Zutaten in Produkt")
title(ylab="Häufigkeit")

# Create a legend at (1, max_y) that is slightly smaller
# (cex) and uses the same line colors and points used by
# the actual plots
#legend(1, max_y, names(data), cex=0.8, col=plot_colors,
#   pch=21:23, lty=1:3);

# Turn off device driver (to flush output to png)
dev.off()


## code to prepare `ipg` dataset goes here

librarian::shelf(
    tidyverse
    , readxl
    , janitor
    , lubridate
    , cran_repo = 'https://cran.r-project.org'
)

igp_begin <- read_excel("source-data/IGP_datos_sismicos.xlsx") |> clean_names()

igp_scrapped <- read_csv(
    "https://raw.githubusercontent.com/TJhon/summary/main/proyectos/ipg-scraping/data/igp_2022.csv"
    # "https://raw.githubusercontent.com/TJhon/summary/main/proyectos/ipg-scraping/data/igp_2022.csv"
    , show_col_types = F) |> clean_names()

head(igp_scrapped)
igp_scrapped_clean <-
    igp_scrapped |>
    separate(date, c("date", "hour"), sep = "-") |>
    mutate(
        across(
            where(is.character), str_trim
        ),
        m = parse_number(m)
        , date = dmy(date)
        , hour = hms(hour)
    ) |>
    relocate(m, .after = prof) |>
    rename(magn = m, intensi_km = prof) |>
    arrange(desc(date))

colnames(igp_begin) <- names(igp_scrapped_clean)
igp_begin_cl <-
    igp_begin |>
    mutate(
        date = dmy(date)
        , hour = hms(hour)
        , across(where(is.character), as.numeric)
    ) |>
    arrange(desc(date))

igp <-
    bind_rows(igp_scrapped_clean, igp_begin_cl) |>
    mutate(
        alert = case_when(
            magn < 4.5 ~ "Green"
            , magn > 6.0 ~ "Red"
            , T ~ "Yellow"
        )
    )

# igp <-
#     readr::read_csv("https://raw.githubusercontent.com/TJhon/summary/main/proyectos/ipg-scraping/output/igp.csv")

usethis::use_data(igp, overwrite = TRUE)


library(tidyr)
library(ggplot2)

source("./config.r")

annotate_text_size <- 7
##############################################################################
# Experiment 2 data

snr_exp <- read.csv("./outputs/simuls/synth_snr/scores.csv", nrows = 5, header = F)
for (ii in c(2, 3, 4, 5, 1)){
  snr_exp[ii,] <- snr_exp[ii,] / snr_exp[1,]
}

snr_exp <- snr_exp %>%
  gather(key = "estimator", value = "score")

estimator2 <- c("chance", "upper", "logdiag", "SPoC", "Riemann") %>%
  factor(, levels = c("chance", "upper", "logdiag", "SPoC", "Riemann"))

snr_exp$estimator <- rep(estimator2, times = 10)

sigmas <- read.csv("./outputs/simuls/synth_snr/sigmas.csv", header = F)
snr_exp$xaxis <- rep(sigmas[["V1"]], each = 5)

color_cats <- c(
  "#56B4E9",# sky blue
  "#009D79",# blueish green
  "#E36C2F",  #vermillon
  "#EEA535"  # orange
  # "#F0E442", #yellow
  # "#0072B2", #blue
  # "#CC79A7" #violet
)

ggplot(
  data = snr_exp %>% subset(estimator != "chance"),
  mapping = aes(y = score, x = xaxis, group = estimator,
                color = estimator)) +
  geom_line(size = 1.5, alpha = 0.8) +
  geom_point(fill = "white", size = 4, shape = 21) +
  my_theme +
  scale_y_continuous(limits = c(0, 1.10), breaks = seq(0, 1, 0.25)) +
  scale_x_log10(breaks =  10^(-10:10),
                minor_breaks = rep(1:9, 21) * (10 ^ rep(-10:10, each=9))) +
  scale_color_manual(values = color_cats, name = NULL) +
  # labs(x = TeX("distance between A and $I_p$"),
  #      y = "normalized M.A.E.") +
  geom_hline(yintercept = 1, color = "black", linetype = "dotted",
             size = 1) +
  annotate(geom = "text", x = 0.05, y = 1.04, label = "chance level",
           size = annotate_text_size) +
  labs(x = expression(sigma),
       y = "Normalized MAE") +
  theme(legend.position = "top", legend.title = element_text(size = 16))

fname <- "./outputs/fig_1b_snr_loglinear"
ggsave(paste0(fname, ".png"), width = 5, height = 5, dpi = 300)
ggsave(paste0(fname, ".pdf"), width = 5, height = 5, dpi = 300,
  useDingbats = F)
embedFonts(file = paste0(fname, ".pdf"), outfile = paste0(fname, ".pdf"))
##############################################################################
# Experiment 2.2 data

snr_exp <- read.csv("./outputs/simuls/synth_snr/scores_powers.csv", nrows = 5, header = F)
for (ii in c(2, 3, 4, 5, 1)){
  snr_exp[ii,] <- snr_exp[ii,] / snr_exp[1,]
}

snr_exp <- snr_exp %>%
  gather(key = "estimator", value = "score")

estimator2 <- c("chance", "upper", "diag", "SPoC", "Riemann") %>%
  factor(, levels = c("chance", "upper", "diag", "SPoC", "Riemann"))

snr_exp$estimator <- rep(estimator2, times = 10)

sigmas <- read.csv("./outputs/simuls/synth_snr/sigmas.csv", header = F)
snr_exp$xaxis <- rep(sigmas[["V1"]], each = 5)

color_cats <- c(
  "#56B4E9",# sky blue
  "#009D79",# blueish green
  "#E36C2F",  #vermillon
  "#EEA535"  # orange
  # "#F0E442", #yellow
  # "#0072B2", #blue
  # "#CC79A7" #violet
)

ggplot(
  data = snr_exp %>% subset(estimator != "chance"),
  mapping = aes(y = score, x = xaxis, group = estimator,
                color = estimator)) +
  geom_line(size = 1.5, alpha = 0.8) +
  geom_point(fill = "white", size = 4, shape = 21) +
  my_theme +
  scale_y_continuous(limits = c(0, 1.10), breaks = seq(0, 1, 0.25)) +
  scale_x_log10(breaks =  10^(-10:10),
                minor_breaks = rep(1:9, 21) * (10 ^ rep(-10:10, each=9))) +
  scale_color_manual(values = color_cats, name = NULL) +
  # labs(x = TeX("distance between A and $I_p$"),
  #      y = "normalized M.A.E.") +
  geom_hline(yintercept = 1, color = "black", linetype = "dotted",
             size = 1) +
  annotate(geom = "text", x = 0.05, y = 1.04, label = "chance level",
           size = annotate_text_size) +
  labs(x = expression(sigma),
       y = "Normalized MAE") +
  theme(legend.position = "top", legend.title = element_text(size = 16))

fname <- "./outputs/fig_1b_snr_linear"
ggsave(paste0(fname, ".png"), width = 5, height = 5, dpi = 300)
ggsave(paste0(fname, ".pdf"), width = 5, height = 5, dpi = 300,
  useDingbats = F)
embedFonts(file = paste0(fname, ".pdf"), outfile = paste0(fname, ".pdf"))


install.packages("survHE", lib ='~/R-packages/')
install.packages("ggmcmc", lib ='~/R-packages/')

devtools::install_github("Philip-Cooney/expertsurv", lib =  '~/R-packages/')
#remove.packages("expertsurv", lib = '~/R-packages/')
#remove.packages("survHE", lib = '~/R-packages/')
library("expertsurv", lib.loc = '~/R-packages/')
library("dplyr")

n <- 2
times <- rexp(n, 0.2)
status <- rep(1,n)
time_study <- 200
conflict_prefer("mutate", "dplyr")
conflict_prefer("filter", "dplyr")
conflict_prefer("select", "dplyr")

df1 <- data.frame(time = times, status = status)
data2 <- df1  %>% mutate(time2 = ifelse(time > time_study, time_study, time), status2 = ifelse(time> time_study, 0, status))

plot(survfit(Surv(time2,status2)~1,data=data2))

param_expert_example1 <- list()

param_expert_example1[[1]] <- data.frame(dist = c("norm","t"),
                                         wi = c(1,1),
                                         param1 = c(0.1,0.12),
                                         param2 = c(0.005,0.005),
                                         param3 = c(NA,3))
timepoint_expert <- c(14)

plot_opinion1<- plot_expert_opinion(param_expert_example1[[1]],
                                    weights = param_expert_example1[[1]]$wi)
#ggsave("Vignette_Example 1 - Expert Opinion.png")

cred_int_val <- cred_int(plot_opinion1,val = "linear pool", interval = c(0.025, 0.975))

undebug(survHE::plot.survHE)
undebug(plot_ggplot_survHE)
example1  <- expertsurv:::fit.models.expert(formula=Surv(time2,status2)~1,
                                            data=data2,
                                            distr=c("wei", "lnorm","llogis", "gompertz",
                                                    "gengamma","exp", "rps", "gamma"),
                                            method="hmc",
                                            pool_type = "linear pool",
                                            iter = 5000,
                                            opinion_type = "survival",
                                            times_expert = timepoint_expert,
                                            param_expert = param_expert_example1,
                                            a0 = rep(0.001,nrow(df1)))

#undebug(expertsurv:::runHMC)
#debug(expertsurv:::)
undebug(expertsurv:::compute_ICs_stan)

posterior <- as.matrix(example1$models[["log-Normal"]])

library("MASS")
DENS <- kde2d(posterior[,c("alpha")],posterior[,c("meanlog")])
contour(DENS)
filled.contour(DENS,plot.axes = {
  axis(1)
  axis(2)
  contour(DENS,add = TRUE)})

plot(example1, add.km = T, t = 0:30)+
  theme_light()+
  scale_x_continuous(expand = c(0, 0), limits = c(0,NA), breaks=seq(0, 30, 2)) +
  scale_y_continuous(expand = c(0, 0), limits = c(0, NA), breaks=seq(0, 1, 0.05))+
  geom_segment(aes(x = 14, y = cred_int_val[1], xend = 14, yend = cred_int_val[2]))

#Issue with surv HE plot is based on the posterior mean. FINE for MLE however, issue when the parameters have different
#interpretation

psa <- survHE::make.surv(fit = example1, mod = 1, nsim = 5000, t = seq(0, 63))
library("ggmcmc", lib.loc = '~/R-packages/' )
library("coda")
ggmcmc(ggs(example1$models$`log-Normal`), file = "Log-Normal.pdf")
ggmcmc(ggs(example1$models$`Royston-Parmar`), file = "RP.pdf")
ggmcmc(ggs(example1$models$Exponential), file = "Exponential.pdf")
ggmcmc(ggs(as.mcmc(example1$models$`Gen. Gamma`)), file = "Gengamma.pdf")
ggmcmc(ggs(as.mcmc(example1$models$`Gamma`)), file = "Gamma.pdf")
ggmcmc(ggs(as.mcmc(example1$models$`Gompertz`)), file = "Gompertz.pdf")
ggmcmc(ggs(example1$models$`Weibull (AFT)`), file = "Weibull.pdf")

example1$misc$data.stan
time_surv_vec <- seq(1,20, by =0.1)

plot(x = time_surv_vec, y = quant_high, ylim = c(0,1), type = "l")
lines(x = time_surv_vec, y = quant_low)
lines(x = psa$times, y= sim.survHE[1,], col = "red", lty = 2)
lines(x = psa$times, y= sim.survHE[2,], col = "red", lty = 2)

quant_low <- quant_high <- rep(NA, length(time_surv_vec))

for(i in 1:length(time_surv_vec)){
  time_surv <- time_surv_vec[i]

  surv_temp<- apply(example1$models$Gompertz$BUGSoutput$sims.matrix[,c("alpha","rate")],1,function(x){
    pgompertz(time_surv,shape =x[1],rate= x[2], lower.tail = F)})
  quant_low[i] <- quantile(surv_temp,c(0.025))
  quant_high[i] <- quantile(surv_temp,c(0.975))
}

sim.survHE<- apply(psa$mat[[1]],1, quantile, probs = c(0.025, 0.975))

head(example1$models$Gompertz$BUGSoutput$sims.matrix)
psa <- survHE::make.surv(fit = example1, mod = 5, nsim = 5000, t = seq(0, 63))

#head(psa[["sim"]][[1]])
survHE::psa.plot(psa)+
  theme_light()+
  scale_x_continuous(expand = c(0, 0), limits = c(0,NA), breaks=seq(0, 50, 2)) +
  scale_y_continuous(expand = c(0, 0), limits = c(0, NA), breaks=seq(0, 1, 0.05))+
  geom_segment(aes(x = 14, y = cred_int_val[1], xend = 14, yend = cred_int_val[2]))


require(data.table)

#
# st_res_input <- readRDS("tmp.rds")

# aa <- extract_n_seeds_from_rds_ste(st_res_input,2)
extract_n_seeds_from_rds_ste <- function(st_res, n_seeds){
	library(data.table)
	# saveRDS(st_res, "tmp.rds")
    seeds <- sample(1:max(st_res$muscle_trajectory), n_seeds, replace=FALSE)
    st_res_dt <- data.table(st_res)
    H_multiconstraint <- attr(st_res,"constraints_and_tasks")$nonredundant_constr
    only_seeds <- st_res_dt[st_res_dt$task_index == 0 & st_res_dt$muscle_trajectory%in%seeds,]
    setorder(only_seeds, "muscle_trajectory")
    muscle_levels <- factor(only_seeds$muscle, levels = colnames(H_multiconstraint$constr)[1:7])
    only_seeds$muscle<-muscle_levels
    seeds <- data.frame(dcast(only_seeds, muscle~muscle_trajectory, value.var="activation"))
    activation_per_seed <- seeds[,-1]
	rownames(activation_per_seed) <- seeds[,1]
	return(activation_per_seed%>%data.table)
}

#puts a diag and -diag equality with the activations in task_0 for the input activations7
assemble_equality_with_seed_point <- function(seed_id, activations7, H_multiconstraint){
	library(data.table)
	equalityconst <- cbind(diag(7), matrix(0,7,42))
	rownames(equalityconst) <- rep(paste0(seed_id,"_task0_equality_w_seed_const"), nrow(equalityconst))
	print('names are')
	print(equalityconst)
	colnames(equalityconst) <- colnames(H_multiconstraint$const)
	equalit_constr_formatted <- create_equality_constraint(equalityconst, activations7)
	return(list(constr = equalit_constr_formatted$constr[1:7,], dir= rep("=",7),rhs = equalit_constr_formatted$rhs[1:7]))
}

#puts a diag and -diag equality with the activations in task_0 for the input activations7
assemble_dual_equality_with_seed_point <- function(seed_id, activations7, H_multiconstraint){
	library(data.table)
	equalityconst_first <- cbind(diag(7), matrix(0,7,42))
	equalityconst_last <- cbind( matrix(0,7,42), diag(7))
	equality_const <- rbind(equalityconst_first,equalityconst_last)
	rownames(equality_const) <- rep(paste0(seed_id,"_task0_6_equality_w_dual_seed_const"), nrow(equality_const))
	print('names are')
	print(equality_const)
	colnames(equality_const) <- colnames(H_multiconstraint$const)
	equalit_constr_formatted <- create_equality_constraint(equality_const, activations7)
	newDualConst <- list(constr = equality_const%>%as.matrix, dir= rep("=",14),rhs = c(activations7,activations7))
	return(newDualConst)
}

trim_top_of_constraint <- function(constraint, nrows_to_rm){
	newversion <- constraint # mk copy
	newversion$constr <- constraint$constr[(nrows_to_rm+1):nrow(constraint$constr),]
	newversion$dir <- constraint$dir[(nrows_to_rm+1):length(constraint$dir)]
	newversion$rhs <- constraint$rhs[(nrows_to_rm+1):length(constraint$rhs)]
	return(newversion)
}
#target string must have a %s so it can put the ID in there
seed_sample_and_save <- function(constraint_with_seed_fixation, har_samples_per_seed, target_string){
    	points <- constraint_with_seed_fixation %>% har_sample(har_samples_per_seed, eliminate=TRUE)
    	attr(points, "constraint_with_seed") <- constraint_with_seed_fixation
    	seed_id <- attr(constraint_with_seed_fixation, "seed_id")
    	target_filepath <- sprintf(target_string,seed_id)
    	saveRDS(points, target_filepath)
    	return(target_filepath)
}

combine_unseeded_and_seeded_data_into_id_tall_df <- function(trajectories_unseeded, trajectories_per_seed){
	#prepare unseeded portion
	velocity_limit <- attr(trajectories_unseeded,"speed_limit")
	unseeded_dt <- data.table(trajectories_unseeded)
	rm(trajectories_unseeded) # reduce memory usage
	unseeded_dt$seed_id <- rep("Not Seeded",nrow(unseeded_dt))
	unseeded_dt$velocity_limit<- NULL

	seed_based_trajectories <- pblapply(trajectories_per_seed, function(x){
		ddf <- trajectory_har_df_melt(x,7) %>% data.table
		# add a column called seed_id so we can keep track of where these 10k trajectories came from
		seed_id <- attr(attr(x, "constraint_with_seed"),"seed_id")
		ddf$seed_id <- seed_id
		return(ddf%>%data.table)
	}) %>% rbindlist

	seed_vs_noseed_trajectories <- rbind(seed_based_trajectories,unseeded_dt[unseeded_dt$muscle_trajectory%in%seq(1,10000),])
	attr(seed_vs_noseed_trajectories,"velocity_limit") <- velocity_limit
	return(seed_vs_noseed_trajectories)
}

gen_freqpoly_seed_vs_unseeded <- function(seed_vs_noseed_trajectories, seed_id_interesting_idx = c(1,2,3)){
	    seed_id_interesting <- unique(seed_vs_noseed_trajectories$seed_id)[seed_id_interesting_idx]
	    seed_collection <- seed_vs_noseed_trajectories[seed_vs_noseed_trajectories$seed_id%in%seed_id_interesting & seed_vs_noseed_trajectories$seed_id!="Not Seeded",]
		p <- ggplot(seed_vs_noseed_trajectories,aes(activation))
		p <- p + geom_freqpoly(aes(y=..ncount.., fill=seed_id, col=seed_id, frame=seed_id),
			alpha=0.5, bins=30, position="identity", data = seed_collection)
		p <- p + geom_freqpoly(aes(y=..ncount..), alpha=0.5, bins=30, col="black", position="identity", data = seed_vs_noseed_trajectories[seed_vs_noseed_trajectories$seed_id=="Not Seeded",])
		p <- p + facet_grid(task_index~factor(muscle, levels=muscle_name_per_index), scales="free_y", space="free_y")
		p <- p + theme_classic() + ylab("Within-bin Volume wrt to mode") + xlab("Muscle activation (0 to 1 is 0 to 100%)")
		return(p)
    }
## seed_constraint_type if start, constrain just the first moment, else make it start_and_end to do both
seed_vs_noseed_diff_speeds <- function(vel, n_seeds = 10, n_samples_per_unseeded=1e5, n_samples_per_seed=1e4, seed_constraint_type="start"){
	message('lets begin')
    fixed_velocity_constraint_speed <- vel
    my_H_matrix <- read.csv("data/fvc_hentz_2002.csv", row.names=1) %>% as.matrix
    tic <- Sys.time()
    target_out_string_projection <- sprintf("outputs/projectionstr_vel_%s.rds",as.character(vel))
    message("working on: %s"%--%target_out_string_projection)
    st_res <- st_with_vel(my_H_matrix, fixed_velocity_constraint_speed, har_n=n_samples_per_unseeded)
    H_multiconstraint <- attr(st_res, "constraints_and_tasks")$nonredundant_constr
    activation_per_seed <- extract_n_seeds_from_rds_ste(st_res, n_seeds)
    multiconstraint_per_seed <- lapply(seq(1,ncol(activation_per_seed)), function(task_0_seed_activation){
    	# trim top which has task0 wrench requirements
    	seed_a <- activation_per_seed[,task_0_seed_activation]
    	seed_id <- colnames(activation_per_seed)[task_0_seed_activation]
    	if (seed_constraint_type == "start"){
	    	res <- merge_constraints(trim_top_of_constraint(H_multiconstraint,22), assemble_equality_with_seed_point(seed_id, seed_a, H_multiconstraint))
    	} else{
    		# (seed_constraint_type == "start_and_end")
	    	temp_res <- merge_constraints(trim_top_of_constraint(H_multiconstraint,22), assemble_dual_equality_with_seed_point(seed_id, seed_a, H_multiconstraint))
	    	rownames(temp_res$const)
	     	# Remove the constraints for the last task (task 6)
			to_keep <- which(!endsWith(rownames(temp_res$const),"_6"))
			aaa <- temp_res$const[to_keep,]
			bbb <- temp_res$dir[to_keep]
			ccc <- temp_res$rhs[to_keep]
			# recompose into a constraint structure
			browser()
			res <- list(constr = aaa, dir = bbb, rhs = ccc)
    	}
    	attr(res, "seed_activation") <- seed_a
    	attr(res, "seed_id") <- seed_id
    	return(res)
    	})
    result_filepaths <- lapply(multiconstraint_per_seed, seed_sample_and_save,
     					target_string = paste0("dual_seeded_outputs/seed_speed_%s_id_"%--%vel, "%s.rda"),
     					har_samples_per_seed = n_samples_per_seed)

	trajectories_per_seed <- lapply(result_filepaths, readRDS)
	seed_vs_noseed_trajectories <- combine_unseeded_and_seeded_data_into_id_tall_df(trajectories_unseeded=st_res, trajectories_per_seed=trajectories_per_seed)
	saveRDS(seed_vs_noseed_trajectories, "outputs/seed_vs_nospeed_talldf_speed_%s.rda"%--%vel)
    p <- gen_freqpoly_seed_vs_unseeded(seed_vs_noseed_trajectories, 1:3)
    p <- p + ggtitle("Velocity lim: %s"%--%fixed_velocity_constraint_speed)
	ggsave("outputs/seed_vs_noseed_trajectories_speed_%s_"%--%fixed_velocity_constraint_speed%>%time_dot("pdf"),p, width=10,height=10)
    message("DONE WITH SPEED OF %s PER SPEED-to-PCA"%--%vel)
    message(print(Sys.time() - tic))

	projection_str <- generate_pca_projection_plots(seed_vs_noseed_trajectories, suffix="_VEL_%s"%--%vel)
	saveRDS(projection_str, target_out_string_projection)
	system("rclone copy outputs remote:outputs", wait=TRUE)
    }


# GetNoAuditCalibrationCopies1Data.r

# G E T   D A T A

source("../common/DataUtil.r")

if (!exists('dir.string') || (is.null(dir.string))) {dir.string <- "./"}
filesList <- grep(pattern="^Giant.*\\.txt$", dir(dir.string),
                perl=TRUE, value = TRUE)
dat.noaudit <- read.table(filesList[1],
                        header=TRUE,sep=" ", na.strings="nolinefound")
mdmlosspct <- dat.noaudit$EmpiricalLosses / 100.0
newdat <- cbind(dat.noaudit,mdmlosspct)
dat.noaudit <- newdat

# P L O T   D A T A
library(ggplot2)
source("../common/PlotUtil.r")

trows <- dat.noaudit
gp <- ggplot(data=trows,aes(x=lifem,y=safe(mdmlosspct)))

nCopies <- 1
trows <- fnSelectCopies(dat.noaudit, nCopies)
gp <- gp +
        aes(trows, x=(lifem), y=(safe(mdmlosspct))) +
        geom_point(data=trows,
            color="red", size=3, shape=(point.DOT)) +
        geom_line(data=trows,
            linetype="dashed", color="black", size=1)

gp <- fnPlotLogScales(gp, x="YES", y="YES"
        , xbreaks=c(2,5,10,50,100,1000,10000)
        , ybreaks=c(0.1,1,10,100)
        )
gp <- fnPlotTitles(gp
        ,titleline="With a single copy, losses are unacceptable, "
            %+% "even with high quality disks"
            %+% "\n(document losses over 10 years)"
        ,titlesize=16
        ,xlabel="1MB sector half-life (megahours)"
            %+% "                     (lower error rate \u2192)"
        ,ylabel="permanent document losses (% of collection)"
        ,labelsize=14
        )
gp <- fnPlotPercentLine(gp)
gp <- fnPlotMilleLine(gp)
#gp <- fnPlotSubMilleLine(gp)

# A N N O T A T I O N S

labelsize <- 10
gp <- gp + geom_text(x=log10(150.0), y=log10(0.04)
                ,label="Increasing quality of storage    \u2192 \u2192 \u2192"
                ,size=labelsize, color="red"
                ,fontface="plain", family="sans")

gp <- gp + geom_text(x=log10(10000.0), y=log10(1.2)
                ,label="Decreasing\ndocument\nlosses "
                %+% "\n\u2193\n\u2193\n\u2193"
                ,size=labelsize, color="red"
                ,fontface="plain", family="sans"
                ,hjust=1)

plot(gp)
fnPlotMakeFile(gp, "baseline-noaudit.png")

# Unwind any remaining sink()s to close output files.
while (sink.number() > 0) {sink()}


# 3. faza: Vizualizacija podatkov

source("lib/libraries.r")

#1. graf:Povprečni pridelek glede na število hektarjev \n kmetijskih površin po regijah
g1 <- ggplot(zemljisca.in.pridelek %>% filter(regija != "slo")) +
  aes(x = leto, y = skupni.povprecni.pridelek, size = skupno.stevilo.zemljisc) +
  labs(title = "Povprečni pridelek glede na število hektarjev \n kmetijskih površin po regijah",
    x = "Leto",
    y = "Povprečni pridelek") +
  labs(size = "Skupno število zemljišč") +
  geom_point(color="darkblue") +
  theme(legend.title = element_text(color = "darkblue", size = 10),
        axis.line = element_line(colour = "darkblue",
                                 size = 1, linetype = "solid"),
        legend.background = element_rect(fill = "lightblue", linetype="solid",
                                         colour ="darkblue"), plot.title = element_text(color = "darkblue", hjust=0.5), strip.background=element_rect(colour="black",fill="white"),
        axis.text.x = element_text(angle = 45, vjust = 0.5)) +
  facet_wrap(.~regija)

#2. graf: Primerjava povprečnih pridelkov v letih 2010 in 2020 za določene kulture
podatki2 <- pridelek %>% filter(regija != "slo", kmetijske.kulture %in% c("koruza", "krompir", "jecmen", "psenica.in.pira"),
                                leto %in% c(2010, 2020))
g2 <- ggplot(podatki2) +
  aes(x = kmetijske.kulture, y = povprecni.pridelek) + geom_bar(stat = "identity", fill = "lightblue")+
  xlab("Vrsta pridelka")+ ylab("Povprečni pridelek") +
  labs(title = "Primerjava povprečnih pridelkov v letih 2010 in 2020")+
  theme(axis.text.x = element_text(angle = 45, vjust = 0.5),
    axis.title.x = element_text(vjust = 0),
  plot.title = element_text(color = "darkblue", hjust=0.5), strip.background=element_rect(colour="black",fill="white")) +
  facet_wrap(.~leto)

#3. graf:Število živine glede na  površino  kmetijskih zemljišč večjih slovenskih regij
data <- zemljisca.in.zivina %>% filter(regija %in% c("lj", "nm", "mb", "ms", "kp", "kr"))
ggplot(data) + aes(x = skupno.stevilo.zemljisc, y = skupno.stevilo.zivine, color = leto, size = zivina.na.ha) +
  labs(title = "Število živine glede na  površino \n kmetijskih zemljišč večjih slovenskih regij") + xlab("Površina zemljišč") + ylab("Število živine") +
  labs(size="Živina na ha", color="Leto") +
  geom_point() +
  theme(plot.title = element_text(color = "darkblue", hjust=0.5, size=15),
        axis.line = element_line(colour = "darkblue",
                                 size = 1, linetype = "solid"),
        legend.background = element_rect(fill = "lightblue", linetype="solid",
                                         colour ="darkblue"))

g3 <- ggplot(zemljisca.in.zivina %>% filter(regija != "slo")) +
  aes(x = skupno.stevilo.zemljisc, y = skupno.stevilo.zivine, size = zivina.na.ha, color = leto,
      text = paste(
        "Regija: ", regija, "\n",
        "Leto: ", leto,
        sep = ""
      )) + ggtitle("Število živine glede na površino kmetijskih zemljišč") + xlab("Površina zemljišč") + ylab("Število živine") +
  geom_point() + labs(color="Leto")
ggplotly(g3, tooltip = "text")

#4. graf
#tortni diagram

podatki3 <- prodaja.in.potrosnja %>% filter(leto == 2020)
g4 <- ggplot(podatki3, aes(x="", y=razmerje, fill=pridelek)) +
  geom_bar(stat="identity", width=1, color="white") +
  coord_polar("y", start=0) + theme_void() +
  scale_fill_hue() +
  labs(title = "Razmerje med potrošnjo in prodajo živil v letu 2020") +
  labs(fill = "Pridelek") +
  theme(plot.title = element_text(color = "darkblue", hjust=0.5, size=15, vjust = -8),
        legend.title = element_text(color = "darkblue", size = 12),
        legend.background = element_rect(fill = "lightblue", linetype="solid",
                                         colour ="darkblue"))

#5. graf:

g5 <- ggplot(samooskrba.in.poraba) + aes(x = leto, y = stopnja.samooskrbe,color = zmoznost) +
  labs(title = "Samooskrba in preskrba z živili") + xlab("Leto") + ylab("Stopnja samooskrbe (v %)") +
  theme(legend.position = "right") + labs(color = "Zmožnost samooskrbe") +
  geom_point(size=3.5) + facet_wrap(.~zivila) +
  theme(plot.title = element_text(color = "darkblue", hjust=0.5, size=15)) +
  theme(strip.background=element_rect(colour="black",fill="white"), legend.title = element_text(color = "darkblue", size = 10),
        legend.background = element_rect(fill = "lightblue", linetype="solid", colour ="darkblue"), axis.text.x = element_text(angle = 45, hjust = 1, colour = "darkblue")) +
  scale_color_manual(values=c("lightgreen", "orange", "red"))

#6. graf:
g6 <- ggplot(samooskrba.in.poraba, aes(poraba, zivila)) + geom_boxplot(fill = "lightblue") + xlab("Poraba") +
  ylab("Živila") +
  theme(axis.line = element_line(colour = "darkblue",
                                 size = 1, linetype = "solid"),
        axis.text.y = element_text(colour = "darkblue")) + xlim(0, 130)

########################################## ZEMLJEVIDI #########################################################

source("lib/uvozi.zemljevid.r")
zemljevid <- uvozi.zemljevid("http://kt.ijs.si/~ljupco/lectures/appr/zemljevidi/si/gadm36_SVN_shp.zip", "gadm36_SVN_1", mapa = "zemljevidi", encoding="UTF-8")

zemljevid <- zemljevid %>% spTransform(CRS("+proj=longlat +datum=WGS84")) # pretvorimo v ustrezen format

loc <- locale(encoding="UTF-8")
for (col in names(zemljevid)) {
  if (is.character(zemljevid[[col]])) {
    zemljevid[[col]] <- zemljevid[[col]] %>% parse_character(locale=loc)
  }
}

zemljevid@data
zemljevid.regije <- zemljevid
names(zemljevid.regije)
zemljevid.regije$NAME_1

zemljevid.regije$NAME_1 <- factor(zemljevid.regije$NAME_1)

lvls <- levels(zemljevid.regije$NAME_1)

# spremenim imena regij, da se ujemajo z zemljevidom, kratice spremenim nazaj v dolga imena

imena.regij.nazaj = tibble(
  oznaka = c(
    "Gorenjska",
    "Goriška",
    "Jugovzhodna Slovenija",
    "Koroška",
    "Obalno-kraška",
    "Osrednjeslovenska",
    "Podravska",
    "Pomurska",
    "Spodnjeposavska",
    "Notranjsko-kraška",
    "Savinjska",
    "Zasavska",
    "SLOVENIJA"
  ),
  regija = c(
    "kr", "ng", "nm", "sg", "kp", "lj", "mb", "ms", "kk", "po", "ce", "za", "slo"
  )
)

#Primerjava števila goveda v regijah leta 2003 in 2016
tmap_mode("plot")
zivina3.za.zemljevid <- merge(x = zivina3, y = imena.regij.nazaj, by = "regija", all.x = TRUE) %>%
  dplyr::select(regija = oznaka, vrsta.zivine, leto, stevilo.zivine) %>% filter(regija != "SLOVENIJA")

zivina3.za.zemljevid.2003 <- zivina3.za.zemljevid %>% filter(leto == 2003, vrsta.zivine == "govedo") %>% group_by(regija, leto)
graf.zemljevid0 <- merge(zemljevid.regije, zivina3.za.zemljevid.2003, by.x = "NAME_1", by.y = "regija")
zem1 <- tm_shape(graf.zemljevid0) + tm_polygons("stevilo.zivine" , popup.vars = c("Število goveda: " = "stevilo.zivine"),
                                       style = "pretty", palette="Blues",title="Število goveda") +
  tm_layout(
    "Število goveda v letu 2003",
    legend.title.size=1,
    legend.text.size = 0.8,
    legend.position = c("right","bottom"),
    legend.bg.color = "white",
    legend.bg.alpha = 1)

zivina3.za.zemljevid.2016 <- zivina3.za.zemljevid %>% filter(leto == 2016, vrsta.zivine == "govedo") %>% group_by(regija, leto)
graf.zemljevid <- merge(zemljevid.regije, zivina3.za.zemljevid.2016, by.x = "NAME_1", by.y = "regija")
zem2 <- tm_shape(graf.zemljevid) + tm_polygons("stevilo.zivine" , popup.vars = c("Število goveda: " = "stevilo.zivine"),
                                       style = "pretty", palette="Blues",title="Število goveda") +
  tm_layout(
    "Število goveda v letu 2016",
    legend.title.size=1,
    legend.text.size = 0.8,
    legend.position = c("right","bottom"),
    legend.bg.color = "white",
    legend.bg.alpha = 1)

#Primerjava hektarjev gozdov leta 2003 in 2016
zemljisca.za.zemljevid <- merge(x = zemljisca, y = imena.regij.nazaj, by = "regija", all.x = TRUE) %>%
  dplyr::select(regija = oznaka, leto, vrsta.zemljisca, povrsina)

zemljisca.2003 <- zemljisca.za.zemljevid %>% filter(regija != "SLOVENIJA", vrsta.zemljisca == "gozd", leto == 2003)

graf.zemljevid2 <- merge(zemljevid.regije, zemljisca.2003, by.x = "NAME_1", by.y = "regija")

zem3 <- tm_shape(graf.zemljevid2) + tm_polygons("povrsina" , popup.vars = c("Število hektarjev gozdov " = "povrsina"),
                                                     style = "pretty", palette="Blues",
                                                    title="Število hektarjev gozda") +
  tm_layout(
    "Število hektarjev gozdov v 2003",
    legend.title.size=1,
    legend.text.size = 0.8,
    legend.position = c("right","bottom"),
    legend.bg.color = "white",
    legend.bg.alpha = 1)

zemljisca.2016 <- zemljisca.za.zemljevid %>% filter(regija != "SLOVENIJA", vrsta.zemljisca == "gozd", leto == 2016)
graf.zemljevid3 <- merge(zemljevid.regije, zemljisca.2016, by.x = "NAME_1", by.y = "regija")

zem4 <- tm_shape(graf.zemljevid3) + tm_polygons("povrsina" , popup.vars = c("Število hektarjev gozdov " = "povrsina"),
                                        style = "pretty", palette="Blues",
                                        title="Število hektarjev gozda") +
  tm_layout("Število hektarjev gozdov v 2016",
    legend.title.size=1,
    legend.text.size = 0.8,
    legend.position = c("right","bottom"),
    legend.bg.color = "white",
    legend.bg.alpha = 1)


library(dplyr)

# weighting for how matches are scored (places more emphasison ideological
# targetting than geography or age)
subject_weight <- c(0, 0.5, 0.5, 1, 1, 3, 3)

# list of person attributes and dataframe of ads as input
# list is List(age, gender, political_orientaiton, region, interest)
# see server sample people for example
target <- function(l, df) {
  df %>%
    filter(
      (MinAge <= l[["age"]] | is.na(MinAge)) &
        (MaxAge >= l[["age"]] | is.na(MinAge)),
      Gender == l[["gender"]] | is.na(Gender),
      str_detect(Segment, l[["political_orientation"]]) | is.na(Segment),
      Region == l[["region"]] | is.na(Region),
      Interest == l[["interest"]] | is.na(Interest)
    ) %>%
    mutate(score = apply(., 1, function(x) {
      sum(
        ifelse(is.na(x), 0, 1) * subject_weight
      )
    })) %>%
    arrange(-score) %>%
    head(4) %>%
    pull(html)
}


# R script
#
# author: Xavier Devroey

library(ggplot2)
library(dplyr)

source('dataclean.r')

colorpalette="Spectral" # Use photocopy friendly colors (http://colorbrewer2.org/)

# ------------------------------
# Functions definition
# ------------------------------

printExceptionsApplicationsDescription <- function(){
  benchmark <- getBenchmark()
  # Get statistics for each application and each exception
  df <- benchmark %>%
    distinct(application, application_name, application_factor, application_kind, application_kind_factor, case, exception_class, exception, exception_factor, frame_count) %>%
    mutate(exception_class = ifelse(exception == "Other", 'Other', exception_class)) %>%
    group_by(application_kind, application_kind_factor, exception_class, exception, exception_factor) %>%
    summarise(n_cases = n(), tot_frame_count = sum(frame_count), mean_frame_count = mean(frame_count), sd_frame_count = sd(frame_count)) %>%
    arrange(application_kind_factor, exception_factor)

  totalException <- benchmark %>%
    distinct(application, application_name, application_factor, application_kind, application_kind_factor, case, exception_class, exception, exception_factor, frame_count) %>%
    mutate(exception_class = ifelse(exception == "Other", 'Other', exception_class)) %>%
    group_by(exception_class, exception, exception_factor) %>%
    summarise(n_cases = n(), tot_frame_count = sum(frame_count), mean_frame_count = mean(frame_count), sd_frame_count = sd(frame_count)) %>%
    arrange(exception_factor)

  totalApplication <- benchmark %>%
    distinct(application, application_name, application_factor, application_kind, application_kind_factor, case, exception_class, exception, exception_factor, frame_count) %>%
    mutate(exception_class = ifelse(exception == "Other", 'Other', exception_class)) %>%
    group_by(application_kind, application_kind_factor) %>%
    summarise(n_cases = n(), tot_frame_count = sum(frame_count), mean_frame_count = mean(frame_count), sd_frame_count = sd(frame_count)) %>%
    arrange(application_kind_factor)

  total <- benchmark %>%
    distinct(application, application_name, application_factor, application_kind, application_kind_factor, case, exception_class, exception, exception_factor, frame_count) %>%
    mutate(exception_class = ifelse(exception == "Other", 'Other', exception_class)) %>%
    summarise(n_cases = n(), tot_frame_count = sum(frame_count), mean_frame_count = mean(frame_count), sd_frame_count = sd(frame_count))

  exceptions <- benchmark %>%
    mutate(exception_class = ifelse(exception == "Other", 'Other', exception_class)) %>%
    arrange(exception_factor) %>%
    distinct(exception, exception_class, exception_factor)
  applications <- benchmark %>%
    arrange(application_kind_factor) %>%
    distinct(application_kind, application_kind_factor)

  cat("% ")
  for (i in 1:nrow(exceptions)) {
    ex <- exceptions[i,]
    cat(ex$exception_class, " (", ex$exception, "), ", sep = "")
  }
  cat("\n")

  cat("\\begin{tabular}{ l | r r r r | r r r r | r r r r | r r r r } ")
  # Print headers
  cat("\\textbf{Except.} ")
  for(j in 1:nrow(applications)){
    app <- applications[j,]
    cat(" & \\multicolumn{4}{c}{\\textbf{", app$application_kind, "}} ")
  }
  cat(" & \\multicolumn{4}{c}{\\textbf{ Total }} ")
  cat("\\\\", "\n")
  cat("\t\t ")
  columnHeader <- " & \\textit{st} & \\textit{fr} & $\\overline{fr}$ & $\\sigma$ "
  for(j in 1:nrow(applications)){
    cat(columnHeader)
  }
  cat(columnHeader)
  cat("\\\\", "\n")
  cat("\\hline", "\n")
  for (i in 1:nrow(exceptions)) {
    ex <- exceptions[i,]
    # Print row header
    # cat(ex$exception_class, " {\\tiny(", ex$exception, ")} ", sep = "")
    cat(ex$exception)
    for(j in 1:nrow(applications)){
      app <- applications[j,]
      square <- df %>%
        filter(application_kind_factor == app$application_kind_factor, exception_factor == ex$exception_factor)
      if(nrow(square) != 0){
        cat(" &", square$n_cases)
        cat(" &", formatC(square$tot_frame_count, digits=0, format="f"))
        cat(" &", formatC(square$mean_frame_count, digits=1, format="f"))
        cat(" &", formatC(square$sd_frame_count, digits=1, format="f"))
      } else {
        # If there is no case for that app and exception
        cat(" &", 0, 0, " ")
        cat(" &", "  ")
        cat(" &", "  ")
      }
    }
    # Print total exception
    square <- totalException %>%
      filter(exception_factor == ex$exception_factor)
    cat(" &", square$n_cases)
    cat(" &", formatC(square$tot_frame_count, digits=0, format="f"))
    cat(" &", formatC(square$mean_frame_count, digits=1, format="f"))
    cat(" &", formatC(square$sd_frame_count, digits=1, format="f"))
    cat("\\\\", "\n")
  }
  # Print total application
  cat("\\hline", "\n")
  cat("\\textbf{ Total }")
  for(j in 1:nrow(applications)){
    app <- applications[j,]
    square <- totalApplication %>%
      filter(application_kind_factor == app$application_kind_factor)
    cat(" &", square$n_cases)
    cat(" &", formatC(square$tot_frame_count, digits=0, format="f"))
    cat(" &", formatC(square$mean_frame_count, digits=1, format="f"))
    cat(" &", formatC(square$sd_frame_count, digits=1, format="f"))
  }
  #Print total
  cat(" &", total$n_cases)
  cat(" &", formatC(total$tot_frame_count, digits=0, format="f"))
  cat(" &", formatC(total$mean_frame_count, digits=1, format="f"))
  cat(" &", formatC(total$sd_frame_count, digits=1, format="f"))
  cat("\\\\", "\n")
  cat("\\end{tabular}")
}

printExceptionsApplicationsVertical <- function(){
  benchmark <- getBenchmark()
  # Get statistics for each application and each exception
  df <- benchmark %>%
    distinct(application, application_name, application_factor, application_kind, application_kind_factor, case, exception_class, exception, exception_factor, frame_count) %>%
    mutate(exception_class = ifelse(exception == "Other", 'Other', exception_class)) %>%
    group_by(application_name, application_factor, exception_class, exception, exception_factor) %>%
    summarise(n_cases = n(), tot_frame_count = sum(frame_count), mean_frame_count = mean(frame_count), sd_frame_count = sd(frame_count)) %>%
    arrange(application_name, exception_factor)

  totalException <- benchmark %>%
    distinct(application, application_name, application_factor, application_kind, application_kind_factor, case, exception_class, exception, exception_factor, frame_count) %>%
    mutate(exception_class = ifelse(exception == "Other", 'Other', exception_class)) %>%
    group_by(exception_class, exception, exception_factor) %>%
    summarise(n_cases = n(), tot_frame_count = sum(frame_count), mean_frame_count = mean(frame_count), sd_frame_count = sd(frame_count)) %>%
    arrange(exception_factor)

  totalApplication <- benchmark %>%
    distinct(application, application_name, application_factor, application_kind, application_kind_factor, case, exception_class, exception, exception_factor, frame_count) %>%
    mutate(exception_class = ifelse(exception == "Other", 'Other', exception_class)) %>%
    group_by(application_name, application_factor) %>%
    summarise(n_cases = n(), tot_frame_count = sum(frame_count), mean_frame_count = mean(frame_count), sd_frame_count = sd(frame_count)) %>%
    arrange(application_name)

  total <- benchmark %>%
    distinct(application, application_name, application_factor, application_kind, application_kind_factor, case, exception_class, exception, exception_factor, frame_count) %>%
    mutate(exception_class = ifelse(exception == "Other", 'Other', exception_class)) %>%
    summarise(n_cases = n(), tot_frame_count = sum(frame_count), mean_frame_count = mean(frame_count), sd_frame_count = sd(frame_count))

  exceptions <- benchmark %>%
    mutate(exception_class = ifelse(exception == "Other", 'Other', exception_class)) %>%
    arrange(exception_factor) %>%
    distinct(exception, exception_class, exception_factor)

  applications <- benchmark %>%
    distinct(application_name, application_factor, version, application_ncss) %>%
    group_by(application_name, application_factor) %>%
    summarise(nb_versions = n(), avg_ncss = mean(application_ncss)/1000) %>%
    arrange(application_factor)

  cat("% ")
  for (i in 1:nrow(exceptions)) {
    ex <- exceptions[i,]
    cat(ex$exception_class, " (", ex$exception, "), ", sep = "")
  }
  cat("\n")

  cat("\\begin{tabular}{ l l | r r r r r r r | r } ")
  # Print headers
  cat("\\textbf{Applications} &")
  for(j in 1:nrow(exceptions)){
    ex <- exceptions[j,]
    cat(" & \\textbf{\\rotatebox{90}{", ex$exception, "}}")
  }
  cat(" & \\textbf{ Total } ")
  cat("\\\\", "\n")
  cat("\\hline", "\n")

  columnHeader <- " & \\textit{st} & \\textit{fr} & $\\overline{fr}$ & $\\sigma$ "

  for (i in 1:nrow(applications)) {
    app <- applications[i,]

    cat("\\textbf{", app$application_name, "}")
    cat(" & \\textit{st} ")
    for(j in 1:nrow(exceptions)){
      ex <- exceptions[j,]
      square <- df %>%
        filter(application_factor == app$application_factor, exception_factor == ex$exception_factor)
      if(nrow(square) != 0){
        cat(" &", formatC(square$n_cases, digits=1, format="f"))
      } else {
        cat(" &", "0.0 ")
      }
    }
    #Print total
    square <- totalApplication %>%
      filter(application_factor == app$application_factor)
    cat(" &", formatC(square$n_cases, digits=1, format="f"))
    cat("\\\\", "\n")

    cat(" ")
    cat(" & \\textit{fr} ")
    for(j in 1:nrow(exceptions)){
      ex <- exceptions[j,]
      square <- df %>%
        filter(application_factor == app$application_factor, exception_factor == ex$exception_factor)
      if(nrow(square) != 0){
        cat(" &", formatC(square$tot_frame_count, digits=1, format="f"))
      } else {
        cat(" &", "0.0")
      }
    }
    #Print total
    square <- totalApplication %>%
      filter(application_factor == app$application_factor)
    cat(" &", formatC(square$tot_frame_count, digits=1, format="f"))
    cat("\\\\", "\n")

    cat(" ")
    cat(" & $\\overline{fr}$ ")
    for(j in 1:nrow(exceptions)){
      ex <- exceptions[j,]
      square <- df %>%
        filter(application_factor == app$application_factor, exception_factor == ex$exception_factor)
      if(nrow(square) != 0){
        cat(" &", formatC(square$mean_frame_count, digits=1, format="f"))
      } else {
        cat(" &  ")
      }
    }
    #Print total
    square <- totalApplication %>%
      filter(application_factor == app$application_factor)
    cat(" &", formatC(square$mean_frame_count, digits=1, format="f"))
    cat("\\\\", "\n")

    cat(" & $\\sigma$ ")
    for(j in 1:nrow(exceptions)){
      ex <- exceptions[j,]
      square <- df %>%
        filter(application_factor == app$application_factor, exception_factor == ex$exception_factor)
      if(nrow(square) != 0){
        cat(" &", formatC(square$sd_frame_count, digits=1, format="f"))
      } else {
        cat(" &  ")
      }
    }
    #Print total
    square <- totalApplication %>%
      filter(application_factor == app$application_factor)
    cat(" &", formatC(square$sd_frame_count, digits=1, format="f"))
    cat("\\\\", "\n")
    cat("\\hline", "\n")
  }

  # Print total exception

  cat(" \\textbf{Total} ")
  cat(" & \\textit{st} ")
  for(j in 1:nrow(exceptions)){
    ex <- exceptions[j,]
    square <- totalException %>%
      filter(exception_factor == ex$exception_factor)
    cat(" &", formatC(square$n_cases, digits=1, format="f"))
  }

  cat(" &", formatC(total$n_cases, digits=1, format="f"))
  cat("\\\\", "\n")

  cat(" ")
  cat(" & \\textit{fr} ")
  for(j in 1:nrow(exceptions)){
    ex <- exceptions[j,]
    square <- totalException %>%
      filter(exception_factor == ex$exception_factor)
    cat(" &", formatC(square$tot_frame_count, digits=1, format="f"))
  }
  cat(" &", formatC(total$tot_frame_count, digits=1, format="f"))
  cat("\\\\", "\n")

  cat(" ")
  cat(" & $\\overline{fr}$ ")
  for(j in 1:nrow(exceptions)){
    ex <- exceptions[j,]
    square <- totalException %>%
      filter(exception_factor == ex$exception_factor)
    cat(" &", formatC(square$mean_frame_count, digits=1, format="f"))
  }
  cat(" &", formatC(total$mean_frame_count, digits=1, format="f"))
  cat("\\\\", "\n")

  cat(" & $\\sigma$ ")
  for(j in 1:nrow(exceptions)){
    ex <- exceptions[j,]
    square <- totalException %>%
      filter(exception_factor == ex$exception_factor)
    cat(" &", formatC(square$sd_frame_count, digits=1, format="f"))
  }
  cat(" &", formatC(total$sd_frame_count, digits=1, format="f"))
  cat("\\\\", "\n")

  cat("\\end{tabular}")
}

# ------------------------------
# Main function definition
# ------------------------------

main <- function(){

  outputFile <- "../tables/benchmark-exceptionsapps-table.tex"
  unlink(outputFile)
  # Redirect cat outputs to file
  sink(outputFile, append = TRUE, split = TRUE)
  printExceptionsApplicationsDescription()
  # Restore cat outputs to console
  sink()

  outputFile <- "../tables/benchmark-exceptionsapps-table-vertical.tex"
  unlink(outputFile)
  # Redirect cat outputs to file
  sink(outputFile, append = TRUE, split = TRUE)
  printExceptionsApplicationsVertical()
  # Restore cat outputs to console
  sink()

}

# ------------------------------
# Program
# ------------------------------

main()


# ------------------------------------------------
# Create unerlying areal units for modelling of bathymetry, etc using lattice methods via carstm

require(aegis.bathymetry)

for ( areal_units_resolution_km in c(5, 10, 20, 25) ) {
  # for ( spatial_domain in c("snowcrab", "SSE")) {
   for ( spatial_domain in c("snowcrab", "SSE")) {
    areal_units_overlay = "snowcrab_managementareas"
    if ( spatial_domain=="SSE") areal_units_overlay = "none"
    p = bathymetry_parameters(
      project_class = "carstm", # defines which parameter set to load
      inputdata_spatial_discretization_planar_km = 1,  # 1 km .. requires 32 GB RAM and limit of speed -- controls resolution of data prior to modelling to reduce data set and speed up modelling
      spatial_domain = spatial_domain,  # defines spatial area
      areal_units_resolution_km = areal_units_resolution_km, # km dim of lattice
      areal_units_proj4string_planar_km = projection_proj4string("utm20"),  # coord system to use for areal estimation and gridding for carstm
      # areal_units_proj4string_planar_km = "+proj=omerc +lat_0=44.0 +lonc=-63.0 +gamma=0.0 +k=1 +alpha=325 +x_0=0 +y_0=0 +ellps=WGS84 +units=km",  # oblique mercator, centred on Scotian Shelf rotated by 325 degrees
      areal_units_type = "lattice", # "stmv_fields" to use ageis fields instead of carstm fields ... note variables are not the same
      areal_units_overlay = areal_units_overlay, # additional polygon layers for subsequent analysis such as management area: "snowcrab" or "groundfish"  # for now ..
      libs = RLibrary ( "sp", "rgeos", "INLA", "raster", "aegis",  "aegis.polygons", "aegis.bathymetry", "carstm" )
    )

    sppoly = areal_units( p=p, redo=TRUE )

  }

}

# Roll your own polygon via mouse interaction

# Example

  # load helper functions
  project.library( "aegis" )
  Rlibrary( "rgdal", "sp", "raster", "maps", "mapdata")

  p = list() # start parameter list

  # define "extents" or "bounding box" in lon/lat
  p$xlim = c(-72, -56 ) # longitudes
  p$ylim = c(42, 49) # latitudes
  p$regions = c("Canada", "USA") # library "map" polygon designations
  p$output.directory = project.datadirectory("aegis", "data","Science")
  p$output.filename = "test.dat"   # must have an "extention" like dat or txt etc,

  # plot background map and using mouse interaction define region:
  # left mouse click to register, right mouse click to finish (or [Esc] is using Rstudio)
  polygon_db( DS="create", p=p )

  # Access method 1: low level
  # read the data with read.table or read.csv
  polygon_db( DS="map.background", p=p )
  scotianshelf = read.table( aegis.polygons::polygon_file( "test"  ) )
  lines( scotianshelf, col="green" )  # plot to confirm we have the right data

  # Access method 2: medium
  polygon_db ( DS="map.background", p=p )
  scotianshelf = polygon_db( polyid="test" )
  lines( scotianshelf, col="orange" )

  # Access method 3: one step .. just the data (projected or not)
  scotianshelf = polygon_db( polyid="test", project_to="+proj=utm +ellps=WGS84 +zone=20 +units=km" )

  # Access method 4: one step data and plot it too
  scotianshelf = polygon_db( polyid="test", project_to="+proj=utm +ellps=WGS84 +zone=20 +units=km", p=p ) # p contains the extent

    u = maps::map( database="worldHires", regions=p$regions, xlim=p$xlim, ylim=p$ylim, fill=FALSE, plot=FALSE )
    v = data.frame( cbind( u$x, u$y) )
    w = sf::sf_project( pts=as.matrix(v), from=sf::st_crs("EPSG:4326"), to=project_to )
    plot( w, pch=".", col="gray", xlab="Easting", ylab="Northing")
    plot( scotianshelf, col="green", add=TRUE)


library(monmlp)
library(caret)

setwd("~/Documents/Models/variant-filtering")
set.seed(123) # here I fix the seed of the random generator to have the same random numbers if re-run

###### functions #####
data_summary <- function(x) {
  m <- median(x)
  ymin <- as.numeric(quantile(x)[2])
  ymax <- as.numeric(quantile(x)[4])
  return(c(y=m,ymin=ymin,ymax=ymax))
}

plot_ggviolin <- function(kfold_TDR, kfold_sens, type){
  dat = data.frame(var=c(rep("TDR", length(kfold_TDR)),rep("sensitivity", length(kfold_sens))),
                   val=c(kfold_TDR, kfold_sens))
  ggplot(dat, aes(x=var, y=val, fill=var)) + theme_bw() + theme(legend.position="none",
                                                                plot.title = element_text(size=18,hjust = 0.5),
                                                                axis.ticks.x = element_blank(),
                                                                panel.border=element_blank(),
                                                                axis.text=element_text(size=12),
                                                                axis.title=element_text(size=14)) + ggtitle(type) +
    geom_violin() + stat_summary(fun.data=data_summary, color="black") +
    scale_fill_manual(values=c("darkorchid1","chocolate1")) + labs(x="", y="") +
    scale_y_continuous(limits = c(0.5, 1))
}
##############################

for(type in c("snv", "indel")){
  train_table="tables/K2H_AllVariants_All_Lib_NoMinAF_noequal_GOF_addVCFfeatures_illuminaBED_WES_samples_annotated_with_coverage_INFO_GENO_status_supp_features.txt"
  train_table = read.table(train_table, quote="\"", stringsAsFactors=F, sep="\t", header=T)
  train_table$IoD = 1 + train_table$SIG * 10^(train_table$ERR)
  if(type=="snv") train_table = train_table[which(train_table$TYPE_INFO=="snv"),]
  if(type=="indel") train_table = train_table[which(train_table$TYPE_INFO=="ins" | train_table$TYPE_INFO=="del"),]
  train_table[which(is.infinite(train_table$MIN_DIST)),"MIN_DIST"] = 1000000000
  train_table[which(is.infinite(train_table$MaxRatioWin)),"MaxRatioWin"] = 1000000000

  propTP = as.numeric(table(train_table$status)["TP"] / nrow(train_table))
  propFP = as.numeric(table(train_table$status)["FP"] / nrow(train_table))

  my_features=c("status","RVSB", "QVAL","AF","ERR_INFO","DP", "medianDP_INFO",
                "FS", "MIN_DIST", "AO", "QUAL", "MaxRatioWin", "NbVarWin", "IoD", "HpLength")

  # use K-fold
  kfold_spec = c()
  kfold_sens = c()
  kfold_TDR = c()

  folds <- createFolds(train_table$status, 10)

  for(i in 1:10){
    print(paste("fold: ",i,sep=""))
    test = train_table[folds[[i]],]
    train = train_table[-folds[[i]],]

    xtest = data.matrix(test[,my_features[my_features!="status"]])
    ytest = test$status
    ytest[which(ytest=="TP")] = 1
    ytest[which(ytest=="FP")] = 0
    ytest=as.matrix(as.numeric(ytest))

    xtrain = data.matrix(train[,my_features[my_features!="status"]])
    ytrain = train$status
    ytrain[which(ytrain=="TP")] = 1
    ytrain[which(ytrain=="FP")] = 0
    ytrain=as.matrix(as.numeric(ytrain))

    model_mlp <- monmlp.fit(xtrain, ytrain, hidden1=3, n.ensemble=1, monotone=1, bag=TRUE)

    test$prediction = monmlp.predict(x = xtest, weights = model_mlp)
    thr = 0.5
    kfold_sens = c(kfold_sens, (sum(test$status == "TP" & test$prediction >= thr) / sum(test$status == "TP")) )
    kfold_spec = c(kfold_spec, (sum(test$status == "FP" & test$prediction <= thr) / sum(test$status == "FP")) )
    kfold_TDR = c(kfold_TDR, (sum(test$status == "TP" & test$prediction >= thr) / sum(test$prediction >= thr)) )
  }

  #boxplot(data.frame("TDR"=kfold_TDR, "sensitivity"=kfold_sens), col="lightgrey", ylim=c(0.5,1), outpch=20, outcex=0.75, axes=F, staplelwd=2)
  #title(type, line = 2.5)
  #axis(side=3, at=c(1,2), labels=c("TDR","sensitivity"), col = NA, col.ticks = NA)
  #axis(side=2, at=seq(0,1,by=0.1))
  plot_ggviolin(kfold_TDR, kfold_sens, type)
}

cols=c(rev(rainbow(400,start=0/6, end=4/6))[1:125],
       rep(rev(rainbow(400,start=0/6, end=4/6))[200],1000),
       rev(rainbow(400,start=0/6, end=4/6))[250:400])

cols=rev(rainbow(256,start=0/6, end=4/6))

plot(perf, colorize=T, xlim=c(1,0), lwd=3,  colorize.palette=cols)


p_file <- function(filename, hours, w, pings) {
library("ggplot2")
 p<-qplot(Timestamp,sent/sent*100,data=pings) + xlab("") + ylab("Pings Returned %") +
   geom_line(aes(Timestamp,received/sent*100), color="blue") +
   geom_line(aes(Timestamp,(sent-received)/sent*100), color="red") +
   scale_y_continuous(limits = c(0, 100)) +
   scale_x_datetime(limits =  c(Sys.time()-3600*hours,Sys.time()))
 png(filename, height = 400, width = w)
 print(p)
 dev.off()
}

p_filev <- function(filename, hours, w, pings) {
library("ggplot2")
 p<-qplot(Timestamp,sent/sent*100,data=pings) + xlab("") + ylab("Pings Returned %") +
   geom_line(aes(Timestamp,received/sent*100), color="blue") +
   geom_line(aes(Timestamp,(sent-received)/sent*100), color="red") +
   scale_y_continuous(limits = c(0, 100)) +
   scale_x_datetime(limits =  c(Sys.time()-3600*hours,Sys.time())) +
   coord_flip()
 png(filename, height = w, width = 500)
 print(p)
 dev.off()
}

pingdata <- read.csv(file=paste(Sys.getenv("DATADIR"),"pingdata.csv",sep=""),head=TRUE,sep=",")
pingdata$Timestamp <- as.POSIXct(pingdata$Timestamp,format="%Y-%m-%dT%H:%M")

p_file(paste(Sys.getenv("WEBDIR"),"ping_plot1.png", sep=""),1,800,pingdata)
p_file(paste(Sys.getenv("WEBDIR"),"ping_plot4.png", sep=""),4,500,pingdata)
p_file(paste(Sys.getenv("WEBDIR"),"ping_plot12.png", sep=""),12,500,pingdata)
p_file(paste(Sys.getenv("WEBDIR"),"ping_plot24.png", sep=""),24,800,pingdata)
p_filev(paste(Sys.getenv("WEBDIR"),"ping_plot72.png", sep=""),72,1600,pingdata)


setwd('~/Projects/NHL/')
standings.all <- read.csv('2018standings.csv')
# Getting overtime wins and losses
standings.all$OTW <- sapply(strsplit(
  as.character(standings.all$Overtime), '-'),`[`, 1)
standings.all$OTL <- sapply(strsplit(as.character(
  standings.all$Overtime), '-'),`[`, 2)
# Getting shootout wins and losses
standings.all$SOW <- sapply(strsplit(as.character(
  standings.all$Shootout), '-'),`[`, 1)
standings.all$SOL <- sapply(strsplit(as.character(
  standings.all$Shootout), '-'),`[`, 2)
# Regulation wins
standings.all$RW <-  sapply(strsplit(as.character(
  standings.all$Overall), '-'),`[`, 1)
# Converting characters to numerics
standings.all$RW <- as.numeric(standings.all$RW)
standings.all$OTW <- as.numeric(standings.all$OTW)
standings.all$SOW <- as.numeric(standings.all$SOW)
standings.all$OTL <- as.numeric(standings.all$OTL)
standings.all$SOL <- as.numeric(standings.all$SOL)
# Correct regulation wins
standings.all$RW <- standings.all$RW - standings.all$OTW - standings.all$SOW

# Calculations! 3 points for regulation wins, 2 points for OT win, 2 points for
# SO win, 1 point for OT loss, 1 point for SO loss
# Also, ROW are used for points tie breakers
standings.all$ROW <- standings.all$RW + standings.all$OTW
standings.all$points <- 3 * standings.all$RW + 2 * standings.all$OTW +
  2 * standings.all$SOW + 1 * standings.all$OTL + 1 * standings.all$SOL

# Ordering the dataframe by points and ROW
standings.all <- standings.all[with(standings.all, order(
	-points, -ROW
	)), ]

# Looking at standings team by team
colnames(standings.all)[2] <- 'Team'
print('Pacific Standings:')
standings.all[standings.all$Division == 'P', c('X', 'points')]
print('Central Standings:')
standings.all[standings.all$Division == 'C', c('X', 'points')]
print('Metro Standings:')
standings.all[standings.all$Division == 'M', c('X', 'points')]
print('Atlantic Standings:')
standings.all[standings.all$Division == 'A', c('X', 'points')]