# ------------------------------------------Questão01----------------------------------------------------
# 01) Utilize uma Distribuição Uniforme para criar uma base de dados aleatória.
# A base deve ser composta por 50 elementos entre os valores 6 e 18.
# Em seguida, calcule o que se pede.

database <- seq(from = 6, to = 18, by = 0.244)
length(database)
database

mean(database) # Média
var(database) # Variância
sd(database) # Desvio padrão
median(database) # Mediana
quantile(database) # Quartis
100*sd(database)/mean(database) # Coeficiente de variação

# ------------------------------------------Questão02--------------------------------------------------------------
# 02) Realize o download da base de dados localizada no link http://archive.ics.uci.edu/ml/datasets/Wine+Quality.
# Dois arquivos devem ser baixados, o que avalia a qualidade dos vinhos tintose outro sobre a qualidade dos vinhos
# brancos (winequality-red.csve winequality-white.csvrespectivamente). Faça o que se pedepara ambas basesde dados.

wine_red <- read.csv("../datasets/winequality-red.csv", sep = ";")
wine_white <- read.csv("../datasets/winequality-white.csv", sep = ";")

head(wine_red, n = 10)

head(wine_white)

# a) Obtenha os parâmetros estatísticos com a função summary.

summary(wine_red)

summary(wine_white)

# b) Plote umgráfico de pontos dos parâmetros de qualidade por pH.

plot(wine_red[,12],wine_red[,9],type="p", main = "Vinho vermelho", xlab = "Qualidade", ylab = "pH", col="blue")

plot(wine_white[,12],wine_white[,9],type="p", main = "Vinho branco", xlab = "Qualidade", ylab = "pH", col="green")

# c) Plote gráficos de barras para os parâmetros pH, qualidade e álcool.

wine_red_aux <- data.frame(pH=wine_red[,9], qualidade=wine_red[,12], alcool=wine_red[,11])
barplot(colSums(wine_red_aux), main = "Vinho vermelho")

wine_white_aux <- data.frame(pH=wine_white[,9], qualidade=wine_white[,12], alcool=wine_white[,11])
barplot(colSums(wine_white_aux), main = "Vinho branco")

# d) Plote histogramas para os parâmetros açúcar residual e volatilidade ácida com 10 intervalos.

hist(wine_red[,2], main = "Vinho vermelho", xlab = "Volatilidade acida")

hist(wine_red[,4], main = "Vinho vermelho", xlab = "Açúcar residual")

hist(wine_white[,2], main = "Vinho branco", xlab = "Volatilidade acida")

hist(wine_white[,4], main = "Vinho branco", xlab = "Açucar residual")

library("ISwR")

# e) Calcule a correlação entre os parâmetros qualidade e pH;densidade e álcool;
# açúcar residual e qualidade. Interprete cada resultado com um breve comentário.

print("Vinho vermelho --BEGIN--")
# qualidade e pH
cor(wine_red[,12], wine_red[,9])
cor.test(wine_red[,12], wine_red[,9])

# densidade e álcool
cor(wine_red[,8], wine_red[,11])
cor.test(wine_red[,8], wine_red[,11])

# açúcar residual e qualidade
cor(wine_red[,4], wine_red[,12])
cor.test(wine_red[,4], wine_red[,12])

print("Vinho vermelho --END--")

print("Vinho branco --BEGIN--")
# qualidade e pH
cor(wine_white[,12], wine_white[,9])
cor.test(wine_white[,12], wine_white[,9])

# densidade e álcool
cor(wine_white[,8], wine_white[,11])
cor.test(wine_white[,8], wine_white[,11])

# açúcar residual e qualidade
cor(wine_white[,4], wine_white[,12])
cor.test(wine_white[,4], wine_white[,12])

print("Vinho branco --END--")

# ------------------------------------------Questão03--------------------------------------------------------------
# 03)Implemente uma função em R que calcule a moda de vetoresde dados criados pelo usuário. Cada vetor deve conter 15 elementos,
# contendo apenas números inteiros positivos e/ou negativos. Crie três vetores para simulação, sendo um amodal,
# um modal e um bimodal para teste do seu programa.

# Função que calcula a moda
calc_moda <- function(vec){
 if(length(vec) != 15){
     print("Vetor inválido! O vetor deve conter 15 elementos.")
     return(FALSE)
 }

 if(typeof(vec[0]) == 'character'){
     print("Vetor inválido! O vetor deve conter apenas inteiros.")
     return(FALSE)
 }

 z <- table(as.vector(vec))
 names(z)[z == max(z)]

 return(z)
}

# Vetores de exemplo
amodal<-c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
modal<-c(1,1,3,4,5,6,7,8,9,10,11,12,13,14,15)
bimodal<-c(1,1,3,3,5,6,7,8,9,10,11,12,13,14,15)

calc_moda(amodal)
calc_moda(modal)
calc_moda(bimodal)

# ------------------------------------------Questão04--------------------------------------------------------------
# A tabela a seguir apresenta a quantidade de itens vendidos em um restaurante por um período
# de tempo. Devido às rasuras alguns dados estão faltantes. Importe os dados no formato XLSX
# para o RStudio®. Calcule média, mediana, variância e desvio padrão da Variável Quantidade.
# Obs.: ao criar a planilha no editor utilize apenas DUAS colunas para inserir os dados.

# PS está em CSV pq nao consegui instalar a LIB de xls do R 3.4

df <- data.frame(read.csv("questao_04.csv", sep = ";"))
head(df)
qtd <- na.omit(df[,2])
qtd

mean(qtd) # Média
var(qtd) # Variância
sd(qtd) # Desvio padrão
median(qtd) # Mediana

# ------------------------------------------Questão05--------------------------------------------------------------
# Calcule as probabilidades dos seguintes eventos. Para cada letra crie o espaço amostral e o
# evento desejado.

# a) Obter três caras no lançamento de 6 vezes de uma moeda justa.

S1 <- tosscoin(6, makespace = TRUE)
head(S1)
E1 <- subset(S1, isrep(S1, vals = "H", nrep = 3))
head(E1)
Prob(E1)

# b) Obter quatro coroas no lançamento de 7 vezes de uma moeda com p_cara = 0.65 e
# p_coroa= 0.35.

S2 <- probspace(tosscoin(7),probs = c(0.65,0.35)) #cara 65% e coroa 35%
head(S2)

E2 <- subset(S2, isrep(S2, vals = "T", nrep = 4))
head(E2)
Prob(E2)

# c) Obter a soma do resultado do lançamento de 4 vezes de um dado com 8 faces maior que
# 22.
S3 <-rolldie(4, nsides = 8, makespace = TRUE)
head(S3)

E3 <- subset(S3, X1+X2+X3+X4 > 22)
head(E3)
Prob(E3) #resultado

# d) Considere uma urna com 04 bolas verdes, 06 bolas azuis, 02 bolas pretas e 03 bolas
# vermelhas. Determine a probabilidade de se retirada a sequencia nesta ordem (preta,
# azul, verde, vermelha e azul) após cinco retiradas sem reposição dessa urna

Balls <- rep(c("verde","azul","preta", "vermelha"),times = c(4,6,2,3))
S4 <- urnsamples(Balls, size = 5, replace = FALSE, ordered = TRUE)
E4 <- probspace(S4)
R4 <- Prob(E4, isin(E4, c("preta","azul","verde","vermelha","azul"), ordered =
TRUE))

R4

# ------------------------------------------Questão06--------------------------------------------------------------
# 06) Para a base de dados beaver1 presente no R faça o que se pede

beav <- beaver1
head(beav)

# a) Plote um gráfico entre as variáveis tempo (eixo X) e temperatura (eixo Y).

plot(beav[,2], beav[,3], type = "b", main = "Beaver1", xlab = "Tempo", ylab = "Temperatura", col=c("red", "blue"))

# b) Faça uma regressão linear considerando Y=f(X)

time<-beav[,2]
temp<-beav[,3]
x1<-time
y1<-temp

beav.lm <- lm(y1 ~ x1, data=beav)
coef1<- coef(beav.lm)
coef1
plot(x1,y1,type="p",xlab = "Tempo", ylab = "Temperatura", col=c("red", "blue"))
abline(coef1)

# c) Com base na regressão preveja o valor da temperatura para o tempo 960 e 1680.

# d) Calcule o vetor de predições

prev1<- fitted(beav.lm)
head(prev1, 10)

# e) Calcule o vetor de resíduos

res1 <- residuals(beav.lm)
head(res1, 10)

# f) Intervalo de confiança para os níveis de 95% e 70%.
conf1 <- confint(beav.lm, level = 0.95) #intervalo de confiança de 95%
conf2 <- confint(beav.lm, level = 0.70) #intervalo de confiança de 70%

conf1 # 95
conf2 # 70

# g) Utilizando a função ci.plot() plote os gráficos dos intervalos junto com os dados.

plot(beav.lm, conf.level = 0.70)

plot(beav.lm, conf.level = 0.95)


### 線形回帰分析(単回帰)の例
### - Brain and Body Weights for 28 Species

## パッケージの読み込み
require(MASS)
require(tidyverse)
require(ggfortify)

## データの読み込み ("MASS::Animals"を用いる)
data(Animals)

## データの内容を確認
help(Animals)  # 内容の詳細を表示
print(Animals) # データの表示

## データのプロット (normal plot)
ggplot(Animals, aes(body, brain, label=rownames(Animals))) +
    geom_point(colour="royalblue") +
    labs(title="Brain and Body Weights (normal plot)",
         x="body [kg]", y="brain [g]")

ggplot(Animals, aes(body, brain)) +
    scale_x_log10() + scale_y_log10() +
    geom_point(colour="royalblue") +
    labs(title="Brain and Body Weights (log-log plot)",
         x="body [kg]", y="brain [g]")

## 回帰分析 (単回帰)
model <- lm(log(brain) ~ log(body), data=Animals)
summary(model) # 分析結果のまとめを表示

## 区間推定
yc <- exp(predict(model, newdata=Animals, interval="confidence"))
colnames(yc) <- paste("c",colnames(yc),sep=".")
yp <- exp(predict(model, newdata=Animals, interval="prediction"))
colnames(yp) <- paste("p",colnames(yp),sep=".")
mydat <- cbind(Animals, yc, yp)

## 回帰式および信頼区間・予測区間の表示
ggplot(mydat, aes(body, brain, label=rownames(mydat))) +
    scale_x_log10() + scale_y_log10() + # log-log plot
    geom_line(aes(y=c.fit), color="dodgerblue", lwd=1.2) +
    geom_ribbon(aes(ymin=c.lwr,ymax=c.upr), fill="blue", alpha=0.2)+
    geom_ribbon(aes(ymin=p.lwr,ymax=p.upr), fill="blue", alpha=0.1)+
    geom_text(size=3) +
    labs(title="Brain and Body Weights", x="body [kg]", y="brain [g]")

## 診断プロット
autoplot(model, colour="royalblue",
         smooth.colour="gray50", smooth.linetype="dashed",
         ad.colour="blue",
         label.size=3, label.n=5, label.colour="red")

## 外れ値を除いた回帰分析
idx <- c(6,16,26) # 外れ値のindex
model <- lm(log(brain) ~ log(body), data=Animals, subset=-idx)
summary(model)

## 区間推定
yc <- exp(predict(model, newdata=Animals, interval="confidence"))
colnames(yc) <- paste("c",colnames(yc),sep=".")
yp <- exp(predict(model, newdata=Animals, interval="prediction"))
colnames(yp) <- paste("p",colnames(yp),sep=".")
mydat <- cbind(Animals, yc, yp)

## 回帰式および信頼区間・予測区間の表示
ggplot(mydat, aes(body, brain, label=rownames(mydat))) +
    scale_x_log10() + scale_y_log10() +
    geom_line(aes(y=c.fit), color="royalblue", lwd=1.2) +
    geom_ribbon(aes(ymin=c.lwr,ymax=c.upr), fill="blue", alpha=0.2)+
    geom_ribbon(aes(ymin=p.lwr,ymax=p.upr), fill="blue", alpha=0.1)+
    geom_text(size=3) +
    labs(title="Brain and Body Weights", x="body [kg]", y="brain [g]")

## 診断プロット
autoplot(model, colour="royalblue",
         smooth.colour="gray50", smooth.linetype="dashed",
         ad.colour="blue",
         label.size=3, label.n=5, label.colour="red")


# See
# http://what-when-how.com/artificial-intelligence/a-comparison-of-cooling-schedules-for-simulated-annealing-artificial-intelligence/

exp_cool <- function(i, ntot, a, b) {
  (1-b)*exp(-a*i/ntot)+b
}

pow_cool <- function(i, ntot, a, b) {
  (1-b)*(a^(i/ntot))+b
}

lin_cool <- function(i, ntot, a, b) {
  (1-b)*(1/(1+a*i))+b
}

quad_cool <- function(i, ntot, a, b) {
  (1-b)*(1/(1+a*(i^2)))+b
}

log_cool <- function(i, ntot, a, b) {
  (1-b)*(1/(1+a*log(1+i)))+b
}

ntot <- 10000
x <- seq(0, ntot, by=1)

# plot(
#   x,
#   pow_cool(x, ntot, 0.001, 0),
#   type="l"
# )

plot(
  x,
  exp_cool(x, ntot, 3, 0),
  type="l"
)

lines(
  x,
  pow_cool(x, ntot, 1e-10, 0),
  col="red"
)

lines(
  x,
  lin_cool(x, ntot, 0.01, 0.01),
  col="green"
)

lines(
  x,
  quad_cool(x, ntot, 0.0000002, 0.05),
  col="blue"
)

lines(
  x,
  log_cool(x, ntot, 3, 0),
  col="purple"
)

# plot(
#   x,
#   0.2*cos(100*x*pi/ntot)+0.3,
#   type="l",
#   ylim=c(0, 1)
# )
#
plot(
  x,
  ((exp(-5*x/ntot)+0.05*cos(100*x*pi/ntot))+0.05)/1.1,
  type="l"
)
#
# plot(
#   seq(-1, 1, by=0.01),
#   seq(-1, 1, by=0.01)^2,
#   type="l"
# )

# 1) Lift the map
# 2) Lift-decay the map
# 3) Discussion: adaptive
# 4) Discussion: partial (parts) of metric
# 5) Discussion: scale with data and parameters


set.seed(102)

#Saving plots
pdf(file = "task3.pdf")

#prior sd is 4 prior
#hyperparameters h_mean=0 h_sd=2
h_mean = 4
h_sd = 2

par(mfrow=c(3,3),xpd=FALSE)
N=1;
x=rnorm(n=N,m=7,sd=4)
#finding observed values
	x<-rnorm(n=N,m=7,sd=4) #creation of observed data
	sampleMean=mean(x);

	x1 <- seq(-30, 30, 0.1)

	#Finding posterior
	posterior_mean = (N*(h_sd^2)*sampleMean + 16*0 )  /  ( N*(h_sd^2) + 16)
	posterior_var = (h_sd^2*16) / N*( h_sd^2 + 16 )
	post.norm<-rnorm(n=N,m=posterior_mean,sd=sqrt(posterior_var)) #creation of observed data

	#finding posterior, observed, prior
	plot(x1, dnorm(x1, 0, 2), type = "l",xlim=c(-20, 20), xlab=N,col="blue")
	lines(x1,dnorm(x1, posterior_mean, sqrt(posterior_var)),col="gold")
	lines(x,dnorm(x1, x, sqrt(0)),col="red")

	legend("topleft",
       inset=.05,
       cex = 1,
       c("data","post","prior"),
       horiz=FALSE,
       lty=c(1,1),
       lwd=c(2,2),
       col=c("red","gold","blue"),
       box.lty=0)

for (N in c(5,10,20,50,100,1000)){
	print(paste("The number of observed values is", N))

	#finding observed values
	x<-rnorm(n=N,m=7,sd=4) #creation of observed data
	sampleMean=mean(x);

	x1 <- seq(-30, 30, 0.1)

	#Finding posterior
	posterior_mean = (N*(h_sd^2)*sampleMean + 16*0 )  /  ( N*(h_sd^2) + 16)
	posterior_var = (h_sd^2*16) / N*( h_sd^2 + 16 )
	post.norm<-rnorm(n=N,m=posterior_mean,sd=sqrt(posterior_var)) #creation of observed data

	#finding posterior, observed, prior
	plot(x1, dnorm(x1, 0, 2), type = "l",xlim=c(-20, 20), xlab=N,col="blue",ylim=c(0, 0.35))
	lines(x1,dnorm(x1, posterior_mean, sqrt(posterior_var)),col="darkgoldenrod1")
	lines(density(x),col="red")

  legend("topleft",
       inset=.05,
       cex = 1,
       c("data","post","prior"),
       horiz=FALSE,
       lty=c(1,1),
       lwd=c(2,2),
       col=c("red","gold","blue"),
       box.lty=0)
}

dev.off()

#Παρατηρήσεις: Η εκ των προτέρων (prior) κατανομή(με εξαιρεση Ν=1) παραμένει σταθερή,
#η κατανομή των παρατηρήσεων παραμένει σχεδόν σταθερή με αβεβαιότητα
#λόγω της μικρής κορυφής και η posterior, όσο αυξάνονται τα δείγματα
# μικραίνει η διακύμανση και αποκτά μεγάλη κορυφή. Λογικό, όπως
#αναφέρεται στη βιβλιογραφία όσο το Ν αυξάνεται η αβεβαιότητα στη posterior
# μειώνεται αφού μειώνεται η επίδραση της σ.


# linear regression model : y= 0.15085 - 0.00288x1 - 0.00759x2 + 0.26528x3
SStotal=3.328
SSresidual=0.674
n=21
R2=(SStotal-SSresidual)/SStotal
print(R2)

#test statistic
F=(R2/3)/((1-R2)/(n-4))
print(F)
alpha=0.05
fvalue=qf(1-alpha,df1=3,df2 = 17)
print(fvalue)
# Because the computed F statistic, , is greater than fvalue, we reject H0 and
#conclude that one or more of the x values has some predictive power


filesSize<-read.table("xn.txt"， header = T)
mydata = filesSize$Byte
cat("Nombre de fichier："，nrow(filesSize))

h = hist(log(mydata), breaks = 15, probability= TRUE, xlab = "log(file size)",
      main="Histogramme de la taille des fichiers en échelle logarithmique")

x <- seq(min(log(mydata)), max(log(mydata)), length = 100)
y <- dnorm( x, mean = mean(log(mydata)), sd = sd(log(mydata)))
lines(x, y, col = "blue", lwd = 2)

400/399 * sd(log(mydata))^2 - sd(log(mydata))^2

h = hist(log(mydata), breaks = 50, probability= TRUE,
      main="Histogramme de la taille des fichiers en échelle logarithmique")

log_x <- seq(-2, max(log(mydata)), length = 1000)
y_normal <- dnorm( log_x, mean = mean(log(mydata)), sd = sd(log(mydata)))
lines(log_x, y_normal, col = "blue", lwd = 2)

densité_lnorm <- function(x, mean, sd){
    return (1.0/(x*sqrt(2*pi*sd^2)) * exp(-(log(x)-mean)^2/(2*sd^2)))
}

#yfit_2 <- densité_lnorm(exp(xfit_2), mean(log(x)), sd(log(x)))
y_dlnorme <- dlnorm(exp(log_x), meanlog = mean(log(mydata)), sdlog = sd(log(mydata)))

par(new = TRUE)
plot(log_x, y_dlnorme, type = "l", axes = FALSE, bty = "n", xlab = "", ylab = "", col='red')
axis(4, ylim=c(0,max(y_dlnorme)), col="red",col.axis="red")

## Add Legend
legend("topright",legend=c("Densité de ln(x) suivant lois normal","Densité de X suivant loi log-Nromal"),
  text.col=c("black","red"),pch=c(16,15),col=c("black","red"))

median(mydata)

exp(mean(log(mydata)))

qlnorm(p=0.95, mean=mean(log(mydata)),sd=sd(log(mydata)))

exp(sqrt(399/400)*sd(log(mydata))*qnorm(p=0.95, mean=0, sd=1)+mean(log(mydata)))

mean(log(mydata))

print(0.1+400/2)

mu = mean(log(mydata))
0.1 + 0.5 * sum((log(mydata) - mu)^2)

margin = seq(0,1,length=5000)
apriori = dgamma(margin, shape=0.1, scale=10)

plot(x=margin,y=apriori,col="red",type="l",ylim=c(0,40),main="Densité de loi",xlab="Valeur",ylab="Densité")

posteriori = dgamma(margin, shape=200.1, scale=1/1708.3)
lines(x=margin,y=posteriori,col="orange",type="l")

abline(v=200.1/1708.3, col="green", lwd = "4")
abline(v=400/399/var(log(mydata)), col="blue", lwd = "2", lty = 2)

legend("topright",legend=c("Densité à priori","Densité à posteriori","Espérance à posteriori","Espérance MV"),col=c("red","orange","green","blue"),lty=c(1,1,1,2), cex=0.8)

L = 8 * qchisq(p=0.95, df = 399)
Accepte = sd(log(mydata))^2*400 <= L
Accepte

seuil = sqrt(sd(log(mydata))^2 * 400 / qchisq(p=0.95,df = 399))
seuil


rm(list = ls()) #cleaning up
library(tidyverse)

df5=data.frame()
for (i in 1:10000){
  df5<-rbind(df5,rexp(5,2))
}
df5$mean<-rowMeans(df5,na.rm=TRUE,dims=1)

ggplot(df5, aes(mean))+
  geom_histogram(data=df5, aes(mean, ..density..), binwidth = 0.01)

mean(df5$mean)

##############1###################
df1=data.frame()
for (i in 1:10000){
  df1<-rbind(df1,rexp(1,2))
}
df1$mean<-rowMeans(df1,na.rm=TRUE,dims=1)

ggplot(df1, aes(mean))+
  geom_histogram(data=df1, aes(mean, ..density..), binwidth = 0.01)

mean(df1$mean)

##############10###################
df10=data.frame()
for (i in 1:10000){
  df10<-rbind(df10,rexp(10,2))
}
df10$mean<-rowMeans(df10,na.rm=TRUE,dims=1)

ggplot(df10, aes(mean))+
  geom_histogram(data=df10, aes(mean, ..density..), binwidth = 0.01)

mean(df10$mean)

##############30###################
df30=data.frame()
for (i in 1:10000){
  df30<-rbind(df30,rexp(30,2))
}
df30$mean<-rowMeans(df30,na.rm=TRUE,dims=1)

ggplot(df30, aes(mean))+
  geom_histogram(data=df30, aes(mean, ..density..), binwidth = 0.01)

mean(df30$mean)

##### same graph #####
df = data.frame("X1"  = df1$mean,
                "X5"  = df5$mean,
                "X10" = df10$mean,
                "X30" = df30$mean)
mean(df1$mean)
mean(df5$mean)
mean(df10$mean)
mean(df30$mean)

ggplot(df)+
  geom_histogram(data=df1, aes(mean, ..density..), color="red", binwidth = 0.01)+
  geom_histogram(data=df5, aes(mean, ..density..), color="orange", binwidth = 0.01)+
  geom_histogram(data=df10, aes(mean, ..density..), color="yellow", binwidth = 0.01)+
  geom_histogram(data=df30, aes(mean, ..density..), color="green", binwidth = 0.01)

##### Comparing the ratio of how decrease the starndard error ###
sd(df30$mean)
sd(df5$mean)/sqrt(6)


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

## B = Bloomberg Barclays Aggregate Bond index ETF (AGG), from Yahoo Finance
expret.bonds <- 0.0269
vol.bonds <- 0.0292
## E = S&P 500 index ETF (SPY), from Yahoo Finance
vol.stocks <- 0.1027
expret.stocks <- 0.1076
rf <- 0.01  ## F = risk-free rate (approximately)

wt.bonds <- seq(-0.5,1.5,0.005)  ## explore bond weights: short 50% to long 150%
## create expected portfolio returns for weights
expret.port <- wt.bonds*expret.bonds + (1-wt.bonds)*expret.stocks

## plot and set up axes
plot.default(NULL, type='l', xlim=c(0,0.15), ylim=c(-0.01, 0.15))
abline(h=0, lty=2, col="gray80")
lines(c(0,0), c(0.08,-0.025), lty=2, col="gray80")

## iterate through correlations from 1 to -1 in steps of -0.25
## find the portfolio volatility and then plot the curve
## RAINBOW-y for visibility and fabulous pride
line.colors <- c("purple","magenta", "red", "orange", "yellow",
                 "chartreuse", "aquamarine", "cyan", "blue")
corrs.bonds.stocks <- seq(1, -1, -0.25)
legend.keys <-  c()
for (i in 1:length(corrs.bonds.stocks)) {
    corr.bs <- corrs.bonds.stocks[i]
    var.port.tmp <- wt.bonds^2*vol.bonds^2 + (1-wt.bonds)^2*vol.stocks^2 +
        2*wt.bonds*(1-wt.bonds)*corr.bs*vol.bonds*vol.stocks
    vol.port.tmp <- sqrt(var.port.tmp)
    lines(vol.port.tmp, expret.port, lty=i, lwd=2, col=line.colors[i])
    legend.keys <- c(legend.keys, bquote(rho==~.(corr.bs)))
}
## Add a legend so we know which curves are for which correlations
legend.text <- as.expression(legend.keys)
legend("topleft", legend.text, lty=1:length(legend.text), cex=0.8, lwd=2, col=line.colors)

## show where F, B, and E are
points(0,0.01,lwd=2)
text(0.005, 0.01, "F")
points(vol.bonds, expret.bonds,lwd=2)
text(vol.bonds+0.005, expret.bonds, "B")
points(vol.stocks, expret.stocks,lwd=2)
text(vol.stocks, expret.stocks-0.01, "E")


library(ISLR)
names(Smarket)
dim(Smarket)

cor(Smarket[,-9])

plot(Smarket$Volume)

glm.fit=glm(Direction ~ Lag1+Lag2+Lag3+Lag4+Lag5+Volume, data=Smarket, family=binomial)
summary(glm.fit)

glm.probs=predict(glm.fit,type="response")
glm.pred=rep("Down",1250)
glm.pred[glm.probs >.5]="Up"
table(glm.pred,Smarket$Direction)
#in training error rate
mean(glm.pred==Smarket$Direction )

train=(Smarket$Year <2005)
Smarket.2005 = Smarket[!train ,]
dim(Smarket.2005)
Direction.2005= Smarket$Direction[!train]

glm.fit=glm(Direction~Lag1+Lag2+Lag3+Lag4+Lag5+Volume, data=Smarket, family=binomial, subset=train)
glm.probs=predict(glm.fit,Smarket.2005,type="response")

glm.pred=rep("Down",252)
glm.pred[glm.probs >.5]="Up"
table(glm.pred,Direction.2005)

mean(glm.pred==Direction.2005)

library(MASS)
lda.fit=lda(Direction~Lag1+Lag2,data=Smarket ,subset=train)
lda.fit
plot(lda.fit)

lda.pred=predict(lda.fit , Smarket.2005)
lda.class=lda.pred$class
table(lda.class, Direction.2005)

qda.fit=qda(Direction ~ Lag1+Lag2,data=Smarket ,subset=train)
qda.fit
qda.class=predict(qda.fit,Smarket.2005)$class
table(qda.class, Direction.2005)
mean(qda.class==Direction.2005)

library(class)
train.X=cbind(Smarket$Lag1, Smarket$Lag2)[train ,]
test.X=cbind(Smarket$Lag1,Smarket$Lag2)[!train ,]
train.Direction = Smarket$Direction [train]

set.seed(1)
knn.pred=knn(train.X,test.X,train.Direction, k=1)
table(knn.pred,Direction.2005)

knn.pred=knn(train.X,test.X,train.Direction, k=3)
table(knn.pred,Direction.2005)

dim(Caravan)
standardized.X=scale(Caravan [,-86])
var(Caravan [,1])
var(standardized.X[,1])
test=1:1000
train.X=standardized.X[-test ,]
test.X=standardized.X[test ,]
train.Y=Caravan$Purchase [-test]
test.Y=Caravan$Purchase [test]
set.seed(1)
knn.pred=knn(train.X,test.X,train.Y,k=1)
mean(test.Y!=knn.pred)
mean(test.Y!="No")

table(knn.pred,test.Y)

glm.fit=glm(Purchase~.,data=Caravan ,family=binomial, subset=-test)
glm.probs=predict(glm.fit,Caravan[test ,],type="response")
glm.pred=rep("No",1000)
glm.pred[glm.probs >.5]="Yes"
table(glm.pred,test.Y)

glm.pred=rep("No",1000)
glm.pred[glm.probs >.25]="Yes"
table(glm.pred,test.Y)


library(plotly)
library(htmlwidgets)

gaussPdf <- function (x, mu, E) {
  k <- length(x)
  ans <- exp(-0.5 * t(x - mu) %*% solve(E) %*% (x - mu)) /
    sqrt((2 * pi) ^ k * det(E))
  return (ans)
}

drawPlot <- function () {
  mu = c(0, 0)
  # E <- matrix(c(1, 3/5, 3/5, 2), nrow = 2)
  # E <- matrix(c(0.5, 0, 0, 2), nrow = 2)
  E <- matrix(c(2, 0.9, 0.9, 2), nrow = 2)

  xs <- seq(from = -5, to = 5, by = 0.1)
  ys <- seq(from = -5, to = 5, by = 0.1)
  z <- c()

  for (y in ys) {
    curr <- c()
    for (x in xs) {
      arg <- c(x, y)
      value <- gaussPdf(arg, mu, E)

      curr <- c(curr, value)
    }
    z <- rbind(z, curr)
  }

  fig <- plot_ly(
    type = 'surface',
    x = ~xs,
    y = ~ys,
    z = ~z) %>% add_surface(
      contours = list(
        z = list(
          show=TRUE,
          usecolormap=TRUE,
          highlightcolor="#ff0000",
          project=list(z=TRUE)
        )
      )
    )
  fig <- fig %>% layout(
    scene = list(
      camera=list(
        eye = list(x=1.87, y=0.88, z=-0.64)
      )
    )
  )
  #saveWidget(fig, file="widget.html")
  return (fig)
}

drawHeatmap <- function() {
  mu = c(0, 0)
  # E <- matrix(c(1, 3/5, 3/5, 2), nrow = 2)
  # E <- matrix(c(0.5, 0, 0, 2), nrow = 2)
  E <- matrix(c(2, 0.9, 0.9, 2), nrow = 2)

  xs <- seq(from = -5, to = 5, by = 0.1)
  ys <- seq(from = -5, to = 5, by = 0.1)
  z <- c()

  for (y in ys) {
    curr <- c()
    for (x in xs) {
      arg <- c(x, y)
      value <- gaussPdf(arg, mu, E)

      curr <- c(curr, value)
    }
    z <- rbind(z, curr)
  }

  fig <- plot_ly(
    type = 'heatmap',
    x = ~xs,
    y = ~ys,
    z = ~z)
  #saveWidget(fig, file="widget.html")
  return (fig)
}

# drawPlot()
drawHeatmap()

# plotly 3D plotting tests:
# x = c(1,2,3,4,5)
# y = c(1,2,3,4,5)
# z <- c()
# z = rbind(z,
#   c(2, 1, 2.2, 1, 0),
#   c(1, 0, 1, 0, 1))
#
# z <- rbind(z,   c(0, 1, 0, 1, 0),
#            c(1, 0, 1, 0, 1),
#            c(0, 1, 0, 1, 0))
#
# fig <- plot_ly(
#   type = 'surface',
#   x = ~x,
#   y = ~y,
#   z = ~z)
#
# fig

5 - Contour lines of the Gaussian distribution PDF/contour-lines.r


B <- matrix(c(7,9,3,5),2,2)
C <- matrix(c(3,2,3,2,8,1,4,-2,8),3,3)
determinant_B=det(B)
determinant_C=det(C)
determinant_B
determinant_C
solve(B)
solve(C)
# B* inverse B
x=zapsmall(solve(B)%*%B)
x
# C* inverse C
y=zapsmall(solve(C)%*%C)
y


#statistical analysis in R is performed by many built in functions

 meanfunc <- function(){
#mean(x, trim = 0, na.rm = FALSE, ...)
# Create a vector.
x <- c(12,7,3,4.2,18,2,54,-21,8,-5)
# Find Mean.
result.mean <- mean(x)
print(result.mean)
#When trim parameter is supplied, the values in the vector get sorted
#and then the required numbers of observations are dropped from calculating the mean.
#applying the trim function
#When trim = 0.3, 3 values from each end will be dropped from the calculations to find mean
result.mean <-  mean(x,trim = 0.3)
print(result.mean)

#If there are missing values, then the mean function returns NA.
#To drop the missing values from the calculation use na.rm = TRUE. which means remove the NA values.
# Create a vector.
x <- c(12,7,3,4.2,18,2,54,-21,8,-5,NA)

# Find mean.
result.mean <-  mean(x)
print(result.mean)

# Find mean dropping NA values.
result.mean <-  mean(x,na.rm = TRUE)
print(result.mean)
 }
#  meanfunc()

 medianfunc <- function(){
#median(x, na.rm = FALSE)
# Create the vector.
x <- c(12,7,3,4.2,18,2,54,-21,8,-5)

# Find the median.
median.result <- median(x)
print(median.result)
 }
#  medianfunc()

#Unike mean and median, mode can have both numeric and character data.
# This function takes the vector as input and gives the mode value as output
modefunc <- function(){
# Create the function.
getmode <- function(v) {
   uniqv <- unique(v)
   uniqv[which.max(tabulate(match(v, uniqv)))]
}

# Create the vector with numbers.
v <- c(2,1,2,3,1,2,3,4,1,5,5,3,2,3)

# Calculate the mode using the user function.
result <- getmode(v)
print(result)

# Create the vector with characters.
charv <- c("o","it","the","it","it")

# Calculate the mode using the user function.
result <- getmode(charv)
print(result)
}
# modefunc()
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# Regression analysis is a very widely used statistical tool
# to establish a relationship model between two variables.
#one of the variables are called predictor variable which its values are gathered through the experiment
#the other variable is called response variable which its values are derived from the other variable
#y= ax + b
# y ==> response variable
# x ==> predictor variable
if(FALSE){
    "The steps to create the relationship is :
==>Carry out the experiment of gathering a sample of observed values of height and corresponding weight.
==>Create a relationship model using the lm() functions in R.
==>Find the coefficients from the model created and create the mathematical equation using these
==>Get a summary of the relationship model to know the average error in prediction. Also called residuals.
==>To predict the weight of new persons, use the predict() function in R."

"# Values of height
151, 174, 138, 186, 128, 136, 179, 163, 152, 131

# Values of weight.
63, 81, 56, 91, 47, 57, 76, 72, 62, 48"
}

#lm() in linear regression syntax: lm(formula,data)
# formula is a symbol presenting the relation between x and y.
# data is the vector on which the formula will be applied.

linear_regression <- function(){
# The predictor vector. (height)
x <- c(151, 174, 138, 186, 128, 136, 179, 163, 152, 131)
# The resposne vector. (weight)
y <- c(63, 81, 56, 91, 47, 57, 76, 72, 62, 48)

# Apply the lm() function.
relation <- lm(y~x)

# print(relation)
# print(summary(relation)) #summary of the relationship

# predict(object, newdata)
# object is the formula which is already created using the lm() function.
# newdata is the vector containing the new value for predictor variable

# Find weight of a person with height 170.
a <- data.frame(x = 170)
result <-  predict(relation,a)
print(result)

#************************************************************ chart of the regression line
# Give the chart file a name.
png(file = "linearregression.png")

# Plot the chart.
plot(y,x,col = "blue",main = "Height & Weight Regression",
abline(lm(x~y)),cex = 1.3,pch = 16,xlab = "Weight in Kg",ylab = "Height in cm")

# Save the file.
dev.off()
#*****************************************************************
}
# linear_regression()
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#Nonlinear regression
if(FALSE){
" In Least Square regression, we establish a regression model in which the sum of the squares of the vertical distances
 of different points from the regression curve is minimized. We generally start with a defined model and assume some values
 for the coefficients. We then apply the nls() function of R to get the more accurate values along with the confidence intervals."
#nls(formula, data, start)
"formula is a nonlinear model formula including variables and parameters.
data is a data frame used to evaluate the variables in the formula.
start is a named list or named numeric vector of starting estimates."

#We will consider a nonlinear model with assumption of initial values of its coefficients
#Next we will see what is the confidence intervals of these assumed values so that we can judge how well these values fit into the model.
}

# We consider the equation a = b1*x^2+b2 for this purpose, and 1 and 3 for the coefissients and fit these values into nls() function
nonlinear_regression <- function(){
xvalues <- c(1.6,2.1,2,2.23,3.71,3.25,3.4,3.86,1.19,2.21)
yvalues <- c(5.19,7.43,6.94,8.11,18.75,14.88,16.06,19.12,3.21,7.58)

# Give the chart file a name.
png(file = "nls.png")

# Plot these values.
plot(xvalues,yvalues)

# Take the assumed values and fit into the model.
model <- nls(yvalues ~ b1*xvalues^2+b2,start = list(b1 = 1,b2 = 3))

# Plot the chart with new data by fitting it to a prediction from 100 data points.
new.data <- data.frame(xvalues = seq(min(xvalues),max(xvalues),len = 100))
lines(new.data$xvalues,predict(model,newdata = new.data))

# Save the file.
dev.off()

# Get the sum of the squared residuals.
print(sum(resid(model)^2))

# Get the confidence intervals on the chosen values of the coefficients.
print(confint(model))
}
# nonlinear_regression()
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# in multiple regression we have more than one predictor variable and one response variable.
# The general mathematical equation for multiple regression is −
# y = a + b1x1 + b2x2 +...bnxn (y ==> response  (x1,x2,x3,..) ==> predictors)
#lm() function creates the relationship model between the predictor and the response variable
if(FALSE){
    'Consider the data set "mtcars" available in the R environment.
    It gives a comparison between different car models in terms of mileage per gallon (mpg),
    cylinder displacement("disp"), horse power("hp"), weight of the car("wt") and some more parameters
    The goal of the model is to establish the relationship between "mpg" as a response variable
     with "disp","hp" and "wt" as predictor variables'
}
multiple_regression <- function(){
input <- mtcars[,c("mpg","disp","hp","wt")]
print(head(input))

# Create the relationship model.
model <- lm(mpg~disp+hp+wt, data = input)

# Show the model.
# print(model)

# Get the Intercept and coefficients as vector elements.
cat("# # # # The Coefficient Values # # # ","\n")

a <- coef(model)[1]
print(a)

Xdisp <- coef(model)[2]
Xhp <- coef(model)[3]
Xwt <- coef(model)[4]

print(Xdisp)
print(Xhp)
print(Xwt)

# creating the equation for the regression model
#we want to create the mathematical equation
# Y = a+Xdisp.x1+Xhp.x2+Xwt.x3
# or
# Y = 37.15+(-0.000937)*x1+(-0.0311)*x2+(-3.8008)*x3

# Applying equation for prediting new values
a <- data.frame(disp = 190,hp=100,wt=3)
result <-  predict(model,a)
print(result)
}
# multiple_regression()

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#The Logistic Regression is a regression model in which the response variable (dependent variable)
#has categorical values such as True/False or 0/1.
#It actually measures the probability of a binary response as the value of response variable
#based on the mathematical equation relating it with the predictor variables
if(FALSE){
    "The general mathematical equation for logistic regression is y = 1/(1+e^-(a+b1x1+b2x2+b3x3+...))"
    "y is the response variable.
    x is the predictor variable.
    a and b are the coefficients which are numeric constants"
    #to create logistic regression model, we use glm() function, glm(formula,data,family)
    "formula is the symbol presenting the relationship between the variables.
    data is the data set giving the values of these variables.
    family is R object to specify the details of the model. It's value is binomial for logistic regression."

'The built-in data set "mtcars" describes different models of a car with their
 various engine specifications. In "mtcars" data set, the transmission mode (automatic or manual)
  is described by the column am which is a binary value (0 or 1). We can create a
  logistic regression model between the columns "am" and 3 other columns - hp, wt and cyl.'
}
logistic_regression <- function(){
    # Select some columns form mtcars.
input <- mtcars[,c("am","cyl","hp","wt")]
print(head(input))
am.data = glm(formula = am ~ cyl + hp + wt, data = input, family = binomial)
# print(summary(am.data))

# Applying equation for prediting new values
a <- data.frame(cyl = 7,hp=200,wt=3.65)
result <-  predict(am.data,a)
print(result) #does not print 1 or 0!

}
# logistic_regression()
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
if(FALSE){ #Possion
    "poisson Regression involves regression models in which the response variable is
    in the form of counts and not fractional numbers. For example, the count of number
    of births or number of wins in a football match series.
    Also the values of the response variables follow a Poisson distribution"

    #log(y) = a + b1x1 + b2x2 + bnxn.....
    "y is the response variable.
    a and b are the numeric coefficients.
    x is the predictor variable."
#possion regression is created by glm() function, glm(formula,data,family)
    "formula is the symbol presenting the relationship between the variables.
    data is the data set giving the values of these variables.
    family is R object to specify the details of the model. It's value is 'Poisson' for Logistic Regression."

}

poisson_regression <- function(){
# We have the built-in data set "warpbreaks" which describes the effect of wool type (A or B) and tension (low, medium or high)
# on the number of warp breaks per loom. Let's consider "breaks" as the response variable
# which is a count of number of breaks. The wool "type" and "tension" are taken as predictor variables
    input <- warpbreaks
print(head(input))
output <-glm(formula = breaks ~ wool+tension, data = warpbreaks,
   family = poisson)
# print(summary(output))

# Applying equation for prediting new values (does not work)
#make a datframe with new data
# library(caret)
# newdata = data.frame(wool="B", tension="M")#use 'predict() to run model on new data
# result <- predict(input, newdata = newdata, type = "response")
# print(result)
}
# poisson_regression()
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# R has four built-in functions to generate normal distribution. They are described below.
if(FALSE){
    "dnorm(x, mean, sd)
    pnorm(x, mean, sd)
    qnorm(p, mean, sd)
    rnorm(n, mean, sd)"

    "x is a vector of numbers.
    p is a vector of probabilities.
    n is number of observations(sample size).
    mean is the mean value of the sample data. It's default value is zero.
    sd is the standard deviation. It's default value is 1."

}
#dnorm() function gives height of the probability distribution at each point
#for a given mean and standard deviation.

dnorm_func <- function(){
    # Create a sequence of numbers between -10 and 10 incrementing by 0.1.
x <- seq(-10, 10, by = .1)

# Choose the mean as 2.5 and standard deviation as 0.5.
y <- dnorm(x, mean = 2.5, sd = 0.5)

# Give the chart file a name.
png(file = "dnorm.png")

plot(x,y)
# Save the file.
dev.off()
}
# dnorm_func()

#***************************************************************************
#pnorm() function gives the probability of a normally distributed random number
#to be less than the value of a given number. It is also called "Cumulative Distribution Function
pnorm_func <- function(){
    # Create a sequence of numbers between -10 and 10 incrementing by 0.2.
x <- seq(-10,10,by = .2)

# Choose the mean as 2.5 and standard deviation as 2.
y <- pnorm(x, mean = 2.5, sd = 2)

# Give the chart file a name.
png(file = "pnorm.png")

# Plot the graph.
plot(x,y)

# Save the file.
dev.off()
}
# pnorm_func()

#***************************************************************************
# qnorm() function takes the probability value and
# gives a number whose cumulative value matches the probability value.
qnorm_func <- function(){
# Create a sequence of probability values incrementing by 0.02.
x <- seq(0, 1, by = 0.02)

# Choose the mean as 2 and standard deviation as 1.
y <- qnorm(x, mean = 2, sd = 1)

# Give the chart file a name.
png(file = "qnorm.png")

# Plot the graph.
plot(x,y)

# Save the file.
dev.off()
}
# qnorm_func()

#***************************************************************************
# rnorm() function is used to generate random numbers whose distribution is normal.
# It takes the sample size as input and generates that many random numbers.
# We draw a histogram to show the distribution of the generated numbers.

rnorm_func <- function(){
# Create a sample of 50 numbers which are normally distributed.
y <- rnorm(50)

# Give the chart file a name.
png(file = "rnorm.png")

# Plot the histogram for this sample.
hist(y, main = "Normal DIstribution")

# Save the file.
dev.off()
}
# rnorm_func()

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
if(FALSE){
    "The binomial distribution model deals with finding the probability of success
    of an event which has only two possible outcomes in a series of experiments.
    For example, tossing of a coin always gives a head or a tail.
    The probability of finding exactly 3 heads in tossing a coin repeatedly
    for 10 times is estimated during the binomial distribution."

# R has four in-built functions to generate binomial distribution. They are described below.
    "dbinom(x, size, prob)
    pbinom(x, size, prob)
    qbinom(p, size, prob)
    rbinom(n, size, prob)"

    "x is a vector of numbers.
    p is a vector of probabilities.
    n is number of observations.
    size is the number of trials.
    prob is the probability of success of each trial."
}

# dbinom() function gives the probability density distribution at each point.
dbinom_func <- function(){
# Create a sample of 50 numbers which are incremented by 1.
x <- seq(0,50,by = 1)

# Create the binomial distribution.
y <- dbinom(x,50,0.5) #50 trials with 1/2 chance of success

# Give the chart file a name.
png(file = "dbinom.png")

# Plot the graph for this sample.
plot(x,y)

# Save the file.
dev.off()
}
# dbinom_func()

# pbinom() function gives the cumulative probability of an event.
# It is a single value representing the probability.
pbinom_func <- function(){
# Probability of getting 26 or less heads from a 51 tosses of a coin.
x <- pbinom(26,51,0.5)

print(x)
}
# pbinom_func()

# qbinom() function takes the probability value and gives a number
# whose cumulative value matches the probability value.
qbinom_func <- function(){
# How many heads will have a probability of 0.25 will come out when a coin
# is tossed 51 times.
x <- qbinom(0.25,51,1/2)

print(x)
}
# qbinom_func()

# rbinom() function generates required number of random values of given probability from a given sample.
rbinom_func <- function(){
# Find 8 random values from a sample of 150 with probability of 0.4.
x <- rbinom(8,150,.4)

print(x)
}
# rbinom_func()

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#ANCOVA Analysis
if(FALSE){
'Create a data frame containing the fields "mpg", "hp" and "am" from the data set mtcars.
Here we take "mpg" as the response variable, "hp" as the predictor variable and "am" as the categorical variable.'
'We create a regression model taking "hp" as the predictor variable and "mpg" as the response variable
taking into account the interaction between "am" and "hp".'
}

ancova <- function(){
# Get the dataset.
input <- mtcars

# Create the regression model. (Model with interaction between categorical variable and predictor variable)
result1 <- aov(mpg~hp*am,data = input)
# print(summary(result1))

# Create the regression model. (Model without interaction between categorical variable and predictor variable)
result2 <- aov(mpg~hp+am,data = input)
# print(summary(result2))

# Compare the two models.
print(anova(result1,result2))
# As the p-value is greater than 0.05(0.9806) we conclude that the interaction between horse power and transmission type is not significant.
# So the mileage per gallon will depend in a similar manner on the horse power of the car in both auto and manual transmission mode.
}
ancova()
# input <- mtcars[,c("am","mpg","hp")]
# print(head(input))


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

rm(list = ls())

x.f <- c(60, 21, 11, 4, 3, 1)
y.f <- c(130, 50, 10, 6, 4, 0)

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

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

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

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

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

(W.xy <- W.x - n.x * (n.x + 1) / 2)
# 10756

(W.xy.mean <- n.x * n.y / 2)
# 10000

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

(ties <- table(c(x, y)))
#   1   2   3   4   5   6
# 190  71  21  10   7   1

(W.xy.var.corrected <- n.x * n.y / 12 * ((n + 1) - sum(ties ^ 3 - ties) / (n * (n - 1))))
# 367381.716833891

# Asymptotic pvalue (with continuity correction, without tie correction)
2 * (1 - pnorm(abs(W.xy + 0.5 * sign(W.xy.mean - W.xy) - W.xy.mean) / sqrt(W.xy.var)))
# 0.286124467472471

## Asymptotic pvalue (with continuity correction, with tie correction)
2 * (1 - pnorm(abs(W.xy + 0.5 * sign(W.xy.mean - W.xy) - W.xy.mean) / sqrt(W.xy.var.corrected)))
# 0.21259835316298

## Exact pvalue (not valid with ties)
2 * (1 - pwilcox(W.xy - (W.xy.mean < W.xy), n.x, n.y, lower.tail = W.xy.mean < W.xy))
# 0.286650510800022

wilcox.test(x, y, alternative = "two.sided", exact = FALSE)
# Wilcoxon rank sum test with continuity correction
#
# data:  x and y
# W = 10756, p-value = 0.2126
# alternative hypothesis: true location shift is not equal to 0


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

rm(list = ls())

x <- c(518, 174, 613, 2010, 2139, 156, 450, 536)
(n.x <- length(x))
# 8

y <- c(899, 326, 2118, 839, 820, 1423, 1687, 1010, 3011, 1739, 1185, 1320, 646,
       505, 4236, 4481, 1433, 1806, 400, 421, 335, 1164, 1713, 1356, 390)
(n.y <- length(y))
# 25

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

sum(duplicated(c(y, x))) > 0
# FALSE

(W <- sum(rank(c(y, x))[1:length(y)]))
# 459

(W.mean <- n.y * (n + 1) / 4)
# 212.5

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

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

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

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

### H0: X <= Y

## Asymptotic pvalue (with continuity correction)
1 - pnorm((W.yx - 0.5 - W.yx.mean) / sqrt(W.yx.var))
# 0.0796719687339751

## Exact pvalue
1 - pwilcox(W.yx - 1, n.y, n.x)
# 0.0812147313815834

### Shift Parameter Estimation

a <- matrix(rep(0, n.x * n.y), n.x, n.y)
for (i in 1:n.x) {
  for (j in 1:n.y) {
    a[i, j] <- y[j] - x[i]
  }
}

# Exact
median(a)
# 491

wilcox.test(y, x, alternative = "greater", conf.int = TRUE)
# Wilcoxon rank sum test
#
# data:  y and x
# W = 134, p-value = 0.08121
# alternative hypothesis: true location shift is greater than 0
# 95 percent confidence interval:
#  -60 Inf
# sample estimates:
# difference in location
#                    491


## Punto 1 ##
n <- 200

nj <- c(60,80,30,20,10)
hj <- nj/n
Nj <- cumsum(nj)
Hj <- cumsum(hj)

#Marca de clase
li <- c(0,10,20,30,100)
ls <- c(10,20,30,100,200)
x <- (li+ls)/2

#Promedio
x_bar <- sum(x*nj)/n

sum(hj[2:4])

## Punto 2 ##

#Importar archivo
library(rstudioapi)
filename = "taller3.r"
filepath = rstudioapi::getActiveDocumentContext()$path
dir = substr(filepath, 1, nchar(filepath)-nchar(filename))
setwd(dir)

datos <- read.table(file="taller03_datos.txt")
cal <- datos$V1

R <- (max(cal)-min(cal))
y_bar <- mean(cal)
n_2 <- length(cal)
m_2 <- 10
a_2 <- R/10

lim <- min(cal) + (0:m_2)*a_2
nj_2 <- table(cut(x = cal, breaks = lim, include.lowest = T))
hj_2 <- nj_2/n_2
Nj_2 <- cumsum(nj_2)
Hj_2 <- cumsum(hj_2)

## Punto 3 ##

M1 <- c(0.32, 0.35, 0.37, 0.39, 0.42, 0.47, 0.51, 0.58, 0.60, 0.62, 0.65, 0.68, 0.75)

M2 <- c(0.25, 0.40, 0.48, 0.55, 0.56, 0.58, 0.60, 0.65, 0.70, 0.76, 0.80, 0.91, 0.99)
R1 <- max(M1)-min(M1)
R2 <- max(M2)-min(M2)

## Punto 4 ##

c <- 87.3
f <- (9*c)/5 + 32

## Punto 5 ##

x_b <- 168
n_5 <- 21
x <- ((x_b+2)*(n_5+1))-(x_b*n_5)

## Punto 6 ##

d <- c(300,400,500,600,700)
nj_6 <- c(10,16,35,26,13)

x_b <- sum(d*nj_6)/sum(nj_6)
g <- (d*1.02)
j <- d+10


#Example randomization code, written (mostly) in class
#30/10/2013

martin<-c(0.13, -0.01, -0.01, 0.42, -0.02, 0.01, 0.09, 0.03, 0.04, 0.06, 0.12, 0.03)

rand.func<-function(data,n=999,H0=0){
#Purpose: Perform randomziation test on a mean of a univariate data sample
#Inputs:
# data - vector of data
# n - number of resamples
# H0 - null hypothesis mean value
#Outputs:
# p-value of test

  #Error checking code should go here

  #vector to store the sim means means
  resample.means<-numeric(n+1)
  #create symetric dataset and turn to all positive
  centered.pos.data<-abs(data-H0)
  n.data<-length(data)

  #Repeat the following two steps many times:
  for(i in 1:n){
    #(a) Simulate a data set according to H0
    #  simulate random signs
    signs<-sample(c(-1,1),n.data,replace=T)
    sim.data<-centered.pos.data*signs
    #(b) Calculate T(x) using the simulated data
    resample.means[i]<-mean(sim.data)
  }

  #Add T(x) evaluated from the sample data
  resample.means[n+1]<-mean(data)-H0

  #p-value is the proportion of the T(x)s as extreme or more
  # extreme than the one from the sample data
  p.value<-sum(abs(resample.means)>=abs(resample.means[n+1]))/(n+1)

  return(p.value)
}

x<-rand.func(martin,n=10000)
print(x)


ejercicio1 <- read.csv('../Data/ejercicio1.csv')
ejercicio2 <- read.csv('../Data/ejercicio2.csv')
ejercicio3 <- read.csv('../Data/ejercicio3.csv')

best_ecuation <- function(data){
  X <- sum(data$X)
  Y <- sum(data$Y)
  XY <- sum(data$X * data$Y)
  X2 <- sum(data$X * data$X)
  Y2 <- sum(data$Y * data$Y)

  SSxy <- XY - (X*Y/length(data$X))

  SSx <- X2 - (X*X)/length(data$Y)

  b1 <- SSxy/SSx

  b0 <- (Y - (b1 * X))/length(data$X)

  result <- function(x) {
    return(b0 + b1*x)
  }

  return(result)
}

#fit <- lm(Y ~ X, data=data)

#print(summary(fit))

#MC(ejercicio1)

## Section Ejercicio 1

jpeg("../Images/ejercicio1.jpeg")

plot(ejercicio1$X,ejercicio1$Y,
     xlab="x",
     ylab="f(x)",main = 'Gráfico de Dispersión con recta de mejor ajuste. (Ejercicio 1)')

fit1 <- lm(Y ~ X, data=ejercicio1)

abline(fit1)

dev.off()

ecuation1 <-best_ecuation(ejercicio1)

print(paste("El valor estimado de la función para x = 1 es: ",ecuation1(1)))

## Section Ejercicio 2

jpeg("../Images/ejercicio2.jpeg")

plot(ejercicio2$X,ejercicio2$Y,
     xlab="x",
     ylab="f(x)",main = 'Gráfico de Dispersión con recta de mejor ajuste. (Ejercicio 2)')

fit2 <- lm(Y ~ X, data=ejercicio2)

abline(fit2)

dev.off()

ecuation2 <-best_ecuation(ejercicio2)

print(paste("El valor estimado de la función para x = 0 es: ",ecuation2(0)))
print(paste("El valor estimado de la función para x = 2 es: ",ecuation2(2)))

## Section Ejercicio 3

jpeg("../Images/ejercicio3norecta.jpeg")

plot(ejercicio3$X,ejercicio3$Y,
     xlab="Velocidad (ft/s)",
     ylab="Rapidez de pasos",main = 'Gráfico de Dispersión. (Ejercicio 3)')

dev.off()

jpeg("../Images/ejercicio3.jpeg")

plot(ejercicio3$X,ejercicio3$Y,
     xlab="Velocidad (ft/s)",
     ylab="Rapidez de pasos",main = 'Gráfico de Dispersión con recta de mejor ajuste. (Ejercicio 3)')

fit3 <- lm(Y ~ X, data=ejercicio3)

abline(fit3)

dev.off()

ecuation3 <-best_ecuation(ejercicio3)

summary(fit3)

print(paste("El valor estimado de la función para una velocidad de 19 pasos por segundo es: ",ecuation3(19)))


# Goal: Prices and returns

# I like to multiply returns by 100 so as to have "units in percent".
# In other words, I like it for 5% to be a value like 5 rather than 0.05.

###################################################################
# I. Simulate random-walk prices, switch between prices & returns.
###################################################################
# Simulate a time-series of PRICES drawn from a random walk
# where one-period returns are i.i.d. N(mu, sigma^2).
ranrw <- function(mu, sigma, p0=100, T=100) {
  cumprod(c(p0, 1 + (rnorm(n=T, mean=mu, sd=sigma)/100)))
}
prices2returns <- function(x) {
  100*diff(log(x))
}
returns2prices <- function(r, p0=100) {
  c(p0, p0 * exp(cumsum(r/100)))
}

cat("Simulate 25 points from a random walk starting at 1500 --\n")
p <- ranrw(0.05, 1.4, p0=1500, T=25)
    # gives you a 25-long series, starting with a price of 1500, where
    # one-period returns are N(0.05,1.4^2) percent.
print(p)

cat("Convert to returns--\n")
r <- prices2returns(p)
print(r)

cat("Go back from returns to prices --\n")
goback <- returns2prices(r, 1500)
print(goback)

###################################################################
# II. Plenty of powerful things you can do with returns....
###################################################################
summary(r); sd(r)                       # summary statistics
plot(density(r))                        # kernel density plot
acf(r)                                  # Autocorrelation function
ar(r)                                   # Estimate a AIC-minimising AR model
Box.test(r, lag=2, type="Ljung")        # Box-Ljung test
library(tseries)
runs.test(factor(sign(r)))              # Runs test
bds.test(r)                             # BDS test.

###################################################################
# III. Visualisation and the random walk
###################################################################
# I want to obtain intuition into what kinds of price series can happen,
# given a starting price, a mean return, and a given standard deviation.
# This function simulates out 10000 days of a price time-series at a time,
# and waits for you to click in the graph window, after which a second
# series is painted, and so on. Make the graph window very big and
# sit back and admire.
# The point is to eyeball many series and thus obtain some intuition
# into what the random walk does.
visualisation <- function(p0, s, mu, labelstring) {
  N <- 10000
  x <- (1:(N+1))/250                        # Unit of years
  while (1) {
    plot(x, ranrw(mu, s, p0, N), ylab="Level", log="y",
         type="l", col="red", xlab="Time (years)",
         main=paste("40 years of a process much like", labelstring))
    grid()
    z=locator(1)
  }
}

# Nifty -- assuming sigma of 1.4% a day and E(returns) of 13% a year
visualisation(2600, 1.4, 13/250, "Nifty")

# The numerical values here are used to think about what the INR/USD
# exchange rate would have looked like if it started from 31.37, had
# a mean depreciation of 5% per year, and had the daily vol of a floating
# exchange rate like EUR/USD.
visualisation(31.37, 0.7, 5/365, "INR/USD (NOT!) with daily sigma=0.7")
# This is of course not like the INR/USD series in the real world -
# which is neither a random walk nor does it have a vol of 0.7% a day.

# The numerical values here are used to think about what the USD/EUR
# exchange rate, starting with 1, having no drift, and having the observed
# daily vol of 0.7. (This is about right).
visualisation(1, 0.7, 0, "USD/EUR with no drift")

###################################################################
# IV. A monte carlo experiment about the runs test
###################################################################
# Measure the effectiveness of the runs test when faced with an
# AR(1) process of length 100 with a coeff of 0.1
set.seed(101)
one.ts <- function() {arima.sim(list(order = c(1,0,0), ar = 0.1), n=100)}
table(replicate(1000, runs.test(factor(sign(one.ts())))$p.value < 0.05))
# We find that the runs test throws up a prob value of below 0.05
# for 91 out of 1000 experiments.
# Wow! :-)
# To understand this, you need to look up the man pages of:
#    set.seed, arima.sim, sign, factor, runs.test, replicate, table.
# e.g. say ?replicate

RFrontEndSolution/Tests Repo/Rscripts All (163 files)/b3.r


#' Fisher's Combined P-value
#'
#' Fisher's combined p-value, used to combine the results of individual statistical tests into an overall hypothesis.
#' @param x - A vector of p-values (floating point numbers).
#' @return a floating point number, a combined p-value using Fisher's method.
#' @export stats.fishersMethod
#' @examples
#' stats.fishersMethod(c(0.2,0.1,0.3))
#' > 0.1152162
stats.fishersMethod = function(x) {
  return (pchisq(-2 * sum(log(x)),df=2*length(x),lower=FALSE))
}


# oneway.test.r
y <- c( 11, 11, 10, 10, 10, 11, 10,  8, 10,  9,
        12, 11, 11, 13, 12, 11, 11, 11, 12,  9,
        12, 13, 13, 11, 10, 13, 11, 12, 13, 11,
         9, 10,  8, 10, 13, 10, 10, 10, 10,  8)
my.i <- c(mean(y[1:10]), mean(y[11:20]), mean(y[21:30]),mean(y[31:40]))
n.i <- c(10,10,10,10)
CT <-  length(y)*mean(y)^2
SST <- sum (y^2) - CT
SSTrt <- sum(n.i*my.i^2) - CT
SSE <- SST - SSTrt
MSTrt <- SSTrt /(4-1)
MSE <- SSE / (40-4)
F0 <- MSTrt / MSE
F0
1-pf(F0, 3, 36)

#====================

y <- c( 11, 11, 10, 10, 10, 11, 10,  8, 10,  9,
        12, 11, 11, 13, 12, 11, 11, 11, 12,  9,
        12, 13, 13, 11, 10, 13, 11, 12, 13, 11,
         9, 10,  8, 10, 13, 10, 10, 10, 10,  8)
x <- c(rep(1,10), rep(2,10), rep(3,10), rep(4,10))
fert <- data.frame(y,x)
oneway.test(y ~x, var.equal=T)


################
#---PACKAGES---#
################
require(ggplot2)
require(reshape2)

#########################
#---JC69 CTMC EXAMPLE---#
#########################
JC69 <- function (theta, t) {
  p0 = 1/4 + 3/4 * exp(-4*theta*t)
  p1 = 1/4 - 1/4 * exp(-4*theta*t)

  trans_prob = matrix(c(p0, p1, p1, p1,
                        p1, p0, p1, p1,
                        p1, p1, p0, p1,
                        p1, p1, p1, p0
  ), nrow = 4, ncol = 4, byrow = T)

  colnames(trans_prob) <- rownames(trans_prob) <- c("T", "C", "A", "G")
  return(trans_prob)
}

N = 50
times = seq(0, 0.1, length.out = N)
data <- data.frame(
  T = rep(NA, N),
  C = rep(NA, N),
  A = rep(NA, N),
  G = rep(NA, N)
)

# set.seed(123)
r    <- runif(4)
vect <- r / sum(r)

data[1, ] <- vect
theta    <- 2

for (i in 2 : N) {
  probs = as.matrix(data[i - 1, ], nrow = 1, ncol = 4)
  data[i, ] <- probs %*% JC69(theta, t = times[i])
}

data_melt <- melt(cbind(t = times, data), id.vars = "t")

p <- ggplot(data_melt)
p <- p + geom_line(aes(x = t, y = value, color = variable))
p <- p + xlab("Time") + ylab("Probability")
theme <- theme(
  axis.title = element_text(colour = "black"),
  axis.text = element_text(colour = "black"),
  axis.line = element_line(colour = "black"),
  axis.ticks = element_line(colour = "black"),
  panel.background = element_rect(size = 1, fill = "white", colour = NA),
  plot.background = element_rect(colour = NA),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.grid.minor = element_blank()
)
p <- p + theme
print(p)

###################################
#---BINOMIAL LIKELIHOOD EXAMPLE---#
###################################
myBlue = rgb(r = 86, g = 110, b = 126, maxColorValue = 250)

like <- function(theta, k = 8, n = 10) {
  return(dbinom(k, n, theta))
}

# 900 x 600
theta <- seq(from = 0, to = 1, by = 0.01)
plot(theta, like(theta), type = "l", col = myBlue, lwd = 3)

points(0.8, like(0.8), pch = 19, col = myBlue, cex = 1.5)

# fair coin?


# Example : 2.1A  Chapter : 2.1   Pageno : 39
#Solving the equations by Column picture
#Column Picture : solution is the linear combination of columns of A that makes b
A=matrix(c(1,2,3,3,2,5,2,2,6),ncol=3)
b=c(-3,-2,-5)
x<-solve(A,b)
x
#if b=(4,4,8)
b=c(4,4,8)
x<-solve(A,b)
x


###########################################################
###    C10 Class: Linear Models
###########################################################

# Fitting simple linear models

data(father.son, package = "UsingR")
library(ggplot2)
library(useful)
library(coefplot)

ggplot(father.son, aes(fheight, sheight)) +
    geom_point() +
    geom_smooth(method="lm") +
    labs(x="Fathers", y="Sons")

heights_lm <- lm(sheight ~ fheight, data=father.son)
summary(heights_lm)

# digression into anova and different data set
data(tips, package="reshape2")

tipsAnova <- aov(tip~day-1, data=tips)
tipsLM <- lm(tip~day-1, data=tips)
summary(tipsAnova)
summary(tipsLM)
# LM has more information than Anova and thus is preferred

# Explore the data for multiple regression, predict one variable on multiple variables
# get some data from website
housing <- read.table("http://www.jaredlander.com/data/housing.csv", sep = ",", header = TRUE, stringsAsFactors = FALSE)
# clean up col names
names(housing) <- c("Neighborhood", "Class", "Units", "Years_Built", "SqFt", "Income", "IncomePerSqFt",
                    "Expense", "ExpensePerSqFt", "NetIncome", "Value", "ValuePerSqFt", "Boro")
# make an exploratory viz
ggplot(housing, aes(x=ValuePerSqFt, fill=Boro, alpha=1/2)) +
    geom_histogram(binwidth=10) +
    labs(x="Value per sq ft") +
    facet_wrap(~Boro)

ggplot(housing, aes(x=SqFt)) +
    geom_histogram()

ggplot(housing, aes(x=SqFt, y=ValuePerSqFt)) +
    geom_point()

# see that there are very large buildings skewing results, so subset

ggplot(housing[housing$Units < 1000, ], aes(x=SqFt)) +
    geom_histogram()

ggplot(housing[housing$Units < 1000, ], aes(x=SqFt, y=ValuePerSqFt)) +
    geom_point()

# right track, so determine how many units to exclude
sum(housing$Units >= 1000)
# yields 6, so few, so remove outliers
housing <- housing[housing$Units < 1000, ]

# name the first model
house1 <- lm(ValuePerSqFt ~ Units + SqFt + Boro, data=housing)
summary(house1)

library(coefplot)
coefplot(house1)
# seek coefficients with CI > 0
# let's try other models
house2 <- lm(ValuePerSqFt ~ Units*SqFt + Boro, data=housing)
coefplot(house2)

house3 <- lm(ValuePerSqFt ~ Units:SqFt, data=housing)
coefplot(house3)

house4 <- lm(ValuePerSqFt ~ SqFt*Units*Income, housing)
coefplot(house4)

house5 <- lm(ValuePerSqFt ~ Class*Boro, housing)
coefplot(house5)

house6 <- lm(ValuePerSqFt ~ I(SqFt/Units) + Boro, housing)
coefplot(house6)

house7 <- lm(ValuePerSqFt ~ I(Units + SqFt)^2, housing)
coefplot(house7)

# plot multiple models
multiplot(house1, house2, house3)

# now let's use a regression model for prediction

housingNew <- read.table("http://www.jaredlander.com/data/housingNew.csv", sep = ",", header = TRUE, stringsAsFactors = FALSE)

housePredict <- predict(house1, newdata=housingNew, se.fit=TRUE, interval="prediction", level=0.95)

# logistic regression
# modelling a yes/no response

# lets grab some data
acs <- read.table("http://www.jaredlander.com/data/acs_ny.csv", sep = ",", header = TRUE, stringsAsFactors = FALSE)

acs$Income <- with(acs, FamilyIncome >= 150000)
names(acs)[length(acs)] <- "Income" # error in names in data fixed

ggplot(acs) +
    aes(x=FamilyIncome) +
    geom_density(fill="grey", color="blue") +
    geom_vline(xintercept=150000, color="red") +
    scale_x_continuous(label=multiple.dollar, limits=c(0,1000000)) +
    ggtitle("Density of National Income")

# fit some glms
income1 <- glm(Income ~ HouseCosts + NumWorkers + OwnRent +
                   NumBedrooms + FamilyType,
               data=acs, family=binomial(link="logit"))

# summary of data and coefplot
summary(income1)
coefplot(income1)
# shows that OwnRentOutright is the most positive coefficient in set.

income1$coefficients
#this shows scale of coefficients is still on logit scale. want to return scale back to original for
#further understanding.
invlogit <- function(x) {
    1/(1 + exp(-x))
}

invlogit(income1$coefficients)
# now back on normal P scale

# Poisson regression
# models count data, number of children, accidents, errors, etc.

# make a plot of number of children
ggplot(acs) +
    aes(x=NumChildren) +
    geom_histogram(binwidth=1)

# appears close to poisson, so fit a glm poisson
children1 <- glm(NumChildren ~ FamilyIncome + FamilyType + OwnRent,
                 data=acs, family=poisson(link="log"))

summary(children1)
coefplot(children1)

# for a nice poisson fit, we need to check for overdipsersion
z <- (acs$NumChildren - children1$fitted.values) /
    sqrt(children1$fitted.values)
sum(z^2) / children1$df.residual
# > 1, considered no overdispersion
# one more test
pchisq(sum(z^2), df=children1.df)
# does indicate overdispersion, so let's refit poisson
children2 <- glm(NumChildren ~ FamilyIncome + FamilyType + OwnRent,
                 data=acs, family=quasipoisson(link="log"))

# let us compare the two models
multiplot(children1, children2)

# Analyze survival data

library(survival)

head(bladder)
# in this dataset there are censored data that we need to take into account to not
# over-fit. Need to find events (whether there was a reccurrence) and stop (if they dropped or something else).
# event = 1 is the area of concern

survObject <- with(bladder[100:105, ] Surv(stop, event))

# fit a model to see if treatment was significant

cox1 <- coxph(Surv(stop, event) ~ rx + number + size + enum, data=bladder)
summary(cox1)
coefplot(cox1)
plot(survfit(cox1), xlab="Days", ylab="Survival Rate", conf.int=TRUE)

# in this analysis, we have munged real and placebos together. Let's separate them
cox2 <- coxph(Surv(stop, event) ~  strata(rx) + number + size + enum, data=bladder)
summary(cox2)
plot(survfit(cox2), xlab="Days", ylab="Survival Rate", conf.int=TRUE, col=1:2)
legend("bottomleft", legend=c(1,2), lty=1, col=1:2, text.col=1:2, title="rx")

# test proportionality
cox.zph(cox1)
cox.zph(cox2)

# Model to predict number of events rather than just time to event
# use a different dataset with start and stop times
ag1 <- coxph(Surv(start, stop, event) ~ rx + number + size + enum +
                 cluster(id), data=bladder2)
ag2 <- coxph(Surv(start, stop, event) ~ strata(rx) + number + size + enum +
                 cluster(id), data=bladder2)
plot(survfit(ag1), conf.int = TRUE)
plot(survfit(ag2), conf.int = TRUE, col=1:2)
legend("topright", legend=c(1,2), lty=1, col=1:2, text.col=1:2, title="rx")

# assess model quality with residuals

# fit a lm on housing data
house1 <- lm(ValuePerSqFt ~ Units + SqFt + Boro, data=housing)
# residual diagnostic info available with fortify function
head(fortify(house1))

ggplot(aes(x=.fitted, y=.resid), data=house1) +
    geom_point() +
    geom_hline(yintercetp = 0) +
    geom_smooth(se=FALSE) +
    labs(x="Fitted Values", y="Residuals") +
    geom_point(aes(color=Boro))
# Q-Q plot
# using base graphics
plot(house1, which=2)
# note that we get deviance from the straight fit, especially at the tails. Indicates a poor fit
# recreate same plot in ggplot
ggplot(house1) +
    aes(sample=.stdresid)) +
    stat_qq() +
    geom_abline()

#want residuals to be normally distributed, so lets make a histogram of them
ggplot(house1) +
    aes(x=.resid) +
    geom_histogram()

#not quite as random as we would like.

# lets construct several models to compare

house1 <- lm(ValuePerSqFt ~ Units + SqFt + Boro, housing)
house2 <- lm(ValuePerSqFt ~ Units * SqFt + Boro, housing)
house3 <- lm(ValuePerSqFt ~ Units + SqFt * Boro + Class, housing)
house4 <- lm(ValuePerSqFt ~ Units + SqFt * Boro + SqFt*Class, housing)
house5 <- lm(ValuePerSqFt ~ Boro + Class, housing)

multiplot(house1, house2, house3, house4, house5, pointSize = 2)

# now lets get some numerical analysis with anova

anova(house1, house2, house3, house4, house5)

#Low RSS is a good indicator of quality, but also could be also a problem with overfitting with multiple variables
#Let's use AIC/BIC for multiple coefficients to penalize for complexity

AIC(house1, house2, house3, house4, house5)
BIC(house1, house2, house3, house4, house5)

# Anova, AIC and BIC all point to house4

# when working with glms, we don't use residuals, but rather deviance.
# let's build up five glms and compare them with deviance.

housing$HighValue <- housing$ValuePerSqFt >= 150 # returns T/F for those observations

high1 <- glm(HighValue ~ Units + SqFt + Boro, housing, family=binomial(link="logit"))
high2 <- glm(HighValue ~ Units * SqFt + Boro, housing, family=binomial(link="logit"))
high3 <- glm(HighValue ~ Units + SqFt * Boro + Class, housing, family=binomial(link="logit"))
high4 <- glm(HighValue ~ Units + SqFt * Boro + SqFt*Class, housing, family=binomial(link="logit"))
high5 <- glm(HighValue ~ Boro + Class, housing, family=binomial(link="logit"))

# now look at deviances

anova(high1, high2, high3, high4, high5)
AIC(high1, high2, high3, high4, high5)
BIC(high1, high2, high3, high4, high5)

# Now lets validate with k-fold validation
# with a K=10, we can train on 9, test on 1, and track the errors, then rotate.

library(boot)

# build a model
houseG1 <- glm(ValuePerSqFt ~ Units + SqFt + Boro, data=housing, family=gaussian(link="identity"))

# now cross validate
houseCV1 <- cv.glm(housing, houseG1, K=5)
houseCV1$delta #validated error and adjusted validated error

# errors are similar, so we can leave out leave-1-out cross validation
# this is useful for comparing one model to another

houseG2 <- glm(ValuePerSqFt ~ Units*SqFt + Boro, data=housing, family=gaussian(link="identity"))
houseG3 <- glm(ValuePerSqFt ~ Units + SqFt*Boro + Class, data=housing, family=gaussian(link="identity"))
houseG4 <- glm(ValuePerSqFt ~ Units + SqFt*Boro + SqFt*Class, data=housing, family=gaussian(link="identity"))
houseG5 <- glm(ValuePerSqFt ~ Boro + Class, data=housing, family=gaussian(link="identity"))

houseCV2 <- cv.glm(housing, houseG2, K=5)
houseCV3 <- cv.glm(housing, houseG3, K=5)
houseCV4 <- cv.glm(housing, houseG4, K=5)
houseCV5 <- cv.glm(housing, houseG5, K=5)

# Now, with the cross validation performed and saved, lets place results in a single df for analysis

cvResults <- as.data.frame(rbind(houseCV1$delta, houseCV2$delta,
                                 houseCV3$delta, houseCV4$delta, houseCV5$delta))

names(cvResults) <- c("Error", "Adjusted Error")
cvResults$Model <- sprintf("houseG%s", 1:5)

cvAnova <- anova(houseG1, houseG2, houseG3, houseG4, houseG5)
cvAIC <- AIC(houseG1, houseG2, houseG3, houseG4, houseG5)
cvBIC <- BIC(houseG1, houseG2, houseG3, houseG4, houseG5)

cvResults$Anova <- cvAnova$'Resid. Dev'
cvResults$AIC <- cvAIC$AIC
cvResults$BIC <- cvBIC$BIC

cvResults

# Estimate uncertainty with Bootstrap when there is no analytic solution
# calculate CI for batting averages

library(plyr)
#subset the data
baseball <- baseball[baseball$year >= 1990, ]

bat.avg <- function(data, indices=1:NROW(data), hits="h", at.bats="ab"){
    sum(data[indices, hits], na.rm=TRUE) /
        sum(data[indices, at.bats], na.rm=TRUE)
}

bat.avg(baseball)

# now we need uncertainty, so load bootstrap
library(boot)
avgBoot <- boot(data=baseball, statistic=bat.avg, R=1200, stype = "i")
avgBoot # this gives a standard error for the distribution
# now use bootstrap to make the CI
boot.ci(avgBoot, conf=.95, type="norm")
# let's build up a plot of these averages with the CI as vlines
ggplot() + geom_histogram(aes(x=avgBoot$t), fill="grey", color="grey") +
    geom_vline(xintercept=avgBoot$t0 + c(-1,1)*2*sqrt(var(avgBoot$t)), linetype=2)

# choose variables in a model with stepwise selection
# use housing data and step function in R
# build a simple model
nullModel <- lm(ValuePerSqFt ~ 1, data=housing)
fullModel <- lm(ValuePerSqFt ~ Units + SqFt*Boro + Boro*Class, housing)
houseStep <- step(nullModel,
                  scope=list(lower=nullModel, upper=fullModel),
                  direction="both")


#criar funcao que retorne a soma dos divisores proprios de um numero
somaDivisoresProprios <- function(n) {
  soma = 0
  for(i in 1:(n-1)) {
    if(n%%i == 0) {
      print(i)
      soma = soma + i
    }
  }
  return(soma)
}

numeroPerfeito <- function(n) {
  if(somaDivisoresProprios(n) == n) {
    return(TRUE)
  } else {
    return(FALSE)
  }
}

numerosAmigos <- function(a, b) {
  if(somaDivisoresProprios(a) == b & somaDivisoresProprios(b) == a) {
    return(TRUE)
  } else {
    return(FALSE)
  }
}


################################################################################
#This function calculates extraterrestrial solar radiation (radiation at the top
#of the earth's atmosphere, aka insolation) from day of the year and latitude.
#It is calculated separately for each day of the year.
#NB: Latitude should be in radians (not degrees).
#NB: Non-real values are produced for w (sunset hour angle) at times of the year
#and at latitudes where the sun never rises or sets. However, it makes sense to
#use just the real portion of the value, as it sets w to 0 in the winter and pi
#(~3.14) in the summer.
#Source: Allen et al. (1998)
################################################################################

calcRa <- function(jd,lat,nrow,ncol) {  #what follows is part of the function

#Calculate the earth-sun distance, which is a function solely of Julian day.  It is a single value for each day
d <- 1+(0.033*cos(2*pi*jd/365))

#Calculate declination, a function of Julian day.  It is a single value for each day.
dc <- 0.409*sin(((2*pi/365)*jd)-1.39)

#Pre-allocate the sunset hour angle (w) matrix
w <- matrix(NA,nrow,ncol)
#Calculate the sunset hour angle, a function of latitude and declination. Note that at v. high latitudes, this function can produce non-real values.
w[!is.na(lat)] <- as.matrix(Re(acos(as.complex(-1*tan(dc)*tan(lat[!is.na(lat)])))))

#Pre-allocate the Ra matrix
Ra <- matrix(NA,nrow,ncol)

#Calculate Ra using the above variables
#S is the solar constant and is =0.082 MJ/m2min
Ra[!is.na(lat)] <- as.matrix((24*60/pi)*d*0.082*(w[!is.na(lat)]*sin(lat[!is.na(lat)])*sin(dc)+cos(lat[!is.na(lat)])*cos(dc)*sin(w[!is.na(lat)])))
return(Ra)
} #this closes the function


sieve <- function(x){
  primes <- 2
  for(i in 2:x){
    s <- ceiling(sqrt(i))
    pflag <- TRUE
    for(p in primes[primes<=s]){
      pflag <- pflag & i %% p
    }
    if(pflag){
      primes <- c(primes,i)
    }
  }
  primes
}

is_prime <- function(x){
  if(x==2){
    return(TRUE)
  }
  s <- ceiling(sqrt(x))
  primes <- sieve(s)
  for(p in primes){
    if(x %% p ==0){
      return(FALSE)
    }
  }
  return(TRUE)
}

factorize <- function(x){
  s <- ceiling(sqrt(x))
  primes <- sieve(s)
  factorization <- c()
  while(x>1 & !is_prime(x)){
    for(p in primes){
      if(x%%p==0){
        factorization[length(factorization)+1] <- p
        x <- x/p
      }
    }
  }
  if(x==1){
    return(factorization)
  }
  c(factorization,x)
}


x <- c(1, 3, -5)
y <- c(4, -2, -1)

sum(x*y)  # compute products, then do the sum
x %*% y   # inner product

# loop implementation
dotp <- function(x, y) {
	n <- length(x)
	if(length(y) != n) stop("invalid argument")
	s <- 0
	for(i in 1:n) s <- s + x[i]*y[i]
	s
}

dotp(x, y)


## 1. A Review On Mutual Exclusivity ##

statement_1 <- FALSE
statement_2 <- TRUE
statement_3 <- TRUE

## 2. From Conditional to Marginal ##

p_spam <- 0.2388
p_secret_given_spam <- 0.4802
p_secret_given_non_spam <- 0.1284
p_non_spam <- 1 - p_spam
p_spam_and_secret <- p_spam * p_secret_given_spam
p_non_spam_and_secret <- p_non_spam * p_secret_given_non_spam
p_secret <- p_spam_and_secret + p_non_spam_and_secret

## 3. A General Formula ##

p_boeing <- 0.73
p_airbus <- 0.27
p_delay_given_boeing <- 0.03
p_delay_given_airbus <- 0.08

p_delay <- p_boeing*p_delay_given_boeing + p_airbus*p_delay_given_airbus

## 4. Extending Our Formula ##

p_boeing <- 0.62
p_airbus <- 0.35
p_erj <- 0.03
p_delay_boeing <- 0.06
p_delay_airbus <- 0.09
p_delay_erj <- 0.01
p_delay <- p_boeing*p_delay_boeing + p_airbus*p_delay_airbus + p_erj*p_delay_erj

## 6. Bayes' Theorem ##

p_boeing <- 0.73
p_airbus <- 0.27
p_delay_given_boeing <- 0.03
p_delay_given_airbus <- 0.08
p_delay <- p_boeing*p_delay_given_boeing + p_airbus*p_delay_given_airbus
p_airbus_delay <- (p_airbus * p_delay_given_airbus) / p_delay

## 7. Prior and Posterior Probability ##

p_spam <- 0.2388
p_secret_given_spam <- 0.4802
p_secret_given_non_spam <- 0.1284
# Exercise 1
p_non_spam <- 1 - p_spam
p_secret <- p_spam*p_secret_given_spam + p_non_spam*p_secret_given_non_spam
p_spam_given_secret <- (p_spam*p_secret_given_spam) / p_secret

# Exercise 2 and 3
prior <- p_spam
posterior <- p_spam_given_secret

# Exercise 4
ratio <- posterior/prior

Data Analyst in R/Step 5 - Probability and Statistics/4. Conditional Probability in R/3. Bayes Theorem.r


#######################################################
### Gamma distribution with Lambda = 8, Alpha = 0.5 ###
#######################################################

## Sample the samples
nSamples <- 10000
lambda = 8
alpha = 0.5
xVal <- rgamma(nSamples, shape=lambda, rate=alpha)

## Calculate characteristics
xA1 <- mean(xVal) # mean
xM2 <- mean((xVal - xA1)^2) # biased sample variance
xS2 <- nSamples * xM2 / (nSamples - 1) # unbiased sample variance
xSigma <- sd(xVal) # standard deviation (sqrt(m2))
xSem <- xSigma / sqrt(nSamples) # error of mean
xMed <- median(xVal) # median
xMax <- max(xVal) # max value
xMin <- min(xVal) # min value
xQuant <- quantile(xVal) # quantiles
xIqr <- IQR(xVal) # interquartile range
xM3 <- mean((xVal - xA1)^3) # third central moment
xGamma1 <- xM3 / xSigma^3 # skewness
xM4 <- mean((xVal - xA1)^4) # forth central moment
xGamma2 <- xM4 / xSigma^4 # kurtosis

## Parameter estimation (moment method)
print('################################')
# E[x] = lambda / alpha; D[x] = lambda^2 / alpha
alphaEstMM <- xA1 / xS2
lambdaEstMM <- xA1^2 / xS2
print(paste0('Estimated alpha (MM): ', alphaEstMM))
print(paste0('Estimated lambda (MM): ', lambdaEstMM))

## Parameter estimation (maximum likelihood)
library(dglm)
fit <- dglm(xVal~1, family=Gamma(link="log"), mustart=mean(xVal))
summary(fit)


ybar = 380          # sample mean
mu0 = 395             # hypothesized value
sigma = 35.2           # population standard deviation
n = 50                 # sample size
z = abs((ybar- mu0)/(sigma/sqrt(n)))
 # test statistic
print(z)
# We then compute the critical value at .01 significance level.
alpha = .01
# critical value
z.alpha = qnorm(1-alpha)
print(z.alpha)
# computing Beta for hypothesized value
Beta_onetailedtest<-pnorm(z.alpha-z)
print(Beta_onetailedtest)
# power for test
powerfortest<-1-Beta_onetailedtest
print(powerfortest)


LISP Interpreter Run

[[[[[

 Elementary Set Theory in LISP (finite sets)

]]]]]

[Set membership predicate:]

define (member? e[lement] set)
   [Is set empty?]
   if atom set [then] false [else]
   [Is the element that we are looking for the first element?]
   if = e car set [then] true [else]
   [recursion step!]
   [return] (member? e cdr set)

define      member?
value       (lambda (e set) (if (atom set) false (if (= e (car
             set)) true (member? e (cdr set)))))

(member? 1 '(1 2 3))

expression  (member? 1 (' (1 2 3)))
value       true

(member? 4 '(1 2 3))

expression  (member? 4 (' (1 2 3)))
value       false

[Subset predicate:]

define (subset? set1 set2)
   [Is the first set empty?]
   if atom set1 [then] true [else]
   [Is the first element of the first set in the second set?]
   if (member? car set1 set2)
      [then] [recursion!] (subset? cdr set1 set2)
      [else] false

define      subset?
value       (lambda (set1 set2) (if (atom set1) true (if (memb
            er? (car set1) set2) (subset? (cdr set1) set2) fal
            se)))

(subset? '(1 2) '(1 2 3))

expression  (subset? (' (1 2)) (' (1 2 3)))
value       true

(subset? '(1 4) '(1 2 3))

expression  (subset? (' (1 4)) (' (1 2 3)))
value       false

[Set union:]

define (union x y)
   [Is the first set empty?]
   if atom x [then] [return] y [else]
   [Is the first element of the first set in the second set?]
   if (member? car x y)
      [then] [return] (union cdr x y)
      [else] [return] cons car x (union cdr x y)

define      union
value       (lambda (x y) (if (atom x) y (if (member? (car x)
            y) (union (cdr x) y) (cons (car x) (union (cdr x)
            y)))))

(union '(1 2 3) '(2 3 4))

expression  (union (' (1 2 3)) (' (2 3 4)))
value       (1 2 3 4)

[Union of a list of sets:]

define (unionl l) if atom l nil (union car l (unionl cdr l))

define      unionl
value       (lambda (l) (if (atom l) nil (union (car l) (union
            l (cdr l)))))

(unionl '((1 2) (2 3) (3 4)))

expression  (unionl (' ((1 2) (2 3) (3 4))))
value       (1 2 3 4)

[Set intersection:]

define (intersection x y)
   [Is the first set empty?]
   if atom x [then] [return] nil [empty set] [else]
   [Is the first element of the first set in the second set?]
   if (member? car x y)
      [then] [return] cons car x (intersection cdr x y)
      [else] [return] (intersection cdr x y)

define      intersection
value       (lambda (x y) (if (atom x) nil (if (member? (car x
            ) y) (cons (car x) (intersection (cdr x) y)) (inte
            rsection (cdr x) y))))

(intersection '(1 2 3) '(2 3 4))

expression  (intersection (' (1 2 3)) (' (2 3 4)))
value       (2 3)

[Relative complement of two sets x and y = x - y:]

define (complement x y)
   [Is the first set empty?]
   if atom x [then] [return] nil [empty set] [else]
   [Is the first element of the first set in the second set?]
   if (member? car x y)
      [then] [return] (complement cdr x y)
      [else] [return] cons car x (complement cdr x y)

define      complement
value       (lambda (x y) (if (atom x) nil (if (member? (car x
            ) y) (complement (cdr x) y) (cons (car x) (complem
            ent (cdr x) y)))))

(complement '(1 2 3) '(2 3 4))

expression  (complement (' (1 2 3)) (' (2 3 4)))
value       (1)

[Cartesian product of an element with a list:]

define (product1 e y)
   if atom y
      [then] nil
      [else] cons cons e cons car y nil (product1 e cdr y)

define      product1
value       (lambda (e y) (if (atom y) nil (cons (cons e (cons
             (car y) nil)) (product1 e (cdr y)))))

(product1 3 '(4 5 6))

expression  (product1 3 (' (4 5 6)))
value       ((3 4) (3 5) (3 6))

[Cartesian product of two sets = set of ordered pairs:]

define (product x y)
   [Is the first set empty?]
   if atom x [then] [return] nil [empty set] [else]
   [return] (union (product1 car x y) (product cdr x y))

define      product
value       (lambda (x y) (if (atom x) nil (union (product1 (c
            ar x) y) (product (cdr x) y))))

(product '(1 2 3) '(x y z))

expression  (product (' (1 2 3)) (' (x y z)))
value       ((1 x) (1 y) (1 z) (2 x) (2 y) (2 z) (3 x) (3 y) (
            3 z))

[Product of an element with a list of sets:]

define (product2 e y)
   if atom y
      [then] nil
      [else] cons cons e car y (product2 e cdr y)

define      product2
value       (lambda (e y) (if (atom y) nil (cons (cons e (car
            y)) (product2 e (cdr y)))))

(product2 3 '((4 5) (5 6) (6 7)))

expression  (product2 3 (' ((4 5) (5 6) (6 7))))
value       ((3 4 5) (3 5 6) (3 6 7))

[Set of all subsets of a given set:]

define (subsets x)
   if atom x
      [then] '(()) [else]
      let y [be] (subsets cdr x) [in]
      (union y (product2 car x y))

define      subsets
value       (lambda (x) (if (atom x) (' (())) ((' (lambda (y)
            (union y (product2 (car x) y)))) (subsets (cdr x))
            )))

(subsets '(1 2 3))

expression  (subsets (' (1 2 3)))
value       (() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))

length (subsets '(1 2 3))

expression  (length (subsets (' (1 2 3))))
value       8

(subsets '(1 2 3 4))

expression  (subsets (' (1 2 3 4)))
value       (() (4) (3) (3 4) (2) (2 4) (2 3) (2 3 4) (1) (1 4
            ) (1 3) (1 3 4) (1 2) (1 2 4) (1 2 3) (1 2 3 4))

length (subsets '(1 2 3 4))

expression  (length (subsets (' (1 2 3 4))))
value       16

End of LISP Run

Elapsed time is 0 seconds.


# Example : 1   Chapter : 6.4     Page No: 331
# Eigen Values and Eigen vectors of A
A<-matrix(c(1,2,2,4),ncol=2)
lambda<-eigen(A)$values
x<-eigen(A)$vectors #These are Normalised eigen vectors
#to get eigen vectors in textbook
x[,1]<-x[,1]*(1/x[1,1])
x[,2]<-x[,2]*(2/x[1,2])
print("Eigen values and eigen vectors of respective eigen values of A")
print(lambda)
print(x)
#The  answer may slightly vary due to  rounding off values
#The answers provided in the text book may vary because of the computation process
#Both answers are correct , here it is taken -Ax+b=0 , In the text book it is considered as Ax-b=0


#  the 95% confidence level would imply the 97.5th percentile of the normal distribution at the upper tail
zstar <-qnorm(.975)
# standard deviation
 sd <- 125
 #  level of accuracy
 E <- 25
sample_size<- zstar^2 * sd * sd/ E^2
 print(ceiling(sample_size))
 # A sample size of 97 or larger is recommended to obtain an estimate of the mean textbook


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})
f2 <- (function(x) {1/x})
f3 <- (function(x) {x})
f4 <- (function(x) {x})

integrate.simpsons(f1,0,1,100) #0.25
integrate.simpsons(f2,1,100,1000) # 4.60517
integrate.simpsons(f3,0,5000,5000000) # 12500000
integrate.simpsons(f4,0,6000,6000000) # 1.8e+07

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


## Author: Sergio García Prado
## Title: Statistical Inference - Goodness of Fit - Exercise 13

rm(list = ls())

observed <- c(1, 10, 20, 36, 23, 10)

(k <- length(observed))
# 6

(n <- sum(observed))
# 100

## common p = 0.5

(expected.equilibred <- n * dbinom(0:(k - 1), size = k - 1, prob = 0.5))
# 3.125 15.625 31.25 31.25 15.625 3.125

(Q.equilibred <- sum((observed - expected.equilibred)  ^ 2 / expected.equilibred))
# 26.848

(pvalue.equilibred <- 1 - pchisq(Q.equilibred, k - 1))
# 6.10645404716115e-05

## common p

(p.hat <- sum(observed * 0:(k - 1)) / (n * (k - 1)))
# 0.6

(expected.common <- n * dbinom(0:(k - 1), size = k - 1, prob = p.hat))
# 1.024 7.68 23.04 34.56 25.92 7.776

(Q.common <- sum((observed - expected.common)  ^ 2 / expected.common))
# 2.12753986625515

(pvalue.common <- 1 - pchisq(Q.common, (k - 1) - 1))
# 0.712314637750688


p_d1=0.028
p_d2=0.012
p_d3=0.032
p_d4=0.928
p_a4_d1=0.02
p_a4_d2=0.09
p_a4_d3=0.10
p_a4_d4=0.95
#  the probabilities that the board has no defect or a D1, D2, or D3 type of defect
p_nodefect_or_d1=(p_d1*p_a4_d1)/((p_d1*p_a4_d1)+(p_d2*p_a4_d2)+(p_d3*p_a4_d3)+(p_d4*p_a4_d4))
print(p_nodefect_or_d1)

p_nodefect_or_d2=(p_d2*p_a4_d2)/((p_d1*p_a4_d1)+(p_d2*p_a4_d2)+(p_d3*p_a4_d3)+(p_d4*p_a4_d4))
print(p_nodefect_or_d2)

p_nodefect_or_d3=(p_d3*p_a4_d3)/((p_d1*p_a4_d1)+(p_d2*p_a4_d2)+(p_d3*p_a4_d3)+(p_d4*p_a4_d4))
print(p_nodefect_or_d3)

p_nodefect_or_d4=(p_d4*p_a4_d4)/((p_d1*p_a4_d1)+(p_d2*p_a4_d2)+(p_d3*p_a4_d3)+(p_d4*p_a4_d4))
print(p_nodefect_or_d4)


x=c(14.6, 14.8, 15.2, 15.7, 17.0,  17.5, 17.3, 16.8, 15.4, 15.0, 14.4, 14.5, 15.0, 15.1, 15.0, 14.9, 14.6, 13.9, 13.8, 13.5, 13.1, 13.0, 13.1, 13.0, 12.8, 12.3, 11.9, 11.7, 11.5, 11.3, 10.9, 10.8, 10.6, 10.6, 10.1, 9.7, 9.3, 9.6, 9.7, 9.9, 10.0, 9.7, 9.10, 8.60, 8.0, 7.55, 7.3, 7.70, 8.00,  8.40, 8.90,  9.80)
y=c(14.7, 12.3, 11.0, 10.2, 8.20,  6.70, 6.60, 6.80, 8.30, 8.80, 9.10, 8.80, 6.30, 5.50, 5.00, 4.70, 4.60, 5.40, 5.80, 6.90, 8.20, 7.60, 5.2, 4.50, 4, 4.2, 5.70, 7.00, 7.80, 8.30, 7.30, 6.70, 5.50, 5.50, 4.60, 4.4, 5.5, 7.2, 7.8, 8.60, 9.40, 10.0, 10.7, 9.9, 9.25, 9.1, 9.3, 11.7, 12.3,  13.0, 13.7,  15.5)

plot(x,-y, pch=19, cex=1, col = "red", asp=1,xlab="X", ylab="Y", main="Diagrama ")

Interpolacion <- function(x,y) {

  a = rep(y)
  n = length(x)

  h <- (c(x,0) - c(0,x))[2:n]
  alph <- (3/c(1,h,1,1)*(c(a,1,1) - c(1,a,1)) - 3/c(1,1,h,1)*(c(1,a,1)-c(1,1,a)))[3:n]

  A <- c(1,rep(0,times=n-1))
  for (i in 1:(n-2)) {
    A <- rbind(A,c( rep(0,times=i-1) , c(h[i],2*(h[i]+h[i+1]),h[i+1]) , rep(0,times=n-i-2) ) )
  }

  A <- rbind(A,c(rep(0,times=n-1),1))
  b <- c(0,alph,0)
  c <- solve(A, b)

  b <- ((c(a,0) - c(0,a))/c(1,h,1) - c(1,h,1)/3*(c(c,0) + 2*c(0,c)))[2:n]
  d <- ((c(c,0) - c(0,c))/(3*c(1,h,1)))[2:n]
  ans = rbind(a[1:n-1],b,c[1:n-1],d)
}

draw <- function(x,y) {
  t = 1:length(x)
  sx = Interpolacion(t,x)
  sy = Interpolacion(t,y)

  for (i in 1:(length(t)-1)) {
    dat<- data.frame(t=seq(t[i],t[i+1], by=0.1) )
    fx <- function(x) (sx[1,i] + sx[2,i]*(x-t[i]) + sx[3,i]*(x-t[i])^2 + sx[4,i]*(x-t[i]))
    fy <- function(x) (sy[1,i] + sy[2,i]*(x-t[i]) + sy[3,i]*(x-t[i])^2 + sy[4,i]*(x-t[i]))

    dat$y=fy(dat$t)
    dat$x=fx(dat$t)
    points(dat$x,dat$y,type='l', col='red')
  }
}
draw(x,-y)


# Computing binomial normal marginal
# using 16-point Gaussian quadrature

xi<- c(.0950125098,.2816035507,.4580167776,.6178762444,
      .7554044083,.8656312023,.9445750230,.9894009439)
xi<- c(-xi[8:1],xi)
wi<- c(.1894506104,.1826034150,.1691565193,.1495959888,
      .1246289712,.0951585116,.0622535239,.0271524594)
wi<- c(wi[8:1],wi)

dbinorm<- function(x,n,p,sig){
  th <- log(p/(1-p))
  u<- xi*4*sig
   pu <- exp(th+u)/(1+exp(th+u))
   pu<- ifelse(pu<exp(-25),exp(-25),pu)
   pu<- ifelse(pu>1-exp(-25),1-exp(-25),pu)
   probu<- dbinom(x,n,pu)*dnorm(u,0,sig)
   4*sig*sum(wi*probu)
  }

# 32-point gaussian quadrature

dbinorm32<- function(x,n,p,sig){
xi<- c(.0483076656,.1444719615,.2392873622,.3318686022,
         .4213512761,.5068999089,.5877157572,.6630442669,
         .7321821187,.7944837959,.8493676137,.8963211557,
         .9349060759,.9647622555,.9856115115,.9972638618)
  xi<- c(-xi[16:1],xi)
wi<- c(.0965400885,.0956387200,.0938443990,.0911738786,
          .0876520930,.0833119242,.0781938957,.0723457941,
          .0658222227,.0586840934,.0509980592,.0428358980,
          .0342738629,.0253920653,.0162743947,.0070186100)
  wi<- c(wi[16:1],wi)
th <- log(p/(1-p))
  u<- xi*4*sig
pu <- exp(th+u)/(1+exp(th+u))
   pu<- ifelse(pu<exp(-25),exp(-25),pu)
   pu<- ifelse(pu>1-exp(-25),1-exp(-25),pu)
   probu<- dbinom(x,n,pu)*dnorm(u,0,sig)
   4*sig*sum(wi*probu)
  }

# example:
xprob<-NULL
for (i in 0:16){
  a<- dbinorm32(i,16,0.5,4)
  xprob<- c(xprob,a)
}
#plot(xprob,ylim=c(0,.25))