library(tidyverse)  # 1.3.1
library(ggcorrplot) # 0.1.3
library(OpenML)

#====================================================================
# Import and inspect
#====================================================================

raw <- OpenML::getOMLDataSet(43093)$data
summary(raw)

# Proportion resellings
mean(duplicated(raw$PARCELNO))  # 0.01119724

#====================================================================
# Map
#====================================================================

# Simple price map with logarithmic price per sqft color scale
raw %>%
  mutate(price_per_sqft = SALE_PRC / TOT_LVG_AREA) %>%
ggplot(aes(LONGITUDE, LATITUDE, z = price_per_sqft)) +
  coord_quickmap() +
  stat_summary_2d(bins = 50) +
  labs(fill = "Mean price per sqft",
       x = element_blank(),
       y = element_blank()) +
  scale_fill_viridis_c(option = "inferno", begin = 0.2, trans = "log10") +
  theme_void() +
  theme(axis.ticks = element_blank(),
        axis.text = element_blank(),
        strip.text.x = element_text(size = 12),
        legend.position = c(0.7, 0.1),
        legend.key.height = unit(3, units = "mm"),
        legend.background = element_rect(fill = "transparent",
                                         linetype = "blank"),
        plot.margin=grid::unit(c(0, 0, 0, 0), "mm"))

#====================================================================
# Prepare data
#====================================================================

prep <- raw %>%
  mutate(
    log_price = log(SALE_PRC),
    log_living = log(TOT_LVG_AREA),
    log_land = log(LND_SQFOOT),
    log_special = log1p(SPEC_FEAT_VAL),
    s_dist_highway = sqrt(HWY_DIST / 1000),
    s_dist_rail = sqrt(RAIL_DIST / 1000),
    dist_ocean = OCEAN_DIST / 1000,
    log_dist_water = log1p(WATER_DIST / 1000),
    s_dist_center = sqrt(CNTR_DIST / 1000),
    s_dist_sub = sqrt(SUBCNTR_DI / 1000)
  )

#====================================================================
# Variable groups
#====================================================================

x_continuous <- c("log_living", "log_land", "log_special", "age",
                  "s_dist_highway", "s_dist_rail", "dist_ocean",
                  "log_dist_water", "s_dist_center", "s_dist_sub")
x_coord <- c("LATITUDE", "LONGITUDE")
x_discrete <- c("month_sold", "structure_quality")
x_vars <- c(x_continuous, x_coord, x_discrete)
y_var <- "log_price"

#====================================================================
# Univariate description
#====================================================================

# Histograms
x <- c(y_var, x_continuous)
prep %>%
  select_at(x) %>%
  pivot_longer(everything()) %>%
  mutate(name = factor(name, levels = x)) %>%
ggplot(aes(x = value)) +
  geom_histogram(bins = 19, fill = "#03336B") +
  facet_wrap(~name, scales = "free", ncol = 3) +
  labs(y = element_blank()) +
  theme(axis.title.y = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank())

# Barplots
prep %>%
  select_at(x_discrete) %>%
  pivot_longer(everything()) %>%
  mutate(name = factor(name, levels = x_discrete),
         value = factor(value)) %>%
ggplot(aes(x = value)) +
  geom_bar(fill = "#03336B") +
  facet_wrap(~name, scales = "free", ncol = 1) +
  labs(y = "Count")

#====================================================================
# Bivariate description
#====================================================================

# Bivariate correlations
prep %>%
  select_at(c(y_var, x_continuous)) %>%
  cor() %>%
  round(2) %>%
ggcorrplot(
  hc.order = FALSE,
  type = "upper",
  outline.col = "white",
  ggtheme = ggplot2::theme_minimal(),
  colors = c("#6D9EC1", "white", "#E46726")
) + theme(plot.margin=grid::unit(c(0, 0, 0, 0), "mm"))

# log price ~ discrete
prep %>%
  select(all_of(x_discrete), y_var) %>%
  mutate(across(-y_var, as.factor)) %>%
  pivot_longer(cols = -y_var) %>%
ggplot(aes_string("value", y_var)) +
  geom_boxplot(varwidth = TRUE, color = "#03336B") +
  facet_wrap(~ name, scales = "free_x", ncol = 1) +
  scale_y_log10()

# log price ~ continuous
prep %>%
  select(all_of(x_continuous), y_var) %>%
  pivot_longer(cols = -y_var) %>%
ggplot(aes_string("value", y = y_var)) +
  geom_hex(bins = 32) +
  facet_wrap(~ name, scales = "free", ncol = 4) +
  scale_y_log10() +
  scale_fill_viridis_c(option = "magma", trans = "log10") +
  theme(legend.position = c(0.7, 0.1),
        legend.direction = "horizontal")

save(prep, x_continuous, x_coord, y_var, x_discrete, x_vars,
     file = "prep.RData")


#uTILS
# defining curves
# Chord distance for spline curves
cumchord <- function(M){
  cumsum(sqrt(apply((M - rbind(M[1, ], M[-nrow(M),]))^2, 1, sum)))
}
# cubic spline
spline3d <- function(pts, npts = 100, proj = FALSE, mesh){
  z <- cumchord(pts)
  zz <- seq(0, max(z), length.out = npts)
  sdata <- data.frame(
    x = splinefun(z, pts[, 1])(zz),
    y = splinefun(z, pts[, 2])(zz),
    z = splinefun(z, pts[, 3])(zz))
  if (proj) sdata <- projRead(as.matrix(sdata), mesh)
  sdata
}


#' Gradient function for negative binomial regression
#'
#' The following variables need to be available to the function in order to
#' be able to call `optim` using this as a gradient function:
#'
#' x - Regression coefficients matrix
#' beta - Regressors, such that beta * x = y
#' y - Observed count values
#'
#' @param par  numeric vector of coefficients in ’x’ and theta
#' @param .x  design matrix of dimension ‘n * p’
#' @param .y  vector of observations of length ‘n’
#' @param weights  vector of weights of length ‘n’
#' @param offset  vector of coefficient offsets of length ‘n’
#' @param verbose  print debug messages
#' @return  direction of steepest descent (the gradient)
gradient = function(par, .x, .y, weights=rep(1, nrow(.x)), offset=rep(0, nrow(.x)),
                    .verbose=FALSE) {
    beta = par[-length(par)]
    theta = exp(par[length(par)])
    mu = .x %*% beta + offset

    if (all(mu >= 0)) {
        grc = drop(.y - mu * (.y + theta)/(mu + theta))
        grt = digamma(.y + theta) - digamma(theta) +
            log(theta) + 1 - log(mu + theta) - (.y + theta)/(mu + theta)
        gr = -colSums(weights * cbind(grc * .x, grt * theta))
    } else {
        gr = c(-beta, 0) # trivial solution for mu=0
    }

    if (.verbose)
        message("gr: ", paste(sprintf("%.2f", gr), collapse=", "))
    gr
}


# Enter your code here. Read input from STDIN. Print output to STDOUT
girlprob <- 1 / 2.09
answer <- pbinom(3, size = 6, prob = girlprob)
write(round(answer, 3), stdout())


library(derivr)
library(dplyr)
library(plotly)

# Plot PnL for three options:

spot_price <- seq(100, 200)
call1 <-  10 * bs_call(180, spot_price, 7, 0.25, 0.001)
call2 <- -10 * bs_call(170, spot_price, 7, 0.30, 0.001)
put1 <-   10 * bs_put(140, spot_price, 7, 0.40, 0.001)

sum <- call1 + call2 + put1
data <- data.frame(spot_price)
atm <- 150
max_val <- max(call1, call2, put1, sum)
min_val <- min(call1, call2, put1, sum)

plotly::plot_ly(data, x= ~spot_price, y = ~sum, name='Sum', type='scatter', mode='lines') %>%
  plotly::add_trace(y = ~call1, name='CALL1', line = list(dash = 'dash')) %>%
  plotly::add_trace(y = ~call2, name='CALL2', line = list(dash = 'dash')) %>%
  plotly::add_trace(y = ~put1, name='PUT1', line = list(dash = 'dash')) %>%
  plotly::add_segments(x = atm, xend = atm, y = max_val, yend = min_val, name='ATM', line=list(dash = 'dot'))


drawLogPlotBox <-function(xlimits=c(1E-10,1E-11), ylimits=c(1E2,1E3),
                          x2limits=NULL, y2limits=NULL, logxy="xy",
                          xlabel="x axis", ylabel="y axis",
                          x2label="", y2label="",
                          naxes=c(T,T,F,F)){
      # draw a plot box with logarithmic axes
      # xlimits: vector with X axis limits (axis=1)
      # ylimits: vector with Y axis limits (axis=2)
      # x2limits: vector with X2 axis limits (axis=3)
      # y2limits: vector with Y2 axis limits (axis=4)
      # logxy: string specifying which axes should be plotted in log scale:
      #        logxy="x" -> X axis
      #        logxy="y" -> Y axis
      #        logxy="xy" -> X and Y axes
      # xlabel: label for X axis
      # ylabel: label for Y axis
      # x2label: label for X2 axis
      # y2label: label for Y2 axis
      # naxes: logical vector with "T" for the axis number to be plotted
      #       (i.e.:  c(TRUE,TRUE,TRUE,TRUE) will draw the four axes, while
      #               c(TRUE,TRUE,FALSE,FALSE) will draw only X (bottom) and
      #               Y (left) axes). By default, all four axes will be plotted.

    getPowerTenLab <- function(expo){
        if(expo == 0){
            powLab <- "1"
        }else if(expo == 1){
            powLab <- "10"
        }else{
            powLab <- as.expression(bquote(10^.(expo)))
        }
        return(powLab)
    }

  # draw plot box with no axes
  # ==========================
  plot(xlimits,ylimits, type="n",log=logxy, xlab=xlabel, cex=0.8, axes=FALSE,
         ylab=ylabel)
  box()

  # check which axes require log scale and plot them

  # X axes
  #========
  if(grepl("x",logxy,ignore.case=TRUE)){ #if log is for X axes
    # set major ticks, major ticks labels and minor ticks for X axis
    expseq<-seq(from=round(log10(xlimits[1])),to=round(log10(xlimits[2])))
    xmjt<-10**expseq
    xmjtlabs<-c()
    xmnt<-c()
    for (expo in expseq){
        xmjtlabs<-append(xmjtlabs,getPowerTenLab(expo))
        xmnt<-append(xmnt,seq(2,9)*10**expo)
    }
    axis(1,at=xmjt,labels=xmjtlabs,las=1,col.axis="black")
    axis(1,at=xmnt,tcl=-0.2,labels=FALSE,col.axis="white")
    if (naxes[3]){
        if(!is.null(x2limits)){
            expseq<-seq(from=round(log10(x2limits[1])),to=round(log10(x2limits[2])))
            xmjt<-(10**expseq)*xlimits[1]/x2limits[1]
            xmjtlabs<-c()
            xmnt<-c()
            for (expo in expseq){
                xmjtlabs<-append(xmjtlabs,getPowerTenLab(expo))
                xmnt<-append(xmnt,seq(2,9)*10**expo)
            }
            xmnt <- xmnt *xlimits[1]/x2limits[1]
        }
        #axis(3,at=xmjt,col.ticks="grey",cex.axis=0.9,labels=xmjtlabs,padj=0.7)
        axis(3,at=xmjt,col.ticks="grey",cex.axis=0.9,labels=FALSE,padj=0.7)
        axis(3,at=xmnt,col.ticks="grey",tcl=-0.2,labels=FALSE,col.axis="white",padj=0.7)
        title(main=x2label,cex.main=0.8)
    }
  }else{ # if X axis not to be log scaled
    axis(1)
    if (naxes[3]){axis(3,col.ticks="grey",cex.axis=0.9,padj=0.7)}
  }

  # Y axes
  #========
  if(grepl("y",logxy,ignore.case=TRUE)){ #if log is for Y axes
    # set major ticks, major ticks labels and minor ticks for Y axis
    expseq<-seq(round(log10(ylimits[1])),round(log10(ylimits[2])))
    ymjt<-10**expseq
    ymjtlabs<-c()
    ymnt<-c()
    for (expo in expseq){
      ymjtlabs<-append(ymjtlabs,getPowerTenLab(expo))
      ymnt<-append(ymnt,seq(2,9)*10**expo)
    }

    axis(2,at=ymjt,labels=ymjtlabs,las=1)
    axis(2,at=ymnt,tcl=-0.2,labels=FALSE,col.axis="white")
    if (naxes[4]){
        if(!is.null(y2limits)){
            expseq<-seq(round(log10(ylimits[1])),round(log10(ylimits[2])))
            ymjt<-10**expseq*ylimits[1]/y2limits[1]
            ymjtlabs<-c()
            ymnt<-c()
            for (expo in expseq){
                ymjtlabs<-append(ymjtlabs,getPowerTenLab(expo))
                ymnt<-append(ymnt,seq(2,9)*10**expo)
            }
            ymnt <- ymnt *ylimits[1]/y2limits[1]
        }
        #axis(4,at=ymjt,col.ticks="grey",cex.axis=0.9,labels=ymjtlabs,las=1,hadj=0.5)
        axis(4,at=ymjt,col.ticks="grey",cex.axis=0.9,labels=FALSE,las=1,hadj=0.5)
        axis(4,at=ymnt,col.ticks="grey",tcl=-0.2,labels=FALSE,col.axis="white",hadj=0.5)
    }
  }else{# if Y axis not to be log scaled
    axis(2,las=1)
    if (naxes[4]){axis(4,col.ticks="grey",las=1,cex.axis=0.9,hadj=0.5)}
  }
}


context("Stability")

test_that("Test spectral radius ", {
    skip_on_cran()
    th <- threshold_setup()
    A <- matrix(c(1, 3, 2, 0), 2, 2)
    expect_equal(th$spectral_radius(A), 3)
})

test_that("Test JSR, CJSR, SCJSR", {
    skip_on_cran()
    th <- threshold_setup()
    A1 <- matrix(c(1, 2, -1, 1), 2, 2)
    A2 <- matrix(c(1, 1, -1, 1), 2, 2)
    A3 <- matrix(c(3, 1, -2, 0), 2, 2)
    A4 <- matrix(c(-2, 1, 0, -1), 2, 2)
    Sigma <- list(A1, A2, A3, A4)
    A1 <- matrix(c(1, 2, -1, 1), 2, 2)
    A2 <- matrix(c(1, 1, -1, 1), 2, 2)
    A3 <- matrix(c(3, 1, -2, 0), 2, 2)
    A4 <- matrix(c(-2, 1, 0, -1), 2, 2)
    E1 <- matrix(c(1, 0, 0, 1), 2, 2)
    D <- matrix(c(0, 0), 1, 2)
    X1 <- list(E1, D)
    E2 <- matrix(c(1, 0, 0, -1), 2, 2)
    X2 <- list(E2, D)
    E3 <- matrix(c(-1, 0, 0, 1), 2, 2)
    X3 <- list(E3, D)
    E4 <- matrix(c(-1, 0, 0, -1), 2, 2)
    X4 <- list(E4, D)
    X <- list(X1, X2, X3, X4)
    G <- th$automaton_constructor(Sigma)
    s <- th$discreteswitchedsystem(Sigma, G, X)
    gamma_sdp <- th$sdpbound_gamma(s)
    gamma_sos <- th$sosbound_gamma(s, 2)
    expect_true(gamma_sdp <= 2.1)
    expect_true(gamma_sdp >= 2)
    expect_true(gamma_sos <= 2.1)
    expect_true(gamma_sos >= 2)
})


# R program - Linear Regression and Lasso Regression

# Read the datasets
data_train <- read.csv("/Project data analysis for business/train.csv")
data_test <- read.csv("/Project data analysis for business/test.csv")

# Split Train and Test using sample()
train <- sample(1:nrow(data_train), nrow(data_train)/2)
test <- (-train)

# Exploratory Data Analysis: verify correlation between the response SalePrice and every other predictor
pdf("my_plot.pdf")
par(mfrow = c(4,3))
for(i in 1:ncol(data_train)){
plot(data_train[,i], data_train$SalePrice, xlab=names(data_train[i]),
ylab="SalePrice", pch=20)
}
dev.off()

# Print how many NAs there are inside each predictor column
for (i in 1:ncol(data_train)){
    n <- sum(is.na(data_train[,i]))
    if (n > 100){
        cat("[", i, "]: ", n, "\n")
    }
}

# Remove predictors that shows a number of NAs > 500.
indexes_NA <- c() #boolean vector: TRUE means that
predictor i has NA values
for (i in 1:ncol(data_train)){
    n <- sum(is.na(data_train[,i]))
    if (n > 500){
        indexes_NA <- c(indexes_NA, TRUE)
    }
    else{ indexes_NA <- c(indexes_NA, FALSE) }
}
#remove:
data_train <- data_train[,!indexes_NA]

# Remove the predictor "Utilities", which contains only one level of factor.
data_train$Utilities <- NULL

# Solve other NAs issues
data_train$GarageFinish <- as.character(data_train$GarageFinish)
data_train$GarageFinish[is.na(data_train$GarageFinish)] <- "No"
data_train$GarageFinish <- as.factor(data_train$GarageFinish)
data_train$GarageQual <- as.character(data_train$GarageQual) > data_train$GarageQual[is.na(data_train$GarageQual)] <- "No"
data_train$GarageQual <- as.factor(data_train$GarageQual)
data_train$GarageYrBlt[is.na(data_train$GarageYrBlt)] <- 0
data_train$MasVnrArea[is.na(data_train$MasVnrArea)] <- mean(data_train$MasVnrArea, na.rm = TRUE) #substitute with mean
data_train$LotFrontage[is.na(data_train$LotFrontage)] <- mean(data_train$LotFrontage, na.rm = TRUE)
data_train$Electrical[is.na(data_train$Electrical)] <- "SBrkr"

# ++++++++++++++++++++++++++++++++++++++++++++++++
# ++++++++++++++++++++++++++++++++++++++++++++++++
# MODEL 1 - Fitting a Linear Regression

lm.fit <- lm(SalePrice~., data=data_train[train,])
summary(lm.fit)

# Compute "studentized residuals" to identify outliers
out <- abs(rstudent(lm.fit))
for(i in 1:length(out)){
    if(out[i] > 3){ print(out[i]) }
}

lm.fit <- lm(SalePrice ~ KitchenQual + X2ndFlrSF + X1stFlrSF + BsmtQual
+ MasVnrArea + OverallQual + OverallCond + LotArea + HouseStyle +
LotFrontage + YearBuilt +TotalBsmtSF, data = data_train[train,])

# Compute the Variance Inflaction Factor (VIF) to detect collinearity
library(car)
vif(lm.fit)

# ++++++++++++++++++++++++++++++++++++++++++++++++
# K-Fold Cross-Validation

mse.lm <- rep(0,10)
for(i in 1:10){
    set.seed(i)
    train <- sample(1:nrow(data_train), nrow(data_train)/2)
    test <- (-train)
    y <- data_train[test,]$SalePrice
    lm.fit <- lm(SalePrice ~ KitchenQual + X2ndFlrSF + X1stFlrSF +
BsmtQual + MasVnrArea + OverallQual + OverallCond + LotArea +
HouseStyle + LotFrontage + YearBuilt +TotalBsmtSF, data =
data_train[train,])
    pred <- predict(lm.fit, data_train[test,])
    mse.lm[i] <- mean((y - pred)^2)
}
print(sqrt(mean(mse.lm)))
# Average RMSE is 29,826.37

# ++++++++++++++++++++++++++++++++++++++++++++++++
# ++++++++++++++++++++++++++++++++++++++++++++++++
# MODEL 2 - Fitting the Lasso

install.packages("glmnet")
library(glmnet)

mse.lasso <- rep(0,10)
for (i in 1:10){
    x <- model.matrix(SalePrice~., data_train)[,-1] #Predictors
    y <- data_train$SalePrice #Response
    set.seed(i)
    train <- sample(1:nrow(x), nrow(x)/2) #split train and test
    test <- (-train)
    y.test = y[test]
    lasso.mod <- glmnet(x[train,], y[train], alpha=1) #fitting a lasso model
    cv.out <- cv.glmnet(x[train,], y[train], alpha=1) #find best lambda
    bestlam <- cv.out$lambda.min
    lasso.pred <- predict(lasso.mod, s=bestlam, newx=x[test,])
    mse.lasso[i] <- mean((y.test - lasso.pred)^2)
}
print(sqrt(mean(mse.lasso)))
# Average MSE is 26,409.52

# R-squared
rsq <- function(predicted, actual){
    mean <- mean(actual)
    tss <- 0
    rss <- 0
    for(i in 1:length(predicted)){
        tss <- tss + (actual[i] - mean)^2
        rss <- rss + (actual[i] - predicted[i])^2
}
    rs <- 1 - rss/tss
}

# Compute R-squared among 10 different dataset splits
rs.lasso <- rep(0,10)
for (i in 1:10){
    x <- model.matrix(SalePrice~., data_train)[,-1] #Predictors
    y <- data_train$SalePrice #Response
    set.seed(i)
    train <- sample(1:nrow(x), nrow(x)/2) #split train and test
    test <- (-train)
    y.test = y[test]
    lasso.mod <- glmnet(x[train,], y[train], alpha=1) #fitting a lasso model
    cv.out <- cv.glmnet(x[train,], y[train], alpha=1) #find best lambda
    bestlam <- cv.out$lambda.min
    lasso.pred <- predict(lasso.mod, s=bestlam, newx=x[test,])
    rs.lasso[i] <-rsq(lasso.pred, y.test)
}
print(sqrt(mean(rs.lasso)))
# R2 is 0.94


#Napoved ekoloških izdatkov Slovenije v prihodnjih letih =======================================
eko.potrosnja.slovenija <- eko.potrosnja %>%
  filter(Drzava == 'Slovenia') %>%
  transform(Izdatki.za.ekologijio = Izdatki.za.ekologijio / 1000)

napoved <- lm(data=eko.potrosnja.slovenija, eko.potrosnja.slovenija$Izdatki.za.ekologijio ~Leto)
dodatna.leta <- data.frame(Leto=seq(2017,2021,1))
napoved.potrosnje <- mutate(dodatna.leta, Izdatki.za.ekologijio=predict(napoved, dodatna.leta))

graf.napovedi.praga.slo <- ggplot(eko.potrosnja.slovenija, aes(x=Leto, y=Izdatki.za.ekologijio)) +
  geom_smooth(method=lm, fullrange=TRUE, color='yellow') +
  geom_point(data=napoved.potrosnje, inherit.aes=TRUE, colour="red") +
  geom_point() +
  scale_x_continuous('Leto', breaks=seq(2008, 2021, 1), limits=c(2008, 2021)) +
  ggtitle('Napoved izdatkov za ekologijo Slovenije v letih 2017-2021') +
  theme(plot.title=element_text(hjust=0.5, size=15, face="bold")) +
  theme_bw() +
  xlab("Leto") +
  ylab("Izdatki za ekologijo v milijardah €")

# plot(graf.napovedi.praga.slo)

##Napoved ekoloških izdatkov Nemčije v prihodnjih letih =======================================
eko.potrosnja.nemcija <- eko.potrosnja %>%
  filter(Drzava == 'Germany') %>%
  transform(Izdatki.za.ekologijio = Izdatki.za.ekologijio / 1000)

napoved <- lm(data=eko.potrosnja.nemcija, eko.potrosnja.nemcija$Izdatki.za.ekologijio ~Leto)
dodatna.leta <- data.frame(Leto=seq(2017,2021,1))
napoved.potrosnje <- mutate(dodatna.leta, Izdatki.za.ekologijio=predict(napoved, dodatna.leta))

graf.napovedi.praga.nem <- ggplot(eko.potrosnja.nemcija, aes(x=Leto, y=Izdatki.za.ekologijio)) +
  geom_smooth(method=lm, fullrange=TRUE, color="yellow") +
  geom_point(data=napoved.potrosnje, inherit.aes=TRUE, colour="red") +
  geom_point() +
  scale_x_continuous('Leto', breaks = seq(2008, 2021, 1), limits=c(2008, 2021)) +
  ggtitle('Napoved izdatkov za ekologijo Nemčije v letih 2016-2020') +
  theme(plot.title=element_text(hjust=0.5, size=15, face="bold")) +
  theme_bw() +
  xlab("Leto") +
  ylab("Izdatki za ekologijo v milijardah €")

# plot(graf.napovedi.praga.nem)


# COVID-19
#
# Estimación de los parametros de una exponecial/ logistica,  el factor de crecimiento
# También para los casos de contacto directo
#
# Fuente @msalnacion
#

require(dplyr)
require(readr)
require(lubridate)
cor <- read_csv("/home/leonardo/Academicos/GitProjects/covid19/coronavirus_ar.csv") %>% dplyr::select(fecha:comunitarios)
cor <- cor  %>% mutate(fecha=ymd(fecha), dias =as.numeric( fecha - min(fecha)))
#
# OJO, los casos en estudio = ? comunitarios no estan acumulados
#

require(ggplot2)

# g0 <- ggplot(cor,aes(x=dias,y=casos)) + geom_point() + theme_bw() + geom_smooth(method="glm",family=gaussian(link="log"))
# g1 <- g0 + expand_limits(x=c(0,240))+
#   geom_smooth(method="glm",family=gaussian(link="log"),
#               fullrange=TRUE)

# Comparación de distintos modelos utilizando el criterio de Akaike (lineal y exponencial nomas)
#
expmdl <- lm(log(casos)~ dias,data=cor)
summary(expmdl)
linmdl <- lm(casos~ dias,data=cor)
summary(linmdl)
AIC(linmdl,expmdl)

# Ajuste no-lineal del los parametros del modelo exponencial
#
model <- nls(casos ~ alpha * exp(beta * dias) , data =cor  , start=list(alpha=0.6,beta=0.4))
# Ajuste del modelo logístico
require(drc)
#
# f(x) = d / (1+exp(b(x - e)))
#
model1 <- drm(casos ~ dias, fct=L.3() , data = cor)
summary(model1)
capacidadcarga <- round(coef(model1)[2])
AIC(model,model1)
# Despues del dia 21 El ajuste del modelo logístico es mejor
# En el dia 21 todavia ajustaba mejor el modelo exponencial
#

# Extraigo los coeficientes para ponerlos en el gráfico
#
model <- nls(casos ~ alpha * exp(beta * dias) , data = filter(cor, dias<22)  , start=list(alpha=0.6,beta=0.4))

a <- round(coef(model)[1],2)
b <- round(coef(model)[2],2)
summary(model)
# Tiempo de duplicacion
#
tau <-  round(log(2)/b,2)

# Prediccion hasta 12/04
#
ldia <- as.numeric(ymd("2020-04-12") - min(cor$fecha))
predexp <-data.frame(pred=predict(model,newdata=data.frame(dias=0:ldia)),predlog = predict(model1,newdata=data.frame(dias=0:ldia))) %>% mutate(dias=0:ldia, fecha=min(cor$fecha)+dias)
predexp
# Estimación de R0
#
#
# Generation time from
# https://github.com/midas-network/COVID-19/tree/master/parameter_estimates/2019_novel_coronavirus
#
require(R0)
mGT<-generation.time("gamma", c(7.5, 3.4))
est.R0.EG(cor$casosdia,mGT,begin = 1,end=22)

tl <- est.R0.ML(cor$casosdia,mGT,begin = 1,end=22)
#plotfit(tl)
r <- round(tl$R,2)
r0 <- round(tl$conf.int,2)

col <- viridisLite::viridis(2)
# Casos totales
#
ggplot(cor, aes(x = fecha, y = casos) ) +
  geom_point() +
#  geom_ribbon( aes(ymin = lwr, ymax = upr), alpha = .15) +
  geom_line(data=predexp, aes(x=fecha,y = pred), size = .5, color= col[1]) +
  geom_line(data=predexp, aes(x=fecha,y = predlog), size = .5, color= col[2]) +  theme_bw() +
  annotate("text",x=ymd("20200330"), y=1, label="Fuente @msalnacion\n by @larysar",color="red",size=2) + scale_y_log10() +
  annotate("text", x=ymd("20200325"), y=3,label=paste("R0 =", r, "[", r0[1], ",", r0[2],"]"),size=3) +
  annotate("text", x=ymd("20200325"), y=2,label=paste("Capacidad de carga =", capacidadcarga),size=3)

ggsave("/home/leonardo/Academicos/GitProjects/covid19/coronaArTotalesLog.jpg",width=6,height=6,units="in",dpi=600)

# Growth Factor para casos totales
#
cor <- cor %>% mutate(delta=casos-lag(casos),deltaPrev=lag(delta),growthFactor= delta/deltaPrev)

ggplot(cor %>% filter(dias>3),aes(x=dias,y=growthFactor)) + geom_point() + theme_bw() + stat_smooth(method=lm,se=FALSE) +   labs(title = bquote("Growth Factor=" ~ Delta* N[t] / Delta* N[t-1] ))  + theme_bw() + annotate(geom="text", x=5, y=8, label="Fuente @msalnacion\n by @larysar",color="red",size=2)

# Nuevos casos vs casos totales en log
#

predexp <- predexp %>% mutate( preddia = pred - lag(pred))

ggplot(cor, aes(x = casos, y = casosdia) ) +
  geom_point() + geom_line() + scale_x_log10() + scale_y_log10() + theme_bw() + ylab("Nuevos casos") + xlab("Casos totales")+
  geom_line(data=predexp, aes(x=pred, y = preddia), size = .5, color= "blue") + coord_cartesian(xlim=c(9,max(predexp$pred)))+
  annotate(geom="text", x=1000, y=1, label="Fuente @msalnacion\n by @larysar",color="red",size=2)

ggsave("/home/leonardo/Academicos/GitProjects/covid19/coronaArNuevosVsTotales.jpg",width=6,height=6,units="in",dpi=600)

#  geom_line(data=predexp, aes(x=fecha,y = pred), size = .5, color= "blue")

#
# Contactos e Importados Comunitarios by group usando tidyverse
#
require(tidyr)
cor1 <- cor %>% gather(tipo,N,casos:comunitarios,importados) %>% filter(tipo %in% c("contactos","importados","comunitarios")) %>% mutate(N = ifelse(N==0,NA,N))

ggplot(cor1 ,aes(x=dias,y=N,color=tipo)) + geom_point() + theme_bw() + stat_smooth(method=lm, se=F) + scale_y_log10() + scale_color_viridis_d() + ylab("Casos")

ggplot(cor1,aes(x=dias,y=N,color=tipo)) + geom_point() + theme_bw() + scale_color_viridis_d() + scale_color_viridis_d() + scale_y_log10() + ylab("Casos") + geom_line()

mod <- cor1 %>% filter(N>0) %>% group_by(tipo) %>% do(mod=drm(N ~ dias, fct=L.3() , data = .) )
mod  %>% do(data.frame(max= coef(.$mod)[2],.$tipo))

newdat <- data.frame(dias = 0:ldia)
library(tidyverse)
predexp <- cor1 %>%
  group_by(tipo) %>%
  nest %>%
    mutate(mod  = purrr::map(.x = data, .f = ~ drm(N ~ dias, fct=L.3() , data = .))) %>%
#    mutate(mod  = purrr::map(.x = data, .f = ~ nls(N~ alpha*exp(dias*beta),start=c(alpha=1.4,beta=0.2),data=.))) %>%
  mutate(pred = purrr::map(.x = mod, ~ predict(., newdat))) %>%
  dplyr::select(tipo,pred) %>% unnest(cols=pred) %>% bind_cols(dias = rep(newdat$dias,3)) %>% mutate(fecha = min(cor1$fecha)+dias)

ggplot(cor1,aes(x=fecha,y=N,color=tipo)) + geom_point() + theme_bw() + scale_color_viridis_d() + scale_color_viridis_d() + ylab("Casos") + geom_line(data=predexp, aes(x=fecha,y = pred,color=tipo), size = .5)
#ggsave("/home/leonardo/Academicos/GitProjects/covid19/coronaArComparacion.jpg",width=6,height=6,units="in",dpi=600)

ggplot(cor1,aes(x=fecha,y=N,color=tipo)) + geom_point() + theme_bw() + scale_color_viridis_d() + scale_color_viridis_d() + scale_y_log10() + ylab("Casos") + geom_line(data=predexp, aes(x=fecha,y = pred,color=tipo), size = .5)
ggsave("/home/leonardo/Academicos/GitProjects/covid19/coronaArComparacionComunitarios.jpg",width=6,height=6,units="in",dpi=600)

#ggsave("/home/leonardo/Academicos/GitProjects/covid19/coronaArComparacionLog.jpg",width=6,height=6,units="in",dpi=600)

#
# Comparacion Casos GLobales Tasa de crecimiento vs Casos Totales
#
# Fuente:  Johns Hopkins University Center for Systems Science and Engineering.
#          https://systems.jhu.edu/research/public-health/ncov/
#
#

corg <- read_csv("https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_confirmed_global.csv")

corg <- corg %>% rename(country="Country/Region",province="Province/State")  %>% filter( country %in% c("US","Italy","Brazil", "Korea, South"))
require(tidyr)

# Umbral de casos a partir de los cuales se calcula la curva
#
umbral <- 100

cor1 <- corg %>% gather(date,N,5:ncol(corg) ) %>% arrange(country) %>% mutate(casosdia = N - lag(N)) %>%  filter(N>umbral, casosdia>0 ) %>% group_by(country) %>% mutate(fecha=mdy(date), dias =as.numeric( fecha - min(fecha)))

# Para argentina usa los datos de @minsal
#
cor1 <- bind_rows( cor1, cor %>% filter(casos>umbral) %>%dplyr::select(casos,casosdia,fecha) %>% mutate(country="Argentina",dias =as.numeric( fecha - min(fecha))) %>% rename(N=casos))

require(ggplot2)

ggplot(cor1, aes(x = N, y = casosdia, colour=country) ) + scale_y_log10() +  scale_x_log10() +
  geom_point() +  theme_bw() +  guides(fill=FALSE) + scale_color_viridis_d() + geom_line() + xlab("Casos Totales") + ylab( "Casos por Día") +
  annotate("text",x=1850, y=10, label="Fuente https://systems.jhu.edu/research/public-health/ncov/\n by @larysar",color="red",size=2) + theme(legend.position="bottom")
ggsave("/home/leonardo/Academicos/GitProjects/covid19/coronaGlobalNuevosVsTotales.jpg",width=6,height=6,units="in",dpi=600)


## prep Cousens data
## tables 1 and 2 provide means
## there were 6 replicates
## RSS for simplest models were
## Response    | Wheat | Barley
## Jun biomass | 0.175 | .63
## Aug biomass | 1.337 | 3.388
## Yield       | .173  | .695
## assume these are variances around each mean
## simulate from a t distribution with 24*6 - 2 df, multiply by sd and
## add variance? Don't bother, just use normal deviates
library(tidyverse)

cousens85 <- read_csv("data/cousens_1985_tab_1_2.csv")
cousensRSS <- read_csv("data/cousens_1985_RSS.csv")

# put the means and variances together
cousensSim <- gather(cousens85, key=variable, value=mass, -(1:2)) %>%
  left_join(cousensRSS)

# a new function to take a row of cousensSim and return appropriate
# random numbers.
myfunc <- function(dfrow, reps=6){
  # method of moments estimates from wikipedia page
  E_X = dfrow$mass
  VAR_X = dfrow$RSS
  mu = log(E_X^2 / sqrt(VAR_X + E_X^2))
  sigma2 = log(1 + VAR_X / E_X^2)
  samples <- suppressWarnings(rnorm(reps,
                                    mean=mu,
                                    sd=sqrt(sigma2)))
  if (any(is.nan(samples))){
    samples <- rep(NA_real_, reps)
  }

  result <- data.frame(rep=1:reps,
                       massrep = samples)
  return(result)
}

# should set seed here ...
set.seed(987304)
# might need to install purrrlyr - extract each row of cousensSim
# and pass to myfunc, collate the result by rows.
cousensSim2 <- purrrlyr::by_row(cousensSim, myfunc, .collate="rows")

# filter(cousensSim2, !grepl("seedlings", variable)) %>%
#   mutate(massrep = exp(massrep)) %>%
#   ggplot(aes(x=wheat_sr, y=massrep, col=barley_sr)) +
#   geom_point() +
#   facet_wrap(~variable, scales="free")

## turn it into something like a real dataset
## discarding mean information etc.
## keep sr, rep variables

cousensSim3 <- cousensSim2 %>%
  select(contains("sr"), variable, contains("rep")) %>%
  filter(!is.na(massrep)) %>%
  mutate(massrep = exp(massrep)) %>%
  spread(variable, massrep)

write.csv(cousensSim3, file = "data/cousenssim.csv",
          row.names = FALSE)


"
Ввести с клавиатуры число N. Подсчитать сумму 1 + 2 + ... + N.
Вывести на экран введенное число и результат расчета.
"
{
  N <- readline("Введите число N  -> ")

  sum <- 0
  for(i in 1:N){
    print(i)
    sum <- sum + i
  }

  print(paste("Сумма:",sum))
}


#
# University: Universidad de Valladolid
# Degree: Grado en Estadística
# Subject: Análisis de Datos
# Year: 2017/18
# Teacher: Miguel Alejandro Fernández Temprano
# Author: Sergio García Prado (garciparedes.me)
# Name: Análisis de Componentes Principales - Práctica 01
#
#

rm(list = ls())

library(ggplot2)
suppressMessages(library(gdata))

DATA <- read.xls('./../../../datasets/olympic-2016.xls')
print(DATA)
A <- as.matrix(DATA[,1:10])
# print(A)

X <- t((t(A) - colMeans(A)) / apply(A, 2, sd))
X_start = (t(X) %*% X ) / (dim(X)[1] - 1)
# print(X_start)

X_lambda <- eigen(X_start)$values
X_u <- eigen(X_start)$vector
# print(X_u)

S <- X %*% X_u

scores = as.data.frame(S)
# print(scores)

ggplot(data = scores, aes(x=V1, y=V2, label=DATA[,12])) +
  geom_point() +
  geom_text()


IsPrime <- function(n) {
    for (i in 2:(n/2)) {
        if ( n %% i == 0) {
            return(FALSE)
        }
    }
    return(TRUE)
}

for (i in 2:100)
    if (IsPrime(i))
        print(i)


# Install and load required packages --------------------------------------------------------------------------------------------------

install.packages("tidyverse")
install.packages("dagitty")
install.packages("ggdag")
install.packages("bnlearn")
install.packages("Rgraphviz")
install.packages("causaleffect")
install.packages("igraph")
install.packages("latex2exp")

library(tidyverse)
library(dagitty)
library(ggdag)
library(bnlearn)
library(Rgraphviz)
library(causaleffect)
library(igraph)
library(latex2exp)

# Slide 12. Common Effect example -----------------------------------------------------------------------------------------------------

talent <- rnorm(10000, 0, 1)
hardwork <- rnorm(10000, 0, 1)
df <- data.frame(talent, hardwork)

# Compute the correlation between the variables

df %>% summarize(correlation = cor(talent, hardwork))

# Success is equal to one if the sum of talent and hardwork is above the 80th percentile in the population -----------

x <- talent + hardwork
success <- 1*(x > quantile(x, c(.8)))
df <- cbind(df, success)

df %>% filter(success == 1) %>% summarize(correlation = cor(talent, hardwork))

# Slide 17. Correlation doesn't imply causation ---------------------------------------------------------------------

# Error terms

e_x <- rnorm(10000)
e_y <- rnorm(10000)
e_z <- rnorm(10000)

# Create nodes for the DAG: y <- x, y <- z, x <- z

z <- 1*(e_z > 0)
x <- 1*(z + e_x > 0.5)
y <- 1*(x + z + e_y > 2)
y_dox <- 1*(1 + z + e_y > 2)

# We see that P(y|do(x=1)) is not equal to P(y|x=1)

mean(y_dox)
mean(y[x==1])

# Slide 17. Visualizing DAGs with ggdag -----------------------------------------------------------------------------

coords <- data.frame(matrix(c("x",0,0,
                              "y",2,0,
                              "z",1,1,
                              "w",1,0), nrow=4, ncol=3, byrow=T))

colnames(coords) <- c("name","x","y")

# "y ~ w" means that w is a parent of y

dag <- ggdag:: dagify(y ~ w,
                      y ~ z,
                      w ~ x,
                      x ~ z,
              exposure = "x",
              outcome = "y",
              coords=coords)

# Plot the DAG

ggdag::ggdag(dag)

# Find all parents of outcome

ggdag:: ggdag_parents(dag, "y")

# Slide 20.Testable implications of graphs --------------------------------------------------------------------------

coords <- data.frame(matrix(c("A",0,0,
                              "B",0,1,
                              "C",1,2,
                              "D",2,1,
                              "E",2,0), nrow=5, ncol=3, byrow=T))

colnames(coords) <- c("name","x","y")

# "A ~ B" means that B is a parent of A

dag <- ggdag:: dagify(A ~ B,
                      C ~ A,
                      C ~ B,
                      E ~ A,
                      C ~ D,
                      E ~ C,
                      E ~ D,
                      exposure = "A",
                      outcome = "E",
                      coords=coords)

# Plot the DAG

ggdag::ggdag(dag)

# Find all d-separation relationships in a DAG

impliedConditionalIndependencies(dag)

# Slide 24. PC Algorithm --------------------------------------------------------------------------------------------

# Simulate data : z <- x, w <- x, w <- y, w <- z

x <- rnorm(10000, 0, 1)
y <- rnorm(10000, 0, 1)
z <- x + rnorm(10000, 0, 1)
w <- x + y + z + rnorm(1000, 0, 1)

df <- data.frame(x,y,z,w)

# PC Algorithm

str <- pc.stable(df, test = "cor", alpha = 0.05, undirected = FALSE)

graphviz.plot(str)

# Slide 29. Backdoor Criterion --------------------------------------------------------------------------------------

coords <- data.frame(matrix(c("x",0,0,
                              "w",1,0,
                              "y",2,0,
                              "z",1,1), nrow=4, ncol=3, byrow=T))

colnames(coords) <- c("name","x","y")

# "x ~ z" means that z is a parent of x

dag <- ggdag:: dagify(x ~ z,
                      w ~ x,
                      y ~ w,
                      y ~ z,
                      exposure = "x",
                      outcome = "y",
                      coords=coords)

# Plot the DAG

ggdag::ggdag(dag)

# List all direct causal effects that are identifiable via backdoor adjustment

for(n in names(dag)){
  for(m in dagitty::children(dag,n)){
    a <- adjustmentSets(dag, n, m, effect="direct")
    if(length(a) > 0){
      cat("The causal effect of ",n," on ",m,
          " is identifiable controlling for:\n",sep="")
      print(a, prefix=" * ")
    }
  }
}

# Example

# Error terms

e_x <- rnorm(10000)
e_y <- rnorm(10000)
e_z <- rnorm(10000)

# Create nodes for the DAG: y <- x, y <- z, x <- z

z <- 1*(e_z > 0)
x <- 1*(z + e_x > 0.5)
y <- 1*(x + z + e_y > 2)

y_dox <- 1*(1 + z + e_y > 2)

mean(y_dox)

# Adjustment formula: P(y|do(x=1)) = P(y|x=1, z=1)*P(z=1) + P(y|x=1, z=0)*P(z=0)

mean(y[x==1 & z==1]) * mean(z==1) + mean(y[x==1 & z==0]) * mean(z==0)

# Do-Calculus ------------------------------------------------------------------------------------------------------

# The causaleffect package uses different syntax than "dagitty", note the +- instead of ~

dag <- graph.formula(y +- z5, y +- z6, y +- z1,
                     z6 +- x,
                     z5 +- z4,
                     z2 +- z3,
                     z1 +- z4, z1 +- z3,
                     x +- z2, x +- z1,
                     simplify = FALSE)

# Shpitser and Pearl (2006) algorithm for the rules of do-calculus. If the effect is identifiable, the function
# returns an expression for the causal effect.

ce_backdoor <- causal.effect(y = "y", x = "x", z = NULL, G = dag, expr = TRUE)
plot(TeX(ce_backdoor), cex=2)


library('foreign')

d <- read.spss("data2.sav" , to.data.frame = T )

d$income = d$v353M_ppp

## my home country v255
d[ !( d$v255 %in% c('yes', 'no') ) , ] <- NA

## spouse home country
d[ !( d$v342 %in% c('yes', 'no') ) , ] <- NA

d$imigrant <- as.integer( d$v342 ) + as.integer( d$v255 ) - 2

## education level
d$combined_education = as.integer( d$v344 ) + as.integer( d$v336 )

## check that combined_education is linked to imigrant status
wilcox.test( d$combined_education ~ d$imigrant > 0 )
wilcox.test( d$income ~ d$imigrant > 0 )

d$has_children = d$v321 > 0
d$political = d$v265_LR

### full model
m1 <- lm( income ~ ( imigrant > 0 ) + combined_education + has_children + age + political, d )
summary( m1 )

m2 <- data.frame( d$combined_education, d$has_children, d$age, d$political, d$imigrant )

m2$imigrant = mean( d$imigrant, na.rm = T )

m2$income <- m1$coefficients[1] + m1$coefficients[3] * m2$d.combined_education + m1$coefficients[4] * m2$d.has_children +
m1$coefficients[5] * m2$d.age + m1$coefficients[6] * m2$d.political + m1$coefficients[2] * m2$imigrant

wilcox.test( m2$income ~ m2$d.imigrant > 0 )


f_logLikelihood <- function(M,x_train,uniform_dist,u,sigma)
{
  logLike <- sum(log(M[[1]]*uniform_dist + M[[2]]*dnorm(x_train, u, sqrt(sigma))))
  return (logLike)
}

f_updateResposibilities <- function(M,x_train,uniform_dist,u,sigma)
{
  uniformP <- uniform_dist
  gaussP <- dnorm(x_train, u, sqrt(sigma)) #stats.norm.pdf(x_train,u,sqrt(sigma))
  resposibilities <- cbind( (M[[1]]*uniformP / (M[[1]]*uniformP + M[[2]]*gaussP)), #.reshape(-1,1),
                                (M[[2]]*gaussP / (M[[1]]*uniformP + M[[2]]*gaussP)) ) # .reshape(-1,1) ))
  return (resposibilities)
}

f_updateMixtureParams <- function(resposibilities,M,x_train)
{
  M[[1]] <- sum(resposibilities[,1])/sum(resposibilities)
  M[[2]] <- sum(resposibilities[,2])/sum(resposibilities)
  u <- (sum(resposibilities[,2]*x_train))/sum(resposibilities[,2])
  sigma <- sum((x_train-u)**2*resposibilities[,2])/sum(resposibilities[,2])
  return (list("M" = M,
               #"uniform_dist" = uniform_dist,
               "u" = u,
               "sigma" = sigma))
}

f_calcCutoffs <- function(M,x_train,u,sigma)
{
  tmp <- sqrt(-2*sqrt(sigma)**2 * (log(M[[1]]/M[[2]]) - log(max(x_train)-min(x_train)) + log(sqrt(sigma)) + 0.5*log(2*pi)))
  cutoffs <- c("low" = u-tmp,
               "high" = u+tmp)
  return (cutoffs)
}

f_call_changes <- function(all_t_tests)
{
  # ignore DEAD and GHOST columns
  localization_cols <- colnames(all_t_tests)[ !colnames(all_t_tests) %in% c("GHOST", "DEAD")]
  tscores <- all_t_tests[ ,localization_cols ]

  localization_hits = list()
  Outlier_M <- 0.001
  for (loc in localization_cols)
  {
    x_train = tscores[,loc]
    ### remove BLANK
    x_train <- x_train[ grep("BLANK", names(x_train), invert=T)]
    ### end remove BLANK
    M <- c(Outlier_M, 1-Outlier_M)
    #randInd = np.random.rand(len(x_train))
    resposibilities <- cbind(0.5 * rep(1, length(x_train)),
                             0.5 * rep(1, length(x_train)))
    uniform_dist <- rep(1, length(x_train))/(max(x_train) - min(x_train))
    u <- 0
    sigma <- 0.1**2
    loglike_prev <- 1
    loglike <- 10
    i <- 0
    while (abs(loglike_prev-loglike) > 0.1)
    {
      loglike_prev <- loglike
      resposibilities <- f_updateResposibilities(M, x_train, uniform_dist, u, sigma)
      res_f_upd <- f_updateMixtureParams(resposibilities, M, x_train)
      u <- res_f_upd$u
      sigma <- res_f_upd$sigma
      #M = [Outlier_M, 1.-Outlier_M] # I do not update this parameter, therefore we do not need to reset it
      loglike <- f_logLikelihood(M, x_train, uniform_dist, u, sigma)
      i <- i+1
    }
    cutoffs <- f_calcCutoffs(M,x_train,u,sigma)
    localization_hits[[loc]] <- all_t_tests[ (all_t_tests[,loc] < cutoffs[["low"]]) |
                                          (all_t_tests[,loc] > cutoffs[["high"]]), ]
  }
  sapply(localization_hits, nrow)
  sum(sapply(localization_hits, nrow))
  sum(sapply(localization_hits, function(x) { length(grep("BLANK", row.names(x), invert=T)) }))
  df <- do.call("rbind", localization_hits)
  nrow(df)
  nrow(unique(df))
  nrow(unique(df[ grep("BLANK", row.names(df), invert = T),]))
  return (localication_hits)
}

f_get_significant_changes <- function(t_tests, Outlier_M = 0.001, VERBOSE=F)
{
  compartments <- colnames(t_tests)
  localization_hits = list()
  significant_changes <- list()
  significant_mut_higher <- list()
  significant_WT_higher <- list()
  cutoffs <- list()
  for (loc in compartments)
  {
    x_train = t_tests[,loc]
    M <- c(Outlier_M, 1-Outlier_M)
    resposibilities <- cbind(0.5 * rep(1, length(x_train)),
                             0.5 * rep(1, length(x_train)))
    uniform_dist <- rep(1, length(x_train))/(max(x_train) - min(x_train))
    u <- 0
    sigma <- 0.1**2
    loglike_prev <- 1
    loglike <- 10
    i <- 0
    while (abs(loglike_prev-loglike) > 0.1)
    {
      loglike_prev <- loglike
      resposibilities <- f_updateResposibilities(M, x_train, uniform_dist, u, sigma)
      res_f_upd <- f_updateMixtureParams(resposibilities, M, x_train)
      u <- res_f_upd$u
      sigma <- res_f_upd$sigma
      #M = [Outlier_M, 1.-Outlier_M] # I do not update this parameter, therefore we do not need to reset it
      loglike <- f_logLikelihood(M, x_train, uniform_dist, u, sigma)
      i <- i+1
    }
    cutoffs[[loc]] <- f_calcCutoffs(M,x_train,u,sigma)
    cutoffs[[loc]][["u"]] <- u
    cutoffs[[loc]][["sigma"]] <- sigma
    localization_hits[[loc]] <- t_tests[ (t_tests[,loc] < cutoffs[[loc]][["low"]]) |
                                         (t_tests[,loc] > cutoffs[[loc]][["high"]]), ,
                                         drop=FALSE]
    cutoffs[[loc]][["counts_changes"]] <- nrow(localization_hits[[loc]])
    cutoffs[[loc]][["counts_mut_higher"]] <- sum(t_tests[,loc] < cutoffs[[loc]][["low"]])
    cutoffs[[loc]][["counts_WT_higher"]] <- sum(t_tests[,loc] > cutoffs[[loc]][["high"]])
    significant_changes[[loc]] <- sort(row.names(localization_hits[[loc]]))
    significant_mut_higher[[loc]] <- sort(row.names(t_tests)[ t_tests[,loc] < cutoffs[[loc]][["low"]] ])
    significant_WT_higher[[loc]] <- sort(row.names(t_tests)[ t_tests[,loc] > cutoffs[[loc]][["high"]] ])
    if (VERBOSE) { cat(sprintf("%s\t%s\t%s\t%s\t%s\t%s\n", loc, u, sigma, cutoffs[[loc]][["low"]], cutoffs[[loc]][["high"]], sum((t_tests[,loc] < cutoffs[["low"]]) | (t_tests[,loc] > cutoffs[["high"]]) ) ) ) }
  }
  # table to return w/ all t-tests, and adding the significant change in each row (we only show rows w/ at least a significant change)
  df <- unique(as.data.frame(do.call("rbind", localization_hits),stringsAsFactors = F))
  tmp <- do.call("rbind", sapply(names(significant_changes), function(x) { cbind(x, significant_changes[[x]] )  }) )
  locs_per_ORF <- sapply(split(tmp[,1], tmp[,2]), function(x) { paste(x, collapse=",") })
  df$enriched_loc <- locs_per_ORF[ row.names(df) ]
  # summary
  df_summary <- as.data.frame(do.call("rbind", cutoffs), stringsAsFactors = F)
  df_summary$genes_changing <- sapply(significant_changes[ row.names(df_summary) ], function(x) { paste(x, collapse=",") })
  df_summary$genes_mut_higher <- sapply(significant_mut_higher[ row.names(df_summary) ], function(x) { paste(x, collapse=",") })
  df_summary$genes_WT_higher <- sapply(significant_WT_higher[ row.names(df_summary) ], function(x) { paste(x, collapse=",") })
  return (list("df" = df,
               "df_summary" = df_summary))
}


context("Weights")

test_that("weighted regression works", {
  n = 200
  ntest = 100
  p = 4
  x = matrix(runif(n*p), n, p)
  f = function(x) (x[,1]>0.5) + 0.8*(x[,2]>0.6) + 0.5*(x[,3]>0.4)
  y = as.numeric(f(x))
  weights = rep.int(c(1, 0.5), n/2)

  xtest = matrix(runif(ntest*p), ntest, p)
  ytest = f(xtest)

  ## learning extra trees:
  et = extraTrees(x, y, mtry=p, ntree=100, weights=weights)
  expect_is   ( et, "extraTrees")
  expect_false( et$factor )
  expect_false( et$multitask )
  expect_true( et$useWeights )

  yhat = predict(et, xtest)
  expect_equal(length(yhat), nrow(xtest))
})


library(ggplot2)

#' @param k     The shape parameter of the Erlang distribution.
#' @param gamma The rate parameter of the Erlang distribution.
#' @return      A vector containing all p_i values, for i = 1 : n.
compute_erlang_discrete_prob <- function(k, gamma) {
    n_bin <- 0
    factorials <- 1    ## 0! = 1
    for (i in 1 : k) {
        factorials[i + 1] <- factorials[i] * i    ## factorial[i + 1] = i!
    }

    one_sub_cummulative_probs <- NULL
    cummulative_prob <- 0
    while (cummulative_prob <= 0.99) {
        n_bin <- n_bin + 1

        one_sub_cummulative_probs[n_bin] <- 0
        for ( j in 0 : (k - 1) ) {
            one_sub_cummulative_probs[n_bin] <-
                one_sub_cummulative_probs[n_bin]  +
                (
                    exp( -n_bin * gamma )
                    * ( (n_bin * gamma) ^ j )
                    / factorials[j + 1]    ## factorials[j + 1] = j!
                )
        }
        cummulative_prob <- 1 - one_sub_cummulative_probs[n_bin]
    }
    one_sub_cummulative_probs <- c(1, one_sub_cummulative_probs)

    density_prob <-
        head(one_sub_cummulative_probs, -1) - tail(one_sub_cummulative_probs, -1)
    density_prob <- density_prob / cummulative_prob

    return(density_prob)
}

#' @param initial_state A vector that contains 4 numbers corresponding to the
#'                      initial values of the 4 classes: S, E, I, and R.
#' @param parameters    A vector that contains 5 numbers corresponding to the
#'                      following parameters: the shape and the rate parameters
#'                      of the Erlang distribution that will be used to
#'                      calculate the transition rates between the E components
#'                      (i.e. k[E] and gamma[E]), the shape and the rate parameters
#'                      of the Erlang distribution that will be used to
#'                      calculate the transition rates between the I components
#'                      (i.e. k[I] and gamma[I]), and the base transmission rate
#'                      (i.e. beta).
#' @param max_time      The length of the simulation.
#' @return A data frame containing the values of S, E, I, and R over time
#'         (from 1 to max_time).
seir_simulation <- function(initial_state, parameters, max_time) {
    names(initial_state) <- c("S", "E", "I", "R")
    names(parameters) <- c( "erlang_shape_for_E", "erlang_rate_for_E",
                            "erlang_shape_for_I", "erlang_rate_for_I",
                            "base_transmission_rate" )

    population_size <- sum(initial_state)
    sim_data <- data.frame( time = c(1 : max_time),
                            S = NA, E = NA, I = NA, R = NA )
    sim_data[1, 2:5] <- initial_state

    ## Initialise a matrix to store the states of the exposed sub-blocks over time.
    exposed_block_adm_rates <- compute_erlang_discrete_prob(
        k = parameters["erlang_shape_for_E"],
        gamma = parameters["erlang_rate_for_E"]
    )
    n_exposed_blocks <- length(exposed_block_adm_rates)
    exposed_blocks <- matrix( data = 0, nrow = max_time,
                              ncol = n_exposed_blocks )
    exposed_blocks[1, n_exposed_blocks] <- sim_data$E[1]

    ## Initialise a matrix to store the states of the infectious sub-blocks over time.
    infectious_block_adm_rates <- compute_erlang_discrete_prob(
        k = parameters["erlang_shape_for_I"],
        gamma = parameters["erlang_rate_for_I"]
    )
    n_infectious_blocks <- length(infectious_block_adm_rates)
    infectious_blocks <- matrix( data = 0, nrow = max_time,
                                 ncol = n_infectious_blocks )
    infectious_blocks[1, n_infectious_blocks] <- sim_data$I[1]

    ## Run the simulation from time t = 2 to t = max_time
    for (time in 2 : max_time) {
        transmission_rate <-
            parameters["base_transmission_rate"] * sim_data$I[time - 1] /
            population_size
        exposure_prob <- 1 - exp(-transmission_rate)

        new_exposed <- rbinom(1, sim_data$S[time - 1], exposure_prob)
        new_infectious <- exposed_blocks[time - 1, 1]
        new_recovered  <- infectious_blocks[time - 1, 1]

        if (new_exposed > 0) {
            exposed_blocks[time, ] <- t(
                rmultinom(1, size = new_exposed,
                          prob = exposed_block_adm_rates)
            )
        }
        exposed_blocks[time, ] <-
            exposed_blocks[time, ] +
            c( exposed_blocks[time - 1, 2 : n_exposed_blocks], 0 )

        if (new_infectious > 0) {
            infectious_blocks[time, ] <- t(
                rmultinom(1, size = new_infectious,
                          prob = infectious_block_adm_rates)
            )
        }
        infectious_blocks[time, ] <-
            infectious_blocks[time, ] +
            c( infectious_blocks[time - 1, 2 : n_infectious_blocks], 0 )

        sim_data$S[time] <- sim_data$S[time - 1] - new_exposed
        sim_data$E[time] <- sum(exposed_blocks[time, ])
        sim_data$I[time] <- sum(infectious_blocks[time, ])
        sim_data$R[time] <- sim_data$R[time - 1] + new_recovered
    }

    return(sim_data)
}

sim <- seir_simulation( initial_state = c(S = 9999, E = 1, I = 0, R = 0),
                        parameters = c(5, 1, 10, 1, 0.25),
                        max_time = 300 )

# Plot
ggplot(sim, aes(time)) +
    geom_line(aes(y = S, colour = "Susceptible"), lwd = 1) +
    geom_line(aes(y = E, colour = "Exposed"), lwd = 1) +
    geom_line(aes(y = I, colour = "Infectious"), lwd = 1) +
    geom_line(aes(y = R, colour = "Recovered"), lwd = 1) +
    xlab("Time") + ylab("Number of Individuals")

set.seed(12345)
test_sim <- seir_simulation( initial_state = c(S = 9999, E = 1, I = 0, R = 0),
                        parameters = c(5, 1, 10, 1, 0.25),
                        max_time = 100 )
test_result <- as.matrix( tail(test_sim, 3) )

correct_result <- matrix( c( 98, 7384, 794, 1015, 807,
                             99, 7184, 864, 1068, 884,
                            100, 6986, 920, 1144, 950), nrow = 3, byrow = T )

n_correct_cells <- sum(correct_result == test_result)

cat("\n--------------------\n")
if (n_correct_cells == 15) {
    cat("    Test PASSED\n")
} else {
    cat("    Test FAILED\n")
}
cat("--------------------\n\n")


#### Healthy Neighborhoods Project: Using Ecological Data to Improve Community Health
### Cedric subproject: Developing better ways to measure equity in health
## Florida Charts Census Tract Mortality Data: Code Script by DrewC!

#### Section A: Prepare Code

### Step 1: Import Libraries and Import Dataset

## Open R Terminal
R # open R in VS Code (any terminal)

## Import Standard Libraries
library(tidyverse)
library(skimr)

## Import Machine Learning Libraries
library(randomForest) # Popular random forest package for R

## Import Statistics Libraries
library(MASS) # Stepwise inclusion model with linear and logistic options
library(pROC) # ROC tests with AUC output
library(psych) # Survey analysis library with factor analysis
library(GPArotation) # Rotation options for factor analysis

## Import Data
setwd("C:/Users/drewc/GitHub/HNB") # Set wd to project repository
df_acs = read.csv("_data/flcharts_acs_top3_stage.csv") # Import dataset from _data folder

### Step 2: Prepare Data for Classificaiton

## Resolve missing data
df_acs = df_acs %>% mutate_if(is.factor, as.numeric) # Change character to numeric values
df_acs = na.omit(df_acs) # Omit rows with NA from Data Frame

## Create new column as sum of others
df_acs$Vascular = df_acs$Heart.Diseases + df_acs$Cerebrovascular.Diseases +  df_acs$Essen.Hypertension...Hypertensive.Renal.Dis + df_acs$ Aortic.Aneurysm...Dissection + df_acs$Atherosclerosis  # Create new column based on conditions
df_acs$Metabolic = df_acs$Diabetes.Mellitus + df_acs$Nephritis..Nephrotic.Syndrome..Nephrosis # Create new column based on conditions
df_acs$Cancer = df_acs$In.Situ..Benign..Uncertain.and.Unknown.Behavior.Neoplasms + df_acs$Malignant.Neoplasm.or.Cancer
df_acs = subset(df_acs, select = -c(Heart.Diseases, Cerebrovascular.Diseases, Essen.Hypertension...Hypertensive.Renal.Dis, Aortic.Aneurysm...Dissection, Atherosclerosis, Diabetes.Mellitus, Nephritis..Nephrotic.Syndrome..Nephrosis, In.Situ..Benign..Uncertain.and.Unknown.Behavior.Neoplasms, Malignant.Neoplasm.or.Cancer))

## Change Outcome label
df_acs$outcome = df_acs$Vascular
df_acs = subset(df_acs, select = -c(Cancer, Metabolic, Vascular))

## Verify Data
dim(df_acs) # Dimensions of data frame
glimpse(df_acs)

#### Section B: Vairable Selection using Quantitative and Qualitative Methods

### Step 3: Conduct Factor Analysis to Identify Latent Variables

## Subset by group with outcome
df_fa = subset(df_acs, outcome > 19.430) # Subset for outcome of interest
df_fa = subset(df_fa, select = -c(Tract, State)) # Remove outcome variable
nrow(df_fa) # Check number of rows

## Perform Scree test and loadings
model_scree = fa.parallel(df_fa) # Create scree plot to determine number of latent variables
print(model_scree)

## Write Factor Analysis Output to File
result = model_scree # Save result df to variable
file = file("cedric_flcharts_fa_rf_log_auc_results.txt") # Open result file in subproject repository
open(file, "w") # Open file and "a" to append
write("Eigenvalues from Factor Analysis",  file) # Insert title
write(" ", file) # Insert space below title
capture.output(result, file = file, append = TRUE) # write summary to file
write(" ", file) # Insert space below result
close(file) # Close file

### Step 4: Use a Random Forest to rank variables by importance

## Create a Random Forest
forest = randomForest(formula = outcome ~ ., data = df_plan, ntree = 1000, importance = TRUE) # This will take time
summary(forest) # Summary of forest model

## Tidy Results for Variable Classification
mat_forest = round(importance(forest), 2) # Round importance outcomes to two places,
df_forest = as.data.frame(mat_forest) # Save as data frame
df_forest = rownames_to_column(df_forest)
colnames(df_forest) <- c("Variable", "MSE", "Gini") # Change column names to easily readible. Both values correspond to the summed increse in either Mean Squared Error or Gini as the variable is removed. Both are important and used elsewhere in randomforests (Scikit-learn).
skim(df_forest) # Descritive statistics, dimensions, and missing values

## Create Importance Variable Lists
df_rank = df_forest[which(df_forest$MSE > 8.37 & df_forest$Gini > 9.26), ] # Save all variables with importance value above column average
df_rank = arrange(df_rank, desc(MSE, Gini)) # Descend by variable in data frame
print(df_rank) # Print output

## Write Random Forest Output to File
result = print(df_rank) # Save result df to variable
file = file("risk_yrbs_rf_factor_log_auc_results.txt") # Open result file in subproject repository
open(file, "a") # Open file and "w" to overwrite
write("Random Forest Variable Classification", file) # Insert title
write(" ", file) # Insert space below title
write.table(result, file, quote = FALSE, sep = "   ") # write table of values to filee
write(" ", file) # Insert space below result
close(file) # Close file

## Create list of variables for input
df_quant = df_rank["Variable"]
char_qual = c("qn13", "qn20", "qn24", "qn25", "qn46", "qn47", "qn50", "qn52", "qn58", "qn59", "qn69")
df_qual["Variable"] = char_qual
df_vars = merge(df_quant, df_qual, by = "Variable", all.x = TRUE, all.y = TRUE) # Merge data frames by column, keeping all of X
paste(df_vars$Variable, collapse = " + ") # Paste + into variable string for Mixed-Method variables combing both above lists

## Write Variable Selection Output to File
result1 = print(char_qual) # Save result df to variable
result2 = print(paste(df_vars$Variable, collapse = " + ")) # Save result df to variable
file = file("risk_yrbs_rf_factor_log_auc_results.txt") # Open result file in subproject repository
open(file, "a") # Open file and "w" to overwrite
write("Qualitative variables Selected", file) # Insert space below title
capture.output(result1, file = file, append = TRUE) # write summary to file
write(" ", file) # Insert space below title
write("Mixed Method Variable Selection Results", file) # Insert title
capture.output(result2, file = file, append = TRUE) # write summary to file
write(" ", file) # Insert space below title
close(file) # Close file

#### Section C: Build Regression Model and Risk Score for Validation

### Step 5: Logistic Regression with Stepwise Selection for Final Model

## Create training and validation set
sample = sample.int(n = nrow(df_plan), size = floor(.50*nrow(df_plan)), replace = F) # Create training and testing dataset with 50% split
train = df_plan[sample, ] # Susbset data frame by sample
test = df_plan[-sample, ] # Subset data frame by removing sample

## Perform Logisitc Regression on selected variables
model_logistic = glm(outcome ~ qn13 + qn19 + qn20 + qn23 + qn24 + qn25 + qn40 + qn46 + qn47 + qn50 + qn52 + qn56 + qn58 + qn59 + qn68 + qn69, data = train)
summary(model_logistic)

## Stepwise backward selection
model_back = stepAIC(model_logistic, direction = "backward") # Stepwise backwards selection on model
summary(model_back) # Output model summary and check for variables to remove for final model
qn13 + qn19 + qn20 + qn23 + qn24 + qn25 + qn50 + qn56 + qn68 # Remove variables not included or signficiant in stepwise

## Final Model and AUC Score
model_final = glm(outcome~ qn13 + qn19 + qn20 + qn23 + qn24 + qn25 + qn50 + qn56 + qn68, data = train) # Perform logistic regression model on selected variables on test data
roc_train = roc(model_final$y, model_final$fitted.values, ci = T, plot = T) # Perform ROC test on test data
auc(roc_test) # Print AUC score

## Write Quantitative Selection Model Output to File
result1 = print(summary(model_back)) # Save result df to variable
result2 = print(summary(model_final)) # Save result df to variable
result3 = print(auc(roc_train)) # Save result df to variable
file = file("risk_yrbs_rf_factor_log_auc_results.txt") # Open result file in subproject repository
open(file, "a") # Open file and "a" to append
write("Backwards Stepwise Logistic Regression Model", file) # Insert space below title
write(" ", file) # Insert space below title
write("Final Model for Risk Score", file) # Insert space below title
write(" ", file) # Insert space below title
write("Training Model", file) # Insert space below title
capture.output(result3, file = file, append = TRUE) # write summary to file
write(" ", file) # Insert space below title
close(file) # Close file

### Step 5: Logistic Regression with Stepwise Selection for Final Model

## Develop Risk Score Variable

# Create new column based on conditions
test$hope <- 0 # Add new outcome column and set value to 0
test$hope <- 3.5*test$qn25 + 1.25*test$qn13 + test$qn19 + 1.5*test$qn20 + test$qn23 + test$qn50 + 0.75*test$qn68 + 0.75*test$qn56 + 0.5*test$qn24

## Final Model and AUC Score
model_test = glm(outcome~ hope, data = test) # Perform logistic regression model on selected variables on test data
roc_test = roc(model_test$y, model_test$fitted.values, ci = T, plot = T) # Perform ROC test on test data
auc(roc_test) # Print AUC score

## Write Quantitative Selection Model Output to File
result = print(auc(roc_test)) # Save result df to variable
file = file("risk_yrbs_rf_factor_log_auc_results.txt") # Open result file in subproject repository
open(file, "a") # Open file and "a" to append
write("Hope Score Validation", file) # Insert space below title
capture.output(result, file = file, append = TRUE) # write summary to file
write(" ", file) # Insert space below title
close(file) # Close file


library(ggplot2)
setwd('/home/enrico/Dropbox/STEM/validation/FEIII2016/precision_recall_threshold_curve/')

#this script plots p,r,f as a function of the threshold

data_read <- read.csv('../precision_recall_curve_scores_nostack.csv')
stacking_data_read <- read.csv('stacking_curves/precision_recall_curve_scores_stacking_test_set.csv')

thresholds <- seq(from = 0.01, to = 0.9562069, by = (0.9562069-0.01)/28)

data <- cbind(data_read,thresholds)

ggplot(xlab="Threshold", ylab="") +
  geom_line(data = data, aes(x = thresholds, y = p, colour="p"),size = 3) +
  geom_point(data = data, aes(x = thresholds, y = p), size=3, shape=21, fill="white") +
  geom_line(data = data, aes(x = thresholds, y = r,colour="r"), size = 3) +
  geom_point(data = data, aes(x = thresholds, y = r),  size=3, shape=21, fill="white") +
  #geom_line(data = data, aes(x = thresholds, y = f,colour="f")) +
  #geom_point(data = data, aes(x = thresholds, y = f),size=2, shape=21, fill="white") +
  ylab("")+
  scale_colour_manual(name="Precision-Recall curves",
                    breaks=c("p", "r"),
                    values=c("green", "red"),
                    labels=c("Precision", "Recall"))

data_stacking <- cbind(stacking_data_read,thresholds)

ggplot(xlab="Threshold", ylab="") +
  geom_line(data = data_stacking, aes(x = thresholds, y = p_stack,colour="p_stack")) +
  geom_point(data = data_stacking, aes(x = thresholds, y = p_stack), size=2, shape=21, fill="white") +
  geom_line(data = data_stacking, aes(x = thresholds, y = r_stack,colour="r_stack")) +
  geom_point(data = data_stacking, aes(x = thresholds, y = r_stack),  size=2, shape=21, fill="white") +
  geom_line(data = data_stacking, aes(x = thresholds, y = f_stack,colour="f_stack")) +
  geom_point(data = data_stacking, aes(x = thresholds, y = f_stack),size=2, shape=21, fill="white") +
  ylab("")+
  scale_colour_manual(name="Precision-Recall curves",
                      breaks=c("p_stack", "r_stack", "f_stack"),
                      values=c("green", "red", "blue"),
                      labels=c("Precision", "Recall", "F-measure"))

#estimating the growth speed with a linear fit
indexes_fit <- indexes/100 #rescale to 0-1
fit <- lm(pointstoplot ~ indexes_fit, weights = 1/sds**2) #setting the estimated variances as errors
summary(fit)


plot_variance_plot = function(pc)
{
	pdf(file=paste0(
			"D:\\Facultate\\",
			"Capitole Speciale de Inteligenta Artificiala\\",
			"homework6\\graphs\\Variance Plot.pdf"),
			width=8, height=8)

	comp_names = paste(rep("Comp", length(pc$sdev)), seq(1, length(pc$sdev)))

	barplot(pc$sdev^2, names=comp_names,
		ylab = "Variance",
		main = "Variance Plot")

	dev.off()

}

plot_screeplot = function(pc)
{
	pdf(file=paste0(
			"D:\\Facultate\\",
			"Capitole Speciale de Inteligenta Artificiala\\",
			"homework6\\graphs\\Screeplot.pdf"),
			width=8, height=8)

	plot(pc$sdev^2, type = "l", col="blue",
		xlab = "# Principal Components",
		ylab = "Cumulative Variance",
		main = "Principal Components Screeplot")
	points(pc$sdev^2, pch=16)

	abline(h = 1, col="green", lty=1)
	legend("topright", legend=c("Eigenvalue = 1"),
      	col=c("green"), lty=1, cex=1, bty="n")

	dev.off()
}

plot_cumulative_variance = function(pc)
{
	pdf(file=paste0(
			"D:\\Facultate\\",
			"Capitole Speciale de Inteligenta Artificiala\\",
			"homework6\\graphs\\Cumulative Variance Plot.pdf"),
			width=8, height=8)

	pc_percentages = 100 * cumsum(pc$sdev^2 / sum(pc$sdev^2))
	plot(pc_percentages, col="blue",
		 type="l",
		 xlab = "# Principal Components",
		 ylab = "% of explained variance",
		 main = "Cumulative Variance Plot")
	points(pc_percentages, pch=16)

	dev.off()
}

plot_biplot = function(pc)
{
	pdf(file=paste0(
			"D:\\Facultate\\",
			"Capitole Speciale de Inteligenta Artificiala\\",
			"homework6\\graphs\\Biplot.pdf"),
			width=8, height=8)

	biplot(pc, cex = 0.5)
	abline(h = 0)
	abline(v = 0)

	dev.off()
}

pca = function(centered=T, scaled=F)
{
	data = read.table(
			paste0(
				"D:\\Facultate\\",
				"Capitole Speciale de Inteligenta Artificiala\\",
				"homework6\\data\\swiss.txt"),
			header=T, sep="", dec=".")

	data = scale(data, center=centered, scale=scaled)

	pc = prcomp(data)

	plot_variance_plot(pc)
	plot_screeplot(pc)
	plot_cumulative_variance(pc)
	plot_biplot(pc)

	pc_eigen_var = pc$sdev^2
	pc_eigen_gt_1 = length(pc_eigen_var[pc_eigen_var > 1])
	eigenvectors = t(pc$rotation)
	sd_variables = diag(var(data))
	sd_pc = pc$sdev
	loadings = (eigenvectors / sd_variables) * sd_pc

	print("Eigenvectors:")
	print(eigenvectors)
	print("Correlation Coefficients:")
	print(loadings[seq(1, pc_eigen_gt_1),])
}


# Correlation Analysis
#
# Author: Jiamao Zheng (jiamaoz@yahoo.com) 02/18/2018
#
# Rscript run_correlation.r
#
##

# install.packages('data.table')
# install.packages('dplyr')
# install.packages('tidyr)
# install.packages('ggplot2')
# install.packages('ggpmisc)
suppressWarnings(suppressMessages(library(data.table)))
suppressWarnings(suppressMessages(library(dplyr)))
suppressWarnings(suppressMessages(library(tidyr)))
suppressWarnings(suppressMessages(library(ggpmisc)))
suppressWarnings(suppressMessages(library(ggplot2)))

# setwd('~/Dropbox/Im_lab/2018/lab_session/HGEN47100Lab_2018-02-23/src/')

# arg variables
argv <- commandArgs(trailingOnly = TRUE)
gene_numbers <- argv[1]
if (length(argv) >1) {
  print('warning: only one numeric argument (e.g. 18 ) is allowed, or no argument by default!')
  break
}

# predicted gene expression
print('load predicted gene expression..')
predictedExpression <- fread('../results/predixcan_results/geuvadis_predicted_expression.txt') %>%
  gather(TargetID, predicted_expression, -FID, -IID) %>%
  select(TargetID, FID, predicted_expression)

# observed gene expression
print('load observed gene expression..')
observedExpression <- fread('zcat < ../datasets/GD462.GeneQuantRPKM.50FN.samplename.resk10.txt.gz') %>%
  select(-Gene_Symbol, -Chr, -Coord) %>%
  gather(FID, observed_expression, -TargetID)

# join between predicted and observed gene expression
print('join predicted and observed gene expression..')
joined <- predictedExpression %>%
  inner_join(observedExpression, by=c('TargetID', 'FID'))

gene_anno <- fread('zcat < ../datasets/gencode.v12.annotation.gtf.gz') %>% # get ensemble_id and gene symbol pair
  filter (V3=='gene') %>% filter(V1 != 'chrX' & V1 != 'chrY' & V1 != 'chrM') %>%
  select(V2, V3, V9) %>%
  rowwise() %>%
  mutate(V2=strsplit(gsub("\"", "", strsplit(V9, ';')[[1]][5]), ' ')[[1]][3]) %>%
  mutate(V3=strsplit(gsub("\"", "", strsplit(V9, ';')[[1]][1]), ' ')[[1]][2]) %>%
  select(V3, V2) %>%
  distinct(V2, .keep_all = TRUE)
colnames(gene_anno) = c('TargetID', 'gene_symbol')
joined <- joined %>% inner_join(gene_anno, by=c('TargetID')) %>% select(gene_symbol, FID, predicted_expression, observed_expression)  # replace ensemble_id with gene_symbol

# correlation plots for all genes
if (length(argv) == 0) {
    genes <- unique(joined$gene_symbol)
} else if (length(argv) == 1) {
    if (as.numeric(gene_numbers) > length(unique(joined$gene_symbol))) {
       print(paste('warning: please enter a number less than ', length(unique(joined$gene_symbol)), sep=''))
       break
    } else {
       genes <- unique(joined$gene_symbol)[1:gene_numbers]
    }
}
summary_table <- data.frame()

for (gene in genes){
  print(paste('plot ../results/correlations/', gene, '.png',sep=''))
  filtered <- joined %>% filter(gene_symbol==gene)
  my.formula <- filtered$predicted_expression ~ filtered$observed_expression
  p <- ggplot(data=filtered, aes(x=predicted_expression, y = observed_expression)) +
       geom_point() +
       labs(title= gene, x="Predicted expression", y=paste("Observed expression")) +
       geom_smooth(method='lm', se=FALSE, color="red") +
       stat_poly_eq(formula = my.formula, aes(label = paste( ..rr.label.., sep = "~~~")), parse = TRUE, size = 8) +
       theme(axis.title.x = element_text(size=12, face='bold'),
             axis.title.y=element_text(size=12, face='bold'),
             title = element_text(size=12, face='bold')
    )
  # output plots
  ggsave(paste('../results/correlations/', gene, '.png',sep=''), width=8, height=8)

  # r2 and pvalue
  cortest <- cor.test(filtered$observed_expression, filtered$predicted_expression, method = "kendall", alternative = "greater")
  r2=summary(lm(my.formula, filtered))$r.squared
  summary_table = rbind(summary_table, t(data.frame(c(gene, r2, cortest$p.value))))
}

# output summary table
print('output all genes r2 and pvalue to ../results/correlations/summary_correlation.csv')
colnames(summary_table) = c('gene_symbol', 'r2', 'pvalue')
write.csv(summary_table, file='../results/correlations/summary_correlation.csv', row.names=F)

print('Done!')


require(PEB)

local({

	# ------------------------------------------------------------
	# well tested functions taken from
	# r:\Urban_N\Rivkin\NovelMarkers\Common_Files\Programs\Quality_Control\NMT\ PEB\ QC\ functions.r
	# ------------------------------------------------------------

	ppeb2 <- function(x,mu,sig,tau,n,ybar){
	# this peb function calculates the PEB in line, which is to say
	# that it assumes that n and ybar have been calculated and
	# are appropriate for the current value x
		bn <- tau/((sig/n) + tau)
		yn_hat <- mu*(1-bn) + ybar*bn
		vn_hat <- sig + (tau*(1-bn))
		z <- (x - yn_hat)/sqrt(vn_hat)
		p <- pnorm(z)
		return(p)
	}

	qpeb2 <- function(p,mu,sig,tau,n,ybar){
		# this peb function calculates quantiles for the PEB in line, which is to say
		# that it assumes that n and ybar have been calculated and
		# are appropriate for the current value quantile
		bn <- tau/((sig/n) + tau)
		yn_hat <- mu*(1-bn) + ybar*bn
		vn_hat <- sig + (tau*(1-bn))
		return(yn_hat + qnorm(p)*sqrt(vn_hat))
	}

	# ------------------------------------------------------------
	# load the PEB package
	# ------------------------------------------------------------

	nvalidations <- 100
	for(i in 1:nvalidations){
		if(!(i %% ceiling(nvalidations/10)))
		cat('i =',i,'\n')

		x <- rnorm(10)
		(tmp <- PEB::ppeb(x,mu=0,sigma=1,tau=0.5,details=T))

		# validate the PEB p-value calculations
		stopifnot(all(abs(tmp$p - ppeb2(x,
										mu=0,
										sig=1,
										tau=0.5,
										n=tmp$n,
										ybar=tmp$ybar) )< 1E-15))

		# validate the PEB threshold calculations
		p <- runif(1)
		PEB::qpeb(p,mu=0,sigma=1,tau=0.5,n=tmp$n,ybar=tmp$ybar)
		stopifnot(all(abs(PEB::qpeb(p,mu=0,sigma=1,tau=0.5,n=tmp$n,ybar=tmp$ybar) -
						  qpeb2(p,
								mu=0,
								sig=1,
								tau=0.5,
								n=tmp$n,
								ybar=tmp$ybar) )< 1E-15))

	}

})


# Plotting the Predictors

# Wages.

library(ISLR); library(ggplot2); library(caret);
data(Wage)
summary(Wage)

# Get training/test sets

inTrain <- createDataPartition(y=Wage$wage,
                               p=0.7, list=FALSE)
training <- Wage[inTrain,]
testing <- Wage[-inTrain,]
dim(training); dim(testing)

#Feature plot (caret package)

featurePlot(x=training[,c("age","education","jobclass")],
            y = training$wage,
            plot="pairs")

#Qplot (ggplot2 package)

qplot(age,wage,data=training)

#Qplot with color (ggplot2 package)

qplot(age,wage,colour=jobclass,data=training)

#Add regression smoothers (ggplot2 package)

qq <- qplot(age,wage,colour=education,data=training)
qq +  geom_smooth(method='lm',formula=y~x)

#cut2, making factors (Hmisc package)

cutWage <- cut2(training$wage,g=3)
table(cutWage)

#Boxplots with cut2

p1 <- qplot(cutWage,age, data=training,fill=cutWage,
            geom=c("boxplot"))
p1

#Boxplots with points overlayed

p2 <- qplot(cutWage,age, data=training,fill=cutWage,
            geom=c("boxplot","jitter"))
grid.arrange(p1,p2,ncol=2)

#Tables

t1 <- table(cutWage,training$jobclass)
t1
prop.table(t1,1)

#Density plots

qplot(wage,colour=education,data=training,geom="density")

# Made with and for training of Data on :

#plots only in the training set
#useing the test set for exploration!

#Imbalance in outcomes/predictors
#Outliers
#Groups of points not explained by a predictor
#Skewed variables

## in dept ploting provided by:
#ggplot2 tutorial
#caret visualizations


library(jsonlite)
library(ggplot2)
library(dplyr)

fromJSON("hsdata.json")$confirmed %>% mutate(date=as.POSIXct(date)) -> conf
count(conf, date, name="dn") %>% arrange(date) %>%
    mutate(n=cumsum(dn),
           days=as.double(difftime(date, date[1], units="d"))) -> conf.agg

#d.new <- "2020-03-12"
d.new <- "2020-03-28"
conf.new <- filter(conf.agg, date >= d.new)
conf.lm <- lm(log10(n) ~ days, conf.new)
conf.lm10 <- 10^(conf.lm$coefficients)
conf.lm2 <- lm(n ~ days, conf.new)

fromJSON("hsdata.json")$deaths %>% mutate(date=as.POSIXct(date)) -> dead
count(dead, date, name="dn") %>% arrange(date) %>%
    mutate(n=cumsum(dn),
           days=as.double(difftime(date, date[1], units="d"))) -> dead.agg

dd.new <- "2020-03-31"
dead.new <- filter(dead.agg, date >= dd.new)
dead.lm <- lm(log10(n) ~ days, dead.new)
dead.lm10 <- 10^(dead.lm$coefficients)
dead.lm2 <- lm(n ~ days, dead.new)

pdf("hs.pdf", title="HS")
print(qplot(days, n, data=conf.agg)
      + scale_y_log10() + annotation_logticks(sides="l")
      + geom_abline(slope=log10(1.1), intercept=0)
      + geom_abline(slope=log10(1.15), intercept=0, col="blue")
      + geom_abline(slope=log10(1.3), intercept=0, col="red")
      + geom_vline(xintercept=difftime(d.new, conf.agg$date[1], units="d"),
                   linetype="dotted")
      + ggtitle("Havaitut tartunnat; lähde: HS",
                subtitle=paste("Kasvusuorat 10, 15 ja 30 % / d.  Alkaa ",
                               conf.agg$date[1], ", raja ",
                               d.new, ", uusin ",
                               conf.agg$date[nrow(conf.agg)],
                               sep="")))
print(qplot(days, n, data=conf.new)
      + scale_y_log10() + annotation_logticks(sides="l")
      + geom_abline(slope=conf.lm$coefficients[2],
                    intercept=conf.lm$coefficients[1])
      + ggtitle("Havaitut tartunnat",
                subtitle=paste("Kasvu", 100 * (conf.lm10["days"] - 1),
                               "% / d alkaen", d.new)))
print(qplot(date, n, data=conf.new)
      + geom_smooth(method="lm")
      + ggtitle("Havaitut tartunnat",
                subtitle=paste("Kasvu", conf.lm2$coefficients["days"], "/ d")))

print(qplot(days, n, data=dead.agg)
      + scale_y_log10() + annotation_logticks(sides="l")
      + geom_abline(slope=log10(1.1), intercept=0)
      + geom_abline(slope=log10(1.15), intercept=0, col="blue")
      + geom_abline(slope=log10(1.3), intercept=0, col="red")
      + geom_vline(xintercept=difftime(dd.new, dead.agg$date[1], units="d"),
                   linetype="dotted")
      + ggtitle("Kuolleet",
                subtitle=paste("Kasvusuorat 10, 15 ja 30 % / d.  Alkaa ",
                               dead.agg$date[1], ", raja ",
                               dd.new, ", uusin ",
                               dead.agg$date[nrow(dead.agg)],
                               sep="")))
print(qplot(days, n, data=dead.new)
      + scale_y_log10() + annotation_logticks(sides="l")
      + geom_abline(slope=dead.lm$coefficients[2],
                    intercept=dead.lm$coefficients[1])
      + ggtitle("Kuolleet",
                subtitle=paste("Kasvu", 100 * (dead.lm10["days"] - 1),
                               "% / d alkaen", dd.new)))
print(qplot(date, n, data=dead.new)
      + geom_smooth(method="lm")
      + ggtitle("Kuolleet",
                subtitle=paste("Kasvu", dead.lm2$coefficients["days"], "/ d")))
dev.off()

summary(conf.lm)
summary(conf.lm2)

summary(dead.lm)
summary(dead.lm2)


# Reading in data
ds = read.csv('Mall_Customers.csv')
X = ds[,4:5]

# Creating dendrogram to choose k
hc = hclust(dist(X, method = "euclidean"), method = "ward.D")

plot(hc, labels = FALSE, hang = 0.03,
     main = paste("Cluster Dendrogram"),
     xlab = 'Customers',
     ylab = "Euclidean distance")

# Clustering
y_hc = cutree(hc, 5)

plot(X, col = y_hc)


for (n in 1:100)
{
   if (n %% 3 == 0 & n %% 5 == 0)
   {
       print("FizzBuzz")
   }
   else if (n %% 3 == 0)
   {
       print("Fizz")
   }
   else if (n %% 5 == 0)
   {
       print("Buzz")
   }
 else print(n)
}


#' diag
#'
#' Methods for getting the diagonal of a float matrix, or constructing a float
#' matrix given a float vector.
#'
#' @param x
#' A float vector (create a diagonal matrix) or matrix (get its diagonal).
#' @param nrow,ncol
#' As in base R's \code{diag()}.
#'
#' @return
#' A float vector or matrix, depending on the input.
#'
#' @examples
#' library(float)
#'
#' s = flrunif(10, 3)
#' s
#' diag(s)
#' diag(diag(s))
#'
#' @name diag
#' @rdname diag
NULL

#' @rdname diag
#' @export
setMethod("diag", signature(x="float32"),
  function(x = 1, nrow, ncol)
  {
    if (missing(nrow) && missing(ncol))
      Data = diag(DATA(x))
    else
      Data = diag(DATA(x), nrow, ncol)

    if (is.double(Data))
      storage.mode(Data) = "integer"

    x@Data = Data
    x
  }
)


#   __      _____             _              __        _
# <(o )___ |  _  |___ ___ ___| |_ ___ ___   |  |   ___| |_ ___
# ( ._> /  |   __|  _| -_|_ -|  _| -_|_ -|  |  |__| .'| . |_ -|
#  `---'   |__|  |_| |___|___|_| |___|___|  |_____|__,|___|___|
#==============================================================================
# Plotting Survival Curves
#==============================================================================
# Title          : Plotting Survival Curves.r
# Description    : Survival Curves related plotting using {ggplot2} and
#                  {ggfortify}.
# Author         : Isaias V. Prestes <isaias.prestes@gmail.com>
# Date           : 20180304
# Version        : 0.0.1
# Usage          : Run in R 3.4
# Notes          : Original http://rpubs.com/sinhrks/plot_surv
# R version      : 3.4
#==============================================================================

# install.packages('ggfortify')
# install.packages('survival')

#==============================================================================
# LIBRARY DEPENDENCE
#==============================================================================
library(ggfortify)
library(survival)

#==============================================================================
# Cox Models
#==============================================================================
d.coxph <- survfit(coxph(Surv(time, status) ~ sex, data = lung))

windows()
autoplot(d.coxph, surv.linetype = 'dashed', surv.colour = 'blue',
		conf.int.fill = 'dodgerblue3', conf.int.alpha = 0.5, censor = FALSE)
windows()
autoplot(aareg(Surv(time, status) ~ age + sex + ph.ecog, data = lung))

#==============================================================================
# Non-Parametric Models
#==============================================================================
fit <- survfit(Surv(time, status) ~ sex, data = lung)
autoplot(fit)

windows()
autoplot(fit, surv.linetype = 'dashed', conf.int = FALSE,
         censor.shape = '*', censor.size = 5, facets = TRUE, ncol = 2)

windows()
autoplot(survfit(Surv(time, status) ~ 1, data = lung), surv.colour = 'orange',
		censor.colour = 'red')

autoplot(survfit(Surv(time, status) ~ sex, data = lung), fun = 'event')

# EOF


### sparkR init for Rstudio ###
### taken from the official documentation: ###
### https://spark.apache.org/docs/latest/sparkr.html#starting-up-from-rstudio ###

if (nchar(Sys.getenv("SPARK_HOME")) < 1) {
  Sys.setenv(SPARK_HOME = "/usr/local/spark")
}
library(SparkR, lib.loc = c(file.path(Sys.getenv("SPARK_HOME"), "R", "lib")))

sparkR.session(master = "local[*]", sparkConfig = list(spark.driver.memory = "2g"))

library(ggplot2)

###########################################################################
############################## EVENTS #####################################
events_schema <- structType(structField("timestamp","string"),structField("visitorid","string"),structField("event","string"),structField("itemid","string"),structField("transactionid","integer"))

#read events.csv
events <- read.df("/home/myrto/Documents/bigData/datasets/events.csv",source="csv",header="true",delimiter=",", na.strings="NA",schema = events_schema)

### get statistics for events ###
createOrReplaceTempView(events,"events_table")
cacheTable("events_table")
head(sql("SELECT count(*) FROM events_table"))
head(sql("SELECT count(distinct visitorid) FROM events_table"))
head(sql("SELECT count(distinct itemid) FROM events_table"))

events_per_user <- sql("SELECT visitorid, count(*) as counted_events from events_table GROUP BY visitorid")
createOrReplaceTempView(events_per_user,"per_user_event")
cacheTable("per_user_event")
head(sql("select avg(counted_events) from per_user_event"))
head(sql("select max(counted_events) from per_user_event"))
head(sql("select count(counted_events) from per_user_event where counted_events > 1"))
head(sql("select count(counted_events) from per_user_event where counted_events > 10"))

events_per_user_r_df <- collect(events_per_user)

uncacheTable("events_table")
uncacheTable("per_user_event")

sd(events_per_user_r_df$counted_events)
median(events_per_user_r_df$counted_events)
counted_event_su <- scale(events_per_user_r_df$counted_events)
events_per_user_r_df["standard_units"] <- counted_event_su
events_per_user_plot <- ggplot(events_per_user_r_df, aes(x=standard_units)) + geom_histogram(binwidth=.5, colour="black", fill="white") + coord_cartesian(xlim = c(-4, 4))

# events <- withColumn(events, "timestamp", from_unixtime(events$timestamp/1000))
events_r_df <- collect(events)
events$timestamp <- as.POSIXct(as.numeric(events_r_df$timestamp)/1000,origin='1970-01-01')
eventsPerDay <- data.frame("dayOfTheWeek"=weekdays(as.Date(as.character(events_r_df$timestamp,"%Y-%m-%d"))), "timestamp"=events_r_df$timestamp, "visitorid"=events_r_df$visitorid, "event" = events_r_df$event, "itemid" = events_r_df$itemid)
daysVector <- c("Δευτέρα", "Τρίτη", "Τετάρτη", "Πέμπτη", "Παρασκευή", "Σάββατο", "Κυριακή")

library(plyr)
eventsPerWeekday <- count( eventsPerDay, c("dayOfTheWeek"))
eventsPerWeekday$dayOfTheWeek <- factor(eventsPerWeekday$dayOfTheWeek, levels = daysVector)
eventsPerWeekdayPlot <- ggplot(eventsPerWeekday,aes(x=dayOfTheWeek,y=freq/100))+geom_bar(stat='identity', fill="#66CCFF")+xlab("")+ylab("Counted events (in thousands)")

###########################################################################
############################ PROPERTIES ###################################
item_prop_schema <- structType(structField("timestamp","string"),structField("itemid","string"),structField("property","string"),structField("value","string"))
item_properties <- read.df("/home/myrto/Documents/bigData/datasets/item_properties_part1.csv",source="csv",header="true",schema = item_prop_schema)
item_properties_2 <- read.df("/home/myrto/Documents/bigData/datasets/item_properties_part2.csv",source="csv",header="true",schema = item_prop_schema)

#union the 2 dataframes
item_properties = union(item_properties,item_properties_2)

#convert unix epoch timestamp to datetime string in a new dataframe
item_props_with_ts <- withColumn(item_properties, "ts", from_unixtime(item_properties$timestamp/1000))
createOrReplaceTempView(item_props_with_ts,"properties_table")
head(sql("select count(*) from properties_table"))
distinct_item_prop_values <- sql("select itemid, property, value from properties_table group by itemid, property, value")
createOrReplaceTempView(distinct_item_prop_values,"distinct_properties")
cacheTable("distinct_properties")
head(sql("select count(*) from distinct_properties"))
head(sql("select count(distinct itemid) from distinct_properties"))
head(sql("select count(distinct property) from distinct_properties"))
#head(sql("select itemid, count(distinct(property)) from distinct_properties group by itemid order by itemid"))

###########################################################################
############################ CATEGORIES ###################################
#cats_ancestors_schema <- structType(structField("categoryid","string"),structField("ancestorid","string"))

#read properties csvs
#cats_ancestors_df <- read.df("/media/myrto/Files/Documents/Master/DI UOA/BigData/project/exported_csv/ancestor_per_catid.csv",source="csv",header="true",schema = cats_ancestors_schema)

#read category_tree.csv
category_tree <- read.df("/media/myrto/Files/Documents/Master/DI UOA/BigData/project/Retailrocket_recom_sys_dataset/category_tree.csv",source="csv",header="true",inferSchema="true")
createOrReplaceTempView(category_tree,"categories_table")
#get parent categories
head(sql("SELECT count(*) FROM categories_table"))
head(sql("SELECT count(distinct categoryid) FROM categories_table"))
head(sql("SELECT count(*) FROM categories_table WHERE isNull(parentid)"))

###########################################################################
################## OTHER COMBINATIONS AND TESTS ###########################

items_in_events <- sql("SELECT distinct(itemid) FROM events_table")
createOrReplaceTempView(items_in_events,"items_table")

#get items with category from properties
items_with_category <- sql("SELECT itemid,value from properties_table WHERE property LIKE 'categoryid'")

createOrReplaceTempView(items_with_category,"item_cats_from_properties")
createOrReplaceTempView(items_in_events,"used_items_table")
items_in_events_categories <- sql("SELECT distinct(i.itemid) as itemid,p.value FROM used_items_table i, item_cats_from_properties p WHERE i.itemid=p.itemid")

#get parent items ###NOT NEEDED###
createOrReplaceTempView(items_in_events_categories,"used_items_cats")
createOrReplaceTempView(parent_categories,"parents_table")
parent_items <- sql("SELECT itemid,value FROM used_items_cats WHERE value IN(SELECT * FROM parents_table)")

createOrReplaceTempView(cats_ancestors_df, "categories_with_ancestors")

#get items and their general categories per time
used_items_categories <- sql("SELECT e.itemid, e.timestamp, c.ancestorid FROM events e, item_cats_from_properties p, categories_with_ancestors c WHERE e.itemid=p.itemid AND p.property LIKE 'categoryid' AND p.value=c.categoryid")

#get weighted property values per item per event
props_per_event <- sql("SELECT e.timestamp, e.itemid, e.visitorid, i.property, max( ( 86400000/(e.timestamp-i.timestamp)) ) as weight FROM events_table e, properties_table i WHERE e.itemid=i.itemid AND i.property NOT IN('categoryid','available') AND i.timestamp < e.timestamp GROUP BY e.timestamp, e.itemid, e.visitorid, i.property")

## new events schema that includes 'implicit ratings' ##
events_with_ratings_schema <- structType(structField("timestamp","string"),structField("visitorid","string"),structField("event","string"),structField("itemid","string"),structField("transactionid","integer"), structField("eventRating","double"))

## lambda expression on events to create the new column according to event type [map-like function called dapply]
events_with_ratings <- dapply(events, function(x) { x <- { a <- 0.0
	if (x$event == "view") {
		a = 0.3
	} else if (x$event == "addtocart") {
		a = 0.7
	} else {
		a = 1.0
	}
	cbind(x, a ) }
	}, events_with_ratings_schema)

createOrReplaceTempView(events_with_ratings, "events_with_ratings_table")


#' From + To 2 DV
#'
#' \code{fromTo2DV} creates a list Descision variables
#'
#' @param from a vector of names of the "From" variables
#' @param to a vector of names of the To" variables
fromTo2DV = function(from, to) {

  l1 = length(from)
  l2 = length(to)
  vars = vector(mode = "character", length = (l1*l2))

  p = 1
  for(i in 1:l1) {
    for(j in 1:l2) {
      vars[p] = sprintf("%s%s", from[i], to[j])
      p = p + 1
    }
  }

  return(vars)
}

#' Capacity Requirments
#'
#' \code{CapacityRequirments} generates a all the capacity requirments
#' variables, assuming the DVs are in the order generated by
#' \link{\code{fromTo2DV}}
CapacityRequirments = function(from, to) {

  res = matrix(0, nrow=from, ncol = (from*to))

  for(i in 1:from) {
    for(j in 1:to) {
      res[i,(i-1)*to+j] = 1
    }
  }

  if(!all(rowSums(res) == to)) { warning("Double check failed") }

  return(res)
}

DemandRequirments = function(from, to) {

  res = matrix(0, nrow=to, ncol = (from*to))

  for(i in 1:to) {
    v = rep_len(0,to)
    v[i] = 1
    res[i,] = rep_len(v, from*to)
  }

  if(!all(rowSums(res) == from)) { warning("Double check failed") }

  return(res)
}

IdMat = function(dim) {

  res = matrix(0, nrow=dim, ncol = dim)

  for(i in 1:dim) {
    res[i,i] = 1
  }

  return(res)
}

LinkRequirments = function(direction, from, to, M) {

  res = if(direction == "from") { CapacityRequirments(from, to) } else { DemandRequirments(from,to) }
  d = dim(res)
  pad = IdMat(d[1])*-M

  res = cbind(pad, res)

  return(res)
}


#reshaping data is comon task in data analysis
#data reshaping involves rearrangement of the form, not the contents of the data
#for the purpose of reshaping we divide vars. in 2 groups. 1st is identifier.
#these vars. identify the unit of measurements that take place on they are ususally decrete and fixed by design
#2nd is measured variable: represents what is measured on that unit.

#melting and casting in R
#reshape package is used under there are 2 func. melt() and cast()
#1.melt() : it takes data in wide format and stacks a set of cols. into a single col. data.
#the arguments to this fun. are data.frame(), id vars. and measured vars.
#e.g : install reshape package use data ships apply function melt() id var = type and year

library(reshape)
library(MASS)
data = head(ships,n=10)
var=melt(data,id=c("type","year"))
var

#aggreagation occures whenthe combination of the variables in the cast function does not idenify individual observations
#in this case cast function() reduces multiple values to a single value by suming up the vals in the value column
#e.g :

var1 = cast(var, type+year~variable,sum)
var1

library(reshape2)
dataf = head(airquality, n=20)
dataf
variable=melt(dataf,id.vars =c("Month","Day"))
variable

variable1 = dcast(variable, Month+Day~variable,sum)
variable1

#in reshape2 package melt takes wide format data and converts it into long format data
#while cast take long format data and converts it into wide format data

#e.g : use reshape2 package
#1. consider mtcars convert into long format by setting id var to cyl and gear
#2. convert dataset to wide format by using mean as aggreagation function

df = head(mtcars, n=20)
df
var=melt(df,id.vars =c("cyl","gear"))
var

var1 = dcast(var, cyl+gear~variable,mean)
var1

var2 = acast(var,cyl+gear~variable, mean)


# 4. faza: Analiza podatkov

#podatki <- obcine %>% transmute(obcina, povrsina, gostota,
#                                gostota.naselij=naselja/povrsina) %>%
#  left_join(povprecja, by="obcina")
#row.names(podatki) <- podatki$obcina
#podatki$obcina <- NULL

# Število skupin
#n <- 5
#skupine <- hclust(dist(scale(podatki))) %>% cutree(n)
#

prileganje <- lm(data = izpust, izpusti ~ Leto)

l <- data.frame(Leto=seq(2018, 2025, 1))

napoved <- mutate(l, izpusti=predict(prileganje, l))
napoved

graf_regresija1 <- ggplot(izpust, aes(x=Leto, y=izpusti)) + geom_line() +
  geom_smooth(method='lm', formula=y ~ poly(x,2,raw=TRUE), fullrange=TRUE, color='green') +
  scale_x_continuous('Leto', limits = c(2008,2023))+
  ylab('Indeksi izpusta toplogrednih plinov (referenčno leto 2010)')+
  ggtitle('Napoved izpusta toplogrednih plinov v Mg do leta 2013')
graf_regresija1

graf2

tabela_analiza <- tabela1 %>% dplyr::select(1,4)
tabela_analiza <- tabela_analiza %>% rename('bdp'='BDP')
tabela_analiza
tabela_analiza$'izpusti' <- izpust$izpusti
tabela_analiza

graf_regresija2 <- ggplot(tabela_analiza, aes(x=Leto, y=bdp)) + geom_point() +
  geom_smooth(method='lm', formula=y ~ poly(x,2,raw=TRUE), fullrange=TRUE, color='blue') +
  scale_x_continuous('Leto', limits = c(2010,2023))+
  ylab('Indeksi rasti BDP-ja (referenčno leto 2010)')+
  ggtitle('Napoved rasti BDP-ja do leta 2013')

graf_regresija2


# H0: None == Triple
# Compare means with one-way ANOVA

## Bloom
data <- read.csv('../../results/filter_types/plot_all.csv', sep = ';')
#t.test(data$combination_0, data$combination_2,paired=TRUE)
kruskal.test(combination_2 ~ combination_3, data = data)
# p: 0.3246
# => Accept H0, equal means
mean(data$combination_0) # 12500.69
mean(data$combination_2) # 12284.03
# None == Triple !

## GCS
data <- read.csv('../../results/filter_types/plot_all.csv', sep = ';')
#t.test(data$combination_1, data$combination_3,paired=TRUE)
# p: 0.09381
# => Accept H0, equal means
#mean(data$combination_1) # 13250.39
#mean(data$combination_3) # 12582.91
# None == Triple !


require(ez)
require(permuco)
require(dplyr)
require(afex)
setwd("C:/Users/ACH/Documents/fearmem")
#setwd('/Users/ach3377/Documents/fearmem')

df <- read.csv('cleaned_corrected_recognition.csv')
str(df)
df$subject <- as.factor(df$subject)

full.form <- cr ~ group * condition * encode_phase + Error(subject/(condition*encode_phase))
full.aov <- aovperm(full.form,df,np=10000)
summary(full.aov)
ezANOVA(df,dv=cr,wid=subject,within=.(condition,encode_phase),between=.(group))

collapse.form <- cr ~ condition * encode_phase + Error(subject/(condition*encode_phase))
collapse.aov <- aovperm(collapse.form,df,np=10000)
select(collapse.aov$table, dfn, dfd, F, "permutation P(>F)")
ezANOVA(df,dv=cr,wid=subject,within=.(condition,encode_phase))

#source memory
df <- read.csv('cleaned_avg_sm.csv')
str(df)
df$subject <- as.factor(df$subject)

full.source.form <- prop ~ group * response_phase * condition * encode_phase + Error(subject/(response_phase * condition * encode_phase))
full.source.aov <- aovperm(full.source.form,df,np=10000)
summary(full.source.aov)
ezANOVA(df,dv=prop,wid=subject,within=.(condition,encode_phase,response_phase),between=.(group))

collapse.source.form <- prop ~ response_phase * condition * encode_phase + Error(subject/(response_phase * condition * encode_phase))
collapse.source.aov <- aovperm(collapse.source.form,df,np=10000)
select(collapse.source.aov$table, dfn, dfd, F, "permutation P(>F)")
ezANOVA(df,dv=prop,wid=subject,within=.(condition,encode_phase,response_phase))

#subset baseline
baseline = df[with(df,encode_phase == 'baseline'),]
extinction = df[with(df,encode_phase == 'extinction'),]

phase.form <- prop ~ group * condition * response_phase + Error(subject/(condition*response_phase))
mem.form <- mem_prop ~ group * condition * response_phase + Error(subject/(condition*response_phase))

prop.res <- aovperm(phase.form,extinction,np=10000) #change data here
mem.res <- aovperm(mem.form,extinction,np=10000) #change data here

#regular anovas here for typicality
df <- read.csv('cleaned_avg_ty.csv')
ty_aov <- ezANOVA(df,dv=.(typicality),wid=.(subject),within=.(condition,encode_phase))
#ty_aov <- ezANOVA(df,dv=.(typicality),wid=.(subject),within=.(condition),between=.(group))

#typicality & source memory lmms
set_sum_contrasts()

df <- read.csv('cleaned_full_sm.csv')

typ.mod <- mixed(typicality ~ condition*source_memory*encode_phase + (1|subject), data=df, REML=FALSE, method="LRT")#, test_intercept=TRUE)
summary(typ.mod)
anova(typ.mod)
typ.comp <- emmeans(typ.mod, pairwise ~ source_memory)
summary(typ.comp)


#  James Rekow

computeUnivWithinSSTEST  = function(abdList, rollRange = 0.025){

  #  ARGS:
  #
  #  RETURNS:

  source("computeInfoWeightMat.r")

  #  compute matrix of info weights
  infoMat = computeInfoWeightMat(abdList = abdList, rollRange = rollRange)

  meanInfoVec = apply(infoMat, 2, mean)

  squaredDistanceFromMean = function(infoVec) sum((infoVec - meanInfoVec) ^ 2)

  seVec = apply(infoMat, 2, squaredDistanceFromMean)
  sse = sum(seVec)

  # normalizedSeVec = seVec / max(seVec)
  #
  # sse = mean(normalizedSeVec)

  # sse = - mean(infoMat[infoMat < 0]) / mean(infoMat[infoMat > 0])

  # M = nrow(infoMat)
  # signMat = matrix(sample(c(-1, 1), M * M, replace = TRUE), nrow = M)
  # newInfoMat = infoMat * signMat
  #
  # newMeanInfoVec = apply(newInfoMat, 2, mean)
  #
  # newSquaredDistanceFromMean = function(infoVec) sum((infoVec - newMeanInfoVec) ^ 2)
  #
  # newSeVec = apply(newInfoMat, 2, newSquaredDistanceFromMean)
  # newSse = sum(newSeVec)
  #
  # sse = sse / newSse

  # sse = sum(infoMat < 0) / sum(infoMat > 0)

  # sse = sse / sum(infoMat[infoMat > 0])

  #  divide by M ^ 1.5 to try and "normalize" out the effect M has on sse, only capturing effect of univ.
  #  If we consider the rows of infoMat as M dimensional vectors that are random perturbations of their
  #  mean vector, then the expected sse should be roughly proportional to c * M ^ 1.5, for some constant
  #  c. This is because each vector v has M dimensions, and if we suppose the difference between each
  #  component of v and the corresponding component of the mean vector is roughly equal to a constant,
  #  call it e, then the squared error of ## should be eM, which ends with M ^ 2, not sure how to explain
  #  this after all ## v is sqrt(M * e ^ 2) = e * sqrt(M). There are M such vectors,
  #  so summing these squared errors will give a dependence of M * sqrt(M) = M ^ 1.5. Squared error is
  #  sum((v - mv) ^ 2), where v is a row vector of infoMat and mv is the vector mean of all such row
  #  vectors.
  M = length(abdList)
  sse = sse / {M ^ 1.5}

  #  crit value appears to be ~0.185

  return(sse)

} #  end  computeUnivWithinSSTEST function


getPerformance = function(pred , val) {
  	res = pred - val
  	MAE = sum(abs(res)) / length(val)
  	RSS = sum(res^2)
  	MSE = RSS / length(val)
  	RMSE = sqrt(MSE)
  	R2 = 1 - ( RSS/ ( sum((val-mean(val))^2) ) )

  	perf = data.frame(MAE,RSS,MSE,RMSE,R2)
}

################
# CAP 1
################

############# passengers aggregate annual series and seasonal values
data(AirPassengers)
AP = AirPassengers
par(mfrow=c(3,1))
plot(AP , ylab = "Passengers (1000's)")
plot(aggregate(AP) , ylab="Aggregated annual series")
boxplot(AP ~ cycle(AP) , ylab = "Boxplot of seasonal values")


inputs <- c(1.2, 5.1, 2.1)
weights <- c(3.1, 2.1, 8.7)
bias <- 3

output <- inputs[1] * weights[1] + inputs[2] * weights[2] + inputs[3] * weights[3] + bias
output