library("testthat")
library("waddR")

##########################################################################
##                        CPP FUNCTIONS EXPOSED TO R                    ##
##########################################################################

#### NUMERIC VECTOR ABSOLUTE VALUE
test_that("abs_test_export", {
  skip_if_not_exported()
  v1 <- c(0,2.3,2,3,4,-3,-134)
  expect_equal(abs_test_export(v1), base::abs(v1))
})

#### Vector sum
test_that("sum_test_export", {
  skip_if_not_exported()
  v1 <- c(12,23,42.5, 22.5)
  expected <- 100
  expect_equal(sum_test_export(v1), expected)
})

#### NUMERIC VECTOR MEAN
test_that("mean_test_export", {
  skip_if_not_exported()
  set.seed(42)
  v <- rnorm(100)
  v2 <- c(-1,3.5,100)
  expect_equal(mean_test_export(v), base::mean(v))
  expect_equal(mean_test_export(v2), base::mean(v2))
  expect_equal(mean_test_export(c(23)), base::mean(c(23)))
})

#### NUMERIC VECTOR SD
test_that("sd_test_export", {
  skip_if_not_exported()
  set.seed(42)
  v <- rnorm(100)
  v2 <- c(-1,3.5,100)
  expect_equal(sd_test_export(v), sd(v))
  expect_equal(sd_test_export(v2), sd(v2))
  # special case: Input vectors of length 1 should have sd=0
  expect_equal(sd_test_export(c(1)), 0)
})

#### Vector add
#### Vector subtract
test_that("add_test_export", {
  skip_if_not_exported()
  v1 <- c(1,2,3,4)
  v2 <- c(2,2,2,2)
  expected <- c(3,4,5,6)
  expect_equal(add_test_export(v1,v2), expected)
  expect_error(add_test_export(v1,2))
  expect_equal(add_test_export_sv(v1,2), expected)
})

#### Vector subtract
test_that("subtract_test_export", {
  skip_if_not_exported()
  v1 <- c(1,2,3,4)
  v2 <- c(2,2,2,2)
  expected <- c(-1,0,1,2)
  expect_equal(subtract_test_export(v1,v2), expected) # with vector
})

#### Vector divide
test_that("divide_test_export", {
  skip_if_not_exported()
  v1 <- c(1,2,3,4)
  v2 <- c(2,2,2,2)
  expected <- c(0.5,1.0,1.5,2)
  expect_equal(divide_test_export_vectors(v1,v2), expected) # with vector
  expect_equal(divide_test_export_sv(v1,2), expected) # with scalar
})

#### Vector multiply
test_that("multiply_test_export", {
  skip_if_not_exported()
  v1 <- c(1,2,3,4)
  v2 <- c(2,2,2,2)
  expected <- c(2,4,6,8)
  expect_equal(multiply_test_export(v1,v2), expected) # with vector
  expect_warning(multiply_test_export(v1,2))
  expect_equal(multiply_test_export_sv(v1,2), expected) # with scalar
})

#### Vector Pow
test_that("pow_test_export", {
  skip_if_not_exported()
  v1 <- c(1,2,3,4)
  expected <- c(1,4,9,16)
  expect_equal(pow_test_export(v1,2), expected) # with scalar
})

#### PERMUTATIONS OF NUMERIC VECTOR
test_that("permutations", {
  set.seed(123)
  a <- rnorm(100)
  n <- 1000
  df <- sapply(1:n, function(e) sample(a, replace = FALSE))

  permutations_matrix = permutations(a, n)
  expect_equal(length(df), length(permutations_matrix))
  expect_true(all(
    apply(permutations_matrix, 2, function(perm) {a %in% perm})
  ))
})

#### CUMULATIVE SUM OF NUMERIC VECTOR
test_that("cumSum_test_export", {
  skip_if_not_exported()
  expect_equal(cumSum_test_export(c(1,2,3,4,5)), c(1,3,6,10,15))
  expect_equal(cumSum_test_export(c(1,2,3,4,5), 3), c(1,3,6))
  expect_equal(cumSum_test_export(c(1,2,3,4), 0), c(1,3,6,10))
})

#### INTERVAL TABLE
test_that("Interval_table_test_export", {
  skip_if_not_exported()
  wa <- c(1)
  wb <- c(0,1,0,0,0,0)
  ua <- (wa/sum(wa))[-1]
  ub <- (wb/sum(wb))[-1]
  cua <- cumsum(ua)
  cub <- cumsum(ub)

  wa2 <- c(0, 0, 0, 10)
  wb2 <- c(13)
  ua2 <- (wa2/sum(wa2))[-1]
  ub2 <- (wb2/sum(wb2))[-1]
  cua2 <- cumsum(ua2)
  cub2 <- cumsum(ub2)

  set.seed(123)
  wa3 <- runif(c(1:60))
  set.seed(234)
  wb3 <- runif(c(1:100))
  ua3 <- (wa2/sum(wa2))[-1]
  ub3 <- (wb2/sum(wb2))[-1]
  cua3 <- cumsum(ua3)
  cub3 <- cumsum(ub3)

  empty_vector <- c(1)[-1]

  # cpp implementation
  cppresult1 <- interval_table_test_export(cub, cua,1)
  cppresult2 <- interval_table_test_export(cua2, cub2,1)
  cppresult3 <- interval_table_test_export(cua3, cub3,1)
  cppresult4 <- interval_table_test_export(c(1,2,3), empty_vector, 1)
  cppresult5 <- interval_table_test_export(empty_vector, c(1,2,3), 1)

  # pure R
  temp <- cut(cub, breaks = c(-Inf, cua, Inf))
  rresult1 <- table(temp) + 1
  temp <- cut(cua2, breaks = c(-Inf, cub2, Inf))
  rresult2 <- table(temp) + 1
  temp <- cut(cua3, breaks = c(-Inf, cub3, Inf))
  rresult3 <- table(temp) + 1
  rresult4 <- table(cut(c(1,2,3), breaks=c(-Inf, empty_vector, Inf))) + 1
  rresult5 <- table(cut(empty_vector, breaks=c(-Inf, c(1,2,3), Inf))) + 1

  expect_true(all(rresult1 == cppresult1))
  expect_true(length(rresult1) == length(cppresult1))
  expect_true(all(rresult2 == cppresult2))
  expect_true(all(rresult3 == cppresult3))
  expect_true(all(rresult4 == cppresult4))
  expect_true(all(rresult5 == cppresult5))
  expect_type(interval_table_test_export(rnorm(1000, 10,0.3),
                                         rnorm(834, 20, 10)),
              "integer")

})

#### Repeat Weighted
test_that("rep_weighted_test_export", {
  skip_if_not_exported()
  expect_equal(rep_weighted_test_export(c(1,2,3), c(1,2,2)),
               rep(c(1,2,3), times=c(1,2,2)))
  expect_equal(rep_weighted_test_export(c(1,2,3,4), c(1,2,2,2)),
               c(1,2,2,3,3,4,4))
  expect_equal(rep_weighted_test_export(c(1,2), c(0,1)), c(2))
#  expect_error(rep_weighted_test_export(c(1,2), c()))
})

#### Concat NumericVectors
test_that("concat_test_export", {
  skip_if_not_exported()
  expect_equal(concat_test_export(c(1,2,3,4), c(5,6,7,8)),
               c(1,2,3,4,5,6,7,8))
  expect_equal(concat_test_export(c(1,2,3), c(1)), c(1,2,3,1))
  expect_equal(concat_test_export(c(1,2,3),c(1,2,3)), c(1,2,3,1,2,3))
#  expect_equal(concat_test_export(c(), c(1,2,3)), c(1,2,3))
})

#### correlation of vectors
test_that("cor_test_export", {
  skip_if_not_exported()
  expect_equal(cor_test_export(c(1), c(11)), 1)
  expect_equal(cor_test_export(c(1.0,2.0,3,4,5), c(2,3,4,5,6)), 1)
  expect_equal(cor_test_export(c(1,2,3,4,5), c(2,3,4,5,6)*-1), -1)
  expect_equal(cor_test_export(c(1,34,134,13,50,5,1,2),
                               c(2,20,55, 18, 55, 6, 2, 2)),
               cor(c(1,34,134,13,50,5,1,2), c(2,20,55, 18, 55, 6, 2, 2)))
})

#### empirical equidistant quantile
test_that("equidist_quantile_test_export",{
  skip_if_not_exported()
  probs = (seq(1:10)) / 10
  probs2 = (seq(1:5)) / 5
  expect_true(all(equidist_quantile_test_export(c(1:10), 10) ==
                  quantile(seq(1:10), probs=probs, type=1)))
  expect_true(all(equidist_quantile_test_export(c(1:10), 5) ==
                  quantile(c(1:10), probs=probs2, type=1)))
  expect_true(all(equidist_quantile_test_export(c(1:5), 5) ==
                  quantile(c(1:5), probs=probs2, type=1)))
})

####quantile
test_that("quantile_test_export",{
  skip_if_not_exported()
  expect_true(all(quantile_test_export(c(1:10),seq(1:10)/10) ==
                  quantile(c(1:10), probs=seq(1:10)/10, type=1)))
  expect_true(all(quantile_test_export(c(1:10),seq(1:5)/5) ==
                  quantile(c(1:10), probs=seq(1:5)/5, type=1)))
  expect_true(all(quantile_test_export(c(1:5), seq(1:10)/10) ==
                  quantile(c(1:5), probs=seq(1:10)/10, type=1)))
})


#media poblacional entre 2 muestras independientes

#mtcars es un built in dataframe mpg es el gas milage de los autos en 1974
#mt$am es el tipo de transmisi??n de los autos

'''
Assuming that the data in mtcars follows the normal distribution,
find the 95% confidence interval estimate of the difference between
the mean gas mileage of manual and automatic transmissions.
'''

#autos con transmision automatica
L = mtcars$am == 0
mpg.auto = mtcars[L,]$mpg

#autos con transmision manual

mpg.manual = mtcars[!L,]$mpg

t.test(mpg.auto,mpg.manual)

#otra forma

t.test(mpg ~ am, data=mtcars)

Parcial/3. Inferencia entre poblaciones/PopulationMeanTwoIndependentSamples.r


ad_click <- read.table(file = 'data/ad_click.csv', header = TRUE, sep=',')
head(ad_click)

# Visualization
crosstab <- xtabs(~ click + agegroup + sex, data=ad_click)
pairs(crosstab, lower_panel = pairs_assoc, shade=TRUE) # https://www.slideshare.net/KumarP34/using-r-for-customer-segmentation
# If the number of variables is about 3
vcd::mosaic(click ~ agegroup | sex, data=ad_click, shad=TRUE)

# Multiple Regression
## Multiple regression analysis can not be applied to qualitative variables.
##   ad_click.lm <- lm(formula = click ~ sex + agegroup, data=ad_click)
##   summary(ad_click.lm)

# Logistic Regression
ad_click.glm <- glm(formula = click ~ sex + agegroup, data = ad_click, family="binomial")
summary(ad_click.glm)

# odds ratio
exp(coef(ad_click.glm))


source('ifm_func.r')

# Strategy D - trend trading:
# Bollinger bands are used in this strategy, which are the 190-day simple moving
# average (SMA) of closing price of the given stock (which is now referred as t-
# he middle band) and its upper (lower) bands calculated by adding to (subtract-
# ing from) the middle band 1.5 of its standard deviation. When the closing pri-
# ce of the given stock crosses above the middle band (golden cross), we buy in
# at opening price on the next day, and then hold to sell out at opening price
# on the following day when the closing price of the given stock crosses below
# the upper band (death cross).
strategy <- function(stock) {
    # Strategy.
    STANDARD_DEVIATION_MULTIPLIER <- 1.5
    MA_DAYS_N <- 190
    M_START <- MA_DAYS_N + 1

    # Prepare data.
    opp <- Op(stock) # [op]en [p]rices
    clp <- Cl(stock) # [cl]ose [p]rices
    bbands <- BBands(clp, n=MA_DAYS_N, sd=STANDARD_DEVIATION_MULTIPLIER) # [b]ollinger [bands]
    bbands_upp <- bbands[, 'up'] # [b]ollinger [bands] [up] [p]rices
    bbands_mip <- bbands[, 'mavg'] # [b]ollinger [bands] [mi]ddle [p]rices
    yesterday <- nrow(stock) - 1

    # Execute the strategy.
    pl <- setNames( rep( 0, length(clp) ), time(stock) )
    is_bought <- FALSE
    for (m in M_START:yesterday) {
        if ( !is_bought
             && as.numeric( clp[m-1] ) <  as.numeric( bbands_mip[m-1] )
             && as.numeric( clp[m]   ) >= as.numeric( bbands_mip[m]   ) ) {
            bought <- long( as.numeric( opp[m+1] ) )
            is_bought <- TRUE
        }
        else if ( is_bought
                  && as.numeric( clp[m-1] ) >  as.numeric( bbands_upp[m-1] )
                  && as.numeric( clp[m]   ) <= as.numeric( bbands_upp[m]   ) ) {
            pl[m] <- -bought + short( as.numeric( opp[m+1] ) )
            is_bought <- FALSE
        }
    }

    # Return [p]rofit-[l]oss.
    return(pl)
}


g1 <- graph.empty(1)
g2 <- make_graph(c(2,1, 3,1, 4,1))
V(g1)$color <- 2
V(g2)$color <- c(3,1,1,1)
is_isomorphic_to(g1,g2, method='vf2')

mypalette <- c("black", "red", "white")

par(mfrow=c(1,2))
la <- layout_with_fr(g1)
plot(g1,
     layout = la,
     vertex.color = mypalette[V(g1)$color],
     vertex.label = V(g1)$color,
     vertex.size = 5,
     edge.width = 1.5)
title("g1")

la <- layout_with_fr(g2)
plot(g2,
     layout = la,
     vertex.color = mypalette[V(g2)$color],
     vertex.label = V(g2)$color,
     vertex.size = 5,
     edge.width = 1.5)
title("g2")

g1 <- make_ring(3, directed=TRUE)
g2 <- make_ring(3, directed=TRUE)
V(g1)$color <- c(1,2,3)
V(g2)$color <- c(1,2,3)
isomorphic(g1,g2)
isomorphic(g1,g2, method='vf2')

mypalette <- c("black", "red", "white")

par(mfrow=c(1,2))
la <- layout_with_fr(g1)
plot(g1,
     layout = la,
     vertex.color = mypalette[V(g1)$color],
     vertex.label = V(g1)$color,
     vertex.size = 5,
     edge.width = 1.5)
title("g1")

la <- layout_with_fr(g2)
plot(g2,
     layout = la,
     vertex.color = mypalette[V(g2)$color],
     vertex.label = V(g2)$color,
     vertex.size = 5,
     edge.width = 1.5)
title("g2")

#write.graph(g1, "g1", format='graphml')
#write.graph(g2, "g2", format='graphml')
#write.graph(eg, "eg", format='graphml')
#write.graph(gmotif, "gmotif", format='graphml')

#g1 <- read.graph("g1",  format='graphml')
#g2 <- read.graph("g2",  format='graphml')
#eg <- read.graph("eg",  format='graphml')
#gmotif <- read.graph("gmotif",  format='graphml')
#is_isomorphic_to(eg, gmotif, method='vf2')

g1_bug <- read.graph("g1",  format='graphml')
g2_bug <- read.graph("g2",  format='graphml')

eg <- read.graph("eg2",  format='graphml')
gmotif <- read.graph("gmotif2",  format='graphml')
is_isomorphic_to(eg, gmotif, method='vf2')

#is_isomorphic_to(g1, eg, method='vf2')
#[1] TRUE
#is_isomorphic_to(g2, gmotif, method='vf2')
#TRUE
#is_isomorphic_to(eg, gmotif, method='vf2')
#Error in .Call("R_igraph_isomorphic_vf2", graph1, graph2, vertex.color1,  :
#                 At topology.c:1106 : Invalid vertex color vector length, Invalid value
#               Called from: is_isomorphic_to(eg, gmotif, method = "vf2")


# O estudo justifica-se pela necessidade de entender o comportamento estatístico
# do Ibovespa, sobretudo, em momentos de maior incerteza na economia local.
# Utilizado Período de jan/2008 - jun/2021 mensal.

#####
#------------------ Confugurações ------------------#
# Bibliotecas
rm(list=ls())
# install.packages("quantmod") # Retornos
# install.packages("ggplot2")
# install.packages("forecast")
# install.packages("stochvol")
# install.packages("dygraphs")
library(quantmod)
library(ggplot2)
library(forecast)
library(dplyr)
library(stochvol)
library(dygraphs)

options(max.print=1000000) # Número de linhas para visualização
options(digits = 2, OutDec = ",") # Configuração decimal

#####
#------------------ Buscando e Plotando o Ativo ------------------#
# Constantes
stock <- "^BVSP" # stock
start <- "2008-01-01"
end <- "2021-06-25" # Sys.Date()
periodicidade <- "monthly"

# Busca os dados do Yahoo Finance
dataframe.atv <- getSymbols(stock, src = "yahoo", from = start, to = end, auto.assign = FALSE, periodicity = periodicidade)
names(dataframe.atv)
atv <- na.omit(dataframe.atv) # na.appox na.locf na.omit

# Algumas conferências
head(atv) # Primeiros dados da base
tail(atv) # Últimos dados da base
summary(atv) # Estatísticas descritivas
str(atv) # Estrutura da série

# Plotagem de Indicadores
candleChart(atv, TA=c(addMACD(fast = 12, slow = 26, signal = 9), addVo(), addBBands()), show.grid = TRUE, "last 180 months", theme = chartTheme('white', up.col='white',dn.col='black'))

# Gráfico Interativo
grafico <-cbind(atv[,4])
dygraph(grafico, ylab="Retorno Logaritmo X Estimativa de volatilidade",main=stock) %>%
  dySeries(label = stock) %>%
  dyOptions(colors = c("blue")) %>%
  dyOptions(stackedGraph = TRUE) %>%
  dyAxis("y", label = (paste("Preço de fechamento de", stock))) %>%
  dyOptions(stepPlot = TRUE) %>%
  dyRangeSelector()

#####
#------------------  Análise de Autocorrelação Serial ------------------#
# Análise de autocorrelação do preço
acf(atv[,4])
title(paste("ACF Análise de Autocorrelação Serial de", stock), line = +1)

# Análise de autocorrelação parcial do retorno
acf(atv[,4], type="partial")
title(paste("PACF parcial do log retorno de", stock), line = +1)

#####
#------------------ Cálculo dos Retornos ------------------#
# Retorno por período
rD <- (100 * dailyReturn(atv)) # Retorno anual
summary(rD)
rW <- (100 * weeklyReturn(atv)) # Retorno anual
summary(rW)
rM <- (100 * monthlyReturn(atv)) # Retorno anual
summary(rM)
rQ <- (100 * quarterlyReturn(atv)) # Retorno anual
summary(rQ)
rA <- (100 * yearlyReturn(atv)) # Retorno anual
summary(rA)
rA

atvRet <- na.omit(100 * diff(log(atv[,4]))) # Retorno percentual
atvRet <- atvRet[-1,]

# Estatística de retorno
summary(atvRet) # Estatíticas gerais
sd(atvRet) # Desvio padrão

# Gráfico do retorno do período total
plot(atvRet, col="blue", lwd = 2)
title(paste("Retorno ao longo do Período", stock), line = +1)

# Retorno logaritmo ao quadrado do período total
plot(atvRet^2, col="brown", lwd = 2)
title(paste("Retorno Logaritmo ao Quadrado(Cluster de Volatilidade) de", stock), line = +1)

#####
#------------------  Modelo de Volatilidade Estocástica(MVE) ------------------#
# Análise a posteriori com simulação Bayesiana via Markov Chain Monte Carlo(MCMC)
postAtv <- svsample(atvRet) # Distribuição a Priori
summary(postAtv, showlatent=FALSE) # Para ter eacesso aos parâmetros estimados da posteriori
# Stored 10000 MCMC draws after a burn-in of 1000.
# Geardas 10.000 amostras e descartadas as primeiras 1.000.
plot(postAtv) # Densidade marginal (mu(B0) phi(B1) sigma) IC(Intervalo de credibilidade Bayesiana)

#Análise residual do modelo
residAtv<-resid(postAtv) # Probabilidade Quanti-Quantil (Qualidade de ajuste)
plot(residAtv, col="darkblue",cex=0.5)


library(GA)

p <- c(15, 100, 90, 60, 40, 15, 10, 1, 1, 2, 3, 4)      # wartości przedmiotów
w <- c(2,  20, 20, 30, 40, 30, 60, 10, 10, 40, 30, 50)  # wagi
cap <- 113                                              # pojemność plecaka

knapsackFitness <- function(knapsack) {
  value <- sum(knapsack * p)
  weight <- sum(knapsack * w)

  # Funkcja kary, gdy nie używamy monitora
  if (weight > cap) {
    # value <- 0  # prosty element kary
    # value <- value * (cap/weight/1.1)
    value <- value - weight + cap
  }

  value
}

knapsackMonitor <- function(obj, digits = getOption("digits"), ...)
{
  for(i in 1:nrow(obj@population)) {
    weight <- sum(obj@population[i,] * w)
    while (weight > cap) {
      removeThing <- sample.int(length(p) - 1, 1) + 1
      obj@population[i,removeThing] <- 0
      weight <- sum(obj@population[i,] * w)
    }
  }

  fitness <- na.exclude(obj@fitness)
  sumryStat <- c(mean(fitness), max(fitness))
  sumryStat <- format(sumryStat, digits = digits)
  cat(paste("GA | iter =", obj@iter, "| Mean =", sumryStat[1],
            "| Best =", sumryStat[2]))
  cat("\n")
  flush.console()
}

set.seed(123)
GA <- ga(
  type = "binary",
  fitness = knapsackFitness,
  nBits = length(p),
  popSize = 50,
  maxiter = 1000,
  run = 100,
  seed = 123,
  monitor = knapsackMonitor
)

summary(GA)
plot(GA)


library(e1071)

outFile <- "Validation/R_Validation.ecl"
outText <- ""

heart_scale <- read.csv("Datasets/heart_scale.csv", header = F)

x <- heart_scale[,-1]
y = heart_scale[,1]

getECL <- function(x, y, scale, regress) {
  svmMdl <- svm(
    x           = if (scale) scale(x) else x,
    y           = if (regress) y else as.factor(y),
    type        = if (regress) "eps-regression" else "C-classification",
    kernel      = "radial",
    gamma       = 0.1,
    probability = T,
    scale       = F,
    fitted      = T
  )
  probs <- attr(predict(svmMdl, if (scale) scale(x) else x, probability = TRUE), "probabilities")[,c(2,1)]
  preds <- if (regress) svmMdl$fitted else 2*(as.integer(probs[,1] <= probs[,2])-0.5)

  rslt <- c("// scale = ", if (scale) "T" else "F", "\n\n")

  suffix <- paste0(if (regress) "_SVR_" else "_SVC_", if (scale) "Scaling" else "NoScaling")
  test <- paste0(if (regress) "'SVR, " else "'SVC,", if (scale) "with scaling'" else "without scaling'")

  rslt <- c(rslt, paste0("EXPORT NumberOfSVs",suffix),":=", svmMdl$tot.nSV, ";\n")
  rslt <- c(rslt, paste0("EXPORT SVCoefs",suffix),":= DATASET([\n")
  rslt <- c(rslt, "{", paste0(paste0(1:svmMdl$tot.nSV, ", ", test, ", ", svmMdl$coefs), collapse = "}, {"), "}\n")
  rslt <- c(rslt, "], {INTEGER ID, STRING20 Test, REAL8 R});\n")
  rslt <- c(rslt, paste0("EXPORT Predictions",suffix),":= DATASET([\n")
  rslt <- c(rslt, "{", paste0(paste0(1:nrow(x), ", ", test, ", ", preds), collapse = "}, {"), "}\n")
  rslt <- c(rslt, "], {INTEGER ID, STRING20 Test, REAL8 R});\n")
  if (!regress) {
    rslt <- c(rslt, paste0("EXPORT Probabilities",suffix), ":= DATASET([\n")
    rslt <- c(rslt, "{", paste0(paste0(1:nrow(x), ", ", test, ", ", probs[,2]), collapse = "}, {"), "}\n")
    rslt <- c(rslt, "], {INTEGER ID, STRING20 Test, REAL8 R});\n\n")
  } else {
    rslt <- c(rslt, "\n\n")
  }
}

outText <- c(outText, "//////// CODE AUTO-GENERATED BY R\n")
outText <- c(outText, "EXPORT R_Validation := MODULE\n\n")
outText <- c(outText, "//// Get coefficients and predictions for SVC\n\n")
outText <- c(outText, getECL(x, y, F, F))
outText <- c(outText, getECL(x, y, T, F))

outText <- c(outText, "//// Get coefficients and predictions for SVR\n\n")
outText <- c(outText, getECL(x, y, F, T))
outText <- c(outText, getECL(x, y, T, T))

outText <- c(outText, "//// Run SVC grid search and get accuracies\n\n")

tuneResults <- tune(
  ranges      = list(
    gamma       = 2^seq(-15, 3, length.out = 10),
    cost        = 2^seq(-5, 15, length.out = 12)),
  tunecontrol = tune.control(
    nrepeat     = 1,
    sampling    = "cross",
    cross       = 10,
    best.model  = F),
  method      = svm,
  train.x     = scale(x),
  train.y     = as.factor(y),
  type        = "C-classification",
  kernel      = "radial",
  probability = F,
  scale = F
)
tuneAccuracy <- tuneResults$performances
outText <- c(outText, "EXPORT GridSearchResults_SVC := DATASET([\n")
outText <- c(outText, paste0("{", paste(1:nrow(tuneAccuracy), tuneAccuracy$cost, tuneAccuracy$gamma, paste0(tuneAccuracy$error, "}"), sep = ", "), collapse = ",\n "))
outText <- c(outText, "\n], {INTEGER ID, REAL8 Cost, REAL8 Gamma, REAL8 R});\n\n")

outText <- c(outText, "//// Run SVR grid search and get accuracies\n\n")

tuneResults <- tune(
  ranges      = list(
    gamma       = 2^seq(-15, 3, length.out = 10),
    cost        = 2^seq(-5, 15, length.out = 12)),
  tunecontrol = tune.control(
    nrepeat     = 1,
    sampling    = "cross",
    cross       = 10,
    best.model  = F),
  method      = svm,
  train.x     = scale(x),
  train.y     = y,
  type        = "eps-regression",
  kernel      = "radial",
  probability = F,
  scale = F
)
tuneAccuracy <- tuneResults$performances
outText <- c(outText, "EXPORT GridSearchResults_SVR := DATASET([\n")
outText <- c(outText, paste0("{", paste(1:nrow(tuneAccuracy), tuneAccuracy$cost, tuneAccuracy$gamma, paste0(tuneAccuracy$error, "}"), sep = ", "), collapse = ",\n "))
outText <- c(outText, "\n], {INTEGER ID, REAL8 Cost, REAL8 Gamma, REAL8 R});\n\n")

outText <- c(outText, "END;")

cat(outText, file = outFile)


# Read data
setwd(".")
spambase <- read.csv("./spambase.data", header=FALSE)

# Import libraries
library(e1071)
library(plyr)

# As all the spam data is at the top, we shuffle
spam <- spambase[sample(nrow(spambase)), ]

# k-fold validation
k = 5
n = floor(nrow(spam)/k)
err.vec = vector()

for (fold in 1:k) {
	s1 = ((fold - 1) * n)
	s2 = (fold * n)
	subset = s1:s2

	# Create training and test sets
	data.test = spam[subset, ]
	data.train = spam[-subset, ]

	# Create a SVM model
	model = svm(x = data.train[, -58], y = as.factor(data.train[, 58]))

	# Predict for the test set using the generated model
	prediction = predict(model, newdata = data.test[, -58])

	# Compute the error
	err.vec[fold] = count(data.test$V58 != prediction)[2,2] / nrow(data.test)
}

# Compute the error
error = mean(err.vec)


library(dplyr)
library(plyr)

setwd('/Users/sarahmullin/Desktop/Teaching/BioStatsBasics/')
Example_1=read.csv("Dataset1.csv", sep=",", header=T)
colnames(Example_1)<-c("Cholesterol", "Group")

#n1=133
n1=length(Example_1[Example_1[,2]==1,][,2])
n1
#n2=41
n2=length(Example_1[Example_1[,2]==2,][,2])
n2

par(mfrow=c(2,2))
hist(Example_1[Example_1[,2]==1,][,1], main="Histogram of Cholesterol for PH patients", xlab="Cholesterol")
hist(Example_1[Example_1[,2]==2,][,1], main="Histogram of Cholesterol for NT patients", xlab="Cholesterol")
qqnorm(Example_1[Example_1[,2]==1,][,1])
qqnorm(Example_1[Example_1[,2]==2,][,1])

par(mfrow=c(1,1))
boxplot(Example_1$Cholesterol~Example_1$Group)
sqrt(var(Example_1[Example_1[,2]==1,][,1]))
sqrt(var(Example_1[Example_1[,2]==2,][,1]))

T1=t.test(Example_1$Cholesterol~Example_1$Group, alternative="greater", var.equal=T)
T1
T2=t.test(Example_1$Cholesterol~Example_1$Group, alternative="greater", var.equal=F)
T2

?t.test

t.test(Example_1$Cholesterol~Example_1$Group, alternative="less", var.equal=T)
##note:
1-T1$p.value

t.test(Example_1$Cholesterol~Example_1$Group, alternative="two.sided", var.equal=T)
2*T1$p.value
#Note: Since this is a two-sided test, the 95% confidence interval is bounded by two sides--(10.77, 32.26)

##create 2x2 table
Example_2<-as.table(matrix(c(20,30,10,40), nrow=2, ncol=2, dimnames=list(c("Growth:Yes", "Growth:No"), c("Centrifuged", "Noncentrifuged" ))))
###tables can also be created from individual data using the function table()
Example_2

##H0: no association between growth and centrifugation in the population; p1-p2=0
##Ha: association between growth and centrifugation the population p1-p2=0

#incidence of combined morbidity index
n1=Example_2[1,2]+Example_2[1,1]
n2=Example_2[2,1]+Example_2[2,2]
incidence_exposed=Example_2[1,1]/n1  ####p1
incidence_unexposed=Example_2[2,1]/n2  ####p2
incidence_exposed
incidence_unexposed

###Chi-square test
Test_2=chisq.test(Example_2, correct=F)
Test_2
#often times, we use something called continuity correction when we are using a continuous function (like the Chi-square) to approximate a discrete function (like binomial)
# to enable continuity correction, change Test=chisq.test(Ex1, correct=T)

####check assumptions, expected count at least 80% of cells >5:
Test_2$expected
#all cells are greater than 5

#df=(r-1)*(c-1)=(2-1)*(2-1)=1
#Test statistic=4.7619
#p-value is P(X^2>7.101)=.0291
#this p-value can also be found this way: 1-pchisq(4.7619,1)

##create 2x2 table
Example_3<-as.table(matrix(c(2,0,115,862), nrow=2, ncol=2, dimnames=list(c("Group1:exposed", "Group2:unexposed "), c("Colonic Necrosis", "No Colonic Necrosis" ))))
Example_3

###incidence estimates
n1=Example_3[1,2]+Example_3[1,1]
n2=Example_3[2,1]+Example_3[2,2]
incidence_exposed=Example_3[1,1]/n1  ####p1
incidence_unexposed=Example_3[2,1]/n2  ####p2
incidence_exposed
incidence_unexposed

##H0: no association between drug and colonic necrosis in the population; p1-p2=0
##Ha: association between drug and colonic necrosisin the population p1-p2 >0

####check assumptions, expected count at least 80% of cells >5:
Test_3=chisq.test(Example_3)
Test_3$expected

###two cells <5...use fisher exact
Test_3=fisher.test(Example_3, alternative="greater")
Test_3

?fisher.test

###create 2x2 table
Example_4<-as.table(matrix(c(0,5,17,0), nrow=2, ncol=2, dimnames=list(c("Yes Died Smoking Twin", "No Died Smoking Twin "), c("Yes Died Non-Smoking Twin", "No Died Non-Smoking Twin" ))))
###tables can also be created from individual data using the function table()
###Normal Approximation Method: McNemar
##H0: no association between smoking and earlier mortality in the population;
##marginal probabilities for each outcome are the same p_a+p_b=p_c+p_d
##Ha: association between smoking and earlier mortality in the population
Example_4

#Check assumption b+c>20: 5+17>20
##without continuity correction
mcnemar.test(Example_4, correct=F)
#with continuity correction
mcnemar.test(Example_4, correct=T)

#Test statistic: X^2=5.5
#df=1
#p-value=.01902
#same as
1-pchisq(5.5,1)
#1-P(X^2<5.5)=P(X^2>5.5)

##H0: no association between smoking and earlier mortality in the population;
#marginal probabilities for each outcome are the same p_a+p_b=p_c+p_d
##Ha: association between smoking and earlier mortality in the population

#number of discordant pairs n=17+5 Bernouilli Trials
n=Example_4[1,2]+Example_4[2,1]
n
###proportion of positive discordancies
p=Example_4[1,2]/n
p
###number of successes
x=Example_4[1,2]
x

###binomial test
binom.test(x,n, alternative=c("two.sided"))

Occasion<-c(seq(1,10,1),seq(1,10,1))

Cloth<-c(1*10^4,3.3*10^7,5.7*10^7,1.9*10^7,1.2*10^4,8.8*10^2,2.6*10^6,3.3*10^7,8.7*10^6,7.6*10^7 )
Sponge<-c(4.6*10^6,9.8*10^7,1.3*10^8,1.3*10^8,6.0*10^2,4.7*10^7,1.4*10^8,1.2*10^8,2.1*10^8,1.1*10^8 )
Df2<-cbind(Occasion, Cloth, Sponge)
colnames(Df2)<-c("Occasion", "Cloth", "Sponge")
Df2

wilcox.test(Cloth,Sponge, data=Df2,paired=TRUE)

Example_5<-as.table(matrix(c(10,20,15,15,15,10,10,5), nrow=2, ncol=4, dimnames=list(c("Yes", "No"), c("1 = no growth", "2 = minimal growth","3 = moderate growth","4 = confluent growth" ))))
Example_5

# Let's turn this into a dataset!
Growth<-c(rep(1,10), rep(2,15), rep(3,15), rep(4,10),rep(1,20), rep(2,15), rep(3,10), rep(4,5))
CultureGroups<-c(rep('Yes',50), rep('No',50))
Df<-as.data.frame(cbind(as.numeric(Growth),CultureGroups))
colnames(Df)<-c('Growth', 'CultureGroups')

library(lattice)

histogram(~ factor(Growth, ordered=T) | CultureGroups,
          data=Df,
          layout=c(1,2)      #  columns and rows of individual plots
          )

wilcox.test(as.numeric(Growth)~CultureGroups, data=Df)


dev.off()

x = seq(1.8, 5.2, 0.1)

f1 <- function(x) {
  x^3 - 10*x^2 + 31*x - 30
}
f2 <- function(x) {
  3*x^2 - 20*x + 31
}

par(mfrow=c(2,1))
plot(x, f1(x), type='l')
abline(h=0)
points(2.45, f1(2.45))
points(4.22, f1(4.22))

plot(x, f2(x), type='l', yaxs="r")
abline(h=0)
points(2.45, f2(2.45))
points(4.22, f2(4.22))


# Abundant, deficient and perfect number classifications. 12/10/16 aev
require(numbers);
propdivcls <- function(n) {
  V <- sapply(1:n, Sigma, proper = TRUE);
  c1 <- c2 <- c3 <- 0;
  for(i in 1:n){
    if(V[i]<i){c1 = c1 +1} else if(V[i]==i){c2 = c2 +1} else{c3 = c3 +1}
  }
  cat(" *** Between 1 and ", n, ":\n");
  cat("   * ", c1, "deficient numbers\n");
  cat("   * ", c2, "perfect numbers\n");
  cat("   * ", c3, "abundant numbers\n");
}
propdivcls(20000);


# MULTIPLY transaction rates in a given cycle to obtain possible profit
fw.mult <- function(nodes, edges, rates, cycle) {

    profit = 1

    # find and multiply by pairs
    for (i in 1:(NROW(cycle)-1)) {
        next_value = rates[which(edges[,1]==nodes[cycle[i]] & edges[,2]==nodes[cycle[i+1]])]
        profit = profit * as.numeric(next_value)
    }

    # as number
    return(profit)
}

# RETRIEVE a path given a predecessor array and a source/target pair of nodes
fw.path <- function(nexts, source, target) {

    if(!is.numeric(source) | !is.numeric(target)) {
        cat("error: fw-path: no-numerical source/target\n")
        return()
    }

    if (nexts[source][target] == -1) {
        cat("error: fw-path: no paths between source/target\n")
        return()
    }

    # track steps
    path = c(source)
    following = nexts[source]
    while (following != target) {
        path = c(path, following)
        following = nexts[following, target]
    }

    # do last step
    path = as.matrix(c(path, target))

    # as vector
    return(path)
}

# APPLY classic Floyd-Warshall Algorithm
fw.find <- function(graph, summary, debug=T) {

    # receive graph as an EDGE LIST with the following format:
    #
    #        [,1]    [,2]    [,3]
    # [1,]  node 1  node 2  weight
    # [1,]  node 1  node 3  weight
    # [1,]  node 2  node 1  weight
    #   .     .       .       .
    #   .     .       .       .
    #   .     .       .       .

    # ready data
    edges = as.matrix(graph)
    nodes = unique(matrix(edges[,1:2], ncol=1))
    weights = as.numeric(as.character(edges[,3]))

    # distances matrix
    dists = matrix(rep(Inf, NROW(nodes)**2), nrow=NROW(nodes), byrow=T)

    # path reconstruction
    nexts = matrix(rep(-1, NROW(nodes)**2), nrow=NROW(nodes), byrow=T)

    # copy existing distances
    for (i in 1:NROW(edges)) {
        u = which(nodes==edges[i, 1]) # from
        v = which(nodes==edges[i, 2]) # to
        dists[u, v] = weights[i]
        nexts[u, v] = v
    }

    # distance to itself is zero
    for (i in 1:NROW(nodes)) {
        dists[i, i] = 0
    }

    if (debug) {
        cat("Applying Floyd-Warshall algorithm\n")
    }

    for (k in 1:NROW(nodes)) {

        if (debug) {
            cat("  computing all paths passing through node", k, "\n")
        }

        for (i in 1:NROW(nodes)) {
            for (j in 1:NROW(nodes)) {
                if (dists[i, k] + dists[k, j] < dists[i, j]) {
                    dists[i, j] = dists[i, k] + dists[k, j]
                    nexts[i, j] = nexts[i, k]
                }
            }
        }
    }

    # check for cycles
    cycle = NULL
    profit = NULL
    for (i in 1:NROW(nodes)) {

        if (dists[i, i] < 0) {
            # cycle path
            cycle = fw.path(nexts, i, i)

            # cycle mult
            rates = as.numeric(as.character(summary[,3]))
            profit = fw.mult(nodes, edges, rates, cycle)

            if (debug) {
                cat("Arbitrage cycle found!\n")
                print(nodes[cycle])
                cat("Possible profit:", profit, "\n")
            }

            break
        }
    }

    if (NROW(cycle) == 0) {
        if (debug) {
            cat("No negative cycles found :(\n")
        }
    }

    ret = list()
    ret$nodes = nodes
    ret$cycle = cycle
    ret$profit = profit

    return(ret)
}


source("mtcars_dane.r")
source("machine_dane.r")
source("imports-85_dane.r")
source("ENB2012_dane.r")

library(e1071) #biblioteka z SVM

svm_regression_mtCars <- function(){
  cat("\n\n\n SVM MTCARS \n")
  cars_train = wczytaj_mtcars()$train
  cars_test = wczytaj_mtcars()$test
  cars_columns = wczytaj_mtcars()$columns

  cars_svm_radial = svm_mtcars(cars_columns, cars_train)
  przewidziane = predict(cars_svm_radial,cars_test)
  cat("\nRMSE dla kernel 'radial' = ", rmse(cars_test$qsec,przewidziane))#~0.60968

  cars_svm_polynomial = svm_mtcars(cars_columns, cars_train, kernel = "polynomial")
  przewidziane2 = predict(cars_svm_polynomial,cars_test)
  cat("\nRMSE dla kernel 'polynomial' = ", rmse(cars_test$qsec,przewidziane2))#~0.9385

  cars_svm_sigmoid = svm_mtcars(cars_columns, cars_train, kernel = "sigmoid")
  przewidziane3 = predict(cars_svm_sigmoid,cars_test)
  cat("\nRMSE dla kernel 'sigmoid' = ", rmse(cars_test$qsec,przewidziane3))#~0.86997

  cars_svm_linear = svm_mtcars(cars_columns, cars_train, kernel = "linear")
  przewidziane4 = predict(cars_svm_linear,cars_test)
  cat("\nRMSE dla kernel 'linear' = ", rmse(cars_test$qsec,przewidziane4))#~0.3739

  ###MSE###

  cars_svm_radial = svm_mtcars(cars_columns, cars_train)
  przewidziane = predict(cars_svm_radial,cars_test)
  cat("\nMSE dla kernel 'radial' = ", mse(cars_test$qsec,przewidziane))#1.671088

  cars_svm_polynomial = svm_mtcars(cars_columns, cars_train, kernel = "polynomial")
  przewidziane2 = predict(cars_svm_polynomial,cars_test)
  cat("\nMSE dla kernel 'polynomial' = ", mse(cars_test$qsec,przewidziane2))#3.363071

  cars_svm_sigmoid = svm_mtcars(cars_columns, cars_train, kernel = "sigmoid")
  przewidziane3 = predict(cars_svm_sigmoid,cars_test)
  cat("\nMSE dla kernel 'sigmoid' = ", mse(cars_test$qsec,przewidziane3))#1.066011

  cars_svm_linear = svm_mtcars(cars_columns, cars_train, kernel = "linear")
  przewidziane4 = predict(cars_svm_linear,cars_test)
  cat("\nMSE dla kernel 'linear' = ", mse(cars_test$qsec,przewidziane4))# 0.6467646

}

svm_regression_imports <- function(){
  cat("\n\n\n SVM IMPORTS-85 \n")

  imports_train = wczytaj_imports_85()$train
  imports_test = wczytaj_imports_85()$test
  imports_columns = wczytaj_imports_85()$columns

  imports_svm_radial = svm_imports(imports_columns, imports_train)
  przewidziane = predict(imports_svm_radial,imports_test)
  cat("\nRMSE dla kernel 'radial' = ", rmse(imports_test$symboling,przewidziane))

  imports_svm_polynomial = svm_imports(imports_columns, imports_train, kernel = "polynomial")
  przewidziane2 = predict(imports_svm_polynomial,imports_test)
  cat("\nRMSE dla kernel 'polynomial' = ", rmse(imports_test$symboling,przewidziane2))

  imports_svm_sigmoid = svm_imports(imports_columns, imports_train, kernel = "sigmoid")
  przewidziane3 = predict(imports_svm_sigmoid,imports_test)
  cat("\nRMSE dla kernel 'sigmoid' = ", rmse(imports_test$symboling,przewidziane3))

  imports_svm_linear = svm_imports(imports_columns, imports_train, kernel = "linear")
  przewidziane4 = predict(imports_svm_linear,imports_test)
  cat("\nRMSE dla kernel 'linear' = ", rmse(imports_test$symboling,przewidziane4))

  ###MSE###

  cat("\nMSE dla kernel 'radial' = ", mse(imports_test$symboling,przewidziane))
  cat("\nMSE dla kernel 'polynomial' = ", mse(imports_test$symboling,przewidziane2))
  cat("\nMSE dla kernel 'sigmoid' = ", mse(imports_test$symboling,przewidziane3))
  cat("\nMSE dla kernel 'linear' = ", mse(imports_test$symboling,przewidziane4))
}

svm_regression_machine <- function(){
  cat("\n\n\n SVM MACHINE \n")

  machine_train = wczytaj_machine()$train
  machine_test = wczytaj_machine()$test
  machine_columns = wczytaj_machine()$columns

  machine_svm_radial = svm_machine(machine_columns, machine_train)
  przewidziane = predict(machine_svm_radial,machine_test)
  cat("\nRMSE dla kernel 'radial' = ", rmse(machine_test$PRP,przewidziane))

  machine_svm_polynomial = svm_machine(machine_columns, machine_train, kernel = "polynomial")
  przewidziane2 = predict(machine_svm_polynomial,machine_test)
  cat("\nRMSE dla kernel 'polynomial' = ", rmse(machine_test$PRP,przewidziane2))

  machine_svm_sigmoid = svm_machine(machine_columns, machine_train, kernel = "sigmoid")
  przewidziane3 = predict(machine_svm_sigmoid,machine_test)
  cat("\nRMSE dla kernel 'sigmoid' = ", rmse(machine_test$PRP,przewidziane3))

  machine_svm_linear = svm_machine(machine_columns, machine_train, kernel = "linear")
  przewidziane4 = predict(machine_svm_linear,machine_test)
  cat("\nRMSE dla kernel 'linear' = ", rmse(machine_test$PRP,przewidziane4))

  ###MSE###

  cat("\nMSE dla kernel 'radial' = ", mse(machine_test$PRP,przewidziane))
  cat("\nMSE dla kernel 'polynomial' = ", mse(machine_test$PRP,przewidziane2))
  cat("\nMSE dla kernel 'sigmoid' = ", mse(machine_test$PRP,przewidziane3))
  cat("\nMSE dla kernel 'linear' = ", mse(machine_test$PRP,przewidziane4))

}

svm_regression_energy <- function(){
  cat("\n\n\n SVM ENERGY \n")

  energy_train = wczytaj_energy_efficiency()$train
  energy_test = wczytaj_energy_efficiency()$test
  energy_columns = wczytaj_energy_efficiency()$columns

  energy_svm_radial = svm_energy(energy_columns, energy_train)
  przewidziane = predict(energy_svm_radial,energy_test)
  cat("\nRMSE dla kernel 'radial' = ", rmse(energy_test$HeatingLoad,przewidziane))

  energy_svm_polynomial = svm_energy(energy_columns, energy_train, kernel = "polynomial")
  przewidziane2 = predict(energy_svm_polynomial,energy_test)
  cat("\nRMSE dla kernel 'polynomial' = ", rmse(energy_test$HeatingLoad,przewidziane2))

  energy_svm_sigmoid = svm_energy(energy_columns, energy_train, kernel = "sigmoid")
  przewidziane3 = predict(energy_svm_sigmoid,energy_test)
  cat("\nRMSE dla kernel 'sigmoid' = ", rmse(energy_test$HeatingLoad,przewidziane3))

  energy_svm_linear = svm_energy(energy_columns, energy_train, kernel = "linear")
  przewidziane4 = predict(energy_svm_linear,energy_test)
  cat("\nRMSE dla kernel 'linear' = ", rmse(energy_test$HeatingLoad,przewidziane4))

  ###MSE###
  cat("\nMSE dla kernel 'radial' = ", mse(energy_test$HeatingLoad,przewidziane))
  cat("\nMSE dla kernel 'polynomial' = ", mse(energy_test$HeatingLoad,przewidziane2))
  cat("\nMSE dla kernel 'sigmoid' = ", mse(energy_test$HeatingLoad,przewidziane3))
  cat("\nMSE dla kernel 'linear' = ", mse(energy_test$HeatingLoad,przewidziane4))
}


=begin
  # sample-cayleyhamilton01.rb

  require "algebra"

  n = 4
  R = MPolynomial(Integer)
  MR = SquareMatrix(R, n)
  m = MR.matrix{|i, j| R.var("x#{i}#{j}") }
  Rx = Polynomial(R, "x")
  ch = m.char_polynomial(Rx)
  p ch.evaluate(m) #=> 0
((<_|CONTENTS>))
=end


bayes <- function(prior, likelihood, data)
{
	posterior <- matrix(0, nrow=length(data), ncol=length(prior))
	dimnames(posterior) <- list(data, names(prior))

	initial_prior = prior
	for(i in 1:length(data))
	{
		posterior[i, ] <-
			prior*likelihood[ , data[i]]/
			sum(prior * likelihood[ , data[i]])

		prior <- posterior[i , ]
	}

	return(rbind(initial_prior,posterior))
}


#impoting dataset
dataset = read.csv('50_Startups.csv')View(dataset)
# dataset = dataset[, 2:3]

# Encoding categorical data
dataset$State = factor(dataset$State,
                       levels = c('New York', 'California', 'Florida'),
                       labels = c(1, 2, 3))

#Splitting the Dataset into Training set and Test set
#install.packages('caTools')
library(caTools)
set.seed(123)
split = sample.split(dataset$Profit, SplitRatio = 0.8)
training_set = subset(dataset, split == TRUE)
test_set = subset(dataset, split == FALSE)

#Fitting MLR to the Training Set
regressor = lm(formula = Profit ~ R.D.Spend + Administration + Marketing.Spend + State , data = training_set)

#predecting the test set result
y_pred = predict(regressor, newdata = test_set)

backwardElimination <- function(x, sl) {
  numVars = length(x)
  for (i in c(1:numVars)){
    regressor = lm(formula = Profit ~ ., data = x)
    maxVar = max(coef(summary(regressor))[c(2:numVars), "Pr(>|t|)"])
    if (maxVar > sl){
      j = which(coef(summary(regressor))[c(2:numVars), "Pr(>|t|)"] == maxVar)
      x = x[, -j]
    }
    numVars = numVars - 1
  }
  return(summary(regressor))
}

SL = 0.05
dataset = dataset[, c(1,2,3,4,5)]
backwardElimination(training_set, SL)


# SCRIPT

lines <- readLines("data/pe_0008.txt")
digit <- as.integer(unlist(strsplit(lines, "")))

i <- 0
hold <- 0
vec <- c(0, 0, 0, 0)

for (n in digit) {
    vec[1 + i %% 4] <- n
    p <- prod(vec)
    if (hold < p) {
        hold <- p
    }
    i <- i + 1
}

message(hold)


# Include libraries
library(ggplot2)

# Read data
df = read.csv(file = "./housePrices.csv", header = TRUE)

# Create pdf file
pdf("housePrices.pdf", width=4, height=2)

# Create plot base
#   (source data, labels and axis limits)
base = ggplot(df, aes(x=sqft, y=price)) +
        labs(x = "Size (square feet)", y = "Price (1000s dollars)") +
        ylim(0, 500) +
        xlim(0, 3000)

# Create and plot fig1 (scatter plot)
fig1 = base +
    geom_point(colour = "#4FC1BB", alpha = 0.6, size = 2)

plot(fig1)

# Create and plot fig2 (add prediction event)
fig2 = fig1 +
    geom_vline(xintercept=1250, colour = "#FF4D48", linetype="dashed")

plot(fig2)

# Create and plot fig3 (scatter with fit regression line)
fig3 = base +
    geom_point(colour = "#4FC1BB", alpha = 0.3, size = 2) +
    geom_smooth(method = "lm", se = FALSE, colour = "#4FC1BB") +
    geom_vline(xintercept=1250, colour = "#FF4D48", linetype="dashed") +
    geom_point(x = 1250, y = 250, alpha = 0.8, size = 2, colour = "#FF4D48", shape=4)

plot(fig3)


physics.volume.calculate.sphere <- function(radius) {
    return((4/3) * pi * radius^3)
}


# n = 20;
# alpha = 0.01;
# x = rnorm(n, mean=10.5, sd=1.3);
#
# # 1.1
# hypothesisTest = t.test(x, mu=10, conf.level = 1-alpha);
# print(hypothesisTest);
#
# #1.1.a
# avg = mean(x);
# stDev = sd(x);
#
# critVal = qt(1-alpha/2, n-1, lower.tail = TRUE);
# lowBound = avg - (stDev * critVal)/sqrt(n);
# upBound = avg + (stDev * critVal)/sqrt(n);
# print((stDev * critVal)/sqrt(n))
#
# #!.1.b
# #TODO if
# print(lowBound);
# print(upBound);
#
# #1.1.c TODO if
# tVal = sqrt(n)*(avg-10)/stDev;
# critVal = qt(1-alpha/2, n-1, lower.tail = TRUE);
#
# lowBound = pt(tVal, n-1, lower.tail = FALSE);
# upBound = pt(tVal, n-1, lower.tail = TRUE);
# pVal = 2*min(lowBound, upBound);
# print(2*lowBound);
# print(2*upBound);
#
# #1.2
# #vybereme jednostranny t-test a cele to zopakujeme
# #Expiricky vime, ze avg = 10.5 a u = 10, proto je vyhodnejsi alternativa greater, protoze s danou pravdepodobnosti jsme schopni rict, ze hodnota je vetsi nez deset. Diky vlastnostem generovanych dat takto casteji zavrhneme H0 a pouzijeme Halph
#
# n = 20;
# alpha = 0.01
# x = rnorm(n, mean=10, sd=1)
# error = rnorm(n, mean=0.5, sd=0.8306624)
# y = x + error
#
# t.test(x, y=y, paired = TRUE, alternative = "less", conf.level = 1-alpha)
#

#2.1
# n = 20;
# alpha = 0.01
# x = rnorm(n, mean=10, sd=1)
# error = rnorm(n, mean=0.5, sd=0.8306624)
# y = x + error
#
# t.test(x, y=y, paired = TRUE, alternative = "less", conf.level = 1-alpha)

# n = 20;
# alpha = 0.01
# x = rnorm(n, mean=10, sd=1)
# error = rnorm(n, mean=0.5, sd=0.8306624)
# y = x + error
#
# res = t.test(x, y=y, paired = TRUE, alternative = "less", conf.level = 1-alpha)
# print(res)
# if(abs(res$statistic) > qt(1-alpha, n-1, lower.tail = TRUE)) {
#   print('Reject null hypothesis!')
# }

# 2.1.b
# res = t.test(x-y, alternative = "less", conf.level = 1-alpha)
# print(res)

#2.2
# n1 = 20;
# n2 = 25;
# alpha = 0.01
# x=rnorm(n1, mean=10, sd=1.3)
# y=rnorm(n2, mean=11.25, sd=1.3)
# res = t.test(x, y=y, paired = FALSE, var.equal = TRUE, alternative = "less", conf.level = 1-alpha)
# print(res)
# if(abs(res$statistic) > qt(1-alpha, n1+n2-2, lower.tail = TRUE)) {
#   print('Reject null hypothesis!')
# }

n1 = 20;
n2 = 25;
alpha = 0.01
x=rnorm(n1, mean=10, sd=1.3)
y=rnorm(n2, mean=11.28, sd=1.2)
res = t.test(x, y=y, paired = FALSE, var.equal = FALSE, alternative = "less", conf.level = 1-alpha)
print(res)
if(abs(res$statistic) > qt(1-alpha, n1+n2-2, lower.tail = TRUE)) {
  print('Reject null hypothesis!')
}

#
# #2.2
# n1 = 20;
# n2 = 25;
# alpha = 0.01
# x=rnorm(n1, mean=10, sd=1.3)
# y=rnorm(n2, mean=11.25, sd=1.3)
#
# res = t.test(x, y=y, paired = FALSE, var.equal = TRUE, alternative = "less", conf.level = 1-alpha)
# print(res);

df = n1 + n2 - 2;
sdiff = sqrt(var(x)/n1+var(y)/n2);
tVal = (mean(x)-mean(y))/(sdiff);
print(tVal)
if(abs(tVal) > qt(1-alpha, df, lower.tail = TRUE)) {
  print('Reject null hypothesis!')
}

# critVal = qt(1-alpha, df, lower.tail = TRUE);
#print(pt(tVal, df, lower.tail = TRUE))
#print(qt(res$p.value, df));

#2.3
# n1 = 20;
# n2 = 25;
# alpha = 0.01
# x=rnorm(n1, mean=10, sd=1.3)
# y=rnorm(n2, mean=11.28, sd=1.2)

# t.test(x, y=y, paired = FALSE, var.equal = FALSE, conf.level = 1-alpha)
#zodpadkovat vsechny kroky
#bude nutne prepsat vypocet bodu 2.2 podle vzorce pro rozdilne rozptyly
#... kdyz se muze clovek rozptylovat, muze se i ptylovat?

#3.1.a,b,c
# sequenceLength = 4000000;
# x = runif(sequenceLength, 0, 100)
# print(system.time(sort(x)))

#pouzijeme hypotezu X1 < X2 ..tj, je algoritmus X1 v prumeru rychlejsi?
#


# File:   Plot.R
# Course: R: An Introduction (with RStudio)

# LOAD DATASETS PACKAGES ###################################

library(datasets)  # Load/unload base packages manually

# LOAD DATA ################################################

head(iris) # Shows first 6 entries of the dataset iris.

# PLOT DATA WITH PLOT() ####################################

?plot  # Help for plot()

plot(iris$Species)  # Categorical variable, here we do plot(dataFrameName$VariableToPlot)
plot(iris$Petal.Length)  # Quantitative variable
plot(iris$Species, iris$Petal.Width)  # Cat x quant
plot(iris$Petal.Length, iris$Petal.Width)  # Quant pair
plot(iris)  # Entire data frame

# Plot with options
plot(iris$Petal.Length, iris$Petal.Width,
  col = "#cc0000",  # Hex code for datalab.cc red
  pch = 19,         # Use solid circles for points
  main = "Iris: Petal Length vs. Petal Width",
  xlab = "Petal Length",
  ylab = "Petal Width")

# PLOT FORMULAS WITH PLOT() ################################

plot(cos, 0, 2*pi)
plot(exp, 1, 5)
plot(dnorm, -3, +3)

# Formula plot with options
plot(dnorm, -3, +3,
  col = "#cc0000",
  lwd = 5,
  main = "Standard Normal Distribution",
  xlab = "z-scores",
  ylab = "Density")

# CLEAN UP #################################################

# Clear packages
detach("package:datasets", unload = TRUE)

# Clear plots
dev.off()  # But only if there IS a plot

# Clear console
cat("\014")  # ctrl+L

# Clear mind :)


#равномерно разпределение - равномерно разпределени случайни величини в интервал [a,b]
#функцията unif() с префикси d,p,q,r за съответно плътност, разпределние, квантил и случайно разпределение(симулиране)

#100 случайни равномерно разпределени величини в интервала [0,2]
x = runif(n = 100, min = 0, max = 2)
hist(x, probability=TRUE, col=gray(.9), main="uniform on [0,2]") #хистограма на разпределението
curve(dunif(x,0,2),add=T) #теоретична плътност -> dunif(x,0,2) всяка от случайните величини с каква вероятност да се случи е

#генериране на извадка -> измежду числата x (от 1 до х, ако х е число, а не вектор), се взимат по случаен начин size числа
sample(x = 1:10, size = 10)
sample(x = 10, size = 10, replace = TRUE) #може да има повторения

#геометрично разпределение - частен случай на отрицателно биномното, кoгато искаме да имаме x неуспеха преди първия успех с вероятност за успех prob
#функцията geom() с префикси d,p,q,r за съответно плътност, разпределние, квантил и случайно разпределение(симулиране)
Y=0:10
plot(Y, dgeom(x = Y, prob = 0.6), type="h", ylim=c(0,1), main="Geometric distribution for p=0.6", ylab="P(Y=Y)", xlab="Y=Number of failures before first success")

#екцпоненциално разпределение - непрекъсната случайна величнина
#функцията exp() с префикси d,p,q,r за съответно плътност, разпределние, квантил и случайно разпределение(симулиране)
mu = 2500
x = rexp(n = 100, rate = 1/mu) #100 случайни експоненциално разпределени величини с вероятност 1/mu
hist(x,probability=TRUE,col=gray(.9),main="exponential mean=2500") #хистограма
curve(dexp(x = x, rate = 1/2500),add=T) #теоретична плътност

#нормално разпределение - очакване(средно) mu и дисперсия sigma (стандартно отклонение sigma)
#функцията norm() с префикси d,p,q,r за съответно плътност, разпределние, квантил и случайно разпределение(симулиране)
#на финкцията се подава очакване (mu) и стандартно отклонение (sigma)
x=c(1:200)
plot(dnorm(x, 100,10), ylim=c(0,0.1))
lines(dnorm(x, 100,5), col="red")
lines(dnorm(x, 130,10), col="blue")

#стандартно нормално разпределение - нормално разпределение с очакване 0 и дисперсия 1
#по подразбиране в norm(x, mu = 0, sd = 1)
#за нормализиране се използва формулата y = (x - mu)/sigma
#където х е нормално разпределена случайна величина с очакване mu и дисперсия sigma^2,
#а у е стандарна нормално разпределене случайна величина

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

#01
#геометрично разпределение с вероятност 1/2, 1/3, 2/3
y=0:10 #случайни числа(за онагледяване)
plot(x = y, dgeom(x = y, prob = 1/2), ylim=c(0,0.8), ylab = "Probability", xlab = "Number of fails before the first success")
lines(x = y, dgeom(x = y, prob = 1/3), col="red")
lines(x = y, dgeom(x = y, prob = 2/3), col="blue")

#02
#експоненциално разпределение с mu =5
k.30 = dexp(x = 5, rate = 1/5)
plot(x = 1:30, y = dexp(x = 1:30, rate = 1/5), main = "Exponentila with mu = 5", ylab = "P(X = x)")

#03
x = rnorm(n = 50, mean = 5, sd = 5) #N(5,5) означава дисперсия 5 = sigma^2 => стандартно отклонение sigma = sqrt(5), но в случая няма значение :)
x.norm = (x - 5)/5
hist(x.norm, probability = TRUE)
x.standart = rnorm(50)
hist(x.standart, probability = TRUE)

#04
#z стандартно нормално разоределена случайна величина
pnorm(q = 0.92 , lower.tail = FALSE) #P(Z > 0.92)
pnorm(q = -0.5, lower.tail = FALSE) #P(Z > -0.5) = P(Z < 0.5)
#P(-0.64 < Z < 0.43) = P(Z < 0.43) - P(Z > -0.64)
pnorm(0.43) - pnorm(-0.64, lower.tail = FALSE)

#05
#x нормално разпределено с mu = 3 и sigma^2 = 4
pnorm(q = 6.2, mean = 3, sd = 2)

#06
pnorm(q = 3100, mean = 3500, sd = 500)
pnorm(-4/5) #нормирано z = (3100 - 3500)/500 = -4/5 е стандартно нормално разпределено N(0,1)

#07
#X = N(80, 10^2), Y=N(78, 13^2) => X-Y = N(80-78, 10^2 + 13^3) = N(2,269)
pnorm(0,2,sqrt(269),lower.tail = FALSE) #искаме Х > Y => X - Y > 0


#'@title Compute and return the degree measure of the angle of the slope of the time series.
#'
#'@description The time series is fitted with a linear model and the degree measure of the angle of the slope is returned.
#'
#'@usage  angleMagnitude <- getSlopeAngleSize(tsData)
#'
#'@param tsData A time series object.
#'
#'@return A numeric value representing the degree measure of the angle of the slope of the time series.
#'
#'@export

getSlopeAngleSize <- function(tsData)
{

    tsObj    <- tsData
	tsObj.lm <- lm(tsObj ~ time(tsObj))

	degreeAngleMeasure <- as.numeric(atan(tsObj.lm$coefficients[2])*(180/pi))

	return (degreeAngleMeasure)

}


#' Scale variable to have range between 0 and 1
#'
#' @param x Vector
#'
#' @export
#' @return Vector
range01 <- function(x)
{
	(x-min(x))/(max(x)-min(x))
}

#' Translate risk from liability to probability scale
#'
#' @param gx score on liability scale
#' @param h2x Disease heritability on liability scale
#' @param prev Prevalence
#'
#' @export
#' @return Vector of disease probabilities
gx_to_gp <- function(gx, h2x, prev)
{
	x_prime <- qnorm(prev, 0, 1)
	p <- pnorm(x_prime, mean=gx, sd = sqrt(1 - h2x), lower.tail=FALSE)
	return(p)
}

#' Plot liability vs probability disease risk
#'
#' @param x Disease risk on liability scale
#' @param o Disease risk on probability scale
#' @param xlab default="Values (low to high)"
#' @param ylab default=""
#' @param title default=""
#' @param xname Name of liability. Default="GRS"
#' @param oname Name of disease. Default="Disease"
#'
#' @export
#' @return ggplot
risk_cross_plot <- function(x, o, xlab="Values (low to high)", ylab="", title="", xname="GRS", oname="Disease")
{
	d <- dplyr::tibble(
		value = c(range01(o), range01(x)),
		key = c(rep(oname, length(o)), rep(xname, length(x))),
		gr = rep(1:length(x), times=2)
	)
	d$key <- factor(d$key, levels=c(xname, oname))
	ggplot2::ggplot(d, ggplot2::aes(x=value, y=key)) +
	ggplot2::geom_line(ggplot2::aes(group=gr), alpha=0.1) +
	ggplot2::geom_point(ggplot2::aes(colour=key)) +
	ggplot2::labs(x=xlab,y=ylab,title=title) +
	ggplot2::scale_colour_discrete(guide=FALSE) +
	ggplot2::theme(axis.text.x=ggplot2::element_blank(),axis.ticks.x=ggplot2::element_blank())
}

#' Make simulation to compare disease and liability scales
#'
#' Compares the liability and probability of disease under two scenarios - where all SNPs are known, and where only some SNPs are known
#'
#' @param G Matrix of genotypes
#' @param eff SNP effects on liability scale
#' @param prevalence Disease prevalence
#' @param prop_discovered Proportion of SNPs discovered
#'
#' @export
#' @return Data frame
risk_simulation <- function(G, eff, prevalence, prop_discovered)
{
	nid <- nrow(G)
	nsnp <- ncol(G)
	gx_true <- scale(G) %*% eff
	h2x <- var(gx_true)
	prob_disease <- gx_to_gp(gx_true, h2x, 1-prevalence)
	disease <- rbinom(nid, 1, prob_disease)
	eff_pred <- eff
	eff_pred[sample(1:nsnp, nsnp * (1-prop_discovered))] <- 0
	gx_pred <- as.numeric(G %*% eff_pred / sqrt(nsnp))
	dat <- dplyr::tibble(gx_true=as.numeric(gx_true), gx_pred=gx_pred, prob_disease=as.numeric(prob_disease), disease=disease)
	return(dat)
}


library(reshape2)
library(data.table)
library(ggplot2)

rm(list = ls())
setwd("~/JUNJIE/WebScraper_Research2020S")

gdp_province <- read.csv("data/20yrs_GDPbyProvince.csv")
count_province <- read.csv("data/by_province_count.csv")

# data melt wide to long;

gdp_province_long <- melt(setDT(gdp_province),
                          id.vars = c("地区"), variable.name = "year")
gdp_province_long$year <- as.character(gdp_province_long$year)
gdp_province_long$year <- gsub('X', '', gdp_province_long$year)
gdp_province_long$year <- gsub('年', '', gdp_province_long$year)

test <- reshape(gdp_province_long, idvar = "地区", timevar = "year", direction = "wide")

colnames(test) <- c(
  "area",
  2019,
  2018,
  2017,
  2016,
  2015,
  2014,
  2013,
  2012,
  2011,
  2010,
  2009,
  2008,
  2007,
  2006,
  2005,
  2004,
  2003,
  2002,
  2001
)

gdp_province_long$year <- as.Date(gdp_province_long$year, format =  "%Y")
gdp_province_long$Year <- format(gdp_province_long$year, format="%Y")

colnames(gdp_province_long) <- c(
  "area",
  "date",
  "value",
  "Year"
)

ggplot(
  data = gdp_province_long ,
  aes(x = as.numeric(Year)
      , y = value, color = area )
)  + geom_line(show.legend = FALSE) + geom_point(show.legend = FALSE) +
  theme(text = element_text(family='Kai') )   + facet_wrap(~ area, scales = "free")

library(tidyverse)
gdp_province_long <- gdp_province_long[order(Year),]

growth <- ddply(gdp_province_long,"area",transform,
    Growth=c(NA,exp(diff(log(value)))-1))

ggplot(
  data = growth ,
  aes(x = as.numeric(Year)
      , y = Growth, color = area )
)  + geom_line(show.legend = FALSE) + geom_point(show.legend = FALSE) +
  theme(text = element_text(family='Kai') )   + facet_wrap(~ area, scales = "free") +
  labs(
    x = NULL,
    Y = NULL,
    title = "Growth Rate by province"
  )

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


# Logistic Regression
dataset = read.csv('Social_Network_Ads.csv')
dataset = dataset[, 3:5]

library(caTools)
library(ElemStatLearn)
set.seed(123)

# Splitting the dataset into the Training Set
split = sample.split(dataset$Purchased, SplitRatio = 0.75)
training_set = subset(dataset, split == TRUE)
test_set = subset(dataset, split == FALSE)

# Feature Scaling
training_set[, 1:2] = scale(training_set[, 1:2])
test_set[, 1:2] = scale(test_set[, 1:2])

# Fitting Logistic Regression to the Training Set
classifier = glm(formula = Purchased ~ .,
                 family = binomial,
                 data = training_set)

# Predicting the Test set results
prob_pred = predict(classifier, type = 'response', newdata = test_set[-3])
y_pred = ifelse(prob_pred > 0.5, 1, 0)

# Making the Confusion Matrix
cm = table(test_set[, 3], y_pred)

# Visualising the Training set results
set = training_set
X1 = seq(min(set[, 1]) - 1, max(set[, 1]) + 1, by = 0.01)
X2 = seq(min(set[, 2]) - 1, max(set[, 2]) + 1, by = 0.01)
grid_set = expand.grid(X1, X2)
colnames(grid_set) = c('Age', 'EstimatedSalary')
prob_set = predict(classifier, type = 'response', newdata = grid_set)
y_grid = ifelse(prob_set > 0.5, 1, 0)
plot(set[, -3],
     main = 'Logistic Regression (Training Set)',
     xlab = 'Age', ylab = 'Estimated Salary',
     xlim = range(X1), ylim = range(X2))
contour(X1, X2, matrix(as.numeric(y_grid), length(X1), length(X2)), add = TRUE)
points(grid_set, pch = '.', col = ifelse(y_grid == 1, 'springgreen3', 'tomato'))
points(set, pch = 21, bg = ifelse(set[, 3] == 1, 'green4', 'red3'))

# Visualising the Test set results
set = test_set
X1 = seq(min(set[, 1]) - 1, max(set[, 1]) + 1, by = 0.01)
X2 = seq(min(set[, 2]) - 1, max(set[, 2]) + 1, by = 0.01)
grid_set = expand.grid(X1, X2)
colnames(grid_set) = c('Age', 'EstimatedSalary')
prob_set = predict(classifier, type = 'response', newdata = grid_set)
y_grid = ifelse(prob_set > 0.5, 1, 0)
plot(set[, -3],
     main = 'Logistic Regression (Test Set)',
     xlab = 'Age', ylab = 'Estimated Salary',
     xlim = range(X1), ylim = range(X2))
contour(X1, X2, matrix(as.numeric(y_grid), length(X1), length(X2)), add = TRUE)
points(grid_set, pch = '.', col = ifelse(y_grid == 1, 'springgreen3', 'tomato'))


# large scale approximation
n<-25
alpha<-0.05
z.half.alpha=qnorm(1-alpha/2)
C_alpha2_n=(n/2)-z.half.alpha*sqrt(n/4)
print(C_alpha2_n)


library(BIBtests, quietly=TRUE)

CHECK <- function(test, truth) stopifnot(all.equal(test, truth))
TESTING <- function(what) cat(paste0(what, ": "))
OK <- function() cat("ok!\n")

set.seed(1234)
len = 100
x = rnorm(len)
y = rnorm(len)

cat("# Level 1\n")

TESTING("dotprod")
test = bib_dotprod(x, y)
truth = sum(x*y)
CHECK(test, truth)
OK()

TESTING("vnorm")
test = bib_vnorm(x)
truth = sqrt(sum(x*x))
CHECK(test, truth)
OK()

TESTING("vcopy and vscale")
alpha = 3.14159
test = bib_vscale(alpha, x)
truth = alpha*x
CHECK(test, truth)
OK()

cat("\n")


library(ggplot2)

gdURL <- "http://tiny.cc/gapminder"
gDat <- read.delim(file = gdURL) # pick one
gDat <- read.delim("gapminderDataFiveYear.txt")
str(gDat)

ggplot(gDat, aes(x = gdpPercap, y = lifeExp)) # nothing to plot yet!

p <- ggplot(gDat, aes(x = gdpPercap, y = lifeExp)) # just initializes

p + geom_point()
#p + layer(geom = "point")

## log transformation ... quick and dirty
ggplot(gDat, aes(x = log10(gdpPercap), y = lifeExp)) + geom_point()
p + geom_point() + scale_x_log10() # a bit better

p <- p + scale_x_log10() # let's make that stick

## convey continent by color
p + geom_point(aes(color = continent))
ggplot(gDat, aes(x = gdpPercap, y = lifeExp, color = continent)) +
  geom_point() + scale_x_log10() # in full detail, up to now

## address overplotting
p + geom_point(alpha = (1/3), size = 5)

## add a smooth regression line
p + geom_point() + scale_x_log10() + geom_smooth(lwd = 3, se = FALSE)

p + geom_point() + scale_x_log10() +
  geom_smooth(lwd = 3, se = FALSE, method = "lm")

p + aes(color = continent) + geom_point() + geom_smooth(lwd = 3, se = FALSE)

## connect the dots scatterplot of lifeExp over year for one country
ggplot(subset(gDat, country == "Zimbabwe"),
       aes(x = year, y = lifeExp)) + geom_line() + geom_point()
## geom_path() works here to because our data already sorted on year

## stripplots of lifeExp by continent

ggplot(gDat, aes(x = continent, y = lifeExp)) + geom_point()

ggplot(gDat, aes(x = continent, y = lifeExp)) + geom_jitter()

ggplot(gDat, aes(x = continent, y = lifeExp)) +
  geom_jitter(position = position_jitter(width = 0.1),
              alpha = 1/4)

ggplot(gDat, aes(x = continent, y = lifeExp)) + geom_boxplot()

## distribution of a quant var

ggplot(gDat, aes(x = lifeExp)) + geom_histogram()

ggplot(gDat, aes(x = lifeExp)) + geom_density()

# weird to stack up the histograms?
ggplot(gDat, aes(x = lifeExp, fill = continent)) + geom_histogram()

ggplot(gDat, aes(x = lifeExp, fill = continent)) +
  geom_histogram(position = "identity")

ggplot(gDat, aes(x = lifeExp, color = continent)) + geom_density()

ggplot(gDat, aes(x = lifeExp, fill = continent)) +
  geom_density(alpha = 0.2)

## bar chart

table(gDat$continent)
ggplot(gDat, aes(x = continent)) + geom_bar()
ggplot(gDat, aes(x = continent)) + geom_bar() + coord_flip()
ggplot(gDat, aes(x = continent)) + geom_bar(width = 0.05) + coord_flip()

ggplot(gDat, aes(x = gdpPercap, y = lifeExp)) +
  scale_x_log10() + geom_bin2d()

# facetting

p + geom_point() + facet_wrap(~ continent)

p + geom_point() + facet_wrap(~ continent) + geom_smooth(lwd = 2, se = FALSE)

ggplot(gDat, aes(x = lifeExp)) + geom_density() +
  facet_wrap(~ continent)

ggplot(gDat, aes(x = lifeExp, fill = continent)) + geom_histogram() +
  facet_wrap(~ continent)

ggplot(subset(gDat, subset = year == 2007),
       aes(x = continent, y = lifeExp)) + geom_point()

ggplot(subset(gDat, subset = year == 2007),
       aes(x = continent, y = lifeExp)) +
  geom_jitter(position = position_jitter(width = .2))

## shock and awe
gdURL <- "http://www.stat.ubc.ca/~jenny/notOcto/STAT545A/examples/gapminder/data/gapminderCountryColors.txt"
countryColors <- read.delim(file = gdURL, as.is = 3) # protect color
str(countryColors)
head(countryColors)
jYear <- 2007 # this can obviously be changed
jPch <- 21
jDarkGray <- 'grey20'
jXlim <- c(150, 115000)
jYlim <- c(16, 100)

## needed for ggplot2 scale_fill_manual()
jColors <- countryColors$color
names(jColors) <- countryColors$country

## needed for lattice cex
jCexDivisor <- 1500                     # arbitrary scaling constant

ggplot(subset(gDat, year == jYear),
       aes(x = gdpPercap, y = lifeExp)) +
  scale_x_log10(limits = jXlim) + ylim(jYlim) +
  geom_point(aes(size = sqrt(pop/pi)), pch = jPch, color = jDarkGray,
             show_guide = FALSE) +
  scale_size_continuous(range=c(1,40)) +
  facet_wrap(~ continent) + coord_fixed(ratio = 1/43) +
  aes(fill = country) + scale_fill_manual(values = jColors) +
  theme_bw() + theme(strip.text = element_text(size = rel(1.1)))

ggplot(gDat, aes(x = year, y = lifeExp, group = country)) +
  geom_line(lwd = 1, show_guide = FALSE) + facet_wrap(~ continent) +
  aes(color = country) + scale_color_manual(values = jColors) +
  theme_bw() + theme(strip.text = element_text(size = rel(1.1)))

## below here experimental ....

## this needs to be using *my* country colors
ggplot(subset(gDat, subset = year %% 10 == 2 & continent != "Oceania"),
       aes(x = gdpPercap, y = lifeExp, color = country)) +
  geom_point(show_guide = FALSE) +
  scale_x_log10() + facet_grid(continent ~ year)


########## Code for working with R packages ##########

# Manage R packages
# List the packages needed
packages <- c("tidyverse","summarytools")

# Check if each package is installed already. If not, install the package.
for (i in packages){
  if(! i %in% installed.packages()){
    install.packages(i,dependencies = TRUE)
  }
  # Show each package that is checked.
  print(i)

  # Load each package into memory so we can use it.
  library(i,character.only=TRUE)
}

########## Code for data exploration ##########

# Skewness and Kurtosis like SPSS
# http://www.stat.cmu.edu/~hseltman/files/spssSkewKurtosis.R
spssSkewKurtosis=function(x) {
  w=length(x)
  m1=mean(x)
  m2=sum((x-m1)^2)
  m3=sum((x-m1)^3)
  m4=sum((x-m1)^4)
  s1=sd(x)
  skew=w*m3/(w-1)/(w-2)/s1^3
  sdskew=sqrt( 6*w*(w-1) / ((w-2)*(w+1)*(w+3)) )
  kurtosis=(w*(w+1)*m4 - 3*m2^2*(w-1)) / ((w-1)*(w-2)*(w-3)*s1^4)
  sdkurtosis=sqrt( 4*(w^2-1) * sdskew^2 / ((w-3)*(w+5)) )
  mat=matrix(c(skew,kurtosis, sdskew,sdkurtosis), 2,
             dimnames=list(c("skew","kurtosis"), c("estimate","se")))
  return(mat)
}

# I split these into separate functions to use with dplyr
# http://www.stat.cmu.edu/~hseltman/files/spssSkewKurtosis.R
skewFunct=function(x, na.rm=FALSE){
  w = ifelse(na.rm==TRUE,length(x)-sum(is.na(x),na.rm=TRUE),length(x))
  m1=mean(x,na.rm=na.rm)
  m2=sum((x-m1)^2,na.rm=na.rm)
  m3=sum((x-m1)^3,na.rm=na.rm)
  m4=sum((x-m1)^4,na.rm=na.rm)
  s1=sd(x,na.rm=na.rm)
  skew=w*m3/(w-1)/(w-2)/s1^3
  return(skew)
}
kurtosisFunct=function(x, na.rm=FALSE){
  w = ifelse(na.rm==TRUE,length(x)-sum(is.na(x),na.rm=TRUE),length(x))
  m1=mean(x)
  m2=sum((x-m1)^2)
  m3=sum((x-m1)^3)
  m4=sum((x-m1)^4)
  s1=sd(x)
  kurtosis=(w*(w+1)*m4 - 3*m2^2*(w-1)) / ((w-1)*(w-2)*(w-3)*s1^4)
  return(kurtosis)
}
SEskewFunct=function(x, na.rm=FALSE){
  w = ifelse(na.rm==TRUE,length(x)-sum(is.na(x),na.rm=TRUE),length(x))
  m1=mean(x)
  m2=sum((x-m1)^2)
  m3=sum((x-m1)^3)
  m4=sum((x-m1)^4)
  s1=sd(x)
  sdskew=sqrt( 6*w*(w-1) / ((w-2)*(w+1)*(w+3)) )
  return(sdskew)
}
SEkurtosisFunct=function(x, na.rm=FALSE){
  w = ifelse(na.rm==TRUE,length(x)-sum(is.na(x),na.rm=TRUE),length(x))
  m1=mean(x)
  m2=sum((x-m1)^2)
  m3=sum((x-m1)^3)
  m4=sum((x-m1)^4)
  s1=sd(x)
  sdskew=sqrt( 6*w*(w-1) / ((w-2)*(w+1)*(w+3)) )
  sdkurtosis=sqrt( 4*(w^2-1) * sdskew^2 / ((w-3)*(w+5)) )
  return(sdkurtosis)
}

# Example of getting useful descriptive statistics for numeric variables.
dataset %>%
  dplyr::select(interval,ratio) %>%
  dplyr::summarise_each(funs(class = class
                             , valid = sum(!is.na(.),na.rm = TRUE)
                             , missing = sum(is.na(.))
                             , misspercent = scales::percent(round(sum(is.na(.))/sum(!is.na(.),na.rm = TRUE),2))
                             , min = min(.,na.rm = TRUE)
                             , q25 = quantile(., 0.25,na.rm = TRUE)
                             , median = median(.,na.rm = TRUE)
                             , q75 = quantile(., 0.75,na.rm = TRUE)
                             , max = max(.,na.rm = TRUE)
                             , range = diff(range(.))
                             , mean = round(mean(.,na.rm = TRUE),2)
                             , sd = round(sd(.,na.rm = TRUE),2)
                             , variance = round(var(.,na.rm = TRUE),2)
                             , skewness = round(skewFunct(.,na.rm = TRUE),2)
                             , SEskewness = round(SEskewFunct(.,na.rm = TRUE),2)
                             , kurtosis = round(kurtosisFunct(.,na.rm = TRUE),2)
                             , SEkurtosis = round(SEkurtosisFunct(.,na.rm = TRUE),2)
                             , ShapWilk = ifelse(sd(.)!=0,round(shapiro.test(.)$statistic,2),NA)
                             , ShapWilkp = ifelse(sd(.)!=0,round(shapiro.test(.)$p.value,2),NA))) %>%
  tidyr::gather(stat,val) %>%
  tidyr::separate(stat, into = c("var", "stat"), sep = "_") %>%
  tidyr::spread(stat, val) %>%
  dplyr::select(var
                , class
                , valid
                , missing
                , misspercent
                , min
                , q25
                , median
                , q75
                , max
                , range
                , mean
                , sd
                , variance
                , skewness
                , SEskewness
                , kurtosis
                , SEkurtosis
                , ShapWilk
                , ShapWilkp) %>% # reorder
  print()

# Start of some code for looking at descriptive statistics for categorical variables
dataset %>%
  dplyr::select(nominal, ordinal) %>%
  dplyr::summarise_each(funs(class = class
                             , valid = sum(!is.na(.),na.rm = TRUE)
                             , missing = sum(is.na(.))
                             , misspercent = scales::percent(round(sum(is.na(.))/sum(!is.na(.)
                                                                                ,na.rm = TRUE),2))
                             , cats = n_distinct)) %>%
  tidyr::gather(stat,val) %>%
  tidyr::separate(stat, into = c("var", "stat"), sep = "_") %>%
  tidyr::spread(stat, val) %>%
  dplyr::select(var
                , class
                , valid
                , missing
                , misspercent
                , cats) %>% # reorder
  print()

# https://beta.rstudioconnect.com/content/3350/dplyr_tutorial.html
dataset %>%
  dplyr::group_by(nominal) %>%
  dplyr::summarize(frequency = n()) %>%
  dplyr::arrange(desc(frequency)) %>%
  dplyr::mutate(relative_frequency = frequency/sum(frequency),
                relative_cumulative_frequency = cumsum(relative_frequency),
                relative_frequency = round(100*relative_frequency,2),
                relative_cumulative_frequency = round(100*relative_cumulative_frequency,2),
                nr = row_number(-frequency)) %>%
  dplyr::select(nr, everything())


#Adjacency matrix1 i/p based on given undirected graph
adj_mat1 <- matrix(c(0,1,0,0,3,0,1,2,2,1,0,0,0,2,0
                    ,1,1,1,0,1,1,0,0,0,3,0,1,0
                    ,0,0,0,0,1,0,0,2),byrow = T,6,6)
show(adj_mat1)
degree <- rowSums(adj_mat1)
vertex <- seq(1,6)
show(data.frame(vertex,degree))

#Adjacency matrix2 i/p based on given directed graph
adj_mat2 <- matrix(c(0,0,0,1,0,0,0,0,1,0,0,0,1,0,0
                     ,0,1,0,0,0,0,0,0,1,0,0,0,
                     1,0,1,0,1,0,0,0,0),byrow = T,6,6)
show(adj_mat2)
degree_in <- rowSums(adj_mat2)
degree_out <- colSums(adj_mat2)
show(data.frame(vertex,degree_in,degree_out))


# Example : 3   Chapter : 8.3     Page No: 433
# Markov matrix Application.
A<-matrix(c(0,0.5,0.5,0.5,0,0.5,0.5,0.5,0),ncol=3)
u0<-c(8,16,32)
u1<-A%*%u0
u2<-A%*%u1
u3<-A%*%u2
print("Populations in three groups in subsequent months")
print(u1)
print(u2)
print(u3)


#' Compute the phase spectrum of a timeseries.
#'
#' @param t Sampling times of the timeseries.
#' @param x Value of the timeseries at each sample time.
#' @param omega Angular frequencies to evaluate periodogram at.
#' @param demeaned Whether timeseries has already been de-meaned.
#'
#' @return Values of phase spectrum at angular frequencies specified.
#'
#' @examples
#' phase.spectrum(1:10, sin(1:10), 2*pi/1:10, FALSE)
#'
#' @export
phase.spectrum <- function(t, x, omega,
                           demeaned = FALSE) {

    ## De-mean, if not already done. ##
    if (!demeaned) {
        x <- x - mean(x)
    }

    tau <- tau(t, omega)

    f1 <- periodogram.phase.component(t, x, omega, tau, "sin")
    f2 <- periodogram.phase.component(t, x, omega, tau, "cos")

    atan2(-f1, f2) %% (2*pi)

}


library(stats)

#' Drop NAs by Columns
#'
#' Remove NAs based on specified columns in the data
#' @param data data.frame object of variations
#' @param desiredCols list of columns from which incomplete cases should be dropped
#'
#' @return dataframe with removed observations
#' @examples
#' data<-data.frame(a=1:4,b=c("a","b","c","d"),c=c(NA,"keep",NA,"keep"))
#' completeFun(data,c("c"))
#'
#' @export
completeFun <- function(data, desiredCols) {
  completeVec <- complete.cases(data[, desiredCols])
  return(data[completeVec, ])
}

#' Mode
#'
#' Function to calculate the mode of a variable
#'
#' @param x numeric vector
#'
#' @return numeric vector of modes
#'
#' @examples
#' x<-c(1,1,3,5,6,6)
#' Modes(x)
#'
#' @export
Modes <- function(x) {
  ux <- unique(x)
  tab <- tabulate(match(x, ux))
  ux[tab == max(tab)]
}

#' Geometric mean
#'
#' Function to calculate the geometric mean of a variable
#'
#' @param x numeric vector
#'
#' @return numeric value of geometric mean
#'
#' @examples
#' x<-c(1,1,3,5,6,6)
#' gm_mean(x)
#'
#' @export
gm_mean = function(x, na.rm=TRUE){
  exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
}

#' Factorial
#'
#' Function to calculate the factorial of a variable
#'
#' @param x numeric vector
#'
#' @return numeric value of factorial
#'
#' @examples
#' factorial(5)
#'
#' @export
factorial <- function(x){
  if(x==0)
    return(1)
  else
    return(x*factorial(x-1))
}

#' Non-unique
#'
#' Function that returns all non-unique values in a vector
#'
#' @param x numeric or character vector
#'
#' @return numeric or character vector of non-unique values
#'
#' @examples
#' x<-c(1,1,3,5,6,6)
#' nonUnique(x)
#'
#' @export
nonUnique<-function(x){
  #return non-unique values
  return(unique(x[duplicated(x)]))
}


library(rgeos)
library(raster)

#####################################
#### Distance to a Polygon
####################################
## make raster
r<- raster(ncol=200, nrow=150, xmn=-1000, xmx=1000, ymn=-100, ymx=900)
rr<-setValues(r, 0)

## create polygon
x<- c(300, 500, 400, 289, 250)
y<- c(300, 80, 20, 50, 80)

poly1<-SpatialPolygons(list(Polygons(list(Polygon(data.frame(x,y))), ID=1)))

x<- c(-500, -700, -600, -589, -450)
y<- c(400, 180, 120, 150, 180)
poly2<-SpatialPolygons(list(Polygons(list(Polygon(data.frame(x,y))), ID=1)))
poly<-bind (poly1, poly2)
plot(poly)

## Mask raster by the geometry of the polygon

rrr<-mask(rr, poly)

## Calculate the distance
rD<- distance(rrr)
plot(rD,
     legend.args=list(text='Distance (m)', side=4, line=3, cex=0.8))
plot(poly, add=T)

#####################################
#### Distance to a line
####################################

## Make the same raster as above
r<- raster(ncol=100, nrow=75, xmn=-1000, xmx=1000, ymn=-100, ymx=900)
r<-setValues(r, 0)

##Make two lines
lines<-SpatialLines(list(
  Lines(list(Line(cbind(c(300, 500, 400, 289, 250), c(300, 80, 20, 50, 80)))), ID="a"),
  Lines(list(Line(cbind(c(-500, -700, -600, -589, -450), c(400, 180, 120, 150, 180)))), ID="b")
))
plot(lines)

##Calculate Distance from Raster to lines
distance<-gDistance(lines, as(r, "SpatialPoints"), byid=TRUE)
r[]<-apply(distance,1, min)

r<-disaggregate(r, fact=2)

plot(r,
     legend.args=list(text='Distance (m)', side=4, line=3, cex=0.8))
plot(lines, add=T)

#####################################
#### decreasing raster resolution, disaggregating, and then adding to regular raster resolution.
#####################################

## Make the same raster as above
rr<- raster(ncol=200, nrow=150, xmn=-1000, xmx=1000, ymn=-100, ymx=900)
rr<-setValues(r, 0)

r1<- raster(ncol=100, nrow=75, xmn=-1000, xmx=1000, ymn=-100, ymx=900)
r1<-setValues(r1, 1)

r1_ag<-disaggregate(r1, fact=2)


#Copyright 2016 Lingjiao Chen, Arun Kumar, Jeffrey Naughton, and Jignesh M. Patel, Version 0.8.
#All rights reserved.
#
#Licensed under the Apache License, Version 2.0 (the "License");
#you may not use this file except in compliance with the License.
#You may obtain a copy of the License at
#
#    http://www.apache.org/licenses/LICENSE-2.0
#
#Unless required by applicable law or agreed to in writing, software
#distributed under the License is distributed on an "AS IS" BASIS,
#WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#See the License for the specific language governing permissions and
#limitations under the License.

KmeansClustering <- function(Data,Max_Iter,Center_Number,k_center,nS)
{
# k_center is the k centers, and YA is the assignment
	All1 = matrix(1, nS, 1);
	All1_k = matrix(1,1,Center_Number);
	All1_C = t(matrix(1,1,nrow(k_center)));
	T2 = rowSums(Data^{2}) %*% All1_k;
	T22 = Data * 2;
	for( k in 1: Max_Iter )
	{
		Dist = T2 - as.matrix(T22 %*% k_center ) +  All1 %*% colSums(k_center ^2);
		YA = (Matrix(Dist == (rowMins((Dist)) %*% All1_k),sparse=TRUE))+0;
		k_center = as.matrix(  ( t(Data) %*% YA ) / ( (All1_C) %*% colSums(YA) )  );
	}
	return(list(k_center ,YA));
}


BCData <- read.table(url("https://archive.ics.uci.edu/ml/machine-learning-databases/breast-cancer-wisconsin/breast-cancer-wisconsin.data"), sep = ",")
names(BCData)<- c('Id', 'ClumpThickness', 'CellSize','CellShape',
                  'MarginalAdhesion','SECellSize', 'BareNuclei',
                  'BlandChromatin','NormalNucleoli', 'Mitoses','Class')
str(BCData)

BCData<-BCData[!(BCData$BareNuclei=="?"),]
BCData$BareNuclei<-as.integer(BCData$BareNuclei)
str(BCData)
summary(BCData)

table(BCData$Class)

boxplot(BCData[,2:10])

par(mfrow=c(3, 3))
hist(BCData$ClumpThickness)
hist(BCData$CellSize)
hist(BCData$CellShape)
hist(BCData$MarginalAdhesion)
hist(BCData$SECellSize)
hist(BCData$BareNuclei)
hist(BCData$BlandChromatin)
hist(BCData$NormalNucleoli)
hist(BCData$Mitoses)
par(mfrow=c(1, 1))

BCData$Class<-replace(BCData$Class,BCData$Class==2,0)
BCData$Class<-replace(BCData$Class,BCData$Class==4,1)

table(BCData$Class)

LoGModel <- glm(Class ~.-Id,family=binomial(link='logit'),data=BCData)
summary(LoGModel)

anova(LoGModel, test="Chisq")

LGModelPred <- round(predict(LoGModel, type="response"))
table(LGModelPred)

table(BCData$Class,LGModelPred)

library(caret)
confusionMatrix(LGModelPred,BCData$Class,positive="1")

library(pROC)

RocObj<-roc(BCData$Class,LGModelPred)

par(mfrow=c(1, 1))
plot.roc(RocObj)

plot(RocObj, print.auc=TRUE, auc.polygon=TRUE, grid=c(0.1, 0.2),
     grid.col=c("green", "red"), max.auc.polygon=TRUE,
     auc.polygon.col="blue", print.thres=TRUE)


#   N-мерни променливи и изследване на връзките между тях

#       Какво предсталяват "n"-мерните данни?
#       Едномерните данни, това са масиви/листа от обекти (числа, стрингове, дати, друг тип обекти).
#   При двумерните данни имаме колекция от едномерни данни. Тоест, представянето е във формата на
#   матрици, data frame-ове или друга подобна структура, при която най-често по редове са представени
#   примерите/елементите, а по колони техните признаци (променливите).

# Пример за многомерни данни е
data("mtcars")
head(mtcars)
mtcars

# Нека да изследваме обема на двигателя за въпроснтие коли. Първо ще построим хистограма
hist(
  x = mtcars$disp,
  col = "red",
  xlab = "Displacement (u.in.)",
  main = "Histogram"
)

summary(mtcars$disp)
sd(mtcars$disp)

abline(v = mean(mtcars$disp), lwd = 2, lty = 4)
abline(v = median(mtcars$disp), lwd = 2, lty = 4, col = "blue")

#   От хистограмата се вижда, че имаме два пика.
#   Тоест, разпределението на променливата е
#   бимодално. Черната вертикалана прекъсната линия показва къде се намира средната стойност,
#   а синята прекъсната - медината. И в двата случая, малко трудно можем да приемем, че това е
#   очакването на разпределението.

#   Нека сега да проверим, какво би станало, ако групираме данните по броя на цилиндрите
disp_cyl4 <- mtcars$disp[which(mtcars$cyl == 4)]
disp_cyl6 <- mtcars$disp[which(mtcars$cyl == 6)]
disp_cyl8 <- mtcars$disp[which(mtcars$cyl == 8)]

par(mfrow = c(2, 2))
hist(x = disp_cyl4, col = "red", xlab = "4 cylinders", main = "Histogram of displacement (u.in.)")
hist(x = disp_cyl6, col = "lightblue", xlab = "6 cylinders", main = "Histogram of displacement (u.in.)")
hist(x = disp_cyl8, col = "forestgreen", xlab = "8 cylinders", main = "Histogram of displacement (u.in.)")
par(mfrow = c(1, 1))

summary(disp_cyl4)
sd(disp_cyl4)

summary(disp_cyl6)
sd(disp_cyl6)

summary(disp_cyl8)
sd(disp_cyl8)

#   За групата на двигетелите, които имат 4 цилиндъра, все още не може да получим добра оценка
#   за очакването, но за другите две групи - можем, защото имаме по един връх.

#   Анализирайки зависимостите на една променлива от други променливи, ние успяваме да подобрим
#   оценките на параметрите, които са ни неогходи. По този начин правим прогнозите си по-точни.

################################
#   Изследване на двумерни данни

#   1. Категорийни (обясняващи) VS категорийни (зависими)
#   Връзките между тези променливи най-лесно се виждат с помощта на cross таблици и barplot-ове.

#   Пример: Направили сме хипотетично прочуване, което измерва дали студентите, които пушат,
#   учат по-малко.

smokes <- c("Y", "N", "N", "Y", "N", "Y", "Y", "Y", "N", "Y")
amount <- c("0 - 5 hours", "5 - 10 hours", "5 - 10 hours", "more than 10 hours",
            "more than 10 hours", "0 - 5 hours", "5 - 10 hours", "0 - 5 hours",
            "more than 10 hours", "5 - 10 hours")
table(amount, smokes)
#   Данните показват, че пушачите учат по-малко от непушачите. Нека да разгледаме резулатите
#   не като честоти, а като проценти. За целта изпозлвае командата

prop.table(x = table(amount, smokes))
#   Показва ни в коя група, колко процента от данните попадат.

prop.table(x = table(amount, smokes), margin = 1)
#   Параметърът "margin" задава как желаем да изчисляваме процентите - по редове или по колони.
#   От данните виждаме, че имаме нарастване в процента на непушещите студентите, спрямо броя на
#   часовете, които отделят за учене.

barplot(table(smokes, amount))
#   Малко трудно бихме видяли разликите, освен ако не са фрапиращи.
#   В долния код ще се опитаме да нормализираме стойностите като използваме процентните
#   съотношения. При този подход, ясно се вижда превъзходствата на едни признаци в една група,
#   спрямо друга.
barplot(prop.table(x = table(smokes, amount), margin = 2))

# Друг подход е описаният по-долу
barplot(table(smokes, amount), beside = TRUE, legend.text = T, col = c('green', 'red'))
#   При този подход съще лесно се забелязват разликите в отделните групи. В сегашния barplot
#   сме задали и легенда

#   Освен че можем да изведем легенда на графиката (legend.text = TRUE), то можем и да я
#   попълним със стойности, които ни трябват. Попълването е показано в примера по-долу.
barplot(
  table(amount, smokes),
  main = "table(amount, smokes)",
  beside = TRUE,
  legend.text = c("less than 5", "5 - 10", "more than 10")
)

#   2. Категорийни (обясняващи) VS числови (зависими)
#   Когато имаме такава конфигурация при връзките, то най-удачно е да използваме One-way ANOVA
#   и t-test или техните непараемтрични еквиваленти. Тези анализи ще ги учим по-нататък в курса
#   по статистика. Ако искаме да ги изследваме графично, удачно решение е boxplot графиките.
amount <- c(5, 5, 5, 13, 7, 11, 11, 9, 8, 9, 11, 8, 4, 5, 9, 5, 10, 5, 4, 10)
category <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
tt <- boxplot(amount ~ category)

#   Както се вижда, лесно могат да се сравнят двете категории.
#   - Средната дебела линия във всяки един boxplot е медианата
#   - Страните на правоъгълника са 1 и 3-ти квартил,
#   - Дължината на опашките са минималната и максималните стойности, като са изключени потенциалните outlier-и.
#       Тоест интерпретацията на тази графика е, че стойнсотите на първата група като цяло са
#   по-големи защото и медианата и третия квартил за първата група са по-големи от тези на втората.
#   Отделно, минималната стойност и първия квартил за първата група съвпадат ( = 5), докато минималната
#   стойност на втората група е 4.

# ----------------------------------------------------------------------------------------------------
#       3. Числови (обясняващи) VS категорийни (зависими)
#   Този случай на връзка е сходен с горния. Затова тук също можем да използваме One-way ANOVA или
#   t-test, непараметричните им екваваленти и boxplot-ове. Също така можем да използваме и
#   логистичната регресия.

#   Този тип връзка ще бъде обяснена по-нататък

# ----------------------------------------------------------------------------------------------------
#       4. Числови (обясняващи) VS числови (зависими)
#       Това е може би групата, за която съществуват най-много похвати за анализи. Променливите от
#   числов тип могат да бъдат превърнати в категорийни и следователно за тях важат горнтие типове
#   анализи. Това, разбира се, би довело до загуба на информация, но в определени случаи е по-подходящо
#   заради по-голямата стабилност на моделите.
#       Похватите, които са характерни за изследването на този тип връзки са най-често корелационен
#   анализ и регресионен анализ, както и dotplot (графично представяне на връзката).
#       Почти винаги изследването на този тип връзка следва последователността dotplot, корелационен
#   анализ и регресионен анализ

data("mtcars")
mtcars
#   Да разгледаме пример от данните "mtcars". Интересуват ни променливите disp (обем на двигателя)
#   и wt (тегло)

plot(mtcars$disp, mtcars$wt)
#   От графиката се вижда, че съществува положителна линейна връзка. Тоест с нарастване на обема
#   на двигателя, нараства и теглото на автомобила. Следователно, можем да използваме линеен модел,
#   за да моделираме връзката.

#   ИНФОРМАЦИЯ, КОЯТО НЯМА ДА Я ИМА НА ИЗПИТА/КОНТРОЛНИТЕ
#   Преди да продължим с корелационния и регресионния анализ, нека да разгледаме друг пример.
#   Този път данните ще бъдат симулирани. И връзката няма да бъде линейна, а кубична.

set.seed(4455)
x <- runif(1000, -3, 3)
y <- x^3 - 3 + rnorm(length(x), sd = 2)
plot(x, y)
x^3
x^3 - 3
rnorm(length(x), sd = 2)
# Както се вижда от графиката, този тип връзка не прилича на линейна. Но чрез подходяща трансформация,
# връзката може да се представи като линейна. Например, ако създадем нова променлива
x3 <- x^3
#   Тогава, новата променлива x3 е в линейна зависимост с променливата y
par(mfrow = c(1, 2))
plot(x, y)
plot(x3, y)
par(mfrow = c(1, 1))

#   Корелационен анализ
#     Корелационният анализ измерва силата на линейна връзка между две променливи. Коефициентът на
#   корелация (rho) принадлежи на интервала [-1, 1]. Силата на връзката се определя от абсолютната
#   стойност на rho. Въпреки, че силата на връзката е субективна, все пак можем да определим някакви
#   нива.
N <- 1000

#   abs(rho) = 1 - Детерминистична връзка (y = f(x)). За една стойност на x имаме точно една
#   единствена стойност на y.
set.seed(3654)
x1 <- runif(N)
y1 <- 3*x1 + 4
rho1 <- round(cor(x1, y1), 3)

#   0.9 <= abs(rho) < 1 - Много силна корелация на между x и y
set.seed(3654)
x2 <- runif(N)
y2 <- 3*x2 + 4 + rnorm(N, sd = 0.2)
rho2 <- round(cor(x2, y2), 3)

#   0.75 <= abs(rho) < 0.9 - Силна корелация на между x и y
set.seed(3654)
x3 <- runif(N)
y3 <- -3*x3 + 4 + rnorm(N, sd = 0.5)
rho3 <- round(cor(x3, y3), 3)

#   0.5 <= abs(rho) < 0.75 - Средна корелация на между x и y
set.seed(3654)
x4 <- runif(N)
y4 <- -3*x4 + 4 + 1*rnorm(N)
rho4 <- round(cor(x4, y4), 3)

# 0 <= abs(rho) < 0.5 - Слаба корелация на между x и y
set.seed(3654)
x5 <- runif(N)
y5 <- 3*x4 + 4 + 3*rnorm(N)
rho5 <- round(cor(x5, y5), 3)

par(mfrow = c(2, 3))
plot(x1, y1, main = paste("rho:", rho1))
abline(a = 4, b = 3, col = "red", lwd = 2)

plot(x2, y2, main = paste("rho:", rho2))
abline(a = 4, b = 3, col = "red", lwd = 2)

plot(x3, y3, main = paste("rho:", rho3))
abline(a = 4, b = -3, col = "red", lwd = 2)

plot(x4, y4, main = paste("rho:", rho4))
abline(a = 4, b = -3, col = "red", lwd = 2)

plot(x5, y5, main = paste("rho:", rho5))
abline(a = 4, b = 3, col = "red", lwd = 2)
par(mfrow = c(1, 1))

#   От графиките се вижда, че колко по-разпръснати са наблюденията около правата,
#   толкова корелацията намалява.

#   Командата за корелация е cor. С командата може да се изследват както връзките
#   между две променливи, така и връзките между N-мерни ЧИСЛОВИ данни.

X <- x3;    Y <- y3
X_mean <- mean(X)
Y_mean <- mean(Y)

XY <- (X - X_mean)*(Y - Y_mean)

XX <- (X - X_mean)^2
YY <- (Y - Y_mean)^2

sum(XY)/sqrt(sum(XX)*sum(YY)) #   Стойността на корелацията
cor(x3, y3)

cor(x = mtcars$mpg, y = mtcars$hp)
# Връща ни само едно число - корелацията между двете променливи

cor(mtcars[, c("mpg", "disp", "hp", "drat", "wt", "qsec")])
mtcars
#       Връща СИМЕТРИЧНА матрица (A[i, j] == A[j, i]) с корелациите между отделните
#   променливи.
#       Интересно е, че, по главния диагонал, всички стойности са единици. Това е
#   следствие от формулата

# ---------------------------------
#       Съществуват три основни вида корелации - Pearson, Spearman и Kendall. Първата
#   корелация е параметрична оценка на връзката между две променливи, докато останалите
#   две - непараметрични.

#   Тоест корелацията на Pearson е по-точна, но е неустойчива при наличието на outlier-и
#   Останалите две корелации са по-стабилни и не толкова точни.

#   Най-лесно това ще го демонстрираме с примера по-долу
set.seed(4413)
x <- sort(rnorm(200, mean = 2))
y <- x + sqrt(1 - 0.8^2)*rnorm(length(x))
plot(x, y, main = paste("Pearson's rho:", round(cor(x, y), 2)))
abline(lm(y ~ x), col = "forestgreen", lwd = 2, lty = 4)
round(cor(x, y), 2) # 0.85

x1 <- c(x, 3.4, 3, 3.8, 3.5, 4, 4.1)
y1 <- c(y, 17, 18.5, 19.2, 19, 20, 22)
plot(x1, y1)
abline(lm(y1 ~ x1), col = "darkred", lwd = 2, lty = 3)

text(x = 0.5, y = 18, labels = paste0("Pearson's rho:", round(cor(x1, y1), 2)))
text(x = 0.5, y = 17, labels = paste0("Spearman's rho: ", round(cor(x1, y1, method = "spearman"), 2)))

# ---------------
# Линейни модели
# Линейна регресия
NN <- 300
set.seed(73391)
x1 <- round(runif(NN, 0, 5), 1)
x2 <- round(runif(NN, 2, 6), 1)
y <- 3 + 2.5*x1 + rnorm(NN)
DF <- data.frame(x1, x2, y)

#       Какво представлява линейната регресия?
#       Линейната регресия е статистически метод, който ни позволява да проучим и обобщим връзките
#   между две множества от непрекъснати променливи - X и y:
#       - в множеството X се намират обясняващите променливи (наречени още предиктори или независими
#   променливи) и върху тях се основават нашите прогнози;
#       - в множеството y се съдържа една променлива (вектор), наричаща се зависима променлива
#   променливаи или резултат, която искаме да прогнозираме.

#       Ако приемем, че размерът на вектора y e N, a размерът на множеството X е N x p, то
#   връзката между двете множества е y = b(0) + b(1)*x(1) + ... + b(p)*x(p) + error, където
#   b(0) е константа, а b(1), ..., b(p) са параметрите, които обясняват влиянието на X над y.
#   Линейната регресия ни позволява да оценим стойностите на тези p+1 коефцициенти.
#       Има няколко начина за намирането на тези коефициенти, но най-често използваният е OLS
#   (метод на най-малките квадрати)

#   В R, функцията за линейна регресия е lm()

#       Два начина за извикване на линейна регресия. Първият, ако виждаме нужните ни променливите
#   в средата на R. Лесно можем да проверим дали променливите са заредени в среда на R с функцията
#   ls().
ls() # List all variables
model1 <- lm(y ~ x1)

# RM variables
rm(list = c("x1", "x2", "y"))

#       Вторият начин е като посочим data frame-а или матрицата, който(която) съдържа необходимите
#   променливи.
model2 <- lm(y ~ x1, data = DF)
model2
rm(list = "model2")

#       Когато изследваме връзка между една зависима и една обясняваща променлива, тогава линейната
#   регресия е едномерна (или проста). При наличието на повече предиктори (обясняващи променливи),
#   тогава имаме многомерна линейна регресия.
#       Горните два модела са пример за проста линейна регресия
#       Многомерната линейна регресия ще бъде разгледана по-подробно по-нататък в курса.

#       След като сме построили линееен модел, следващата стъпка е да проверим до колко този модел
#   описва добре данни и какви са оценките на коефициенти му.
summary(model1)

#   -------
#       Хипотези и проверка на хипотези
#       Накратко, статистическата хипотеза е предположение за параметър на извадката/популацията.
#   Това предположение може да бъде вярно или невярно. Ето защо съществуват две взаимоизключващи се
#   хипотези - нулева (H0) и алтернативна (H1).
#       Имаме три типа хипотези:
#           1. H0: параметър = число, H1: параметър != число
#           2. H0: параметър <= число, H1: параметър > число
#           3. H0: параметър >= число, H1: параметър < число

#       Проверката на хипотезите става с помощта на тестове. На база вида на теста, искаме да
#   отхвърлим или не нулевата хипотеза H0. Дали нулевата хипотеза е отхвърлена се определя от
#   стойност, наречена "p-value". Стандартно, една H0 се отхвърля при стойност на p-value < 0.05.
#   При отхвърляне на нулева хипотеза, за вярна се приема алтернативната H1.
#   -------

#       Първо ще проверим дали коефициентите са статистически значими, тоест дали е необходимо да
#   участват в анализа. За всеки един коефициент проверяваме хипотезата дали коефициентът е равен
#   на 0 (b(i) ?= 0). За да бъде един коефициент значим, то трябва за него да отхвърлим горната
#   хипотеза. Както беше споменато по-горе, за да се отхвърли H0, то стойността на p-vaue трябва да
#   бъде по-малка от 0.05. Стойностите p-value се намират в колоната "Pr(>|t|)". Стойностите на
#   p-value за двата параметъра е 2e-16 << 0,05 и следователно двата параметъра са статистически
#   значими.

summary(model3 <- lm(y ~ x2, data = DF))
rm("model3")

#       Да разгледаме оценките пред коефицнета x2. Оценката на коефициента е -0,1505. Но въпреки, че
#   стойността му е различна от 0, то той е статистически незначим. Защо? Защото стойността на
#   p-value e 0,414 > 0,05. Тоест, този коефициент може да отпадне от анализа.

#       Следващата стъпка е да проверим до колко модела описва добре данните. За целта ще използваме
#   статистиките "Multiple R-squared" или "Adjusted R-squared". Статистиката "Multiple R-squared"
#   приема стойности в интервала [0-1]. Колкото тази статистика се приближава до единица, толкова
#   моделът е по-добър. И обратното, колкото стойността на R2 клони към 0, толкова  моделът не се
#   справя с описването на данните. Моделите, които имат стойности за R2 под 0.5, ги приемаме за
#   слаби.

#       Препоръчително е да се използва обаче статистиката Adjusted R-squared, защото тя "наказва",
#   когато използваме ненужни променливи. По принцип, тази статистика също приема стойности в
#   интервала [0-1], но когато използваме само статистически незначими, тогава Adjusted R-squared
#   може да приеме и отрицателни стойности.

summary(model1)
#   Какво можем да кажем за model2? Стойността на Adjusted R2 е 0.9284. Тоест моделът описва
#   много добре данните.

#   - Какво представлява R2 и как можем да го изчислим?
#   - За целта първо ще разгледаме начините да изчисляваме прогнози и остатъците (residuals).

#   Регресионното уравнение придобива вида y = 3.027 + 2.247*x1.

#       Линейната регресия позволява не само да се оценят връзките между отделните обясняващи
#   променливи и резулатата, но както споменахме по-горе, позволява да се правят прогнози. В R
#   използваме функцията "predict" за прогнозиране. Функцията съдържа два основни параметъра object
#   (построения модел) и newdata (данни, за които искаме да направим прогноза)
model1.predictions <- predict(object = model1, newdata = DF)
model1.predictions.alt <- model1$coefficients[1] + model1$coefficients[2]*DF$x1  #   Алтернативен начин
all(model1.predictions == model1.predictions.alt)
rm("model1.predictions.alt")

### ......


plotfitcol <- function(df,xx,yy,byvar,ncol=2,xlimspec=NULL,ylimspec=NULL,bg="grey90",outputfile=NULL) {
    ## create scatter plot with linear regression line and 95% confidence lines
    ## xx and yy are variables within dataframe df
    ## color datapoints by continuous variable byvar
    ## required inputs: xx, yy, df, byvar
    ## example usage: plotfitcol(df,hsub_in,power_ratio_fb,kin_fwd)                        # to write to screen
    ##                plotfitcol(df,hsub_in,power_ratio_fb,kin_fwd,outputfile="trend.jpg") # to write to jpg file
    ##                plotfitcol(df,hsub_in,power_ratio_fb,kin_fwd,ncol=4)                 # 4 colors for byvar

    xlabel  <- deparse(substitute(xx))
    ylabel  <- deparse(substitute(yy))
    bylabel <- deparse(substitute(byvar))
    xx    <- eval(substitute(xx),df)    # need to recognize name passed into function as xx
    yy    <- eval(substitute(yy),df)
    byvar <- eval(substitute(byvar),df)
    newdf <- data.frame(xx,yy,byvar)

    ## debug
    ##ncol <- 2
    ##xlabel <- deparse("psyst")
    ##ylabel <- deparse("power_ratio")
    ##bylabel <- deparse("gin")
    ##xx    <- eval(substitute(psyst),df)    ## need to recognize name passed into function as xx
    ##yy    <- eval(substitute(power_ratio),df)
    ##byvar <- eval(substitute(gin),df)
    ##newdf <- data.frame(xx,yy,byvar)

    ## perform regression
    fit       <- lm(yy~xx,data=newdf)
    intercept <- fit$coefficients[[1]]
    slope     <- fit$coefficients[[2]]
    eq = paste0("y = ", signif(intercept,4), "* x + ", signif(slope,4))

    ## set min and max limits for plot ignoring NaN
    xmin <- min(newdf$xx,na.rm=TRUE)
    xmax <- max(newdf$xx,na.rm=TRUE)
    xmax_plot <- xmax + (xmax-xmin)*0.2  # did this to make room for a legend
    ymin <- min(newdf$yy,na.rm=TRUE)
    ymax <- max(newdf$yy,na.rm=TRUE)
    if (missing(xlimspec)) { xlimspec <- c(xmin,xmax_plot) }
    if (missing(ylimspec)) { ylimspec <- c(ymin,ymax) }
    if (!missing(outputfile)) jpeg(filename=outputfile)

    ## set color pallet for plot byvar
    ##cols <- c("blue","red")                         ## define colors
    ##cols <- brewer.pal(ncol,"Spectral")             # Spectral color pallette has ncol=11 colors
    ##cols <- c("black","blue","green","grey","orange","red")
    ##cols <- c("black","blue","darkorchid2","darkturquoise","darkgreen","green","deeppink","magenta","red")
    cols <- c("black","darkturquoise","pink","red")
    pal  <- colorRampPalette(cols)                  # define color pallette

    ## changes background of plot to specified color
    par(bg=bg)

    ## plot data points
    plot(newdf$xx,newdf$yy,xlim=xlimspec,ylim=ylimspec,
         xlab=xlabel,ylab=ylabel, main=eq,
         col=pal(ncol)[as.numeric(cut(newdf$byvar,breaks=ncol))])

    ## add fit lines
    new.xx <- seq(min(newdf$xx,na.rm=TRUE),max(newdf$xx,na.rm=TRUE),len=100)
    pred   <- predict(fit, new=data.frame(xx=new.xx), interval="conf", level=1-0.05)
    lines(new.xx,pred[,"fit"],lwd=2)
    lines(new.xx,pred[,"lwr"],lty=3)
    lines(new.xx,pred[,"upr"],lty=3)

    ## add legend
    low  <- min(newdf$byvar,na.rm=TRUE)
    high <- max(newdf$byvar,na.rm=TRUE)
    legendlabel <- seq( low, high, (high-low)/(ncol-1) )
    ##legend("right",title=bylabel,col=pal(ncol), pch=19,legend=round(legendlabel))
    legend("right",title=bylabel,col=pal(ncol), pch=19,legend=signif(legendlabel,digits=4))

    if (!missing(outputfile)) dev.off()
    estbound(fit)
}
## examples
##plotfitcol(df,kin_fwd,power_ratio_fb,byvar=kin_fwd,ncol=21)
##plotfitcol(df,gin,    power_ratio_fb,byvar=kin_fwd,ncol=4,outputfile="junk2.jpg")
##plotfitcol(df,gin,    power_ratio_fb,      kin_fwd)
##plotfitcol(df,psyst, power_ratio,    gin,  ylimspec=c(0.7,1.1))
##plotfitcol(df,psyst, power_ratio , gin, ncol=10, ylim=c(0.7,1.05))

## plotfitcol(mtcars, disp, mpg, byvar=cyl)