## Question 1

seed(123)
library("ggplot2")
years_of_education <- runif(999,0,30)
life_expectancy <- 71.5 + 0.15 * years_of_education
life_expectancy_with_error <- life_expectancy + rnorm(999,0,1)
df <- data.frame(Years = years_of_education, Expectancy = life_expectancy_with_error)
ggplot(df, aes(x=Years, y=Expectancy)) + geom_point(size=0.5, shape=23)

fit<- lm(life_expectancy_with_error~years_of_education)
summary(fit)

df_new <- rbind(df, c(0, 1222))
ggplot(df_new, aes(x=Years, y=Expectancy)) + geom_point(size=0.5, shape=23)
fit_with_outlier <- lm(Expectancy~Years, data=df_new)
summary(fit_with_outlier)

plot(df$Years, df$Expectancy, xlab = "Years of Education", ylab = "Life Expectancy (years)")
lines(df$Years, predict(fit), col = "blue")
lines(df_new$Years, predict(fit_with_outlier), col = "red")

ggplot(df_new) + geom_smooth(aes(x=Years, y=Expectancy), data=df, method=lm, se=FALSE, color ="blue") + geom_smooth(aes(x=Years, y=Expectancy), data=df_new, method=lm, se=FALSE, color = "red")  + labs(x = "Years of Education", y = "Life Expectancy (years)") + xlim(0,35) + ggtitle("Regression Line Based on 999 Points (Blue) and Based on 1000 points (Red)")

## Question 2

library(Matching)
library(arm)
data(lalonde)
df_control = subset(lalonde, treat == 0)

reg_control <- lm(re78 ~ age + educ + re74 + re75 + I(educ*re74) + I(educ*re75) + I(age*re74) + I(age*re75) + I(age*age) + I(re74*re75), data=df_control)

confint(reg_control)

med_educ=median(df_control$educ)
med_re74=median(df_control$re74)
med_re75=median(df_control$re75)

Simulation <- sim(reg_control, n.sims = 10000)

storagedf<- matrix(NA, nrow = 10000, ncol=39 )

for (age in 17:55){
  for(i in 1:10000){

    predictedYs <- Simulation@coef[i,1] * 1 +
      Simulation@coef[i,2] * age +
      Simulation@coef[i,3] * med_educ +
      Simulation@coef[i,4] * med_re74 +
      Simulation@coef[i,5] * med_re75 +
      Simulation@coef[i,6] * med_educ*med_re74 +
      Simulation@coef[i,7] * med_educ*med_re75 +
      Simulation@coef[i,8] * age*med_re74 +
      Simulation@coef[i,9] * age*med_re75 +
      Simulation@coef[i,10] * age*age +
      Simulation@coef[i,11] * med_re74*med_re75
    #+ rnorm(1,0,Simulation@sigma[i])
    # put preductedYs into a matrix
      storagedf[i,age-16] = predictedYs

  }
}

head(storagedf)

lowbounds.medians = rep(NA, 39)
upperbounds.medians = rep(NA, 39)
age <- c(17:55)

for (i in 1:ncol(storagedf)) {
  lowbounds.medians[i] = quantile(storagedf[,i],0.025)
  upperbounds.medians[i] = quantile(storagedf[,i],0.975)

}

data.frame(Age = as.numeric(age_list), Lower_Quantile = lowbounds.medians, Upper_Quantile =upperbounds.medians, med_educ, med_re74, med_re75, med_educ*med_re74, med_educ*med_re75, age*med_re74, age*med_re75, age*age, med_re74*med_re75)

confidence_intervals_one <- quantile(storagedf, probs = c(0.025, 0.975))

q_re74 = quantile(df_control$re74)[4]
q_educ = quantile(df_control$educ)[4]
q_re75 = quantile(df_control$re75)[4]

storagedf1<- matrix(NA, nrow = 10000, ncol=39 )

for (age in 17:55){
  for(i in 1:10000){

    predictedYs <- Simulation@coef[i,1] * 1 +
      Simulation@coef[i,2] * age +
      Simulation@coef[i,3] * q_educ +
      Simulation@coef[i,4] * q_re74 +
      Simulation@coef[i,5] * q_re75 +
      Simulation@coef[i,6] * q_educ*q_re74 +
      Simulation@coef[i,7] * q_educ*q_re75 +
      Simulation@coef[i,8] * age*q_re74 +
      Simulation@coef[i,9] * age*q_re75 +
      Simulation@coef[i,10] * age*age +
      Simulation@coef[i,11] * q_re74*q_re75
    #+ rnorm(1,0,Simulation@sigma[i])
    # put preductedYs into a matrix
    storagedf1[i,age-16] = predictedYs

  }
}

head(storagedf1)

lowbounds.medians1 = rep(NA, 39)
upperbounds.medians1 = rep(NA, 39)

for (i in 1:ncol(storagedf1)) {
  lowbounds.medians1[i] = quantile(storagedf1[,i],0.025)
  upperbounds.medians1[i] = quantile(storagedf1[,i],0.975)

}
age <- c(17:55)
data.frame(Age = as.numeric(age_list), Lower_Quantile = lowbounds.medians1, Upper_Quantile = upperbounds.medians1, q_educ, q_re74, q_re75, q_educ*q_re74, q_educ*q_re75, age*q_re74, age*q_re75, age*age, q_re74*q_re75)

Simulation <- sim(reg_control, n.sims = 10000)

med_educ=median(df_control$educ)
med_re74=median(df_control$re74)
med_re75=median(df_control$re75)

storagedf2<- matrix(NA, nrow = 10000, ncol=39 )

for (age in 17:55){
  for(i in 1:10000){

    predictedYs <- Simulation@coef[i,1] * 1 +
      Simulation@coef[i,2] * age +
      Simulation@coef[i,3] * med_educ +
      Simulation@coef[i,4] * med_re74 +
      Simulation@coef[i,5] * med_re75 +
      Simulation@coef[i,6] * med_educ*med_re74 +
      Simulation@coef[i,7] * med_educ*med_re75 +
      Simulation@coef[i,8] * age*med_re74 +
      Simulation@coef[i,9] * age*med_re75 +
      Simulation@coef[i,10] * age*age +
      Simulation@coef[i,11] * med_re74*med_re75
    + rnorm(1,0,Simulation@sigma[i])
    # put preductedYs into a matrix
    storagedf2[i,age-16] = predictedYs

  }
}

lowbounds.medians2 = rep(NA, 39)
upperbounds.medians2 = rep(NA, 39)

for (i in 1:ncol(storagedf1)) {
  lowbounds.medians2[i] = quantile(storagedf2[,i],0.025)
  upperbounds.medians2[i] = quantile(storagedf2[,i],0.975)

}

age <- c(17:55)

data.frame(Age = as.numeric(age_list), Lower_Quantile = lowbounds.medians2, Upper_Quantile =upperbounds.medians2, med_educ, med_re74, med_re75, med_educ*med_re74, med_educ*med_re75, age*med_re74, age*med_re75,age*age, med_re74*med_re75)

storagedf3<- matrix(NA, nrow = 10000, ncol=39 )

for (age in 17:55){
  for(i in 1:10000){

      predictedYs <- Simulation@coef[i,1] * 1 +
        Simulation@coef[i,2] * age +
        Simulation@coef[i,3] * q_educ +
        Simulation@coef[i,4] * q_re74 +
        Simulation@coef[i,5] * q_re75 +
        Simulation@coef[i,6] * q_educ*q_re74 +
        Simulation@coef[i,7] * q_educ*q_re75 +
        Simulation@coef[i,8] * age*q_re74 +
        Simulation@coef[i,9] * age*q_re75 +
        Simulation@coef[i,10] * age*age +
        Simulation@coef[i,11] * q_re74*q_re75
      + rnorm(1,0,Simulation@sigma[i])
    # put preductedYs into a matrix
    storagedf3[i,age-16] = predictedYs

  }
}

head(storagedf3)

lowbounds.medians3 = rep(NA, 39)
upperbounds.medians3 = rep(NA, 39)

for (i in 1:ncol(storagedf3)) {
  lowbounds.medians3[i] = quantile(storagedf3[,i],0.025)
  upperbounds.medians3[i] = quantile(storagedf3[,i],0.975)

}
age <- c(17:55)

data.frame(Age = as.numeric(age_list), Lower_Quantile = lowbounds.medians3, Upper_Quantile = upperbounds.medians3, q_educ, q_re74, q_re75, q_educ*q_re74, q_educ*q_re75, age*q_re74, age*q_re75, age*age, q_re74*q_re75)

plot(x=c(1,100), y = c(1,100), type = "n", xlim = c(17,55), ylim = c(500,15000),
     main = "95% Prediction Interval (PI) for re78 from Control Group", xlab = "Age of Subject",
     ylab = "95% PI")

for (age in 17:55) {
  segments(
    x0 = age,
    y0 = lowbounds.medians2[age - 16],
    x1 = age,
    y1 = upperbounds.medians2[age-16],
    lwd = 2,
    col="red")
}

legend("topleft", c("Using Median Values for educ, re74 and re75"), col=c("red"), lwd=4)

plot(x=c(1,100), y = c(1,100), type = "n", xlim = c(17,55), ylim = c(500,15000),
     main = "95% Prediction Interval (PI) for re78 from Control Group", xlab = "Age of Subject",
     ylab = "95% PI")

for (age in 17:55) {
  segments(
    x0 = age,
    y0 = lowbounds.medians3[age - 16],
    x1 = age,
    y1 = upperbounds.medians3[age-16],
    lwd = 2,
    col="blue")
}

legend("topleft", c("Using 75% quantiles for educ, re74 and re75"), col=c("blue"), lwd=4)

## Question 3

data(PlantGrowth)
df <- subset(PlantGrowth, group!="trt2") #removing rows in treatment2
df$group <- ifelse(df$group=="ctrl", 0,1) #recoding variables

model_1 <- lm(weight~group,data=df)

confint(model_1, level = 0.95)

storage <- rep(0,10000)

for (i in 1:10000) {

  sample_index <- sample(nrow(df), nrow(df), replace = T)
  model <- lm(weight ~ group, data = df, subset = sample_index)
  se <- summary(model)$coef[2]
  storage[i] <- se
}

quantile(storage, probs = c(0.025, 0.975))

## Question 4
r_squared <- function(x,y){ #x is actual y and y is predicted y's
  rss <- sum((y - x) ^ 2)  ## residual sum of squares
  tss <- sum((x - mean(x)) ^ 2)  ## total sum of squares
  rsq <- 1 - rss/tss
  print(rsq)
}

r_squared(df$weight,predict(model_1))

## Question 5
library('arm')

df <- read.dta("C:/Users/tanha/Desktop/Direction Year Syllabi/CS112/nsw.dta")
#no re78

log_model <- glm(treat~ age + education + black + hispanic + married + nodegree + re75, data = df, family="binomial")

treat_group <- subset(df, treat == 1)

control_group <- subset(df, treat == 0)

hist(predict(log_model, newdata=treat_group, type = "response"), xlab = "Estimated Probability", main="Estimated Probability of Treatment for Treatment Group", col = "red")

legend("topright", c("Treatment Group"), col=c("red"), lwd=4)

p2 <- hist(predict(log_model, newdata=control_group, type = "response"),xlab = "Estimated Probability", main="Estimated Probability of Treatment for Control Group", col = "blue")
legend("topright", c("Control Group"), col=c("blue"), lwd=4)


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