# 3. faza: Vizualizacija podatkov

# library(tidyverse)
# library(ggplot2)
# library(dplyr)
# library(sp)
# library(rgdal)
# library(rgeos)
# library(raster)
# library(tmap)

# source("lib/libraries.r", encoding="UTF-8")

########################################## GRAFIČNA ANALIZA #########################################################

# ANALIZA PO STATISTIČNIH REGIJAH

# GRAF 1: Delež visokoizobraženih po statističnih regijah,ločeno po spolu za leto 2020

visokoizobrazeni.regije <- struktura.prebivalstva %>%
  filter(leto == "2020", izobrazba == " Višješolska, visokošolska - Skupaj"
           ) %>%
  group_by(regija, spol
           ) %>% summarise(delez.visoko.izobrazenih = round(sum(stevilo) / sum(prebivalci) * 100,2))

graf1 <- ggplot(visokoizobrazeni.regije) +
  aes(x = spol, y = delez.visoko.izobrazenih, fill = spol) + geom_col(position = "dodge")+
  xlab("Spol")+ ylab("Delež visoko izobraženih") +
  ggtitle("Delež visokoizobraženih po statističnih regijah za leto 2020") +
  scale_fill_manual(values = c("lightskyblue", "hotpink")) + facet_wrap(.~regija)

# GRAF 2: Delež brezposelnih po statističnih regijah za leto 2020

stevilo.prebivalcev.regije <- prebivalstvo.pripadnost.regijam %>%
  filter(leto == "2020") %>%
  group_by(regija) %>%
  summarise(prebivalci.regija = sum(prebivalci))

brezposelni.regije <- placa.in.brezposelnost.po.obcinah %>%
  filter(leto == "2020", stopnja.izobrazbe == "Skupaj", vrsta.place == "neto"
         ) %>%
  group_by(regija) %>% summarise(brezposelnost.regija = sum(stevilo.brezposelnih))

prebivalstvo.in.brezposelni.po.regijah <- stevilo.prebivalcev.regije %>%
  left_join(brezposelni.regije, by = "regija"
            ) %>%
  mutate(delez.brezposelnih = round((brezposelnost.regija/prebivalci.regija) * 100,2))

graf2 <- ggplot(prebivalstvo.in.brezposelni.po.regijah) +
  aes(x = regija, y = delez.brezposelnih) + geom_bar(stat = "identity", fill = "lightblue")+
  xlab("Regija")+ ylab("Delež brezposelnih") +
  ggtitle("Delež brezposelnih po statističnih regijah za leto 2020")+
  theme(
    axis.text.x = element_text(angle = 45, vjust = 0.5),
    axis.title.x = element_text(vjust = 0)
  )

# GRAF 3: Porazdelitev plač po statističnih regijah za leto 2020

# na tem mestu sem si dovolila aktualne podatke za Osilnico vnesti ročno,
# saj mi sicer na zemljevidu podatek manjka, grafi se ne rišejo pravilno ...

povprecna.slovenska.placa.tabela.2020 <- placa.in.brezposelnost.po.obcinah %>% group_by(obcina) %>%
  filter(leto == "2020", vrsta.place == "neto", stopnja.izobrazbe == "Skupaj")
povprecna.slovenska.placa.tabela.2020$povprecna.placa[povprecna.slovenska.placa.tabela.2020$obcina == "OSILNICA"] <- 714.13

povprecna.slovenska.placa.tabela.2019 <- placa.in.brezposelnost.po.obcinah %>% group_by(obcina) %>%
   filter(leto == "2019", vrsta.place == "neto", stopnja.izobrazbe == "Skupaj")

izracun.povprecne.place <- function(x){
  tabela.regija <- povprecna.slovenska.placa.tabela.2020 %>% filter(regija == as.character(x))
  placa <-round(sum(tabela.regija$povprecna.placa/nrow(tabela.regija)),2)
  return(placa)
}

graf3 <- ggplot(povprecna.slovenska.placa.tabela.2020) +
  aes(x = regija , y = povprecna.placa) +
  theme(
    axis.text.x = element_text(angle = 45, vjust = 0.5),
    axis.title.x = element_text(vjust = 0)
  ) + geom_boxplot() +
  xlab("Regija")+ ylab("Povprečna plača") +
  ggtitle("Porazdelitev plač po statističnih regijah za leto 2020")

# ANALIZA PO OBČINAH

# GRAF 4: Občine po številu študentk in plačni vrzeli za leto 2020

povprecna.slovenska.placa <- round(sum(povprecna.slovenska.placa.tabela.2020$povprecna.placa)
                                   /nrow(povprecna.slovenska.placa.tabela.2020),2)

podatki.graf.4 <- place.in.studentke %>%
  filter(leto == "2020") %>%
  left_join(filter(placa.in.brezposelnost.po.obcinah, leto == "2020" &
                     stopnja.izobrazbe == "Skupaj" &
                     vrsta.place == "neto"), by = c("obcina", "regija", "leto")) %>%
  dplyr::select("obcina", "leto", "stevilo.studentk", "stopnja.razlike", "povprecna.placa") %>%
  transform(stopnja.razlike = as.numeric(stopnja.razlike))

podatki.graf.4 <- podatki.graf.4 %>%
  mutate(povprecna = ifelse(podatki.graf.4$povprecna.placa >= povprecna.slovenska.placa, "nadpovprečna",
                               ifelse(podatki.graf.4$povprecna.placa < povprecna.slovenska.placa, "podpovprečna", 0))
         )%>%
  filter(stopnja.razlike > - 3.0 & stopnja.razlike < 3.0)

podatki <- podatki.graf.4 %>%
  filter(stopnja.razlike > - 0.5 & stopnja.razlike < 0.5)

graf4 <- ggplot(podatki.graf.4) +
  aes(x = stopnja.razlike, y = stevilo.studentk, colour = povprecna ) +
  geom_point(size = 1) +
  geom_text(aes(label = ifelse(stopnja.razlike %in% podatki$stopnja.razlike, as.character(obcina), '')),
                                    hjust = -0.05, vjust= 0.1, size = 2.5) +
  xlab("Stopnja razlike v plači") + ylab("Število študentk na 100 študentov")+
  ggtitle("Občine po številu študentk in plačni vrzeli za leto 2020") +
  scale_colour_manual("Plača", values = c("maroon", "slateblue1"), labels = c("nadpovprečna", "podpovprečna"))

# GRAF 5: Gibanje števila visokoizobraženih v občinah z najmanjšo plačno vrzeljo

enake.obcine <- struktura.prebivalstva %>%
  mutate(obcine = casefold(obcina, upper = TRUE), .keep = "unused"
          ) %>%
   dplyr::select(obcina = obcine, leto, spol, izobrazba, stevilo, odstotek) %>%
  rename("obcina.nova" = "obcina")

enake.obcine <- enake.obcine %>%
  filter(obcina.nova %in% podatki$obcina, izobrazba == " Višješolska, visokošolska - Skupaj")

graf5 <- ggplot(enake.obcine) + aes(x = leto, y = odstotek, color = spol) +
  geom_line() +
  theme(
    axis.text.x = element_text(angle = 45, vjust = 0.5),
    axis.title.x = element_text(vjust = 0)
  ) +
  scale_color_manual("Spol",
                     values = c("lightskyblue",  "orchid"),
                     labels = c("Moški", "Ženske")) +
  facet_wrap(.~obcina.nova) +
  xlab("Leto") + ylab("Delež visokoizobraženih") +
  ggtitle("Gibanje deleža visokoizobraženih v občinah \n z najmanjšo plačno vrzeljo od leta 2012 do 2020")

# GRAF 6: Izobrazbena struktura v občini z najvišjo povprečno plačo za leto 2020

podatki.graf.6 <- povprecna.mesecna.placa %>% filter(leto == 2020, vrsta.place == "neto")
podatki.graf.6$povprecna.placa[podatki.graf.6$obcina == "Osilnica"] <- 714.13

podatki.graf.6 <- podatki.graf.6 %>%
  left_join(filter(izobrazbena.struktura, leto == 2020, izobrazba !=
                     " Višješolska, visokošolska - Skupaj"), by = c("obcina", "leto"))

podatki.graf.6 <- podatki.graf.6 %>%
  filter(povprecna.placa == max(povprecna.placa)
         ) %>% group_by(izobrazba) %>%
  mutate(sestav = sum(stevilo)) %>%
  filter(spol == "Ženske")

graf6 <- ggplot(podatki.graf.6) +
  aes(x = "", y = sestav, fill = izobrazba) + geom_col(width = 1) +
  scale_fill_manual("Stopnja izobrazbe",
                    values = c("seagreen1", "lightskyblue", "plum", "greenyellow", "salmon"),
                    labels = c("Osnovnošolska ali manj", "Srednješolska", "Visokošolska 1. stopnje ipd",
                               "Visokošolska 2. stopnje ipd", "Visokošolska 3. stopnje ipd")) +
  coord_polar(theta = "y") +
  xlab("") + ylab("")  +
  theme(axis.text = element_blank(),
                              axis.ticks = element_blank(),
                              panel.grid = element_blank()) +
  ggtitle(paste("Izobrazbena struktura za občino", podatki.graf.6$obcina[1], "v letu 2020", sep = " "))

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

source("lib/uvozi.zemljevid.r")
obcine <- uvozi.zemljevid("http://baza.fmf.uni-lj.si/OB.zip", "OB",
                           pot.zemljevida="OB", encoding="Windows-1250")

# tm_shape(obcine) + tm_polygons("OB_UIME") + tm_legend(show=FALSE)
obcine$OB_UIME <- factor(obcine$OB_UIME)

lvls <- levels(obcine$OB_UIME)
povprecna.placa.zemljevid <- unique(povprecna.slovenska.placa.tabela.2020$obcina) %>% sort()

razlicni <- lvls!= povprecna.placa.zemljevid

primerjava <- data.frame(obcina.zemljevid = parse_character(lvls),
                         obcina.placa = povprecna.placa.zemljevid)[razlicni,]

placa.na.zemljevidu <- povprecna.slovenska.placa.tabela.2020 %>%
  left_join(primerjava, by = c("obcina" = "obcina.placa")) %>%
  mutate(obcina = ifelse(is.na(obcina.zemljevid), obcina, obcina.zemljevid) %>% factor()) %>%
  dplyr::select(-obcina.zemljevid)

obcine.placa.zemljevid <- merge(obcine, placa.na.zemljevidu,
                 by.x = "OB_UIME", by.y = "obcina")

mapa1 <- tm_shape(obcine.placa.zemljevid) +
  tm_polygons("povprecna.placa", popup.vars = c("Višina povprečne plače: " = "povprecna.placa"))
tmap_mode("view")

prebivalstvo.obcin.2020 <- prebivalstvo.obcin %>% filter(leto == "2020") %>%
   group_by(obcina) %>% mutate(prebivalstvo = sum(prebivalci)) %>%
  filter(spol == "Ženske") %>% dplyr::select(- c("spol", "prebivalci"))

brezposelnost.zemljevid <- unique(prebivalstvo.obcin.2020$obcina) %>% sort()

razlicni.elementi <- lvls!= brezposelnost.zemljevid

primerjava.elementi <- data.frame(obcina.zemljevid = parse_character(lvls),
                         obcina.brezposelnost = brezposelnost.zemljevid)[razlicni,]

brezposelnost.na.zemljevidu <- prebivalstvo.obcin.2020 %>%
  left_join(primerjava.elementi, by = c("obcina" = "obcina.brezposelnost"))  %>%
   mutate(obcina = ifelse(is.na(obcina.zemljevid), obcina, obcina.zemljevid) %>% factor()) %>%
   dplyr::select(-obcina.zemljevid)

brezposelnost.na.zemljevidu <- placa.na.zemljevidu %>%
  left_join(brezposelnost.na.zemljevidu, by = c("leto", "obcina")) %>%
  mutate(Brezposelni = round((stevilo.brezposelnih / prebivalstvo) * 100, 2))

obcine.brezposelnost.zemljevid <- merge(obcine, brezposelnost.na.zemljevidu,
                                by.x = "OB_UIME", by.y = "obcina")

mapa2 <- tm_shape(obcine.brezposelnost.zemljevid) +
  tm_polygons("Brezposelni", popup.vars = c("Delež brezposelnih: " = "Brezposelni"))
tmap_mode("view")


rm(list=ls())
library(dplyr)
library(ggplot2)
library(tidyr)
library(ggpubr)

# set dataset

dataset <- "Streicher"
h <- "AIvAvg"

setwd(paste("/Users/ChatNoir/Projects/Squam/Graphs/",dataset, sep=''))

# Read in data
load(paste("/Users/ChatNoir/Projects/Squam/Graphs/",dataset,"/Calcs_",dataset,".RData", sep=''))

# Colors
color_S <- "orange"
color_TP <- "springgreen4"
color_AI <- "#2BB07FFF"
color_SA <- "#38598CFF"
color_SI <- "#C2DF23FF"

# Add column to name type of support
mLGL <- mutate(mLGL, supportType = case_when(TvS != 'a' ~ "dGLS"))
mLBF <- mutate(mLBF, supportType = case_when(TvS != 'a' ~ "BF"))

GL <- function(df.g,xval.g,yval.g,ylablab.g,ytic.g,hline.g,cc.g,title.g){
  GL_violin <- ggplot(df.g, aes(x=xval.g, y=yval.g, fill=xval.g)) +
    geom_violin(trim=TRUE) +
    geom_point(shape = 18,size=0.75, position = position_jitterdodge(), color='black',alpha=1)+
    scale_color_manual(values=cc.g) + scale_fill_manual(values=cc.g) +
    theme_classic() +
    theme(plot.title = element_text(hjust = 0.5, size=16),
          axis.text = element_text(size=10, color="black"),
          text = element_text(size=14),
          legend.position = "none") +
    labs(y=ylablab.g,x="")  +
    ggtitle(title.g) +
    coord_cartesian(ylim=ytic.g) +
    scale_y_continuous(breaks = ytic.g) +
    geom_hline(yintercept=hline.g,color=c("black"), linetype="dashed", size=0.5)
  return(GL_violin)
}

df.1 <- mLGL
yval.1 <- mLGL$AIvAvg
xval.1 <- mLGL$supportType
ylablab.1 <- "dGLS value"
title.1 <- paste(dataset," - ",h,sep="")
max(abs(min(yval.1)),abs(max(yval.1)))
limit.1 <- 10
ytic.1 <- c(seq(-limit.1,limit.1,1))
cc.1 <- c(color_AI)
hline.1 <- c(-0.5,0.5)

quartz()

GL.1 <- GL(df.1,xval.1,yval.1,ylablab.1,ytic.1,hline.1,cc.1,title.1)

GL.1

df <- mLBF
ylablab <- "2ln(BF) value"
title <- ""
max(abs(min(df$TvS)),abs(max(df$TvS)))
#limit <- 1000
#ytic <- c(seq(-limit,limit,100))
limit <- 200
ytic <- c(seq(-limit,limit,20))
cc <- c(color_TP)

#quartz()
BF_violin <- ggplot(df, aes(x=supportType, y=TvS, fill=supportType)) +
  geom_violin(trim=FALSE) +
  geom_point(shape = 18,size=0.75, position = position_jitterdodge(), color='black',alpha=1)+
  scale_color_manual(values=cc) + scale_fill_manual(values=cc) +
  theme_classic() +
  theme(plot.title = element_text(hjust = 0.5, size=16),
        axis.text = element_text(size=10, color="black"),
        text = element_text(size=14),
        legend.position = "none") +
  labs(y=ylablab,x="")  +
  ggtitle(title) +
  coord_cartesian(ylim=ytic) +
  scale_y_continuous(breaks = ytic) +
  geom_hline(yintercept=c(-10,10),color=c("black"), linetype="dashed", size=0.5)

BF_violin

graph_combined <- ggarrange(GL_violin, BF_violin, ncol=2, nrow=1, align="h")
graph_combined

ggsave(paste(dataset,"_violin","_scaled",".pdf",sep=""), plot=graph_combined,width = 4, height = 6, units = "in", device = 'pdf',bg = "transparent")

##Streicher
#limit.g <- 50
#ytic.g <- c(seq(-limit.g,limit.g,5))
#limit.g <- 10
#ytic.g <- c(seq(-limit.g,limit.g,1))
#limit <- 1000
#ytic <- c(seq(-limit,limit,100))
#limit <- 200
#ytic <- c(seq(-limit,limit,20))

##Singhal
#limit <- 1600
#limit <- 1000
#ytic <- c(seq(-limit,limit,100))
#limit.g <-80
#limit.g <- 50
#ytic.g <- c(seq(-limit.g,limit.g,5))

##Reeder
#limit.g <- 60
#limit.g <- 40
#ytic.g <- c(seq(-limit.g,limit.g,5))
#limit <- 1200
#limit <- 800
#ytic <- c(seq(-limit,limit,100))


args = commandArgs(trailingOnly=TRUE)

if (length(args)!=1) {
	stop("this script requires only one mandatory argument: the working directory", call.=FALSE)
}

setwd(args[1])

list.of.packages <- c("ggplot2", "plyr")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]

if(length(new.packages)) {
	install.packages(new.packages)
}

library("ggplot2")
library("plyr")

ue4_stats <- read.csv("ue4_stats.csv", row.names = NULL)
acl_stats <- read.csv("acl_stats.csv", row.names = NULL)

name <- factor(rep(c("ue4", "acl"), times = c(nrow(ue4_stats), nrow(acl_stats))))
compression_ratio <- c(ue4_stats$Compression.Ratio, acl_stats$Compression.Ratio)
max_error <- c(ue4_stats$Max.Error, acl_stats$Max.Error)

bundle <- data.frame(name, compression_ratio, max_error)
mu_ratio <- ddply(bundle, "name", summarise, grp.mean = mean(compression_ratio))
mu_error <- ddply(bundle, "name", summarise, grp.mean = mean(max_error))

p1 <- ggplot(ue4_stats, aes(x = Compression.Ratio)) +
  geom_histogram(color = "black", fill = "white") +
  geom_vline(aes(xintercept = mean(Compression.Ratio)), color = "blue", linetype = "dashed", size = 1)

png(filename = "ue4_compression_ratio.png")
plot(p1)
dev.off()

p2 <- ggplot(ue4_stats, aes(x = Max.Error)) +
  geom_histogram(color = "black", fill = "white") +
  geom_vline(aes(xintercept = mean(Max.Error)), color = "blue", linetype = "dashed", size = 1)

png(filename = "ue4_max_error.png")
plot(p2)
dev.off()

p3 <- ggplot(acl_stats, aes(x = Compression.Ratio)) +
  geom_histogram(color = "black", fill = "white") +
  geom_vline(aes(xintercept = mean(Compression.Ratio)), color = "blue", linetype = "dashed", size = 1)

png(filename = "acl_compression_ratio.png")
plot(p3)
dev.off()

p4 <- ggplot(acl_stats, aes(x = Max.Error)) +
  geom_histogram(color = "black", fill = "white") +
  geom_vline(aes(xintercept = mean(Max.Error)), color = "blue", linetype = "dashed", size = 1)

png(filename = "acl_max_error.png")
plot(p4)
dev.off()

p5 <- ggplot(bundle, aes(x = compression_ratio, color = name)) + geom_histogram(fill = "white", alpha = 0.5, position = "identity") +
geom_vline(data = mu_ratio, aes(xintercept = grp.mean, color = name), linetype = "dashed") +
theme(legend.position = "top")

png(filename = "ue4_acl_compression_ratio.png")
plot(p5)
dev.off()

p6 <- ggplot(bundle, aes(x = max_error, color = name)) + geom_histogram(fill = "white", alpha = 0.5, position = "identity") +
geom_vline(data = mu_error, aes(xintercept = grp.mean, color = name), linetype = "dashed") +
theme(legend.position = "top")

png(filename = "ue4_acl_max_error.png")
plot(p6)
dev.off()


histo <- read.delim("output/histogram/part-r-00000", header=F)

pdf(file="output/histogram/plot.pdf")

hist(histo$V1, breaks=50)


# ---------------------------------------------------------------------------
# Two-way Tanimoto algorithm: prediction accuracy for 2-Tanimoto_analysis.r
# ---------------------------------------------------------------------------

catalog_predictions_accuracy <- function(Tanimoto_analysis, predict.only = FALSE, empirical.only = FALSE) {
    load("./RData/interactions_source.RData")
    source("./Script/prediction_matrix.r")
    source("./Script/empirical_matrix.r")
    source("./Script/prediction_accuracy.r")

    accuracy <- matrix(ncol = 16, nrow = length(Tanimoto_analysis) * length(Tanimoto_analysis[[1]]) * length(Tanimoto_analysis[[1]][[1]]) * length(Tanimoto_analysis[[1]][[1]][[1]]) * length(Tanimoto_analysis[[1]][[1]][[1]][[1]]) * length(Tanimoto_analysis[[1]][[1]][[1]][[1]][[1]]), data = 0, dimnames = list(c(), c('pc_rm','nb_tx','nb_tx_rm','iter','MW','K','wt','Cm','a','b','c','d','TSS','ScoreY1','ScoreY0','FSS')))
    iteration <- 1
    for(p in 1: length(Tanimoto_analysis)) { #loop through percent remove values
        for(o in 1: length(Tanimoto_analysis[[1]])) { #loop through iterations
            for(n in 1: length(Tanimoto_analysis[[1]][[1]])) { #loop through MW values
                for(m in 1: length(Tanimoto_analysis[[1]][[1]][[1]])) { # loop through K values
                    for(i in 1:length(Tanimoto_analysis[[1]][[1]][[1]][[1]])){ #1st loop for all types of wt values
                        for(j in 1:length(Tanimoto_analysis[[1]][[1]][[1]][[1]][[1]])) { #2nd loop for all C[i]
                            # Arguments:
                            S1 <- Tanimoto_analysis[[p]][[o]][[n]][[m]][[i]][[j]][, 'consumer']
                            predictions <- Tanimoto_analysis[[p]][[o]][[n]][[m]][[i]][[j]]
                            interactions_source <- interactions_sources
                            source <- names(Tanimoto_analysis[[p]][[o]][[n]][[m]][[i]])[j]

                            accuracy[iteration, 'pc_rm'] <- names(Tanimoto_analysis)[p]
                            accuracy[iteration, 'iter'] <- names(Tanimoto_analysis[[p]])[o]
                            accuracy[iteration, 'nb_tx'] <- length(S1)
                            accuracy[iteration, 'nb_tx_rm'] <- round((as.numeric(accuracy[iteration, 'pc_rm'])/100) * length(S1))
                            accuracy[iteration, 'MW'] <- names(Tanimoto_analysis[[p]][[o]])[n]
                            accuracy[iteration, 'K'] <- names(Tanimoto_analysis[[p]][[o]][[n]])[m]
                            accuracy[iteration, 'wt'] <- names(Tanimoto_analysis[[p]][[o]][[n]][[m]])[i]
                            accuracy[iteration, 'Cm'] <- names(Tanimoto_analysis[[p]][[o]][[n]][[m]][[i]])[j]

                            accuracy[iteration, 9:16] <- prediction_accuracy(predicted = prediction_matrix(S1 = S1, predictions = predictions, predict.only = predict.only, empirical.only = empirical.only),
                                                                empirical = empirical_matrix(S1 = S1, interactions_source = interactions_source, source = source))

                            iteration <- iteration + 1
                            remove(S1, predictions, interactions_source, source)
                        }#j
                    }#i
                }#m
            }#n
        }#o
    }#p

    return(accuracy)

}#Tanimoto_accuracy function


rm(list = ls())

dd <- "/home/eric/Desktop/MXelsCalendGovt/elecReturns/data/"
setwd(dd)

# read raw data file
dat <- read.csv(file = "aymu1989-present.csv", stringsAsFactors = FALSE)
dim(dat)

#########################################################################
#########################################################################
##  script ayClean.r has routines used once to save a cleaner dataset  ##
#########################################################################
#########################################################################

# re-compute effective and total votes
sel <- grep("^v[0-9]{2}", colnames(dat))
v <- dat[,sel] # subset votes columns
v[is.na(v)==TRUE] <- 0 # replace NAs with zeroes
v[v==""|v=="NA"|v=="-"|v=="N/R"] <- 0 # replace with zeroes
for (i in 1:ncol(v)){
    v[,i] <- as.numeric(v[,i])
}
dat[,sel] <- v # return votes without missing to data
v$efec <- round(rowSums(v), 0)
dat$efec <- v$efec
tmp <- dat$nr # remove NAs
tmp[is.na(tmp)] <- 0
dat$nr <- tmp
tmp <- as.numeric(dat$nulos)  # make numeric & remove NAs
tmp[is.na(tmp)] <- 0
dat$nulos <- tmp
v$tot <- dat$efec + dat$nr + dat$nulos
dat$tot <- v$tot
rm(v, tmp)

# verify that coalition member separator is always a -
sel <- grep("^l[0-9]{2}", colnames(dat))
l <- dat[,sel] # subset label columns
for (i in 1:ncol(l)){
    #i <- 18 # debug
    tmp <- l[,i] # duplicate column for manipulation
    #table(gsub(pattern = "([0-9a-zA-Záéíóúñ])", replacement = "", tmp)) # keep only non-letter-number characters
    tmp <- gsub(pattern = "[ ]", replacement = "", tmp)
    tmp <- gsub(pattern = "[.,]", replacement = "-", tmp)
    #sel1 <- grep("[ ]", tmp)
    #tmp[sel1]
    l[,i] <- tmp # return to data
}
dat[,sel] <- l # return to data
rm(l)

## # replace NAs with zeroes (no longer needed)
## sel.v <- grep("^v[0-9]{2}", colnames(dat))
## v <- dat[,sel.v] # subset vote columns
## v[is.na(v)] <- 0
## dat[,sel.v] <- v # return to data
## rm(v)

# any votes with no labels?
sel.l <- grep("^l[0-9]{2}", colnames(dat))
l <- dat[,sel.l] # subset label columns
sel.v <- grep("^v[0-9]{2}", colnames(dat))
v <- dat[,sel.v] # subset vote columns
for (i in 1:ncol(l)){
    #i <- 2 # debug
    sel <- which(v[,i]>0 & l[,i]=="0")
    if (length(sel)>0) print(paste("Warning!!!  i=", i, sep = ""))
    print(paste("column", i , "ok"))
}
rm(l,v)

# drop upper case from labels
sel.l <- grep("^l[0-9]{2}", colnames(dat))
l <- dat[,sel.l] # subset labels columns
for (i in 1:ncol(l)){
    l[,i] <- tolower(l[,i])
    }
dat[,sel.l] <- l # return to data
rm(l)

# remove useless labels
sel.l <- grep("^l[0-9]{2}", colnames(dat))
l <- dat[,sel.l] # subset label columns
sel.v <- grep("^v[0-9]{2}", colnames(dat))
v <- dat[,sel.v] # subset vote columns
for (i in 1:ncol(l)){
    #i <- 1 # debug
    sel <- which(v[,i]==0 & l[,i]!="0")
    l[sel,i] <- "0"
}
dat[,sel.l] <- l # return to data
rm(l,v)

# change confusing party labels
sel.l <- grep("^l[0-9]{2}", colnames(dat))
l <- dat[,sel.l] # subset labels columns
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^c$|^cd$|^cdppn$|^pc$|^conver(gencia)?$", replacement = "conve", l[,i])
    l[,i] <- gsub(pattern = "-c-|-cd-|-cdppn-|-pc-|-conver(gencia)?-", replacement = "-conve-", l[,i])
    l[,i] <- gsub(pattern = "-c$|-cd$|-cdppn$|-pc$|-conver(gencia)?$", replacement = "-conve", l[,i])
    }
#
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^pmc$", replacement = "mc", l[,i])
    l[,i] <- gsub(pattern = "^pmc-", replacement = "mc-", l[,i])
    l[,i] <- gsub(pattern = "-pmc-", replacement = "-mc-", l[,i])
    l[,i] <- gsub(pattern = "-pmc$", replacement = "-mc", l[,i])
    }
#
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^panal$", replacement = "pna", l[,i])
##     l[,i] <- gsub(pattern = "-panal-", replacement = "-pna-", l[,i])
##     l[,i] <- gsub(pattern = "-panal$", replacement = "-pna", l[,i])
##     l[,i] <- gsub(pattern = "^panal-", replacement = "pna-", l[,i])
##     }
#
# avoid "na" in csv, recognized as missing...
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^na$", replacement = "pna", l[,i])
    l[,i] <- gsub(pattern = "-na-", replacement = "-pna-", l[,i])
    l[,i] <- gsub(pattern = "-na$", replacement = "-pna", l[,i])
    l[,i] <- gsub(pattern = "^na-", replacement = "pna-", l[,i])
    }
#
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^pd$", replacement = "pd1", l[,i])
    l[,i] <- gsub(pattern = "^pd-", replacement = "pd1-", l[,i])
    l[,i] <- gsub(pattern = "-pd-", replacement = "-pd1-", l[,i])
    l[,i] <- gsub(pattern = "-pd$", replacement = "-pd1", l[,i])
    }
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^p?asd?c?$|^alter(nativa)?$", replacement = "pasd", l[,i])
##     l[,i] <- gsub(pattern = "-p?asd?c?-|-alter(nativa)?-", replacement = "-pasd-", l[,i])
##     l[,i] <- gsub(pattern = "-p?asd?c?$|-alter(nativa)?$", replacement = "-pasd", l[,i])
##     l[,i] <- gsub(pattern = "^p?asd?c?-|^alter(nativa)?-", replacement = "pasd-", l[,i])
##     }
## #
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^pl$", replacement = "pl1", l[,i])
    l[,i] <- gsub(pattern = "^pl-", replacement = "pl1-", l[,i])
    l[,i] <- gsub(pattern = "-pl-", replacement = "-pl1-", l[,i])
    l[,i] <- gsub(pattern = "-pl$", replacement = "-pl1", l[,i])
    }
#
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^pp$", replacement = "pp1", l[,i])
    l[,i] <- gsub(pattern = "^pp-", replacement = "pp1-", l[,i])
    l[,i] <- gsub(pattern = "-pp-", replacement = "-pp1-", l[,i])
    l[,i] <- gsub(pattern = "-pp$", replacement = "-pp1", l[,i])
    }
#
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^pr$", replacement = "pr1", l[,i])
    l[,i] <- gsub(pattern = "^pr-", replacement = "pr1-", l[,i])
    l[,i] <- gsub(pattern = "-pr-", replacement = "-pr1-", l[,i])
    l[,i] <- gsub(pattern = "-pr$", replacement = "-pr1", l[,i])
    }
#
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^ps$", replacement = "ps1", l[,i])
    l[,i] <- gsub(pattern = "^ps-", replacement = "ps1-", l[,i])
    l[,i] <- gsub(pattern = "-ps-", replacement = "-ps1-", l[,i])
    l[,i] <- gsub(pattern = "-ps$", replacement = "-ps1", l[,i])
    }
#
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^pt$", replacement = "pt1", l[,i])
##     l[,i] <- gsub(pattern = "-pt-", replacement = "-pt1-", l[,i])
##     l[,i] <- gsub(pattern = "-pt$", replacement = "-pt1", l[,i])
##     l[,i] <- gsub(pattern = "^pt-", replacement = "pt1-", l[,i])
##     }
#
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^pac$", replacement = "pac1", l[,i])
##     l[,i] <- gsub(pattern = "-pac-", replacement = "-pac1-", l[,i])
##     l[,i] <- gsub(pattern = "-pac$", replacement = "-pac1", l[,i])
##     l[,i] <- gsub(pattern = "^pac-", replacement = "pac1-", l[,i])
##     }
## #
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^pbc$", replacement = "ppbc", l[,i])
##     l[,i] <- gsub(pattern = "-pbc-", replacement = "-ppbc-", l[,i])
##     l[,i] <- gsub(pattern = "-pbc$", replacement = "-ppbc", l[,i])
##     l[,i] <- gsub(pattern = "^pbc-", replacement = "ppbc-", l[,i])
##     }
## #
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^pcd$", replacement = "pcd1", l[,i])
##     l[,i] <- gsub(pattern = "-pcd-", replacement = "-pcd1-", l[,i])
##     l[,i] <- gsub(pattern = "-pcd$", replacement = "-pcd1", l[,i])
##     l[,i] <- gsub(pattern = "^pcd-", replacement = "pcd1-", l[,i])
##     }
#
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^pcm$", replacement = "pcm1", l[,i])
##     l[,i] <- gsub(pattern = "-pcm-", replacement = "-pcm1-", l[,i])
##     l[,i] <- gsub(pattern = "-pcm$", replacement = "-pcm1", l[,i])
##     l[,i] <- gsub(pattern = "^pcm-", replacement = "pcm1-", l[,i])
##     }
## #
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^pds$", replacement = "pds1", l[,i])
##     l[,i] <- gsub(pattern = "-pds-", replacement = "-pds1-", l[,i])
##     l[,i] <- gsub(pattern = "-pds$", replacement = "-pds1", l[,i])
##     l[,i] <- gsub(pattern = "^pds-", replacement = "pds1-", l[,i])
##     }
## #
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^pfd$", replacement = "pfd1", l[,i])
##     l[,i] <- gsub(pattern = "-pfd-", replacement = "-pfd1-", l[,i])
##     l[,i] <- gsub(pattern = "-pfd$", replacement = "-pfd1", l[,i])
##     l[,i] <- gsub(pattern = "^pfd-", replacement = "pfd1-", l[,i])
##     }
## #
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^ppn$", replacement = "ppn1", l[,i])
##     l[,i] <- gsub(pattern = "-ppn-", replacement = "-ppn1-", l[,i])
##     l[,i] <- gsub(pattern = "-ppn$", replacement = "-ppn1", l[,i])
##     l[,i] <- gsub(pattern = "^ppn-", replacement = "ppn1-", l[,i])
##     }
## #
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^psd$", replacement = "psd1", l[,i])
##     l[,i] <- gsub(pattern = "-psd-", replacement = "-psd1-", l[,i])
##     l[,i] <- gsub(pattern = "-psd$", replacement = "-psd1", l[,i])
##     l[,i] <- gsub(pattern = "^psd-", replacement = "psd1-", l[,i])
##     }
## #
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^udc$", replacement = "pudc", l[,i])
##     l[,i] <- gsub(pattern = "-udc-", replacement = "-pudc-", l[,i])
##     l[,i] <- gsub(pattern = "-udc$", replacement = "-pudc", l[,i])
##     l[,i] <- gsub(pattern = "^udc-", replacement = "pudc-", l[,i])
##     }
## #
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^mrps$", replacement = "pmrps", l[,i])
##     l[,i] <- gsub(pattern = "-mrps-", replacement = "-pmrps-", l[,i])
##     l[,i] <- gsub(pattern = "-mrps$", replacement = "-pmrps", l[,i])
##     l[,i] <- gsub(pattern = "^mrps-", replacement = "pmrps-", l[,i])
##     }
## #
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^otro$", replacement = "otros", l[,i])
    l[,i] <- gsub(pattern = "-otro-", replacement = "-otros-", l[,i])
    l[,i] <- gsub(pattern = "-otro$", replacement = "-otros", l[,i])
    l[,i] <- gsub(pattern = "^otro-", replacement = "otros-", l[,i])
    }
#
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^parme.$", replacement = "parm", l[,i])
##     l[,i] <- gsub(pattern = "-parme.-", replacement = "-parm-", l[,i])
##     l[,i] <- gsub(pattern = "-parme.$", replacement = "-parm", l[,i])
##     l[,i] <- gsub(pattern = "^parme.-", replacement = "parm-", l[,i])
##     }
#
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^indep$", replacement = "indep1", l[,i])
##     l[,i] <- gsub(pattern = "-indep-", replacement = "-indep1-", l[,i])
##     l[,i] <- gsub(pattern = "-indep$", replacement = "-indep1", l[,i])
##     l[,i] <- gsub(pattern = "^indep-", replacement = "indep1-", l[,i])
##     }
#
## for (i in 1:ncol(l)){
##     l[,i] <- gsub(pattern = "^alianza$", replacement = "alianza1", l[,i])
##     l[,i] <- gsub(pattern = "-alianza-", replacement = "-alianza1-", l[,i])
##     l[,i] <- gsub(pattern = "-alianza$", replacement = "-alianza1", l[,i])
##     l[,i] <- gsub(pattern = "^alianza-", replacement = "alianza1-", l[,i])
##     }
#
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^es$", replacement = "pes", l[,i])
    l[,i] <- gsub(pattern = "-es-", replacement = "-pes-", l[,i])
    l[,i] <- gsub(pattern = "-es$", replacement = "-pes", l[,i])
    l[,i] <- gsub(pattern = "^es-", replacement = "pes-", l[,i])
    }
#
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^pmac$|^moveracps$", replacement = "pmch", l[,i])
    l[,i] <- gsub(pattern = "-pmac-|-moveracps-", replacement = "-pmch-", l[,i])
    l[,i] <- gsub(pattern = "-pmac$|-moveracps$", replacement = "-pmch", l[,i])
    l[,i] <- gsub(pattern = "^pmac-|^moveracps-", replacement = "pmch-", l[,i])
    }
#
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^pcu$", replacement = "pchu", l[,i])
    l[,i] <- gsub(pattern = "-pcu-", replacement = "-pchu-", l[,i])
    l[,i] <- gsub(pattern = "-pcu$", replacement = "-pchu", l[,i])
    l[,i] <- gsub(pattern = "^pcu-", replacement = "pchu-", l[,i])
    }
#
for (i in 1:ncol(l)){
    l[,i] <- gsub(pattern = "^fsm$", replacement = "fxm", l[,i])
    l[,i] <- gsub(pattern = "-fsm-", replacement = "-fxm-", l[,i])
    l[,i] <- gsub(pattern = "-fsm$", replacement = "-fxm", l[,i])
    l[,i] <- gsub(pattern = "^fsm-", replacement = "fxm-", l[,i])
    }
#
#
sel.r <- which(dat$yr>2006)
#table(l[sel.r,18]) # easier to verify one column at a time
dat[,sel.l] <- l # return to data
rm(l)

## # some longer pty labels include shorter ones (eg pan panal) giving false positives in regexes
## # figure which and change them
## sel.l <- grep("^l[0-9]{2}", colnames(dat))
## l <- dat[,sel.l] # subset label columns
## lab.tmp <- c(t(l)) # vectorize
## lab.tmp <- lab.tmp[lab.tmp!="0"] # drop empty cells
## lab.tmp <- unique(lab.tmp)
## lab.tmp <- strsplit(lab.tmp, split = "-") # break into component character vector
## lab.tmp <- unlist(lab.tmp)
## lab.tmp <- unique(lab.tmp)
## lab.tmp <- lab.tmp[lab.tmp!="0"] # drop empty cells
## lab.tmp <- lab.tmp[order(lab.tmp)]        # sort
## lab.tmp <- lab.tmp[order(nchar(lab.tmp))] # put shorter labels first
## # verify that all labels unique
## i <- 1
## i <- i+1; grep(lab.tmp[i], lab.tmp)
## lab.tmp[grep(lab.tmp[i], lab.tmp)]
## x

save.image(file = "tmp.RData")

## consider running script above to make sure data is up-to-date with latest csv
rm(list = ls())
dd <- "/home/eric/Desktop/MXelsCalendGovt/elecReturns/data/"
setwd(dd)
load(file = "tmp.RData")

######################################################
######################################################
# identify coalitions by searching for "-" in labels #
######################################################
######################################################
sel.l <- grep("^l[0-9]{2}", colnames(dat))
l <- dat[,sel.l] # subset label columns
sel.v <- grep("^v[0-9]{2}", colnames(dat))
v <- dat[,sel.v] # subset vote columns
#
# dummy had at least one coalition
dat$dcoal <- 0
for (i in 1:ncol(l)){
    dat$dcoal[grep("-", l[,i])] <- 1
}

# create objects with vote for coalition(s) added and redudant columns dropped
# 3sep2021: old version used to empty contents which set a bug --- 2nd round manip would forget 1st round manip
# 3sep2021: new precidure keeps votes/labels in to avoid this
cv <- v; #cv[] <- NA # will receive votes with coalitions aggregated
cl <- l; #cl[] <- NA # will keep coalition labels but drop coalition member labels
# create "split" objects for votes contrinuted by each coalition member and joint column dropped
sv <- v; #sv[] <- NA
sl <- l; #sl[] <- NA
#
ci <- data.frame(dcoal=dat$dcoal, ncoal=NA, coal1="none", coal2="none", coal3="none", coal4="none", stringsAsFactors = FALSE) # coalition summary info
ci$ncoal[ci$dcoal==0] <- 0 # 0=no coalition
# ci$coal1 coal2 coal3 coal4 pre-filled
  # n is object reporting how many parties reported in a v/l cell?
  ln1 <- v # duplicate votes
  ln1[] <- 0 # will receive info
  ln2 <- ln1 # duplicate
  # replace each label with its character length
  for (i in 1:ncol(ln1)){
      #i <- 16 # debug
      tmp <- l[,i] # pick ith column as vector
      ln1[,i] <- nchar(tmp) # replace items with num characters
  }
  # drop hyphens to count character difference
  l.tmp <- l # duplicate
  for (i in 1:ncol(l.tmp)){
      #i <- 1 # debug
      l.tmp[,i] <- gsub("-", "", l.tmp[,i]) # remove hyphens to count char dif
      ln2[,i] <- nchar(l.tmp[,i]) # replace items with num characters
  }
  n <- ln1 - ln2 + 1 # 1 means no coalition, single party
  n[l=="0"] <- 0     # empty votes
  rm(i, ln1, ln2, l.tmp, sel, tmp)
#
max.tmp <- apply(n, 1, max) # max parties reported in a row's cell
table(max.tmp) # coal w most members has 7
I <- nrow(v)
c4 <- c3 <- c2 <- c1 <- as.data.frame(matrix("0", I, 7), col.names = paste("p", 1:7, sep = ""), stringsAsFactors = FALSE) # will receive vector of 1st 2nd 3rd 4th coalition's members
#
# will receive columns corresponding to coalition members in v/l for use when weighting votes contributed by each member
w4 <- w3 <- w2 <- w1 <- as.list(rep("noCoal",I))
#
## # fill in easy cases with no coalition --- 3sep2021 no longer needed with new procedure
## sel <- which(dat$dcoal==0)
## cv[sel,] <- v[sel,]
## cl[sel,] <- l[sel,]
## sv[sel,] <- v[sel,]
## sl[sel,] <- l[sel,]
## # c1 c2 c3 c4 are pre-filled
## # w1 w2 w3 w4 are pre-filled

# fill in info selecting cases of coalitions with most members
sel7 <- which(max.tmp>1)
#grep("ags-18", dat$emm[sel7]) # debug
tmp.v  <- cv[sel7,] # subset for manipulation --- 3sep2021 used to pick from v, forgetting manip in later rounds
tmp.vw <- sv[sel7,] # will receive votes contributed by each coalition member
tmp.l  <- cl[sel7,]
tmp.lw <- sl[sel7,] # will receive labels of vote-contributing parties
tmp.n  <- n[sel7,]
tmp.c1 <- c1[sel7,]
tmp.w1  <- w1[sel7] # will receive indices to manipulate
tmp.vw1 <- w1[sel7] # will receive manipulated votes
max.tmp <- max.tmp[sel7]
tmp.ci <- ci[sel7,]

for (i in 1:length(sel7)){
    #i <- length(sel7) # debug
    #i <- 50 # debug
    #tmp.l[i,]
    message(sprintf("loop %s of %s", i, length(sel7)))
    tmp.ci$ncoal[i] <- 1               # running tally ncoal
    save.col <- which(tmp.n[i,]==max.tmp[i])[1] # spare this column from erasure in process below (1st if multiple hits)
    save.label <- tmp.l[i, save.col]            # keep coalition full label
    tmp.ci$coal1[i] <- save.label      # plug coal label into summary
    tmp <- strsplit(save.label, split = "-") # break into component character vector
    tmp.c1[i,1:length(tmp[[1]])] <- tmp[[1]] # fill in coalition members
    #
    target.cols <- numeric()       # initialize empty vector for vote sum
    for (j in 1:7){
        #j <- 1 # debug
        if (tmp.c1[i,j]=="0") next
        pat <- paste("^", tmp.c1[i,j], "$|", tmp.c1[i,j], "-|-", tmp.c1[i,j], sep="") # searches ^pty$, pty- or -pty (avoids panal hit when searching for pan) --- reduntant given label changes
        tmp.target <- grep(pattern = pat, x = tmp.l[i,])
        #tmp.target <- grep(pattern = tmp.c1[i,j], x = tmp.l[i,]) # version hits panal when searching pan
        if (length(tmp.target)>0) {
            target.cols <- c(target.cols, tmp.target)
        }
    }
    target.cols <- unique(target.cols); target.cols <- target.cols[order(target.cols)]
    tmp.w1[[i]] <- target.cols # cols to use when replacing coalition members' contributed votes
    sel <- setdiff(target.cols, save.col)  # setdiffs joint votes
    if (length(sel)==0) sel <- target.cols # or all if singleton (ie setdiff empty)
    tmp.vw1[[i]] <- tmp.v[i, sel] # keep to fill coalition members' contribution
    save.vote <- sum(tmp.v[i,target.cols])
    tmp.vw1[[i]] <- tmp.vw1[[i]] / sum(tmp.v[i,sel])   # relative contributions
    tmp.vw1[[i]] <- round(tmp.vw1[[i]] * save.vote, 2) # relative votes contributed
    if (length(sel)>1){ # do not manipulate if singleton
        tmp.v[i, target.cols] <- 0   # erase votes to keep only aggregate
        tmp.l[i, target.cols] <- "0" # erase labels to keep only full coalition label manipulation
        tmp.v[i, save.col] <- save.vote  # place aggregate vote back in
        tmp.l[i, save.col] <- save.label # place coalition label back in
        # votes contributed
        tmp.vw[i, save.col] <- 0   # erase joint votes
        tmp.lw[i, save.col] <- "0" # erase joint label
        tmp.vw[i, sel] <- tmp.vw1[[i]]  # place contributed votes back in
    }
    tmp.n[i, target.cols] <- 0   # erase ns, prep for obs's next coalition
}
# return to data
cv[sel7,] <- tmp.v
cl[sel7,] <- tmp.l
n[sel7,] <- tmp.n
c1[sel7,] <- tmp.c1
w1[sel7] <- tmp.w1
ci[sel7,] <- tmp.ci
sv[sel7,] <- tmp.vw
sl[sel7,] <- tmp.lw
#tail(w1[sel7])

####################################
# process cases with 2nd coalition #
####################################
max.tmp <- apply(n, 1, max) # max parties reported in a row's cell
table(max.tmp) # coal w most members has 7
sel7 <- which(max.tmp>1)
#grep("ags-18", dat$emm[sel7]) # debug
tmp.v  <- cv[sel7,] # subset for manipulation --- 3sep2021 used to pick from v, forgetting manip in later rounds
tmp.vw <- sv[sel7,] # will receive votes contributed by each coalition member
tmp.l  <- cl[sel7,]
tmp.lw <- sl[sel7,] # will receive labels of vote-contributing parties
tmp.n <- n[sel7,]
tmp.c2 <- c2[sel7,]
tmp.w2 <- w2[sel7]
tmp.vw2 <- w2[sel7] # will receive manipulated votes
max.tmp <- max.tmp[sel7]
tmp.ci <- ci[sel7,]

# debug
#i <- which(dat$ord[sel7]==847)

for (i in 1:length(sel7)){
    #i <- 50 # debug
    #tmp.l[i,] # debug
    #tmp.n[i,] # debug
    message(sprintf("loop %s of %s", i, length(sel7)))
    tmp.ci$ncoal[i] <- 2               # running tally co ncoal
    save.col <- which(tmp.n[i,]==max.tmp[i])[1] # spare this column from erasure in process below (1st if multiple hits)
    save.label <- tmp.l[i, save.col]            # keep coalition full label
    tmp.ci$coal2[i] <- save.label      # plug coal label into summary
    tmp <- strsplit(save.label, split = "-") # break into component character vector
    tmp.c2[i,1:length(tmp[[1]])] <- tmp[[1]] # fill in coalition members
    #
    target.cols <- numeric() # initialize empty vector
    for (j in 1:7){
        #j <- 2 # debug
        if (tmp.c2[i,j]=="0") next
        pat <- paste("^", tmp.c2[i,j], "$|", tmp.c2[i,j], "-|-", tmp.c2[i,j], sep="") # searches ^pty$, pty- or -pty (avoids panal hit when searching for pan) --- unnecessary given label changes
        tmp.target <- grep(pattern = pat, x = tmp.l[i,])
        #tmp.target <- grep(pattern = tmp.c2[i,j], x = tmp.l[i,]) # version hits panal when searching pan
        if (length(tmp.target)>0) {
            target.cols <- c(target.cols, tmp.target)
        }
    }
    target.cols <- unique(target.cols); target.cols <- target.cols[order(target.cols)]
    tmp.w2[[i]] <- target.cols # for use when computing coalition members' contribution
    sel <- setdiff(target.cols, save.col)  # setdiffs joint votes
    if (length(sel)==0) sel <- target.cols # or all if singleton
    tmp.vw2[[i]] <- tmp.v[i, sel] # keep to fill coalition members' contribution (setdiffs joint votes)
    save.vote <- sum(tmp.v[i,target.cols])
    tmp.vw2[[i]] <- tmp.vw2[[i]] / sum(tmp.v[i,sel])   # relative contributions
    tmp.vw2[[i]] <- round(tmp.vw2[[i]] * save.vote, 2) # relative votes contributed
    if (length(sel)>1){ # do not manipulate if singleton
        tmp.v[i, target.cols] <- 0   # erase votes to keep only aggregate
        tmp.l[i, target.cols] <- "0" # erase labels to keep only full coalition label
        tmp.v[i, save.col] <- save.vote  # place aggregate vote back in
        tmp.l[i, save.col] <- save.label # place coalition label back in
        # votes contributed
        tmp.vw[i, save.col] <- 0   # erase joint votes
        tmp.lw[i, save.col] <- "0" # erase joint label
        tmp.vw[i, sel] <- tmp.vw2[[i]]  # place contributed votes back in
    }
    tmp.n[i, target.cols] <- 0   # erase ns
}
# return to data
cv[sel7,] <- tmp.v
cl[sel7,] <- tmp.l
n[sel7,] <- tmp.n
c2[sel7,] <- tmp.c2
w2[sel7] <- tmp.w2
ci[sel7,] <- tmp.ci
sv[sel7,] <- tmp.vw
sl[sel7,] <- tmp.lw
# tail(w2[sel7])

####################################
# process cases with 3rd coalition #
####################################
max.tmp <- apply(n, 1, max) # max parties reported in a row's cell
table(max.tmp) # coal w most members has 7
sel7 <- which(max.tmp>1)
tmp.v  <- cv[sel7,] # subset for manipulation --- 3sep2021 used to pick from v, forgetting manip in later rounds
tmp.vw <- sv[sel7,] # will receive votes contributed by each coalition member
tmp.l  <- cl[sel7,]
tmp.lw <- sl[sel7,] # will receive labels of vote-contributing parties
tmp.n <- n[sel7,]
tmp.c3 <- c3[sel7,]
tmp.w3 <- w3[sel7]
tmp.vw3 <- w1[sel7] # will receive manipulated votes
max.tmp <- max.tmp[sel7]
tmp.ci <- ci[sel7,]

for (i in 1:length(sel7)){
    #i <- 1 # debug
    #tmp.l[i,] # debug
    #tmp.n[i,] # debug
    message(sprintf("loop %s of %s", i, length(sel7)))
    tmp.ci$ncoal[i] <- 3               # running tally co ncoal
    save.col <- which(tmp.n[i,]==max.tmp[i])[1] # spare this column from erasure in process below (1st if multiple hits)
    save.label <- tmp.l[i, save.col]            # keep coalition full label
    tmp.ci$coal3[i] <- save.label      # plug coal label into summary
    tmp <- strsplit(save.label, split = "-") # break into component character vector
    tmp.c3[i,1:length(tmp[[1]])] <- tmp[[1]] # fill in coalition members
    #
    target.cols <- numeric() # initialize empty vector
    for (j in 1:7){
        #j <- 2 # debug
        if (tmp.c3[i,j]=="0") next
        pat <- paste("^", tmp.c3[i,j], "$|", tmp.c3[i,j], "-|-", tmp.c3[i,j], sep="") # searches ^pty$, pty- or -pty (avoids panal hit when searching for pan) --- unnecessary given label changes
        tmp.target <- grep(pattern = pat, x = tmp.l[i,])
        #tmp.target <- grep(pattern = tmp.c3[i,j], x = tmp.l[i,]) # version hits panal when searching pan
        if (length(tmp.target)>0) {
            target.cols <- c(target.cols, tmp.target)
        }
    }
    target.cols <- unique(target.cols); target.cols <- target.cols[order(target.cols)]
    tmp.w3[[i]] <- target.cols # for use when computing coalition members' contribution
    sel <- setdiff(target.cols, save.col)  # setdiffs joint votes
    if (length(sel)==0) sel <- target.cols # or all if singleton
    tmp.vw3[[i]] <- tmp.v[i, sel] # keep to fill coalition members' contribution (setdiffs joint votes)
    save.vote <- sum(tmp.v[i,target.cols])
    tmp.vw3[[i]] <- tmp.vw3[[i]] / sum(tmp.v[i,sel])   # relative contributions
    tmp.vw3[[i]] <- round(tmp.vw3[[i]] * save.vote, 2) # relative votes contributed
    if (length(sel)>1){ # do not manipulate if singleton
        tmp.v[i, target.cols] <- 0   # erase votes to keep only aggregate
        tmp.l[i, target.cols] <- "0" # erase labels to keep only full coalition label
        tmp.v[i, save.col] <- save.vote  # place aggregate vote back in
        tmp.l[i, save.col] <- save.label # place coalition label back in
        # votes contributed
        tmp.vw[i, save.col] <- 0   # erase joint votes
        tmp.lw[i, save.col] <- "0" # erase joint label
        tmp.vw[i, sel] <- tmp.vw3[[i]]  # place contributed votes back in
    }
    tmp.n[i, target.cols] <- 0   # erase ns
}
# return to data
cv[sel7,] <- tmp.v
cl[sel7,] <- tmp.l
n[sel7,] <- tmp.n
c3[sel7,] <- tmp.c3
w3[sel7] <- tmp.w3
ci[sel7,] <- tmp.ci
sv[sel7,] <- tmp.vw
sl[sel7,] <- tmp.lw
# tail(w3[sel7])

####################################
# process cases with 4th coalition #
####################################
max.tmp <- apply(n, 1, max) # max parties reported in a row's cell
table(max.tmp) # coal w most members has 7
sel7 <- which(max.tmp>1)
tmp.v  <- cv[sel7,] # subset for manipulation --- 3sep2021 used to pick from v, forgetting manip in later rounds
tmp.vw <- sv[sel7,] # will receive votes contributed by each coalition member
tmp.l  <- cl[sel7,]
tmp.lw <- sl[sel7,] # will receive labels of vote-contributing parties
tmp.n <- n[sel7,]
tmp.c4 <- c4[sel7,]
tmp.w4 <- w4[sel7]
tmp.vw4 <- w4[sel7] # will receive manipulated votes
max.tmp <- max.tmp[sel7]
tmp.ci <- ci[sel7,]

for (i in 1:length(sel7)){
    #i <- 1 # debug
    #tmp.l[i,] # debug
    #tmp.n[i,] # debug
    message(sprintf("loop %s of %s", i, length(sel7)))
    tmp.ci$ncoal[i] <- 4               # running tally co ncoal
    save.col <- which(tmp.n[i,]==max.tmp[i])[1] # spare this column from erasure in process below (1st if multiple hits)
    save.label <- tmp.l[i, save.col]            # keep coalition full label
    tmp.ci$coal4[i] <- save.label      # plug coal label into summary
    tmp <- strsplit(save.label, split = "-") # break into component character vector
    tmp.c4[i,1:length(tmp[[1]])] <- tmp[[1]] # fill in coalition members
    #
    target.cols <- numeric() # initialize empty vector
    for (j in 1:7){
        #j <- 2 # debug
        if (tmp.c4[i,j]=="0") next
        pat <- paste("^", tmp.c4[i,j], "$|", tmp.c4[i,j], "-|-", tmp.c4[i,j], sep="") # searches ^pty$, pty- or -pty (avoids panal hit when searching for pan) --- unnecessary given label changes
        tmp.target <- grep(pattern = pat, x = tmp.l[i,])
        #tmp.target <- grep(pattern = tmp.c4[i,j], x = tmp.l[i,]) # version hits panal when searching pan
        if (length(tmp.target)>0) {
            target.cols <- c(target.cols, tmp.target)
        }
    }
    target.cols <- unique(target.cols); target.cols <- target.cols[order(target.cols)]
    tmp.w4[[i]] <- target.cols # for use when computing coalition members' contribution
    sel <- setdiff(target.cols, save.col)  # setdiffs joint votes
    if (length(sel)==0) sel <- target.cols # or all if singleton
    tmp.vw4[[i]] <- tmp.v[i, sel] # keep to fill coalition members' contribution (setdiffs joint votes)
    save.vote <- sum(tmp.v[i,target.cols])
    tmp.vw4[[i]] <- tmp.vw4[[i]] / sum(tmp.v[i,sel])   # relative contributions
    tmp.vw4[[i]] <- round(tmp.vw4[[i]] * save.vote, 2) # relative votes contributed
    if (length(sel)>1){ # do not manipulate if singleton
        tmp.v[i, target.cols] <- 0   # erase votes to keep only aggregate
        tmp.l[i, target.cols] <- "0" # erase labels to keep only full coalition label
        tmp.v[i, save.col] <- save.vote  # place aggregate vote back in
        tmp.l[i, save.col] <- save.label # place coalition label back in
        # votes contributed
        tmp.vw[i, save.col] <- 0   # erase joint votes
        tmp.lw[i, save.col] <- "0" # erase joint label
        tmp.vw[i, sel] <- tmp.vw1[[i]]  # place contributed votes back in
    }
    tmp.n[i, target.cols] <- 0   # erase ns
}
# return to data
cv[sel7,] <- tmp.v
cl[sel7,] <- tmp.l
n[sel7,] <- tmp.n
c4[sel7,] <- tmp.c4
w4[sel7] <- tmp.w4
ci[sel7,] <- tmp.ci
sv[sel7,] <- tmp.vw
sl[sel7,] <- tmp.lw

max.tmp <- apply(n, 1, max) # max parties reported in a row's cell
print("Table must have 0s and 1s only, else coalitions remain to manipulate")
table(max.tmp) # must have 0s and 1s only (number of parties being reported by remaining columns)

## # debug
## sel <- which(max.tmp==2)
## cv[sel[2],]
## cl[sel[2],]
## sv[sel[2],]
## sl[sel[2],]
## dat[sel[2],]
## dat$emm[sel]
## x

# plug ncoal into data
dat$ncoal  <- ci$ncoal

# prepare object with coalition party weights
w <- as.list(rep("noCoal",I))
sel <- which(ci$ncoal>=1)
for (i in sel){
    w[[i]] <- list(coal1="no", coal2="no", coal3="no", coal4="no")
    #i <- sel[1] # debug
    w[[i]]$coal1 <- v[i,w1[[i]]]
    names(w[[i]]$coal1) <- l[i,w1[[i]]]
}
#
sel <- which(ci$ncoal>=2)
for (i in sel){
    #i <- sel[1] # debug
    w[[i]]$coal2 <- v[i,w2[[i]]]
    names(w[[i]]$coal2) <- l[i,w2[[i]]]
}
#
sel <- which(ci$ncoal>=3)
for (i in sel){
    #i <- sel[1] # debug
    w[[i]]$coal3 <- v[i,w3[[i]]]
    names(w[[i]]$coal3) <- l[i,w3[[i]]]
}
#
sel <- which(ci$ncoal>=4)
for (i in sel){
    #i <- sel[1] # debug
    w[[i]]$coal4 <- v[i,w4[[i]]]
    names(w[[i]]$coal4) <- l[i,w4[[i]]]
}
coal.weights <- w # rename
coal.info <- ci
rm(w, ci)

rm(c1, c2, c3, c4, I, i, j, max.tmp, n, pat, save.col, save.label, save.vote, sel, sel7, target.cols, tmp, tmp.c1, tmp.c2, tmp.c3, tmp.c4, tmp.ci, tmp.l, tmp.n, tmp.target, tmp.v, tmp.w1, tmp.w2, tmp.w3, tmp.w4, w1, w2, w3, w4, tmp.lw, tmp.vw, tmp.vw1, tmp.vw2, tmp.vw3, tmp.vw4) # housecleaning

## winner (sorts data to have largest vote-winning party in column 1)
# handy function to sort one data frame's rows by order of another, matching data frame
# if my machine use scripts in disk
pth <- ifelse (Sys.info()["user"] %in% c("eric", "magar"),
    "~/Dropbox/data/useful-functions",
    "https://raw.githubusercontent.com/emagar/useful-functions/master"
    )
# Reads sortBy function
source( paste(pth, "sortBy.r", sep = "/") )
rm(pth)

## # debug
## grep("ags-18", dat$emm)
## sl[156,]
## x

# sort coalition-aggregated data
tail(cv)
tail(cl)
###########################################
cv.sorted <- sortBy(target = cv, By = cv) # slow! convenient to wait for
#                                         # process end before continuing
###########################################
cl.sorted <- sortBy(target = cl, By = cv) # slow! convenient to wait for
#                                         # process end before continuing
###########################################
cv.sorted <- as.data.frame(cv.sorted, stringsAsFactors = FALSE) # return matrix to dataframe
cl.sorted <- as.data.frame(cl.sorted, stringsAsFactors = FALSE) # return matrix to dataframe
colnames(cv.sorted) <- colnames(v); colnames(cl.sorted) <- colnames(l)
cv.sorted <- transform(cv.sorted, v01 = as.numeric(v01), v02 = as.numeric(v02), v03 = as.numeric(v03), v04 = as.numeric(v04), v05 = as.numeric(v05), v06 = as.numeric(v06), v07 = as.numeric(v07), v08 = as.numeric(v08), v09 = as.numeric(v09), v10 = as.numeric(v10), v11 = as.numeric(v11), v12 = as.numeric(v12), v13 = as.numeric(v13), v14 = as.numeric(v14), v15 = as.numeric(v15), v16 = as.numeric(v16), v17 = as.numeric(v17), v18 = as.numeric(v18), v19 = as.numeric(v19) , v20 = as.numeric(v20) , v21 = as.numeric(v21) , v22 = as.numeric(v22) , v23 = as.numeric(v23) , v24 = as.numeric(v24) , v25 = as.numeric(v25)) # return to numeric format
tail(cv.sorted)
tail(cl.sorted)

# rename objects so that dat now has coalition aggregates
dat.orig <- dat # duplicate original data
dat[,sel.l] <- cl.sorted # return manipulated labels to data
dat[,sel.v] <- cv.sorted # return manipulated votes to data
head(dat)
# prepare coalition-split object for export
dat.split <- dat.orig
dat.split[,sel.l] <- sl # return manipulated labels to data
dat.split[,sel.v] <- sv # return manipulated votes to data
# move dcoal and ncoal columns before v01
tmp <- dat # duplicate if I mess up
tmp1 <- grep("v01", colnames(dat))
tmp2 <- grep("dcoal", colnames(dat))
tmp3 <- grep("ncoal", colnames(dat))
dat <- dat[, c(1:(tmp1-1), tmp2, tmp3, tmp1:(tmp2-1))]
colnames(dat)
rm(sv, sl, cv, cl, cv.sorted, cl.sorted, sel.l, sel.v, v, l, tmp, tmp1, tmp2, tmp3)

## # All 18 cols needed thanks to mor 2021...
## table(dat$v24) # check that only has zeroes
## # if not, which cases remain?
## #sel <- which(dat$v14>0)
## #dat[sel,]
dat$v24 <- dat$l24 <- dat$v25 <- dat$l25 <- NULL # drop redundant columns
dat$win <- dat$l01
# move win column before v01
tmp <- dat # duplicate if I mess up
tmp1 <- grep("v01", colnames(dat))
tmp2 <- grep("win", colnames(dat))
dat <- dat[, c(1:(tmp1-1), tmp2, tmp1:(tmp2-1))]
colnames(dat)

sel.l <- grep("^l[0-9]{2}", colnames(dat))
l <- dat[,sel.l] # subset label columns
sel.v <- grep("^v[0-9]{2}", colnames(dat))
v <- dat[,sel.v] # subset vote columns
dat$ncand <- apply(v, 1, function(x) length(x[x>0]))
# check that coal aggregation produces same efec as before
check <- rowSums(v) - dat$efec
table(check==0) # all must be true
## sel <- which(check!=0)
## dat[sel[2],]
## dat.orig[sel[2],]
# move ncand column before dcoal
tmp <- dat # duplicate if I mess up
tmp1 <- grep("dcoal", colnames(dat))
tmp2 <- grep("ncand", colnames(dat))
dat <- dat[, c(1:(tmp1-1), tmp2, tmp1:(tmp2-1))]
colnames(dat)

## #################################
## #### DROPS USOS Y COSTUMBRES ####
## #################################
## # any dusos==1?
## table(dat$dusos)
## # caso Cherán
## sel <- which(dat$dusos==1 & dat$edon==16)
## dat$munn[sel]
## sel <- which(dat$edon==16 & dat$munn==24)
## dat[sel, c("yr","efec","status")]
## # drop uyc
## sel <- which(dat$dusos==1)
## table(dat$v01[sel]==0) # all report no votes?
## dat <- dat[-sel,]

#########################################################
## ################################################### ##
## ## Export a coalAgg version of votes returns to  ## ##
## ## the same directory where aymu1979-present.csv ## ##
## ################################################### ##
#########################################################
sel <- dat$yr>=1989
dat <- dat[sel,] # drop early years
dat$nr <- dat$nulos <- dat$tot <- dat$fuente <- NULL # drop void ballots and other columns
dat$ord <- 1:nrow(dat)
write.csv(dat, file = "aymu1989-present.coalAgg.csv", row.names = FALSE)

save.image(file = "tmp1.RData")

rm(list = ls())
dd <- "/home/eric/Desktop/MXelsCalendGovt/elecReturns/data/"
setwd(dd)
load(file = "tmp1.RData")

#########################################################
## ################################################### ##
## ## Export splitCoal version of votes returns to  ## ##
## ## the same directory where aymu1979-present.csv ## ##
## ################################################### ##
#########################################################
sel <- which(dat.split$yr>=1989)
dat.split <- dat.split[sel,] # drop early years
dat.split <- dat.split[order(dat.split$emm),] # sort emm
#
################################################################
## manipulate coalitions remaining in split vote object       ##
## these should all be cases where no vote split is available ##
################################################################
sel.l <- grep("^l[0-9]{2}", colnames(dat.split))
l <- dat.split[,sel.l] # subset label columns
sel.v <- grep("^v[0-9]{2}", colnames(dat.split))
v <- dat.split[,sel.v] # subset vote columns
# need to manipulate indicator: dummy had at least one coalition
dat.split$dhascoal <- rep(0, nrow(dat.split))
for (i in 1:ncol(l)){
    dat.split$dhascoal[grep("-", l[,i])] <- 1
}
table(dat.split$dhascoal)
#
# function manipulate cases by hand: select state-year function grants all joint votes to party reported first in label
by.hand <- function(edo.cyc = NA){ # example: edo.cyc = "ags-12"
    sel <- grep(edo.cyc, dat.split$emm)
    for (i in 1:ncol(l)){
        #i <- 2
        l[sel,i] <- sub("^([a-z]+)[-].+$", "\\1", l[sel,i]) # keeps first pty in coal label
    }
    dat.split[sel,sel.l] <- l[sel,] # return manipulated labels to data
    dat.split$dhascoal[sel] <- 0 # reset indices
    return(dat.split)
}
#
# manipulate cases where source offers no clue about intra-coal vote split --- all votes to 1st pty listed
dat.split <- by.hand("ags-12")
dat.split <- by.hand("ags-13")
dat.split <- by.hand("bc-11")
dat.split <- by.hand("bc-12")
dat.split <- by.hand("bc-13")
dat.split <- by.hand("bc-14")
dat.split <- by.hand("bc-15")
dat.split <- by.hand("bcs-10")
dat.split <- by.hand("bcs-11")
dat.split <- by.hand("bcs-12")
dat.split <- by.hand("bcs-13")
dat.split <- by.hand("bcs-14")
dat.split <- by.hand("bcs-15")
dat.split <- by.hand("cam-11")
dat.split <- by.hand("cam-13")
dat.split <- by.hand("cam-14")
dat.split <- by.hand("cam-15")
dat.split <- by.hand("coa-08")
dat.split <- by.hand("coa-10") # 1999 pan-prd to pan
dat.split <- by.hand("col-11")
dat.split <- by.hand("col-13")
dat.split <- by.hand("col-14")
dat.split <- by.hand("col-15")
dat.split <- by.hand("cps-11")
dat.split <- by.hand("cps-12") # 2004 prd-pan to prd
dat.split <- by.hand("cps-13")
dat.split <- by.hand("cps-14")
dat.split <- by.hand("cps-15")
dat.split <- by.hand("cps-16")
dat.split <- by.hand("cps-17a")
dat.split <- by.hand("cua-11") # 2001 pan-prd to pan
dat.split <- by.hand("cua-12") # 2004 pan-prd to pan pri-pvem to pri
dat.split <- by.hand("cua-13") # 2007 pri-pna to pri
dat.split <- by.hand("cua-14") # 2010 pri-pvem-pna to pri
dat.split <- by.hand("cua-15") # 2013 pri-pvem-pna to pri
dat.split <- by.hand("cua-16") # 2016 pri-pvem-pna to pri
dat.split <- by.hand("df-11") # 2000 pan-pvem to pan
dat.split <- by.hand("dgo-11") # 2000 pt-prd to pt
dat.split <- by.hand("dgo-13") # 2007 pri-pna to pri pt-c to pt
dat.split <- by.hand("dgo-14") # 2010 pri-pvem-pna to pri
dat.split <- by.hand("dgo-15") # 2013 pri-pvem-pna to pri
dat.split <- by.hand("dgo-16") # 2016 pri-pvem-pna to pri
dat.split <- by.hand("gua-11") # 2000 prd-pt-ps to prd
dat.split <- by.hand("gua-13") # 2006 prd-pt to prd
dat.split <- by.hand("gue-09") # 1996 pps-c to pps
dat.split <- by.hand("gue-11") # 2002 prd-pt to prd
dat.split <- by.hand("gue-12") # 2005 prd-prs to prd
dat.split <- by.hand("gue-13") # 2008 pri-pvem to pri c-pt to c
dat.split <- by.hand("gue-14") # 2012 pri-pvem to pri prd-pt-c to prd
dat.split <- by.hand("gue-16") # 2018 prd-mc to prd
dat.split <- by.hand("hgo-11") # 2002 pri-pvem to pri
dat.split <- by.hand("hgo-13") # 2008 pri-pna to pri
dat.split <- by.hand("hgo-14") # 2011 pt-conve to pt
dat.split <- by.hand("jal-13") # 2006 prd-pt to prd
dat.split <- by.hand("jal-15") # 2012 pt-mc to pt
dat.split <- by.hand("mex-12") # 2006 pri-pvem to pri
dat.split <- by.hand("mex-14") # 2012 pt-mc to pt
dat.split <- by.hand("mic-11") # 2001 prd+5 to prd
dat.split <- by.hand("mic-12") # 2004 pri-prd to pri
dat.split <- by.hand("mic-13") # 2007 prd-pt-conve to prd
dat.split <- by.hand("mic-14") # 2011 prd-pt to prd
dat.split <- by.hand("mic-15") # 2015 prd-pt to prd
dat.split <- by.hand("mor-09") # 1994 pps-pt to pps
dat.split <- by.hand("mor-13") # 2006 prd-pt-c to prd
dat.split <- by.hand("nay-09") # 1996 pps-oth to pps
dat.split <- by.hand("nay-13") # 2008 pri-pna to pri prd-pvem to prd
dat.split <- by.hand("nay-14") # 2011 pri-pvem-pna to pri
dat.split <- by.hand("nay-15") # 2014 pri-pvem-pna to pri
dat.split <- by.hand("nl-10") # 1997 prd-pvem to prd
dat.split <- by.hand("nl-11") # 2000 prd-oth to prd
dat.split <- by.hand("nl-12") # 2003 pri-pvem to pri
dat.split <- by.hand("nl-13") # 2006 pri-pvem to pri
dat.split <- by.hand("nl-14") # 2009 pri-pvem to pri
dat.split <- by.hand("nl-15") # 2012 pri-pvem to pri
dat.split <- by.hand("pue-13") # 2007 pri-pvem to pri prd-mc to prd
dat.split <- by.hand("pue-14") # 2010 pri-pvem to pri
dat.split <- by.hand("pue-15") # 2013 pri-pvem to pri
dat.split <- by.hand("que-11") # 2000 pt-conve-psn to pt
dat.split <- by.hand("que-12") # 2003 pri-pvem to pri
dat.split <- by.hand("que-13") # 2006 pri-pvem to pri
dat.split <- by.hand("que-14") # 2009 pri-pna to pri
dat.split <- by.hand("que-15") # 2012 pri-pvem-pna to pri
dat.split <- by.hand("qui-13.009") # 2009 tulum--new pri-pvem to pri
dat.split <- by.hand("qui-15") # 2013 pri-pvem-pna to pri
dat.split <- by.hand("san-11") # 2000 prd-etc to prd
dat.split <- by.hand("san-12") # 2003 pri-pvem to pri
dat.split <- by.hand("sin-11") # 2001 pt-pas to pt
dat.split <- by.hand("sin-13") # 2007 pri-pna to pri
dat.split <- by.hand("sin-15") # 2013 pri-pvem-pna to pri
dat.split <- by.hand("son-12") # 2003 pas-mexpos to pas
dat.split <- by.hand("son-13") # 2006 pri-pna to pri
dat.split <- by.hand("son-14") # 2009 pri-pvem to pri (except few cases where pvem nominated in 2006)
dat.split <- by.hand("son-15.029") # 2012 pri-pvem to pri
dat.split <- by.hand("son-15.030") # 2012 pri-pvem to pri
dat.split <- by.hand("tam-08") # 1992 pan-prd to pan
dat.split <- by.hand("tam-11.021") # 2001 pt-pvem to pt
dat.split <- by.hand("tam-11.032") # 2001 pt-pvem-pas-local to pt
dat.split <- by.hand("tam-13") # 2007 pri-pna to pri
dat.split <- by.hand("tam-14") # 2010 pri-pna or pri-pvem-pna to pri
dat.split <- by.hand("tam-15") # 2013 pri-pvem-pna to pri
dat.split <- by.hand("tla-11.016") # 2002 pt-oth to pt
dat.split <- by.hand("tla-11.044") # 2002 pas-loc to pas
dat.split <- by.hand("tla-12") # 2004 pri-pvem to pri
dat.split <- by.hand("tla-13") # 2007 pri-pvem to pri pan-pac to pan
dat.split <- by.hand("tla-14") # 2010 pri-pvem to pri pan-panal-pac to pan
dat.split <- by.hand("tla-15") # 2013 pt-pac to pt pvem-ps to pvem
dat.split <- by.hand("tla-16") # 2016 pvem-ps to pvem
dat.split <- by.hand("ver-11") # 2000 pri-chicos to pri
dat.split <- by.hand("yuc-11") # 2001 pt-conve to pt
dat.split <- by.hand("yuc-13") # 2007 pt-conve to pt
dat.split <- by.hand("yuc-16") # 2015 pes-ph to pes
#
table(dat.split$dhascoal)
# drop little-use columns
dat.split$dhascoal <- dat.split$dcoal <- NULL
dat.split$ord <- dat.split$fuente <- NULL
dat.split$tot <- dat.split$nr <- dat.split$nulos <- NULL
#
## # debug
## tmp <- dat.split[dat.split$dhascoal==1,]; i <- 1
## tmp[i,]
## tmp[i,grep("^l[0-9]{2}", colnames(dat.split))]
## tmp$emm[i]
## tmp$yr[i]
## #
## pat <- "sin-13.018"
## tmp2 <- dat.split[grep(pat, dat.split$emm), grep("^[lv][0-9]{2}", colnames(dat.split))]
## #tmp2
## round(tmp2$v02/(tmp2$v02+tmp2$v05), 3) - .001
## table(dat.split$dhascoal)
# save
write.csv(dat.split, file = "aymu1989-present.coalSplit.csv", row.names = FALSE)

## # save coalition weights and info
## save(coal.weights # list with total vote
##    , coal.info # data frame with coalitions
##      , file = "aymu1989-present.coalAgg-weights-info.RData")
## coal.weights[100]
## coal.info[100,]
## dat.orig[100,]


setwd("P:/2019 0970 151 000/User Data/Faraz-Export IDAVE folders/Models2.5")
library(tidyverse)
library(h2o)
library(inspectdf)
tabna <- function(x){table(x, useNA = "ifany")}
dfx <- readRDS("./dfx_v2.5.rds")

h2o.init()
dfx %>% inspect_na() %>% print(n=10)
dfx <- drop_na(dfx)

####

features <- read.csv("mutualInfo_features.csv")
features$X <- levels(features$X)[features$X]
names(features)[1:2] <- c("predictor", "mutInf")
features[grep("^flag", features$predictor), "is_ed"] <- FALSE
features[grep("^patserv", features$predictor), "is_ed"] <- FALSE
features[
which(features$predictor %in% c("acutelos", "scu", "prior_hosp_90d",
"prior_hosp_365d", "readm_90d")), "is_ed"] <- FALSE
features[is.na(features$is_ed), "is_ed"] <- TRUE

# sum(features$is_ed)
# [1] 37
# sum(features$is_ed[1:40])
# [1] 21

sel_feat_ed_small <- features[1:40,] %>% filter(is_ed) %>% .$predictor
sel_feat_ed_big <- features %>% filter(is_ed) %>% .$predictor
sel_feat <- features[1:40,] %>% .$predictor

####

df.hex  <- as.h2o(dfx)
# Now that we have our tuned model and parameters, we train the models on the train sample and test
# on the hold-out test sample
df.split <- h2o.splitFrame(df.hex, ratios = c(0.8), seed = 1234)
train <- df.split[[1]]
test <- df.split[[2]] #unseen data

df.split_valid <- h2o.splitFrame(train, ratios = c(0.8), seed = 1234)

####
#NAIVE BAYES####
####
t <- Sys.time()
naive1 <- h2o.naiveBayes(
model_id = "naiveBayes_1",
x = c( "main_PhysInj_1L" ,   "admambul"  ),
y = "alc_status",
training_frame = df.split_valid[[1]],
validation_frame = df.split_valid[[2]],
balance_classes = TRUE,
laplace = 0,
seed = 1234)

cat("time elapsed for model training: ",  difftime(Sys.time(), t, unit = "hour"), "hours \n")

svm1 <- h2o.psvm(
model_id = "SVM_1",
x = sel_feat_ed_small,
y = "alc_status",
training_frame = df.split_valid[[1]],
validation_frame = df.split_valid[[2]],
gamma = 0.01,
rank_ratio = 0.1,
seed = 1234)


#-----------------------------------#
# LA variation caterpillar plots ----
#-----------------------------------#

library(dplyr)
library(ggplot2)
library(ggsci)

lavar_cat_plot <- function(data, var, var_lbl,pal) {
  eval(data)

  dat <- data %>%
    rename(var_unquo = var) %>%
    group_by(la_code) %>%
    mutate(mean_pct = mean(var_unquo),
           y_min = mean(var_unquo) - sd(var_unquo),
           y_max = mean(var_unquo) + sd(var_unquo)) %>%
    ungroup() %>%
    distinct(la_code, .keep_all = TRUE) %>%
    arrange(mean_pct, la_code) %>%
    mutate(id = row_number(),
           mean_tot = mean(mean_pct))

  p <- ggplot(data = dat, aes(x = id, y = mean_pct, colour = region_name)) +
    geom_point() +
    geom_errorbar(aes(ymin = y_min, ymax = y_max), width = 0.75) +
    geom_hline(aes(yintercept = mean_tot, linetype = "English average")) +
    theme_classic() +
    scale_x_continuous("Local Authority", breaks = seq(1,max(dat$id), by = 1)) +
    scale_color_manual("Region", values = pal) +
    ylab(var_lbl) +
    scale_linetype_manual("", values = "dashed") +
    theme(axis.text.x = element_blank(),
          axis.title = element_text(size = 14),
          axis.ticks.x = element_blank(),
          axis.text = element_text(size = 12),
          legend.text = element_text(size = 14),
          legend.title = element_text(size = 14))

  return(p)
}

#---------------------------------------#
# ARAs over time - caterpillar plots ----
#---------------------------------------#

xlims <- c(1,149)

# Get colour palette:
cbPal <- c("#1F78B4",  "#D95F02", "#1B9E77", "#7570B3",  "#66A61E", "#E7298A", "#E6AB02", "#FB9A99", "#666666")

# Create caterpillar plot:
cat_plot <-
lavar_cat_plot(data    = analysis_dat, var = "any_ara_pct",
               var_lbl = "% of live births where \nmother had a history of ARA", pal = cbPal) +
  labs(title    = "Average % of live-births with maternal history of adversity, by local authority (2006/7 - 2013/14)",
       subtitle = "Mean % with +/- standard deviation error bars for each local authority, compared to England mean (black, dashed line)") +
  ylab("Percentage\nof\nlive births") +
  xlab("Local authority") +
  theme(axis.line.x  = element_blank(),
        axis.title.y = element_text(size = 11, angle = 0, vjust = 0.5),
        axis.title.x = element_text(size = 11),
        axis.text    = element_text(size = 11),
        legend.text  = element_text(size = 11),
        legend.title = element_text(size = 11))

# add barchart underneath:
bar_dat <-
analysis_dat %>%
  group_by(la_code) %>%
  mutate(mean_pct = mean(any_ara_pct),
         y_min    = mean(any_ara_pct) - sd(any_ara_pct),
         y_max    = mean(any_ara_pct) + sd(any_ara_pct)) %>%
  ungroup() %>%
  distinct(la_code, .keep_all = TRUE) %>%
  arrange(mean_pct, la_code) %>%
  mutate(id = row_number())

bar_plot <-
ggplot(data = bar_dat,
       aes(x = id, y = n_mother/100000, fill = region_name)) +
  geom_col() +
  scale_fill_manual(values = cbPal) +
  guides(fill = "none") +
  theme_classic() +
  xlab("") +
  ylab("Number\nof\nlive births") +
  theme(axis.line.y = element_blank(),
        axis.title.y = element_text(size = 11, angle = 0, vjust = 0.5),
        axis.ticks = element_blank(),
        axis.line.x.bottom = element_blank(),
        axis.text = element_text(size = 12))

# plot cat_plot and bar_plot together:
ggarrange(ggplotGrob(cat_plot),
          gtable_add_cols(ggplotGrob(bar_plot), unit(rep(1,2), "null")),
          ncol =1, nrow = 2, align = "v",
          heights = c(3,0.5))

ggsave("N:/Documents/Data & Programming/outputs/la variation/figures/ara_catplot.png",
       units  = "mm",
       height = 200,
       width  = 290)


#-------------------------------------------------
# manual colors
#-------------------------------------------------

colors = c("val1"="red", "val2"="darkgreen")
scale_color_manual(values=colors)

#-------------------------------------------------
# labels
#-------------------------------------------------

# https://ggplot2.tidyverse.org/reference/geom_text.html
# centered above, y in y-units
geom_label(aes(label=value), vjust=0, nudge_y=2000) +

#-------------------------------------------------
# color brewer
#-------------------------------------------------

# https://colorbrewer2.org/
library(RColorBrewer)

# base plot...
col=brewer.pal(8, "Set3")

# show bunch of palettes
display.brewer.all()
# show specific palette
display.brewer.pal(5, "Greens")

# ggplot2
+ scale_color_brewer(palette="Greens")

#-------------------------------------------------
# typical geom_point values
#-------------------------------------------------

geom_point(.., show.legend=FALSE, alpha=0.4, size=2.5, stroke=0) +

#-------------------------------------------------
# types of lines
#-------------------------------------------------

# http://www.cookbook-r.com/Graphs/Shapes_and_line_types/
linetype="dashed"

#-------------------------------------------------
# horizontal jitter (20%), no-vertical jitter
#-------------------------------------------------

geom_jitter(height=0, width=0.2, ...)

#-------------------------------------------------
# rotated x-axis labels
#-------------------------------------------------

theme(
  axis.text.x = element_text(angle=-90)
)

#-------------------------------------------------
# customized datetime x-axis
#-------------------------------------------------

scale_x_datetime(breaks=date_breaks("week"), labels=date_format("%m/%d"))

# details from: ?strptime
# %b / %B -- short/full month
# %F -- %Y-%m-%d
# %T -- %H:%M:%S

#-------------------------------------------------
# HTML table for tibbles
#-------------------------------------------------

library(kableExtra)

knitr::kable() %>%
kable_styling(bootstrap_options=c("striped", "hover"), full_width=FALSE, position="left")

#-------------------------------------------------
# ordered horizontal bar-charts
#-------------------------------------------------

d %>%
  count(whatever, sort=TRUE) %>%
  ggplot(aes(reorder(whatever, n), n)) +
  geom_col() +
  coord_flip() +
  NULL

#-------------------------------------------------
# alpha density
#-------------------------------------------------

d$density = fields::interp.surface(MASS::kde2d(d$date, d$duration),
                                   as.data.frame(d[,c("date","duration")]))

# alpha=1/density  ... or
# alpha=sqrt(1/density)

#-------------------------------------------------
# Rmd: asis block
#-------------------------------------------------

```{r, results="asis"}

cat("\n\n## ", header, "\n\n")

```

#-------------------------------------------------
# Rmd: section with tabs
#-------------------------------------------------

## Header {.tabset}
### Tab1
### Tab2
### Tab3


library(ngram)

str <- "A B A C A B B"

### Construct ngrams
ng <- ngram(str, n=2)

### Print
ng
print(ng, output="truncated")

### Generate nonesense
babble(ng, 10)


#!/usr/bin/Rscript

<<<<<<< HEAD
# to customize
datadir <- "~/data/eagle_T2D_without_combined/"
=======
# to customize: input data
inputdir <- c(
              "experiment/eagle_T2D_3/data/",
              "experiment/eagle_T2D_3_multiplier_downto_8/data/",
              "experiment/eagle_T2D_3_MaxN_downto_50/data/",
              "experiment/eagle_T2D_3_MaxN_downto_42/data/",
              "experiment/eagle_T2D_3_Taylor_downto_8/data/",
              "experiment/eagle_T2D_3_Taylor_to_12/data/"
              )
>>>>>>> 2593628... Plot multiple experiments simultaneously

for(datadir in inputdir){
  #datadir <- "experiment/eagle_T2D_3_Taylor_downto_8/data/"

<<<<<<< HEAD
# plot accuracy
png(paste(datadir, "accuracy.png", sep=""))
## absolute error
plot(mydata[, 3],
     type="l",
     #xlim=c(1, experiment_indices),
     main="error of secure meta-analysis",
     xlab="index of experiment",
     ylab="error of secure meta-analysis",
     col="blue")

## relative error
lines(mydata[, 4],
      col="red")
=======
  mydata <- read.csv(paste(datadir, "final_result.csv", sep=""), skip=1)
  experiment_indices=34

  # plot accuracy
  svg(paste(datadir, "accuracy.svg", sep=""),
      width=8, height=6)
  ## absolute error
  plot(mydata[, 3],
       #type="l",
       #xlim=c(1, experiment_indices),
       main="error of secure meta-analysis",
       xlab="experiment index",
       ylab="error",
       pch=22,
       col="blue")

  ## relative error
  points(mydata[, 4],
         pch=20,
        col="red")
>>>>>>> 2593628... Plot multiple experiments simultaneously

  legend("topright",
         legend=c("absolute error", "relative error"),
         col=c("blue", "red"),
         #ncol=2,
         cex=0.8,
         #bty="n",
         lwd=2)

  # Plot relative error separately
  svg(paste(datadir, "accuracy_relative.svg", sep=""),
      width=8, height=6)
  plot(mydata[, 4],
       main="relative error of secure meta-analysis",
       xlab="experiment index",
       ylab="relative error",
       pch=20,
       col="red")

<<<<<<< HEAD
## plot runtime (over all experiments)
png(paste(datadir, "runtime_SMC_and_division.png", sep=""))
plot((mydata[, 8] + mydata[, 7]),
     col="blue",
     #xlim=c(1, experiment_indices),
     main="runtime of different experiments",
     xlab="index of experiment",
     ylab="runtime (seconds)",
     type="l")

## plot runtime breakdown
mytime <- read.csv(paste(datadir, "division_time_breakdown.csv", sep=""), skip=2)

png(paste(datadir, "runtime_lnx_breakdown_for_numerator.png", sep=""))
barplot(t(data.frame(mytime[, 2:3])),
        col=c("blue", "red"),
        legend.text=c("Fairplay", "poly. eval."),
        args.legend=list(x="center"),
        main="ln(x) runtime breakdown for numerator"
        )

png(paste(datadir, "runtime_lnx_breakdown_for_denominator.png", sep=""))
barplot(t(data.frame(mytime[, 4:5])),
        col=c("blue", "red"),
        legend.text=c("Fairplay", "poly. eval."),
        args.legend=list(x="center"),
        main="ln(x) runtime breakdown for denominator"
        )
=======
  ## plot runtime (over all experiments)
  svg(paste(datadir, "runtime_total.svg", sep=""),
      width=8, height=6)
  plot((mydata[, 8] + mydata[, 7]),
       col="blue",
       #xlim=c(1, experiment_indices),
       main="runtime of different experiments",
       xlab="index of experiment",
       #type="l",
       ylab="runtime (seconds)")

  ## plot runtime breakdown
  mytime <- read.csv(paste(datadir, "division_time_breakdown.csv", sep=""), skip=1)

  svg(paste(datadir, "runtime_breakdown_of_lnx_for_numerator.svg", sep=""),
      width=10, height=6)
  barplot(t(data.frame(mytime[0:420, 2:3])),
          col=c("cyan", "red"),
          xlab="experiment index",
          ylab="runtime breakdown",
          ylim=c(0, 25000),
          legend.text=c("Fairplay", "Taylor expansion"),
          args.legend=list(x="center"),
          main="ln(x) runtime breakdown for numerator"
          )

  svg(paste(datadir, "runtime_breakdown_of_lnx_for_denominator.svg", sep=""),
             width=10, height=6)
  barplot(t(data.frame(mytime[0:420, 4:5])),
          col=c("cyan", "red"),
          xlab="experiment index",
          ylab="runtime breakdown",
          ylim=c(0, 25000),
          legend.text=c("Fairplay", "Taylor expansion"),
          args.legend=list(x="center"),
          main="ln(x) runtime breakdown for denominator"
          )
>>>>>>> 2593628... Plot multiple experiments simultaneously

  # close output
  dev.off()
}


#!/usr/bin/env Rscript

timeCol = "time"

args <- commandArgs(TRUE)
requiredArgCount = 1
if(length(args) < requiredArgCount) {
	cat(sprintf("Expected %d arguments!\n", requiredArgCount))
	q(status=1)
}

X <- read.csv(args[1])

result = ceiling(sum(X[[timeCol]]) / 1000.0)

cat(sprintf("%d\n", result))