#Relation is the relationship between two set of numbers
#It can be represented as ordered pairs
#When we do correlation, we find the relationship between two set of numbers(ie variables)
#The correlation coefficient explains about the relation.
#It gives an idea to expand it as functions

#Functions
# A function is a set of ordered pairs in which the first coordinate, usually x, matches with exactly one second coordinate, y.
# the y coordinate represents the dependent variable
# A function can be expressed as an equation -> f(x) = y
# f(x) - f is the name of the function and x is the name of the independent variable.

#Mathematical modeling
# Mathematical modeling involves creating a set of mathematical equations that describes a situation, solving those equations, and using them to understand the real life problem
# Model can also be used to predict what a system will do for different values of the independent variable. Lastly, a model can be used to estimate quantities that are difficult to evaluate exactly
# The goal is not to produce an exact copy of the "real object" but rather to give a representation of some aspect of the real thing.
# Slope - the coefficient of x
# Rate of change - f(b) - f(a) / (b-a)
hotel = linear_tips
cor(hotel$meal_amt, hotel$tips)
plot(hotel$meal_amt, hotel$tips)
model = lm(tips$meal_amt, data=hotel)
model
summary(model)
new = c(20,25)
newx = as.data.frame(meal_amt=new)
newx
newy = predict(model, newx)
newy
sample.read.csv(file.choose(), header=T)
head(sample)
library(SDSFoundations)
linFit(sample$x, sample$y)
linFitPred(sample$x, sample$y, 1)
linFitPred(sample$x, sample$y, 2)
mean(sample$x)
mean(sample$y)

# Exponential model
expFit(sample$x, sample$y)
# R-squared = 1 - (Explained variation) / Total variation
expFitPred(sample$x, sample$y, 1)
#determining the target is known as Extrapolation - given y we need to find x, this is known as extrapolation
# Logistic growth model will be best explainable when the data has reached the upper limit and there after the growth is consistent, logistic growth model can be used
logisticFit(sample$x, sample$y)
logisticFit(sample$x, sample$y, 1)
logisticFit(sample$x, sample$y, 2)
tripleFit(sample$x, sample$y)


library(deSolve)
library(reshape)
library(ggplot2)
library(plotly)

micro_1 <- function(times,init,parms){
  with(as.list(c(parms,init)), {
  # ODEs
  dS <- r*(1-S/K)*S - beta*S*I
  dI <- beta*S*I-(mu + alpha)*I
  list(c(dS,dI))
  })
}

w <- 1
m <- 10
beta <- 0.0247*m*w**0.44
r <- 0.6*w**-0.27
mu <- 0.4*w**-0.26
K <- 16.2*w**-0.7
alpha <- (m-1)*mu

parms <- c(beta=beta,r=r,mu=mu,K=K,alpha=alpha)
init <- c(S=K,I=1.)
times = seq(0,10,length.out=101)

sir_out <- lsoda(init,times,micro_1,parms)

sir_out_long <- melt(as.data.frame(sir_out),"time")

# Plot
p <- plot_ly(data = sir_out_long, x = ~time[variable=="S"], y = ~value[variable=="S"],type = "scatter", mode = "lines",name = "S(t)") %>%
add_trace(y = ~value[variable=="I"],type = "scatter", mode = "lines",name = "I(t)") %>%
layout(xaxis = list(title="Time"), yaxis = list(title="Number"))
p

m <- c(5,10,20,40)
ws <- 10^seq(-3,3,length.out=601)
betas <- data.frame("ws"=ws, "m5"=0.0247*m[1]*ws^0.44,"m10"=0.0247*m[2]*ws^0.44,"m20"=0.0247*m[3]*ws^0.44,"m40"=0.0247*m[4]*ws^0.44)

# Plot
p <- plot_ly(betas,x=~ws,y=~m5,type = "scatter", mode = "lines",name = "m = 5") %>%
add_trace(y = ~m10,type = "scatter", mode = "lines",name = "m = 10") %>%
add_trace(y = ~m20,type = "scatter", mode = "lines",name = "m = 20") %>%
add_trace(y = ~m40,type = "scatter", mode = "lines",name = "m = 40") %>%
layout(xaxis = list(title="Weight",type = "log"), yaxis = list(title="beta_min",type = "log"))
p


## Author: Sergio García Prado
## Title: Exercises with Solutions 5

rm(list = ls())

Q <- matrix(c(-20,  20,   0,   0,
               10, -30,   0,  20,
                5,   0, -25,  20,
                0,   5,  10, -15),
            4, 4, byrow = TRUE)

(A <- cbind(Q[, 1:(nrow(Q) - 1)], rep(1, nrow(Q))))
# -20	 20	  0	1
#  10	-30	  0	1
#   5	  0	-25	1
#   0	  5	 10	1

(stationary <- solve(A)[nrow(A), ])
# 0.135802469135802 0.172839506172839 0.197530864197531 0.493827160493827

stationary[2] + (5 / (10 + 5)) * stationary[4]
# 0.337448559670782

20 * (1 - stationary[4])
# 10.1234567901235


# Function definitions for the inverse-gamma probability distribution.
# The parameters of the distribution (alpha, beta) are as defined here:
# https://en.wikipedia.org/wiki/Inverse-gamma_distribution

pinvgamma <- function(x, alpha, beta) {
    # The cdf of the inverse-gamma distribution.
    return(1 - pgamma(1/x, shape=alpha, rate=beta));
}

qinvgamma <- function(p, alpha, beta) {
    # The quantile function of the inverse-gamma distribution.
    return(1 / qgamma(1 - p, shape=alpha, rate=beta));
}

dinvgamma <- function(x, alpha, beta) {
    # The pdf of the inverse-gamma distribution.
    if (alpha <= 0 | beta <= 0) {
        stop("Shape or scale parameter negative in dinvgamma().\n");
    }
    log_density <- alpha * log(beta) - lgamma(alpha) - (alpha + 1) * log(x) - (beta / x);
    return(exp(log_density));
}

rinvgamma <- function(n, alpha, beta) {
    # Draw n samples from the inverse-gamma distribution.
    return(1 / rgamma(n=n, shape=alpha, rate=beta));
}


# This file contains R code for the Cmax estimator used as an example in section 3.
# Although not designed to be the most efficient R program, it is simply here to
# assist students in writing their own functions by illustrating several useful concepts.

# Function to calculate the statistic
Cmax=function(song){
# song is a vector of 0's and 1's that represents the hits (0) and
# misses (1) of the notes in order

  n = length(song)  # determine the number of notes in the song

  c_temp=0  # this is a temporary counter which tallies the strings of misses

  c_max=0   # this holds the current length of the longest streak of misses

  for(i in 1:n){  # set up a for loop to scan through entire song
    if(song[i]==1){  # use this section only if a miss on note i
      c_temp=c_temp+1   # increase miss streak by 1
      if(c_temp>c_max) c_max=c_temp  # check if new streak is longer than current max
    }
    if(song[i]==0){  # use this section only if a hit on note i
      c_temp=0       # reset current streak of misses
    }
  }

  return(c_max)  # returns the maximum consecutive number of misses
}

# Hypothesis test based on the Cmax method
Cmax_test = function(song,B=1000){
    # song is a vector of 0's and 1's that represents the hits (0)
	# and misses (1) of the notes in order
	# B is the number of new samples to generate

	test_stat = Cmax(song)
	n = length(song)
	tstar_b = numeric(B)
	for(b in 1:B){
		song_tmp = sample(song)  # for permutation test
#		song_tmp = sample(song,replace=T) # for non-parametric bootstrap
#		song_tmp = rbinom(n,1,mean(song)) # for parametric bootstrap
		tstar_b[b] = Cmax(song_tmp)
	}

	# calculate the two-sided p-value from the sampling distribution
	pval = 2*min(sum(tstar_b >= test_stat),sum(tstar_b <= test_stat))/B

	# calculate a one sided p-value
#	pval = sum(tstar_b >= test_stat)/B

	return(pval)
}

# Examples using Songs A and B from Table 1

songA = c(1,0,0,0,0,0,1,0,1,0,0,1,0,0,0,0,1,0,0,0)
Cmax(songA)
Cmax_test(songA,5000)

songB = c(0,0,0,1,0,0,0,0,0,0,0,1,1,1,1,0,0)
Cmax(songB)
Cmax_test(songB,5000)


library(Sleuth3)
with(case0202,hist(Unaffected-Affected))
diffs<-case0202$Unaffected-case0202$Affected
diffs<-with(case0202,Unaffected-Affected)
diffs
hist(diffs)
t.test(diffs)
with(case0202,t.test(Unaffected,Affected,paired=TRUE))
with(case0202,t.test(Unaffected,Affected))
sample.mean<-mean(diffs) #Calculate the sample mean of the differences
sample.sd<-sd(diffs)     #Calculate the sample standard deviation
n<-length(diffs)         #Find the sample size

se.mean<-sample.sd/sqrt(n)    #Calculate the standard error of the sample mean.
sample.mean/se.mean

pt(3.228928,14) # Area under the t_14 curve to the left of 3.228928
1-pt(3.228928,14) # Area to the right.
2*(1-pt(3.228928,14)) # Two-sided p-value.

qt(.975,14) # t quantile for 95% confidence interval and 14 df.
sample.mean-qt(.975,14)*se.mean
sample.mean+qt(.975,14)*se.mean

library(ggplot2)
qplot(factor(Year),Depth,data=case0201,geom="boxplot")

t.test(Depth~Year,data=case0201,var.equal=TRUE)
t.test(Depth~Year,data=case0201,var.equal=TRUE,alternative="less")


# Compare means with Kruskal-Wallis test (nonparametric, because non-normal distribution)

data <- read.csv('../../results/client_algos/data_all.csv', sep = ';')

# Means
aggregate(data$time, list(data$combination), median)
# None: 1492.0
# Triple: 1588.5
# BGPSimple: 745.0
# BGPCombined: 736.0
# TripleBGP: 658.5

#boxplot(time ~ combination, data = data, ylab="Exec (ms)", xlab="Combination")

# H0: None == Triple
kruskal.test(time ~ combination, data = data[which(data$combination=='combination_0' | data$combination=='combination_1'),])
# p: 0.9318
# => Accept H0, equal means => None == Triple

# H0: None == BGPSimple
kruskal.test(time ~ combination, data = data[which(data$combination=='combination_0' | data$combination=='combination_2'),])
# p: 0.006231
# => Accept H0, non-equal means => None > BGPSimple

# H0: None == BGPCombined
kruskal.test(time ~ combination, data = data[which(data$combination=='combination_0' | data$combination=='combination_3'),])
# p: 0.002631
# => Reject H0, non-equal means => None > BGPCombined

# H0: Triple == BGPSimple
kruskal.test(time ~ combination, data = data[which(data$combination=='combination_1' | data$combination=='combination_2'),])
# p: 0.009066
# => Accept H0, non-equal means => Triple > BGPSimple

# H0: Triple == BGPCombined
kruskal.test(time ~ combination, data = data[which(data$combination=='combination_1' | data$combination=='combination_3'),])
# p: 0.004172
# => Reject H0, non-equal means => Triple > BGPCombined

# H0: None == TripleBGP
kruskal.test(time ~ combination, data = data[which(data$combination=='combination_0' | data$combination=='combination_4'),])
# p: 0.00234
# => Reject H0, non-equal means => None > TripleBGP

# H0: Triple == TripleBGP
kruskal.test(time ~ combination, data = data[which(data$combination=='combination_1' | data$combination=='combination_4'),])
# p: 0.003434
# => Reject H0, non-equal means => Triple > TripleBGP

# H0: BGPSimple == TripleBGP
kruskal.test(time ~ combination, data = data[which(data$combination=='combination_2' | data$combination=='combination_4'),])
# p: 0.5758
# => Accept H0, equal means => BGPSimple == TripleBGP

# H0: BGPCombined == TripleBGP
kruskal.test(time ~ combination, data = data[which(data$combination=='combination_3' | data$combination=='combination_4'),])
# p: 0.9484
# => Accept H0, equal means => BGPCombined == TripleBGP

# H0: BGPCombined == BGPSimple
kruskal.test(time ~ combination, data = data[which(data$combination=='combination_3' | data$combination=='combination_2'),])
# p: 0.6689
# => Accept H0, equal means => BGPCombined == BGPSimple


# 04. 정규분포

# 정규분포 : 평균과 분산으로 표시
# 난수함수: rnorm(n, mean=0, sd=1)
# 확률밀도함수: d~
# 누적분포함수(점수): p~
# 누적분포함수(확률): q~

# 난수함수: rnorm(n, mean=0, sd=1)
x <-rnorm(100,50,20) # 숫자 100개를 무작위로 뽑아라. 그런데 평균이 50이고 표준편차가 20이다. 랜덤으로 추출

x # 무작위 추출

x <- sort(x) # 순서대로 정리

x <- round(x,2)

plot(x,
     dnorm(x,50,20),
     type='l', # 선을 연결하는 옵션
     main="정규분포, X~N(50,20)")
abline(v=50, # 평균이 50이니까 보기좋게 선 그린 것
       col="blue",
       lty=2) # 라인 스타일

# 정규분포 누적분포함수(점수)
# pnorm(q, mean=0, sd=1, lower.tail=FALSE)
# 이하 : P(X <= a) lower.tail = TRUE
# 초과: P(X > a) lower.tail = FALSE
# 만약 60점이라면
pnorm(60, mean=50, sd=20, lower.tail=TRUE) # 60점 이하 => 60점이면 아래에 전체의 몇 %가 있는가? 아래료 70%
pnorm(60, mean=50, sd=20, lower.tail=FALSE) # 60점 초과 => 60점을 초과하는 학생은 전체의 몇 % 인가? 상위 몇 %에 속하는가? 30%
abline(v=60, col="red", lty=3)

# 누적분포함수(확률) => 몇 % 일때 점수를 알고 싶다.
# qnorm(p, mean=0, sd=1, lower.tail=FALSE)
# 이하 : P(X <= a) lower.tail = TRUE
# 초과: P(X > a) lower.tail = FALSE
# 상위 35% 안에 들어가려면
qnorm(0.35, mean=50, sd=20, lower.tail=FALSE) # 상위 35%의 점수를 알려주어라. 위에서 부터 재는 것
qnorm(0.35, mean=50, sd=20, lower.tail=TRUE) # 하위 35%의 점수를 알려주어라.
abline(v=57.7, col="green", lty=3)

# 정규분포 그래프
plot(x,
     dnorm(x, 50,20),
     type='l',
     main="정규분포, X~N(50,20)")
abline(v=50, col="blue", lty=3)
abline(v=50+1.96*20, col="red", lty=3) # 신뢰수준 95% 구간에 표시하라.
abline(v=50-1.96*20, col="red", lty=3)

# 표준정규분포 그래프 <- 평균을 0로 하여 그린 그래프
x <- seq(-3, 3, length=200)
plot(x,
     dnorm(x, mean=0, sd=1),
     type='l',
     main="Normal distribution, X~N(0,1)")

# 퀴즈
#대학 경영통계 수업 듣는 학생의 시험점수가 평균 70, 표준편차가 20점이라고 한다.
#상위 35%에 들기 위한 점수는?

qnorm(0.35, 70, 20, lower.tail = FALSE)
qnorm(0.35, mean=70, sd=20, lower.tail=FALSE)

#B이상(80%)에 들기 위한 점수는?7
qnorm(0.2, mean=70, sd=20, lower.tail=TRUE)


library(forecast)
library(ggplot2)
library(plyr)
library(reshape)
library(tseries)
library(TSPred)

setwd("C:/Dhaval/Program Course Work/Time Series Analysis and Forecasting/Project/")

######################## Cleaned Loops for all the Departments

# Reading the Raw Data
raw.train <- function(){
  # Loads the training data with correct classes
  cls <- c('factor', 'factor', 'Date', 'numeric', 'logical')
  train <- read.csv('train.csv',
                    colClasses=cls)
}

# Transposing the data to create a matrix of date by stores for each department
train_tr <- function(raw.train,dept){
  tr.data <- raw.train[raw.train$Dept==dept,c(3,1,4)]
  # Transpose to create a matrix of dates x stores with values populated as weekly sales
  train.processed <- cast(tr.data,Date ~ Store)
  return(train.processed)
}

# Calculating the SVD
preprocess.svd <- function(train,nu.arg = nrow(train),nv.arg = ncol(train)){
  # Filling in missing values with 0 for the SVD function to work
  train[is.na(train)] <- 0

  z <- svd(train[, 2:ncol(train)], nu=nu.arg, nv=nv.arg-1)
  return(z)
}

# Using Arima to do a univariate ts forecast on the reduced train data
forecast.reduced.arima <- function(reduced.train){
  c1 <- ts(reduced.train[,1],frequency = 7)
  c1.forecast <- auto.arima(c1,stepwise = F,approximation = F)
  c1.new <- c1.forecast$fitted
  c1.pred <- forecast(c1.forecast,h = 4)

  c2 <- ts(reduced.train[,2],frequency = 7)
  c2.forecast <- auto.arima(c2,stepwise = F,approximation = F)
  c2.new <- c2.forecast$fitted
  c2.pred <- forecast(c2.forecast,h = 4)

  c3 <- ts(reduced.train[,3],frequency = 7)
  c3.forecast <- auto.arima(c3,stepwise = F,approximation = F)
  c3.new <- c3.forecast$fitted
  c3.pred <- forecast(c3.forecast,h = 4)

  # Re-Creating the forecasted u dot product s
  reduced.train.forecast <- as.matrix(cbind(c1.new,c2.new,c3.new))

  reduced.train.pred <- as.matrix(cbind(summary(c1.pred)[,1],summary(c2.pred)[,1],summary(c3.pred)[,1]))
  return(list(reduced.train.forecast,reduced.train.pred))
  #return(reduced.train.forecast)
}

# Using the 3 components to create the reduced train data to forecast and return the forecasted train and test data
dept.forecast.arima <- function(train.processed){
  svd.result <- preprocess.svd(train.processed)
  S <- diag(svd.result$d,nrow = nrow(train.processed),ncol = ncol(train.processed)-1)
  us <- svd.result$u%*%S
  usvt <- us%*%t(svd.result$v)
  # Considering only the first 3 components since they explain 99% of variance
  reduced.train <- us[,1:3]

  # Running a arima forecast on the 3 columns of the u dot s
  arima.list <- forecast.reduced.arima(reduced.train)

  # THe Training data forecast from the model. A matrix of 3 columns
  reduced.train.forecast <- as.matrix(arima.list[[1]])

  # The forecasted test data for 4 future weeks
  reduced.train.pred <- as.matrix(arima.list[[2]])

  # Recosntructing back the forecasted matrix of weeks by stores - For Train Data
  us.forecast <- as.matrix(cbind(reduced.train.forecast,us[,4:ncol(us)]))
  dept.forecast <- us.forecast%*%t(svd.result$v)

  ### Prediction
  # Recosntructing back the forecasted matrix of weeks by stores - For Test Data
  us.predict <- as.matrix(cbind(reduced.train.pred,us[136:139,4:ncol(us)]))
  dept.pred <- us.predict%*%t(svd.result$v)

  return(list(dept.forecast,dept.pred))
}

# Reading the Raw Data

train.data <- raw.train()
train.data$Store = sprintf("%02d",train.data$Store)
train.data$Dept = sprintf("%02d",train.data$Dept)

################ Forecasting for Department 1

## ARIMA
# Preprocessing the data

train.tran <- train_tr(train.data,dept = "01")

train.processed <- train.tran[1:139,]
test <- train.tran[140:143,]

# Training for Dept 1 Sales
dept.1.list <- dept.forecast.arima(train.processed)
dept.1.forecast <- dept.1.list[[1]]
dept.1.pred <- dept.1.list[[2]]

## SMAPE For Train Data
sMAPE(as.vector(as.matrix(train.processed[,2:ncol(train.processed)])),as.vector(as.matrix(dept.1.forecast)))

## SMAPE for Test Data

sMAPE(as.vector(as.matrix(test[,2:ncol(train.processed)])),as.vector(as.matrix(dept.1.pred)))

######## DEPT 5

train.tran <- train_tr(train.data,dept = "05")

train.processed <- train.tran[1:139,]
test <- train.tran[140:143,]

# Training for Dept 1 Sales
dept.5.list <- dept.forecast.arima(train.processed)
dept.5.forecast <- dept.5.list[[1]]
dept.5.pred <- dept.5.list[[2]]

## SMAPE For Train Data
sMAPE(as.vector(as.matrix(train.processed[,2:ncol(train.processed)])),as.vector(as.matrix(dept.5.forecast)))

## Smape for Test Data
sMAPE(as.vector(as.matrix(test[,2:ncol(test)])),as.vector(as.matrix(dept.5.pred)))

#### The Forecast for each department can be created by looping through each of the departments from the data.


?rbinom
n <- 1000 #number of observations
p <- 0.2 #probability of success

#create random binomial distribution of [0,1,...,7] scores
scores <- rbinom(n, 8, p)

#plotting histogram
hist(scores)

#Unfair coin with P(heads) = 0.65, 10 tosses
#10 trials, exactly 7 heads
dbinom(7, 10, 0.65) #using density function

#10 trials, at most 7 heads
pninom(7, 10, 0.65) #cumulative probs, using distribution function

#10 trials, at least 6 heads
# density 6 heads + density 7 heads + ... + density 10 heads
dbinom(6, 10, 0.65)+dbinom(7, 10, 0.65)+dbinom(8, 10, 0.65)+dbinom(9, 10, 0.65)+dbinom(10, 10, 0.65)
#or cumulative of 10 heads - cumulative 5 heads
pbinom(10, 10, 0.65) - pbinom(5, 10, 0.65)

#Plotting better the previous hist(scores) using densities
library(tidyverse)
df <- as_tibble(data.frame(scores))
df_with_freqs <- df %>%
                 group_by(scores) %>%
                 summarize(n=n()) %>%
                 mutate(freq= n/sum(n))

ggplot(df_with_freqs, aes(x=scores, y=freq)) + geom_col() + ylab("Estimated Density")

#Plotting analytical densities in binominal distribution
binom <- as_tibble(list(x=0:n, prob= dbinom(0:n, n, p)))
ggplot(binom, aes(x=x, y=prob)) + geom_col() + ylab("Analytical Density")

#Computing the cumulative density function using previous probability density function
df_with_cdf <- binom %>%
               mutate(cdf=cumsum(prob))
ggplot(df_with_cdf, aes(x=x, y=cdf)) + geom_step() + ylab("CDF")

#Plotting histogram and density with ggplot
ggplot(binom, aes(x))+
  geom_histogram(data=binom, aes(x, ..density..), fill="white", color="darkred")+
  geom_density(kernel="gaussian", aes(x))


#' @export
#'
#' @title Baysian estimation to binomial proportion using a conjugate
#' prior.
#'
#' @description This routine assumes a beta(a,b) prior for a binomial
#' proportion and computes posterior point and inteval estimates
#' for the proportion given
#' an observed number of 'successes' and number of 'trials'.
#'
#' @param x The number of 'successes' (an integer vector)
#'
#' @param n The number of 'trials' (an integer vector)
#'
#' @param a A vector of shape parameters to specify the beta prior
#'
#' @param b A vector of scale parameters to specify the beta prior
#'
#' @param conf A scalar specifying the desired confidence level
#' of the interval estimate.  This scalar should be between 0.5 and 1.
#'
#' @param ci A character string specifying the type of posterior
#' confidence interval to compute.  A value of 'eq' computes
#' posterior intervals with equal area in both tails.  A value
#' of 'hdi' computes highest density interval estimates.  See Details.
#'
#' @details
#'
#' Computations are elementary because the beta(a,b) prior is
#' conjugate for the binomial. Nearly every text on Bayesian
#' estimation shows that given values for \code{x}, \code{n},
#' \code{a}, and \code{b}, the posterior distribution of p
#' is,
#' \deqn{beta(x+a, n-x+b).}
#' Hence, the Bayes point estimator is,
#' \deqn{phat = (x+a) / (n+a+b),}
#' which is the mean of the posterior. Standard error of the
#' posterior is,
#' \deqn{se.phat=sqrt(a*b/((a+b)^2*(a+b+1))).}
#' If \code{a>1} and \code{b>1}, mode of the posterior for p is,
#' \deqn{(a-1)/(a+b-2).}
#'
#'
#' Confidence intervals can be computed two ways. The default,
#' \code{ci='eq'}, puts \code{(1-conf)/2} probability in the
#' lower tail and \code{(1-conf)/2} in the upper tail.
#' That is, the lower limit is
#' \code{qbeta((1-conf)/2,x+a,n-x+b)} and the upper limit is
#' \code{qbeta(1-(1-conf)/2,x+a,n-x+b)}.  If \code{ci='hdi'},
#' this routine finds the interval [l,u] such that
#' \code{pbeta(u,x+a,n-x+b) - pbeta(l,x+a,n-x+b)} and
#' \code{dbeta(u,x+a,n-x+b) = dbeta(l,x+a,n-x+b)}.
#'
#' The default values for \code{a} and \code{b}
#' imply use of the Jeffery's prior.  The Jeffery's prior is
#' proportional to the root of Fisher's information and
#' is equal to beta(0.5,0.5). A flat prior is beta(1,1).
#'
#' @return A data frame with number of rows equal to
#' \code{max(length(x), length(n), length(a), length(b)}
#' containing the Baysian point and interval estimates.
#' The data frame has the
#' following columns:
#' \enumerate{
#'   \item \code{phat} : the Bayes point estimates equal to the
#'   mean of the posterior distribution.
#'   \item \code{phat.mode} : if \code{a>1} and \code{b>1}, this
#'   column contains the mode of the posterior. If either
#'   \code{a<=1} or \code{b<=1}, the posterior is either multi-modal
#'   or its mode is infinity.  In this case, \code{phat.mode = NA}.
#'   \item \code{se.phat} : the standard
#'   error of the posterior distribution.
#'   \item \code{ll.phat} : the lower limit of a \code{100*(1-(1-conf)/2)}%
#'   posterior confidence interval for \code{phat}. See Details for
#'   interpretation under the allowed values of \code{ci}.
#'   \item \code{ul.phat} : the upper limit of a \code{100*(1-(1-conf)/2)}%
#'   posterior confidence interval for \code{phat}. See Details for
#'   interpretation under the allowed values of \code{ci}.
#' }
#'
#' @author Trent McDonald
#'
#'
#' @seealso \code{\link{agrestiCoullPhat}}
#'
#' @examples
#' bayesPhat(0:5, 100, 0.5, 0.5)  # Jeffery's prior
#' bayesPhat(0:5, 100, 1, 1) # flat prior
#'
#' # When prior data is available:
#' x.prior <- 5
#' n.prior <- 100
#' bayesPhat(0:5, 100, x.prior+0.5, n.prior-x.prior+0.5)
#'
#' # Simulation: point est bias and ci coverage
#' trueP <- 0.01
#' n <- 1000
#' x <- rbinom( 1000, n, trueP)
#' baPhat <- bayesPhat( x, n )
#' muBA <- mean(baPhat$phat)
#' covBA <- mean(baPhat$ll.phat <= trueP & trueP <= baPhat$ul.phat)
#' baStats <- c(mean=muBA,
#'              relBias = abs(muBA-trueP)/trueP),
#'              coverage = covBA)
#'
#'
#'
#'
bayesPhat <- function(x, n, a=0.5, b=0.5, conf=0.9, ci="eq"){
  aPost <- x + a
  bPost <- n - x + b
  phat <- aPost / (aPost + bPost)

  se <- sqrt(aPost*bPost / ((aPost+bPost)^2*(aPost+bPost+1)))

  if((aPost>1) & (bPost>1)){
    phat.mode <- (aPost-1) / (aPost + bPost - 2)
  } else {
    phat.mode <- NA
  }

  ll <- qbeta((1-conf)/2,aPost,bPost)
  ul <- qbeta(1-(1-conf)/2,aPost,bPost)
  if(ci=="hdi"){
      if((aPost>1) & (bPost>1)){
        fl <- function(q, a, b, p){
          (dbeta(q,a,b) - p)^2
        }
        hdi.obj <- function(p, a, b, conf, phat.mode){
          q1 <- optim(par=phat.mode/2,fn=fl,a=a, b=b, p=p,
                      method="Brent",lower=0, upper = phat.mode)$par
          q2 <- optim(par=(1+phat.mode)/2,fn=fl,a=a, b=b, p=p,
                      method="Brent",lower=phat.mode, upper = 1)$par
          hdi.prob <- pbeta(q2,a,b) - pbeta(q1,a,b)
          (hdi.prob - conf)^2
        }
        fp <- optim(par=dbeta(phat.mode,aPost,bPost)/2, fn=hdi.obj,
                    a=aPost, b=bPost, conf=conf, phat.mode=phat.mode,
                    method="Brent", lower=1e-10,
                    upper=dbeta(phat.mode,aPost,bPost))$par
        ll <- optim(par=ll,fn=fl,a=aPost, b=bPost, p=fp,
                    method="Brent",lower=0, upper = phat.mode)$par
        ul <- optim(par=ul,fn=fl,a=aPost, b=bPost, p=fp,
                    method="Brent",lower=phat.mode, upper = 1)$par
    } else {
      ll <- ul <- NA
    }
  }

  data.frame(phat=phat, se.phat=se, phat.mode=phat.mode, ll.phat=ll, ul.phat=ul)
}


#' @export
#' @title decibar2depth
#' @description This function calculates depth in meters from pressure in decibars using Saunders and Fofonoff's method
#' @param \code{P} = pressure, in decibars
#' @param \code{lat} = degrees latitude
#' @param \code{Del} = geopotential anomaly (defaults to 0)
#' @param \code{method} = valid values include"default", "seabird", and "unesco", although they all appear to be treated the same
#' @return \code{DEPTH} = depth in M
#' @author  unknown, \email{<unknown>@@dfo-mpo.gc.ca}
#' @examples
#' decibar2depth(10000,30,0)
#' [1] 9712.653
#' @note
#'
# DEEP-SEA RES., 1976, 23, 109-111.
#' / UNITS:
#' //   PRESSURE     P      DECIBARS
#' //   LATITUDE     LAT    DEGREES
#' //   DEPTH        DEPTH  METERS
#' //   DTN. HEIGHT  DEL    DYN. METERS (geopotenial anomaly in J/kg:: assume 0)
#' // CHECKVALUE:
#' //   1.) DEPTH = 9712.653 M for P=10000 DECIBARS, LAT=30 DEG, DEL=0
#' //   ABOVE FOR STANDARD OCEAN: T=0 DEG CELSIUS; S=35 (PSS-78)
#' // ----------------------------------------------------------
#' // Original fortran code is found in:
#' //   UNESCO technical papers in marine science 44 (1983) -
#' //   'Algorithms for computation of fundamental properties of seawater'
#' @references \url{http://www.code10.info/index.php?option=com_content&view=article&id=67:calculating-the-depth-from-pressure&catid=54:cat_coding_algorithms_seawater&Itemid=79}, \url{http://www.code10.info/index.php?option=com_content&view=article&id=67:calculating-the-depth-from-pressure&catid=54:cat_coding_algorithms_seawater&Itemid=79}
#' @family physical and chemical properties
#' @export

      decibar2depth = function( P, lat, Del=0, method="default" ) {

        if (method %in% c("default", "seabird", "unesco" ) ) {

          X = (sin( lat * pi / 180 ))^2 # convert degree decimal to RADs

          # GR=GRAVITY VARIATION WITH LATITUDE: ANON (1970) BULLETIN GEODESIQUE
          GR = 9.780318 * (1.0 + (5.2788E-3 + 2.36E-5 * X) * X) + 1.092E-6 * P
          DepthTerm = (((-1.82E-15 * P + 2.279E-10) * P - 2.2512E-5) * P + 9.72659) * P ## assuming (35 psu, 0 C, and P=pressure in decibars )
          DEPTH = DepthTerm / GR + Del / 9.8
          return (DEPTH)
        }

      }


# V17: moyenne; V18: max; V25: Nom de l'Etat;
head(df)
#S?lection des colonnes pertinentes
data_80_14 <- data_80_14[,c("V25", "V18", "V17")]
#S?lection des donn?es des Etats qui nous int?ressent
data_80_14=subset(df, V25=="California" | V25=="Louisiana" | V25=="Ohio" | V25=="Minnesota" | V25=="Montana")
#Renommage des colonnes
colnames(data_80_14)[1] <- "?tat"
colnames(data_80_14)[2] <- "Temp?rature maximale"
colnames(data_80_14)[3] <- "Temp?rature moyenne"

#Comme la moyenne est une moyenne arithm?tique, on peut d?terminer
#la temp?rature minimale ? partir de la moyenne et de la temp?rature
#maximale
#Moy = (Min+Max)/2
#2*Moy = Min+Max
#2*Moy-Max = Min
temp_minimale=2*data_80_14$`Temp?rature moyenne`-data_80_14$`Temp?rature maximale`
data_80_14$temp_minimale=temp_minimale

#Calcul de la moyenne et de l'?cart type, pour cet ?chantillon

#Moyenne de la temp?rature max
moy_max_1 <- mean(data_80_14$`Temp?rature maximale`)
#Ecart type sur la temp?rature max
sigma_tmp <- 0
for(j in 1:nrow(data_80_14))
{
  sigma_tmp <- sigma_tmp + (moy_max_1-data_80_14$`Temp?rature maximale`[j])^2

}
#?cart-type = racine carr? de la variance
sigma_max_1 <- sqrt(sigma_tmp/(nrow(data_80_14)-1))

#Moyenne de la temp?rature moyenne
moy_moyenne_1 <- mean(data_80_14$`Temp?rature moyenne`)

#Ecart type sur la temp?rature moyenne
sigma_tmp <- 0
for(j in 1:nrow(data_80_14))
{
  sigma_tmp <- sigma_tmp+(moy_moyenne_1-data_80_14$`Temp?rature moyenne`[j])^2

}
sigma_moy_1 <- sqrt(sigma_tmp/(nrow(data_80_14)-1))

#Moyenne de la temp?rature minimale
moy_min_1 <- mean(data_80_14$`temp_minimale`)

#Ecart type sur la temp?rature minimale
sigma_tmp <- 0
for(j in 1:nrow(data_80_14))
{
  sigma_tmp <- sigma_tmp+(moy_min_1-data_80_14$`temp_minimale`[j])^2

}
sigma_min_1 <- sqrt(sigma_tmp/(nrow(data_80_14)-1))

#-------DEUXIEME ECHANTILLON: 2015 - 2019 -------#
#On fait pareil avec le deuxi?me ?chantillon

# V17 moyenne V18 max V25 Nom de l'Etat
head(df)
data_15_19=subset(df, V25=="California" | V25=="Louisiana" | V25=="Ohio" | V25=="Minnesota" | V25=="Montana")
data_15_19 <- data_15_19[,c("V25", "V18", "V17")]
colnames(data_15_19)[1] <- "?tat"
colnames(data_15_19)[2] <- "Temp?rature maximale"
colnames(data_15_19)[3] <- "Temp?rature moyenne"

#Comme la moyenne est une moyenne arithm?tique, on peut d?terminer
#la temp?rature minimale ? partir de la moyenne et de la temp?rature
#maximale
temp_minimale=2*data_15_19$`Temp?rature moyenne`-data_15_19$`Temp?rature maximale`
data_15_19$temp_minimale=temp_minimale

#Moyenne de la temp?rature max
moy_max_2 <- mean(data_15_19$`Temp?rature maximale`)
#Ecart type sur la temp?rature max
sigma_tmp <- 0
for(j in 1:nrow(data_15_19))
{
  sigma_tmp <- sigma_tmp + (data_15_19$`Temp?rature maximale`[j]-moy_max_2)^2

}
sigma_max_2 <- sqrt(sigma_tmp/(nrow(data_15_19)-1))
print(data_15_19$`Temp?rature maximale`)

#Moyenne de la temp?rature moyenne
moy_moyenne_2 <- mean(data_15_19$`Temp?rature moyenne`)

#Ecart type sur la temp?rature moyenne
sigma_tmp <- 0
for(j in 1:nrow(data_15_19))
{
  sigma_tmp <- eval.parent(substitute(sigma_tmp+(moy_moyenne_1-data_15_19$`Temp?rature moyenne`[j])^2))

}
sigma_moy_2 <- sqrt(sigma_tmp/(nrow(data_15_19)-1))

#Moyenne de la temp?rature minimale
moy_min_2 <- mean(data_15_19$`temp_minimale`)

#Ecart type sur la temp?rature minimale
sigma_tmp <- 0
for(j in 1:nrow(data_15_19))
{
  sigma_tmp <- sigma_tmp+(moy_min_1-data_15_19$`temp_minimale`[j])^2

}
sigma_min_2 <- sqrt(sigma_tmp/(nrow(data_15_19)-1))

#----------- COMPARAISON DES MOYENNES ----------------#
print("Moyennes pour l'?chantillon 1: ")
print(paste0("Temp?rature minimale: ", moy_min_1))
print(paste0("Temp?rature moyenne: ", moy_moyenne_1))
print(paste0("Temp?rature maximale: ", moy_max_1))

print("Moyennes pour l'?chantillon 2: ")
print(paste0("Temp?rature minimale: ", moy_min_2))
print(paste0("Temp?rature moyenne: ", moy_moyenne_2))
print(paste0("Temp?rature maximale: ", moy_max_2))

#---------------- COMPARAISON DES ECARTS TYPE ----------#
print("Ecarts type pour l'?chantillon 1: ")
print(paste0("Temp?rature minimale: ", sigma_min_1))
print(paste0("Temp?rature moyenne: ", sigma_moy_1))
print(paste0("Temp?rature maximale: ", sigma_max_1))

print("Ecarts type pour l'?chantillon 2: ")
print(paste0("Temp?rature minimale: ", sigma_min_2))
print(paste0("Temp?rature moyenne: ", sigma_moy_2))
print(paste0("Temp?rature maximale: ", sigma_max_2))

sigma_essai=sd(data_15_19$`Temp?rature maximale`)
print(paste0("ESSAI FONCTION SD ", sigma_essai))
print(sigma_essai)


> #1.	Dla zmiennych losowych przedstawionych w tabelach obliczyć podstawowe statystyki
> #     Wartość = 1, Prawdopodobieństwo = 1/6 (podobnie dla wartośći 2,3,4,5,6)
>
> #2.	Wygeneruj próby dla n=100 dla następujących rozkładów: Bernoulliego, Dwumianowego, Poissona
> library(Rlab)
Błąd w poleceniu 'library(Rlab)':nie ma pakietu o nazwie ‘Rlab’
> Probs <- rep(1/6, 6)
> items <- seq(1, 6, 1)
> it_mean = mean(items)
> it_median = median(items)
> it_std = sd(items)
> it_var = var(items)
> n = 100
> p = 0.2
> k = 5
> ber <- rbern(n,p)
Błąd w poleceniu 'rbern(n, p)':nie udało się znaleźć funkcji 'rbern'
> ber <- rber(n,p)
Błąd w poleceniu 'rber(n, p)':nie udało się znaleźć funkcji 'rber'
> library(Rlab)
Błąd w poleceniu 'library(Rlab)':nie ma pakietu o nazwie ‘Rlab’
> install.packages("Rlab")
WARNING: Rtools is required to build R packages but is not currently installed. Please download and install the appropriate version of Rtools before proceeding:

https://cran.rstudio.com/bin/windows/Rtools/
Installing package into ‘C:/Users/Adam/Documents/R/win-library/3.6’
(as ‘lib’ is unspecified)
próbowanie adresu URL 'https://cran.rstudio.com/bin/windows/contrib/3.6/Rlab_2.15.1.zip'
Content type 'application/zip' length 347255 bytes (339 KB)
downloaded 339 KB

package ‘Rlab’ successfully unpacked and MD5 sums checked

The downloaded binary packages are in
	C:\Users\Adam\AppData\Local\Temp\RtmpKIlQ6d\downloaded_packages
> library(Rlab)
Rlab 2.15.1 attached.

Dołączanie pakietu: ‘Rlab’

Następujące obiekty zostały zakryte z ‘package:stats’:

    dexp, dgamma, dweibull, pexp, pgamma, pweibull, qexp, qgamma, qweibull, rexp, rgamma, rweibull

Następujący obiekt został zakryty z ‘package:datasets’:

    precip

> ber <- rbern(n,p)
> bin <- rbinom(n,k,p)
> poi <- rpois(n,p)
>
> # 3.	Policz dla nich statystyki podstawowe (średnią, wariancję, kurtozę i skośność).
>
> mean(ber)
[1] 0.23
> median(ber)
[1] 0
> var(ber)
[1] 0.1788889
> skew(ber)
[1] 1.283171
> kurt(ber)
[1] 2.646527
>
>
> mean(bin)
[1] 0.92
> median(bin)
[1] 1
> var(bin)
[1] 0.599596
> skew(bin)
[1] 0.6624718
> kurt(bin)
[1] 3.275383
>
>
> mean(poi)
[1] 0.26
> median(poi)
[1] 0
> var(poi)
[1] 0.2145455
> skew(poi)
[1] 1.397018
> kurt(poi)
[1] 3.703055
>
>
> # 4.Dla rozkładów Dwumianowego, Poissona narysuj wykresy rozkładu prawdopodobieństwa (dobierz dowolnie parametry)
>
> hist(bin)
> hist(poi)
>
>
> # 5.	Dla rozkładów Poissona i Dwumianowego wygeneruj rozkład prawdopodobieństwa dla n = 20, k = 0, …, 20 oraz p = 0.4. #Sprawdź, czy suma prawdopodobieństw wygenerowana dla tych rozkładów jest równa 1
>
> poi <- rpois(20,0.4)
> P <- ecdf(poi)
> plot(P)
>
> bin <- rbinom(20,20,0.4)
> P <- ecdf(bin)
> plot(P)
>
>
> # 6.	Wygeneruj 30 danych dla rozkładu normalnego o średniej równej 0 i odchyleniu standardowym równym 2. Wyznacz statystyki podstawowe – czy są one równe z wartościami teoretycznymi? Sprawdź, czy zwiększenie liczby danych zwiększy dokładność wyliczeń statystyk opisowych.
>
> norm <- rnorm(10, 0, 2)
> norm
 [1] -1.0128677 -0.8912117  1.2523880 -0.2495768  1.8834332 -0.3241169  0.9447989  0.5889541 -4.0469052 -0.0990004
> print('mean - 0')
[1] "mean - 0"
> mean(norm)
[1] -0.1954105
> print('median - 0')
[1] "median - 0"
> median(norm)
[1] -0.1742886
> print('variance - 4') var(norm)
BŁĄD: nieoczekiwany symbol in "print('variance - 4') var"
> print('variance - 4')
[1] "variance - 4"
> var(norm)
[1] 2.705355
> print('skewness - 0')
[1] "skewness - 0"
> skew(norm)
[1] -1.159013
> print('kurtosis - 0')
[1] "kurtosis - 0"
> kurt(norm)
[1] 4.147324
>
>
> norm <- rnorm(100, 0, 2)
>
> print('mean - 0')
[1] "mean - 0"
> mean(norm)
[1] 0.07480349
> print('median - 0')
[1] "median - 0"
> median(norm)
[1] 0.09660881
> print('variance - 4')
[1] "variance - 4"
> var(norm)
[1] 4.825696
> print('kurtosis - 0')
[1] "kurtosis - 0"
> kurt(norm)
[1] 3.351857
> print('skewness - 0')
[1] "skewness - 0"
> skew(norm)
[1] -0.3885361
>
>
> norm <- rnorm(1000, 0, 2)
>
> print('mean - 0')
[1] "mean - 0"
> mean(norm)
[1] 0.06857219
> print('median - 0')
[1] "median - 0"
> median(norm)
[1] 0.1334143
> print('variance - 4')
[1] "variance - 4"
> var(norm)
[1] 3.977514
> print('skewness - 0')
[1] "skewness - 0"
> skew(norm)
[1] -0.2148435
> print('kurtosis - 0')
[1] "kurtosis - 0"
> kurt(norm)
[1] 3.049271
>
>
> # 7.	Narysować histogram dla rozkładu normalnego o parametrach: średnia = 1, odchylenie =2, wykres dla rozkładu standardowego, oraz wykres gęstości dla średniej równej -1 oraz odchylenia równego 0.5.
>
> norm1 <- rnorm(1000, 1, 2)
> norm2 <- rnorm(1000, 0, 1)
> norm3 <- rnorm(1000, -1, 0.5)
>
> hist(norm1)
> hist(norm2)
> hist(norm3)
>


## 1. Comparing Frequency Distributions ##

library(dplyr)
library(readr)
exp_by_pos <- wnba %>%
  group_by(Pos, Exp_ordinal) %>%
  summarize(Freq = n())

pos_by_exp <- wnba %>%
  group_by(Exp_ordinal, Pos) %>%
  summarize(Freq = n())

## 2. Grouped Bar Charts ##

library(ggplot2)
ggplot(data = wnba,
         aes(x = Pos, fill = Exp_ordinal)) +
  geom_bar(position = "dodge", stat = "count") +
  labs(x = "Position",
       y = "Frequency")

ggplot(data = pos_by_exp,
         aes(x = Pos, y = Freq, fill = Exp_ordinal)) +
  geom_bar(position = "dodge", stat = "identity") +
  labs(x = "Position",
       y = "Frequency")

## 3. Challenge: Do Older Players Play Less? ##

ggplot(data = wnba,
       aes(x = age_relative, fill = min_relative)) +
  geom_bar(position = "dodge")

result <- 'reject'

## 5. Visualizing the Mean with Histograms ##

ggplot(data = wnba,
         aes(x = PTS, fill = age_relative)) +
  geom_histogram(bins = 10,
                 position = "identity",
                 alpha = 0.5) +
  geom_vline(aes(xintercept = mean(wnba$PTS),
                 linetype = "Average points"),
             color = "black")

ggplot(data = wnba,
         aes(x = PTS, fill = age_relative)) +
  geom_histogram(bins = 10,
                 position = "identity",
                 alpha = 0.5) +
  geom_vline(aes(xintercept = mean(wnba$PTS),
                 linetype = "Average points"),
             color = "black") +
  facet_wrap(~ age_relative)

## 6. Frequency Polygons and Kernel Density Estimate Plots ##

ggplot(data = wnba,
         aes(x = PTS, color = age_relative)) +
  geom_density() +
  geom_vline(aes(xintercept = mean(wnba$PTS),
                 linetype = "Average points"),
             color = "black")

## 8. Scatter Plots ##

ggplot(data = wnba,
       aes(x = Pos, y = Weight, color = Pos)) +
  geom_point() +
  geom_jitter()

## 9. Box Plots ##

ggplot(data = wnba,
         aes(x = Pos, y = Weight, color = Pos)) +
  geom_boxplot()

## 10. Outliers ##

# ggplot(data = wnba,
#          aes(x = "", y = Games_Played, group = 1)) +
#   geom_boxplot()
iqr <- 29 - 22
lower_bound <- 22 - (1.5 * iqr)
upper_bound <- 29 + (1.5 * iqr)
outliers_low <- sum(wnba$Games_Played < lower_bound) # True values will count as 1 in the summation
outliers_high <- sum(wnba$Games_Played > upper_bound)

ggplot(data = wnba,
         aes(x = "", y = Games_Played, group = 1)) +
  geom_boxplot()

Data Analyst in R/Step 5 - Probability and Statistics/1. Statistics Fundamentals in R/6. Comparing Frequency Distributions.r


library("NbClust")

df <- read.csv("winequality-red.csv", sep=";", header=TRUE)

# Plots within groups sum of squares
wssplot <- function(data, nc=15, seed=1234){
               wss <- (nrow(data)-1)*sum(apply(data,2,var))
               for (i in 2:nc){
                    set.seed(seed)
                    wss[i] <- sum(kmeans(data, centers=i)$withinss)}
                plot(1:nc, wss, type="b", xlab="Number of Clusters",
                     ylab="Within groups sum of squares")}

# Center and scale data frame columns
df_scaled <- scale(df[-1])
head(df_scaled)

# Determine optimal number of columns
wssplot(df_scaled)

set.seed(1234)
nc <- NbClust(df_scaled, min.nc=2, max.nc=15, method="kmeans")

# Optimal Number of clusters
barplot(table(nc$Best.n[1,]),
          xlab="Numer of Clusters", ylab="Number of Criteria",
          main="Number of Clusters Chosen by 26 Criteria")

# K-means cluster analysis
set.seed(1234)
fit.km <- kmeans(df, 3, nstart=25)

fit.km$size # Number of items in each cluster

fit.km$centers # returns central value for each cluster

aggregate(df[-1], by=list(cluster=fit.km$cluster),mean)


library(tidyr)
library(dplyr)
library(stringr)

as_decimal <- function(binary) {
  binary <- rev(binary)
  total <- 0
  for(j in 1:length(binary)) {
    c <- as.numeric(binary[j])
    total <-total + (c*(2^(j-1)))
  }
  return(total)
}

data <- read.csv("input.csv", header=FALSE) %>%
  mutate(row = str_sub(V1,1,7)) %>%
  mutate(column = str_sub(V1,8,11)) %>%
  mutate(row = str_replace_all(row,"F","0")) %>%
  mutate(row = str_replace_all(row,"B", "1")) %>%
  mutate(column = str_replace_all(column, "L", "0")) %>%
  mutate(column = str_replace_all(column, "R", "1")) %>%
  mutate(row = str_split(row, boundary("character"))) %>%
  mutate(column = str_split(column, boundary("character"))) %>%
  rowwise() %>%
  mutate(row_dec = as_decimal(row)) %>%
  mutate(column_dec = as_decimal(column)) %>%
  mutate(seat_id = (row_dec*8)+column_dec)
# Part 1
print(max(data$seat_id))
# Part 2
compare <- tibble(seat_id=1:max(data$seat_id))
compare <- compare[-data$seat_id,]
print(compare)


dataset = read.csv('ETFs.csv')

str(dataset)

summary(dataset)

boxplot(dataset)

DataSel<- as.data.frame(matrix(0, nrow = 150, ncol = 6),col.names = Names)
rowmax = apply(dataset, 1, max)
for (i in 1:150){
  for (j in 1:6){
    if (dataset[i,j] == rowmax[i])
      DataSel[i,j] <- 1
  }
}

NumObs = 150
NumArms = 6
ETFSelected = integer()
NumSelections = integer(NumArms)
RewSum = integer(NumArms)
TotRew = 0
for (n in 1:NumObs){
  ETF = 0
  MaxUpBound = 0
  for (i in 1:NumArms){
    if(NumSelections[i]> 0 ){
      AverageReward = RewSum[i]/NumSelections[i]
      DeltaI  = sqrt(3/2 * log(n)/NumSelections[i])
      UpBound = AverageReward + DeltaI
    } else{
      UpBound  = 1e400
    }
    if(UpBound > MaxUpBound){
      MaxUpBound = UpBound
      ETF = i
    }
  }
  ETFSelected = append(ETFSelected, ETF)
  NumSelections[ETF] = NumSelections[ETF] + 1
  reward = DataSel[n, ETF]
  RewSum[ETF] = RewSum[ETF] + reward
  TotRew = TotRew + reward
}

hist(ETFSelected,
     col = 'blue',
     main = 'Histogram of ETFs selections',
     xlab = 'ETFs',
     ylab = 'Number of times each ETF was selected')


#'  This function calculates depth in meters from pressure in decibars using Saunders and Fofonoff's method
#'  \code{P} = pressure, in decibars
#'  \code{lat} = degrees latitude
#'  \code{Del} = geopotential anomaly (defaults to 0)
#'  \code{method} = valid values include"default", "seabird", and "unesco", although they all appear to be treated the same
#'  \code{DEPTH} = depth in M
#'
# DEEP-SEA RES., 1976, 23, 109-111.
#' / UNITS:
#' //   PRESSURE     P      DECIBARS
#' //   LATITUDE     LAT    DEGREES
#' //   DEPTH        DEPTH  METERS
#' //   DTN. HEIGHT  DEL    DYN. METERS (geopotenial anomaly in J/kg:: assume 0)
#' // CHECKVALUE:
#' //   1.) DEPTH = 9712.653 M for P=10000 DECIBARS, LAT=30 DEG, DEL=0
#' //   ABOVE FOR STANDARD OCEAN: T=0 DEG CELSIUS; S=35 (PSS-78)
#' // ----------------------------------------------------------
#' // Original fortran code is found in:
#' //   UNESCO technical papers in marine science 44 (1983) -
#' //   'Algorithms for computation of fundamental properties of seawater'
#'  \url{http://www.code10.info/index.php?option=com_content&view=article&id=67:calculating-the-depth-from-pressure&catid=54:cat_coding_algorithms_seawater&Itemid=79}, \url{http://www.code10.info/index.php?option=com_content&view=article&id=67:calculating-the-depth-from-pressure&catid=54:cat_coding_algorithms_seawater&Itemid=79}

      decibar2depth = function( P, lat, Del=0, method="default" ) {

        if (method %in% c("default", "seabird", "unesco" ) ) {

          X = (sin( lat * pi / 180 ))^2 # convert degree decimal to RADs

          # GR=GRAVITY VARIATION WITH LATITUDE: ANON (1970) BULLETIN GEODESIQUE
          GR = 9.780318 * (1.0 + (5.2788E-3 + 2.36E-5 * X) * X) + 1.092E-6 * P
          DepthTerm = (((-1.82E-15 * P + 2.279E-10) * P - 2.2512E-5) * P + 9.72659) * P ## assuming (35 psu, 0 C, and P=pressure in decibars )
          DEPTH = DepthTerm / GR + Del / 9.8
          return (DEPTH)
        }

        if (method %in% c("seabird", "unesco") ){

          ## NOTE this method is the same as the above ...

          # http://www.seabird.com/application_notes/AN69.htm
          #
          # Sea-Bird uses the formula in UNESCO Technical Papers in Marine Science No. 44.
          # This is an empirical formula that takes compressibility (that is, density) into account.
          # An ocean water column at 0 °C (t = 0) and 35 PSU (s = 35) is assumed.
          #
          # The gravity variation with latitude and pressure is computed as:
          #
          # g (m/sec2) = 9.780318 * [ 1.0 + ( 5.2788x10 -3  + 2.36x10 -5  * x) * x ] + 1.092x10 -6  * p
          #
          # where
          # x = [sin (latitude / 57.29578) ] ^2
          # p = pressure (decibars)
          #
          # Then, depth is calculated from pressure:
          #
          # depth (meters) = [(((-1.82x10 -15  * p + 2.279x10 -10 ) * p - 2.2512x10 -5 ) * p + 9.72659) * p] / g
          #
          # where
          # p = pressure (decibars)
          # g = gravity (m/sec2)

          # x = (sin (latitude / 57.29578) )^2
          # g = 9.780318 * [ 1.0 + ( 5.2788E-3  + 2.36E-5  * x) * x ] + 1.092E-6  * p
          # depth = ((((-1.82E-15  * p + 2.279E-10 ) * p - 2.2512E-5 ) * p + 9.72659) * p) / g

        }

      }


library(MASS) # ginv()
lenth <- function(xy, theta, x.hat=NULL, i.max=1000, threshold=10.0^(-6)) {
  norm2 <- function(v) sum(v*v)
  #
  # Pseudo-MLE.
  #
  improve <- function(x, cs, xy){
    #
    # Improves an initial estimate `x` based on bearings as represented
    # by a 2 x * matrix of cosines and sines `cs` relative to locations `xy`
    # (as a 2 by * matrix).
    #
    if (is.null(x)) {
      cs.star <- cs                                          # Starting estimate
    }
    else {
      xy.relative <- apply(xy, 2, function(v) x-v)           # vectors towards x
      d <- apply(xy.relative, 2, function(v) norm2(v)^(3/2)) # cubed distances
      cs.star <- xy.relative / d                             # direction cosines
    }
    z <- cs[2,]*xy[1,] - cs[1,]*xy[2,]
    a <- cs.star %*% t(cs) * matrix(c(-1,-1,1,1), nrow=2)    # Eq 2.6, lhs
    b <- cs.star %*% z                                       # Eq 2.6, rhs
    u <- solve(a,b)                                          # Solution
    c(u[2], u[1])
  }
  #
  # Convert bearings into direction cosines and sines.
  #
  cs <- sapply(theta, function(x) c(cos(x), sin(x)))
  #
  # Iterate until convergence.
  #
  if (is.null(x.hat)) x.hat <- improve(x.hat, cs, xy)
  repeat {
    x.new <- improve(x.hat, cs, xy)
    eps <- norm2(x.hat-x.new) / sqrt(max(apply(xy, 2, norm2)))
    lines(t(cbind(x.hat, x.new)), pch=2, col="Red")
    x.hat <- x.new
    i.max <- i.max - 1
    if (eps <= threshold) break
    if (i.max < 0) stop("Convergence failed.")
  }
  #
  # Estimate kappa.
  #
  mu.hat <- apply(x.hat - xy, 2, function(u) atan2(u[2], u[1]))
  c.bar <- mean(cos(theta - mu.hat))
  kappa.inv <- 2*(1-c.bar) + (1-c.bar)^2 * (0.48794/c.bar - 0.82905 - 1.3915*c.bar)
  kappa <- 1/kappa.inv
  #
  # Estimate the covariance matrix for x.hat.
  #
  xy.relative <- apply(xy, 2, function(v) x.hat - v)
  d <- apply(xy.relative, 2, function(v) norm2(v)^(3/2))
  cs.star <- xy.relative / d
  q.hat <- cs.star %*% t(cs)
  q.hat <- (q.hat + t(q.hat))/2
  q.hat <- q.hat * matrix(c(1,-1,-1,1), nrow=2)
  q.hat <- q.hat[2:1, 2:1]
  q.hat <- ginv(q.hat, tol=10^(-16)) * kappa.inv
  x.se <- sqrt(q.hat[1,1])
  y.se <- sqrt(q.hat[2,2])

  list(x.hat=x.hat, cov=q.hat, se=c(x.se, y.se), kappa=kappa)
}
#--------------------------------------------------------------------------------------#
set.seed(17)
#
# Target point.
#
x.0 <- c(1, 1)
#
# Observation points.
#
n <- 16
xy <- matrix(rnorm(2*n), nrow=2)
cs <- sapply(theta, function(x) c(cos(x), sin(x)))
#
# Simulate the observed bearings (in radians)
#
xy.fuzzy <- matrix(rnorm(2*n, sd=0.2), nrow=2) + x.0
theta <- apply(xy.fuzzy - xy, 2, function(u) atan2(u[2], u[1]))
#
# Obtain the MLE.
#
fit <- lenth(xy, theta)
#
# Plot all points.
#
cs <- sapply(theta, function(x) c(cos(x), sin(x)))
par(mfrow=c(1,1))
plot(t(cbind(xy, fit$x.hat, x.0)), asp=1, type="n", xlab="x", ylab="y")
    temp <- sapply(1:length(theta),
               function(i) lines(t(cbind(xy[,i], xy[,i]+9*cs[,i])), col="Gray"))
    points(t(xy))
    points(x.0[1], x.0[2], pch=19, col="Blue")
    points(t(fit$x.hat), pch=19, col="Red")
#
# Plot the 95% confidence ellipse.
#
lines(ellipse(fit$cov, centre=fit$x.hat, level=0.95), col="#AA4444")


# based upon R Tutorial for Knockoffs : https://web.stanford.edu/group/candes/knockoffs/software/knockoffs
#
# Creating an artificial problem Let us begin by creating some
# synthetic data. For simplicity, we will use synthetic data
# constructed from a generalized linear model such that the response
# only depends on a small fraction of the variables.

load_install_packages <- function(list.of.packages) {
    new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
    if(length(new.packages)) install.packages(new.packages,repos="http://cran.cnr.Berkeley.edu/")
    for (i in list.of.packages) {
        library(i,character.only=T)
    }
}

load_install_packages(c("argparse"))

init_arg <- function() {
    parser <- ArgumentParser(description='')
    parser$add_argument('-o', type="character")
    parser$add_argument('--ojson', type="character")
    parser$add_argument('--target', default='label', type="character")
    return (parser)
}

args <- init_arg()$parse_args()
lbl <- args$target
fn_csv <- args$o
fn_json <- args$ojson

set.seed(12345)

                   # parameters generation of synthetic data
n = 3000           # number of observations
p = 100            # number of variables
k = 10             # number of variables with nonzero coefficients
amplitude = 2*7.5  # signal amplitude

# Generate the variables from a multivariate normal distribution
mu = rep(0,p)
rho = 0.10
Sigma = toeplitz(rho^(0:(p-1))) # diagnal const

X = matrix(rnorm(n*p),n) %*% chol(Sigma)  # rnorm(n, mean = , sd = ) is used to generate n normal random numbers with arguments mean and sd ; , %*% is matrix multiplication

# Generate the response from a logistic model and encode it as a factor.
nonzero = sample(p, k)
beta = amplitude * (1:p %in% nonzero) / sqrt(n)
invlogit = function(x) exp(x) / (1+exp(x))
y.sample = function(x) rbinom(n, prob=invlogit(x %*% beta), size=1)
y = factor(y.sample(X), levels=c(0,1), labels=c("A","B"))

df_syn= as.data.frame(X)
df_syn[, lbl] = y
write.csv(df_syn, file=fn_csv, row.names=FALSE)
features <- names(df_syn)[names(df_syn) != lbl]
result_json = sprintf('{ "features_selected": [\"%s\" ], "features": ["%s"]}',
    paste(features[nonzero], collapse='","'),
    paste(features, collapse='","'))

print(sprintf("# samples:%d, # explanatory variables:%d, relevant variables: # %d) : %s",
              NROW(df_syn),
              NCOL(df_syn) - 1,
              length(nonzero),
              paste(features[nonzero], collapse=',')))
write(result_json, file=fn_json)


scaledf <- function(df, meanvec = NULL, scaledata = NULL, scalefactor = 2, zeromin = FALSE) {
    ## centers and scales a dataframe
    ## df          = dataframe of parameters to be scaled
    ## meanvec     = vector of mean values for centering
    ##               default uses means of df for centering
    ## scaledata   = dataframe used to provide range of each parameter for scaling
    ##               default uses range of df for scaling
    ## scalefactor = number used to set range of scaled data (multiplies data by scalefactor / range of scaledata)
    ##               (2 results in -1 to +1 if centered and ranges of scaledata are equal distant from mean)
    ##               (1 results in  0 to +1 if zeroed   and ranges of scaledata are equal distant from mean)
    ## zeromin     = FALSE (default) results in center of scaled df at 0 if ranges of scaledata are equal distant from mean)
    ##             = TRUE results in min of scaled df at 0 if ranges of scaledata are equal distant from mean)
    ## suffix "_s" to be added to each variable to identify it is scaled

    ## center data
    if (missing(meanvec))   meanvec <- apply(df, 2, mean)  # use mean of df  to center
    # subtract meanvec from each row in df; output is a dataframe
    dfcenter <- sweep(df,       2, meanvec,    "-")

    ## scale centered data
    if (missing(scaledata)) scaledata <- df                # use range of df to scale
    ## calculate vector (1 value for each parameter in scaledata) = range of parameter / scalefactor
    scalerange <- (sapply(scaledata,max) - sapply(scaledata,min)) / scalefactor
    ## divide every row in dfcenter by scalerange
    dfs        <- sweep(dfcenter, 2, scalerange, "/")

    ## adjust location center if needed
    if (zeromin == TRUE) dfs <- sweep(dfs, 2, (scalefactor/2), "+")

    ## ## convert to dataframe and ad suffix to column names
    ## dfs <- data.frame(dfs)
    ## names(dfs) <- paste(names(dfs), "_s", sep = "")

    ## return parameters
    return( list(dfs=dfs, meanvec=meanvec, scaledata=scaledata, scalefactor=scalefactor, zeromin=zeromin) )
}
# dfs.out <- scaledf(df)$dfs
# dfs     <- dfs.out$dfs
# summary(dfs)


 DSPGV Example Program Results

 Eigenvalues
       -2.2254    -0.4548     0.1001     1.1270

 Estimate of reciprocal condition number for B
        5.8E-03

 Error estimates for the eigenvalues
        9.3E-14    2.5E-14    1.1E-14    5.1E-14


## Author: Sergio García Prado
## Title: Statistical Inference - Goodness of Fit - Exercise 05

rm(list = ls())

observed <- c(34, 10, 20)

(k <- length(observed))
# 3

(n <- sum(observed))
# 64

proportion <- c(9, 3, 2)

(expected <- n * proportion / sum(proportion))
# 41.1428571428571 13.7142857142857 9.14285714285714

(Q <- sum((observed - expected) ^ 2 / expected))
# 15.1388888888889

(pvalue <- 1 - pchisq(Q, df = k - 1))
# 0.000515979024014124


buckets <- read.delim("~/gas-simulator/buckets.txt", sep=" ", header=F)

fn <- buckets

for(vv in buckets[1]) {
  r <- 1
  for (v in vv) {
    fn[r,2] <- fn[r,2]/(4*pi*fn[r,1]^2)*2900000 # 10 is for scale
    r <- r+1
  }
}

#
# Maxwell distribution
#

# f(v)dv = √(m/2pikT)^3*4*pi*v^2*exp(-mv^2/(2kT))*dv

# assume homogeneous buckets distribution in velocity
dv <- buckets[3,1] - buckets[2,1]
maxwell <- buckets

# physical constants
Na = 6.022e+23
R = 8.3144598
k = R/Na

# params
N = 1000000
m = 6.646476410e-27
T = 293.321

# compute maxwell distribution
for(vv in buckets[1]) {
  r <- 1
  for (v in vv) {
    maxwell[r,2] <- N*((m/(2*pi*k*T))^(3/2))*(4*pi*v^2)*exp(-m*(v^2)/(2*k*T))*dv
    r <- r+1
  }
}

sum(buckets[2])
sum(maxwell[2])

plot(buckets, type="o",
  xlab="Velocity",
  ylab="Number of particles"
)
lines(fn, type="o", col="red")
lines(maxwell, type="o", col="green")


lesmis <- read.delim("lesmis.dat", header = F, sep = ",")
d <- data.frame((lesmis[,1] + 1), (lesmis[,2] + 1))
n <- max(d) #No. of vertices
a <- matrix(0,n,n,dimnames = list(c(seq(1:n)),c(seq(1:n))))

#Adjacency matrix from given list
for (i in 1:nrow(d)){
  x <- d[i,1]
  y <- d[i,2]
  a[x,y] <- 1
  a[y,x] <- 1
}

#Adjacency lists
adj_list <- NULL
for (i in 1:n) {
  adj_list[[i]] <- which(a[i,]==1)
}

#BFS better Implementation
dist <- matrix(-1, n, n, byrow = T,dimnames = list(c(seq(1:n)),c(seq(1:n)))) #Distance array for each vertex
start_time <- Sys.time()

for (i in 1:n) { #Running BFS n times
  dist[i,i] <- 0  #Set source dist 0
  queue <- NULL
  queue <- c(queue,i)
  j <- 1

  while(length(which(dist[i,] == -1))!=0){
    idx <- queue[j:length(queue)]
    nridx <- length(idx)
    for (j in 1:nridx) {
      d <- dist[i,idx[j]]
      nbr <- adj_list[[idx[j]]]
      for (k in nbr) {
        if(dist[i,k] == -1){
          dist[i,k] <- d + 1
          queue <- c(queue,k)
        }
      }
      j <- j + 1
    }
  }
}
end_time <- Sys.time()
time_req <- difftime(end_time, start_time)
cat(sprintf("Time required for better Implementation is : %f seconds\n",time_req))


# R version 3.6.1

#Install Scatterplot3D
install.packages("scatterplot3d")

# Call Library
library("scatterplot3d")

# For Colors Visit http://www.stat.columbia.edu/~tzheng/files/Rcolor.pdf
colors <- c("chartreuse", "#E69F00", "#56B4E9")

# Lets Import Data (You can import your csv after saving it from Excel)
imported_data <- read.csv("IRIS.csv", header = TRUE)

# Iris dataset
z <- imported_data$Sepal.Length
x <- imported_data$Sepal.Width
y <- imported_data$Petal.Length

# For coloring according to the Grouping
grps<- as.factor(imported_data[,5])
# For Different shapes for different values in Specieis column in imported_data
shapes<- c(16,17,18)
shapes<- shapes[as.numeric(imported_data$Species)]
shapes

# Make Sctterplot
S3D <- scatterplot3d(x, y, z,
                     main="3D Scatter Plot",
                     sub="Subtitle",
                     xlab="X-axis",
                     ylab="Y-axis",
                     zlab="Z-axis",
                     #highlight.3d=TRUE,
                     col.axis="blue",
                     col.grid="lightblue",
                     col.lab="royalblue",
                     cex.axis =1,
                     cex.lab=1,
                     font.axis=2 ,
                     font.lab=1,
                     lty.axis=2,
                     lty.grid=2,
                     color=colors[grps],     # Will be ignored if highlight.3d = TRUE
                     pch=shapes,
                     xlim=c(-1,2),
                     ylim=c(-1,2),
                     zlim=c(-9, 10),
                     type="h",
                     scale.y,
                     grid=TRUE,
                     box=FALSE,
                     angle = 45,
                     axis=TRUE,
                     tick.marks=TRUE,         # only if axis = TRUE
                     label.tick.marks=TRUE,
                     lwd=1,
                     mar= c(5,5,4,3)
)

# Add labels to the points (OPTIONAL)
S3D.coords <- S3D$xyz.convert(x, y, z)
text(S3D.coords$x, S3D.coords$y,                # x and y coordinates
     labels=iris$Species,                       # text on plot
     cex=.5, pos=4)

# add the legend (OPTIONAL)
legend("topleft",                               # topleft, right, bottom
       inset=.05,
       legend = levels(iris$Species),
       bty="n", cex=1,                          # suppress legend box, shrink text 50%
       pch = c(16, 17, 18),
       col =  colors,
       title="Type",
       xpd = TRUE,
       c("Sepal.Width", "Petal.Length", "Sepal.Length"),
       #fill=colors,
       horiz = FALSE
)

# Add regression plane (OPTIONAL)
lm <- lm(z ~ x + y)
S3D$plane3d(lm, draw_polygon = TRUE, draw_lines = FALSE,
            polygon_args = list(col = adjustcolor( "slategray1", alpha.f = 0.2)),lty= "dotted" , lwd=0.7)


# Gets the canonical display name for a distance_type
distance_name <- function(distance_type) {
  if (distance_type == "minkowski3") {
    return("Minkowski-3")
  }
  else if(distance_type == "euclidean") {
    return("Euclidean")
  }
  else if(distance_type == "cosine") {
    return("cosine")
  }
  else if(distance_type == "correlation") {
    return("correlation")
  }
  else {
    stop("Unsupported distance type")
  }
}

# Gets the display column name for a distance type
distance_col_name <- function(distance_type) {
  name <- paste0(distance_name(distance_type), " distance")
  name <- capitalize(tolower(name))  # Just the first letter is capitalised
  return(name)
}

# Computes a distance matrix from two data matrices
distance_matrix <- function(matrix_left, matrix_right, distance_type) {
  if (distance_type == "minkowski3") {
    distances <- cdist(matrix_left, matrix_right, metric="minkowski", p=3)
  }
  else if(distance_type == "euclidean") {
    distances <- cdist(matrix_left, matrix_right, metric="euclidean", p=2)
  }
  else if(distance_type == "cosine") {
    distances <- cdist(matrix_left, matrix_right, metric=function(x, y) {1 - (x %*% y / sqrt(x%*%x * y%*%y))} )
  }
  else if(distance_type == "correlation") {
    # For some reason, when you tell rdist to do "correlation distance", it
    # actually does square root of half the correlation distance
    # this is probably to make it a metric distance.
    # either way, this is not what we want, and we correct it here
    distances <- cdist(matrix_left, matrix_right, metric="correlation") ^ 2 * 2
  }
  else {
    stop("Unsupported distance type")
  }
  return(distances)
}


# Building a Support Vector Machine with kernlab's ksvm

library(data.table)

data = read.table("//es00cifs00/users$/egagne/WINNT/System/Desktop/credit_card_data-headers.txt", header=TRUE)

#Install and load kernlab package
# install.packages("kernlab")
library(kernlab)

#set the seed, so that results will be replicable
set.seed(3)

# call ksvm
ccmodel <-  ksvm(as.matrix(data[,1:10]) #training data is cols 1-10 of df data
                 ,as.factor(data[,11]), #test data is the 11th col of df data
                 type="C-svc", #specify C classification
                 kernel="vanilladot", #linear kernel
                 C=100, # weight of error vs margin
                 scaled=TRUE) #scale the data
ccmodel # Training error: 0.13608
attributes(ccmodel)

# calculate a1.am (coefficients)
a <- colSums(ccmodel@xmatrix[[1]] * ccmodel@coef[[1]])
a
# calculate a0 (intercept)
a0 <- -ccmodel@b
a0
# view predictions
pred <- predict(ccmodel,data[,1:10])
pred
# get model accurracy aka 1-training error
sum(pred == data[,11]) / nrow(data) # = 0.8639144

# Explore possible C values by manually plugging them in
# It looks like 100 is the best option here. Maybe I would get different results with a funtion that iterates through all the possible values of C
# call ksvm
cmodels <-  ksvm(as.matrix(data[,1:10]),as.factor(data[,11]),type="C-svc",kernel="vanilladot",C=100,scaled=TRUE)
# calculate a1.am
a <- colSums(cmodels@xmatrix[[1]] * cmodels@coef[[1]])
a
# calculate a0
a0 <- -cmodels@b
a0
# view predictions
pred <- predict(cmodels,data[,1:10])
pred
# get model accuracy
sum(pred == data[,11]) / nrow(data)

#C=0.0001 --> 0.5474006
#C=0.001 --> 0.8379205
#C=0.01 --> 0.8639144
#C=1 --> 0.8639144
#C=10 --> 0.8639144
#C=50 --> 0.8639144
#C=100 --> 0.8639144
#C=150 --> 0.8639144
#C=200 --> 0.8639144
#C=500 --> 0.8639144
#C=1000 --> 0.8623853
#C=10000 --> 0.8623853
#C=100000 --> 0.8639144
#C=1000000 --> 0.6253823
#C=10000000 --> 0.5458716
#C=100000000 --> 0.6636086

# Iterate through many possible C values and return the top 5 values
allC = seq(from = 0.0001, to = 100000000, by = 0.1) #create a sequence with lots of possible C values
allC_samp = sample(x = allC, size=100) #create a random sample of the sequence
hist(allC_samp) #see that the sample is uniformly distributed
results=list()
for(i in 1:length(allC_samp)){
  c.model <-  ksvm(as.matrix(data[,1:10]),as.factor(data[,11]),type="C-svc",kernel="vanilladot",C=allC_samp[[i]],scaled=TRUE)
  results[[i]]=data.table(C=0.0001,accuracy=sum(pred == data[,11])/nrow(data))
}
rbindlist(results)
results_dt = rbindlist(results)
results_dt[order(-accuracy)][1:5] #return the 5 C values with the highest accuracy

#Try another way to iterate through C values
CVal <- 1
C_vector <- numeric()
error <- numeric()

while(CVal <= 10000)
{

  # call ksvm. Vanilladot is a simple linear kernel.
  model <- ksvm(as.matrix(data[,1:10]),as.factor(data[,11]),type="C-svc",kernel="vanilladot",C=CVal,scaled=TRUE)

  # see what the model predicts
  pred <- predict(model,data[,1:10])
  pred

  #actual classification
  sum(pred == data[,11]) / nrow(data)
  error <- c(error, model@error)

  C_vector <- c(C_vector, CVal)

  # increment C
  CVal <- CVal * 10
}

# store C and error
pt_data <- data.frame(C_vector, error)
pt_data

#cross validation
svm_cross <- ksvm(as.matrix(data[,1:10]),as.factor(data[,11]),type = "C-svc",kernel = "vanilladot",C =
                    100,scaled = TRUE,cross=10)

# Let's see if a linear kernel really is the best option
# Build a list of all available kernels in ksvm
# Iterate through them and display accuracy metric for each in a table
myKernels = c("vanilladot","polydot","besseldot", "rbfdot", "tanhdot", "laplacedot", "anovadot", "splinedot", "stringdot")
results=list()
for(i in 1:length(myKernels)){
  # call ksvm
  models <-  ksvm(as.matrix(data[,1:10]),as.factor(data[,11]),type="C-svc",kernel=myKernels[[i]],C=100,scaled=TRUE)
  # calculate a1.am
  a <- colSums(models@xmatrix[[1]] * models@coef[[1]])
  a
  # calculate a0
  a0 <- -models@b
  a0
  # view predictions
  pred <- predict(models,data[,1:10])
  pred
  # view accuracy metric
  results[[i]]=data.table(kernel=myKernels[[i]],accuracy=sum(pred == data[,11]) / nrow(data))
}
rbindlist(results)


phys <- c(15,  12,  8,   8,   7,   7,   7,   6,   5,   3)
hist <- c(10,  25,  17,  11,  13,  17,  20,  13,  9,   15)

ph <- cor(phys, hist, use="complete.obs", method="pearson")

write(round(ph, 3), stdout())


## 1. Creating a Matrix Restructuring a Vector ##

vector_1 <- c(1, 4, 5, 9) # [1] 1 4 5 9
vector_2 <- 1:12 # [1] 1  2  .. 11 12
vector_3 <- seq(from = 2.0, to = 5.50, by = 0.25) # [1] 2.00 2.25 .. 5.25 5.50
# Type your code below
matrix_1 <- matrix(vector_1, nrow = 2)
matrix_2 <- matrix(vector_2, ncol = 3)
matrix_3 <- matrix(vector_3, nrow = 3, ncol = 5, byrow = TRUE)

## 2. Creating a Matrix Combining Vectors ##

world_rank <- c(1, 2, 3, 4, 5, 6)
quality_of_education <- c(1, 9, 3, 2, 7, 13)
influence <- c(1, 3, 2, 6, 12, 13)
broad_impact <- c(1, 4, 2, 13, 9, 12)
patents <- c(3, 10, 1, 48, 15, 4)
# Type your code below
university_matrix <- cbind(world_rank, quality_of_education, influence, broad_impact, patents)

## 3. Naming Matrix Rows and Columns ##

#university_matrix <- cbind(world_rank, quality_of_education, influence, broad_impact, patents)
rownames(university_matrix) <- c("harvard", "stanford", "MIT", "cambridge", "oxford", "columbia")

## 4. Indexing Matrices by columns and rows ##

cell_columbia_influence <- university_matrix[6, 3]
vector_cambridge <- university_matrix[4, ]
vector_world_rank <- university_matrix[, 1]

## 5. Indexing Matrices using Vectors ##

usa_universities <- c(TRUE, TRUE, TRUE, FALSE, FALSE, TRUE)
# Type your code below
sub_matrix <- university_matrix[c(1, 3, 4), c(1, 4)]
usa_universities_rankings <- university_matrix[usa_universities, c(1, 5)]

## 6. Modifying Elements in a Matrix ##

university_matrix <- cbind(world_rank, quality_of_education, influence, broad_impact, patents)
rownames(university_matrix) <- c("harvard", "stanford", "MIT", "cambridge", "oxford", "columbia")

usa_universities <- c(TRUE, TRUE, TRUE, FALSE, FALSE, TRUE)

# Type your code below
university_matrix[4, 5] <- 3
university_matrix[usa_universities, ] <- 2

## 7. Appending Elements To a Matrix ##

california <- c(7, 5, 4, 7, 29, 43176)
# Type your code below
complete_university_matrix <- rbind(university_matrix, california)

## 8. Removing Elements from a Matrix ##

university_matrix_wtho_first <- complete_university_matrix[, -1]
below_10_university_matrix <- complete_university_matrix[broad_impact <= 10, c(-2, -5)]

## 9. Performing Operations with Matrices ##

harvard_scores_avg <- mean(complete_university_matrix["harvard",])
university_scores_avg <- rowMeans(complete_university_matrix)
category_scores_avg <- colMeans(complete_university_matrix)

## 10. Scoring and Ranking Universities ##

university_matrix_avg <- colMeans(ranks_university_matrix)

Data Analyst in R/Step 1 - Introduction to R/2. Data Structures in R/2. Matrices in R.r


## defaults for matrix size and cp for synthetic wavefront construction

nrow.default <- 640
ncol.default <- nrow.default
cp.default <- list(xc=320.5, yc=320.5, rx=319.5, ry=319.5, obstruct=0)

## create a unit aperture inside a matrix of arbitrary size
## note the parameter cp is a list with components (xc, yc, rx, ry, obstruct) as returned by pupil.pars()

pupil <- function(zcoef=NULL, maxorder=14L, isoseq=FALSE,
                  phi=0, piston=NULL,
                  nrow=nrow.default, ncol=ncol.default,
                  cp=cp.default) {

  prt <- pupil.rhotheta(nrow, ncol, cp)
  rho <- prt$rho
  theta <- prt$theta
  rho.v <- rho[!is.na(rho)]
  theta.v <- theta[!is.na(rho)] - pi*phi/180
  wf.v <- numeric(length(rho.v))
  if (cp$obstruct > 0) {
    use.circ <- FALSE
  } else {
    use.circ <- TRUE
  }
  if (!is.null(zcoef)) {
    if (!is.null(piston)) {
      zcoef <- c(piston, zcoef)
    }
    if (isoseq) {
      if (use.circ) {
        wf.v <- zpm_cart(x=rho.v*cos(theta.v), y=rho.v*sin(theta.v), maxorder=maxorder) %*% zcoef
      } else {
        wf.v <- zapm_cart(x=rho.v*cos(theta.v), y=rho.v*sin(theta.v), maxorder=maxorder) %*% zcoef
      }
    } else {
      if (use.circ) {
        wf.v <- zpm(rho.v, theta.v, maxorder = maxorder) %*% zcoef
      } else {
        wf.v <- zapmC(rho.v, theta.v, maxorder = maxorder) %*% zcoef
      }
    }
  }
  wf <- matrix(NA, nrow=nrow, ncol=ncol)
  wf[!is.na(rho)] <- wf.v
  class(wf) <- c("pupil", class(wf))
  wf
}

pupil.arb <- function(zcoef=NULL, zlist=makezlist(),
                      phi=0, piston=0,
                      nrow=nrow.default, ncol=ncol.default,
                      cp=cp.default) {

  prt <- pupil.rhotheta(nrow, ncol, cp)
  rho <- prt$rho
  theta <- prt$theta
  rho.v <- rho[!is.na(rho)]
  theta.v <- theta[!is.na(rho)]
  wf.v <- numeric(length(rho.v))
  if (!is.null(zcoef)) {
    wf.v <- zpm.arb(rho.v, theta.v, phi, zlist=zlist) %*% zcoef
  }
  wf <- matrix(NA, nrow=nrow, ncol=ncol)
  wf[!is.na(rho)] <- wf.v
  wf <- wf+piston
  class(wf) <- c("pupil", class(wf))
  wf
}

## estimate of rms over pupil

pupilrms <- function(pupil) {
    sd(as.vector(pupil), na.rm=TRUE)
}

## estimate of p-v over pupil

pupilpv <- function(pupil) {
    max(pupil, na.rm=TRUE) - min(pupil, na.rm=TRUE)
}

#' Zygo's "robust" PV
#'
#' A peak to valley error estimate that reduces the effect of noise and artifacts
#'
#' @param wf.zfit matrix containing the smoothed Zernike fit wavefront
#' @param wf.residual matrix of the difference between the raw wavefront
#'  and the Zernike fit. These values are returned by [wf_net()]
#' @return the estimated PVr
#' @references
#'  Evans, C. (2009) Optical Engineering 48(4), 43605.
#'  <https://doi.org/10.1117/1.3119307>
#'
#' @details
#'  no check is performed on the wavefronts, so it's the user's
#'  responsibility to make sure these come from the same source
PVr <- function(wf.zfit, wf.residual) {
  pvr <- pupilpv(wf.zfit) + 3*sd(wf.residual, na.rm=TRUE)
  pvr
}

## Mahajan's approximation to Strehl ratio

strehlratio <- function(rms) {
    exp(-(2*pi*rms)^2)
}

## a summary method for pupils

summary.pupil <- function(wf, digits=3) {
	cat("Size:   ",nrow(wf), "x",ncol(wf),"\n")
	cat("RMS    =", format(pupilrms(wf), digits=digits), "\n")
	cat("P-V    =", format(pupilpv(wf), digits=digits), "\n")
	cat("Strehl =", format(strehlratio(pupilrms(wf)), digits=digits), "\n")
}

## a plot method for pupils

plot.pupil <- function(wf, cp=NULL, col=topo.colors(256), addContours=TRUE,
                       cscale=FALSE, eqa=FALSE, zlim=NULL, ...) {
    nr <- nrow(wf)
    nc <- ncol(wf)
    if(is.null(zlim)) zlim <- range(wf, finite=TRUE)
    if(eqa) wfcdf <- ecdf(wf[!is.na(wf)])
    if (cscale) {
        mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar
        on.exit(par(par.orig))
        w <- (3 + mar.orig[2]) * par("csi") * 2.54
        layout(matrix(c(2, 1), ncol = 2), widths = c(1, lcm(w)))
        par(las = 1)
        mar <- mar.orig
        mar[4] <- mar[2]
        mar[2] <- 1
        par(mar = mar)
        levels <- seq(zlim[1], zlim[2], length=length(col)+1)
        plot.new()
        plot.window(xlim=c(0,1),ylim=range(levels), xaxs="i", yaxs="i")
        if (eqa) {
            vcol <- col[round((length(col)-1)*wfcdf(seq(zlim[1],zlim[2],length=length(col)))+1)]
        } else vcol <- col
	rect(0, levels[-length(levels)], 1, levels[-1], col=vcol, density=NA)
        axis(4)
        box()
        mar <- mar.orig
        mar[4] <- 0
        par(mar = mar)
    }
    if (is.null(cp)) {
        axis1 <- 1:nr
        axis2 <- 1:nc
    } else {
        axis1 <- ((1:nr)-cp$xc)/cp$rx
        axis2 <- ((1:nc)-cp$yc)/cp$ry
    }
    if (eqa) {
        iwf <- wfcdf(wf[!is.na(wf)])
        iwfm <- wf
        iwfm[!is.na(iwfm)] <- iwf
        zlim <- wfcdf(zlim)
        col1 <- round((length(col)-1)*zlim[1]+1)
        col2 <- round((length(col)-1)*zlim[2]+1)
        image(axis1, axis2, iwfm, zlim=zlim, asp=1, col=col[col1:col2],
              xlab="X", ylab="Y", useRaster=TRUE, ...)
    } else {
        image(axis1, axis2, wf, zlim=zlim, asp=1, col=col,
                  xlab="X", ylab="Y", useRaster=TRUE, ...)
    }
    if (addContours) contour(axis1, axis2, wf, add=TRUE)
}

## RGL animated 3D plot

## administrative stuff needed to make this a method for class "pupil"

wf3d <- function(wf, ...) UseMethod("wf3d", wf)

col3d <- function(wf, surf.col=topo.colors(256), zlim = NULL, eqa=FALSE) {
	if (is.null(zlim)) zlim <- range(wf, na.rm=TRUE)
    if (eqa) {
        wfcdf <- ecdf(wf[!is.na(wf)])
        iwf <- wfcdf(wf[!is.na(wf)])
        wf[!is.na(wf)] <- iwf
        zlim <- wfcdf(zlim)
    }
    surf.col[(length(surf.col)-1)*(wf-zlim[1])/(zlim[2]-zlim[1])+1]
}

wf3d.pupil <- function(wf, cp=NULL, zoom.wf=1, surf.col=topo.colors(256), bg.col="black",
                eqa=FALSE) {
    require(rgl)
    zlim <- range(wf, na.rm=TRUE)
    col <- col3d(wf, surf.col, zlim, eqa)
    if (is.null(cp)) {
        axis1 <- seq(-1, 1, length=nrow(wf))
        axis2 <- seq(-1, 1, length=ncol(wf))*(ncol(wf)/nrow(wf))
    } else {
        axis1 <- ((1:nrow(wf))-cp$xc)/cp$rx
        axis2 <- ((1:ncol(wf))-cp$yc)/cp$ry
    }

    rgl.bg(sphere=FALSE, fogtype="exp2", color=bg.col)
    rgl.surface(-axis1, axis2, wf*zoom.wf, color=col, shininess=100)
    rgl.lines(c(-1,-1.25)*max(axis1),c(0,0),c(0,0),color="red", lit=FALSE)
    rgl.lines(c(0,0),c(0,0),c(1,1.25)*max(axis2),color="red", lit=FALSE)
    rgl.texts(-1.3*max(axis1),0,0, "X", color="red")
    rgl.texts(0,0,1.3*max(axis2), "Y", color="red")
}

## polar coordinates inside the unit radius pupil

pupil.rhotheta <- function(nrow, ncol, cp) {
	xs <- ((1:nrow)-cp$xc)/cp$rx
	ys <- ((1:ncol)-cp$yc)/cp$ry
	rho <- function(x,y) sqrt(x^2+y^2)
	theta <- function(x,y) atan2(y,x)
	rho.mat <- outer(xs, ys, rho)
	theta.mat <- outer(xs,ys,theta)
	rho.mat[rho.mat>1] <- NA
	rho.mat[rho.mat<cp$obstruct] <- NA
	theta.mat[is.na(rho.mat)] <- NA
	list(rho=rho.mat, theta=theta.mat)
}


# Compute correlation matrix across chains

## Load libraries

library(coda)
library(mcmc)
library(stringr)

## Define function for computing mean correlation matrix across multiple chains

mean_cor <- function(chains) {
  return(Reduce('+', lapply(chains, function(chain) cor(as.matrix(chain))))/length(chains))
}

## Read chains

num_chains <- 4
num_pars <- 3

chains <- vector(mode="list", length=num_chains)
for (i in seq(1, num_chains)) {
  print(paste("Loading chain", str_pad(i, 2, pad='0')))
  chains[[i]] <- mcmc(
    read.table(paste('chain', str_pad(i, 2, pad='0'), '.csv', sep=''), header=FALSE, sep=",")
  )
}

## Compute mean correlation matrix

mean_cor_val <- mean_cor(chains)

print("Mean correlation matrix:")
print(mean_cor_val)

## Compute empirical correlation matrix via crosscorr function of coda, which merges multiple chains into one

crosscorr_val <- crosscorr(mcmc.list(chains))
colnames(crosscorr_val) <- seq(1, num_pars)
rownames(crosscorr_val) <- colnames(crosscorr_val)

print("Correlation matrix across chains provided by coda crosscorr:")
print(crosscorr_val)

## Difference between mean correlation matrix and correlation matrix prrovided by coda crosscorr

cor_val_diff <- mean_cor_val - crosscorr_val

print("Difference between mean correlation matrix and correlation matrix prrovided by coda crosscorr:")
print(cor_val_diff)


Poisson_Process <- function(beta, Texp){
    # Generates a Poisson process with a truncated last step.
    # Constructor. Sets dt:
    # dt (array-like): Waiting times between arrivals (exponential random variables).
    #     The last waiting time is shrunk so that its arrival coincides with Texp.
    #     A 0 is inserted in the beginning so that the indices match the reference paper.
    #
    # Args:
    #     beta (numeric): Parameter for exponential random variable.
    #     Texp (numeric): Expiry. The Poisson process is generated up to this point.

    # Generate exponential random variables until their sum adds to more than Texp
    total <- dt <- 0
    while (total < Texp){
        random_exponential <- rexp(1, beta)
        total <- total + random_exponential
        dt <- c(dt, random_exponential)
    }
    # Change the last exponential so that the sum of all exponentials equals Texp
    dt[length(dt)] <- dt[length(dt)] - (total - Texp)

    return(dt)
}

# An example to show how the class works. Keep this commented out unless testing the function.
# print(Poisson_Process(1,3))


# Code for samplers use in Beer sodium examples and the summary plots

beers <- read.table("beer_data.txt", header=T)
sodium.mat <- matrix(beers$Sodium,ncol=8,byrow=T)
sodium <- apply(sodium.mat,1,mean)

nsamp <- 5000
tau <- (0:4000)/100
sigma <- 0.846140/sqrt(8)
Vmu <- (sigma^2+tau^2)/6
muhat <- mean(sodium)

logpost <- tau*0

for (i in 1:length(tau)) {
  logpost[i] <- 0.5*log(Vmu[i]) -3*log(sigma^2+tau[i]^2) - sum((sodium-muhat)^2)/(sigma^2+tau[i]^2)/2
  }
post <- exp(logpost)

tausim <- sample(tau,nsamp,T,post)
Vmuk <- (sigma^2 + tausim^2)/6
musim <- rnorm(nsamp,muhat,sqrt(Vmuk))
thetasim <- matrix(0,ncol=6,nrow=nsamp)
for(i in 1:6) {
  vari <- sigma^2*tausim^2/(sigma^2 + tausim^2)
  meani <- (sodium[i]/sigma^2 + musim/tausim^2)*vari
  thetasim[,i] <- rnorm(nsamp,meani,sqrt(vari))
}

sodium.res <-sodium.mat
yrep <- array(0,c(nsamp,6,8))
r <- matrix(0, nrow=6, ncol=8)
corr <- rep(0,nsamp)
corrdat <- rep(0,nsamp)
vr <- rep(0,nsamp)
vrdat <- rep(0,nsamp)
for(i in 1:nsamp) {
  for(j in 1:6) {
    yrep[i,j,] <- rnorm(8,thetasim[i,j],sigma)
    r[j,] <- yrep[i,j,] - thetasim[i,j]
    sodium.res[j,] <- sodium.mat[j,] - thetasim[i,j]
  }
  corr[i] <- cor(sort(as.vector(r)),qnorm((1:48)/49))
  corrdat[i] <- cor(sort(as.vector(sodium.res)),qnorm((1:48)/49))
  vari <- apply(yrep[i,,],1,var)
  vr[i] <- max(vari)/min(vari)
  varidat <- apply(sodium.res,1,var)
  vrdat[i] <- max(varidat)/min(varidat)
}

sum(corr >= corrdat)/length(corr)
sum(vr >= vrdat)/length(vr)

fill.lm <- lm(Sodium ~ Beer, data=beers)
corrobs <- cor(sort(residuals(fill.lm)),qnorm((1:48)/49))

postscript("../beerdata.eps",horiz=F,width=6,height=4)
par(mfrow=c(1,1), pty="m", mar=c(4,4,2,1)+0.1)

plot(beers$Beer,beers$Sodium,pch=16, xlab="Beer", ylab="Sodium")
points(1:6,sodium,pch=16,col=2)
dev.off()

postscript("../beerhyper.eps",horiz=F,width=8,height=5)
par(mfrow=c(1,2), pty="m", mar=c(4,4,2,1)+0.1)

hist(tausim,prob=T,xlim=c(0,30), xlab=expression(tau),main="")
lines(tau,post/mean(post)/40,col=2)

hist(musim,prob=T, xlab=expression(mu),xlim=c(10,30),main="")

dev.off()

postscript("../beertheta.eps",horiz=F,width=8,height=5)
par(mfrow=c(2,3), pty="m", mar=c(4,4,2,1)+0.1)

hist(thetasim[,1],prob=T, xlab=expression(theta[1]),
  main="Beer 1")
points(sodium[1],0,pch=16,col=2)
points(mean(thetasim[,1]),0,pch=16,col=4)
hist(thetasim[,2],prob=T, xlab=expression(theta[2]),
  main="Beer 2")
points(sodium[2],0,pch=16,col=2)
points(mean(thetasim[,2]),0,pch=16,col=4)
hist(thetasim[,3],prob=T, xlab=expression(theta[3]),
  main="Beer 3")
points(sodium[3],0,pch=16,col=2)
points(mean(thetasim[,3]),0,pch=16,col=4)
hist(thetasim[,4],prob=T, xlab=expression(theta[4]),
  main="Beer 4")
points(sodium[4],0,pch=16,col=2)
points(mean(thetasim[,4]),0,pch=16,col=4)
hist(thetasim[,5],prob=T, xlab=expression(theta[5]),
  main="Beer 5")
points(sodium[5],0,pch=16,col=2)
points(mean(thetasim[,5]),0,pch=16,col=4)
hist(thetasim[,6],prob=T, xlab=expression(theta[6]),
  main="Beer 6")
points(sodium[6],0,pch=16,col=2)
points(mean(thetasim[,6]),0,pch=16,col=4)
dev.off()

postscript("../beercheck.eps",horiz=F,width=8,height=3.5)
par(mfrow=c(1,2), pty="m", mar=c(4,4,2,1)+0.1)

hist(corr,prob=T, xlab="Correlation",
  main="")
abline(v=corrobs,col=2)
hist(vr,prob=T, xlab="Variance Ratio",
  main="")
abline(v=vrdat,col=2)
dev.off()


analyze_bivariate_data <- function(matrix, explanatory_variable, response_variable) {
    relationship <- "linear"
    r <- cor(matrix[,1], matrix[,2])

    exponential_r <- cor(matrix[,1], log(matrix[,2]))
    if (exponential_r > r) {
        relationship <- "exponential"
        r <- exponential_r
    }

    logarithmic_r <- cor(log(matrix[,1]), matrix[,2])
    if (logarithmic_r > r) {
        relationship <- "logarithmic"
        r <- logarithmic_r
    }

    power_r <- cor(log(matrix[,1]), log(matrix[,2]))
    if (power_r > r) {
        relationship <- "power"
        r <- power_r
    }

    r <- round(r, 4)

    inc_or_dec <- if (r > 0) "increase" else "decrease"

    linear_description <- ""
    if (abs(r) < 0.5) {
        linear_description <- "weakly"
    } else if (abs(r) < 0.8) {
        linear_description <- "moderately"
    } else if (abs(r) <= 1) {
        linear_description <- "strongly"
    }

    title <- paste(c(explanatory_variable, "vs.", response_variable), collapse = " ")

    plot(matrix[,1], matrix[,2], main = title, xlab = explanatory_variable, ylab = response_variable)

    if (relationship == "linear") {
        abline(lm(matrix[,2] ~ matrix[,1]))
    }

    return(paste(c("As ", explanatory_variable, " increases, ", response_variable, " tends to ", inc_or_dec, ". The association is ", linear_description, " ", relationship, ", as evidenced by r = ", r, "."), collapse = ""))
}


library(sde)

# define the return and volatility
mu=0.14
sigma=0.25
nt=50
n=2^8

# initial price
P0=1.19542
T=1/12

# generate Brownian motion sample paths of currency price
dt=T/n
t=seq(0, T, by=dt)
B <- matrix(rep(0, length(t)*nt), nrow=nt)
for (i in 1:nt) {
   B[i,]=GBM(x=P0,r=mu,sigma=sigma,T=T,N=n)
}

# plotting the Price Brownian motion sample paths
# boundary for the simulated price
ymax=max(B)
ymin=min(B)
plot(t,B[1,],t='l',ylim=c(ymin, ymax),col=1,ylab="Price S(t)", xlab="Time t")
for (i in 2:nt)
{
    lines(t, B[i,], t='l', ylim=c(ymin, ymax),col=i)
}


#KERNEL DENSITY PLOT | Use to compare groups
par(mfrow=c(2,1))
d<-density(mtcars$mpg)
plot(d)

d <- density(mtcars$mpg)
plot(d, main="Kernel Density of Miles Per Gallon")
polygon(d, col="red", border="blue")
rug(mtcars$mpg, col="brown")

#COMPARATIVE KERNEL DENSITY PLOTS
par(lwd=2)
library(sm)
attach(mtcars)
cyl.f<-factor(cyl, levels=c(4,6,8), labels=c("4 cylinder","6 cylinder", "8 cylinder")) #create grouping factors

sm.density.compare(mpg,cyl,xlab='Miles per Gallon') #plot
title(main='MPG Distribution by Car Cylinders') #title

colfill<-c(2:(1+length(levels(cyl.f))))
legend(locator(1), levels(cyl.f), fill=colfill)#add via click

detach(mtcars)


## 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.
library(xts)
library(Quandl)

## Get 6 contracts of the crude curve
crude.tickers <- c("CHRIS/CME_CL1", "CHRIS/CME_CL2", "CHRIS/CME_CL3",
                 "CHRIS/CME_CL4", "CHRIS/CME_CL5", "CHRIS/CME_CL6")
settle.field <- "Settle"
crude.prices <- Quandl(crude.tickers[1], type="xts")[,settle.field]
for (i in 2:length(crude.tickers)) {
    crude.tmp <- Quandl(crude.tickers[i], type="xts")[,settle.field]
    crude.prices <- cbind(crude.prices, crude.tmp)
}
colnames(crude.prices) <- paste("CL", 1:6, sep="")

crude.returns <- na.omit(diff(log(crude.prices)))
pc.crude <- princomp(crude.returns)
summary(pc.crude)
loadings(pc.crude)

## Get 6 contracts of the natgas curve
natgas.tickers <- c("CHRIS/CME_NG1", "CHRIS/CME_NG2", "CHRIS/CME_NG3",
                 "CHRIS/CME_NG4", "CHRIS/CME_NG5", "CHRIS/CME_NG6")
settle.field <- "Settle"
natgas.prices <- Quandl(natgas.tickers[1], type="xts")[,settle.field]
for (i in 2:length(natgas.tickers)) {
    natgas.tmp <- Quandl(natgas.tickers[i], type="xts")[,settle.field]
    natgas.prices <- cbind(natgas.prices, natgas.tmp)
}
colnames(natgas.prices) <- paste("NG", 1:6, sep="")

natgas.returns <- na.omit(diff(log(natgas.prices)))
pc.natgas <- princomp(natgas.returns)
summary(pc.natgas)
loadings(pc.natgas)


rm(list=ls(all=TRUE))

prior_heads = 10
prior_tails = 10
heads = 3
tails = 7

post_heads = prior_heads + heads
post_tails = prior_tails + tails
epost_heads = prior_heads + (2 * heads)
epost_tails = prior_tails + (2 * tails)

q = seq(0, 1, 0.005)
prior = dbeta(q, prior_heads, prior_tails)
post = dbeta(q, post_heads, post_tails)
epost = dbeta(q, epost_heads, epost_tails)
ymax = max(epost) + (0.02 * max(epost))

post_prob_unfair_heads = pbeta(0.5, post_heads, post_tails,
                               lower.tail = F)
epost_prob_unfair_heads = pbeta(0.5, epost_heads, epost_tails,
                                lower.tail = F)
post_mode = (post_heads - 1) / (post_heads + post_tails - 2)
epost_mode = (epost_heads - 1) / (epost_heads + epost_tails - 2)
cat(paste('post prob unfair heads: ', post_prob_unfair_heads, '\n'))
cat(paste('emp post prob unfair heads: ', epost_prob_unfair_heads, '\n'))
cat(paste('post mode: ', post_mode, '\n'))
cat(paste('emp post mode: ', epost_mode, '\n'))

pdf('coin_flip.pdf', width=7.087, height=4.5)
par(yaxs="i", xaxs="i", cex.lab=1.2, cex.axis=1.0, mgp=c(2.2, 0.7, 0),
    oma=c(0, 0, 0.2, 0.5), mar=c(3.2, 3.2, 0.5, 0.1))
plot(x=c(), y = c(), xlab=bquote(theta), ylab='Density', xlim=c(0,1),
     ylim=c(0, ymax))
lines(q, prior)
lines(q, post, col='blue')
lines(q, epost, col='red')
dev.off()


#1

#perform the ANOVA and save the results to plantanova
plantanova<-aov(weight~group, PlantGrowth)

#view the ANOVA data
anova(plantanova)

#p-value = 0.0159. p-value is less than the significance level of 0.05, So we can reject the null hypothesis that the mean growth is the same for all treatments.

#p-value = 0.0159.This means that, if the effect of all three treatments were the same, we would have less than 2% chance of seeing differences between groups as large or larger than this

coef(plantanova)

#Control treatment gives an average weight of 5.032. The effect of treatment 1 (trt1) is to reduce weight by an average of -0.371 units compared to the control method, and the effect of treatment 2 (trt2) is to increase weight by an average of 0.494 units compared to the control method.

#2

bottles<-read.csv("bottles.csv")
ks.test(bottles$Volume, "pnorm", 500, 25)

#The p-value for the one-sample Kolmogorov-Smirnov test is 0.2108. As this is not less than the significance level of 0.05, we can not reject the null hypothesis. This means that there is no evidence that the bottle volumes are not drawn from the normal distribution.

#3

dbinom(2,10,1/6)
#The probability of throwing exactly two sixes, when a fair die is rolled 10 times is 0.29071 or 29.071%

#4

dpois(18,20)
# the probability that exactly eighteen lobsters will be ordered tomorrow is 8.4%

#5

airquality_dataset<-as.data.frame(airquality)
summary(airquality_dataset)
airquality_dataset=na.omit(airquality_dataset)

max_data<-apply(airquality_dataset,2,max)
min_data<-apply(airquality_dataset,2, min)
data_scaled<-scale(airquality_dataset,center=min_data,scale=max_data-min_data)
summary(data_scaled)

#6

airquality_dataset<-as.data.frame(airquality)
summary(airquality_dataset)
airquality_dataset=na.omit(airquality_dataset)

mean_data<-apply(airquality_dataset, 2, mean)
std_data<-apply(airquality_dataset, 2, sd)

data_scaled<-scale(airquality_dataset, center=mean_data, scale=std_data)
summary(data_scaled)

R Community/R Stats_Basics Part 2/programs.r


=begin
  # sample-polynomial02.rb

  require "algebra"
  P = Polynomial(Integer, "x", "y", "z")
  x, y, z = P.vars
  p((-x + y + z)*(x + y - z)*(x - y + z))
  #=> -z^3 + (y + x)z^2 + (y^2 - 2xy + x^2)z - y^3 + xy^2 + x^2y - x^3

((<_|CONTENTS>))
=end


findfactors <- function(n) {
  d <- c()
  div <- 2; nxt <- 3; rest <- n
  while( rest != 1 ) {
    while( rest%%div == 0 ) {
      d <- c(d, div)
      rest <- floor(rest / div)
    }
    div <- nxt
    nxt <- nxt + 2
  }
  d
}

print(findfactors(1005025))


## Output : A matrix such that the
##          column sums are item log-likelihood values, and
##          row sums are person log-likelihood values.
log.prob <- function(U.data, th, a, b) {
        ## Step 1: Build the matrix of probabilities
        ##         (see Post 2 for details)
        term.1     <- outer(th, a)
        term.2     <- matrix(rep(a*b, P.persons), nrow=P.persons,
                             byrow=TRUE)
        P.prob <- plogis(term.1 - term.2) #### 1/(1 + exp(term.2 - term.1))

        ## Step 2: Build the likelihood from Equation 1 on the log scale
        log.bernoulli <- log(P.prob^U.data) + log((1-P.prob)^(1-U.data))
        return(log.bernoulli)
}


 explicit.to.implicit.2d.line = function ( p1, p2 ) {

# LINE_EXP2IMP_2D converts an explicit line to implicit form in 2D.
#%      A * X + B * Y + C = 0
  dx = p1[1] - p2[1]
  dy = p1[2] - p2[2]
  slope = dy/dx
  # slope =  (p1[2] - Y) / (p1[1] - X)
  # slope * (p1[1]-X) = (p1[2]-Y)
  # slope * p1[1] - slope * X - p1[2] + Y = 0
  # - slope * X + Y + slope*p1[1] - p1[2] = 0
  A = -slope
  B = 1
  C = slope * p1[1] - p1[2]
  out = as.matrix( cbind( A,B,C) )
  return( out )

}


library(polynom)
library(orthopolynom)

legendre.coeff <- function(x,y,l, xlim=range(x)) {
	a <- (xlim[2] - xlim[1])/2
	b <- xlim[1] + a
	x_ <- (x-b)/a

	n <- length(y)
	coeffs <- NULL

	for (i in 1:length(l)) {
		coeffs <- cbind(coeffs, 2 * sum(y * predict(l[[i]], x_))/n)
	}
	# Return a vector of coefficients
	#print(coeffs)
	coeffs
}

legendre.var <- function(x,y,xlim) {

	n <- length(y)
	k <- ceiling(n/4)
	l <- legendre.polynomials(length(y), normalized=T)
	coeffs <- legendre.coeff(x,y,l,xlim)
	#print(coeffs)
	v <- 4 * sum(coeffs[(n-k+1):n] * coeffs[(n-k+1):n])
	print(v)
	v
}

legendre.R <- function(J,x,y,xlim) {
	n <- length(y)
	l <- legendre.polynomials(J, normalize=T)
	coeffs <- legendre.coeff(x,y,l,xlim)
	v <- legendre.var(x,y,xlim)

	j <- c(1:n)
	R <- J*(v/n) + sum(coeffs[J+1:n] - (v * j[J+1:n]))

	R
}

legendre.choose.R <- function(x,y,xlim) {
	Js <- c(1:length(y))
	print(Js)
	Rs <- sapply(Js, function(j){legendre.R(j,x,y,xlim)})
	print(Rs)
	J.min <- which.min(Rs)
}

legendre.eval <- function(x, coeffs, l, xlim=range(x)) {
	a <- (xlim[2] - xlim[1])/2
	b <- xlim[1] + a
	x_ <- (x-b)/a

	y <- 0
	for (i in 1:length(l)) {
		y <- y + coeffs[i] * predict(l[[i]], x_)
	}
	y
}

legendre.trial <- function() {
	x <- seq(2,10,by=0.001)
	y <- sin(2*x)

	plot(x,y)
	l <- legendre.polynomials(3, normalized = TRUE)
	g <- legendre.coeff(x,y,l)
	lines(x, legendre.eval(x,g,l), col="orange")

	g <- legendre.coeff(x,y,l)
	lines(x, legendre.eval(x,g,l), col="orange")

}


# O(N)
square_sum <- 0
sum_of_squares <- 0
rng = 1:100

for (i in rng) {
    square_sum <- square_sum + i
    sum_of_squares <- sum_of_squares + i*i
}

square_sum <- square_sum * square_sum

print(square_sum - sum_of_squares)

# O(1)
sm <- 100 * (100+1)/ 2
squared <- (100 * (100 + 1) * (2 * 100 + 1)) / 6

result <- sm * sm - squared

print(result)


data = read.csv(file="C:/Users/shcmpq/OneDrive - BP/Documents/GitHub/algos_practice/montyCarlo/callers.csv", header=TRUE)

head(data)
pairs(data)

library("rjags")

mod_string =" model {
    for (i in 1:length(calls)) {
		calls[i] ~ dpois( days_active[i] * lam[i] )
		log(lam[i]) = b0  + b[1]*isgroup2[i] + b[2]*age[i]
	}

    b0 ~ dnorm(0.0, 1.0/1e2)

    for(j in 1:2) {
        b[j] ~ dnorm(0.0, 1.0/1e2)
    }

} "

set.seed(102)

data_jags = as.list(data)

params = c("b0", "b[1]", "b[2]")

mod = jags.model(textConnection(mod_string), data=data_jags, n.chains=3)
update(mod, 1e3)

mod_sim = coda.samples(model=mod,
                        variable.names=params,
                        n.iter=20e3)
mod_csim = as.mcmc(do.call(rbind, mod_sim))

## convergence diagnostics
#plot(mod_sim)

gelman.diag(mod_sim)
autocorr.diag(mod_sim)
autocorr.plot(mod_sim)
effectiveSize(mod_sim)

x = c(1,29)
loglam = mod_csim[,"b0"] + mod_csim[,c(2,3)] %*% x
lam = exp(loglam)

n_sim = length(lam)
y = rpois(n=n_sim, lambda=lam*30)
mean(y>2)

X = as.matrix(data[,3:4])
head(X)

pmed_coef = colMeans(mod_csim)

llam_hat = pmed_coef["b0"] + X %*% pmed_coef[c("b[1]", "b[2]")]
lam_hat = exp(llam_hat)


### SPOTTING A VOLATILE TIME SERIES

# Compute the length n of djx
n <- length(djx)

#  Generate a normal sample of size n with parameters given by npars
ndata <- rnorm(n)*npars[2] + npars[1]

# Generate a t-distributed sample of size n with paramaters given by tpars
tdata <- rt(n, df = tpars[1])*tpars[3] + tpars[2]

# Make ndata and tdata into xts objects
ndatax <- xts(ndata, time(djx))
tdatax <- xts(tdata, time(djx))

# Merge djx, ndatax, and tdatax and plot
alldata <- merge(djx,ndatax, tdatax)
plot.zoo(alldata, type = "h", ylim = range(alldata))

### COMPUTING VaR and ES for NORMAL DISTRIBUTION

# Make a sequence of 100 x-values going from -4*sigma to 4*sigma
xvals <- seq(from = -4*sigma, to = 4*sigma, length.out = 100)

# Compute the density of a N(mu, sigma^2) distribution at xvals
ndens <- dnorm(xvals, mean = mu, sd = sigma)

# Plot ndens against xvals
plot(xvals, ndens, type = "l")

# Compute the 99% VaR and 99% ES of a N(mu, sigma^2) distribution
VaR99 <- qnorm(0.99, mean = mu, sd = sigma)
ES99 <- ESnorm(0.99, mu = mu, sd = sigma)

# Draw vertical lines at VaR99 and ES99 in red and green
abline(v = VaR99, col = "red")
abline(v = ES99, col = "green")

### Examining risk factors for international equity portfolio

# Plot the risk-factor data
plot.zoo(riskfactors)

# Calculate the log-returns, assign to returns, and plot
returns <- diff(log(riskfactors))[-1, ]
plot.zoo(returns)

# Use apply() to carry out the Jarque-Bera test for all 5 series
apply(returns, 2, jarque.test)

# Make a Q-Q plot against normal for the 5th return series and add a reference line
qqnorm(returns[, 5])
qqline(returns[, 5])

# Make a picture of the sample acfs for returns and their absolute values
acf(returns)
acf(abs(returns))

# Partition plotting area into 3 pieces
par(mfrow = c(1, 3))

# Plot djx_extremes
plot(djx_extremes, type = "h")

# Compute the spaces between the times of the extremes
djx_spaces <- diff(time(djx_extremes))

# Make a histogram of these spaces
hist(as.numeric(djx_spaces))

# Make a Q-Q plot of djx_spaces against exp_quantiles
qqplot(exp_quantiles, djx_spaces)

# Carry out the previous 4 steps for iid_extremes
plot(iid_extremes, type="h")
iid_spaces <- diff(time(iid_extremes))
hist(as.numeric(iid_spaces))
qqplot(exp_quantiles, iid_spaces)

# Make a time series plot of indexes with plot.zoo and a pairwise scatterplot with pairs
plot.zoo(indexes)
pairs(as.zoo(indexes))

# Calculate the sample correlation matrix of indexes
cor(indexes)

# Plot the sample acfs and cross-correlation functions for the returns in indexes
acf(indexes)

# Plot the sample acfs and cross-correlations functions for the absolute values of indexes
acf(abs(indexes))

# Plot fx and fx_w
plot.zoo(fx, type = "h")
plot.zoo(fx_w, type = "h")

# Make acf plots of fx and the absolute values of fx
acf(fx)
acf(abs(fx))

# Apply the Ljung-Box test to the components of fx and their absolute values
apply(fx, 2, Box.test, lag = 10, type = "Ljung")
apply(abs(fx), 2, Box.test, lag = 10, type = "Ljung")

# Make acf plots of fx_w and the absolute values of fx_w
acf(fx_w)
acf(abs(fx_w))

# Apply the Ljung-Box test to the components of fx_w and their absolute values
apply(fx_w, 2, Box.test, lag = 10, type = "Ljung")
apply(abs(fx_w), 2, Box.test, lag = 10, type = "Ljung")


peso = 70
altura = 1.70
imc = peso/(altura*altura)

if(imc < 20) {
  print("Abaixo do ideal")
} else {
  if(imc >= 20 & imc < 30) {
    print("Na faixa ideal")
  } else {
    print("Acima do ideal")
  }
}


#' Computes Moran's I correlation index
#'
#' Natively built for computing Moran's I on \code{dgCMatrix} objects, this
#' routine allows computing the I on large sparse matrices (graphs). Part of
#' its implementation was based on \code{\link[ape:Moran.I]{ape::Moran.I}},
#' which computes the I for dense matrices.
#'
#' @param x Numeric vector of size \eqn{n}.
#' @param w Numeric matrix of size \eqn{n\times n}{n * n}. Weights. It can be
#'  either a object of class \code{\link{matrix}} or \code{\link[Matrix:dgCMatrix-class]{dgCMatrix}}
#'  from the \code{\link[Matrix]{Matrix}} package.
#' @param normalize.w Logical scalar. When TRUE normalizes rowsums to one (or zero).
#' @param alternative	Character String. Specifies the alternative hypothesis that
#' is tested against the null of no autocorrelation; must be of one \code{"two.sided"},
#' \code{"less"}, or \code{"greater"}.
#' @export
#' @details
#' In the case that the vector \code{x} is close to constant (degenerate random
#' variable), the statistic becomes irrelevant, and furthermore, the standard error
#' tends to be undefined (\code{NaN}).
#'
#' @family statistics
#' @family Functions for inference
#' @return A list of class \code{diffnet_moran} with the following elements:
#' \item{observed}{Numeric scalar. Observed correlation index.}
#' \item{expected}{Numeric scalar. Expected correlation index equal to \eqn{-1/(N-1)}.}
#' \item{sd}{Numeric scalar. Standard error under the null.}
#' \item{p.value}{Numeric scalar. p-value of the specified \code{alternative}.}
#' @references
#'
#' Moran's I. (2015, September 3). In Wikipedia, The Free Encyclopedia.
#' Retrieved 06:23, December 22, 2015, from \url{https://en.wikipedia.org/w/index.php?title=Moran\%27s_I&oldid=679297766}
#'
#' @examples
#'
#' if (require("ape")) {
#'
#'   # Generating a small random graph
#'   set.seed(123)
#'   graph <- rgraph_ba(t = 4)
#'   w <- approx_geodesic(graph)
#'   x <- rnorm(5)
#'
#'   # Computing Moran's I
#'   moran(x, w)
#'
#'   # Comparing with the ape's package version
#'   ape::Moran.I(x, as.matrix(w))
#'
#' }
#'
#' @author George G. Vega Yon
moran <- function(x, w, normalize.w=TRUE, alternative = "two.sided") {
  if (!inherits(w, "matrix") & !inherits(w, "dgCMatrix"))
    stop("-w- must be either a matrix or a dgCMatrix.")

  if (any(!is.finite(x)))
    stop("-x- must have only numbers.")

  if (inherits(w, "matrix"))
    w <- methods::as(w, "dgCMatrix")

  if (normalize.w)
    w <- w/(rowSums(w) + 1e-20)

  res <- moran_cpp(x, w)

  # Computing pval
  pv  <- with(res, pnorm(observed, mean = expected, sd = sd))

  # Checking alternatives
  alternative <- match.arg(
    alternative, c("two.sided", "less", "greater")
    )

  if (alternative == "two.sided")
    pv <- if (res$observed <= res$expected)
      2 * pv
  else 2 * (1 - pv)
  if (alternative == "greater")
    pv <- 1 - pv

  # Returning
  structure(
    c(res, p.value = pv),
    class = "diffnet_moran"
  )

}