library(repr) ; options(repr.plot.width = 5, repr.plot.height = 6) # Change plot sizes (in cm)

rm(list = ls())
graphics.off()

set.seed(54321)

## 50 draws with each p
pp <- c(0.1, 0.5, 0.8)
N <- 20
reps <- 50

## histograms + density here
x <- seq(0, 50, by=1)
par(mfrow=c(1,3), bty="n")

# Write more code here

## MOM estimators for 3 simulated sets

## MoM estimates, histogram

pp <- .25
N <- 10
reps <- 10
## Make one set of data

## the likelihood is always exactly zero
## at p=0,1, so I skip those values
ps <- seq(0.01, 0.99, by=0.01)

## Likelihood

## MLE/MoM estimators

## now plot the negative log likelihood profile

WL.data <- read.csv("../data/MidgeWingLength.csv")
Y <- WL.data$WingLength
n <- length(Y)

hist(Y,breaks=10,xlab="Wing Length (mm)")

m <- sum(Y)/n
s2 <- sum((Y-m)^2)/(n-1)
round(c(m, s2), 3)

x <- seq(1.4,2.2, length=50)
hist(Y,breaks=10,xlab="Wing Length (mm)", xlim=c(1.4, 2.2), freq=FALSE)
lines(x, dnorm(x, mean=m, sd=sqrt(s2)), col=2)

tau.post <- function(tau, tau0, n){n * tau + tau0}
mu.post <- function(Ybar, mu0, sig20, sig2, n){
 weight <- sig2+n * sig20

 return(n * sig20 * Ybar/weight + sig2 * mu0/weight)
}

mu0 <- 1.9
s20 <- 0.8
s2 <- 0.025 ## "true" variance

mp <- mu.post(Ybar=m, mu0=mu0, sig20=s20, sig2=s2, n=n)
tp <- tau.post(tau=1/s2, tau0=1/s20, n=n)

x <- seq(1.3,2.3, length=1000)
hist(Y,breaks=10,xlab="Wing Length (mm)", xlim=c(1.3, 2.3),
  freq=FALSE, ylim=c(0,8))
lines(x, dnorm(x, mean=mu0, sd=sqrt(s20)), col=2, lty=2, lwd=2) ## prior
lines(x, dnorm(x, mean=mp, sd=sqrt(1/tp)), col=4, lwd=2) ## posterior
legend("topleft", legend=c("prior", "posterior"), col=c(2,4), lty=c(2,1), lwd=2)

# Load libraries
require(rjags) # does the fitting
require(coda) # makes diagnostic plots
##require(mcmcplots) # another option for diagnostic plots

model1 <- "model{

 ## Likelihood
 for(i in 1:n){
 Y[i] ~ dnorm(mu,tau)
 }

 ## Prior for mu
 mu  ~ dnorm(mu0,tau0)

} ## close model
"

model <- jags.model(textConnection(model1),
     n.chains = 1, ## usually do more
     data = list(Y=Y,n=n, ## data
        mu0=mu0, tau0=1/s20, ## hyperparams
        tau = 1/s2 ## known precision
        ),
     inits=list(mu=3) ## setting an starting val
     )

samp <- coda.samples(model,
  variable.names=c("mu"),
  n.iter=1000, progress.bar="none")

plot(samp)

update(model, 10000, progress.bar="none") # Burnin for 10000 samples

samp <- coda.samples(model,
  variable.names=c("mu"),
  n.iter=20000, progress.bar="none")

plot(samp)

summary(samp)

x <- seq(1.3,2.3, length=1000)
hist(samp[[1]], xlab="mu", xlim=c(1.3, 2.3),
  freq=FALSE, ylim=c(0,8), main ="posterior samples")
lines(x, dnorm(x, mean=mu0, sd=sqrt(s20)), col=2, lty=2, lwd=2) ## prior
lines(x, dnorm(x, mean=mp, sd=sqrt(1/tp)), col=4, lwd=2) ## posterior
legend("topleft", legend=c("prior", "analytic posterior"), col=c(2,4), lty=c(2,1), lwd=2)

model2 <- "model{

 # Likelihood
 for(i in 1:n){
 Y[i] ~ dnorm(mu,tau) T(0,) ## truncates at 0
 }

 # Prior for mu
 mu ~ dnorm(mu0,tau0)

 # Prior for the precision
 tau ~ dgamma(a, b)

 # Compute the variance
 s2  <- 1/tau
}"

## hyperparams for tau
a <- 0.01
b <- 0.01

m2 <- jags.model(textConnection(model2),
     n.chains = 1,
     data = list(Y=Y, n=n,
        mu0=mu0, tau0=1/s20, ## mu hyperparams
        a=a, b=b ## tau hyperparams
        ),
     inits=list(mu=3, tau=10) ## starting vals
    )

samp <- coda.samples(m2,
  variable.names=c("mu","s2"),
  n.iter=1000, progress.bar="none")

plot(samp)

summary(samp)

par(mfrow=c(1,2), bty="n")

hist(samp[[1]][,1], xlab="samples of mu", main="mu")
lines(x, dnorm(x, mean=mu0, sd=sqrt(s20)),
  col=2, lty=2, lwd=2) ## prior

x2 <- seq(0, 200, length=1000)
hist(1/samp[[1]][,2], xlab="samples of tau", main="tau")
lines(x2, dgamma(x2, shape = a, rate = b),
  col=2, lty=2, lwd=2) ## prior

plot(as.numeric(samp[[1]][,1]), samp[[1]][,2], xlab="mu", ylab="s2")

require(R2jags) # fitting
require(coda) # diagnostic plots
set.seed(1234)

Aaeg.data <- read.csv("../data/AeaegyptiTraitData.csv")

head(Aaeg.data)

mu.data <- subset(Aaeg.data, trait.name == "mu")
lf.data <- subset(Aaeg.data, trait.name == "1/mu")
par(mfrow=c(1,2), bty="l")
plot(trait ~ T, data = mu.data, ylab="mu")
plot(trait ~ T, data = lf.data, ylab="1/mu")

mu.data.inv <- mu.data # make a copy of the mu data
mu.data.inv$trait <- 1/mu.data$trait # take the inverse of the trait values to convert mu to lifespan
lf.data.comb <- rbind(mu.data.inv, lf.data) # combine both lifespan data sets together

plot(trait ~ T, data = lf.data.comb, ylab="1/mu")

sink("quad.txt") # create a file
cat("
 model{

 ## Priors
 cf.q ~ dunif(0, 1)
 cf.T0 ~ dunif(0, 24)
 cf.Tm ~ dunif(25, 45)
 cf.sigma ~ dunif(0, 1000)
 cf.tau <- 1 / (cf.sigma * cf.sigma)

 ## Likelihood
 for(i in 1:N.obs){
 trait.mu[i] <- -1 * cf.q * (temp[i] - cf.T0) * (temp[i] - cf.Tm) * (cf.Tm > temp[i]) * (cf.T0 < temp[i])
 trait[i] ~ dnorm(trait.mu[i], cf.tau)
 }

 ## Derived Quantities and Predictions
 for(i in 1:N.Temp.xs){
 z.trait.mu.pred[i] <- -1 * cf.q * (Temp.xs[i] - cf.T0) * (Temp.xs[i] - cf.Tm) * (cf.Tm > Temp.xs[i]) * (cf.T0 < Temp.xs[i])
 }
 } # close model
",fill=T)
sink()

# Parameters to Estimate
parameters <- c("cf.q", "cf.T0", "cf.Tm","cf.sigma", "z.trait.mu.pred")

# Initial values for the parameters
inits <- function(){list(
 cf.q = 0.01,
 cf.Tm = 35,
 cf.T0 = 5,
 cf.sigma = rlnorm(1))}

# MCMC Settings: number of posterior dist elements = [(ni - nb) / nt ] * nc
ni <- 25000 # number of iterations in each chain
nb <- 5000 # number of 'burn in' iterations to discard
nt <- 8 # thinning rate - jags saves every nt iterations in each chain
nc <- 3 # number of chains

# Temperature sequence for derived quantity calculations
Temp.xs <- seq(0, 45, 0.2)
N.Temp.xs <- length(Temp.xs)

### Fitting the trait thermal response; Pull out data columns as vectors
data <- lf.data.comb # this lets us reuse the same generic code: we only change this first line
trait <- data$trait
N.obs <- length(trait)
temp <- data$T

# Bundle all data in a list for JAGS
jag.data <- list(trait = trait, N.obs = N.obs, temp = temp, Temp.xs = Temp.xs, N.Temp.xs = N.Temp.xs)

lf.fit <- jags(data=jag.data, inits=inits, parameters.to.save=parameters,
    model.file="quad.txt", n.thin=nt, n.chains=nc, n.burnin=nb,
    n.iter=ni, DIC=T, working.directory=getwd())

lf.fit.mcmc <- as.mcmc(lf.fit)

lf.fit$BUGSoutput$summary[1:5,]

plot(lf.fit.mcmc[,c(1,3,4)])

plot(trait ~ T, xlim = c(0, 45), ylim = c(0,42), data = lf.data.comb, ylab = "Lifespan for Ae. aegypti", xlab = "Temperature")
lines(lf.fit$BUGSoutput$summary[6:(6 + N.Temp.xs - 1), "2.5%"] ~ Temp.xs, lty = 2)
lines(lf.fit$BUGSoutput$summary[6:(6 + N.Temp.xs - 1), "97.5%"] ~ Temp.xs, lty = 2)
lines(lf.fit$BUGSoutput$summary[6:(6 + N.Temp.xs - 1), "mean"] ~ Temp.xs)

Temp.xs[which.max(as.vector(lf.fit$BUGSoutput$summary[6:(6 + N.Temp.xs - 1), "mean"]))]

lf.grad <- lf.fit$BUGSoutput$sims.list$z.trait.mu.pred
dim(lf.grad) # A matrix with 7500 iterations of the MCMC chains at 226 temperatures

require(R2jags) # does the fitting
require(coda) # makes diagnostic plots
library(IDPmisc) # makes nice colored pairs plots to look at joint posteriors

dat <- read.csv("../data/lb_ab_temps.csv")
head(dat)

d2 <- dat[which(dat$EXP==2),2:8]
d2 <- d2[which(d2$TEMP==12),]
summary(d2)

Temps <- seq(0,max(d2$DAY)-1, by=0.05)
mycol <- 1
my.ylim <- c(0, 0.5)
my.title <- "LB-AB isolate, T=12C"

plot(d2$DAY-1, d2$OD, xlim=c(0,max(Temps)), ylim=my.ylim,
 pch=(mycol+20),
 xlab="time (days)", ylab="",
 main=my.title,
 col=mycol+1, cex=1.5)

sink("jags-logistic.bug")
cat("
 model {

 ## Likelihood
 for (i in 1:N) {
  Y[i] ~ dlnorm(log(mu[i]), tau)
  mu[i] <- K * Y0/(Y0+(K-Y0) * exp(-r * t[i]))
 }

 ## Priors
 r~dexp(1000)
 K ~ dunif(0.01, 0.6)
 Y0 ~ dunif(0.09, 0.15)
 tau <- 1/sigma^2
 sigma ~ dexp(0.1)

 } # close model
 ",fill=T)
sink()

# Parameters to Estimate
parameters <- c('Y0', 'K', 'r', 'sigma')

# Initial values for the parameters
inits <- function(){list(
 Y0 = 0.1,
 K = 0.4,
 r = 0.1,
 sigma = rlnorm(1))}

# MCMC Settings: number of posterior dist elements = [(ni - nb) / nt ] * nc
ni <- 6000 # number of iterations in each chain
nb <- 1000 # number of 'burn in' iterations to discard
nt <- 1 # thinning rate - jags saves every nt iterations in each chain
nc <- 5 # number of chains

# Pull out data columns as vectors
data <- d2 # this lets us reuse the same generic code: we only change this first line
Y <- data$OD
N <- length(Y)
t <- data$DAY

# Bundle all data in a list for JAGS
jag.data <- list(Y = Y, N = N, t = t)

# Run JAGS
OD.12C <- jags(data=jag.data, inits=inits, parameters.to.save=parameters,
    model.file="jags-logistic.bug", n.thin=nt, n.chains=nc, n.burnin=nb,
    n.iter=ni, DIC=T, working.directory=getwd())

OD.12C.mcmc <- as.mcmc(OD.12C)

OD.12C$BUGSoutput$summary

plot(OD.12C.mcmc[,c(1,2,4)])

s1 <- as.data.frame(OD.12C.mcmc[[1]])
par(mfrow=c(2,2))
for(i in 2:5) acf(s1[,i], lag.max=20)

source("../code/mcmc_utils.R")

samps <- NULL
for(i in 1:nc){
 samps <- rbind(samps, as.data.frame(OD.12C.mcmc[[i]]))
}

samps <- samps[,c(5,2,3,4)]

priors <- list()
priors$names <- c("Y0", "K", "r","sigma")
priors$fun <- c("uniform", "uniform", "exp","exp")
priors$hyper <- matrix(NA, ncol=4, nrow=3)
priors$hyper[,1] <- c(0.09, 0.15, NA)
priors$hyper[,2] <- c(0.01, 0.6, NA)
priors$hyper[,3] <- c(1000, NA, NA)
priors$hyper[,4] <- c(0.1, NA, NA)

plot.hists(samps, my.par=c(2,2), n.hists=4, priors=priors, mai=c(0.5, 0.5, 0.25, 0.2))

ipairs(s1[,2:5], ztransf = function(x){x[x<1] <- 1; log2(x)})

my.logistic <- function(t, Y0, K, r){
 return(K * Y0/(Y0+(K-Y0) * exp(-r * t)))
}

ts <- seq(0, 40, length=100)
ss <- seq(1, dim(samps)[1], by=10)
my.curves <- matrix(NA, nrow=length(ss), ncol=length(ts))

for(i in 1:length(ss)){
 my.curves[i,] <- my.logistic(t=ts, Y0=samps$Y0[i], K=samps$K[i], r=samps$r[i])
}

plot(ts, my.curves[1,], col=1, type="l", ylim=c(0.09, 0.36),
  ylab="predicted OD", xlab="time (days)")
for(i in 2:length(ss)) lines(ts, my.curves[i,], col=i)

m.log <- apply(my.curves, 2, mean)
l.log <- apply(my.curves, 2, quantile, probs=0.025)
u.log <- apply(my.curves, 2, quantile, probs=0.975)

hpd.log <- NULL
for(i in 1:length(ts)){
 hpd.log <- cbind(hpd.log, as.numeric(HPDinterval(mcmc(my.curves[,i]))))
}

my.ylim <- c(0.09, 0.45)
my.title <- "LB-AB isolate, T=12C"

plot(d2$DAY-1, d2$OD, xlim=c(0,max(Temps)), ylim=my.ylim,
 pch=(mycol+20),
 xlab="time (days)", ylab="",
 main=my.title,
 col="grey", cex=1.5)
lines(ts, m.log, col=1, lwd=2)
lines(ts, l.log, col=2, lwd=2, lty=2)
lines(ts, u.log, col=2, lwd=2, lty=2)

lines(ts, hpd.log[1,], col=3, lwd=2, lty=3)
lines(ts, hpd.log[2,], col=3, lwd=2, lty=3)


### 5.2-9

hypMean <- 16
experData <- c(20, 24, 18, 16, 16, 19, 21, 23)

experMean <- mean(experData)
experSd <- sd(experData)
nSamples <- length(experData)

t <- (experMean - hypMean) / (experSd / sqrt(nSamples))
print(nSamples)
print(t)

### df = r - k - 1 = 8 - 2 - 1 = 5
tCrit <- qt(0.975, nSamples-2-1, ncp=0, lower.tail=TRUE, log.p=FALSE)
print(tCrit)

### t = 3.448613  ->  H0 is rejected (mu is not equal to 16)


# Example : 1   Chapter : 4.3     Page No: 218
# Fit a straight line
solution<-function(A,b){
  ATA<-t(A)%*%A
  ATb<-t(A)%*%b
  xhat<-solve(ATA,ATb)
  return(xhat)
}
fit_line<-function(D){
  num_of_points<-nrow(D)
  t<-c()
  for(i in 1:num_of_points){
    t<-c(t,1)
  }
  t<-c(t,D[,1])
  A<-matrix(c(t),ncol=2)
  b<-D[,2]
  b<-matrix(c(b),ncol=1)
  x<-solution(A,b)# The system has no solution, we need to find the best solution
  return(x)
}
Data<-matrix(c(0,6,1,0,2,0),ncol=2,byrow=T)
x<-fit_line(Data)
C<-x[1]
D<-x[2]
print(paste("The best straight line is b= ",C," + ",D,"t"))


# function: tosscoin() gives the result of tossing a fair coin
tosscoin <- function(){
  x<-runif(1,0,1)
  if (x<1/2) "H" else "T"
}

# function:  heads(x) where x is a vector of characters 'H' and 'T' returns
# the number of times 'H' appears
heads<-function(x){
  sum(x=="H")
}

# function:  tosscoins(n) where n is a counting number tosses a fair coin n
# times and returns the number of times it comes up heads
tosscoins <- function(n){
  heads(replicate(n,tosscoin()))
}

# EXERCISE 1 # -----------------------------------------------------

ex1<-function(n){
  x<-replicate(n,tosscoin())
  k<-floor(n/100) #number of sequences of length 100
  y<-rep(0,k+1)
  for(i in 1:k)
    y[i]<-heads(x[c(1:(i*100))])/(i*100)-1/2
  y[k+1]<-heads(x)/length(x)-1/2
  y
}

ex11<-function(n){
  x<-replicate(n,tosscoin())
  k<-floor(n/100) #number of sequences of length 100
  y<-rep(0,k+1)
  z<-y
  for(i in 1:k)
    y[i]<-heads(x[c(1:(i*100))])/(i*100)-1/2
  y[k+1]<-heads(x)/length(x)-1/2
  for(i in 1:k)
    z[i]<-heads(x[c(1:(i*100))])-i*50
  z[k+1]<-heads(x)-1/2*length(x)
  list(y,z)
}

# EXERCISE 2 # -----------------------------------------------------

ex2<-function(n){
  x<-replicate(n,tosscoin())
  p<-heads(x)/length(x)-1/2
  if(abs(p)<.1) "Y" else "N"
}

repex2<-function(n){
  sum(replicate(100,ex2(n))=="Y")
}

# EXERCISE 3 # -----------------------------------------------------

# sum the roll of three dice
galileo<-function(n){
  x<-replicate(n,sum(sample(1:6,3,replace=TRUE)))
  a<-sum(x==9)/n
  b<-sum(x==10)/n
  list(a,b)
}

# EXERCISE 4 # -----------------------------------------------------

matches=1000
score_A=0
score_B=0
serve_A=1 # A serves first
serve_B=0
win_A=0

# Player_A serves with 60% probability of winning the volley and 50% if he
# does not serve
for(i in 1:matches){
  while(score_A<21 && score_B<21){
    # A serves first
    if(serve_A==1){
      if(runif(1,0,1)<0.6){
        score_A<-score_A+1
        else
          serve_B=1
        serve_A=0 #Change Serve
      }
    }
    if(serve_B==1){
      if(runif(1,0,1)<0.5){
        score_B<-score_B+1
        else
          serve_B=0
        serve_A=1
      }
    }
  }
  if(score_A>score_B){
    win_A<-win_A+1
  }
  score_A=0
  score_B=0
  serve_A=1
  serve_B=0 # A serves first
}

# sprintf('A won %d percent of %d mactches',win_A/matches*100,matches)


# lets first simulate a bivariate normal sample
library(MASS)
library(mvtnorm)
bigauss <- mvrnorm(50000, mu = c(0, 0), Sigma = matrix(c(1, .1, .1, 1), 2))
bigauss.estimate <- kde2d(bigauss[,1], bigauss[,2], n = 50)
contour(bigauss.estimate,nlevels=6,lty=2)

bigauss <- mvrnorm(50000, mu = c(0, 0), Sigma = matrix(c(.1, .01, .01, .1), 2))
bigauss.estimate <- kde2d(bigauss[,1], bigauss[,2], n = 50)
contour(bigauss.estimate,nlevels=6,col=2,add=TRUE)

L <- 1000
smallcov <- matrix(c(.1,.01,.01,.1),2)
x <- c(0,0)
for(i in 1:L)
{
	x2 <- mvrnorm(1, mu=x, Sigma=smallcov)
	lines(c(x[1],x2[1]), c(x[2],x2[2]), t='p',pch=20)
	x <- x2
}


## Vectorized operation continued...

# Now we will compute the per 100k murder rate for each state and then store it in a object murder_rate
# Then we will compute the average state murder rates for the US using the mean function

# This is how you would display this average

# You can use vectorization to calculate the rate.
# If tot is the total number of murders and pop is the population per state
tot/pop*100000 # Rate each state

# Now you can calculate the average using mean

# Stores per 100k the murder rates per state in the variable murder_rate
# In order to calculate the average murder rate in the US you will

library(dslabs) # Load the data
data(murders)

murder_rate <- murders$total/murders$population*100000 # Store the per 100,000 murder rate for each state in murder_rate
mean(murder_rate) # Calculate the average murder rate in the US


library(deSolve)

# Function to return derivatives of SEIR model
seir_ode<-function(t,Y,par){
  S<-Y[1]
  E<-Y[2]
  I<-Y[3]
  R<-Y[4]

  beta<-par[1]
  sigma<-par[2]
  gamma<-par[3]
  mu<-par[4]

  dYdt<-vector(length=3)
  dYdt[1]=mu-beta*I*S-mu*S
  dYdt[2]=beta*I*S-(sigma+mu)*E
  dYdt[3]=sigma*E-(gamma+mu)*I

  return(list(dYdt))
}

# Set parameter values
beta<-520/365;
sigma<-1/60;
gamma<-1/30;
mu<-774835/(65640000*365) # UK birth and population figures 2016
init<-c(0.8,0.1,0.1)
t<-seq(0,365)
par<-c(beta,sigma,gamma,mu)
# Solve system using lsoda
sol<-lsoda(init,t,seir_ode,par)

# Plot
plot(t,sol[,2],type="l",col="blue",ylim=c(0,1),ylab="Proportion")
lines(t,sol[,3],col="orange")
lines(t,sol[,4],col="red")
lines(t,1-rowSums(sol[,2:4]),col="green")
legend(300,0.7,legend=c("S","E","I","R"),col=c("blue","orange","red","green"), lty=1, cex=0.8)


 # mean for interval data
ClassInterval <- c("16.25-18.75", "18.75-21.25", "21.25-23.75","23.75-26.25", "26.25-28.75", " 28.75-31.25", " 31.25-33.75", "33.75-36.25","36.25-38.75", " 38.75- 41.25","41.25- 43.75")
freq <- c( 2,7,7,14,17,24,11,11,3,3,1)
mid_interval<- c(17.5,20.0,22.5,25.0,27.5,30.0,32.5,35.0,37.5,40.0,42.5)
fmi<-freq*mid_interval

List<- data.frame(ClassInterval, freq, mid_interval,fmi)
print(List)
print("mean is")
print(sum(fmi)/sum(freq))


bisector <- function (P1, P2) {
	delta <- P2 - P1
	mid <- (P1 + P2) / 2.0
	result <- c(-delta[1] / delta[2], (t(delta) %*% mid) / delta[2])
}

plotb <- function (P1, P2, col = "black", x = c(-10, 10)) {
	b <- bisector(P1, P2)
	y <- b[1] * x + b[2]
	lines(x, y, col = col)
}

plotbh <- function (P1, P2, col = "black", x = seq(-10, 10, by = 0.1)) {
	b <- bisector(P1, P2)
	y <- b[1] * x + b[2]
	dx <- x - P2[1]
	dy <- y - P2[2]
	y <- y + sqrt(dx * dx + dy * dy)
	lines(x, y, col=col)
}

plotl <- function (P, l, col = "black") {
	text(t(P), l, col = col)
}

plotp <- function (P, l, col = "black", offset = c(0.4, 0)) {
	points(t(P), col = col)
	plotl(P + offset, l, col = col)
}

lineval <- function(x, line) {
	result <- (line[3] - line[1] * x) / line[2]
}

psb <- function(P1, n1, P2, n2, x, color = "black") {
	b <- bisector(P1, P2)
	y <- b[2] + b[1] * x
	print(sprintf("%02f * x + %02f", b[1], b[2]))
	offset <- c(0.4, 0)
	lines(x, y, col=color)
	points(t(P1))
	text(t(P1 + offset), n1)
	points(t(P2))
	text(t(P2 + offset), n2)
}

dist <- function (P1, P2) {
	return <- sqrt(sum((P2 - P1)^2))
}

psbh <- function (P1, n1, P2, n2, x, color= "black") {
	b <- bisector(P1, P2)
	y <- b[2] + b[1] * x
	dx <- x - P2[1]
	dy <- y - P2[2]
	y <- y + sqrt(dx * dx + dy * dy)
	offset <- c(0.4, -0.4)
	lines(x, y, col=color)
	points(t(P1))
	text(t(P1 + offset), n1)
	points(t(P2))
	text(t(P2 + offset), n2)
}

xlabel <- function (P1, P2, P3, label) {
	b1 <- bisector(P1, P2)
	b2 <- bisector(P2, P3)
	xx <- (b1[2] - b2[2]) / (b1[1] - b2[1])
	xy <- b1[1] * xx + b1[2]
	text(xx, xy - 0.4, label)
}

crossb <- function (P1, P2, P3) {
	b1 <- bisector(P1, P2)
	b2 <- bisector(P2, P3)
	xx <- (b2[2] - b1[2]) / (b1[1] - b2[1])
	xy <- b1[1] * xx + b1[2]
	return <- c(xx, xy)
}

crossbh <- function (P1, P2, P3) {
	cross <- crossb(P1, P2, P3)
	return <- c(cross[1], cross[2] + dist(cross, P3))
}

wholeplot <- function (A, B, X, Y, Z, plotter = plotb, offset = c(0.4, 0)) {
	plotter(A, B)
	plotter(A, X, col = "blue")
	plotter(B, X, col = "red")
	plotter(A, Y, col = "blue")
	plotter(B, Y, col = "red")
	plotter(A, Z, col = "blue")
	plotter(B, Z, col = "red")

	plotp(A, "A", col = "blue", offset = offset)
	plotp(B, "B", col = "red", offset = offset)
	plotp(X, "X", offset = offset)
	plotp(Y, "Y", offset = offset)
	plotp(Z, "Z", offset = offset)
}

crossplot <- function (A, B, X, Y, Z) {
	offset <- c(0, -0.4)
	plotl(crossb(A, B, X) + offset, "X'")
	plotl(crossb(A, B, Y) + offset, "Y'")
	plotl(crossb(A, B, Z) + offset, "Z'")
}

x <- seq(-10, 10, by = 0.1)
A <- c(3, 0)
B <- c(4, 1)
X <- c(0, 6.5)
Y <- c(0, 9)
Z <- c(0, 11.5)

par(mfrow=c(1,1))

plot('x', 'y', xlab='', ylab='', type="n", ylim=c(-1, 12), xlim=c(-5, 5), asp=1)
wholeplot(A, B, X, Y, Z)
crossplot(A, B, X, Y, Z)
lines(c(0, 0), c(-0.5, 12), lty="dotted")

plot('x', 'y', xlab='', ylab='', type="n", ylim=c(-1, 12), xlim=c(-5, 5), asp=1)
wholeplot(A, B, X, Y, Z, plotter = plotbh, offset = c(0.3, 0.3))
plotl(crossbh(A, B, X) + c(0.4, -0.2), "X'")
plotl(crossbh(A, B, Y) + c(-0.3, -0.4), "Y'")
plotl(crossbh(A, B, Z) + c(-0.2, -0.3), "Z'")
lines(c(0, 0), c(-0.5, 12), lty="dotted")

plot('x', 'y', xlab='', ylab='', type="n", ylim=c(-1, 12), xlim=c(-5, 5), asp=1)
P1 <- c(-1.5, 0)
P2 <- c(-0.5, 5)
plotbh(P1, P2)
plotp(P1, "A", col = "blue", offset = offset)
plotp(P2, "B", col = "red", offset = offset)
lines(c(-6, 6), c(7, 7), lty="dotted")
text(-5, 6.5, "R* of A", col="blue")
text(0, 6.5, "R* of B", col="red")
text(5, 6.5, "R* of A", col="blue")


library(DescTools)
brandA=c(211.4,204.4,202.0,201.9,202.4,202.0,202.4,207.1,203.6,216.0,208.9,208.7,213.8,201.6,201.8,200.3,201.8,201.5,212.1,203.4)
brandB=c(186.3,205.7,184.4,203.6,180.4,202.0,181.5,186.7,205.7,189.1,183.6,188.7,188.6,204.2,181.6,208.7,181.5,208.7,186.8,182.9)
difference=brandA-brandB

y=rank(replace(abs(difference),abs(difference)==0,NA),na='keep');
cbind(difference,y)
# sum of positive and negative ranks are
Tminus=1+2+3+4+5+6
Tplus= 7 + 8 + 9 + 10 + 11 + 12 + 13 + 14 +15 + 16 +17.5 +18 + 19
T=min(Tminus,Tplus)
T
# T<53, we reject H0 and conclude that brand A fertilizer tends to produce more grass than brand B
difference=difference[-6]

MedianCI(difference,conf.level = 0.95,na.rm = FALSE, method = "exact",R = 999)


months = seq(1, 6)
profit = c(1.2, 1.5, 2, 3.5, 4.1, 5.6)
sales = c(24, 25, 25, 28, 27, 29)
price = c(0.95, 0.93, 0.92, 0.9, 0.87, 0.86)

d = data.frame(months=months, profit=profit, sales=sales, price=price)

png('images/cor.png')
pairs(d)
dev.off()

cor(d)

model.fit = lm(profit ~ months + sales + price, data=d)
print(summary(model.fit))

d_scaled = data.frame(
    months=scale(d$months),
    profit=scale(d$profit),
    sales=scale(d$sales),
    price=scale(d$price)
)

model.fit_scaled = lm(profit ~ months + sales + price, data=d_scaled)

print(summary(model.fit_scaled))

print('Media de error residual (scaled)')
print(mean(model.fit_scaled$residuals))

print('Suma de error residual (scaled)')
print(sum(model.fit_scaled$residuals))

png('images/plots.png', width=800, height=400)
par(mfrow=c(1,2))

hist(model.fit_scaled$residuals, xlab='Residuals')
qqnorm(model.fit_scaled$residuals)
qqline(model.fit_scaled$residuals)

dev.off()

require(lmtest)
dwtest(model.fit_scaled)

print(d_scaled)

pred = predict(model.fit_scaled, data=data.frame(
    months=scale(d$months),
    sales=scale(d$sales),
    price=scale(d$price)
))

print('Predicciones en modelo escalado')
print(pred)

print('Errores residuales')
print(residuals(model.fit_scaled))

png('images/homo.png')
plot(pred, residuals(model.fit_scaled), xlab='Predictions', ylab='Residuals of scaled model')
abline(h=0, lty=2)
dev.off()


####CHAPTER 1
library(tidyverse)
library(xts)
library(tseries)
library(zoo)
library(astsa)
library(rugarch) #garch

setwd("C:/Users/Ghozy Haqqoni/Documents/!Bahan Data Science Ghozy/DS Courses/DATACAMP/Time_Series_with_R_Track/7_GARCH_Models_in_R/")

####ANALYZING VOLATILITY#### <-video
library(PerformanceAnalytics)
###Calculating Returns
# Example in R for daily S&P 500 prices (xts object)
SP500returns <- CalculateReturns(SP500prices)
###How to estimate return volatility
#Compute daily standard deviation
sd(sp500ret) #0.01099357
###Annualized volatility
# Compute annualized standard deviation
sqrt(252)*sd(sp500ret) #0.1745175
###Rolling volatility estimation
#Function chart.RollingPerformance()
chart.RollingPerformance(R = sp500ret ,
                         width = 22,
                         FUN = "sd.annualized",
                         scale = 252,
                         main = "Rolling 1 month volatility")
############################

####Computing returns####
library(xts)
library(PerformanceAnalytics)
# Plot daily S&P 500 prices
plot(sp500prices)
# Compute daily returns
sp500ret <- CalculateReturns(sp500prices)
# Check the class of sp500ret
class(sp500ret)
# Plot daily returns
plot(sp500ret)
####

####Standard deviation on subsamples####
#number of periods in a year (daily scale = 252,
#monthly scale = 12, quarterly scale = 4)
# Compute the daily standard deviation for the complete sample
sd(sp500ret)
# Compute the annualized volatility for the complete sample
sqrt(252)*sd(sp500ret)
# Compute the annualized standard deviation for the year 2009
sqrt(252)* sd(sp500ret["2009"])
# Compute the annualized standard deviation for the year 2017
sqrt(252)* sd(sp500ret["2017"])
####

####Roll, roll, roll####
# Load the library PerformanceAnalytics
library(PerformanceAnalytics)

# Showing two plots on the same figure
par(mfrow=c(2,1))
#1 month estimate, width = 22
# Compute the rolling 1 month estimate of annualized volatility
chart.RollingPerformance(R = sp500ret["2000::2017"],
                         width = 22,
                         FUN = "sd.annualized",
                         scale = 252,
                         main = "One month rolling volatility")
# Compute the rolling 3 months estimate of annualized volatility
chart.RollingPerformance(R = sp500ret["2000::2017"], width = 22*3,
                         FUN ="sd.annualized", scale = 252,
                         main = "Three months rolling volatility")
####

####GARCH EQUATION FOR VOLATILITY PREDICTION#### <-video
###Specify Inputs
# Set parameter values
alpha <- 0.1
beta <- 0.8
omega <- var(sp500ret)*(1-alpha-beta)
# Then: var(sp500ret) = omega/(1-alpha-beta)
# Set series of prediction error
e <- sp500ret - mean(sp500ret) # Constant mean
e2 <- e^2
# Volatility is sqrt of predicted variance
predvol <- sqrt(predvar)
predvol <- xts(predvol, order.by = time(sp500ret))
# We compare with the unconditional volatility
uncvol <- sqrt(omega / (1 - alpha-beta))
uncvol <- xts(rep(uncvol, nobs), order.by = time(sp500ret))
# Plot
plot(predvol)
lines(uncvol, col = "red", lwd = 2)
#####################################

####Prediction errors####
# Compute the mean daily return
m <- mean(sp500ret)
# Define the series of prediction errors
e <- sp500ret - m
# Plot the absolute value of the prediction errors
par(mfrow = c(2,1),mar = c(3, 2, 2, 2))
plot(abs(e))
# Plot the acf of the absolute prediction errors
plot(acf(abs(e)))
####

####The recursive nature of the GARCH variance####
# Compute the predicted variances
predvar[1] <- var(sp500ret)
for(t in 2:nobs){
  predvar[t] <- omega + alpha* e2[t-1] + beta * predvar[t-1]
}
# Create annualized predicted volatility
ann_predvol <- xts(sqrt(predvar) * sqrt(252), order.by = time(sp500ret))
# Plot the annual predicted volatility in 2008 and 2009
plot(ann_predvol["2008::2009"], main = "Ann. S&P 500 vol in 2008-2009")
####

####THE RUGARCH PACKAGE#### <-video
###Workflow in R
#ugarchspec(): Specify which GARCH model you want to use.
# Constant mean, standard garch(1,1) model
garchspec <- ugarchspec(
  mean.model = list(armaOrder = c(0,0)),
  variance.model = list(model = "sGARCH"),
  distribution.model = "norm")
#ugarchfit(): Estimate the GARCH model
garchfit <- ugarchfit(data = sp500ret ,
                      spec = garchspec)
#ugarchforecast(): Forecast the volatility of the future returns
garchforecast <- ugarchforecast(fitORspec = garchfit,
                                n.ahead = 5)
###Ugarchfit Object
# Coefficients
garchcoef <- coef(garchfit)
# Unconditional variance
garchuncvar <- uncvariance(garchfit)
# Predicted mean
garchmean <- fitted(garchfit)
# Predicted volatilities
garchvol <- sigma(garchfit)
###Estimated GARCH coeff returns
print(garchcoef)
#           mu        omega       alpha1        beta1
# 5.728020e-04 1.220515e-06 7.792031e-02 9.111455e-01
###Estimated volatilities
garchvol <- sigma(garchfit)
plot(garchvol)
###What about future volatility?
tail(garchvol, 1)
# 2017-12-29 0.004862908
###Forecasting h-day ahead volatilities
#Applying the sigma() method to the ugarchforecast object gives the volatility forecasts:
sigma(garchforecast)
#Applying the fitted() method to the ugarchforecast object gives the mean forecasts:
fitted(garchforecast)
#####################################

####Specify and taste the GARCH model flavors####
library(rugarch)
citation("rugarch")
# Specify a standard GARCH model with constant mean
garchspec <- ugarchspec(
  mean.model = list(armaOrder = c(0,0)),
  variance.model = list(model = "sGARCH"),
  distribution.model = "norm")
# Estimate the model
garchfit <- ugarchfit(data = sp500ret, spec = garchspec)
# Use the method sigma to retrieve the estimated volatilities
garchvol <-  sigma(garchfit)
# Plot the volatility for 2017
plot(garchvol["2017"])
####

####Out-of-sample forecasting####
# Compute unconditional volatility
#The volatility is the square root of the variance.
sqrt(uncvariance(garchfit))
# Print last 10 ones in garchvol
tail(garchvol, 10)
# Forecast volatility 5 days ahead and add
garchforecast <- ugarchforecast(fitORspec = garchfit,
                                n.ahead = 5)
# Extract the predicted volatilities and print them
print(sigma(garchforecast))
####

####Volatility targeting in tactical asset allocation####
# Compute the annualized volatility
annualvol <- sqrt(252) * sqrt(sp500ret)
# Compute the 5% vol target weights
vt_weights <- 0.05 / annualvol
vt_weights
# Compare the annualized volatility to the portfolio weights in a plot
plot(merge(annualvol, vt_weights), multi.panel = TRUE)

####


library(tidyverse)
library(ggplot2)

# Set for reproducibility
set.seed(777)
sampleSize <- 10000

# Bernoulli
data <- tibble(Outcome = rbinom(sampleSize, 1, 0.5))

ggplot(data, aes(x = Outcome)) + geom_histogram()

# Binomial
dataBinom2 <- tibble(Outcome = rbinom(sampleSize, 2, 0.2), OutcomeNo=2)
dataBinom4 <- tibble(Outcome = rbinom(sampleSize, 4, 0.2), OutcomeNo=4)
dataBinom10 <- tibble(Outcome = rbinom(sampleSize, 10, 0.2), OutcomeNo=10)
dataBinom50 <- tibble(Outcome = rbinom(sampleSize, 50, 0.2), OutcomeNo=50)

data <- bind_rows(dataBinom2, dataBinom4, dataBinom10, dataBinom50)

ggplot(data, aes(x = Outcome)) +
  geom_histogram(binwidth = .5) +
  facet_wrap(~OutcomeNo, scales = "free") +
  labs(
    title = "Sampling distributions (10,000 samples) of the Binomial distribution",
    subtitle = "10,000 samples with 0.2 as the probability of success."
  )

# Discrete Uniform
data <- tibble(Outcome = rdunif(sampleSize, 1, 6))

ggplot(data, aes(x = Outcome)) +
  geom_histogram(binwidth = .5) +
  scale_x_continuous(breaks = seq(1,6,1)) +
  labs(
    title = "Simulating dice rolling outcomes",
    subtitle = "10,000 samples"
  )

# Poisson
dataPois1 <- tibble(dist = rpois(sampleSize, 1), lambda = 1)
dataPois3 <- tibble(dist = rpois(sampleSize, 3), lambda = 3)
dataPois10 <- tibble(dist = rpois(sampleSize, 10), lambda = 10)
dataPois50 <- tibble(dist = rpois(sampleSize, 50), lambda = 50)

data <- bind_rows(dataPois1, dataPois3, dataPois10, dataPois50)

ggplot(data, aes(x = dist)) +
  geom_histogram(binwidth = .5) +
  facet_wrap(~lambda) +
  labs(
    title = "Sampling distributions of the poisson distribution",
    subtitle = "10,000 samples, lambdas are specified at the top of each graph"
  )

# Negative binomial
dataNb2 <- tibble(dist = rnbinom(sampleSize, 2, .3), success = 2)
dataNb3 <- tibble(dist = rnbinom(sampleSize, 3, .3), success = 3)
dataNb4 <- tibble(dist = rnbinom(sampleSize, 4, .3), success = 4)
dataNb5 <- tibble(dist = rnbinom(sampleSize, 5, .3), success = 5)
dataNb6 <- tibble(dist = rnbinom(sampleSize, 6, .3), success = 6)
dataNb7 <- tibble(dist = rnbinom(sampleSize, 7, .3), success = 7)

data <- bind_rows(dataNb2, dataNb3, dataNb4, dataNb5, dataNb6, dataNb7)

ggplot(data, aes(x = dist)) +
  geom_histogram(binwidth = .5) +
  facet_wrap(~success, ncol = 2) +
  labs(
    title = "Sampling distributions of the negative binomial distribution",
    subtitle = "10,000 samples, target number of successful trials are specified at the top of each graph",
    x = "Number of trials occured before the kth success"
  )

# Geometric
dataGeom2 <- tibble(dist = rgeom(sampleSize, .2), prob = 0.2)
dataGeom3 <- tibble(dist = rgeom(sampleSize, .3), prob = 0.3)
dataGeom4 <- tibble(dist = rgeom(sampleSize, .4), prob = 0.4)
dataGeom5 <- tibble(dist = rgeom(sampleSize, .5), prob = 0.5)

data <- bind_rows(dataGeom2, dataGeom3, dataGeom4, dataGeom5)

ggplot(data, aes(x = dist)) +
  geom_histogram(binwidth = .5) +
  facet_wrap(~prob) +
  labs(
    title = "Sampling distributions of the geometric distribution",
    subtitle = "10,000 samples, probability of successes are specified at the top of each graph"
  )


cat('###PyRInText2019###')
cat(12)
cat('###PyRInText2019###')

mcPi <- function(points){ # This is R comment
	inR <- 0
	cols <- NULL
	range <- c(0,1)
	x <- runif(points,0,1)
	y <- runif(points,0,1)
	r <- x^2+y^2
	for(i in r){
		if(i<=1){
			inR <- inR + 1
			cols <- c(cols,"red")
		}
		else
		  cols <- c(cols,"black")
	}
	return_data <- 4*inR/points

	pdf("mc_pi.pdf")
	plot(x,y,col=cols,xlim=range,ylim=range,pch=20,
		main="Estimate pi value with Monte Carlo method",
		sub=sprintf("%s points. pi = %1.6f",points, return_data))
	curve(sqrt(1-x^2),xlim=c(0,1),ylim=c(0,1),add=T)
	lines(c(0,1),c(0,0))
	lines(c(0,0),c(1,0))
	return(return_data)
}

cat('###PyRInText2019###')
cat(57)
cat('###PyRInText2019###')
points<-2003
cat('###PyRInText2019###')
cat(59)
cat('###PyRInText2019###')
cat(points)
cat('###PyRInText2019###')
cat(61)
cat('###PyRInText2019###')
cat(mcPi(points))
cat('###PyRInText2019###')
cat(66)
cat('###PyRInText2019###')
library(knitr);data(iris);data<-iris[c(41:60),];kable(data, "latex")


# adding libraries
library(dplyr)
# Performing Linear Regression on MPG data
mpg <- read.csv('MechaCar_mpg.csv',stringsAsFactors = F) # loading mpg dataset
lm(mpg ~ vehicle_length + vehicle_weight + spoiler_angle + ground_clearance + AWD, mpg) # create linear regression
summary(lm(mpg ~ vehicle_length + vehicle_weight + spoiler_angle + ground_clearance + AWD, mpg)) # summarize linear regression
# Creating Visualizations for the Trip Analysis
sus_coils <- read.csv('Suspension_Coil.csv', stringsAsFactors = F) # loading suspension coil dataset
total_summary <- sus_coils %>% summarize(Mean=mean(PSI), Median=median(PSI), Variance=var(PSI), SD=sd(PSI)) # Create a summary for all PSI data
lot_summary <- sus_coils %>% group_by(Manufacturing_Lot) %>% summarize(Mean=mean(PSI), Median=median(PSI), Variance=var(PSI), SD=sd(PSI)) # Create a summary for all PSI data by lot
# T-tests on Suspension Coils
?t.test()
t.test(x=sus_coils$PSI, mu=1500) # t test n all cars' PSI with a mean of 1500
pop1 <- subset(sus_coils, Manufacturing_Lot=='Lot1') # Create subset for lot 1 cars
t.test(x=pop1$PSI, mu=1500) # t test on lot 1 cars' PSI with a mean of 1500
pop2 <- subset(sus_coils, Manufacturing_Lot=='Lot2') # Create subset for lot 2 cars
t.test(x=pop2$PSI, mu=1500) # t test on lot 2 cars' PSI with a mean of 1500
pop3 <- subset(sus_coils, Manufacturing_Lot=='Lot3') # Create subset for lot 3 cars
t.test(x=pop3$PSI, mu=1500) # t test on lot 3 cars' PSI with a mean of 1500
# Comparing MechaCar to the Competition


#!/usr/bin/env Rscript

#### matrix

############################################################
### Arrays
############################################################
z = 1:24
dim(z) = c(3, 4, 2)

## all data
z[,,]
z[1,,]

x = array(1:20, dim = c(4,5))

### 4x6 全填1
X = matrix(1, 4, 6)

rownames(X) = paste("S", seq(1, dim(X)[1]), sep = "")
colnames(X) = paste("V", seq(1, dim(X)[2]), sep = "")

### outer product
a = 1:3
b = 1:5
### 外积的维度是由两个向量共同决定
ab1 = a %o% b
ab2 = outer(a, b, "*")
## ?? ab3 == ab1 == ab2
ab3 = a %*% t(b)

## 真正理解一下outer函数作用
f = function(x, y) x + y
ab4 = outer(a, b, f)

### 1到20, 矩阵以row下标跑的块(列元素是顺序的)
Y = matrix(1:20, 4, 5)
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    1    5    9   13   17
# [2,]    2    6   10   14   18
# [3,]    3    7   11   15   19
# [4,]    4    8   12   16   20

### 方阵才有逆
A = c(c(0,1,4), c(1,0,-3), c(2,3,8))
dim(A) = c(3,3)
B = solve(A)
A %*% B


#===============================================================
# Vector products
# R implementation
#===============================================================

a <- c(3, 4, 5)
b <- c(4, 3, 5)
c <- c(-5, -12, -13)

#---------------------------------------------------------------
# Dot product
#---------------------------------------------------------------

dotp <- function(x, y) {
  if (length(x) == length(y)) {
    sum(x*y)
  }
}

#---------------------------------------------------------------
# Cross product
#---------------------------------------------------------------

crossp <- function(x, y) {
  if (length(x) == 3 && length(y) == 3) {
    c(x[2]*y[3] - x[3]*y[2], x[3]*y[1] - x[1]*y[3], x[1]*y[2] - x[2]*y[1])
  }
}

#---------------------------------------------------------------
# Scalar triple product
#---------------------------------------------------------------

scalartriplep <- function(x, y, z) {
  if (length(x) == 3 && length(y) == 3 && length(z) == 3) {
    dotp(x, crossp(y, z))
  }
}

#---------------------------------------------------------------
# Vector triple product
#---------------------------------------------------------------

vectortriplep <- function(x, y, z) {
  if (length(x) == 3 && length(y) == 3 && length(z) == 3) {
    crosssp(x, crossp(y, z))
  }
}

#---------------------------------------------------------------
# Compute and print
#---------------------------------------------------------------

cat("a . b =", dotp(a, b))
cat("a x b =", crossp(a, b))
cat("a . (b x c) =", scalartriplep(a, b, c))
cat("a x (b x c) =", vectortriplep(a, b, c))


n<-100000

cleanup()
par(mfrow=c(2,1))
meanlog<-3
sdlog<-0.8
m<-rlnorm(n, meanlog = meanlog, sdlog = sdlog)
hist(m,freq=F,breaks=100,main=paste("input mean:",round(exp(meanlog),2),"mean:",round(mean(m),2),"median:",round(median(m),3),
               "\n","exp(mu+0.5sd^2):",round(exp(meanlog+0.5*sdlog^2),2)))
abline(v=mean(m),col="blue",lwd=2)
abline(v=median(m),col="red",lwd=2)

m<-rnorm(n, mean =meanlog, sd = sdlog)
m<-exp(m)

hist(m,freq=F,breaks=100,main=paste("input mean:",round(exp(meanlog),2),"mean:",round(mean(m),2),"median:",round(median(m),3),
               "\n","exp(mu+0.5sd^2):",round(exp(meanlog+0.5*sdlog^2),2)))
abline(v=mean(m),col="blue",lwd=2)
abline(v=median(m),col="red",lwd=2)

# the SMS way with truncated variance
X11()
par(mfrow=c(2,1))
#mind<- -100; maxd<- 100
mind<- -2; maxd<- 2
a<-data.frame(rn=rnorm(n*2, mean = 0, sd = 1))
a<-subset(a,rn> mind & rn<maxd)
noise<-a[1:n,'rn']
hist(noise,freq=F,breaks=100)
m<-exp(meanlog)*exp(sdlog^2*noise)
hist(m,freq=F,breaks=100,main=paste("input mean:",round(exp(meanlog),2),"mean:",round(mean(m),2),"median:",round(median(m),3),
               "\n","exp(mu+0.5sd^2):",round(exp(meanlog+0.5*sdlog^2),2)))
abline(v=mean(m),col="blue",lwd=2)
abline(v=median(m),col="red",lwd=2)

#X11()
#sd<-seq(0,1,0.05)
#plot(sd, sd-sqrt(exp(sd^2) - 1))


#!/usr/bin/Rscript

# Bhishan Poudel
# Jan 8, 2016
# clear; Rscript rmatrix.r; rm *~
# ref: http://www.programiz.com/r-programming/vector
# 5 data types in R : vectors, matrix, list, data frame and a factor
setwd("~/Copy/2016Spring/RProgramming/presentation/dataTypes/")

#########################################################################################################
#   MATRIX CREATION
#########################################################################################################

cat("\nMatrix is a two dimensional data structure in R.")
cat("\nWe can check if a variable is a matrix or not with the class() function.")
cat("\nMatrix is very much similar to vectors but additionally contains the")
cat("\ndimension attribute. All attributes of an object can be checked with the")
cat("\nattributes() function (dimension can be checked directly ")
cat("\nwith the dim() function\n")

cat("\nCreating a Matrix \n")
matrix(1:9, nrow=3, ncol=3)

# same result is obtained by providing only one dimension
#matrix(1:9, nrow=3)
matrix(1:9, nrow=3, byrow=TRUE)    # fill matrix row-wise
x <- matrix(1:9, nrow=3, dimnames=list(c("X","Y","Z"),c("A","B","C")))
x

cat("\nThese names can be accessed or changed with colnames() and rownames().\n")
colnames(x)
rownames(x)
# It is also possible to change names
colnames(x) <- c("C1","C2","C3")
rownames(x) <- c("R1","R2","R3")
x

cat("\nAnother way is using cbind() and rbind()\n")
cbind(c(1,2,3),c(4,5,6))
rbind(c(1,2,3),c(4,5,6))

cat("\ncreate a matrix from a vector by setting its dimension using dim(). \n")
x <- c(1,2,3,4,5,6); x; class(x)

dim(x) <- c(2,3); x; class(x)

#########################################################################################################
#   MATRIX CREATION
#########################################################################################################
cat("\nAccessing Elements in Matrix ")
cat("\nElements can be accessed as var[row, column]\n")
cat("\nUsing integer vector as index\n")
x <- matrix(1:9, nrow=3); x
x[c(1,2),c(2,3)]    # select rows 1 & 2 and columns 2 & 3
x[c(3,2),]    # leaving column field blank will select entire columns
x[,]    # leaving row as well as column field blank will select entire matrix
x[-1,]    # select all rows except first
x[1,]; class(x[1,])

cat("Using logical vector as index\n")
cat("Two logical vectors can be used to index a matrix.\n")
x <- cbind(c(4,6,1),c(8,0,2),c(3,7,9)); x
x[c(TRUE,FALSE)] # indexes recycled T F T F
x[c(TRUE,FALSE,TRUE),c(TRUE,TRUE,FALSE)]
x[c(TRUE,FALSE),c(2,3)]
# TF will be recycled, columns 2 and 3 will be read
cat("extracting matrix elements\n")
x[x>5]    # select elements greater than 5
x[x%%2 == 0]    # select even elements

#example 2
mymat = matrix(1:12,4,3)
mymat = matrix(1:12,ncol=3,byrow=F)
# reading from a data file
m <- matrix(scan('matrix.dat'),nrow=3,byrow=TRUE); m
cat("scanning the numbers from a file\n")
nums = scan('matrix.dat'); nums
######################################
a <- matrix(1:9, nrow = 3)
colnames(a) <- c("A", "B", "C"); a
a[1:2, ]
#>      A B C
#> [1,] 1 4 7
#> [2,] 2 5 8
a[c(T, F, T), c("B", "A")]
# TFT will be recycled, first B will be read then A will be read
#>      B A
#> [1,] 4 1
#> [2,] 6 3
a[0, -2]
#>      A C

#########################################################################################################
#   MATRIX MODIFICATION
#########################################################################################################
cat("\nModifying a Matrix \n")
x <- matrix(1:9, nrow = 3); x
x[2,2] <- 10; x    # modify a single element
x[x<5] <- 0; x    # modify elements less than 5

cat("\ntranspose a matrix \n")
t(x)
cat("\nWe can add row or column using rbind() and cbind() function \n")

cbind(x,c(1,2,3))    # add columns
rbind(x,c(1,2,3))    # add row
x <- x[1:2,]; x    # remove last row

cat("\nDimension of matrix can be modified as well, using the dim() function. \n")
x <- matrix(1:6, nrow = 2); x
dim(x) <- c(3,2); x    # change to 3X2 matrix
dim(x) <- c(1,6); x    # change to 1X6 matrix

cat("\nMatrix Mathematics \n")
x <- matrix(1:9, nrow = 3,byrow=T); x
y <- matrix(1:9, nrow = 3,byrow=T); y
z <- x %*% y; z;
det(x)
rowSums(x)
rowMeans(x)
z1 <- cbind(x,y); z1

# finding xy'  and x'y
cat("\nxy' is outer product and x'y is cross product\n")
a<- x %o% y ; a # xy'
a<- crossprod(x,y); a

cat("\nfinding inverse using solve\n")
A=rbind(c(1, 2), c(3, 4)); A
solve(A)  # inverse of A

# find inverses using solve
A =rbind(c(1:3),c(0,4,5),c(1,0,6))
det(A)
solve(A)* det(A)

# inverse using ginv
cat("\ninverse of A using ginv is \n")
library(	MASS)
ginv(A)*det(A)

#1 2 3     inverse is 1/22 *   24  -12  -2
#0 4 5                         5   3    -5
#1 0 6                         -4  2    4

cat("\n \n")
cat("\n \n")

# THE END
############################################################################################
#Matrix facilites
#In the following examples, A and B are matrices and x and b are a vectors.
#Operator or Function	Description

#A * B	Element-wise multiplication
#A %*% B	Matrix multiplication
#A %o% B	Outer product. AB'

#crossprod(A,B)
#crossprod(A)	A'B and A'A respectively.

#t(A)	Transpose

#diag(x)	Creates diagonal matrix with elements of x in the principal diagonal

#diag(A)	Returns a vector containing the elements of the principal diagonal

#diag(k)	If k is a scalar, this creates a k x k identity matrix. Go figure.

#solve(A, b)	Returns vector x in the equation b = Ax (i.e., A-1b)

#solve(A)	Inverse of A where A is a square matrix.

#ginv(A)	Moore-Penrose Generalized Inverse of A.

#ginv(A) requires loading the MASS package.

#y<-eigen(A)	y$val are the eigenvalues of A

#y$vec are the eigenvectors of A

#y<-svd(A)	Single value decomposition of A.

#y$d = vector containing the singular values of A

#y$u = matrix with columns contain the left singular vectors of A

#y$v = matrix with columns contain the right singular vectors of A

#R <- chol(A)	Choleski factorization of A. Returns the upper triangular factor, such that R'R = A.

#y <- qr(A)	QR decomposition of A.

#y$qr has an upper triangle that contains the decomposition and a lower triangle that contains information on the Q decomposition.

#y$rank is the rank of A.

#y$qraux a vector which contains additional information on Q.

#y$pivot contains information on the pivoting strategy used.

#cbind(A,B,...)	Combine matrices(vectors) horizontally. Returns a matrix.

#rbind(A,B,...)	Combine matrices(vectors) vertically. Returns a matrix.

#rowMeans(A)	Returns vector of row means.

#rowSums(A)	Returns vector of row sums.

#colMeans(A)	Returns vector of column means.

#colSums(A)	Returns vector of column sums.


######################################################################################
# Fitting a univariate state-space model with MARSS and JAGS
# x[1] = mu
# x[t] = x[t-1] + u + w[t], w[t] ~ N(0, q)
# y[t] = x[t] + v[t], v[t] ~ N(0, r)
######################################################################################

# load the needed packages
require(coda)
require(R2jags)
require(MARSS)

# Our univariate data
y = log(graywhales[,2])
n = length(y)

# Fit with MARSS
# MARSS specification for a random walk with drift, observed with error
mod.list = list(
  B=matrix(1), U=matrix("u"), Q=matrix("q"),
  Z=matrix(1), A=matrix(0), R=matrix("r"),
  x0=matrix("mu"), tinitx=1 )

fit.marss = MARSS(y, model=mod.list)

# Fit with JAGS
# jags model specification
jagsscript = cat("
	model {
	# priors on parameters
	# Make sure mu prior is scaled to the data
	mu ~ dnorm(Y1, 1/(Y1*100));
	tau.q ~ dgamma(0.001,0.001); # This is inverse gamma
	sd.q <- 1/sqrt(tau.q); # sd is treated as derived parameter
	tau.r ~ dgamma(0.001,0.001); # This is inverse gamma
	sd.r <- 1/sqrt(tau.r); # sd is treated as derived parameter
	u ~ dnorm(0, 0.01);

	# If X[0] = mu instead of X[1]
	# X[1] ~ dnorm(mu+u, tau.q)
	X[1] <- mu;
	Y[1] ~ dnorm(X[1], tau.r);
	# Jags is not vectorized, so we have to loop over observations
	for(i in 2:N) {
	predX[i] <- X[i-1]+u;
	X[i] ~ dnorm(predX[i],tau.q); # Process variation
	Y[i] ~ dnorm(X[i], tau.r); # Observation variation
		}
	}

",file="ss_model.txt")

# The data (an any other input) we pass to jags
jags.data = list("Y"=y, "N"=n, Y1=y[1])
# The parameters that we are monitoring (must monitor at least 1)
jags.params=c("sd.q","sd.r","X","mu", "u")
model.loc=("ss_model.txt")
mod_ss = jags(jags.data, parameters.to.save=jags.params, model.file=model.loc, n.chains = 3,
              n.burnin=5000, n.thin=1, n.iter=10000, DIC=TRUE)

# Plot the posterior of mu, u, q and r with the MLE ests from MARSS on top
attach.jags(mod_ss)
par(mfrow=c(2,2))
#you need to know that mu is in the x0 val in MARSS
hist(mu)
abline(v=coef(fit.marss)$x0, col="red")
#you need to know that u is in the U val in MARSS
hist(u)
abline(v=coef(fit.marss)$U, col="red")
#you need to know that q is in the Q val in MARSS
#put on log scale
hist(log(sd.q^2))
abline(v=log(coef(fit.marss)$Q), col="red")
#you need to know that r is in the R val in MARSS
#put on log scale
hist(log(sd.r^2))
abline(v=log(coef(fit.marss)$R), col="red")
detach.jags()

# Plotting the estimated states
# We define a function to do this for us from the jags output
plotModelOutput = function(jagsmodel, Y) {
  # attach the model
  attach.jags(jagsmodel)
  x = seq(1,length(Y))
  summaryPredictions = cbind(apply(X,2,quantile,0.025), apply(X,2,mean),
                             apply(X,2,quantile,0.975))
  ylims = c(min(c(Y,summaryPredictions), na.rm=TRUE),max(c(Y,summaryPredictions), na.rm=TRUE))
  plot(Y, col="white",ylim=ylims,
       xlab="",ylab="95% CIs of predictions and data")
  polygon(c(x,rev(x)), c(summaryPredictions[,1], rev(summaryPredictions[,3])),
          col="grey70",border=NA)
  lines(summaryPredictions[,2])
  points(Y)
  detach.jags()
}

par(mfrow=c(1,1))
plotModelOutput(mod_ss, y)
lines(fit.marss$states[1,], col="red")
lines(1.96*fit.marss$states.se[1,]+fit.marss$states[1,], col="red", lty=2)
lines(-1.96*fit.marss$states.se[1,]+fit.marss$states[1,], col="red", lty=2)
title("State estimate and data from\nJAGS (black) versus MARSS (red)")

Lab-fitting-uni-ss-models/Fitting univariate state-space models in JAGS.r


#This scripts will simulate a single sample, and calculate the mean
#The gold background illustrates the 95% prediction interval (PI), The orange background illustrates the 95% confidence interval
#The black dotted line illustrates the true mean. 95% of the CI should contain the true mean
#Then, a simulation is run. The simulations generates a large number of additional samples
#The simulation returns the number of CI that contain the mean, and returns the % of means from future studies that fall within the 95% of the original study
#This is known as the capture percentage. It differs from (and is lower than) the confidence interval

if(!require(ggplot2)){install.packages('ggplot2')}
library(ggplot2)
if(!require(Rcpp)){install.packages('Rcpp')}
library(Rcpp)

# Set seed for random generator
set.seed(1000)

n=20 #set sample size
nSims<-100000 #set number of simulations

x<-rnorm(n = n, mean = 100, sd = 15) #create sample from normal distribution

#95% Confidence Interval
CIU<-mean(x)+qt(0.975, df = n-1)*sd(x)*sqrt(1/n)
CIL<-mean(x)-qt(0.975, df = n-1)*sd(x)*sqrt(1/n)

#95% Prediction Interval
PIU<-mean(x)+qt(0.975, df = n-1)*sd(x)*sqrt(1+1/n)
PIL<-mean(x)-qt(0.975, df = n-1)*sd(x)*sqrt(1+1/n)

#plot data
#png(file="CI_mean.png",width=2000,height=2000, res = 300)
ggplot(as.data.frame(x), aes(x))  +
  geom_rect(aes(xmin=PIL, xmax=PIU, ymin=0, ymax=Inf), fill="gold") + #draw orange CI area
  geom_rect(aes(xmin=CIL, xmax=CIU, ymin=0, ymax=Inf), fill="#E69F00") + #draw orange CI area
  geom_histogram(colour="black", fill="grey", aes(y=..density..), binwidth=2) +
  xlab("IQ") + ylab("number of people")  + ggtitle("Data") + theme_bw(base_size=20) +
  theme(panel.grid.major.x = element_blank(), axis.text.y = element_blank(), panel.grid.minor.x = element_blank()) +
  geom_vline(xintercept=mean(x), colour="black", linetype="dashed", size=1) +
  coord_cartesian(xlim=c(50,150)) + scale_x_continuous(breaks=c(50,60,70,80,90,100,110,120,130,140,150)) +
  annotate("text", x = mean(x), y = 0.02, label = paste("Mean = ",round(mean(x)),"\n","SD = ",round(sd(x)),sep=""), size=6.5)
#dev.off()

#Simulate Confidence Intervals
CIU_sim<-numeric(nSims)
CIL_sim<-numeric(nSims)
mean_sim<-numeric(nSims)

for(i in 1:nSims){ #for each simulated experiment
  x<-rnorm(n = n, mean = 100, sd = 15) #create sample from normal distribution
  CIU_sim[i]<-mean(x)+qt(0.975, df = n-1)*sd(x)*sqrt(1/n)
  CIL_sim[i]<-mean(x)-qt(0.975, df = n-1)*sd(x)*sqrt(1/n)
  mean_sim[i]<-mean(x) #store means of each sample
}

#Save only those simulations where the true value was inside the 95% CI
CIU_sim<-CIU_sim[CIU_sim<100]
CIL_sim<-CIL_sim[CIL_sim>100]

cat((100*(1-(length(CIU_sim)/nSims+length(CIL_sim)/nSims))),"% of the 95% confidence intervals contained the true mean")

#Calculate how many times the observed mean fell within the 95% CI of the original study
mean_sim<-mean_sim[mean_sim>CIL&mean_sim<CIU]
cat("The capture percentage for the plotted study, or the % of values within the observed confidence interval from",CIL,"to",CIU,"is:",100*length(mean_sim)/nSims,"%")

#? Daniel Lakens, 2016.
# This work is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International License. https://creativecommons.org/licenses/by-nc-sa/4.0/


#http://www.r-tutor.com/elementary-statistics/probability-distributions/binomial-distribution

install.packages("plotly")
library(plotly)

# experimento completamente al azar

x <- seq(1, 100, length=100)

fd <- dbinom(x = x, size = 100, prob = 0.5)

plot_ly(x = x , y = fd, type = 'scatter', mode='lines', fill = 'tozeroy')

fp <- pbinom(x , size = 100, prob = 0.5 )
plot_ly(x = x , y = fp, type = 'scatter', mode='lines', fill = 'tozeroy')

# probabilidad  0.07 de 5 obtener por lo menos 1,  P(x >= 1)  = 1 - P(x = 0)
1 - dbinom(0, size = 5, prob = 0.07)

#-------------------------------------------------
# Binomial distribution
# p = probability of a dichotomous outcome
# size = number of trials
# x = possible outcomes

# use "d" binom for density function
MyVec <- dbinom(x=seq(0,10),size=10,prob=0.5)
names(MyVec) <- seq(0,10)
barplot(height=MyVec)

MyVec <- dbinom(x=seq(0,10),size=10,prob=0.95)
names(MyVec) <- seq(0,10)
barplot(height=MyVec)

# use "p" binom for cumulative distribution

# what is probability of getting 5 heads out of 10 tosses?
dbinom(x=5,size=10,prob=0.5)

# what is the probability of getting 5
# or fewer heads out of 10 tosses?
pbinom(q=5,size=10,prob=0.5)
pbinom(q=4,size=9,prob=0.5)

# use "q" binom for quantiles

# what minimum number of heads will be found
# for 40% of 50 trials with p = 0.5?

qbinom(p=0.4,size=50,prob=0.5)

# what is a 95% confidence interval for 100 trials
# of a coin with p = 0.7 for heads?
qbinom(p=c(0.025,0.975),size=100,prob=0.7)


moderate=c(15,32,18,5)
mildly=c(8,29,23,18)
severe=c(1,20,25,22)
all_ages=c(sum(moderate),sum(mildly),sum(severe))
all_servetiles=c(24,81,66,45)
grand_total=216
# For row 1,the estimated expected number of occurrences
E11=(sum(moderate)*all_servetiles[1])/grand_total
print(E11)
E12=(sum(moderate)*all_servetiles[2])/grand_total
print(E12)
E13=(sum(moderate)*all_servetiles[3])/grand_total
print(E13)
E14=(sum(moderate)*all_servetiles[4])/grand_total
print(E14)

# For row 2,the estimated expected number of occurrences
E21=(sum(mildly)*all_servetiles[1])/grand_total
print(E21)
E22=(sum(mildly)*all_servetiles[2])/grand_total
print(E22)
E23=(sum(mildly)*all_servetiles[3])/grand_total
print(E23)
E24=(sum(mildly)*all_servetiles[4])/grand_total
print(E24)

# For row 3,the estimated expected number of occurrences
E31=(sum(severe)*all_servetiles[1])/grand_total
print(E31)
E32=(sum(severe)*all_servetiles[2])/grand_total
print(E32)
E33=(sum(severe)*all_servetiles[3])/grand_total
print(E33)
E34=(sum(severe)*all_servetiles[4])/grand_total
print(E34)

dt=data.frame(cbind(E11,E12,E13,E14),cbind(E21,E22,E23,E24),cbind(E31,E32,E33,E34))
dt


library(stats)
library(dplyr)
library(magrittr)

#1,2
df = read.csv('gia_nha.csv');
new_DF = df %>% select('price', 'sqft_living15', 'floors','condition','sqft_above','sqft_living');
new_DF = new_DF %>% filter(!(is.na(price) | is.na(sqft_living15) | is.na(sqft_living) | is.na(floors) | is.na(condition) | is.na(sqft_above)));
new_DF = new_DF %>% rename('log(price)'=price, 'log(sqft_living15)'=sqft_living15, 'log(sqft_living)'=sqft_living, 'log(sqft_above)'=sqft_above);

#3
#a)
Log = function(x) {log(x)};
new_DF = data.frame(new_DF %>% select('floors','condition'), apply(new_DF %>% select('log(price)', 'log(sqft_living15)','log(sqft_living)','log(sqft_above)'),2,Log));
print(new_DF);
#b)colMeans(new_DF[,c(3:6)]);
table = data.frame(Name = c('mean','median','sd','min','max'),
        log.price.= c(mean(new_DF[,'log.price.']), median(new_DF[,'log.price.']),sd(new_DF[,'log.price.']),min(new_DF[,'log.price.']),max(new_DF[,'log.price.'])),
        log.sqft_living15.= c(mean(new_DF[,'log.sqft_living15.']), median(new_DF[,'log.sqft_living15.']),sd(new_DF[,'log.sqft_living15.']),min(new_DF[,'log.sqft_living15.']),max(new_DF[,'log.sqft_living15.'])),
        log.sqft_living.= c(mean(new_DF[,'log.sqft_living.']), median(new_DF[,'log.sqft_living.']),sd(new_DF[,'log.sqft_living.']),min(new_DF[,'log.sqft_living.']),max(new_DF[,'log.sqft_living.'])),
        log.sqft_above.= c(mean(new_DF[,'log.sqft_above.']), median(new_DF[,'log.sqft_above.']),sd(new_DF[,'log.sqft_above.']),min(new_DF[,'log.sqft_above.']),max(new_DF[,'log.sqft_above.']))
)
#c)
ftable(new_DF[,'floors'])
ftable(new_DF[,'condition'])
#d)
#hist(new_DF[,'log.price.'],freq=FALSE, probability = TRUE)
P = hist(new_DF$log.price, main="Distribution of Prices",
         xlab = "Times", ylab = "Frequency");
plot(P)

#e) Not sure
boxplot(new_DF$log.price. ~ new_DF$floors, ylab = "Prices", xlab = "Prices by floors number")
boxplot(new_DF$log.price. ~ new_DF$condition, ylab = "Prices", xlab = " Prices by conditions")
#pairs(new_DF[,c('floors','log.price.')])
#pairs(new_DF[,c('condition','log.price.')])

#f)
pairs(new_DF[,c('log.sqft_living15.','log.price.')])
pairs(new_DF[,c('log.sqft_living.','log.price.')])
pairs(new_DF[,c('log.sqft_above.','log.price.')])

#4
#a)
lmPrice = lm(log.price.~log.sqft_living15.+log.sqft_living.+log.sqft_above.+floors+condition,new_DF)
summary(lmPrice)
#plot(new_DF)
#abline(lmPrice)

#b)
#Eliminate floors condition sign 0.1 1 (>0.05)

#lmPricy = lm(log.price.~condition,new_DF[,c('log.price.','condition')])
#summary(lmPricy)
#plot(new_DF[,c('condition','log.price.')])
#abline(lmPricy)

#c)
lmPriceC = lm(log.price.~log.sqft_living15.+log.sqft_living.+log.sqft_above.+floors,new_DF)
summary(lmPriceC)

#d)
lmPricy = lm(log.price.~condition,new_DF[,c('log.price.','condition')])
#summary(lmPricy)
anovaD = anova(lmPricy)
anovaD

lmPrici = lm(log.price.~log.sqft_living15.,new_DF[,c('log.price.','log.sqft_living15.')])
#summary(lmPrici)
anovai = anova(lmPrici)
anovai
#Assume price not linearly dependent with condition M2 better

#e)
resi = lmPriceC$residuals
fitted = lmPriceC$fitted.values
plot(fitted, resi)

#5)
#meanX = c(mean(new_DF[,'log.sqft_living15.']), mean(new_DF[,'log.sqft_living.']),mean(new_DF[,'log.sqft_above.']), new_DF$floors=2, new_DF$condition=3)
#maxX = c(max(new_DF[,'log.sqft_living15.']), max(new_DF[,'log.sqft_living.']),max(new_DF[,'log.sqft_above.']))

x1 = data.frame(log.sqft_living15. = mean(new_DF[,'log.sqft_living15.']), log.sqft_living. = mean(new_DF[,'log.sqft_living.']), log.sqft_above. = mean(new_DF[,'log.sqft_above.']), floors = 2, condition = 3)
x2 = data.frame(log.sqft_living15. = max(new_DF[,'log.sqft_living15.']), log.sqft_living. = max(new_DF[,'log.sqft_living.']), log.sqft_above. = max(new_DF[,'log.sqft_above.']), floors = 2, condition = 3)

predict(lmPrice, x1, interval = "confidence")
predict(lmPrice, x2, interval = "confidence")


# Recursion
FibRec <- function(n) {
  if (n<=2)
    return(1)

  return (FibRec(n-1)+FibRec(n-2))
}

StartTime <- Sys.time()
paste("20th Fibonacci number is: ",FibRec(20))
EndTime <- Sys.time()

paste("Computational time using Recursion is: ",EndTime - StartTime)


# Un Antonio Banos
N <- 1

# una urna con 3030 papeletas numeradas
papeletas <- 1:3030

# Simula muchas, muchas asambleas
M <- 100000
asambleas <- data.frame(matrix(0,M,1))
names(asambleas) <- "papeleta"
for (i in 1:M){
  asambleas[i,] <- sample(papeletas, N)
}
hist(asambleas$papeleta, breaks = 100, probability=TRUE,
     xlab="Papeleta ganadora", ylab="probabilidad (sobre 1)",
     main="100000 asambleas de la CUP")

# probabilidad de empate
empates <- sum(asambleas$papeleta==1515)
probabilidad_empate <- empates/M
cat("Probabilidad de empate:", probabilidad_empate*100)

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

# N cupaires
N <- 3030

# con un debate muy ajustado
probabilitat_si <- 0.5
probabilitat_no <- 1 - probabilitat_si

# Simula muchas, muchas asambleas
M <- 100000
asambleas <- data.frame(matrix(0,M,2))
names(asambleas) <- c("sies", "noes")
for (i in 1:M){
  votos <- sample(c("si", "no"), N, replace=TRUE, prob=c(probabilitat_si,probabilitat_no))
  sies <- sum(votos=="si")
  noes <- sum(votos=="no")
  asambleas[i,] <- c(sies, noes)
}
hist(asambleas$sies, breaks = 100)
hist(asambleas$sies, breaks = 100, probability=TRUE,
     xlab="Numero de sies", ylab="probabilidad (sobre 1)",
     main="100000 asambleas de la CUP")

# probabilidad de empate
empates <- sum(asambleas$sies==1515)
probabilidad_empate <- empates/M
cat("Probabilidad de empate:", probabilidad_empate*100)

##################################################################################
# N cupaires
N <- 3030

# 80% ya llegan con el voto decidido.
si_fijos <- 1212 # 3030*0.4
no_fijos <- 1212 # 3030*0.4

indecisos <- N - si_fijos - no_fijos

# con un debate muy ajustado
probabilitat_si <- 0.5
probabilitat_no <- 1 - probabilitat_si

# Simula muchas, muchas asambleas
M <- 100000
asambleas <- data.frame(matrix(0,M,2))
names(asambleas) <- c("sies", "noes")
for (i in 1:M){
  votos <- sample(c("si", "no"), indecisos, replace=TRUE, prob=c(probabilitat_si,probabilitat_no))
  sies <- sum(votos=="si") + si_fijos
  noes <- sum(votos=="no") + no_fijos
  asambleas[i,] <- c(sies, noes)
}
hist(asambleas$sies, breaks = 100)
hist(asambleas$sies, breaks = 100, probability=TRUE,
     xlab="Numero de sies", ylab="probabilidad (sobre 1)",
     main="100000 asambleas de la CUP")

# probabilidad de empate
empates <- sum(asambleas$sies==1515)
probabilidad_empate <- empates/M
cat("Probabilidad de empate:", probabilidad_empate*100)


x<-c(14.2, 5.3 ,2.9, 4.2,1.2, 4.3, 1.1, 2.6 ,6.7 ,7.8 ,25.9, 43.8, 2.7,
     5.6, 7.8 ,3.9, 4.7, 6.5, 29.5 ,2.1 ,34.8 ,3.6 ,5.8, 4.5, 6.7 )
bootmed = apply(matrix(sample(x, rep=TRUE, 10^4*length(x)), nrow=10^4), 1, median)
# The 95% confidence interval for the population median is given by
print("Confidence interval is")
 quantile(bootmed, c(.025, 0.975))


# econ589univariateGarch.r
#
# R examples for lectures on univariate GARCH models
#
# Eric Zivot
# April 2nd, 2012
# update history
# May 14, 2013
#   Changed "compound" to "log" in CalculateReturns()
# April 17, 2013
#   Updated examples for spring 2013 class
# April 19, 2012
#   Added GARCH estimation and forecasting

# load libraries
library(PerformanceAnalytics)
library(quantmod)
library(rugarch)
library(car)
library(FinTS)

options(digits=4)
#

# download data
symbol.vec = c("MSFT", "^GSPC")
getSymbols(symbol.vec, from ="2000-01-03", to = "2012-04-03")
colnames(MSFT)
start(MSFT)
end(MSFT)

# extract adjusted closing prices
MSFT = MSFT[, "MSFT.Adjusted", drop=F]
GSPC = GSPC[, "GSPC.Adjusted", drop=F]

# plot prices
plot(MSFT)
plot(GSPC)

# calculate log-returns for GARCH analysis
MSFT.ret = CalculateReturns(MSFT, method="log")
GSPC.ret = CalculateReturns(GSPC, method="log")

# remove first NA observation
MSFT.ret = MSFT.ret[-1,]
GSPC.ret = GSPC.ret[-1,]
colnames(MSFT.ret) ="MSFT"
colnames(GSPC.ret) = "GSPC"

# create combined data series
MSFT.GSPC.ret = cbind(MSFT.ret,GSPC.ret)

# plot returns
plot(MSFT.ret)
plot(GSPC.ret)

# plot returns with squared and absolute returns
dataToPlot = cbind(MSFT.ret, MSFT.ret^2, abs(MSFT.ret))
colnames(dataToPlot) = c("Returns", "Returns^2", "abs(Returns)")
plot.zoo(dataToPlot, main="MSFT Daily Returns", col="blue")

dataToPlot = cbind(GSPC.ret, GSPC.ret^2, abs(GSPC.ret))
colnames(dataToPlot) = c("Returns", "Returns^2", "abs(Returns)")
plot.zoo(dataToPlot, main="GSPC Daily Returns", col="blue")

# plot autocorrelations of returns, returns^2 and abs(returns)
par(mfrow=c(3,2))
  acf(MSFT.ret, main="MSFT Returns")
  acf(GSPC.ret, main="GSPC Returns")
  acf(MSFT.ret^2, main="MSFT Returns^2")
  acf(GSPC.ret^2, main="GSPC Returns^2")
  acf(abs(MSFT.ret), main="MSFT abs(Returns)")
  acf(abs(GSPC.ret), main="GSPC abs(Returns)")
par(mfrow=c(1,1))

# compute summary statistics
table.Stats(MSFT.GSPC.ret)

#
# simulate ARCH(1) process
#

# use rugarch function ugarchsim
?ugarchspec
?ugarchpath

# specify arch(1) model
arch1.spec = ugarchspec(variance.model = list(garchOrder=c(1,0)),
                        mean.model = list(armaOrder=c(0,0)),
                        fixed.pars=list(mu = 0, omega=0.1, alpha1=0.8))
class(arch1.spec)
arch1.spec

set.seed(123)
arch1.sim = ugarchpath(arch1.spec, n.sim=1000)
# result is an S4 object
class(arch1.sim)
# [1] "uGARCHpath"
# attr(,"package")
# [1] "rugarch"
slotNames(arch1.sim)
# [1] "path"  "model" "seed"
names(arch1.sim@path)
# [1] "sigmaSim"  "seriesSim" "residSim"

# use the plot method to plot simulated series and conditional volatilities
par(mfrow=c(2,1))
plot(arch1.sim, which=2)
plot(arch1.sim, which=1)
par(mfrow=c(1,1))

par(mfrow=c(3,1))
  acf(arch1.sim@path$seriesSim, main="Returns")
  acf(arch1.sim@path$seriesSim^2, main="Returns^2")
  acf(abs(arch1.sim@path$seriesSim), main="abs(Returns)")
par(mfrow=c(1,1))

# use qqPlot() function from car package
qqPlot(arch1.sim@path$seriesSim, ylab="ARCH(1) Returns")

#
# simulate GARCH(1,1) process
#

# specify GARCH(1,1) model
garch11.spec = ugarchspec(variance.model = list(garchOrder=c(1,1)),
                        mean.model = list(armaOrder=c(0,0)),
                        fixed.pars=list(mu = 0, omega=0.1, alpha1=0.1,
                                        beta1 = 0.7))
set.seed(123)
garch11.sim = ugarchpath(garch11.spec, n.sim=1000)

# use the plot method to plot simulated series and conditional volatilities
par(mfrow=c(2,1))
  plot(garch11.sim, which=2)
  plot(garch11.sim, which=1)
par(mfrow=c(1,1))

par(mfrow=c(3,1))
  acf(garch11.sim@path$seriesSim, main="Returns")
  acf(garch11.sim@path$seriesSim^2, main="Returns^2")
  acf(abs(garch11.sim@path$seriesSim), main="abs(Returns)")
par(mfrow=c(1,1))

# use qqPlot() function from car package
qqPlot(garch11.sim@path$seriesSim, ylab="GARCH(1,1) Returns")

#
# Testing for ARCH/GARCH effects in returns
#

# use Box.test from stats package
Box.test(coredata(MSFT.ret^2), type="Ljung-Box", lag = 12)
Box.test(coredata(GSPC.ret^2), type="Ljung-Box", lag = 12)

# use ArchTest() function from FinTS package for Engle's LM test
ArchTest(MSFT.ret)
ArchTest(GSPC.ret)

#
# Estimate GARCH(1,1)
#
# specify GARCH(1,1) model with only constant in mean equation
garch11.spec = ugarchspec(variance.model = list(garchOrder=c(1,1)),
                          mean.model = list(armaOrder=c(0,0)))
MSFT.garch11.fit = ugarchfit(spec=garch11.spec, data=MSFT.ret,
                             solver.control=list(trace = 1))
class(MSFT.garch11.fit)
slotNames(MSFT.garch11.fit)
names(MSFT.garch11.fit@fit)
names(MSFT.garch11.fit@model)

# show garch fit
MSFT.garch11.fit

# use extractor functions

# estimated coefficients
coef(MSFT.garch11.fit)
# unconditional mean in mean equation
uncmean(MSFT.garch11.fit)
# unconditional variance: omega/(alpha1 + beta1)
uncvariance(MSFT.garch11.fit)
# persistence: alpha1 + beta1
persistence(MSFT.garch11.fit)
# half-life:
halflife(MSFT.garch11.fit)

# residuals: e(t)
plot.ts(residuals(MSFT.garch11.fit), ylab="e(t)", col="blue")
abline(h=0)

# sigma(t) = conditional volatility
plot.ts(sigma(MSFT.garch11.fit), ylab="sigma(t)", col="blue")

# illustrate plot method
plot(MSFT.garch11.fit)
plot(MSFT.garch11.fit, which=1)
plot(MSFT.garch11.fit, which="all")
plot(MSFT.garch11.fit, which=9)
#
# simulate from fitted model
#

MSFT.garch11.sim = ugarchsim(MSFT.garch11.fit,
                             n.sim=nrow(MSFT.ret),
                             rseed=123,
                             startMethod="unconditional")
class(MSFT.garch11.sim)
slotNames(MSFT.garch11.sim)

# plot actual returns and simulated returns
par(mfrow=c(2,1))
  plot(MSFT.ret, main="Actual MSFT returns")
  plot(as.xts(MSFT.garch11.sim@simulation$seriesSim,
              order.by=index(MSFT.ret)),
       main="Simulated GARCH(1,1) Returns")
par(mfrow=c(1,1))

#
# fit ARCH(1) using "cleaned data"
#

# convergence problems with ARCH(1) fit to MSFT
arch1.spec = ugarchspec(variance.model = list(garchOrder=c(1,0)),
                        mean.model = list(armaOrder=c(0,0)))
MSFT.arch1.fit = ugarchfit(spec=arch1.spec, data=MSFT.ret,
                           solver.control=list(trace = 1))

MSFT.ret.clean = Return.clean(MSFT.ret, method="boudt")
par(mfrow=c(2,1))
plot(MSFT.ret, main="Raw MSFT Returns", ylab="MSFT")
plot(MSFT.ret.clean, main="Cleaned MSFT Returns", ylab="MSFT")
par(mfrow=c(1,1))

MSFT.clean.arch1.fit = ugarchfit(spec=arch1.spec, data=MSFT.ret.clean,
                                 solver.control=list(trace = 1))
MSFT.clean.arch1.fit

#
# model selection on GARCH(p,q) models
#

arch.order = 1:5
arch.names = paste("arch", arch.order, sep="")

# fit all arch models with p <= 5
arch.list = list()
for (p in arch.order) {
  arch.spec = ugarchspec(variance.model = list(garchOrder=c(p,0)),
                         mean.model = list(armaOrder=c(0,0)))
  arch.fit = ugarchfit(spec=arch.spec, data=MSFT.ret.clean,
                       solver.control=list(trace = 0))
  arch.list[[p]] = arch.fit
}
names(arch.list) = arch.names

# refit GARCH(1,1) to cleaned data
garch11.fit = ugarchfit(spec=garch11.spec, data=MSFT.ret.clean,
                        solver.control=list(trace = 0))
arch.list$garch11 = garch11.fit

# extract information criteria for all models
info.mat = sapply(arch.list, infocriteria)
rownames(info.mat) = rownames(infocriteria(arch.list[[1]]))
info.mat

#
# compare arch(5) to garch(1,1)
#

par(mfrow=c(2,1))
plot.ts(sigma(garch11.fit), main="GARCH(1,1) conditional vol",
        ylab="vol", col="blue")
plot.ts(sigma(arch.list$arch5), main="ARCH(5) conditional vol",
        ylab="vol", col="blue")
par(mfrow=c(1,1))

#
# forecasting
#

MSFT.garch11.fcst = ugarchforecast(MSFT.garch11.fit, n.ahead=100)
class(MSFT.garch11.fcst)
slotNames(MSFT.garch11.fcst)
names(MSFT.garch11.fcst@forecast)

MSFT.garch11.fcst
plot(MSFT.garch11.fcst)

par(mfrow=c(2,1))
  plot(MSFT.garch11.fcst, which=1)
  plot(MSFT.garch11.fcst, which=3)
par(mfrow=c(1,1))

#
# forecast from ARCH(5)
#
MSFT.arch5.fcst = ugarchforecast(arch.list$arch5, n.ahead=100)
plot(MSFT.arch5.fcst)
par(mfrow=c(2,1))
  plot(MSFT.arch5.fcst, which=1)
  plot(MSFT.arch5.fcst, which=3)
par(mfrow=c(1,1))

#
# compute h-day variance forecast = sum of h-day ahead variance forecasts
#

MSFT.fcst.df = as.data.frame(MSFT.garch11.fcst)
head(MSFT.fcst.df)
# h-day return variance forecast = sum of h-day ahead variance forecasts
MSFT.fcst.var.hDay = cumsum(MSFT.fcst.df$sigma^2)
MSFT.fcst.vol.hDay = sqrt(MSFT.fcst.var.hDay)

# plot h-day vol forecasts
fcst.vol.hDay.zoo = zoo(MSFT.fcst.vol.hDay, as.Date(rownames(MSFT.fcst.df)))
chart.TimeSeries(fcst.vol.hDay.zoo, main="GARCH(1,1) Forecast of h-day Return Vol",
                 colorset="blue", ylab="h-day vol forecast")

#
# computing VaR Forecasts
#

# h step-ahead conditional normal GARCH(1,1) VaR
VaR.95.garch11 = MSFT.fcst.df$series[1] + MSFT.fcst.df$sigma[1]*qnorm(0.05)
VaR.95.garch11

# compute 20-day vol forecast from fitted GARCH(1,1)
sigma.20day = sqrt(sum(MSFT.fcst.df$sigma[1:20]^2))
VaR.95.garch11.20day = 20*MSFT.fcst.df$series[1] + sigma.20day*qnorm(0.05)
VaR.95.garch11.20day

?VaRTest
# look at example to see how to implement test
plot(MSFT.garch11.fit, which="2")

#
# bootstrap forecast densities
#

MSFT.garch11.boot = ugarchboot(MSFT.garch11.fit, method="Partial",
                               n.ahead=100, n.bootpred=2000)
class(MSFT.garch11.boot)
MSFT.garch11.boot
plot(MSFT.garch11.boot)
#
# rolling estimation of GARCH(1,1)
#

MSFT.garch11.roll = ugarchroll(garch11.spec, MSFT.ret, n.ahead=1,
                               forecast.length = 1000,
                               refit.every=20, refit.window="moving")
class(MSFT.garch11.roll)

plot(MSFT.garch11.roll)
# VaR plot
plot(MSFT.garch11.roll, which=4)
# Coef plot`
plot(MSFT.garch11.roll, which=5)
# show backtesting report
?report
report(MSFT.garch11.roll, type="VaR")
report(MSFT.garch11.roll, type="fpm")


# Imitate Wiener process on [0;1]

library(ggplot2)

Wiener <- function(length, sigma = 1)
{
  # according to definition
  initValue <- 0
  # sd = sigma / length, as (t-s) = const
  return(c(initValue, cumsum(rnorm(n = (length-1), mean = 0, sd = sigma / length))))
}

Timeline <- seq(from = 0, to = 1, by = 0.001)
N <- Wiener(length(Timeline))

ggplot() + geom_path(aes(x = Timeline, y = N)) + ggtitle("Wiener process") + xlab('t') + ylab('N(t)')


#
# 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 02
#
#

rm(list = ls())

library(ggplot2)
library(ca)
#
# 1) Importar los datos a R desde el fichero salud by edad.csv
#

N <- data.matrix(read.csv(
  './../../../datasets/salud-by-edad.csv',
  header=TRUE,
  row.names = 1))
print(N)

F <- N / sum(N)
print(F)

D_r <- diag(rowSums(N) / sum(N))
D_c <- diag(colSums(N) / sum(N))

print(D_r)
print(D_c)

P_r <- solve(D_r) %*% F
P_c <- solve(D_c) %*% t(F)

print(P_r)
print(P_c)

#
# 2) Revisar el test chi-cuadrado, su interpretación, las tablas que llevan a
#   la generación de sus valores y los perfiles fila y columna
#

chi_value <- sum(
  (N - (rowSums(N) %*% t(colSums(N))) / sum(N)) ^ 2 /
  ((rowSums(N) %*% t(colSums(N))) / sum(N))
)
print(chi_value)

pval <- pchisq(chi_value,
  df = (dim(N)[1] - 1) * (dim(N)[2] - 2), lower.tail=FALSE)
print(pval)

#
# 3) Tomar decisiones sobre el número de componentes a extraer basadas en los
#   autovalores. ¿Cuántos autovalores hay en este análisis?
#

X <- t(F) %*% solve(D_r) %*% F %*% solve(D_c)

X_eigen <- eigen(X)
X_eigenval <- X_eigen$values
X_eigenvec_1 <- X_eigen$vectors

X_eigenvec_norm <- diag(t(X_eigenvec_1) %*% solve(D_c) %*% X_eigenvec_1)

X_eigenvec <- t(t(X_eigenvec_1) / sqrt(X_eigenvec_norm))

print(X_eigenval)
print(X_eigenvec)

fact <- solve(D_c) %*% X_eigenvec

Proyec_r <- P_r %*% fact
Proyec_c <- t(sqrt(X_eigenval) * t(fact))

DF = as.data.frame(rbind(Proyec_r, Proyec_c))

ggplot(data=DF, aes(x=V2, y=V3)) +
  geom_point() +
  geom_text(label=c(rownames(N),colnames(N)))

#
# 4) Inspeccionar las tablas de coordenadas de filas y columnas. ¿Dónde aparece
#   la calidad de la representación de los puntos sobre el plano definido por
#   los dos primeros factores? ¿Cuánto vale esa calidad para la observación
#   correspondiente a los individuos entre 45 y 54 años?
#

summary(ca(N))

#
# 5) Buscar posibles puntos de influencia en alguno de los dos primeros
#   factores. Rehacer el análisis si es necesario e interpretar el primer
#   plano factorial
#

N[-4,]

summary(ca(N[-4,]))

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

plot(ca(N[-4,]))

#
# 7) ¿Puede decirse, a la vista del gráfico, que entre los individuos entre 16
#   y 24 años predomina la percepción de salud propia como MB? ¿Puede decirse,
#   a la vista del gráfico, que entre los de percepción de salud M predominan
#   los individuos de 75 o más años? Revisar los perfiles fila y perfiles
#   columna.
#

P_r
P_c


setwd("*path of the working directory*")

mydata <- read.csv("*path and name of the csv file for import*")

attach(mydata)

names(mydata)

head(mydata)

#--------------------------------1)APPLICATION-----------------------------------

# 1) Applied by Attended
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0) #converting 'Yes' or 'No' from the 'APPLIED' column in my original dataset into '1' and '0', and storing these values in a newly created R vector named 'applied'
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes", 1,0)
linreg = lm(applied ~ attended, data = mydata) #performing linear regression to model relationship between attending the webinar(independent variable) and applying for the grant(dependent variable)
summary(linreg)

# 1)b) Applied by Attended, controlling for region
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = lm(applied ~ attended + DEVELOPMENT.REGION, data = mydata) #note that one of the regions will be omitted from the resulting table as this is the reference region
summary(linreg)

# 1)c) Applied by Attended, controlling for region + category + amount requested
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
#testing 'logit' regression below as this might fit our data better since our dependent variable 'applied' is binary. see: https://towardsdatascience.com/logistic-regression-for-dummies-a-detailed-explanation-9597f76edf46
linreg = glm(applied ~ attended + DEVELOPMENT.REGION, + CATEGORY + REQUESTED.AMOUNT, family=binomial(link='logit'),data = mydata)
summary(linreg)

#-------------------------------2)SUCCESSFUL APPLICATION-------------------------

# 2) Success by Attended
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = lm(success ~ attended, data = subset(mydata,applied==1)) #subsetting because only those who applied are relevant here
summary(linreg)

# 2)b) Success by Attended, controlling for pass/fail
#This should get rid of the effect of missed documents(which determines pass/fail) on the success
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = lm(success ~ attended + PASS.FAIL, data = subset(mydata,applied==1))
summary(linreg)

# 2)c) Success by Attended, controlling for category
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = lm(success ~ attended + CATEGORY, data = subset(mydata,applied==1))
summary(linreg)

# 2) d) Success by Attended, controlling for region
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = lm(success ~ attended + DEVELOPMENT.REGION, data = subset(mydata,applied==1))
summary(linreg)

# 2) e) Success by Attended, controlling for region + category
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = lm(success ~ attended + DEVELOPMENT.REGION + CATEGORY, data = subset(mydata,applied==1))
summary(linreg)

# 2) f) Success by Attended, controlling for region + category + amount requested
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = lm(success ~ attended + DEVELOPMENT.REGION + CATEGORY + REQUESTED.AMOUNT, data = subset(mydata,applied==1))
summary(linreg)

#*******************Testing LOGIT on each of the above****************

# 2) Success by Attended
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = glm(success ~ attended, family=binomial(link='logit'), data = subset(mydata,applied==1))
summary(linreg)

# 2)b) Success by Attended, controlling for pass/fail
#This should get rid of the effect of missed documents on the success, but
#why does fail not have a negative coefficient?
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = glm(success ~ attended + PASS.FAIL, family=binomial(link='logit'), data = subset(mydata,applied==1))
summary(linreg)

# 2)c) Success by Attended, controlling for category
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = glm(success ~ attended + CATEGORY, family=binomial(link='logit'), data = subset(mydata,applied==1))
summary(linreg)

# 2) d) Success by Attended, controlling for region
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = glm(success ~ attended + DEVELOPMENT.REGION, family=binomial(link='logit'), data = subset(mydata,applied==1))
summary(linreg)

# 2) e) Success by Attended, controlling for region + category
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = glm(success ~ attended + DEVELOPMENT.REGION + CATEGORY, family=binomial(link='logit'), data = subset(mydata,applied==1))
summary(linreg)

# 2) f) Success by Attended, controlling for region + category + amount requested
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = glm(success ~ attended + DEVELOPMENT.REGION + CATEGORY + REQUESTED.AMOUNT, family=binomial(link='logit'), data = subset(mydata,applied==1))
summary(linreg)

# 2) g) Success by Attended, controlling for region + category + amount requested (with URBAN)
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
#adding an interaction variable below (attended*URBAN) to see impact of being from an urban region AND attending
linreg = glm(success ~ attended + URBAN + attended*URBAN + DEVELOPMENT.REGION + CATEGORY + REQUESTED.AMOUNT, family=binomial(link='logit'), data = subset(mydata,applied==1))
summary(linreg)

#-------------------------------------3)SCORE--------------------------------------

# 3) Score by Attended
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = lm(SCORE ~ attended, data = subset(mydata,applied==1)) #subsetting because only those who applied are relevant here
summary(linreg)

# 3)b) Score by Attended, controlling for amount requested
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = lm(SCORE ~ attended + REQUESTED.AMOUNT, data = subset(mydata,applied==1))
summary(linreg)

# 3)c) Score by Attended, controlling for amount requested + region + category
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = lm(SCORE ~ attended + DEVELOPMENT.REGION + CATEGORY + REQUESTED.AMOUNT, data = subset(mydata,applied==1))
summary(linreg)

#--------------------------------------4)PASS/FAIL---------------------------------

# 4) Pass/Fail by Attended
mydata$passfail = ifelse(mydata$PASS.FAIL == "PASS", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = lm(passfail ~ attended, data = subset(mydata,applied==1))
summary(linreg)

#---------------------------------------5)MISC--------------------------------------

# 5)Success by Score
mydata$success = ifelse(mydata$SUCCESS == "Yes", 1,0)
mydata$applied = ifelse(mydata$APPLIED == "Yes", 1,0)
mydata$attended = ifelse(mydata$ATTENDED.WEBINAR == "Yes",1,0)
linreg = lm(success ~ SCORE, data = subset(mydata,applied==1))
summary(linreg)


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

rm(list = ls())

x.f <- c(5, 7, 16, 12)
y.f <- c(7, 9, 15, 9)

x <- rep(1:length(x.f), x.f)

(n.x <- length(x))
# 40

y <- rep(1:length(y.f), y.f)

(n.y <- length(y))
# 40

(n <- n.x + n.y)
# 80

(W.y <- sum(rank(c(y, x))[1:n.y]))
# 1520

(W.yx <- W.y - n.y * (n.y + 1) / 2)
# 700

(W.yx.mean <- n.y * n.x / 2)
# 800

(W.yx.var <- n.y * n.x * (n + 1) / 12)
# 10800

## Asymptotic pvalue (with continuity correction, without tie correction)
1 - pnorm(W.yx - 0.5, mean = W.yx.mean, sd = sqrt(W.yx.var))
# 0.830827188754516

## Asymptotic pvalue (with continuity correction, with tie correction)
# W.xy.var.corrected <- TODO
#
# 1 - pnorm(W.yx + 0.5, mean = W.yx.mean, sd = sqrt(W.xy.var.corrected))
#

## Exact pvalue (not valid with ties)
1 - pwilcox(W.yx - 1, n.y, n.x)
# 0.832293774410869

wilcox.test(y, x, alternative = "greater", exact = FALSE)
# Wilcoxon rank sum test with continuity correction
#
# data:  y and x
# W = 700, p-value = 0.8443
# alternative hypothesis: true location shift is greater than 0

## We can't reject H0, so we assume that treatment is less or equal than
## control cases. pvalues are different due to ties correction.


x = c(46000, 45000, 35000, 32000, 42000, 36000, 41000, 56000, 73000, 53000)
y = c(34000, 27000, 30000, 26000, 30000, 28000, 34000, 34000, 43000, 36000)

n = length(x)

num = sum(x * y) - sum(x) * sum(y) / n
den = sum(x * x) - sum(x) * sum(x) / n

B1 = num / den
B0 = (sum(y) - (B1 * sum(x))) / n

#png('disp_diagram.png')
plot(x, y)

#png('line_diagram.png')
plot(x, y)
abline(B0, B1)

#dev.off()

B0
B1

print('Pendiente: ')
print(B1)

print('Estime el costo de un vehículo “semejante” comparable a uno de lujo de $60 000.')
print(B1 * 60000 + B0)

print('Estime el costo de un vehículo “semejante” comparable a uno de lujo de $40 000')
print(B1 * 40000 + B0)


# 1. Simulate phi_i from Beta(2,2)
# 2. Simulate y_i from Binom(10, phi_i)

m = 1e5

y = numeric(m)
phi = numeric(m)

#avoid using loops if possible
for (i in 1:m){
    phi[i] = rbeta(1, shape1=2.0, shape2=2.0)
    y[i] = rbinom(1, size=10, prob=phi[i])
}

#conditional on phi, y follows a binomial dist
phi = rbeta(m, shape1=2.0, shape2=2.0)
y = rbinom(m, size=10, prob=phi)

table(y) / m
#approximation of marginal distribution of y = beta binomial
plot(table(y)/m)

#estimation of the expectation
mean(y)


## 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.

t5.sd <- sqrt(5/3) # scaling factor to standardize t_5 distribution
desired.sd <- 0.02
scale.true <- desired.sd/t5.sd # scaling factor to get the desired sd

# left.frac of the random numbers will come from the left distribution
# the rest will come from the right distribution
left.frac <- 3/5
n.obs <- 50
x.obs <- c(rt(n.obs*left.frac, df=5)*scale.true-0.05,
           rt(n.obs*(1-left.frac), df=5)*scale.true+0.05)

# create values of the true density
x <- seq(-0.15, 0.15, by=0.001)
true.density <- left.frac*dt((x+0.05)/scale.true,df=5)/scale.true +
    (1-left.frac)*dt((x-0.05)/scale.true, df=5)/scale.true
y.max = max(true.density)

# plot the kernel density estimator; then add the true density
plot(density(x.obs, kernel="gaussian", bw="SJ"), main="",
     xlim=c(-0.15,0.15), ylim=c(0,y.max), lwd=2, col="red")
lines(x, true.density, lty=2, lwd=2)
rug(x.obs)  # show the observations as ticks at plot bottom


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

rm(list = ls())

x1 <- c(26, 28, 34, 48, 21, 22, 34)
x2 <- c(28, 27, 42, 44, 17, 6, 16)

(s <- (x1 - x2)[x1 != x2])
# -2 1 -8 4 4 16 18

(n <- length(s))
# 7

(V <- sum((s > 0) * rank(abs(s))))
# 21

(V.mean <- n * (n + 1) / 4)
# 14

(V.var <- n * (n + 1) * (2 * n + 1) / 24)
# 35

## Asymptotic pvalue (with continuity correction, without tie correction)
pnorm(V + 0.5, mean = V.mean, sd = sqrt(V.var))
# 0.897553053091811

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

(ties <- table(abs(s)))
#  1  2  4  8 16 18
#  1  1  2  1  1  1

(V.var.corrected <- V.var - sum(ties ^ 3 - ties) / 48)
# 34.875

pnorm((V + 0.5 - V.mean) / sqrt(V.var.corrected))
# 0.897957911117213

## Exact pvalue (not valid with ties)
psignrank(V, n)
# 0.890625

wilcox.test(x1, x2, paired = TRUE, alternative = "less", exact = FALSE)
# Wilcoxon signed rank test with continuity correction
#
# data:  x1 and x2
# V = 21, p-value = 0.898
# alternative hypothesis: true location shift is less than 0


require(lmtest)
#Set absolute path to file
data <- read.csv(".files/Advertising.csv")

data$X <- NULL

png('images/images/cor.png')
pairs(data)
dev.off()

print(cor(data))

model.fitRTN <- lm(data$sales ~  data$radio + data$TV + data$newspaper, data=data)
model.fitTN <- lm(data$sales ~   data$TV + data$newspaper, data=data)
model.fitRN <- lm(data$sales ~  data$radio + data$newspaper, data=data)
model.fitRT <- lm(data$sales ~  data$radio + data$TV, data=data)

print('Radio + TV + Newspaper')

print(summary(model.fitRTN))

print('Media de error residual')
print(mean(model.fit$residuals))

print('Suma de error residual')
print(sum(model.fit$residuals))

png('images/images/plotsRTN.png', width=800, height=400)
par(mfrow=c(1,2))

hist(model.fitRTN$residuals, xlab='Residuals', main='Radio + TV + Newspaper')
qqnorm(model.fitRTN$residuals)
qqline(model.fitRTN$residuals)

dev.off()

print(dwtest(model.fitRTN))

pred = predict(model.fitRTN, data=data.frame(
  tv=data$TV,
  radio=data$radio,
  newspaper=data$newspaper
))

png('images/homoRTN.png')
plot(pred, residuals(model.fitRTN), xlab='Predictions', ylab='Residuals of model')
abline(h=0, lty=2)
dev.off()

print('TV + Newspaper')

print(summary(model.fitTN))

print('Media de error residual')
print(mean(model.fitTN$residuals))

print('Suma de error residual')
print(sum(model.fitTN$residuals))

png('images/plotsTN.png', width=800, height=400)
par(mfrow=c(1,2))

hist(model.fitTN$residuals, xlab='Residuals', main='TV + Newspaper')
qqnorm(model.fitTN$residuals)
qqline(model.fitTN$residuals)

dev.off()

print(dwtest(model.fitTN))

pred = predict(model.fitTN, data=data.frame(
  tv=data$TV,
  radio=data$radio,
  newspaper=data$newspaper
))

png('images/homoTN.png')
plot(pred, residuals(model.fitTN), xlab='Predictions', ylab='Residuals of model')
abline(h=0, lty=2)
dev.off()

print('Radio + TV')

print(summary(model.fitRT))

print('Media de error residual')
print(mean(model.fitRT$residuals))

print('Suma de error residual')
print(sum(model.fitRT$residuals))

png('images/plotsRT.png', width=800, height=400)
par(mfrow=c(1,2))

hist(model.fitRT$residuals, xlab='Residuals', main='Radio + TV')
qqnorm(model.fitRT$residuals)
qqline(model.fitRT$residuals)

dev.off()

print(dwtest(model.fitRT))

pred = predict(model.fitRT, data=data.frame(
  tv=data$TV,
  radio=data$radio,
  newspaper=data$newspaper
))

png('images/homoRT.png')
plot(pred, residuals(model.fitRT), xlab='Predictions', ylab='Residuals of model')
abline(h=0, lty=2)
dev.off()

print('Radio + Newspaper')

print(summary(model.fitRN))

print('Media de error residual')
print(mean(model.fitRN$residuals))

print('Suma de error residual')
print(sum(model.fitRN$residuals))

png('images/plotsRN.png', width=800, height=400)
par(mfrow=c(1,2))

hist(model.fitRN$residuals, xlab='Residuals', main='Radio + Newspaper')
qqnorm(model.fitRN$residuals)
qqline(model.fitRN$residuals)

dev.off()

print(dwtest(model.fitRN))

pred = predict(model.fitRN, data=data.frame(
  tv=data$TV,
  radio=data$radio,
  newspaper=data$newspaper
))

png('images/homoRN.png')
plot(pred, residuals(model.fitRN), xlab='Predictions', ylab='Residuals of model')
abline(h=0, lty=2)
dev.off()


#
# Don't complain; just work harder! Dan Stanford
#
# Our responsibility is to do what we can, learn what we can, improve the solutions, and pass them on. RF
#
# @author: me@andreagirardi.it
# @since: Wed Jan  8 19:11:27 CET 2020
# @project: RExercises
# @module: Matrix lesson
# @desc:
#
#
# Exercises

A <- c(1, 2, 3)
B <- c(4, 5, 6)

> m <- rbind(A, B)
> m
  [,1] [,2] [,3]
A    1    2    3
B    4    5    6

> n <- cbind(A, B)
> n
     A B
[1,] 1 4
[2,] 2 5
[3,] 3 6

> j <- matrix(1:9, byrow = T,  nrow = 3)
> j
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    4    5    6
[3,]    7    8    9

> j <- matrix(1:9, byrow = F, nrow = 3)
> j
     [,1] [,2] [,3]
[1,]    1    4    7
[2,]    2    5    8
[3,]    3    6    9

> is.matrix(j)
[1] TRUE

> l <- matrix(1:25, by-km row = T, nrow = 5)
> l
     [,1] [,2] [,3] [,4] [,5]
[1,]    1    2    3    4    5
[2,]    6    7    8    9   10
[3,]   11   12   13   14   15
[4,]   16   17   18   19   20
[5,]   21   22   23   24   25

# From row 2 to 3, from colum 2 to 3
> z <- l[2:3, 2:3]
> z
     [,1] [,2]
[1,]    7    8
[2,]   12   13

# Sum of all elements
> sum(l)
[1] 325


aVar=0

integrate.rect <- function(f, a, b, n, k=0) {
  #k = 0 for left, 1 for right, 0.5 for midpoint
  h <- (b-a)/n
  x <- seq(a, b, len=n+1)
  sum(f(x[-1]-h*(1-k)))*h
}

integrate.trapezoid <- function(f, a, b, n) {
  h <- (b-a)/n
  x <- seq(a, b, len=n+1)
  fx <- f(x)
  sum(fx[-1] + fx[-length(x)])*h/2
}

integrate.simpsons <- function(f, a, b, n) {
  h <- (b-a)/n
  x <- seq(a, b, len=n+1)
  fx <- f(x)
  sum(fx[-length(x)] + 4*f(x[-1]-h/2) + fx[-1]) * h/6
}

f1 <- (function(x) {(x^3)+aVar})
f2 <- (function(x) {1/(x+aVar)})
f3 <- (function(x) {x+aVar})
f4 <- (function(x) {x+aVar})

executeTask <- function(i) {

  integrate.rect(f1,0,1,100,0) #TopLeft 0.245025
  integrate.rect(f1,0,1,100,0.5) #Mid 0.2499875
  integrate.rect(f1,0,1,100,1) #TopRight 0.255025
  integrate.trapezoid(f1,0,1,100) # 0.250025
  integrate.simpsons(f1,0,1,100) #0.25

  integrate.rect(f2,1,100,1000,0) #TopLeft 0.245025
  integrate.rect(f2,1,100,1000,0.5) #Mid 0.2499875
  integrate.rect(f2,1,100,1000,1) #TopRight 0.255025
  integrate.trapezoid(f2,1,100,1000) # 0.250025
  integrate.simpsons(f2,1,100,1000) #0.25

  integrate.rect(f3,0,5000,5000000,0) #TopLeft 0.245025
  integrate.rect(f3,0,5000,5000000,0.5) #Mid 0.2499875
  integrate.rect(f3,0,5000,5000000,1) #TopRight 0.255025
  integrate.trapezoid(f3,0,5000,5000000) # 0.250025
  integrate.simpsons(f3,0,5000,5000000) #0.25

  integrate.rect(f3,0,6000,6000000,0) #TopLeft 0.245025
  integrate.rect(f3,0,6000,6000000,0.5) #Mid 0.2499875
  integrate.rect(f3,0,6000,6000000,1) #TopRight 0.255025
  integrate.trapezoid(f3,0,6000,6000000) # 0.250025
  integrate.simpsons(f3,0,6000,6000000) #0.25
	return(i+1)
}

r=1

for (aVar in 0:100) {
	r = executeTask(aVar)
}


#' Check whether partitions of the figuration matrix are unimodular
#'
#' Check whether partitions of the figuration matrix are unimodular. For partitions A=[A1 A2], the function um_partition computes the determinants of A1 for all possible (unique) combinations of rows. Function um_partition_sample coputes determinants of A1 for a sample of those partitions.
#' @param A Configuration matrix with ncol(A) >= nrow(A)
#' @return A list comprising a table of determinants and the number of rows (n) and columns (r) of the matrix A
#' @export
#' @examples
#' data(YangNetwork)
#' set.seed(2020)
#' um_partition_sample(YangNetwork$A)

um_partition <- function(A){
	require(gtools)
	n <- qr(t(A))$rank
	A <- t( t(A)[,qr(t(A))$pivot[1:n]] )
	r <- ncol(A)
	combs <- combinations(r,n,1:r)
	dets <- numeric(nrow(combs))
	for (i in 1:nrow(combs)){
		if (i/100000 == round(i/100000)) cat(i,"\n")
		dets[i] <- det(A[,combs[i,1:n]])
	}
	list(dets=table(dets),r=r,n=n)
}

um_partition_sample <- function(A,nsample=1e6){
	r <- ncol(A)
	n <- nrow(A)
	dets <- numeric(nsample)
	for (i in 1:nsample){
		sample.rows <- sample(1:r,n,replace=F)
		dets[i] <- det(A[,sample.rows])
	}
	list(dets=table(dets),r=r,n=n)
}