#This script takes a .csv file and output a dendrogram of k clusters
#In the console, just pass cardsort the path to the file and the number of clusters you want
#For example, cardsort('/Data/card_sort.csv', 5)

compare <- function(x1, x2) {
      x3 <- x1 + x2
      ints <- sum(x3 > 1)
      uno <- sum(x3 > 0)
      return (ints / uno)
}

getJaccard <- function(data) {
  	l = length(data[1,])
  	jmatrix <- matrix(nrow=l,ncol=l)
  	for (i in 1:l) {
  		for (j in i:l) {
  			s <- compare(data[i], data[,j])
  			jmatrix[i,j] <- s
  			jmatrix[j,i] <- s
  		}
  		}
  	return (jmatrix)
}

cardsort <- function(filename, blocks) {
      filedata <- read.csv(filename, header=T, sep=",", row.names=NULL)
      data <- getJaccard(filedata)
      colnames(data) <- colnames(filedata)
      hc <- hclust(dist(t(data)), method="ward.D")
      hc$labels <- colnames(data)
      plot(as.dendrogram(hc),horiz=F)
      rect.hclust(hc, k=blocks, border="#0078D6")
}


###############################
# Linear Discriminant Analysis#
##############################
library(MASS)
lda.fit=lda(income~age+education+capitalGain+capitalLoss+hoursPerWeek+sex
         +race+workclass+maritalStatus+relationship+occupation,data=adult.data)
summary(lda.fit)

lda.pred=predict(lda.fit, adult.test)
names(lda.pred)
lda.class=lda.pred$class
table(lda.class,adult.test$income)
mean(lda.class!=adult.test$income)

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


# prior predictive checks
# pull out the necessary internal functions from greta
op <- .internals$nodes$constructors$op

#' @import greta
#'
#' @title Prior predictive checks for greta models
#'
#' @description Perform prior predictive checks on a greta model object
#'
#' @param y A greta array of the response variable
#' @param fun A character, the name of the function to apply to the simulated response values, default is "mean". Custom functions can also be passed, see examples.
#' @param probs A vector of two numeric, the lower and upper bound of the predictive interval
#' @param nsim A numeric, the number of simulation draws, default is 100
#'
#' @return A character string of the form: XX of the nsim simulated response from the prior distributions had a fun value between XX and XX.
#'
#' @details Prior predictive checks allow a better tuning of the prior distribution of the model parameters by checking simulated new draws of the response. For instance, if we want to model the speed of migratory birds, we do not expect the maximum value of simulated draws from the priors to be beyond 100 of km/h.
#'
#' @usage prior_check(y, fun = "mean", probs = c(0.1, 0.9), nsim = 100)
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' # a simple lm example
#' intercept <- normal(0, 1)
#' slope <- normal(0, 1)
#' sd_resid <- cauchy(0, 1, truncation = c(0, 100))
#' x <- runif(100)
#' y <- as_data(rnorm(100, 1 + 2 * x, 1))
#' linpred <- intercept + slope * x
#' distribution(y) <- normal(linpred, sd_resid)
#' prior_check(y)
#'
#' # can also use custom function, like counting number
#' # of zero observations to check for zero-inflation
#' count0 <- function(x){
#' sum(x==0)
#' }
#'
#' # a poisson regression
#' intercept <- normal(0, 1)
#' slope <- normal(0, 1)
#' x <- runif(100)
#' y <- as_data(rpois(100, exp(0.001 + 1 * x, 1))
#' linpred <- intercept + slope * x
#' distribution(y) <- poisson(linpred)
#' prior_check(y, fun = "count0")
#'
#' }
#'

prior_check <- function(y, fun = "mean",
                        probs = c(0.1, 0.9), nsim = 100){
  # get the summary functions to use
  sum_fun <- match.fun(fun)
  # draw prior distributions
  sims <- calculate(y, nsim = nsim)
  # summarize prior distribution of response
  sum_prior <- apply(sims[[1]], 1, sum_fun)
  # get the quantiles
  qq <- quantile(sum_prior, probs = probs, na.rm = TRUE)
  # quantile range
  r_qq <- (probs[2] - probs[1]) * 100
  # output
  out <- paste0(r_qq, "% of the ", nsim, " simulated response draws from the prior distributions had a ",fun, " value between ", round(qq[1], 2), " and ", round(qq[2], 2),".")

  return(out)
}


statmode <- function(v) {
  a <- sort(table(v), decreasing=TRUE)
  r <- c()
  for(i in 1:length(a)) {
    if ( a[[1]] == a[[i]] ) {
      r <- c(r, as.integer(names(a)[i]))
    } else break; # since it's sorted, once we find
                  # a different value, we can stop
  }
  r
}

print(statmode(c(1, 3, 6, 6, 6, 6, 7, 7, 12, 12, 17)))
print(statmode(c(1, 1, 2, 4, 4)))


#'@title calcTEU
#'
#' @description Estimate vessel size in twenty-foot equivalent units (TEUs) from
#' deadweight tonnage (\code{dwt}) for container ships.
#'
#'@param shipType Ship type (vector of strings, see \code{\link{calcShipType}}),
#'determined by Stat 5 code, \itemize{
#' \item"container.ship"
#' \item"bulk.carrier"
#' \item"tanker"
#' \item"general.cargo"
#' \item"vehicle.carrier"
#' \item"reefer"
#' \item"ro.ro"
#' \item"passenger"
#' \item"tug"
#' \item"misc"
#'}
#' @param dwt Ship maximum deadweight tonnage (vector of numericals, tonnage)
#'
#' @return TEU (vector of numericals)
#'
#' @references
#'\href{https://gitlab.gbar.dtu.dk/oceanwave3d/Ship-Desmo}{Kristensen, H. O.
#'"Ship-Desmo-Tool." https://gitlab.gbar.dtu.dk/oceanwave3d/Ship-Desmo}
#'
#' @examples
#' calcTEU(c("bulk.carrier","container.ship"), c(70000,191144))
#'
#' @export

calcTEU<- function(shipType, dwt){
  TEU<-ifelse(shipType=="container.ship",
         ifelse( #case 1 Feeder
           dwt <= 35000,((dwt/15.19)^(1/0.9814)),
           ifelse(#case 2 Panamax
             dwt <= 60000,((dwt/28.81)^(1/0.902)),
             ((dwt/37)^(1/0.875))
           )
         ),0
  )
  return(TEU)
}


if (deficitOnTopLayers / 1000.0 <= 0) {
  diffusionLimitedEvaporation = 8.3 * 1000
} else {

  if (deficitOnTopLayers / 1000 < 25){

    diffusionLimitedEvaporation = (2 * soilDiffusionConstant * soilDiffusionConstant / (deficitOnTopLayers / 1000.0)) * 1000.0
  } else{

    diffusionLimitedEvaporation = 0
  }
}


> perm(3)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    1    2    2    3    3
[2,]    2    3    1    3    1    2
[3,]    3    2    3    1    2    1


pop_sd <- function(v) {
  # compute population sd instead of sample sd
  # built in sd uses denominator n - 1
  n <- length(v)
  if(n == 1){
    return(0)
  } else {
    return(stats::sd(v) * sqrt((n - 1) / n))
  }
}


---
title: "classification bt T-test"
author: "rakesh sharma, Deepak sharma"
date: "December 30, 2016"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

```{r}
piclo <- read.csv("G:/udacity/piclo.csv")
piclo$reg <- as.double(paste(piclo$reg))
piclo$reg[5]  <- 64.0

```

T-test
```{r}

trt_group<-split(piclo,piclo$Treatmentsa.b,drop=FALSE)
trt_group
trt_group[1:3]
trt_group1<-trt_group[1-2]
out <- lapply(1:length(trt_group1),function (x) out[[x]]<- t.test(trt_group1[[x]]$reg))
out
trt_group2<-trt_group[1-3]
out2 <- lapply(1:length(trt_group2),function (x) out[[x]]<- t.test(trt_group2[[x]]$reg))
out2
```
```{r}
dt_result = piclo %>% group_by(Treatmentsa.b) %>% do(tidy(t.test(piclo$reg~piclo$Treatmentsa.b)))
#dt_result

```
For sorting
```{r}
piclo <- piclo[order(piclo$Treatmentsa.b),]
piclo
rownames(piclo) <- 1:nrow(piclo)
piclo

```
Apply T-test on two group
```{r}
twogrp <- piclo[1:15,]
View(twogrp)
lapply(twogrp[,c("reg", "emb", "trn")], function(x) t.test(x ~ twogrp$Treatmentsa.b, var.equal = TRUE))

```
```{r}
trt_group<-split(Iris,Iris$Species,drop=FALSE)
trt_group
trt_group[1:3]
trt_group1<-trt_group[1-2]
out <- lapply(1:length(trt_group1),function (x) out[[x]]<- t.test(trt_group1[[x]]$Sepal.length))
out
trt_group2<-trt_group[1-3]
out2 <- lapply(1:length(trt_group2),function (x) out[[x]]<- t.test(trt_group2[[x]]$Sepal.length))
out2
```
```


# Logistic Regression Classification for machine learning.
#
# In statistics, logistic regression, or logit regression, or logit model is a
# regression model where the dependent variable (DV) is categorical. This project
# covers the case of a binary dependent variable—that is, where it can take
# only two values, "0" and "1", which represent outcomes such as pass/fail,
# win/lose, alive/dead or healthy/sick.
#
# The binary Logistic regression model is an example of a qualitative
# response/discrete choice model. It is used to estimate the probability of a
# binary response based on one or more predictor (or independent) variables
# (features).

# Importing the data set
dataset = read.csv('Social_Network_Ads.csv')
dataset = dataset[, 3:5]

# Splitting the Dataset into a Training set and a Test set
# install.packages('caTools')
# library(caTools)
set.seed(123) # choose random number, only same number for debugging
split = sample.split(dataset$Purchased, SplitRatio = 0.75)
training_set = subset(dataset, split==TRUE)
test_set = subset(dataset, split==FALSE)

# Feature scaling, normalize scale is important. Especially on algorithms
# involving euclidian distance. Two main feature scaling formulas are:
# Standardisation: x_stand = (x-mean(x))/(standard_deviation(x))
# Normalisation: x_norm = (x-min(x))/(max(x)-min(x))
training_set[, 1:2] = scale(training_set[, 1:2])
test_set[, 1:2] = scale(test_set[, 1:2])

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

# Predict the test_set results by using the classifier
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)

# Plot the training_set results
# install.packages('ElemStatLearn')
# library(ElemStatLearn)
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'))

# Plot the test_set results
# install.packages('ElemStatLearn')
# library(ElemStatLearn)
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 (testing 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'))


x <- c(0,  1,  2,  3,  4,  5,  6,   7,   8,   9,   10)
y <- c(1,  6,  17, 34, 57, 86, 121, 162, 209, 262, 321)
coef(lm(y ~ x + I(x^2)))


cor_result = cor.test(trees$Girth,trees$Volume)
cor_result

R Community/R Stats_Basics Part 1/Assignment2.r


.assign_kmeanspp <- function(x, K) {
  stopifnot(K >= 1)
  stopifnot(is.matrix(x))

  result <- list()
  result$k <- K

  center_ix <- rep(NA, K)
  center_ix[1] <- sample.int(nrow(x), 1)
  result$centers <- matrix(NA, K, ncol(x))
  result$centers[1,] <- x[center_ix[1],]

  if (K > 1) {
      for (i in 2:K) {
          min_dist_sq <- rep(NA, nrow(x))
          for (xi in 1:nrow(x)) {
              dist_sq <- rep(NA, i - 1)
              for (j in 1:(i - 1)) {
                  dist_sq[j] <- sum((x[xi,] - result$centers[j,]) ^ 2)
              }
              min_dist_sq[xi] <- min(dist_sq)
          }

          total <- sum(min_dist_sq)
          center_ix[i] <- sample.int(nrow(x), 1, prob = min_dist_sq / total)
          result$centers[i,] <- x[center_ix[i],]
      }
  }

  result$weights <- matrix(0, nrow(x), K)

  for (xi in 1:nrow(x)) {
    dist_sq <- apply(result$centers, 1, function(v) { return(sum((x[xi,] - v) ^ 2)) })
    assign_ix <- which.min(dist_sq)
    result$weights[xi, assign_ix] <- 1
  }

  result$covariances <- list()
  result$component_weights <- rep(NA, result$k)
  for (ki in 1:result$k) {
    result$component_weights[ki] <- sum(result$weights[, ki]) / nrow(x)
    weighted <- cov.wt(x, result$weights[, ki])
    if (!is.null(result$min_cov)) {
      weighted$cov <- pmax(weighted$cov, result$min_cov)
    }
    result$covariances[[ki]] <- weighted$cov
  }

  return(result)
}

.mixture_expectation_step <- function(x, fit, truncated, tdist=F, tdistdf=3) {
  log_l <- matrix(NA, nrow(x), fit$k)
  for (ki in 1:fit$k) {
    if (tdist) {
      if (truncated) {
        log_l[, ki] <- tmvtnorm::dtmvt(x, fit$centers[ki,], fit$covariances[[ki]], tdistdf,
                                          lower = fit$bounds[, 1], upper = fit$bounds[, 2], log = T) + log(fit$component_weights[ki])
      } else {
        log_l[, ki] <- mvtnorm::dmvt(x, fit$centers[ki,], fit$covariances[[ki]], tdistdf, log = T) + log(fit$component_weights[ki])
      }
    } else {
      if (truncated) {
        log_l[, ki] <- tmvtnorm::dtmvnorm(x, fit$centers[ki,], fit$covariances[[ki]],
                                lower = fit$bounds[, 1], upper = fit$bounds[, 2], log = T) + log(fit$component_weights[ki])
      } else {
        log_l[, ki] <- mvtnorm::dmvnorm(x, fit$centers[ki,], fit$covariances[[ki]], log = T) + log(fit$component_weights[ki])
      }
    }
  }
  fit$logl <- sum(apply(log_l, 1, .logsum))

  fit$weights <- exp(log_l)
  total_weights <- apply(fit$weights, 1, sum)
  fit$weights <- fit$weights / total_weights

  return(fit)
}

.mixture_maximization_step <- function(x, fit, truncated) {
  fit$component_weights <- rep(NA, fit$k)
  for (ki in 1:fit$k) {
    fit$component_weights[ki] <- sum(fit$weights[, ki]) / nrow(x)
    weighted <- cov.wt(x, fit$weights[, ki])
    if (!is.null(fit$min_cov)) {
      weighted$cov <- pmax(weighted$cov, fit$min_cov)
    }

    if (truncated) {
      # Based on Lee and Scott 2012
      old_mu_k <- fit$centers[ki,]
      old_sigma_k <- fit$covariances[[ki]]
      correction <- tmvtnorm::mtmvnorm(sigma = old_sigma_k, lower=fit$bounds[,1] - old_mu_k, upper=fit$bounds[,2] - old_mu_k)

      # Make covariance matrices symmetric (numerical issue?)
      symmetric_correction <- (correction$tvar + t(correction$tvar))/2

      fit$centers[ki,] <- weighted$center - correction$tmean
      fit$covariances[[ki]] <- weighted$cov + old_sigma_k - symmetric_correction
    } else {
      fit$centers[ki,] <- weighted$center
      fit$covariances[[ki]] <- weighted$cov
    }
  }
  return(fit)
}

.fit.gmm.internal <- function(x, K, truncated, bounds, min_cov, epsilon, maxsteps, numkmeans=20, verbose, tdist, tdistdf = NA) {
  fit <- NULL

  for (j in 1:10) {
    if (verbose) {
      cat("Running k-means++..\n")
    }

    kmeansfits <- list()
    kmeansfits_logl <- rep(NA, numkmeans)
    for (i in 1:numkmeans) {
      fit <- .assign_kmeanspp(x, K)
      fit$bounds <- bounds
      fit$min_cov <- min_cov

      return_value <- try(fit <- .mixture_expectation_step(x, fit, truncated, tdist, tdistdf), silent = !verbose)
      if (inherits(return_value, "try-error")) {
        next
      }
      if (any(is.na(fit$weights))) {
        next
      }
      if (any(apply(fit$weights, 2, sum, na.rm=T) == 0)) {
        next
      }

      kmeansfits[[i]] <- fit
      kmeansfits_logl[i] <- fit$logl
    }

    if (sum(!is.na(kmeansfits_logl)) == 0) {
      warning("Could not find initial clustering with k-means++")
      return(NULL)
    }

    best_initial_fit <- which.max(kmeansfits_logl)
    fit <- kmeansfits[[best_initial_fit]]

    if (verbose) {
      cat("Best k-means likelihood:", kmeansfits_logl[best_initial_fit], "\n")
      cat("Starting EM..\n")
    }

    fit <- .mixture_maximization_step(x, fit, truncated)

    previous_logl <- -Inf
    singular <- F
    converged <- F
    for (i in 1:maxsteps) {
      return_value <- try(fit <- .mixture_expectation_step(x, fit, truncated, tdist, tdistdf), silent = !verbose)
      if (inherits(return_value, "try-error")) {
        singular <- T
        break
      }

      if (any(is.na(fit$weights))) {
        singular <- T
        break
      }
      if (any(apply(fit$weights, 2, sum, na.rm=T) == 0)) {
        singular <- T
        break
      }

      if (verbose) {
        cat("Log likelihood: ", fit$logl, "\n")
      }
      if (fit$logl < previous_logl) {
        # Uhhh, what?? Numerical issues maybe?
        converged <- T
        break;
      } else if (fit$logl - previous_logl < epsilon) {
        converged <- T
        break;
      } else {
        previous_logl <- fit$logl
      }

      fit <- .mixture_maximization_step(x, fit, truncated)
    }

    if (!singular) {
      break
    }
  }

  if (singular) {
    warning("singular solutions for 10 restarts")
    return(NULL)
  } else {
    if (!converged) {
      warning("Solution not converged in", maxsteps, ", returning optimal found solution")
    }
    return(fit)
  }
}

#' Fit a Gaussian mixture with a specific number of components.
#'
#' description
#' @param x Matrix or vector of samples. For matrices, rows are samples and columns are variables.
#' @param K Integer specifying the number of components of the Gaussian mixture.
#' @param epsilon For the EM algorithm, stop when the difference in log likelihood is less than this epsilon.
#' @param maxsteps Maximum number of steps to take in the EM algorithm. When the maximum number is reached, the current fit will be returned and a warning will be issued.
#' @param verbose Display the fitting progress by showing the likelihood at every iteration.
#' @export
fit.gmm <- function(x, K, epsilon = 1e-5, maxsteps = 1000, verbose = F) {
  nparam <- K * (ncol(x) + ncol(x) * (ncol(x) + 1) / 2) + K - 1
  if (nparam >= nrow(x)) {
    warning("More parameters than samples, consider lowering K")
  }

  fit <- .fit.gmm.internal(x, K, truncated = F, bounds = NA, min_cov = NULL, epsilon = epsilon, maxsteps = maxsteps, verbose = verbose, tdist = F)
  if (is.null(fit)) {
    return(NULL)
  }

  result <- list()
  result$type <- "gmm"
  result$K <- K
  result$centers <- fit$centers
  result$covariances <- fit$covariances
  result$proportions <- fit$component_weights
  result$log_likelihood <- fit$logl
  result$AIC <- 2 * nparam - 2 * fit$logl
  result$BIC <- log(nrow(x)) * nparam - 2 * fit$logl
  #result$assignment <- apply(fit$weights, 1, which.max)
  return(structure(result, class = "mvd.density"))
}

#' Fit a transformed Gaussian mixture with a specific number of components.
#'
#' description
#' @param x Matrix or vector of samples. For matrices, rows are samples and columns are variables.
#' @param K Integer specifying the number of components of the Gaussian mixture.
#' @param bounds Dx2 matrix specifying the lower and upper bound for each variable.
#' @param epsilon For the EM algorithm, stop when the difference in log likelihood is less than this epsilon.
#' @param maxsteps Maximum number of steps to take in the EM algorithm. When the maximum number is reached, the current fit will be returned and a warning will be issued.
#' @param verbose Display the fitting progress by showing the likelihood at every iteration.
#' @export
fit.gmm.transformed <- function(x, K, bounds, epsilon = 1e-5, maxsteps = 1000, verbose = F) {
  result <- list()
  result$type <- "gmm.transformed"
  result$transform.bounds <- bounds
  transformed <- mvd.transform_to_unbounded(x, bounds)
  result$gmm <- fit.gmm(transformed, K, epsilon = epsilon, maxsteps = maxsteps, verbose = verbose)
  if (is.null(result$gmm)) {
    return(NULL)
  }
  return(structure(result, class = "mvd.density"))
}

#' Fit a truncated Gaussian mixture with a specific number of components.
#'
#' description
#' @param x Matrix or vector of samples. For matrices, rows are samples and columns are variables.
#' @param K Integer specifying the number of components of the Gaussian mixture.
#' @param bounds Dx2 matrix specifying the lower and upper bound for each variable.
#' @param epsilon For the EM algorithm, stop when the difference in log likelihood is less than this epsilon.
#' @param maxsteps Maximum number of steps to take in the EM algorithm. When the maximum number is reached, the current fit will be returned and a warning will be issued.
#' @param verbose Display the fitting progress by showing the likelihood at every iteration.
#' @export
fit.gmm.truncated <- function(x, K, bounds = cbind(rep(-Inf, ncol(x)), rep(Inf, ncol(x))), min_cov = NULL, epsilon = 1e-5, maxsteps = 1000, verbose = F) {
  fit <- .fit.gmm.internal(x, K, truncated = T, bounds = bounds, min_cov = min_cov, epsilon = epsilon, maxsteps = maxsteps, verbose = verbose, tdist = F)
  if (is.null(fit)) {
    return(NULL)
  }

  result <- list()
  result$type <- "gmm.truncated"
  result$K <- K
  result$centers <- fit$centers
  result$covariances <- fit$covariances
  result$proportions <- fit$component_weights
  result$bounds <- bounds
  result$log_likelihood <- fit$logl
  nparam <- K * ncol(x) * (ncol(x) + 1) / 2 + K
  result$AIC <- 2 * nparam - 2 * fit$logl
  result$BIC <- log(nrow(x)) * nparam - 2 * fit$logl
  result$assignment <- apply(fit$weights, 1, which.max)
  return(structure(result, class = "mvd.density"))
}

#' Fit a truncated t-distribution mixture with a specific number of components.
#'
#' description
#' @param x Matrix or vector of samples. For matrices, rows are samples and columns are variables.
#' @param K Integer specifying the number of components of the mixture.
#' @param df Degrees of freedom of the t-distrubtions.
#' @param bounds Dx2 matrix specifying the lower and upper bound for each variable.
#' @param epsilon For the EM algorithm, stop when the difference in log likelihood is less than this epsilon.
#' @param maxsteps Maximum number of steps to take in the EM algorithm. When the maximum number is reached, the current fit will be returned and a warning will be issued.
#' @param verbose Display the fitting progress by showing the likelihood at every iteration.
#' @export
fit.tmixture.truncated <- function(x, K, df = 3, bounds = cbind(rep(-Inf, ncol(x)), rep(Inf, ncol(x))), min_cov = NULL, epsilon = 1e-5, maxsteps = 1000, verbose = F) {
  fit <- .fit.gmm.internal(x, K, truncated = T, bounds = bounds, min_cov = min_cov, epsilon = epsilon, maxsteps = maxsteps, verbose = verbose, tdist = T, tdistdf = df)
  if (is.null(fit)) {
    return(NULL)
  }

  result <- list()
  result$type <- "gmm.truncated"
  result$K <- K
  result$centers <- fit$centers
  result$covariances <- fit$covariances
  result$proportions <- fit$component_weights
  result$bounds <- bounds
  result$log_likelihood <- fit$logl
  nparam <- K * ncol(x) * (ncol(x) + 1) / 2 + K
  result$AIC <- 2 * nparam - 2 * fit$logl
  result$BIC <- log(nrow(x)) * nparam - 2 * fit$logl
  result$assignment <- apply(fit$weights, 1, which.max)
  return(structure(result, class = "mvd.density"))
}

#' Calculate AIC of a Gaussian mixture across a range of number of components.
#'
#' description
#' @param x Matrix or vector of samples. For matrices, rows are samples and columns are variables.
#' @param K Vector specifying the number of components to test
#' @param optimal.only If TRUE, directly return only the GMM with optimal number of components; otherwise return a structure with fits for all tested number of components
#' @param epsilon See fit.gmm
#' @param maxsteps See fit.gmm
#' @param verbose Display the fitting progress.
#' @export
gmm.AIC <- function(x, K = 1:6, optimal.only = F, epsilon = 1e-5, maxsteps = 1000, verbose = F) {
  result <- list()
  result$K <- K
  result$AIC <- rep(NA, length(K))
  result$fits <- list()
  for (k in 1:length(K)) {
    if (verbose) {
      cat("Fitting K=", K[k], "\n")
    }

    nparam <- K[k] * (ncol(x) + ncol(x) * (ncol(x) + 1) / 2) + K[k] - 1
    if (k > 1 && nparam >= nrow(x)) {
      result$fits[[k]] <- NULL
      result$AIC[k] <- NA
    } else {
      fit <- fit.gmm(x, K[k], epsilon = epsilon, maxsteps = maxsteps, verbose = verbose)
      if (!is.null(fit)) {
        result$fits[[k]] <- fit
        result$AIC[k] <- result$fits[[k]]$AIC
      }
    }
  }
  if (optimal.only) {
    if (sum(!is.na(result$AIC)) == 0) {
      return(NULL)
    } else {
      ix <- which.min(result$AIC)
      return(result$fits[[ix]])
    }
  } else {
    return(result)
  }
}

#' Calculate AIC of a transformed Gaussian mixture across a range of number of components.
#'
#' description
#' @param x Matrix or vector of samples. For matrices, rows are samples and columns are variables.
#' @param K Vector specifying the number of components to test
#' @param bounds Dx2 matrix specifying the lower and upper bound for each variable.
#' @param optimal.only If TRUE, directly return only the GMM with optimal number of components; otherwise return a structure with fits for all tested number of components
#' @param epsilon See fit.gmm.transformed
#' @param maxsteps See fit.gmm.transformed
#' @param verbose Display the fitting progress.
#' @export
gmm.transformed.AIC <- function(x, K = 1:6, bounds, optimal.only = F, epsilon = 1e-5, maxsteps = 1000, verbose = F) {
  result <- list()
  result$K <- K
  result$AIC <- rep(NA, length(K))
  result$fits <- list()
  for (k in 1:length(K)) {
    if (verbose) {
      cat("Fitting K=", K[k], "\n")
    }
    nparam <- K[k] * (ncol(x) + ncol(x) * (ncol(x) + 1) / 2) + K[k] - 1
        if (k > 1 && nparam >= nrow(x)) {
            result$fits[[k]] <- NULL
            result$AIC[k] <- NA
        } else {
            result$fits[[k]] <- fit.gmm.transformed(x, K[k], bounds, epsilon = epsilon, maxsteps = maxsteps, verbose = verbose)
            if (!is.null(result$fits[[k]])) {
              result$AIC[k] <- result$fits[[k]]$gmm$AIC
            }
        }
    }
    if (optimal.only) {
      if (sum(!is.na(result$AIC)) == 0) {
        return(NULL)
      } else {
        ix <- which.min(result$AIC)
        return(result$fits[[ix]])
      }
    } else {
        return(result)
    }
}

#' Calculate AIC of a truncated Gaussian mixture across a range of number of components
#'
#' description
#' @param x Matrix or vector of samples. For matrices, rows are samples and columns are variables.
#' @param K Vector specifying the number of components to test
#' @param bounds Dx2 matrix specifying the lower and upper bound for each variable.
#' @param optimal.only If TRUE, directly return only the GMM with optimal number of components; otherwise return a structure with fits for all tested number of components
#' @param epsilon See fit.gmm.truncated
#' @param maxsteps See fit.gmm.truncated
#' @param verbose Display the fitting progress.
#' @export
gmm.truncated.AIC <- function(x, K = 1:6, bounds = cbind(rep(-Inf, ncol(x)), rep(Inf, ncol(x))), optimal.only = F, min_cov = NULL, epsilon = 1e-5, maxsteps = 1000, verbose = F) {
    result <- list()
    result$K <- K
    result$AIC <- rep(NA, length(K))
    result$fits <- list()
    for (k in 1:length(K)) {
        if (verbose) {
            cat("Fitting K=", K[k], "\n")
        }
        nparam <- K[k] * (ncol(x) + ncol(x) * (ncol(x) + 1) / 2) + K[k] - 1
        if (k > 1 && nparam >= nrow(x)) {
            result$fits[[k]] <- NULL
            result$AIC[k] <- NA
        } else {
            result$fits[[k]] <- fit.gmm.truncated(x, K[k], bounds = bounds, min_cov = min_cov, epsilon = epsilon, maxsteps = maxsteps, verbose = verbose)
            if (!is.null(result$fits[[k]])) {
              result$AIC[k] <- result$fits[[k]]$AIC
            }
        }
    }
    if (optimal.only) {
      if (sum(!is.na(result$AIC)) == 0) {
        return(NULL)
      } else {
        ix <- which.min(result$AIC)
        return(result$fits[[ix]])
      }
    } else {
        return(result)
    }
}


# Simulates different scenarios for finding functional variants in 0-n SC and in X/54 HapMaps (X=0)
# Fisher exact (or chi square) for 2x2 table
# TABLE LAYOUT
#
#       n(SC)| N(ctrls)
#     	col1 | col2
# row1 | x1  | x3	|	Negatives
# row2 | x2  | x4	|	Positives (ie functional variant)
#
# Table can be enlarged to rown (x in col2 of row1 will be x(n+1) etc
# rown | xn  | etc  |   Condition n

n=9 # total of population n (max nr of SCs OR alleles)
cutoff = 0.05 # could be 0.05
tests=1211 #nr of tests for bonferroni corr
bonf_cutoff =(cutoff/tests) # adjusted P value cutoff
bf<-prettyNum(bonf_cutoff,digits=2)
cat("Bonf cutoff for P =",cutoff,": ",bonf_cutoff) #bonf cutoff
plist=NULL

for (i in 0:n){

x1=(n-i)	# negatives n (SC)
x2=i		# positives n (SC)
x4= 		#positives N (default 0) (HM54)
x3=54-x4   	#positives N (default 0) (HM54)

table <- matrix(c(x1, x2, x3, x4), nr=2, #nr= nr of datarows
dimnames=list(c("negatives", "positives"), c("SCs", "Ctrls"))) #headers

#NB only use Fisher when one of the nrs in contingency table is small (ie one cell < 5) chisq.test(table) # dont use chi square when one of the nrs in table is low
ft<-c(fisher.test(table)) #vectorizes fisher test output
fisher.test(table)
#ft_pval_adj <- (ft$p.value*bonf) #bonf correction using p value from fisher
plist <- c(plist, ft$p.value)
print(table)
cat("\n")
#cat("positives: ",i) #positives
cat("P-val=",format(ft$p.value, digits=2), fill=FALSE) #Unadj. Pval

if (ft$p.value < bonf_cutoff) {
	cat(" --> Bonf significant!", fill=FALSE, "\n")
	} else {
	cat("(not bonf signif.)", "\n")
	}
}
cat("Bonf cutoff for P =",cutoff,": ",format(bonf_cutoff, digits=2)) #bonf cutoff
#print(format(plist, digits=2), quote=FALSE)
plot(0:n, log10(plist), type="b", col="red", xlab="Nr. of positive SC alleles", ylab="log10 of P value",
     main=c("Nr. of positives in HM54:",x4,"Bonf=",bf))

#,segments(0,log10(bonf_cutoff),n,log10(bonf_cutoff), col=par("fg"), lty=2)) #segments is not working yet


MoSS <- function(n, alpha, m){

  p.score <- runif(n*alpha)**m
  n.score <- 1 - runif( round(n*(1-alpha), digits=0) )**m
  scores  <- cbind(c(p.score, n.score),c(rep(1,length(p.score)), rep(2,length(n.score))))
  scores  <- cbind(scores[,1], scores[,1], scores[,2])
  return(scores)

}


#линейна регресия - проверява дали Y = Y1,..,Yn (вектор със стойности от извадка) се влияе от предиктори X = X1,..,Xn ... Z = Z1,..,Zn
#функцията lm(y~x) или lm(y~x1+x2+x3+..+xn) за определяне на коефициентите на регресионната права при съответно един или няколко предиктора
#функцията coefficients(lm(..)) изкарва много информация за регресията

#Стъки при построяване на регресионен модел (трябва да проверим за всички тези неща и да отстраним предикторите, които създават проблеми):
#1.Проверка дали някои от предикторите не са зависими помежду си -> с cor(), ако някоя стойност е много близка до 1 или -1, трябва да махнем една от величините или графично със scatterplot() (трябва да бъде заредена библиотеката car предварително library("car"))
#2.Проверка дали величините са нормално разпределени -> с qqnorm() и qqline() графично, ако някъде точките много се отдалечават от правата, значи величините не са норално разпределени и трябва да се махне от модела
#3.Проверка за outlier-и -> с boxplot() графично, ако има точки много отгоре или отдолу трябва да бъдат махнати (тези редове да трябва да бъдат махнати от всички предиктори, ако работим с матрица със предиктори по стълбовете)
#4.Построяване на регресионния моде -> lm(Y~X1+..+Xn); plot(Y); abline(lm(Y~X1+..+Xn)) трябва графично всички точки да са близо до правата
#5.Заключение дали модела е добър и дали данните са добри -> със summary(lm(..)) се гледа дали предикторите са от голямо значение (броят на звездичките), колкото по-голяма е стойността на R-squared, толкова по-добър е модела
#6.Може да се направи друг модел с други предиктори и да се провери кой е по-добър с anova

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

#01
x=c(2,-6,7)
y=c(3,4,6)

#емпирично
r=cor(x,y)
sy=sd(y)
sx=sd(x)
b1=r*(sy)/sx
y.cherta=mean(y)
x.cherta=mean(x)
b0=y.cherta - b1*x.cherta

#теоретично
b=lm(y~x)

plot(x,y)
abline(b)
#abline(b0,b1)

#02
x=c(-2,-1,0,1,2)
y=x*x

plot(x,y)
abline(lm(y~x))
m1=lm(y~x)
cov(x,y)
summary(m1)

plot(x,y)
abline(lm(y~I(x^2)))
m2=lm(y~I(x^2))
summary(m2)
cov(x^2,y)

#03
x=c(0,4,10,15,21,29,36,51,68)
y=c(66.7,71,76.3,80.6,85.7,92.9,99.4,113.6,125.1)
m=lm(y~x)
plot(x,y)
abline(m)
summary(m)

#определете интервалите на параметрите на правата
alpha= 0.05
c=coefficients(summary(m))
b0 = summary(m)$coefficients[1]
se = summary(m)$coefficients[3]
b1 = summary(m)$coefficients[2]
se1 = summary(m)$coefficients[4]

upper0 = b0 + qnorm(1-alpha/2)*se
lower0 = b0 - qnorm(1-alpha/2)*se

upper1 = b1 + qnorm(1-alpha/2)*se1
lower1 = b1 - qnorm(1-alpha/2)*se1

#04
x=c(1.5, 1.7, 2.0, 2.5, 2.5, 2.7, 2.9, 3, 3.5, 3.4, 9.5, 9.5, 3.8, 4.2, 4.3, 4.6, 4, 5.1, 5.1, 5.1, 5.2, 5.5)
y=c(3, 2.5, 3.5, 3, 3.1, 3.6, 3.2, 3.9, 4, 4, 8, 2.5, 4.2, 4.1, 4.8, 4.2, 5.1, 5.1, 5.1, 5.1, 4.8, 5.3)
plot(x,y)
m=lm(y~x)
abline(m)
summary(m)

#махаме outlier-ite
boxplot(x,y)
x.better=c(1.5, 1.7, 2.0, 2.5, 2.5, 2.7, 2.9, 3, 3.5, 3.4, 3.8, 4.2, 4.3, 4.6, 4, 5.1, 5.1, 5.1, 5.2, 5.5)
y.better=c(3, 2.5, 3.5, 3, 3.1, 3.6, 3.2, 3.9, 4, 4, 4.2, 4.1, 4.8, 4.2, 5.1, 5.1, 5.1, 5.1, 4.8, 5.3)
m.better = lm(y.better~x.better)
plot(x.better,y.better)
abline(m.better)
summary(m.better)
rstandard(m.better) #???

#05
Er_red= 630.43
Er_full = 615.62
p = 2;
sfull=1.513
fratio = (Er_red-Er_full)/(p*sfull^2)
fratio
df(3.23,2,269)

#06
#install.packages("faraway")
library(faraway)
?savings
#install.packages("car")
library(car)
scatterplotMatrix(savings)
savings
x=lm(savings$sr~savings$pop75+savings$pop15+savings$dpi+savings$ddpi)
y1=lm(savings$sr~savings$pop15+savings$dpi+savings$ddpi)
y2=lm(savings$sr~savings$pop75+savings$pop15+savings$ddpi)
summary(y1)
summary(y2)
summary(x)
anova(x)
anova(y1)
anova(y2)
predict(y2,interval='confidence')


collatz.chain <- function(n) {
    chain <- vector()
    i <- 1
    while (n != 1) {
        if (n%%2 == 0)
            n <- n / 2
        else
        n <- 3 * n + 1
        chain[i] <- n
        i <- i + 1
    }
    return(chain)
}
answer <- 0
collatz.max <- 0
for (n in 1:1E6) {
    collatz.length <- length(collatz.chain(n))
    if (collatz.length > collatz.max) {
        answer <- n
        collatz.max <- collatz.length
    }
}
print(answer)


fibo <- function(n, a=0, b=1) {
  if (n == 1) {
    b
  } else {
    fibo(n-1, b, a+b)
  }
}

cat(sapply(as.integer(readLines(tail(commandArgs(), n=1))), function(x) {
  if (x == 0) {
    0
  } else {
    fibo(x)
  }
}), sep="\n")


#' Sequence by a multiple
#'
#' @description Gets sequence by a multiple, with the minimum and maximum of data
#'
#' @param x numeric vector
#' @param m multiple
#'
#' @return sequence
#' @export
#'
#' @examples
#' x <- rnorm(100)
#'
#' mult_seq(x,m = .5)
#'

mult_seq <- function(x, m = 1){

  if(!is.numeric(x)){
    stop("x must be numeric.")
  }

  if(!is.numeric(m)){
    stop("m must be numeric.")
  }

  if(m <= 0){
    stop("m must be > 0.")
  }

  min <- m*ceiling((min(x)-m)/m)

  max <- m*ceiling((max(x))/m)

  out <- seq(min, max, by = m)

  return(out)

}


## Created on Saturday, December 12, 2020 at 9:33pm EST by WeekendEditor on WeekendEditorMachine.
## Copyright (c) 2020, SomeWeekendReading.  All rights reserved.  As if you care.

library("plyr")                                        # For ddply()
toolsDir <- "../../tools"                              # Various tools available from author
source(file.path(toolsDir, "graphics-tools.r")         # Various graphics hacks

##
## Re-estimate efficacy and confidence intervals on Pfizer vaccine data.
##
## See: https://www.fda.gov/media/144245/download, especially Table 8, p 26.
##
## Also analyzed by Gary Cornell:
## https://garycornell.com/2020/12/09/statistics-in-the-pfizer-data-how-good-is-the-vaccine/
##

doit <- function(plotDir           = "../images",
                 posteriorPlotFile = "2020-12-12-pfizer-vaccine-efficacy-confidence-intervals-posterior-betas.png") {

  efficacy <- function(Ntrt, Ntrtinf, Ncnt, Ncntinf) { # Vaccine efficacy point estimate
    100.0 * (1 - (Ntrtinf / Ntrt) / (Ncntinf / Ncnt))  # 1 - Pr(inf | trt) / Pr(inf | control)
  }                                                    #

  efficacyQuantiles <- function(alphaNum, betaNum, alphaDenom, betaDenom,
                                n = 1000, probs = c(0.025, 0.500, 0.975)) {
    round(quantile(100.0 * (1 - rbeta(n, alphaNum, betaNum) / rbeta(n, alphaDenom, betaDenom)),
                   probs = probs),                     #
          digits = 1)                                  #
  }                                                    #

  ## Create table of patient counts by treatment arm & infection status, then add
  ## a point estimate of the efficacy to compare with Pfizer:
  tbl <- transform(data.frame(Subgroup = c("Overall", "16-17", "18-64", "65-74", ">= 75"),
                              Ntrt     = c(    18559,      58,   14443,    3239,     805),
                              Ntrtinf  = c(        9,       0,       8,       1,       0),
                              Ncnt     = c(    18708,      61,   14566,    3255,     812),
                              Ncntinf  = c(      169,       1,     149,      14,       5)),
                   Subgroup = factor(Subgroup,
                                     levels = c("Overall", "16-17", "18-64", "65-74", ">= 75")),
                   VE        = round(efficacy(Ntrt, Ntrtinf, Ncnt, Ncntinf), digits = 1))
  cat(sprintf("Age groups, patient counts, and point estimates of efficacy:\n"))
  print(tbl)                                           # Show the data table

  ## Make plots of the posterior Beta distributions for the probability of infection in
  ## treatment and control arms, assuming a uniform prior.  Do it for each age cohort.
  ps <- seq(from = 0.0, to = 0.05, length.out = 1000)  # Values of p (horizontal axis)n
  f  <- file.path(plotDir, posteriorPlotFile)          # Plot destination pathname
  withPNG(f, 600, 1500, FALSE, function() {            # Start file capture
    withPars(function() {                              # Save/restore graphics params
      ddply(tbl, "Subgroup", function(df) {            # Do for each age cohort
        stopifnot(nrow(df) == 1)                       # 1 row only per age cohort
        with(df, {
          pinftrts    <- dbeta(ps, shape1 = Ntrtinf + 1, shape2 = Ntrt - Ntrtinf + 1)
          pinftrtsMAP <- ps[which.max(pinftrts)]
          pinftrtsCL  <- quantile(rbeta(1000, shape1 = Ntrtinf + 1, shape2 = Ntrt - Ntrtinf + 1),
                                  probs = c(0.025, 0.975))

          pinfcnts    <- dbeta(ps, shape1 = Ncntinf + 1, shape2 = Ncnt - Ncntinf + 1)
          pinfcntsMAP <- ps[which.max(pinfcnts)]
          pinfcntsCL  <- quantile(rbeta(1000, shape1 = Ncntinf + 1, shape2 = Ncnt - Ncntinf + 1),
                                  probs = c(0.025, 0.975))

          matplot(x = ps, y = cbind(pinftrts, pinfcnts),
                  type = "l", lty = "solid", col = c("blue", "black"),
                  ylab = "Density", xlab = "p", main = sprintf("%s Cohort", as.character(Subgroup)))
          legend("topright", inset = 0.01, bg = "antiquewhite",
                 col = c("blue", "black"), lty = "solid",
                 legend = c(sprintf("Treatment MAP: %.4f [%.4f - %.4f]",
                                    pinftrtsMAP, pinftrtsCL[[1]], pinftrtsCL[[2]]),
                            sprintf("Control MAP:     %.4f [%.4f - %.4f]",
                                    pinfcntsMAP, pinfcntsCL[[1]], pinfcntsCL[[2]])))
          abline(v = c(pinftrtsCL), col = "blue",  lty = "dashed")
          abline(v = c(pinfcntsCL), col = "black", lty = "dashed")
        })                                             # Close with()
        NULL                                           # So ddply() will return nothing of interest
      })                                               # Close ddply()
    }, pty = "m",                                      # Maximal plotting area
       bg  = "transparent",                            # Transparent background
       ps  = 16,                                       # Larger type size for file capture
       mgp = c(1.7, 0.5, 0),                           # Axis title, label, tick
       mar = c(3, 3, 2, 1),                            # Pull in on margins a bit
       mfrow = c(length(levels(tbl$"Subgroup")), 1))   # 1 column of plots for each age cohort
  })                                                   # End file capture
  cat(sprintf("\n\nPosterior beta distributions plotted to %s.", f))

  foo <- subset(ddply(tbl, "Subgroup", function(df) {  # Numerically compute random ratios of
    stopifnot(nrow(df) == 1)                           #  the Beta-distributed variables, and
    with(df,                                           #  then find the 2.5% & 97.5% quantiles
         efficacyQuantiles(Ntrtinf + 1, Ntrt - Ntrtinf + 1, Ncntinf + 1, Ncnt - Ncntinf + 1))
  }), select = c("Subgroup", "2.5%", "50%", "97.5%"))  # Also report the median, because why not
  tbl <- merge(tbl, foo, by = "Subgroup", sort = FALSE)# Join onto our magic table
  cat("\n\n"); print(tbl)                              # Show the table

  cat("\n")                                            # Final newline
  invisible(tbl)                                       # Return data table, invisibly
}                                                      #


#
#  Plot the results of a clustering in whisker plots
############################################################
library(reshape2)
library(ggplot2)

data(iris)
df <- iris[,1:4]
fit <- kmeans(df, 3)

cluster.means <- aggregate(df, by=list(fit$cluster), FUN=mean)
names(cluster.means)[1] <- c("cluster")
melted.means <- melt(cluster.means, id="cluster", value.name = "mean")

cluster.devs <- aggregate(df, by=list(fit$cluster),FUN=sd)
names(cluster.devs)[1] <- c("cluster")
melted.devs <- melt(cluster.devs, id="cluster",  value.name = "var")

# set up a dataframe with means and variances of every cluster
cluster.profiles <- merge(melted.means, melted.devs, by=c("cluster", "variable"))
cluster.profiles$cluster <- as.factor(cluster.profiles$cluster)

points <- df
points$cluster <- fit$cluster
points <- melt(points, id='cluster')

p <- ggplot(points, aes(x=variable, y=value))
p <- p + geom_boxplot(aes(fill = factor(cluster)))
p <- p + geom_jitter(aes(color=factor(cluster)))
print(p)

# More possibilities
p <- ggplot(points, aes(x=variable, y=value))
p <- p + geom_boxplot(aes(fill = factor(cluster)))
print(p)

p <- ggplot(points, aes(x=variable, y=value))
p <- p + geom_boxplot(aes(fill = factor(cluster)))
p <- p + geom_jitter(aes(color=factor(cluster)))
print(p)

p <- ggplot(points, aes(x=variable, y=value, color=factor(cluster), fill=factor(cluster)))
p <- p + geom_point(aes(color= factor(cluster), fill=factor(cluster)), position=position_jitterdodge(dodge.width=0.9))
p <- p + geom_boxplot(fill="white", position = position_dodge(width=0.9))
print(p)


=begin
  # sample-splitting-field01.rb

  require "algebra"

  PQ = Polynomial(Rational, "x")
  x = PQ.var
  f = x**4 + 2
  p f #=> x^4 + 2
  field, modulus, facts = f.decompose
  p modulus #=> [a^4 + 2, b^2 + a^2]
  p facts #=> (x - a)(x + a)(x - b)(x + b)

  fp = Polynomial(field, "x")
  x = fp.var
  facts = Factors.new(facts.collect{|g, n| [g.evaluate(x), n]})
  p facts.pi == f.convert_to(fp) #=> true
((<_|CONTENTS>))
=end


library(MFPCA)

mfpca_train = function(multivar, argvals){

    # multivariate FPCA based on results from uPACE
    mFPCA = function(Xi, phi, p , L, I=I){

        # eigenanalysis on matrix M
        M = t(Xi)%*%Xi/(I-1)
        eigen.M = eigen(M)
        values = eigen.M$values
        pve = cumsum(values)/sum(values)
        Cms = eigen.M$vectors
        index = unlist(lapply(1:length(L), function(x) rep(x, L[x])))

        # MFPCA score
        rho = mfpca_score(Xi, Cms)

        # MFPCA eigenfunction
        psis = NULL
        for(j in 1:p){
            psi = NULL
            for(m in 1:dim(Cms)[2]){
                psi = cbind(psi, phi[[j]]%*%Cms[which(index==j),m])
            }
            psis[[j]] = psi
        }

        out = list(eigenvalue = values, Cms = Cms, pve = pve, rho = rho, psis=psis)
        return(out)
    }

    multivar = as.array(multivar)
    argvals = as.numeric(argvals)
    multivar = ifelse(multivar==0, NA, multivar)

    I = dim(multivar)[1]
    Q = dim(multivar)[3]

    # univariate FPCA via PACE
    Xi.train = L = phi.train =  NULL
    for(p in 1:Q){
        tmp.ufpca = uPACE(multivar[,,p], argvals)
        Xi.train = cbind(Xi.train, tmp.ufpca$scores) # FPC scores
        L = c(L, dim(tmp.ufpca$scores)[2])
        phi.train[[p]] = t(tmp.ufpca$functions@X) # FPC eigenfunctions
    }

    # multivariate FPCA
    mFPCA.train = mFPCA(Xi=Xi.train, phi=phi.train, p=Q, L=L ,I=I)
    rho.train = mFPCA.train$rho  #MFPC scores
    pve = mFPCA.train$pve
    Cms = mFPCA.train$Cms
    psis = mFPCA.train$psis
    psi = array(dim=c(Q,dim(psis[[1]])[1],dim(psis[[1]])[2]))
    for(p in 1:Q){
        psi[p,,] = psis[[p]]
    }

    return(list("scores"=rho.train, "Cms"=Cms, "psi"=psi))
}

mfpca_test = function(multivar.train, multivar.test, argvals, Cms, psi){
    multivar.train = as.array(multivar.train)
    multivar.test = as.array(multivar.test)
    multivar.train = ifelse(multivar.train==0, NA, multivar.train)
    multivar.test = ifelse(multivar.test==0, NA, multivar.test)
    argvals = as.numeric(argvals)
    Q = dim(multivar.test)[3]

    # univariate FPC
    Xi.test = NULL
    meanf = NULL
    for(qq in 1:Q){
        tmp.ufpca = uPACE(multivar.train[,,qq], argvals, multivar.test[,,qq])
        Xi.test = cbind(Xi.test, tmp.ufpca$scores) # dynamic FPC scores for test subjects
        meanf[[qq]] = tmp.ufpca$mu@X
    }

    # estimate MFPC scores for test subjects
    rho.test = mfpca_score(Xi.test, Cms)
    long.pred = mfpca_pred(rho.test, meanf, psi)

    return(list("scores"=rho.test, "long_pred"=long.pred))
}

# mfpc score calculation
mfpca_score = function(predXi, Cms){
    rho = matrix(NA, nrow = nrow(predXi), ncol=dim(Cms)[2])
    for(i in 1:nrow(predXi)){
        for(m in 1:dim(Cms)[2]){
            rho[i,m] = predXi[i,]%*%Cms[,m]
        }
    }
    return(rho)
}

# mfpc trajectories prediction
mfpca_pred = function(score, meanf, psi, n.rho=NULL){
    p = dim(psi)[1]
    n = nrow(score)

    if(is.null(n.rho)){
        n.rho = ncol(score)
    }

    out = NULL
    for(m in 1:p){
        out[[m]] = matrix(meanf[[m]], nrow=n, ncol=length(meanf[[m]]), byrow = T ) + score[,1:n.rho]%*%t(psi[m,,1:n.rho])
    }

    long.pred = array(data=NA, dim=c(dim(out[[1]])[1],dim(out[[1]])[2],p))
    for(m in 1:p){
        long.pred[,,m] = out[[m]]
    }
    return(long.pred)
}

# univariate FPCA via principal analysis by conditional estimation(PACE)
uPACE = function(testData, domain, predData=NULL, nbasis = 5, pve = 0.99, npc = NULL){
    tmp = funData(domain, testData)
    if(is.null(predData)){
        tmp2 = NULL
    }else{
        tmp2 = funData(domain, predData)
    }
    res = PACE(tmp, tmp2, pve=pve, npc= npc, nbasis=nbasis)
    return(res)
}


library(gRain)

F = cptable(~F, values=c(10,90),levels=val)
C = cptable(~C|F, values=c(10,90,20,80),levels=val)
E = cptable(~E|F, values=c(50,50,30,70),levels=val)
A = cptable(~A|C, values=c(50,50,70,30),levels=val)
D = cptable(~D|E, values=c(60,40,70,30),levels=val)
B = cptable(~B|A:D, values=c(60,40,70,30,20,80,10,90),levels=val)

plist = compileCPT(list(F,E,C,A,D,B))
plist

print(plist$F)
print(plist$B)

jtree = grain(plist)
jtree

querygrain(jtree, nodes=c("F"), type="marginal")
querygrain(jtree, nodes=c("C"), type="marginal")
querygrain(jtree, nodes=c("B"), type="marginal")
querygrain(jtree, nodes=c("A","B"), type="joint")
querygrain(jtree, nodes=c("A","B","C"), type="joint")

jtree2 = setEvidence(jtree, evidence=list(F="true"))
querygrain(jtree, nodes=c("F"), type="marginal")
querygrain(jtree2, nodes=c("F"), type="marginal")
querygrain(jtree, nodes=c("A"), type="marginal")
querygrain(jtree2, nodes=c("A"), type="marginal")
querygrain(jtree, nodes=c("B"), type="marginal")
querygrain(jtree2, nodes=c("B"), type="marginal")

jtree3 = setEvidence(jtree, evidence=list(F="true",A="false"))
querygrain(jtree, nodes=c("C"), type="marginal")
querygrain(jtree2, nodes=c("C"), type="marginal")
querygrain(jtree3, nodes=c("C"), type="marginal")


test.score.quadratic.weighted.kappa <- function()
{
    rater.a <- c(1, 2, 1)
    rater.b <- c(1, 2, 2)
    kappa <- ScoreQuadraticWeightedKappa(rater.a, rater.b)
    checkEqualsNumeric(kappa, 0.4)

    rater.a <- c(1, 2, 3, 1, 2, 3)
    rater.b <- c(1, 2, 3, 1, 3, 2)
    kappa <- ScoreQuadraticWeightedKappa(rater.a, rater.b)
    checkEqualsNumeric(kappa, 0.75)

    rater.a <- c(1, 2, 3)
    rater.b <- c(1, 2, 3)
    kappa <- ScoreQuadraticWeightedKappa(rater.a, rater.b)
    checkEqualsNumeric(kappa, 1.0)

    rater.a <- c(1, 3, 5)
    rater.b <- c(2, 4, 6)
    kappa <- ScoreQuadraticWeightedKappa(rater.a, rater.b)
    checkEqualsNumeric(kappa, 0.8421052631578947)

    rater.a <- c(1, 3, 3, 5)
    rater.b <- c(2, 4, 5, 6)
    kappa <- ScoreQuadraticWeightedKappa(rater.a, rater.b, 1, 6)
    checkEqualsNumeric(kappa, 0.6956521739130435)
}

test.mean.quadratic.weighted.kappa <- function()
{
    kappa <- MeanQuadraticWeightedKappa( c(1, 1) )
    checkEqualsNumeric(kappa, 0.999)

    kappa <- MeanQuadraticWeightedKappa( c(1, -1) )
    checkEqualsNumeric(kappa, 0.0)

    kappa <- MeanQuadraticWeightedKappa( c(.5, .8), c(1.0, .5) )
    checkEqualsNumeric(kappa, 0.624536446425734)
}


#Outlier Detection
# WARNING : DATA SET USED FOR OUTLIER DETECTION MUST BE ENTIERLY FILLING IN (NO MISSING VALUES)
# HERE WE USED THE MEAN METHOD TO FILLING MISSING VALUES, REPLACE "MEAN" BY "MEDIAN" or "KNN" TO USE ANOTHER METHOD

######################################## PERCENTILE ################################################
#######################TEST###################
x_train = read.csv("x_train_mean.csv")
x_train

#EXAMPLE for first column

#Check density function in order to see whether are not the distribution is a Gaussian distribution or not
d <- density(x_train[,2])
plot(d)

#Get the lower bound
lower_bound <- quantile(x_train[,2], 0.025)
lower_bound

#Get the upper bound
upper_bound <- quantile(x_train[,2], 0.975)
upper_bound

#Get samples index (raw) of the outlier
outlier_ind <- which(x_train[,2] < lower_bound | x_train[,2] > upper_bound)
outlier_ind

#Get the number of outlier
nbr <- length(outlier_ind)
nbr

######################SELECTION AND REPLACEMENT##################
#############TRAININGSET################
#FOR ALL THE DATA SET USING MEAN
x_train = read.csv("x_train_mean.csv")
x_train

#Check all coloumn outlier
for(i in 2:ncol(x_train)){
  lower_bound <- quantile(x_train[,i], 0.025)
  upper_bound <- quantile(x_train[,i], 0.975)
  outlier_ind <- which(x_train[,i] < lower_bound | x_train[,i] > upper_bound)
  #replace outlier by zeros
  if (length(outlier_ind) > 0) {
    for (j in 1:length(outlier_ind)){
      x_train[outlier_ind[j], i] <- NA
    }
  }
}

#The data set with NAs instead of outlier
x_train

##############TESTSET##################
x_test = read.csv("x_test_mean.csv")
x_test

#Check all coloumn outlier
for(i in 2:ncol(x_test)){
  lower_bound <- quantile(x_test[,i], 0.025)
  upper_bound <- quantile(x_test[,i], 0.975)
  outlier_ind <- which(x_test[,i] < lower_bound | x_test[,i] > upper_bound)
  #replace outlier by zeros
  if (length(outlier_ind) > 0) {
    for (j in 1:length(outlier_ind)){
      x_test[outlier_ind[j], i] <- NA
    }
  }
}

#The data set with NAs instead of outlier
x_test

############WRITTING PROCESS################
write.csv(x_train, "x_train_mean_percentile.csv", row.names = FALSE)
write.csv(x_test, "x_test_mean_percentile.csv", row.names = FALSE)

######################################### HAMPEL ####################################################
#############TEST####################
x_train = read.csv("x_train_mean.csv")
x_train

#EXAMPLE for first column only
#Get the lower bound
lower_bound <- median(x_train[,2]) - 3 * mad(x_train[,2])
lower_bound

#Get the upper bound
upper_bound <- median(x_train[,2]) + 3 * mad(x_train[,2])
upper_bound

#Get samples index (raw) of the outlier
outlier_ind <- which(x_train[,2] < lower_bound | x_train[,2] > upper_bound)
outlier_ind

#Get the number of outlier
nbr <- length(outlier_ind)
nbr

######################SELECTION AND REPLACEMENT##################
#############TRAININGSET##########
x_train = read.csv("x_train_mean.csv")
x_train

#Check all coloumn outlier
for(i in 2:ncol(x_train)){
  lower_bound <- median(x_train[,i]) - 3 * mad(x_train[,i])
  upper_bound <- median(x_train[,i]) + 3 * mad(x_train[,i])
  outlier_ind <- which(x_train[,i] < lower_bound | x_train[,i] > upper_bound)
  #replace outlier by zeros
  if (length(outlier_ind) > 0) {
    for (j in 1:length(outlier_ind)){
      x_train[outlier_ind[j], i] <- NA
    }
  }
}

#The data set with NAs instead of outlier
x_train

###########TESTSET##########
x_test = read.csv("x_test_mean.csv")
x_test

#Check all coloumn outlier
for(i in 2:ncol(x_test)){
  lower_bound <- median(x_test[,i]) - 3 * mad(x_test[,i])
  upper_bound <- median(x_test[,i]) + 3 * mad(x_test[,i])
  outlier_ind <- which(x_test[,i] < lower_bound | x_test[,i] > upper_bound)
  #replace outlier by zeros
  if (length(outlier_ind) > 0) {
    for (j in 1:length(outlier_ind)){
      x_test[outlier_ind[j], i] <- NA
    }
  }
}

#The data set with NAs instead of outlier
x_test

######WRITTING PROCESS############
write.csv(x_train, "x_train_mean_hampel.csv", row.names = FALSE)
write.csv(x_test, "x_test_mean_hampel.csv", row.names = FALSE)

########################################### ISOLATION FOREST #######################################################
# IsolationForest Method
install.packages("solitude")
library(solitude)
x_train = read.csv("x_train_mean.csv")

n = 1000
Var1 = c(rnorm(n, 0, 0.5), rnorm(n*0.1, -2, 1))
Var2 = c(rnorm(n, 0, 0.5), rnorm(n*0.1,  2, 1))
outliers = c(rep(0, n), rep(1, (0.1*n))) + 3
data = data.frame(Var1, Var2)
iforest <- solitude::isolationForest$new(sample_size = length(data))
iforest$fit(data)
data

############################################# DBSCan ########################################################
install.packages("ggplot2")
install.packages("data.table")
install.packages("dbscan")
library(ggplot2)
library(data.table)
library(dbscan)

x_train <- read.csv("x_train_mean.csv")
x_scale <- apply(x_train, 2, function(y) (y - mean(y)) / sd(y) ^ as.logical(sd(y)))
print(sum(is.na(x_train)))

distance_matrix <- as.matrix(dist(x_scale))
pca <- prcomp(distance_matrix)
embedding <- data.table(pca$x[, 1:2])
embedding[, ids := rownames(x_train)]
ggplot(embedding, aes(x = PC1, y = PC2)) +
  geom_point(size = 10, colour = "steelblue", alpha = 0.3) +
  geom_text(aes(label = ids), check_overlap = TRUE) +
  theme_minimal()

embedding[, DClusters := dbscan(x_scale, eps = 0.2, minPts = 2)$cluster]
ggplot(embedding, aes(x = PC1, y = PC2)) +
  geom_point(aes(colour = factor(DClusters)), size = 10, alpha = 0.3) +
  geom_text(aes(label = ids), check_overlap = TRUE) +
  theme_minimal()

################################### EXPECTATION MAXIMISATION ###############################

install.packages("ggplot2")
install.packages("data.table")
install.packages("mclust")
library(ggplot2)
library(data.table)
library(mclust)

x_train <- read.csv("x_train_mean.csv")
x_scale <- apply(x_train, 2, function(y) (y - mean(y)) / sd(y) ^ as.logical(sd(y)))
print(sum(is.na(x_train)))

distance_matrix <- as.matrix(dist(x_scale))
pca <- prcomp(distance_matrix)
embedding <- data.table(pca$x[, 1:2])
embedding[, ids := rownames(x_train)]
ggplot(embedding, aes(x = PC1, y = PC2)) +
  geom_point(size = 10, colour = "steelblue", alpha = 0.3) +
  geom_text(aes(label = ids), check_overlap = TRUE) +
  theme_minimal()

cars_em <- Mclust(scale(x_train), G = 4)
embedding[, EMClusters := cars_em$classification]
ggplot(embedding, aes(x = PC1, y = PC2)) +
  geom_point(aes(colour = factor(EMClusters)), size = 10, alpha = 0.3) +
  geom_text(aes(label = ids), check_overlap = TRUE) +
  theme_minimal()

################################### PCOutlierDetecton ######################################

install.packages("OutlierDetection")
library(OutlierDetection)

x_train <- read.csv("x_train_mean.csv")

outdetect <- PCOutlierDetection(x_train[,2])


elements2 <- list(1,2,3,4,5)
cubes <- sapply(elements2, cube)


#Series temporais e analises preditivas - Fernando Amaral

library(forecast)
library(ggplot2)
library(seasonal)
library(seasonalview)
library(urca)

#importar dados do hotel
dados = read.csv(file.choose(),header = F)
print(dados)
ocupacao = ts(dados, start = c(2003,1), end = c(2017,12), frequency=12)

#resumo
summary(ocupacao)

#visualizar
autoplot(ocupacao)
hist(ocupacao)
boxplot(ocupacao)

#decompor
dec =   decompose(ocupacao)
autoplot(dec)

#analisar a tendência com mais cuidado
autoplot(dec$trend)
autoplot(window(dec$trend, start=c(2015,9)))

#efeito sazonal por ano
ggseasonplot(ocupacao)
ggseasonplot(window(ocupacao, start=c(2016)))

#teste de estacionariedade
est = ur.kpss(ocupacao)
print(est)
ndiffs(ocupacao)

tsdisplay(ocupacao)

modelo = auto.arima(ocupacao, trace = T,stepwise = F, approximation = F )
print(modelo)

checkresiduals(modelo)

shapiro.test(modelo$residuals)

#previsao para 2 anos
previsao = forecast(modelo,h=24)

autoplot(previsao)

Udemy/Series Temporais e Analises Preditivas/Resources/Codigo/11.1.Casopratico.r


rm(list = ls())

n <- 50
k <- 3
y <- c(8, 14)

menosLogLikelihood <- function(theta, y, n) {
  p1 <- theta[1]
  p2 <- theta[2]
  l <- sum(y * log(theta)) + (n - sum(y)) * log(1 - sum(theta))
  return(-l)
}

p.init <- c(0.3, 0.3)
opt <- optim(p.init, menosLogLikelihood, y=y, n=n, hessian = TRUE)

(emv <- opt$par)
emv.value <- opt$value

info.obs <- opt$hessian
(v.hat <- solve(info.obs))

(residual.standard <- sqrt(diag(v.hat)))

# Hipothesis H0: p2 - 2p1 = 0

p.obs <- emv[2] - 2 * emv[1]
p.0 <- 0

# WALD

wald.var <- t(c(2, -1)) %*% v.hat %*% c(2, -1)
wald.obs <- (p.obs - p.0) ^ 2 / wald.var
(wald.pvalue <- 1 - pchisq(wald.obs, 1))

# LIKELIHOOD RATIO

# TODO
likeratio.obs <- 2 * 0

(likeratio.pvalue <- 1 - chisq(likeratio.obs, 1))


=begin
  # sample-algebraic-equation02.rb

  require "algebra"

  PQ = MPolynomial(Rational)
  a, b, c = PQ.vars("abc")
  p AlgebraicEquation.minimal_polynomial(a + b + c, a**2-2, b**2-3, c**2-5)
  #=> x^8 - 40x^6 + 352x^4 - 960x^2 + 576
((<_|CONTENTS>))
=end


require(compiler)
enableJIT(3)

library(MASS)

generate_state_seq = function( seq_len = 10, states = c('A', 'B'), probs = matrix(NA, 2, 2), initial_state_pos=NA ) {
	ret_seq = rep(0, seq_len)
	rand_list = runif(seq_len)
	if (is.na(initial_state_pos)) { ret_seq[1]=sample.int(nrow(probs), 1) }
	else { ret_seq[1] = initial_state_pos }
	cum_prob = t(apply(probs, 1, cumsum))
	cum_prob[,nrow(cum_prob)] = 1  #Set the last column to 1 to avoid rounding errors
	for (i in 2:seq_len){
		 ret_seq[i] = 1+sum(cum_prob[ret_seq[i-1],] <= rand_list[i] )
	}
	# Could add code to replace the state_index with the state code (as.factor)
	return(ret_seq)
}

rds.mcmc.props = function( S, weights=NULL, method="data.smoothing")
{
	# Returns the Fixed Vector (W) for Transition Probs when weights=NULL
	#
	# Variables to hold calculations
	if (is.null(dimnames(S)[[1]])) {
		 dimnames(S)[1] = list(1:nrow(S))
		 dimnames(S)[2] = list(1:nrow(S))
	}

	groupNames = dimnames(S)[[1]]
	len = length(groupNames)

	#print(len)

 	#Generic Weighted MCMC Estimate
	if (len==2) {
		# Weighted Estimates of Equilibrium Proportions
		# P[A] = S[BA]*D[B]/ ( Sba*Db + Sab*Da )
		if (is.null(weights) ) { weights=rep(1,nrow(S)) }
		P.hat = rep(0 , len)
		for (i in 1:len ) {
			a = i
			b = 3 - i

			P.hat[i] = S[groupNames[b],groupNames[a]]*weights[b] /
			(S[groupNames[b],groupNames[a]]*weights[b] + S[groupNames[a],groupNames[b]]*weights[a])

		}

	} else { # (groupCount > 2)
		P.hat = rep(NA , len)
		if (method=="data.smoothing") {
			if( is.null(weights) ) {
				#print(t(S))
				#print(diag(1,len,len))
				coe = t(S) - diag(1,len,len)
				coe[len,] = rep(1, len )
				b = c(rep(0,len-1),1)
			} else {
				coe = matrix(rep(0,len^2),nrow=len)
				coe[1:len] = c( weights[1] * S[1,] )
				diag(coe) = c(-1*weights*S[,1])
				coe[1,] = rep(1,len)
				b = c(1,rep(0,len-1))
			}
			try((P.hat = solve( coe , b )))
		}
		if (method=="least.squares") {
			stop("*** Unimplemented Method ***")
		}

	}
	names(P.hat) = groupNames
	P.hat[which(P.hat<=0)]=0
	#P.hat[which(is.na(P.hat))]=0
	P.hat
}

fundamental_matrix = function( trans_matrix ) {
	# Calculate the fundamental matrix of transition matrix
	#  Z = (I-P+W)^-1
	W = matrix(rep(rds.mcmc.props(trans_matrix), nrow(trans_matrix)), nrow=nrow(trans_matrix), ncol=nrow(trans_matrix), byrow=TRUE)
	z_inv = diag(x=1, nrow=nrow(trans_matrix), ncol=nrow(trans_matrix) ) - trans_matrix + W

	return( ginv(z_inv) )
}

#asym_mean_count = n*w_j where n is sample size
asym_var_count = function(probs) {
	w = rds.mcmc.props(probs)
	z = fundamental_matrix(probs)
	return( 2* (w*diag(z)) - w - w^2 )
}

# Generate a bootstrapped CI for estimate (no variance in transition probs)
simple_bs = function(S, degree_weights_lists, trials=100, one_tail_alpha=.025 ) {
	bs_results = matrix(nrow=trials, ncol=ncol(S))
	sample_size = length(unlist(degree_weights_lists))
	bs_mean_deg = unlist(lapply(lapply(degree_weights_lists, mean), '^', -1))
	overall_mean = mean(bs_mean_deg)

	state_count = nrow(S)
	#print(bs_results)
	#print(sample_size)
	#print(bs_mean_deg)

	for (j in 1:trials) {
		#Bootstrap a sample composition and transition probs
		bs_sample = generate_state_seq(seq_len=sample_size, probs=S)

		rec = matrix(0, state_count, state_count)
		for (i in 2:length(bs_sample)) {
			rec[bs_sample[i-1], bs_sample[i]] = rec[bs_sample[i-1], bs_sample[i]]+1
		}

		bs.props = prop.table(rec, 1)
		bs.cnum  = as.vector(table( factor(bs_sample, levels=c(1:state_count) ) ))
		#print(bs.cnum)

		#Bootstrap a degree for each group, based on the bootstrapped sample composition
		for (i in 1:length(bs_mean_deg)){
			if (bs.cnum[i]>=1) {
				bs_mean_deg[i] = bs.cnum[i] / sum( sample(degree_weights_lists[[i]], size=bs.cnum[i], replace=TRUE) )
			} else {
				bs_mean_deg[i] = overall_mean
			}
		}

		bs_results[j,] = unlist(rds.mcmc.props(bs.props, bs_mean_deg))
	}
	#print(bs_results)
	bs_ci = as.vector(apply( bs_results, 2, quantile, c(one_tail_alpha, 1-one_tail_alpha), na.rm=TRUE))

	return(bs_ci)
}

# Generate a bootstrapped CI for estimate (with variance in transition probs)
trans_var_bs = function(S, degree_weights_lists, trials=100, one_tail_alpha=.025, fudge=1) {
	bs_results = matrix(nrow=trials, ncol=ncol(S))
	sample_size = length(unlist(degree_weights_lists))
	bs_mean_deg = unlist(lapply(lapply(degree_weights_lists, mean), '^', -1))
	overall_mean = mean(bs_mean_deg)
	state_count = nrow(S)
	#print(bs_results)
	#print(sample_size)
	#print(bs_mean_deg)

	expected_sd = apply(S, c(1,2), function(x) sqrt(x*(1-x)/(sample_size/fudge)) )

	for (j in 1:trials) {
		# Add some variation in the S matrix
		# Create some noise using expected sd
		noise = apply(expected_sd, c(1,2), function(x) rnorm(1, sd=x))

		#if (FALSE) {
			## Correct for dependence of proportions
			## Might only work for 2 states, non-zero recruitment
			noise[,state_count] = noise[,1:(state_count-1)]*-1

			# Re-normalize S after applying noise
			S_noise = S+noise
			S_noise[S_noise<0] = 0
		#}

		S_p = prop.table(S+noise, 1)

		#Bootstrap a sample composition and transition probs
		bs_sample = generate_state_seq(seq_len=sample_size, probs=S_p)

		rec = matrix(0, state_count, state_count)
		for (i in 2:length(bs_sample)) {
			rec[bs_sample[i-1], bs_sample[i]] = rec[bs_sample[i-1], bs_sample[i]]+1
		}

		bs.props = prop.table(rec, 1)
		bs.cnum  = as.vector(table( factor(bs_sample, levels=c(1:state_count) ) ))
		#print(bs.props)
		#print(bs.cnum)

		#Bootstrap a degree for each group, based on the bootstrapped sample composition
		for (i in 1:length(bs_mean_deg)){
			if (bs.cnum[i]>=1) {
				bs_mean_deg[i] = bs.cnum[i] / sum( sample(degree_weights_lists[[i]], size=bs.cnum[i], replace=TRUE) )
			} else {
				bs_mean_deg[i] = overall_mean
			}
		}
		bs_results[j,] = unlist(rds.mcmc.props(bs.props, bs_mean_deg))
	}
	#print(bs_results)
	bs_ci = as.vector(apply( bs_results, 2, quantile, c(one_tail_alpha, 1-one_tail_alpha), na.rm=TRUE))

	return(bs_ci)
}

simple_wts_bs = function(vals_list, weights_list, trials=100, one_tail_alpha=.025 ) {
	bs_results = matrix(nrow=trials, ncol=ncol(S))
	sample_size = length(weights_list)
	state_count = length( unique(vals_list) )
	states = sort(unique(vals_list))
	for (j in 1:trials) {
		#Bootstrap a sample
		bs_sample = sample(vals_list, size=sample_size, replace=TRUE , prob=weights_list )

		bs_results[j,] = prop.table( table(factor(bs_sample, levels=states)) )
	}
	bs_ci = as.vector(apply( bs_results, 2, quantile, c(one_tail_alpha, 1-one_tail_alpha), na.rm=TRUE))

	return(bs_ci)
}

var_wts_bs = function(vals_list, rc_weights_list, dc_weights_list, trials=100, one_tail_alpha=.025 ) {
	bs_results = matrix(nrow=trials, ncol=ncol(S))
	sample_size = length(weights_list)
	states = sort(unique(vals_list))
    state_count = length( states )

	# use vals to partition weights list and get a distribution for each unique val
	rc_lists = list()
	dc_lists - list()

	for (i in state_count) {
		bool_membership = vals_list==state[i]
		rc_lists[[i]] = rc_weights_list[ bool_membership ]
		dc_lists[[i]] = dc_weights_list[ bool_membership ]
	}

	#For each trial
	# permute the weights list within groups

	for (j in 1:trials) {
		#Bootstrap a sample
		bs_sample = sample(vals_list, size=sample_size, replace=TRUE , prob=weights_list )

		bs_results[j,] = prop.table( table(factor(bs_sample, levels=states)) )
	}
	bs_ci = as.vector(apply( bs_results, 2, quantile, c(one_tail_alpha, 1-one_tail_alpha), na.rm=TRUE))

	return(bs_ci)
}

# Generate a bootstrapped CI for estimate (with variance in transition probs)
two_step_trans_var_bs = function(S, degree_weights_lists, trials=100, one_tail_alpha=.05) {
	bs_results = matrix(nrow=trials, ncol=ncol(S))
	sample_size = length(unlist(degree_weights_lists))
	bs_mean_deg = unlist(lapply(lapply(degree_weights_lists, mean), '^', -1))
	state_count = nrow(S)
	#print(bs_results)
	#print(sample_size)
	#print(bs_mean_deg)

	#Generate a set of draws for n_i and n_ij
	w = rds.mcmc.props(S)
	asym_var = asym_var_count(probs)

	# random permutations of the transition matrix S
	S_p = replicate(trials, S)   # random permutations of the transition matrix S
	bs_mean_deg_replicates = replicate(trials, bs_mean_deg)

	# Populate the permutations
	for (i in 1:nrow(S)) {
		# Sample the number of each state in sample
		n_sub_i = round(rnorm(trials, sd=sqrt(asym_var[i] * sample_size))+ sample_size*w[i])

		# Sample the mean degree for each state group
		bs_mean_deg_replicates[i,] = sapply( n_sub_i,  function(x) x / sum( sample(degree_weights_lists[[i]], size=x, replace=TRUE) ) )

		# Sample the transitions from each group ( n_ij, then calculate permuted transitions S )
		S_p[i,,] = prop.table(sapply(n_sub_i, function(x) rmultinom(1, size=x, prob=S[i,] )), 2)
	}
	head(bs_mean_deg_replicates)
	head(S_p)

	for (j in 1:trials) {
		bs_results[j,] = rds.mcmc.props(S_p[,,j], bs_mean_deg_replicates[,j])
	}
	#print(bs_results)
	bs_ci = as.vector(apply( bs_results, 2, quantile, c(one_tail_alpha, 1-one_tail_alpha), na.rm=TRUE))

	return(bs_ci)
}

sim_transition_probs = function(num_trials, sample_size, probs ) {
	# We think the variance for resampled markov chains should be p*(1-p)/n_i when n_i is fixed
	# Need to test that theory with MCMC samples
	results = list()

	for(k in 1:nrow(probs)) {
		results[[k]] = matrix(data=NA, nrow=num_trials, ncol=ncol(probs))
	}

	for (trial in 1:num_trials ) {
		#Generate State Sequence
		foo = generate_state_seq(sample_size, probs=probs)

		state_count = length(unique(foo))
		rec = matrix(0, state_count, state_count)

		for (i in 2:length(foo)) {
			rec[foo[i-1], foo[i]] = rec[foo[i-1], foo[i]]+1
		}

		S = prop.table(rec, 1)

		for(k in 1:nrow(probs)) {
		    results[[k]][trial,] = S[k,]
	    }

	}
	results_list = lapply(results,function(x) apply(x, 2, var))
	return( matrix(unlist(results_list), nrow=nrow(probs), ncol=ncol(probs), byrow=TRUE))
}

sim_transition_probs_mean = function(num_trials, sample_size, probs ) {
	# We think the variance for resampled markov chains should be p*(1-p)/n_i when n_i is fixed
	# Need to test that theory with MCMC samples
	results = list()

	for(k in 1:nrow(probs)) {
		results[[k]] = matrix(data=NA, nrow=num_trials, ncol=ncol(probs))
	}

	for (trial in 1:num_trials ) {
		#Generate State Sequence
		foo = generate_state_seq(sample_size, probs=probs)

		state_count = length(unique(foo))
		rec = matrix(0, state_count, state_count)

		for (i in 2:length(foo)) {
			rec[foo[i-1], foo[i]] = rec[foo[i-1], foo[i]]+1
		}

		S = prop.table(rec, 1)

		for(k in 1:nrow(probs)) {
		    results[[k]][trial,] = S[k,]
	    }

	}
	results_list = lapply(results,function(x) apply(x, 2, mean))
	return( matrix(unlist(results_list), nrow=nrow(probs), ncol=ncol(probs), byrow=TRUE))
}

sim_state_count = function(num_trials, sample_size, probs ) {
	# We think the variance for resampled markov chains should be p*(1-p)/n_i when n_i is fixed
	# Need to test that theory with MCMC samples

	results = matrix(data=NA, nrow=num_trials, ncol=ncol(probs))

	for (trial in 1:num_trials ) {
		#Generate State Sequence
		foo = generate_state_seq(sample_size, probs=probs)

		state_count = length(unique(foo))
		rec = matrix(0, state_count, state_count)

		for (i in 2:length(foo)) {
			rec[foo[i-1], foo[i]] = rec[foo[i-1], foo[i]]+1
		}

		S = rowSums(rec)

		results[trial,] = S

	}

	return( apply(results, 2, var) )

}

two_step_var_est = function(num_replications, sample_size, probs) {
	w = rds.mcmc.props(probs)
	results = matrix(NA,nrow=nrow(probs), ncol=nrow(probs))
	asym_var = asym_var_count(probs)

	for (i in 1:nrow(probs)) {
			n_sub_i = round(rnorm(num_replications, sd=sqrt(asym_var[i] * sample_size))+ sample_size*w[i])
			results[i,] = apply(prop.table(sapply(n_sub_i, function(x) rmultinom(1, size=x, prob=probs[i,] )), 2), 1, var )
	}
	return(results)
}

two_step_var_est_const_sample_size = function(num_replications, sample_size, probs) {
	#This version holds sample size constant by setting the size of the last group as a function of
	# the other groups. Might still produce large samples if the first n-1 groups get large draws
	w = rds.mcmc.props(probs)
	results = matrix(NA,nrow=nrow(probs), ncol=nrow(probs))
	asym_var = asym_var_count(probs)

	n_sub = matrix(0,nrow=nrow(probs),ncol=num_replications)
	for (i in 1:nrow(probs)) {
		if(i==nrow(probs)){
			n_sub[i,] = apply(n_sub, 2, function(x) max(0, sample_size-sum(x)))
		} else {
		    n_sub[i,] = round(rnorm(num_replications, sd=sqrt(asym_var[i] * sample_size))+ sample_size*w[i])
		}
		results[i,] = apply(prop.table(sapply(n_sub[i,], function(x) rmultinom(1, size=x, prob=probs[i,] )), 2), 1, var )
	}
	return(results)
}

two_step_mean_est = function(num_replications, sample_size, probs) {
	w = rds.mcmc.props(probs)
	results = matrix(NA,nrow=nrow(probs), ncol=nrow(probs))
	asym_var = asym_var_count(probs)

	for (i in 1:nrow(probs)) {
			n_sub_i = round(rnorm(num_replications, sd=sqrt(asym_var[i] * sample_size))+ sample_size*w[i])
			results[i,] = apply(prop.table(sapply(n_sub_i, function(x) rmultinom(1, size=x, prob=probs[i,] )), 2), 1, mean )
	}
	return(results)
}

run_interactive = function() {
# --------------------------------------------------------------------------------------------
# ---- this code is protected by the function -------------------------------
# --------------------------------------------------------------------------------------------

degree_listA = c( 350,  150, 100, 300, 700, 200, 200, 300, 300, 200, 100, 400, 200, 150, 100, 200, 50, 500, 30, 500, 500, 25, 150, 50, 500, 150, 300,  250, 400,  250, 100, 200,  100, 150, 150, 60, 500, 100, 200, 200, 150, 20,  200, 500, 100, 700, 300, 200, 500, 125, 500, 250, 100, 200, 30,  150, 400,  100,  100, 100, 200, 100, 250, 50, 60, 100, 150, 500, 200, 200, 100, 100,  100, 150,  70, 400, 25, 50, 200, 300, 250, 50, 200, 100, 500, 150, 600, 100, 500, 150, 200, 300, 200, 150, 300, 100, 500, 200, 200, 100, 125, 50, 500, 50, 200, 500, 500, 300, 200, 100, 70, 300, 75, 300,  500, 100, 100, 125, 500,  200, 200, 500, 25, 80, 150, 120, 150,  500, 250,  150, 25, 30, 50, 30, 200,  70,  100, 100, 50, 100, 100, 100, 50, 100, 400, 25, 200, 800, 30, 400, 100, 100, 150, 40, 250, 300, 200,  300, 200, 800, 400, 400, 500, 450, 600, 300, 70, 100, 100, 300, 75, 500, 40, 400 )

degree_listB = c(585, 400, 300, 100, 383, 700, 80, 150, 300, 850,  200, 300, 150, 300, 300, 200, 150, 100, 150, 600, 300, 50, 300, 100, 700, 300, 100, 35, 70, 500, 150, 200,  20, 250, 100, 500, 20, 150, 90, 200, 20, 150,  30, 100, 200, 100, 60, 600, 100,  375, 50, 200, 300, 100, 100, 200, 75, 100, 220, 300, 500, 400, 100, 50)

degree_weights_list = list(degree_listA^-1, degree_listB^-1)

afterA_probs = c(0.8414634, 0.1585366)
afterB_probs = c(0.5250000, 0.4750000)

probs = matrix( c(afterA_probs, afterB_probs), 2,2,byrow=TRUE)

sample_size = 246

#Get the observed trans
foo = generate_state_seq(sample_size, probs=probs)

state_count = length(unique(foo))
rec = matrix(0, state_count, state_count)

for (i in 2:length(foo)) {
	rec[foo[i-1], foo[i]] = rec[foo[i-1], foo[i]]+1
}

S = prop.table(rec, 1)

cnum = as.vector(table(foo))
# Get Degree Seq by group, invert, bootstrap based on the counts in bootstrapped state_seq

# deg_wt_list is a list of 1/degrees by group, so deg_list[[1]] is the degrees of state index 1
bs_mean_deg = unlist(lapply(lapply(deg_wt_list, mean), '^', -1))  #initialize with group means, probably not necessary

for (i in 1:length(bs_mean_deg)){
	bs_mean_deg[i] = cnum[i] / sum( sample(deg_wt_list[[i]], size=cnum[i], replace=TRUE) )
}

bs_results = c()
sample_size = c()
bs_mean_deg = c()

w_2 = rds.mcmc.props(S)

sim_transition_probs(100000, sample_size, probs)

# [1] 0.0007175294 0.0007175294
# [1] 0.004568726 0.004568726

apply(prop.table(rmultinom(1000000, size = 195, prob = w_2),2), 1, var)
#           1            2
#0.0008414084 0.0008414084

apply(prop.table(rmultinom(1000000, size = 195, prob = afterA_probs),2), 1, var)
# 0.0006855071

apply(prop.table(rmultinom(1000000, size = 50, prob = afterB_probs),2), 1, var)
# 0.004999966

sim_transition_probs(10000, sample_size, probs=matrix(.5,nrow=2, ncol=2))
#0.002080681

apply(prop.table(rmultinom(1000000, size = 195, prob = c(.5, .5)),2), 1, var)
# 0.001282336

apply(prop.table(rmultinom(1000000, size = 50, prob = c(.5, .5)),2), 1, var)
# 0.005005388

#Need to sample number from each group
# VAR[S_j(n)] ~ 2 * w_j * z_jj - w_j- w_j^2

var(rnorm(10000000, sd=sqrt(.343*246))+246*.79 )   #Something like the expected variation of count in each state
# 84.397

var(rnorm(10000000, sd=sqrt(asym_var_count(probs)*246))+246*rds.mcmc.props(probs)[1] )

sim_state_count(100000, 246, probs)
# 83.481

var(rnorm(10000000, sd=sqrt(asym_var_count(probs)*1000))+1000*rds.mcmc.props(probs)[1] )

sim_state_count(10000, 1000, probs)
# 83.481

#Lets simulate the variance of the ratio of n_ij / n_i
#First get the number of n_i:
sample_size = 246
asym_var = asym_var_count(probs)
e_hats = rds.mcmc.props(probs)

n_sub_i = round(rnorm(100000, sd=sqrt(asym_var[1] * sample_size))+ sample_size*e_hats[1])

#n_sub_ij = sapply(n_sub_i, function(x) rmultinom(1, size=x, prob=afterA_probs)

#var_prop = apply(prop.table(sapply(n_sub_i, function(x) rmultinom(1, size=x, prob=afterA_probs) ), 2), 1, var )
apply(prop.table(sapply(n_sub_i, function(x) rmultinom(1, size=x, prob=afterA_probs) ), 2), 1, var )

#.0007 vs .00068  --- not bad, need to check the p=c(.5, .5)

two_step_var_est(100000, 300, matrix(.5,2,2))
#[1,] 0.0008405214 0.0008405214
#[2,] 0.0008378114 0.0008378114

sim_transition_probs(10000, 300, matrix(.5,2,2))
#[1] 0.0008397932 0.0008397932
#[1] 0.0008414575 0.0008414575

# Looks like variance is accurate to within ~2%

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

}

# Test the percent error in the modeled variance compared to MC
percent_errors_2_groups = function( reps=100, size=300, p_ij=c(.1, .25, .5, .75, .90) ){
	results = matrix(nrow=length(p_ij), ncol=length(p_ij), dimnames=list(p_ij, p_ij))

	for( i in 1:length(p_ij) ) {
		for( j in 1:length(p_ij) ){
			probs = matrix( c(1-p_ij[i], p_ij[j], p_ij[i], 1-p_ij[j]) , 2,2)
			#print(probs)
			mc = sim_transition_probs(reps, size, probs)
			model = two_step_var_est_const_sample_size(reps, size, probs)
			results[i,j] = max((mc-model)/mc)
		}
	}
	results
}


library(dplyr)
library(ggplot2)
library(repr)
library(cowplot)
options(repr.plot.width=12, repr.plot.height=4)

#Code snippet 2.1
df <- read.csv("/Users/jmoolay/Personal/Packt/Supervised Learning with R/Chapters/Chapter 2/Data/bank-additional/bank-additional-full.csv",sep=';')
str(df)

#Code snippet 2.2
library(ggplot2)
print(summary(df$age))
print(paste("Std.Dev:",round(sd(df$age),2)))
ggplot(data=df,aes(y=age)) + geom_boxplot(outlier.colour="black")

#Code snippet 2.3
ggplot(data=df,aes(x=age)) +
    geom_histogram(bins=10,fill="blue",color="black", alpha =0.5)  +
    ggtitle("Histogram for Age") + theme_bw()

#Code snippet 2.4
ggplot(data=df,aes(x=age)) + geom_density(fill="red",alpha =0.5) +
                             ggtitle("Density Plot for Age") +
                             theme_bw()

#Code snippet 2.5
#Automate plotting numeric variables

library(cowplot)
#Define a function to plot histograms for all numeric columns
plot_grid_numeric <- function(df,list_of_variables,ncols=2){
    plt_matrix<-list()
    i<-1
    for(column in list_of_variables){
        plt_matrix[[i]]<-ggplot(data=df,aes_string(x=column)) +
            geom_histogram(binwidth=2,fill="blue",color="black", alpha =0.5)  +
            ggtitle(paste("Histogram for varaible:",column)) + theme_bw()
            i<-i+1
            }
    plot_grid(plotlist=plt_matrix,ncol=2)
}
summary(df[,c("campaign","pdays","previous","emp.var.rate")])

#Call the defined function to plot the hisitogram
plot_grid_numeric(df,c("campaign","pdays","previous","emp.var.rate"),2)

#Code snippet 2.6
#Study the next set of numeric variables
summary(df[,c("nr.employed","euribor3m","cons.conf.idx","duration")])
plot_grid_numeric(df,c("nr.employed","euribor3m","cons.conf.idx","duration"),2)

#Code snippet 2.7
#Use the dplyr library function to perform grouped data aggregation
marital_distribution <- df %>% group_by(marital) %>% summarize(Count = n()) %>%
                                mutate(Perc.Count = round(Count/sum(Count)*100))
print(marital_distribution)

#Code snippet 2.8
ggplot(data = marital_distribution,aes(x=marital,y=Perc.Count)) +
                        geom_bar(stat="identity",fill="blue",alpha=0.6) +
                        geom_text(aes(label=marital_distribution$Perc.Count, vjust = -0.3))

#Code snippet 2.9
#Define label positions
plot_breaks = 100 - (cumsum(marital_distribution$Perc.Count)  - marital_distribution$Perc.Count/2)

#Define labels for the plots
plot_labels <- paste0(marital_distribution$marital,"-",marital_distribution$Perc.Count,"%")

#Setting plot size for better visuals
options(repr.plot.width=12, repr.plot.height=8)

#Creating the pie chart
ggplot(data = marital_distribution,aes(x=1,y=Perc.Count, fill=marital)) +
              geom_bar(stat="identity") + #Creates the base bar visual
               coord_polar(theta ="y")  + #Creates the pie chart
               scale_y_continuous(breaks=plot_breaks, labels = plot_labels,position = "left") +
               theme(axis.text.x = element_text(angle = 30, hjust =1)) + #rotates the labels
               theme(text = element_text(size=15)) + #increases the font size for the legend
               ggtitle("Percentage Distribution of Marital Status") #Adds the plot title

#Code snippet 2.10
#Automate plotting categorical variables
library(cowplot)

#Define a function to plot histograms for all numeric columns
plot_grid_categorical <- function(df,list_of_variables,ncols=2){
    plt_matrix <- list()
    i<-1
    #Iterate for each variable
    for(column in list_of_variables){
       #Creating a temporary dataframe with the aggregation
        var.dist <- df %>% group_by_(column) %>%
                                       summarize(Count = n()) %>%
                                       mutate(Perc.Count = round(Count/sum(Count)*100,1))

        options(repr.plot.width=12, repr.plot.height=10)

        plt_matrix[[i]]<-ggplot(data = var.dist,aes_string(x=column,y="Perc.Count")) +
            geom_bar(stat="identity",fill="blue",alpha=0.6) + #Defines the bar plot
            geom_text(label=var.dist$Perc.Count,vjust=-0.3)+  #Adds the labels
            theme(axis.text.x = element_text(angle = 90, vjust = 1)) + #rotates the labels
            ggtitle(paste("Percentage Distribution of variable:",column))  #Creates the title +

            i<-i+1
        }

        plot_grid(plotlist=plt_matrix,ncol=ncols) #plots the grid

}

#call summary statistics
summary(df[,c("job","education","default","contact")])

#Call the defined function to plot the hisitogram
plot_grid_categorical(df,c("job","education","default","contact"),2)

#Code snippet 2.11
#call summary statistics
summary(df[,c("loan","month","day_of_week","poutcome")])
#Call the defined function to plot the hisitogram
plot_grid_categorical(df,c("loan","month","day_of_week","poutcome"),2)

#Code snippet 2.12
#call summary statistics
summary(df[,c("y","housing")])

#Call the defined function to plot the hisitogram
plot_grid_categorical(df,c("y","housing"),2)

#Code snippet 2.13
#Scatter plot
options(repr.plot.width=8, repr.plot.height=3)
ggplot(data=df,aes(x=emp.var.rate,y=nr.employed)) + geom_point(size=4) +
ggtitle("Scatterplot of Employment variation rate v/s Number of Employees")

#Code snippet 2.14
temp <- df %>% group_by(y) %>% summarise(Avg.Age = round(mean(age),2),
                                       Num.Records = n())
print(temp)
options(repr.plot.width=8, repr.plot.height=3)

ggplot(data= temp, aes(x=y, y=Avg.Age)) +
        geom_bar(stat="identity",fill="blue",alpha= 0.5) +   #Creates the bar plot
        geom_text(label=temp$Avg.Age,vjust=-0.3)+  #Adds the label
        ggtitle(paste("Average.Age across target outcome"))  #Creates the title

#Code snippet 2.15
plot_bivariate_numeric_and_categorical <- function(df,target,list_of_variables,ncols=2){
    target<-sym(target) #Defined for converting text to column names
    plt_matrix <- list()
    i<-1

for(column in list_of_variables){
        col <-sym(column) #defined for converting text to column name

        temp <- df %>% group_by(!!sym(target)) %>%
                       summarise(Avg.Val = round(mean(!!sym(col)),2))
        options(repr.plot.width=12, repr.plot.height=8) #Defines plot size
            plt_matrix[[i]]<-ggplot(data= temp, aes(x=!!sym(target), y=Avg.Val)) +
            geom_bar(stat="identity",fill="blue",alpha= 0.5) +
            geom_text(label=temp$Avg.Val,vjust=-0.3)+  #Adds the labels
            ggtitle(paste("Average",column,"across target outcomes"))  #Creates the title

            i<-i+1
    }
    plot_grid(plotlist = plt_matrix,ncol=ncols)

}
print("Distribution of records across target outcomes-")
print(table(df$y))
plot_bivariate_numeric_and_categorical(df,"y",c("campaign","pdays","previous","emp.var.rate"),2)

#Code snippet 2.16
plot_bivariate_numeric_and_categorical(df,"y",
c("cons.price.idx","cons.conf.idx", "euribor3m", "nr.employed"),2)

#Code snippet 2.17
#Create a temp aggregation dataset
temp <- df %>% group_by(y,marital) %>% summarise(Count = n())

#Define plot size
options(repr.plot.width=12, repr.plot.height=4)

#Plot teh chart with frequency distribution
ggplot(data = temp,aes(x=marital,y=Count,fill=y)) +
    geom_bar(stat="identity") +
    ggtitle("Distribution of target 'y' across Marital Status")

#Code snippet 2.18
#create a temp aggregation dataset
temp <- df %>% group_by(y,marital) %>%
            summarise(Count = n()) %>%
            ungroup() %>% 	#This function ungroups the previously grouped dataframe
            group_by(marital) %>%
            mutate(Perc = round(Count/sum(Count)*100)) %>%
            arrange(marital)
#Define the plot size
options(repr.plot.width=12, repr.plot.height=4)

#Plot the percentage distribution
ggplot(data = temp,aes(x=marital,y=Perc,fill=y)) +
    geom_bar(stat="identity") +
    geom_text(aes(label = Perc), size = 5, hjust = 0.5, vjust = 0.3, position = "stack") +
    ggtitle("Distribution of target 'y' percentage across Marital Status")

#Code snippet 2.19
#create a temp aggregation dataset
plot_bivariate_categorical <-  function(df, target, list_of_variables){
    target <- sym(target) #Converting the string to a column reference
    i <-1
    plt_matrix <- list()
    for(column in list_of_variables){
        col <- sym(column)
        temp <- df %>% group_by(!!sym(target),!!sym(col)) %>%
            summarise(Count = n()) %>%
            ungroup() %>% #This fucntion ungroups the previously grouped dataframe
            group_by(!!sym(col)) %>%
            mutate(Perc = round(Count/sum(Count)*100)) %>%
            arrange(!!sym(col))
    #Define the plot size
    options(repr.plot.width=14, repr.plot.height=12)

    #Plot the chart with frequency distribution
    plt_matrix[[i]]<- ggplot(data = temp,aes(x=!!sym(col),y=Count,fill=!!sym(target))) +
        geom_bar(stat="identity") +
        geom_text(aes(label = Count), size = 3, hjust = 0.5, vjust = -0.3, position = "stack") +
        theme(axis.text.x = element_text(angle = 90, vjust = 1)) + #rotates the labels
        ggtitle(paste("Distribution of target 'y'  frequency across",column))
    i<-i+1

    #Plot the percentage distribution
    plt_matrix[[i]] <- ggplot(data = temp,aes(x=!!sym(col),y=Perc,fill=!!sym(target))) +
            geom_bar(stat="identity") +
            geom_text(aes(label = Perc), size = 3, hjust = 0.5, vjust = -1, position = "stack") +
            theme(axis.text.x = element_text(angle = 90, vjust = 1)) + #rotates the labels
            ggtitle(paste("Distribution of target 'y' percentage across",column))
    i <- i+1

    }
    plot_grid(plotlist = plt_matrix, ncol=2)
}
plot_bivariate_categorical(df,"y",c("job","education"))

#Code snippet 2.21
plot_bivariate_categorical(df,"y",c("loan","contact"))

#Code snippet 2.22
#Hypothesis testing for categorical dependent variable and continuous independent variable
#Convert the dependent variable into a factor type
df$y <- factor(df$y)

#Perform Logistic regression
h.test <- glm(y ~ emp.var.rate, data = df, family = "binomial")

#Print test summary
summary(h.test)

#Code snippet 2.23
#Hypothesis testing for categorical dependent variable and continuous independent variable

#Perform Logistic regression
h.test2 <- glm(y ~ euribor3m, data = df, family = "binomial")

#Print test summary
summary(h.test2)

#Code snippet 2.24
#Hypothesis testing for categorical dependent variable and categorical independent variable

#Create a flag for "Single" clients
df$single_flag <- as.factor(ifelse(df$marital == "single","single","other"))
sample <- table(df$y, df$single_flag)
print(sample)

#Perform chi squared test
h.test3 <- chisq.test(sample)

#Print test summary
print(h.test3)

#Code snippet 2.25
#Hypothesis #4 and #5
#Prepare the independent variable
df$job_flag <- as.factor(ifelse(df$job %in% c("student","retired"),as.character(df$job),"other"))
df$contact <- as.factor(df$contact)

sample4 <- table(df$y, df$job_flag)
print("Frequency table for Job")
print(sample4)

#Perform test for hypothesis #4
h.test4 <- chisq.test(sample4)

#Print test summary for hypothesis #4
print("Hypothesis #4 results")
print(h.test4)

print("Frequency table for Contact")
sample5 <- table(df$y, df$contact)
print(sample5)

#Perform test
h.test5 <- chisq.test(sample5)

#Print test summary for hypothesis #5
print("Hypothesis #5 results")
print(h.test5)


# ......................................................................................
# .........................Exercise 3 - Discrete random variable........................
# ......................................................................................
# ......................................................................................

# If text does not display correctly, set File \Reopen with Encoding ... to UTF-8
# Use CTRL + SHIFT + O to display the contents of the script
# Use CTRL + ENTER to run commands on a single line

#  Examples ####
#
# * Example 1. ####
#
# The owner of the service center offered maintanace to a car dealership that set up car
# rental company. For each car rented through it, they will receive CZK 500 from the car
# rental company. At the same time, however, he undertook to invest CZK 800 in the
# maintenance every day. The number of cars rented through the service center in 1 day
# is described by the following probability function: </br>
#  ![Image-3.png](attachment:image-3.png)
#
# ** 1. a) ####
#
# The value of the probability function for 5 cars was difficult to read. Specify it:
#

x = c(0,1,2,3,4,5,6)
p = c(0.01,0.40,0.25,0.15,0.10,0,0.03)
x
p

1 - sum(p) # Computer arithmetic can be annoying here
round(1 - sum(p), digits=2) # round to the hundredth
p[6] = round(1 - sum(p), digits=2) # the notation for x=5 is the 6th position
p

plot(x, p)

# Probability function
probability_draw = function(x,p){
    plot(x, p, # solid wheels - in actual values
        ylab='p(x)',xaxt='n',pch=19,ylim=c(0,max(p)),main="Probability function")
    lines(c(min(x)-100,max(x)+100),c(0, 0))
    for(i in 1:length(x)){
        lines(c(min(x)-100,max(x)+100), c(p[i],p[i]),
              type = 'l', lty = 3, lwd=0.5) # horizontal grid
        lines(c(x[i],x[i]), c(-0.1,1.1),
              type = 'l', lty = 3, lwd=0.5) # vertical grid
    }
    par(new=TRUE) # that we want to draw in one graph
    plot(x, p*0, # empty circles - where a non-zero value is defined
        ylab='p(x)', xaxt='n', ylim=c(0,max(p)))
    axis(1, at=x,labels=x) # set values to X
    axis(4, at=p,labels=p, las=2, cex.axis=0.7, tck=-.01) # and Y
}

probability_draw(x, p)

# More on plotting in R can be found here:
# http://www.statmethods.net/advgraphs/parameters.html or here
# https://flowingdata.com/2015/03/17/r-cheat-sheet-for-graphical-parameters/ or
# http://bcb.dfci.harvard.edu/~aedin/courses/BiocDec2011/2.Plotting.pdf
#

# ** 1. b) ####
#
# Determine and plot the distribution function of the random variable X, which is
# defined as the number of rented cars.
#

p
F = cumsum(p)
F

plot(x, F, type="s") # simplified distribution function graph

# Function for calculating and plotting the distribution function
distribution_draw = function(x,p){
    F = cumsum(p)
    F_ext = c(0, F) # we stretch F by 0 at the beginning
    x_ext = c(x[1]-1, x, x[length(x)]+1) # axz both sides

    plot(x, F, ylab="F(x)", xaxt='n', ylim=c(0,1), # empty wheels
         type='p', main="Distribution function")
    par(new=TRUE) # that we want to draw in one graph
    plot(x, F_ext[1:(length(F_ext)-1)], # full wheels
         ylab="F(x)", xaxt='n', ylim=c(0,1), type='p', pch=19)

    for(i in 1:(length(x_ext)-1)){
        lines(c(min(x)-100,max(x)+100), c(F_ext[i],F_ext[i]),
              type = 'l', lty = 3, lwd=0.5) # horizontal grid
        lines(c(x_ext[i],x_ext[i]), c(-0.1,1.1),
              type = 'l', lty = 3, lwd=0.5) # vertical grid
        lines(x_ext[i:(i+1)], c(F_ext[i],F_ext[i])) # graph - lines
    }
    axis(1, at=x,labels=x) # set values to X
    axis(4, at=F,labels=F, las=2, cex.axis=0.7, tck=-.01) # a Y
    return(F)
}

distribution_draw(x,p)

# ** 1. c) ####
#
# Determine the mean, variance, standard deviation, and mode of the number of cars
# rented per day.
#

# Mean value
x*p
EX = sum(x*p)
EX

# Scattering
EX2 = sum(x*x*p)  # second general moment
DX = EX2 - EX^2
DX

# Standard deviation
sigma.X = sqrt(DX)
sigma.X

# Functions for calculating basic numerical characteristics
summary_of_RV=function(x,p){
  EX = sum(x*p)
  EX2 = sum(x*x*p)
  DX = EX2-EX^2
  sigma.X = sqrt(DX)
  # write the results to the table
  tab = rbind(EX, DX, sigma.X)
  tab.popis = c("mean","variance","st. dev.")
  rownames(tab) = tab.popis
  return(tab)
}

summary_of_RV(x, p)

# ** 1. d) ####
#
# Determine the probability function and the distribution function of the random
# variable Y, which is defined as the daily income of the service owner.
#

y = 500*x
y

probability_draw(y, p)

# Distribution function
distribution_draw(y,p)

# ** 1. e) ####
#
# Determine the mean, standard deviation, and mode of receipt of the service owner from
# rented cars within one day.
#

summary_of_RV(y,p)

# ** 1. f) ####
#
# Determine the probability that the service owner's income(random variable Y) from car
# rental will exceed his expenses.
#

# profit
z=500*x-800
z

# income exceeds expenses when profit is positive
z > 0

p
sum(p[z>0])

# ** 1. g) ####
#
# Determine the mean, standard deviation, and mode of the random variable Z, which is
# defined as the service owner's profit from rented cars in one day.
#

summary_of_RV(z,p)

# * Example  2 #### ####
#
# For the distribution function of the random variable X: $F(x)=\begin{cases} 0   &
# x \leq -1 \\ 0.3 & -1 < x \leq  0 \\ 0.7 &  0 < x \leq  1 \\ 1   & -1 < x \end{cases}$
#
# ** 2. a) ####
#
# Determine the probability function of a random variable X, its mean and standard
# deviation.
#

F = c(0, 0.3, 0.7, 1)
F
x = c(-1,0,1)
x

diff(F)

p = diff(F)
x
p

probability_draw(x,p)

distribution_draw(x,p)

summary_of_RV(x,p)

# ** 2. b) ####
#
# Random variable Y=1 - 3X, determine P(y), F(y), E(Y), D(Y).
#

y = 1 - 3*x
probability_draw(y,p)

distribution_draw(y,p)   # Nonsensical output - what is the cause?
y
p

y
sort(y)
idx_sorted = order(y) # The order function returns the sorted order indexes
idx_sorted
y = y[idx_sorted]
p_y = p[idx_sorted]
p_y

distribution_draw(y,p_y)

summary_of_RV(y, p_y)

# ** 2. c) ####
#
# Random variable W=$3X^2$, determine P(w), F(w), E(W), D(W).
#

w = 3*x*x
w

probability_draw(w,p)
distribution_draw(w,p)

w
w_uniq = unique(w)
w_uniq
w_sorted = sort(w_uniq)
w_sorted

p_w = w_sorted*0 # initialize an array of the same size
for(i in 1:length(w_sorted)){
    p_w[i] = sum(p[w == w_sorted[i]])
}
p_w

probability_draw(w_sorted,p_w)
distribution_draw(w_sorted,p_w)
summary_of_RV(w_sorted,p_w)

# * Example 3. ####
#
# There are two machines working independently in the workshop. The probability of
# failure of the first machine is 0.2, the probability of failure of the second machine
# is 0.3. The random variable X is defined as the number of machines that have failed at
# the same time. Specify:
#
# ** 3. a) ####
#
# probability function of a random variable X,
#

x = c(0, 1, 2)
x
p1 = 0.2
p2 = 0.3

p = x*0
# we calculate the individual probabilities of the number of broken machines
p[1] = (1 - p1)*(1 - p2) # 0 broken, so both in operation
p[3] = p1*p2 # 2 so broken both
p
1 - sum(p)
p[2] = (1 - p1)*p2 + p1*(1 - p2) # just one - either the first or the second
p

sum(p)

probability_draw(x,p)

# ** 3. b) ####
#
# distribution function of random variable X,
#

distribution_draw(x,p)

# ** 3. c) ####
#
# mean and variance of a random variable X.
#

summary_of_RV(x,p)


el = read.csv(file = 'adjacency.csv',header=FALSE,sep=',')
library(igraph)
library(ggplot2)
net <- as.matrix(el)
graph <- graph_from_adjacency_matrix(net)

V(graph)$color <- "gray50"
V(graph)$shape <- "circle"
E(graph)$width <- 6/sqrt(length(E(graph)))

E(graph)$color <- "orange"
E(graph)$arrow.size <- 0
V(graph)$size <- 100 / sqrt(length(V(graph)))

graph.degrees <- degree(graph)

graph.degree.histogram <- as.data.frame(table(graph.degrees))
graph.degree.histogram[,1] <- as.numeric(graph.degree.histogram[,1])

set.seed(123)
plot(graph,vertex.label=NA)
ggplot(graph.degree.histogram, aes(x = graph.degrees, y = Freq)) +
  geom_point() +
  scale_x_continuous("Degree",
                     breaks = c(2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192),
                     trans = "log2") +
  scale_y_continuous("Frequency",
                     breaks = c(2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192),
                     trans = "log2") +
  ggtitle("Degree Distribution (log-log)") +
theme_bw()

pdf('graph.pdf')
set.seed(123)
plot(graph,vertex.label=NA)
dev.off()

jpeg('graph.jpg')
set.seed(123)
plot(graph,vertex.label=NA)
dev.off()

jpeg('degree_distribution.jpg')
ggplot(graph.degree.histogram, aes(x = graph.degrees, y = Freq)) +
  geom_point() +
  scale_x_continuous("Degree\n(nodes with this amount of connections)",
                     breaks = c(0, 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024),
                     trans = "log2") +
  scale_y_continuous("Frequency\n(how many of them)",
                     breaks = c(0, 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024),
                     trans = "log2") +
  ggtitle("Degree Distribution (log-log)") +
theme_bw()
dev.off()

pdf('degree_distribution.pdf')
ggplot(graph.degree.histogram, aes(x = graph.degrees, y = Freq)) +
  geom_point() +
  scale_x_continuous("Degree\n(nodes with this amount of connections)",
                     breaks = c(2, 4, 8, 16, 32, 64, 128, 256, 512, 1024),
                     trans = "log2") +
  scale_y_continuous("Frequency\n(how many of them)",
                     breaks = c(2, 4, 8, 16, 32, 64, 128, 256, 512, 1024),
                     trans = "log2") +
  ggtitle("Degree Distribution (log-log)") +
theme_bw()
dev.off()