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


# Print correlation matrix with corrplot in R

# delete workspace
remove(list = ls())
# clear console window in rstudio
cat("\014")

# 1. install and load the packages
if (!require(quantmod)) install.packages('quantmod')
library('quantmod')

if (!require(corrplot)) install.packages('corrplot')
library(corrplot)

if (!require(RColorBrewer)) install.packages('RColorBrewer')
library(RColorBrewer)

# 2. params
# Pay attention currencys and stock do not trade always at the same day
STARTDATE = '2018-01-05'
WATCHLIST = c('MMM','AXP','AAPL','BA','CAT','CVX','CSCO','KO','DIS','DWDP','XOM','GE','GS','HD','IBM','INTC','JNJ','MCD','MRK','MSFT','NKE','PFE','PG','TRV','UTX','UNH','VZ','V','WMT')

# 3. get data
ALLSYMBOLS = getSymbols(WATCHLIST, from=STARTDATE)

# merge daily return to a matrix
# Stocks = lapply(WATCHLIST, function(sym) {
#   dailyReturn(na.omit(getSymbols(sym, from=STARTDATE, auto.assign=FALSE)))
# })
# stocks <- do.call(merge, Stocks)

# 4. merge the data to a close price matrix
ClosePrices <- do.call(merge, lapply(WATCHLIST, function(x) Cl(get(x))))
head(ClosePrices)

# 5. quick exploration of quantmod charting capabilities
# chartSeries(AMZN, TA = c(addSMA(50),addVo(),addBBands()), subset='2016-07::2018-03')

# 6. take a quick look at what the data looks like
# head(AMZN)

# 7. merge data we want into new object, cast as data.frame
# stocks = as.data.frame(merge(FB$FB.Close, AMZN$AMZN.Close,NFLX$NFLX.Close, GOOG$GOOG.Close, GE$GE.Close, XOM$XOM.Close, USD_EUR$USD.EUR))
# stocks = as.data.frame(merge(V$V.Close , FB$FB.Close, AMZN$AMZN.Close,NFLX$NFLX.Close, GOOG$GOOG.Close, GE$GE.Close, XOM$XOM.Close, CAT$CAT.Close, NKE$NKE.Close, MMM$MMM.Close, MCD$MCD.Close, HD$HD.Close, DIS$DIS.Close))

# 8. see what we have
# head(stocks)

# 9. change column names
# names(stocks) = c('FB', 'AMZN', 'NFLX', 'GOOG', 'GE', 'XOM', 'USDEUR')
# names(stocks) = c('FB', 'AMZN', 'NFLX', 'GOOG', 'GE', 'XOM')
names(ClosePrices) = WATCHLIST;

# 10. store daily returns in new dataframe
# quantmod also has a function periodReturn(stock, period='daily, monthly, etc.') and allReturns()
stocks_returns = data.frame(diff(as.matrix(log(ClosePrices))))

# 11. check transformed data
# head(stocks_returns)

# 12. get correlations
cor(stocks_returns)

# 13. plot scatter matrix, top row second col x = fb, second row first col x = amzn, etc
plot(stocks_returns)

# 14.make a coorelation
m <- cor(stocks_returns)
#corrplot.mixed(m, order = "hclust", addrect = 2, tl.col = "black", tl.srt = 45)
#corrplot.mixed(m)

# 16 plot it
# http://www.sthda.com/english/wiki/visualize-correlation-matrix-using-correlogram
col <- colorRampPalette(c("#BB4444", "#EE9988", "#FFFFFF", "#77AADD", "#4477AA"))
corrplot(m, method="color", col=col(200),
         type="upper", order="hclust",
         addCoef.col = "black", # Add coefficient of correlation
         tl.col="black", tl.srt=45, #Text label color and rotation
         # Combine with significance
         p.mat = p.mat, sig.level = 0.01, insig = "blank",
         # hide correlation coefficient on the principal diagonal
         diag=FALSE
         )

 corrplot(m, type="upper", order="hclust",
 col=brewer.pal(n=8, name="RdYlBu"))

# Computing the p-value of correlations
# mat : is a matrix of data
# ... : further arguments to pass to the native R cor.test function
cor.mtest <- function(mat, ...) {
    mat <- as.matrix(mat)
    n <- ncol(mat)
    p.mat<- matrix(NA, n, n)
    diag(p.mat) <- 0
    for (i in 1:(n - 1)) {
        for (j in (i + 1):n) {
            tmp <- cor.test(mat[, i], mat[, j], ...)
            p.mat[i, j] <- p.mat[j, i] <- tmp$p.value
        }
    }
  colnames(p.mat) <- rownames(p.mat) <- colnames(mat)
  p.mat
}

# matrix of the p-value of the correlation
p.mat <- cor.mtest(ClosePrices)
head(p.mat[, 1:5])

siglevel = 0.01
M <- cor(ClosePrices)
corrplot(M, type="upper", order="hclust", p.mat = p.mat, sig.level = siglevel, insig = "blank")

col <- colorRampPalette(c("#BB4444", "#EE9988", "#FFFFFF", "#77AADD", "#4477AA"))
corrplot(M, method="color", col=col(200), type="upper", order="hclust",
addCoef.col = "black", # Add coefficient of correlation
tl.col="black", tl.srt=45, #Text label color and rotation
# Combine with significance
p.mat = p.mat, sig.level = siglevel, insig = "blank",
# hide correlation coefficient on the principal diagonal
diag=FALSE
)

corrplot(M, type = "upper", order = "hclust",
         col = brewer.pal(n = 8, name = "RdYlBu"))


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


# Example : 6   Chapter : 6.3     Page No: 321
# Solve Differential equation

# lambda1,lamda2,x1,x2,c,d are computed here.. for remaining details look textbook
A<-matrix(c(1,0,1,2),ncol=2)
lambda<-eigen(A)$values
x<-round(eigen(A)$vectors)
u<-c(2,1)
c<-solve(x,u)
print("Lambda 1 and Lambda 2")
print(lambda)
print("x1 and x2")
print(x)
print("c1 and c2 are")
print(c)
#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


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


#Installing the package
#install.packages("ggplot2")
library(ggplot2)

# We will be using the diamonds dataset (which is part of ggplot2 package)

#Let us look at the dataset:
head(diamonds)

#***************************************
#********* Grammer of Graphics *********
#***************************************

#The syntax for the ggplot:

#Step 1: Specify the data:

ggplot(diamonds) #At this point we have the empty plot:

#Step 2:Add the geometries

#ggplot(diamonds ) +
#  geom_point()

#Step 3:Add the aesthetics to the geometries:

ggplot(diamonds ) +
  geom_point(aes(x= carat , y= price , color=cut , alpha=.25) )

## Alpha- for transparency

#***************************************
#***** Geometries and Aesthetics  ******
#***************************************

# Simple Scatter Plot:

p <- ggplot(mtcars, aes(wt, mpg))
p + geom_point()

# Add aesthetic mappings
p + geom_point(aes(colour = factor(cyl)))
p + geom_point(aes(shape = factor(cyl) , colour = factor(cyl) ))
# A "bubblechart":
p + geom_point(aes(size = wt))

# Histograms:

ggplot(diamonds, aes(x=carat)) +
  geom_histogram()

#1. binwidth
ggplot(diamonds, aes(carat)) +
  geom_histogram(binwidth = 1)

# no. of the bins:
ggplot(diamonds, aes(carat)) +
  geom_histogram(bins = 200)

# Yet another histogram:
ggplot(diamonds, aes(price, fill = cut)) +
  geom_histogram(binwidth = 500)

# Frequency Plot
ggplot(diamonds, aes(price, colour = cut)) +
  geom_freqpoly(binwidth = 500)

###########   For categorical Data ###########

# geom_bar is designed to make it easy to create bar charts that show
# counts (or sums of weights)
g <- ggplot(mpg, aes(x=class))
g + geom_bar()

# Number of cars in each class:
g + geom_bar(aes(fill = drv))

?geom_bar # See help for more aesthetics

# Flipping the bars:
g + geom_bar(aes(fill = drv)) + coord_flip()
?geom_bar

# Box Plot:

p <- ggplot(mpg, aes(class, hwy))
p + geom_boxplot()
p + geom_boxplot(fill = "white", colour = "#3366FF")

#**********************************************
#****** Beautiying your visualizations ********
#**********************************************

g <- ggplot(midwest, aes(x=area, y=poptotal)) + geom_point() + geom_smooth(method="lm")  # set se=FALSE to turnoff confidence bands
plot(g)
# midwest <- read.csv("http://goo.gl/G1K41K")  # backup data source

#Adjusting the X and Y axis limits

g1 <- g + xlim(c(0, 0.1)) + ylim(c(0, 1000000))

#How to Change the Title and Axis Labels

gg <- g1 + labs(title="Area Vs Population",
          subtitle="From midwest dataset",
          y="Population", x="Area",
          caption="Midwest Demographics")

#Color and Size of Points:
ggplot(midwest, aes(x=area, y=poptotal)) +
  geom_point(color="brown" , size=3) + geom_smooth(method="lm")

#Sellecting the themes
# Adding theme Layer itself.
gg + theme_bw() + labs(subtitle="BW Theme")
gg + theme_classic() + labs(subtitle="Classic Theme")

library(ggthemes)
gg + theme_economist()+scale_colour_economist() # from the ggthemes packages:

#**********************************************
#**********   A short case study! *************
#**********************************************

install.packages("ggalt")
library(ggalt)
options(scipen=999)  # turning off the scientific notation

data("midwest")

theme_set(theme_bw())

# Scatterplot
gg <- ggplot(midwest, aes(x=area, y=poptotal)) +
  geom_point(aes(col=state, size=popdensity)) +
  geom_smooth(method="loess" , se=F) +
  xlim(c(0, 0.1)) +
  ylim(c(0, 300000)) +
  labs(subtitle="Area Vs Population",
       y="Population",
       x="Area",
       title="Scatterplot",
       caption = "Data Source: midwest") +
  geom_encircle(data=midwest_select,
                color="red",
                size=1,
                expand=0.08)

#Let's encircle some points:

install.packages("ggalt")
library(ggalt)

midwest_select <- midwest[midwest$poptotal > 270000 &
                            midwest$poptotal <= 300000 &
                            midwest$area > 0.025 &
                            midwest$area < 0.05, ]

ggplot(midwest, aes(x=area, y=poptotal)) +
  geom_point(aes(col=state, size=popdensity)) +   # draw points
  geom_smooth(method="loess", se=F) +
  xlim(c(0, 0.1)) +
  ylim(c(0, 500000)) +   # draw smoothing line
  geom_encircle(aes(x=area, y=poptotal),
                data=midwest_select,
                color="red",
                size=2,
                expand=0.08) +   # encircle
  labs(subtitle="Area Vs Population",
       y="Population",
       x="Area",
       title="Scatterplot + Encircle",
       caption="Source: midwest")

# Congratulations! You have now learned to create great visualizations!


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

x = c(1, 6, 2)
x

y = c(1, 4, 3)

length(x)

length(y)

x + y

ls()

rm(x, y)
ls()

rm(list = ls())

?matrix

x = matrix(data = c(1, 2, 3, 4), nrow = 2, ncol = 2)
x

x = matrix(c(1 ,2 ,3 ,4), 2, 2)

matrix(c(1, 2, 3, 4), 2, 2, byrow = TRUE)

sqrt(x)

x^2

x = rnorm(50)
y = x + rnorm(50, mean = 50, sd = .1)
cor(x, y)

set.seed(1303)
rnorm(50)

set.seed(3)
y = rnorm(100)
mean(y)

var(y)

sqrt(var(y))

sd(y)

x = rnorm(100)
y = rnorm(100)
plot(x, y)

plot(x, y, xlab="this is the x-axis", ylab = "this is the y-axis", main = "Plot of X vs Y")

pdf("../../../output/Figure.pdf")
plot(x, y, col = "green")
dev.off()

x = seq(1, 10)
x

x = 1:10
x

x = seq(-pi, pi, length = 50)

y = x
f = outer(x, y, function(x, y) cos(y)/(1 + x^2))

contour(x, y, f)

contour(x, y, f, nlevels = 45)

fa = (f - t(f))/2
contour(x, y, fa, nlevels = 15)

image(x, y, fa)

persp(x, y, fa)

persp(x, y, fa, theta = 30)

persp(x, y, fa, theta = 30, phi = 20)

persp(x, y, fa, theta = 30, phi = 70)

persp(x, y, fa, theta = 30, phi = 40)

A = matrix(1:16, 4, 4)
A

A[2, 3]

A[c(1, 3), c(2, 4)]

A[1:3, 2:4]

A[1:2,]

A[, 1:2]

A[1,]

A[-c(1, 3),]

A[-c(1, 3), -c(1, 3, 4)]

dim(A)

Auto = read.table("../../../data/Auto.data")
# fix(Auto) - not workin in Jupyter
head(Auto)

Auto = read.table("../../../data/Auto.data", header = T, na.strings = "?")
head(Auto)

Auto = read.csv("../../../data/Auto.csv", header = T, na.strings = "?")
head(Auto)

dim(Auto)

Auto[1:4,]

Auto = na.omit(Auto)
dim(Auto)

names(Auto)

plot(Auto$cylinders, Auto$mpg)

attach(Auto)
plot(cylinders, mpg)

cylinders = as.factor(cylinders)

plot(cylinders, mpg)

plot(cylinders, mpg, col = "red")

plot(cylinders, mpg, col = "red", varwidth = T)

plot(cylinders, mpg, col = "red", varwidth = T, horizontal = T)

plot(cylinders, mpg, col = "red", varwidth = T, xlab = "cylinders", ylab = "MPG")

hist(mpg)

hist(mpg, col = 2)

hist(mpg, col = 2, breaks = 15)

pairs(Auto)

pairs(~mpg + displacement + horsepower + weight + acceleration, Auto)

plot(horsepower, mpg)

# identify ( horsepower ,mpg , name) - not working in Jupyter

summary(Auto)

summary(mpg)

notebooks/R/2 Statistical Learning/2.3 Lab - Introduction to R.r


### 主成分分析の例
### - 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])
}