library(deSolve)
library(rstan)
library(shinystan)
library(ggplot2)
library(RColorBrewer)
library(reshape2)
library(gridExtra)

# NOTE: to save plots, uncomment the ggsave lines

SIR <- function(Time, State, Pars) {

    with(as.list(c(State, Pars)), {

        B   <- R0*r/N
        BSI <- B*S*I
        rI  <- r*I

        dS = -BSI
        dI = BSI - rI
        dR = rI

        return(list(c(dS, dI, dR)))

    })

}

StocSIR <- function(y, pars, T, steps) {

	out <- matrix(NA, nrow = (T+1), ncol = 4)

	R0 <- pars[['R0']]
	r <- pars[['r']]
	N <- pars[['N']]
	eta <- pars[['eta']]
	berr <- pars[['berr']]

	S <- y[['S']]
	I <- y[['I']]
	R <- y[['R']]

	B0 <- R0 * r / N
	B <- B0

	out[1,] <- c(S,I,R,B)

	h <- 1 / steps

	for ( i in 1:(T*steps) ) {

		B <- exp( log(B0) + eta*(log(B) - log(B0)) + rnorm(1, 0, berr) )

		BSI <- B*S*I
		rI <- r*I

		dS <- -BSI
		dI <- BSI - rI
		dR <- rI

		S <- S + h*dS  #newInf
		I <- I + h*dI  #newInf - h*dR
		R <- R + h*dR  #h*dR

		if (i %% steps == 0)
			out[i/steps+1,] <- c(S,I,R,B)

	}

	return(out)

}

set.seed(1001)

T 		<- 60
i_infec <- 5
steps 	<- 7
N 		<- 500
sigma 	<- 10
Tlim 	<- 25

pars <- c(R0 = 3.0, 	# new infected people per infected person
          r = 0.1, 		# recovery rate
          gam = 2, 		# new infected shock intensity
		  N = 500, 		# population size
		  eta = 0.5, 	# geometric random walk
		  berr = 0.5) 	# Beta geometric walk noise

true_init_cond <- c(S = N - i_infec,
					I = i_infec,
					R = 0)

sdeout <- StocSIR(true_init_cond, pars, T, steps)
colnames(sdeout) <- c('S','I','R','B')

infec_counts_raw <- sdeout[,'I'] + rnorm(T+1, 0, sigma)
infec_counts     <- ifelse(infec_counts_raw < 0, 0, infec_counts_raw)

datapart <- c(infec_counts[1:(Tlim+1)],rep(NA,T-Tlim))

plotdata <- data.frame(times = 0:T, true = sdeout[,'I'], data = datapart)

g <- ggplot(plotdata, aes(times)) +
        geom_line(aes(y = true, colour = "True")) +
        geom_point(aes(y = data, colour = "Data")) +
        labs(x = "Time", y = "Infection count", color = "") +
        scale_color_brewer(palette="Paired") +
        theme(panel.background = element_rect(fill = "#F0F0F0"))

quartz()
print(g)
#ggsave(g, filename="dataplot.pdf", height=4, width=6.5)

datlen <- T*7 + 1

data <- matrix(data = -1, nrow = T+1, ncol = steps)
data[,1] <- infec_counts
standata <- as.vector(t(data))[1:datlen]

sir_data <- list( T = datlen,   	# simulation time
                  y = standata, 	# infection count data
                  N = 500,      	# population size
                  h = 1/steps )   	# step size per day

rstan_options(auto_write = TRUE)
options(mc.cores = parallel::detectCores())

stan_options <- list(   chains = 1,    		# number of chains
                        iter   = 5000, 		# iterations per chain
                        warmup = 1000, 		# warmup interations
                        thin   = 10,   		# thinning number
                        verbose = TRUE,
                        refresh = 50)

fit <- with(stan_options,
            stan(file  	= "sirode_euler.stan",
	            data    = sir_data,
	            chains  = chains,
	            iter    = iter,
	            warmup  = warmup,
	            thin    = thin,
	            verbose = verbose,
	            refresh = refresh )
        	)

# traceplots
if (stan_options$chains > 1) {

	exfit <- extract(fit, permuted = FALSE, inc_warmup = FALSE)
	plotdata <- melt(exfit[,,'R0'])
	tracefitR0 <- ggplot() +
	              geom_line(data = plotdata,
	                        aes(x = iterations,
	                        y = value,
	                        color = factor(chains, labels = 1:stan_options$chains))) +
	              labs(x = "Sample", y = expression(R[0]), color = "Chain") +
	              scale_color_brewer(palette="Paired") +
	              theme(panel.background = element_rect(fill = "#F0F0F0"))

	quartz()
	print(tracefitR0)
	#ggsave(tracefitR0, filename="traceplotR0.pdf", height=4, width=6.5)

	exfit <- extract(fit, permuted = FALSE, inc_warmup = TRUE)
	plotdata <- melt(exfit[,,2])
	tracefitR0 <- ggplot() +
	              geom_line(data = plotdata,
	                        aes(x = iterations,
	                        y = value,
	                        color = factor(chains, labels = 1:stan_options$chains))) +
	              labs(x = "Sample", y = expression(R[0]), color = "Chain") +
	              scale_color_brewer(palette="Paired") +
	              theme(panel.background = element_rect(fill = "#F0F0F0"))

	quartz()
	print(tracefitR0)
	#ggsave(tracefitR0, filename="traceplotR0_inc.pdf", height=4, width=6.5)

}

exfit <- extract(fit, permuted = FALSE, inc_warmup = FALSE)
paramdata <- data.frame(R0 = melt(exfit[,,'R0'])$value,
               			r = melt(exfit[,,'r'])$value,
               			sigma = melt(exfit[,,'sigma'])$value,
               			eta = melt(exfit[,,'eta'])$value,
               			berr = melt(exfit[,,'berr'])$value,
               			Sinit = melt(exfit[,,4])$value,
               			Iinit = melt(exfit[,,5])$value,
               			Rinit = melt(exfit[,,6])$value )

# sample from parameter distributions
sdeout_true <- sdeout

nTraj 	<- 100
datlen 	<- dim(paramdata)[1]
inds 	<- sample.int(datlen,nTraj,replace = TRUE)
params 	<- paramdata[inds,]

bootstrapdata <- matrix(NA, nrow = nTraj, ncol = T+1)

for (i in 1:nTraj) {

	init_cond <- c(S = params$Sinit[i],
	               I = params$Iinit[i],
	               R = params$Rinit[i])
	pars <- c(R0 = params$R0[i],
	          r = params$r[i],
	          N = 500.0,
	          eta = params$eta[i],
	          berr = params$berr[i])

	sdeout <- StocSIR(init_cond, pars, T, steps)
	colnames(sdeout) <- c('S','I','R','B')

	bootstrapdata[i,] <- sdeout[,'I']

}

meanTraj 	<- colMeans(bootstrapdata)
quantTraj 	<- apply(bootstrapdata, 2, quantile, probs = c(0.025,0.975))

plotdata <- data.frame(times=0:T,true=sdeout_true[,'I'],est=meanTraj,quants=t(quantTraj),datapart=datapart)

g <- ggplot(plotdata, aes(times)) +
		geom_ribbon(aes(ymin = quants.2.5., ymax=quants.97.5.), alpha=0.1) +
        geom_line(aes(y = true, colour = "True")) +
        geom_line(aes(y = est, colour = "IF2")) +
        geom_point(aes(y = datapart, color = "Data")) +
        labs(x = "Time", y = "Infection count", color = "") +
        scale_color_brewer(palette="Paired") +
        theme(panel.background = element_rect(fill = "#F0F0F0"))

quartz()
print(g)

# kernel plots

f <- function(pal) brewer.pal(brewer.pal.info[pal, "maxcolors"], pal)
kcolours <- f("Paired")

trueval.R0 		<- 3.0
trueval.r 		<- 0.1
trueval.sigma 	<- 10.0
trueval.Iinit 	<- 5
trueval.eta 	<- 0.5
trueval.berr 	<- 0.5

meanval.R0 		<- mean(paramdata$R0)
meanval.r 		<- mean(paramdata$r)
meanval.sigma 	<- mean(paramdata$sigma)
meanval.Iinit 	<- mean(paramdata$Iinit)
meanval.eta 	<- mean(paramdata$eta)
meanval.berr 	<- mean(paramdata$berr)

linecolour <- "grey50"
lineweight <- 0.5

kerdataR0 <- data.frame(R0points = paramdata$R0)
R0kernel <- ggplot(kerdataR0, aes(x = R0points, y = ..scaled..)) +
                geom_density(color = kcolours[1], fill = kcolours[1]) +
                theme(panel.background = element_rect(fill = "#F0F0F0")) +
                scale_color_brewer(palette="Paired") +
                labs(x = expression(R[0]), y = "Density", color = "") +
                geom_vline(aes(xintercept=trueval.R0), linetype="solid", size=lineweight, color=linecolour) +
                geom_vline(aes(xintercept=meanval.R0), linetype="dashed", size=lineweight, color=linecolour)

kerdatar <- data.frame(rpoints = paramdata$r)
rkernel <- ggplot(kerdatar, aes(x = rpoints, y = ..scaled..)) +
                geom_density(color = kcolours[2], fill = kcolours[2]) +
                theme(panel.background = element_rect(fill = "#F0F0F0")) +
                scale_color_brewer(palette="Paired") +
                labs(x = "r", y = "", color = "") +
                geom_vline(aes(xintercept=trueval.r), linetype="solid", size=lineweight, color=linecolour) +
                geom_vline(aes(xintercept=meanval.r), linetype="dashed", size=lineweight, color=linecolour)

kerdatasigma <- data.frame(sigmapoints = paramdata$sigma)
sigmakernel <- ggplot(kerdatasigma, aes(x = sigmapoints, y = ..scaled..)) +
                geom_density(color = kcolours[3], fill = kcolours[3]) +
                theme(panel.background = element_rect(fill = "#F0F0F0")) +
                scale_color_brewer(palette="Paired") +
                labs(x = expression(sigma), y = "Density", color = "") +
                geom_vline(aes(xintercept=trueval.sigma), linetype="solid", size=lineweight, color=linecolour) +
                geom_vline(aes(xintercept=meanval.sigma), linetype="dashed", size=lineweight, color=linecolour)

kerdatainfec <- data.frame(infecpoints = paramdata$Iinit)
infeckernel <- ggplot(kerdatainfec, aes(x = infecpoints, y = ..scaled..)) +
                geom_density(color = kcolours[4], fill = kcolours[4]) +
                theme(panel.background = element_rect(fill = "#F0F0F0")) +
                scale_color_brewer(palette="Paired") +
                labs(x = "Initial infected", y = "", color = "") +
                geom_vline(aes(xintercept=trueval.Iinit), linetype="solid", size=lineweight, color=linecolour) +
                geom_vline(aes(xintercept=meanval.Iinit), linetype="dashed", size=lineweight, color=linecolour)

kerdataeta <- data.frame(etapoints = paramdata$eta)
etakernel <- ggplot(kerdataeta, aes(x = etapoints, y = ..scaled..)) +
                geom_density(color = kcolours[5], fill = kcolours[5]) +
                theme(panel.background = element_rect(fill = "#F0F0F0")) +
                scale_color_brewer(palette="Paired") +
                labs(x = expression(eta), y = "", color = "") +
                geom_vline(aes(xintercept=trueval.eta), linetype="solid", size=lineweight, color=linecolour) +
                geom_vline(aes(xintercept=meanval.eta), linetype="dashed", size=lineweight, color=linecolour)

kerdataberr <- data.frame(berrpoints = paramdata$berr)
berrkernel <- ggplot(kerdataberr, aes(x = berrpoints, y = ..scaled..)) +
                geom_density(color = kcolours[6], fill = kcolours[6]) +
                theme(panel.background = element_rect(fill = "#F0F0F0")) +
                scale_color_brewer(palette="Paired") +
                labs(x = expression(beta[err]), y = "", color = "") +
                geom_vline(aes(xintercept=trueval.berr), linetype="solid", size=lineweight, color=linecolour) +
                geom_vline(aes(xintercept=meanval.berr), linetype="dashed", size=lineweight, color=linecolour)

# show grid
quartz()
grid.arrange(R0kernel, rkernel, sigmakernel, infeckernel, etakernel, berrkernel, ncol = 3, nrow = 2)

# Shiny Stan!!!

sso <- as.shinystan(fit)
sso <- launch_shinystan(sso)


## L(D|theta)^a_0 pi(theta)

alpha <- 10
beta <- 10
yy <- 20
NN <- 50
a_0 <- 0
###########################

power_post <- function(p, y, N, a0){
  lp <- a0 * ( y* log(p) + (N-y) * log(1-p) ) + dbeta(x = p, shape1 = alpha, shape2 = beta, log = TRUE)
  return(exp(lp))
}
power_post <- Vectorize(power_post)

curve(power_post(p = x, y = yy, N = NN, a0 = a_0))

log_sq_lik <- function(p, y, N){
  ( y* log(p) + (N-y) * log(1-p) )^2
}
curve(log_sq_lik(p = x, y = yy, N = NN))

expect <- function(p, y, N, a0){
  ans <- power_post(p = p, y = y, N = N, a0 = a0) * log_sq_lik(p = p, y = y, N = N)
  return(ans)
}
expect <- Vectorize(expect)
curve(expect(p = x, y = yy, N = NN, a0 = a_0))
integrate(function(x) expect(p = x, y = yy, N = NN, a0 = a_0), 0, 1)

## 1/X^2
one_over_x_sq <- function(p, y, N){
  exp(
    - 2*(y* log(p) + (N-y) * log(1-p))
  )
}
## test that code for 1/L(D|theta)^2 is correct
# pp <- .2
# L <- pp^yy * (1-pp)^{NN-yy}
# 1/L^2
# one_over_x_sq(p = pp, y = yy, N = NN)

expect2 <- function(p, y, N, a0){
  ans <- power_post(p = p, y = y, N = N, a0 = a0) * one_over_x_sq(p = p, y = y, N = N)
  return(ans)
}
expect2 <- Vectorize(expect2)

curve(expect2(p = x, y = yy, N = NN, a0 = a_0))

integrate(function(x) expect2(p = x, y = yy, N = NN, a0 = a_0), 0, 1)

## -log(X)/X

minus_logX_over_X <- function(p, y, N){
  logX <- y* log(p) + (N-y) * log(1-p)
  return(
    -logX/exp(logX)
  )
}

expect3 <- function(p, y, N, a0){
  ans <- power_post(p = p, y = y, N = N, a0 = a0) * minus_logX_over_X(p = p, y = y, N = N)
  return(ans)
}
expect3 <- Vectorize(expect3)

curve(expect3(p = x, y = yy, N = NN, a0 = a_0))

integrate(function(x) expect3(p = x, y = yy, N = NN, a0 = a_0), 0, 1)


#02. 포아송분포(Poisson distribution) : 램덤하게 선택한 일정단위시간(시, 분, 초)나 공간 등 내에 발생하는 사건의 개수를 설명
  # 보통 단위시간 당 도착에 대한 모델이 많이 사용되므로 시간이 주로 사용 / 하루 사고 건수, 10분간 민원 전화 건수 등
  # <=> 지수분포 : 도착에 따른 시간 측정에 활용 : 건과 건 사이의 시간

# 확률밀도함수: d~
# 누적분포함수(점수): p~
# 누적분포함수(확률): q~

# 포아송분포 확률밀도함수
# dpois(발생건수, lambda(단위시간당 평균발생 건수)
# 서비스센터 사례
# 서비스 센터에서 단위 시간 당(시간은 임의로 정하는 것) 평균발생건수: 1.5회
# P(X = a) 확률 계산
dpois(x=0, lambda = 1.5)
dpois(x=1, lambda = 1.5)
dpois(x=2, lambda = 1.5)
dpois(x=3, lambda = 1.5)
dpois(x=4, lambda = 1.5)
dpois(x=5, lambda = 1.5)

# 포아송분포 확률밀도함수 graph
plot(dpois(x=c(0:10), lambda = 1.5), # 평균을 기준으로 가장 높고 평균을 넘어가면 확률이 낮아지는 개념
     type='h',
     lwd=10,
     col="red",
     xlab="성공확률 X",
     main = "포아송분포")

# 포아송분포 누적확률계산 - 사건을 알때 확률 계산
# 이하 : P(X <= a) lower.tail = TRUE
# 초과: P(X > a) lower.tail = FALSE
# 2회이상(x>=2) 받을 확률: P(X > 1) 확률 계산 -> R에서는 이상이 없으니까 초과 개념으로 해서 2회 이상이면 1을 입력한다.
ppois(q=1, lambda = 1.5, lower.tail = FALSE)

# 포아송분포 누적확률 graph
plot(ppois(0:10, lambda = 1.5),
     type='h',
     lwd=10,
     col="red",
     main = "누적포아송분포")

## 퀴즈 K 서비스 센터 10분에 평균 2회 전화, 10분 동안 2회 이하로 전화 받을 확률?

# P(X <= 2)이하로 받을 확률
ppois(q=2, lambda = 2, lower.tail = TRUE)


#Mann-Whitney-Wilcoxon
#Si dos muestras son independientes, entonces
#provenen de poblaciones distintas y no se afectan entre si

#Usando Mann-White-Wilcoxon, podemos decidir si las
#distribuciones poblacionales son identicas sin asumir una distribucion
#normal

#Without assuming the data to have normal distribution, decide at .05 significance level if the gas mileage data of manual and automatic transmissions in mtcars have identical data distribution.

wilcox.test(mpg ~ am,data=mtcars)

'''
	Wilcoxon rank sum test with continuity
	correction

data:  mpg by am
W = 42, p-value = 0.001871
alternative hypothesis: true location shift is not equal to 0
'''

Parcial/5. Metodos no parametricos/MannWhitneyWilcoxon.r


#  Mergesort implementation in R
#  Author: Carlos Abraham Hernandez
#  github.com/abranhe

merge <- function(x, start, middle, end){

  x.left <- c(x[start:middle], Inf)
  x.right <- c(x[(middle+1):end], Inf)

  index.left <- 1
  index.right <- 1

  for(index.x in start:end){
    if(x.left[index.left] <= x.right[index.right]){
      x[index.x] <- x.left[index.left]
      index.left <- index.left + 1
    }
    else{
      x[index.x] <- x.right[index.right]
      index.right <- index.right + 1
    }
  }

  return(x)
}

mergeSort <- function(x, start, end){

  if(start < end){
    middle <- floor((start + end)/2)
    x <- mergeSort(x, start, middle)
    x <- mergeSort(x, middle+1, end)
    x <- merge(x, start, middle, end)
  }

  return(x)
}

x <- c(7,19,3,15,22,4,9,100)

print(x)
print(mergeSort(x, 1, length(x)))


library(quaternions)

q <- Q(1, 2, 3, 4)
q1 <- Q(2, 3, 4, 5)
q2 <- Q(3, 4, 5, 6)
r <- 7.0

display <- function(x){
  e <- deparse(substitute(x))
  res <- if(class(x) == "Q") paste(x$r, "+", x$i, "i+", x$j, "j+", x$k, "k", sep = "") else x
  cat(noquote(paste(c(e, " = ", res, "\n"), collapse="")))
  invisible(res)
}

display(norm(q))
display(-q)
display(Conj(q))
display(r + q)
display(q1 + q2)
display(r*q)
display(q*r)
if(display(q1*q2) == display(q2*q1)) cat("q1*q2 == q2*q1\n") else cat("q1*q2 != q2*q1\n")

## norm(q) = 5.47722557505166
## -q = -1+-2i+-3j+-4k
## Conj(q) = 1+-2i+-3j+-4k
## r + q = 8+2i+3j+4k
## q1 + q2 = 5+7i+9j+11k
## r * q = 7+14i+21j+28k
## q * r = 7+14i+21j+28k
## q1 * q2 = -56+16i+24j+26k
## q2 * q1 = -56+18i+20j+28k
## q1*q2 != q2*q1


## Dale W.R. Rosenthal, 2018
## You are free to distribute and use this code so long as you attribute
## it to me or cite the text.
## The legal disclaimer in _A Quantitative Primer on Investments with R_
## applies to this code.  Use or distribution without these comment lines
## is forbidden.

## No prepayments
principal <- 300000  # mortgage principal
n.peryr <- 12  # monthly = 12 payments per year
T <- 30   # 30-year mortgage
r <- 0.0625  # 6.25%
t <- 1:(n.peryr*T)
pmt.level <- principal*r/(n.peryr*(1-1/(1+r/n.peryr)^(n.peryr*T)))
pmt.principal <- pmt.level/(1+r/n.peryr)^(n.peryr*T-t+1)
pmt.interest <- pmt.level-pmt.principal

areaplot(t, data.frame(pmt.interest, pmt.principal), col=c("red","blue"),
         ylim=c(0,pmt.level), border=FALSE)

## With prepayments
principal.start <- 300e3  # mortgage principal
n.peryr <- 12  # monthly = 12 payments per year
T <- 30   # 30-year mortgage
r <- 0.0625  # 6.25%
t <- 1:(n.peryr*T)
## calculate level monthly payment
pmt.level <- principal.start*r/(n.peryr*(1-1/(1+r/n.peryr)^(n.peryr*T)))

## Prepay an extra 5\% each payment
pmt.prepay.plan <- 0.05*pmt.level

## In production code, this would be more elegant; however,
## a for loop shows the intuition better than other approaches
num.pmts <- n.peryr*T
principal.left <- c(principal.start, rep(0,num.pmts-1))
pmt.interest <- pmt.principal <- pmt.prepays <- rep(0, num.pmts)
for (i in 1:num.pmts) {
    pmt.interest[i] <- principal.left[i]*r/n.peryr
    pmt.principal[i] <- pmt.level - pmt.interest[i]
    if (pmt.principal[i] > principal.left[i]) {
        ## do not repay more than principal remaining
        pmt.principal[i] <- principal.left[i]
        ## stop the loop; mortgage is paid off
        break
    } else {
        ## do not prepay more than principal remaining after normal payment
        pmt.prepays[i] <- pmt.prepay.plan
        if ((pmt.principal[i] + pmt.prepays[i]) > principal.left[i]) {
            pmt.prepays[i] <- principal.left[i] - pmt.principal[i]
            ## stop the loop; mortgage is paid off
            break
        }
    }
    if (i < num.pmts) {
        principal.left[i+1] <- principal.left[i] - pmt.principal[i] - pmt.prepays[i]
    }
}

areaplot(t,data.frame(pmt.interest, pmt.principal, pmt.prepays),
         ylim=c(0,pmt.level+max(pmt.prepays)), col=c("red","blue","orange"),
         border=FALSE)


# two tailed test
ybar = 178.2            # sample mean
mu0 = 190             # hypothesized value
sigma = 45.3          # population standard deviation
n = 100                 # sample size
# We  compute the critical value at .025 significance level.
alpha = .05
z.half.alpha = qnorm(1-alpha/2)
# critical values
lr=mu0-(z.half.alpha*sigma)/sqrt(n)
ur=mu0+(z.half.alpha*sigma)/sqrt(n)
paste0(" lower rejection = ",lr)
paste0("upper rejection = ",ur)
z = (ybar- mu0)/(sigma/sqrt(n))
print(z) # test statistic

 print("The test statistic doesnot lies between the critical values(i.e. |z|>critical value). Hence, at .025 significance level, we  reject the null hypothesis")


# 기본함수
n <- 6
r <- 3
factorial(n)
factorial(n)/factorial(n-r)
choose(n,r)

# 패키지 이용
install.packages("gtools")
library(gtools)

nrow(permutations(6,3))
nrow(combinations(6,3))

# 야구경기 (9명-9개)
factorial(9)

# 집배원(4군데)
factorial(4)

# 12명중 8개
nrow(permutations(12,8))

n <- 12
r <- 8
factorial(n)/factorial(n-r)

# 20명중 2명씩 짝
choose(20,2)

# 45개 숫자중 6개 고름
choose(45,6)

# 1등 당첨확률
# 지수표기법 환원 1.2e+10->0.00000000012
options("scipen" = 20) # 통계치 유의확률 0.05
lot <- choose(45,6)
1/lot

# 5등 당첨확률(3개만)
options("scipen" = 20)
lot5 <- (choose(6,3)*choose(39,3))
lot5/lot


paint_data=c(28, 35, 27, 21,21, 36, 25 ,18,26, 38, 27, 17,16, 25, 22, 18)
ybar=sum(paint_data)/length(paint_data)
print(ybar)
# total sum of squares
TSS=0
i=1
while(i<=length(paint_data)){
  TSS=TSS+(paint_data[i]-ybar)^2
  i=i+1
}
print(TSS)
# between treatment sum of squares

yi=c(mean(paint_data[1:4]),mean(paint_data[5:8]),mean(paint_data[9:12]),mean(paint_data[13:16]))

SST=0
j=1
while(j<=length(paint_data)/4){
  SST=SST+4*((yi[j]-ybar)^2)
  j=j+1
}
print(SST)
#  sum of squares for error
SSE=TSS-SST
print(SSE)


#Q4. The following iterative sequence is defined for the set of positive integers:
#n → n/2 (n is even)
#n → 3n + 1 (n is odd)

#Using the rule above and starting with 13, we generate the following sequence:
#13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1
#It can be seen that this sequence (starting at 13 and finishing at 1) contains 10 terms. Although it has not been proved yet (Collatz Problem), it is thought that all starting numbers finish at 1.
#Which starting number, under one thousand, produces the longest chain?

collatz.length <- vector(length = 1E6)
collatz.length[1] <- 0
for (n in 2:1E6) {
    x <- n
    count <- 0
    while (x != 1 & x >= n) {
        if (x %% 2 == 0) {
            x <- x / 2
            count <- count + 1
        }
        else {
            x <- (3 * x + 1) / 2
            count <- count + 2
        }
    }
    count <- count + collatz.length[x]
    collatz.length[n] <- count
}
answer <- which.max(collatz.length)
print(answer)


library(tidyverse)

##########################
######### T-test #########
##########################

# Two-tailed t-test (unpaired)
# assumptions: independent, normally distributed, homogeneous variance

treatment1 <- PlantGrowth[PlantGrowth$group == 'trt1',]$weight
treatment2 <- PlantGrowth[PlantGrowth$group == 'trt2',]$weight

shapiro.test(treatment1)
shapiro.test(treatment2)

# check if variances are equal
var.test(treatment1, treatment2)

t.test(
  treatment1,
  treatment2,
  alternative = "two.sided",
  var.equal = FALSE
)

# Two-tailed t-test (paired)

age5 <- Loblolly[Loblolly$age == 5,]$height
age20 <- Loblolly[Loblolly$age == 20,]$height
age25 <- Loblolly[Loblolly$age == 25,]$height

shapiro.test(age20)
shapiro.test(age25)

# near equal variance
var.test(age20, age25)

t.test(
  age20,
  age25,
  alternative = "two.sided",
  paired = TRUE
)

# change alternative to "less" or "greater" for one-tailed test

##########################
######### F-test #########
##########################

var.test(
  age20,
  age25,
  ratio = 1,
  conf.level = 0.95,
  alternative = "two.sided"
)

#########################
######### ANOVA #########
#########################
mtcars

lm1 <- lm(mpg ~ hp , mtcars)
lm2 <- lm(mpg ~ hp + gear, mtcars)

summary(lm1)
summary(lm2)

anova(lm1, lm2)


n <- 10
p0 <- 1/2
alpha0 <- 0.2

# c(p0)
# delta_c é um teste de tamanho alpha0=0.05

tamanho_c <- function(c){
  ## Pr(Y >= c | p = p0)
  res <-  1- sum(dbinom(0:(c-1), n, p0))
  return(res)
}
tamanho_c <- Vectorize(tamanho_c)

# Agora vamos plotar para tentar achar c* tal que Pr(Y >= c | p = p0) <= alpha0

curve(tamanho_c, 1, n, lwd = 2, xlab = expression(c))
abline(h = alpha0, lty = 2)

## Agora vamos expressar o poder como função da probabilidade postulada p0

Y <- 5

poder_p <- function(p){
  res <- 1- sum(dbinom(0:(Y-1), n, p))
  return(res)
}
poder_p <- Vectorize(poder_p)

curve(poder_p, xlab = expression(p[0]))
abline(h = alpha0, lty = 2)

# LRT: razão de verossimilhanças

Lambda <- function(y, log = FALSE){
  l1 <- y * (log(n*p0)-log(y))
  if(y==0) l1 <- 0
  l2 <- (n-y)*(log(n*(1-p0))-log(n-y))
  if(y==n) l2 <- 0
  ans <- l1 + l2
  if(!log) ans <- exp(ans)
  return(ans)
}
Lambda <- Vectorize(Lambda)

tabProb <- data.frame(y = 0:n, Lambda = Lambda(0:n), Pr = dbinom(x = 0:n, size = n, prob = p0))
round(tabProb, 3)
plot(0:n, Lambda(0:n), xlab = expression(y), ylab = expression(Lambda(y)))

findSet <- function(tab, level = alpha0){
  K <- nrow(tab)
  set <- NA
  accpr <- 0
  for(i in 1:K){
    accpr.tent <- accpr + tab$Pr[i]
    if(accpr.tent < level){
      accpr <- accpr.tent
      set <- c(set, tab$y[i])
    }else{
      next
    }
  }
  set <- na.omit(set)
  return(
    list(
      confidence_set = as.vector(set),
      test_size = accpr
    )
  )
}
findSet(tab = tabProb)


dist <- "beta"

## Beta
alpha <- 3
beta <- 2

## Log-normal
mu <- 0
sigma <- 2

if(dist == "ln"){
  EX <- exp(mu + sigma^2/2)
}else{
  EX <- alpha / (alpha + beta)
}

computa_media <- function(n){
  if(dist == "ln"){
    mean(rlnorm(n = n, meanlog = mu, sdlog = sigma))
  }else{
    mean(rbeta(n = n, shape1 = alpha, shape2 = beta))
  }
}
ns <- seq(2, 1E5, by = 500)
medias <- sapply(ns, computa_media)

library(ggplot2)

forplot <- data.frame(n = ns, x_bar = medias)

ggplot(forplot, aes(x = n, y = x_bar))+
  geom_line() +
  scale_x_continuous("Tamanho de amostra", expand = c(0, 0)) +
  scale_y_continuous(expression(bar(X[n])), expand = c(0, 0)) +
  geom_hline(yintercept = EX, linetype = "longdash", size = 2) +
  theme_bw(base_size = 16)


#Copyright (c) 2016 Riccardo Francescato
a <- c(16.85,16.40,17.21,16.35,16.52,17.04,16.96,17.15,16.59,16.57)
b <- c(16.62,16.75,17.37,17.12,16.98,16.87,17.34,17.02,17.08,17.27)
#confidency level
alpha = .05
#type of test: 0 left tail 1 double tail 2 right tail
type = 1
#calculations....
n0 = length(a)		# number of reps for sample 0
n1 = length(b)		# number of reps for sample 1
xbar0 = mean(a)		# sample 0 mean
xbar1 = mean(b)		# sample 1 mean
s0 = sd(a)			# sample 0 standard deviation
s1 = sd(b)			# sample 1 standard deviation
sp2 = ((n0-1)*s0^2 + (n1-1)*s1^2)/(n0+n1-2)
t = (xbar0−xbar1)/(sqrt(sp2)*sqrt((1/n0) + (1/n1)))
if(type == 0){
	t.alpha = qt(1−alpha, df=n0−1)
	pval = pt(t, df=n0−1)
	cat("Results of lower tail\n")
	cat("First sample\n")
	cat(paste("# of elements: ", n0, " Mean: ", xbar0, " St Dev: ",s0))
	cat("\nSecond sample\n")
	cat(paste("# of elements: ", n1, " Mean: ", xbar1, " St Dev: ",s1))
	cat(paste("\nEstimate of common variance Sp: ",sqrt(sp2)))
	cat(paste("\nt0: ",t))
	cat(paste("\ntalpha: ",−t.alpha))
	cat(paste("\np-value: ",pval))
	if(t<−t.alpha) cat("\nREJECT H0\n") else cat("\nACCEPT H0\n")
}else if(type == 1){
	t.half.alpha = qt(1−alpha/2, df=n0−1)
	pval = 2 * pt(t, df=n0−1)
	cat("Results of 2-tail tail\n")
	cat("First sample\n")
	cat(paste("# of elements: ", n0, " Mean: ", xbar0, " St Dev: ",s0))
	cat("\nSecond sample\n")
	cat(paste("# of elements: ", n1, " Mean: ", xbar1, " St Dev: ",s1))
	cat(paste("\nEstimate of common variance Sp: ",sqrt(sp2)))
	cat(paste("\nt0: ",t))
	cat(paste("\ntalpha +: ",t.half.alpha))
	cat(paste("\ntalpha -: ",-t.half.alpha))
	cat(paste("\np-value: ",pval))
	if(t<-t.half.alpha || t>t.half.alpha) cat("\nREJECT H0\n") else cat("\nACCEPT H0\n")

}else if(type == 2){
	t.alpha = qt(1−alpha, df=n0−1)
	pval = pt(t, df=n0−1, lower.tail=FALSE)
	cat("Results of upper tail\n")
	cat("First sample\n")
	cat(paste("# of elements: ", n0, " Mean: ", xbar0, " St Dev: ",s0))
	cat("\nSecond sample\n")
	cat(paste("# of elements: ", n1, " Mean: ", xbar1, " St Dev: ",s1))
	cat(paste("\nEstimate of common variance Sp: ",sqrt(sp2)))
	cat(paste("\nt0: ",t))
	cat(paste("\ntalpha: ",t.alpha))
	cat(paste("\np-value: ",pval))
	if(t>t.alpha) cat("\nREJECT H0\n") else cat("\nACCEPT H0\n")
}


readings=c(203.1, 184.5, 206.8 ,211.0 ,218.3, 174.2, 193.2 ,201.9 ,199.9 ,194.3,
           199.4, 193.6, 194.6 ,187.2 ,197.8 ,184.3, 196.1, 196.4 ,197.5 ,187.9)
n=length(readings)
ybar=mean(readings)
s=sd(readings)
muo=5
# test static
X=(n-1)*(s^2)/(muo^2)
print(X)
#critical value
alpha=0.05
X.alpha=qchisq(1-0.05,df=19)

# the null hypothesis, H0 is rejected if the value of the X is greater than X.alpha
#Since the computed value of the X., 74.61, is greater than the
# critical value 30.14, there is sufficient evidence to reject H0
# The upper-tail chi-square value
XU=qchisq(.975, df=19)
# The lower-tail chi-square value
XL=qchisq(1-.975, df=19)
# The 95% confidence interval for standard deviation
right_i=sqrt((n-1)*(s^2)/(XL))
left_i=sqrt((n-1)*(s^2)/(XU))
print(left_i)
print(right_i)


library(ISLR)
set.seed(1)
train=sample (392,196)

lm.fit=lm(mpg~horsepower ,data=Auto,subset=train)

mean((Auto$mpg - predict(lm.fit, Auto))[-train]^2)

library(boot)
glm.fit=glm(mpg∼horsepower ,data=Auto)
cv.err=cv.glm(Auto ,glm.fit)
cv.err$delta

#LOOCV test
cv.error=rep(0,5)
for (i in 1:5){
  glm.fit=glm(mpg∼poly(horsepower ,i),data=Auto)
  cv.error[i]=cv.glm(Auto,glm.fit)$delta[1]
}
cv.error

#10-fold CV test
set.seed(17)
cv.error.10=rep(0,10)
for (i in 1:10){
  glm.fit=glm(mpg ~ poly(horsepower ,i),data=Auto)
  cv.error.10[i]=cv.glm(Auto,glm.fit,K=10)$delta[1]
}
cv.error.10

#bootstrap
alpha.fn=function (data,index){
  X=data$X[index]
  Y=data$Y[index]
  return((var(Y)-cov(X,Y))/(var(X)+var(Y)-2*cov(X,Y)))
}

alpha.fn(Portfolio ,1:100)
set.seed(1)
alpha.fn(Portfolio ,sample (100,100, replace=T))

boot(Portfolio, alpha.fn, R=1000)

#bootstrap for linear regression coefficients
boot.fn=function (data ,index) return(coef(lm(mpg ~ horsepower ,data=data,subset=index)))
boot.fn(Auto ,1:392)

set.seed(1)
boot.fn(Auto ,sample (392,392, replace=T))
boot(Auto ,boot.fn, 1000)

boot.fn=function (data ,index) coefficients(lm(mpg~horsepower +I(horsepower ^2),data=data ,                   subset=index))
set.seed(1)
boot(Auto ,boot.fn,1000)


#' rsvd
#'
#' Randomized singular value decomposition.
#'
#' @details
#' A randomized SVD is an approximate method for computing using random
#' projections to estimate singular values/vectors. It is usually faster than
#' a full SVD (say via \code{svd()}) when only the first few singular
#' values/vectors are needed.
#'
#' @section Communication:
#' The operation is completely local except for forming the crossproduct, which
#' is an \code{allreduce()} call, quadratic on the number of columns.
#'
#' @param x
#' The input data matrix.
#' @param k
#' The number of singular values and/or left/right singular vectors
#' to estimate.
#' @param q
#' An integer exponent, say 1, 2, or 3.  See the paper for details.
#' @param retu
#' Logical; should the left singular vectors ("U") be returned?
#' @param retv
#' Logical; should the right singular vectors ("V") be returned?
#'
#' @return
#' A list of elements \code{d}, \code{u}, and \code{v}, as with R's own
#' \code{svd()}.  The elements are, respectively, a regular vector, a shaq, and
#' a regular matrix.
#'
#' @examples
#' \dontrun{
#' library(kazaam)
#' x = ranshaq(runif, 10, 3)
#'
#' svd = rsvd(x)
#' comm.print(svd$d) # a globally owned vector
#' svd$u # a shaq
#' comm.print(svd$v) # a globally owned matrix
#'
#' finalize()
#' }
#'
#' @references
#' Halko, Martinsson, and Tropp. 2011. Finding structure with randomness:
#' probabilistic algorithms for constructing approximate matrix decompositions.
#' SIAM Review 53 217-288.
#'
#' @export
rsvd <- function(x, k=1, q=2, retu=TRUE, retv=TRUE)
{
  if (!is.shaq(x))
    comm.stop("input 'x' must be a shaq")

  ### Stage A from the paper
  n = ncol(x)
  Omega = runif(n * 2*k) # nx(2k)
  dim(Omega) = c(n, 2*k)

  Y = x %*% Omega # mx(2k)
  Q = qr_Q(Y) # mx(2k)

  for (i in 1:q)
  {
    Y = crossprod(x, Q) # nx(2k)
    Q = qr.Q(qr(Y)) # nx(2k)
    Y = x %*% Q # mx(2k)
    Q = qr_Q(Y) # mx(2k)
  }

  ### Stage B
  B = crossprod(Q, x) # (2k)xn

  if (!retu)
    nu = 0
  else
    nu = min(dim(B))

  if (!retv)
    nv = 0
  else
    nv = min(dim(B))

  svd.B = svd(B, nu, nv)

  ind = 1L:k
  d = (svd.B$d)[ind]

  # Produce u/v as desired
  if (retu)
  {
    u = Q %*% svd.B$u
    u = u[, ind]
  }

  if (retv)
    v = svd.B$v[, ind, drop=FALSE]

  # wrangle return
  if (retu)
  {
    if (retv)
      svd <- list(d=d, u=u, v=v)
    else
      svd <- list(d=d, u=u)
  }
  else
  {
    if (retv)
      svd <- list(d=d, v=v)
    else
      svd <- list(d=d)
  }

  svd
}


# Example : 2   Chapter : 6.1     Page No: 285
# Eigen values and eigen vectors of Projection matrix
A<-matrix(c(0.5,0.5,0.5,0.5),ncol=2)
sol<-eigen(A)
lambda<-sol$values
x<-sol$vectors #These are normalised eigen vectors
#to get eigen vectors in text book multiply them with scalars
x[,1]<-x[,1]*(1/x[1,1])
x[,2]<-x[,2]*(1/x[1,2])
print("The eigen values of the matrix are")
print(lambda)
print("The eigen vectors of the matrix are")
print(x)


# Packages used  : pracma
# To install pracma,type following in command line while connected to internet
# install.packages("pracma")
# package can be included by command " library(pracma) "
# for more information about pracma visit https://cran.r-project.org/web/packages/pracma/index.html

# Example : 3.3A   Chapter : 3.3     Page No: 149
# Find the row reduced echelon form, rank and special solution for given matrix

library(pracma)
solution <- function(A){
  R<-rref(A)
  m<-nrow(A)
  n<-ncol(A)
  pivotcol<-c() #vector to store the column numbers of pivot columns
  freecol<-c()  #vector to store the column numbers of free columns
  i<-1
  j<-1

  # to find which columns are pivot and which are free
  while(i<=m & j<=n){
    if(R[i,j]==1){
      pivotcol<-c(pivotcol,j)
      i<-i+1
      j<-j+1
    }
    else{
      j<-j+1
    }
  }
  y<-length(pivotcol)
  freecol<-c(1:n)
  freecol<-freecol[!freecol%in%pivotcol]
  x<-length(freecol)
  N<-c()
  #find the basis for null space based on Row reduced echelon form of given matrix
  if(y==n){
    N<-c()
  }
  else{
  for(i in 1:x){
    temp<-c(1:n)
    for(j in 1:x){
      temp[freecol[j]]<-0
    }
    temp[freecol[i]]<-1
    temp[freecol[i]]
    for(j in 1:y){
      temp[pivotcol[j]]<-R[j,freecol[i]]*-1
    }
    N<-c(N,temp)
  }
  N<-matrix(N,nrow=n,ncol=x)
  }
  print("Row reduced echelon form is")
  print(R)
  print("Rank of the Matrix is")
  print(y)
  print("Special solutions for given matrix are given by")
  print(N)
}

A<-matrix(c(1,-1,0,0,-1,2,-1,0,0,-1,2,-1,0,0,-1,1),nrow=4)
solution(A)


catch=c(3.6,.8,2.5,2.9,1.4,.9,3.2,2.7,2.2,5.9,3.3,2.9,3.6,2.4,.9,2.0,1.9,3.1,2.6,3.4)
residence=c(92.2,86.7,80.2,87.2,64.9,90.1,60.7,50.9,86.1,90.0,80.4,75.0,70.0,64.6,50.0,50.0,51.2,40.1,45.0,50.0)
size=c(.21,.30,.31,.40,.44,.56,.78,1.21,.34,.40,.52,.66,.78,.91,1.10,1.24,1.47,2.21,2.46,2.80)
access=c(0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1)
structures=c(81,26,52,64,40,22,80,60,30,90,74,50,61,40,22,50,37,61,39,53)
relation = lm(catch~residence+size+access+structures)
print(summary(relation))
anova(relation)

# for reduced model
print(" for reduced model")
relation = lm(catch~residence+size)
print(summary(relation))
anova(relation)
# complete linear regression model :  -2.78 + .0268x1 + .504x2 + .743x3 + .0511x4
# reduced model : -.87 + .0394x1 + .828x2
# test statistic
SSregression_complete=24.0624
SSregression_reduced=2.913
Ssresidual_complete=2.2756
n=20
a=(SSregression_complete-SSregression_reduced)/2
b=(Ssresidual_complete)/(n-5)
F=a/b
print(F)
fvalue=qf(1-.01,2,15)
print(fvalue)
#  The value of the test statistic is much larger than the tabled value, so we have conclusive evidence that the access and structure variables add predictive value


##Correlation tests of local instability, island size and degree of NNI graph

##number of areas vs island size
areas <- c(4, 6, 6, 8, 9)
islandSize <- c(18, 72, 90, 216, 486)
areaBySize <- as.data.frame(cbind(areas,islandSize))
cor.test(areaBySize$areas, areaBySize$islandSize, method = "pearson")
#r=0.9053, pval=0.0345

##number of possible topologies vs island size
topol <- c(3^4, 3^6, 3^6, 3^8, 3^9)
islandSize <- c(18, 72, 90, 216, 486)
topolBySize <- as.data.frame(cbind(topol,islandSize))
cor.test(topolBySize$topol, topolBySize$islandSize, method = "pearson")
#r=0.9925, pval=0.0008

##number of areas of instability vs degree
areas <- c(4, 6, 6, 8, 9)
degree <- c(4.33,6.33,6.33,7.67,9.00)
areaByDegree <- as.data.frame(cbind(areas,degree))
cor.test(areaByDegree$areas, areaByDegree$degree, method = "pearson")
#r=0.9936, pval=0.000615

##island size vs degree
islandSize <- c(18, 72, 90, 216, 486)
degree <- c(4.33,6.33,6.33,7.67,9.00)
islandByDegree <- as.data.frame(cbind(islandSize,degree))
cor.test(islandByDegree$islandSize, islandByDegree$degree, method = "pearson")
#r=0.9158, pval=0.02895


# Q.1 -> Q1. The prime factors of 13195 are 5, 7, 13 and 29. What is the largest prime factor of the number?

euler <- function(n) {
  if (n==1) return(NULL)
  if (n==2) return(n)
  l <- 2:n
  i <- 1
  p <- 2
  while (p^2<=n) {
    l <- l[l==p | l%%p!=0]
    i <- i+1
    p <- l[i]
  }
  return(l)
}

prime.factors <- function (n) {
  factors <- c()
  primes <- esieve(floor(sqrt(n)))
  d <- which(n%%primes == 0)
  if (length(d) == 0)
    return(n)
  for (q in primes[d]) {
    while (n%%q == 0) {
      factors <- c(factors, q)
      n <- n/q } }
  if (n > 1) factors <- c(factors, n)
  return(factors)
}

print(max(prime.factors(13195)))


# ......................................................................................
# ...............................Exercise 2 - Probability...............................
#  code presented in this excercise is not required on homeworks or exams, its only to show what is possible in R an to complement the excercise with nice graphs.**
# ......................................................................................

# If text does not display correctly, set File \Reopen with Encoding ... to UTF-8
# Use CTRL + SHIFT + O to display the contents of the script
# Use CTRL + ENTER to run commands on a single line

# In this exercise, we will go through an introduction to probability. We assume you are
# familiar with the terms: **definition of probability, conditional probability, total
# probability theorem, Bayes' theorem**.
#
#  Auxiliary functions ####
#
# * Total probability ####
#
# $P(A)=\sum_{i=1}^{n}P(B_i)P(A|B_i)$
#

# probability calculation P(A) - total probability theorem
total_probability = function(P_B, P_AB)
{   # we consider P_B as a vector of values P(B_i) and P_AB as a vector of values P(A|B_i)
    P_A = 0
    for (i in 1:length(P_B))
    {
        P_A = P_A + P_B[i]*P_AB[i]
    }
    return(P_A)
}

# * Bayes' theorem ####
#
# $P(B_k|A)=\frac{P(B_k)P(A|B_k)}{\sum_{i=1}^{n}P(B_i)P(A|B_i)}$
#

# calculation of conditional probability P(B_k|A) - Bayes' theorem
bayes = function(P_B, P_AB, k)
{   # we consider P_B as a vector of values P(B_i), P_AB as a vector of values P(A|B_i) and k as and index in P(B_k|A)
    P_A = total_probability(P_B, P_AB)
    P_BkA = P_B[k]*P_AB[k]/P_A
    return(P_BkA)
}

# **We will add functions from the last exercise for computing combinatorial selections,
# they are in the combinatorics script.R**
#

source('combinatorics.R')

#  Examples ####
#
# * Example 1. ####
#
# Determine the probability that a number greater than 14 will fall on a 20-wall fair
# dice roll.
#

omega = 1:20
A = c(15,16,17,18,19,20)
# probability as a proportion favorable to all
length(A)/length(omega)

# * Example 2. ####
#
# Determine the probability that a number greater than 14 will fall on a 20-wall dice
# roll, if you know that even numbers fall twice as often as odd numbers.
#

p_odd = 1/(20+10)
p_even = 2*p_odd
probability = c(p_odd, p_even, p_odd, p_even, p_odd, p_even, p_odd, p_even, p_odd, p_even,
                p_odd, p_even, p_odd, p_even, p_odd, p_even, p_odd, p_even, p_odd, p_even)
probability
# probability is
sum(probability[15:20])

# * Example 3. ####
#
# Determine the probability that you will guess exactly 4 numbers in the lottery.(6
# numbers out of 49 are drawn)
#

(combinations(6,4)*combinations(43,2))/combinations(49,6)

# * Example 4. ####
#
# From the alphabetical list of students enrolled in the exercise, the teacher selects
# the first 12 and offers them a bet: “If each of you was born in a different zodiac
# sign, I will give each of you CZK 100. However, if there are at least two students
# among you who were born in the same sign, each of you will give me 100 CZK. ”Is it
# worthwhile for students to accept a bet? How likely are students to win?
#

permutation(12)/r_permutation_repetition(12,12)

# * Example 5. ####
#
# Calculate the probability that an electric current will flow from point 1 to point 2
# if part of the el. circuit, including the probability of failure of individual
# components is indicated in the following figure.(The failures of the individual
# components are independent of each other.) </br>
#  ![Image.png](attachment:image.png)
#

# divided into blocks I=(A, B) and II=(C, D, E)
PI = 1 - (1 - 0.1)*(1 - 0.3)
PI
PII = 0.2*0.3*0.2
PII
# result
(1 - PI)*(1-PII)

# * Example 6. ####
#
# The patient is suspected of having one of four mutually exclusive diseases - N1, N2,
# N3, N4 with a probability of occurrence of P(N1)=0.1; P(N2)=0.2; P(N3)=0.4; P(N4)=0.3.
# Laboratory test A is positive in the case of the first disease in 50% of cases, in the
# second disease in 75% of cases, in the third disease in 15% of cases and in the fourth
# in 20% of cases. What is the probability that the result of the laboratory test will
# be positive?
#

# total probability theorem
P_N = c(0.1,0.2,0.4,0.3) # P(N1), P(N2),...
P_PN = c(0.5,0.75,0.15,0.2) # P(P|N1), P(P|N2),...
P_P = total_probability(P_B = P_N, P_AB = P_PN) # P(P)
P_P

# * Example 7. ####
#
# Telegraphic characters consist of "dot" and "comma" signals. It is statistically found
# that 25% of "dot" messages and 20% of "comma" signals are distorted. It is also known
# that signals are used in a 3: 2 ratio. Determine the probability that the signal was
# received correctly if a "dot" signal was received.
#

# Bayes' theorem
P_O = c(0.6, 0.4)   # P(O.), P(O-)
P_PO = c(0.75, 0.2) # P(P.|O.), P(P.|O-)
bayes(P_B = P_O, P_AB = P_PO, k = 1) # k=1 because correctly=O.

# * Example 8. ####
#
# 85% of green taxis and 15% of blue taxis run in one city. The witness of the traffic
# accident testified that the accident was caused by the driver of the blue taxi, who
# then left. Tests carried out under similar lighting conditions showed that the witness
# identified the color of the taxi well in 80% of cases and was wrong in 20% of cases.
#
# - What is the probability that the culprit of the accident actually drove a blue taxi?
#
# - Subsequently, another independent witness was found who also claims that the taxi
# was blue. What is the probability that the culprit of the accident actually drove a
# blue taxi now?
#
# - Does the probability that the perpetrator of the accident actually drove a blue taxi
# affect whether the two witnesses mentioned above testified gradually or
# simultaneously?
#

# a) again Bayes' theorem
P_B = c(0.85, 0.15)  # P(Z), P(M)
P_SB = c(0.20, 0.80) # P(SM|Z), P(SM|M)
bayes(P_B = P_B, P_AB = P_SB, k = 2) # blue is second

# b) first option - second pass through Bayes
P_M = bayes(P_B = P_B, P_AB = P_SB, k = 2)
P_B = c(1 - P_M, P_M)  # P(Z), P(M)
P_SB = c(0.20, 0.80)   # P(S2M|Z), P(S2M|M)
bayes(P_B = P_B, P_AB = P_SB, k = 2)

# c) or answered at once
P_B = c(0.85, 0.15)      # P(Z), P(M)
P_SB = c(0.20^2, 0.80^2) # P(S1M & S2M|Z), P(S1M & S2M|M)
bayes(P_B = P_B, P_AB = P_SB, k = 2)

# * Example 9. ####
#
# We need to find out the answer to a sensitive question. How to estimate what
# percentage of respondents will answer YES to the question and at the same time
# guarantee complete anonymity to all respondents? One of the solutions is the so-called
# double-anonymous survey:
#
# We will let the respondents throw the coin A and the coin B.
# - Those who got head on coin A will write the answer(YES/NO) to the sensitive question
# on teir card.
# - Those who got tail on coin A will write YES = if coin B landed on head or NO = if
# coin B landed on tail.
#
# How do we determine the proportion of students who answered YES to a sensitive
# question?
#
# Assume that respondents were asked if they were cheating on an exam. From the
# questionnaires, it was found that 120 respondents answered "YES" and 200 respondents
# answered "NO". What percentage of students cheated at the exam?
#

# total probability theorem
# P(YES)=P(A_YES) * P(YES|A_YES) + P(A_NO) * P(B_YES|A_NO)
# equation 120/320=0.5 * x + 0.5 * 0.5
(120/320-0.5^2)/0.5

# * Bonus - Monty Hall Problem ####
#
# You are winner of the TV competition. You are presented with three doors. Behind one
# is the crown prize and behind twe there is nothing. You have to pick one door. Then
# the moderator opens one of the two doors left (the ones you did not pick) and the
# doors without a prize (as the moderator knows where the prize is, he will always pick
# empty doors).
#
# Now the Question, will you stick with your original choice of the door, or you will
# switch to the other one still not opened?


MiniBatchGradientDescent <- function(X, Y, alpha=0.1, max.iter=1000, precision=0.0001, batchRate=0.5, seed=1){
  if (is.null(n <- nrow(X))) stop("'X' must be a matrix")

  if(n == 0L) stop("0 (non-NA) cases")

  p <- ncol(X)

  if(p == 0L) {
    return(list(
      x = X,
      y = Y,
      coefficients = numeric(),
      residuals = Y,
      fitted.values = 0 * Y
    ))
  }

  if(NROW(Y) != n) {
    stop("incompatible dimensions")
  }

  # Initial value of coefficients
  B <- rep(0, ncol(X))
  # batch size
  batchSize <- ceiling(n * batchRate)
  # Recorded for loss vs iteration
  loss_iter <- data.frame(
    loss = numeric(),
    iter = integer()
  )
  for(iter in 1:max.iter){
    B.prev <- B

    for(i in seq(1, n, batchSize)){
      indexes <- i:min((i+batchSize), n)
      Xtemp <- X[indexes,,drop=FALSE]
      Ytemp <- Y[indexes,drop=FALSE]

      yhat <- Xtemp %*% B
      B <- B + (alpha / length(indexes)) * t(Xtemp) %*% (Ytemp - yhat)
    }

    loss <- Y - X %*% B
    loss_iter <- rbind(loss_iter, c(sqrt(mean(loss^2)), iter))

    if(any(is.na(B)) ||
       !any(abs(B.prev - B) > precision * B)){
      break
    }
  }

  names(B) <- colnames(X)
  fv <- X %*% B
  rs <- Y - fv
  coef <- as.vector(B)
  names(coef) <- rownames(B)
  colnames(loss_iter) <- c('loss', 'iter')

  z <- structure(list(
    x=X,
    y=Y,
    coefficients = coef,
    fitted.values = fv,
    residuals = rs,
    loss_iter = loss_iter
  ),
  class = c("rlm", "rlmmodel"))

  z
}


## Zernike coefficients for a conic

zconic <- function(D, rc, b = -1, lambda = 632.8, nmax = 6) {
    if ((nmax %%2) != 0) stop("nmax must be even")
    nterms <- nmax/2+1
    sa <- zc <- zs <- numeric(0)
    cz <- matrix(0, nterms, nterms)

    sd <- D/2
    na <- (sd/rc)^2
    sa[1] <- sa[2] <- 0
## 4th order conic term
    zs[3] <- (sd/rc)^3*sd*1e6/8/lambda
    zc[3] <- (1+b)*zs[3]
    sa[3] <- zc[3]-zs[3]
## binomial expansion of conic
    if (nterms >= 4) {
        for (k in 4:nterms) {
            mult <- (1-3/(2*(k-1)))*na
            zc[k] <- mult*(1+b)*zc[k-1]
            zs[k] <- mult*zs[k-1]
            sa[k] <- zc[k]-zs[k]
        }
    }
## recurrence relation for coefficients of radial zernikes
    cz[1,] <- (-1)^(0:(nterms-1))
    cz[2,2] <- 2
    for (j in 3:nterms) {
        for (i in 2:j) {
            n <- 2*(j-1)
            cz[i, j] <- (4*(n-1)*cz[i-1, j-1]-2*(n-1)*cz[i,j-1]-(n-2)*cz[i,j-2])/n
        }
    }
    for (j in 1:nterms) {
        n <- 2*(j-1)
        cz[,j] <- cz[,j]*sqrt(n+1)
    }
    solve(cz,sa)[-(1:2)]
}

## Zernike coefficients of Wavefront error due to testing a conic at center of curvature
## this should be more accurate for numerical nulling than twice the height difference as in zconic

sconic <- function(D, rc, b = -1, eps = 0., lambda = 632.8, nmax = 6) {

    if ((nmax %%2) != 0) stop("nmax must be even")
    nz <- (nmax-2)/2
    zc <- numeric(nz)

    na <- D/2/rc
    p <- function(rho, na, b) {
        (rho*na)^2*(1 - 2/(1 + sqrt(1 - (1+b)*(rho*na)^2)) +
        (rho*na)^2/(1 + sqrt(1 - (1+b)*(rho*na)^2))^2)
    }
    q <- function(rho, na, b) 1 - sqrt(1 + p(rho, na, b))
    f <- function(rho, na, b, n) q(rho, na, b)*rzernike(sqrt((rho^2-eps^2)/(1-eps^2)), n, 0)*rho
    for (i in 1:nz) {
        n <- 2 + 2*i
        int <- integrate(f, lower=eps, upper=1, na=na, b=b, n=n)
        zc[i] <- 4 * rc * sqrt(n+1) * int$value * 1.e6/lambda/(1-eps^2)
        if (int$message != "OK") warning("coefficient may be inaccurate")
    }
    zc
}

## returns cosine and sine components of Bath astigmatism

##
# D = diameter
# rc = radius of curvature
# s = beam separation
# lambda = source wavelength
# phi = angle from horizontal (degrees)
##

astig.bath <- function(D, rc, s, lambda=632.8, phi=0) {
    astig.tot <- D^2 * s^2/(32 * sqrt(6) * lambda* 1.e-6 * rc^3)
    astig.tot*c(cos(pi*phi/90), sin(pi*phi/90))
}


# Imitate Poisson process built on the exponential random variables and plot its trajectories

library(ggplot2)

Poisson <- function(seed_n, seed_rate)
{
  # function to generate values of the Poisson process contructed on exponential random variables
  return(c(0,cumsum(rexp(n = seed_n, rate = seed_rate))))
}

DrawTrajectory <- function(numInst,
                           timeline,
                           N,
                           inRate)
{
  # function drawing <numInst> trajectories of the Poisson process over <timeline>
  # <N> and <inRate> used to generate Poisson process instances within function

  plot <- ggplot() + ggtitle("Trajectories of Poisson process") + labs(x = 't', y = 'N(t)')
  for(i in 1:numInst)
  {
    plot <- plot + geom_path(aes(x = T, y = Poisson(N, inRate)))
  }
  plot
}

## input parameters
lambda <- 1.0
tMax <- 10 * lambda
num <- tMax
T <- 0:10
# call example
DrawTrajectory(10, T, num, lambda)


### 5.2-1

p <- 0.29
nSamples <- 83
pHat <- 17

z <- (pHat - p*nSamples) / (sqrt(nSamples * p * (1 - p)))
print(z)

### 1 - alpha / 2 = 1 - 0.025 = 0.975
zCrit <- qnorm(0.975, mean=0, sd=1, lower.tail = TRUE, log.p = FALSE)
print(zCrit)

### z = -1.710221  ->  H0 is accepted (mu = 29%)


# N Queens Problem : Place N Queens on an N * N board so that no two queens attack each other.
# The board is represented by a nested list. An empty square is represented by 0, a queen is represented by 1.
nqueens {
    *board = list(
                  list(0,0,0,0,0,0,0,0),
                  list(0,0,0,0,0,0,0,0),
                  list(0,0,0,0,0,0,0,0),
                  list(0,0,0,0,0,0,0,0),
                  list(0,0,0,0,0,0,0,0),
                  list(0,0,0,0,0,0,0,0),
                  list(0,0,0,0,0,0,0,0),
                  list(0,0,0,0,0,0,0,0)
             );
    tryRow(*board, 0);
}

# Try to place a queen on row *a
tryRow(*board, *a) {
    on(*a == size(*board)) {
        printBoard(*board);
    }
    or {
        trySquare(*board, *a, 0);
    }
}

# Try to place a queen at square (*a, *b)
trySquare(*board, *a, *b) {
    or {
    	accept(*board,*a,*b);
    	tryRow(updateBoard(*board, *a, *b, 1), *a+1);
    }
    on(*b+1 < size(elem(*board, *a))) {
	    trySquare(*board, *a, *b+1);
    }
}

# Test if placing a queen at square (*a, *b) is acceptable.
# Placing a queens at square (*a, *b) is acceptable if it does not attack any queen on the board.
accept(*board, *a, *b) {
    for(*i=0;*i<size(*board);*i=*i+1) {
        if(elem(elem(*board,*i),*b)==1) {
            fail;
        }
    }
    for(*i=0;*i<size(*board);*i=*i+1) {
        *j=*b-*a+*i;
        if(0<=*j && *j<size(elem(*board,*i))){
            if(elem(elem(*board,*i),*j)==1) {
                fail;
            }
        }
        *j=*b+*a-*i;
        if(0<=*j && *j<size(elem(*board,*i))){
            if(elem(elem(*board,*i),*j)==1) {
                fail;
            }
        }
    }
}

# Return a new board that is the same as *board except that square (*a, *b) is *elem
updateBoard(*board, *a, *b, *elem) = setelem(*board, *a, setelem(elem(*board, *a), *b, *elem));

# Output *board
printBoard(*board) {
    *str = "";
    for(*i=0;*i<size(*board);*i=*i+1) {
	    *row = elem(*board, *i);
        for(*j=0;*j<size(*row);*j=*j+1) {
            *str = *str ++ str(elem(*row, *j)) ++ " ";
        }
        *str = *str ++ "\n";
    }
    writeLine("stdout", *str);
}

input null
output ruleExecOut


n1= 33
n2= 12
y1bar = 25.2
y2bar=33.9
s1=8.6
s2=17.4

t=(y1bar-y2bar)/(sqrt((s1*s1/n1)+(s2*s2/n2)))
print(t)
# To compute the rejection and p-value, we need to compute the approximate df
c=((s1*s1)/n1)/(((s1*s1)/n1)+((s2*s2)/n2))
print(c)
df=((n1-1)*(n2-1))/((1-c)^2*(n1-1)+(c*c)*(n2-1))
print(df)
# crtitical value
alpha= 0.05

t.alpha=qt(0.05, df=13)
if(t<=t.alpha){
  print(" We will reject H0")
}else{
  print("we fail to reject H0 (no significant evidence")
}


# recursive
recfibo <- function(n) {
  if ( n < 2 ) n
  else Recall(n-1) + Recall(n-2)
}

# print the first 21 elements
print.table(lapply(0:20, recfibo))

# iterative
iterfibo <- function(n) {
  if ( n < 2 )
    n
  else {
    f <- c(0, 1)
    for (i in 2:n) {
      t <- f[2]
      f[2] <- sum(f)
      f[1] <- t
    }
    f[2]
  }
}

print.table(lapply(0:20, iterfibo))

# iterative but looping replaced by map-reduce'ing
funcfibo <- function(n) {
  if (n < 2)
    n
  else {
    generator <- function(f, ...) {
      c(f[2], sum(f))
    }
    Reduce(generator, 2:n, c(0,1))[2]
  }
}

print.table(lapply(0:20, funcfibo))


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

rm(list = ls())

s <- c(0.464, 0.137, 2.455, -0.323, -0.068, 0.906, -0.513, -0.525, 0.595, 0.881,
      -0.482, 1.678, -0.057, -1.229, -0.486, -1.787, -0.261, 1.237, 1.046)

(n <- length(s))
# 19

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

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

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

### H0: X symmetric
### H1: X not symmetric

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

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

wilcox.test(s, alternative = "two.sided")
# Wilcoxon signed rank test
#
# data:  s
# V = 111, p-value = 0.5412
# alternative hypothesis: true location is not equal to 0


### 主成分分析の例
### - Lawyers' Ratings of State Judges in the US Superior Court

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

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

## データの内容を確認
help(USJudgeRatings)  # 内容の詳細を表示
## print(USJudgeRatings) # 全データの表示
head(USJudgeRatings)  # 最初の6個を表示
tail(USJudgeRatings)  # 最後の6個を表示

## データの散布図 (一部項目のみ): 図(a)
ggpairs(USJudgeRatings, columns=1:6) +
    ggtitle("Ratings of US Judges")

## 各データの視覚化 (radar chart)
jdgs <- sapply(rownames(USJudgeRatings), # 姓だけ取り出す
               function(x){unlist(strsplit(x,","))[1]})
mydata <- mutate(USJudgeRatings, jdgs) %>%
    head(12) %>% melt(id.vars="jdgs") # 最初の12名のみ表示
## 各データの表示 (一部データのみ): 図(b)
ggplot(mydata, aes(x=variable, y=value, group=jdgs)) +
    geom_polygon(fill="lightgreen") + coord_polar() +
    facet_wrap(~jdgs)

## 主成分分析
model <- prcomp(~ ., data=USJudgeRatings)

## 結果の評価
summary(model) # 寄与率の表示
round(model$rotation,3) # 主成分方向の表示(3桁)

## 寄与率: 図(c)
plot(model, col="lightblue",
     main="Proportion of Variance") # 寄与率
## biplotによる表示
## 主成分得点 (第1,2主成分): 図(d)
autoplot(model, data=USJudgeRatings, colour="gray",
         label=TRUE, label.size=3, label.colour="darkgreen",
         loadings=TRUE, loadings.colour="blue",
         loadings.label=TRUE, loadings.label.size=5,
         loadings.label.colour="blue",
         main="PCA of US Judge Ratings")
## 主成分得点 (第2,3主成分): 図(e)
autoplot(model, x=2, y=3, data=USJudgeRatings, colour="gray",
         label=TRUE, label.size=3, label.colour="darkgreen",
         loadings=TRUE, loadings.colour="blue",
         loadings.label=TRUE, loadings.label.size=5,
         loadings.label.colour="blue",
         main="PCA of US Judge Ratings")

## 主成分得点の散布図: 図(f)
ggpairs(model$x, columns=1:6) +
    ggtitle("Scatterplot of PCA result")
## (無相関になっていることを確認)


# a script to estimate the value of pi using the Monte Carlo calculation

set.seed(0.537916728589)

# random vectors of length 100k
x=runif(100000)
y=runif(100000)

# radius
z=sqrt(x^2+y^2)

# count the number of points inside the quarter-circle
which(z<1)
length(which(z<=1))*4/length(z)

# make some plots
plot(x[which(z<=1)],y[which(z<=1)],xlab="X",ylab="Y",main="Monte Carlo sim")
points(x[which(z>1)],y[which(z>1)],col='yellow')


# reminder on descriptive statistics
{r}
data(iris)
X = iris$Sepal.Length
# we use famous iris dataset that is built in R
hist(X)
# lets see how histogram changes based on breaks specified
hist(X, breaks=100)
#it's also interesting to combine hist with an estimation of the
#pdf function made by density
hist(X, freq=FALSE)
lines(density(X),col=2, lwd=2)

boxplot(X) #let's now use boxplots
#to relate boxplot with hist:
par(mfrow=c(2,1))
hist(X, freq=FALSE)
lines(density(X),col=2, lwd=2)
boxplot(X, horizontal = TRUE)

#regarding multivariate data it's possible to perform boxplot
boxplot(iris[,-5])
#it's possible for iris data to plot several boxplots side by side
#because 4 variables are all expressed in the same units (cm)

#the alternative will be a for loop
par(mfrow=c(2,2))
for (j in 1:4) boxplot(iris[,j], main=paste('variable',j))

#about scatterplots:
plot(iris[,-5])

cor(iris[,-5]) #correlation matrix

#it is possible to add to this plot an additional category
#called variable(here the species)
plot(iris[,-5], col=as.numeric(iris$Species))

# of course, it is possible to have a classical scatter plot
#when looking only at 2 variables
plot(iris$Sepal.Length, iris$Petal.Length, col=as.numeric(iris$Species))

# Multivariate numerical indicators

mu = colMeans(iris[,-5])  #colMeans computes mean of each column of the dataset
mu

#mean() function computes mean of all data, NA for multiviriable

#Covariance and correlation metrices:

S = cov(iris[,-5])
S

C = cor(iris[,-5])
C

#it's easier to read correlation matrix where -1 -> inverse-relation
# 0 -> no relation and 1 -> strong relation

#LDA and logistic regression
#lets start again with iris data (as Fisher used it himself)
data(iris)
library(MASS)

X = iris[,-5]
Y = as.numeric(iris$Species)

library(MASS)
system.time(f <- lda(X,Y))

#after learning it's possible to examine the output
#Call:
lda(X,Y)

#afterwards, if we would like to classify a new observation,
#we have to call the 'predict' function:

xstar = c(6, 2.9, 5, 3) #new observtion

ystar = predict(f, xstar)
ystar #it belongs to class 1 virginica

#let's compute error rate of this model
#first a single split

n = nrow(X)
learn = sample(1:n, 2/3*n)
f <- lda(X[learn,], Y[learn])
ystar = predict(f,X[-learn,])

#compiute the classification error
err = sum(Y[-learn] != ystar$class) / length(ystar$class)
err

# a better version with resampling (boostraping):

n = nrow(X)
err = c()
for (i in 1:10){
  learn = sample(1:n, 2/3*n)
  f <- lda(X[learn,], Y[learn])
  ystar = predict(f,X[-learn,])
  #compute the classification error
  err[i] = sum(Y[-learn] != ystar$class) / length(ystar$class)
}
boxplot(err)


linear.model<-function(beta,covariate){
  # beta: a 2-vector, where the first entry is the intercept
  yout=covariate*beta[2]+beta[1]
  return(yout);
  # Note: this function only works with simple linear regression model
  # How would you generalize it?
}

fit.linear.model<-function(covariate,outcome){
  # I will write down the function for (multiple) linear regression here
  X=cbind(1,covariate);
  beta.fit=solve( t(X)%*%X )%*%t(X)%*%outcome;
  return(beta.fit)
}

sum.of.squares<-function(beta,covariate,outcome){
  yout=linear.model(beta=beta,covariate=covariate);
  res=outcome-yout;
  sos= sum(res^2);
  return(sos)
}

estimate.sigma.sq<-function(beta,covariate,outcome){
  residual.sum.of.squares=sum.of.squares(beta=beta,covariate=covariate,outcome=outcome)
  n=length(outcome)
  sigma.sq.hat=residual.sum.of.squares/(n-2)
  return(sigma.sq.hat)
}

estimate.coef.var<-function(beta,covariate,outcome){
  sigma.sq.hat=estimate.sigma.sq(beta,covariate,outcome)
  var.hat.beta=beta;
  var.hat.beta[2]=sigma.sq.hat/sum(  (covariate-mean(covariate))^2  )
  n=length(outcome)
  var.hat.beta[1]=sigma.sq.hat*sum(covariate^2)/sum((covariate-mean(covariate))^2  )/n
  return( var.hat.beta)
}

estimate.coef.sd<-function(beta,covariate,outcome){
  var.hat.beta=estimate.coef.var(beta,covariate,outcome)
  sd.hat.beta=sqrt(var.hat.beta);
  return(sd.hat.beta)
}

conf.int.quantile<-function(alpha,type,...){
  if(type=="t"){
    out=qt(c(1-alpha/2,alpha/2), ... )
  }else if (type=="normal"){
    out=qnorm(c(1-alpha/2,alpha/2), ... )
  }
  return(out)
}

boot.fit<-function(covariate,outcome){
  n=length(outcome);
  sample_indices = sample(1:n,n,replace=TRUE) # sampling with replacement
  covariate.boot= covariate[sample_indices]; outcome.boot= outcome[sample_indices];

  beta.hat=fit.linear.model(covariate=covariate.boot,outcome=outcome.boot);
  return(t(beta.hat ))
}

conf.int<-function(alpha,type,covariate,outcome,B=1e5){

  beta.hat=fit.linear.model(covariate,outcome);
  beta.sd=estimate.coef.sd(beta=beta.hat,covariate,outcome);
  if(type=='bootstrap'){
    beta.hat.boot=replicate(B,boot.fit(covariate,outcome));
    out=t(apply(beta.hat.boot[1,,],1,quantile,probs=c(alpha/2,1-alpha/2)));
  }else if(type=='t'){
    quants<-conf.int.quantile(alpha,type='t',df=n-2)
    out=beta.hat%*%c(1,1)-beta.sd%*%quants;
  }else{
    quants<-conf.int.quantile(alpha,type='normal')
    out=beta.hat%*%c(1,1)-beta.sd%*%quants;
  }
  colnames(out)=c( paste(round(alpha*50,digits=3),'%'), paste(100-round(alpha*50,digits=3),'%')  )
  return(out)
}

calculate.t<-function(covariate,outcome){
  beta.hat=fit.linear.model(covariate=covariate,outcome=outcome)
  beta.hat.sd=estimate.coef.sd(beta=beta.hat,covariate=covariate,outcome=outcome)
  beta.hat.t = (beta.hat-0)/beta.hat.sd;
  return(beta.hat.t)
}

## Wrap up the above code into one function
calculate.pvalue<-function(covariate,outcome,type){
  beta.hat.t=calculate.t(covariate,outcome);
  if (type=='t'){
    n=length(outcome);
    pval=2*apply(cbind(pt(beta.hat.t,df=n-2),(1-pt(beta.hat.t,df=n-2))),1,min);

  }else if (type=='z'){
    pval=2*apply(cbind(pnorm(-abs(beta.hat.t)),(1-pnorm(abs(beta.hat.t)))),1,min);

  }else if (type == 'bootstrap'){

    beta.hat=fit.linear.model(covariate=covariate,outcome=outcome)
    beta.hat.boot=replicate(1e5,boot.fit(covariate=covariate,outcome=outcome));
    pval=numeric(length(beta.hat));
    for(i in 1:length(beta.hat)){
      boot.est=beta.hat.boot[1,i,]
      pval[i]=2*min( mean(0<boot.est), mean(0>boot.est) )
    }
  }
  return(pval)
}

permutation.test<-function(covariate,outcome){
  n=length(outcome);
  sample_indices = sample(1:n,n,replace=FALSE) # sampling without replacement
  covariate.perm= covariate[sample_indices]; outcome.perm= outcome;

  beta.hat.t=calculate.t(covariate.perm,outcome.perm)

  return(beta.hat.t[2])
}