do.sim <- function(mix.par=0.2,mu1=5,sigma1=4,mu2=5,df=4,n=30,
                 alpha.vec=c(0,0.1,0.2), M=1000) {
#Purpose:
# Runs a simulation to compute the RMSEs for trimmed means from
#  samples taken from a 2 point normal and t mixture model
#Inputs:
# mix.par - mixture parameter of the distribution (range 0-1)
# mu1 - mean of the normal component of the mixture
# sigma1 - sd of the normal component of the mixture
# mu2 - mean of the t component of the mixture
# df - degrees of freedom for the t component
# n - size of samples to generate in simulation
# alpha.vec - vector of trimming levels to try (0=no trim i.e. mean,
#   0.5=trim 50th quantile above and below - i.e., median)
# M - number of simultions to run
#Output: List containing elements:
# MSE - vector of the MSEs at each trim level
# ests - matrix with M rows and length(alpha.vec) columns containing the raw estimates
# mu - the true mean of the input distribution

#initialize matrix of outputs
  est.matrix <- matrix(NA,M,length(alpha.vec))
#run simulation
  for(simulation in 1:M) {
    temp <- mix.dist(n,mix.par,mu1,sigma1,mu2,df)
    est.matrix[simulation, ] <- estimate.mean(temp,alpha.vec)
  }

#work out the expected value of the input distribution
  E.Z <- get.expectation(mix.par,mu1,mu2)

#Calculate MSEs
  mean.square.error <- mean.square.error(est.matrix,E.Z)

  return(list(MSE=mean.square.error, ests=est.matrix, mu=E.Z))

}


.kernel.squared.exponential <- function(x1, x2, l) {
    factor <- -1.0 / (2 * l * l)
    if (is.matrix(x1)) {
        sigma <- matrix(0, nrow(x1), nrow(x2))
        for (i in 1:nrow(sigma)) {
            v <- t(x1[i,] - t(x2))
            rsq <- apply(v * v, 1, sum)
            sigma[i,] <- exp(factor * rsq)
        }
    } else {
        sigma <- matrix(0, length(x1), length(x2))
        for (i in 1:nrow(sigma)) {
            v <- x1[i] - x2
            sigma[i,] <- exp(factor * v * v)
        }
    }

    return(sigma)
}

.kernel.se.integral <- function(alpha, l, D) {
    d <- sqrt((2*pi*l*l)^D)
    integral <- sum(d * alpha)
    return(integral)
}

.kernel.matern32 <- function(x1, x2, l) {
    if (is.matrix(x1)) {
        sigma <- matrix(0, nrow(x1), nrow(x2))
        for (i in 1:nrow(sigma)) {
            v <- t(x1[i,] - t(x2))
            rsq <- apply(v * v, 1, sum)
            y <- sqrt(3) * sqrt(rsq) / l
            sigma[i,] <- (1 + y) * exp(-y)
        }
    } else {
        sigma <- matrix(0, length(x1), length(x2))
        for (i in 1:nrow(sigma)) {
            v <- x1[i] - x2
            y <- sqrt(3) * sqrt(v * v) / l
            sigma[i, ] <- (1 + y) * exp(-y)
        }
    }

  return(sigma)
}

.kernel.matern32.integral <- function(alpha, l, D) {
  d <- 2 * (1+D) * (l * sqrt(pi/3)) ^ D * gamma(D) / gamma(D / 2)
  integral <- sum(d * alpha)
  return(integral)
}

.gp.log.marginal.likelihood <- function(l, b1, b2, result, verbose) {
  kxx <- result$kernel(result$x, result$x, l) + result$sigman * diag(result$n)

  return_value <- try(L <- chol(kxx), silent = !verbose)
  if (inherits(return_value, "try-error")) {
    return(NA)
  }

  if (is.null(result$meanfn)) {
    mean_sub <- rep(NA, length(result$p))
    for (i in 1:length(result$p)) {
      mean_sub[i] <- result$p[i] - b1 - b2 * (result$xcentered[i,] %*% result$xcentered[i,])
    }
    p1 <- sum(backsolve(L, mean_sub, transpose = T) ^ 2)
  } else {
    p1 <- sum(backsolve(L, result$pmean_sub, transpose = T) ^ 2)
  }
  logdet <- 2.0 * sum(log(diag(L)))
  logml <- -0.5 * p1 - 0.5 * logdet - 0.5 * result$n * log(2*pi)
  if (verbose) {
    cat(c("l:", l, "b1:", b1, "b2:", b2, "logml:",logml, "\n"))
  }
  return(logml)
}

.gp.log.marginal.likelihood.optiml <- function(x, result, verbose) {
  return(.gp.log.marginal.likelihood(x, result$b1, result$b2, result, verbose))
}
.gp.log.marginal.likelihood.optimb1 <- function(x, result, verbose) {
  return(.gp.log.marginal.likelihood(result$l, x, result$b2, result, verbose))
}

.gp.cv.optimize2 <- function(par, result, verbose) {
  result$sigman <- par[2]
  .gp.cv.optimize(par[1], result, verbose)
}

.gp.cv.optimize <- function(l, result, verbose) {
  nfolds <- 5
  n <- result$n
  if (is.matrix(result$x)) {
    D <- ncol(result$x)
  } else {
    D <- 1
  }

  sse <- rep(NA, nfolds)
  for (fi in 1:nfolds) {
    foldsize <- n / nfolds
    test_ix <- (fi - 1) * foldsize + 1:foldsize
    #test_ix <- sample(n, foldsize)
    train_ix <- setdiff(1:n, test_ix)

    if (is.matrix(result$x)) {
      xtrain <- result$x[train_ix,]
      xtest <- result$x[test_ix,]
    } else {
      xtrain <- result$x[train_ix]
      xtest <- result$x[test_ix]
    }
    nt <- length(train_ix)
    K <- result$kernel(xtrain, xtrain, l)

    return_value <- try(L <- chol(K + result$sigman * diag(nt)), silent = !verbose)
    if (inherits(return_value, "try-error")) {
      return(Inf)
    }

    alpha <- backsolve(L, backsolve(L, result$p[train_ix], transpose = T))

    ntest <- length(test_ix)
    ktest <- result$kernel(xtest, xtrain, l)

    integral <- result$kernel.integral(alpha, l, D)
    f <- abs(integral) * (ktest %*% alpha)
    f[f < 0] <- 0
    diff <- result$p[test_ix] - f
    sse[fi] <- sum(diff ^ 2)
    if (integral < 0) {
      # Heavily penalize negative integrals
      #sse[fi] <- sse[fi] * 1e10
    }

  }
  rmse <- sqrt(sum(sse) / n)

  if (verbose) {
    cat(c("l:", l, "sigman:", result$sigman, "rmse:", rmse, "\n"))
  }

  return(rmse)
}

#' Fit a Gaussian process density function.
#'
#' Fit a Gaussian process through the posterior density samples. The GP can optionally be normalized such that the predictive function integrates to 1.
#' The GP assumes a zero mean, and can use either a squared exponential or Matern-type covariance function. A single length scale parameter is used, which is
#' optimized by minimizing the RMSE in 5-fold cross validation.
#' @param x Matrix or vector of samples. For matrices, rows are samples and columns are variables.
#' @param p Probability density at the sample locations; does not have to be normalized. Note that the probabilities should not be log transformed.
#' @param kernel Which kernel to use, can be "se" or "matern32".
#' @param l If optimize == TRUE, this should be a vector of size two with the lower and upper bound for the length scale; if optimize == FALSE, this is the fixed length scale.
#' @param optimize Boolean specifying whether l (and possibly sigman) should be optimized.
#' @param normalize Boolean specifying whether to normalize the GP such that it integrates to 1.
#' @param sigman Can be either a fixed sigman or, if optimize == TRUE, this can also be a vector of size two specifying the lower and upper bound, and in this case sigman will be optimized along with l.
#' @param verbose Display progress during the optimization of l.
#' @export
fit.gp <- function(x, p, kernel, l = 1.0, optimize = T, normalize = T, sigman = 1e-12, verbose = F) {
    result <- list()
    result$type <- "gp"

    if (is.matrix(x)) {
        result$n <- nrow(x)
    } else {
        result$n <- length(x)
    }

    result$kernel.name <- kernel
    if (kernel == "squared.exponential" || kernel == "se") {
        result$kernel <- .kernel.squared.exponential
        result$kernel.integral <- .kernel.se.integral
    } else if (kernel == "matern32") {
        result$kernel <- .kernel.matern32
        result$kernel.integral <- .kernel.matern32.integral
    }

    result$x <- x
    result$p <- p
    result$log <- FALSE

    if (optimize) {
      stopifnot(length(l) > 1)
      options <- nloptr::nl.opts(list(ftol_rel = 1e-6))
      if (length(sigman) > 1) {
          opt <- nloptr::sbplx(c(mean(l), mean(sigman)), .gp.cv.optimize2, c(l[1], sigman[1]), c(l[2], sigman[2]), result = result, verbose = verbose, control=options)
          result$l <- opt$par[1]
          result$sigman <- opt$par[2]
      } else {
          result$sigman <- sigman
          # opt <- optimize(.gp.cv.optimize, l, result = result, verbose = verbose)
          # result$l <- opt$minimum
          opt <- nloptr::sbplx(mean(l), .gp.cv.optimize, l[1], l[2], result = result, verbose = verbose, control=options)
          result$l <- opt$par[1]
      }
    } else {
        result$l <- l
        result$sigman <- sigman
    }

    result$kxx <- result$kernel(result$x, result$x, result$l) + result$sigman * diag(result$n)
    L <- chol(result$kxx)
    result$alpha <- backsolve(L, backsolve(L, p, transpose = TRUE))

    if (normalize) {
        if (is.matrix(result$x)) {
            D <- ncol(result$x)
        } else {
            D <- 1
        }
        integral <- result$kernel.integral(result$alpha, result$l, D)
        result$s <- 1.0 / integral
    } else {
        result$s <- 1.0
    }

    return(structure(result, class = "mvd.density"))
}

#' Evaluate a Gaussian process density function
#'
#' description
#' @param fit mvd.density object
#' @param x Matrix or vector of samples. For matrices, rows are samples and columns are variables.
#' @export
evaluate.gp <- function(fit, x, log) {
    stopifnot(fit$type == "gp")

  if (log) {
    if (fit$log) {
      kxsx <- fit$kernel(x, fit$x, fit$l)
      f <- kxsx %*% fit$alpha
      return(fit$s * f)
    } else {
      kxsx <- fit$kernel(x, fit$x, fit$l)
      f <- kxsx %*% fit$alpha
      p <- abs(fit$s) * f
      p[p < 0] <- 0
      return(log(p))
    }
  } else {
    if (fit$log) {
      kxsx <- fit$kernel(x, fit$x, fit$l)
      f <- kxsx %*% fit$alpha
      return(exp(fit$s * f))
    } else {
      kxsx <- fit$kernel(x, fit$x, fit$l)
      f <- kxsx %*% fit$alpha
      p <- abs(fit$s) * f
      p[p < 0] <- 0
      return(p)
    }
  }
}


# Author: Luis, Brent Ian
# Lab Section: CMSC 150 B-5L
# December 1, 2016

# implements Simplex method
Simplex <- function(matrix, numberOfRows, numberOfColumns){
  iterations = 0
  hasNegative = TRUE

  while(hasNegative){
    # selects the pivot column
    pivotColumn = 0
    for(i in seq(1, numberOfColumns-1)) {
      if(matrix[numberOfRows, i] < 0){  # checks negative elements in the last row
        if(pivotColumn == 0){
          pivotColumn = i
        } else if(matrix[numberOfRows, i] < matrix[numberOfRows, pivotColumn]){
          pivotColumn = i
        }# else if
      }# if
    }# for

    # selects the pivot row
    pivotRow = 0
    for(i in seq(1, numberOfRows-1)) {
      if(matrix[i, pivotColumn] > 0) {
        if(pivotRow == 0){
          pivotRow = i
        } else if(matrix[i, numberOfColumns] / matrix[i, pivotColumn] >= 0 && matrix[i, numberOfColumns] / matrix[i, pivotColumn] < matrix[pivotRow, numberOfColumns] / matrix[pivotRow, pivotColumn]){ # computes test ratio: solution column divided by the pivot column
          pivotRow = i
        }# else if
      }# if
    }# if

    # normalizes pivot row
    pivotElement = matrix[pivotRow, pivotColumn]
    matrix[pivotRow, ] = matrix[pivotRow, ] / pivotElement

    # implements Gauss-Jordan Elimination
    for(i in seq(1, numberOfRows)) {
      # retains only pivot row
      if(i != pivotRow){
        matrix[i, ] = matrix[i, ] - (matrix[pivotRow, ] * matrix[i, pivotColumn])
      }# if
    }# for

    # checks last row if it has negative
    hasNegative = FALSE
    for(i in matrix[numberOfRows, ]) {
      if(i < 0){
        hasNegative = TRUE
      } # if
    }# for

    # prints each iteration
    iterations = iterations + 1
    cat("Iteration: ", iterations, "\n")
    print(matrix)
  }# while
}# Simplex

# initializes the main function
Main <- function () {
  # reads input file as a matrix
  input <- read.csv(file="C:\\Users\\Brent Ian Luis\\Desktop\\luis_project\\test cases\\test case 1.csv", header=TRUE, sep=",")
  matrix <- as.matrix(input)

  # gets matrix dimensions
  numberOfRows = nrow(matrix)
  numberOfColumns = ncol(matrix)

  # prints initial tableau
  cat("Initial Tableau:\n")
  print((matrix))

  Simplex(matrix, numberOfRows, numberOfColumns)
}# Main


#----------------------------------------------------------------------#
# Function to calculate Fisher's Classification coefficients           #
# This code follows the formulas in Legendre and Legendre's Numerical Ecology (1998)   #
#----------------------------------------------------------------------#
classfunc.lda <- function(x, groups){
  x.lda <- lda(groups ~ ., as.data.frame(x))

  gr <- length(unique(groups))   ## groups might be factors or numeric
  v <- ncol(x)                   ## variables
  m <- x.lda$means               ## group means

  w <- array(NA, dim = c(v, v, gr))

  tot.len <- nrow(x)
  subgr.len <- array(0, gr)

  for(i in 1:gr){
    tmp <- scale(subset(x, groups == unique(groups)[i]), scale = FALSE)
    w[,,i] <- t(tmp) %*% tmp
    subgr.len[i] <- nrow(tmp)
  }

  W <- w[,,1]
  for(i in 2:gr)
    W <- W + w[,,i]

  V <- W/(nrow(x) - gr)
  iV <- solve(V)

  class.func <- matrix(NA, nrow = v + 1, ncol = gr)

  colnames(class.func) <- rownames(m)
  rownames(class.func) <- c("constant", colnames(m) )

  for(i in 1:gr) {
    ni <- subgr.len[i]
    class.func[1, i] <- -0.5 * t(m[i,]) %*% iV %*% (m[i,]) + log(ni / tot.len)
    class.func[2:(v+1) ,i] <- iV %*% (m[i,])
  }

  x.lda$class.func <- class.func

  return(x.lda)
}


=begin
[((<index-ja|URL:index-ja.html>))]
= Algebra::EuclidianRing

((*(G.C.D.計算モジュール)*))

((|divmod|)) から G.C.D(最大公約数)等を計算するモジュールです。
これは ((|Integer|)) や ((|Algebra::Polynomial|)) にインクルードされます。

== ファイル名:
* ((|euclidian-ring.rb|))

== メソッド:

--- gcd(other)
    ((|self|)) と ((|other|)) との最大公約数を返します。

--- gcd_all(other0 [, other1[, ...]])
    ((|self|)) と ((|other0|)), ((|other1|)),... との最大公約数を返します。

--- gcd_coeff(other)
    ((|self|)) と ((|other|)) との最大公約数と、それを表現する係数の
    配列を返します。

    例:
      require "polynomial"
      require "rational"
      P = Algebra.Polynomial(Rational, "x")
      x = P.var
      f = (x + 2) * (x**2 - 1)**2
      g = (x + 2)**2 * (x - 1)**3
      gcd, a, b = f.gcd_coeff(g)
      p gcd #=> 4x^3 - 12x + 8
      p a   #=> -x + 2
      p b   #=> x - 1
      p gcd == a*f + b*g #=> true

--- gcd_ext(other)
    ((<gcd_coeff>)) と同じです。

--- gcd_coeff_all(other0 [, other1[, ...]])
    ((|self|)) と ((|other0|)), ((|other1|)),... との最大公約数と、それ
    を表現する係数の配列を返します。

    例:
      require "polynomial"
      require "rational"
      P = Algebra.Polynomial(Rational, "x")
      x = P.var
      f = (x + 2) * (x**2 - 1)**2
      g = (x + 2)**2 * (x - 1)**3
      h = (x + 2) * (x + 1) * (x - 1)
      gcd, a, b, c = f.gcd_coeff_all(g, h)
      p gcd #=> -8x^2 - 8x + 16
      p a   #=> -x + 2
      p b   #=> x - 1
      p c   #=> -4
      p gcd == a*f + b*g + c*h #=> true

--- gcd_ext_all(other)
    ((<gcd_coeff_all>)) と同じです。

--- lcm(b)
    ((|self|)) と ((|other|)) との最小公倍数を返します。

--- lcm_all(other0 [, other1[, ...]])
    ((|self|)) と ((|other0|)), ((|other1|)),... との最小公倍数を返します。

=end


tanident_1( 1*atan(1/2)    +  1*atan(1/3) )
## [1] TRUE
tanident_1( 2*atan(1/3)    +  1*atan(1/7))
## [1] TRUE
tanident_1( 4*atan(1/5)    + -1*atan(1/239))
## [1] TRUE
tanident_1( 5*atan(1/7)    +  2*atan(3/79))
## [1] TRUE
tanident_1( 5*atan(29/278) +  7*atan(3/79))
## [1] TRUE
tanident_1( 1*atan(1/2)    +  1*atan(1/5)   +   1*atan(1/8) )
## [1] TRUE
tanident_1( 4*atan(1/5)    + -1*atan(1/70)  +   1*atan(1/99) )
## [1] TRUE
tanident_1( 5*atan(1/7)    +  4*atan(1/53)  +   2*atan(1/4443))
## [1] TRUE
tanident_1( 6*atan(1/8)    +  2*atan(1/57)  +   1*atan(1/239))
## [1] TRUE
tanident_1( 8*atan(1/10)   + -1*atan(1/239) +  -4*atan(1/515))
## [1] TRUE
tanident_1(12*atan(1/18)   +  8*atan(1/57)  +  -5*atan(1/239))
## [1] TRUE
tanident_1(16*atan(1/21)   +  3*atan(1/239) +   4*atan(3/1042))
## [1] TRUE
tanident_1(22*atan(1/28)   +  2*atan(1/443) +  -5*atan(1/1393) + -10*atan(1/11018))
## [1] TRUE
tanident_1(22*atan(1/38)   + 17*atan(7/601) +  10*atan(7/8149))
## [1] TRUE
tanident_1(44*atan(1/57)   +  7*atan(1/239) + -12*atan(1/682)  +  24*atan(1/12943))
## [1] TRUE
tanident_1(88*atan(1/172)  + 51*atan(1/239) +  32*atan(1/682)  +  44*atan(1/5357) + 68*atan(1/12943))
## [1] TRUE
tanident_1(88*atan(1/172)  + 51*atan(1/239) +  32*atan(1/682)  +  44*atan(1/5357) + 68*atan(1/12944))
## [1] FALSE


#Generate the sets
a = runif(10,min=0,max=1)
b = runif(100,min=0,max=1)
c = runif(1000,min=0,max=1)
d = runif(10000,min=0,max=1)

#Print out the set of 10 values
cat("a = ",a)

#Print out the Mean and Standard Deviations of each of the sets
cat("Mean of a : ",mean(a))
cat("Standard Deviation of a : ", sd(a))
cat("Mean of b : ",mean(b))
cat("Standard Deviation of b : ", sd(b))
cat("Mean of c : ",mean(c))
cat("Standard Deviation of c : ", sd(c))
cat("Mean of d : ",mean(d))
cat("Standard Deviation of d : ", sd(d))

#Plotting the histogram of d
hist(d)

#Following lines error out due to insufficient memory

cat("Mean of a trillion random values in the range [0,1] : ",mean(runif(10^12,min=0,max=1)))
cat("Standard Deviation of a trillion random values in the range [0,1] : ", sd(runif(10^12,min=0,max=1)))


closest.pairs.bruteforce <- function(x, y=NULL)
{
	if (!is.null(y))
	{
		x <- cbind(x,y)
	}
	d <- dist(x)
	cp <- x[combn(1:nrow(x), 2)[, which.min(d)],]
	list(p1=cp[1,], p2=cp[2,], d=min(d))
}

closest.pairs.dandc <- function(x, y=NULL)
{
	if (!is.null(y))
	{
		x <- cbind(x,y)
	}
	if (sd(x[,"x"]) < sd(x[,"y"]))
	{
		x <- cbind(x=x[,"y"],y=x[,"x"])
		swap <- TRUE
	}
	else
	{
		swap <- FALSE
	}
	xp <- x[order(x[,"x"]),]
	.cpdandc.rec <- function(xp,yp)
	{
		n <- dim(xp)[1]
		if (n <= 4)
		{
			closest.pairs.bruteforce(xp)
		}
		else
		{
			xl <- xp[1:floor(n/2),]
			xr <- xp[(floor(n/2)+1):n,]
			cpl <- .cpdandc.rec(xl)
			cpr <- .cpdandc.rec(xr)
			if (cpl$d<cpr$d) cp <- cpl else cp <- cpr
			cp
		}
	}
	cp <- .cpdandc.rec(xp)

	yp <- x[order(x[,"y"]),]
	xm <- xp[floor(dim(xp)[1]/2),"x"]
	ys <- yp[which(abs(xm - yp[,"x"]) <= cp$d),]
	nys <- dim(ys)[1]
	if (!is.null(nys) && nys > 1)
	{
		for (i in 1:(nys-1))
		{
			k <- i + 1
			while (k <= nys && ys[i,"y"] - ys[k,"y"] < cp$d)
			{
				d <- sqrt((ys[k,"x"]-ys[i,"x"])^2 + (ys[k,"y"]-ys[i,"y"])^2)
				if (d < cp$d) cp <- list(p1=ys[i,],p2=ys[k,],d=d)
				k <- k + 1
			}
		}
	}
	if (swap)
	{
		list(p1=cbind(x=cp$p1["y"],y=cp$p1["x"]),p2=cbind(x=cp$p2["y"],y=cp$p2["x"]),d=cp$d)
	}
	else
	{
		cp
	}
}

# Test functions
cat("How many points?\n")
n <- scan(what=integer(),n=1)
x <- rnorm(n)
y <- rnorm(n)
tstart <- proc.time()[3]
cat("Closest pairs divide and conquer:\n")
print(cp <- closest.pairs.dandc(x,y))
cat(sprintf("That took %.2f seconds.\n",proc.time()[3] - tstart))
plot(x,y)
points(c(cp$p1["x"],cp$p2["x"]),c(cp$p1["y"],cp$p2["y"]),col="red")
tstart <- proc.time()[3]
cat("\nClosest pairs brute force:\n")
print(closest.pairs.bruteforce(x,y))
cat(sprintf("That took %.2f seconds.\n",proc.time()[3] - tstart))


#биномно разпределение - n независими опита с вероятност за успех на всеки p и за провал 1-p=q
#dbinom - Р(X = x)
x <- seq(0,50,by=1)
y <- dbinom(x = x, size = 50, prob = 0.2) #вероятността да имаш x успешни опита от общо size опита с вероятност за усех prob
plot(x,y)
y <- dbinom(x = x, size = 50,prob = 0.5)
plot(x,y)

#pbinom - P(X <= x)
pbinom(q = 24, size = 50, prob = 0.5) #вероятността да имаш по-малко или равно на q успеха от общо size опита с вероятност за усех prob
pbinom(q = 25, size = 50, prob = 0.5, lower.tail = FALSE) #P(X>x) -> вероятността да имаш повече от q успеха от общо size опита с вероятност за усех prob

#qbinom - по зададена вероятност намира колко успеха от size опита с вероятност за успех prob е имало (обратното на dbinom)
qbinom(p = 0.4438624,size = 50, prob = 1/2)
qbinom(p = 0.5561376,size = 50, prob = 0.5)

#rbinom за генериране на n случайно разпределени величини от 0 до size с вероятноса за успех prob
rbinom(n = 5, size = 10, prob = 0.2)
rbinom(n = 5, size = 100,prob = 0.2)

#отрицателно биномно разпределение - колко неусеха да получаване на фиксиран брй успехи
#dnbinom - вероятността да има x неуспеха да получаването на size-тия успех с вероятност за успех prob
dnbinom(x = c(1:10), size = 5, prob = 0.5)

#pnbinom
pnbinom(q = 8, size = 3, prob = 0.2) #вероятността да има по-малко или равно на q неуспеха дo получаването на size-тия успех с вероятност за успех prob
pnbinom(q = 8, size = 3, prob = 0.2, lower.tail = FALSE) #повече от q неуспеха до получаването на size-тия успех с вероятност за успех prob

#qnbinom и rnbinom аналогични на qbinom и rbinom

#Хипергеометрично разпределение - N обекта, M от тях са маркирани, по случаен начин избираме n на брой. X - броят на маркираните, измежду тези които сме избрали случайно
#функцията hyper() с префикси d,p,q,r за съответно плътност, разпределние, квантил и случайно разпределение(симулиране)
success=c(0:6)
dhyper(x = success, m = 6, n = 30, k = 6)

#Поасоново разпределение - биномно разпределение, което има много малка вероятност
#n->inf, p->0, np = lamda
#Функция pois() c префикси d,p,q,r за съответно плътност, разпределние, квантил и случайно разпределение(симулиране)
ppois(q = 16, lambda = 12)

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

#01
#биномно разпределение n=79, k=29, p=1/2
result = choose(79,29) * 1/(2^29) * 1/(2^50) #choose смята биномен коефициент
result.binom = dbinom(x = 29, size = 79, prob = 1/2)

#02
not.fixed = pbinom(q = 2, size = c(3,4,5,7,8), prob = 1/2) #по-малко или равно на size опита за изтегляне на 2 езита
fixed = dbinom(x = 2, size = c(3,4,5,7,8), prob = 1/2) #точно size опита за изтегляне на 2 езита

plot(x= c(3,4,5,7,8), y = not.fixed, type = "l", main = "Dstribution of two ezi", xlab = "Number of tries", ylab = "Probability")
lines(x= c(3,4,5,7,8), y = fixed, type = "p", col = "red")

#03
#оцелването на тройка е биномно разпределена случайна величина с вероятност за успех p = 0.7
n = qbinom(p = 1 - 0.18522, size = 3, prob = 0.7 ) + 3 #???

x = qbinom(p = 0.18522, size = c(3:10), prob = 0.7 ) #с вероятност 0.18522 проверяваме от 3 до няколко(10) опита на кой опит ще е уцелил три пъти
names(x) = c(3:10)
result = as.numeric(names(x[x == 3]))
# => на 5-ти и 6-ти опит ще е оцелил три тройки с вероятност 0.18522

#04
#вероятността да има <=35 жени в извадка от k = 100 човека, като жените са m = 40% от 600000 човека, а мъжете са n = 60% от 600000 човека
theoretical = phyper(q = 35, m = 0.4*600000, n = 0.6*600000, k = 100)
pop = rep(c(0,1),c(360000, 240000)) #симулираме 600000 човека -> 360000 нули за мъжете и 240000 единици за жените
res=sapply(c(0:1000), function(x) sum(sample(pop,100))) # 1000 елементен вектор с резултатите за общия брой жени в случайна извадка от 100 човека
empirical = sum(res<=35)/100

#05
#поасоново разпределение с ламда = 2 обаждания за минута
# => поасоново разпределенеи с ламда = 2*5 = 10 обаждания за 5 минути
exactly.2 = dpois(x = 2, lambda = 10) # P(X = 2)
less.than.2 = ppois(q = 1, lambda = 10) # P(X <= 1) = P(X < 2)
more.than.2 = ppois(q = 1, lambda = 10, lower.tail = FALSE) # P(X > 1) = P(X >= 2)

#06
#отрицателно биномно разпределение с вероятност за успех 4/52 (4 аса от 52 карти)
#търсим вероятността за 4 провала до първия успех => 5-тата изтеглена карта е асо
dnbinom(x = 4, size = 1, prob = 4/52)
dgeom(x = 4, prob = 4/52)


# ......................................................................................
# ..............................Exercise 4 - Random vector..............................
# he content of this script is only as a supplementary illustration to the exercise, it is not necessary to know at the exam. It is important to be able to calculate manually.**
# ......................................................................................

# 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

#  Example ####
#
# Random vector $Z =(Y;X)^T$ has a probability function specified by the table </br>
#  ![Image.png](attachment:image.png)
#
# * a) Determine the missing value of the combined probability function, ####
#

data = c(0.01, 0.04, 0.12,
         0.02, 0.16, 0.07,
         0.03, 0,    0.06,
         0.25, 0.05, 0.01)
P = matrix(data , nrow=3, ncol=4) # possibly byrow=...
X = c(3, 5, 7)
Y = c(1, 2, 3, 4)
dimnames(P) = list(X,Y)
P

sum(P)

# do not run this cell twice, otherwise you will set the value back to 0,
# Do you know why?
p_5_3 = 1 - sum(P)
P["5","3"] = p_5_3
P

# * b) Specify the distribution function ####
#
# **Attention! The vector Z is $(Y,X)^T$ so the first parameter is the value Y and the
# second value X.**
#

# F(2.8; 7.1)
# P(Y<2.8, X<7.1)
P[X<7.1, Y<2.8]
sum(P[X<7.1, Y<2.8])

F = matrix(rep(0,4*5), nrow=4, ncol=5)
dimnames(F) = list(c('(-inf,3>', '(3,5>', '(5,7>', '(7,inf)'),
                   c('(-inf,1>', '(1,2>', '(2,3>', '(3,4>', '(4,inf)'))
F

# we go through the rows and columns, we always take one value
# from the relevant row or column
x_vals = c(3,5,7,8)
y_vals = c(1,2,3,4,5)
for(i in 1:4){
    for(j in 1:5){
        x = x_vals[i]
        y = y_vals[j]
        F[i,j] = sum(P[X<x, Y<y])
    }
}
F

# * c) Determine the marginal distribution ####
#

P_x = rowSums(P)
P_x

F_x = c(0, cumsum(P_x))
F_x

P_y = colSums(P)
P_y

F_y = c(0, cumsum(P_y))
F_y

# * d) Conditional probabilities and conditional probability functions $P(x|y), P(y|x)$ ####
#

# P(Y>2.1|X<5.3)
# P(Y>2.1 ∧ X<5.3)/P(X<5.3)
sum(P[X<5.3, Y>2.1])
sum(P[X<5.3,])
sum(P[X<5.3, Y>2.1])/sum(P[X<5.3,])

# P(X=5|Y=1)
# P(X=5 ∧ Y=1)/P(Y=1)
P['5','1']/sum(P[,'1'])
P['5','1']/sum(P_y['1'])

# **$P(x|y)=\frac{P(X=x,Y=y)}{P_Y(y)}$**
#

P_xy = P # it's the same size, so we'll steal the formatting
X_lab = c('3', '5', '7')
Y_lab = c('1', '2', '3', '4')
for(x in X_lab){
    for(y in Y_lab){
        P_xy[x, y] = P[x, y]/P_y[y]
    }
}
P_xy
colSums(P_xy)

# **$P(y|x)$**
#

P_yx = P # it's the same size, so we'll steal the formatting
for(x in X_lab){
    for(y in Y_lab){
        P_yx[x, y] = P[x, y]/P_x[x]
    }
}
P_yx
rowSums(P_yx)

# * e) basic characteristics of random variables X and Y ####
#

E_X = sum(X*P_x)
E_X
E_XX = sum(X*X*P_x)
D_X = E_XX - E_X^2
D_X

E_Y = sum(Y*P_y)
E_Y
E_YY = sum(Y*Y*P_y)
D_Y = E_YY - E_Y^2
D_Y

# * f) conditional mean E(X|Y=2) ####
#

# P(x|Y=2)
P_xy[,'2']
E_X_Y2 = sum(X*P_xy[,'2'])
E_X_Y2

# * g) covariance and correlation ####
#

X_Y = P # matrix where in each column is the value x * y
for(x in X){
    for(y in Y){
        X_Y[toString(x), toString(y)] = x*y
    }
}
X_Y

# or we can use matrix multiplication
X %*% t(Y)

# mean value of E(X * Y)
E_XY = sum(X_Y*P)
E_XY

# covariance
cov_XY = E_XY-E_X*E_Y
cov_XY

# correlation
cov_XY/sqrt(D_X*D_Y)


func <- function(x,y)
{
  func1 <- (-5*y) + 5*x^2 + 2*x
}

Euler <- function (x0, y0, h, n )
{
  x <- x0
  y <- y0

  for ( i in 1 : n )
  {
    y0 <- y0 + h * func ( x0, y0 )
    x0 <- x0 + h
    x <- c ( x, x0 )
    y <- c ( y, y0 )
  }

  return ( data.frame ( x = x, y = y ) )
}

Euler(0, 1/3, 0.1 ,10)


#' @title calcCbw
#'
#' @description Calculates the waterline block coefficient (\code{Cbw})
#' (dimensionless) using actual draft.
#'
#' @param Cb Maximum block coefficient (vector of numericals, dimensionless)
#' (see \code{\link{calcCb}})
#' @param actualDraft Actual draft (vector of numericals, m)
#' @param maxDraft Maximum summer load line draft (vector of numericals, m)
#'
#' @details
#' The block coefficient is the ratio of the vessel's displacement and its
#' volume, defined by its waterline length (\code{lwl}), breadth, and draft:
#' \deqn{Cb=\frac{displacement}{lwl*breadth*draft}}{Cb=displacement/(lwl*breadth*draft)}
#'
#' This function returns the  waterline block coefficient (\code{Cbw}), which
#' represents a loaded condition estimation using actual draft using the
#' Riddlesworth method. Actual draft is typically obtained from sources such as
#' AIS messages or ship records.
#'
#' NOTE: Technically, no block coefficient can be greater than 1. Even a
#' waterline block coefficient of 1 itself is extremely improbable and can cause
#' numerical errors elsewhere in the model. Therefore, the upper bound of the
#' waterline block coefficient is fixed at 0.99 in this function.
#'
#' @return \code{Cbw} (vector of numericals, dimensionless)
#'
#' @references
#'\href{https://www.man-es.com/marine/products/propeller-aft-ship}{MAN Energy
#' Solutions. 2011. "Basic Principles of Propulsion."}
#'
#' @seealso \code{\link{calcCb}}
#'
#' @examples
#' calcCbw(c(0.82,0.66),c(12.48,11.09),c(13.57,11.49))
#' calcCbw(0.82,12.48,13.57)
#'
#' @export

calcCbw <- function(Cb,actualDraft,maxDraft){

  #ensure that: actualDraft < maxDraft
  actualDraft<-pmin(actualDraft,
                    maxDraft)

  Cbw<- pmin(0.99,
             1-(1-pmin(0.99,
                        Cb
                       )
                )*((maxDraft/actualDraft)^(1/3))
  )
  return(Cbw)
}


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

rm(list = ls())

library(ggplot2)
library(MASS)

#
# 1)
# Importar los datos a SAS desde el fichero Olympic2016 v2.txt;
#

DATA <- read.csv('./../../../datasets/olympic-2016-v2.txt', header=TRUE)

A <- DATA[,1:10]
rownames(A) <- DATA[,12]

#
# 2)
# Efectuar mediante un ACP normado con los datos de las 10 pruebas.
#

X <- t((t(A) - colMeans(A)) / apply(A, 2, sd))
X_n <- dim(X)[1]
X_p <- dim(X)[2]

X_star <- (t(X) %*% X) / (X_n-1)

X_eig <- eigen(X_star)
X_lambda <- X_eig$values
X_u <- X_eig$vectors

#
# 3)
# Calcular los scores en las 10 componentes y comprobar que tienen media 0
# y varianza igual al autovalor correspondiente.
#

F <- X %*% X_u

ggplot(as.data.frame.matrix(F), aes(x=V1, y=V2)) +
  geom_point() +
  geom_text(label=rownames(F))

0 == round(colMeans(F), digits=4)
round(X_lambda, digits=4) == round(apply(F, 2, sd) ^ 2, digits=4)
sum(X_lambda)

#
# 4)
# Calcular las contribuciones absolutas y relativas de los puntos a las
# componentes y hacer la representación gráfica correspondiente.
#

X_ca <- t(t(F^2) / rowSums(t(F ^ 2)))
X_re <- (F^2) / rowSums(F ^ 2)

print(round(X_ca, digits = 4))
print(round(X_re, digits = 4))

#
# 5)
# Considerar ahora la nube de los puntos columna y calcular los autovalores y
# autovectores correspondientes. Comprobar las relaciones con los resultados
# de la nube de puntos fila.
#

X_v <- t(t(F) / sqrt(X_lambda * (X_n - 1)))

print(round(X_v, digits = 4))

G <- t(X) %*% X_v

print(G)

X_u_2 <- t(t(G) / sqrt(X_lambda * (X_n - 1)))

round(X_u_2, digits = 4) == round(X_u, digits = 4)

ggplot(as.data.frame.matrix(G), aes(x=V1, y=V2)) +
  geom_point() +
  geom_text(label=rownames(G))

#
# 6)
# Calcular las proyecciones de las variables (scores) en los nuevos ejes.
# Calcular sus medias, sus varianzas y la suma de sus cuadrados (dividida por n-1).
#

# Medias (nada)
round(colMeans(G), digits=4)

# Varianzas (Nada)
round(apply(G, 2, sd) ^ 2, digits=4)

# Suma de cuadrados dividida entre n-1 (lambdas o autovalores)
round(colSums(G^2)/(X_n -1), digits=4)

#
# 7)
# Reconstruir la matriz de datos original a partir de los autovalores y
# autovectores.
#

# Reconstrucción de la matriz de covarianzas
X_u %*% diag(X_lambda) %*% ginv(X_u)

# Reconstrucción de la matriz de datos
X
(X_v %*% diag(sqrt(X_lambda  * (X_n -1))) %*% t(X_u))

#
# 8)
# Reconstruir la matriz con las dos primeras componentes principales y valorar
# la pérdida.
#

# Ratio de distorsión por la reducción de dimensiones
1-sum(X_lambda[1:2]) / sum(X_lambda)

# Reconstrucción de la matriz de covarianzas
X_u[,1:2] %*% diag(X_lambda[1:2]) %*% ginv(X_u[,1:2])

# Reconstrucción de la matriz de datos
X_v[,1:2] %*% diag(sqrt(X_lambda[1:2] * (X_n -1))) %*% t(X_u[,1:2])


# Examples 07 EM Algorithm
# ------------------------

# MLE
# ---

# This script estimates the allelic freq from genotype freq
# using Maximum Likelihood Estimation

nAA<-12
nAB<-35
nA0<-21
nBB<-15
nB0<-30
n00<-9
n<-nAA+nAB+nA0+nBB+nB0+n00

p<-(nAA+nA0/2+nAB/2)/n
q<-(nBB+nB0/2+nAB/2)/n
r<-(n00+nA0/2+nB0/2)/n
p;q;r

# EM Algorithm
# ------------

# This script estimates the allelic freq from phenotype freq
# using EM Algorithm

nA<-33  # nAA and nA0 unknown: nA=nAA+nA0
nB<-45  # nBB and nB0 unknown: nB=nBB+nB0
nAB<-35 # nAB known
n0<-9   # n00=n0 known

n<-nA+nB+nAB+n0

# STEP 1

# Parameters' vector par=(p,q). Note that r=1-p-q

# HYP 1 - Uniform Distribution
p<-1/3
q<-1/3
r<-1/3

# HYP 2 - Bernstein
p<-1-sqrt((n0+nB)/n)
q<-1-sqrt((n0+nA)/n)
r<-sqrt(n0/n)
p;q;r

# STEP 2 (E)

# Calculate approximate values for nAA, nA0, nBB, nB0
expected<-function(p,q,r){
nAA<-nA*p/(p+2*r)
nA0<-nA*2*r/(p+2*r)
nBB<-nB*q/(q+2*r)
nB0<-nB*2*r/(q+2*r)
c(nAA,nA0,nBB,nB0)
}
expected(p,q,r)

# STEP 3 (M)

# Update p, q and r
param<-function(nAA,nA0,nBB,nB0){
p<-(2*nAA+nA0+nAB)/(2*n)
q<-(2*nBB+nB0+nAB)/(2*n)
r<-(2*n0+nA0+nB0)/(2*n)
c(p,q,r)
}
param(nAA,nA0,nBB,nB0)

# STEP 4 e 5

# EM ALGORITHM - iterative procedure

i<-0
er<-1
erro<-10^(-5)

while(sum(er>=erro)>0)
{
 # Step E
 e<-expected(p,q,r)
 # Step M
 par<-param(e[1],e[2],e[3],e[4])
 # STOP criteria
 er<-abs(c(p,q,r)-c(par[1],par[2],par[3]))
 i<-i+1
 p<-par[1]; q<-par[2]; r<-par[3]
 cat(i,p,q,r,"\n") # print all the values obtained in each iterate.
}

cat("\nObtained solution after ",i," iterations:\n
p* =",p,
"\nq* =",q,
"\nr* =",r,"\n")

# Example of Application - nudge
# ------------------------------

# Download the datafiles from the web

# http://bioinf.wehi.edu.au/limma/
# go to the end of the webpage
# download the Zebrafish data - zip.file
# working directory - swirl
# Chip: 4x4 blocks, 22 rows and 24 col, each

# Change directory to folder 'Swirl'
# install and load package limma in order to read the data
source("http://bioconductor.org/biocLite.R")
biocLite("limma")
library(limma)

# Don't forget to download the data, as described previously
swirl <- readTargets("SwirlSample.txt")
swirl
RG <- read.maimages(swirl$FileName, source="spot")
RG
RG$genes <- readGAL("fish.gal")
# Get some information about the files
head(RG$genes)
RG$printer <- getLayout(RG$genes)
RG$printer
show(RG)
summary(RG$R)

# Create the data matrix
lr <- matrix(nrow=8448,ncol=4)
lr[,1] <- log2(RG$R[,1])-log2(RG$G[,1])
lr[,2] <- log2(RG$G[,2])-log2(RG$R[,2])
lr[,3] <- log2(RG$R[,3])-log2(RG$G[,3])
lr[,4] <- log2(RG$G[,4])-log2(RG$R[,4])
li <- log2(RG$R)+log2(RG$G)

# Install and load package nudge
biocLite("nudge")
library(nudge)

# Run packade nudge
result <- nudge1(logratio = lr,logintensity = li, dye.swap = T)

names(result)
result$mu
result$sigma
result$mixprob
result$a
result$b
result$iter

# Top 20 genes with the highest probability of being DE
s <- sort(result$pdiff, decreasing = T, index.return = T)
rownames(lr) <- RG$genes$Name
cbind(rownames(lr)[s$ix[1:20]], round(s$x[1:20], 2))

# number of genes with a probability of DE, greater than 0.5
thresh <- 0.5
sum(result$pdiff >= thresh)


## Fibonacci word/fractal  2/20/17 aev
## Create Fibonacci word order n
fibow <- function(n) {
  t2="0"; t1="01"; t="";
  if(n<2) {n=2}
  for (i in 2:n) {t=paste0(t1,t2); t2=t1; t1=t}
  return(t)
}
## Plot Fibonacci word/fractal:
## n - word order, w - width, h - height, d - segment size, clr - color.
pfibofractal <- function(n, w, h, d, clr) {
  dx=d; x=y=x2=y2=tx=dy=nr=0;
  if(n<2) {n=2}
  fw=fibow(n); nf=nchar(fw);
  pf = paste0("FiboFractR", n, ".png");
  ttl=paste0("Fibonacci word/fractal, n=",n);
  cat(ttl,"nf=", nf, "pf=", pf,"\n");
  plot(NA, xlim=c(0,w), ylim=c(-h,0), xlab="", ylab="", main=ttl)
  for (i in 1:nf) {
    fwi=substr(fw, i, i);
    x2=x+dx; y2=y+dy;
    segments(x, y, x2, y2, col=clr); x=x2; y=y2;
    if(fwi=="0") {tx=dx; nr=i%%2;
      if(nr==0) {dx=-dy;dy=tx} else {dx=dy;dy=-tx}}
  }
  dev.copy(png, filename=pf, width=w, height=h); # plot to png-file
  dev.off(); graphics.off();  # Cleaning
}

## Executing:
pfibofractal(23, 1000, 1000, 1, "navy")
pfibofractal(25, 2300, 1000, 1, "red")


alpha=0.025
pie=0.5
E=0.03
z.alpha=qnorm(1-alpha)
#  sample size necessary to achieve this accuracy
n=((z.alpha^2)*pie*(1-pie))/E^2
print(ceiling(n))
# 1,068 programs would need to be tested in order to be 95% confident that
#the estimate of pie is within .03 of the actual value of pie

pie=0.8
n=((z.alpha^2)*pie*(1-pie))/E^2
print(n)
#  if the designer was fairly certain that the actual value of pie was at least .80,
#then the required sample size can be greatly reduced.


findfactors <- function(n) {
  a <- NULL
  if (n > 1) {
    while (n %% 2 == 0) {
      a <- c(a, 2)
      n <- n %/% 2
    }
    k <- 3
    while (k * k <= n) {
      while (n %% k == 0) {
        a <- c(a, k)
        n <- n %/% k
      }
      k <- k + 2
    }
    if (n > 1) a <- c(a, n)
  }
  a
}


# Problemas y post-estimation: multicolinealidad perfecta,
# heteroskedasticidad, no linearidad, outliers, no normalidad de residuos, auto-correlación

#################################################################
cat("\014")
rm(list=ls())
graphics.off()

#################################################################
# Motivacion
#################################################################
# (1) Los modelos lineales deben ser...bueno, "lineales." Es decir,
# OLS asume que la relacion entre "X" e "Y" puede ser representada
# por una linea recta. Podemos "desafiar" este concepto de "linea recta"?

# (2) Los modelos lineales asumen "varianza constante entre los errores".
# Como podemos checkear ese supuesto? Como lo podemos arreglar? Como lo podemos
# derivar matematicamente? Que relacion tiene con los outliers?
# Var Constante: Homoesquedasticidad.
# Var no-const: Heteroskedasticity.

# (3) Como podemos detectar outliers? Como podemos solucionar este problema?

# (4) Por que el aporte de una variable independiente en la dependiente
# podria NO SER lineal, es decir, curvilinea? Este punto es importante. Que cosas
# en la sociedad NO SON LINEALES?

#################################################################
# Linearidad y no Linearidad
#################################################################
library(car)
data(Prestige)

options(scipen = 100000)

modelo.lineal <- lm(prestige ~ income + education + women, data=Prestige)
summary(modelo.lineal)

# Plotear errores: manera "artesanal"
plot(modelo.lineal$fitted.values, modelo.lineal$residuals)

# Plotiemos los betas (uno por uno), y veamos:
## (1) Cuanto error aportan al modelo.
## (2) Cuan lineal es la relacion existe entre X e Y.

crPlot(modelo.lineal, "income") # Problema.
crPlot(modelo.lineal, "education") # no es exactamente lineal, pero es super tolerable.
crPlot(modelo.lineal, "women") # no hay relacion, pero no hay problemas con los residuos.

# (1) El "aporte" de cada variable independiente debe ser lineal, es decir, una
# linea recta. Esto es la parte del "componente" (en azul).

# (2) El error de cada parte del "componente" debe ser lineal y normalmente
# distribuido. Esta es la parte del "residuo" (en morado).

# Estimemos una regresion no lineal
modelo.no.lineal = lm(prestige ~ poly(income, 3) + poly(education, 2) + women, data = Prestige)
summary(modelo.no.lineal)

# crPlot con el polynomial
crPlot(modelo.no.lineal, "poly(income, 3)")
hist(modelo.no.lineal$residuals)
mean(modelo.no.lineal$residuals)
# Ahora ya no hay problema con esta variable. Ademas, hemos mejorado nuestro error total.

# Comparemos los errores
## (1) Que modelo tendra menos errores y por que?

# resumamos los residuos
summary(summary(modelo.lineal)$residuals)
summary(summary(modelo.no.lineal)$residuals)
# Una distribucion normal (como se supone que debieran ser los errores): media = mediana = moda = 0. Y ESTE NO ES EL CASO. (MEDIA ES DIFERENTE DE MEDIANA).

# grafiquemos los residuos
library(lattice)
xyplot(modelo.lineal$residuals ~ modelo.lineal$fitted.values, type=c("smooth", "p")) # mal.
xyplot(modelo.no.lineal$residuals ~ Prestige$prestige, type=c("smooth", "p")) # algo mejor.

# Grafiquemos el "aporte" NO LINEAL de las variables independientes
library(effects)
plot(effect("poly(income, 3)", modelo.no.lineal)) # es el menos lineal de todos
plot(effect("poly(education, 2)", modelo.no.lineal)) # es el mas lineal.

# El punto es que nuestros modelos estan disenados para ser LINEALES.
# Aunque hemos usado polinomios para calzar mejor los datos, seguimos teniendo residuos heteroesquedasticos.
# La manera en que podemos solucionar este tipo de problemas, es recurriendo
# a transformaciones.

# Nuestro problema es el siguiente: debemos estimar un modelo lineal, pero
# la relacion entre X e Y no es lineal. Entonces, como podemos estimar modelos
# lineales cuando tenemos relaciones no lineales?

#################################################################
# Linearidad y no Linearidad: Resolviendo el problema via transformaciones
#################################################################

# (1) Box-Tidwell Test
## Estimar usando este test a cuanto tenemos que elevar nuestras variables
## problematicas, en este caso ingresos (income).

boxTidwell(prestige ~ income, ~ education + women, data=Prestige)
# OK. Sugiere que debemos elevar income al "0.08073"

# estimemos un modelo nuevo, pero con "income" transformado
Prestige$income.transformado = Prestige$income^0.08073 # transformemos income

# veamos como se ve income "normal" y "transformado"
xyplot(Prestige$prestige ~ Prestige$income, type=c("smooth", "p")) # el "normal" esta mal porque no es lineal.
xyplot(Prestige$prestige ~ Prestige$income.transformado, type=c("smooth", "p")) # el transformado arregla el problema porque ahora si que tenemos una relacion lineal entre Y y X.

# OK. Ahora estimemos un nuevo modelo ocupando nuestro "income" transformado, y
# veamos si soluciona el problema de fondo (es decir, no tener varianza constante en los errores).
# Al final del dia, ese es el problema de no tener linearidad entre uno de los Xs y nuestra Y.

# modelo con "ingresos" (income) transformado
modelo.no.lineal.box.tid = lm(prestige ~ income.transformado + education + women, data=Prestige)

# interpretacion
plot(effect("income.transformado", modelo.no.lineal.box.tid)) # es el menos lineal de todos

# Hagamos un scatter entre los residuos y cada una de las x (transformada y normal)
xyplot(modelo.no.lineal.box.tid$residuals ~ modelo.no.lineal.box.tid$fitted.values, type=c("smooth", "p")) # bien.
xyplot(modelo.lineal$residuals ~ modelo.lineal$fitted.values, type=c("smooth", "p")) # mal.

# Resumen de los residuos: modelo con "income" transformado y normal.
summary(summary(modelo.no.lineal.box.tid)$residuals) # Mucho mejor residuos.
summary(summary(modelo.lineal)$residuals) # No bien.

# graficar la densidad (integral) de los residuos
library(lattice)
densityplot((modelo.no.lineal.box.tid)$residuals) # bien
densityplot((modelo.lineal)$residuals) # mas o menos no mas...

# (2) Tomar el log de la variable no lineal (en este caso, "ingresos" o "income")
Prestige$log.income = log(Prestige$income)

## veamos como se ve cada variable
library(lattice)
densityplot(Prestige$income)
densityplot(Prestige$log.income)

# modelo
modelo.log.income = lm(prestige ~ log.income + education + women, data=Prestige)

# resumen del modelo
summary(modelo.log.income)
# (1) Como interpretamos este tipo de modelos (con una X logeada)?

# Hagamos un scatter entre los residuos y cada una de las x (transformada y normal)
xyplot(modelo.log.income$residuals ~ modelo.log.income$fitted.values, type=c("smooth", "p")) # bien.
xyplot(modelo.lineal$residuals ~ modelo.lineal$fitted.values, type=c("smooth", "p")) # mal.

# Resumen de los residuos: modelo con "income" transformado y normal.
summary(summary(modelo.log.income)$residuals)
summary(summary(modelo.lineal)$residuals) # OK---hemos mejorado algo.

#################################################################
# Outliers
#################################################################

# Parte del motivo de que algunas veces tenemos varianza no constante en los
# residuos, es por la presencia de outliers ("observaciones inusuales").

# Que podemos hacer respecto a esto?
## (1) Borrar los outliers?
## (2) Como detectamos los outliers?

# Existen dos tipos de outliers: leverage e influence.

#################################################################
# Influence: observaciones que tiran la linea de regresion hacia arriba/abajo
#################################################################

# Demostrar ejemplo en la pizarra.

library(foreign) # significa "foraneo"
load(url("https://github.com/hbahamonde/OLS/raw/master/Datasets/data.rdata"))
dat = data_reg

# veamos como se ven los datos
head(dat)

# estimemos modelo 3 de la tarea # 5
m3 = lm(y3 ~ x3, dat)

# veamos como se ven los problemas de "influence"
library(lattice)
xyplot(m3$residuals ~ m3$fitted.values, type=c("smooth", "p")) # residuos no tienen varianza constante.
# Pero en especial, hay un punto con mucha "influencia"

# Una ruta es la inspeccion visual. Tratemos de hacer algo mas sistematico.
# Calculemos el "Cook's Distance" que es una medida de cuantificar cuanta "influencia"
# tiene cada punto.

options(scipen=100000000) # increases threshold for scientific notation (it's got very small numbers).

dat$cooks.d <- cooks.distance(m3)

# veamos que es el Cook's D.
dat # Por cada dato (o punto), tenemos un Cook's D. Fijate que la observacion numero 3 tiene mucho Cook's D.
# ESE ES NUESTRO OUTLIER.

# grafiquemos los Cooks'D
# install.packages("olsrr")
library(olsrr)
ols_plot_cooksd_chart(m3)

# Ver el error
dat$residuals = as.vector(m3$residuals)
dat

# El punto de quiebre es 4/n.
4/nrow(dat) # Lo que esta arriba de 0.3636364 (arriba de la linea roja, es influence).

#################################################################
# Leverage: observaciones que tiran la linea de regresion hacia el lado izq/der
#################################################################

# Demostrar ejemplo en la pizarra.

# Estimemos un modelo con leverage
autos <- lm(mpg ~ wt, data = mtcars)
summary(autos)

# ahora, grafiquemos lo que vemos vs. lo que predecimos
plot(autos$fitted, mtcars$mpg) # Donde esta el problema?

# Dado que SI tenemos un problema, nuestro error debiera seguir algun patron.
# Es decir, debieramos NO ver una nube dispersa, y la linea debiera ser curva. Veamos.
xyplot(autos$residuals ~ autos$fitted.values, type=c("smooth", "p")) # residuos no tienen varianza constante.

# Ocupemos una funcion de R para detectar observaciones con leverage.
ols_plot_resid_stud_fit(autos) # OK. Son las mismas 3 observaciones que habiamos visto (17, 18 y 20)

# armemos una base de datos, solo para ver que observaciones/marcas son...
data.frame(
        res = autos$residuals,
        marca = rownames(mtcars),
        fila = 1:nrow(mtcars)
        )

#################################################################
# Errores Estandard Inflados: Multicolinearidad ("imperfecta") y Multicolinearidad Perfecta
#################################################################

# Apagar not scient.
options(scipen = 100000)

# Inventemos las variables independientes
set.seed(2020)
x1 = rnorm(1000, 10)
x2 = rnorm(1000, 20)
x3 = (x2*x2)/1000 # x3 es una combinacion lineal de x2

# Definamos que, como debiera ser, el error tiene promedio cero.
e = rnorm(1000, 0)

# Establecer el valor real de los betas: conocemos con exactitud los valores,
# porque nosotros los creamos!
b1 = 1
b2 = -100
b3 = 500

# modelo verdadero ("true model").
y = b1*x1 + b2*x2 + b3*x3 + e

# Modelo completo
modelo.completo = lm(y ~ x1 + x2 + x3)
summary(modelo.completo)

# Modelo incompleto
modelo.incompleto = lm(y ~ x1 + x2)
summary(modelo.incompleto)

# Si Variance Inflation Factor (VIF) > 4....multicollinearity
library(car)
vif(modelo.completo)
vif(modelo.incompleto)

# Ver como se "inflan las varianzas". Y como nosotros creamos estos datos,
# sabemos que no es debido a "error de medicion". Sabemos exactamente cual es el
# problema: x3 es una combinacion lineal de x2.

# Ejemplo real: hay muchas cosas que en la sociedad estan correlacionadas, por ej?

### Ejemplo Extremo

ej.extremo = lm(y ~ x1 + x2 + x2)
summary(ej.extremo)

x2.prima = x2
ej.extremo.2 = lm(y ~ x1 + x2 + x2.prima)
summary(ej.extremo.2)


## Author: Sergio García Prado
## Title: Statistical Inference - Non parametric Tests - Exercise 14

rm(list = ls())

x <- c(9.8, 10.1, 9.7, 9.9, 10.0, 10.0, 9.8, 9.7, 9.8, 9.9)

(s.x <- (x - 10)[x != 10])
# -0.199999999999999 0.0999999999999996 -0.300000000000001 -0.0999999999999996
# -0.199999999999999 -0.300000000000001 -0.199999999999999 -0.0999999999999996

sum(duplicated(s.x))
# 4

(n.s.x <- length(s.x))
# 8

(V.x <- sum((s.x > 0) * rank(abs(s.x))))
# 2

(V.x.mean <- n.s.x * (n.s.x + 1) / 4)
# 18

(V.x.var <- n.s.x * (n.s.x + 1) * (2 * n.s.x + 1) / 24)
# 51

### H0 median == 10
### H1 median != 10

## Asymptotic pvalue (with continuity correction, without tie correction)
2 * (1 - pnorm(abs(V.x + 0.5 - V.x.mean) / sqrt(V.x.var)))
# 0.0299739735865558

## Asymptotic pvalue (with continuity correction, with tie correction
# TODO

## Exact pvalue (not valid with ties)
2 * (1 - psignrank(V.x, n.s.x, lower.tail = V.x.mean < V.x))
# 0.0234375

wilcox.test(x - 10, alternative = "two.sided", exact = FALSE)
# Wilcoxon signed rank test with continuity correction
#
# data:  x - 10
# V = 2, p-value = 0.02818
# alternative hypothesis: true location is not equal to 0

y <- c(9.83, 10.09, 9.72, 9.87, 10.04, 9.95, 9.82, 9.73, 9.79, 9.90)

(s.y <- (y - 10)[y != 10])
# -0.17 0.0899999999999999 -0.279999999999999 -0.130000000000001 0.0399999999999991
#  -0.0500000000000007 -0.18 -0.27 -0.210000000000001 -0.0999999999999996

sum(duplicated(s.y))
# 0

(n.s.y <- length(s.y))
# 10

(V.y <- sum((s.y > 0) * rank(abs(s.y))))
# 4

(V.y.mean <- n.s.y * (n.s.y + 1) / 4)
# 27.5

(V.y.var <- n.s.y * (n.s.y + 1) * (2 * n.s.y + 1) / 24)
# 96.25

### H0 median == 10
### H1 median != 10

## Asymptotic pvalue (with continuity correction)
2 * (1 - pnorm(abs(V.y + 0.5 * sign(V.y.mean - V.y) - V.y.mean) / sqrt(V.y.var)))
# 0.0190588916017305

## Exact pvalue
2 * (1 - psignrank(V.y - (V.y.mean < V.y), n.s.y, lower.tail = V.y.mean < V.y))
# 0.013671875

wilcox.test(y - 10, alternative = "two.sided", exact = TRUE)
# Wilcoxon signed rank test
#
# data:  y - 10
# V = 4, p-value = 0.01367
# alternative hypothesis: true location is not equal to 0


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

rm(list = ls())

library(ca)

#
# 1)  Importar los datos a R desde el fichero oscar.csv
#

N <- read.csv(
  './../../../datasets/oscar.csv',
  header=TRUE,
  row.names = 1)
N

#
# 2)  Efectuar un análisis de correspondencias múltiples con el paquete ac con
# solo las variables médicas como activas a partir de la matriz de binaria, a
# partir de la matriz de Burt y con un análisis de correspondencias conjunto y
# comparar los resultados.
#

N_medicas <- N[,-c(1,2,3,4)]
N_medicas_mca1 <- mjca(N_medicas, lambda="indicator")
N_medicas_mca2 <- mjca(N_medicas, lambda="Burt")
N_medicas_mca3 <- mjca(N_medicas, lambda="JCA")

summary(N_medicas_mca1)
summary(N_medicas_mca2)
summary(N_medicas_mca3)

plot(N_medicas)

#
# 3)  ¿Cuál es la categoría peor representada en el plano definido por los 2
# primeros factores? ¿Y cuál es la mejor representada?
#

# La categoría peor representada en todos los casos es la aparicion.subita,
# mientras que la mejor representada es vacunado.temporada.anterior

#
# 4)  Incluir las variables demográficas edad y sexo como suplementarias. Para
# ello categorizar edad en 4 categorías de la siguiente forma: 1 para menores de
# 18, 2 entre 18 y 35, 3 entre 36 y 65, 4 más de 65 años. Rehacer el análisis a
# partir de la matriz de Burt mediante correspondencias simples.
#

N_copy <- N[,-c(1,2,4)]
N_copy[N_copy[,1] < 18,1] = 1
N_copy[N_copy[,1] >= 18 & N_copy[,1] <= 35,1] = 2
N_copy[N_copy[,1] >= 36 & N_copy[,1] < 65,1] = 3
N_copy[N_copy[,1] >= 65,1] = 4
N_copy[,1]

N_copy_mca1 <- (mjca(N_copy, lambda="Burt", colsup=c(1)))
summary(N_copy_mca1)
N_copy_mca1$Burt
N_copy_mca1$sv
summary(ca(N_copy_mca1$Burt))

#
# 5)  ¿Cuánto vale la inercia recogida por las variables suplementarias en el
# primer factor?
#

#
# Las variables suplementarias no contribuyen a la generación de los factores,
# por tanto, no generan inercia en el análisis.
#

#
# 6)  Efectuar una representación conjunta de las proyecciones de filas y
# columnas e interpretar los factores y el resultado del análisis.
#

plot(N_copy_mca1, what = c("none","all"))


## Dale W.R. Rosenthal, 2018
## You are free to distribute and use this code so long as you attribute
## it to me or cite the text.
## The legal disclaimer in _A Quantitative Primer on Investments with R_
## applies to this code.  Use or distribution without these comment lines
## is forbidden.

principal.start <- 30e6  # pool principal
n.peryr <- 12  # monthly = 12 payments per year
T <- 30   # 30-year mortgage
r <- 0.0625  # 6.25%
t <- 1:(n.peryr*T)

## calculate level monthly payment
pmt.level <- principal.start*r/(n.peryr*(1-1/(1+r/n.peryr)^(n.peryr*T)))

## 100% PSA prepayment: rate up to 6% annual at 30 months
psa.speed <- 100  # 100% PSA
max.rate <- psa.speed/100*0.06
seasoned.month <- 30  # at 30 months, PSA says mortgages are seasoned
prepay.rate <- c(seq(max.rate/seasoned.month, max.rate, max.rate/seasoned.month),
                 rep(max.rate, n.peryr*T-seasoned.month))
prepay.monthly.survival <- (1-prepay.rate)^(1/n.peryr)
prepay.monthly.rate <- 1-prepay.monthly.survival

## In production code, this would be more elegant; however,
## a for loop shows the intuition better than other approaches
num.pmts <- n.peryr*T
principal.left <- c(principal.start, rep(0,num.pmts-1))
pmt.perperiod <- c(pmt.level, rep(0,num.pmts-1))
pmt.interest <- rep(0, num.pmts)
pmt.principal <- rep(0, num.pmts)
pmt.prepays <- rep(0, num.pmts)
for (i in 1:num.pmts) {
    pmt.interest[i] <- principal.left[i]*r/n.peryr
    pmt.principal[i] <- pmt.perperiod[i] - pmt.interest[i]
    if (pmt.principal[i] > principal.left[i]) {
        ## do not repay more than principal remaining
        pmt.principal[i] <- principal.left[i]
        ## stop the loop; pool is paid off!
        break
    } else {
        ## do not prepay more than principal remaining after normal payment
        pmt.prepays[i] <- (principal.left[i]-pmt.principal[i])*prepay.monthly.rate[i]
        if ((pmt.principal[i] + pmt.prepays[i]) > principal.left[i]) {
            pmt.prepays[i] <- principal.left[i] - pmt.principal[i]
            ## stop the loop; pool is paid off!
            break
        }
    }
    if (i < num.pmts) {
        principal.left[i+1] <- principal.left[i] - pmt.principal[i] - pmt.prepays[i]
        pmt.perperiod[i+1] <- pmt.perperiod[i]*prepay.monthly.survival[i]
    }
}

areaplot(t,data.frame(pmt.interest, pmt.principal, pmt.prepays),
         ylim=c(0,pmt.level+max(pmt.prepays)), col=c("red","blue","orange"),
         border=FALSE)


# ST3068/ST2054 -- tutorial -- 30 September 2016
# Question 4

game = c('car', 'goat1', 'goat2')
win = c('car')
switch = TRUE

host_strategy = function(x, w) {
  # x is the list of options for the host
  # w is the winning option in the game -- the car
  # the host has to follow the rule "never reveal the car"

  y = setdiff(x, w);
  # if y has length 1 then the host must take this option
  # otherwise the host can choose between options at random

  if (length(y) > 1) {y = sample(x, 1, replace=FALSE)};
  return(y)
}

player_strategy = function (x, y, b) {
  # b is a Boolean variable
  # if b is TRUE then y is replaced with x

  if (b) {y = x};
  return(y)
}

win_count = 0;
game_count = 1000;

for (i in 1:game_count) {

  player_choice = sample(game, 1, replace=FALSE);

  host_game = setdiff(game, player_choice);

  host_choice = host_strategy(host_game, win);

  player_game = setdiff(host_game, host_choice);

  outcome = player_strategy(player_game, player_choice, switch);

  if (outcome == win) {win_count = win_count + 1}

}

if (switch) {
print(paste('The outcome of the switch strategy:', win_count, 'wins out of', game_count, 'games.'))
} else {
print(paste('The outcome of the non-switch strategy:', win_count, 'wins out of', game_count, 'games.'))
}


# ......................................................................................
# ..................Exercise 1 - Brief introduction to R, Combinatorics.................
# ......................................................................................
# ......................................................................................

# 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

#  Combinatorics ####

# * r-permutations ####
#
# P(n, k) - r-permutations, the first argument will be the total number of entities, the
# second argument the size of the selection
#

# the function is created by the fucntion command, it is an object whose name is given by a variable
# to which I will assign this object
r_permutation = function(n,k) # here I enter the number of parameters and their names
{ # the whole body of the function is enclosed in parentheses {...}
    numerator = factorial(n)  # the factorial in the original R exists so we will use it
    denominator = factorial(n-k)
    return(numerator/denominator)    # what the function returns is given in the return(...) statement
}

# P*(n, k) - r-permutations with repetition
#

r_permutation_repetition = function(n,k)
{
  return(n^k)
}

# * Permutation ####
#
# P(n)=P(n, n) - permutation
#

permutation = function(n)
{
  return(r_permutation(n,n))
}

# P*(n1, n2, n3,...., nk) - permutation with repetition, input will be a vector with
# individual numbers of unique entities
#

permutation_repetition = function(vec_n) # vec_n is the vector of values eg: vec_n=c(2,2,2,4,3)
{
    n = sum(vec_n) # we calculate how many values we have in total
    res_temp=factorial(n) # their factorial=value in the numerator
    # a simple loop starts with the for statement, then the iterator name follows in parentheses
    # and what list will be taken as iterable object
    for(count in vec_n) # count is an iterator and will gradually take values from the vector vec_n
    {
        # we gradually divide by the factorial of each number of unique entities
        res_temp=res_temp/factorial(count)
    }
    return(res_temp)
}

# * Combination ####
#
# C(n, k) - combination
#

combinations = function(n,k)
{
  return(choose(n,k)) # the function for combination already exists in R and is called choose
}

# C*(n, k) - combination with repetition
#

combinations_repetition = function(n,k)
{
  return(choose(n+k-1,k)) # we use a known formula
}

#  Exercise tasks ####
#
# * Example 1. ####
#
# There are three types of locks available in the store. To open the first lock, it is
# necessary to press four of the ten buttons marked with numbers 0 to 9.(The order does
# not matter - the buttons remain pressed.) The second lock will open if we press six of
# the ten buttons. To open the third lock, it is necessary to set the correct
# combination on the four discs. Which of these locks best protects against thieves?
#

z1=combinations(10,4)
z2=combinations(10,6)
z3=r_permutation_repetition(10,4)
paste("count of possible passwords: ",z1,",",z2,",",z3)
paste("probability od random opening: ",1/z1,",",1/z2,",",1/z3)

# * Example 2. ####
#
# The store offers two types of briefcase locking. The first briefcase is locked with a
# six-digit cipher. The second case is locked with two locks that open at the same time.
# The cipher of each of them consists of three digits. Determine for each briefcase the
# probability of opening by a thief on the first attempt. Which type of lock is safer?
#

z1=r_permutation_repetition(10,6);
z2=r_permutation_repetition(10,3)*r_permutation_repetition(10,3);
z2_v2=r_permutation_repetition(10,3)+r_permutation_repetition(10,3);
paste("count combinations: ",z1,",",z2,",second variant - ",z2_v2)

# * Example 3. ####
#
# There are 40 balls in the urn - 2 red and 38 white. We randomly pull 2 balls out of
# the urn. How likely are they both to be red?
#

all_combinations=combinations(40,2);
combinations_valid=combinations(2,2);
prob=combinations_valid/all_combinations;
paste("probability is: ",prob)

# * Example 4. ####
#
# The student had to prepare answers to 40 questions for the exam. He could not answer
# the two questions the examiner asked him, so he said, “I'm unlucky! These are the only
# two questions I can't answer. ”How likely is he to tell the truth?
#

# * Example 5. ####
#
# A student passes a chemistry test if he underlines the only two aldehydes on the list
# of 40 chemical compounds. What is the probability that a student who underlines the
# compounds at random will pass the test?
#

# * Example 6. ####
#
# A group of 40 tourists returned from abroad, including 2 smugglers. At the border,
# customs officer called for a personal search of two passengers and it turned out that
# both were smugglers. The remaining tourists responded: "The customs officer was really
# lucky!", "Someone reported the smugglers!",.... How to deal with these statements? Is
# there a legitimate suspicion that someone reported the smugglers?
#

# * Example 7. ####
#
# From the urn with three balls, two red and one white, two balls will be selected at
# the same time. The student and the teacher place a bet. If both balls are of the same
# color, the student wins. If the balls have different colors, the teacher wins. Is the
# game fair? What are the probabilities of a teacher and a student winning?
#

# the combn function produces combinations of the specified size - the first parameter is a vector of values, the second the size of the selection
combn(c('red','red','white'),2)

# * Example 8. ####
#
# The game described in Example 7 was not fair. What ball(red or white) do we need to
# add to the urn to make the game fair?
#

combn(c('red','red','white','white'),2)
combn(c('red','red','white', 'red'),2)

# * Example 9. ####
#
# You want to play "Man, don't be angry" (a board game requiring a dice), but all the
# dices are lost. How can a dice be replaced if you have playing cards(a deck of 32
# cards) and 4 different colored balls?
#

# * Example 10. ####
#
# You want to play Man, don't be angry, but the dice is lost. How can one replace a dice
# if he has only 3 different colored balls?
#

# * Example 11. ####
#
# They have a sales event in the Škoda car dealership in February. In addition to the
# standard equipment, they offer 3 items from the above-standard equipment free of
# charge. Extra equipment includes 7 items:
#
# - cruise control, seat heating, rear airbags, xenon headlights, sunroof, gearbox lock,
# and  special durable metallic paint.
#
# How many options does the customer have to choose 3 items from the above-standard
# equipment?
#

combinations(7,3)

# * Example 12. ####
#
# During the exam, 12 students will be sitting in the 5th row. The examiner wants to
# determine himself where every student will be sitting.
#
# - How many ways to organize those 12 students?
#
# - Student Brahý asks to be able to sit on aisle seat and leave earlier to catch the
# train. How many options are there for deploying students if the examiner wants to meet
# Brahý's request?
#
# - How many opportunities are there to organize the students if Pažout and Horáček are
# not allowed to sit next to each other?
#

# a
permutation(12)
# b
1*permutation(11)+permutation(11)*1
# c
together=permutation(11)+permutation(11)
permutation(12)-together

# * Example 13. ####
#
# How many anagrams can be created from the word STATISTICS?
#

# 3S,3T,1A,2I,1C
STATISTICS=c(3,3,1,2,1)
permutation_repetition(STATISTICS)

# * Example 14. ####
#
# They got new goods in Tesco - boys' T-shirt in 6 different colors. They have at least
# 7 pieces of each color. The mother wants to buy 4 T-shirts for her son. How many
# options are there to choose from
#
# - if they have to be all to be different?
#
# - if they can all be the same?
#

# a
combinations(6,4)
# b
combinations_repetition(6,4)

# * Example 15. ####
#
# How many passwords of length 5 can we create from alphabetic characters
#
# - if case insensitive?
#
# - if case sensitive?
#

# a
r_permutation_repetition(26,5)
# b
r_permutation_repetition(52,5)

#  Bonus Exercise tasks ####
#
# * Bonus Example 1. ####
#
# Which password is more secure?
#
# * An eight-character password consisting of numbers only.
#
# * A five-character password composed only of letters of the English alphabet.
#

# password 1
h1 = r_permutation_repetition(n = 10, k = 8)
# password 2
h2 = r_permutation_repetition(n = 26, k = 5)
h1/h2

# * Bonus Example 2. ####
#
# How long would it take to solve a business traveler's problem for n=10 cities by brute
# force if the evaluation of the length of each of the possible journeys takes 1 µs?
#

n = 10
count = permutation(n-1)/2
time = count/1000000
time

# * Bonus Example 3. ####
#
# How to divide the booty between 2 robbers to get both items of the same value(or as
# close as possible). I.e. can I divide N numbers into two groups so that the sum of the
# numbers in each group is the same?
#
# **How many options would have to be tried if we solved the problem with brute force?**
#

N = 10
L = 4
r_permutation_repetition(n = L, k = N)

# * Bonus Example 4. ####
#
# How many anagrams of the word "AUTO" can we create? How many anagrams of the word
# "AUTOMOBILKA" can we create? How many of them start with "K"?
#

permutation(4)
vec = c(2,1,1,2,1,1,1,1,1)
sum(vec)
permutation_repetition(vec)

vec = c(2,1,1,2,1,1,1,1)
sum(vec)
permutation_repetition(vec)

# * Bonus Example 5. ####
#
# They have 6 types of colored cups in the shop.
#
# - How many different ways can we buy 4 different-colored mugs?
#
# - How many different options can we buy 5 cups(if we don't mind more of the same
# color)?
#
# - How will the situation change if they have only 4 pieces of each(and we don't mind
# more of the same color)?
#

combinations(6,4)
combinations_repetition(6,5)
combinations_repetition(6,5) - 6

# * Bonus Example 6. ####
#
# There are 5 different pairs of socks in the package (the left and right socks are
# always the same).
#
# - How many different pairs of socks can be chosen?
#
# - How many different ways can I wear it? (i.e. it is important what sock is on which
# leg)
#

combinations_repetition(n = 5,k = 2)
r_permutation_repetition(n=5,k=2)
combinations_repetition(n = 5,k = 2)*2 - 5

# * Bonus Example 7. ####
#
# I have 12 weights weighing 1,2,..., 12 kg.
#
# - How many ways can I divide them into 2 piles?
#
# - How many ways can I divide them into 3 piles?
#
# - How many ways can I divide them into 3 piles if they all have the same number of
# weights?
#
# - How many ways can I divide them into 3 piles of the same number of weights, if the
# weight of none of the pile can exceed 40 kg?
#

r_permutation_repetition(2,12)
r_permutation_repetition(3,12)
(r_permutation_repetition(3,12)-3)/permutation(3)+1
(r_permutation_repetition(3,12)-(r_permutation_repetition(2,12)-2)*3-3)/permutation(3)
combinations(12,4)*combinations(8,4)/permutation(3)
permutation(12)/(permutation(4)*permutation(4)*permutation(4)*permutation(3))
combinations(12,4)*combinations(8,4)/permutation(3)-combinations(8,4)

# * Bonus Example 8. ####
#
# I have 20 seeds from each of the three vegetables(carrots, radishes, celery).
# Unfortunately, they are mixed up and unrecognizable from each other.
#
# - I will plant 5 random seeds in the box. What is the probability that there will be
# at least three radishes among them?
#
# - I'll plant 5 random seeds in the box. What is the probability that there will be
# more carrots than celery among them?
#

(combinations(20,3)*combinations(40,2)+combinations(20,4)*combinations(40,1)+combinations(20,5))/combinations(60,5)


ybar = 390           # sample mean
mu0 = 380            # hypothesized value
sigma = 35.2        # population standard deviation
n = 50                 # sample size
z = (ybar- mu0)/(sigma/sqrt(n))
 # test statistic

p_value=1-pnorm(z)
print(p_value)
alpha=0.01
if(p_value>alpha){
  print("we fail to reject H0")
print(" data do not support the research hypothesis.")
 }else{
   print("reject H0")
     }


#' @export
#' @title compute.oxygen.saturation
#' @description This function determines the percentage of Dissolved oxygen in solution at a given temperature and salinity given a known saturation amount. formula attributed to Weiss DSR 17, 721-735, 1970
#' @param \code{t.C} = temperature in Celsius
#' @param \code{sal.ppt} = salinity in ppt
#' @param \code{oxy.ml.l} = oxygen saturation in ml/L
#' @return \code{DO} = saturation percentage
#' @examples
#' compute.oxygen.saturation(0, 25, 8.2)
#' [1] 95.19575
#' @family physical and chemical properties
#' @author  unknown, \email{<unknown>@@dfo-mpo.gc.ca}
#' @export
  compute.oxygen.saturation = function(t.C, sal.ppt, oxy.ml.l) {
    warning('MMM - 2016-06-17 - Please ensure this works correctly - I was unable to replicate values from online calculators')
    t.K = t.C + 273.15
    o.ml.l.saturated = exp( -173.4292 + 249.6339 * (100/t.K)
      + 143.3483*( log(t.K/100) )
      - 21.8492*(t.K/100)
      + sal.ppt * (-0.033096 + 0.014259 * (t.K/100) - 0.0017*(t.K/100)^2 ) )

#  o.mg.l.saturated = o.ml.l.saturated * 32/22.414

    DO = oxy.ml.l / o.ml.l.saturated * 100
    return(DO)
  }


#la media entre 2 muestras de la misma poblacion
#immer es un dataframe don y1 y y2 del rendimiento de cebada entre los a??os 1931 y 1932

#Assuming that the data in immer follows the normal distribution, find the
#95% confidence interval estimate of the difference between the mean barley
#yields between years 1931 and 1932.

#usamos t.test para obtener el intervalo estimado entra la diferencia de medias poblacionales

library(MASS)
head(immer)

t.test(immer$Y1,immer$Y2,paired = TRUE)

#Paired t-test

#data:  immer$Y1 and immer$Y2
#t = 3.324, df = 29, p-value = 0.002413
#alternative hypothesis: true difference in means is not equal to 0
#95 percent confidence interval:
#  6.121954 25.704713
#sample estimates:
#  mean of the differences
#15.91333

Parcial/3. Inferencia entre poblaciones/PopulationMeanTwoMatchedSamples.r


alpha=0.05
m=4 #comparisons
alpha_l=alpha/m
F_aplha_l_1_25=qf(1-alpha_l,df1 = 1,df2 = 25)
print(F_aplha_l_1_25)
# We would then reject H0 if SSCi/MSError >=F_alpha_l_1_25
F1 = 13.71 # computed in 9.5
F2 = 8.48
F3 = 0.24
F4 = 1.42
#  we would declare contrast l1 and l2 significantly different from 0 because their F ratios are greater than 7.24.


## ----echo=FALSE---------------------------------------------------------------
require(Hmisc)
knitrSet('survintro')

## ----fun-example,bty='l',echo=FALSE,cap='Survival function'-------------------
tt <- c(seq(.0001,.002,by=.001),seq(.002,.02,by=.001),
        seq(.02,1,by=.01))
# Note: bb,dd not stated in usual Weibull form
aa <- .5
bb <- -.5
cc <- 10
dd <- 4
cumhaz <- (aa/(bb+1))*tt^(bb + 1) + (cc/(dd+1))*tt^(dd + 1)
survival <- exp(-cumhaz)
hazard <- ifelse(tt>.001, aa*tt^bb + cc*tt^dd, NA)
plot(tt, survival, type="l", xlab=expression(t), ylab=expression(S(t)))

## ----cumhaz-example,bty='l',echo=FALSE,cap='Cumulative hazard function'-------
plot(tt, cumhaz, type="l", xlab=expression(t),
     ylab=expression(Lambda(t)))

## ----hazard-example,bty='l',echo=FALSE,cap='Hazard function'------------------
plot(tt, hazard, type="l", xlab=expression(t), ylab=expression(lambda(t)))

## ----weibull-shapes,bty='l',echo=FALSE,cap='Some Weibull hazard functions with $\\alpha=1$ and various values of $\\gamma$.'----
tt <- seq(1e-5, 1.2, length=100)
plot(tt, rep(0,100), ylim=c(0,7), type="n", xlab=expression(t), ylab="")
a <- 1
i <- 0
for(b in c(.5,1,2,4)) {
  i <- i + 1
  lines(tt, a*b*tt^(b-1), lty=i)
}
legend(.4, 6, c(".5","1","2","4"), lty=1:4, cex=.9, bty="n")

## ----km-example,bty='l',cap='Kaplan--Meier product--limit estimator with $0.95$ confidence bands.  The Altschuler--Nelson--Aalen--Fleming--Harrington estimator is depicted with the dotted lines.',scap='Kaplan--Meier and Nelson--Aalen estimates'----
require(rms)
tt <- c(1,3,3,6,8,9,10)
stat <- c(1,1,1,0,0,1,0)
S <- Surv(tt, stat)
survplot(npsurv(S ~ 1), conf="bands", n.risk=TRUE,
         xlab=expression(t))
survplot(npsurv(S ~ 1, type="fleming-harrington",
                 conf.int=FALSE), add=TRUE, lty=3)

## ----eval=FALSE---------------------------------------------------------------
## require(rms)
## units(y) <- "Month"
## # Default is "Day" - used for axis labels, etc.
## npsurv(Surv(y, event) ~ svar1 + svar2 + ... , data, subset,
##        type=c("kaplan-meier", "fleming-harrington", "fh2"),
##        error=c("greenwood", "tsiatis"), se.fit=TRUE,
##        conf.int=.95,
##        conf.type=c("log","log-log","plain","none"), ...)

## ----eval=FALSE---------------------------------------------------------------
## f <- npsurv(...)
## print(f)    # print brief summary of f
## summary(f, times, censored=FALSE)   # in survival

## ----eval=FALSE---------------------------------------------------------------
## f <- npsurv(Surv(futime, event) ~ sex)
## summary(f, seq(30, 180, by=30))

## ----eval=FALSE---------------------------------------------------------------
## units(y) <- "Year"
## f <- npsurv(Surv(y, stat) ~ treatment)
## survplot(f, ylab="Fraction Pain-Free")

## ----eval=FALSE---------------------------------------------------------------
## cph(Survobject ~ predictor)


library(reshape2)
library(Rcpp)
library(ggplot2)

cppFunction('
  List sirc(double beta, double gamma, double N, double S0, double I0, double R0, double tf){
    double t = 0;
    double S = S0;
    double I = I0;
    double R = R0;
    std::vector<double> ta;
    std::vector<double> Sa;
    std::vector<double> Ia;
    std::vector<double> Ra;
    do{
      ta.push_back(t);
      Sa.push_back(S);
      Ia.push_back(I);
      Ra.push_back(R);
      double pf1 = beta*S*I;
      double pf2 = gamma*I;
      double pf = pf1+pf2;
      double dt = rexp(1,pf)[0];
      t += dt;
      double r = runif(1)[0];
      if(r<pf1/pf){
        S--;
        I++;
      }else{
        I--;
        R++;
      }
      if(I==0){break;}
    } while (t<=tf && (I>0));
  return List::create(_["time"] = ta, _["S"] = Sa, _["I"] = Ia, _["R"]=Ra);
  }'
)

set.seed(42)

sir_out_list <- sirc(0.1/1000,0.05,1000,999,1,0,200)

sir_out <- as.data.frame(sir_out_list)

if(dim(sir_out)[1]==1){
    sir_out_list <- sirc(0.1/1000,0.05,1000,999,1,0,200)
    sir_out <- as.data.frame(sir_out_list)
}

head(sir_out)

sir_out_long <- melt(sir_out,"time")

# Plot
ggplot(sir_out_long,aes(x=time,y=value,colour=variable,group=variable)) +
  geom_line(lwd=2) + xlab("Time") + ylab("Number")


#!/usr/bin/env Rscript

# eg.1 总体均值mu的区级估计
weight = scan("res/noodle.TXT")
summary(weight)
result = t.test(weight, con =.95)
print(result$con)

# eg.2 两个总体均值之差估计(mu1 - mu2)
v = read.table("res/expend.txt", header=T)
v1 = v[v[, 2] == 1, 1]
v2 = v[v[, 2] == 2, 1]

m1 = mean(v1)
m2 = mean(v2)

diff = m1 - m2
print(diff)

sd(v1)
sd(v2)

t.test(v1, con=.95)$con
t.test(v2, con=.95)$con

t.test(v1, v2, con=.90)$conf


## let L(D|theta) be a likelihood > 0 for all thera.
## let Y = [L(D|theta)]^2
## then the prior pi(theta) induces a measure on the space Y

### Binomial

n <- 10
x <- 3

ap <- 2
bp <- 2

p.samples <- rbeta(n = 1e6, shape1 = ap, shape2 = bp)

X <- dbinom(x = x, size = n, prob = p.samples)

hist(X, main = "Binomial")

Y <- X^2

hist(Y, main = "Binomial")

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

#### Normal, fixed variance

x <- -1
s <- .1

mu.samples <- rnorm(n = 1E6)

X <- dnorm(x = x, mean = mu.samples, sd = s)

hist(X, main = "Gaussian")

Y <- X^2

hist(Y, main = "Gaussian")

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

#### Beta with fixed shape1

psi <- .5
s1 <- 2

s2.samples <- rgamma(n = 1E6, shape = 2, rate = 1)

X <- dbeta(x = psi, shape1 = s1, shape2 = s2.samples)

hist(X, main = "Beta")

Y <- X^2

hist(Y, main = "Beta")


zeckendorf <- function(number) {

  # Get an upper limit on Fibonacci numbers needed to cover number
  indexOfFibonacciNumber <- function(n) {
    if (n < 1) {
      2
    } else {
      Phi <- (1 + sqrt(5)) / 2
      invertClosedFormula <- log(n * sqrt(5)) / log(Phi)
      ceiling(invertClosedFormula)
    }
  }

  upperLimit <- indexOfFibonacciNumber(number)

  # Return the sequence as digits, sorted descending
  fibonacciSequenceDigits <- function(n) {
    fibGenerator <- function(f, ...) { c(f[2], sum(f)) }
    fibSeq <- Reduce(fibGenerator, 1:n, c(0,1), accumulate=TRUE)

    fibNums <- unlist(lapply(fibSeq, head, n=1))

    # drop last F0 and F1 and reverse sequence
    rev(fibNums[-2:-1])
  }

  digits <- fibonacciSequenceDigits(upperLimit)

  isInNumber <- function(digit) {
    if (number >= digit) {
      number <<- number - digit
      1
    } else {
      0
    }
  }

  zeckSeq <- Map(isInNumber, digits)

  # drop leading 0 and convert to String
  gsub("^0+1", "1", paste(zeckSeq, collapse=""))
}

print(unlist(lapply(0:20, zeckendorf)))


## Author: Sergio García Prado

rm(list = ls())

y <- c(7, 6, 8, 16, 13)
k <- length(y)
n <- sum(y)

LogLikelihood <- function(p, y, k) {
  sum(y[1:(k - 1)] * log(p)) + y[k] * log(1 - sum(p))
}

NegativeLogLikelihood <- function(...) {
  - LogLikelihood(...)
}

p.hat.initial <- rep(1 / k, k - 1)
opt <- optim(p.hat.initial[1:(k - 1)], NegativeLogLikelihood, y = y, k = k, hessian = TRUE)

(p.hat <- opt$par)
# 0.139976175373378 0.120217883250931 0.159986995019396 0.319854212163691

(p.hat.var <- solve(opt$hessian))
# 0.0024070858	-0.0003370446	-0.0004477195	-0.0008948212
# -0.0003370446	0.0021183563	-0.0003852716	-0.0007700115
# -0.0004477195	-0.0003852716	0.0026874471	-0.0010228592
# -0.0008948212	-0.0007700115	-0.0010228592	0.0043497380

## a)
####

LogLikelihood1H0 <- function(theta, y, k) {
  LogLikelihood(c(theta[1], theta[1], theta[1], theta[2]), y, k)
}

NegativeLogLikelihood1H0 <- function(...) {
  - LogLikelihood1H0(...)
}

opt1.hzero <- optim(c(0.1, 0.1), NegativeLogLikelihood1H0, y = y, k = k, hessian = TRUE)

(LRT1 <-  2 * (LogLikelihood(p.hat, y, k) - LogLikelihood1H0(opt1.hzero$par, y, k)))
# 0.286670914555231

(LRT1.pvalue <- 1 - pchisq(LRT1, df = (k - 1) - 3))
# 0.59236182742952

## b)
####

g1 <- function(p) {
  c(p[1] - p[2],
    p[1] - p[3],
    p[1] + p[2] + p[3] + 2 * p[4] - 1)
}

g1.derivative <- function(p) {
  matrix(c(1, -1,  0, 0,
           1,  0, -1, 0,
           1,  1,  1, 2),
         3, 4, byrow = TRUE)
}

(g1.hat <- g1(p.hat))
# 0.0197582921224479 -0.0200108196460179 0.059889477971087

(g1.hat.var <- g1.derivative(p.hat) %*% p.hat.var %*% t(g1.derivative(p.hat)))
# 5.199531e-03	2.806578e-03	-2.333792e-05
# 2.806578e-03	5.989972e-03	2.394155e-05
# -2.333792e-05	2.394155e-05	1.152100e-02

(W1 <- t(g1.hat - rep(0, 3)) %*% solve(g1.hat.var) %*% (g1.hat - rep(0, 3)))
# 0.6002303

(W1.pvalue <- 1 - pchisq(W1, df = (k - 1) - 3))
# 0.4384902

## c)
####

LogLikelihood2H0 <- function(theta, y, k) {
  LogLikelihood(c(theta[1], 2 * theta[1], theta[2], theta[2]), y, k)
}

NegativeLogLikelihood2H0 <- function(...) {
  - LogLikelihood2H0(...)
}

opt2.hzero <- optim(c(0.1, 0.1), NegativeLogLikelihood2H0, y = y, k = k, hessian = TRUE)

(LRT2 <-  2 * (LogLikelihood(p.hat, y, k) - LogLikelihood2H0(opt2.hzero$par, y, k)))
# 5.01968859661113

(LRT2.pvalue <- 1 - pchisq(LRT2, df = (k - 1) - 2))
# 0.0812808938285899

## d)
####

g2 <- function(p) {
  c(p[2] - 2 * p[1],
    p[3] - p[4])
}

g2.derivative <- function(p) {
  matrix(c(-2, 1,  0, 0,
            0, 1, -1, 0),
            2, 4, byrow = TRUE)
}

(g2.hat <- g2(p.hat))
# -0.120217883250931 -0.159867217144294

(g2.hat.var <- g2.derivative(p.hat) %*% p.hat.var %*% t(g2.derivative(p.hat)))
# 0.013094878	0.002282278
# 0.002282278	0.005576347

(W2 <- t(g2.hat - rep(0, 2)) %*% solve(g2.hat.var) %*% (g2.hat - rep(0, 2)))
# 5.314512

(W2.pvalue <- 1 - pchisq(W2, df = (k - 1) - 2))
# 0.07014043


#' Generate a damped random walk power spectrum.
#'
#' \deqn{PSD(f) = \frac{\tau^2 SF_\infty^2}{1 + (2 \pi f \tau)^2}}
#'
#' @param N Number of frequencies (must be even).
#' @param freq.max Value of largest frequency.
#' @param tau Characteristic timescale.
#' @param SF Value of structure function over long time scales.
#' @param sd Standard deviation.
#'
#' @return Frequencies and power spectral density.
#'
#' @examples
#' damped.random.walk(100)                # 100 samples with default options
#' damped.random.walk(100, freq.max = 50) # provide maximum frequency
#' damped.random.walk(100, sd = 2.0)      # provide standard deviation
#' damped.random.walk(100, tau = 2.0)     # provide characteristic timescale
#' damped.random.walk(100, SF = 2.0)      # provide value of structure function
#'
#' @export
damped.random.walk <- function(N, freq.max = 1/(2*pi),
                           tau = 1.0, SF = 1.0, sd = 1.0) {
    f <- freq(N, freq.max = freq.max)
    freq.pos <- f$freq.pos
    freq     <- f$freq

    # compute the mean values of the power spectrum's absolute value
    mean.power <- tau * SF * (1 + (2*pi * freq.pos*tau)^2)^-0.5

    # generate a noisy power spectrum in complex form
    z <- noisy.power.spectrum(mean.power, sd = sd)
    # include negative frequencies in the final spectrum, with opposite phase
    z <- mirror.complex(z)

    # return the power spectrum along with the frequencies
    rbind(freq, z)
}


# Sampling from easy distributions
# with the method of inversion
#
# author: Alberto Lumbreras
######################################
par(mfrow=c(1,1))

# demo 1: logistic distribution
# demo 2: exponential distribution
demo <- 1

# Logistic distribution
###########################
if(demo==1){

  # Plot density and cdf
  x <- seq(-10,10, by=0.1)
  plot(x, dlogis(x), type='l', lwd=3, col="black", ylim=c(0,1)) # density
  lines(x, plogis(x), lwd=3, col="red") # cdf
  title("Inverse method (Logistic distribution)")

  # Inverse CDF
  cdf_inv <- function(x, loc=0, scale=10){
    log(x/(1-x))
  }

}

# Exponential distribution
###########################
if(demo==2){

  # Plot density and cdf
  x <- seq(0,10, by=0.1)
  plot(x, dexp(x), type='l', lwd=3, col="black", ylim=c(0,1)) # density
  lines(x, pexp(x), lwd=3, col="red") # cdf
  title("Inverse method (Exponential distribution)")

  # Inverse CDF
  cdf_inv <- function(x){
    -log(1-x)
  }
}

# Sampling by the inverse method
#################################
nsamples <-100000
samples <- rep(NA,nsamples)
for (i in 1:nsamples){
  x <- runif(1)
  samples[i] <- cdf_inv(x)
}

# Plot samples
hist(samples, breaks=100, add=TRUE, probability = TRUE)


library(markovchain)

set.seed(1)
States <- c("Rainy","Cloudy","Sunny")
TransMat <- matrix(c(0.30,0.50,0.20,0.25,0.4,0.35,0.1,0.2,0.70),nrow = 3, byrow = TRUE,dimnames = list(States,States))

MarkovChainModel <- new("markovchain",transitionMatrix=TransMat, states=States, byrow = TRUE, name="MarkovChainModel")
MarkovChainModel

states(MarkovChainModel)
dim(MarkovChainModel)

str(MarkovChainModel)
MarkovChainModel@transitionMatrix

library(diagram)

plot(MarkovChainModel,package="diagram")

transitionProbability(MarkovChainModel, "Sunny", "Rainy")

StartState<-c(0,0,1)

Pred3Days <- StartState * (MarkovChainModel ^ 3)
print (round(Pred3Days, 3))
Pred1Week <- StartState * (MarkovChainModel ^ 7)
print (round(Pred1Week, 3))

steadyStates(MarkovChainModel)

YearWeatherState <- rmarkovchain(n = 365, object = MarkovChainModel, t0 = "Sunny")
YearWeatherState[1:40]


# Bayesian approach:
gibbs1 = function(iters,y,alpha){
  x<-array(0,c(iters+1,3))
  beta = 0.0446
  x[1,1] = 8.625 # initial lamda value.
  x[2,2] =  (0.20 * sum(y)) # OD initial value.
  temp = c()

  # Posterior Distribution is gamma distribution for parameter lamda.
  total_probability = function(lamda,X){
    a = 0
    for (i in 1:8){
      xp = (exp(-lamda)*lamda^(X[i]))/factorial(X[i])
      a = a + xp
    }
    return(mean(a))
  }

  for (t in 2: (iters+1)){

    x[t,1] = rgamma(1, (x[t,2] + (sum(y) - x[t,2]) + alpha), 8 + beta)
    z = c(9,16,6,8,15,8,2,5) # these are the units failed in a hourly basis in the sample dataset.
    # total probability of failure occurance.
    p = total_probability(x[t,1],z)
    x[t,3] = (0.20 * p) # this gives the probability of units failed beacuse of Other Defects.
    x[t,2] = rbinom(1,69,0.20 * p)
  }

  par(mfrow=c(1,2))
  plot(1:length(x[,1]),x[,1], type='l', lty=1, xlab='t', ylab='lambda')
  plot(1:length(x[,2]),x[,2], type='l', ylim=c(0,20), lty=1, xlab='t', ylab='OD')

  return(x)
  }
set.seed(123)
y=rpois(8, 8.625)

output = gibbs1(1000, y, 1)
output

# Lamda value.
absence<-(output[,1])
absent<-(absence [101:1000])
mean(absent) # posterior estimate for lambda.
var(absent) # variance associated with lamda.
# Posterior lamda distribution graph.
par(mfrow=c(1,1))
hist(absent,
     breaks=25,
     freq=F,
     main="Total Defects",
     xlab="Rate parameter(Units failed)",
     ylab="Density")

# Number of Other Defects caused.
OD <- (output[,2])
mean(OD) # mean number of Other defect occurance.

# Probibility sample of Other Defects occurance.
other_defect <- (output[,3])
other_defect_mean <- mean(other_defect) # mean probability of Other Defects Occurance.


# Example : 3   Chapter : 6.6     Page No: 357
# Pascals matrix and its inverse are similar
A<-matrix(c(1,1,1,1,0,1,2,3,0,0,1,3,0,0,0,1),ncol=4)
A1<-solve(A)
Aev<-eigen(A)$values
A1ev<-eigen(A1)$values
print("Both pascal matrix and its inverse have same eigen values")
print(Aev)
print(A1ev)


# Chapter 3 Lab: Linear Regression

library(MASS)
library(ISLR)

# Simple Linear Regression

fix(Boston)
names(Boston)
lm.fit=lm(medv~lstat)
lm.fit=lm(medv~lstat,data=Boston)
attach(Boston)
lm.fit=lm(medv~lstat)
lm.fit
summary(lm.fit)
names(lm.fit)
coef(lm.fit)
confint(lm.fit)
predict(lm.fit,data.frame(lstat=(c(5,10,15))), interval="confidence")
predict(lm.fit,data.frame(lstat=(c(5,10,15))), interval="prediction")
plot(lstat,medv)
abline(lm.fit)
abline(lm.fit,lwd=3)
abline(lm.fit,lwd=3,col="red")
plot(lstat,medv,col="red")
plot(lstat,medv,pch=20)
plot(lstat,medv,pch="+")
plot(1:20,1:20,pch=1:20)
par(mfrow=c(2,2))
plot(lm.fit)
plot(predict(lm.fit), residuals(lm.fit))
plot(predict(lm.fit), rstudent(lm.fit))
plot(hatvalues(lm.fit))
which.max(hatvalues(lm.fit))

# Multiple Linear Regression

lm.fit=lm(medv~lstat+age,data=Boston)
summary(lm.fit)
lm.fit=lm(medv~.,data=Boston)
summary(lm.fit)
library(car)
vif(lm.fit)
lm.fit1=lm(medv~.-age,data=Boston)
summary(lm.fit1)
lm.fit1=update(lm.fit, ~.-age)

# Interaction Terms

summary(lm(medv~lstat*age,data=Boston))

# Non-linear Transformations of the Predictors

lm.fit2=lm(medv~lstat+I(lstat^2))
summary(lm.fit2)
lm.fit=lm(medv~lstat)
anova(lm.fit,lm.fit2)
par(mfrow=c(2,2))
plot(lm.fit2)
lm.fit5=lm(medv~poly(lstat,5))
summary(lm.fit5)
summary(lm(medv~log(rm),data=Boston))

# Qualitative Predictors

fix(Carseats)
names(Carseats)
lm.fit=lm(Sales~.+Income:Advertising+Price:Age,data=Carseats)
summary(lm.fit)
attach(Carseats)
contrasts(ShelveLoc)

# Writing Functions

LoadLibraries
LoadLibraries()
LoadLibraries=function(){
 library(ISLR)
 library(MASS)
 print("The libraries have been loaded.")
 }
LoadLibraries
LoadLibraries()


# Hypothesis Testing or  one-tailed test

ybar = 573            # sample mean
 mu0 = 520              # hypothesized value
 sigma = 124           # population standard deviation
 n = 36                 # sample size
 z = (ybar- mu0)/(sigma/sqrt(n))
 print(z) # test statistic

 # We then compute the critical value at .025 significance level.
 #  For alpha= .025, reject the null hypothesis if lies more than 1.96
  alpha = .025
 z.alpha = qnorm(1-alpha)
  print(z.alpha)


library(MASS)

white <- 10
red <- 4
green <- 7

total <- green + red + white
pr_total <- choose(total, 3)

# Richiesta 1: tre rosse

trerosse <- fractions(choose(red, 3)/pr_total)
print(trerosse)

# Richiesta 2: tre bianche

trebianche <- fractions(choose(white, 3)/pr_total)
print(trebianche)

# Richiesta 3: 2 rosse e 1 bianca

duerosseunabianca <- fractions((choose(red, 2)*choose(white, 1))/pr_total)
print(duerosseunabianca)

# Richiesta 4: almeno una sia bianca

almenounabianca <- fractions(1 - choose(red+green, 3)/pr_total)
print(almenounabianca)

# Richiesta 5: tutte di colori diversi

trecolori <- fractions((red*green*white)/pr_total)
print(trecolori)

# Richiesta 6: ordine rosso, bianco, verde

final <- fractions(red/total * white/(total-1) * green/(total-2))
print(final)