##### Code used for generation graphs used in JRC article on effective reproduction number estimating   ####
#####  parts of the code reutilizes already partly written code by othe researcrhes, the sources for these are:
#####https://www.datacamp.com/community/tutorials/replicating-in-r-covid19
##### https://www.r-bloggers.com/effective-reproduction-number-estimation/
#####
######
######
#####

### instructions to run the code  ####
### 1. set the homedirectory in your computer where to save the results
### 2. Uncomment the package installations if they are not installed
### 2. Execute the code, all output will be saved in the homedirectory

##   ADD HOMEDIRECTORY, for example "c:/DATA/COVID/RESULTS_CALCULATION"
Homedir<-"ADD DIRECTORY TO SAVE RESULTS HERE"

# uncomment if the packages are not installed
# install.packages("purrr")
# install.packages("knitr")
#install.packages("kableExtra")
# install.packages("viridis")
# install.packages("accelerometry")
# install.packages("tidyverse")
# install.packages("R0")
#install.packages("IRdisplay")
#install.packages("smoother")
#install.packages("HDInterval")

suppressPackageStartupMessages(library(purrr))
suppressPackageStartupMessages(library(knitr))
suppressPackageStartupMessages(library(kableExtra))
suppressPackageStartupMessages(library(viridis))
suppressPackageStartupMessages(library(accelerometry))
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(IRdisplay))
suppressPackageStartupMessages(library(smoother))
suppressPackageStartupMessages(library(HDInterval))

country_startdate <- function(Country_Name) {
if(Country_Name == "Italy") return("2020-02-20")
if(Country_Name == "Germany") return("2020-02-26")
  if(Country_Name == "Sweden") return("2020-02-27")
  if(Country_Name == "Hungary") return("2020-03-05")
  if(Country_Name == "Poland") return("2020-03-04")
}

### Set up distribution on generation time
GT_pmf <- structure( c(0, 0.1, 0.1, 0.2, 0.2, 0.2, 0.1, 0.1), names=0:7)
GT_obj <- R0::generation.time("empirical", val=GT_pmf)

GT_obj<-R0::generation.time("gamma", c(6.6, 1.5))

## Read in ECDC data   ##
data_ECDC <- read.csv("https://opendata.ecdc.europa.eu/covid19/casedistribution/csv", na.strings = "", fileEncoding = "UTF-8-BOM")

#####  Define functions to calculate effective reproduction number #######

####### Functions to use for effective reproduction number calculations   #######

##### Kevin systrom method   ########

est_rt_Systrom <- function(covid_cases, state_selected) {

  R_T_MAX = 12
  r_t_range = seq(0, R_T_MAX, length = R_T_MAX*100 + 1)
  GAMMA = 1/7

  #' Compute new cases and smooth them
  smooth_new_cases_1 <- function(cases){
    cases %>%
      arrange(date) %>%
      mutate(new_cases = c(cases[1], diff(cases))) %>%
      mutate(new_cases_smooth = round(
        smoother::smth.gaussian(new_cases, window = 7, alpha=7/4, tails = FALSE)
      )) %>%
      select(state, date, new_cases, new_cases_smooth)
  }

  #' Start using data first when smoothed value is above 25
  smooth_new_cases_25 <- function(x){
    start_index <- which(x$new_cases_smooth > 25)[1]
    length_vector <-dim(x)[1]
    return(x[start_index:length_vector,])
  }

  compute_likelihood <- function(cases){
    likelihood <- cases %>%
      filter(new_cases_smooth > 0) %>%
      mutate(
        r_t = list(r_t_range),
        lambda = map(lag(new_cases_smooth, 1), ~ .x * exp(GAMMA * (r_t_range - 1))),
        likelihood_r_t = map2(new_cases_smooth, lambda, dpois, log = TRUE)
      ) %>%
      slice(-1) %>%
      select(-lambda) %>%
      unnest(c(likelihood_r_t, r_t))
  }

  compute_posterior <- function(likelihood){
    likelihood %>%
      arrange(date) %>%
      group_by(r_t) %>%
      mutate(posterior = exp(
        zoo::rollapplyr(likelihood_r_t, 7, sum, partial = TRUE)
      )) %>%
      group_by(date) %>%
      mutate(posterior = posterior / sum(posterior, na.rm = TRUE)) %>%
      # HACK: NaNs in the posterior create issues later on. So we remove them.
      mutate(posterior = ifelse(is.nan(posterior), 0, posterior)) %>%
      ungroup() %>%
      select(-likelihood_r_t)
  }

  # Estimate R_t and a 95% highest-density interval around it
  estimate_rt <- function(posteriors){
    posteriors %>%
      group_by(state, date) %>%
      summarize(
        r_t_simulated = list(sample(r_t_range, 10000, replace = TRUE, prob = posterior)),
        r_t_most_likely = r_t_range[which.max(posterior)]
      ) %>%
      mutate(
        r_t_lo = map_dbl(r_t_simulated, ~ hdi(.x)[1]),
        r_t_hi = map_dbl(r_t_simulated, ~ hdi(.x)[2])
      ) %>%
      select(-r_t_simulated)
  }

  estimates <- covid_cases %>%
    filter(state == state_selected) %>%
    smooth_new_cases_1() %>%
    smooth_new_cases_25()  %>%
    compute_likelihood() %>%
    compute_posterior() %>%
    estimate_rt()

  return(estimates)

}

##### cislaghi method

est_rt_Cislaghi <- function(ts, window_interval) {
  data1 <- accelerometry::movingaves(ts, window=5)
  names(data1) <- names(ts)[3:(length(ts)-2)]
  res <- sapply( (1+window_interval):length(data1), function(t) {
    data1[t]/data1[t-window_interval]
  })
  return(res)

}

###### JRC method ###########################

est_rt_JRC <- function(ts, window_interval) {
  res <- sapply( 1:(length(ts)-window_interval), function(t) {
    ((log(ts[t+window_interval])-log(ts[t]))/window_interval)*7 + 1
  })
  return(res)

}

#### RKI method   ##############################

est_rt_rki <- function(ts, GT=4L) {
  # Sanity check
  if (!is.integer(GT) | !(GT>0)) stop("GT has to be postive integer.")
  # Estimate, if s=1 is t-7
  res <- sapply( (2*GT):length(ts), function(t) {
    sum(ts[t-(0:(GT-1))]) / sum(ts[t-2*GT+1:GT])
  })
  names(res) <- names(ts)[(2*GT):length(ts)]
  return(res)
}

###### Exponential growth, Wallinga & Lipsitch   ########

R.from.r <- function (r, GT) {
  Tmax = length(GT$GT)
  R = 1/sum(GT$GT * (exp(-r * (0:(Tmax - 1)))))
}

est_rt_exp <- function(ts, GT_obj, half_window_width=3L) {
  # Loop over all time points where the sliding window fits in
  res <- sapply((half_window_width+1):(length(ts)-half_window_width), function(t) {
    # Define the sliding window
    idx <- (t-half_window_width):(t+half_window_width)
    data <- data.frame(Date=1:length(ts), y=as.numeric(ts))
    # Fit a Poisson GLM
    m <- glm( y ~ 1 + Date, family=poisson, data= data  %>% slice(idx))
    # Extract the growth rate
    r <- as.numeric(coef(m)["Date"])

    # Equation 2.9 from Wallinga & Lipsitch
    R <- R.from.r(r, GT_obj)
    return(R)
  })
  names(res) <- names(ts)[(half_window_width+1):(length(ts)-half_window_width)]
  return(res)
}

######### Wallinga & Teunis   ##############

est_rt_wt <- function(ts1, GT_obj) {
  end1 <- length(ts1)

  R0::est.R0.TD(ts1, GT=GT_obj, begin=1, end=as.numeric(end1),correct=TRUE, nsim=1000)
}

#### cislaghi method  ######

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out <- data2[which(data2$CountryName == "Italy"),]
# Get starting date for the country
out<-out[dim(out)[1]:1,]
start_date <- as.Date(country_startdate("Italy"))
out <- out[out$Date %in% seq(from=start_date , to=out$Date[length(out$Date)] , by=1),]

rt_Cislaghi_3 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=3)
rt_Cislaghi_4 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=4)
rt_Cislaghi_5 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=5)
rt_Cislaghi_6 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=6)

rt_Cislaghi_3_df <- data.frame(Date=as.Date(names(rt_Cislaghi_3)), R_hat=rt_Cislaghi_3, Method=" 3")
rt_Cislaghi_4_df <- data.frame(Date=as.Date(names(rt_Cislaghi_4)), R_hat=rt_Cislaghi_4, Method=" 4")
rt_Cislaghi_5_df <- data.frame(Date=as.Date(names(rt_Cislaghi_5)), R_hat=rt_Cislaghi_5, Method=" 5")
rt_Cislaghi_6_df <- data.frame(Date=as.Date(names(rt_Cislaghi_6)), R_hat=rt_Cislaghi_6, Method=" 6")
max_R <- 5
Normalizer <-  max(out$y) / max_R
bar_data <- data.frame(Date = as.Date(out$Date),y_upd <- out$y/max(out$y) * max_R)
out$Method <- "New cases"
cols = c("red", "green", "blue", "orange", "black")
### produce the plots   ####

png(file.path(Homedir, "Casliaghi_Italy.png"), width = 800, height = 480)
ggplot(rt_Cislaghi_4_df, aes(x=Date, y=R_hat, color=Method)) +
  geom_line(data=rt_Cislaghi_3_df , lwd=1.5) +
  geom_line(data=rt_Cislaghi_4_df , lwd=1.5) +
  geom_line(data=rt_Cislaghi_5_df , lwd=1.5) +
  geom_line(data=rt_Cislaghi_6_df , lwd=1.5) +
  geom_line(data=out,
            aes(x = as.Date(Date),
                y = y / Normalizer), lwd=2)+

  scale_colour_manual(values = cols)+

  geom_hline(yintercept =1, lwd=1.5) +
  ylab(expression(R(t))) +
  ggtitle("Cislaghi (on Italian data)")+
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+

  scale_y_continuous(expand = c(0, 0), limits=c(0,max_R), sec.axis = sec_axis(trans= ~.*Normalizer,
                                                                              name = 'Number of new confirmed cases')) +
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())
dev.off()

#### Kevins Systrom method    ######

# r_t_range is a vector of possible values for R_t
R_T_MAX = 12
r_t_range = seq(0, R_T_MAX, length = R_T_MAX*100 + 1)

# Gamma is 1/serial interval
# https://wwwnc.cdc.gov/eid/article/26/6/20-0357_article
GAMMA = 1/7

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out <- data2[which(data2$CountryName == "Germany"),]
# Get starting date for the country
out<-out[dim(out)[1]:1,]
start_date <- as.Date(country_startdate("Germany"))
out <- out[out$Date %in% seq(from=start_date , to=out$Date[length(out$Date)] , by=1),]
names(out)<-c("date", "cases1", "state")
out2<-out
out$cases[1] <-out$cases1[1]
for (j in 2:dim(out)[1]) {
 out$cases[j] <-   out$cases[j-1]+  out$cases1[j]
}

rt_Systrom <- est_rt_Systrom(covid_cases=out, state_selected="Germany")

rt_Systrom_df <- data.frame(Date=rt_Systrom$date, R_hat=rt_Systrom$r_t_most_likely, upper=rt_Systrom$r_t_hi, lower=rt_Systrom$r_t_lo, Method="Systrom")

max_R <- 5
Normalizer <- max(out$cases1)   / max_R
bar_data <- data.frame(Date = as.Date(out$date),y_upd <- out$cases1/max(out$cases1) * max_R)
out$Method <- "Daily reported new cases"
cols = c("black", "blue")

### produce the plots   ####

png(file.path(Homedir, "Systrom_Germanyy.png"), width = 800, height = 480)
ggplot(rt_Systrom_df, aes(x=Date, y=R_hat, color=Method)) +
  geom_line(lwd=1.5)+
  geom_ribbon(data=rt_Systrom_df, aes( ymin=lower, ymax=upper),inherit.aes=TRUE, fill="lightgrey", alpha=0.3) +
  geom_line(data=out,
            aes(x = as.Date(date),
                y= cases1 / Normalizer, color="New cases"), lwd=2)+

  scale_colour_manual(values = cols)+

  geom_hline(yintercept =1, lwd=1.5) +
  ylab(expression(R(t))) +
  ggtitle("Systrom (on German data)")+
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+

  scale_y_continuous(expand = c(0, 0), limits=c(0,max_R), sec.axis = sec_axis(trans= ~.*Normalizer,
                                                                              name = 'Number of new confirmed cases')) +
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())
dev.off()

####   JRC method    #######

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out <- data2[which(data2$CountryName == "Germany"),]
# Get starting date for the country
out<-out[dim(out)[1]:1,]
start_date <- as.Date(country_startdate("Germany"))
out <- out[out$Date %in% seq(from=start_date , to=out$Date[length(out$Date)] , by=1),]

rt_jrc <- est_rt_JRC(out$y  %>% setNames(out$Date), window_interval=7)

rt_jrc_df <- data.frame(Date=as.Date(names(rt_jrc)), R_hat=rt_jrc, Method="JRC, GT=7")

max_R <- 5
Normalizer <-  max(out$y) / max_R
bar_data <- data.frame(Date = as.Date(out$Date),y_upd <- out$y/max(out$y) * max_R)
out$Method <- "New cases"

cols = c("red", "black")
### Make a plot of JRC method and epidemic curve  ###
png(file.path(Homedir, "JRC_Germany.png"), width = 800, height = 480)
ggplot(rt_jrc_df, aes(x=Date, y=R_hat, color=Method)) +
  geom_line(data=rt_jrc_df,lwd=1.5)+
  geom_line(data=out,
            aes(x = as.Date(Date),
                y = y / Normalizer), lwd=2)+
  # coord_cartesian(ylim=c(0, ,max_R)) +
  geom_hline(yintercept =1, lwd=1.5) +
  ylab(expression(R(t))) +
  scale_colour_manual(values = cols)+
  ggtitle("JRC method (on German data)")+
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+

  scale_y_continuous(expand = c(0, 0), limits=c(0,max_R), sec.axis = sec_axis(trans= ~.*Normalizer,
                                                                              name = 'Number of new confirmed cases')) +
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())
dev.off()

#############  RKI method ################

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out <- data2[which(data2$CountryName == "Germany"),]
# Get starting date for the country
out<-out[dim(out)[1]:1,]
start_date <- as.Date(country_startdate("Germany"))
out <- out[out$Date %in% seq(from=start_date , to=out$Date[length(out$Date)] , by=1),]

# RKI method as specified in 2020-04-24 version of the article
rt_rki <- est_rt_rki(out$y  %>% setNames(out$Date), GT=4L)

rt_rki_df <- data.frame(Date=as.Date(names(rt_rki)), R_hat=rt_rki, Method="RKI, GT=4")

max_R <- 5
Normalizer <-  max(out$y) / max_R
bar_data <- data.frame(Date = as.Date(out$Date),y_upd <- out$y/max(out$y) * max_R)
out$Method <- "New cases"

cols = c("black", "red")
### Make a plot of JRC method and epidemic curve  ###
png(file.path(Homedir, "RKI_method_Germany.png"), width = 800, height = 480)
ggplot(rt_rki_df, aes(x=Date, y=R_hat, color=Method)) +
  geom_line(data=rt_rki_df,lwd=1.5)+
  geom_line(data=out,
            aes(x = as.Date(Date),
                y = y / Normalizer), lwd=2)+
  # coord_cartesian(ylim=c(0, ,max_R)) +
  geom_hline(yintercept =1, lwd=1.5) +
  ylab(expression(R(t))) +
  scale_colour_manual(values = cols)+
  ggtitle("Robert Koch Institute method (on German data)")+
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+

  scale_y_continuous(expand = c(0, 0), limits=c(0,max_R), sec.axis = sec_axis(trans= ~.*Normalizer,
                                                                              name = 'Number of new confirmed cases')) +
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())
dev.off()

###### Wallinga & Lipsitch method    #############

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out <- data2[which(data2$CountryName == "Germany"),]
# Get starting date for the country
out<-out[dim(out)[1]:1,]
start_date <- as.Date(country_startdate("Germany"))
out <- out[out$Date %in% seq(from=start_date , to=out$Date[length(out$Date)] , by=1),]

# Exponential growth with discrete Laplace transform of a GT \equiv = 4 distribution
rt_exp2 <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=R0::generation.time("empirical", c(0,0,0,0,0,0,0,1)), half_window_width=3)

# Exponential growth with discrete Laplace transform of the correct GT distribution
rt_exp <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=GT_obj, half_window_width=3)

rt_exp_df <- data.frame(Date=as.Date(names(rt_exp)), R_hat=rt_exp, Method="Stochastic generation time")
#rt_exp_df <- data.frame(Date=as.Date(names(rt_exp_int[1:dim(rt_exp_int)[2]])), R_hat=rt_exp_int[1,], lower= rt_exp_int[2,], upper=rt_exp_int[3,], Method="Exp-Growth, random GT")

rt_exp2_df <- data.frame(Date=as.Date(names(rt_exp2)), R_hat=rt_exp2, Method="Generation time 7 days (constant)")

max_R <- 5
Normalizer <-  max(out$y) / max_R
bar_data <- data.frame(Date = as.Date(out$Date),y_upd <- out$y/max(out$y) * max_R)
out$Method <- "New cases"

cols = c("red", "black", "blue")
### Make a plot of JRC method and epidemic curve  ###
png(file.path(Homedir, "Wallinga_Lipsitch_germany.png"), width = 800, height = 480)
ggplot(rt_exp_df, aes(x=Date, y=R_hat, color=Method)) +
  geom_line()+
  geom_line(data=rt_exp2_df , lwd=1.5) +
  geom_line(data=out,
            aes(x = as.Date(Date),
                y = y / Normalizer), lwd=2)+
  # coord_cartesian(ylim=c(0, ,max_R)) +
  geom_hline(yintercept =1, lwd=1.5) +
  ylab(expression(R(t))) +
  scale_colour_manual(values = cols)+
  ggtitle("Wallinga and Lipsitch (exponential growth method) (on German data)")+
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+

  scale_y_continuous(expand = c(0, 0), limits=c(0,10), sec.axis = sec_axis(trans= ~.*Normalizer,
                                                                              name = 'Number of new confirmed cases')) +
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())
dev.off()

### Wallinga and Teuniss############

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out <- data2[which(data2$CountryName == "Germany"),]
# Get starting date for the country
out<-out[dim(out)[1]:1,]
start_date <- as.Date(country_startdate("Germany"))
out <- out[out$Date %in% seq(from=start_date , to=out$Date[length(out$Date)] , by=1),]

rt_wt <- est_rt_wt( out$y, GT=GT_obj)

rt_wt_df <- cbind(Date=out$Date[as.numeric(names(rt_wt$R))], R_hat=rt_wt$R, rt_wt$conf.int, Method="W & T, ramdom GT")

max_R <- 5
Normalizer <-  max(out$y) / max_R
bar_data <- data.frame(Date = as.Date(out$Date),y_upd <- out$y/max(out$y) * max_R)
out$Method <- "New cases"

cols = c("black", "blue")

png(file.path(Homedir, "Wallinga_Teunis_Germany.png"), width = 800, height = 480)
ggplot(rt_wt_df, aes(x=Date, y=R_hat, color=Method)) +
  geom_ribbon(data=rt_wt_df, aes( ymin=lower, ymax=upper),inherit.aes=TRUE, fill="lightgrey", alpha=0.6) +
    geom_line(lwd=0.5)+
  geom_line(data=out,
            aes(x = as.Date(Date),
                y= y / Normalizer, color="New cases"), lwd=2)+

scale_colour_manual(values = cols)+

  geom_hline(yintercept =1, lwd=1.5) +
  ylab(expression(R(t))) +
  ggtitle("Wallinga and Teunis (on German data")+
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+

  scale_y_continuous(expand = c(0, 0), limits=c(0,7), sec.axis = sec_axis(trans= ~.*Normalizer,
                                                                              name = 'Number of new confirmed cases')) +
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())
dev.off()

###### Apply different methods for Italy #######

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out_sys <- data2[which(data2$CountryName == "Italy"),]
# Get starting date for the country
out_sys<-out_sys[dim(out_sys)[1]:1,]
start_date <- as.Date(country_startdate("Italy"))
out_sys <- out_sys[out_sys$Date %in% seq(from=start_date , to=out_sys$Date[length(out_sys$Date)] , by=1),]
names(out_sys)<-c("date", "cases1", "state")
out2<-out_sys
out_sys$cases[1] <-out_sys$cases1[1]
for (j in 2:dim(out_sys)[1]) {
  out_sys$cases[j] <-   out_sys$cases[j-1]+  out_sys$cases1[j]
}

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out <- data2[which(data2$CountryName == "Italy"),]
# Get starting date for the country
out<-out[dim(out)[1]:1,]
start_date <- as.Date(country_startdate("Italy"))
out <- out[out$Date %in% seq(from=start_date , to=out$Date[length(out$Date)] , by=1),]

rt_Cislaghi_5 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=5)
rt_Cislaghi_5_df <- data.frame(Date=as.Date(names(rt_Cislaghi_5)), R_hat=rt_Cislaghi_5, Method=" 5")
rt_Systrom <- est_rt_Systrom(covid_cases=out_sys, state_selected="Italy")
rt_Systrom_df <- data.frame(Date=rt_Systrom$date, R_hat=rt_Systrom$r_t_most_likely, upper=rt_Systrom$r_t_hi, lower=rt_Systrom$r_t_lo, Method="Systrom")
rt_jrc <- est_rt_JRC(out$y  %>% setNames(out$Date), window_interval=7)
rt_jrc_df <- data.frame(Date=as.Date(names(rt_jrc)), R_hat=rt_jrc, Method="JRC, GT=7")
rt_rki <- est_rt_rki(out$y  %>% setNames(out$Date), GT=4L)
rt_rki_df <- data.frame(Date=as.Date(names(rt_rki)), R_hat=rt_rki, Method="RKI, GT=4")
rt_exp2 <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=R0::generation.time("empirical", c(0,0,0,0,0,0,0,1)), half_window_width=3)
rt_exp <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=GT_obj, half_window_width=3)
rt_exp_df <- data.frame(Date=as.Date(names(rt_exp)), R_hat=rt_exp, Method="Stochastic generation time")
rt_exp2_df <- data.frame(Date=as.Date(names(rt_exp2)), R_hat=rt_exp2, Method="Generation time 7 days (constant)")
rt_wt <- est_rt_wt( out$y, GT=GT_obj)
rt_wt_df <- cbind(Date=out$Date[as.numeric(names(rt_wt$R))], R_hat=rt_wt$R, rt_wt$conf.int, Method="W & T, ramdom GT")

max_R <- 5
Normalizer <-  max(out$y) / max_R
bar_data <- data.frame(Date = as.Date(out$Date),y_upd <- out$y/max(out$y) * max_R)
out$Method <- "New cases"

date_col <- c(as.Date(names(rt_exp2)), out$Date[as.numeric(names(rt_wt$R))],as.Date(names(rt_jrc)),  as.Date(names(rt_rki)), as.Date(names(rt_exp)), as.Date(names(rt_Cislaghi_5)), as.Date(rt_Systrom$date) )

R_col <- as.numeric(c(rt_exp2, rt_wt$R, rt_jrc, rt_rki, rt_exp, rt_Cislaghi_5, rt_Systrom_df$R_hat))

Method_col <- c( rep("Exp-Growth, GT = 7", length= length(rt_exp2)),  rep("W & T, ramdom GT", length= length(rt_wt$R)), rep("JRC, GT=7", length= length(rt_jrc)), rep("RKI, GT=4", length= length(rt_rki)), rep("Exp-Growth, random GT", length= length(rt_exp)), rep("Cislaghi, Window=5", length= length(rt_Cislaghi_5)),  rep("Systrom", length= dim(rt_Systrom)[1]))

Data_Total <- data.frame(Date=date_col, R_hat=R_col, Method=Method_col)

Data_total1 <- Data_Total[Data_Total$Method %in% c("Exp-Growth, GT = 7", "W & T, ramdom GT", "JRC, GT=7", "RKI, GT=4", "Exp-Growth, random GT", "Cislaghi, Window=5","Systrom"),]

### Plot the methods   ######
png(file.path(Homedir, "All_methods_Italy.png"), width = 800, height = 480)
ggplot(Data_total1, aes(x=Date, y=R_hat, group=Method)) +

  geom_ribbon(data= rt_wt_df, aes( ymin=lower, ymax=upper),inherit.aes=TRUE, fill="lightgrey", alpha=0.5) +
  #geom_line(data=Ret_true, size=2, color="red") +
  geom_line(aes(linetype=Method, color=Method, size=Method)) +
  scale_size_manual(values=c(1,1,1,1,1,1,1))+
    #scale_linetype_manual(values=c("twodash","longdash","dotdash","dashed","twodash","longdash","solid"))+
  coord_cartesian(ylim=c(0, 5)) +
  ylab(expression(R(t))) +

  scale_x_date(date_labels = "%b %d", breaks = "2 week")+
  geom_hline(yintercept=1, linetype="solid", color = "black")+
  ggtitle("R(t) estimate for Italy, grey area = 95% Wallinga & Teunis confidence interval")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())

dev.off()

png(file.path(Homedir, "Epidemic_curve_Italy.png"), width = 800, height = 480)
ggplot(out, aes(x=Date, y=y)) +
  geom_line(data=out , lwd=1.5) +
     ylab("Number of new confirmed cases") +
  ggtitle("Epidemic curve for Italy")+
  scale_x_date(date_labels = "%b %d")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 10),panel.background = element_blank())

dev.off()

###### Apply different methods for Germany #######

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out_sys <- data2[which(data2$CountryName == "Germany"),]
# Get starting date for the country
out_sys<-out_sys[dim(out_sys)[1]:1,]
start_date <- as.Date(country_startdate("Germany"))
out_sys <- out_sys[out_sys$Date %in% seq(from=start_date , to=out_sys$Date[length(out_sys$Date)] , by=1),]
names(out_sys)<-c("date", "cases1", "state")
out2<-out_sys
out_sys$cases[1] <-out_sys$cases1[1]
for (j in 2:dim(out_sys)[1]) {
  out_sys$cases[j] <-   out_sys$cases[j-1]+  out_sys$cases1[j]
}

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out <- data2[which(data2$CountryName == "Germany"),]
# Get starting date for the country
out<-out[dim(out)[1]:1,]
start_date <- as.Date(country_startdate("Germany"))
out <- out[out$Date %in% seq(from=start_date , to=out$Date[length(out$Date)] , by=1),]

rt_Cislaghi_5 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=5)
rt_Cislaghi_5_df <- data.frame(Date=as.Date(names(rt_Cislaghi_5)), R_hat=rt_Cislaghi_5, Method=" 5")
rt_Systrom <- est_rt_Systrom(covid_cases=out_sys, state_selected="Germany")
rt_Systrom_df <- data.frame(Date=rt_Systrom$date, R_hat=rt_Systrom$r_t_most_likely, upper=rt_Systrom$r_t_hi, lower=rt_Systrom$r_t_lo, Method="Systrom")
rt_jrc <- est_rt_JRC(out$y  %>% setNames(out$Date), window_interval=7)
rt_jrc_df <- data.frame(Date=as.Date(names(rt_jrc)), R_hat=rt_jrc, Method="JRC, GT=7")
rt_rki <- est_rt_rki(out$y  %>% setNames(out$Date), GT=4L)
rt_rki_df <- data.frame(Date=as.Date(names(rt_rki)), R_hat=rt_rki, Method="RKI, GT=4")
rt_exp2 <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=R0::generation.time("empirical", c(0,0,0,0,0,0,0,1)), half_window_width=3)
rt_exp <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=GT_obj, half_window_width=3)
rt_exp_df <- data.frame(Date=as.Date(names(rt_exp)), R_hat=rt_exp, Method="Stochastic generation time")
rt_exp2_df <- data.frame(Date=as.Date(names(rt_exp2)), R_hat=rt_exp2, Method="Generation time 7 days (constant)")
rt_wt <- est_rt_wt( out$y, GT=GT_obj)
rt_wt_df <- cbind(Date=out$Date[as.numeric(names(rt_wt$R))], R_hat=rt_wt$R, rt_wt$conf.int, Method="W & T, ramdom GT")

max_R <- 5
Normalizer <-  max(out$y) / max_R
bar_data <- data.frame(Date = as.Date(out$Date),y_upd <- out$y/max(out$y) * max_R)
out$Method <- "New cases"

date_col <- c(as.Date(names(rt_exp2)), out$Date[as.numeric(names(rt_wt$R))],as.Date(names(rt_jrc)),  as.Date(names(rt_rki)), as.Date(names(rt_exp)), as.Date(names(rt_Cislaghi_5)), as.Date(rt_Systrom$date) )

R_col <- as.numeric(c(rt_exp2, rt_wt$R, rt_jrc, rt_rki, rt_exp, rt_Cislaghi_5, rt_Systrom_df$R_hat))

Method_col <- c( rep("Exp-Growth, GT = 7", length= length(rt_exp2)),  rep("W & T, ramdom GT", length= length(rt_wt$R)), rep("JRC, GT=7", length= length(rt_jrc)), rep("RKI, GT=4", length= length(rt_rki)), rep("Exp-Growth, random GT", length= length(rt_exp)), rep("Cislaghi, Window=5", length= length(rt_Cislaghi_5)),  rep("Systrom", length= dim(rt_Systrom)[1]))

Data_Total <- data.frame(Date=date_col, R_hat=R_col, Method=Method_col)

Data_total1 <- Data_Total[Data_Total$Method %in% c("Exp-Growth, GT = 7", "W & T, ramdom GT", "JRC, GT=7", "RKI, GT=4", "Exp-Growth, random GT", "Cislaghi, Window=5","Systrom"),]

### Plot the methods   ######
png(file.path(Homedir, "All_methods_Germany.png"), width = 800, height = 480)
ggplot(Data_total1, aes(x=Date, y=R_hat, group=Method)) +

  geom_ribbon(data= rt_wt_df, aes( ymin=lower, ymax=upper),inherit.aes=TRUE, fill="lightgrey", alpha=0.5) +
  #geom_line(data=Ret_true, size=2, color="red") +
  geom_line(aes(linetype=Method, color=Method, size=Method)) +
  scale_size_manual(values=c(1,1,1,1,1,1,1))+
  #scale_linetype_manual(values=c("twodash","longdash","dotdash","dashed","twodash","longdash","solid"))+
  coord_cartesian(ylim=c(0, 5)) +
  ylab(expression(R(t))) +

  scale_x_date(date_labels = "%b %d", breaks = "2 week")+
  geom_hline(yintercept=1, linetype="solid", color = "black")+
  ggtitle("R(t) estimate for Germany, grey area = 95% Wallinga & Teunis confidence interval")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())

dev.off()

png(file.path(Homedir, "Epidemic_curve_Germany.png"), width = 800, height = 480)
ggplot(out, aes(x=Date, y=y)) +
  geom_line(data=out , lwd=1.5) +
  ylab("Number of new confirmed cases") +
  ggtitle("Epidemic curve for Germany")+
  scale_x_date(date_labels = "%b %d")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 10),panel.background = element_blank())

dev.off()

###### Apply different methods for Sweden #######

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out_sys <- data2[which(data2$CountryName == "Sweden"),]
# Get starting date for the country
out_sys<-out_sys[dim(out_sys)[1]:1,]
start_date <- as.Date(country_startdate("Sweden"))
out_sys <- out_sys[out_sys$Date %in% seq(from=start_date , to=out_sys$Date[length(out_sys$Date)] , by=1),]
names(out_sys)<-c("date", "cases1", "state")
out2<-out_sys
out_sys$cases[1] <-out_sys$cases1[1]
for (j in 2:dim(out_sys)[1]) {
  out_sys$cases[j] <-   out_sys$cases[j-1]+  out_sys$cases1[j]
}

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out <- data2[which(data2$CountryName == "Sweden"),]
# Get starting date for the country
out<-out[dim(out)[1]:1,]
start_date <- as.Date(country_startdate("Sweden"))
out <- out[out$Date %in% seq(from=start_date , to=out$Date[length(out$Date)] , by=1),]

rt_Cislaghi_5 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=5)
rt_Cislaghi_5_df <- data.frame(Date=as.Date(names(rt_Cislaghi_5)), R_hat=rt_Cislaghi_5, Method=" 5")
rt_Systrom <- est_rt_Systrom(covid_cases=out_sys, state_selected="Sweden")
rt_Systrom_df <- data.frame(Date=rt_Systrom$date, R_hat=rt_Systrom$r_t_most_likely, upper=rt_Systrom$r_t_hi, lower=rt_Systrom$r_t_lo, Method="Systrom")
rt_jrc <- est_rt_JRC(out$y  %>% setNames(out$Date), window_interval=7)
rt_jrc_df <- data.frame(Date=as.Date(names(rt_jrc)), R_hat=rt_jrc, Method="JRC, GT=7")
rt_rki <- est_rt_rki(out$y  %>% setNames(out$Date), GT=4L)
rt_rki_df <- data.frame(Date=as.Date(names(rt_rki)), R_hat=rt_rki, Method="RKI, GT=4")
rt_exp2 <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=R0::generation.time("empirical", c(0,0,0,0,0,0,0,1)), half_window_width=3)
rt_exp <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=GT_obj, half_window_width=3)
rt_exp_df <- data.frame(Date=as.Date(names(rt_exp)), R_hat=rt_exp, Method="Stochastic generation time")
rt_exp2_df <- data.frame(Date=as.Date(names(rt_exp2)), R_hat=rt_exp2, Method="Generation time 7 days (constant)")
rt_wt <- est_rt_wt( out$y, GT=GT_obj)
rt_wt_df <- cbind(Date=out$Date[as.numeric(names(rt_wt$R))], R_hat=rt_wt$R, rt_wt$conf.int, Method="W & T, ramdom GT")

max_R <- 5
Normalizer <-  max(out$y) / max_R
bar_data <- data.frame(Date = as.Date(out$Date),y_upd <- out$y/max(out$y) * max_R)
out$Method <- "New cases"

date_col <- c(as.Date(names(rt_exp2)), out$Date[as.numeric(names(rt_wt$R))],as.Date(names(rt_jrc)),  as.Date(names(rt_rki)), as.Date(names(rt_exp)), as.Date(names(rt_Cislaghi_5)), as.Date(rt_Systrom$date) )

R_col <- as.numeric(c(rt_exp2, rt_wt$R, rt_jrc, rt_rki, rt_exp, rt_Cislaghi_5, rt_Systrom_df$R_hat))

Method_col <- c( rep("Exp-Growth, GT = 7", length= length(rt_exp2)),  rep("W & T, ramdom GT", length= length(rt_wt$R)), rep("JRC, GT=7", length= length(rt_jrc)), rep("RKI, GT=4", length= length(rt_rki)), rep("Exp-Growth, random GT", length= length(rt_exp)), rep("Cislaghi, Window=5", length= length(rt_Cislaghi_5)),  rep("Systrom", length= dim(rt_Systrom)[1]))

Data_Total <- data.frame(Date=date_col, R_hat=R_col, Method=Method_col)

Data_total1 <- Data_Total[Data_Total$Method %in% c("Exp-Growth, GT = 7", "W & T, ramdom GT", "JRC, GT=7", "RKI, GT=4", "Exp-Growth, random GT", "Cislaghi, Window=5","Systrom"),]

### Plot the methods   ######
png(file.path(Homedir, "All_methods_Sweden.png"), width = 800, height = 480)
ggplot(Data_total1, aes(x=Date, y=R_hat, group=Method)) +

  geom_ribbon(data= rt_wt_df, aes( ymin=lower, ymax=upper),inherit.aes=TRUE, fill="lightgrey", alpha=0.5) +
  #geom_line(data=Ret_true, size=2, color="red") +
  geom_line(aes(linetype=Method, color=Method, size=Method)) +
  scale_size_manual(values=c(1,1,1,1,1,1,1))+
  #scale_linetype_manual(values=c("twodash","longdash","dotdash","dashed","twodash","longdash","solid"))+
  coord_cartesian(ylim=c(0, 5)) +
  ylab(expression(R(t))) +

  scale_x_date(date_labels = "%b %d", breaks = "2 week")+
  geom_hline(yintercept=1, linetype="solid", color = "black")+
  ggtitle("R(t) estimate for Sweden, grey area = 95% Wallinga & Teunis confidence interval")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())

dev.off()

png(file.path(Homedir, "Epidemic_curve_Sweden.png"), width = 800, height = 480)
ggplot(out, aes(x=Date, y=y)) +
  geom_line(data=out , lwd=1.5) +
  ylab("Number of new confirmed cases") +
  ggtitle("Epidemic curve for Sweden")+
  scale_x_date(date_labels = "%b %d")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 10),panel.background = element_blank())

dev.off()

###### Apply different methods for Hungary #######

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out_sys <- data2[which(data2$CountryName == "Hungary"),]
# Get starting date for the country
out_sys<-out_sys[dim(out_sys)[1]:1,]
start_date <- as.Date(country_startdate("Hungary"))
out_sys <- out_sys[out_sys$Date %in% seq(from=start_date , to=out_sys$Date[length(out_sys$Date)] , by=1),]
names(out_sys)<-c("date", "cases1", "state")
out2<-out_sys
out_sys$cases[1] <-out_sys$cases1[1]
for (j in 2:dim(out_sys)[1]) {
  out_sys$cases[j] <-   out_sys$cases[j-1]+  out_sys$cases1[j]
}

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out <- data2[which(data2$CountryName == "Hungary"),]
# Get starting date for the country
out<-out[dim(out)[1]:1,]
start_date <- as.Date(country_startdate("Hungary"))
out <- out[out$Date %in% seq(from=start_date , to=out$Date[length(out$Date)] , by=1),]

rt_Cislaghi_5 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=5)
rt_Cislaghi_5_df <- data.frame(Date=as.Date(names(rt_Cislaghi_5)), R_hat=rt_Cislaghi_5, Method=" 5")
rt_Systrom <- est_rt_Systrom(covid_cases=out_sys, state_selected="Hungary")
rt_Systrom_df <- data.frame(Date=rt_Systrom$date, R_hat=rt_Systrom$r_t_most_likely, upper=rt_Systrom$r_t_hi, lower=rt_Systrom$r_t_lo, Method="Systrom")
rt_jrc <- est_rt_JRC(out$y  %>% setNames(out$Date), window_interval=7)
rt_jrc_df <- data.frame(Date=as.Date(names(rt_jrc)), R_hat=rt_jrc, Method="JRC, GT=7")
rt_rki <- est_rt_rki(out$y  %>% setNames(out$Date), GT=4L)
rt_rki_df <- data.frame(Date=as.Date(names(rt_rki)), R_hat=rt_rki, Method="RKI, GT=4")
rt_exp2 <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=R0::generation.time("empirical", c(0,0,0,0,0,0,0,1)), half_window_width=3)
rt_exp <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=GT_obj, half_window_width=3)
rt_exp_df <- data.frame(Date=as.Date(names(rt_exp)), R_hat=rt_exp, Method="Stochastic generation time")
rt_exp2_df <- data.frame(Date=as.Date(names(rt_exp2)), R_hat=rt_exp2, Method="Generation time 7 days (constant)")
rt_wt <- est_rt_wt( out$y, GT=GT_obj)
rt_wt_df <- cbind(Date=out$Date[as.numeric(names(rt_wt$R))], R_hat=rt_wt$R, rt_wt$conf.int, Method="W & T, ramdom GT")

max_R <- 5
Normalizer <-  max(out$y) / max_R
bar_data <- data.frame(Date = as.Date(out$Date),y_upd <- out$y/max(out$y) * max_R)
out$Method <- "New cases"

date_col <- c(as.Date(names(rt_exp2)), out$Date[as.numeric(names(rt_wt$R))],as.Date(names(rt_jrc)),  as.Date(names(rt_rki)), as.Date(names(rt_exp)), as.Date(names(rt_Cislaghi_5)), as.Date(rt_Systrom$date) )

R_col <- as.numeric(c(rt_exp2, rt_wt$R, rt_jrc, rt_rki, rt_exp, rt_Cislaghi_5, rt_Systrom_df$R_hat))

Method_col <- c( rep("Exp-Growth, GT = 7", length= length(rt_exp2)),  rep("W & T, ramdom GT", length= length(rt_wt$R)), rep("JRC, GT=7", length= length(rt_jrc)), rep("RKI, GT=4", length= length(rt_rki)), rep("Exp-Growth, random GT", length= length(rt_exp)), rep("Cislaghi, Window=5", length= length(rt_Cislaghi_5)),  rep("Systrom", length= dim(rt_Systrom)[1]))

Data_Total <- data.frame(Date=date_col, R_hat=R_col, Method=Method_col)

Data_total1 <- Data_Total[Data_Total$Method %in% c("Exp-Growth, GT = 7", "W & T, ramdom GT", "JRC, GT=7", "RKI, GT=4", "Exp-Growth, random GT", "Cislaghi, Window=5","Systrom"),]

### Plot the methods   ######
png(file.path(Homedir, "All_methods_Hungary.png"), width = 800, height = 480)
ggplot(Data_total1, aes(x=Date, y=R_hat, group=Method)) +

  geom_ribbon(data= rt_wt_df, aes( ymin=lower, ymax=upper),inherit.aes=TRUE, fill="lightgrey", alpha=0.5) +
  #geom_line(data=Ret_true, size=2, color="red") +
  geom_line(aes(linetype=Method, color=Method, size=Method)) +
  scale_size_manual(values=c(1,1,1,1,1,1,1))+
  #scale_linetype_manual(values=c("twodash","longdash","dotdash","dashed","twodash","longdash","solid"))+
  coord_cartesian(ylim=c(0, 5)) +
  ylab(expression(R(t))) +

  scale_x_date(date_labels = "%b %d", breaks = "2 week")+
  geom_hline(yintercept=1, linetype="solid", color = "black")+
  ggtitle("R(t) estimate for Hungary, grey area = 95% Wallinga & Teunis confidence interval")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())

dev.off()

png(file.path(Homedir, "Epidemic_curve_Hungary.png"), width = 800, height = 480)
ggplot(out, aes(x=Date, y=y)) +
  geom_line(data=out , lwd=1.5) +
  ylab("Number of new confirmed cases") +
  ggtitle("Epidemic curve for Hungary")+
  scale_x_date(date_labels = "%b %d")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 10),panel.background = element_blank())

dev.off()

###### Apply different methods for Poland #######

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out_sys <- data2[which(data2$CountryName == "Poland"),]
# Get starting date for the country
out_sys<-out_sys[dim(out_sys)[1]:1,]
start_date <- as.Date(country_startdate("Poland"))
out_sys <- out_sys[out_sys$Date %in% seq(from=start_date , to=out_sys$Date[length(out_sys$Date)] , by=1),]
names(out_sys)<-c("date", "cases1", "state")
out2<-out_sys
out_sys$cases[1] <-out_sys$cases1[1]
for (j in 2:dim(out_sys)[1]) {
  out_sys$cases[j] <-   out_sys$cases[j-1]+  out_sys$cases1[j]
}

data2<-data_ECDC[,c("dateRep", "cases", "countriesAndTerritories")]
# Set cases with minus value to 0
data2$cases[which(data2$cases <0)]<-0
# change format of Dates
data2$dateRep <- as.Date(as.character(data2$dateRep), format="%d/%m/%Y")
names(data2) <- c("Date", "y", "CountryName")
out <- data2[which(data2$CountryName == "Poland"),]
# Get starting date for the country
out<-out[dim(out)[1]:1,]
start_date <- as.Date(country_startdate("Poland"))
out <- out[out$Date %in% seq(from=start_date , to=out$Date[length(out$Date)] , by=1),]

rt_Cislaghi_5 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=5)
rt_Cislaghi_5_df <- data.frame(Date=as.Date(names(rt_Cislaghi_5)), R_hat=rt_Cislaghi_5, Method=" 5")
rt_Systrom <- est_rt_Systrom(covid_cases=out_sys, state_selected="Poland")
rt_Systrom_df <- data.frame(Date=rt_Systrom$date, R_hat=rt_Systrom$r_t_most_likely, upper=rt_Systrom$r_t_hi, lower=rt_Systrom$r_t_lo, Method="Systrom")
rt_jrc <- est_rt_JRC(out$y  %>% setNames(out$Date), window_interval=7)
rt_jrc_df <- data.frame(Date=as.Date(names(rt_jrc)), R_hat=rt_jrc, Method="JRC, GT=7")
rt_rki <- est_rt_rki(out$y  %>% setNames(out$Date), GT=4L)
rt_rki_df <- data.frame(Date=as.Date(names(rt_rki)), R_hat=rt_rki, Method="RKI, GT=4")
rt_exp2 <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=R0::generation.time("empirical", c(0,0,0,0,0,0,0,1)), half_window_width=3)
rt_exp <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=GT_obj, half_window_width=3)
rt_exp_df <- data.frame(Date=as.Date(names(rt_exp)), R_hat=rt_exp, Method="Stochastic generation time")
rt_exp2_df <- data.frame(Date=as.Date(names(rt_exp2)), R_hat=rt_exp2, Method="Generation time 7 days (constant)")
rt_wt <- est_rt_wt( out$y, GT=GT_obj)
rt_wt_df <- cbind(Date=out$Date[as.numeric(names(rt_wt$R))], R_hat=rt_wt$R, rt_wt$conf.int, Method="W & T, ramdom GT")

max_R <- 5
Normalizer <-  max(out$y) / max_R
bar_data <- data.frame(Date = as.Date(out$Date),y_upd <- out$y/max(out$y) * max_R)
out$Method <- "New cases"

date_col <- c(as.Date(names(rt_exp2)), out$Date[as.numeric(names(rt_wt$R))],as.Date(names(rt_jrc)),  as.Date(names(rt_rki)), as.Date(names(rt_exp)), as.Date(names(rt_Cislaghi_5)), as.Date(rt_Systrom$date) )

R_col <- as.numeric(c(rt_exp2, rt_wt$R, rt_jrc, rt_rki, rt_exp, rt_Cislaghi_5, rt_Systrom_df$R_hat))

Method_col <- c( rep("Exp-Growth, GT = 7", length= length(rt_exp2)),  rep("W & T, ramdom GT", length= length(rt_wt$R)), rep("JRC, GT=7", length= length(rt_jrc)), rep("RKI, GT=4", length= length(rt_rki)), rep("Exp-Growth, random GT", length= length(rt_exp)), rep("Cislaghi, Window=5", length= length(rt_Cislaghi_5)),  rep("Systrom", length= dim(rt_Systrom)[1]))

Data_Total <- data.frame(Date=date_col, R_hat=R_col, Method=Method_col)

Data_total1 <- Data_Total[Data_Total$Method %in% c("Exp-Growth, GT = 7", "W & T, ramdom GT", "JRC, GT=7", "RKI, GT=4", "Exp-Growth, random GT", "Cislaghi, Window=5","Systrom"),]

### Plot the methods   ######
png(file.path(Homedir, "All_methods_Poland.png"), width = 800, height = 480)
ggplot(Data_total1, aes(x=Date, y=R_hat, group=Method)) +

  geom_ribbon(data= rt_wt_df, aes( ymin=lower, ymax=upper),inherit.aes=TRUE, fill="lightgrey", alpha=0.5) +
  #geom_line(data=Ret_true, size=2, color="red") +
  geom_line(aes(linetype=Method, color=Method, size=Method)) +
  scale_size_manual(values=c(1,1,1,1,1,1,1))+
  #scale_linetype_manual(values=c("twodash","longdash","dotdash","dashed","twodash","longdash","solid"))+
  coord_cartesian(ylim=c(0, 5)) +
  ylab(expression(R(t))) +

  scale_x_date(date_labels = "%b %d", breaks = "2 week")+
  geom_hline(yintercept=1, linetype="solid", color = "black")+
  ggtitle("R(t) estimate for Poland, grey area = 95% Wallinga & Teunis confidence interval")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())

dev.off()

png(file.path(Homedir, "Epidemic_curve_Poland.png"), width = 800, height = 480)
ggplot(out, aes(x=Date, y=y)) +
  geom_line(data=out , lwd=1.5) +
  ylab("Number of new confirmed cases") +
  ggtitle("Epidemic curve for Poland")+
  scale_x_date(date_labels = "%b %d")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 10),panel.background = element_blank())

dev.off()

#################    TEST MODELLED DATA   ####################

################### Test modelled data   ##############################

# Define time varying effective reproduction number
Ret1 <- function(date1) {
  if(date1 <= as.Date("2020-03-15")) {
    R_val <- 2.5
  }
  if (date1 > as.Date("2020-03-15") & date1 <= as.Date("2020-04-15")) {
    R_val <- 1.5
  }
  if (date1 > as.Date("2020-04-15"))  {
    R_val <- 0.75
  }
  return(R_val)
}
Ret<-Ret1

routbreak <- function(n=100, Ret, GT_obj, initial_cases = 10) {
  # Set up time series of incident cases
  y <- rep(0, n + length(GT_pmf))
  y[seq_len(length(initial_cases))] <- initial_cases
  # Outbreak starts on 2020-02-15
  dates <- as.Date("2020-02-15") + 0:(n-1)
  # Extract serial interval PMF, ignore support at 0.
  GT_pmf <- GT_obj$GT[-1]

  # Loop over all time points
  for (i in 1:n) {
    date <- dates[i]
    y[i + 1:length(GT_pmf)] <- y[i] * (Ret(date) * GT_pmf) + y[i + 1:length(GT_pmf)]
  }

  # Data frame with the result. Assume we start on 15th of Feb
  res <- data.frame(Date=dates, y=y[1:n])

  #Done
  return(res)
}

# Generate an outbreak (no stochasticity, just the difference equation)
out <- routbreak(n=100, Ret=Ret, GT_obj=GT_obj)
out <- out %>% mutate(ratio = y/lag(y))
# Data frame with the true values
True_val <- NULL
for (i in 1:length(out$Date)) {
  date <- out$Date[i]
  True_val <- c(True_val, Ret(date))
}
n1<-100
names(True_val) <- as.Date("2020-02-15") + 0:(n1-1)
Data_R_sim <- data.frame(Date=as.Date("2020-02-15") + 0:(n1-1), R_sim=True_val, Method="Simulated R(t)")

max_R <- 2.5
Normalizer <-  max(out$y) / max_R
bar_data <- data.frame(Date = as.Date(out$Date),y_upd <- out$y/max(out$y) * max_R)
out$Method <- "Daily reported new cases"
cols = c("black", "red")

png(file.path(Homedir, "Model_outbreak.png"), width = 800, height = 480)
ggplot(Data_R_sim, aes(x=Date, y=R_sim, color=Method)) + geom_line(lwd=1.5) +
  ylab("R(t)")+
  scale_colour_manual(values = cols)+
  geom_line(data=out,
            aes(x = as.Date(Date),
                y= y / Normalizer, color="New cases"), lwd=2)+
  scale_y_continuous(expand = c(0, 0), limits=c(0,max_R), sec.axis = sec_axis(trans= ~.*Normalizer,
                                                                              name = 'Daily new cases (simulated)')) +
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+    theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())
dev.off()

# RKI method as specified in 2020-04-24 version of the article
rt_rki <- est_rt_rki(out$y  %>% setNames(out$Date), GT=4L)

# Exponential growth with discrete Laplace transform of a GT \equiv = 4 distribution
rt_exp2 <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=R0::generation.time("empirical", c(0,0,0,0,0,0,0,1)), half_window_width=3)

# Exponential growth with discrete Laplace transform of the correct GT distribution
rt_exp <- est_rt_exp( out$y %>% setNames(out$Date), GT_obj=GT_obj, half_window_width=3)

# Wallinga Teunis approach with correct GT distribution
rt_wt <- est_rt_wt( out$y, GT=GT_obj)

# Data frame with the true values
True_val <- NULL
for (i in 1:length(out$Date)) {
  date <- out$Date[i]
  True_val <- c(True_val, Ret(date))
}

Ret_true <- data.frame(Date=out$Date, R_hat = True_val, Method="True R(t)")

rt_jrc <- est_rt_JRC(out$y  %>% setNames(out$Date), window_interval=7)

# Cislaghi method
rt_Cislaghi_3 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=3)
rt_Cislaghi_4 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=4)
rt_Cislaghi_5 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=5)
rt_Cislaghi_6 <- est_rt_Cislaghi(out$y  %>% setNames(out$Date), window_interval=6)

rt_jrc <- est_rt_JRC(out$y  %>% setNames(out$Date), window_interval=7)

out2 <- out
out2$state <- "simulated"
out2$date <- as.character(out2$Date)
out2$cases[1] <-out2$y[1]
for (j in 2:dim(out2)[1]) {
  out2$cases[j] <-   out2$cases[j-1]+  out2$y[j]
}
out2$cases <- round(out2$cases,0)

rt_Systrom <- est_rt_Systrom(covid_cases=out2, state_selected="simulated")

#########
# Convert fits to unified data.frames
##########
rt_wt_df <- cbind(Date=out$Date[as.numeric(names(rt_wt$R))], R_hat=rt_wt$R, rt_wt$conf.int, Method="W & T, ramdom GT")

rt_rki_df <- data.frame(Date=as.Date(names(rt_rki)), R_hat=rt_rki, Method="RKI, GT=4")

rt_exp_df <- data.frame(Date=as.Date(names(rt_exp)), R_hat=rt_exp, Method="Exp-Growth, correct GT")

rt_exp2_df <- data.frame(Date=as.Date(names(rt_exp2)), R_hat=rt_exp2, Method="Exp-Growth, GT=7")

rt_Cislaghi_3_df <- data.frame(Date=as.Date(names(rt_Cislaghi_3)), R_hat=rt_Cislaghi_3, Method="Cislaghi, Window=3")
rt_Cislaghi_4_df <- data.frame(Date=as.Date(names(rt_Cislaghi_4)), R_hat=rt_Cislaghi_4, Method="Cislaghi, Window=4")
rt_Cislaghi_5_df <- data.frame(Date=as.Date(names(rt_Cislaghi_5)), R_hat=rt_Cislaghi_5, Method="Cislaghi, Window=5")
rt_Cislaghi_6_df <- data.frame(Date=as.Date(names(rt_Cislaghi_6)), R_hat=rt_Cislaghi_6, Method="Cislaghi, Window=6")

rt_jrc_df <- data.frame(Date=as.Date(names(rt_jrc)), R_hat=rt_jrc, Method="JRC, GT=7")
rt_Systrom_df <- data.frame(Date=as.Date(rt_Systrom$date), R_hat=rt_Systrom$r_t_most_likely,Method="Systrom")

########## Make a major dataframe
Ret_true <- data.frame(Date=out$Date, R_hat = True_val, Method="True R(t)")

date_col <- c(as.Date(names(rt_exp2)),out$Date, out$Date[as.numeric(names(rt_wt$R))],as.Date(names(rt_jrc)),  as.Date(names(rt_rki)), as.Date(names(rt_exp)), as.Date(names(rt_Cislaghi_4)), as.Date(names(rt_Cislaghi_5)),as.Date(names(rt_Cislaghi_6)))
R_col <- as.numeric(c(rt_exp2, True_val, rt_wt$R, rt_jrc, rt_rki, rt_exp, rt_Cislaghi_4, rt_Cislaghi_5, rt_Cislaghi_6))

Method_col <- c( rep("Exp-Growath, GT = 7", length= length(rt_exp2)), rep("True R(t)", length= length(True_val)), rep("W & T, ramdom GT", length= length(rt_wt$R)), rep("JRC, GT=7", length= length(rt_jrc)), rep("RKI, GT=4", length= length(rt_rki)), rep("Exp-Growth, random GT", length= length(rt_exp)), rep("Cislaghni, Window=4", length= length(rt_Cislaghi_4)), rep("Cislaghni, Window=5", length= length(rt_Cislaghi_5)), rep("Cislaghni, Window=6", length= length(rt_Cislaghi_6)))

Data_total <- data.frame(Date=date_col, R_hat=R_col, Method=Method_col)

date_col <- c(as.Date(names(rt_exp2)),out$Date, out$Date[as.numeric(names(rt_wt$R))],as.Date(names(rt_jrc)),  as.Date(names(rt_rki)), as.Date(names(rt_exp)), as.Date(names(rt_Cislaghi_3)),as.Date(names(rt_Cislaghi_4)), as.Date(names(rt_Cislaghi_5)),as.Date(names(rt_Cislaghi_6)), as.Date(rt_Systrom$date) )

R_col <- as.numeric(c(rt_exp2, True_val, rt_wt$R, rt_jrc, rt_rki, rt_exp, rt_Cislaghi_3, rt_Cislaghi_4, rt_Cislaghi_5, rt_Cislaghi_6,rt_Systrom_df$R_hat))

Method_col <- c( rep("Exp-Growth, GT = 7", length= length(rt_exp2)), rep("True R(t)", length= length(True_val)), rep("W & T, ramdom GT", length= length(rt_wt$R)), rep("JRC, GT=7", length= length(rt_jrc)), rep("RKI, GT=4", length= length(rt_rki)), rep("Exp-Growth, random GT", length= length(rt_exp)), rep("Cislaghi, Window=3", length= length(rt_Cislaghi_3)),rep("Cislaghi, Window=4", length= length(rt_Cislaghi_4)), rep("Cislaghi, Window=5", length= length(rt_Cislaghi_5)), rep("Cislaghi, Window=6", length= length(rt_Cislaghi_6)), rep("Systrom", length= dim(rt_Systrom)[1]))

Data_Total <- data.frame(Date=date_col, R_hat=R_col, Method=Method_col)

Data_total <- Data_Total[Data_Total$Method %in% c("Exp-Growth, GT = 7", "True R(t)", "W & T, ramdom GT", "JRC, GT=7", "RKI, GT=4", "Exp-Growth, random GT", "Cislaghi, Window=5","Systrom"),]

### Plot the methods   ######
png(file.path(Homedir, "R_e_Simulated.png"), width = 800, height = 480)
ggplot(Data_total, aes(x=Date, y=R_hat, group=Method)) +

  geom_ribbon(data= rt_wt_df, aes( ymin=lower, ymax=upper),inherit.aes=TRUE, fill="lightgrey", alpha=0.5) +
  #geom_line(data=Ret_true, size=2, color="red") +
  geom_line(aes(linetype=Method, color=Method, size=Method)) +
  scale_size_manual(values=c(1,1,1,1,1,1,2,1))+
  scale_linetype_manual(values=c("twodash","longdash","dotdash","dashed","twodash","longdash","solid","dotted"))+
  coord_cartesian(ylim=c(0, 5)) +
  ylab(expression(R(t))) +
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+
  geom_hline(yintercept=1, linetype="solid", color = "black")+
  ggtitle("R(t) estimate with simulated data, grey area = 95% Wallinga & Teunis confidence interval")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())

dev.off()

######  Routint to plot the simulated data    ######

### Cislaghi

Data_cislaghi <- Data_Total[Data_Total$Method %in% c("True R(t)", "Cislaghi, Window=3", "Cislaghi, Window=4", "Cislaghi, Window=5", "Cislaghi, Window=6"),]

##### Plot the methods   ######
png(file.path(Homedir, "cislaghi, simulated.png"), width = 800, height = 480)
ggplot(Data_cislaghi, aes(x=Date, y=R_hat, group=Method)) +

  geom_line(aes(linetype=Method, color=Method, size=Method)) +
  scale_size_manual(values=c(1,1,1,1,2))+
  scale_linetype_manual(values=c("twodash","longdash","dotdash","dashed","solid"))+
  coord_cartesian(ylim=c(0, 5)) +
  ylab(expression(R(t))) +
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+
  geom_hline(yintercept=1, linetype="solid", color = "black")+
  ggtitle("Cislaghi method with simulated data")+

  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 10),panel.background = element_blank())

dev.off()

### Systrom

Data_Systrom <- Data_Total[Data_Total$Method %in% c("True R(t)", "Systrom"),]

### Plot the methods   ######
png(file.path(Homedir, "Systrom_simulated.png"), width = 800, height = 480)
ggplot(Data_Systrom, aes(x=Date, y=R_hat, group=Method)) +

  geom_line(aes(linetype=Method, color=Method, size=Method)) +
  scale_size_manual(values=c(1,2))+
  scale_linetype_manual(values=c("dashed","solid"))+
  coord_cartesian(ylim=c(0, 5)) +
  ylab(expression(R(t))) +
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+
  geom_hline(yintercept=1, linetype="solid", color = "black")+
  ggtitle("Systrom method with simulated data")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())

dev.off()

### JRC

Data_JRC <- Data_Total[Data_Total$Method %in% c("True R(t)", "JRC, GT=7"),]

### Plot the methods   ######
png(file.path(Homedir, "JRC_simulated.png"), width = 800, height = 480)
ggplot(Data_JRC, aes(x=Date, y=R_hat, group=Method)) +

  geom_line(aes(linetype=Method, color=Method, size=Method)) +
  scale_size_manual(values=c(1,2))+
  scale_linetype_manual(values=c("dashed","solid"))+
  coord_cartesian(ylim=c(0, 5)) +
  ylab(expression(R(t))) +
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+
  geom_hline(yintercept=1, linetype="solid", color = "black")+
  ggtitle("JRC method with simulated data")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())

dev.off()

### RKI

Data_RKI <- Data_Total[Data_Total$Method %in% c("True R(t)", "RKI, GT=4"),]

### Plot the methods   ######
png(file.path(Homedir, "RKI_simulated.png"), width = 800, height = 480)
ggplot(Data_RKI, aes(x=Date, y=R_hat, group=Method)) +

  geom_line(aes(linetype=Method, color=Method, size=Method)) +
  scale_size_manual(values=c(1,2))+
  scale_linetype_manual(values=c("dashed","solid"))+
  coord_cartesian(ylim=c(0, 5)) +
  ylab(expression(R(t))) +
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+
  geom_hline(yintercept=1, linetype="solid", color = "black")+
  ggtitle("RKI method with simulated data")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())

dev.off()

### Wallinga & Lipsitch

Data_Expo <- Data_Total[Data_Total$Method %in% c("True R(t)", "Exp-Growth, random GT", "Exp-Growth, GT = 7"),]

### Plot the methods   ######
png(file.path(Homedir, "Exp_simulated.png"), width = 800, height = 480)
ggplot(Data_Expo, aes(x=Date, y=R_hat, group=Method)) +

  geom_line(aes(linetype=Method, color=Method, size=Method)) +
  scale_size_manual(values=c(1,1, 2))+
  scale_linetype_manual(values=c("dashed","dotdash","solid"))+
  coord_cartesian(ylim=c(0, 5)) +
  ylab(expression(R(t))) +
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+
  geom_hline(yintercept=1, linetype="solid", color = "black")+
  ggtitle("Exponential growth method with simulated data")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())

dev.off()

### Wallinga & Teunis

Data_Teunis <- Data_Total[Data_Total$Method %in% c("True R(t)", "W & T, ramdom GT"),]

### Plot the methods   ######
png(file.path(Homedir, "WT_simulated.png"), width = 800, height = 480)
ggplot(Data_Teunis, aes(x=Date, y=R_hat, group=Method)) +

  geom_line(aes(linetype=Method, color=Method, size=Method)) +
  geom_ribbon(data= rt_wt_df, aes( ymin=lower, ymax=upper),inherit.aes=TRUE, fill="lightgrey", alpha=0.5) +
  scale_size_manual(values=c(2,1))+
  scale_linetype_manual(values=c("solid", "dashed"))+
  coord_cartesian(ylim=c(0, 5)) +
  ylab(expression(R(t))) +
  scale_x_date(date_labels = "%b %d", breaks = "2 week")+
  geom_hline(yintercept=1, linetype="solid", color = "black")+
  ggtitle("Wallinga & Teunis method with simulated data (shaded area 95% confidence interval)")+
  theme(axis.text.x = element_text(angle=45, hjust = 1),legend.position="bottom",plot.title = element_text(size = 20),axis.line = element_line(colour = "black", size=1.5), axis.text = element_text(size = 20), axis.title = element_text(size = 20), legend.text = element_text(size = 20),panel.background = element_blank())

dev.off()


#' @title whichEventsVincenty
#' @description Uses Vincenty Formula to Determine Distances between points
#' @param \code{radius} km
#' @family abysmally documented
#' @author  unknown, \email{<unknown>@@dfo-mpo.gc.ca}
#' @export
whichEventsVincenty <- function(lonlat,events,radius) {
		cat('Uses Vincenty Formula to Determine Distances between points \n')
		cat('radius is in km \n')

		if(length(which((names(events) %in% c('lon','lat'))))!=2) {
			cat('events need to be a data.frame and must contain columns named c(lon,lat)\n')
			stop()
			}

		po	 	 <- data.frame(lon=lonlat[1],lat=lonlat[2])
		events$D <- vincenty(loc1=po,loc2=events,a=6378.13700, f= 1/298.257223563)
		return(events[which(events$D<radius),])
		}


#' @title Partial Least Squares (PLS)
#' @export
#' @description This function fits Partial Least Squares (O-PLS) models for regression (R) or discriminant analysis (DA). The optimal number of components is determined automatically using automated stop criteria based on statistical cross validation indices.
#' @param X Numeric input matrix or dataframe (usually measurements obtained through NMR spectroscopy or mass spectrometry) with each row representing an observation and each column a metabolic feature.
#' @param Y Response vector or matrix with same length or number of columns than rows in X, respectively. Y have multiple columns.
#' @param t_pred Parameter specifying the maximum number of predictive components (needed only for multi-factor Y)
#' @param center Logical value (TRUE or FALSE) indicating if features should be mean centered.
#' @param scale Desired scaling method (currently only no or unit variance scaling (UV) implemented).
#' @param cv Named list of cross-validation paramters to derive the optimal number of components: method, one of 'k-fold', 'k-fold_stratified', 'MC', 'MC_balanced' (see Details), split: fraction of observations used for model training, k: k-fold paramter, ie., the number of cross-validation sets. The latter depends on the number of observations in X but typically takes a value between 3 and 9.
#' @param plotting Logical value (TRUE or FALSE) indicating if model parameters (R2X, Q2, etc) should be visualised once the model is trained.
#' @param maxPCo The maximum number of orthogonal components (in case stop criteria fail).
#' @details Models are fully statistically validated, currently only k-fold cross validation (CV) and class-balanced k-fold cross validation is implemented. Further extensions, e.g. Monte-Carlo CV, are work in progress. Although the algorithm accepts three and more levels as Y, model interpretation is more straightforward for pairwise group comparisons.
#' @references Geladi, P and Kowalski, B.R. (1986), Partial least squares and regression: a tutorial. \emph{Analytica Chimica Acta}, 185, 1-17.
#' @return This function returns a PLS-metabom8 object (S4).
#' @examples
#' data(covid)
#' model=opls(X, Y=an$type)
#' plotscores(model, an=list(Class=an$type, Clinic=an$hospital, id=1:nrow(an)), pc=c(1,2))
#' @author \email{torben.kimhofer@murdoch.edu.au}
#' @importFrom graphics plot
#' @importFrom methods getSlots new representation setClass
#' @importFrom stats cov sd var
#' @importFrom utils methods
#' @importFrom ggplot2 ggplot aes aes_string scale_fill_manual scale_y_continuous theme_bw labs scale_x_discrete scale_alpha theme element_blank element_line element_rect geom_bar element_text
#' @importFrom pROC roc multiclass.roc

# data(iris)
# X=as.matrix(iris[,1:4])
# Y=cbind(as.character(iris[,5]))
# center = T
# scale = "UV"
# plotting = T
# maxPCo = 5
# cv=list(method='k-fold', split=2/3, k=3)

# load('/Volumes/Torben_1 1/Rproj/KMeyer/NMR_cleanSpectra.Rdata')
# idx=which(!is.na(an$HBP30))
# X=X[idx,]
# Y=factor(an$HBP30[idx])

#mod=pls(X,factor(iris$Species))
#plotscores(mod, an=list(class=factor(Y)), cv.scores = F)

# Load data
# data(bariatric)

# Declare variables
# X <-bariatric$X.pqn # NMR matrix
# X[,100]=999
# ppm<-bariatric$ppm     # ppm vector
# meta<-bariatric$meta   # Metadata
# an<-bariatric$an       # Sample annotation
# Y=factor(an$Timepoint)
# readBruker('/Volumes/Torben_2/Ariwave/')

# test=opls_rcpp(X, Y, t_pred = 1, center = T, scale = "UV", plotting = T, maxPCo = 5, cv=list(method='k-fold_stratified', split=2/3, k=20))

pls <- function(X, Y, center = TRUE, scale = 'UV', cv=list(method='k-fold_stratified', k=7, split=2/3), maxPCo = 5, plotting = TRUE) {

  {

    if(is.data.frame(X)) X=as.matrix(X)

    if(!is.logical(center)){stop('Check center parameter argument!')}
    sc_num<-switch(scale,
                   'None'={0},
                   'UV'={1},
                   'Pareto'={2})
    if(is.null(sc_num)){stop('Check scale parameter argument!')}

    x_check<-.checkXclassNas(X)
    y_check<-.checkYclassNas(Y)
    xy_check<-.checkDimXY(X, y_check[[1]])
    type<-y_check[[3]]

    msd_y<-.sdRcpp(y_check[[1]])
    msd_x<-.sdRcpp(X)
    XcsTot<-.scaleMatRcpp(X, 0:(nrow(X)-1), center=TRUE, scale_type = sc_num)[[1]]
    YcsTot<-.scaleMatRcpp(y_check[[1]], 0:(nrow(y_check[[1]])-1), center=TRUE, scale_type = sc_num)[[1]]

    tssx<-.tssRcpp(XcsTot)
    tssy<-.tssRcpp(YcsTot)/ncol(YcsTot)
  }

  cv$cv_sets<-.cvSetsMethod(Y=y_check[[1]], type = type, method = cv$method, k = cv$k,  split=cv$split)
  cv$k <- length(cv$cv_sets)

  r2_comp <- r2x_comp <- q2_comp <- aucs_tr <- aucs_te <- array()
  nc <- 1
  overfitted <- FALSE

  while (overfitted == FALSE) {

    if(nc == 1){ tt<-.plsComponentCv(X, Y=y_check[[1]], cv$cv_sets, nc,  mod.cv=NULL)
    #browser()
    }else{
      tt<-.plsComponentCv(X=NA, Y=y_check[[1]], cv$cv_sets, nc,  mod.cv=tt)
    }

    # extract cv stats -> if Y is multi-column, fct .extrMeanCVFeat function is likely not working
    preds_test<-.extMeanCvFeat_pls(cv_obj = tt, feat = 'y_pred_test', cv_type = cv$method, model_type=type)
    preds_train<-.extMeanCvFeat_pls(tt, feat = 'y_pred_train', cv_type = cv$method, model_type=type)

    # distinguish between MULTI-Y/SINGLE-Y, as well as MCCV vs k-fold

    # calculate R2 and auroc for cv compounds
    switch(strsplit(cv$method, '_')[[1]][1],
           'MC'={
             if( grepl('DA', type) ) {
               if ( grepl('mY', type) ) {                           # multi Y DA using MCCV
                 pred_mean=preds_test[1,,]
                 colnames(pred_mean)=colnames(y_check[[1]])
                 mod <- suppressWarnings(multiclass.roc(response = factor(Y), predictor = pred_mean))
                 aucs_te[nc] <- mod$auc
                 pred_tr_mean=preds_train[1,,]
                 colnames(pred_tr_mean)=colnames(y_check[[1]])
                 mod <- suppressWarnings(multiclass.roc(response = factor(Y), predictor = pred_tr_mean))
                 aucs_tr[nc] <- mod$auc
               }else{                                             # single Y DA using MCCV
                 # need the same decision boundary
                 mod <- suppressWarnings(roc(response = Y, predictor = preds_test[1,], quiet = TRUE))
                 aucs_te[nc] <- mod$auc
                 mod <- suppressWarnings(roc(response = Y, predictor = preds_train[1,], quiet = TRUE))
                 aucs_tr[nc] <- mod$auc
               }
             } else{
               if (grepl('mY', type)) {                         # multi Y regression using MCCV
                 r2_comp[nc] <- .r2(YcsTot, preds_train, NULL)
                 q2_comp[nc] <- .r2(YcsTot, preds_test, tssy)
               }else{

                 # single Y regression using MCCV
                 r2_comp[nc] <- .r2(YcsTot, preds_train[1,], NULL)
                 q2_comp[nc] <- .r2(YcsTot, preds_test[1,], tssy)
               }
             }
           },
           'k-fold'={
             if( grepl('DA', type) ) {
               if ( grepl('mY', type) ) {
                 colnames(preds_test)=colnames(y_check[[1]])
                 mod <- suppressWarnings(multiclass.roc(response = Y, predictor = apply(preds_test, 2, as.numeric)))
                 aucs_te[nc] <- mod$auc
                 preds_te = preds_train # this extracts mean values
                 colnames(preds_te)=colnames(y_check[[1]])
                 mod <- suppressWarnings(multiclass.roc(response = Y, predictor = preds_te, quiet = TRUE))
                 aucs_tr[nc] <- mod$auc
               }else{
                 mod <- suppressWarnings(roc(response = Y, predictor = preds_test, quiet = TRUE))
                 aucs_te[nc] <- mod$auc
                 mod <- suppressWarnings(roc(response = Y, predictor = preds_train[1,], quiet = TRUE))
                 aucs_tr[nc] <- mod$auc
               }
             }else{
               if (grepl('MC', type)) {
                 r2_comp[nc] <- .r2(YcsTot, preds_train[1,,], NULL)
                 q2_comp[nc] <- .r2(YcsTot, preds_test[4,], tssy)
               }else{
                 r2_comp[nc] <- .r2(YcsTot, preds_train[1,], NULL)
                 q2_comp[nc] <- .r2(YcsTot, preds_test[,1], tssy)
               }
             }
           }
    )
    overfitted <- .evalFit(type, q2_comp, aucs_te, maxPCo)

    if (nc >= 2) {
      if(nc==2){
        pls_full <- .nipPlsCompRcpp(X = XcsTot, Y = YcsTot)
        r2x_comp[nc-1]<-.r2(XcsTot, pls_full$t_x %*% pls_full$p_x, NULL)
      }else{
        x_sq_bef=pls_full$x_res
        pls_full <- .nipPlsCompRcpp(X = pls_full$x_res, Y = YcsTot)
        r2x_comp[nc-1]<-.r2(x_sq_bef, pls_full$t_x %*% pls_full$p_x, NULL)
      }
    }

    if (overfitted == TRUE) {
      message(paste0("A PLS-", type, " model with ", nc - 1, " components was fitted."))
      if(grepl('MC', cv$method)){
        # this means output will be mean, sd and %cv
        if(grepl('mY', type)){
          pls_full$t_cv <- t(t(.extMeanCvFeat(tt, 't_xp', cv_type = cv$method, model_type=type)[,1:(nc-1)]))
          #pred_comp$t_o_cv <- t(t(.extMeanCvFeat(tt, 't_xo', cv_type = cv$method, model_type=type)[1,,-nc]))
        }else{
          #extract mean value
          pls_full$t_cv <- t(t(.extMeanCvFeat(tt, 't_xp', cv_type = cv$method, model_type=type)[1,]))
          #pred_comp$t_o_cv <- t(t(.extMeanCvFeat(tt, 't_xo', cv_type = cv$method, model_type=type)[1,]))
        }
      }else{
        #pred_comp$t_cv<-matrix(.extMeanCvFeat(tt, 't_xp', cv_type = cv$method, model_type=type), ncol=1)
        pls_full$t_cv <- t(t(.extMeanCvFeat(tt, 't_xp', cv_type = cv$method, model_type=type)[,1:(nc-1)]))
      }
      # pred_comp$t_cv<-t(t(.extMeanCvFeat(tt, 't_xp', cv_type = cv$method, model_type=type)[1,,]))
      #pred_comp$t_o<-t_orth
      # pred_comp$t_o_cv<-.extMeanCvFeat(tt, 't_xo', cv_type = cv$method, model_type=type)[1,,-nc]
      #if(!is.matrix(pred_comp$t_o_cv)){pred_comp$t_o_cv=t(t(pred_comp$t_o_cv))}
    }
    nc <- nc + 1
  }

  # xfilt_obsolete <- .nipOplsRcpp(X = opls_filt$X_res, Y = YcsTot)
  m_summary=.orthModelCompSummary(type = type, r2x_comp = c(r2x_comp, NA), r2_comp = r2_comp, q2_comp = q2_comp, aucs_te = aucs_te, aucs_tr=aucs_tr, cv = cv)
  if (plotting == TRUE) { suppressWarnings(print(m_summary[[2]]+labs(x='Predictive Components', titel='PLS-DA'))) }

  Xpred <- pls_full$t_x %*% pls_full$p_x
  E <- XcsTot - (Xpred)  # this is for calculation of DModX
  Y_res = YcsTot -  (pls_full$t_y %*% t(pls_full$p_y)) # this is scaled and mean centered Y residual

  pars <- list(
    'center'= center,
    'scale'= scale,
    'nPredC'= 1,
    'nOrthC'= nc-1,
    'maxPCo'= maxPCo,
    'cv'= cv,
    'tssx'= tssx,
    'tssy'= tssy
  )

  mod_pls <- new("PLS_metabom8",
                  type = type,
                  t_pred = pls_full$t_x,
                  p_pred = pls_full$p_x,
                  w_pred = pls_full$w_x,
                  betas_pred = drop(pls_full$b),
                  Qpc = pls_full$w_y,
                  t_pred_cv = pls_full$t_cv,
                  nPC = nc - 1,
                  summary = m_summary[[1]],
                  Y_res = Y_res,
                  X_res = E,
                  X_mean =  msd_x[[2]],
                  X_sd = msd_x[[1]],
                  Y_mean = msd_y[[2]],
                  Y_sd = msd_y[[1]],
                  Parameters = pars,
                  X = X,
                  X_scaled = XcsTot,
                  Y = list(ori=Y, dummy=y_check[[1]])
  )

  return(mod_pls)
}


#!/usr/bin/env Rscript
#########################################################################
# Dependencies
suppressMessages(library(dplyr))
suppressMessages(library(purrr))
suppressMessages(library(MASS))
suppressMessages(source("src/dgm.r"))

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

configure <- function() {
  args = commandArgs(trailingOnly = TRUE)
  .config_id <- args[1] %>% as.numeric
  configs <- read.csv("configs/configs.csv")
  config <- configs %>%
    filter(config_id == .config_id)

  Alpha0 <- .Alpha0(config$px, config$pz, config$a, config$s.j)
  beta0 <- .beta0(config$px, config$b, config$s_beta)
  Sigma.uv <- Sigma.uv.(config$px, config$sigma0_v, config$sigma0_u)

  # sprintf("Generating parameters for configuration %d", .config_id) %>% print
  write.matrix(Alpha0, paste("configs", .config_id, "Alpha0", sep = "/"))
  write.matrix(beta0, paste("configs", .config_id, "beta0", sep = "/"))
  write.matrix(Sigma.uv, paste("configs", .config_id, "Sigma.uv", sep = "/"))
}

configure()


require("shinydashboard")
require("plotly")

# source("degreeDist.r")
# source("graphLayout.r")
# source("adjacencyPlot.r")

require("networkD3", quietly = T)

# shinyUI(fluidPage(
# style = "padding-top: 80px;",

header <- dashboardHeader(title = "GraphX")

body <- dashboardBody(fluidRow(

  column(
    width = 9,

     #Distribution
    box(
      width = NULL,
      solidHeader = TRUE,

    ##end  distribution

    #Distribution
    box(
      width = NULL,
      solidHeader = TRUE,
      conditionalPanel(
        "input.plot_degree == true",

        selectInput(
          inputId = "graph_stats",
          label = "Statistics:",
          choices = c(
            "Degree",
            # "Attribute: Edge Weight",
            "Betweenness Centrality",
            "Closeness Centrality",
            "Eigenvector Centrality",
            "Bonacich Power Centrality",
            "Authority Score"
            ),
          selected = "Degree"
          ),

        # conditionalPanel(
          # "input.vertex_conditional == false",
          # plotlyOutput(outputId = "density_dist", height = "300px"),
        # ) ,

        # conditionalPanel(
        # "input.vertex_conditional == true",

        plotlyOutput(outputId = "vertex_dist", height = "300px"),
         sliderInput(
            inputId = "bw_adjust_overlay",
            label = "Bandwidth adjustment:",
            min = 0.2,
            max = 10,
            value = 1,
            step = 0.2
            ),
        # ),

        # checkboxInput(
        #   inputId = "show_histogram",
        #   label = strong("Show histogram"),
        #   value = FALSE
        #   ),

        # #show this only if we bin the observations and show it in histogram
        # conditionalPanel(
        #   condition = "input.show_histogram == true",
        #   sliderInput(
        #     inputId = "hist_number_bins",
        #     label = "No. of Bins:",
        #     min = 1,
        #     max = 20,
        #     ticks = F,
        #     step = 1,
        #     value = 10
        #     )
        #   ),

        # checkboxInput(
        #   inputId = "density",
        #   label = strong("Show density estimate"),
        #   value = FALSE
        #   ),

        # # Display this only if the density is shown
        # conditionalPanel(
        #   condition = "input.density == true",
        #   sliderInput(
        #     inputId = "bw_adjust",
        #     label = "Bandwidth adjustment:",
        #     min = 0.2,
        #     max = 1,
        #     value = .5,
        #     step = 0.2
        #     )
        #   ),

        checkboxInput(
        inputId = "vertex_conditional",
        label = strong("Conditonal on Vertex Attribute "),
        value = FALSE
        ),

        conditionalPanel(
        "input.vertex_conditional == true",
        wellPanel(
          p("Select Attribute:"),
          uiOutput("AttributeSelect"))
        )

      )

        )
      ),
    ##end  distribution

    # adjacency view
    box(
      width = NULL,
      solidHeader = TRUE,

      conditionalPanel(
        "input.plot_adjacencyy == true",
        selectInput(
          inputId = "adjacency_mode",
          label = "View:",
          choices = c("Adjacency", "Laplacian", "Normalized Laplacian", "Diffusion"),
          selected = "Adjacency"
          ),

        uiOutput("caption_adjacency"),

        fluidRow(
          splitLayout(cellWidths = c("50%", "50%"),

            plotlyOutput(
              outputId = "adjacency_view",
              height = 500,
              width = 600

              ),

            conditionalPanel(
              "input.embedding_sbm == true",
              plotlyOutput(
                outputId = "p_hat_view",
                height = 500,
                width = 600
                )
              )
            )
          )
        ,

        selectInput(
          inputId = "adjacency_sortedby",
          label = "Sorted By:",
          choices = c("Unsorted", "Degree", "Block"),
          selected = "Unsorted"
          )

        )
      ),

    # end adjacency view

    # layout

    box(
      width = NULL,
      solidHeader = TRUE,
      conditionalPanel(
        "input.plot_layout == true",
        forceNetworkOutput(outputId = "graph_layout", height = "500px")
        )
      ),
    # end layout

    # scree plot

    box(
      width = NULL,
      solidHeader = TRUE,

      #scree plot
      conditionalPanel(
        "input.plot_scree == true",
        # numericInput("spectral_d_to_view", "Number of eigenvalues to keep:", 5),
        plotlyOutput(outputId = "scree_plot", height = 300),
        checkboxInput(
          inputId = "elbow_detect",
          label = strong("Elbow Detection"),
          value = FALSE
          )
        )
      ),

    #end scree plot
    #pairs plot
    box(
      width = NULL,
      solidHeader = TRUE
      ,

      conditionalPanel("input.plot_pairs == true",
       uiOutput("pairsplot"))
      )
    #end pairs plot
    ),

  column(
    width = 3,
    box(
      width = NULL,

      fileInput('file1', 'Upload Graph',
        accept = c('.graphml')),

       checkboxInput("use_demo_graph", "Use Demo Graph",  value = TRUE),

      checkboxInput(
        inputId = "plot_degree",
        label = strong("Graph Statistics"),
        value = FALSE
        ),
      checkboxInput(
        inputId = "plot_adjacencyy",
        label = strong("Adjacency Matrix"),
        value = FALSE
        ),
      checkboxInput(
        inputId = "plot_layout",
        label = strong("Graph Layout"),
        value = FALSE
        ),

      checkboxInput(
        inputId = "plot_scree",
        label = strong("Scree Plot"),
        value = FALSE
        ),

      conditionalPanel(
        "input.plot_scree == true",
        wellPanel(
          p("Show:"),
          checkboxInput(
            inputId = "scree_A",
            label = strong("Adjacency"),
            value = TRUE
            ),
          checkboxInput(
            inputId = "scree_L",
            label = strong("Laplacian"),
            value = TRUE
            ),
          checkboxInput(
            inputId = "scree_nL",
            label = strong("Normalized Laplacian"),
            value = TRUE
            )
          )
        ),

      checkboxInput(
        inputId = "plot_pairs",
        label = strong("Pairs Plot"),
        value = FALSE
        ),

      conditionalPanel(
        "input.plot_pairs == true",
        sliderInput(
          "eigenvector_range",
          "View Eigenvectors (up to 9):",
          min = 1,
          max = 9#nrow(A)
          ,
          value = c(1, 5),
          step = 1
          )
        # uiOutput("max_ev_range")
        )),

      # selectInput(
      #   inputId = "svd_mat",
      #   label = "Using the spectral decomp of",
      #   choices = c("Adjacency",
      #     "Normalized Laplacian",
      #     "Laplacian"),
      #   selected = "Normalized Laplacian"
      #   ),

    box(
      width = NULL,

      checkboxInput(
        inputId = "embedding_sbm",
        label = strong("Embedding?"),
        value = FALSE
        ),
      conditionalPanel(
        "input.embedding_sbm == true",

        selectInput(
          inputId = "embedding_model",
          label = "Model",
          choices = c("Random Dot Product Model",
            "Stochastic Block Model"),
          selected = "Stochastic Block Model"
          ),

        sliderInput(
          inputId = "embedding_d",
          label = "Latent dimension (d):",
          min = 1,
          max = 50,
          ticks = T,
          step = 1,
          value = 5
          ),

        conditionalPanel(
          "input.embedding_model == 'Stochastic Block Model'",
          sliderInput(
            inputId = "embedding_k",
            label = "Blocks (K):",
            min = 1,
            max = 50,
            ticks = T,
            step = 1,
            value = 5
            )
          )
        ),

      checkboxInput(
        inputId = "use_k_core",
        label = strong("Use k-core?"),
        value = FALSE
        ),

      conditionalPanel("input.use_k_core == true",
       uiOutput("KinKcore"))

      #     sliderInput(
      # inputId = "par_k_cores",
      # label = "K:",
      # min = 1,
      # max = 10,
      # ticks = T,
      # step = 1,
      # value = 10
      # )

      )
    )

  ))

dashboardPage(header,
  dashboardSidebar(disable = TRUE),
  body)


# This R script gets and performs some cleaning on human activity data, built
# from recordings of subjects performing daily activities while carrying
# smartphone. The full description of the data set is available at:
# http://archive.ics.uci.edu/ml/datasets/Human+Activity+Recognition+Using+Smartphones

# This script `run_analysis.R` performs following operations in sequence
# 0. downloads the data from [UCI Machine Learning Repository](http://archive.ics.uci.edu/ml/index.html). if needed
# 1. merges the training and test data sets to create one consolidated data set
# 2. replaces `activity` values in the dataset with descriptive activity names
# 3. extracts only the measurements (features) on the mean and standard deviation for each measurement
# 4. appropriately labels the columns with descriptive names
# 5. creates a second, independent tidy dataset with an average of each variable for each each activity and each subject. In other words, same type of measurements for a particular subject and activity are averaged into one value and the tidy data set contains these mean values only. The processed tidy data set is also exported as csv file.

library(plyr)

# 0. downloads the data from [UCI Machine Learning Repository](http://archive.ics.uci.edu/ml/index.html). if needed
download_data = function() {
  if (!file.exists("data")) {
    dir.create("data")
  }
  if (!file.exists("data/UCI HAR Dataset")) {
    # downloading the data
    fileURL <- "https://d396qusza40orc.cloudfront.net/getdata%2Fprojectfiles%2FUCI%20HAR%20Dataset.zip"
    datazip="data/UCI_HAR_data.zip"
    download.file(fileURL, destfile=datazip, method="curl")
    unzip(datazip, exdir="data")
  }
}

# 1. merges the training and test data sets to create one consolidated data set
merge_data = function() {
  # Read data
  training.x <- read.table("data/UCI HAR Dataset/train/X_train.txt")
  training.y <- read.table("data/UCI HAR Dataset/train/y_train.txt")
  training.subject <- read.table("data/UCI HAR Dataset/train/subject_train.txt")
  test.x <- read.table("data/UCI HAR Dataset/test/X_test.txt")
  test.y <- read.table("data/UCI HAR Dataset/test/y_test.txt")
  test.subject <- read.table("data/UCI HAR Dataset/test/subject_test.txt")

  # Merge
  merged.x <- rbind(training.x, test.x)
  merged.y <- rbind(training.y, test.y)
  merged.subject <- rbind(training.subject, test.subject)
  # merge train and test datasets and return
  list(x=merged.x, y=merged.y, subject=merged.subject)
}

# 3. extracts only the measurements (features) on the mean and standard deviation for each measurement
extract_meansd = function(dataframe) {
  features <- read.table("data/UCI HAR Dataset/features.txt")
  # Find the mean and standard deviation columns
  mean.col <- sapply(features[,2], function(x) grepl("mean()", x, fixed=T))
  std.col <- sapply(features[,2], function(x) grepl("std()", x, fixed=T))

  # Extract them from the data
  exdataframe <- dataframe[, (mean.col | std.col)]
  colnames(exdataframe) <- features[(mean.col | std.col), 2]
  exdataframe
}

# 4. appropriately labels the columns with descriptive names
descriptive_activities = function(dataframe) {
  colnames(dataframe) <- "activity"
  dataframe$activity[dataframe$activity == 1] = "WALKING"
  dataframe$activity[dataframe$activity == 2] = "WALKING_UPSTAIRS"
  dataframe$activity[dataframe$activity == 3] = "WALKING_DOWNSTAIRS"
  dataframe$activity[dataframe$activity == 4] = "SITTING"
  dataframe$activity[dataframe$activity == 5] = "STANDING"
  dataframe$activity[dataframe$activity == 6] = "LAYING"
  dataframe
}

bind.data <- function(x, y, subjects) {
  # Combine mean-std values (x), activities (y) and subjects into one data frame.
  cbind(x, y, subjects)
}

create.tidy.dataset = function(dataframe) {
  # Given X values, y values and subjects, create an independent tidy dataset with the average of each variable for each activity and each subject.
  tidy <- ddply(dataframe, .(subject, activity), function(x) colMeans(x[,1:60]))
  tidy
}

clean_data = function() {
  # Download data
  download_data()
  # merge training and test datasets. merge.datasets function returns a list of three dataframes: X, y, and subject
  mergeddata <- merge_data()
  # Extract only the measurements of the mean and standard deviation for each measurement
  cx <- extract_meansd(mergeddata$x)
  # Name activities
  cy <- descriptive_activities(mergeddata$y)
  # Use descriptive column name for subjects
  colnames(mergeddata$subject) <- c("subject")
  # Combine data frames into one
  combineddata <- bind.data(cx, cy, mergeddata$subject)
  # Create tidy dataset
  # 5. creates a second, independent tidy dataset with an average of each variable for each each activity and each subject.
  tidydata <- create.tidy.dataset(combineddata)
  # Write tidy dataset as csv
  write.table(tidydata, "UCI_HAR_tidydata.csv", row.names=FALSE)
}


h2o.server <- h2o.init(nthreads=-1)
h2o.server.status <- h2o.clusterStatus(h2o.server)

# h2o.shutdown(h2o.server)

master.file.df <- as.data.frame(fread(paste(input.local.data.dir,"master.file.csv",sep="")))
master.file.df <- subset(master.file.df, use.this == "yes")

dl.with.dropout <- TRUE
dataset.names <- sort(unique(master.file.df$dataset))

all.classification.errors <- NULL
for(this.dataset in dataset.names){

  # this.dataset <- "horse-colic" dataset.names[1]
  print(paste0("STARTING Deep Learning on: ", this.dataset))

  this.response.location <- subset(master.file.df, dataset == this.dataset)$index.of.response

  tryCatch((h2o.server.status <- h2o.clusterStatus(h2o.server)),
           error = function(e){
             print("Starting h2o Server")
             h2o.server <- h2o.init(nthreads=-1)
           })

  training.df <- h2o.importFile(h2o.server, path = paste(input.data.dir,"ml-datasets/",this.dataset,".data.training.txt",sep=""), header = F, sep = ',')
  test.df <- h2o.importFile(h2o.server, path = paste(input.data.dir,"ml-datasets/",this.dataset,".data.holdout.txt",sep=""), header = F, sep = ',')

  n.cols <- ncol(training.df)

  predictor.cols <- NULL
  response.col <- NULL

  if(this.response.location == "last"){
    response.col <- n.cols
    predictor.cols <- 1:(n.cols-1)
  }else{
    response.col <- 1
    predictor.cols <- 2:n.cols
  }

  column.names <- colnames(training.df)

  dl.results <- h2o.deeplearning(x=column.names[predictor.cols],
                                 y=column.names[response.col],
                                 training_frame=training.df,
                                 validation_frame=test.df,
                                 hidden=c(10,10,10,10),
                                 epochs=0.1,
                                 activation="Rectifier",
                                 loss = "CrossEntropy", #response defined by loss
                                 export_weights_and_biases = TRUE)

  validation.classification.error <- dl.results@model$validation_metrics@metrics$MSE  #documentation states this is classification error for c problems

  dnn.weights.list <- dl.results@model$weights
  weights.df.names <- c()
  for(dnn.weights in dnn.weights.list){ weights.df.names <- c(weights.df.names,dnn.weights$name) }

  dnn.weights.list <- list()
  for(weights.df.name in weights.df.names){
    dnn.weights.list[[weights.df.name]] <- as.data.frame(h2o.getFrame(weights.df.name, conn = h2o.getConnection(), linkToGC = FALSE))
  }

  save(dnn.weights.list, file=paste0(output.data.dir, "saved-weights/", this.dataset, "-weights-list.RData") )
  h2o.saveModel(dl.results, filename=paste0(output.data.dir, "saved-models/",this.dataset,"_model"), force=TRUE)

  validation.classification.error.dropout <- ""
  if(dl.with.dropout){

      dl.results.w.dropout <- h2o.deeplearning(x=column.names[predictor.cols],
                                                y=column.names[response.col],
                                                training_frame=training.df,
                                                validation_frame=test.df,
                                                hidden=c(10,10,10,10),
                                                epochs=0.1,
                                                activation="RectifierWithDropout",  # "TanhWithDropout"
                                                loss = "CrossEntropy", #response defined by loss
                                                export_weights_and_biases = TRUE)

      dl.model.w.dropout <- dl.results.w.dropout@model

      validation.classification.error.dropout <- dl.results.w.dropout@model$validation_metrics@metrics$MSE  #documentation states this is classification error for c problems

      dnn.dropout.weights.list <- dl.results.w.dropout@model$weights
      weights.dropout.df.names <- c()
      for(dnn.weights in dnn.dropout.weights.list){ weights.dropout.df.names <- c(weights.dropout.df.names,dnn.weights$name) }

      dnn.dropout.weights.list <- list()
      for(weights.df.name in weights.dropout.df.names){
        dnn.dropout.weights.list[[weights.df.name]] <- as.data.frame(h2o.getFrame(weights.df.name, conn = h2o.getConnection(), linkToGC = FALSE))
      }

      save(dnn.dropout.weights.list, file=paste0(output.data.dir, "saved-weights/", this.dataset, "-dropout-weights-list.RData") )
      h2o.saveModel(dl.results.w.dropout, filename=paste0(output.data.dir, "saved-models/",this.dataset,"_dropout_model"), force=TRUE)

  }

  print(paste0("COMPLETED Deep Learning on: ", this.dataset))
  print(paste("Classification Error for Dropout: ", validation.classification.error.dropout))
  print(paste("Classification Error: ", validation.classification.error))

  these.classification.errors <- data.frame(dataset=this.dataset,
                                            cross.entropy.from.dropout=round(validation.classification.error.dropout,2),
                                            cross.entropy = round(validation.classification.error, 2))

  all.classification.errors <- rbind(all.classification.errors, these.classification.errors)
}

write.table(all.classification.errors, file = paste(output.local.data.dir, "cross-entropy-all-datasets.csv",sep=""),row.names=FALSE, sep=",", na="")


files = list.files('./',recursive=1,pattern='filelist.csv$')

for (file in files)
{
	# -------- Histogram --------
	histogram = paste(file, 'histogram.pdf',sep='.')
	pdf(histogram)

	data = read.csv(file, header=T)
	axioms = as.matrix(data$logical_axiom_count)
	hist(axioms,
		main='Histogram of logical axioms',
		ylab="Number of ontologies",
		xlab='Logical axioms')

	dev.off()

	# -------- KDE --------

	density = paste(file, 'density.pdf',sep='.')
	pdf(density)

	d <- density(axioms)
	plot(d,
		main="Kernel density estimation of logical axioms")

	dev.off()

	# -------- Histogram limited --------

	histogram2 = paste(file, 'pie.pdf',sep='.')
	pdf(histogram2)

	m = as.matrix(table(data$constructs))
	total = sum(m[,1])
	limit = total / 40
	m1 = subset(m, m[,1] > limit)
	m2 = subset(m, m[,1] <= limit)
	c = matrix(c(sum(m2)), dimnames=list(c('Other',c())))

	result = rbind(m1,c)

	options(digits=2)
	result = round(result / (total * 0.01), digits=2)

	print(m1)

	labs = paste(names(result[,]), "\n", result[,],"%", sep="")
	pie(result[,],
		labels = labs,
		col=gray(seq(0,1,length=length(result))),
		main="Expressivity of ontologies")

	dev.off()
}