library(jsonlite)
library(ggplot2)
library(zoo)

library(colorspace)
library(gridExtra)

library(plotly)
library(htmlwidgets)

library(sf)
sf_use_s2(FALSE)

library(lubridate)
library(plyr)

library(dplyr)

library(tidyr)

library(reshape2)

library("scales")
Sys.setlocale("LC_TIME", "hr_HR.UTF-8")

# get last_date_
load('data/latest/last_date_.Rda')

# get age data
json_data <- fromJSON('data/latest/last_data_po_osobama.json')

# age grouping step
step <- 5

population_by_age <- read.csv(file = 'data/cro_population_by_age.csv')

json_data <- json_data %>%  mutate(dob = ifelse(dob < 1901, NA, dob))

json_data$Datum <- as.Date(json_data$Datum, format="%Y-%m-%d")

min_date = min(json_data$Datum)
max_date = max(json_data$Datum)

json_data <- json_data[order(json_data$Datum),]

json_data$dob <- as.Date(paste0(json_data$dob, '-01-01'), format="%Y-%m-%d")

json_data$age <- round(time_length(difftime(json_data$Datum, json_data$dob), "years"))

json_data$age_group <- findInterval(json_data$age, seq(0, 85, by=step))

labels <- paste0(seq(0, 85, by=step), '-', seq(step - 1, 85, by=step), sep='')

labels[length(labels)] = '85+'

counties <- unique(json_data[c("Zupanija")])

f <- list(size = 13, color = "black")

p <- list()
a <- list()
i <-22

current_county_data <- json_data

json_d <- current_county_data %>% group_by(Datum, age_group) %>% tally()

age_reshaped <- pivot_wider(json_d, names_from = age_group, values_from = n) %>%
  mutate_at(vars(-("Datum")), ~replace(., is.na(.), 0))

missing_cols <- setdiff(as.character(c(1:length(labels))), names(age_reshaped))

age_reshaped[missing_cols] <- 0

age_reshaped <- age_reshaped[c('Datum', as.character(1:length(labels)))]

# add missing dates
missing_rows <- as.Date(setdiff(seq.Date(min_date, max_date, by="day"), age_reshaped$Datum))
missing_data <- data.frame(missing_rows)
colnames(missing_data)[1] <- "Datum"

age_reshaped <- rbind.fill(age_reshaped, missing_data)
age_reshaped[is.na(age_reshaped)] <- 0

# sort by date
age_reshaped <- age_reshaped[order(age_reshaped$Datum),]

# calc 7 day sums
age_reshaped_sum7 <- as.data.frame(rollapply(age_reshaped[, names(age_reshaped) != "Datum"], 7, sum, fill=0, align="right"))

current_population <-c(population_by_age[1:nrow(population_by_age) - 1, c(i + 1)])

age_reshaped_sum7[, 1:ncol(age_reshaped_sum7)] <- sweep(age_reshaped_sum7[, 1:ncol(age_reshaped_sum7)], 2, current_population / 100000, `/`)
#
# change column names to age groups
colnames(age_reshaped_sum7)[1:length(labels)] <- labels

age_reshaped_sum7$Datum <- age_reshaped$Datum

data_to_plot <- head(age_reshaped_sum7, n=nrow(age_reshaped_sum7) - 1)

last_date <- strftime(data_to_plot$Datum[(nrow(data_to_plot))], "%d.%m.%Y.")

d <- melt(data_to_plot, id.vars="Datum")

colnames(d)[2:3] <- c('Dobna_skupina', 'Broj_zadnjih_7_data')

my_breaks <-c(0, 10, 50, 100, 200, 400, 800)
my_labels <-c('0', '10', '50', '100', '200', '400', '800+')

# p <- ggplot(d, aes_string('Datum', colnames(d)[2], fill='Broj_zadnjih_7_data')) +
#   geom_tile() +
#   ylab("Dobna skupina") +
#   scale_fill_distiller(palette="Spectral", oob = scales::squish, name='Ukupno\nu 7 dana\nna 100000\nstanovnika',
#                        limits = c(0, 800), labels=my_labels, breaks=my_breaks) +
#   theme_minimal()

d

# 18-24
# 25-49
# 50-59
# 60-69
# 70-79
# 80+

library(scales)

colour_hex_codes <- hue_pal()(6)

p <- ggplot() +
  geom_line(data=data_to_plot, aes(Datum, y=`20-24`, colour='20-24', size='20-24')) +

  geom_line(data=data_to_plot, aes(Datum, y=`30-34`, colour='30-34', size='30-34')) +
  geom_line(data=data_to_plot, aes(Datum, y=`35-39`, colour='35-39', size='35-39')) +
  geom_line(data=data_to_plot, aes(Datum, y=`40-44`, colour='40-44', size='40-44')) +
  geom_line(data=data_to_plot, aes(Datum, y=`45-49`, colour='45-49', size='45-49')) +
  geom_line(data=data_to_plot, aes(Datum, y=`50-54`, colour='50-54', size='50-54')) +
  geom_line(data=data_to_plot, aes(Datum, y=`55-59`, colour='55-59', size='55-59')) +
  geom_line(data=data_to_plot, aes(Datum, y=`60-64`, colour='60-64', size='60-64')) +
  geom_line(data=data_to_plot, aes(Datum, y=`65-69`, colour='65-69', size='65-69')) +

  geom_line(data=data_to_plot, aes(Datum, y=`70-74`, colour='70-74', size='70-74')) +
  geom_line(data=data_to_plot, aes(Datum, y=`75-79`, colour='75-79', size='75-79')) +
  geom_line(data=data_to_plot, aes(Datum, y=`80-84`, colour='80-84', size='80-84')) +
  geom_line(data=data_to_plot, aes(Datum, y=`85+`, colour='85+', size='85+')) +

  geom_line(data=data_to_plot, aes(Datum, y=`25-29`, colour='25-29', size='25-29')) +

  geom_line(data=data_to_plot, aes(Datum, y=`0-4`, colour='0-4', size='0-4')) +
  geom_line(data=data_to_plot, aes(Datum, y=`5-9`, colour='5-9', size='5-9')) +

  geom_line(data=data_to_plot, aes(Datum, y=`15-19`, colour='15-19', size='15-19')) +
  geom_line(data=data_to_plot, aes(Datum, y=`10-14`, colour='10-14', size='10-14')) +

  #scale_x_date(labels = date_format("%d.%m."), date_breaks = "1 week") +
  scale_x_date(labels = date_format("%b %Y."), date_breaks = "1 month") +
  scale_color_manual(name='Dobna skupina', values = c(
    '0-4' = 'black',
    '5-9' = 'black',
    '10-14' = 'black',

    '15-19' = colour_hex_codes[1],
    '20-24' = colour_hex_codes[1],

    '25-29' = colour_hex_codes[2],
    '30-34' = colour_hex_codes[2],
    '35-39' = colour_hex_codes[2],
    '40-44' = colour_hex_codes[2],
    '45-49' = colour_hex_codes[2],

    '50-54' = colour_hex_codes[3],
    '55-59' = colour_hex_codes[3],
    '60-64' = colour_hex_codes[4],
    '65-69' = colour_hex_codes[4],
    '70-74' = colour_hex_codes[5],
    '75-79' = colour_hex_codes[5],
    '80-84' = colour_hex_codes[6],
    '85+' = colour_hex_codes[6]))  +
  scale_size_manual(name='Dobna skupina', values = c(
    '0-4' = 0.3,
    '5-9' = 0.7,
    '10-14' = 1.2,

    '15-19' = 1.2,
    '20-24' = 0.5,

    '25-29' = 1.2,
    '30-34' = 0.9,
    '35-39' = 0.6,
    '40-44' = 0.4,
    '45-49' = 0.2,

    '50-54' = 1,
    '55-59' = 0.5,
    '60-64' = 1,
    '65-69' = 0.5,
    '70-74' = 1,
    '75-79' = 0.5,
    '80-84' = 1,
    '85+' = 0.5)) +
  theme_minimal() +
  theme(legend.position="right") +
  ylab('Broj slučajeva na 100k stanovnika') +
  labs(title = paste('Kretanje broja COVID-19 slučajeva na 100 tisuća stanovnika po dobnim skupinama u Hrvatskoj (02.03.2020. -', last_date, ')', sep='')) +
  theme(text = element_text(size=18)) +
  labs(caption = paste('Izvori podataka: koronavirus.hr (broj slučajeva), dzs.hr (broj stanovnika po dobnim skupinama, podaci iz 2019.). Generirano:', format(Sys.time() + as.difftime(1, units="hours"), '%d.%m.%Y. %H:%M:%S h.'), 'Autor: Petar Palašek, ppalasek.github.io')) +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1))
p

ggsave(paste('img/', last_date_, '_cases_per_age_group_lines.png', sep = ''),
       plot = p, dpi=300, width=1600*4, height=700*4, units="px",
       bg = "white")

p <- ggplot() +
  geom_line(data=data_to_plot, aes(Datum, y=`20-24`, colour='20-24', size='20-24')) +

  geom_line(data=data_to_plot, aes(Datum, y=`30-34`, colour='30-34', size='30-34')) +
  geom_line(data=data_to_plot, aes(Datum, y=`35-39`, colour='35-39', size='35-39')) +
  geom_line(data=data_to_plot, aes(Datum, y=`40-44`, colour='40-44', size='40-44')) +
  geom_line(data=data_to_plot, aes(Datum, y=`45-49`, colour='45-49', size='45-49')) +
  geom_line(data=data_to_plot, aes(Datum, y=`50-54`, colour='50-54', size='50-54')) +
  geom_line(data=data_to_plot, aes(Datum, y=`55-59`, colour='55-59', size='55-59')) +
  geom_line(data=data_to_plot, aes(Datum, y=`60-64`, colour='60-64', size='60-64')) +
  geom_line(data=data_to_plot, aes(Datum, y=`65-69`, colour='65-69', size='65-69')) +

  geom_line(data=data_to_plot, aes(Datum, y=`70-74`, colour='70-74', size='70-74')) +
  geom_line(data=data_to_plot, aes(Datum, y=`75-79`, colour='75-79', size='75-79')) +
  geom_line(data=data_to_plot, aes(Datum, y=`80-84`, colour='80-84', size='80-84')) +
  geom_line(data=data_to_plot, aes(Datum, y=`85+`, colour='85+', size='85+')) +

  geom_line(data=data_to_plot, aes(Datum, y=`25-29`, colour='25-29', size='25-29')) +

  geom_line(data=data_to_plot, aes(Datum, y=`0-4`, colour='0-4', size='0-4')) +
  geom_line(data=data_to_plot, aes(Datum, y=`5-9`, colour='5-9', size='5-9')) +

  geom_line(data=data_to_plot, aes(Datum, y=`15-19`, colour='15-19', size='15-19')) +
  geom_line(data=data_to_plot, aes(Datum, y=`10-14`, colour='10-14', size='10-14')) +

  #scale_x_date(labels = date_format("%d.%m."), date_breaks = "1 week") +
  scale_x_date(labels = date_format("%b %Y."), date_breaks = "1 month") +
  scale_color_manual(name='Dobna skupina', values = c(
    '0-4' = 'black',
    '5-9' = 'black',
    '10-14' = 'black',

    '15-19' = colour_hex_codes[1],
    '20-24' = colour_hex_codes[1],

    '25-29' = colour_hex_codes[2],
    '30-34' = colour_hex_codes[2],
    '35-39' = colour_hex_codes[2],
    '40-44' = colour_hex_codes[2],
    '45-49' = colour_hex_codes[2],

    '50-54' = colour_hex_codes[3],
    '55-59' = colour_hex_codes[3],
    '60-64' = colour_hex_codes[4],
    '65-69' = colour_hex_codes[4],
    '70-74' = colour_hex_codes[5],
    '75-79' = colour_hex_codes[5],
    '80-84' = colour_hex_codes[6],
    '85+' = colour_hex_codes[6]))  +
  scale_size_manual(name='Dobna skupina', values = c(
    '0-4' = 0.3,
    '5-9' = 0.7,
    '10-14' = 1.2,

    '15-19' = 1.2,
    '20-24' = 0.5,

    '25-29' = 1.2,
    '30-34' = 0.9,
    '35-39' = 0.6,
    '40-44' = 0.4,
    '45-49' = 0.2,

    '50-54' = 1,
    '55-59' = 0.5,
    '60-64' = 1,
    '65-69' = 0.5,
    '70-74' = 1,
    '75-79' = 0.5,
    '80-84' = 1,
    '85+' = 0.5)) +
  theme_minimal() +
  theme(legend.position="right") +
  ylab('Broj slučajeva na 100k stanovnika') +
  scale_y_continuous(trans='pseudo_log', breaks = c(0, 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096)) +
  labs(title = paste('Kretanje broja COVID-19 slučajeva na 100 tisuća stanovnika po dobnim skupinama u Hrvatskoj (02.03.2020. -', last_date, ') (logaritamska skala)', sep='')) +
  theme(text = element_text(size=18)) +
  labs(caption = paste('Izvori podataka: koronavirus.hr (broj slučajeva), dzs.hr (broj stanovnika po dobnim skupinama, podaci iz 2019.). Generirano:', format(Sys.time() + as.difftime(1, units="hours"), '%d.%m.%Y. %H:%M:%S h.'), 'Autor: Petar Palašek, ppalasek.github.io')) +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1))
p

ggsave(paste('img/', last_date_, '_cases_per_age_group_lines_log.png', sep = ''),
       plot = p, dpi=300, width=1600*4, height=700*4, units="px",
       bg = "white")

p


library(shiny)
library(forecast)
library(tseries)
library(DT)
library(ggplot2)
library(tidyr)
library(xts)
library(dygraphs)
library(forecastHybrid)

#webshot::install_phantomjs()
#source("common.R")

function(input, output, session) {

# added "session" because updateSelectInput requires it
# adding action button

  data <- reactive({
    input$upload
    isolate(
    req(input$file1) ## ?req #  require that the input is available
    )
    inFile <- input$file1

    df <- read.csv(inFile$datapath, header = TRUE, sep = input$sep)

    # Update inputs (you could create an observer with both updateSel...)
    # You can also constraint your choices. If you wanted select only numeric
    # variables you could set "choices = sapply(df, is.numeric)"
    # It depends on what do you want to do later on.

    updateSelectInput(session, inputId = 'xcol', label = 'X Variable',
                      choices = names(df), selected = names(df)[1])
    updateSelectInput(session, inputId = 'ycol', label = 'Y Variable',
                      choices = names(df), selected = names(df)[2])
    updateSelectInput(session, inputId = 'xreg', label = 'xreg',
                      choices = names(df), selected = names(df)[3])

    return(df)

})

###################################################################
#1. presenting data

  output$contents <- renderDataTable(
    {
      data()
    },

    options = list(lengthMenu = c(10, 30, 50), pageLength = 10,searching=TRUE)

  )#end function

###################################################################
#2. plotting the function using plot methods.
# the function is replaced with dygraph

  output$MyPlot <- renderPlot(
    {
    #x <- data()[, c(input$xcol, input$ycol)]
    #plot(mydata)

    }
  )# end function

###################################################################
# Plot the data using dygraph

  output$dygraph <- renderDygraph(
    {
      input$drawPlot
      isolate(
      dygraph( xts(x = data(), order.by = as.Date(data()[,input$xcol] , format='%m/%d/%Y'))
      , main = "Predicted Deaths/Month" ) %>%
      dyOptions(drawGrid = input$xcol) %>%
      dyRangeSelector()
      )
    })

##########################################################################
##################### subset of the data.
subsetdata  <- reactive({

df <- data()
if (is.null(df)) return(NULL)
if(!is.numeric( input$Xrange[1]) ) {
        df
}

if(!is.numeric( input$Yrange[1]) ) {
        df
}

if(is.numeric( input$Xrange[1]) & is.numeric(df[,input$xcol])) {
df<- df [!is.na(df[,input$xcol]),]

df <-  df [df[,input$xcol] >= input$Xrange[1]&df[,input$xcol] <= input$Xrange[2],]

}

if(is.numeric( input$Yrange[1])& is.numeric(df[,input$ycol]) ) {
df<- df [!is.na(df[,input$ycol]),]

df <-  df [df[,input$ycol] >= input$Yrange[1]&df[,input$ycol] <= input$Yrange[2],]

}

df
})

############################################################################
#############################download plot downloadPlot based on plot function
  output$downloadPlot <- downloadHandler(

    filename = function () {paste('plot', '.png',sep='') },
    content = function(file) {
      cat(output$dygraph,file = 'temp.html')

    saveWidget(x, "temp.html", selfcontained = FALSE)
     webshot("temp.html", file = file)
    }

    )#end download plot handler

#################### chossing the model ####################################
##applying model
  modeldata <- reactive(
    {
      #Converting frequecny from character into int.
      #adding regressors
      xreg <- (data()[ ,input$xreg])
      mydata<-ts(data()[ ,input$ycol],frequency= as.numeric(input$freq))

      #choose between models
      if(input$model =="ARIMA")
      {
        #results <- auto.arima(mydata)
        results <- auto.arima(mydata,xreg = xreg ,frequency= input$freq)
      }# end ARIMA

      # 2. ANN model
      else if (input$model =="ANN")
      {
        #results <- nnetar(mydata)
         results <- nnetar(mydata,xreg = xreg,frequency= as.numeric(input$freq))
      }
      # TBATS model, note TBATS do not accept regressors
      else if (input$model == "TBATS")
      {
        results <- tbats(mydata)
      }
      # Exponential smoothing model
      else if (input$model =="HoltWinters")
      {
        results <- HoltWinters(mydata)
      }
      else if (input$model == "STLF")
      {
        results <-  stlf(mydata,s.window="periodic", method=c("ets","arima","naive","rwdrift"))
      }
      else if (input$model == "HybridModel")
      {
        results <- hybridModel(mydata,
                               models = "aenst",
                               a.args = list(xreg = xreg),
                               n.args = list(xreg = xreg),
                               s.args = list(xreg = xreg, method = "arima"))
      }

      input$applymodel
      isolate(        return(results))

    })#end function

#########################################################################
#presenting output
    output$modelData <- renderPrint(
     {
       input$applymodel
       isolate(
        modeldata()
        )
     })

#presenting summary
    output$modelData2 <- renderTable(
     {
       input$applymodel
       isolate({
       mydaya <- ts(data()[,input$ycol])

#comparing models
# if ARIMA
      if(input$model =="ARIMA")
        {
          summary(modeldata())
        }#if TBATS
      else if (input$model == "TBATS")
        {
          accuracy(modeldata()$fitted.values,mydaya)
        }#if ANN
      else if (input$model == "ANN")
        {
          accuracy(modeldata()$fitted,mydaya)
        }
      else if (input$model == "STLF")
        {
          accuracy(modeldata()$fitted,mydaya)
        }
      else if (input$model == "HoltWinters")
        {
          accuracy(modeldata()$fitted,mydaya)
        }
      else if (input$model == "HybridModel")
        {
          accuracy(modeldata()$fitted,mydaya)
        }
       })
      })#end function

###############################################################
# plotting forecasting period.##############################
  output$forecastPlot <- renderPlot(
    {
      xreg <- data.frame(data()[ ,input$xreg])
      input$forecastAction
    isolate(    {
      if (input$model == "ARIMA" || input$model == "ANN")
      {
        autoplot(forecast(modeldata(),xreg = xreg, h = input$FP))
      }
      else if (input$model == "TBATS")
      {
        p <- predict(modeldata())
        autoplot(p)
      }
      else if (input$model == "HybridModel")
      {

        autoplot(forecast(modeldata(),xreg = xreg, h = as.numeric(input$FP)))
      }
      else if(input$model =="HoltWinters")
      {
        y <- modeldata()
        p <- predict(y, input$FP)

        X <- cbind(  fitted = y$fitted[,1] , mean = p)
        df <- cbind(y$x, X)
        colnames(df) <- c("Data", "Fitted", "Forecasting")
        autoplot(df)
      }
      else if(input$model == "STLF")
      {
        autoplot(modeldata())
      }

    })

    }
  )#end function
############################################################
######## present forecast data

    output$forecastTables <- renderDataTable({
      xreg <- data.frame(data()[ ,input$xreg])
      input$forecastAction
      isolate({

        if (input$model == "ARIMA")
        {
          p <- forecast(modeldata(), xreg = xreg, h = input$FP)
          a <- cbind(p$mean,p$lower,p$upper)
          colnames(a) <- c("Point Forecast","LO 95","HI 95","Lo 80","Hi 80")
        }
        else if (input$model == "ANN")
        {
          p <- forecast(modeldata(), xreg = xreg, h = input$FP)
          a <- cbind( seq(1:length(p$mean)),p$mean)
          colnames(a) <- c("Point Forecast","mean")

        }
        else if (input$model == "TBATS")
        {
          p <- (predict(modeldata()))
          a <- cbind(p$mean,p$lower,p$upper)
          colnames(a) <- c("Point Forecast","LO 95","HI 95","Lo 80","Hi 80")
        }
        else if(input$model == "STLF" || input$model == "HoltWinters")
        {
          p <- forecast(modeldata(),h = input$FP)
          a <- cbind( seq(1:length(p$mean)),p$mean)
          colnames(a) <- c("Point Forecast","mean")

        }
        else if (input$model ==  "HybridModel")
        {

          p <- forecast(modeldata(), xreg = xreg, h = as.numeric(input$FP)
                        , FUN = hybridModel)
          a <- cbind( seq(1:length(p$mean)),p$mean)
          colnames(a) <- c("Point Forecast","mean")

        }
        # format the data
        a <- formatC(a)
      })

#  colnames(a) <- c("Point Forecast","LO 95","HI 95","Lo 80","Hi 80")
    }, options = list(lengthMenu = c(10, 30, 50), pageLength = 10,searching=TRUE))

############################################################
# Download forecasted data and figure as pdf
    output$forecastData <- downloadHandler(
      filename = function() {

        paste("forecasting-",input$model,'.csv',sep='')},
      content = function(file){
        xreg <- data.frame(data()[ ,input$xreg])

        if (input$model == "ARIMA")
        {
          p <- forecast(modeldata(),xreg= xreg,h = input$FP)
          dataFor <- data.frame(p$mean,p$lower,p$upper)
          colnames(dataFor) <- c("Point Forecast","LO 95","HI 95","Lo 80","Hi 80")
        }
        else if (input$model == "ANN")
        {
          p <- forecast(modeldata(),xreg = xreg,h = input$FP)
          dataFor <- data.frame(p$mean)
          colnames(dataFor) <- c("Forecasting")

        }
        else if (input$model == "TBATS")
        {
          p <- (predict(modeldata()))
          dataFor <- data.frame(p$mean,p$lower,p$upper)
          colnames(dataFor) <- c("Point Forecast","LO 95","HI 95","Lo 80","Hi 80")
        }
        else if(input$model == "STLF" || input$model == "HoltWinters")
        {
          p <- forecast(modeldata(),h = input$FP)
          dataFor <- data.frame( p$mean)
          colnames(dataFor) <- c("Forecasting")

        }
        else if (input$model == "HybridModel")
        {
          p <- forecast(modeldata(), xreg = xreg, h = as.numeric(input$FP)
                        , FUN = hybridModel)
          dataFor <- data.frame( p$mean)
          colnames(dataFor) <- c("Forecasting")
        }
        # format the data
       # dataFor <- formatC(dataFor)
        write.csv(dataFor,file)
      }

    )#end function

############################################################
##############Reiduals######################################

  output$residualsTables <- renderDataTable(
    {

      if(input$model == "HoltWinters" || input$model == "HybridModel")
      {
        a <-  cbind( seq(1:length(residuals(modeldata()))),residuals(modeldata()))

        colnames(a) <- c("Sequence","Residuals")

      }else
      {
        a <-  cbind( seq(1:nrow(data())),residuals(modeldata()))
        colnames(a) <- c("Sequence","Residuals")
      }
      # removing NULL values, adjusting data format
      a <- na.omit(a)
      a <- formatC(a)

    },
    options = list(lengthMenu = c(10, 30, 50), pageLength = 10,searching=TRUE))

########################################################### Residuals plot
# plot  residuals figure.
# adjusting time series by date.
    output$residualsPlot <- renderPlot(
      {
        autoplot(residuals(modeldata()))
      }
    )
############################################################
# Download Residuals data
  output$downloadRes <- downloadHandler(
    filename = function() {

      paste("res-",input$model,'.csv',sep='')},
    content = function(file){

      DataRes <-  data.frame(residuals(modeldata()))
      # removing NULL values, adjusting data format
      DataRes <- na.omit(DataRes)
      colnames(DataRes) <- c("Residuals")
      write.csv(DataRes,file)
    }

    )#end function

}# end session


executeTask <- function(i) {
	a1 <- c(1+i, 2-i, 3+i, 4-i, 5+i)
	a2 <- c(6+i, 7-i, 8+i, 9-i, 10+i)
	a3 <- c(a1, a2)
	return(i)
}

r = 1
for(i in 0:2000000000) {
	r = executeTask(i)
}


inverserunlengthencoding <- function(x)
{
    lengths <- as.numeric(unlist(strsplit(output, "[[:alpha:]]")))
    values <- unlist(strsplit(output, "[[:digit:]]"))
    values <- values[values != ""]
    uncompressed <- inverse.rle(list(lengths=lengths, values=values))
    paste(uncompressed, collapse="")
}

output <- "12W1B12W3B24W1B14W"
inverserunlengthencoding(output)


# wahpenayo at gmail dot com
# 2018-01-02
#-----------------------------------------------------------------
if (file.exists('e:/porta/projects/taigabench')) {
  setwd('e:/porta/projects/taigabench')
} else {
  setwd('c:/porta/projects/taigabench')
}
source('src/scripts/r/functions.r')
#-----------------------------------------------------------------
prefixes <- c('h2o','randomForest','randomForestSRC',
  'scikit-learn','taiga','xgboost')
#-----------------------------------------------------------------
classify <- NULL
for (prefix in prefixes) {
  f <- results.file(
    dataset='ontime',
    problem='classify',
    prefix=prefix)
  print(f)
  classify <- rbind(classify,read_csv(file=f))
}
classify$model <- factor(classify$model,levels=models)
dev.on(
  file=plot.file(
    dataset='ontime',problem='classify',
    prefix='classify-traintime'),
  aspect=0.5,
  width=1280)
ggplot(classify, aes(x = ntrain, y = traintime, color = model)) +
  geom_point(size=4.0) +
  geom_line(size=2.0) +
  scale_x_log10(breaks = (1000000*c(0.01,0.1,1,10))) +
  scale_y_log10() +
  scale_color_manual(values=(model.colors),drop=FALSE) +
  theme(text=element_text(size=24)) +
  ggtitle("lower is better")
dev.off()
dev.on(
  file=plot.file(
    dataset='ontime',
    problem='classify',
    prefix="auc"),
  aspect=0.5,
  width=1280)
ggplot(classify, aes(x = ntrain, y = auc, color = model)) +
  geom_point(size=4.0) +
  geom_line(size=2.0) +
  scale_x_log10(breaks = (1000000*c(0.01,0.1,1,10)))  +
  scale_color_manual(values=(model.colors),drop=FALSE) +
  theme(text=element_text(size=24)) +
  ggtitle("higher is better")
dev.off()
#-----------------------------------------------------------------
l2 <- NULL
for (prefix in prefixes) {
  f <- results.file(
    dataset='ontime',
    problem='l2',
    prefix=prefix)
  l2 <- rbind(l2,read_csv(file=f)) }
l2$model <- factor(l2$model,levels=models)
dev.on(
  file=plot.file(
    dataset='ontime',problem='l2',prefix='l2-traintime'),
  aspect=0.5,
  width=1280)
ggplot(l2, aes(x=ntrain,y=traintime,color=model)) +
  geom_point(size=4.0) +
  geom_line(size=2.0) +
  scale_x_log10(breaks = (1000000*c(0.01,0.1,1,10))) +
  scale_y_log10() +
  scale_color_manual(values=(model.colors),drop=FALSE) +
  theme(text=element_text(size=24)) +
  ggtitle("lower is better")
dev.off()

dev.on(
  file=plot.file(
    dataset='ontime',
    problem='l2',
    prefix='rmse'),
  aspect=0.5,
  width=1280)
ggplot(l2, aes(x=ntrain, y=rmse, color=model)) +
  geom_point(size=4.0) +
  geom_line(size=2.0) +
  scale_x_log10(breaks = (1000000*c(0.01,0.1,1,10)))  +
  scale_color_manual(values=(model.colors),drop=FALSE) +
  theme(text=element_text(size=24)) +
  ggtitle("lower is better")
dev.off()
#-----------------------------------------------------------------
qcost <- read_csv(
  file=file.path('output','qcost','ontime','results.csv'))
qcost$model <- factor(qcost$model,levels=models)
dev.on(
  file=plot.file(
    dataset='ontime',problem='qcost',
    prefix='qcost-traintime'),
  aspect=0.5,
  width=1280)
ggplot(qcost, aes(x=ntrain,y=traintime,color=model)) +
  geom_point(size=4.0) +
  geom_line(size=2.0) +
  scale_x_log10(breaks = (1000000*c(0.01,0.1,1,10))) +
  scale_y_log10() +
  scale_color_manual(values=(model.colors),drop=FALSE) +
  theme(text=element_text(size=24)) +
  ggtitle("lower is better")
dev.off()

dev.on(
  file=plot.file(
    dataset='ontime',
    problem='qcost',
    prefix='qcost'),
  aspect=0.5,
  width=1280)
ggplot(qcost, aes(x=ntrain, y=decilecost, color=model)) +
  geom_point(size=4.0) +
  geom_line(size=2.0) +
  scale_x_log10(breaks = (1000000*c(0.01,0.1,1,10)))  +
  scale_color_manual(values=(model.colors),drop=FALSE) +
  theme(text=element_text(size=24)) +
  ggtitle("lower is better")
dev.off()
#-----------------------------------------------------------------


# 3. faza: Vizualizacija podatkov

#-------------------------------------------------------------------------------
#GRAFI

#spol:

zdruzitev <- zivljenje.po.spolu %>%
  dplyr::select(drzava, leto,spol, pricakovana.starost, zdrava.leta) %>%
  pivot_longer(cols = c(pricakovana.starost, zdrava.leta),
               names_to = "ID",
               values_to = "leta")
zdruzitev$drzava[zdruzitev$drzava == "United Kingdom"] <- "UK"
zdruzitev$drzava[zdruzitev$drzava == "Czech Republic"] <- "Czech Rep."
zdruzitev$zdruzeno <- paste(zdruzitev$ID, zdruzitev$spol, sep = "-")

# skupaj pricakovana starost in zdrava leta
leta.po.drzavah.graf <- ggplot(zdruzitev) +
  geom_line(aes(x = leto, y = leta, color = zdruzeno)) +
  scale_color_manual("",
                     values = c("red", "blue", "#F8766D", "#00BFC4"),
                     labels = c("ženske - pričakovana starost",
                                "moški - pričakovana starost",
                                "ženske - zdrava leta",
                                "moški - zdrava leta") )+
  facet_wrap(.~drzava)+
  labs(
    x = "Leto",
    y = "Pričakovana življenjska doba ob rojstvu in število zdravih let",
    title = "Gibanje življenjske dobe ob rojstvu \nin števila zdravih let, glede na spol in leto v Evropi"
  )+
  theme(
    axis.text.x = element_text(angle = 50, vjust = 0.5),
    axis.title.x = element_text(vjust = 0))

leta.po.drzavah.graf

odstotek.po.spolu.graf <- zivljenje.po.spolu%>% filter(leto == "2018") %>%
  ggplot(mapping = aes(x = spol, y = odstotek.zdravih.od.pricakovanih)) +
  geom_boxplot()+
  ylab("Odstotek zdravih let od pričakovane življenjske dobe")+
  xlab("Spol")+
  ggtitle("Odstotek zdravih let življenja od pričakovane \nživljenjske dobe glede na spol za leto 2018")+
  scale_x_discrete(labels=c("Ženske","Moški"))

odstotek.po.spolu.graf

# samo pričakovana starost in zdrava leta, po državah oz. letih

pricakovana.2018.graf <- zivljenje %>%filter(leto == "2018")%>%
  ggplot()+
  geom_bar(mapping = aes(x = reorder(drzava, -pricakovana.starost),
                               y = pricakovana.starost),
                 stat = "identity")+
  ylab("Pričakovana življenjska doba ob rojstvu")+
  xlab("Država")+
  theme_classic()+
  theme(
    axis.text.x = element_text(angle = 50, vjust = 0.5),
    axis.title.x = element_text(vjust = 0))+
  ggtitle("Pričakovana življenjska doba po državah leta 2018")+
  geom_hline(yintercept=mean(filter(zivljenje, leto == "2018")$pricakovana.starost),color="red")
pricakovana.2018.graf

# pricakovana leta in BDP, sadje in zelenjava, revscina

pricakovana.in.BDP.graf <- zivljenje %>%filter(!is.na(odstotek.BDP.ki.gre.v.zdravstvo))%>% filter(leto == "2011") %>%
  ggplot() +
  aes(x = odstotek.BDP.ki.gre.v.zdravstvo, y = pricakovana.starost, color = zdrava.leta) +
  geom_point()+
  labs(
    x ="% BDP, ki ga država nameni v zdravstvo",
    y = "Pričakovana življenjska doba",
    title = "Pričakovana življenjska doba v odvisnosti od % BDP namenjenega v zdravstvo leta 2011",
    color = "Zdrava leta"
  )+
  scale_color_gradient(low = "blue", high = "red")

pricakovana.in.BDP.graf

pricakovana.in.sadje.graf <- ggplot(zivljenje %>% filter(!is.na(kg.na.osebo)) %>% filter(leto == "2011"))+
  aes(x = kg.na.osebo, y = pricakovana.starost, color = zdrava.leta) +
  geom_point()+
  labs(
    x = "Sadje in zelenjava, ki je na voljo na eno osebo v enem letu, v kg",
    y = "Pričakovana življenjska doba",
    color = "Zdrava leta",
    title = "Pričakovana življenjska doba in količina sadja in zelenjave na osebo leta 2011",
    color = "Zdrava leta"
  )+ scale_color_gradient(low = "blue", high = "red")

pricakovana.in.sadje.graf

pricakovana.in.revscina.graf <- ggplot(zivljenje %>% filter(!is.na(tveganje.revscine))%>%filter(leto == "2011")) +
  aes(x = tveganje.revscine, y = pricakovana.starost, color = zdrava.leta)+
  geom_point()+
  labs(
    x = "Tveganje revščine",
    y = "Pričakovana življenjska doba",
    title = "Pričakovana življenjska doba ob rojstvu glede na tveganje revščine v letu 2011",
    color = "Zdrava leta"
  )+ scale_color_gradient(low = "blue", high = "red")

pricakovana.in.revscina.graf

#Dodatni grafi
# pricakovana leta po državah čez leta
ggplot(zivljenje) + aes(x = leto, y= pricakovana.starost, color = drzava) + geom_line()

# odstotek po spolu;
ggplot(zivljenje.po.spolu) +
  aes(x = leto, y = odstotek.zdravih.od.pricakovanih, color = spol)+
  geom_line()+
  facet_wrap(.~drzava)+
  ggtitle("Evropa")+
  ylab("Odstotek zdravih let življenja od pričakovane starosti")+
  scale_color_manual("Spol",
                     values = c("#F8766D", "#00BFC4"),
                     labels = c("ženske", "moški"))

zivljenje %>% ggplot(mapping = aes(x = as.character(leto), y = zdrava.leta))+
  geom_boxplot()+
  labs(
    x = "leto",
    y = "zdrava leta"
  )

zivljenje %>% ggplot(mapping = aes(x = as.character(leto), y = pricakovana.starost))+
  geom_boxplot()+
  labs(
    x = "leto",
    y = "pričakovana starost"
  )

#-------------------------------------------------------------------------------
#ZEMLJEVIDI

data("World")
zivljenje1 <- zivljenje
zivljenje1$drzava[zivljenje1$drzava == "Czech Republic"] <- "Czech Rep."

map <- function(){
  evropa <- World %>% filter (continent == 'Europe')
  starost <- zivljenje1 %>% filter (leto =="2018") %>% dplyr::select('drzava', 'pricakovana.starost', "zdrava.leta")
  podatki <- merge(y = starost,x = evropa, by.x='name', by.y = 'drzava')
  evropa <- tm_shape(podatki) +
    tm_polygons(c('pricakovana.starost','zdrava.leta'),
                popup.vars = c("Pričakovana starost: " = "pricakovana.starost", "Zdrava leta:" = "zdrava.leta")) +
    tm_facets(sync = TRUE)
    tmap_mode('view')
  return(evropa)
}
map()

#pomožni zemljevid:

odstotek.map <- function(){
  evropa <- World %>% filter (continent == 'Europe')
  starost <- zivljenje1 %>% filter (leto == 2018) %>% dplyr::select('drzava', 'odstotek.zdravih.od.pricakovanih')
  podatki <- merge(y = starost,x = evropa, by.x='name', by.y = 'drzava')
  evropa <- tm_shape(podatki) + tm_polygons('odstotek.zdravih.od.pricakovanih')
  tmap_mode('view')
  return(evropa)
}

odstotek.map()


print("--------------- File plot-trend.r")

library(ggplot2)
library(tidyr)
library(dplyr)
library(rstan)
library(data.table)
library(lubridate)
library(gdata)
library(EnvStats)
library(matrixStats)
library(scales)
library(gridExtra)
library(ggpubr)
library(bayesplot)
library(cowplot)
library(zoo)
library(plotly)

source("utils/geom-stepribbon.r")

#---------------------------------------------------------------------------

make_three_pannel_plot <- function() {
  args <- commandArgs(trailingOnly = TRUE)
  filename2 <- args[1]

  load(paste0("../modelOutput/results/", filename2))
  print(sprintf("loading: %s", paste0("../modelOutput/results/", filename2)))

  codeToName <- unique(data.frame("code" = d$countryterritoryCode, "name" = d$countriesAndTerritories))

  lastObs <- tail(dates[[1]], 1)
  # lastObs <- as.Date("06/01/2020", format="%m/%d/%y")

  cd <- dates[[1]]
  cd <- cd[cd > lastObs]

  ### final Rt via bayesplot
  dimensions <- dim(out$Rt)

  # idx is lastobs
  idx <- dimensions[2] - length(cd)

  # here we calculate avg Rt over the 7 days leading up to the last observation
  date_bin <- ceiling(dimensions[2] / (10 * 7))
  date_break <- paste(as.character(date_bin), "weeks", sep = " ")
  Rt <- out$Rt[, (idx - 6):idx, ]
  Rt <- apply(Rt, c(1, 3), mean)

  # visualize it
  colnames(Rt) <- codeToName$name
  Rt_to_save <- Rt
  if (dim(Rt)[2] > 20){
    Rt_to_save <- Rt[, 1:20]
  }
  g_svg_top20 <- mcmc_intervals(Rt_to_save, prob = .9) +
      ggtitle(sprintf("Average Rt %s to %s", format(lastObs - 6, "%B %d"), format(lastObs, "%B %d")), "with 90% posterior credible intervals") +
      xlab("Rt") + ylab("County") +
      theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust = 0.5)) # center title and subtitle
  ggsave(sprintf("../modelOutput/figures/Rt_Top20.svg"), g_svg_top20, width = 6, height = 4)
  ggsave(sprintf("../modelOutput/figures/Rt_Top20.png"), g_svg_top20, width = 6, height = 4)

  # next
  # 1. Rt pre-lockdown
  # 2. Rt lockdown
  # 3. Rt post-lockdown
  # 4. delta's
  # so that's 5 quantities - 3 intervals, 2 transitions of great importance

  # dev'ing #

  # two transitions
  # lockdownStart <- as.Date("03/21/2020", format="%m/%d/%y")
  # lockdownEnd <- as.Date("05/30/2020", format="%m/%d/%y") # source: https://www.usatoday.com/storytelling/coronavirus-reopening-america-map/

  # datesRef <- dates[[1]]

  # cd <- cd[cd > lastObs]

  # split the dates
  # preLockdownDates <- datesRef[datesRef < lockdownStart]
  # lockdownDates <- datesRef[datesRef >= lockdownStart & datesRef < lockdownEnd]
  # postLockdownDates <- datesRef[datesRef >= lockdownEnd & datesRef <= lastObs]

  # map to indexes
  # idxLockdown <- length(preLockdownDates)
  # idxReopen <- idxLockdown + length(lockdownDates)
  # idxLastObs <- idxReopen + length(postLockdownDates)

  # Rt_PreLockdown <- out$Rt[,1:idxLockdown,]
  # Rt_Lockdown <- out$Rt[,(idxLockdown+1):idxReopen,]
  # Rt_PostLockdown <- out$Rt[,(idxReopen+1):idxLastObs,]

  # certainly, certainly make a function out of this

  # average Rt for each time period
  # Rt_PreLockdown <- apply(Rt_PreLockdown, c(1,3), mean)
  # Rt_Lockdown <- apply(Rt_Lockdown, c(1,3), mean)
  # Rt_PostLockdown <- apply(Rt_PostLockdown, c(1,3), mean)

  # here! visualize it
  # colnames(Rt_PreLockdown) <- codeToName$name
  # colnames(Rt_Lockdown) <- codeToName$name
  # colnames(Rt_PostLockdown) <- codeToName$name

  # Rt_Delta_Lockdown <- Rt_Lockdown - Rt_PreLockdown
  # Rt_Delta_Reopen <- Rt_PostLockdown - Rt_Lockdown

  # move this
  # plot_Rt_by_time_period <- function(Rt, title, path){
  #   g = mcmc_intervals(Rt,prob = .9) +
  #     ggtitle(title, "with 90% posterior credible intervals") +
  #     xlab("Rt") + ylab("County") +
  #     theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust = 0.5)) # center title and subtitle
  #   ggsave(file.path("../modelOutput/figures", path),g,width=6,height=4)
  # }

  # plot_Rt_by_time_period(Rt_PreLockdown, "Average Rt Prior To Lockdown", "Rt_PreLockdown_All.png")
  # plot_Rt_by_time_period(Rt_Lockdown, "Average Rt During Lockdown", "Rt_Lockdown_All.png")
  # plot_Rt_by_time_period(Rt_PostLockdown, "Average Rt After Reopening", "Rt_Reopening_All.png")
  # plot_Rt_by_time_period(Rt_Delta_Lockdown, "Average Change In Rt Following Lockdown", "Rt_Delta_Lockdown_All.png")
  # plot_Rt_by_time_period(Rt_Delta_Reopen, "Average Change In Rt Following Reopening", "Rt_Delta_Reopen_All.png")

  ##### ////////////// #####

  # interventions table
  # NOTE: "covariate" == "intervention";
  # e.g., if there are 3 different interventions in the model, then there are 3 covariates here in the code
  # covariates <- read.csv("../modelInput/ILInterventionsV1.csv", stringsAsFactors = FALSE)
  covariates <- read.csv("../modelInput/USInterventions_Static.csv", stringsAsFactors = FALSE)
  covariates$Country <- sapply(covariates$Country, as.character)
  # covariates$Country <- sub("840", "", covariates$Country) # cutoff US prefix code - note: maybe this should be in the python etl, not here
  # don't need this ^ when using the static file

  ###

  allErr <- list()
  for (i in 1:length(countries)) {
    N <- length(dates[[i]])

    # here! careful - country is an integer right here (is it? double check)
    country <- countries[[i]] # this is the numeric code -> "84017031"
    countryName <- as.character(codeToName$name[codeToName$code == country]) # this is the name -> "Cook"

    predicted_cases <- colMeans(prediction[, 1:N, i])
    predicted_cases_li <- colQuantiles(prediction[, 1:N, i], probs = .025)
    predicted_cases_ui <- colQuantiles(prediction[, 1:N, i], probs = .975)
    predicted_cases_li2 <- colQuantiles(prediction[, 1:N, i], probs = .25)
    predicted_cases_ui2 <- colQuantiles(prediction[, 1:N, i], probs = .75)

    estimated_deaths <- colMeans(estimated.deaths[, 1:N, i])
    estimated_deaths_li <- colQuantiles(estimated.deaths[, 1:N, i], probs = .025)
    estimated_deaths_ui <- colQuantiles(estimated.deaths[, 1:N, i], probs = .975)
    estimated_deaths_li2 <- colQuantiles(estimated.deaths[, 1:N, i], probs = .25)
    estimated_deaths_ui2 <- colQuantiles(estimated.deaths[, 1:N, i], probs = .75)

    rt <- colMeans(out$Rt[, 1:N, i])
    rt_li <- colQuantiles(out$Rt[, 1:N, i], probs = .025)
    rt_ui <- colQuantiles(out$Rt[, 1:N, i], probs = .975)
    rt_li2 <- colQuantiles(out$Rt[, 1:N, i], probs = .25)
    rt_ui2 <- colQuantiles(out$Rt[, 1:N, i], probs = .75)

    # NOTE: `country` is an integer - should be okay here
    covariates_country <- covariates[which(covariates$Country == country), 3:ncol(covariates), drop = FALSE]

    covariates_country_long <- gather(covariates_country[], key = "key", value = "value")
    covariates_country_long$x <- rep(NULL, length(covariates_country_long$key))
    un_dates <- unique(covariates_country_long$value)

    for (k in 1:length(un_dates)) {
      idxs <- which(covariates_country_long$value == un_dates[k])
      max_val <- round(max(rt_ui)) + 0.3
      for (j in idxs) {
        covariates_country_long$x[j] <- max_val
        max_val <- max_val - 0.3
      }
    }

    covariates_country_long$value <- as_date(covariates_country_long$value)
    covariates_country_long$country <- rep(country, length(covariates_country_long$value))

    data_country <- data.frame(
      "time" = as_date(as.character(dates[[i]])),
      "country" = rep(country, length(dates[[i]])),
      "reported_cases" = reported_cases[[i]],
      "reported_cases_c" = cumsum(reported_cases[[i]]),
      "predicted_cases_c" = cumsum(predicted_cases),
      "predicted_min_c" = cumsum(predicted_cases_li),
      "predicted_max_c" = cumsum(predicted_cases_ui),
      "predicted_cases" = predicted_cases,
      "predicted_min" = predicted_cases_li,
      "predicted_max" = predicted_cases_ui,
      "predicted_min2" = predicted_cases_li2,
      "predicted_max2" = predicted_cases_ui2,
      "deaths" = deaths_by_country[[i]],
      "deaths_c" = cumsum(deaths_by_country[[i]]),
      "estimated_deaths_c" = cumsum(estimated_deaths),
      "death_min_c" = cumsum(estimated_deaths_li),
      "death_max_c" = cumsum(estimated_deaths_ui),
      "estimated_deaths" = estimated_deaths,
      "death_min" = estimated_deaths_li,
      "death_max" = estimated_deaths_ui,
      "death_min2" = estimated_deaths_li2,
      "death_max2" = estimated_deaths_ui2,
      "rt" = rt,
      "rt_min" = rt_li,
      "rt_max" = rt_ui,
      "rt_min2" = rt_li2,
      "rt_max2" = rt_ui2
    )

    county_deaths_and_est <- make_plots(
      data_country = data_country,
      covariates_country_long = covariates_country_long,
      filename2 = filename2,
      country = countryName,
      code = country,
      date_break = date_break
    )

    # allErr[[i]] <- county_deaths_and_est
  }

  #### all estimated deaths curves one plot ####

  # minDate <- min(sapply(allErr, function(x) min(x$time)))

  # allEst <- lapply(allErr, function(x) x[x$time <= lastObs,])
  # allEst <- lapply(allEst, function(x) subset(x, select=-c(deaths)))

  # pad_est <- function(x) {
  #   if (min(x$time) == minDate){return(x)}
  #   df <- data.frame(
  #     time = seq(as.Date(minDate), as.Date(min(x$time)-1), by="days"),
  #     est = rep(0, min(x$time) - minDate),
  #     countyName = rep(x$countyName[1], min(x$time) - minDate)
  #   )
  #   return(rbind(df,x))
  # }
  # allEst <- lapply(allEst, pad_est)

  # rough - add county name as ID
  # pEst <- ggplot(bind_rows(allEst), aes(x=time, y=est, colour=countyName)) + geom_line()
  # save_plot(filename = "../modelOutput/figures/allEstimates.png", pEst)

  #### error analysis ####
  # cutoff <- max(sapply(allErr, function(x) min(x$time)))
  # allErr <- sapply(allErr, function(x) x[x$time >= cutoff & x$time <= lastObs,])

  # err_df <- data.frame(time=allErr[,1]$time)

  # err_df$deaths <- 0
  # err_df$est <- 0
  # for (i in 1:dim(allErr)[2]){
  #   err_df$deaths <- err_df$deaths + allErr[,i]$deaths
  #   err_df$est <- err_df$est + allErr[,i]$est
  # }

  ### scaled error daily
  # error_plot(
  #   df = err_df,
  #   title = "All County Daily Deaths",
  #   path = "../modelOutput/figures/%sse_daily_all.png"
  # )

  ### scaled error weekly
  # weekly_error_plot(
  #   df = err_df,
  #   title = "All County Weekly Deaths",
  #   path = "../modelOutput/figures/%sse_weekly_all.png"
  # )
}

weekly_error_plot <- function(df, title, path) {
  weeklyDeaths <- unname(tapply(df$deaths, (seq_along(df$deaths) - 1) %/% 7, sum))
  weeklyEst <- unname(tapply(df$est, (seq_along(df$est) - 1) %/% 7, sum))
  weeklyDates <- as.Date(unname(tapply(df$time, (seq_along(df$time) - 1) %/% 7, min)))

  w <- data.frame(time = weeklyDates, deaths = weeklyDeaths, est = weeklyEst)

  error_plot(
    df = w,
    title = title,
    path = path
  )
}

error_plot <- function(df, title, path) {
  df$err_raw <- df$est - df$deaths
  avg_naive <- mean(abs(diff(df$deaths)))
  df$err_scaled <- df$err_raw / avg_naive
  df$err_abs_scaled <- abs(df$err_scaled)

  abs_and_signed_error(
    df = df,
    title = title,
    path = path
  )
}

abs_and_signed_error <- function(df, title, path) {
  gg_error(
    df = df,
    target = "err_scaled",
    title = sprintf("%s Scaled Error", title),
    path = sprintf(path, "")
  )

  gg_error(
    df = df,
    target = "err_abs_scaled",
    title = sprintf("%s Absolute Scaled Error", title),
    path = sprintf(path, "a")
  )
}

gg_error <- function(df, target, title, path) {
  p <- ggplot(df) +
    ggtitle(title) +
    geom_bar(
      data = df, aes(x = time, y = !!sym(target)),
      fill = "coral4", stat = "identity", alpha = 0.5
    ) +
    xlab("Time") +
    ylab("Error") +
    labs(subtitle = sprintf("avg_err: %f", mean(df[[target]]))) +
    scale_x_date(date_breaks = "weeks", labels = date_format("%e %b")) +
    theme_pubr() +
    theme(
      axis.text.x = element_text(angle = 45, hjust = 1),
      plot.title = element_text(hjust = 0.5),
      legend.position = "None"
    ) +
    guides(fill = guide_legend(ncol = 1))

  save_plot(filename = path, p)
}

#---------------------------------------------------------------------------

# todo: break down into 3 fn's - modular, man, modular

make_plots <- function(data_country, covariates_country_long,
                       filename2, country, code, date_break) {
  countyDir <- file.path("../modelOutput/figures", code)
  dir.create(countyDir, showWarnings = FALSE)

  #### scaled error plot daily counts
  # deaths_err <- data.frame(time=data_country$time, deaths=data_country$deaths, est=data_country$estimated_deaths, deaths_c=data_country$deaths_c)

  # index = which(d1$cases>0)[1]
  # index <- which(deaths_err$deaths_c>10)[1]
  # deaths_err <- deaths_err[index:nrow(deaths_err),]

  # MASE : https://en.wikipedia.org/wiki/Mean_absolute_scaled_error
  # https://robjhyndman.com/papers/foresight.pdf
  # file:///Users/mattgarvin/Downloads/A-note-on-the-MASE-Revision-for-IJF.pdf

  # error_plot(
  #   df = deaths_err,
  #   title = paste0(country, " County Daily Deaths"),
  #   path = file.path(countyDir, "%sse_daily.png")
  # )

  # weekly_error_plot(
  #   df = deaths_err,
  #   title = paste0(country, " County Weekly Deaths"),
  #   path = file.path(countyDir, "%sse_weekly.png")
  # )

  ## p1

  data_cases_95 <- data.frame(
    data_country$time, data_country$predicted_min,
    data_country$predicted_max
  )
  names(data_cases_95) <- c("time", "cases_min", "cases_max")
  data_cases_95$key <- rep("nintyfive", length(data_cases_95$time))
  data_cases_50 <- data.frame(
    data_country$time, data_country$predicted_min2,
    data_country$predicted_max2
  )
  names(data_cases_50) <- c("time", "cases_min", "cases_max")
  data_cases_50$key <- rep("fifty", length(data_cases_50$time))
  data_cases <- rbind(data_cases_95, data_cases_50)
  levels(data_cases$key) <- c("ninetyfive", "fifty")

  p1 <- ggplot(data_country) +
    ggtitle(paste0(country, " County Daily Cases")) +
    geom_bar(
      data = data_country, aes(x = time, y = reported_cases),
      fill = "coral4", stat = "identity", alpha = 0.5
    ) +
    geom_ribbon(
      data = data_cases,
      aes(x = time, ymin = cases_min, ymax = cases_max, fill = key)
    ) +
    xlab("Time") +
    ylab("Cases") +
    scale_x_date(date_breaks = date_break, labels = date_format("%e %b")) +
    scale_fill_manual(
      name = "", labels = c("50%", "95%"),
      values = c(
        alpha("deepskyblue4", 0.55),
        alpha("deepskyblue4", 0.45)
      )
    ) +
    theme_pubr() +
    theme(
      axis.text.x = element_text(angle = 45, hjust = 1),
      plot.title = element_text(hjust = 0.5),
      legend.position = "None"
    ) +
    guides(fill = guide_legend(ncol = 1))

  save_plot(filename = file.path(countyDir, "cases.svg"), p1)
  save_plot(filename = file.path(countyDir, "cases.png"), p1)

  ### p2

  data_deaths_95 <- data.frame(
    data_country$time, data_country$death_min,
    data_country$death_max
  )
  names(data_deaths_95) <- c("time", "death_min", "death_max")
  data_deaths_95$key <- rep("nintyfive", length(data_deaths_95$time))
  data_deaths_50 <- data.frame(
    data_country$time, data_country$death_min2,
    data_country$death_max2
  )
  names(data_deaths_50) <- c("time", "death_min", "death_max")
  data_deaths_50$key <- rep("fifty", length(data_deaths_50$time))
  data_deaths <- rbind(data_deaths_95, data_deaths_50)
  levels(data_deaths$key) <- c("ninetyfive", "fifty")

  p2 <- ggplot(data_country, aes(x = time)) +
    ggtitle(paste0(country, " County Daily Deaths")) +
    geom_bar(
      data = data_country, aes(y = deaths, fill = "reported"),
      fill = "coral4", stat = "identity", alpha = 0.5
    ) +
    geom_ribbon(
      data = data_deaths,
      aes(ymin = death_min, ymax = death_max, fill = key)
    ) +
    xlab("Time") +
    ylab("Deaths") +
    scale_x_date(date_breaks = date_break, labels = date_format("%e %b")) +
    scale_fill_manual(
      name = "", labels = c("50%", "95%"),
      values = c(
        alpha("deepskyblue4", 0.55),
        alpha("deepskyblue4", 0.45)
      )
    ) +
    theme_pubr() +
    theme(
      axis.text.x = element_text(angle = 45, hjust = 1),
      plot.title = element_text(hjust = 0.5),
      legend.position = "None"
    ) +
    guides(fill = guide_legend(ncol = 1))

  save_plot(filename = file.path(countyDir, "deaths.svg"), p2)
  save_plot(filename = file.path(countyDir, "deaths.png"), p2)

  ### p3

  plot_labels <- c("lockdown")

  # Plotting interventions
  data_rt_95 <- data.frame(
    data_country$time,
    data_country$rt_min, data_country$rt_max
  )
  names(data_rt_95) <- c("time", "rt_min", "rt_max")
  data_rt_95$key <- rep("nintyfive", length(data_rt_95$time))
  data_rt_50 <- data.frame(
    data_country$time, data_country$rt_min2,
    data_country$rt_max2
  )
  names(data_rt_50) <- c("time", "rt_min", "rt_max")
  data_rt_50$key <- rep("fifty", length(data_rt_50$time))
  data_rt <- rbind(data_rt_95, data_rt_50)
  levels(data_rt$key) <- c("ninetyfive", "fifth")

  p3 <- ggplot(data_country) +
    ggtitle(paste0(country, " County Estimated Rt")) +
    geom_stepribbon(data = data_rt, aes(
      x = time,
      ymin = rt_min, ymax = rt_max,
      group = key,
      fill = key
    )) +
    geom_hline(yintercept = 1, color = "black", size = 0.1) +
    # missing values in one row -> warning -> td: double check this
    geom_segment(
      data = covariates_country_long,
      aes(x = value, y = 0, xend = value, yend = max(x)),
      linetype = "dashed", colour = "grey", alpha = 0.75
    ) +
    # missing values in one row -> warning
    geom_point(data = covariates_country_long, aes(
      x = value,
      y = x,
      group = key,
      shape = key,
      col = key
    ), size = 2) +
    xlab("Time") +
    ylab(expression(R[t])) +
    scale_fill_manual(
      name = "", labels = c("50%", "95%"),
      values = c(alpha("seagreen", 0.75), alpha("seagreen", 0.5))
    ) +
    scale_shape_manual(
      name = "Interventions", labels = plot_labels,
      values = c(21, 22, 23, 24, 25, 12)
    ) +
    scale_colour_discrete(name = "Interventions", labels = plot_labels) +
    scale_x_date(date_breaks = date_break, labels = date_format("%e %b")) +
    theme_pubr() +
    theme(
      axis.text.x = element_text(angle = 45, hjust = 1),
      plot.title = element_text(hjust = 0.5),
      legend.position = "right"
    )

  save_plot(filename = file.path(countyDir, "Rt.svg"), p3)
  save_plot(filename = file.path(countyDir, "Rt.png"), p3)

  # df_err <- data.frame(time=deaths_err$time, deaths=deaths_err$deaths, est=deaths_err$est, countyName=country)
  # return(df_err)
  return()
}

make_three_pannel_plot()


library(tidyverse)
library(data.table)
library(ggplot2)
library(ggthemes)
library(grid)

res <- list()
for(i in 1:1200){
    ss <- try(load(paste0('output/out', i, '.rda')))
    if(inherits(ss, 'try-error')) {
        ## cat('error ', i)
    } else {
        rtemp <- get(paste0('r', i))
        if(any(sapply(rtemp, length) == 1)) print(i)
        res <- c(res, rtemp)
    }
}

out <- rbindlist(res[sapply(res, length) > 1])

## out %>% filter(estimator == 'TMLE', n == 16200, parameter == 'DE', type == 1) %>%
##     pull(estimate) %>% hist()

## out %>% filter(estimator == 'TMLE', n == 16200, parameter == 'DE', type == 4) %>%
##     pull(estimate) %>% mean()

load('true.rda')
## source('utils.r')
## true <- truth(1e7)
## save(true, file = 'true.rda')
alpha <- 0.05
dplot <- out %>% left_join(true, by = 'parameter') %>%
    group_by(type, parameter, estimator, n) %>%
    summarise(## m = n(),
        rbias = abs(mean(estimate - truth)),
        rnbias = abs(mean(sqrt(n) * (estimate - truth))),
        relse = mean(ses) / sd(estimate),
        relsd = sd(sqrt(n) * estimate / sqrt(eff_bound)),
        relrmse = sqrt(mean(n * (estimate - truth)^2  / eff_bound)),
        coverage = mean(qnorm(alpha / 2) < (estimate - truth) / ses &
                        (estimate - truth) / ses < qnorm(1 - alpha / 2))) %>%
    ## filter(type ==  0, estimator == 'os') %>%
    gather(statistic, value, rbias, rnbias, relse, relsd, relrmse, coverage) %>%
    ungroup() %>%
    mutate(parameter = factor(parameter),
           type = factor(type),
           estimator = factor(estimator),
           statistic = factor(statistic,
                              levels = c('rbias', 'rnbias',
                                         'relsd', 'relrmse',
                                         'coverage', 'relse'),
                              labels = c("group('|',Bias,'|')",
                                         "n^{1/2}~group('|',Bias,'|')",
                                         'rel~sd(hat(theta))',
                                         '(n%*%rel~MSE)^{1/2}',
                                         'Cov(0.95)',
                                         'hat(sd)(hat(theta))/sd(hat(theta))')),
           type = factor(type,
                         levels = 0:5,
                         labels = c('none', 'g', 'e', 'm', 'b', 'd')))

dummy <- data.frame(statistic = c("n^{1/2}~group('|',Bias,'|')",
                                  "group('|',Bias,'|')",
                                  'hat(sd)(hat(theta))/sd(hat(theta))',
                                  'rel~sd(hat(theta))',
                                  '(n%*%rel~MSE)^{1/2}',
                                  'Cov(0.95)'),
                    lim = c(0, 0, 1, 1, 1, 1 - alpha))

ns <- cumsum(rep(sqrt(200), 9))^2
split1 <- c('none')
split2 <- c('g','b')
split3 <- c('m','e','d')

plot1 <- dplot %>% rename(Parameter = parameter, Estimator = estimator) %>%
    filter(type %in% split1) %>%
    ggplot(aes(n, value, colour = Estimator, shape = Parameter)) +
    ylab('') +
    geom_hline(data = dummy, aes(yintercept = lim), colour = 'darkgray', size = 1.5) +
    geom_point(size = 2) +
    geom_line(linetype = "dotted", size = 0.5) +
    theme_igray() +
    scale_x_continuous(breaks = ns, trans = 'sqrt') +
    theme(legend.position = 'none', axis.text.x = element_text(angle = 50, hjust = 1),
          text = element_text(size = 18), panel.spacing = unit(1, "lines"),
          strip.text.y = element_blank()) +
    ## scale_shape_manual(name = 'Estimator:',
    ##                    values = c(3, 4, 1, 2)) +
    facet_grid(statistic ~ type, scales = 'free_y', labeller = label_parsed)
plot2 <- dplot %>% rename(Parameter = parameter, Estimator = estimator) %>%
    filter(type %in% split3) %>%
    ggplot(aes(n, value, colour = Estimator, shape = Parameter)) +
    ylab('') +
    geom_hline(data = dummy, aes(yintercept = lim), colour = 'darkgray', size = 1.5) +
    geom_point(size = 2) +
    geom_line(linetype = "dotted", size = 0.5) +
    theme_igray() +
    scale_x_continuous(breaks = ns, trans = 'sqrt') +
    theme(legend.position = 'none', axis.text.x = element_text(angle = 50, hjust = 1),
          text = element_text(size = 18), panel.spacing = unit(1, "lines"),
          strip.text.y = element_blank()) +
    ## scale_shape_manual(name = 'Estimator:',
    ##                    values = c(3, 4, 1, 2)) +
    facet_grid(statistic ~ type, scales = 'free_y', labeller = label_parsed)
plot3 <- dplot %>% rename(Parameter = parameter, Estimator = estimator) %>%
    filter(type %in% split2) %>%
    ggplot(aes(n, value, colour = Estimator, shape = Parameter)) +
    ylab('') +
    geom_hline(data = dummy, aes(yintercept = lim), colour = 'darkgray', size = 1.5) +
    geom_point(size = 2) +
    geom_line(linetype = "dotted", size = 0.5) +
    theme_igray() +
    scale_x_continuous(breaks = ns, trans = 'sqrt') +
    theme(legend.position = 'right', axis.text.x = element_text(angle = 50, hjust = 1),
          text = element_text(size = 18), panel.spacing = unit(1, "lines")) +
    ## scale_shape_manual(name = 'Estimator:',
    ##                    values = c(3, 4, 1, 2)) +
    facet_grid(statistic ~ type, scales = 'free_y', labeller = label_parsed)

pdf('plot.pdf', width = 13, height = 11)
grid.newpage()
grid.draw(cbind(ggplotGrob(plot1), ggplotGrob(plot2), ggplotGrob(plot3), size = 'last'))
dev.off()

dplot %>%
    filter(type == 'All-consistent', parameter == 'indirect', n == 9800,
           statistic == 'hat(sd)(hat(theta))/sd(hat(theta))')


#' Predictor layers
#'
#' Raster brick of environmental predictors
#'
#' @format A RasterBrick
#' \describe{
#'   \item{Annual Mean Radiation}{}
#'   \item{Annual Mean Temperature}{}
#'   \item{Annual Precipitation}{}
#'   \item{Precipitation Seasonality}{}
#'   \item{Soil Fertility}{}
#'   \item{Topographic Wetness}{}
#' }
#'
"predictors"


#!/usr/bin/Rscript
# Command line arguments for R are not fun... so to make this easy create the args
# by prepending them to this script directly before the R call:
# [bash]$ echo 'arg1 = "value";arg2="someValue"' |cat - script.r | R --no-save
# Variables dataFrame, inputDir, outputDir,  are required
args <- commandArgs(TRUE)

if (length(args) != 2) {
    print("Usage: GoSumWordCloud.r <data> <outputFile>")
}

data <- args[1]
#inputDir <- args[2]
#outputDir <-args[3]
outputFile <-args[2]

library(GOsummaries);
up <-read.table(data, header =TRUE, sep ="\t", quote="");
wcd1 = data.frame(Term = up$Name, Score = up$Pvalue);
gs = gosummaries(wc_data = list(wcd1));
#DO I NEED TO GIVE IT AN OUTPUT DIR?
#fullOutFile = paste(outputDir, outputFile, sep="/");
#plot(gs, filename ="fullOutFile");

#IF NOT THEN:

plot(gs, filename =outputFile);

#library(ggplot2);
#up <-read.table(data, header =TRUE, sep ="\t");
#png(outputFile);
#hist(up$Result.count);
dev.off();


# 4. faza: Analiza podatkov

# priprava tabel

priprava.podatkov <- function(tabela, stolpec) {
  tabela %>%
    filter(
      drzava !="EU28",
      spol == "skupaj",
      `starostna skupina` == "skupaj",
      leto == 2019
    ) %>%
    select(-`starostna skupina`, -spol, -leto) %>%
    pivot_wider(names_from = stolpec, values_from = odstotek)
}

pogostost.razvrscanje <- priprava.podatkov(pogostost, "pogostost")

vrednosti.razvrscanje <- priprava.podatkov(vrednosti, "vrednost")

izvor.razvrscanje <- priprava.podatkov(izvor, "prodajalec")

podatki.razvrscanje <- pogostost.razvrscanje %>%
  inner_join(vrednosti.razvrscanje) %>%
  inner_join(izvor.razvrscanje) %>%
  select(-drzava) %>%
  scale()

fviz_nbclust(podatki.razvrscanje, FUN = hcut, method = "wss")
fviz_nbclust(podatki.razvrscanje, FUN = hcut, method = "silhouette")
fviz_nbclust(podatki.razvrscanje, FUN = hcut, method = "gap_stat", nstart=25, nboot=300)

D <- dist(podatki.razvrscanje)
model <- hclust(D)

dnd <- as.dendrogram(model) %>%
  set("labels",pogostost.razvrscanje$drzava[model$order]) %>%
  set("leaves_pch", 19) %>%
  set("leaves_cex", 2) %>%
  set("leaves_col", "black") %>%
  set("branches_k_color",
      value = c("red", "blue"), k = 2) %>%
  as.ggdend()

dnd$labels$label <- paste(pogostost.razvrscanje$drzava[model$order])
dnd$labels$drzava <- pogostost.razvrscanje$drzava[model$order]


#SV Scarpino
#July 2020
#CA COVID county-level Hospitalizations

###########
#libraries#
###########
library(zoo)

#########
#Globals#
#########
roll_mean_days <- 7
time_stamp <- format(Sys.time(), format = "%d_%m_%Y")
save_new <- FALSE

######
#Data#
######
dat_ca <- read.csv("https://data.ca.gov/dataset/529ac907-6ba1-4cb7-9aae-8966fc96aeef/resource/42d33765-20fd-44b8-a978-b083b7542225/download/hospitals_by_county.csv")
dat_ca$date <- as.POSIXct(strptime(dat_ca$todays_date, format = "%Y-%m-%d"))

#########
#Process#
#########
by_day_ca_county <- by(data = dat_ca$hospitalized_covid_confirmed_patients, INDICES = dat_ca[,c("todays_date", "county")], FUN = sum, na.rm = TRUE)

mat_by_day_ca_county <- matrix(by_day_ca_county, nrow = nrow(by_day_ca_county), ncol = ncol(by_day_ca_county))
colnames(mat_by_day_ca_county) <- colnames(by_day_ca_county)
rownames(mat_by_day_ca_county) <- rownames(by_day_ca_county)

######
#Save#
######
if(save_new == TRUE){
  write.csv(mat_by_day_ca_county, file = paste0("../Data/CA_county_hosp_COVID_", time_stamp, ".csv"), quote = FALSE)
}


# takes g_inputdir,g_filetable and g_outputdir
##and g_duration_slider, g_bin_size
# return activity plots

message("starting activity.r")
### compute the activities

act_table = data.frame()

#compute activities for each individum
for (i in c(1:nrow(id_table))) {
	act = c.activity_speed(traj[id(traj)==id_table$id[i]],g_duration_slider/10)
	act_id = rep(id_table$id[i],nrow(act))
	act_group = rep(id_table$group[i],nrow(act))
	act_table = rbind(act_table,data.frame(act,id=act_id,group=act_group))

}

# filter activities which are smaller than the act slider
act_table_ori = act_table
pause_table = act_table[act_table$act<0,]
pause_table$pause = - pause_table$act
#act_table = act_table[act_table$act>g_duration_slider/10*4,]
act_table = act_table[act_table$act>0,]

print(head(act_table_ori))

#calculation of linearity of curve for each bout
#########################
act_table$lin = sqrt( (act_table$Xe-act_table$Xs)^2+(act_table$Ye-act_table$Ys)^2)/act_table$dist_traveled

print(head(act_table))

### get rid of act of lenght 1
#act_table = act_table[act_table$lin<1,]
print(head(act_table))

#calculate total activity time for each individual
sum_act = c()
median_act = c()
median_pause = c()
number_pause = c()
median_lin = c()
mean_lin = c()
for (i in c(1:nrow(id_table))) {
	act = act_table[act_table$id==id_table$id[i],]$act
	pause = pause_table[act_table$id==id_table$id[i],]$act
	lin = act_table[act_table$id==id_table$id[i],]$lin
	sum_act = c(sum_act,sum(act))
	median_act = c(median_act,median(act))
	median_pause = c(median_pause, median(abs(pause)))
	number_pause = c(number_pause,length(pause))
	median_lin = c(median_lin, quantile(lin, probs =0.5))

}
act_table_2_2 = data.frame(sumact2=sum_act,median_act2=median_act,median_pause2=median_pause,number_pause2=number_pause,median_lin2= median_lin,id=id_table$id,group=id_table$group)

act_table_2 = data.frame(sum_act,median_act,median_pause,number_pause,median_lin,id=id_table$id,group=id_table$group)

f_table=data.frame(f_table,act_table_2_2 [,1:5])

message("starting writing activities log.txt")

setwd(rgghome)

if (g_bin_size==0)
	{g_bin_size = 0.5}

v = act_table$act
bins = seq(min(v[!is.na(v)])-g_bin_size,max(v[!is.na(v)])+g_bin_size,g_bin_size)

#create mean and sd table
mean_table = create.mean.table(act_table_2,group_ids,data_cols=1:5)

message("starting plots activity")
### create plots
mybarplot(mean_table$means$sum_act,mean_table$ses$sum_act,rownames(mean_table$means),
	main="Total activity time threshold",ylab="Total activity time [s]", ylim= c(0,ylim_acttime))
mybarplot(mean_table$means$median_act,mean_table$ses$median_act,rownames(mean_table$means),
	main="Mean of medians of bouts length threshold",ylab="median of bouts length [s]",ylim = c(0,20))

mybarplot(mean_table$means$number_pause,mean_table$ses$number_pause,rownames(mean_table$means),
	main="Number of pauses threshold",ylab="Number of pauses", ylim = c(0,ylim_pauses))

#mybarplot(mean_table$means$median_pause,mean_table$ses$median_pause,rownames(mean_table$means),
#	main="Mean of medians of pause time",ylab="Median pause time [s]", ylim =c(0, ylim_pausetime))

mybarplot(mean_table$means$median_lin,mean_table$ses$median_lin,rownames(mean_table$means),
	main="Mean of medians of linearity score threshold",ylab="Lin score [0 to 1]", ylim =c(0, 1))

#
#bins = 0.05
#hplot1 = hist(act_table$lin,breaks= c(seq(0,1, bins)), plot=FALSE)
#
#print(plot(hplot1, xlim=c(0,1),freq = FALSE))
#
#bins = 0.11
#
#hplot4 = hist(act_table$act,breaks= c(seq(0,max(act_table$act)+bins*5, bins*5)), plot=FALSE)
#print(plot(hplot4, freq = FALSE, xlim=c(0,100)))
#
#
#
#plot (act_table$lin, act_table$dist_traveled, ylim =c(0,1000))
#
#plot (act_table$lin, act_table$dist_traveled, ylim =c(0,35))
#
#plot (act_table_ori$speedmax_inbout, act_table_ori$dist_traveled)
#hist(act_table_ori$speedmax_inbout)


\name{fastplm}
\alias{fastplm}
\title{Solve Fixed Effect Model}

\description{\code{fastplm} solves a fixed effects model.}

\usage{fastplm(formula = NULL, data = NULL, index = NULL,
               y = NULL, x = NULL, ind = NULL,
               sfe = NULL, cfe = NULL,
               PCA = TRUE, sp = NULL, knots = NULL,
               degree = 3, se = 1, vce = "robust",
               cluster = NULL, wild = FALSE,
               refinement = FALSE, test_x = NULL, parallel = FALSE,
               nboots = 200, seed = NULL, core.num = 1)}

\arguments{

  \item{formula}{An object of class "formula": a symbolic description of
   the model to be fitted.}

  \item{data}{An object of class "dataframe" or "matrix". If both \code{formula}
   and \code{y} are omitted, the first column of \code{data} will be regarded
   as the vector of outcome variable. If both \code{data} and \code{y} present,
   \code{data} is used.}

  \item{index}{A string vector specifying the indicators. Omissible if
   \code{formula} is omitted.}

  \item{y}{The Y vector. Omissible if \code{data} is provided.}

  \item{x}{The X matrix. Omissible if \code{data} is provided.
   If both \code{data} and \code{X} are not provided, the model is still valid. In
   such case, the function merely estimates fixed effects. }

  \item{ind}{A matrix where each row corresponds to the row (observation) in the
    X-Y dataset and each column represents an effect. The entry of row X of effect
    Y represents the group in Y that X belongs to.

    Groups can be specified by either numbers or strings, i.e. the input matrix can
    be of mode \code{numeric} or \code{character}. }

  \item{sfe}{A vector index of simple (i.e. non-complex) fixed effects.
    Each can be specified either by effect name or position as in \code{index} or
    by the position in the indicator matrix \code{ind}.

    If omitted, \code{sfe} will be the collection of all effects in
    \code{index} or \code{inds}. }

  \item{cfe}{A list index of complex fixed effects.

    Specifically, an complex fixed effect is a generalized fixed effect. It consists a
    pair of two effects, (I, E), interacting with each other. "I" stands for influence,
    whose level has an observed vector \code{weight}. "E" stands for effect, whose
    level has an unobserved vector \code{coefficient} to estimate. For each
    observation, the effect of I, E) is the dot product of the weight of the row's
    level for "I" and the coefficient of the row's level for "E".

    Each element is a vector whose length is 2. The 1st item of each element is the
    index of effect and the 2nd item is the index of influence. For index, see
    \code{sfe}.

    If omitted, complex fixed effects will not be estimated.

  }

  \item{PCA}{A logical flag indicating whether to perform principal components analysis
    for influence in complex fixed effects (see \code{cfe}).}

  \item{sp}{A character value or a numeric vector specifying the variable for
    fitting a b-spline curve.}

  \item{knots}{A numeirc value specifying the knots point for \code{sp}. If
    left blank, a polynomial curve will be fitted.}

  \item{degree}{A positive integer speficying the order of the spline curve.
    Default value is \code{degree = 3} for a cubic curve.}

  \item{se}{A logical flag indicating whether uncertainty estimates of
    covariates will be produced.}

  \item{vce}{A character value indicating type for variance estimator.
    Choose from: "standard" for standard ols standard errors, "robust" for
    the Huber White robust standard errors (default value), "clustered" (or "cl")
    for clustered standard errors, "jackknife" for jackknife standard errors,
    and "bootstrap" (or "boot") for bootstrapped standard errors.}

  \item{cluster}{A character value of the clustered variable(s) in the data frame if
    \code{formula} is provided or a matrix object of the clustered variable(s) for
    robust standard error. Two-way clustering is also supported. }

  \item{wild}{A logical flag specifies if wild bootstrap will be performed to obtain
    uncertainty estimates. Omissible if \code{se = FALSE}.}

  \item{refinement}{A logical flag specifies if clutser bootstrap refinement will be
    performed to obtain uncertainty estimates. Omissible if \code{se = FALSE}.}

  \item{test_x}{A character specifies the variable of interest for wild cluster
    bootstrap refinement. Omissible if \code{refinement = FALSE} or
    \code{wild = FALSE}.}

  \item{parallel}{A logical flag indicating whether to perform parallel computing for
    the bootstrap procedure.}

  \item{nboots}{An integer specifying the number of bootstrap
    runs. Omissible if \code{se = FALSE}.}

  \item{seed}{An integer that sets the seed in random number generation.
    Omissible if \code{se = FALSE}.}

  \item{core.num}{The number of cores that will be used for computation. Default is one.
    Do not use more than the number of your physical cores.}
}

\value{An object of class \code{fastplm} with at least the following properties:

  \item{demeaned}{A list represents the demeaned linear model. It has, among other
    properties, \code{x} and \code{y}, which are the demean result of the input
    \code{x} and \code{y}.}

  \item{coefficients}{The coefficients for the demeaned linear model.}

  \item{sfe.coefs}{A list of estimated simple fixed effects. Each is a column
    vector, in which row names correspond to names of levels in \code{inds}. Each, as
    a list item, has the same name as its effect name in \code{inds}. Each vector is
    centered, i.e. set to have zero mean.}

  \item{cfe.coefs}{A list of estimated complex fixed effects. Each is a matrix in
    which each row represents a level. The naming convention is the same as in
    \code{sfe.coefs}. There is no centering. Expect an arbitrary intercept.}

  \item{fitted.values}{The fitted values of the fixed effect model.}

  \item{residuals}{The residuals of the fixed effect model, which is numerically the
    same as the residual of the demeaned linear model.}

  \item{intercept}{The intercept of the fixed effect model. Arbitrary if complex fixed
    effects are present.}

  \item{inds}{As in the input.}

  \item{fe}{An object of "fixed.effects" created for intermediate computing.}

  \item{refinement}{A list that restores results from cluster bootsrap refinement.}

}

\examples{
SEED  <- 19260817
N     <- 2000
LEVEL <- 50

set.seed(SEED)

x <- matrix(rnorm(N * 5, 3), N, 5)
e <- matrix(rnorm(N, 1), N, 1)

raw.inds <- matrix(sample(LEVEL, N * 3, replace = TRUE), N, 3)
sfe.coefs <- matrix(runif(LEVEL * 3), LEVEL, 3)

with.effects <- function(j) sapply(1 : N,
  function(i) sfe.coefs[raw.inds[i, j], j])

beta <- c(7, 3, 2, 5, 8)
effs <- rowSums(sapply(1 : 3, with.effects))

y <- x %*% beta + 5 + e + effs

###########################################
model <- fastplm(y = y, x = x, ind = raw.inds, se = 0)
}

%\author{}


#' ---
#' title: "Prior probabilities in the interpretation of 'some': analysis of model predictions and empirical data"
#' author: "Judith Degen"
#' date: "November 28, 2014"
#' ---

library(ggplot2)
theme_set(theme_bw(18))
#setwd("~/Dropbox/sinking_marbles/sinking-marbles/models/complex_prior/results/")
setwd("/Users/titlis/cogsci/projects/stanford/projects/sinking_marbles/sinking-marbles/models/complex_prior/smoothed_unbinned15/results/")
source("rscripts/helpers.r")

#' get model predictions
load("data/mp.RData")
mp = read.table("data/parsed_results.tsv", quote="", sep="\t", header=T)
nrow(mp)
head(mp)
summary(mp)

# get prior expectations
priorexpectations = read.table(file="~/cogsci/projects/stanford/projects/sinking_marbles/sinking-marbles/experiments/12_sinking-marbles-prior15/results/data/expectations.txt",sep="\t", header=T, quote="")
row.names(priorexpectations) = paste(priorexpectations$effect,priorexpectations$object)
head(priorexpectations)
mp$PriorExpectation = priorexpectations[as.character(mp$Item),]$expectation

priorprobs = read.table(file="~/cogsci/projects/stanford/projects/sinking_marbles/sinking-marbles/experiments/12_sinking-marbles-prior15/results/data/smoothed_15marbles_priors_withnames.txt",sep="\t", header=T, quote="")
head(priorprobs)
row.names(priorprobs) = paste(priorprobs$effect,priorprobs$object)
mpriorprobs = melt(priorprobs, id.vars=c("effect", "object"))
head(mpriorprobs)
row.names(mpriorprobs) = paste(mpriorprobs$effect,mpriorprobs$object,mpriorprobs$variable)
mp$PriorProbability = mpriorprobs[paste(as.character(mp$Item)," X",mp$State,sep=""),]$value
mp$AllPriorProbability = priorprobs[paste(as.character(mp$Item)),]$X15
head(mp)

# get empirical state posteriors:
load("/Users/titlis/cogsci/projects/stanford/projects/sinking_marbles/sinking-marbles/experiments/3_sinking-marbles-nullutterance/results/data/r.RData")
head(r)
r$Item = as.factor(paste(r$effect,r$object))
# because posteriors come in 4 bins, make Bin variable for model prediction dataset:
mp$Proportion = as.factor(ifelse(mp$State == 0, "0", ifelse(mp$State == 15, "100", ifelse(mp$State < 8, "1-50", "51-99"))))

agr = aggregate(normresponse ~ Item + quantifier + Proportion,data=r,FUN=mean)
#agr$CILow = aggregate(normresponse ~ Item + quantifier + Proportion,data=r, FUN=ci.low)$normresponse
#agr$CIHigh = aggregate(normresponse ~ Item + quantifier + Proportion,data=r,FUN=ci.high)$normresponse
#agr$YMin = agr$normresponse - agr$CILow
#agr$YMax = agr$normresponse + agr$CIHigh
agr$Quantifier = as.factor(tolower(agr$quantifier))
row.names(agr) = paste(agr$Item, agr$Proportion, agr$Quantifier)
mp$PosteriorProbability_empirical = agr[paste(mp$Item,mp$Proportion,"some"),]$normresponse

summary(mp)
#plot empirical against predicted distributions for "some"
some = ddply(mp, .(Item, QUD, Alternatives, SpeakerOptimality, PriorExpectation, Proportion, PosteriorProbability_empirical), summarise, PosteriorProbability_predicted=sum(PosteriorProbability), PriorProbability_smoothed=sum(PriorProbability))
#some= subset(some, Quantifier == "some")
nrow(some)
head(some)
msome = melt(some, measure.vars=c("PosteriorProbability_empirical","PosteriorProbability_predicted","PriorProbability_smoothed"))
msome$ptype = as.factor(ifelse(msome$variable == "PosteriorProbability_empirical", "posterior (empirical)",ifelse(msome$variable == "PosteriorProbability_predicted","posterior (model)", "prior")))
head(msome)
nrow(msome)
summary(msome)

toplot = droplevels(subset(msome, QUD == "how-many" & SpeakerOptimality == 2 & Alternatives == "0_basic"))#"0_basic1_lownum2_extra4_twowords5_threewords"))
nrow(toplot)
toplot$Probability = as.factor(ifelse(toplot$ptype == "prior","prior","posterior"))
toplot$Prop = factor(toplot$Proportion, levels=c("1-50","51-99","100"))
ggplot(toplot, aes(x=Prop, y=value,color=ptype, group=ptype, size=Probability)) +
  geom_point() +
  geom_line() +
  scale_size_discrete(range=c(1,2)) +
  scale_color_manual(values=c("red","blue","black")) +
  facet_wrap(~Item)
ggsave("graphs/model-empirical-howmany-2-basic.pdf",width=35,height=30)

#plot empirical against predicted allstate-prbabilities for "some"
allstate = droplevels(subset(mp, State == 15))
cors = ddply(allstate, .(Alternatives, QUD, SpeakerOptimality), summarise, r=cor(PosteriorProbability, PosteriorProbability_empirical))
cors = cors[order(cors[,c("r")],decreasing=T),]
head(cors)
# .57 correlation despite being shitty model

ggplot(allstate, aes(x=PosteriorProbability, y=PosteriorProbability_empirical,color=as.factor(SpeakerOptimality))) +
  geom_point() +
  geom_smooth() +
  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1)) +
  scale_y_continuous(limits=c(0,1)) +
  #  geom_text(data=cors, aes(label=r)) +
  #scale_size_discrete(range=c(1,2)) +
  #scale_color_manual(values=c("red","blue","black")) +
  facet_grid(QUD~Alternatives)
ggsave("graphs/model-empirical-allstateprobs.pdf",width=30,height=10)

#maybe COGSCI plot basis? plot  predicted allstate-prbabilities for "some" as a function of prior allstate-probabilities

ggplot(allstate, aes(x=PriorProbability, y=PosteriorProbability,color=as.factor(SpeakerOptimality))) +
  geom_point() +
  geom_smooth() +
  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1)) +
  scale_y_continuous(limits=c(0,1)) +
  #  geom_text(data=cors, aes(label=r)) +
  #scale_size_discrete(range=c(1,2)) +
  #scale_color_manual(values=c("red","blue","black")) +
  facet_grid(QUD~Alternatives)
ggsave("graphs/model-allstateprobs.pdf",width=30,height=10)

#plot empirical against predicted expectations for "some"
load("/Users/titlis/cogsci/projects/stanford/projects/sinking_marbles/sinking-marbles/experiments/13_sinking-marbles-priordv-15/results/data/r.RData")
summary(r)
r$Item = as.factor(paste(r$effect, r$object))
agr = aggregate(ProportionResponse ~ Item + quantifier, data=r, FUN=mean)
#agr$CILow = aggregate(ProportionResponse ~ Item + quantifier,data=r, FUN=ci.low)$ProportionResponse
#agr$CIHigh = aggregate(ProportionResponse ~ Item + quantifier,data=r,FUN=ci.high)$ProportionResponse
#agr$YMin = agr$ProportionResponse - agr$CILow
#agr$YMax = agr$ProportionResponse + agr$CIHigh
agr$Quantifier = as.factor(tolower(agr$quantifier))
row.names(agr) = paste(agr$Item, agr$Quantifier)
mp$PosteriorExpectation_empirical = agr[paste(mp$Item,"some"),]$ProportionResponse
mp$PriorExpectation_smoothed = mp$PriorExpectation/15

pexpectations = ddply(mp, .(Item, QUD, Alternatives, SpeakerOptimality,PriorExpectation_smoothed, PosteriorExpectation_empirical), summarise, PosteriorExpectation_predicted=sum(State*PosteriorProbability)/15)
head(pexpectations)
summary(pexpectations)
some = pexpectations#droplevels(subset(pexpectations, Quantifier == "some"))

cors = ddply(some, .(Alternatives, QUD, SpeakerOptimality), summarise, r=cor(PosteriorExpectation_predicted, PosteriorExpectation_empirical))
cors = cors[order(cors[,c("r")],decreasing=T),]
head(cors)

ggplot(some, aes(x=PosteriorExpectation_predicted, y=PosteriorExpectation_empirical,color=as.factor(SpeakerOptimality))) +
  geom_point() +
  geom_smooth(method="lm") +
  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1)) +
  scale_y_continuous(limits=c(0,1)) +
  #  geom_text(data=cors, aes(label=r)) +
  #scale_size_discrete(range=c(1,2)) +
  #scale_color_manual(values=c("red","blue","black")) +
  facet_grid(QUD~Alternatives)
ggsave("graphs/model-empirical-expectations.pdf",width=30,height=10)

# plot posterior expectation against prior expectation
ggplot(some, aes(x=PriorExpectation_smoothed, y=PosteriorExpectation_predicted,color=as.factor(SpeakerOptimality))) +
  geom_point() +
  geom_smooth(method="lm") +
#  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1)) +
  scale_y_continuous(limits=c(0,1)) +
  #  geom_text(data=cors, aes(label=r)) +
  #scale_size_discrete(range=c(1,2)) +
  #scale_color_manual(values=c("red","blue","black")) +
  facet_grid(QUD~Alternatives)
ggsave("graphs/model-expectations.pdf",width=30,height=10)

# plot posterior expectation against prior expectation for basic model with speaker optimality =2 and qud = how-many and alternatives = basic
toplot = droplevels(subset(some, QUD=="how-many" & Alternatives == "0_basic" & SpeakerOptimality == 2))
ggplot(toplot, aes(x=PriorExpectation_smoothed, y=PosteriorExpectation_predicted)) +
  geom_point(color="#00B0F6") + #values=c("#F8766D", "#A3A500", "#00BF7D", "#E76BF3", "#00B0F6")
  geom_smooth(color="#00B0F6") +
  #  geom_abline(intercept=0,slope=1,color="gray50") +
  scale_x_continuous(limits=c(0,1), name="Prior expectation") +
  scale_y_continuous(limits=c(0,1), name="Model predicted posterior expectation")
  #  geom_text(data=cors, aes(label=r)) +
  #scale_size_discrete(range=c(1,2)) +
  #scale_color_manual(values=c("red","blue","black"))
ggsave("graphs/model-expectations.pdf",width=5.5,height=4.5)#,width=30,height=10)
ggsave("~/cogsci/conferences_talks/_2015/2_cogsci_pasadena/wonky_marbles/paper/pics/model-expectations.pdf",width=5.5,height=4.5)
save(toplot, file="data/toplot-expectations.RData")

save(mp, file="data/mp.RData")

expectations = ddply(mp, .(Item, QUD, Alternatives, SpeakerOptimality, NormAllPrior,PriorExpectation), summarize, expectation=sum(PosteriorProbability*seq(1,15,by=1)))
head(expectations)
expectations$ExpectationProportion = expectations$expectation/15
expectations$QUDOpt = as.factor(paste(expectations$QUD,expectations$SpeakerOptimality))

ggplot(expectations, aes(x=NormAllPrior,y=ExpectationProportion,color=as.factor(SpeakerOptimality),shape=QUD,group=QUDOpt)) +
  geom_point() +
  geom_smooth() +
  facet_wrap(~Alternatives)
ggsave("graphs/expectations.pdf",width=12,height=7)

ggplot(expectations, aes(x=ExpectationProportion,fill=QUD)) +
  geom_histogram(position="dodge") +
  facet_grid(SpeakerOptimality~Alternatives,scales="free_y")
ggsave("graphs/expectation_histograms.pdf",width=12)

subexp = subset(expectations, SpeakerOptimality == 2 & QUD == "how-many")
ggplot(subexp, aes(x=NormAllPrior,y=ExpectationProportion)) +
  geom_point() +
  geom_smooth() +
  facet_wrap(~Alternatives)
ggsave("graphs/expectations_spopt2_qudhowmany.pdf",width=12,height=7)

ggplot(subexp, aes(x=PriorExpectation,y=ExpectationProportion)) +
  geom_point() +
  geom_smooth() +
  geom_abline(intercept=0,slope=1) +
  facet_wrap(~Alternatives)
ggsave("graphs/expectations_bypriorexp_spopt2_qudhowmany.pdf",width=12,height=7)

ggplot(subset(subexp,Alternatives=="0_basic"), aes(x=PriorExpectation,y=ExpectationProportion)) +
  geom_point() +
  geom_smooth() +
  geom_abline(intercept=0,slope=1,color="gray70")  +
  scale_x_continuous(name="Prior expectation") +
  scale_y_continuous(name="Posterior expectation")
ggsave("graphs/expectations_bypriorexp_spopt2_qudhowmany_alternativesbasic.pdf",width=12,height=7)
ggsave("graphs/modelpredictions_expectations.pdf")

ggplot(subset(mp, Alternatives=="0_basic" & SpeakerOptimality == 2 & QUD == "how-many" & NumState == 15), aes(x=NormAllPrior,y=PosteriorProbability)) +
  geom_point() +
  #geom_smooth() +
  #geom_abline(intercept=0,slope=1,color="gray70") +
  scale_x_continuous(name="Prior probability of all-state") +
  scale_y_continuous(name="Posterior probability of all-state")
ggsave("graphs/modelpredictions_allstate.pdf")

# get empirical posteriors:
load("/Users/titlis/cogsci/projects/stanford/projects/sinking_marbles/sinking-marbles/experiments/3_sinking-marbles-nullutterance/results/data/r.RData")
head(r)
some = subset(r, quantifier == "Some" & Proportion == 100)
some$Item = as.factor(paste(some$effect, some$object))
head(some$normresponse)
# get model predictions for all-state with basic alts, spopt==2, and qud==how-many
mp_some_allstate = subset(mp, Alternatives=="0_basic" & SpeakerOptimality == 2 & QUD == "how-many" & NumState == 15)
head(mp_some_allstate)
nrow(mp_some_allstate)

agr = aggregate(normresponse ~ Item,data=some,FUN=mean)
agr$CILow = aggregate(normresponse ~ Item,data=some, FUN=ci.low)$normresponse
agr$CIHigh = aggregate(normresponse ~ Item,data=some,FUN=ci.high)$normresponse
agr$YMin = agr$normresponse - agr$CILow
agr$YMax = agr$normresponse + agr$CIHigh
row.names(agr) = agr$Item
head(agr)
mp_some_allstate$EmpiricalPosterior = agr[as.character(mp_some_allstate$Item),]$normresponse
mp_some_allstate$YMin = agr[as.character(mp_some_allstate$Item),]$YMin
mp_some_allstate$YMax = agr[as.character(mp_some_allstate$Item),]$YMax

ggplot(mp_some_allstate, aes(x=PosteriorProbability, y=EmpiricalPosterior)) +
  geom_point() +
  geom_smooth() +
#  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  geom_abline(x=0,slope=1,color="gray70") +
  scale_x_continuous(name="Model predicted posterior all-state probability") +
  scale_y_continuous(name="Empirical mean all-state probability")
ggsave("graphs/model-empirical.pdf")
cor(mp_some_allstate$PosteriorProbability,mp_some_allstate$EmpiricalPosterior) # .51

head(subexp)
# plot subject variability
ggplot(some, aes(x=ProportionResponse)) +
  geom_histogram() +
  facet_wrap(~workerid)
ggsave("graphs/some_subjectvariability.pdf",width=12,height=10)

# mark the people who chose at most 3 middle values to respond to "some" with
some$NoVariance = as.factor(ifelse(some$workerid %in% c("8","24","27","37","52","54","61","72","79","108","113"),1,0))

agr = aggregate(ProportionResponse ~ Item,data=some,FUN=mean)
agr$CILow = aggregate(ProportionResponse ~ Item,data=some, FUN=ci.low)$ProportionResponse
agr$CIHigh = aggregate(ProportionResponse ~ Item,data=some,FUN=ci.high)$ProportionResponse
agr$YMin = agr$ProportionResponse - agr$CILow
agr$YMax = agr$ProportionResponse + agr$CIHigh
row.names(agr) = agr$Item

subexp$EmpiricalMean = agr[as.character(subexp$Item),]$ProportionResponse
subexp$YMin = agr[as.character(subexp$Item),]$YMin
subexp$YMax = agr[as.character(subexp$Item),]$YMax

ggplot(subexp, aes(x=ExpectationProportion, y=EmpiricalMean)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  geom_abline(intercept=0,slope=1,color="gray70") +
  geom_smooth(method="lm") +
  #scale_y_continuous(breaks=seq(0,1,0.1)) +
  facet_wrap(~Alternatives)
ggsave("graphs/modelpredictions.pdf",width=12,height=7)

cors = ddply(subexp, .(Alternatives), summarize, Correlation=cor(ExpectationProportion,EmpiricalMean))
cors # best correlation is with basic alternatives (some, none, all -- .6) and basic+many/most/few/afew (-- .59)

# split up by subject vairance on "some" trials
agr = aggregate(ProportionResponse ~ Item + NoVariance,data=some,FUN=mean)
agr$CILow = aggregate(ProportionResponse ~ Item + NoVariance,data=some, FUN=ci.low)$ProportionResponse
agr$CIHigh = aggregate(ProportionResponse ~ Item + NoVariance,data=some,FUN=ci.high)$ProportionResponse
agr$YMin = agr$ProportionResponse - agr$CILow
agr$YMax = agr$ProportionResponse + agr$CIHigh
agrgood = subset(agr, NoVariance == 0)
agrbad = subset(agr, NoVariance == 1)
row.names(agrgood) = agrgood$Item
row.names(agrbad) = agrbad$Item
nrow(agrgood)
nrow(agrbad)
subexp$EmpiricalMean_good = agrgood[as.character(subexp$Item),]$ProportionResponse
subexp$YMin_good = agrgood[as.character(subexp$Item),]$YMin
subexp$YMax_good = agrgood[as.character(subexp$Item),]$YMax

ggplot(subexp, aes(x=ExpectationProportion, y=EmpiricalMean_good)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin_good,ymax=YMax_good)) +
  geom_abline(intercept=0,slope=1,color="gray70") +
  geom_smooth(method="lm") +
  #scale_y_continuous(breaks=seq(0,1,0.1)) +
  facet_wrap(~Alternatives)
ggsave("graphs/modelpredictions_good.pdf",width=12,height=7)

subexp$EmpiricalMean_bad = agrbad[as.character(subexp$Item),]$ProportionResponse
subexp$YMin_bad = agrbad[as.character(subexp$Item),]$YMin
subexp$YMax_bad = agrbad[as.character(subexp$Item),]$YMax

ggplot(subexp, aes(x=ExpectationProportion, y=EmpiricalMean_bad)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin_bad,ymax=YMax_bad)) +
  geom_abline(intercept=0,slope=1,color="gray70") +
  geom_smooth(method="lm") +
  #scale_y_continuous(breaks=seq(0,1,0.1)) +
  facet_wrap(~Alternatives)
ggsave("graphs/modelpredictions_bad.pdf",width=12,height=7)

corsgood = ddply(subexp, .(Alternatives), summarize, Correlation=cor(ExpectationProportion,EmpiricalMean_good))
cors # best correlation is with basic alternatives (some, none, all -- .6) and basic+many/most/few/afew (-- .59)

# prior expectations
agr = aggregate(ProportionResponse ~ Item,data=some,FUN=mean)
agr$CILow = aggregate(ProportionResponse ~ Item,data=some, FUN=ci.low)$ProportionResponse
agr$CIHigh = aggregate(ProportionResponse ~ Item,data=some,FUN=ci.high)$ProportionResponse
agr$YMin = agr$ProportionResponse - agr$CILow
agr$YMax = agr$ProportionResponse + agr$CIHigh
row.names(agr) = agr$Item

exps = read.csv("data/expectations_15_bw5_prior.txt",header=T,sep="\t")
exps$EmpiricalMean = agr[paste(exps$effect, exps$object),]$ProportionResponse
exps$YMin = agr[paste(exps$effect, exps$object),]$YMin
exps$YMax = agr[paste(exps$effect, exps$object),]$YMax
exps$Expectation = exps$expectation/100

ggplot(exps, aes(x=Expectation, y=EmpiricalMean)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax)) +
  geom_abline(intercept=0,slope=1,color="gray70") +
  geom_smooth(method="lm")
ggsave("graphs/prior_expectation.pdf",width=4.5,height=3)

#0.008312938/sum(0.005127138,0.00545222,0.005461004,0.005362598,0.005405903,0.005763719,0.006450809,0.007313772,0.008111662,0.008657936,0.008930543,0.009054953,0.009158519,0.009213201,0.009011604,0.008312938)

p=ggplot(mp, aes(x=NumState,y=PosteriorProbability,shape=as.factor(SpeakerOptimality),color=QUD,group=QUDOpt)) +
  geom_point() +
  geom_line() +
  facet_grid(Item~Alternatives,scales="free_y") +
  theme(axis.text.x=element_text(size=6))
ggsave("graphs/full-dists.pdf",height=45,width=12)

# plot prior versus posterior expectations
pp = data.frame(PriorExpectation = exps$Expectation[1:89],PosteriorExpectation = subexp[subexp$Alternatives == "0_basic",]$ExpectationProportion, Item=subexp[subexp$Alternatives == "0_basic",]$Item)
head(pp)

ggplot(pp, aes(x=PriorExpectation,y=PosteriorExpectation)) +
  geom_point()

ggplot(pp, aes(x=PriorExpectation,y=PosteriorExpectation)) +
  geom_point() +
  geom_abline(intercept=0,slope=1,color="gray70") +
  geom_text(aes(label=Item,y=PosteriorExpectation+.01),color="gray60",size=2)
ggsave("graphs/prior_posterior.pdf")

## expectation for posterior under uniform prior, 15 states
sum(seq(1,15,by=1) * c(0.07111111111111111, 0.07111111111111111, 0.07111111111111111, 0.07111111111111111, 0.07111111111111111, 0.07111111111111111, 0.07111111111111111, 0.07111111111111111, 0.07111111111111111, 0.07111111111111111, 0.07111111111111111, 0.07111111111111111, 0.07111111111111111, 0.07111111111111111, 0.004444444444444445))/15


# combining EMP, Ramirez, and Bahram data
rm(list=ls())
library(betareg)
source("paths.r")
source("paths_fall2019.r")
source('NEFI_functions/crib_fun.r')

# read in abundances
d <- readRDS(delgado_ramirez_abun.path)
#load mapping data.----
map.all <- readRDS(delgado_ramirez_bahram_mapping.path)
map.all <- map.all[map.all$source != "Bahram",]

r2_lev <- list()
#map.all$study_id <- as.integer(as.factor(map.all$study_id))

# without study_id
preds <- c("new.C.5","ph","forest","NPP","map","mat","relEM","ndep.glob")
# with study_id
preds <- c("new.C.5","ph","forest","NPP","map","mat","relEM","ndep.glob","study_id")

k <- 1
for(k in 1:length(d)){
#for(k in 18:18){
  #setup some empty lists.
  model.out <- list()
  predicted.out <- list()
  observed.out <- list()
  y <- d[[k]]

  #match up all data
  #map <- map.all[1:200,] # testing
  map <- map.all
  map <- map[map$sampleID %in% rownames(y),]
  y <- y[rownames(y) %in% map$sampleID,]
  y <- y[order(match(rownames(y), map$sampleID)),]
  x <- map[,colnames(map) %in% preds]

  #loop across the columns of y.
  for(i in 1:ncol(y)){
    if (colnames(y)[i]=="other") next()

    #setup data object
    data <- cbind(y[,i],x)
    data <- data[complete.cases(data),]
    # pals <- data$pals
    # data$pals <- NULL
    group <- data[,1]

    form <- as.formula(paste0(c('group ~ ',paste(preds[!preds %in% c("pals")], collapse="+")), collapse=""))
    #fit model.
    mod <- betareg(form, data = data[,2:ncol(data)])
    #save fitted and predicted values.
    model.out[[i]] <- mod
    predicted.out[[i]] <- fitted(mod)
    observed.out[[i]] <- data[,1]
    names(model.out)[[i]] <- colnames(y)[i]
    names(predicted.out)[[i]] <- colnames(y)[i]
    names(observed.out)[[i]] <- colnames(y)[i]
  }
  predicted.out <- data.frame(do.call('cbind',predicted.out))
  observed.out <- data.frame(do.call('cbind', observed.out))
  par(mfrow = c(3,3))
  par(mar=c(1.5,2.5,2.5,1.5))
  par(oma=c(3.3,2.3,2,0))
  r2_out <- list()
  for(p in 1:ncol(observed.out)){
    mod <- lm(observed.out[,p] ~ predicted.out[,p])
    rsq <- round(summary(mod)$r.squared, 2)
    r2_out[[p]] <- rsq
    plot(observed.out[,p] ~ predicted.out[,p], cex = 0.6)
    mtext(colnames(observed.out)[p], side = 3, line = -1.3, adj = 0.05, cex = 1.3)
    mtext(paste0('R2 = ',rsq), side = 3, line = -2.7, adj = 0.05, cex = 1.2)
    abline(0,1, lwd = 2)
  }
  mtext('predicted', side = 1, line = 1.5, cex = 2, outer=TRUE)
  mtext('observed', side = 2, line = 0, cex = 2, outer=TRUE)

  title(paste(names(d)[k], 'calibration fits'), cex.main=2.3, outer=TRUE, line = -0.75)
  r2_lev[[k]] <- unlist(r2_out)
}
names(r2_lev) <- names(d)
lev.mu <- lapply(r2_lev, mean)
print(lev.mu)

r2_all <- r2_lev
tax.mu <- lapply(r2_all[1:5], unlist)
tax.mu <- lapply(tax.mu, mean)
fg.mu <- mean(unlist(r2_all[6:18]))
n.mu <- mean(unlist(r2_all[7:13]))
c.mu <- mean(unlist(r2_all[c(6,14:16)]))
co.mu <- mean(unlist(r2_all[c(17:18)]))

lev.mu <- c(tax.mu, fg.mu, n.mu, c.mu, co.mu)
names(lev.mu) <- c(names(tax.mu), "functional", "N-cycling", "C-cycling", "Cop-olig")
# plot by taxon level
par(mfrow=c(1,1),mar = c(6,4.2,1.5,1.5)); limx <- c(0,1); trans <- 0.2; o.cex <- 1.8 #outer label size.
lev.mu <- unlist(lev.mu)
xx <- seq(1,length(lev.mu))
ylim <- c(0.2,.6)
plot(lev.mu ~ xx, cex = 2.5, ylim = ylim, pch = 16, ylab = NA, xlab = NA, bty='n', xaxt = 'n', col="grey")
points(lev.mu ~ xx, cex = 2.5, pch = 16)
lines(xx, lev.mu, lty = 2, col="grey")
mtext(expression(paste("Calibration site-Level R"^"2")), side = 2, line = 2.2, cex = o.cex)
axis(1, labels = F)
text(x=xx, y = .17, labels= names(lev.mu), srt=45, adj=1, xpd=TRUE, cex = 1.8)


a <- mean(x)


context("bed_shift")

bed_tbl <- tibble::tribble(
  ~ chrom, ~ start, ~ end, ~ strand,
  "chr1", 100, 150, "+",
  "chr1", 200, 250, "+",
  "chr2", 300, 350, "+",
  "chr2", 400, 450, "-",
  "chr3", 500, 550, "-",
  "chr3", 600, 650, "-"
)

genome <- tibble::tribble(
  ~ chrom, ~ size,
  "chr1", 1000,
  "chr2", 2000,
  "chr3", 3000
)

test_that("pos increment works", {
  size <- 100
  out <- bed_shift(bed_tbl, genome, size)
  expect_true(
    all(out$start - bed_tbl$start == size),
    all(out$end - bed_tbl$end == size)
  )
})

test_that("neg increment works", {
  size <- -50
  out <- bed_shift(bed_tbl, genome, size)
  expect_true(
    all(out$start - bed_tbl$start == size),
    all(out$end - bed_tbl$end == size)
  )
})

test_that("starts forced to 0", {
  size <- -120
  out <- bed_shift(bed_tbl, genome, size)
  expect_true(all(out$start >= 0))
})

test_that("end forced to chrom length", {
  size <- 1675
  out <- bed_shift(bed_tbl, genome, size) %>%
    left_join(genome, by = "chrom")
  expect_true(all(out$end <= out$size))
})

test_that("fraction increment works", {
  fraction <- 0.5
  interval <- bed_tbl$end - bed_tbl$start
  out <- bed_shift(bed_tbl, genome, fraction = fraction)
  expect_true(all(
    out$start - bed_tbl$start == fraction * interval,
    all(out$end - bed_tbl$end == fraction * interval)
  ))
})

test_that("negative fraction increment works", {
  fraction <- -0.5
  interval <- bed_tbl$end - bed_tbl$start
  out <- bed_shift(bed_tbl, genome, fraction = fraction)
  expect_true(all(
    out$start - bed_tbl$start == fraction * interval,
    all(out$end - bed_tbl$end == fraction * interval)
  ))
})

test_that("rounding fraction increment works", {
  fraction <- 0.51234
  interval <- bed_tbl$end - bed_tbl$start
  out <- bed_shift(bed_tbl, genome, fraction = fraction)
  expect_true(all(
    out$start - bed_tbl$start == round(fraction * interval),
    all(out$end - bed_tbl$end == round(fraction * interval))
  ))
})

test_that("shift by strand works", {
  size <- 100
  x <- group_by(bed_tbl, strand)
  out <- bed_shift(x, genome, size)
  expect_true(all(
    ifelse(out$strand == "+",
      out$start - bed_tbl$start == size,
      out$start - bed_tbl$start == -size
    ),
    ifelse(out$strand == "+",
      out$end - bed_tbl$end == size,
      out$end - bed_tbl$end == -size
    )
  ))
})

test_that("shift by strand and fraction works", {
  fraction <- 0.5
  x <- group_by(bed_tbl, strand)
  sizes <- bed_tbl$end - bed_tbl$start
  out <- bed_shift(x, genome, fraction = fraction)
  expect_true(all(
    ifelse(out$strand == "+",
      out$start - bed_tbl$start == sizes * fraction,
      out$start - bed_tbl$start == -sizes * fraction
    ),
    ifelse(out$strand == "+",
      out$end - bed_tbl$end == sizes * fraction,
      out$end - bed_tbl$end == -sizes * fraction
    )
  ))
})

# from https://github.com/arq5x/bedtools2/blob/master/test/shift/test-shift.sh
a <- tibble::tribble(
  ~ chrom, ~ start, ~ end, ~ name, ~ score, ~ strand,
  "chr1", 100, 200, "a1", 1, "+",
  "chr1", 100, 200, "a2", 2, "-"
)

tiny.genome <- tibble::tribble(
  ~ chrom, ~ size,
  "chr1", 1000
)

test_that("test going beyond the start of the chrom", {
  out <- bed_shift(a, tiny.genome, size = -300, trim = TRUE)
  expect_true(all(
    out$start == c(0, 0),
    out$end == c(1, 1)
  ))
})

test_that("test going beyond the start of the chrom", {
  out <- bed_shift(a, tiny.genome, size = -200, trim = TRUE)
  expect_true(all(
    out$start == c(0, 0),
    out$end == c(1, 1)
  ))
})

test_that("test going beyond the end of the chrom", {
  out <- bed_shift(a, tiny.genome, size = 1000, trim = TRUE)
  expect_true(all(
    out$start == c(999, 999),
    out$end == c(1000, 1000)
  ))
})

test_that("test shift being larger than a signed int", {
  out <- bed_shift(a, tiny.genome, size = 3000000000, trim = TRUE)
  expect_true(all(
    out$start == c(999, 999),
    out$end == c(1000, 1000)
  ))
})

test_that("test chrom boundaries", {
  tiny2.genome <- tibble::tribble(
    ~ chrom, ~ size,
    "chr1", 10
  )

  b <- tibble::tribble(
    ~ chrom, ~ start, ~ end, ~ name, ~ score, ~ strand,
    "chr1", 5, 10, "cds1", 0, "+"
  )
  out <- bed_shift(b, tiny2.genome, size = 2, trim = TRUE)
  expect_true(all(
    out$start == 7,
    out$end == 10
  ))
})

test_that("test shift huge genome", {
  tiny2.genome <- tibble::tribble(
    ~ chrom, ~ size,
    "chr1", 249250621
  )

  b <- tibble::tribble(
    ~ chrom, ~ start, ~ end, ~ name, ~ score, ~ strand,
    "chr1", 66999638L, 67216822L, "NM_032291", 0L, "+",
    "chr1", 92145899L, 92351836L, "NR_036634", 0L, "-"
  )
  out <- bed_shift(b, tiny2.genome, size = 1000, trim = TRUE)
  expect_true(all(
    out$start == c(67000638, 92146899),
    out$end == c(67217822, 92352836)
  ))
})