######R as a Calculator######
2+2
2-3+1
2/3*2
2*3/2
2^3
2^3*2
2^(3*2)

###Mathematical functions in R
log(10)
log(10,2) ##log(number,base)
sqrt(25)
sin(1)
cos(x = 45)

# Some of the Built in constants

pi

LETTERS

letters

month.name

month.abb[12]

months(.leap.seconds)

############################Data Types in R######################################
# a.  Numeric --real numbers
# b.  Integer-- positive and negative whole  numbers including zero
# c.	logical-- True or False
# d.	character-- alphabets/special characters
# e.	complex--  z<-1+2i;  Arg(0+1i); Mod(2-3i)

nos <- 10:1
#setting a directory
setwd("/home/tiger028/Besant/")

#Getting the directory path
getwd()

#Generating a sequence of numbers using scope operator and assigning to a variable
numbers<-10:15
numbers

#Generating a sequence of numbers using a "seq" function
numbers <- seq(1,10)
numbers
numbers<-seq(1,10,2)
numbers

#Using  the "c" (concatenate) , we use this most of the time
numbers<-c(1,2,10)
numbers

#########################Variables in R########################################
# a.  Scalar -- a single number/character
x=5
x="a"

#b.	Vector-- a sequence of elements
x<-c(1,2,3,4,5)
x<-c("a","c")
y<-c("alpha",7)
z <- c(T,F,TRUE,FALSE)

#To know the data type or class

class(z)

x <- c(1,3,5,7,9)

y <- c(2,4,6,8,10)

# Element wise addition

x+y

# Elementwise subtraction

x-y

# Elementwise multiplication

x * y

# Elementwise division

x / y

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

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

y <- c(10,20)

x + y # here vector y gets replicated so that vector addition be completed

### Binding the vectors- Row binding and column binding

A <- rbind(x, y)
A

B <- cbind(x, y)
B


### 6.2-2

experData <- c(28, 32, 15, 14, 38, 43, 19)
nSamples <- length(experData)
experMean <- mean(experData)

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

### df = r - k - 1 = 7 - 1 = 6
chiSquareCritical <- qchisq(0.95, nSamples-1, ncp=0, lower.tail=TRUE, log.p=FALSE)
print(chiSquareCritical)

### chiSquare = 28.88889  ->  H0 is rejected (the dataset is not uniformly distributed)


# 2.2 a)
'''
Install the R-package astsa, load the package and the dataset varve. You may use
the following code:
	install.packages("astsa")
	library(astsa)
	data(varve)
Plot the glacial varve data.
The time series exhibits some nonstationarity that can be improved by transforming to
logarithms and some additional nonstationarity that can be corrected by
differencing the logarithms.
'''

install.packages("astsa")
library(astsa)
data(varve)

plot(varve)

#b)
'''
Argue that the glacial varves series, say Xt,
exhibits heteroscedasticity by computing the sample variance over the first half and the second half of the data.
Argue that the transformation Yt = log Xt stabilizes the variance over the series.
Plot the histograms of Xt and Yt to see whether the approximation to normality
is improved by transforming the data.
'''

hist(varve, breaks = 10)
#Not so different
for (i in c(0:9)){
	sample = sample.int(n=length(varve), size=0.5*length(varve))
	print(var(varve[sample]))
	print(var(varve[-sample]))
	print("********")
}

#different variance
subset = seq(from = 1,to = length(varve)/2, by = 1)
var(varve[subset])
var(varve[-subset])

#log-transformation
y = log(varve)
par(mfrow=c(1,2))
hist(y, breaks = 20, prob=TRUE)
lines(dt <- seq(0,150,0.1), dnorm(dt, mean(y), sd(y)), col=2, lty=2)
hist(varve, breaks=10, prob=TRUE)
lines(dt <- seq(0,150,0.1), dnorm(dt, mean(varve),sd(varve)), col=2, lty=2)

'''
heteroscedasticity is the variability of a variable is unequal across the range of values of a second variable that predicts it
After log transform - the variable is symmetic about its mean - so more normal.
'''

#c) Plot the series Yt
plot(log(varve),lty=1)

#d) Examine the sample ACF of Yt and comment.
acf(log(varve), lag.max= 40))
acf(log(varve), lag.max= 150))
acf(varve, lag.max= 150))

#looking at plot in c) Y_t oscilates, acf(y) oscilates and acf is declining
#So there is trend and seasonality

#e)
'''
Compute the difference Ut = Yt - Yt−1 , examine its time plot and sample ACF,
and argue that differencing the logged varve data produces a reasonably stationary
series. Can you think of a practical interpretation for Ut ?
'''

#U_t is the differenced (differenciated) time-series of Y_t - so without trend
U_t_x= diff(varve, lag = 1)
plot(U_t_x)
U_t= diff(y, lag = 1)
plot(U_t)

acf(U_t, lag.max=150)

#U_t is the definition of derivative when h=1. Since time discrete this is smallest h.

#f)
'''
Based on the sample ACF of the differenced transformed series computed in (d),
argue that the model in (1) below might be reasonable.

Assume U_t = mu + Z_t + theta*Z_t-1

is stationary when the inputs Zt are assumed independent with mean 0 and variance sigma_z**2
Then, show ACVF: (1+theta**2) , h=0, theta*sima_z**2, h=1, 0 else
'''

#see paper solution - its a MA(1) processs

# g)
'''
Based on part (f), use ρbU (1) and the estimate of the variance of Ut
, γ_U (1) ), to
derive estimates of θ and σ
2
Z
. This is an application of the method of moments
from classical statistics, where estimators of the parameters are derived by equating
sample moments to theoretical moments. You can calculate the empirical autocorrelation and autocovariance functions
using the acf function, by using the following syntax
	acf(u, type = "correlation")
	acf(u, type = "covariance")
'''

acf(U_t, type = "correlation")
acf(U_t, type = "covariance")

(a<-acf(U_t, plot=FALSE)$acf[2])
(b<-acf(U_t, type="covariance", plot=FALSE)$acf[1])
(theta <- (1 + c(-1,1) * sqrt(1 - 4 * a^2))/(2 * a))
(sigma2<- b / (1 + theta^2))
arima(U_t, order=c(0,0,1), include.mean=FALSE)

########
p <- as.vector(acf(Ut, type = "correlation", lag.max = 1, plot=FALSE)$acf[2]) #rho
g <- as.vector(acf(Ut, type = "covariance", lag.max = 0, plot=FALSE)$acf) #g=gamma

theta <- c((1+sqrt(1-4*p^2))/(2*p),(1-sqrt(1-4*p^2))/(2*p))
sigmasq <- g/(1+theta^2)

theta
sigmasq
#Need |theta| < 1 to be invertible, thus the solution is
#theta hat = -0.494 and sigmasq hat = 0.266


# Goal: Simulation to study size and power in a simple problem.

set.seed(101)

# The data generating process: a simple uniform distribution with stated mean
dgp <- function(N,mu) {runif(N)-0.5+mu}

# Simulate one FIXED hypothesis test for H0:mu=0, given a true mu for a sample size N
one.test <- function(N, truemu) {
  x <- dgp(N,truemu)
  muhat <- mean(x)
  s <- sd(x)/sqrt(N)
  # Under the null, the distribution of the mean has standard error s
  threshold <- 1.96*s
  (muhat < -threshold) || (muhat > threshold)
} # Return of TRUE means reject the null

# Do one experiment, where the fixed H0:mu=0 is run Nexperiments times with a sample size N.
# We return only one number: the fraction of the time that H0 is rejected.
experiment <- function(Nexperiments, N, truemu) {
  sum(replicate(Nexperiments, one.test(N, truemu)))/Nexperiments
}

# Measure the size of a test, i.e. rejections when H0 is true
experiment(10000, 50, 0)
# Measurement with sample size of 50, and true mu of 0.

# Power study: I.e. Pr(rejection) when H0 is false
# (one special case in here is when the H0 is actually true)

muvalues <- seq(-.15,.15,.01)
  # When true mu < -0.15 and when true mu > 0.15,
  # the Pr(rejection) veers to 1 (full power) and it's not interesting.

# First do this with sample size of 50
results <- NULL
for (truth in muvalues) {
  results <- c(results, experiment(10000, 50, truth))
}
par(mai=c(.8,.8,.2,.2))
plot(muvalues, results, type="l", lwd=2, ylim=c(0,1),
     xlab="True mu", ylab="Pr(Rejection of H0:mu=0)")
abline(h=0.05, lty=2)

# Now repeat this with sample size of 100 (should yield a higher power)
results <- NULL
for (truth in muvalues) {
  results <- c(results, experiment(10000, 100, truth))
}
lines(muvalues, results, lwd=2, col="blue")
legend(x=-0.15, y=.2, lwd=c(2,1,2), lty=c(1,2,1), cex=.8,
       col=c("black","black","blue"), bty="n",
       legend=c("N=50", "Size, 0.05", "N=100"))

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


# Introduction to Computational Finance and Financial Econometrics
# Assignment 2
# Paul-Gabriel Müller
# Topic: Probability

# question 1:
# Suppose X is a normally distributed random variable with mean 0.05 and variance (0.10)2. Compute the following.
# a) Pr(X>.10)
1- pnorm(0.1, mean=0.05, sd=0.1)

# question 2:
# Suppose X is a normally distributed random variable with mean 0.05 and variance (0.10)2. Compute the following.
# Pr(X<−.10)
pnorm(-0.1, mean=0.05, sd=0.1)

# question 3:
# Suppose X is a normally distributed random variable with mean 0.05 and variance (0.10)2. Compute the following.
# c) Pr(−0.05<X<0.15)
x = pnorm(-0.05, mean=0.05, sd=0.1)
y = pnorm(0.15, mean=0.05, sd=0.1)
y-x

#question 4:
#1% quantile, q.01
qnorm(0.01, mean=0.05, sd=0.1)

#question 5:
#  5% quantile, q.05
qnorm(0.05, mean=0.05, sd=0.1)

#question 6:
# 95% quantile, q.95
qnorm(0.95, mean=0.05, sd=0.1)

#question 7:
# 95% quantile, q.95
qnorm(0.99, mean=0.05, sd=0.1)

# question 8:
# Let X denote the monthly return on Microsoft Stock and let Y denote the monthly return on Starbucks stock.
#Assume that X∼N(0.05,(0.10)2) and Y∼N(0.025,(0.05)2).
# Using a grid of values between –0.25 and 0.35, plot the normal curves
# for X and Y. Make sure that both normal curves are on the same plot.
# Which stock has the higher risk?

intervals <- seq(-0.25, 0.35,length=100)
hx <- dnorm(intervals,0.05,0.1)
hy <- dnorm(intervals,0.025,0.05)
plot(intervals, hx, type="l", col="blue")
lines(intervals, hy, type="l", col="green")

# Question 9
# Let R denote the simple monthly return on Microsoft stock and let W0 denote the initial wealth to be invested
# over the month. Assume that R∼N(0.04,(0.09)^2)) and that W0=$100,000
# Determine the 1% and 5% value-at-risk (VaR) over the month on the investment.
# That is, determine the loss in investment value that may occur over the next month with 1% probability
# and with 5% probability.

w0 = 100000
qnorm(0.01, mean=0.04, sd=0.09) * w0
qnorm(0.05, mean=0.04, sd=0.09) * w0

# Question 10
# Let the r denote the continuously compounded monthly return on Microsoft stock and let W0
# denote the initial wealth to be invested over the month. Assume that r∼iid N(0.04,(0.09)2)
# and that W0=$100,000.
# Determine the 1% and 5% value-at-risk (VaR) over the month on the investment.
# That is, determine the loss in investment value that may occur over the next month
#  with 1% probability and with 5% probability.
#(Hint: compute the 1% and 5% quantile from the Normal distribution for r and then convert
# continuously compounded return quantile to a simple return quantile using the transformation R=er−1)

w0 = 100000;
# R = (e^r) -1 <=> r = ln(1+R)
r.01 = qnorm(0.01, mean=0.04, sd=0.09)
r.05 = qnorm(0.05, mean=0.04, sd=0.09)

R.01 = exp(r.01) -1
R.05 = exp(r.05) -1

R.01*w0
R.05*w0

#Question 11
# For the following questions:

# Consider a one month investment in two Northwest stocks: Amazon and Costco.
# Suppose you buy Amazon and Costco at the end of September at P(A,t−1)=$38.23, P(C,t−1)=$41.11 and then sell
# at the end of October for P(A,t)=$41.29, P(C,t)=$41.74. (Note: these are actual closing prices for 2004 taken
# from Yahoo!)
# What are the simple monthly returns for the two stocks?

R.A = (41.29 - 38.23) / 38.23
R.C = (41.74 - 41.11) / 41.11
# Question 12
# What are the continuously compounded returns for the two stocks?
r.A = log(1 + R.A)
r.C = log(1 + R.C)
r.A
r.C

# Question 13
# Suppose Amazon paid a $0.10 per share cash dividend at the end of October.
# What is the monthly simple total return on Amazon? What is the monthly dividend yield?

Rsimple = (41.29 + 0.1 - 38.23) / 38.23
divYield = 0.01 / 38.23
Rsimple * 100
divYield * 100

#question 14
# Suppose the monthly returns on Amazon from question 12 above are the same every month for 1 year.
# Compute the simple annual returns, as well as the continuously compounded annual returns.
# r is always smaller than R
R.month = (41.29 - 38.23) / 38.23
R.year = ((1+R.month)^12) -1
R.year*100

r.year = log(1+R.year)
r.year*100
# Question 15
Question 15
# At the end of September 2004, supposed you have $10,000 to invest in Amazon and Costco over the next month.
# If you invest $8,000 in Amazon and $2,000 in Costco, what are your portfolio shares, xA and xC.

# Question 16
# Continuing with the previous question, compute the monthly simple return on the portfolio.
# Assume than no dividends are paid.

R.total = 0.8 * R.A + 0.2*R.C
R.total*100


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

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

require("minpack.lm") # for Levenberg-Marquardt nlls fitting

powMod <- function(x, a, b) {
 return(a * x^b)
}

MyData <- read.csv("../data/GenomeSize.csv")

head(MyData)

Data2Fit <- subset(MyData,Suborder == "Anisoptera")

Data2Fit <- Data2Fit[!is.na(Data2Fit$TotalLength),] # remove NA's

plot(Data2Fit$TotalLength, Data2Fit$BodyWeight)

library("ggplot2")

ggplot(Data2Fit, aes(x = TotalLength, y = BodyWeight)) +
geom_point(size = (3),color="red") + theme_bw() +
labs(y="Body mass (mg)", x = "Wing length (mm)")

PowFit <- nlsLM(BodyWeight ~ powMod(TotalLength, a, b), data = Data2Fit, start = list(a = .1, b = .1))

summary(PowFit)

Lengths <- seq(min(Data2Fit$TotalLength),max(Data2Fit$TotalLength),len=200)

coef(PowFit)["a"]
coef(PowFit)["b"]

Predic2PlotPow <- powMod(Lengths,coef(PowFit)["a"],coef(PowFit)["b"])

Exercisesplot(Data2Fit$TotalLength, Data2Fit$BodyWeight)
lines(Lengths, Predic2PlotPow, col = 'blue', lwd = 2.5)

confint(PowFit)

QuaFit <- lm(BodyWeight ~ poly(TotalLength,2), data = Data2Fit)

Predic2PlotQua <- predict.lm(QuaFit, data.frame(TotalLength = Lengths))

plot(Data2Fit$TotalLength, Data2Fit$BodyWeight)
lines(Lengths, Predic2PlotPow, col = 'blue', lwd = 2.5)
lines(Lengths, Predic2PlotQua, col = 'red', lwd = 2.5)

RSS_Pow <- sum(residuals(PowFit)^2) # Residual sum of squares
TSS_Pow <- sum((Data2Fit$BodyWeight - mean(Data2Fit$BodyWeight))^2) # Total sum of squares
RSq_Pow <- 1 - (RSS_Pow/TSS_Pow) # R-squared value

RSS_Qua <- sum(residuals(QuaFit)^2) # Residual sum of squares
TSS_Qua <- sum((Data2Fit$BodyWeight - mean(Data2Fit$BodyWeight))^2) # Total sum of squares
RSq_Qua <- 1 - (RSS_Qua/TSS_Qua) # R-squared value

RSq_Pow
RSq_Qua

n <- nrow(Data2Fit) #set sample size
pPow <- length(coef(PowFit)) # get number of parameters in power law model
pQua <- length(coef(QuaFit)) # get number of parameters in quadratic model

AIC_Pow <- n + 2 + n * log((2 * pi) / n) + n * log(RSS_Pow) + 2 * pPow
AIC_Qua <- n + 2 + n * log((2 * pi) / n) + n * log(RSS_Qua) + 2 * pQua
AIC_Pow - AIC_Qua

AIC(PowFit) - AIC(QuaFit)

alb <- read.csv(file="../data/albatross_grow.csv")
alb <- subset(x=alb, !is.na(alb$wt))
plot(alb$age, alb$wt, xlab="age (days)", ylab="weight (g)", xlim=c(0, 100))

logistic1 <- function(t, r, K, N0){
 N0 * K * exp(r * t)/(K+N0 * (exp(r * t)-1))
}

vonbert.w <- function(t, Winf, c, K){
 Winf * (1 - exp(-K * t) + c * exp(-K * t))^3
}

scale <- 4000

alb.lin <- lm(wt/scale ~ age, data = alb)

alb.log <- nlsLM(wt/scale~logistic1(age, r, K, N0), start=list(K=1, r=0.1, N0=0.1), data=alb)

alb.vb <- nlsLM(wt/scale~vonbert.w(age, Winf, c, K), start=list(Winf=0.75, c=0.01, K=0.01), data=alb)

ages <- seq(0, 100, length=1000)

pred.lin <- predict(alb.lin, newdata = list(age=ages)) * scale

pred.log <- predict(alb.log, newdata = list(age=ages)) * scale

pred.vb <- predict(alb.vb, newdata = list(age=ages)) * scale

plot(alb$age, alb$wt, xlab="age (days)", ylab="weight (g)", xlim=c(0,100))
lines(ages, pred.lin, col=2, lwd=2)
lines(ages, pred.log, col=3, lwd=2)
lines(ages, pred.vb, col=4, lwd=2)

legend("topleft", legend = c("linear", "logistic", "Von Bert"), lwd=2, lty=1, col=2:4)

par(mfrow=c(3,1), bty="n")
plot(alb$age, resid(alb.lin), main="LM resids", xlim=c(0,100))
plot(alb$age, resid(alb.log), main="Logisitic resids", xlim=c(0,100))
plot(alb$age, resid(alb.vb), main="VB resids", xlim=c(0,100))

n <- length(alb$wt)
list(lin=signif(sum(resid(alb.lin)^2)/(n-2 * 2), 3),
 log= signif(sum(resid(alb.log)^2)/(n-2 * 3), 3),
 vb= signif(sum(resid(alb.vb)^2)/(n-2 * 3), 3))

aedes <- read.csv(file="../data/aedes_fecund.csv")

plot(aedes$T, aedes$EFD, xlab="temperature (C)", ylab="Eggs/day")

quad1 <- function(T, T0, Tm, c){
 c * (T-T0) * (T-Tm) * as.numeric(T<Tm) * as.numeric(T>T0)
}

briere <- function(T, T0, Tm, c){
 c * T * (T-T0) * (abs(Tm-T)^(1/2)) * as.numeric(T<Tm) * as.numeric(T>T0)
}

scale <- 20

aed.lin <- lm(EFD/scale ~ T, data=aedes)

aed.quad <- nlsLM(EFD/scale~quad1(T, T0, Tm, c), start=list(T0=10, Tm=40, c=0.01), data=aedes)

aed.br <- nlsLM(EFD/scale~briere(T, T0, Tm, c), start=list(T0=10, Tm=40, c=0.1), data=aedes)

t <- seq(0, 22, 2)
N <- c(32500, 33000, 38000, 105000, 445000, 1430000, 3020000, 4720000, 5670000, 5870000, 5930000, 5940000)

set.seed(1234) # set seed to ensure you always get the same random sequence

data <- data.frame(t, N * (1 + rnorm(length(t), sd = 0.1))) # add some random error

names(data) <- c("Time", "N")

head(data)

ggplot(data, aes(x = Time, y = N)) +
 geom_point(size = 3) +
 labs(x = "Time (Hours)", y = "Population size (cells)")

data$LogN <- log(data$N)

# visualise
ggplot(data, aes(x = t, y = LogN)) +
 geom_point(size = 3) +
 labs(x = "Time (Hours)", y = "log(cell number)")

(data[data$Time == 10,]$LogN - data[data$Time == 6,]$LogN)/(10-6)

diff(data$LogN)

max(diff(data$LogN))/2 # 2 is the difference in any successive pair of timepoints

lm_growth <- lm(LogN ~ Time, data = data[data$Time > 2 & data$Time < 12,])
summary(lm_growth)

logistic_model <- function(t, r_max, K, N_0){ # The classic logistic equation
 return(N_0 * K * exp(r_max * t)/(K + N_0 * (exp(r_max * t) - 1)))
}

# first we need some starting parameters for the model
N_0_start <- min(data$N) # lowest population size
K_start <- max(data$N) # highest population size
r_max_start <- 0.62 # use our estimate from the OLS fitting from above

fit_logistic <- nlsLM(N ~ logistic_model(t = Time, r_max, K, N_0), data,
      list(r_max=r_max_start, N_0 = N_0_start, K = K_start))

summary(fit_logistic)

timepoints <- seq(0, 22, 0.1)

logistic_points <- logistic_model(t = timepoints,
         r_max = coef(fit_logistic)["r_max"],
         K = coef(fit_logistic)["K"],
         N_0 = coef(fit_logistic)["N_0"])
df1 <- data.frame(timepoints, logistic_points)
df1$model <- "Logistic equation"
names(df1) <- c("Time", "N", "model")

ggplot(data, aes(x = Time, y = N)) +
 geom_point(size = 3) +
 geom_line(data = df1, aes(x = Time, y = N, col = model), size = 1) +
 theme(aspect.ratio=1)+ # make the plot square
 labs(x = "Time", y = "Cell number")

ggplot(data, aes(x = Time, y = LogN)) +
 geom_point(size = 3) +
 geom_line(data = df1, aes(x = Time, y = log(N), col = model), size = 1) +
 theme(aspect.ratio=1)+
 labs(x = "Time", y = "log(Cell number)")

ggplot(data, aes(x = N, y = LogN)) +
 geom_point(size = 3) +
 theme(aspect.ratio = 1)+
 labs(x = "N", y = "log(N)")

gompertz_model <- function(t, r_max, K, N_0, t_lag){ # Modified gompertz growth model (Zwietering 1990)
 return(N_0 + (K - N_0) * exp(-exp(r_max * exp(1) * (t_lag - t)/((K - N_0) * log(10)) + 1)))
}

N_0_start <- min(data$LogN) # lowest population size, note log scale
K_start <- max(data$LogN) # highest population size, note log scale
r_max_start <- 0.62 # use our previous estimate from the OLS fitting from above
t_lag_start <- data$Time[which.max(diff(diff(data$LogN)))] # find last timepoint of lag phase

diff(data$LogN) # same as what we did above - get differentials

diff(diff(data$LogN)) # get the differentials of the differentials (approx 2nd order derivatives)

which.max(diff(diff(data$LogN))) # find the timepoint where this 2nd order derivative really takes off

data$Time[which.max(diff(diff(data$LogN)))] # This then is a good guess for the last timepoint of the lag phase

fit_gompertz <- nlsLM(LogN ~ gompertz_model(t = Time, r_max, K, N_0, t_lag), data,
      list(t_lag=t_lag_start, r_max=r_max_start, N_0 = N_0_start, K = K_start))

summary(fit_gompertz)

timepoints <- seq(0, 24, 0.1)

logistic_points <- log(logistic_model(t = timepoints,
          r_max = coef(fit_logistic)["r_max"],
          K = coef(fit_logistic)["K"],
          N_0 = coef(fit_logistic)["N_0"]))

gompertz_points <- gompertz_model(t = timepoints,
         r_max = coef(fit_gompertz)["r_max"],
         K = coef(fit_gompertz)["K"],
         N_0 = coef(fit_gompertz)["N_0"],
         t_lag = coef(fit_gompertz)["t_lag"])

df1 <- data.frame(timepoints, logistic_points)
df1$model <- "Logistic model"
names(df1) <- c("Time", "LogN", "model")

df2 <- data.frame(timepoints, gompertz_points)
df2$model <- "Gompertz model"
names(df2) <- c("Time", "LogN", "model")

model_frame <- rbind(df1, df2)

ggplot(data, aes(x = Time, y = LogN)) +
 geom_point(size = 3) +
 geom_line(data = model_frame, aes(x = Time, y = LogN, col = model), size = 1) +
 theme_bw() + # make the background white
 theme(aspect.ratio=1)+ # make the plot square
 labs(x = "Time", y = "log(Abundance)")

nll.slr <- function(par, dat, ...){
 args <- list(...)

 b0 <- par[1]
 b1 <- par[2]
 X <- dat$X
 Y <- dat$Y
 if(!is.na(args$sigma)){
  sigma <- args$sigma
 } else
  sigma <- par[3]

 mu <- b0+b1 * X

 return(-sum(dnorm(Y, mean=mu, sd=sigma, log=TRUE)))
}

set.seed(123)
n <- 30
b0 <- 10
b1 <- 3
sigma <- 2
X <- rnorm(n, mean=3, sd=7)
Y <- b0 + b1 * X + rnorm(n, mean=0, sd=sigma)
dat <- data.frame(X=X, Y=Y) # convert to a data frame

plot(X, Y)

N <- 50
b0s <- seq(5, 15, length=N)
mynll <- rep(NA, length=50)
for(i in 1:N){
 mynll[i] <- nll.slr(par=c(b0s[i],b1), dat=dat, sigma=sigma)
}

plot(b0s, mynll, type="l")
abline(v=b0, col=2)
abline(v=b0s[which.min(mynll)], col=3)

N0 <- 100
N1 <- 101
b0s <- seq(7,12, length=N0)
b1s <- seq(1,5, length=N1)

mynll <- matrix(NA, nrow=N0, ncol=N1)
for(i in 1:N0){
 for(j in 1:N1) mynll[i,j] <- nll.slr(par=c(b0s[i],b1s[j]), dat=dat, sigma=sigma)
}

ww <- which(mynll==min(mynll), arr.ind=TRUE)

b0.est <- b0s[ww[1]]
b1.est <- b1s[ww[2]]
rbind(c(b0, b1), c(b0.est, b1.est))

filled.contour(x = b0s, y = b1s, z= mynll, col=heat.colors(21),
    plot.axes = {axis(1); axis(2); points(b0,b1, pch=21);
       points(b0.est, b1.est, pch=8, cex=1.5); xlab="b0"; ylab="b1"})

par(mfrow=c(1,2), bty="n")
plot(b0s, mynll[,ww[2]], type="l", xlab="b0", ylab="NLL")
plot(b1s, mynll[ww[1],], type="l", xlab="b1", ylab="NLL")

fit <- optim(nll.slr, par=c(2, 1), method="L-BFGS-B", ## this is a n-D method
    lower=-Inf, upper=Inf, dat=dat, sigma=sigma)

fit

fit <- optim(nll.slr, par=c(2, 1, 5), method="L-BFGS-B", ## this is a n-D method
    lower=c(-Inf, -Inf, 0.1), upper=Inf, dat=dat, sigma=NA)
fit$par

plot(X, Y)
abline(a=fit$par[1], b=fit$par[2], col=2, lwd=2)

fit <- optim(nll.slr, par=c(2, 1), method="L-BFGS-B", hessian=TRUE, lower=-Inf, upper=Inf, dat=dat, sigma=sigma)

fisher_info <- solve(fit$hessian)
est_sigma <- sqrt(diag(fisher_info))
upper <- fit$par+1.96 * est_sigma
lower <- fit$par-1.96 * est_sigma
interval <- data.frame(value=fit$par, upper=upper, lower=lower)
interval

lmfit <- lm(Y~X)

summary(lmfit)$coeff

set.seed(54321)

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

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

# Write more code here

## MOM estimators for 3 simulated sets

## MoM estimates, histogram

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

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

## Likelihood

## MLE/MoM estimators

## now plot the negative log likelihood profile

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

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

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

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

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

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

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

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

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

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

model1 <- "model{

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

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

} ## close model
"

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

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

plot(samp)

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

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

plot(samp)

summary(samp)

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

model2 <- "model{

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

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

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

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

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

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

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

plot(samp)

summary(samp)

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

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

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

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

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

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

head(Aaeg.data)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

OD.12C$BUGSoutput$summary

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


#' @title e
#'
#' @description Calculates the Nash-Sutcliffe modelling efficiency (E)
#' from observed and predicted values.
#'
#' @param observed Numeric vector of observed values
#'
#' @param predicted Numeric vector of predicted values. The length shall be
#' the same as for observed.
#'
#' @return The Nash-Sutcliffe modelling efficiency (E) calculated from observed and
#' predicted values.
#'
#' @details E = 1 - sum(observed - predicted)/sum(observed - mean (observed))
#'
#' @references Nash, J. E., & Sutcliffe, J. V. (1970). River flow forecasting
#' through conceptual models part I—A discussion of principles. Journal of
#' hydrology, 10(3), 282-290.
#'
#' @examples
#' o<-1:5
#' p<-c(2,2,4,3,5)
#' e(observed=o, predicted=p)
#'
#' @export
e<-function(observed, predicted){
  return(1-(sum((observed-predicted)^2)/sum((observed-mean(observed))^2)))
}


# Readming materials
# https://www.rdocumentation.org/packages/vegan/versions/2.4-2/topics/diversity

#https://cran.r-project.org/web/packages/vegan/vignettes/diversity-vegan.pdf

#https://www.statology.org/shannon-diversity-index/

#http://www.countrysideinfo.co.uk/simpsons.htm  --> explain on Simpson index

##Loading the data
# Example 1
# Let us use the measure from the left.

# We will create two plots with three species each. However, the abundances are different for each species:

plot1<-c(300,335,365)
plot2<-c(20,49,931)
plots<-cbind(plot1,plot2)
plots

#simpson index
source("simpson-f.r")

simpson1

simpson1(plots, type ="complement")
simpson2(plots, type ="complement")

sample <- c(2,8,1,1,3)
sample

simpson1(cbind(sample), type ="complement")
simpson2(cbind(sample), type ="complement")

#shanon index
source("shannon-f.r")
plots<-rbind(plot1,plot2)
plots

shannon.h(plots)
shannon.h(rbind(sample))

## using vegan package
library(vegan)

H = diversity(sample,'shannon')

H

D1 <- diversity(sample,'simpson')
D1
1/(1-D1)
D2 <- diversity(sample,'invsimpson')
D2
##


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


recurse_fibonacci <- function(n) {
    if(n <= 1) {
        return(n)
    } else {
        return(recurse_fibonacci(n-1) + recurse_fibonacci(n-2))
    }
}

# take input from the user
nterms = as.integer(readline(prompt="How many terms? "))

# check if the number of terms is valid
if(nterms <= 0) {
    print("Plese enter a positive integer")
} else {
    print("Fibonacci sequence:")
    for(i in 0:(nterms-1)) {
        print(recurse_fibonacci(i))
    }
}


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


celegans <- as.matrix(read.delim("celegans.dat",header = F,sep = ","))
celegans_t <- t(celegans)
cocitation_mat <- celegans%*% celegans_t
bibiliographic_mat <- celegans_t%*%celegans
diag(cocitation_mat) <- 0
diag(bibiliographic_mat) <- 0

View(cocitation_mat)
View(bibiliographic_mat)

#Eigen vector centrality
n <- dim(celegans)[1]
old <- rep(1,n)
new <- old
eps <- 10^-4

while (sum(abs(old - new)) < eps) {
  old <- new
  for (i in 1:n) {
    x1 <- which(celegans[i,]==1) #neighbor
    x <- sum(old[x1])
    new[i] <- x
  }
  #print(new)
  new <- new/sum(new)
}
Eigen_cent <- new
cat(sprintf("\n Important node wrt Eigen Vector centrality is : %d", which.max(Eigen_cent)))

#Page rank centrality
o <- matrix(1,n)
I <- diag(n)
alpha <- 0.85 #This value is less than max value of eigen value of AD^-1
A <- as.matrix(celegans)
kout <- colSums(A)
kout[kout==0] <- 1
D <- diag(1/kout)
xPR <- solve(I - alpha * A%*%D) %*% o
cat(sprintf("\n Important node wrt Page Rank centrality is : %d", which.max(xPR)))


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