score <- function(input) {
    var0 <- subroutine0(input)
    var1 <- subroutine1(input)
    var2 <- subroutine2(input)
    var3 <- subroutine3(input)
    var4 <- subroutine4(input)
    var5 <- subroutine5(input)
    var6 <- subroutine6(input)
    var7 <- subroutine7(input)
    var8 <- subroutine8(input)
    var9 <- subroutine9(input)
    var10 <- subroutine10(input)
    var11 <- subroutine11(input)
    var12 <- subroutine12(input)
    var13 <- subroutine13(input)
    var14 <- subroutine14(input)
    var15 <- subroutine15(input)
    var16 <- subroutine16(input)
    var17 <- subroutine17(input)
    var18 <- subroutine18(input)
    var19 <- subroutine19(input)
    var20 <- subroutine20(input)
    var21 <- subroutine21(input)
    var22 <- subroutine22(input)
    var23 <- subroutine23(input)
    var24 <- subroutine24(input)
    var25 <- subroutine25(input)
    var26 <- subroutine26(input)
    var27 <- subroutine27(input)
    var28 <- subroutine28(input)
    var29 <- subroutine29(input)
    var30 <- subroutine30(input)
    var31 <- subroutine31(input)
    var32 <- subroutine32(input)
    var33 <- subroutine33(input)
    var34 <- (var21) * (-29.893441720221567)
    return(c((((((((((((((((((((((-0.10040896360166912) + ((var0) * (-0.0))) + ((var1) * (-0.0))) + ((var2) * (-0.41839590533727394))) + ((var3) * (-0.0))) + ((var4) * (-0.04143676373258231))) + ((var5) * (-0.41839590533727394))) + ((var6) * (-0.41839590533727394))) + ((var7) * (-0.0))) + ((var8) * (-0.09370933375375942))) + ((var9) * (-0.021427693031370827))) + ((var10) * (-0.19906272901896646))) + ((var11) * (-0.41839590533727394))) + ((var12) * (0.01790941942476885))) + ((var13) * (0.19838472644676905))) + ((var14) * (0.41839590533727394))) + ((var15) * (0.0))) + ((var16) * (0.41839590533727394))) + ((var17) * (0.13934237366514107))) + ((var18) * (0.0))) + ((var19) * (0.41839590533727394))) + ((var20) * (0.41839590533727394)), ((((((((((((((((((((((-0.18554309515982967) + ((var21) * (-0.06950455855790763))) + ((var22) * (-0.0))) + ((var23) * (-0.04843045931251089))) + ((var24) * (-0.0))) + ((var25) * (-0.3538789357824905))) + ((var26) * (-0.0609756100198299))) + ((var27) * (-0.11288644645628641))) + ((var28) * (-0.3538789357824905))) + ((var29) * (-0.30936738135098624))) + ((var30) * (-0.3538789357824905))) + ((var31) * (-0.0))) + ((var32) * (-0.08889946907833211))) + ((var33) * (-0.0))) + ((var12) * (0.14642472878044094))) + ((var13) * (0.11750372941413528))) + ((var14) * (0.3538789357824905))) + ((var15) * (0.3538789357824905))) + ((var16) * (0.0))) + ((var17) * (0.0722565307987864))) + ((var18) * (0.3538789357824905))) + ((var19) * (0.3538789357824905))) + ((var20) * (0.0)), (((((((((((((((((((((((((0.5039648533253523) + (var34)) + ((var22) * (-29.893441720221567))) + ((var23) * (-0.0))) + ((var24) * (-23.66820011477251))) + ((var25) * (-0.0))) + ((var26) * (-0.0))) + ((var27) * (-0.0))) + ((var28) * (-7.128872495868185))) + ((var29) * (-19.888600728398526))) + ((var30) * (-0.4282859091720985))) + ((var31) * (-5.683580020209366))) + ((var32) * (-0.0))) + ((var33) * (-29.893441720221567))) + ((var0) * (15.40619227503478))) + ((var1) * (11.497905273164342))) + ((var2) * (0.0))) + ((var3) * (29.893441720221567))) + ((var4) * (29.893441720221567))) + ((var5) * (0.0))) + ((var6) * (0.0))) + ((var7) * (29.893441720221567))) + ((var8) * (29.893441720221567))) + ((var9) * (0.0))) + ((var10) * (0.0))) + ((var11) * (0.0))))
}
subroutine0 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((5.4) - (input[1])) ^ (2)) + (((3.0) - (input[2])) ^ (2))) + (((4.5) - (input[3])) ^ (2))) + (((1.5) - (input[4])) ^ (2)))))
}
subroutine1 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((6.2) - (input[1])) ^ (2)) + (((2.2) - (input[2])) ^ (2))) + (((4.5) - (input[3])) ^ (2))) + (((1.5) - (input[4])) ^ (2)))))
}
subroutine2 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((5.0) - (input[1])) ^ (2)) + (((2.3) - (input[2])) ^ (2))) + (((3.3) - (input[3])) ^ (2))) + (((1.0) - (input[4])) ^ (2)))))
}
subroutine3 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((5.9) - (input[1])) ^ (2)) + (((3.2) - (input[2])) ^ (2))) + (((4.8) - (input[3])) ^ (2))) + (((1.8) - (input[4])) ^ (2)))))
}
subroutine4 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((6.7) - (input[1])) ^ (2)) + (((3.0) - (input[2])) ^ (2))) + (((5.0) - (input[3])) ^ (2))) + (((1.7) - (input[4])) ^ (2)))))
}
subroutine5 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((7.0) - (input[1])) ^ (2)) + (((3.2) - (input[2])) ^ (2))) + (((4.7) - (input[3])) ^ (2))) + (((1.4) - (input[4])) ^ (2)))))
}
subroutine6 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((4.9) - (input[1])) ^ (2)) + (((2.4) - (input[2])) ^ (2))) + (((3.3) - (input[3])) ^ (2))) + (((1.0) - (input[4])) ^ (2)))))
}
subroutine7 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((6.3) - (input[1])) ^ (2)) + (((2.5) - (input[2])) ^ (2))) + (((4.9) - (input[3])) ^ (2))) + (((1.5) - (input[4])) ^ (2)))))
}
subroutine8 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((6.0) - (input[1])) ^ (2)) + (((2.7) - (input[2])) ^ (2))) + (((5.1) - (input[3])) ^ (2))) + (((1.6) - (input[4])) ^ (2)))))
}
subroutine9 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((5.7) - (input[1])) ^ (2)) + (((2.6) - (input[2])) ^ (2))) + (((3.5) - (input[3])) ^ (2))) + (((1.0) - (input[4])) ^ (2)))))
}
subroutine10 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((6.9) - (input[1])) ^ (2)) + (((3.1) - (input[2])) ^ (2))) + (((4.9) - (input[3])) ^ (2))) + (((1.5) - (input[4])) ^ (2)))))
}
subroutine11 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((5.1) - (input[1])) ^ (2)) + (((2.5) - (input[2])) ^ (2))) + (((3.0) - (input[3])) ^ (2))) + (((1.1) - (input[4])) ^ (2)))))
}
subroutine12 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((5.1) - (input[1])) ^ (2)) + (((3.8) - (input[2])) ^ (2))) + (((1.9) - (input[3])) ^ (2))) + (((0.4) - (input[4])) ^ (2)))))
}
subroutine13 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((4.4) - (input[1])) ^ (2)) + (((2.9) - (input[2])) ^ (2))) + (((1.4) - (input[3])) ^ (2))) + (((0.2) - (input[4])) ^ (2)))))
}
subroutine14 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((5.7) - (input[1])) ^ (2)) + (((4.4) - (input[2])) ^ (2))) + (((1.5) - (input[3])) ^ (2))) + (((0.4) - (input[4])) ^ (2)))))
}
subroutine15 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((5.8) - (input[1])) ^ (2)) + (((4.0) - (input[2])) ^ (2))) + (((1.2) - (input[3])) ^ (2))) + (((0.2) - (input[4])) ^ (2)))))
}
subroutine16 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((5.1) - (input[1])) ^ (2)) + (((3.3) - (input[2])) ^ (2))) + (((1.7) - (input[3])) ^ (2))) + (((0.5) - (input[4])) ^ (2)))))
}
subroutine17 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((5.7) - (input[1])) ^ (2)) + (((3.8) - (input[2])) ^ (2))) + (((1.7) - (input[3])) ^ (2))) + (((0.3) - (input[4])) ^ (2)))))
}
subroutine18 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((4.3) - (input[1])) ^ (2)) + (((3.0) - (input[2])) ^ (2))) + (((1.1) - (input[3])) ^ (2))) + (((0.1) - (input[4])) ^ (2)))))
}
subroutine19 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((4.5) - (input[1])) ^ (2)) + (((2.3) - (input[2])) ^ (2))) + (((1.3) - (input[3])) ^ (2))) + (((0.3) - (input[4])) ^ (2)))))
}
subroutine20 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((4.8) - (input[1])) ^ (2)) + (((3.4) - (input[2])) ^ (2))) + (((1.9) - (input[3])) ^ (2))) + (((0.2) - (input[4])) ^ (2)))))
}
subroutine21 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((6.0) - (input[1])) ^ (2)) + (((3.0) - (input[2])) ^ (2))) + (((4.8) - (input[3])) ^ (2))) + (((1.8) - (input[4])) ^ (2)))))
}
subroutine22 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((6.3) - (input[1])) ^ (2)) + (((2.8) - (input[2])) ^ (2))) + (((5.1) - (input[3])) ^ (2))) + (((1.5) - (input[4])) ^ (2)))))
}
subroutine23 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((5.8) - (input[1])) ^ (2)) + (((2.8) - (input[2])) ^ (2))) + (((5.1) - (input[3])) ^ (2))) + (((2.4) - (input[4])) ^ (2)))))
}
subroutine24 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((6.1) - (input[1])) ^ (2)) + (((3.0) - (input[2])) ^ (2))) + (((4.9) - (input[3])) ^ (2))) + (((1.8) - (input[4])) ^ (2)))))
}
subroutine25 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((7.7) - (input[1])) ^ (2)) + (((2.6) - (input[2])) ^ (2))) + (((6.9) - (input[3])) ^ (2))) + (((2.3) - (input[4])) ^ (2)))))
}
subroutine26 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((6.9) - (input[1])) ^ (2)) + (((3.1) - (input[2])) ^ (2))) + (((5.1) - (input[3])) ^ (2))) + (((2.3) - (input[4])) ^ (2)))))
}
subroutine27 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((6.3) - (input[1])) ^ (2)) + (((3.3) - (input[2])) ^ (2))) + (((6.0) - (input[3])) ^ (2))) + (((2.5) - (input[4])) ^ (2)))))
}
subroutine28 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((4.9) - (input[1])) ^ (2)) + (((2.5) - (input[2])) ^ (2))) + (((4.5) - (input[3])) ^ (2))) + (((1.7) - (input[4])) ^ (2)))))
}
subroutine29 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((6.0) - (input[1])) ^ (2)) + (((2.2) - (input[2])) ^ (2))) + (((5.0) - (input[3])) ^ (2))) + (((1.5) - (input[4])) ^ (2)))))
}
subroutine30 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((7.9) - (input[1])) ^ (2)) + (((3.8) - (input[2])) ^ (2))) + (((6.4) - (input[3])) ^ (2))) + (((2.0) - (input[4])) ^ (2)))))
}
subroutine31 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((7.2) - (input[1])) ^ (2)) + (((3.0) - (input[2])) ^ (2))) + (((5.8) - (input[3])) ^ (2))) + (((1.6) - (input[4])) ^ (2)))))
}
subroutine32 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((7.7) - (input[1])) ^ (2)) + (((3.8) - (input[2])) ^ (2))) + (((6.7) - (input[3])) ^ (2))) + (((2.2) - (input[4])) ^ (2)))))
}
subroutine33 <- function(input) {
    var0 <- (0) - (0.25)
    return(exp((var0) * ((((((6.2) - (input[1])) ^ (2)) + (((2.8) - (input[2])) ^ (2))) + (((4.8) - (input[3])) ^ (2))) + (((1.8) - (input[4])) ^ (2)))))
}


#!/usr/bin/env Rscript

source("/tmp/class-libs.R")

class_name = "2019 Fall Stat 131a"
BiocManager::install('Biobase')
class_libs = c(
  "alluvial", "0.1-2",
  "latticeExtra", "0.6-29",
  "DAAG", "1.24",
  "faraway", "1.0.7",
  "fdrtool", "1.2.16",
  "gpairs", "1.3.3",
  "gplots", "3.1.1",
  "hexbin", "1.28.1",
  "leaps", "3.1",
  "NMF", "0.23.0",
  "randomForest", "4.6-14",
  "rpart.plot", "3.0.9",
  "scatterplot3d", "0.3-41",
  "shape", "1.4.5",
  "sm", "2.2-5.6",
  "pheatmap", "1.0.12",
  "vioplot", "0.3.5"
)
class_libs_install_version(class_name, class_libs)


# 3. faza: Vizualizacija podatkov

setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
source("../lib/libraries.r", encoding="UTF-8")

# UVOD: UVRSTITVE LIVERPOOLA V PREMIER LIGI, OBDOBJE JURGENA KLOPPA

sezone_Klopp <- zgodovina_uvrstitev %>%
  filter(Sezona %in%  c("2016-17","2017-18","2018-19","2019-20","2020-21"))

zgodovina_uvrstitev_graf <- ggplot(data = zgodovina_uvrstitev, aes(x=Sezona, y=Uvrstitev, group=1)) +
  geom_point() + geom_line() + scale_y_reverse(breaks = 1*1:8) +
  theme(axis.text.x = element_text(angle = 90)) + geom_point(data=sezone_Klopp, aes(x=Sezona,y=Uvrstitev),color='red') +
  geom_line(data=sezone_Klopp, aes(x=Sezona,y=Uvrstitev),color='red') + ggtitle("Ligaske uvrstitve Liverpoola v Premier ligi (polne sezone Jurgena Kloppa rdece)")
print(zgodovina_uvrstitev_graf)
uvrstitve_Klopp <- sezone_Klopp$Uvrstitev

# ANALIZA USPESNOSTI V LIGI GLEDE NA DODATNE TEKME

vse_tekme <- c(last(rezultati2021$`Odigrane tekme`),last(rezultati1920$`Odigrane tekme`),last(rezultati1819$`Odigrane tekme`),
               last(rezultati1718$`Odigrane tekme`),last(rezultati1617$`Odigrane tekme`))
ligaske_tekme <- c(38,38,38,38,38) #v ligi je 20 mostev, torej vsako sezono po 38 tekem
st_dodatnih_tekem <- vse_tekme - ligaske_tekme #neligaske tekme - to bo x os
tocke <- c(rezultati2021$Zmage[1]*3 + rezultati2021$Remiji[1],rezultati1920$Zmage[1]*3 + rezultati1920$Remiji[1],
           rezultati1819$Zmage[1]*3 + rezultati1819$Remiji[1],rezultati1718$Zmage[1]*3 + rezultati1718$Remiji[1],
           rezultati1617$Zmage[1]*3 + rezultati1617$Remiji[1]) #to bo y os

plot(st_dodatnih_tekem,tocke, ,xlim = c(8,22), xlab = "Neligaske tekme", ylab = "tocke v ligi", main = "Uspesnost v ligi glede na dodatne tekme")
points(st_dodatnih_tekem, tocke, col="red", pch = 16)
grid()
for (i in 1:length(ligaske_tekme))
  {
  text(st_dodatnih_tekem[i]+0.5,tocke[i]+0.5, uvrstitve_Klopp[i])
  text(st_dodatnih_tekem[i]+0.70,tocke[i]-0.15, ".,")
  text(st_dodatnih_tekem[i]+1.55,tocke[i]+0.5, sezone_Klopp$Sezona[i])
}

# OBREMENJOST POZICIJ
vratarji <- nastopi1920 %>%
  filter(nastopi1920$`Igralno mesto` ==  "GK")

branilci <- nastopi1920 %>%
  filter(nastopi1920$`Igralno mesto` ==  "DF")

vezisti <- nastopi1920 %>%
  filter(nastopi1920$`Igralno mesto` ==  "MF")

napadalci <- nastopi1920 %>%
  filter(nastopi1920$`Igralno mesto` ==  "FW")

prikaz_obremenjenosti <- ggplot(data=nastopi1920, aes(x=Igralec, y=nastopi1920$"Skupaj vse tekme")) +
  theme(axis.text.x = element_text(angle = 90)) +
  geom_point(data=vratarji, aes(Igralec, vratarji$`Skupaj vse tekme`), color="blue") +
  geom_point(data=branilci, aes(Igralec, branilci$`Skupaj vse tekme`), color="red") +
  geom_point(data=vezisti, aes(Igralec, vezisti$`Skupaj vse tekme`), color="black") +
  geom_point(data=napadalci, aes(Igralec, napadalci$`Skupaj vse tekme`), color="green")
print(prikaz_obremenjenosti)

#izboljsava: tiste z manj kot 5 zacetimi tekmami vrzemo ven
nastopi1920mod <- nastopi1920 %>% filter(nastopi1920$`Skupaj prva postava` >= 5) #mod - modifikacija
nastopi1920mod <- nastopi1920mod[order(nastopi1920mod$`Igralno mesto`), ]
vratarjimod <- nastopi1920mod %>% filter(nastopi1920mod$`Igralno mesto` ==  "GK")
branilcimod <- nastopi1920mod %>% filter(nastopi1920mod$`Igralno mesto` ==  "DF")
vezistimod <- nastopi1920mod %>% filter(nastopi1920mod$`Igralno mesto` ==  "MF")
napadalcimod <- nastopi1920mod %>% filter(nastopi1920mod$`Igralno mesto` ==  "FW")

prikaz_obremenjenosti_mod <- ggplot(data=nastopi1920mod, aes(x=Igralec, y=nastopi1920mod$`Skupaj vse tekme`)) +
  theme(axis.text.x = element_text(angle = 90)) +
  scale_x_discrete(limits=nastopi1920mod$Igralec) +
  geom_point(data=vratarjimod, aes(Igralec, vratarjimod$`Skupaj vse tekme`), color="blue") +
  geom_point(data=branilcimod, aes(Igralec, branilcimod$`Skupaj vse tekme`), color="red") +
  geom_point(data=vezistimod, aes(Igralec, vezistimod$`Skupaj vse tekme`), color="black") +
  geom_point(data=napadalcimod, aes(Igralec, napadalcimod$`Skupaj vse tekme`), color="green") +
  geom_point(data=vratarjimod, aes(Igralec, vratarjimod$`Skupaj prva postava`), color="blue", pch=2) +
  geom_point(data=branilcimod, aes(Igralec, branilcimod$`Skupaj prva postava`), color="red", pch=2) +
  geom_point(data=vezistimod, aes(Igralec, vezistimod$`Skupaj prva postava`), color="black", pch=2) +
  geom_point(data=napadalcimod, aes(Igralec, napadalcimod$`Skupaj prva postava`), color="green", pch=2) +
  ggtitle("Pregled nastopov v sezoni 2019-20") + xlab("Igralci") + ylab("Stevilo odigranih tekem")
print(prikaz_obremenjenosti_mod)

#####################################
## ZEMLJEVID ZASTOPANOSTI DRZAV V SAMPIONSKI SEZONI 2019/20

igralci1920$Igralec[6] <- "Virgil van Dijk"
igralci1920$Igralec[17] <- "Georginio Wijnaldum"
igralci1920$Igralec[18] <- "James Milner"
igralci1920$Igralec[20] <- "Jordan Henderson"
igralci1920$Narodnost[4] <- "Ireland"

uk <- function(niz){
  if (niz == "Scotland" || niz == "Wales" || niz == "England" || niz == "Northern Ireland"){
    niz = "United Kingdom"
  }
  return(niz)
}
igralci2021$Narodnost <- sapply(igralci2021$Narodnost,uk)
igralci1920$Narodnost <- sapply(igralci1920$Narodnost,uk)
igralci1819$Narodnost <- sapply(igralci1819$Narodnost,uk)
igralci1718$Narodnost <- sapply(igralci1718$Narodnost,uk)
igralci1617$Narodnost <- sapply(igralci1617$Narodnost,uk)

#data("World")
#igralci1920$igralcidrzave <- igralci1920$Narodnost
#Pri vsaki drzavi naredim vektor igralcev - narediti s funkcijo:, ki preisce
#drzave v tabeli igralci1920 in doda v nov stolpec igralce iste drzave.
#sleparim, ker take funkcije ne znam narediti - naredim rocno samo za brazilijo
#NE DELA: tmp3 <- aggregate(label~igralci1920$Narodnost, sample, paste, collapse=" ")
#igralci1920$igralcidrzave[1] <- "Alisson, Fabinho, Roberto Firmino"
#igralci1920$igralcidrzave[16] <- "Alisson, Fabinho, Roberto Firmino"
#igralci1920$igralcidrzave[26] <- "Alisson, Fabinho, Roberto Firmino"
#tmp1 <- igralci1920 %>% select('Narodnost', 'igralcidrzave')
#tmp2 <- merge(y = tmp1,x = World, by.x= 'sovereignt', by.y = 'Narodnost')

#data("World")
#tmap_mode('view')
#zemljevid_1920 <- function(){
#  World <- tm_shape(tmp2) + tm_fill('sovereignt', popup.vars="igralcidrzave", legend.show=FALSE)
  #v tm_shape vzamemo tmp2, da obarva le izbrane drzave
#  return(World)
#}
#data("World")
#tmap_mode('view')
#zemljevid_1920 <- function(){
#  tmp1 <- igralci1920 %>% select('Narodnost', 'Igralec')
#  tmp2 <- merge(y = tmp1,x = World, by.x= 'sovereignt', by.y = 'Narodnost')
#  World <- tm_shape(tmp2) + tm_fill('sovereignt', popup.vars=c("Igralec"), legend.show=FALSE)
  #v tm_shape vzamemo tmp2, da obarva le izbrane drzave
#  return(World)
#}
#print(zemljevid_1920())
########################################

# KARTONI - PRIMERJAVA LIVERPOOL IN LIGA PO SEZONAH
kartoni_sezona <- c(sezone_Klopp$Sezona)
rumeni_liverpool <- c(last(kartoni1617$Rumeni),last(kartoni1718$Rumeni),last(kartoni1819$Rumeni),
                last(kartoni1920$Rumeni),last(kartoni2021$Rumeni))
rdeci_liverpool <- c(last(kartoni1617$Rdeci),last(kartoni1718$Rdeci),last(kartoni1819$Rdeci),
                      last(kartoni1920$Rdeci),last(kartoni2021$Rdeci))
rumeni_liga <- c(sum(liga_kartoni1617$yellow_cards)/20,sum(liga_kartoni1718$yellow_cards)/20,
                 sum(liga_kartoni1819$yellow_cards)/20,sum(liga_kartoni1920$yellow_cards)/20,
                 sum(liga_kartoni2021$yellow_cards)/20)
rdeci_liga <- c(sum(liga_kartoni1617$red_cards)/20,sum(liga_kartoni1718$red_cards)/20,
                 sum(liga_kartoni1819$red_cards)/20,sum(liga_kartoni1920$red_cards)/20,
                 sum(liga_kartoni2021$red_cards)/20)
razpredelnica_kartoni <- data.frame(kartoni_sezona,rumeni_liverpool, rdeci_liverpool,rumeni_liga,rdeci_liga)
kartoni_graf <- ggplot(data = razpredelnica_kartoni, aes(x=kartoni_sezona, y=rumeni_liverpool,group=1)) +
  geom_point(color="gold1") + geom_line(color="gold1") + geom_point(aes(x=kartoni_sezona, y=rdeci_liverpool),color="red") +
  geom_line(aes(x=kartoni_sezona, y=rdeci_liverpool),color="red") +
  geom_point(aes(x=kartoni_sezona, y=rumeni_liga),color="goldenrod4") +
  geom_line(aes(x=kartoni_sezona, y=rumeni_liga),color="goldenrod4") +
  geom_point(aes(x=kartoni_sezona, y=rdeci_liga),color="darkorchid4") +
  geom_line(aes(x=kartoni_sezona, y=rdeci_liga),color="darkorchid4") +
  ggtitle("Pregled kartonov po sezonah") + labs(x = "Sezona", y = "Stevilo kartonov")
print(kartoni_graf)


#cleaning of the data using the coercion

#uncleaned data and the values are all strings
age <- "34"
employed <- "TRUE"
salary <- "90000"

#converting them into proper formats

age_clean <- as.numeric(age)
employed_clean <- as.logical(employed)
salary_clean <- as.numeric(salary)

#printing the outputs to the console

print(age_clean, employed_clean, salary_clean)


code <- quote(
          if (n == 1) n else {
            count <- count + 1;
            n <- if (n %% 2 == 1) 3 * n + 1 else n/2
          })

eprint <- function(envs, var="n")
  cat(paste(sprintf("%4d", sapply(envs, `[[`, var)), collapse=" "), "\n")

envs <- mapply(function(...) list2env(list(...)), n=1:12, count=0)

while (any(sapply(envs, eval, expr=code) > 1)) {eprint(envs)}
eprint(envs)

cat("\nCounts:\n")
eprint(envs, "count")


#!/usr/bin/Rscript

library(ggplot2)
library(grid)
library(gridBase)
library(igraph)

stat_sum_df <- function(fun, geom="crossbar", ...) {
    stat_summary(fun.data=fun, colour="red", geom=geom, width=0.2, ...)
}
load('corSims-layer1.RData')

test <- rdf$expectedIntros == 1 & rdf$couplingFactor == 1
df <- rdf[test,]
test <- df$comSize == 64 & df$R0baseline==1

colScale <- c("degreeBalanced"="#4477AA", "recipUnbalanced"="#DDCC77", "unbalanced"="#CC6677")
g <- ggplot(data=df[test,], aes(x=cohesion, y=cc1, group=scheme, color=scheme))
g <- g + geom_point(position=position_jitter(width=0.05), alpha=0.75)
g <- g + scale_x_log10()
g <- g + labs(x='Vertex\nconnectivity', y='Cross correlation')
g <- g + scale_color_manual(values=colScale)
g <- g + stat_sum_df("mean_cl_normal", geom = "smooth")
g <- g + scale_y_continuous(limits=c(-0.15,0.85))
g <- g + theme_classic()
g <- g + theme(text = element_text(size=10))
## Because label from adjacent plot gets partially covered with opaque background
g <- g + theme(plot.background = element_rect(fill = "transparent",colour = NA))
pCohesion <- g + theme(legend.position='none')

g <- ggplot(data=df[test,], aes(x=nedges, y=cc1, group=scheme, color=scheme))
g <- g + geom_point(position=position_jitter(width=0.05), alpha=0.75)
g <- g + scale_x_log10()
g <- g + labs(x='Edges in\ncut set', y='Cross correlation')
g <- g + stat_sum_df("mean_cl_normal", geom = "smooth")
g <- g + scale_color_manual(values=colScale)
g <- g + scale_y_continuous(limits=c(-0.15,0.85))
g <- g + theme_classic()
g <- g + theme(text = element_text(size=10))
#g <- g + theme(axis.title.x=element_text(hjust=1))
pNedges <- g + theme(legend.position='none')

tt <- df$nedges == df$comSize^2
dff <- df[tt,]

g <- ggplot(data=dff, aes(x=R0baseline, y=cc1))
g <- g + geom_point(position=position_jitter(width=0.05), alpha=0.75)
g <- g + labs(x='R0 baseline\n', y='Cross correlation')
g <- g + scale_x_log10(breaks=c(.5,1,2))
g <- g + scale_y_continuous(limits=c(-0.15,0.85))
g <- g + theme_classic()
g <- g + theme(text = element_text(size=10))
pR0 <- g

test <- rdf$expectedIntros == 1 & rdf$R0baseline == 1

df <- rdf[test,]
tt <- df$nedges == df$comSize^2
dff <- df[tt,]

g <- ggplot(data=dff, aes(x=couplingFactor, y=cc1))
g <- g + geom_point(position=position_jitter(width=0.05), alpha=0.75)
g <- g + labs(x='Capacity\nfactor', y='Cross correlation')
g <- g + scale_x_log10(breaks=c(.5,1,2))
g <- g + scale_y_continuous(limits=c(-0.15,0.85))
g <- g + theme_classic()
g <- g + theme(text = element_text(size=10))
pCoupFac <- g

# make wiring diagrams

gr <- gu <- gbal <- graph.empty(8, directed=FALSE)
lay <- layout.grid(gr, width=2)
gbal <- gbal + edges(1,2, 3,4, 5,6, 7,8)
gbal <- gbal + edges(3,2, 5,4, 7,6)

gu <- gu + edges(7,8, 7,6, 7,4, 7,2)
gu <- gu + edges(1,2, 1,4, 1,6)

gr <- gr + edges(7,8, 7,6, 7,4, 7,2)
gr <- gr + edges(2,1, 2,3, 2,5)

nodeLayout <- layout.grid(gr, width=2)
plotNetwork <- function(x) plot(x, layout=nodeLayout, vertex.label='', vertex.color='black',
                                vertex.size=20, edge.color='black')

## create plot

tmpf <- function(){
    plot.new() # seems necessary for cairo_pdf and cairo_ps devices
    grid.newpage()
    pushViewport(viewport(width=unit(17.8, 'cm'), height=unit(6, 'cm')))
    lay <- grid.layout(1,5, widths=unit(c(1.1,1,1,1,1), 'null'),
                       heights=unit(c(1), 'null'))
    pushViewport(viewport(layout=lay))
    pushViewport(viewport(layout.pos.col=1, layout.pos.row=1))
    print(pR0, newpage=FALSE)
    grid.text(label="a", x=unit(0, "npc") - unit(0.2, "lines"),
              y=unit(.95, "npc"), just= "left")
    popViewport()
    pushViewport(viewport(layout.pos.col=2, layout.pos.row=1))
    print(pCoupFac + labs(y=NULL), newpage=FALSE)
    grid.text(label="b", x=unit(0, "npc") - unit(0., "lines"),
              y=unit(.95, "npc"), just= "left")
    popViewport()
    pushViewport(viewport(layout.pos.col=3, layout.pos.row=1))
    print(pNedges + labs(y=NULL), newpage=FALSE)
    grid.text(label="c", x=unit(0, "npc") - unit(0., "lines"),
              y=unit(.95, "npc"), just= "left")
    popViewport()
    pushViewport(viewport(layout.pos.col=4, layout.pos.row=1))
    print(pCohesion + labs(y=NULL), newpage=FALSE)
    grid.text(label="d", x=unit(0, "npc") - unit(0., "lines"),
              y=unit(.95, "npc"), just= "left")
    popViewport()
    pushViewport(viewport(layout.pos.col=5, layout.pos.row=1))
    lay <- grid.layout(5,4, widths=unit(c(.25,.2, 2.2,.5), 'null'),
                       heights=unit(c(.75, .75, .75, .75,1), 'null'))
    pushViewport(viewport(layout=lay))
    pushViewport(viewport(layout.pos.col=4, layout.pos.row=2))
    par(plt=gridPLT(), new=TRUE)
    plotNetwork(gbal)
    popViewport()
    pushViewport(viewport(layout.pos.col=4, layout.pos.row=3))
    par(plt=gridPLT(), new=TRUE)
    plotNetwork(gu)
    popViewport()
    pushViewport(viewport(layout.pos.col=4, layout.pos.row=4))
    par(plt=gridPLT(), new=TRUE)
    plotNetwork(gr)
    popViewport()
    pushViewport(viewport(layout.pos.col=3, layout.pos.row=2))
    grid.text(label='Balanced',  gp=gpar(fontsize=10))
    popViewport()
    pushViewport(viewport(layout.pos.col=3, layout.pos.row=3))
    grid.text(label='Unbalanced',  gp=gpar(fontsize=10))
    popViewport()
    pushViewport(viewport(layout.pos.col=3, layout.pos.row=4))
    grid.text(label='Reciprocally\nunbalanced', gp=gpar(fontsize=10))
    popViewport()
    pushViewport(viewport(layout.pos.col=3, layout.pos.row=1))
    grid.text(label='Wiring scheme', gp=gpar(fontsize=10, fontface=1))
    popViewport()
    pushViewport(viewport(layout.pos.col=2, layout.pos.row=2))
    grid.circle(gp=gpar(fill=colScale["degreeBalanced"], alpha=0.75, col="transparent"))
    popViewport()
    pushViewport(viewport(layout.pos.col=2, layout.pos.row=2))
    grid.circle(gp=gpar(fill=colScale["degreeBalanced"], alpha=0.75, col="transparent"))
    popViewport()
    pushViewport(viewport(layout.pos.col=2, layout.pos.row=3))
    grid.circle(gp=gpar(fill=colScale["unbalanced"], alpha=0.75, col="transparent"))
    popViewport()
    pushViewport(viewport(layout.pos.col=2, layout.pos.row=4))
    grid.circle(gp=gpar(fill=colScale["recipUnbalanced"], alpha=0.75, col="transparent"))
    popViewport()
}

cairo_ps(filename='sim-panel.eps', onefile=TRUE, width=7.1, height=2.45)
tmpf()
dev.off()

cairo_pdf(filename='tmp.pdf', onefile=TRUE, width=7.1, height=2.45)
tmpf()
dev.off()
# First page is blank (due to plot.new?), so:
system('pdfseparate -f 2 -l 2 tmp.pdf sim-panel.pdf && rm tmp.pdf')


#  James Rekow

computeSubgroupVec = function(M , numSubgroups){

  #  ARGS: M - number of samples in cohort
  #        numSubgroups - number of subgroups in cohort
  #
  #  RETURNS: subgroupVec - numeric vector of length M whose ith value is the index of the default subgroup
  #                         to which the ith sample in the cohort will belong, assuming the cohort was
  #                         created using subgroupsAbdListCreator

  source("partition.r")

  #  compute the number of samples in each subgroup
  subgroupSizes = partition(n = M, numPartitions = numSubgroups)

  #  create subgroupList
  subgroupList = lapply(as.list(1:numSubgroups), function(ii) rep(ii, subgroupSizes[ii]))

  #  unlist into a vector
  subgroupVec = unlist(subgroupList)

  return(subgroupVec)

} #  end computeSubgroupVec function


###  t.seq  function to build a full sequence of days, weeks, week-days, months and years
###         to subset a time-series template for specified monitoring season, independent of
###         the year

t.seq = function(init.year=1970,last.year=format(Sys.Date(),"%Y")) {

    init.date <- as.Date(paste((init.year-1), "01-01", sep = "-"))
    last.date <- as.Date(paste((as.numeric(last.year)+1), "12-31", sep = "-"))

    date.serie <- as.POSIXct(seq(from=init.date, to= last.date, by = "day"), format = "%Y-%m-%d")
    date.serie <- date.serie[!format(date.serie,'%Y') %in% c((init.year-1),as.numeric(last.year)+1)]

    return(date.serie)

    }

t.table = function(init.year=1970,last.year=format(Sys.Date(),"%Y"),week_day1='monday') {

        d.s <- t.seq(init.year,last.year)

        if(week_day1=='monday'){
            w <- c(7,1:6)
        }else{
            w <- c(1:7)
        }

        date.serie <- data.table::data.table(date=data.table::as.IDate(d.s),
                                 day.since=seq_along(d.s),
                                 month=data.table::month(d.s),
                                 week=data.table::isoweek(d.s),
                                 week_day=w[data.table::wday(d.s)],
                                 month_day=data.table::mday(d.s))

        return(date.serie)

    }

year_day_func = function(sp_data) {

a <- t.table(1999,2000)

a <- data.table::as.IDate(init.date)
b <- data.table::as.IDate(last.date)

data.table::isoweek(a)[5]

c(7,1,2,3,4,5,6)[data.table::wday(a)[5]]
data.table::month(a)[32]

a[1]

install.packages("ISOweek")

ISOweek::date2ISOweek(a)[5]

lubridate::wday(a)[1]

b-a

    dayno <- as.numeric(julian(date.serie, origin = as.Date(origin.d)) + 1)
    month <- as.numeric(strftime(date.serie, format = "%m"))
    week <- as.numeric(strftime(date.serie, format = "%W"))
    week_day <- as.numeric(strftime(date.serie, format = "%u"))
    day <- as.numeric(strftime(date.serie, format = "%d"))


source('source/utils/manifest-operations.r')

is_there_column <- function(data, column_name){
    return(any(names(data) == column_name))
}

group_columns <- function(data, manifest){
    column_groups = get_property_value_as_reversed_string_map(manifest, 'column-groups')
    if(is.null(column_groups)){
        return(data)
    }
    input_data <- data

    for(column_name in column_groups$keys()){
        data_without_target_rows <- subset(data, data$variable != column_name)
        for(group_name in str_split(column_groups[[column_name]], group_names_separator)[[1]]){
            target_rows <- data[data$variable == column_name,]
            target_rows$variable <- group_name
            data_without_target_rows <- rbind(data_without_target_rows, target_rows)
        }
        data <- data_without_target_rows
    }

    return(data)
}

read_corpus_data <- function(path, manifest) {
    # Generate data path and read the corpus contents

    data_path <- paste(path, get_property_value(manifest, 'data', 'data.tsv'), sep = "/")
    data <- read.table(file = data_path, sep = '\t', header = TRUE, check.names = FALSE)

    # Make sure that there is an index column in the corpus data

    index_column_name <- get_property_value(manifest, 'index-column', 'id')
    if (!is_there_column(data, index_column_name)) {
        print("Oops, no index column in the dataset! Initializing it with default values which reflect the index of row")
        data[index_column_name] <- 1:nrow(data)
    }

    return(list(data = data, index_column_name = index_column_name))
}

melt_and_group_columns <- function(corpus) {
    melted <- melt(corpus$data, id=corpus$index_column_name)
    names(melted)[1] <- 'id'
    melted <- group_columns(melted, corpus$manifest)
    return(melted)
}

get_bin_bounds <- function(bins_specification) {
    left_boundary <- get_property_value(bins_specification, 'min')
    right_boundary <- get_property_value(bins_specification, 'max')
    bin_size <- get_property_value(bins_specification, 'bin-size')

    left_interval_boundaries <- seq(left_boundary, right_boundary - bin_size, by=bin_size)
    right_interval_boundaries <- seq(left_boundary + bin_size, right_boundary, by=bin_size)

    return(data.frame(left_interval_boundaries, right_interval_boundaries))
}


# 3. faza: Vizualizacija podatkov

library(ggplot2)
library(ggvis)
library(dplyr)
library(rgdal)
library(mosaic)
library(maptools)
library(ggmap)
library(mapproj)
library(munsell)

# 1.graf POTNIŠKI PREVOZ IN PROMET

graf_potniski_promet <- ggplot(data = potniski_promet, mapping = aes(x=Leto, y=Stevilo_potnikov, group=Vrsta_prevoza, color=Vrsta_prevoza)) +
  geom_line(stat = "identity", position = position_dodge(width = NULL)) +
  theme(axis.text.x = element_text(angle = 90, size = 8)) +
  labs(y='Stevilo potnikov(1000)', color='Vrsta prevoza') +
  theme(legend.text = element_text(size=8)) +
  ggtitle("Potniški prevoz in promet")

# 2.graf ŠTEVILO UMRLIH V CESTNOPROMETNIH NESREČAH NA 10.000 REGISTRIRANIH MOTORNIH VOZIL PO REGIJAH

graf_preminuli <- ggplot(data = filter(preminuli, Regija == 'Pomurska' | Regija == 'Podravska' |
                                      Regija == 'Koroška' | Regija == 'Savinjska' | Regija == 'Zasavska' |
                                      Regija == 'Posavska' | Regija == 'Jugovzhodna' | Regija == 'Osrednjeslovenska' |
                                      Regija == 'Gorenjska' | Regija == 'Primorsko-notranjska' |
                                      Regija == 'Goriška' | Regija == 'Obalno-kraška'),
                      mapping = aes(x=Leto, y=Preminuli, color=Regija)) +
                      ggtitle('Število umrlih v cestnoprometnih nesrečah na 10.000 registriranih motornih vozil') +
                      geom_point() +
                      facet_wrap(Regija~., ncol=3) +
                      theme(axis.text.x = element_text(angle = 90, size = 6))

# 3.graf POVPREČNA STAROST OSEBNIH AVTOMOBILOV PO REGIJAH

graf_povprecna_starost <- ggplot(data = povprecna_starost, mapping = aes(x=Regija, y=Povprecna_starost_avtomobila, fill=factor(Leto))) +
  geom_bar(stat = 'identity', position = 'dodge') +
  labs(y = 'Povprecna starost avtomobila') +
  theme(axis.text.x = element_text(angle = 90, size = 8)) +
  ggtitle("Povprečna starost osebnih avtomobilov po regijah")

# 4.graf INDEKS ŠTEVILA OSEBNIH IN SPECIALNIH AVTOMOBILOV GLEDE NA VRSTO GORIVA IN POGONA

graf_pogon_in_gorivo <- ggplot(data=indeks, mapping = aes(x=Leto, y=Indeks, group=Vrsta_pogona, color=Vrsta_pogona))+
  geom_line(stat = 'identity') +
  theme(axis.text.x = element_text(angle = 90, size = 8)) +
  theme(legend.text = element_text(size=8)) +
  ggtitle("Indeks števila avtomobilov glede na vrsto goriva in pogona") +
  labs(color='Vrsta goriva in pogona')

# Uvozimo zemljevid.

zemljevid <- uvozi.zemljevid("http://biogeo.ucdavis.edu/data/gadm2.8/shp/SVN_adm_shp.zip",
                             "SVN_adm1", mapa = 'zemljevid', encoding = "UTF-8")

zemljevid$NAME_1 <- c("Gorenjska", "Goriška","Jugovzhodna", "Koroška", "Primorsko-notranjska", "Obalno-kraška", "Osrednjeslovenska", "Podravska", "Pomurska", "Savinjska", "Posavska", "Zasavska")

zemljevid <- fortify(zemljevid)

# 1.ZEMLJEVID: POVPREČNO NETO PLAČA V LETU 2018

zemljevid_neto_placa <- ggplot() + geom_polygon(data=left_join(zemljevid, neto_placa2018, by=c("NAME_1"="Regija")),
                                           aes(x=long, y=lat, group=group, fill=Neto_placa)) +
  geom_line() +
  theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(),
        axis.ticks.y=element_blank()) +
  guides(fill=guide_colorbar(title="Plača")) +
  ggtitle("Povprečna neto plača po regijah leta 2018") +
  labs(x = " ") +
  labs(y = " ") +
  scale_fill_gradient(low = "white", high = "red",
                      space = "Lab", na.value = "#e0e0d1", guide = "black",
                      aesthetics = "fill")

# 2.ZEMLJEVID: POVPREČNA STAROST OSEBNEGA AVTOMOBILA GLEDE NA REGIJO

zemljevid_povprecna_starost <- ggplot() + geom_polygon(data=left_join(zemljevid, povprecna_starost2018, by=c("NAME_1"= "Regija")),
                                             aes(x=long, y=lat, group=group, fill=Povprecna_starost_avtomobila)) +
  geom_line() +
  theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(),
        axis.ticks.y=element_blank()) +
  guides(fill=guide_colorbar(title="Povprečna starost avtomobila")) +
  ggtitle("Povprečna starost avtomobila po regijah leta 2018") +
  labs(x = " ") +
  labs(y = " ") +
  scale_fill_gradient(low = "white", high = "red",
                      space = "Lab", na.value = "#e0e0d1", guide = "black",
                      aesthetics = "fill")

cor(povprecna_starost2018$Povprecna_starost_avtomobila, neto_placa2018$Neto_placa)

osebni_avtomobili1 <- filter(osebni_avtomobili, Leto=='2018')

zemljevid_osebni_avtomobili <- ggplot() + geom_polygon(data=left_join(zemljevid, osebni_avtomobili1, by=c("NAME_1"= "Regija")),
                                                aes(x=long, y=lat, group=group, fill=Osebni_avtomobili)) +
  geom_line() +
  theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(),
        axis.ticks.y=element_blank()) +
  guides(fill=guide_colorbar(title="Število avtomobilov")) +
  ggtitle("Število avtomobilov na 1000 prebivalcev leta 2018") +
  labs(x = " ") +
  labs(y = " ") +
  scale_fill_gradient(low = "white", high = "red",
                      space = "Lab", na.value = "#e0e0d1", guide = "black",
                      aesthetics = "fill")


sessionInfo()
library(dHRUM)
nHrus <- 2
# Areas <- runif(nHrus,min = 1,max  = 100)
Areas <- c(2.5,1.92)#les 1.92 Zem_puda 2.5
IdsHrus <- paste0("ID",seq(1:length(Areas)))
dhrus <- initdHruModel(nHrus,Areas,IdsHrus)

filname2 = "Calibrations/Amalie/indata/BP_1960_01_01.txt"
setPTInputsToAlldHrusFromFile(dHRUM_ptr = dhrus, filname2)
calcPetToAllHrus(dHRUM_ptr = dhrus,50.1,"Hamon")

ParDF1 = data.frame( B_SOIL = 1.6, C_MAX = 500, B_EVAP = 1,  KS = 0.01, KF = 0.03, ADIV = 0.8, CDIV = 0.3,
SDIV = 0.3, CAN_ST = 1., STEM_ST = 1., CSDIV = 0.8, TETR = 0, DDFA = 0.75, TMEL = 0.0,
RETCAP = 10 )

ParDFup1 = data.frame( B_SOIL = 2., C_MAX = 800, B_EVAP = 2,  KS = 0.4, KF = 0.7, ADIV = 0.9, CDIV = 0.1,
                    SDIV = 0.05, CAN_ST = 2., STEM_ST = 2., CSDIV = 0.8, TETR = 4, DDFA = 0.8, TMEL = 0.0,
                    RETCAP = 2 )
ParDFlow1 = data.frame( B_SOIL = 0.6, C_MAX = 400, B_EVAP = 0.6,  KS = 0.002, KF = 0.2, ADIV = 0.01, CDIV = 0.05,
                      SDIV = 0.01, CAN_ST = 0.1, STEM_ST = 0.1, CSDIV = 0.01, TETR = 0, DDFA = 0.08, TMEL = -10.0,
                      RETCAP = 1 )

ParDF2 = data.frame( B_SOIL = 1.6, C_MAX = 500, B_EVAP = 1,  KS = 0.01, KF = 0.03, ADIV = 0.8, CDIV = 0.3,
                     SDIV = 0.3, CAN_ST = 1., STEM_ST = 1., CSDIV = 0.8, TETR = 0, DDFA = 0.75, TMEL = 0.0,
                     RETCAP = 2 )

ParDFup2 = data.frame( B_SOIL = 2., C_MAX = 400, B_EVAP = 2,  KS = 0.4, KF = 0.7, ADIV = 0.9, CDIV = 0.1,
                       SDIV = 0.05, CAN_ST = 2., STEM_ST = 2., CSDIV = 0.8, TETR = 4, DDFA = 0.8, TMEL = 0.0,
                       RETCAP = 5 )
ParDFlow2 = data.frame( B_SOIL = 0.6, C_MAX = 10, B_EVAP = 0.6,  KS = 0.002, KF = 0.2, ADIV = 0.01, CDIV = 0.05,
                        SDIV = 0.01, CAN_ST = 1., STEM_ST = 1., CSDIV = 0.01, TETR = 0, DDFA = 0.08, TMEL = -10.0,
                        RETCAP = 1 )
nPars1HRU= ncol(ParDFlow1)

dny=c(30,60,90,120,150,180,210,240,270,300,330,355,364)
p_OBS=dny/365.25

# BP 96.68961 (1.736-2.430446)
RaBP = 96# odhad Martin Hanel
QmBP = c(26, 18, 14, 12, 10, 8.0, 7.0, 6.0, 4.5, 3.5, 2.5, 1.0, 0.5)
A=4.42*1000*1000# plocha BP
RmBP = QmBP * (3600*24) / A #CHMU ZHU
# simRM=as.numeric(quantile(dF$TOTR,probs=(1-p_OBS)))
ParDF = data.frame( B_SOIL = 1.6, C_MAX = 100, B_EVAP = 2,  KS = 0.1, KF = 0.2, ADIV = 0.3, CDIV = 0.03,
                    SDIV = 0.03, CAN_ST = 2, STEM_ST = 2, CSDIV = 0.3, TETR = 5, DDFA = 0.5, TMEL = 0, RETCAP = 10 )

mae = function(myPar){
  # parrvv=as.numeric(c(ParDFlow1[1,],ParDFlow2[1,]))
  # Par1 = parrvv[1:nPars1HRU]
  # Par2 = as.numeric(parrvv[(nPars1HRU+1):(2*nPars1HRU)])
  # Par1 =ParDF1[1,]
  # Par2 =ParDF2[1,]
  Par1 = myPar[1:nPars1HRU]
  Par2 = as.numeric(myPar[(nPars1HRU+1):(2*nPars1HRU)])
  setParamsToOnedHru(dHRUM_ptr = dhrus,as.numeric(Par1),names(ParDF),0)
  setParamsToOnedHru(dHRUM_ptr  = dhrus,as.numeric(Par2),names(ParDF),1)
  # # for( i in 1:1000){
  calcHBInAlldHrus(dHRUM_ptr = dhrus)
  gatherHBdata(dHRUM_ptr = dhrus)
  # # }
  dta <- getOutput(dHRUM_ptr = dhrus)
  dF <-data.frame(dta$outDta)
  names(dF) <- dta$VarsNams
  simRM=as.numeric(quantile(dF$TOTR,probs=(1-p_OBS), na.rm = TRUE))
  mymae =as.double(sum(abs(simRM - RmBP)))
  # # mymae=NA
  # if(is.na(mymae)) mymae = 9999
  # (return as.double(mymae))
}

library(RcppDE)
itermaxW=10
decntr<-DEoptim.control(VTR = 0, strategy = 2, bs = FALSE, NP = 300,
                itermax = itermaxW, CR = 0.25, F = 0.58, trace = TRUE,
                initialpop = NULL, storepopfrom = itermaxW + 1,
                storepopfreq = 1, p = 0.2, c = 0, reltol = sqrt(.Machine$double.eps),
                steptol = itermaxW)

u=DEoptim( lower=as.numeric(c(ParDFlow1[1,],ParDFlow2[1,])),
           upper=as.numeric(c(ParDFup1[1,],ParDFup2[1,])), fn=mae, control = decntr)

u$optim$bestmem

ParBest = as.numeric(u$optim$bestmem)
# ParDF
setParamsToOnedHru(dHRUM_ptr = dhrus,as.numeric(ParBest[1:nPars1HRU]),names(ParDF),0)
setParamsToOnedHru(dHRUM_ptr  = dhrus,as.numeric(ParBest[(nPars1HRU+1):(2*nPars1HRU)]),names(ParDF),1)

calcHBInAlldHrus(dHRUM_ptr = dhrus)
gatherHBdata(dHRUM_ptr = dhrus)
# # }
dta <- getOutput(dHRUM_ptr = dhrus)
dF <-data.frame(dta$outDta)

names(dF) <- dta$VarsNams

plot(dF$TOTR, type='l')
plot(dF$BASF, type='l')
plot(dF$DIRR, type='l')
plot(dF$SOIS, type='l')
plot(dF$GROS, type='l')
plot(dF$SNOW, type='l')
simBest=as.numeric(quantile(dF$TOTR,probs=(1-p_OBS), na.rm = TRUE))

plot(RmBP, simBest)

plot(p_OBS,RmBP, pch=19, main = "Brejlský potok - kalibrace dHRUM - 2 HRU",xlab="P(Qm)", ylab="Qm [mm/den]")
points(p_OBS,simBest,col="red",pch=19)
grid()

ParBest[1:nPars1HRU]
ParBest[(nPars1HRU+1):(2*nPars1HRU)]

Par1 = myPar[1:nPars1HRU]
Par2 = as.numeric(myPar[(nPars1HRU+1):(2*nPars1HRU)])

require(data.table)
pars=data.table(ParDF1)

ParDF11=ParDF1
ParDF11[1,] = ParBest[1:nPars1HRU]

ParDF11=rbind(ParDF11,ParBest[(nPars1HRU+1):(2*nPars1HRU)])

pars2hru_bp <-cbind(ParDF11,Areas=c(2.50, 1.92))

saveRDS(pars2hru_bp,file = "./data/Params/Amalie/BP_2HRU.rds")

outDta <- dHRUMrunDist(dHRUM_ptr = dhrus)
outDF <- data.frame(outDta$outDta)
outDF <- cbind(outDF, outDta$Ids)
names(outDF) <-c(outDta$VarsNams)

library(data.table)
outDF <- as.data.table(outDF)

plot(outDF[HruIds == "ID2", BASF], type ='l', col='red')
lines(outDF[HruIds == "ID1", BASF], type ='l', col='blue')


library(ggplot2)
library(reshape)
library(effsize)
library(rtracklayer)

compute.effect.size.vs.global <- function(global, subset, col) {
  exclude <- subsetByOverlaps(global, setdiff(global, subset))
  df.global <- mcols(exclude)[, col]
  df.subset <- mcols(subset)[, col]

  # Drop non finite values (if log was applied)
  g <- df.global[is.finite(df.global)]
  s <- df.subset[is.finite(df.subset)]

  cohen.d(s, g)
}

wilcoxon.category.enriched <- function(global, subset, col) {
  exclude <- subsetByOverlaps(global, setdiff(global, subset))
  df.global <- mcols(exclude)[, col]
  df.subset <- mcols(subset)[, col]

  # Drop non finite values (if log was applied)
  g <- df.global[is.finite(df.global)]
  s <- df.subset[is.finite(df.subset)]
  wilcox.test(s, g)
}

args = commandArgs(trailingOnly=TRUE)

in.bins.file <- args[1]
in.iap.file <- args[2]
outfile.prefix <- args[3]

df <- read.table(in.bins.file, sep='\t', header=T)
values <- df[, c('chr', 'start', 'end', 'H33.00h','H33.inp','H3K9me3.WT','H3K9me3.input')]
values$H33logfc <- log2(values$H33.00h/values$H33.inp)
values$H3k9me3.logfc <- log2(values$H3K9me3.WT/values$H3K9me3.input)

iap.ranges <- import(in.iap.file)
bins.grang <- makeGRangesFromDataFrame(values, keep.extra.columns = T)
iap.bins <- subsetByOverlaps(bins.grang, iap.ranges, minoverlap=2500)

iap.bins.df <- data.frame(H33=iap.bins$H33logfc, H3K9me3=iap.bins$H3k9me3.logfc)

# Calculate effect sizes
k9.estimate <- compute.effect.size.vs.global(bins.grang, iap.bins, 'H3k9me3.logfc')
h33.estimate <- compute.effect.size.vs.global(bins.grang, iap.bins, 'H33logfc')

# Without overlay
p1 <- ggplot(values, aes(x=H33logfc,y=H3k9me3.logfc)) +
  geom_bin2d(binwidth=c(0.1,0.1)) +
  ylim(-10, 7) +
  scale_fill_gradient(low="#eeeeee", high="#bb0000") +
  theme_classic()

# With overlay
p2 <- ggplot(values, aes(x=H33logfc,y=H3k9me3.logfc)) +
  geom_bin2d(binwidth=c(0.1,0.1)) +
  ylim(-10, 7) +
  geom_point(data=iap.bins.df, aes(x=H33,y=H3K9me3), color='black', alpha=0.8, size=0.8) +
  scale_fill_gradient(low="#eeeeee", high="#bb0000") +
  annotate(geom="text", x=-1.2, y=-8.5, label="Wilcoxon rank sum test p-val < 2.2e-16 (both axes)",
           color="black") +
  annotate(geom="text", x=-1.2, y=-9.5,
           label=paste0("Cohen's d effect: ", round(h33.estimate$estimate, digits=2) ,", ", round(k9.estimate$estimate,digits=2)," (H3.3,H3K9me3)"),
           color="black") +
  theme_classic()

ggsave(paste0(outfile.prefix, '_bins_density.png'), plot=p1, dpi=300)
ggsave(paste0(outfile.prefix, '_bins_density_at_iap.png'), plot=p2, dpi=300)


library(dplyr)

# Not Needed: Use PostgreSQL version instead
# # Gets inflation-adjusted numbers
# InflationCalculator <- setRefClass(
#   "InflationCalculator",
#   fields = c('cpi_data'),
#   methods = list(
#     initialize = function(sql_conn) {
#       # Arguments:
#       #  * sql_conn:  A dplyr PostgreSQL connection
#       cpi_data <<- collect(
#         tbl(sql_conn, sql(
#         "SELECT year, CAST(value  as float8) FROM cpi
#          WHERE series_id LIKE '%CUUR0000AA0%'
#          AND period LIKE '%M13%'"))
#      )
#    },
#
#    inflate = function(money, start_year, end_year) {
#      # Arguments:
#      #  * money:        Dollar amount to be inflation adjusted
#      #  * start_year:   The year money is calculated from
#      #  * end_year:     The year money should be converted to
#
#      start_cpi <- as.numeric(.self$cpi_data %>%
#                                filter(year==start_year) %>%
#                                select(value))
#
#      end_cpi <- as.numeric(.self$cpi_data %>%
#                                filter(year==end_year) %>%
#                                select(value))
#
#      inflation = end_cpi/start_cpi
#
#      return(money * inflation)
#    }
#  )
# )

# Lazy loads median household income data for county
IncomeData <- setRefClass(
  "IncomeData",
  fields = c('sql_conn', 'county_data'),
  methods = list(
    initialize = function(sql_conn, counties, query) {
      # Arguments:
      #  * sql_conn:  A dplyr PostgreSQL connection
      #   * Should be a connection to the database with all Census tables
      #  * counties:  A GeoJSON with county boundary information
      #  * query:     A SQL string containing an SQL query which gets the data

      sql_conn <<- sql_conn
      county_data <<- left_join(counties@data,
                                collect(tbl(sql_conn, sql(query()))),
                                by='geo_id')
    },

    get_mhhi_data = function(year) {
      # Return a subset of median household income data for one year
      #  * year:  Should be in two digit format e.g. '05', '12', ...
      #  * top:   Get top N entries

      # Get integer position of correct column
      col_name = sprintf('mhhi_%s', year)
      col_pos = which(names(.self$county_data) == col_name)

      return(unlist(.self$county_data %>%
                      select(col_pos)))
    },

    get_top_mhhi = function(year) {
      # Get top 100 counties by median household income
      # along with geographic information

      # Get integer position of correct column
      col_name = sprintf('mhhi_%s', year)
      col_pos = which(names(.self$county_data) == col_name)

      # browser()
      data <- .self$county_data %>%
        select(geo_display_label, lat, long, col_pos) %>%

        # Strip out excessive whitespace
        mutate(lat = as.numeric(lat)) %>%
        mutate(long = as.numeric(long))

      # Rename median household income column
      names(data)[4] = "mhhi"

      return((data %>%
        arrange(desc(mhhi)))[1:100, ])
    }
  )
)

# Generate SQL query that gets median household income time series data
# Use writeLines(get_mhhi_ts_query()) to test output
get_mhhi_ts_query = function() {
  columns_temp <- c()
  joins_temp <- c()

  k <- 1

  # Count backwards because ACS 15 has more counties
  for (i in seq(15, 5)) {
    # 5 -> 2005, 13 -> 2013, ...
    four_digit_year <- 2000 + i

    # 5 -> 05, 6 -> 06, ...
    if (nchar(i) == 1) { i <- sprintf('0%s', i) }

    columns_temp <- append(columns_temp, sprintf('mhhi_%s, mhhi_moe_%s', i, i))

    # Return inflation adjusted numbers
    joins_temp <- append(joins_temp, sprintf(
      "(SELECT geo_id, geo_id2, geo_display_label,
          inflate(float_or_null(hc01_est_vc14), %s, 2016) AS mhhi_%s,
          inflate(float_or_null(hc01_moe_vc14), %s, 2016) AS mhhi_moe_%s FROM acs%s_finance_county) as q%s",
        four_digit_year, # Inflation start year
        i,               # Get correct column name
        four_digit_year, # Inflation start year
        i, i, k)
      )

    k <- k + 1;
  }

  columns <- paste(columns_temp, collapse=', ')

  k <- 1

  for (j in joins_temp) {
    if (k == length(joins_temp)) {
      # Last item
      joins_temp[k] = sprintf('%s ON q1.geo_id = q%s.geo_id', j, k);
    } else if (k > 1) {
      # Not first item
      joins_temp[k] = sprintf('%s ON q1.geo_id = q%s.geo_id
                              FULL OUTER JOIN ', j, k)
    } else {
      # First Item
      joins_temp[k] = sprintf('%s
                              FULL OUTER JOIN', j)
    }
    k <- k + 1
  }

  joins <- paste(joins_temp, collapse='')

  return(sprintf('SELECT q1.geo_id, q1.geo_display_label,
                    intptlat as lat,
                    intptlong as long,
                 %s FROM %s
                 JOIN geography_county ON
                    geography_county.geoid = q1.geo_id2', columns, joins))
}

# Get ACS 5-Year Estimates of Financial Information
get_mhhi_acs5 = function() {
  return(
  'SELECT
      acs15_5yr_finance_county.geo_id,
      acs15_5yr_finance_county.geo_display_label,
      intptlat as lat,
      intptlong as long,
      inflate(float_or_null(acs15_5yr_finance_county.hc01_est_vc14), 2015, 2016) as mhhi_15,
      inflate(float_or_null(acs15_5yr_finance_county.hc01_moe_vc14), 2015, 2016) as mhhi_moe_15,
      inflate(float_or_null(acs10_5yr_finance_county.hc01_est_vc14), 2010, 2016) as mhhi_10,
      inflate(float_or_null(acs10_5yr_finance_county.hc01_moe_vc14), 2010, 2016) as mhhi_moe_10
    FROM
      acs15_5yr_finance_county
    JOIN
      acs10_5yr_finance_county
    ON acs10_5yr_finance_county.geo_id = acs15_5yr_finance_county.geo_id
    JOIN
      geography_county
    ON geography_county.geoid = acs15_5yr_finance_county.geo_id2'
    )
}


#' Calculate topological indices for ecological networks. The mean trophic level
#' and Omnivory and the Level of omnivory are calculated with the function [NetIndices::TrophInd()]
#'
#' @param ig vector of igraph objects
#' @param ncores number of cores used to compute in parallel, if 0 sequential processing is used.
#'
#' @return a data.frame with the following fields:
#'
#'  \item{Size:}{Number of species}
#'  \item{Top:}{Number of top predator species}
#'  \item{Basal:}{Number of basal especies}
#'  \item{Omnivory:}{ Proportion of omnivorous species }
#'  \item{Links:}{ number of interactions}
#'  \item{LD:}{ linkage density}
#'  \item{Connectance:}{ directed Connectance}
#'  \item{PathLength:}{ average path length}
#'  \item{Clustering:}{ clustering coeficient}
#'  \item{Cannib:}{ number of cannibalistic species}
#'  \item{TLmean:}{ mean trophic level}
#'  \item{TLmax:}{ maximum trophic level}
#'  \item{LOmnivory:} { Level of omnivory, quantiﬁes mean of the variety in trophic levels of the preys of a consumer}
#'  \item{Components:}{ number of weakly connected components}
#'  \item{Vulnerability:}{ mean of number of consumers per prey}
#'  \item{VulSD:}{ the standard deviation of normalized Vulnerability}
#'  \item{Generality:}{ mean number of prey per consumer}
#'  \item{GenSD:}{ the standard deviation of normalized Generality}
#'
#'
#' @export
#' @importFrom NetIndices TrophInd
#' @import igraph
#' @importFrom foreach foreach %dopar%
#' @importFrom doFuture registerDoFuture
#' @importFrom future sequential multiprocess
#'
#' @aliases calcTopologicalIndices
#'
#' @examples
#'
#' calc_topological_indices(netData)
#'
#' # Generate a test network
#'
#' g <-   graph_from_literal( 1 -+ 4 -+ 7,2 -+ 5 -+7, 3-+6-+7, 7-+7, 4+-3, simplify = FALSE)
#'
#' calc_topological_indices(g)

calc_topological_indices <- function(ig,ncores=0){

  if(inherits(ig,"igraph")) {
    ig <- list(ig)
  } else if(class(ig[[1]])!="igraph") {
    stop("parameter ig must be an igraph object")
  }

  registerDoFuture()
  if(ncores) {
    cn <- future::availableCores()
    if(ncores>cn)
      ncores <- cn
    future::plan(multiprocess, workers=ncores)
    on.exit(future::plan(sequential))
  } else {
    future::plan(sequential)
  }

  df <-  foreach(g=ig,.combine='rbind',.inorder=FALSE,.packages=c('igraph','NetIndices')) %dopar%
    {

    deg <- degree(igraph::simplify(g), mode="out") # calculate the out-degree: the number of predators

    V(g)$outdegree <-  deg

    nTop <- length(V(g)[outdegree==0]) # Top predators do not have predators

    deg <- degree(g, mode="in") # calculate the in-degree: the number of preys

    V(g)$indegree <-  deg

    nBasal <- length(V(g)[indegree==0]) # Basal species do not have preys

    #vcount(g)-nTop-nBasal

    size <- vcount(g)

    links <- ecount(g)

    linkDen <- links/size          # Linkage density

    conn <- links/size^2           # Connectance

    pathLength <- mean_distance(g)   # Average path length

    clusCoef <- transitivity(g, type = "global")

    cannib <- sum(which_loop(g))

    a <- get.adjacency(g,sparse=F)

    tl <- TrophInd(a)  # Calculate the trophic level

    omn <- sum(round(tl$OI,5)>0)/size        # Omnivory proportion

    lomn <- mean(tl$OI)                      # Level of omnivory

    vulnerability <- links / (size - nTop)    # l/(nb + ni)
    generality    <- links / (size - nBasal)  # l/(nt + ni)
    vulSD         <- sd(apply(a, 1, sum)*1/linkDen)
    genSD         <- sd(apply(a, 2, sum)*1/linkDen)

    data.frame(Size=size,Top=nTop,Basal=nBasal,Omnivory=omn,Links=links, LD=linkDen,Connectance=conn,PathLength=pathLength,
               Clustering=clusCoef, Cannib=cannib, TLmean=mean(tl$TL),TLmax=max(tl$TL),LOmnivory=lomn,Components=components(g)$no,
               Vulnerability=vulnerability,VulSD=vulSD,Generality=generality,GenSD=genSD)
  }
return(df)
}

#' @export
calcTopologicalIndices <- function(ig,ncores=0){
    calc_topological_indices(ig,ncores)
}

#' Calculate the incoherence index of a food web
#'
#' The incoherence index is based in how the species fit in discrete trophic levels
#' when Q is closer to 0 more coherent and stable is a food web, and the less omnivory it has.
#' It calculates the trophic level using the package NetIndices.
#'
#' Based on:
#'
#' @references Johnson, S., Domínguez-García, V., Donetti, L., & Muñoz, M. A. (2014). Trophic coherence determines food-web stability. Proceedings of the National Academy of Sciences , 111(50), 17923–17928. https://doi.org/10.1073/pnas.1409077111
#'
#' @references Johnson, S., & Jones, N. S. (2017). Looplessness in networks is linked to trophic coherence. Proceedings of the National Academy of Sciences, 114(22), 5618–5623. https://doi.org/10.1073/pnas.1613786114
#'
#'
#' @param ig an igraph object or a list of igraph objects
#' @param ncores number of cores used to compute in parallel, if 0 sequential processing is used.
#'
#' @return a data.frame with the following fields
#'
#'  \item{Q}{incoherence (0=coherent)}
#'  \item{rQ}{ratio of Q with expected Q under null expectation of a random network given N=nodes L=links B=basal nodes Lb=basal links}
#'  \item{mTI}{mean trophic level}
#'  \item{rTI}{ratio of mTI with expected TI under the same null model expectation than Q}
#
#' @aliases calcIncoherence
#'
#' @export
#'
#' @examples
#'
#' calc_incoherence(netData[[1]])
#'
#'
#' @importFrom NetIndices TrophInd
#' @importFrom igraph     V degree get.adjacency vcount ecount
#' @importFrom foreach foreach %dopar%
#' @importFrom doFuture registerDoFuture
#' @importFrom future sequential multiprocess

calc_incoherence <- function(ig,ncores=0) {

  if(inherits(ig,"igraph")) {
    ig <- list(ig)
  } else if(class(ig[[1]])!="igraph") {
    stop("parameter ig must be an igraph object")
  }

  registerDoFuture()
  if(ncores) {
    cn <- future::availableCores()
    if(ncores>cn)
      ncores <- cn
    future::plan(multiprocess, workers=ncores)
    on.exit(future::plan(sequential))
  } else {
    future::plan(sequential)
  }

  # if(!is.null(ncores)) {
  #   cn <-parallel::detectCores()
  #   if(cn>ncores)
  #     cn <- ncores
  #   else
  #     cn <- cn-1
  #
  #   # cl <- makeCluster(cn,outfile="foreach.log") # Logfile to debug
  #   cl <- parallel::makeCluster(cn)
  #   doParallel::registerDoParallel(cl)
  #   on.exit(parallel::stopCluster(cl))
  # } else {
  #   foreach::registerDoSEQ()
  # }

  df <-  foreach(g=ig,.combine='rbind',.inorder=FALSE,.packages=c('igraph','NetIndices')) %dopar%
  {
    ti<-TrophInd(get.adjacency(g,sparse=FALSE))
    v <- ti$TL
    z <- round(outer(v,v,'-'),8);
    A <- get.adjacency(g,sparse = FALSE)
    xx <- A>0
    x <- (A*t(z))[xx]
    Q <- round(sqrt(sum((x-1)^2)/ecount(g) ),8)

    basal <- which(round(v,8)==1)
    bedges <- sum(degree(g,basal,mode='out'))
    mTI <- mean(v)
    mK <- mean(degree(g,mode='out'))
    eTI <- 1+(1-length(basal)/vcount(g))*ecount(g)/bedges
    eQ <- sqrt(ecount(g)/bedges-1)
    data.frame(Q=Q,rQ=Q/eQ,mTI=mTI,rTI=mTI/eTI)
  }
  return(df)
}

#' @export
calcIncoherence <- function(ig,ncores=0){
  calc_incoherence(ig,ncores)
  }

#' Calculation of Modularity and Small-world-ness z-scores
#'
#' The function calculates modularity, number of groups and small-world-ness z-scores and 99\% CI intervals
#' using as null model the list of networks in the nullDist parameters. Modularity is calculated using the [igraph::cluster_spinglass()]
#' if the parameter weights is NULL the atribute "weigths" is used, or if it has the name of an network attribute, that is used as a weigth
#' to build the modules, when this parameter is NA then no weigth is used.
#' Only works for one component networks
#'
#' @references
#' Marina, T. I., Saravia, L. A., Cordone, G., Salinas, V., Doyle, S. R., & Momo, F. R. (2018). Architecture of marine food webs: To be or not be a ‘small-world.’ PLoS ONE, 13(5), 1–13. https://doi.org/10.1371/journal.pone.0198217
#'
#' @param g  igraph object
#' @param nullDist list of igraph object with the null model simulations
#' @param sLevel significance level to calculate CI (two tails)
#' @param ncores number of cores to use paralell computation, if 0 sequential processing is used.
#' @param weights The weights of the edges. Either a numeric vector or NULL or NA. If it is null and the input graph has a ‘weight’ edge attribute
#'                then that will be used. If NULL and no such attribute is present then the edges will have equal weights.
#'                Set this to NA if the graph was a ‘weight’ edge attribute, but you don't want to use it for community detection.
#'
#'
#' @return a list with two data frames: one with indices z-scores and CI
#'
#'  \item{Clustering}{ Clustering coefficient, measures the average fraction of pairs of neighbors of a node that are also neighbors of each other}
#'  \item{PathLength}{ Mean of the shortest paths between all pair of vertices }
#'  \item{Modularity}{ modularity measures how separated are different groups from each other, the algorithm \code{cluster_spinglass} was used to obtain the groups}
#'  \item{zCC,zCP,zMO}{Z-scores of Clustering,PathLength and Modularity with respect to a random Erdos-Renyi null model}
#'  \item{CClow,CChigh,CPlow,CPhigh,MOlow,MOhigh}{sLevel confidence intervals}
#'  \item{SWness,SWnessCI}{ Small-world-ness and it CI value}
#'  \item{isSW,isSWness}{ Logical variable signalling if the network is Small-world by the method of Marina 2018 or the method of Humprhies & Gurney 2008 }
#'
#'  Another data.frame with the values calculated for the nullDist.
#'
#' @export
#'
#' @importFrom igraph transitivity average.path.length cluster_spinglass
#' @importFrom future.apply future_lapply
#' @importFrom future sequential multiprocess
#'
#' @examples
#' \dontrun{
#' nullg <- generateERbasal(netData[[1]],10)
#' calcModularitySWnessZScore(netData[[1]],nullg)
#' }
#'
calc_modularity_swness_zscore<- function(g, nullDist,sLevel=0.01,ncores=0,weights=NA){

  if(!is_igraph(g))
    stop("Parameter g must be an igraph object")

  t <- calcTopologicalIndices(g)

  if(length(nullDist)<5)
    stop("nullDist: There has to be more than 5 elements in the list")

  if(any(sapply(nullDist, function(g) components(g)$no>1)))
    stop("nullDist: one or more igraph object from nullDist have more than one component")

  # nullDist <- lapply(1:nsim, function (x) {
  #   e <- sample_gnm(t$Size, t$Links, directed = TRUE)
  #
  #   # Check that the ER networks has only one connected component
  #   #
  #   while(components(e)$no>1)
  #     e <- erdos.renyi.game(t$Size, t$Links, type="gnm",directed = TRUE)
  #
  #   return(e) }
  # )

  if(ncores) {
    cn <- future::availableCores()
    if(ncores>cn)
      ncores <- cn
    future::plan(multiprocess, workers=ncores)
    on.exit(future::plan(sequential))
  } else {
    future::plan(sequential)
  }

  ind <- data.frame()

  ind <- future_lapply(1:length(nullDist), function(i)
  {
    m<-cluster_spinglass(nullDist[[i]],weights=weights)
    modl <- m$modularity
    clus.coef <- transitivity(nullDist[[i]], type="Global")
    cha.path  <- average.path.length(nullDist[[i]])
    data.frame(modularity=modl,clus.coef=clus.coef,cha.path=cha.path)
  }, future.seed = TRUE)
  ind <- bind_rows(ind)

  ind$gamma <- t$Clustering/ind$clus.coef
  ind$lambda <- t$PathLength/ind$cha.path
  ind$SWness <- ind$gamma/ind$lambda

  # 99% confidence interval
  #
  sLevel <- sLevel/2
  qSW <- quantile(ind$SWness,c(sLevel,1-sLevel),na.rm = TRUE)
  qmo <- quantile(ind$modularity,c(sLevel,1-sLevel))

  mcc <- mean(ind$clus.coef)
  mcp <- mean(ind$cha.path)

  zcc <- (t$Clustering-mcc)/sd(ind$clus.coef)
  zcp <- (t$PathLength-mcp)/sd(ind$cha.path)
  qcc <- quantile(ind$clus.coef,c(sLevel,1-sLevel),na.rm = TRUE)
  qcp <- quantile(ind$cha.path,c(sLevel,1-sLevel),na.rm = TRUE)

  m<-cluster_spinglass(g, weights=weights)

  zmo <- (m$modularity - mean(ind$modularity))/sd(ind$modularity)

  mSW <- mean(t$Clustering/mcc*mcp/t$PathLength)
  mCI <- 1+(qSW[2]-qSW[1])/2

  isLowInsideCPL <- t$PathLength<=qcp[2]
  isGreaterCC <- t$Clustering>qcc[2]
  isSW       <- (isLowInsideCPL & isGreaterCC)
  isSWness   <- (mSW>mCI)

  return(list(da=data.frame(Clustering=t$Clustering, PathLength= t$PathLength, Modularity=m$modularity,
    zCC=zcc,zCP=zcp,zMO=zmo,
    CClow=qcc[1],CChigh=qcc[2],CPlow=qcp[1],CPhigh=qcp[2],MOlow=qmo[1],MOhigh=qmo[2],
    SWness=mSW,SWnessCI=mCI,
    isSW=isSW,isSWness=isSWness),sims=ind))
}

#' @export
calcModularitySWnessZScore<- function(g, nullDist,sLevel=0.01,ncores=0){
  calc_modularity_swness_zscore(g, nullDist,sLevel,ncores)
}

#' Calculation Small-world-ness z-scores
#'
#' The function calculates small-world-ness z-scores and 99\% CI intervals,
#' using as null model the list of networks in the nullDist parameter.
#'
#' @references
#' Marina, T. I., Saravia, L. A., Cordone, G., Salinas, V., Doyle, S. R., & Momo, F. R. (2018). Architecture of marine food webs: To be or not be a ‘small-world.’ PLoS ONE, 13(5), 1–13. https://doi.org/10.1371/journal.pone.0198217
#'
#' @param g  igraph object
#' @param nullDist list of igraph object with the null model simulations
#' @param sLevel significance level to calculate CI (two tails)
#' @param ncores number of cores to use paralell computation, if 0 sequential processing is used.
#'
#'
#' @return a list with two data frames: one with indices z-scores and CI
#'
#'  \item{Clustering}{ Clustering coefficient, measures the average fraction of pairs of neighbors of a node that are also neighbors of each other}
#'  \item{PathLength}{ Mean of the shortest paths between all pair of vertices }
#'  \item{Modularity}{ modularity measures how separated are different groups from each other, the algorithm \code{cluster_spinglass} was used to obtain the groups}
#'  \item{zCC,zCP,zMO}{Z-scores of Clustering,PathLength and Modularity with respect to a random Erdos-Renyi null model}
#'  \item{CClow,CChigh,CPlow,CPhigh,MOlow,MOhigh}{sLevel confidence intervals}
#'  \item{SWness,SWnessCI}{ Small-world-ness and it CI value}
#'  \item{isSW,isSWness}{ Logical variable signalling if the network is Small-world by the method of Marina 2018 or the method of Humprhies & Gurney 2008 }
#'
#'  Another data.frame with the values calculated for the nullDist.
#'
#' @export
#'
#' @importFrom igraph transitivity average.path.length
#' @importFrom foreach foreach %dopar%
#' @importFrom doFuture registerDoFuture
#' @importFrom future sequential multiprocess
#'
#' @examples
#' \dontrun{
#' nullg <- generateERbasal(netData[[1]],10)
#' calc_swness_zscore(netData[[1]],nullg)
#' }
#'
calc_swness_zscore<- function(g, nullDist,sLevel=0.01,ncores=0,weights=NA){

  if(!is_igraph(g))
    stop("Parameter g must be an igraph object")

  t <- calcTopologicalIndices(g)

  if(length(nullDist)<5)
    stop("nullDist: There has to be more than 5 elements in the list")

  registerDoFuture()
  if(ncores) {
    cn <- future::availableCores()
    if(ncores>cn)
      ncores <- cn
    future::plan(multiprocess, workers=ncores)
    on.exit(future::plan(sequential))
  } else {
    future::plan(sequential)
  }

  ind <- data.frame()

  ind <- foreach(i=1:length(nullDist),.combine='rbind',.inorder=FALSE,.packages='igraph') %dopar%
    {
      clus.coef <- transitivity(nullDist[[i]], type="Global")
      cha.path  <- average.path.length(nullDist[[i]])
      data.frame(clus.coef=clus.coef,cha.path=cha.path)
    }

  ind$gamma <- t$Clustering/ind$clus.coef
  ind$lambda <- t$PathLength/ind$cha.path
  ind$SWness <- ind$gamma/ind$lambda

  # 99% confidence interval
  #
  sLevel <- sLevel/2
  qSW <- quantile(ind$SWness,c(sLevel,1-sLevel),na.rm = TRUE)

  mcc <- mean(ind$clus.coef)
  mcp <- mean(ind$cha.path)

  zcc <- (t$Clustering-mcc)/sd(ind$clus.coef)
  zcp <- (t$PathLength-mcp)/sd(ind$cha.path)
  qcc <- quantile(ind$clus.coef,c(sLevel,1-sLevel),na.rm = TRUE)
  qcp <- quantile(ind$cha.path,c(sLevel,1-sLevel),na.rm = TRUE)

  mSW <- mean(t$Clustering/mcc*mcp/t$PathLength)
  mCI <- 1+(qSW[2]-qSW[1])/2

  isLowInsideCPL <- t$PathLength<=qcp[2]
  isGreaterCC <- t$Clustering>qcc[2]
  isSW       <- (isLowInsideCPL & isGreaterCC)
  isSWness   <- (mSW>mCI)

  return(list(da=data.frame(Clustering=t$Clustering, PathLength= t$PathLength,
                            zCC=zcc,zCP=zcp,
                            CClow=qcc[1],CChigh=qcc[2],CPlow=qcp[1],CPhigh=qcp[2],
                            SWness=mSW,SWnessCI=mCI,
                            isSW=isSW,isSWness=isSWness),sims=ind))
}

#' Calc topological roles among network communities/modules
#'
#' Topological roles characterize species as its roles between communities or modules, we calculate the modules using
#' the [igraph::cluster_spinglass()] function.
#' Topological roles are described by two parameters: the standardized within-module degree \eqn{dz} and the among-module
#' connectivity participation coefficient \eqn{PC}.  The within-module degree is a z-score that measures how well a species is
#' connected to other species within its own module compared with a random graph. The participation coefficient \eqn{PC}
#' estimates the distribution of the links of species among modules. As the community algorithm is stochastic we run it several
#' times and return the repeated runs for both parameters.
#'
#' @references
#'
#' 1. Guimerà, R. & Nunes Amaral, L.A. (2005). Functional cartography of complex metabolic networks. Nature, 433, 895–900
#'
#' 1. Kortsch, S. et al. 2015. Climate change alters the structure of arctic marine food webs due to poleward shifts of boreal generalists. - Proceedings of the Royal Society B: Biological Sciences 282: 20151546. https://doi.org/10.1098/rspb.2015.1546

#'
#' @param g an Igraph object with the network
#' @param nsim  number of simulations with different community
#' @param ncores  number of cores to use paralell computation, if 0 sequential processing is used.
#'
#' @return a  data frame with two numeric fields: within_module_degree, among_module_conn
#'
#' @export
#'
#' @import igraph
#' @importFrom foreach foreach %dopar%
#' @importFrom doFuture registerDoFuture
#' @importFrom future sequential multiprocess
#'
#' @examples
#' #' \dontrun{
#'
#' g <- netData[[2]]
#'
#' tp <- calc_topological_roles(g,nsim=10)
#'
#' }

calc_topological_roles <- function(g,nsim=1000,ncores=0)
{
  if(!is_igraph(g))
    stop("Parameter g must be an igraph object")

  toRol <- data.frame()

  registerDoFuture()
  if(ncores) {
    cn <- future::availableCores()
    if(ncores>cn)
      ncores <- cn
    future::plan(multiprocess, workers=ncores)
    on.exit(future::plan(sequential))
  } else {
    future::plan(sequential)
  }

  toRol <- foreach(idx=1:nsim,.combine='rbind',.inorder=FALSE,.packages='igraph') %dopar%
  {
    # within-module degree
    #
    # Standarized Within module degree z-score
    #
    m<-cluster_spinglass(g,weights = NA)
    spingB.mem<- m$membership

    l<-vector()
    memMod<-vector()

    for (i in 1:vcount(g)){

      sp.in.deg <- V(g)[nei(i, "in")]
      sp.out.deg<- V(g)[nei(i, "out")]
      mem.sp<-spingB.mem[i]
      k<- length(which(spingB.mem[c(sp.in.deg, sp.out.deg)]==mem.sp))
      mem<- which(spingB.mem==mem.sp)

      for (m in 1:length(mem)){
        mem.in.deg <- V(g)[nei(mem[m], "in")]
        mem.out.deg<- V(g)[nei(mem[m], "out")]
        memMod.id<- length(which(spingB.mem[c(mem.in.deg, mem.out.deg)]==mem.sp))
        memMod[m]<- memMod.id
      }

      k.ave<- mean(memMod)
      k.sd<- sd(memMod)
      l[i]<- (k-k.ave)/k.sd
    }

    # among module connectivity
    r<- vector()
    for (i in 1:vcount(g)){

      d<-degree(g)[i]
      sp.in.deg <- V(g)[nei(i, "in")]
      sp.out.deg<- V(g)[nei(i, "out")]
      mod.sp<-table(spingB.mem[c(sp.in.deg, sp.out.deg)])
      mod.no<-as.numeric(names(mod.sp))
      mod<-rep(0, length(unique(spingB.mem)))
      mod[mod.no]<-c(mod.sp)
      r[i]<- 1-(sum((mod/d)^2))
    }
    return(data.frame(node=1:vcount(g),within_module_degree=l, among_module_conn=r))

  }

  return(toRol)
}

#' Classify and plot topological roles
#'
#' We use the topological roles calculated with [calc_topological_roles()] and categorize them following the approach of
#' Kortsch (2015), that defines species roles based in two thresholds \eqn{PC=0.625} and \eqn{dz=2.5}.
#' If a species had at least 60% of links within its own module then \eqn{PC<0.625}, and if it also had \eqn{dz\ge 2.5}, thus it was
#' classified as a module hub, labeled **modhub**. If a species had \eqn{PC<0.625} and \eqn{dz<2.5}, then it was called a peripheral
#' or specialist, labeled **modspe**. Species that had \eqn{PC\ge0.625} and \eqn{dz<2.5} were considered module connectors **modcon**.
#' Finally, if a species had \eqn{PC\ge0.625} and \eqn{dz\ge 2.5}, then it was classified as a super-generalist or hub-connector **hubcon**.
#'
#' @references
#'
#'1. Kortsch, S., Primicerio, R., Fossheim, M., Dolgov, A. V & Aschan, M. (2015). Climate change alters the structure of arctic marine food webs due to poleward shifts of boreal generalists. Proc. R. Soc. B Biol. Sci., 282
#'
#' 1. Saravia, L.A., Marina, T.I., De Troch, M. & Momo, F.R. (2018). Ecological Network assembly: how the regional meta web influence local food webs. bioRxiv, 340430, doi: https://doi.org/10.1101/340430
#'
#' @param tRoles Calculated topological roles with the function [calc_topological_roles()]
#' @param g Igraph network object
#' @param spingB Igraph community object
#' @param plt logical whether a plot is generated
#'
#' @return a data.frame with the classified topological roles
#' @export
#'
#' @importFrom RColorBrewer brewer.pal
#' @importFrom dplyr %>% group_by summarise_all inner_join
#'
#' @examples
#' \dontrun{
#'
#' g <- netData[[2]]
#'
#' tp <- calc_topological_roles(g,nsim=10)
#'
#' classify_topological_roles(tp,g,plt=TRUE)
#' }
classify_topological_roles <- function(tRoles,g,spingB=NULL,plt=FALSE){

  if(is.null(spingB))
    spingB <- cluster_spinglass(g,weights=NA)

  spingB.mem<- spingB$membership
  tRoles <- tRoles %>% group_by(node) %>% summarise_all(mean)
  l <- tRoles$within_module_degree
  r <- tRoles$among_module_conn
  # Plot
  if(plt){

    colbar.FG <- brewer.pal(length(spingB$csize),"Dark2")

    old_par <- par(mfrow=c(1,1))
    par(oma=c(2.7,1.3,0.7,1)) # change outer figure margins
    par(mai=c(1,1,0.7,0.7)) # size of figure margins
    yran <- range(l,na.rm = TRUE,finite=TRUE)
    xran <- range(r)
    plot(l~r, type="n", axes=T ,tck=F, lwd=2, ann=F, cex.axis=1.2, xlim=xran, ylim=yran)
    lines(c(0.625,0.625), yran, col="grey")
    lines(xran, c(2.5, 2.5), col="grey")
    points(r, l, col=colbar.FG[spingB.mem], pch=20, cex=2)
    mtext(2, text="Within module degree", line=4,font=2, cex=1.2)
    mtext(1, text="Among module connectivity",line=4, font=2, cex=1.2)
    axis(1, tck=0.02, lwd=1,las=2,lty=1, labels=F, xlim=c(0,1))
    axis(2,tck=0.02, labels=FALSE)
  }
  # Which are the module hubs: many links within its own module.
  #
  modhub <- which(l>2.5)
  modhub <- modhub[which(l>2.5) %in% which(r<=0.625)]
  modlbl <- vertex_attr(g, "name", index=modhub)
  if(is.null(modlbl))
    modlbl <- modhub
  hub_conn <- data.frame()

  if(length(modhub)) {
    if(plt) text(r[modhub],l[modhub],labels = modlbl,cex=0.7,pos=3)
    hub_conn <- data.frame(type="modhub",node=modhub,name=modlbl)
  }

  #points(r[modhub], l[modhub], cex=4, col="blue", pch=20)

  # Which are the hub connectors: high within and between-module connectivity
  #                              and are classified super-generalists
  #
  modhub <- which(l>2.5)
  modhub <- modhub[which(l>2.5) %in% which(r>0.625)]
  modlbl <- vertex_attr(g,"name",index=modhub)
  if(is.null(modlbl))
    modlbl <- modhub
  if(length(modhub)) {
    if(plt) {
      text(r[modhub],l[modhub],labels = modlbl,cex=0.7,pos=3)
      par(old_par)
    }
  }

  #points(r[modhub], l[modhub], cex=4, col="blue", pch=20)
  if(length(modhub)){
    hub_conn <- rbind(hub_conn, data.frame(type="hubcon",node=modhub,name=modlbl))
  }

  # Which are the module specialist: Few links and most of them within its own module
  #
  modhub <- which(l<=2.5)
  modhub <- modhub[which(l<=2.5) %in% which(r<=0.625)]
  modlbl <- vertex_attr(g,"name",index=modhub)
  if(is.null(modlbl))
    modlbl <- modhub

  hub_conn <- rbind(hub_conn, data.frame(type="modspe",node=modhub,name=modlbl))

  # Which are the module connectors: Few links and between modules
  #
  modhub <- which(l<=2.5)
  modhub <- modhub[which(l<=2.5) %in% which(r>0.625)]
  modlbl <- vertex_attr(g,"name", index=modhub)
  if(is.null(modlbl))
    modlbl <- modhub

  hub_conn <- rbind(hub_conn, data.frame(type="modcon",node=modhub,name=modlbl))
  hub_conn <- hub_conn %>% inner_join(tRoles)
  return(hub_conn)
}

#' Calculation of Modularity for a list of igraph objects
#'
#' The function calculates modularity of the list of networks in the nullDist parameter.
#' Modularity is calculated using the [igraph::cluster_spinglass()]
#' Only works for one component networks.
#'
#'
#' @param ig list of igraph objects to calculate modularity
#' @param ncores number of cores used to compute in parallel, if 0 sequential processing is used.
#' @param weights The weights of the edges. Either a numeric vector or NULL or NA. If it is null and the input graph has a ‘weight’ edge attribute
#'                then that will be used. If NULL and no such attribute is present then the edges will have equal weights.
#'                Set this to NA if the graph was a ‘weight’ edge attribute, but you don't want to use it for community detection.

#'
#' @return a data.frame with the field Modularity
#'
#' @export
#'
#' @import igraph
#' @importFrom future.apply future_lapply
#' @importFrom future sequential multiprocess
#'
#'
#' @examples
#' \dontrun{
#' nullg <- generateERbasal(netData[[1]],10)
#' calc_modularity(nullg)
#' }
#'
calc_modularity <- function(ig,ncores=0,weights=NA){

  if(inherits(ig,"igraph")) {
    ig <- list(ig)
  } else if(class(ig[[1]])!="igraph") {
    stop("parameter ig must be an igraph object")
  }

  registerDoFuture()
  if(ncores) {
    cn <- future::availableCores()
    if(ncores>cn)
      ncores <- cn
    future::plan(multiprocess, workers=ncores)
    on.exit(future::plan(sequential))
  } else {
    future::plan(sequential)
  }
  df <-  future_lapply(ig, function(g)
    {
      m<-cluster_spinglass(g,weights=weights)
      modl <- m$modularity
      data.frame(Modularity=modl)
    }, future.seed=TRUE)
  return(bind_rows(df))
}


library(ggplot2)

args <- commandArgs(trailingOnly = TRUE)

read.csv(args[1])

regrex1 = read.csv(args[1])

#regrex1 = read.csv("regrex1.csv")

png("r_orig.png")
r_orig = ggplot(regrex1, aes(x = x, y = y)) +
            geom_point()
r_orig
dev.off()

png("r_lm.png") #open device called png
r_lm = ggplot(regrex1, aes(x = x, y = y)) +
            geom_point() +
            geom_smooth(method = "lm", se = FALSE)
r_lm
dev.off()


library(tidyverse)
library(janitor)
library(viridis)
library(ggrepel)
library(gganimate)
library(gifski)
library(wppExplorer)
library(wbstats)
G_base_url <- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_19-covid-"
MIN_COUNT_START <- 75
NUM_COUNTRIES_LABEL <- 10
Highlight_country <- "Canada"
country_2_remove <- c("China","Cruise Ship")
#country_2_remove <- c("Cruise Ship")
#country_2_remove <- c("BLA BLA BLA")

#################################
#
# get CSV File from URL link
#
covid_19_get_file <- function(type = "Confirmed", base_url = G_base_url){
  full_url  <- paste0(base_url, type, ".csv")
  df_raw <- read_csv(full_url)
  df_raw$type <- type
  return(df_raw)
}

#################################
#
#  Get JHU DATa
#
covid_19_get_data <- function(base_url = G_base_url, types = c("Confirmed", "Deaths","Recovered")){

  a <- map(.x = types, .f = covid_19_get_file,  base_url = base_url)
  a <- a %>% map_df(.f = rbind)
  a <- a %>% clean_names()

  a %>% pivot_longer(cols = starts_with(match = "x"), names_to = "date") %>%
    mutate(date = as.Date(date, "x%m_%d_%y")) %>%
    mutate(full_geo = paste0(province_state, "_", country_region))
}

get_covid_19_International_compare <- function(){

  df_raw <- NULL
  df_raw <- covid_19_get_data()
  df<- df_raw

  #####################3
  # what is the latest date
  MAX_DATE <- df$date %>% max()
  df %>% filter(country_region == Highlight_country) %>% pull(date) %>% max()
  #df %>% group_by(country_region) %>% slice(which.max(date)) %>% View()

  top_countries <-
    df %>%
    filter(type == "Confirmed") %>%
    group_by(country_region) %>%
    summarise(value = max(value)) %>%
    arrange(desc(value)) %>% head(16) %>%
    pull(country_region)

  df %>%
    group_by(country_region, type, date) %>%
    summarise(value = sum(value)) %>%
    pivot_wider(names_from = type, values_from = value) %>%
    mutate(currently_sick = Confirmed - Deaths - Recovered) %>%
    pivot_longer(cols = c("currently_sick" ,"Confirmed" ,"Deaths" , "Recovered"), names_to = "type") %>%
    filter(type != "Confirmed" ) %>%
    filter(country_region %in% top_countries) %>%
    group_by(country_region) %>%
    mutate(value_max = max(value)) %>%
    ungroup(country_region) %>%
    mutate(country_region = paste0(country_region, "\nMax infected (", value_max, ")")) %>%
    mutate(country_region = fct_reorder(country_region, 1/value_max)) %>%
    ggplot(aes(x = date, y = value, color = type, fill= type)) +
    geom_point() +
    geom_line() +
    scale_y_log10() +
    facet_wrap(vars(country_region)) +
    theme_bw() +
    labs(title = "COVID-19 most infections in country", y = "Counts", X = "Dates")

}
get_covid_19_growth_compare <- function(){

  df_raw <- NULL
  df_raw <- covid_19_get_data()
  df<- df_raw

  #####################3
  # what is the latest date
  MAX_DATE <- df$date %>% max()
  df %>% filter(country_region == Highlight_country) %>% pull(date) %>% max()
  #df %>% group_by(country_region) %>% slice(which.max(date)) %>% View()

  # df %>% count(full_geo)
  # df %>% count(country_region)
  # df %>% count(province_state, sort = T)

  ###################################
  #Mutate the dataframe for plotting
  df_p <-
    df %>% # filter(country_region == "Canada") %>%
    arrange(date, full_geo) %>%
    #group_by(full_geo, lat, long, type, country_region, province_state) %>%

    group_by( type, country_region, date) %>%
    #group_by( type, province_state, date) %>%
    summarise(value = sum(value)) %>%
    filter(value > MIN_COUNT_START) %>% ungroup() %>%
    group_by( type, country_region) %>%
    #group_by( type, province_state) %>%

    mutate(date_min = min(date)) %>%
    ungroup() %>%
    mutate(date_since = date - date_min) %>%
    mutate(delta_dates = date_since - lag(date_since, n = 1), delta_value = value - lag(value, n = 1)) %>%
    mutate(const = (value / lag(value, n = 1))/as.integer(delta_dates)) %>%
    filter(!(country_region %in% country_2_remove)) %>%
    filter(type == "Confirmed") %>%
    drop_na()

  longest_countries <-
  df_p %>% #pull(province_state) %>% unique()
    group_by(country_region) %>%
    mutate(N = n()) %>%
    slice(which.max(date)) %>%
    ungroup() %>%
    arrange(desc(N)) %>%
    mutate(., rank = 1:nrow(.)) %>%
    filter(rank < NUM_COUNTRIES_LABEL | country_region == Highlight_country) %>%
    pull(country_region) %>%
    unique()

  ##############################
  # Mutate the dataframe so we have only the ones we will label
  df_p_l <-
    df_p %>%
    #filter(rank < NUM_COUNTRIES_LABEL | country_region == Highlight_country) %>%
    filter(country_region %in% longest_countries | country_region == Highlight_country) %>%
    #mutate(lbl = paste(country_region, "\ncases=", value,"\ndays later=", date_since)) %>%
    mutate(lbl_short = paste(country_region, "\n", value)) %>%
    #mutate(lbl_short = paste(province_state, "\n", value)) %>%
    group_by(country_region) %>%
    #group_by(province_state) %>%
    slice(which.max(date)) %>%
    ungroup()

  df_dt <- df_p %>% distinct(date) %>% arrange(date)
  df_dt$lbl = as.character(df_dt$date)
  df_dt$x = 7
  df_dt$y = 20000
  df_dt<-df_dt %>% slice(which.max(date))

  #######################################
  # Plot the points and lines
  p <-
    df_p %>%
    ggplot(aes(x = date_since, y = value, color = country_region), color = "grey", alpha = 0.5) +
    #ggplot(aes(x = date_since, y = value, color = province_state), color = "grey", alpha = 0.5) +
    geom_point() +
    geom_line(aes(group = country_region)) +
    #geom_line(aes(group = province_state)) +
    geom_text(data = df_dt, aes(x= x, y= y, label = lbl), size=8, color = "grey") +
    #geom_smooth(aes(group = country_region), method = "lm", se = F) +
    #geom_smooth(inherit.aes = F, mapping = aes(x = date_since, y = value), size = 2, color = "black") +
    scale_y_log10() +
    #scale_color_viridis() +
    annotation_logticks(sides = "l") +
    theme_bw() +
    theme(legend.position = "none")

  #p
  ############## xcvxcvxcv########################
  # Add the points and lines for Canada
  p<-
    p+
    geom_point(data = df_p%>% filter(country_region == Highlight_country), color = "red", size = 2) +
    geom_line(data = df_p%>% filter(country_region == Highlight_country), color = "red", size = 2)
    #geom_smooth(data = df_p%>% filter(country_region == Highlight_country), method = "lm", color = "black", size = 1, fullrange=TRUE, linetype = "dashed") +

  p <- p +
    labs(caption = paste0("data = ", G_base_url),
         x = paste0("Days Since ",MIN_COUNT_START , " infections."), y = "Number Of Cases",
         title = paste0("COVID-19 Growth By Country\nlast day of data = ", MAX_DATE))
  #p

  ########################################
  # Add labels for some of the lines
  p <- p +  geom_label_repel(data = df_p_l %>% filter(country_region != Highlight_country) , mapping = aes(label = lbl_short), alpha = 0.75, seed = 123)
  #p <- p +  geom_label(data = df_p_l , mapping = aes(label = lbl_short), alpha = 0.75, seed = 123)

  p <- p +  geom_label(data = df_p_l %>% filter(country_region == Highlight_country) , mapping = aes(label = lbl_short), alpha = 0.75, seed = 123, color = "red")
  p

  #
  # anim <- p +
  #   transition_reveal(date)
  #
  # animate(anim, nframes = 200, renderer = gifski_renderer("gganim.gif", width = 1024, height = 768), end_pause = 100)
  #
  #
  #

}

# p<-
# df  %>% filter(country_region == "US") %>%
#   ggplot(aes(x = date, y = value, color = full_geo, group = full_geo)) +
#   geom_line() +
#   geom_point() +
#   #geom_line(data = df %>% filter(country_region == "Canada"), color = "black" , size = 3, stroke = 3) +
#   #viridis::scale_color_viridis() +
#   scale_y_log10() +
#   facet_grid(rows = vars(type)) +
#   theme(legend.position = "none") +
#   annotation_logticks(sides = "l")
#
#
# ggplotly(p)

#   df %>%
#   arrange(date, full_geo) %>%
#   group_by(full_geo, lat, long, type, country_region, province_state) %>%
#   mutate(delta_date = date - lag(date, n = 5), delta_value = value - lag(value, n = 5), const = (value / lag(value, n = 7))/7) %>%
#   #mutate(slope = lag_value / as.integer(lag_date)) %>%
#   #mutate(up_rate = slope / value) %>% # View()
#   mutate(grp = paste(full_geo, type, sep = "_")) %>%
#   ungroup() %>%
#   filter(type == "Confirmed") %>%
#   filter(value > 75) %>%
#   arrange(full_geo, date) %>%
#   ggplot(aes(x = date, y = const, color = country_region)) +
#   geom_point() +
#   #geom_line(aes(group = full_geo)) +
#   #geom_smooth(aes(group = full_geo), method = "gam", se = F) +
#   scale_y_log10() +
#   #theme(legend.position = "none") +
#   facet_grid(rows = vars(type))
#
#
#
#
# ggplotly(p)
#   mutate(delta_date = date - lag(date, n = 5), delta_value = value - lag(value, n = 5), const = (value / lag(value, n = 7))/7) %>%
#     #mutate(slope = lag_value / as.integer(lag_date)) %>%
#     #mutate(up_rate = slope / value) %>% # View()
#     mutate(grp = paste(full_geo, type, sep = "_")) %>%
#     ungroup() %>%
#     filter(type == "Confirmed") %>%
#
#     filter(country_region != "China") %>%
#     arrange(full_geo, date) %>%
#
# ggplotly(p)
#
# df %>% count(country_region) %>% view()
# df %>% filter(country_region == "Canada" & type == "Confirmed")  %>% arrange(desc(date))
#
# library(plotly)
#
#
#   group_by(date) %>%
#   summarise(value = sum(value)) %>%
#   arrange(desc(date)) %>%
#


library(tidyverse)

# lst_dates --------------------------------------------------------------------
lst_dates <- list(seq.Date(from = as.Date("2010-01-01"), to = as.Date("2019-12-31"), by = "month"))

# trunc_rnorm ------------------------------------------------------------------
trunc_rnorm <- function(n, mean = 0, sd = 1, lwr = -Inf, upr = Inf, nnorm = n) {
  samp <- rnorm(n = nnorm, mean = mean, sd = sd)
  samp <- samp[samp >= lwr & samp <= upr]
  if (length(samp) >= n) {
    return(sample(samp, n))
  } else {
    trunc_rnorm(n = n, mean = mean, sd = sd, lwr = lwr, upr = upr, nnorm = nnorm * 1.1)
  }
}

# example_keywords -------------------------------------------------------------
kw_control <- tibble(
  type = "control",
  batch = 1,
  keyword = c("gmail", "maps", "translate", "wikipedia", "youtube")
)

kw_object <- tibble(
  type = "object",
  batch = 1:4,
  keyword = list(
    c("fc barcelona", "fc bayern", "manchester united", "real madrid"),
    c("bayern munich", "bayern munchen"),
    c("amazon", "apple", "facebook", "google"),
    c("instagram", "microsoft", "netflix", "twitter")
  )
) %>%
  unnest(cols = keyword)

example_keywords <- bind_rows(kw_control, kw_object)
usethis::use_data(example_keywords, overwrite = TRUE)

# example_time -----------------------------------------------------------------
ti_control <- tibble(
  type = "control",
  batch = 1,
  time = "2010-01-01 2019-12-31"
)

ti_object <- tibble(
  type = "object",
  batch = 1:4,
  time = "2010-01-01 2019-12-31"
)

example_time <- bind_rows(ti_control, ti_object)
usethis::use_data(example_time, overwrite = TRUE)

# example_control --------------------------------------------------------------
stat_control <- read_rds("stat_control.rds")

out <- map(
  seq(nrow(stat_control)),
  ~ with(
    stat_control[.x, ],
    trunc_rnorm(n = 120, mean = mean, sd = sd, lwr = min, upr = max)
  )
)

example_control <- stat_control %>%
  select(location, keyword) %>%
  mutate(
    hits = out,
    date = lst_dates,
    batch = 1L
  ) %>%
  unnest(cols = c(hits, date)) %>%
  mutate(
    hits = as.integer(hits),
    date = as.integer(date)
  )

usethis::use_data(example_control, overwrite = TRUE)

# example_object ------------------------------------------------------------------
stat_object <- read_rds("stat_object.rds")

out <- map(
  seq(nrow(stat_object)),
  ~ with(
    stat_object[.x, ],
    trunc_rnorm(n = 120, mean = mean, sd = sd, lwr = min, upr = max)
  )
)

example_object <- stat_object %>%
  select(location, keyword, batch_o) %>%
  mutate(
    hits = out,
    date = lst_dates,
    batch_c = 1L
  ) %>%
  unnest(cols = c(hits, date)) %>%
  mutate(
    hits = as.integer(hits),
    date = as.integer(date)
  )

usethis::use_data(example_object, overwrite = TRUE)

# example_score ----------------------------------------------------------------
stat_score <- read_rds("stat_score.rds")

out <- map(
  seq(nrow(stat_score)),
  ~ with(
    stat_score[.x, ],
    trunc_rnorm(n = 120, mean = mean, sd = sd, lwr = min, upr = max)
  )
)

example_score <- stat_score %>%
  select(location, keyword, type) %>%
  left_join(example_keywords, by = "keyword") %>%
  select(-type.y, type = type.x, batch_o = batch) %>%
  mutate(
    score = out,
    date = lst_dates,
    batch_c = 1L
  ) %>%
  unnest(cols = c(score, date)) %>%
  mutate(date = as.integer(date)) %>%
  pivot_wider(names_from = type, values_from = score)

usethis::use_data(example_score, overwrite = TRUE)

# example_doi ------------------------------------------------------------------
stat_doi <- read_rds("stat_doi.rds")

out <- map(
  seq(nrow(stat_doi)),
  ~ with(
    stat_doi[.x, ],
    trunc_rnorm(n = 120, mean = mean, sd = sd, lwr = min, upr = max)
  )
)

example_doi <- stat_doi %>%
  select(keyword, type, measure) %>%
  left_join(example_keywords, by = "keyword") %>%
  select(-type.y, type = type.x, batch_o = batch) %>%
  mutate(
    doi = out,
    date = lst_dates,
    batch_c = 1L,
    locations = "countries"
  ) %>%
  unnest(cols = c(doi, date)) %>%
  mutate(date = as.integer(date)) %>%
  pivot_wider(names_from = measure, values_from = doi)

usethis::use_data(example_doi, overwrite = TRUE)


library(shiny)
# install.packages('shinydashboard')
library(shinydashboard)
library(fmsb)
library(dplyr)
library(readr)
library(ECharts2Shiny)

library(reticulate)
source_python('py_helpers.py')

#######################################################
################ FMSB INGESTION ####################

# read in data from github
data <-  "https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/vaccinations/vaccinations.csv"
data <- read_csv(data)

#######################################################
################ DATA MANIPULATION ####################

# extract most recent rows for each country
recent <- data.frame(data) %>%
  group_by (location) %>%
  slice(which.max(date))

data_out <- as.data.frame(manip_data(recent, 'total_vaccinations',
                                     top_n = 6, early_out=FALSE))

#######################################################
############### RADAR CHART TESTING ###################

# https://www.r-graph-gallery.com/142-basic-radar-chart.html
# >> (Can't get axes labels to pop up!)
radarchart(data_out, caxislabels=seq(20, 100, 20), axislabcol="grey")

#######################################################
################ FMSB DASHBOARDING ####################

ui <- shinyUI(dashboardPage(
  dashboardHeader(title = "COVID Radar Charts 😃"),
  dashboardSidebar(),
  dashboardBody(
    # Boxes need to be put in a row (or column)
    fluidRow(
      box(
        selectInput(
          "metric_type",
          "Please select the metric you wish to investigate",
          choices = c(colnames(recent))[-c(1:3)]
        )
      ),

      box(
        title = "Controls",
        sliderInput(
          "top_boundary",
          "Please select how many top countries you want to see:",
          min = 3,
          max = 30,
          value = 10,
          step = 1
        )
      )
    ),
    fluidRow(
      # box(selectizeInput("geo_13_14",
      #                           "Select the school, sos my wording:")),
             box(loadEChartsLibrary(),
               plotOutput('radarPlot')))
  )
))
server <- shinyServer(function(input, output) {
  output$radarPlot <- renderPlot({
    # Create data: note in High school for several students
    set.seed(99)
    data = data_out
    radarchart(as.data.frame(manip_data(recent, input$metric_type, top_n=input$top_boundary)))
    # radarchart(as.data.frame(manip_data(recent, input$download)))
  },
  width = 800,
  height = 600)
})

# FMSB BASED SHINY DASHBOARD
shinyApp(ui = ui, server = server)

#######################################################
#######################################################

#######################################################
################ E CHARTS EXPERIMENTAL ################

# (NOT FULLY FUNCTIONAL)
ui_echarts <- fluidPage(
  # We MUST load the ECharts javascript library in advance
  loadEChartsLibrary(),

  tags$div(id="test", style="width:50%;height:400px;"),
  deliverChart(div_id = "test")
)

# (NOT FULLY FUNCTIONAL)
server_echarts <- function(input, output) {
  renderRadarChart(div_id = "test",
                  data = data_out)
}

# E CHARTS BASED SHINY DASHBOARD (NOT FULLY FUNCTIONAL)
shinyApp(ui = ui_echarts, server = server_echarts)


\name{restore_matrix}
\alias{restore_matrix}
\title{
Restore the index vector to index matrix in layer_fun
}
\description{
Restore the index vector to index matrix in layer_fun
}
\usage{
restore_matrix(j, i, x, y)
}
\arguments{

  \item{j}{Column indices directly from \code{layer_fun}.}
  \item{i}{Row indices directly from \code{layer_fun}.}
  \item{x}{Position on x-direction directly from \code{layer_fun}.}
  \item{y}{Position on y-direction directly from \code{layer_fun}.}

}
\details{
The values that are sent to \code{layer_fun} are all vectors (for the vectorization
of the grid graphic functions), however, the heatmap slice where
\code{layer_fun} is applied to, is still represented by a matrix, thus, it would be
very convinient if all the arguments in \code{layer_fun} can be converted to the
sub-matrix for the current slice. Here, as shown in above example,
\code{\link{restore_matrix}} does the job. \code{\link{restore_matrix}} directly accepts the first
four argument in \code{layer_fun} and returns an index matrix, where rows and
columns correspond to the rows and columns in the current slice, from top to
bottom and from left to right. The values in the matrix are the natural order
of e.g. vector \code{j} in current slice.

For following code:

  \preformatted{
    Heatmap(small_mat, name = "mat", col = col_fun,
        row_km = 2, column_km = 2,
        layer_fun = function(j, i, x, y, w, h, fill) \{
            ind_mat = restore_matrix(j, i, x, y)
            print(ind_mat)
        \}
    )  }

The first output which is for the top-left slice:

  \preformatted{
         [,1] [,2] [,3] [,4] [,5]
    [1,]    1    4    7   10   13
    [2,]    2    5    8   11   14
    [3,]    3    6    9   12   15  }

As you see, this is a three-row and five-column index matrix where the first
row corresponds to the top row in the slice. The values in the matrix
correspond to the natural index (i.e. 1, 2, ...) in \code{j}, \code{i}, \code{x}, \code{y},
... in \code{layer_fun}. Now, if we want to add values on the second column in the
top-left slice, the code which is put inside \code{layer_fun} would look like:

  \preformatted{
    for(ind in ind_mat[, 2]) \{
        grid.text(small_mat[i[ind], j[ind]], x[ind], y[ind], ...)
    \}  }
}
\examples{
set.seed(123)
mat = matrix(rnorm(81), nr = 9)
Heatmap(mat, row_km = 2, column_km = 2,
    layer_fun = function(j, i, x, y, width, height, fill) {
       ind_mat = restore_matrix(j, i, x, y)
       print(ind_mat)
})

set.seed(123)
mat = matrix(round(rnorm(81), 2), nr = 9)
Heatmap(mat, row_km = 2, column_km = 2,
    layer_fun = function(j, i, x, y, width, height, fill) {
       ind_mat = restore_matrix(j, i, x, y)
       ind = unique(c(ind_mat[2, ], ind_mat[, 3]))
       grid.text(pindex(mat, i[ind], j[ind]), x[ind], y[ind])
})
}