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)


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")


#!/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


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


# 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


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


#
# 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)
}


HaversineDistance=function(lat1,lon1,lat2,lon2)
{

	#returns the distance in km
	REarth<-6371
	lat<-abs(lat1-lat2)*pi/180
	lon<-abs(lon1-lon2)*pi/180
	lat1<-lat1*pi/180
	lat2<-lat2*pi/180
	a<-sin(lat/2)*sin(lat/2)+cos(lat1)*cos(lat2)*sin(lon/2)*sin(lon/2)
	d<-2*atan2(sqrt(a),sqrt(1-a))
	d<-REarth*d

	return(d)

}

RMSE<-function(pre,real)
{
	return(sqrt(mean((pre-real)*(pre-real))))
}

meanHaversineDistance<-function(lat1,lon1,lat2,lon2)
{
	return(mean(HaversineDistance(lat1,lon1,lat2,lon2)))
}

#USAGE
#
#FUNCTION PARAMETERS: @submission,@answers
#@submission: path+filename containing the answers to submit in CSV format
#@answers: path+filename containing the answers to evaluate the submission in CSV format
travelTime.PredictionEvaluation<-function(submission,answers)
{
	dt<-read.csv(submission)
	tt_sub<-dt[,2]
	dt<-read.csv(answers)
	tt_real<-dt[,2]
	return (RMSE(tt_sub,tt_real))
}

#USAGE
#
#FUNCTION PARAMETERS: @submission,@answers
#@submission: path+filename containing the answers to submit in CSV format
#@answers: path+filename containing the answers to evaluate the submission in CSV format
destinationMining.Evaluation<-function(submission,answers)
{
	dt<-read.csv(submission)
	lat_sub<-dt[,2]
	lon_sub<-dt[,3]
	dt<-read.csv(answers)
	lat_real<-dt[,2]
	lon_real<-dt[,3]
	return (meanHaversineDistance(lat_sub,lon_sub,lat_real,lon_real))
}


## Vamos ilustrar o exemplo da proporção de itens defeitusos dado em De Groot, seção 7.4

n <- 100 #! Dica: mude o tamanho de amostra e veja o que acontece
y <- 10 #! Dica: mude o número de itens defeituosos e veja o que acontece com as posterioris

prior1 <- function(theta) dbeta(x = theta, shape1 = 1, shape2 = 1)
prior2 <- function(theta) dbeta(x = theta, shape1 = 1, shape2 = 2)

posterior1 <- function(theta) dbeta(x = theta, shape1 = 1 + y, shape2 = 1 + (n - y))
posterior2 <- function(theta) dbeta(x = theta, shape1 = 1 + y, shape2 = 2 + (n -y))

curve(prior1, xlab = expression(theta), ylab = "Density", lwd = 3, lty  = 1, ylim = c(0, 15))
curve(prior2, lwd = 3, lty = 2, col = "red", add = TRUE)
curve(posterior1, lwd = 3, add = TRUE)
curve(posterior2, lwd = 3, col = "red", lty = 2, add = TRUE)
abline(v = y/n, lty = 3, lwd = 3)
legend(x = "topright", legend = c("Prior/Posterior 1", "Prior/Posterior 2"),
       col = c("black", "red"), lty = 1:2, bty = 'n')


#  the 99% confidence level would imply the 99.5th percentile of the normal distribution at the upper tail
zstar <- qnorm(0.995)
width_interval<-0.50
E<-width_interval/2
sd<-0.75
sample_size<- zstar^2 * sd * sd/ E^2
print(ceiling(sample_size))
# the federal agency must obtain a random sample of 60 cereal cartons to estimate .


library(data.table)
library(ggplot2)

N <- 1000
Xbar <- numeric(N) # space for results

for( i in 1:n)
{
  x <- rexp(100, rate = 1/15) # draw random sample of size 100
  Xbar[i] <- mean(x)
}

hist(Xbar)

qqnorm(Xbar)
qqline(Xbar)

mean(Xbar)
sd(Xbar)

maxY <- numeric(N)

for( i in 1:N)
{
  y <- runif(12) # draw random sample of size 12
  maxY[i] <- max(y)
}

hist(maxY)

X <- rpois(10^4, 5) # Draw 10^4 values from Pois(5)
Y <- rpois(10^4, 12) # Draw 10^4 values from Pois(12)

W <- X + Y

hist(W, prob = T) # prob = T, scales hist to 1
lines(2:35, dpois(2:35, 17), type = "b")

mean(W)
var(W)

sd(W) / sqrt(N)

Xbar <- numeric(N)

for( i in 1:N )
{
  x <- rgamma(30, shape = 5, rate = 2)
  Xbar[i] <- mean(x)
}

hist(Xbar)

qqnorm(Xbar)
qqline(Xbar)

mean(Xbar)
sd(Xbar)

mean(Xbar > 3)

# work

p <- c(3, 4, 6, 6)

sample.size <- 2
perm <- permutations( length(p), sample.size, repeats.allowed = T)

d <- data.table( c1 = p[perm[, 1]], c2 = p[perm[, 2]])
d[, m := (c1 + c2) / 2]

( 3 - 5/2 ) / (sqrt(5/2^2) / sqrt(30))

pnorm(2.44949, lower.tail = F)

z <- (0.53333 - 0.5) / 0.0289
pbinom(z, prob = .5, size = 300, lower.tail = T)

pbinom(160, size = 300, prob = .5, lower.tail = T)


# Goal: Utilise matrix notation
#       We use the problems of portfolio analysis as an example.

# Prices of 4 firms to play with, at weekly frequency (for calendar 2004) --
p <- structure(c(300.403, 294.604, 291.038, 283.805, 270.773, 275.506, 292.271, 292.837, 284.872, 295.037, 280.939, 259.574, 250.608, 268.84, 266.507, 263.94, 273.173, 238.609, 230.677, 192.847, 219.078, 201.846, 210.279, 193.281, 186.748, 197.314, 202.813, 204.08, 226.044, 242.442, 261.274, 269.173, 256.05, 259.75, 243, 250.3, 263.45, 279.5, 289.55, 291.95, 302.1, 284.4, 283.5, 287.8, 298.3, 307.6, 307.65, 311.9, 327.7, 318.1, 333.6, 358.9, 385.1, 53.6, 51.95, 47.65, 44.8, 44.85, 44.3, 47.1, 44.2, 41.8, 41.9, 41, 35.3, 33.35, 35.6, 34.55, 35.55, 40.05, 35, 34.85, 28.95, 31, 29.25, 29.05, 28.95, 24.95, 26.15, 28.35, 29.4, 32.55, 37.2, 39.85, 40.8, 38.2, 40.35, 37.55, 39.4, 39.8, 43.25, 44.75, 47.25, 49.6, 47.6, 46.35, 49.4, 49.5, 50.05, 50.5, 51.85, 56.35, 54.15, 58, 60.7, 62.7, 293.687, 292.746, 283.222, 286.63, 259.774, 259.257, 270.898, 250.625, 242.401, 248.1, 244.942, 239.384, 237.926, 224.886, 243.959, 270.998, 265.557, 257.508, 258.266, 257.574, 251.917, 250.583, 250.783, 246.6, 252.475, 266.625, 263.85, 249.925, 262.9, 264.975, 273.425, 275.575, 267.2, 282.25, 284.25, 290.75, 295.625, 296.25, 291.375, 302.225, 318.95, 324.825, 320.55, 328.75, 344.05, 345.925, 356.5, 368.275, 374.825, 373.525, 378.325, 378.6, 374.4, 1416.7, 1455.15, 1380.97, 1365.31, 1303.2, 1389.64, 1344.05, 1266.29, 1265.61, 1312.17, 1259.25, 1297.3, 1327.38, 1250, 1328.03, 1347.46, 1326.79, 1286.54, 1304.84, 1272.44, 1227.53, 1264.44, 1304.34, 1277.65, 1316.12, 1370.97, 1423.35, 1382.5, 1477.75, 1455.15, 1553.5, 1526.8, 1479.85, 1546.8, 1565.3, 1606.6, 1654.05, 1689.7, 1613.95, 1703.25, 1708.05, 1786.75, 1779.75, 1906.35, 1976.6, 2027.2, 2057.85, 2029.6, 2051.35, 2033.4, 2089.1, 2065.2, 2091.7), .Dim = c(53, 4), .Dimnames = list(NULL, c("TISCO", "SAIL", "Wipro", "Infosys")))
# Shift from prices to returns --
r <- 100*diff(log(p))

# Historical expected returns --
colMeans(r)
# Historical correlation matrix --
cor(r)
# Historical covariance matrix --
S <- cov(r)
S

# Historical portfolio variance for a stated portfolio of 20%,20%,30%,30% --
w <- c(.2, .2, .3, .3)
t(w) %*% S %*% w

# The portfolio optimisation function in tseries --
library(tseries)
optimised <- portfolio.optim(r)         # This uses the historical facts from r
optimised$pw                            # Weights
optimised$pm                            # Expected return using these weights
optimised$ps                            # Standard deviation of optimised port.

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


N <- 100000
eigenValues <- matrix(nrow=N, ncol=2)

for (i in 1:N) {
	rand <- runif(3, min=-1, max=1)
	m <- matrix(nrow=2, ncol=2)
	m[1,1] <- rand[1]
	m[1,2] <- rand[2]
	m[2,1] <- rand[2]
	m[2,2] <- rand[3]
	e <- eigen(m)
	e$values <- c(min(e$values), max(e$values))
	eigenValues[i,] <- e$values
}

print(eigenValues[,1])

hist(eigenValues[,1], col=rgb(0.8, 0, 0, alpha=0.3), xlab="eigenvalue", ylab="frequency", main="frequency of eigenvalues")
hist(eigenValues[,2], col=rgb(0, 0.8, 0, alpha=0.5), add=T)

# Wikipedia [Positive-definite matrix]
# "The following properties are equivalent to M being positive definite:
# All its eigenvalues are positive."

posdef <- length(eigenValues[eigenValues[,1] > 0,])
print(paste('Absolute # of positive-definite matrices:', posdef))
print(paste('Relative # of positive-definite matrices:', 100 * posdef / N, '%'))


# Example : 1   Chapter : 4.2     Page No: 208
# Projection of the vector onto line

#Answers to this problem are displayed in the form of x/y in textbook
#Here the same answers are in decimal formats

projection<-function(b,a){
  xhat<-(sum(a*b))/(sum(a*a))
  p<-xhat*a
  return(p)
}
b<-c(1,1,1)
a<-c(1,2,2)
p<-projection(b,a)
print("The projection vector p i.e., b on a is ")
print(p)
e<-b-p
print("The error vector is ")
print(e)
if(sum(e*a)==0){
  print("Vector e is perpendicular to a")
}
#The  answer may slightly vary due to  rounding off values


rm(list = ls()) # clear console

# ADETAYO ADEGOKE
# WEEK 02 Homework - Foundations of probablity for finite sample spaces
# Due: February 10, 2020
# Mathematics E-23c, Spring 2020
# Michael Liotti Office Hour Review

# Questions 1 (a)

# Creating two columns representing the quiz scores
# Both quizes have 0.25 probablity of getting 100 and 0.75 probablity of getting 0
Q1 <- c(100,0,0,0)
Q2 <- Q1

# create the dataframe with colmns Q1 and Q2.  It should have 16 rows
ttbl <- expand.grid(Q1, Q2); ttbl
Q1 < - ttbl$Var1; Q2 <- ttbl$Var2
ttbl <- data.frame(Q1, Q2); ttbl # rename the columns

# Question 1 (b)

# Column X is the random variable the average of the quiz scores: 100, 50 or 0
X = (Q1 + Q2)/2
ttbl$X <- X; ttbl

# Column Y is the improvement rating random variable
# Y is 0 if Quiz 2 score is worse
# Y is 1 if Quiz 1 and 2 scores are the same
# Y is 2 if Quiz 2 score is better
Y <- ifelse(Q2 < Q1, 0, ifelse(Q2==Q1,1,2)); Y
ttbl$Y <- Y; ttbl

# Question 1 (c)

# X and Y are uncorrelated if E(XY) - E(X)E(Y) = 0
# Check to see if this is true
(mean(X*Y) - (mean(X) * mean(Y))) == 0 # True, hence X and Y random variables are uncorrelated

# Question 1 (d)

# X and Y are independent if E(X^2 * Y^2) - E(X^2)E(Y^2) = 0
# Check to see if this is true
(mean((X^2) * (Y^2)) - (mean(X^2) * mean(Y^2))) == 0 # False, hence X and Y random variables are not independent

# Question 1 (e)

A <- ifelse(X < Q2, 1, 0) # create an indicator random variable involving X
B <- ifelse((Y == 0) | (Y == 1), 1, 0) # create an indicator random variable involving Y
ttbl$A <- A; ttbl$B <-B; ttbl # add these variables to the dataframe
PAandB <- sum(A*B) / nrow(ttbl); PAandB
PA <- sum(A) / nrow(ttbl); PA # find the probability of A
PB <- sum(B) / nrow(ttbl); PB # find the probability of B
PAandB == (PA * PB) # False, hence X and Y random variables are not independent

# Question 2 (a)

rm(list = ls()) # clear console

# Checking question 4 in the pencil and paper homework (pnp hw)
# m = 6, n = 20, k = 13

# Checking P(X = 3) using dhyper() and comparing with our computation in pnp hw
dhyper(3, 6, 20, 13) # result is 0.3552795
(choose(6, 3) * choose(20, 10)) / choose(26, 13) # result is 0.3552795
# We have a match!

# Checking P(X = 2) using dhyper() and comparing with our computation in pnp hw
dhyper(2, 6, 20, 13) # result is 0.242236
(choose(6, 2) * choose(20, 11)) / choose(26, 13) # result is 0.242236
# We have a match!

# Checking P(X = 1) using dhyper() and comparing with our computation in pnp hw
dhyper(1, 6, 20, 13) # result is 0.07267081
(choose(6, 1) * choose(20, 12)) / choose(26, 13) # result is 0.07267081
# We have a match!

# Checking P(X = 0) using dhyper() and comparing with our computation in pnp hw
dhyper(0, 6, 20, 13) # result is 0.007453416
(choose(6, 0) * choose(20, 13)) / choose(26, 13) # result is 0.007453416
# We have a match!

# Question 2 (b)

m <- 6 # number of trump cards - type 1 objects
n <- 20 # number of non-trump cards - type 2 objects
k <- 13 # number of cards in hand

Player <- c(rep("EAST", k), rep("WEST", m + n - k)); Player # create the ownership column
Trumps <- c(rep(TRUE, 6), rep(FALSE, 20)); Trumps

# Set up key variables for running the simulation to estimate P(X = 3)
N <- 10000
X <- numeric(N)

# Execute the simulation
for (i in 1:N){
  scramble <- sample(Trumps, m + n, replace = FALSE)  #permute the trumps
  X[i] <- sum((Player == "EAST") & scramble)
}
(table(X)[4])/N    # 0.3562, which is really close to results computed earlier on of 0.3552795

# Question 2 (c)

# Setup the second column so that East has two trumps
East <- c(rep(TRUE, k), rep(FALSE, m + n - k)); East # create the ownership column
Trumps <- c(rep(TRUE, 2), rep(FALSE, 20), rep(TRUE, 4))

# Contigency Table
table(East, Trumps)

# Running the Fisher exact testto find the probability that East has two or more trumps
fisher.test(East, Trumps, alternative = "g")
# The test has a p-value of 0.9199, which is the probablity that East has two or more trumps

# Computing dhyper() to compare results above to
# Note that P(X >= 2) = 1 - P(X < 2) = 1 - P(X <= 1) since X must be an integer
1 - phyper(1, 6, 20, 13) # computest to 0.9198758 which is close to the the fisher.test results above of 0.9199

# Question 3 (a)

rm(list = ls()) # clear console

# load the input file
setwd("/Users/adegade/OneDrive/Documents/Education/Harvard/Software Engineering/Spring-2020-MATH-E-23C/Homework")
NC <- read.csv("NCBirths2004.csv"); head(NC)

idx <- which(NC$Gender == "Male") # create an index for extracting gender from the data set
mmbw <- mean(NC$Weight[idx]); mmbw # compute male babies mean birth weight - 3501.58

# doing a similar exercise for female babies
# another way to do this is fmbw <- mean(NC$Weight[-idx])
idx <- which(NC$Gender == "Female") # create an index for extracting gender from the data set
fmbw <- mean(NC$Weight[idx]); fmbw # compute female babies mean birth weight - 3398.317

wdiff <- mmbw - fmbw; diff # mean birth weight difference is 103.2632, just over 100

# Execute a permutation test to determine if the difference in mean shown above is statistically significant
N <- 10000 # number of experiements to run
diff <- numeric(N) # empty vector to store results

for (i in 1:N) {
  gender <- sample(NC$Gender) # permute the gender labels
  mbavg <- sum(NC$Weight * (gender == "Male")) / sum(gender == "Male"); mbavg # average weight for males
  fbavg <- sum(NC$Weight * (gender == "Female")) / sum(gender == "Female"); fbavg # average weight for females
  diff[i] <- mbavg - fbavg # store the average weight difference in the vector
}

mean(diff) # -0.06855603, which is close to 0
hist(diff, breaks = "FD")
abline(v= wdiff, col = "red") # observed difference is way out on the tail

pv1t <- (sum(diff >= wdiff) + 1) / (N + 1); pv1t # 1-tailed p-value is 0.00019998
pv2t <- pv1t * 2; pv2t # 2-tailed p value is 0.00039996

# The two-tailed p-value indicates that there is a very low chance that we could come by the observed differnece
# in mean birth weights by chance (only a probability of 0.00039996 which is a lot less than .05).  As such, we
# have sufficient evidence against the null hypothesis which is there no difference in the mean birth weights
# and instead suggest that the alternative hypothesis is true which is that there is indeed a difference in the
# mean birth weights.  The one-tailed p-value suggests that male babies do have a larger mean baby weight than
# female babies

# Question 3 (b)

# Determine whether tobacco use by the mother has a statisticallysignificant effect on birth weight

tb <- NC$Tobacco # extract the tobacco column
bw <- NC$Weight # extract the baby weight column

# Compute the average weight of babies whose mothers used tobacco
idxt <- which(NC$Tobacco == "Yes") # create an index for extracting tobacco use from the data set
bwt <- mean(bw[idxt]); mmbwt # compute the babies mean birth weight whose mothers used tobacco - 3256.91

# doing a similar exercise for female babies
# another way to do this is bwnt <- mean(bw[-idxt])
idxnt <- which(NC$Tobacco == "No") # create an index for extracting tobaco use from the data set
bwnt <- mean(bw[idxnt]); bwnt # compute the babies mean birth weight whose mothers did not use tobacco - 3471.912

wdifft <- bwnt - bwt; wdifft # mean birth weight difference is 215.0021

# Execute a permutation test to determine if the difference in mean shown above is statistically significant
N <- 10000 # number of experiements to run
difft <- numeric(N) # empty vector to store results
for (i in 1:N) {
  tobacco <- sample(tb) # permute the tobacco use labels
  tavg <- sum(bw * (tobacco == "Yes")) / sum(tobacco == "Yes"); tavg # average weight for babies whose mothers used tobacco
  ntavg <- sum(bw * (tobacco == "No")) / sum(tobacco == "No"); ntavg # average weight for babies whose mothers did not use tobacco
  difft[i] <- ntavg - tavg # store the average weight difference in the vector
}

mean(difft) # 0.6645301
hist(difft, breaks = "FD")
abline(v= wdifft, col = "blue") # observed difference is way out on the right tail

pv1tt <- (sum(difft >= wdifft) + 1) / (N + 1); pv1tt # 1-tailed p-value is 9.999e-05
pv2tt <- pv1tt * 2; pv2tt # 2-tailed p value is 0.00019998

# The two-tailed p-value indicates that there is a very low chance that we could come by the observed differnece
# in mean birth weights by chance (only a probability of 0.00019998 which is a lot less than .05).  As such, we
# have sufficient evidence against the null hypothesis which is there no difference in the mean birth weights
# and instead suggest that the alternative hypothesis is true which is that there is indeed a difference in the
# mean birth weights based on tobacco usage.  The one-tailed p-value suggests that babies whose mothers do not use
# tobacco have a mean baby weight that is larger than babies whose mothers do uses tobacco

# Question 4

rm(list = ls()) # clear console

# load the input file
setwd("/Users/adegade/OneDrive/Documents/Education/Harvard/Software Engineering/Spring-2020-MATH-E-23C/Homework")
Battle <- read.csv("Battle.csv"); head(Battle)

champs <- "MEZU"
swords <- "BRIG"
sset <- subset(Battle, (Battle$Abbr == champs | Battle$Abbr == swords))
score <- sset$Kills - sset$Lost

idxchamps <- which(sset$Abbr == champs) # create an index for extracting MEZU aka champs rows from the data set

msdiff <- mean(score[idxchamps]) - mean(score[-idxchamps]); msdiff # -14.69173 - mean score difference between champs and swordsmen

# Execute a permutation test to determine if the difference in mean shown above is statistically significant
N <- 10000 # number of experiements to run
diffms <- numeric(N) # empty vector to store results
numchamps <- sum(sset$Abbr == champs); numchamps

for (i in 1:N) {
  idxchamps <- sample(nrow(sset), numchamps)
  diffms[i] <- mean(score[idxchamps]) - mean(score[-idxchamps])
}

mean(diffms) # -0.03305469 which is close to 0
hist(diffms, breaks = "FD")
abline(v= msdiff, col = "purple")

pv1ms <- (sum(diffms <= msdiff) + 1) / (N + 1); pv1ms # 1-tailed p-value is 0.01689831
pv2ms <- pv1ms * 2; pv2ms # 2-tailed p value is 0.03379662

# The two-tailed p-value indicates that there is a low chance that we could come by the observed differnece
# in mean score (a probability of 0.03379662 which is less than .05).  As such, we have sufficient evidence
# against the null hypothesis which is there no difference in the unit superiority  and instead suggest that
# the alternative hypothesis is true which is that there is indeed a difference in the # unit superiority.
# The one-tailed p-value suggests that babies the swordsmen unit are more skilled than the champions unit in
# terms of kills - losses


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

rm(list = ls())

x <- c("B", "B", "B", "A", "A", "B", "A", "B", "B", "B", "B", "A", "B", "A", "A", "B", "A", "A", "A")

(n <- length(x))
# 19

(n.a <- sum(x == "A"))
# 9

(n.b <- n - n.a)
# 10

(W.a <- sum(which(x == "A")))
# 111

(W.ab <- W.a - n.a * (n.a + 1) / 2)
# 66

(W.ab.mean <- n.a * n.b / 2)
# 45

(W.ab.var <- n.a * n.b * (n + 1) / 12)
# 150

### H0: A(x) == B(x)
### H1: A(x) != B(x)

## Asymptotic pvalue (with continuity correction)
2 * (1 - pnorm(abs(W.ab + 0.5 * sign(W.ab.mean - W.ab) - W.ab.mean) / sqrt(W.ab.var)))
# 0.0941663754378799

## Exact Pvalue
2 * (1 - pwilcox(W.ab - (W.ab.mean < W.ab), n.a, n.b, lower.tail = W.ab.mean < W.ab))
# 0.0947195219641039

wilcox.test(which(x == "A"), which(x == "B"))
# Wilcoxon rank sum test
#
# data:  which(x == "A") and which(x == "B")
# W = 66, p-value = 0.09472
# alternative hypothesis: true location shift is not equal to 0

## If we choose alpha = 0.05, we don't have enought evidences to reject
## the hipothesis that both exam models takes same time to complete.


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

rm(list = ls())

r <- c(1.1, -21.7, -16.3, -11.3, -10.4, -7.0, -2.0, 1.9, 6.2)

(n.r <- length(r))
# 9

u <- c(-2.4, 9.9, 14.2, 18.4, 20.1, 23.1, 70.4)

(n.u <- length(u))
# 7

(n <- n.u + n.r)
# 16

(W.u <- sum(rank(c(u, r))[1:length(u)]))
# 87

(W.ur <- W.u - n.u * (n.u + 1) / 2)
# 59

(W.ur.mean <- n.u * n.r / 2)
# 31.5

(W.ur.var <- n.u * n.r * (n + 1) / 12)
# 89.25

### a)
###
### H0: U <= R
### H1: U > R

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

## Exact pvalue
1 - pwilcox(W.ur - 1, n.u, n.r)
# 0.00104895104895109

## We reject H0 in favor of H1, so U > R

### b)

A <- matrix(rep(0, n.u * n.r), n.u, n.r)
for (i in 1:n.u) {
  for (j in 1:n.r) {
    A[i, j] <- u[i] - r[j]
  }
}
median(A)
# 22.1

wilcox.test(u, r, alternative = "greater", conf.int = TRUE)
# Wilcoxon rank sum test
#
# data:  u and r
# W = 59, p-value = 0.001049
# alternative hypothesis: true location shift is greater than 0
# 95 percent confidence interval:
#  13.9  Inf
# sample estimates:
# difference in location
#                   22.1

### c)

## TODO

### d)

## TODO


#Series temporais e analises preditivas - Fernando Amaral
library(forecast)
library(ggplot2)

autoplot(fdeaths)

#calculando a media movel com ordem 5
fdeaths2 = ma(fdeaths, order = 5 )
autoplot(fdeaths2)

#novamente, ordem 12
fdeaths3 = ma(fdeaths,order=12)
autoplot(fdeaths3)

#limpeza dos dados
fdeaths4 = tsclean(fdeaths)
autoplot(fdeaths4)

#comparando
plot(fdeaths)
lines(fdeaths2, col="red")
lines(fdeaths3, col="blue")
lines(fdeaths4, col="green")

#legenda
legend("topright",legend=c("Orig.","Ma5","Ma12","Tsc"), col = c("black","red","blue","green"), lty=1:2, cex=0.8,)

Udemy/Series Temporais e Analises Preditivas/Resources/Codigo/5.7.R Medias Moveis.r