## Multivariate Regression

## Section 1: Loading Libraries ---------------------------------------------------------

## Load the "data.table", "ggplot2", and "reshape2" libraries.
library(data.table)
library(ggplot2)
library(reshape2)

## Section 2: Regressing Years of Service on Salary  ---------------------------------------------------------

## Load the "Salaries" dataset, and convert it to a data.table.
data("Salaries")
Salaries <- data.table(Salaries)

## Run a regression where the outcome variable is "salary" and the predictor variable is "yrs.service".
regression_output <- lm(salary ~ yrs.service, data = Salaries)
print(regression_output)
## Run the "summary" command on your regression, and answer the following questions:

## 1. What are the coefficients for intercept and "yrs.service"?
## Coefficients: Intercept 99974.7,  yrs.service   779.6

## 2. Put those intercepts into a sentence describing the linear relationship, like we did for the two regressions in lecture.
# A professor with zero years of service is expected to make $99,974 and every additional year of service will add $779.

## 3. What is the standard error and p-value of the "yrs.service" coefficient? Is that p-value statistically significant?
summary(regression_output)
#   Std error 110.4, p value 7.53e-12, yes

## 4. What is the adjusted R-squared value for this regression? What does that mean?
#Adjusted R-squared:  0.1098. R-squared, along with p-value, is another common statistic for assessing the goodness-of-fit of your model. the R-squared value will tell you how much variation in your outcome variable can be predicted by your predictor variable.
# about 10% of the variance in salary is explained by yrs.service
#If the data were a straight line, the R-squared value would be 1. If the data were random noise, R-squared would be close to zero (or could, in some cases, even be negative). Here we have an adjusted R-squared of 0.1098, meaning that only about 10% of the variance in salary can be explained by yrs.since.phd.

## Make a new column in your dataset with predicted salary values.
Salaries[, salary.predict:=predict(regression_output)]
print(Salaries)

## Make a scatter plot of yrs.service vs. salary, and add a line plot showing the regression predictions.
## NOTE: I want you to plot your predicted values (from the last question). Do *not* use geom_smooth().
## Fully label both axes, and add a title.
salary_plot <- ggplot(data=Salaries, aes(x=yrs.service)) + geom_point(aes(y=salary)) + geom_line(aes(y=salary.predict), color="green") + labs(title="Professor's Actual and Predicted Salary Over Years of Service", x="Years of Service", y="Salary")
print(salary_plot)

ggplot(Salaries, aes(x=yrs.service))+
  geom_point(aes(y=salary), color="orange", alpha=0.7)+
  geom_line(aes(y=predictedSalary), color="blue") +
  labs(title="Data and Regression Line for Years of Service and Salary among Professors",
       x="Years of Service",
       y="Salary (USD)")
## ---------------------------------------------------------------------------------
## Section 3: Regressing with the "tips" Dataset  ---------------------------------------------------------

## Load the "tips" dataset from the "reshape2" library, and convert it to a data.table.
data(tips)
tips <- data.table(tips)

## What does one row of this dataset represent?
# One row represents a restaurant bill transaction and has bill amount, day of week, time (categorical bfast, lunch and dinner) and details about the customer such as number in the party, sex and smoking status.

## Run a regression where the outcome variable is "tip" and the predictor variable is "total_bill".
regression_tip <- lm(tip ~ total_bill, data = tips)
print(regression_tip)
## Run the "summary" command on your regression, and answer the following questions:
summary(regression_tip)

## 1. What are the coefficients for intercept and "total_bill"?
#Intercept : 0.920270
# Total bill: 0.105025

## 2. Put those intercepts into a sentence describing the linear relationship, like we did for the two regressions in lecture.
# A total bill of zero dollars is expected to make 0$.92  in tips and every additional dollar of total bill will add $0.105025

## 3. What is the standard error and p-value of the "total_bill" coefficient? Is that p-value statistically significant?
#Standard error: 0.007365, p-value: <2e-16. Yes, P value is significant.

## 4. What is the adjusted R-squared value for this regression? What does that mean?
# Adjusted R-squared:  0.4544. R-squared, along with p-value, is another common statistic for assessing the goodness-of-fit of your model. the R-squared value will tell you how much variation in your outcome variable can be predicted by your predictor variable.
#If the data were a straight line, the R-squared value would be 1. If the data were random noise, R-squared would be close to zero (or could, in some cases, even be negative). Here we have an adjusted R-squared of 0.1098, meaning that only about 10% of the variance in salary can be explained by yrs.since.phd.

## 5. What are the units of the coefficients in the "Estimate" column?
#Dollars
## Make a new column in your dataset with predicted tip values.
tips[, tips.predict:=predict(regression_tip)]
print(tips)
## Make a scatter plot of total_bill vs. tips, and add a line plot showing the regression predictions.
## See note above about how to plot predicted values. Again, make sure both axes are labeled and the plot
## has a title.
tips_plot <- ggplot(data=tips, aes(x=total_bill)) + geom_point(aes(y=tip)) + geom_line(aes(y=tips.predict), color="red") + labs(title="Tips of Prediction", x="Total Bill", y="Tips")
print(tips_plot)

## Think about the expected relationship between "total_bill" and "tip", according to cultural norms in the US.
## How does the coefficient on "total_bill" relate to those cultural norms?

## Section 2: Exploring variables in the "tips" dataset ---------------------------------------------------------

## Load the "tips" dataset and convert it to a data.table.
data(tips)
tips <- data.table(tips)

## Let's say that we're interested in the relationship between total bill (predictor variable) and tip (outcome variable).

## For each of the other five variables in the dataset, indicate what class that variable falls into (confounder, effect modifier,
## mediator, or none of the above). Explain why you think that. Is this variable categorical or continuous?
## Should this variable be included in the regression?

#sex: confounder (since it's associated with both predictor and outcome)
#smoker: effect modifier, but would also accept confounder or irrelevant (definitely associated with outcome, more tenuously associated with predictor, if they make a good argument for why it should theoretically be irrelevant I'll accept it)
#day: confounder (associated with both predictor and outcome)
#time: irrelevant, or confounder (not strongly associated with either predictor or outcome, but you could make the case for why it might be a confounder)
#size: mediator (associated with tip and total bill, but on the causal pathway)
ggplot(tips, aes(x=total_bill, y=tip)) +
  geom_point() +
  geom_smooth(method="lm", color="black")+
  facet_grid(.~sex)+
  labs(title="Total Bill size and Tips by Sex",
       x="Total Bill ($)",
       y="Tips($)")
tips_bi <- lm(tip ~ sex, data=tips)
summary(tips_bi)
## Section 3: Designing a regression ---------------------------------------------------------

## In section 2, you decided what variables should and should not be included in your regression on the relationship
## between total bill and tip.Write out what your regression equation should be, including all the variables
## you deemed necessary in Section 2.
## You can use "b" instead of "beta", for example: "tip = b0 + b1*total_bill + b2*sex".
## You should have at least three predictor variables.

## Section 4: Running that regression ---------------------------------------------------------

## Run the regression specified in Section 3. Print the output using summary().
regression_multi_tips <- lm(formula = tip ~ total_bill + size + day, data = multi_tips)
summary(regression_multi_tips)
## What category/categories is your Intercept value capturing? For example, in our "full regression" video from
## lecture, our Intercept value captured both the category "sex=Female" and the category "discipline=A".
# The intercept is capturing the category value of "day=Friday".

## For each row of the regression output, tell me:
## --If the coefficient in question refers to a continuous or categorical variable (and if categorical, what category)
## --How to interpret that value in a sentence.
##    For continuous variables, this should be in the format of "an [x] increase in [predictor variable]
##    leads to a [y] increase/decrease in my outcome variable.
##    For categorical variables, tell me how the Intercept changes for each categorical variable.

# Coefficients:
#              Estimate Std. Error t value Pr(>|t|)
# (Intercept)  0.745787   0.281343   2.651  0.00857 ** - a bill of $0 is expected to generate $0.75 in tips.
# total_bill   0.092994   0.009239  10.065  < 2e-16 *** - continuous - an increase of $1.00 in total_bill is expected to generate
#                                                                      an increase of $0.09 in tips.
# size         0.187132   0.087199   2.146  0.03288 *   - continuous - an increase of 1 person in party size is expected to generate
#                                                                      an increase of $0.19 in tips.
# daySat      -0.124658   0.259746  -0.480  0.63172     - categorical - if the bill is on a Saturday, it's expected to generate $0.13
#                                                                      less in tips than if it were on Friday.
# daySun      -0.013498   0.266391  -0.051  0.95963     - categorical - if the bill is on a Sunday, it's expected to generate $0.14
#                                                                      less in tips than if it were on Friday.
# dayThur     -0.077493   0.268534  -0.289  0.77316     - categorical - if the bill is on a Thursday, it's expected to generate $0.08
#                                                                      less in tips than if it were on Friday.

## NOTE: You **do not** have to work through every possible combiations of categories and give me their intercept values--
## depending on which variables you choose, that could wind up being a lot of combinations. Just tell me how each categorical
## coefficient changes the intercept.

#1) The coefficient for total_bill refers to a continuous variable. A $1 increase in the total_bill
## leads to an increase in the tip amount by $0.093205
## 2) The coefficient for sex refers to a categorical variable and indicates the Male category.
##    If the sex of the bill payer is Male, the tip amount reduces by $0.032595
## 3) The coefficents for day refer to a categorical variable and indicate the Sat, Sun and Thur categories.
##    The 'Fri' category is represented by absence i.e. if the bill is paid on a Friday, then none of the coefficients will apply.
##    If the bill is for Sat, the tip amount reduces by $0.120244 (~12 cents), if the bill is for Sun, the tip amount
##    reduces by $0.006392 and if the bill is for Thur, then the tip amount reduces by $0.078854 (~7cents)
## 4) The coefficnets for size refer to a continuous variable. An increase in size of party by 1, leads to
##    an increase in the tip amount by $0.186741 (~18 cents)

## Section 5: Visualization ---------------------------------------------------------

## Make a plot of your regression outputs. If you included continuous variables, make one plot where the x-axis is
## "total_bill" and another where it is your continuous variable. The results won't be straight lines, but that's ok.
## If you only have one categorical variable, distinguish its values by color. If you have multiple categorical variables,
## Use some combination of color and faceting to come up with the appropriate number of regression lines.
tips[,predicted_tip := predict(tip.regression, data=tips)]

visualization <- ggplot(tips, aes(x=total_bill)) +
  geom_point(aes(y=tip, color=sex), alpha=0.7) +
  geom_line(aes(y=predicted_tip, color=sex), size=1) +
  facet_grid(.~smoker, scales="free") +
  labs(title="Multivariate Regression with Categorical Variables: Sex and Smoking", x="Total Bill", y="Tip Amount")

print(visualization)

Interesting vizualizations
tips[, predicted_tips_total_bill:= predict(combined_regression, data=tips)]
print(tips)

## Plot predicted values - sex
ggplot(tips, aes(x=total_bill)) +
  geom_point(aes(y=tip, color=sex), alpha=0.7) +
  geom_line(aes(y=predicted_tips_total_bill, color=sex), size=1) +
  labs(title="Multivariate Regression with Categorical Variables: Day, Sex & Time",
       x="Total Bill (USD)",
       y="Tip Amount (USD)")

## Plot predicted values - sex, Factetted by sex
ggplot(tips, aes(x=total_bill)) +
  geom_point(aes(y=tip, color=sex), alpha=0.7) +
  geom_line(aes(y=predicted_tips_total_bill), size=1) +
  facet_grid(.~sex, scales="free") +
  labs(title="Multivariate Regression with Categorical Variables: Day, Sex & Time",
       x="Total Bill (USD)",
       y="Tip Amount (USD)")

#Plot Tip v Bill, Faceting by Day and Time, Sex by color of plot, Best fit line
faceting <- ggplot(data=tips, aes(x=total_bill, y=tip)) +
  geom_point(aes(color=sex)) +
  geom_smooth(method="lm", color="black") +
  # adding a facet_wrap component
  facet_grid(time~day) +
  labs(title="Multivariate Regression with Categorical Variables: Day, Sex & Time",
       x="Total Bill (USD)",
       y="Tip Amount (USD)")
print(faceting)

#Plots Tip v Bill, Faceting Sex by Time and Day, Best fit Line
faceting <- ggplot(data=tips, aes(x=total_bill, y=tip)) +
  geom_point(aes(color=sex)) +
  geom_smooth(method="lm", color="black") +
  # adding a facet_wrap component
  facet_grid(time~day~sex) +
  labs(title="Multivariate Regression with Categorical Variables: Day, Sex & Time",
       x="Total Bill (USD)",
       y="Tip Amount (USD)")
print(faceting)

#Plots Tip v Bill, Faceting Sex by Time and Day, Geomteric Line
faceting <- ggplot(data=tips, aes(x=total_bill, y=tip)) +
  geom_point(aes(color=sex)) +
  geom_line(color="black") +
  # adding a facet_wrap component
  facet_grid(time~day~sex) +
  labs(title="Multivariate Regression with Categorical Variables: Sex - Time and Day",
       x="Total Bill (USD)",
       y="Tip Amount (USD)")
print(faceting)
# Note there is only one Thursday Dinner

#Plots Tip v Bill, Faceting Sex by Time and Day, Geomteric Line & Best fit line
faceting <- ggplot(data=tips, aes(x=total_bill, y=tip)) +
  geom_point(aes(color=sex)) +
  geom_line(color="black") +
  geom_smooth(method="lm", color="green") +
  # adding a facet_wrap component
  facet_grid(time~day~sex) +
  labs(title="Multivariate Regression with Categorical Variables: Day, Sex & Time",
       x="Total Bill (USD)",
       y="Tip Amount (USD)")
print(faceting)
# Note there is only one Thursday Dinner

#Plots Tip v Bill, Faceting by Day and Time, Sex by color of plot, Geomteric Line & Best fit line
faceting <- ggplot(data=tips, aes(x=total_bill, y=tip)) +
  geom_point(aes(color=sex)) +
  geom_line(color="black") +
  geom_smooth(method="lm", color="green") +
  # adding a facet_wrap component
  facet_grid(time~day) +
  labs(title="Multivariate Regression with Categorical Variables: Day, Sex & Time",
       x="Total Bill (USD)",
       y="Tip Amount (USD)")
print(faceting)
# Note there is only one Thursday Dinner

#Plots Tip v Bill, Faceting by Day and Sex, Time by color of plot, Best fit line
faceting <- ggplot(data=tips, aes(x=total_bill, y=tip)) +
  geom_point(aes(color=time)) +
  geom_smooth(method="lm", color="black") +
  # adding a facet_wrap component
  facet_grid(sex~day) +
  labs(title="Multivariate Regression with Categorical Variables: Day, Sex & Time",
       x="Total Bill (USD)",
       y="Tip Amount (USD)")
print(faceting)

#Plots Tip v Bill, Faceting by Day and Sex, Time by color of plot, Geomteric Line & Best fit line
faceting <- ggplot(data=tips, aes(x=total_bill, y=tip)) +
  geom_point(aes(color=time)) +
  geom_line(color="black") +
  geom_smooth(method="lm", color="green") +
  # adding a facet_wrap component
  facet_grid(sex~day) +
  labs(title="Multivariate Regression with Categorical Variables: Day, Sex & Time",
       x="Total Bill (USD)",
       y="Tip Amount (USD)")
print(faceting)


#' Entropy of a bit-string
#'
#' The entropy of a bitstring (ex: 1010111000) is calculated.
#' @param x - A vector of 0's and 1's.
#' @return e - a floating point percentage, between 0 and 1.
#' @export stats.entropyFunction
#' @examples
#' stats.entropyFunction(c(1,0,0,0,1,0,0,0,0,0,0,0,0))
#' > 0.6193822
#' stats.entropyFunction(c(1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0))
#' > 1
#' stats.entropyFunction(c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1))
#' > 0
stats.entropyFunction = function(bitString) {
  pT = sum(bitString)/length(bitString)
  pF = 1-pT
  if (pT==1 || pT==0) {
    e = 0
  } else {
    e = -pT*log2(pT)-pF*log2(pF)
  }
  return(e)
}


# Author: Nikos Kougianos
# Date: 13/12/2020

custom_median <- function(x, na.rm = FALSE) {
    # Check if vector has any NA values
    if (anyNA(x)) {
        # Check na.rm if TRUE or FALSE
        if (na.rm == TRUE) {
            # If true, remove NA values from x
            x <- x[!is.na(x)]

        } else {
            # If false, then return NA as result like median function
            return(NA)

        }

    }

    # Sort x
    x = sort(x)

    # Check if length of x is even or odd
    # If even, then we want to return the mean of the 2 middle elements
    # If odd, then we want to return only the middle element
    if (length(x) %% 2 == 0) {
        middle1 <- x[length(x) %/% 2]
        middle2 <- x[length(x) %/% 2 + 1]
        return(mean(c(middle1, middle2)))
    } else {
        return(x[length(x) %/% 2 + 1])
    }

}

# Sample executions of custom_median function, using integer vectors,
# double vectors, vectors with NA values and vectors without NA values
custom_median(runif(10, 0, 100), FALSE)
custom_median(runif(150, 0, 100), FALSE)
custom_median(sample.int(100, 9), FALSE)
custom_median(sample.int(100, 200, replace=TRUE), FALSE)
custom_median(c(NA,1,5,15.6,NA,6,7,8,9), FALSE)
custom_median(c(NA,1,5,15.6,NA,6,7,8,9), TRUE)
custom_median(c(1,5,15.6,6,7,8,9), FALSE)


#' Geometric mean
#'
#' @description Calculates geometric mean
#'
#' @param x numeric vector
#'
#' @return Geometric mean
#' @export
#'
#' @examples
#'
#' x <- rexp(100,.5)
#'
#' geometric_mean(x)
#'

geometric_mean <- function(x){

  if(sum(x == 0, na.rm = T) > 0 ){
    warning("There is at least one value = 0 and that cause the geometric mean to be 0")
  }

  if(sum(x < 0, na.rm = T) > 0 ){
    warning("There is at least one value < 0 and that cause NaN's when computing the geometric mean")
  }

  exp(mean(log(x), na.rm = T))

}


quaddiscrroots <- function(a,b,c, tol=1e-5) {
  d <- b*b - 4*a*c + 0i
  root1 <- (-b + sqrt(d))/(2*a)
  root2 <- (-b - sqrt(d))/(2*a)
  if ( abs(Re(d)) < tol ) {
    list("real and equal", abs(root1), abs(root1))
  } else if ( Re(d) > 0 ) {
    list("real", Re(root1), Re(root2))
  } else {
    list("complex", root1, root2)
  }
}

for(coeffs in list(c(3,4,4/3), c(3,2,-1), c(3,2,1), c(1, -1e6, 1)) ) {
  cat(sprintf("roots of %gx^2 %+gx^1 %+g are\n", coeffs[1], coeffs[2], coeffs[3]))
  r <- quaddiscrroots(coeffs[1], coeffs[2], coeffs[3])
  cat(sprintf("  %s: %s, %s\n", r[[1]], r[[2]], r[[3]]))
}


# Suppose we have two students taking a 40-question
# multiple-choice exam.
# We think they will do better than chance.

# 1. What are our parameters of interest?

# Ad 1: Theta 1 and thata 2 - probailities that a given student gets a question right

# 2. what is our likelihood?

# It's Binom(40, theta), assuming that questions are independent and
# probabilities of answers are the same for each question

# 3. What prior should we use?
# Beta, as it's a conjucate prior for binom.
theta = seq(0, 1, .1)
plot(theta, dbeta(theta, 8, 4), type = 'l')
# beta(8, 4) gives a reasonable model of doing better than chance (P > .25)
prior_alpha = 8
prior_beta  = 4

# 4. What's the prior probability that theta > .25, > .5, > .8?
1 - pbeta(.25, prior_alpha, prior_beta)
1 - pbeta( .5, prior_alpha, prior_beta)
1 - pbeta( .8, prior_alpha, prior_beta)

# 5. Suppose the first student takes the test and gets 33 of the 40 questions right.
#    What's the postrior distribution for their parameter?
#    What's P(theta > .25), > .5,  > .8?
#    What's a 95% credible interval for it?
post_alpha_1 = prior_alpha + 33
post_beta_1  = prior_beta  + 7

post_mean_1  = post_alpha_1 / (post_alpha_1 + post_beta_1)
cat('Posterior mean:', post_mean_1)
cat('MLE:', 33/40)

1 - pbeta(.25, post_alpha_1, post_beta_1)
1 - pbeta( .5, post_alpha_1, post_beta_1)
1 - pbeta( .8, post_alpha_1, post_beta_1)

cat('95% CI:', qbeta(.025, post_alpha_1, post_beta_1),
               qbeta(.975, post_alpha_1, post_beta_1))

# 6. Suppose the 2nd student gets 24 questions right.
#    What's the distribution for their parameter?
#    What's P(theta > .25), > .5, > .8?
#    What's a 95% credible interval for it?
post_alpha_2 = prior_alpha + 24
post_beta_2  = prior_beta  + 40 - 24

post_mean_2  = post_alpha_2 / (post_alpha_2 + post_beta_2)
cat('Posterior mean:', post_mean_2)
cat('MLE:', 24/40)

1 - pbeta(.25, post_alpha_2, post_beta_2)
1 - pbeta( .5, post_alpha_2, post_beta_2)
1 - pbeta( .8, post_alpha_2, post_beta_2)

cat('95% CI:', qbeta(.025, post_alpha_2, post_beta_2),
               qbeta(.975, post_alpha_2, post_beta_2))

# 7) Estimate by simulation: draw 1,000 samples from each and see how often
#    we observe theta1 > theta2

theta_1 = rbeta(1000,41,11)
theta_2 = rbeta(1000,32,20)
mean(theta_1 > theta_2)


pie1=94/125
pie2=113/175
# The sample awareness proportion is higher in Wichita, so let's make Wichita region 1.
#The estimated standard error is
sigma=sqrt(((pie1*(1-pie1))/125)+((pie2*(1-pie2))/175))

#test statistic
z=(pie1-pie2)/sigma
print(z)
alpha=0.05
z.alpha=qnorm(1-alpha)
zstar=qnorm(1-alpha/2)
# Since z   is greater than z.alpha, we reject H0 and conclude that the observations
#support the hypothesis
error=zstar*sigma
#  95% confidence interval
left_i=(pie1-pie2)-error
right_i=(pie1-pie2)+error
print(left_i)
print(right_i)


##########################################
#
# Introduction to Correspondence Analysis
#
# Author: Maximilian Stoehr
# Email: maximilian.stoehr@protonmail.com
# License: MIT
##########################################

# Uncomment to install packages
# install.packages("FactoMineR")
# install.packages("factoextra")

# Load packages and dataset
library(FactoMineR)
library(factoextra)
data(housetasks)

##########################################
#
# We are going to work with the housetasks
# dataset.
# Data contents: housetasks repartition in the couple.
#
# rows are the different tasks
#
# values are the frequencies of the tasks done by:
#   the i) wife only,
#   ii) alternatively,
#   iii) husband only,
#   iv) jointly.
###########################################

# Task 1
# Explore the housetasks dataset and create the correspondence matrix P

# Task 2
# Compute the chi^2 test statistic X^2

# Task 3
# Compare the test statistic with the 95th percentile of
# a chi^2 distribution with (I-1)(J-1) degrees of freedom

# Task 4
# Build the distance matrix D which elements are the chi^2 distances
# Tipp: The diagional should be 0 (reference to the row itself)

# Task 5
# Compute the total row inertia

# Task 6
# Fit a CA to the dataset and visualize it with a biplot
# Tipp: Use the command CA and plot

# Task 7
# Display a scree plot of the dataset
# Tipp: The structure of the CA object will give you a hint
#       on how to access the eigenvalues

## **Results of the Correspondence Analysis (CA)**
## The row variable has  13  categories; the column variable has 4 categories
## The chi square of independence between the two variables is equal to 1944 (p-value =  0 ).
## *The results are available in the following objects:
##
##    name              description
## 1  "$eig"            "eigenvalues"
## 2  "$col"            "results for the columns"
## 3  "$col$coord"      "coord. for the columns"
## 4  "$col$cos2"       "cos2 for the columns"
## 5  "$col$contrib"    "contributions of the columns"
## 6  "$row"            "results for the rows"
## 7  "$row$coord"      "coord. for the rows"
## 8  "$row$cos2"       "cos2 for the rows"
## 9  "$row$contrib"    "contributions of the rows"
## 10 "$call"           "summary called parameters"
## 11 "$call$marge.col" "weights of the columns"
## 12 "$call$marge.row" "weights of the rows"


#####################################################################
# CS638: Applied Machine Learning
# Copyright 2016 Pejman Ghorbanzade <pejman@ghorbanzade.com>
# More info: https://github.com/ghorbanzade/beacon
#####################################################################

# clear workspace
rm(list = ls())

# enable traceback on error messages
options(error=traceback)

# remove all plots if there are any
if (!is.null(dev.list())) trash <- dev.off()

args = commandArgs(trailingOnly=TRUE)
if (0 == length(args)) {
  stop("expected path to root directory of course", call.=FALSE)
}
pngdir <- args[1]
courseNameFull <- "umb-cs638-2016s"

# loading database
data = read.table("dat/hw02/data.txt", sep=",")
colnames(data) <- c('population', 'profit')

##
# visualize dataset
##
png(filename=file.path(pngdir, paste(courseNameFull, "-hw02-01", ".png", sep="")),
	height=768, width=1024, res=150, units="px", bg="white")

xrange <- seq(floor(min(data$population)/5)*5,
	ceiling(max(data$population)/5)*5,
	length.out=5
	)
yrange <- seq(floor(min(data$profit)/5)*5,
	ceiling(max(data$profit)/5)*5,
	length.out=7
	)
plot(0, 0, type="n", axes=F, ann=F,
	xlim=range(xrange), ylim=range(yrange))
points(data$population, data$profit, type="p", col="blue")
axis(1, at=xrange, labels=round(xrange, 3))
axis(2, at=yrange, labels=round(yrange, 3))

grid(10, 10)
box()
title(main="Profit of Coffee Shop Based on City's Population", font.main=1)
title(xlab="Population in 10,000", col.lab='black')
title(ylab="Profit in $10,000", col.lab='black')
trash <- dev.off()

##
# Check feature correlation
##
with(data, cor.test(data$population, data$profit, alternative="greater", conf.level=.8))

##
# data variables in pairs to check for correlation easily
##
png(filename=file.path(pngdir, paste(courseNameFull, "-hw02-02", ".png", sep="")),
	height=768, width=1024, res=150, units="px", bg="white")
pairs(data)
trash <- dev.off()

##
# fit linear model and print summary regression
##
lm.out <- lm(data$profit ~ data$population)
summary(lm.out)

##
# Plot regression line on the dataset
##
png(filename=file.path(pngdir, paste(courseNameFull, "-hw02-03", ".png", sep="")),
	height=768, width=1024, res=150, units="px", bg="white")

xrange <- seq(floor(min(data$population)/5)*5,
	ceiling(max(data$population)/5)*5,
	length.out=5
	)
yrange <- seq(floor(min(data$profit)/5)*5,
	ceiling(max(data$profit)/5)*5,
	length.out=7
	)
plot(0, 0, type="n", axes=F, ann=F,
	xlim=range(xrange), ylim=range(yrange))
points(data$population, data$profit, type="p", col="blue")
abline(lm.out, col="red")
axis(1, at=xrange, labels=round(xrange, 3))
axis(2, at=yrange, labels=round(yrange, 3))

grid(10, 10)
box()
title(main="Profit of Coffee Shop Based on City's Population", font.main=1)
title(xlab="Population in 10,000", col.lab='black')
title(ylab="Profit in $10,000", col.lab='black')
trash <- dev.off()

##
# plot linear regression model summary
##
png(filename=file.path(pngdir, paste(courseNameFull, "-hw02-04", ".png", sep="")),
    height=768, width=1024, res=150, units="px", bg="white")
par(mfrow=c(2,2))
plot(lm.out)
trash <- dev.off()

##
# compute value of the cost function for a given theta
##
lm.out <- lm(data$profit ~ data$population)
theta <- coef(lm.out)
x <- cbind(1,data$population)
y <- data$profit
m <- nrow(data)
cost <- sum(((x%*%theta)- y)^2)/(2*m)

##
# Function to find theta values obtained via gradient descent method
# for a given learning rate
##
gradient_descent <- function(x, y, alpha) {
	x <- cbind(1, x)
	m <- nrow(x)
	iterations <- 500
	theta <- c(0, 0)
	for (i in 1:iterations)
	{
		theta[1] <- theta[1] - alpha * (1/m) * sum(((x%*%theta)- y))
		theta[2] <- theta[2] - alpha * (1/m) * sum(((x%*%theta)- y)*x[,2])
	}
	return(theta)
}

##
# Find an report regression coefficient
##
theta <- gradient_descent(data$population, data$profit, 0.02)
theta <- gradient_descent(data$population, data$profit, 0.005)

##
# Compute theta values for different learning rates
##
realtheta <- coef(lm(data$profit ~ data$population))
min <- 0.001
max <- 0.024
num <- 20
alpha <- seq(min, max, length.out=num)
theta <- mat.or.vec(num, 2)
nrmtheta <- mat.or.vec(num, 2)
for (i in 1:length(alpha)) {
	theta[i,] <- gradient_descent(data$population, data$profit, alpha[i])
	nrmtheta[i,] <- (realtheta - theta[i,]) / realtheta * 100
}

##
# Plot theta_0 and theta_1 for different learning rates
##
png(filename=file.path(pngdir, paste(courseNameFull, "-hw02-05", ".png", sep="")),
	height=768, width=1024, res=150, units="px", bg="white")

xrange <- seq(min(alpha),
	max(alpha),
	length.out=5
	)
yrange <- seq(floor(min(theta, realtheta)),
	ceiling(max(theta, realtheta)),
	length.out=7
	)
plot(0, 0, type="n", axes=F, ann=F,
	xlim=range(xrange), ylim=range(yrange))
lines(alpha, theta[,1], type="o", pch=21, col="blue")
lines(alpha, theta[,2], type="o", pch=22, col="red")
abline(h=realtheta[1], col="blue", lty=3)
abline(h=realtheta[2], col="red", lty=3)
axis(1, at=xrange, labels=round(xrange, 3))
axis(2, at=yrange, labels=round(yrange, 3))
legend(0.015, 0.5,
	cex=1,
	c(expression(paste(theta[0], " gradient descent")),
		expression(paste(theta[1], " gradient descent")),
		expression(paste(theta[0], " regression line")),
		expression(paste(theta[1], " regression line"))
	),
	col=c("blue","red","blue","red"),
	pch=c(21, 22, 21, 22),
	lty=c(1, 2, 3, 3));

grid(10, 10)
box()
title(main="Impact of different learning rate on hypothesis function coefficients", font.main=1)
title(xlab=expression(paste("Learning Rate (", alpha, ")")), col.lab='black')
title(ylab=expression(paste("Hypothesis Function Coefficients (", theta, ")")), col.lab='black')
trash <- dev.off()

##
# Plot normalized gradient descent error for different learning rates
##
png(filename=file.path(pngdir, paste(courseNameFull, "-hw02-06", ".png", sep="")),
	height=768, width=1024, res=150, units="px", bg="white")

xrange <- seq(min(alpha), max(alpha), length.out=5)
yrange <- seq(0, 100, length.out=6)
plot(0, 0, type="n", axes=F, ann=F,
	xlim=range(xrange), ylim=range(yrange))
lines(alpha, nrmtheta[,1], type="o", col="blue")
lines(alpha, nrmtheta[,2], type="o", pch=22, lty=2, col="red")
axis(1, at=xrange, labels=round(xrange, 3))
axis(2, at=yrange, labels=paste(round(yrange, 3), "%", sep=""))
legend("topright", inset=0.05,
	legend = c(expression(theta[0]), expression(theta[1])),
	col=c("blue","red"),
	pch=c(21, 22),
	lty=c(1, 2));

grid(10, 10)
box()
title(main="Impact of different learning rate on values of\n hypothesis function coefficients after 500 iterations", font.main=1)
title(xlab=expression(paste("Learning Rate (", alpha, ")")), col.lab='black')
title(ylab=expression(paste("Normalized Error")), col.lab='black')
trash <- dev.off()

##
#
##
get_iterations <- function(x, y, alpha, realtheta) {
	x <- cbind(1, x)
	m <- nrow(x)
	theta <- c(0, 0)
	counter <- 0
	satisfy <- FALSE
	while (!all(abs(realtheta - theta)/realtheta*100 < c(1, 1))) {
		theta[1] <- theta[1] - alpha * (1/m) * sum(((x%*%theta)- y))
		theta[2] <- theta[2] - alpha * (1/m) * sum(((x%*%theta)- y)*x[,2])
		counter <- counter + 1
	}
	return(counter)
}

##
# compute required number of iterations to acheive less than 1 percent error
# for different learning rates
##
min <- 0.001
max <- 0.024
num <- 20
alpha <- seq(min, max, length.out=num)
iterations <- vector(mode="numeric", num)
for (i in 1:length(alpha)) {
	iterations[i] <- get_iterations(data$population, data$profit, alpha[i], realtheta)
}

##
# plot required number of iterations for different learning rates
##
png(filename=file.path(pngdir, paste(courseNameFull, "-hw02-07", ".png", sep="")),
	height=768, width=1024, res=150, units="px", bg="white")

xrange <- seq(min(alpha), max(alpha), length.out=5)
yrange <- seq(floor(min(iterations)/5000)*5000,
	ceiling(max(iterations)/5000)*5000,
	length.out=5
	)
plot(0, 0, type="n", axes=F, ann=F,
	xlim=range(xrange), ylim=range(yrange))
lines(alpha, iterations, type="o", col="blue")
axis(1, at=xrange, labels=round(xrange, 3))
axis(2, at=yrange, labels=round(yrange, 3))

grid(10, 10)
box()
title(main="Required number of iterations for different learning rates\n to achieve less than one percent error", font.main=1)
title(xlab=expression(paste("Learning Rate (", alpha, ")")), col.lab='black')
title(ylab="Required Number of Iterations", col.lab='black')
trash <- dev.off()

##
# predict profit of store, given population of the city
##
given_population <- 645966 * 1e-4
predicted_profit <- c(1, given_population) %*% realtheta
predicted_profit

new_row <- cbind(given_population, predicted_profit)
colnames(new_row) <- c('population', 'profit')
new_data <- rbind(data, new_row)

##
# visualize dataset and include the estimated profit for Boston
##
png(filename=file.path(pngdir, paste(courseNameFull, "-hw02-08", ".png", sep="")),
	height=768, width=1024, res=150, units="px", bg="white")

xrange <- seq(floor(min(new_data$population)/5)*5,
	ceiling(max(new_data$population)/5)*5,
	length.out=5
	)
yrange <- seq(floor(min(new_data$profit)/5)*5,
	ceiling(max(new_data$profit)/5)*5,
	length.out=7
	)
plot(0, 0, type="n", axes=F, ann=F,
	xlim=range(xrange), ylim=range(yrange))
points(data$population, data$profit, type="p", col="blue")
abline(lm(data$profit ~ data$population), col="red")
points(new_row[1], new_row[2], type="p", col="green")
axis(1, at=xrange, labels=round(xrange, 3))
axis(2, at=yrange, labels=round(yrange, 3))

grid(10, 10)
box()
title(main="Profit of Coffee Shop Based on City's Population", font.main=1)
title(xlab="Population in 10,000", col.lab='black')
title(ylab="Profit in $10,000", col.lab='black')
trash <- dev.off()


# Finding shortest path
# Ko Byeongmin
# Jan 26 2021

# functions

greedy <- function(costdata) { # calculates optimal path with greedy algorithm

    num.row <- dim(costdata)[1]
    num.col <- dim(costdata)[2]

    path = rbind(c(1,1))

    i <- 1
    j <- 1

    while (i < num.row & j < num.col) {
        if (costdata[i+1, j] > costdata[i, j+1]) {
            j <- j+1
            path = rbind(path, c(i, j))
        } else {
            i <- i+1
            path = rbind(path, c(i, j))
        }
    }

    if (i == num.row) {
        while (j < num.col) {
            j <- j+1
            path = rbind(path, c(i, j))
        }
    }

    if (j == num.col) {
        while (i < num.row) {
            i <- i+1
            path = rbind(path, c(i, j))
        }
    }

    totalexpense = 0

    for (i in 1:dim(path)[1]) {
        totalexpense = totalexpense + costdata[path[i, 1], path[i, 2]]
    }

    return(list("grid" = costdata, "path" = path, "totalexpense" = totalexpense))

}

expensecalc <- function (costdata) { # calculates optimal path recursively

    num.row <- dim(costdata)[1]
    num.col <- dim(costdata)[2]
    expense <- matrix(
        nrow = num.row,
        ncol = num.col,
        data = 0
    )

    for (i in 1:(num.col-1)) {
        expense[num.row, (num.col-i)] =
            costdata[num.row, (num.col-i)] +
            expense[num.row, (num.col-i+1)]
    }

    for (i in 1:(num.row-1)) {
        expense[(num.row-i), num.col] =
            costdata[(num.row-i), num.col] +
            expense[(num.row-i+1), num.col]
    }

    for (j in 1:(num.col-1)) {
        for (i in 1:(num.row-1)) {
            if (expense[(num.row-i), (num.col-j+1)] >= expense[(num.row-i+1), (num.col-j)]) {
                expense[(num.row-i), (num.col-j)] = expense[(num.row-i+1), (num.col-j)] +
                    costdata[(num.row-i), (num.col-j)]
            } else {
                expense[(num.row-i), (num.col-j)] = expense[(num.row-i), (num.col-j+1)] +
                    costdata[(num.row-i), (num.col-j)]
            }
        }
    }

    path = rbind(c(1,1))

    i <- 1
    j <- 1

    while (i < num.row & j < num.col) {
        if (expense[i+1, j] > expense[i, j+1]) {
            j <- j+1
            path = rbind(path, c(i, j))
        } else {
            i <- i+1
            path = rbind(path, c(i, j))
        }
    }

    if (i == num.row) {
        while (j < num.col) {
            j <- j+1
            path = rbind(path, c(i, j))
        }
    }

    if (j == num.col) {
        while (i < num.row) {
            i <- i+1
            path = rbind(path, c(i, j))
        }
    }

    totalexpense = 0

    for (i in 1:dim(path)[1]) {
        totalexpense = totalexpense + costdata[path[i, 1], path[i, 2]]
    }

    return(list("grid" = costdata, "path" = path, "totalexpense" = totalexpense))

}

## showcase

costdata <- matrix(
    data = c(2, 5 ,3, 8, 6,
    4, 2, 9, 4, 1,
    5, 3, 2, 6, 9,
    0, 3, 8, 5, 0),
    nrow = 4,
    ncol = 5,
    byrow = T
)

print(costdata)

myway = expensecalc(costdata)
myway$path
myway$totalexpense
myanotherway = greedy(costdata)
myanotherway$path
myanotherway$totalexpense

## performance review

testcost <- function(nrow, ncol, times) {

    diff = 0

     for (trial in 1:times) {

        costdata <- matrix(
            data = sample(x = 0:15, size = nrow*ncol, replace = TRUE),
            nrow = nrow,
            ncol = ncol
        )

        diff = c(diff, (greedy(costdata)$totalexpense - expensecalc(costdata)$totalexpense))
    }

    return(diff[-1])
}

mytest = testcost(10, 12, 1000)
plot(mytest, type = "l",
     main = "Differnce of costs: how bad is the greedy algorithm?",
     sub = "Done on 10 by 12 Grid. Costs sampled from 0 to 15",
     xlab = "Trial",
     ylab = "Difference in costs")
abline(h = mean(mytest), col = "red")
mean(mytest)


library(tidyverse)
library(stringr)
library(purrr)
library(lubridate)
library(readr)
library(forecast)

setwd("C:/Users/Ghozy Haqqoni/Documents/!Kuliah/Semester 5 - DS/Time Series/datas/")

#########
#CHAPTER 4
#########

####Simulate the autoregressive model####
# Simulate an AR model with 0.5 slope
x <- arima.sim(model = list(ar = 0.5), n = 100)
# Simulate an AR model with 0.9 slope
y <- arima.sim(model = list(ar = 0.9), 100)
# Simulate an AR model with -0.75 slope
z <- arima.sim(model = list(ar = -0.75), 100)
# Plot your simulated data
plot.ts(cbind(x, y, z))
####

####Estimate the autocorrelation function (ACF) for an autoregression####
# Calculate the ACF for x
acf(x)
# Calculate the ACF for y
acf(y)
# Calculate the ACF for z
acf(z)
####

####Compare the random walk (RW) and autoregressive (AR) models####
# Simulate and plot AR model with slope 0.9
x <- arima.sim(model = list(ar =.9), n = 200)
ts.plot(x)
acf(x)
# Simulate and plot AR model with slope 0.98
y <- arima.sim(model = list(ar =.98), n = 200)
ts.plot(y)
acf(y)
# Simulate and plot RW model (diff = 1)
z <- arima.sim(model = list(order = c(0,1,0)), n = 200)
ts.plot(z)
acf(z)
####

####################################################
####AR Model Estimation and Forecasting#### <- video
#load data
data(Mishkin, package = "Ecdat")
class(Mishkin)
View(Mishkin)
#make inflation -> ts
inflation <- as.ts(Mishkin[,1])
class(inflation)
#AR Processes: Inflation Rate
ts.plot(inflation); acf(inflation)
#AR Model: Inflation Rate
library(forecast)
AR_inflation2 <- arima(inflation, order = c(1,0,0))
AR_inflation2
#AR Processes: Fitted Values
ts.plot(inflation)
AR_inflation_fitted2 <- inflation - residuals(AR_inflation2)
points(AR_inflation_fitted2, type = "l", col = "red",
       lty = 2)
#forecasting
predict(AR_inflation2) #1-step ahead forecasts
predict(AR_inflation2, n.ahead = 5) #n-step ahead forecasts
####
####################################################

####Estimate the autoregressive (AR) model####
# Fit the AR model to x
arima(x, order = c(1,0,0))
# Copy and paste the slope (ar1) estimate
0.8575
# Copy and paste the slope mean (intercept) estimate
-0.0948
# Copy and paste the innovation variance (sigma^2) estimate
1.022
# Fit the AR model to AirPassengers
AR <- arima(AirPassengers, order = c(1,0,0))
print(AR)
# Run the following commands to plot the series and fitted values
ts.plot(AirPassengers)
AR_fitted <- AirPassengers - residuals(AR)
print(AR_fitted)
points(AR_fitted, type = "l", col = 2, lty = 2)
####

####Simple forecasts from an estimated AR model####
data("Nile")
# Fit an AR model to Nile
AR_fit <-arima(Nile, order  = c(1,0,0))
print(AR_fit)
# Use predict() to make a 1-step forecast
predict_AR <- predict(AR_fit)
# Obtain the 1-step forecast using $pred[1]
predict_AR$pred[1]
# Use predict to make 1-step through 10-step forecasts
predict(AR_fit, n.ahead = 10)
# Run to plot the Nile series plus the forecast and 95% prediction intervals
ts.plot(Nile, xlim = c(1871, 1980))
AR_forecast <- predict(AR_fit, n.ahead = 10)$pred
AR_forecast_se <- predict(AR_fit, n.ahead = 10)$se
points(AR_forecast, type = "l", col = 2)
points(AR_forecast - 2*AR_forecast_se, type = "l", col = 2, lty = 2)
points(AR_forecast + 2*AR_forecast_se, type = "l", col = 2, lty = 2)
####

#########
#CHAPTER 5
#########

#The Simple Moving Average Model

####Simulate the simple moving average model####
# Generate MA model with slope 0.5
x <- arima.sim(model = list(ma = 0.5), n = 100)
# Generate MA model with slope 0.9
y <- arima.sim(model = list(ma = 0.9), n = 100)
# Generate MA model with slope -0.5
z <- arima.sim(model = list(ma = -0.5), n = 100)
# Plot all three models together
plot.ts(cbind(x, y, z))
####

####Estimate the autocorrelation function (ACF) for a moving average####
# Calculate ACF for x
acf(x)
# Calculate ACF for y
acf(y)
# Calculate ACF for z
acf(z)
####

####################################################
####MA Model Estimation and Forecasting
#load data
data(Mishkin, package = "Ecdat")
class(Mishkin)
View(Mishkin)
#make inflation -> ts
inflation <- as.ts(Mishkin[,1])
class(inflation)
#MA Processes: Changes (diff) in Inflation Rate
inflation_diff <- diff(inflation)
ts.plot(inflation); ts.plot(inflation_diff)
acf(inflation_diff, lag.max=24)
#MA Model
MA_inflation_diff <- arima(inflation_diff, order=c(0,0,1))
MA_inflation_diff
#MA Processes: Fitted Value
ts.plot(inflation_diff)
MA_inflation_diff_fitted <- inflation_diff - residuals(MA_inflation_diff)
points(MA_inflation_diff_fitted, type="l",
       col = "red", lty = 2)
#forecast
predict(MA_inflation_diff, n.ahead = 5)
####################################################

####Estimate the simple moving average model####
# Fit the MA model to x
arima(x, order = c(0,0,1))
# Paste the slope (ma1) estimate below
.7928
# Paste the slope mean (intercept) estimate below
.1589
# Paste the innovation variance (sigma^2) estimate below
.9576
# Fit the MA model to Nile
data("Nile")
MA <- arima(Nile, order = c(0,0,1))
print(MA)
AIC(MA); BIC(MA)
# Plot Nile and MA_fit
ts.plot(Nile)
MA_fit <- Nile - resid(MA)
points(MA_fit, type = "l", col = 2, lty = 2)
####

####Simple forecasts from an estimated MA model####
# Make a 1-step forecast based on MA
predict_MA <- predict(MA)
predict_MA
# Obtain the 1-step forecast using $pred[1]
predict_MA$pred[1]
# Make a 1-step through 10-step forecast based on MA
predict(MA, 10)
# Plot the Nile series plus the forecast and 95% prediction intervals
ts.plot(Nile, xlim = c(1871, 1980))
MA_forecasts <- predict(MA, n.ahead = 10)$pred
MA_forecast_se <- predict(MA, n.ahead = 10)$se
points(MA_forecasts, type = "l", col = 2)
points(MA_forecasts - 2*MA_forecast_se, type = "l", col = 2, lty = 2)
points(MA_forecasts + 2*MA_forecast_se, type = "l", col = 2, lty = 2)
####

#Compare the AR and MA Models

####AR vs MA models####
# Find correlation between AR_fit and MA_fit
cor(AR_fit, MA_fit)
# Find AIC of AR
AIC(AR)
# Find AIC of MA
AIC(MA)
# Find BIC of AR
BIC(AR)
# Find BIC of MA
BIC(MA)
####


#' Compute the squared error
#'
#' This function computes the elementwise squared error for a
#' number or a vector
#'
#' @param actual ground truth number or vector
#' @param predicted predicted number or vector
#' @export
se <- function (actual, predicted) (actual-predicted)^2

#' Compute the mean squared error#'
#' This function computes the mean squared error between
#' two vectors
#'
#' @param actual ground truth vector
#' @param predicted predicted vector
#' @export
mse <- function (actual, predicted) mean(se(actual, predicted))

#' Compute the root mean squared error#'
#' This function computes the root mean squared error
#' between two vectors
#'
#' @param actual ground truth vector
#' @param predicted predicted vector
#' @export
rmse <- function (actual, predicted) sqrt(mse(actual, predicted))

#' Compute the absolute error#'
#' This function computes the elementwise absolute error for a
#' number or a vector
#'
#' @param actual ground truth number or vector
#' @param predicted predicted number or vector
#' @export
ae <- function (actual, predicted) abs(actual-predicted)

#' Compute the mean absolute error#'
#' This function computes the mean absolte error between
#' two vectors
#'
#' @param actual ground truth vector
#' @param predicted vector
#' @export
mae <- function (actual, predicted) mean(ae(actual, predicted))

#' Compute the squared log error
#'
#' This function computes the elementwise squared log error for a
#' number or a vector
#'
#' @param actual ground truth number or vector
#' @param predicted predicted number or vector
#' @export
sle <- function (actual, predicted) (log(1+actual)-log(1+predicted))^2

#' Compute the mean squared log error
#'
#' This function computes the mean squared log error between
#' two vectors
#'
#' @param actual ground truth vector
#' @param predicted predicted vector
#' @export
msle <- function (actual, predicted) mean(sle(actual, predicted))

#' Compute the root mean squared log error
#'
#' This function computes the root mean squared log error between
#' two vectors
#'
#' @param actual ground truth vector
#' @param predicted predicted vector
#' @export
rmsle <- function (actual, predicted) sqrt(msle(actual, predicted))

#' Compute the area under the ROC (AUC)
#'
#' This function computes the area under the receiver-operator
#' characteristic (AUC)
#'
#' @param actual binary vector
#' @param predicted real-valued vector that defines the ranking
#' @export
auc <- function(actual, predicted)
{
    r <- rank(predicted)
    n_pos <- sum(actual==1)
    n_neg <- length(actual) - n_pos
    auc <- (sum(r[actual==1]) - n_pos*(n_pos+1)/2) / (n_pos*n_neg)
    auc
}

#' Compute the log loss
#'
#' This function computes the elementwise log loss for a
#' number or a vector
#'
#' @param actual binary ground truth number or vector
#' @param predicted predicted number or vector
#' @export
ll <- function(actual, predicted)
{
    score <- -(actual*log(predicted) + (1-actual)*log(1-predicted))
    score[actual==predicted] <- 0
    score[is.nan(score)] <- Inf
    score
}

#' Compute the mean log loss
#'
#' This function computes the mean log loss between
#' two vectors
#'
#' @param actual binary ground truth vector
#' @param predicted predicted vector
#' @export
logLoss <- function(actual, predicted) mean(ll(actual, predicted))

#' Compute the average precision at k
#'
#' This function computes the average precision at k
#' between two sequences
#'
#' @param k max length of predicted sequence
#' @param actual ground truth set (vector)
#' @param predicted predicted sequence (vector)
#' @export
apk <- function(k, actual, predicted)
{
    score <- 0.0
    cnt <- 0.0
    for (i in 1:min(k,length(predicted)))
    {
        if (predicted[i] %in% actual && !(predicted[i] %in% predicted[0:(i-1)]))
        {
            cnt <- cnt + 1
            score <- score + cnt/i
        }
    }
    score <- score / min(length(actual), k)
    score
}

#' Compute the mean average precision at k
#'
#' This function computes the mean average precision at k
#' of two lists of sequences.
#'
#' @param k max length of predicted sequence
#' @param actual list of ground truth sets (vectors)
#' @param predicted list of predicted sequences (vectors)
#' @export
mapk <- function (k, actual, predicted)
{
    scores <- rep(0, length(actual))
    for (i in 1:length(scores))
    {
        scores[i] <- apk(k, actual[[i]], predicted[[i]])
    }
    score <- mean(scores)
    score
}

#' Compute the classification error
#'
#' This function computes the classification error
#' between two vectors
#'
#' @param actual ground truth vector
#' @param predicted predicted vector
#' @export
ce <- function (actual, predicted)
{
    cntError <- 0.0
    for (i in 1:length(actual))
    {
        if (actual[i] != predicted[i])
        {
            cntError <- cntError + 1
        }
    }

    score = cntError / length(actual)
    score
}

#' Compute the quadratic weighted kappa
#'
#' This function computes the quadratic weighted kappa
#' between two vectors of integers
#'
#' @param rater.a is the first rater's ratings
#' @param rater.b is the second rater's ratings
#' @param min.rating is the minimum possible rating
#' @param max.rating is the maximum possible rating
#' @export
ScoreQuadraticWeightedKappa <- function (rater.a , rater.b,
                                        min.rating,
                                        max.rating) {

    if (missing(min.rating)) {
        min.rating <- min(min(rater.a),min(rater.b))
    }
    if (missing(max.rating)) {
        max.rating <- max(max(rater.a),max(rater.b))
    }

    rater.a <- factor(rater.a, levels<-min.rating:max.rating)
    rater.b <- factor(rater.b, levels<-min.rating:max.rating)

    #pairwise frequencies
    confusion.mat <- table(data.frame(rater.a, rater.b))
    confusion.mat <- confusion.mat / sum(confusion.mat)

    #get expected pairwise frequencies under independence
    histogram.a <- table(rater.a) / length(table(rater.a))
    histogram.b <- table(rater.b) / length(table(rater.b))
    expected.mat <- histogram.a %*% t(histogram.b)
    expected.mat <- expected.mat / sum(expected.mat)

    #get weights
    labels <- as.numeric( as.vector (names(table(rater.a))))
    weights <- outer(labels, labels, FUN <- function(x,y) (x-y)^2 )

    #calculate kappa
    kappa <- 1 - sum(weights*confusion.mat)/sum(weights*expected.mat)
    kappa
}

#' Compute the mean quadratic weighted kappa
#'
#' This function computes the mean quadratic weighted
#' kappa, which can optionally be weighted
#'
#' @param kappas is a vector of possible kappas
#' @param weights is an optional vector of ratings
#' @export
MeanQuadraticWeightedKappa <- function (kappas, weights) {

    if (missing(weights)) {
        weights <- rep(1, length(kappas))
    } else {
        weights <- weights / mean(weights)
    }

    max999 <- function(x) sign(x)*min(0.999,abs(x))
    min001 <- function(x) sign(x)*max(0.001,abs(x))
    kappas <- sapply(kappas, max999)
    kappas <- sapply(kappas, min001)

    r2z <- function(x) 0.5*log((1+x)/(1-x))
    z2r <- function(x) (exp(2*x)-1) / (exp(2*x)+1)
    kappas <- sapply(kappas, r2z)
    kappas <- kappas * weights
    kappas <- mean(kappas)
    kappas <- z2r(kappas)
    kappas
}


# Example : 2   Chapter : 6.2     Page No: 300
# The diagonal matrix of any matrix contains the eigen values in its main diagonal
A<-matrix(c(0.8,0.2,0.3,0.7),ncol=2)
lambda<-eigen(A)$values
print(lambda)
S<-eigen(A)$vectors #Normlised eigen vectors, Answer can also be validated with normalised eigen vectors
#to get eigen vector matrix in text book
S[,1]<-S[,1]*(0.6/S[1,1])
S[,2]<-S[,2]*(1/S[1,2])
S1<-solve(S)
Diag_matrix<-diag(2)*lambda
print("S*diag_matrix(A)*S-1 is A")
print(S%*%Diag_matrix%*%S1)
#The  answer may slightly vary due to  rounding off values
#The answers provided in the text book may vary because of the computation process
#Both answers are correct , here it is taken -Ax+b=0 , In the text book it is considered as Ax-b=0


#!/usr/bin/env Rscript

# eg.1 假设检验
w = scan("res/sugar.txt")

par(mfrow=c(1,1))
hist(x=w, main="Histogram of sugar weight")

summary(object = w)

# QQ正态图
par(mfrow=c(1,1))
qqnorm(w)
qqline(w)

# H0: u = 500 <=>  H1: u < 500
# 检验统计量的分布从H0导出, 如果有矛盾, 就对H0不利
# p值: 检验统计量取实现值以及更极端值的概率
# p值很小: 在H0下, 小概率的事件发生了
# 显著性水平alpha, PV < alpha 拒绝H0
# R软件给出PValue值, 一般不给alpha, PValue又叫观测的显著性水平(sig)
# alpha不是越小越好, 越小越不好拒绝H0, 导致犯第二类错误
# 显著性水平和临界值是前计算机时代, 因为计算难度
# 现在计算机直接给出P-Value和统计量的实现值

# Nvim: \rp可以直接看结果
result = t.test(x = w, mu = 500, alternative = "less")
print(result$p.value)

# eg.2
w = scan("res/exh.txt")
result = t.test(w, mu = 20, alternative = "greater")
print(result$p.value)

# eg.3  (w1, w2必需相互独立)
w = read.table(file = "res/drug.txt", header = T)
w1 = w[w[,2]==1,1]
w2 = w[w[,2]==2,1]
t.test(w1, w2, alt="greater")

# eg.4 (w1, w2 并不相互独立, 不能是u1 = u2假设, 但是可以udiff = before - after的差后的数据)
w = read.table(file = "res/diet.txt", header = T)
w1 = w$before
w2 = w$after
summary(w1)
summary(w2)
# 我们是在H0的分布下做假设, 然后把实测数据扔进去, 发现这种假设下实测数据的概率很低
t.test(w$before - w$after, alt = "greater")
# or
t.test(w$before , w$after, alt = "greater", pair = T)

# eg.5: 总体比例的检验
# 电视收视率调查1500人, 某电视台期望25%看, 实测23%, 是否显著
# 二项分布
# 方法一: 假设分布是B(1500, 0.25), 那么1500*0.23看此台的概率 ---> P-Value
# p-value: 0.03836
pbinom(q = 1500*0.23, size = 1500, prob = 0.25)

# 方法二: R精确检验
# p-value: 0.03837
binom.test(0.23*1500, 1500, 0.25, alt="less")

# 方法三: 近似(样本量大), 历史计算问题, 被淘汰
# p-value: 0.3929
prop.test(0.23*1500, 1500, 0.25, alt="less")

# eg.5: 两个总体比例之差
# A收视率: 20%  B收视率: 21%   A比B好吗?
n1 = 1200
n2 = 1300

# 精确
binom.test(c(0.20*n1, 0.21*n2), c(n1, n2), alt="less")$p.value
# 近似
prop.test(c(0.20*n1, 0.21*n2), c(n1, n2), alt="less")$p.value

# eg.6: 连续型变量检验
data = scan("res/life.txt")
# 大于2的数据
data[data > 2]
# Question: 小于2的是否少于70% ?
# 把疑问作为H0: p = 0.7 (p <= 0.7, 等于0.7, p-value已经很小了, 小于0.7更是如此)
binom.test(x = sum(data < 2),
           n = length(data),
           p = 0.7,
           alternative = "greater")$p.value

# eg.7: 非参数检验(秩)
# 如果把数据排序, 中位数100, 大于100, 小于100各0.5的概率
# 实际上从样本上观测大于100的个数没有一半
data = scan("res/GS.TXT")
pbinom(q = 1000, size = 2000, prob = 0.5)
pbinom(q = sum(data > 100), size = length(data), prob = 0.5)


'''
For n = 5 and n = 1000, generate a random sample (e.g. using the R-command runif)
from the unif(0; 1) distribution.
Perform the two tests in c) having size alpha = 0.05 on your datasets.
For which of the tests do you reject H0? Discuss your fndings.
'''

min_n=5
max_n=1000
x_min = runif(min_n, min = 0, max = 1) #The Uniform Distribution
x_max = runif(max_n, min = 0, max = 1) #runif (open) will not generate either of the extreme values

#The likelihood ratio statistics rejects H0 if max(x) > 1 which it isnt from U(0,1)
# theta_MoM = 2*X_bar

theta_MoM_min = 2* mean(x_min)
theta_MoM_max = 2* mean(x_max)

sample.mean = 2*mean(x_min)
print(sample.mean)
sample.n = min_n
sample.sd = sd(x_min)
sample.se = sample.sd/sqrt(sample.n)
bound = ci_for_u(sample)

#MLE
print(max(x_min))
#[1] 0.7081458

#MoM
#2*sample_mean [1] 0.5812125
#t-score [1] 2.776445
#confidence interval [1] 0.2281778 0.9342472

sample.mean = 2* mean(x_max)
print(sample.mean)
sample.n = max_n
sample.sd = sd(x_max)
sample.se = sample.sd/sqrt(sample.n)
bound = ci_for_u(sample)

#MLE
print(max(x_max))
#[1] 0.999497

#MoM
#2*sample_mean [1] 0.9991154
#t-score [1] 1.962341
#confidence interval [1] 0.9814277 1.0168030

# discuss: likelihood ratio test is asymptotically better
# theta_Mom contains level alpha=0.05 test with theta > 1 when we know U(0,1)
# But for small sample size MoM is better (n approximatly 5)

ci_for_u <- function(sample) {
	alpha = 0.05
	degrees.freedom = sample.n - 1
	t.score = qt(p=alpha/2, df=degrees.freedom,lower.tail=F)
	print(t.score)
	margin.error = t.score * sample.se
	bound.lower = sample.mean - margin.error
	bound.upper = sample.mean + margin.error
	print(c(bound.lower,bound.upper))
	return (c(bound.lower,bound.upper))
}

'''
 here is a little simulation for the MSE of the estimators of the mean,
 showing that while the MLE if we do not know the lower bound is zero is unbiased,
 the MSEs for the two variants are identical, suggesting that the estimator which
 incorporates knowledge of the lower bound reduces variability.

https://stats.stackexchange.com/questions/252129/is-there-an-example-where-mle-produces-a-biased-estimate-of-the-mean
'''

theta <- 1
mean <- theta/2
reps <- 500000
n <- 5
mse <- bias <- matrix(NA, nrow = reps, ncol = 2)

for (i in 1:reps){
  x <- runif(n, min = 0, max = theta)
  mle.knownlowerbound <- max(x)/2
  mle.unknownlowerbound <- (max(x)+min(x))/2
  mse[i,1] <- (mle.knownlowerbound-mean)^2
  mse[i,2] <- (mle.unknownlowerbound-mean)^2
  bias[i,1] <- mle.knownlowerbound-mean
  bias[i,2] <- mle.unknownlowerbound-mean

}

> colMeans(mse)
[1] 0.01194837 0.01194413

> colMeans(bias)
[1] -0.083464968 -0.000121968


Group1 <- c(5,17,12,10,4)
Group2 <- c(19,10,9,7,5)
Group3 <- c(25,15,12,9,8)

Combined_Groups <- data.frame(cbind(Group1, Group2, Group3)) # combines the data into a single data set.
Combined_Groups # shows spreadsheet like results
#summary(Combined_Groups)  # min, median, mean, max

Stacked_Groups <- stack(Combined_Groups)
Stacked_Groups #shows the table Stacked_Groups

Anova_Results <- aov(values ~ ind, data = Stacked_Groups)
summary(Anova_Results) # shows Anova_Results

# answer given in book is wrong because sample varaince calcaulated for group 1 column in book is 33.7 which is wrong
# correct sample varaince is 28.3


p = function(x)
{
	dnorm(x,0,1)
}

mh = function(x,alpha)
{
	xt <- runif(1,x-alpha,x+alpha)
	if( runif(1) > p(xt) / p(x) )
		xt <- x

	return(xt)
}

sampler = function(L,alpha)
{
	x <- numeric(L)
	for(i in 2:L)
		x[i] <- mh(x[i-1],alpha)

	return(x)
}

par(mfrow=c(2,2))
for(l in c(10,100,1000,10000))
{
	hist(sampler(l,1),main=paste(l,"iterations"),breaks=50,freq=F,xlim=c(-4,4),ylim=c(0,1))
	lines(x0,p(x0))
}

par(mfrow=c(2,2))
for(a in c(0.1,0.5,1,10))
{
	hist(sampler(50000,a),main=paste("alpha=",a),breaks=50,freq=F,xlim=c(-4,4),ylim=c(0,1))
	lines(x0,p(x0))
}

#x0 <- seq(-4,4,0.1)
#plot( x0, p(x0), lty=2 , t='l')


#####################################################################
######  						 Applied Linear Model  	                  ######
#####################################################################
library("alr3")
###############
#A data frame with 32 observations on 11 variables in mtcars
#[, 1]	 mpg	 Miles/(US) gallon
#[, 2]	 cyl	 Number of cylinders
#[, 3]	 disp	 Displacement (cu.in.)
#[, 4]	 hp	 Gross horsepower
#[, 5]	 drat	 Rear axle ratio
#[, 6]	 wt	 Weight (lb/1000)
#[, 7]	 qsec	 1/4 mile time
#[, 8]	 vs	 V/S
#[, 9]	 am	 Transmission (0 = automatic, 1 = manual)
#[,10]	 gear	 Number of forward gears
#[,11]	 carb	 Number of carburetors
######
###### Problem2 R code
scatterplotMatrix(mtcars[,c(1, 2, 3, 4, 5, 6, 7)], smooth=FALSE)
y <- mtcars$mpg
wt <- mtcars$wt
hp <- mtcars$hp
qsec <- mtcars$qsec
disp <- mtcars$disp
cyl <- mtcars$cyl
dc <- disp/cyl
m3 <- lm(y~wt+hp+qsec+dc, mtcars)
summary(m3)
anova(m3)
######
m4 <- lm(y~wt+hp+qsec, mtcars)
summary(m4)
anova(m4)
######
m5 <- lm(y~wt+hp, mtcars)
summary(m5)
anova(m5)

###### Problem 3.1 R code
library("alr3")
scatterplotMatrix(BGSgirls[, c(2, 3, 4, 5, 6, 7, 12)], smooth=FALSE)
print(cor(BGSgirls[, c(2, 3, 4, 5, 6, 7, 12)]), 3)

######
par(mfrow=c(2,2))

wt9 <- BGSall$WT9
lg9 <- BGSall$LG9
soma <-BGSall$Soma

plot(wt9, soma)
fit1 <- lm(soma~wt9)
abline(fit1)

plot(lg9, soma)
fit2 <- lm(soma~lg9)
abline(fit2)

plot(wt9, lg9)
fit12 <- lm(lg9~wt9)
abline(fit12)

e12 <- fit12$residuals
e1 <- fit1$residuals
plot(e12, e1)
abline(h=0, lty="dashed")
abline(v=0, lty="dashed")
abline(lm(e1~e12))

######
m1 <- lm(Soma~HT2+WT2+HT9+WT9+ST9, BGSgirls)
summary(m1)

######
anova(m1)

######
m2 <- lm(Soma~ST9+WT9+HT9+WT2+HT2, BGSgirls)
anova(m2)


# Example : 3   Chapter : 4.2     Page No: 211
# Find the best possible solution, projection vector and projection matrix

solution<-function(A,b){
  ATA<-t(A)%*%A
  b<-matrix(c(b),ncol=1)
  ATb<-t(A)%*%b
  xhat<-solve(ATA,ATb)
  p<-A%*%xhat
  e<-b-p
  ATA1<-solve(ATA)
  P<-A%*%ATA1
  P<-P%*%t(A)
  print("The best possible solution is ")
  print(xhat)
  print("The projection vector is ")
  print(p)
  print("The error vector e is")
  print(e)
  print("The projection matrix is ")
  print(P)
}

A<-matrix(c(1,1,1,0,1,2),ncol=2)
b<-c(6,0,0)
solution(A,b)
#The  answer may slightly vary due to  rounding off values


### 6.2-4

hypoPerc <- c(0.44, 0.42, 0.1, 0.04)
experData <- c(58, 65, 55, 22)
nSamples <- length(experData)
nPartic <- sum(experData)

hypoData <- hypoPerc * nPartic

chiSquare <- sum((experData - hypoData)^2 / hypoData)
print(chiSquare)

### m = r - k - 1 = 4 - 1 = 3
chiSquareCritical <- qchisq(0.9, nSamples-1, ncp=0, lower.tail=TRUE, log.p=FALSE)
print(chiSquareCritical)

### chiSquare = 100.2749  ->  H0 is accepted (the dataset does not obey the hypothetical percentage)


#   __      _____             _              __        _
# <(o )___ |  _  |___ ___ ___| |_ ___ ___   |  |   ___| |_ ___
# ( ._> /  |   __|  _| -_|_ -|  _| -_|_ -|  |  |__| .'| . |_ -|
#  `---'   |__|  |_| |___|___|_| |___|___|  |_____|__,|___|___|
#==============================================================================
# Local Regression NonParametric LOESS
#==============================================================================
# Title          : Local Regression NP LOESS.r
# Description    : Local Regression - Fit a line with LOESS in R
# Author         : Isaias V. Prestes <isaias.prestes@gmail.com>
# Date           : 20180304
# Version        : 0.0.1
# Usage          : Run in R 3.4
# Notes          : Based on
# https://stackoverflow.com/questions/15337777/fit-a-line-with-loess-in-r
# http://ggplot2.tidyverse.org/reference/geom_smooth.html
# r-statistics.co by Selva Prabhakaran
# R version      : 3.4
#==============================================================================
# install.packages('ggplot2')

#==============================================================================
# LIBRARY DEPENDENCE
#==============================================================================
library(ggplot2)

# Loess short for Local Regression is a non-parametric approach that fits
# multiple regressions in local neighborhood. This can be particularly
# resourceful, if you know that your X variables are bound within a range.

#------------------------------------------------------------------------------
# Regular
#------------------------------------------------------------------------------
load(url('https://www.dropbox.com/s/ud32tbptyvjsnp4/data.R?dl=1'))
lw1 <- loess(y ~ x,data=data)
plot(y ~ x, data=data,pch=19,cex=0.1, main="Loess Smoothing and Prediction")
j <- order(data$x)
lines(data$x[j],lw1$fitted[j],col="red",lwd=3)

#------------------------------------------------------------------------------
# Scatter
#------------------------------------------------------------------------------
scatter.smooth(data$y ~ data$x, span = 2/3, degree = 2, main="Loess Smoothing and Prediction")

#------------------------------------------------------------------------------
# ggplot2
#------------------------------------------------------------------------------
# http://ggplot2.tidyverse.org/reference/geom_smooth.html
load(url("https://www.dropbox.com/s/ud32tbptyvjsnp4/data.R?dl=1"))
ggplot(data, aes(x, y), main="Loess Smoothing and Prediction") +
geom_point() +
geom_smooth(method = "loess", se = FALSE)

ggplot(data, aes(x, y)) +
geom_point() +
geom_smooth(method = "loess", se = TRUE)

# Second Example

data(economics, package="ggplot2")  # load data
economics$index <- 1:nrow(economics)  # create index variable
economics <- economics[1:80, ]  # retail 80rows for better graphical understanding
loessMod10 <- loess(uempmed ~ index, data=economics, span=0.10) # 10% smoothing span
loessMod25 <- loess(uempmed ~ index, data=economics, span=0.25) # 25% smoothing span
loessMod50 <- loess(uempmed ~ index, data=economics, span=0.50) # 50% smoothing span
# get smoothed output
smoothed10 <- predict(loessMod10)
smoothed25 <- predict(loessMod25)
smoothed50 <- predict(loessMod50)

# Plot it
plot(economics$uempmed, x=economics$date, type="l", main="Loess Smoothing and Prediction", xlab="Date", ylab="Unemployment (Median)")
lines(smoothed10, x=economics$date, col="red")
lines(smoothed25, x=economics$date, col="green")
lines(smoothed50, x=economics$date, col="blue")

#------------------------------------------------------------------------------
# Finding the optimal smoothing span
#------------------------------------------------------------------------------
# As the smoothing span changes, the accuracy of the fitted curve also changes.
# If your intent is to minimize the error, the optim() can be used to find that
# value of span, that minimizes the Sum of Squared Errors (SSE). For this case,
# it is graphically intuitive that lower SSE will likely be achieved at lower
# values of span, but for more challenging cases, optimizing span could help.
# To implement optim(), we define the function that computes the SSE. An error
# handling mechanism is needed to address very low values of span and cases where
# the non-numerics are produced. The simulated annealing method (SANN) is
# implemented here to find the span that gives minimal SSE. The par argument
# specifies the first value of the span at which optim() will begin the search.

# define function that returns the SSE
calcSSE <- function(x){
  loessMod <- try(loess(uempmed ~ index, data=economics, span=x), silent=T)
  res <- try(loessMod$residuals, silent=T)
  if(class(res)!="try-error"){
    if((sum(res, na.rm=T) > 0)){
      sse <- sum(res^2)
    }
  }else{
    sse <- 99999
  }
  return(sse)
}

# Run optim to find span that gives min SSE, starting at 0.5
optim(par=c(0.5), calcSSE, method="SANN")

# EOF

Local Regression MP LOESS/Local Regression MP LOESS.r


# confidence interval for indpendent sample

n1= 12
n2= 12
y1bar = 26.58
y2bar=39.67
s1=14.36
s2=13.86
# solving part c
# common standard deviation
sp=sqrt(((n1-1)*s1*s1+(n2-1)*s2*s2)/(n1+n2-2))

# the t-percentile based on df for 95% confidence interval
tstar=qt( .975, df=18)
margin=tstar*sp*sqrt((1/n1)+(1/n2))
left_i=(y1bar-y2bar)-margin
right_i=(y1bar-y2bar)+margin
print("confidence interval is")
print(left_i)
print(right_i)

# solving part  a and b
t=(y1bar-y2bar)/((sp)*sqrt((1/n1)+(1/n2)))
print(t)
# crtitical value
alpha= 0.05
df=n1+n2-2
t.alpha=qt(0.05, df=22)
if(t<=t.alpha){
  print(" We will reject H0")
}else{
  print("we will fail to reject H0 (no significant evidence")
}


# mean
mean_g <- function(x, gmean = "sqrtsin") {
    switch(
        gmean,
        "linear" = 0.2 + 0.4 * x,
        "log" = log(x),
        "sin" = sin(2 * pi * x),
        "lsin" =  0.5 + 2 * x + sin(2 * pi * x - 0.5),
        "sqrtsin" = sqrt(x * (1 - x)) * sin(2 * pi * (1 + 2 ^ (-7 / 5)) / (x + 2 ^ (-7 / 5)))
    )
}
# error
err_sig <- function(x, xsig = "quad", derr = "norm") {
    v_sig <- switch(
        xsig,
        "const" = 0.2,
        "linear" = 0.2 + 0.2 * x,
        "quad" = 0.5 + 0.5 * (x - 1) ^ 2
    )
    switch(
        derr,
        "norm" = rnorm(x, 0),
        "chisq3" = rchisq(x, 3),
        "t3" = rt(x, 3),
        "t1" = rt(x, 1)
        #"laplace" = rla
    ) * v_sig
}
# error quantile
err_qt <- function(x, tau = 0.5, xsig = "quad", derr = "norm") {
    v_sig <- switch(
        xsig,
        "const" = 0.2,
        "linear" = 0.2 + 0.2 * x,
        "quad" = 0.5 + 0.5 * (x - 1) ^ 2
    )
    switch(
        derr,
        "norm" = qnorm(tau, 0),
        "chisq3" = qchisq(tau, 3),
        "t3" = qt(tau, 3),
        "t1" = qt(tau, 1)
        #"laplace" = rla
    ) * v_sig
}
obs_f <- function(x, gmean = "sqrtsin", xsig = "quad", derr = "norm") {
    mean_g(x, gmean) + err_sig(x, xsig, derr)
}
truth_f <- function(x, tau, gmean = "sqrtsin", xsig = "quad", derr = "norm") {
    mean_g(x, gmean) + err_qt(x, tau, xsig, derr)
}

# x <- sort(x)
# plot(x, obs_f(x, derr = "chisq3"))
# for (tau in seq(0.001, 0.999, length.out = 10)) {
#     lines(comp[[3]][[1]]$x, truth_f(comp[[3]][[1]]$x, tau, gmean = "linear", xsig = "linear", derr = "t3"))
# }


##########################
# Linear regression in R #
##########################

# Create some data
x <- c(1,3,4,5,4,3,6,4,8,9,10,11,4,6,2,4,9,12,4)
n = length(x)
y <- 3 + 1.6 * x + + 0.5 * x^2 + rnorm(n,mean=0,sd=4)
plot(x,y)      #scatterplot

# Fit a linear regression model
fit1 <- lm(y~x)       # intercept is included automatically
summary(fit1)

plot(fit1)      # Some standard diagnostics for checking model assumptions

# Alternatively can do this by hand
fitted1 <- fit1$fitted      # fitted values y_hat
rstd1 <- rstandard(fit1)    # standardized residuals

# Residuals against fitted. Always look at this plot. Goal: See no pattern whatsoever
plot(fitted1,rstd1)                 # See the U-shaped pattern?
                                    # Suggests including a quadratic term

# Normality
qqnorm(rstd1)
qqline(rstd1)               # Normality looks OK

# Try a new model
x.sq = x^2
fit2 <- lm(y ~ x + x.sq)
summary(fit2)

fitted2 <- fit2$fitted      # fitted values y_hat
rstd2 <- rstandard(fit2)    # standardized residuals

plot(fitted2,rstd2)         # Now it looks OK. => Use model fit2, not fit1.

qqnorm(rstd2)
qqline(rstd2)               # OK

?lm

fit2$model                  # It doesn't show the first column that is constant all 1's. But it is used nevertheless (intercept).

fit2$coefficients           # The OLS estimate beta_hat
vcov(fit2)                  # The variance/covariance matrix of beta_hat

# Illustrate Near-collinearity
x3 <- 2*x + 5*x.sq + rnorm(n,mean=0,sd=0.01)

fit3 <- lm(y ~ x + x.sq + x3)
summary(fit3)               # The standard errors became huge now. Hard to identify the beta's.
plot(fit3)

fitted3 <- fit3$fitted      # fitted values y_hat
rstd3 <- rstandard(fit3)    # standardized residuals

plot(fitted3,rstd3)         #

qqnorm(rstd3)
qqline(rstd3)               #

# How to detect near (multi-)collinearity?
# Check whether one of the Variance Inflation Factors (VIF) is > 10.  If yes => potential problem.

# install.packages("car")
library(car)                # need to install package 'car' first

vif(fit2)                   # Not great, but not tooo bad either
vif(fit3)                   # Catastrophic. Clearly, one of the variables has to go.

# Check numerical stability of calculations by hand

# Create model matrix X for model fit3
fit3$model                  # Doesn't include constant column with all ones. Have to add it by hand
const <- rep(1,n)
X3_ <- cbind(const,fit3$model[,2:4])
X3_                         # Can't do matrix opertions on this array. Have to convert to matrix.
X3 <- as.matrix(X3_)
X3                          # That's it

# Easier alternative: X3 <- model.matrix(fit3)

beta_hat3_naive <- solve(t(X3) %*% X3) %*% t(X3) %*% y
t(beta_hat3_naive)
fit3$coef                   # Here the naive method doesn't create problems yet.

summary(fit3)
names(summary(fit3))
sigma3 <- summary(fit3)$sigma

V3_naive <- sigma3^2 * solve(t(X3) %*% X3)
V3_naive
vcov(fit3)                  # Comparison shows that the naive method still works

# Let's make it worse
x4 <- 2*x + 5*x.sq + rnorm(n,mean=0,sd=0.00005)

fit4 <- lm(y ~ x + x.sq + x4)
summary(fit4)
vif(fit4)           # HUGE

X4 <- model.matrix(fit4)

beta_hat4_naive <- solve(t(X4) %*% X4) %*% t(X4) %*% y
t(beta_hat4_naive)
fit4$coef                   # Here the naive method gives a slightly different result. Numerical instability (rounding error).

sigma4 <- summary(fit4)$sigma
V4_naive <- sigma4^2 * solve(t(X4) %*% X4)
V4_naive
vcov(fit4)                  # Comparison shows that the naive method start's getting into trouble

# Even worse
x5 <- 2*x + 5*x.sq + rnorm(n,mean=0,sd=0.000005)

fit5 <- lm(y ~ x + x.sq + x5)
summary(fit5)                 # Even R's QR decomposition can't deal with it any more.


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

rm(list = ls())

a <- c(0.41, 0.45, 0.36, 0.49, 0.39, 0.54, 0.38, 0.43)
b <- c(0.38, 0.40, 0.32, 0.50, 0.31, 0.52, 0.32, 0.36)

(s <- (a - b)[a != b])
# 0.03 0.05 0.04 -0.01 0.08 0.02 0.06 0.07

(n <- length(s))
# 8

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

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

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

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

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

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

wilcox.test(a, b, paired = TRUE, alternative = "two.sided")
# Wilcoxon signed rank test
#
# data:  a and b
# V = 35, p-value = 0.01563
# alternative hypothesis: true location shift is not equal to 0


### PART 1:
makeHailstone <- function(n){
  hseq <- n
  while (hseq[length(hseq)] > 1){
    current.value <- hseq[length(hseq)]
    if (current.value %% 2 == 0){
      next.value <- current.value / 2
    } else {
      next.value <- (3 * current.value) + 1
    }
    hseq <- append(hseq, next.value)
  }
  return(list(hseq=hseq, seq.length=length(hseq)))
}

### PART 2:
twenty.seven <- makeHailstone(27)
twenty.seven$hseq
twenty.seven$seq.length

### PART 3:
max.length <- 0;  lower.bound <- 1;  upper.bound <- 100000

for (index in lower.bound:upper.bound){
  current.hseq <- makeHailstone(index)
  if (current.hseq$seq.length > max.length){
    max.length <- current.hseq$seq.length
    max.index  <- index
  }
}

cat("Between ", lower.bound, " and ", upper.bound, ", the input of ",
    max.index, " gives the longest hailstone sequence, which has length ",
    max.length, ". \n", sep="")


##========================================================
##
##  Credits:
##  Theory by Paul Bourke http://local.wasp.uwa.edu.au/~pbourke/geometry/pointline/
##  Based in part on C code by Damian Coventry Tuesday, 16 July 2002
##  Based on VBA code by Brandon Crosby 9-6-05 (2 dimensions)
##  With grateful thanks for answering our needs!
##  This is an R (http://www.r-project.org) implementation by Gregoire Thomas 7/11/08
##
##========================================================

distancePointLine <- function(x, y, slope, intercept) {
  ## x, y is the point to test.
  ## slope, intercept is the line to check distance.
  ##
  ## Returns distance from the line.
  ##
  ## Returns 9999 on 0 denominator conditions.
  x1 <- x-10
  x2 <- x+10
  y1 <- x1*slope+intercept
  y2 <- x2*slope+intercept
  distancePointSegment(x,y, x1,y1, x2,y2)
}

distancePointSegment <- function(px, py, x1, y1, x2, y2) {
  ## px,py is the point to test.
  ## x1,y1,x2,y2 is the line to check distance.
  ##
  ## Returns distance from the line, or if the intersecting point on the line nearest
  ## the point tested is outside the endpoints of the line, the distance to the
  ## nearest endpoint.
  ##
  ## Returns 9999 on 0 denominator conditions.
  lineMagnitude <- function(x1, y1, x2, y2) sqrt((x2-x1)^2+(y2-y1)^2)
  ans <- NULL
  ix <- iy <- 0   # intersecting point
  lineMag <- lineMagnitude(x1, y1, x2, y2)
  if( lineMag < 0.00000001) {
    warning("short segment")
    return(9999)
  }
  u <- (((px - x1) * (x2 - x1)) + ((py - y1) * (y2 - y1)))
  u <- u / (lineMag * lineMag)
  if((u < 0.00001) || (u > 1)) {
    ## closest point does not fall within the line segment, take the shorter distance
    ## to an endpoint
    ix <- lineMagnitude(px, py, x1, y1)
    iy <- lineMagnitude(px, py, x2, y2)
    if(ix > iy)  ans <- iy
    else ans <- ix
  } else {
    ## Intersecting point is on the line, use the formula
    ix <- x1 + u * (x2 - x1)
    iy <- y1 + u * (y2 - y1)
    ans <- lineMagnitude(px, py, ix, iy)
  }
  ans
}

distancePointLineTest <- function() {
  if(abs(distancePointSegment(  5,   5,  10, 10, 20, 20) - 7.07106781186548)>.0001)
    stop("error 1")
  if(abs(distancePointSegment( 15,  15,  10, 10, 20, 20) - 0)>.0001)
    stop("error 2")
  if(abs(distancePointSegment( 15,  15,  20, 10, 20, 20) - 5)>.0001)
    stop("error 3")
  if(abs(distancePointSegment(  0,  15,  20, 10, 20, 20) - 20)>.0001)
    stop("error 4")
  if(abs(distancePointSegment(  0,  25,  20, 10, 20, 20) - 20.6155281280883)>.0001)
    stop("error 5")
  if(abs(distancePointSegment(-13, -25, -50, 10, 20, 20) - 39.8808224589213)>.0001)
    stop("error 6")
  if(abs(distancePointSegment(  0,   3,   0, -4,  5,  0) - 5.466082)>.0001)
    stop("error 7")
  if(abs(distancePointSegment(  0,   9,   0, -4,  0, 15) - 0)>.0001)
    stop("error 8")
  if(abs(distancePointSegment(  0,   0,   0, -2,  2,  0)^2 - 2)>.0001)
    stop("error 9")
  return(TRUE)
}


#!/usr/bin/Rscript

# Bhishan Poudel
# Jan 12, 2016

# Chapter. 2 Probability
################################################################################
# set the working directory
setwd ("~/Copy/2016Spring/RProgramming/presentation/")

# Start device driver to save output
postscript(file="figures/chap2.eps", height=14, width=8)

# Set up 6 panel figure
par(mfrow=c(3,2))  # par is parameter

# Expand right side of clipping rect to make room for the legend
#par(xpd=T, mar=par()$mar+c(0,0,0,4))

# Plot upper left panel with three illustrative
# exponential p.d.f. distributions (dexp)
xdens <- seq(0,5,0.02)
plot(xdens,dexp(xdens,rate=0.5), type='l', ylim=c(0,1.5), xlab='', ylab='Exponential p.d.f.',lty=1)

lines(xdens,dexp(xdens,rate=1), type='l', lty=2)
lines(xdens,dexp(xdens,rate=1.5), type='l', lty=3)
legend(2, 1.45, lty=1, substitute(lambda==0.5), box.lty=0)
legend(2, 1.30, lty=2, substitute(lambda==1.0), box.lty=0)
legend(2, 1.15, lty=3, substitute(lambda==1.5), box.lty=0)

# Help files to learn these function
# help(seq) ; help(plot); help(par) ; help(lines); help(legend)

# Plot upper right panel with three illustrative exponential c.d.f. distributions
plot(xdens, pexp(xdens,rate=0.5), type='l', ylim=c(0,1.0), xlab='', ylab='Exponential c.d.f.', lty=1)
lines(xdens, pexp(xdens,rate=1), type='l', lty=2)
lines(xdens, pexp(xdens,rate=1.5),type='l',lty=3)
legend(3, 0.50, lty=1, substitute(lambda==0.5), box.lty=0)
legend(3, 0.38, lty=2, substitute(lambda==1.0), box.lty=0)
legend(3, 0.26, lty=3, substitute(lambda==1.5), box.lty=0)

# Plot middle panels with illustrative normal p.d.f. and c.d.f.
xdens <- seq(-5, 5, 0.02)
ylabdnorm <- expression(phi[mu~sigma^2] (x))
plot(xdens, dnorm(xdens, sd=sqrt(0.2)), type='l', ylim=c(0,1.0), xlab='', ylab=ylabdnorm,lty=1)
lines(xdens,dnorm(xdens, sd=sqrt(1.0)), type='l', lty=2)
lines(xdens,dnorm(xdens, sd=sqrt(5.0)), type='l', lty=3)
lines(xdens,dnorm(xdens, mean=-2.0, sd=sqrt(0.5)), type='l', lty=4)
leg1 <- expression(mu^' '==0, mu^' '==0, mu^' '==0, mu^' '==-2)
leg2 <- expression(sigma^2==0.2, sigma^2==1.0, sigma^2==5.0, sigma^2==0.5,)
legend(0.5, 1.0, lty=1:4, leg1, lwd=2, box.lty=0)
legend(3.0, 1.01, leg2, box.lty=0)
ylabpnorm <- expression(Phi[mu~sigma^2] (x))
plot(xdens,pnorm(xdens,sd=sqrt(0.2)), type='l', ylim=c(0,1.0), xlab='',ylab=ylabpnorm,lty=1)
lines(xdens,pnorm(xdens, sd=sqrt(1.0)), type='l', lty=2)
lines(xdens,pnorm(xdens, sd=sqrt(5.0)), type='l', lty=3)
lines(xdens,pnorm(xdens, mean=-2.0, sd=sqrt(0.5)), type='l', lty=4)
leg1 <- expression(mu^' '==0, mu^' '==0, mu^' '==0, mu^' '==-2)
leg2 <- expression(sigma^2==0.2, sigma^2==1.0, sigma^2==5.0, sigma^2==0.5,)
legend(0.5, 0.6, lty=1:4, leg1, lwd=2, box.lty=0)
legend(3.0, 0.61, leg2, box.lty=0)

# Plot bottom panels with illustrative lognormal p.d.f. and c.d.f.
xdens <- seq(0,3, 0.02)
plot(xdens, dlnorm(xdens, meanlog=0, sdlog=5), type='l', ylim=c(0,2), xlab='', ylab='Lognormal density', lty=1)
lines(xdens, dlnorm(xdens, meanlog=0, sdlog=1), type='l', lty=2)
lines(xdens, dlnorm(xdens, meanlog=0, sdlog=1/2), type='l', lty=3)
lines(xdens, dlnorm(xdens, meanlog=0, sdlog=1/8), type='l', lty=4)
leg1 <- expression(sigma==5, sigma==1, sigma==1/2, sigma==1/8)
legend(1.8,1.8,lty=1:4,leg1,box.lty=0)
plot(xdens,plnorm(xdens,meanlog=0,sdlog=5),type='l',ylim=c(0,1),xlab='x', ylab='Lognormal distribution',lty=1)
lines(xdens,plnorm(xdens,meanlog=0,sdlog=1),type='l',lty=2)
lines(xdens,plnorm(xdens,meanlog=0,sdlog=1/2),type='l',lty=3)
lines(xdens,plnorm(xdens,meanlog=0,sdlog=1/8),type='l',lty=4)
leg1 <- expression(sigma==5,sigma==1,sigma==1/2,sigma==1/8)
legend(1.5,0.6,lty=1:4,leg1,box.lty=0)

# Turn off device driver (to flush output to png)
dev.off()

# Return plot to single-panel format
par(mfrow=c(1,1))

# Restore default clipping rect
par(mar=c(5, 4, 4, 2) + 0.1)

#‘mfcol, mfrow’ A vector of the form ‘c(nr, nc)’.  Subsequent
#          figures will be drawn in an ‘nr’-by-‘nc’ array on the device
#          by _columns_ (‘mfcol’), or _rows_ (‘mfrow’), respectively.

#          In a layout with exactly two rows and columns the base value
#          of ‘"cex"’ is reduced by a factor of 0.83: if there are three
#          or more of either rows or columns, the reduction factor is
#          0.66.

#          Setting a layout resets the base value of ‘cex’ and that of
#          ‘mex’ to ‘1’.

#          If either of these is queried it will give the current
#          layout, so querying cannot tell you the order in which the
#          array will be filled.


##### Chapter 6: Regression Methods -------------------

#### Part 1: Linear Regression -------------------

## Understanding regression ----
## Example: Space Shuttle Launch Data ----
launch <- read.csv("challenger.csv")

# estimate beta manually
b <- cov(launch$temperature, launch$distress_ct) / var(launch$temperature)
b

# estimate alpha manually
a <- mean(launch$distress_ct) - b * mean(launch$temperature)
a

# calculate the correlation of launch data
r <- cov(launch$temperature, launch$distress_ct) /
       (sd(launch$temperature) * sd(launch$distress_ct))
r
cor(launch$temperature, launch$distress_ct)

# computing the slope using correlation
r * (sd(launch$distress_ct) / sd(launch$temperature))

# confirming the regression line using the lm function (not in text)
model <- lm(distress_ct ~ temperature, data = launch)
model
summary(model)

# creating a simple multiple regression function
reg <- function(y, x) {
  x <- as.matrix(x)
  x <- cbind(Intercept = 1, x)
  b <- solve(t(x) %*% x) %*% t(x) %*% y
  colnames(b) <- "estimate"
  print(b)
}

# examine the launch data
str(launch)

# test regression model with simple linear regression
reg(y = launch$distress_ct, x = launch[2])

# use regression model with multiple regression
reg(y = launch$distress_ct, x = launch[2:4])

# confirming the multiple regression result using the lm function (not in text)
model <- lm(distress_ct ~ temperature + field_check_pressure + flight_num, data = launch)
model

## Example: Predicting Medical Expenses ----
## Step 2: Exploring and preparing the data ----
insurance <- read.csv("insurance.csv", stringsAsFactors = TRUE)
str(insurance)

# summarize the charges variable
summary(insurance$expenses)

# histogram of insurance charges
hist(insurance$expenses)

# table of region
table(insurance$region)

# exploring relationships among features: correlation matrix
cor(insurance[c("age", "bmi", "children", "expenses")])

# visualing relationships among features: scatterplot matrix
pairs(insurance[c("age", "bmi", "children", "expenses")])

# more informative scatterplot matrix
library(psych)
pairs.panels(insurance[c("age", "bmi", "children", "expenses")])

## Step 3: Training a model on the data ----
ins_model <- lm(expenses ~ age + children + bmi + sex + smoker + region,
                data = insurance)
ins_model <- lm(expenses ~ ., data = insurance) # this is equivalent to above

# see the estimated beta coefficients
ins_model

## Step 4: Evaluating model performance ----
# see more detail about the estimated beta coefficients
summary(ins_model)

## Step 5: Improving model performance ----

# add a higher-order "age" term
insurance$age2 <- insurance$age^2

# add an indicator for BMI >= 30
insurance$bmi30 <- ifelse(insurance$bmi >= 30, 1, 0)

# create final model
ins_model2 <- lm(expenses ~ age + age2 + children + bmi + sex +
                   bmi30*smoker + region, data = insurance)

summary(ins_model2)

# making predictions with the regression model
insurance$pred <- predict(ins_model2, insurance)
cor(insurance$pred, insurance$expenses)

plot(insurance$pred, insurance$expenses)
abline(a = 0, b = 1, col = "red", lwd = 3, lty = 2)

predict(ins_model2,
        data.frame(age = 30, age2 = 30^2, children = 2,
                   bmi = 30, sex = "male", bmi30 = 1,
                   smoker = "no", region = "northeast"))

predict(ins_model2,
        data.frame(age = 30, age2 = 30^2, children = 2,
                   bmi = 30, sex = "female", bmi30 = 1,
                   smoker = "no", region = "northeast"))

predict(ins_model2,
        data.frame(age = 30, age2 = 30^2, children = 0,
                   bmi = 30, sex = "female", bmi30 = 1,
                   smoker = "no", region = "northeast"))

#### Part 2: Regression Trees and Model Trees -------------------

## Understanding regression trees and model trees ----
## Example: Calculating SDR ----
# set up the data
tee <- c(1, 1, 1, 2, 2, 3, 4, 5, 5, 6, 6, 7, 7, 7, 7)
at1 <- c(1, 1, 1, 2, 2, 3, 4, 5, 5)
at2 <- c(6, 6, 7, 7, 7, 7)
bt1 <- c(1, 1, 1, 2, 2, 3, 4)
bt2 <- c(5, 5, 6, 6, 7, 7, 7, 7)

# compute the SDR
sdr_a <- sd(tee) - (length(at1) / length(tee) * sd(at1) + length(at2) / length(tee) * sd(at2))
sdr_b <- sd(tee) - (length(bt1) / length(tee) * sd(bt1) + length(bt2) / length(tee) * sd(bt2))

# compare the SDR for each split
sdr_a
sdr_b

## Example: Estimating Wine Quality ----
## Step 2: Exploring and preparing the data ----
wine <- read.csv("whitewines.csv")

# examine the wine data
str(wine)

# the distribution of quality ratings
hist(wine$quality)

# summary statistics of the wine data
summary(wine)

wine_train <- wine[1:3750, ]
wine_test <- wine[3751:4898, ]

## Step 3: Training a model on the data ----
# regression tree using rpart
library(rpart)
m.rpart <- rpart(quality ~ ., data = wine_train)

# get basic information about the tree
m.rpart

# get more detailed information about the tree
summary(m.rpart)

# use the rpart.plot package to create a visualization
library(rpart.plot)

# a basic decision tree diagram
rpart.plot(m.rpart, digits = 3)

# a few adjustments to the diagram
rpart.plot(m.rpart, digits = 4, fallen.leaves = TRUE, type = 3, extra = 101)

## Step 4: Evaluate model performance ----

# generate predictions for the testing dataset
p.rpart <- predict(m.rpart, wine_test)

# compare the distribution of predicted values vs. actual values
summary(p.rpart)
summary(wine_test$quality)

# compare the correlation
cor(p.rpart, wine_test$quality)

# function to calculate the mean absolute error
MAE <- function(actual, predicted) {
  mean(abs(actual - predicted))
}

# mean absolute error between predicted and actual values
MAE(p.rpart, wine_test$quality)

# mean absolute error between actual values and mean value
mean(wine_train$quality) # result = 5.87
MAE(5.87, wine_test$quality)

## Step 5: Improving model performance ----
# train a Cubist Model Tree
library(Cubist)
m.cubist <- cubist(x = wine_train[-12], y = wine_train$quality)

# display basic information about the model tree
m.cubist

# display the tree itself
summary(m.cubist)

# generate predictions for the model
p.cubist <- predict(m.cubist, wine_test)

# summary statistics about the predictions
summary(p.cubist)

# correlation between the predicted and true values
cor(p.cubist, wine_test$quality)

# mean absolute error of predicted and true values
# (uses a custom function defined above)
MAE(wine_test$quality, p.cubist)


ybar = 178.2           # sample mean
mu0 = 190           # hypothesized value
sigma = 45.3       # population standard deviation
n = 100               # sample size
z = (ybar- mu0)/(sigma/sqrt(n))
print(z)
k=abs(z)
# test statistic
 # formula based on level of significance
p_value=2*(1-pnorm(k))
print(p_value)
# mentioned p value in book is wrong
alpha=0.01
if(p_value>alpha){
  print("we fail to reject H0")
  print(" data do not support the research hypothesis(insufficient evidence).")
}else{
  print("  there is very little evidence in the data to support the research hypothesis  hence we will reject H0")
}


truemu <- -.5
truesd <- 200

n <- 10
M <- 10000
gama <- .90
cc <- qt(p = (1  + gama)/2, df = n-1)

computa_D <- function(x) {
  n <- length(x)
  Delta.sq <- sum((x - mean(x))^2)
  sigma.prime <- sqrt(Delta.sq/(n-1))
  d <- cc * sigma.prime/sqrt(n)
  return(d)
}

ta_no_intervalo <- function(intervalo){
  (intervalo[1] <= truemu) * (truemu <= intervalo[2])
}
#######

data.sets <- matrix(rnorm(n = n*M, mean = truemu, sd = truesd),
                    ncol = n, nrow = M)

Xbars <- apply(data.sets, 1, mean)
Ds <- apply(data.sets, 1, computa_D)
As <- Xbars - Ds
Bs <- Xbars + Ds

Intervalos <- data.frame(lwr = As, upr = Bs)
Intervalos$contem <- apply(Intervalos, 1, ta_no_intervalo)

mean(Intervalos$contem) ## cobertura dos intervalos

########### Figura
praplotar <- data.frame(lwr = As, media = Xbars, upr = Bs,
                        inclui = as.factor(Intervalos$contem), replicata = 1:M)
library(ggplot2)

p0 <- ggplot(data = praplotar, aes(x = replicata, y = media, colour = inclui)) +
  geom_point() +
  geom_errorbar(aes(ymin = lwr, ymax = upr)) +
  geom_hline(yintercept = truemu, linetype = "longdash", size = 1.5) +
  scale_y_continuous(expression(bar(X[n]) %+-%  D), expand = c(0, 0)) +
  theme_bw(base_size = 16)

p0


# Intervalos de confianza, error estándar y variance-covariance matrix.
#################################################################
cat("\014")
rm(list=ls())
graphics.off()

# Cargar paquete para cargar bases que no son de R.
# install.packages("foreign")
library(foreign) # significa "foraneo"
options(scipen = 1000000) # apagar notacion cientifica.
dat = read.dta("https://github.com/hbahamonde/OLS/raw/master/Datasets/cow.dta")

# Estimar modelo lineal: relacion entre crecimiento economico y democracia, controlando por poblacion
modelo.1 = lm(rgdpch ~ democracy + pop, dat)
summary(modelo.1)

# (1) Que significa "controlando por"?

# Obtener intervalos de confianza
## Estos valores representan la incertidumbre de nuestra estimacion al promedio de cada variable,
## manteniendo las otras variables independientes "constantes en sus medias".
confint(modelo.1, level = 0.95) # 95% de confianza
confint(modelo.1, level = 0.99) # 99% de confianza

# DIBUJAR EN EL PIZARRON LA REPRESENTACION DE QUE _SIGNIFICA_
# "EL 95%", Y DE POR QUE VEMOS LOS NUMEROS "2.5%" Y "97.5%"
# EN NUESTRA TABLA DE "CONFINT".

# Fijate que el intervalo de confianza de "democracia" va de ~1179 a ~2097
## "~" significa "aproximadamente". Esos valores representan, nuevamente,
## valores de nuestra "y" (es decir, "crecimiento economico", segun lo
## estimamos en nuestro "modelo.1".)

# Tambien podemos ver los coeficientes y su incertidumbre
# en forma grafica tambien.

# plotear CI
# install.packages("coefplot", "ggplot2")
library(coefplot, ggplot2)
coefplot(modelo.1)

# (1) Compara los numeros de la tabla "confint" y lo que ves en el grafico.
# (2) Que es lo que vemos en este grafico?
# (3) Que podemos decir de los distintos coeficientes?
# (4) Que podemos decir respecto al ancho de los intervalos de confianza?
# (5) Que es mejor? Intervalos de confianza "angostos" o "anchos"?

# Sin embargo, hay algunas veces que queremos observar como esta incertidumbre
# varia a medida que recorremos la distribucion entera (no solo el promedio).
## Atencion: "coefplot" y la tabla de coeficientes ("summary(modelo.1)")
## solo muestra la incertidumbre respecto al PROMEDIO ("el centro") de la distribucion.
## Lo que quiero decir, es que hay veces en que queremos ver como es que
## la incertidumbre (es decir, los intervalos de confianza) VARIAN
## segun nos movemos a lo LARGO de la distribucion, es decir, cuando
## vemos mas que el solo PROMEDIO.

### ESTE PUNTO ES IMPORTANTE, y ASEGURATE DE ENTENDERLO BIEN.

# Veamos como se ve esta incertidumbre a lo LARGO de la distribucion.

# install.packages("effects")
library(effects)
plot(allEffects(modelo.1))

# (1) Que vemos en este grafico?
# * DIBUJAR EN LA PIZARRA: CUANDO AVANZO UNA UNIDAD EN X, AVANZO 1179.9 EN DEMOCRACIA.
# (2) Que notan respecto al grado de incertidumbre?

# OK. Ya sabemos lo que los intervalos de confianza significan, y para que estan.
# Ahora calculemos intervalos de confianza a mano, y veamos de donde vienen
# estos numeros.

########################################################
# Como estimar manualmente los intervalos de confianza
########################################################

# Todo empieza estimando la Varianza del Error (sigma^2).

# Primero, obtengamos el error
e = as.vector(modelo.1$residuals)
e # es simplemente un vector con todos los errores (diferencia entre observado
# y predicho)

# Segundo, veamos cuantos parametros estimamos. Sera importante para la formula.
k = 3 # numero de variables a estimar (incluyendo intercepto).
# Tenemos "democracy", "pop", "Intercept". Entonces, tenemos 3 parametros.

# sigma.2 (varianza del error)
# Varianza es una medida de la variabilidad o dispersion de un vector. En este caso, del vector "e", que es nuestro error. Matematicamente, es la suma de los elementos diagonales que resultan de la multiplicacion entre el vector del error y el vector del error traspuesto, dividido por la cantidad de observaciones menos el numero de parametros que estaremos estimando (3 en este ejemplo).
sigma.2 = (1/(nrow(dat)-k))*sum(diag(e %*% t(e)))

# Tercero, obtengamos la matriz "x". La matriz "x" representa lo que observamos.
## Recuerda que para calcular el intercepto, debemos poner una columna de 1's del mismo largo que la dimension de el resto de las variables.
unos = rep(1, nrow(dat)) # repetir "1" 112 veces, que es el largo de la base de datos
# que lo acabo de calcular con "nrow(dat)".

## OK, ahora creemos la matrix "x".
x = matrix(c(unos, dat$democracy, dat$pop), ncol=3)
x # Ve como quedo.

# Cuarto, estimemos los errores estandard.
# Es importante sacar los errores estandard porque necesitamos eso para calcular los intervalos de confianza.

# Los errores estandard de hecho, salen en nuestra tabla de regresion.

summary(modelo.1) # "Std. Error"

# Para calcular los errores estandard, usaremos una vieja tecnica de matrices.

# Esta matriz es famosa, y se llama Matriz de Varianza-Covarianza.
# Las varianzas aparecen en la diagonal, y las covarianzas fuera de la diagonal.

library(matlib) # paquete para hacer operaciones con matrices.

# Calculemos la Matriz de Varianza-Covarianza
# Multiplicar sigma^2 por (x'x)^-1
options(scipen=999)
sigma.2 * inv(t(x) %*% x)

# Pero habia un camino mas corto...
vcov(modelo.1)

# Recapitulemos, esta matriz de Varianzas y Covarianzas tiene elementos importantes para calcular el error estandard, que sera necesario para calcular el intervalo de confianza.

# Lo interesante es que la raiz cuadrada de la diagonal, son los errores estandard.
sqrt(diag(sigma.2 * inv(t(x) %*% x)))

# Comprobemos. Los errores std. del "summary" debieran ser los mismos
# que los que estimamos nosotros manualmente.
summary(modelo.1)

# OK. Una manera de anotar esto, es extraer elemento por elemento de lo que acabamos de calcular.
sqrt(diag(sigma.2 * inv(t(x) %*% x)))[1] # error std. del intercepto
sqrt(diag(sigma.2 * inv(t(x) %*% x)))[2] # error std. de democracy
sqrt(diag(sigma.2 * inv(t(x) %*% x)))[3] # error std. de pop.

## Hablemos del error estandar
### La manera en la que debemos entender el error estandard (SE) asociado al
### coeficiente (lo que vemos en "summary(modelo.1)") es como un ESTIMATIVO de
### la desviacion estandard de la POBLACION.

### ATENCION: Poblacion es distinto a MUESTRA. Pensemos mas en esto...

### Pensemos en esto por un segundo. La razon por la que ESTIMAMOS, MODELAMOS, y
### tenemos INCERTIDUMBRE, es precisamente porque NO PODEMOS acceder a la poblacion.
### Es decir, dado que es imposible tener TODOS LOS DATOS, nosotros trabajamos
### con MUESTRAS. Un ejemplo de esto, es una encuesta para conocer preferencias
### politicas. Dado que no podemos entrevistar a todo el pais (POBLACION), entrevistamos
### a una MUESTRA, generalmente, aleatoria.

### Entonces, el error estandard del coeficiente hace referencia a algo que no conocemos

### En ese sentido, es precisamente la informacion que necesitamos para calcular los Intervalos de Confianza (nuestro tema de hoy).

### Antes de seguir, definamos los "grados de libertad"
### Se define como el numero de observaciones - 2.
grados.de.libertad = nrow(dat)-2

grados.de.libertad # ...veamos.

### La manera en que calculamos el intervalo de confianza,
### es la siguiente:

### Formula del intervalo de confianza
### coeficiente +/- t * SE del coeficiente.

# Es un calculo "doble":
### coeficiente + t * SE del coeficiente.
### coeficiente - t * SE del coeficiente.

### Hasta el momento, sabemos como derivar el coeficiente ( o "beta").
### Solo recuerda nuestros ej's en matrices:
### beta = (x'x)^-1x'y

### En la clase de hoy, aprendimos tambien a sacar el error estandard
### y entendimos lo que significa.
### Recuerda, el SE se saca asi:
### sqrt(diag(sigma.2 * inv(t(x) %*% x)))
### Es decir, la raiz cuadrada del los elementos diagonales de la
### multiplicacion entre sigma^2 y x'x (que es el "variance-covariance matrix").

### Para completar nuestra formula de los intervalos de confianza,
### necesitamos un ultimo elemento, "t".
### T es un valor critico que sacamos de una distribicion
### llamada "t".

#### Ocupemos una funcion para conseguir estos valores criticos.
t = qt(1-.05/2, grados.de.libertad) # valores criticos de t, a un 95% de confianza.

# "1-.05" porque queremos el 95% de la distribucion.
# Piensa en "la distribucion" como al area bajo la curva
# que representa "confianza". Es por eso que decimos
# que "estamos 95% seguros/confiados que nuestra estimacion
# es cierta"
# Y es dividido por dos ("/2") porque queremos repartir esa
# confianza a ambos lados de la distribucion.

#
10631.611789 - t * sqrt(diag(sigma.2 * inv(t(x) %*% x)))[1]  # (Intercept)  #  9136.09240230
10631.611789 + t * sqrt(diag(sigma.2 * inv(t(x) %*% x)))[1]  # (Intercept)  #  12127.13117506

#
1638.874546  - t * sqrt(diag(sigma.2 * inv(t(x) %*% x)))[2]  # democracy  # 1179.996
1638.874546  + t * sqrt(diag(sigma.2 * inv(t(x) %*% x)))[2]  # democracy  # 2097.753

#
0.002947     - t * sqrt(diag(sigma.2 * inv(t(x) %*% x)))[3]  # pop
0.002947     + t * sqrt(diag(sigma.2 * inv(t(x) %*% x)))[3]  # pop

# Pero nuevamente, siempre hay un camino mas corto.
confint(modelo.1, level = 0.95) # 95% de confianza

# Discutir
## (1) Por que 95 vs. 99?
## (2) Logica frecuentista: limites del "supuesto asintotico". Es posible?