## 2. Combining Vectors into Matrices ##

harvard <- c(1,1,1,1,3)
stanford <- c(2,9,3,4,10)
MIT <- c(3,3,2,2,1)
cambridge <- c(4,2,6,13,48)
oxford <- c(5,7,12,9,15)
columbia <- c(6,13,13,12,4)
uni_matrix<-rbind(harvard,stanford,MIT,cambridge,oxford,columbia)
uni_matrix

## 3. Naming Matrix Rows and Columns ##

uni_matrix <- rbind(harvard, stanford, MIT, cambridge, oxford, columbia)
categories <- c("world_rank", "quality_of_education", "influence", "broad_impact" ,"patents")
colnames(uni_matrix)<-categories
uni_matrix

## 4. Finding Matrix Dimensions ##

tuition <- c(43280,45000,45016,49350,28450,55161)
dim(uni_matrix)[1]==length(tuition)

## 5. Adding Columns to Matrices ##

tuition <- c(43280, 45000, 45016, 49350, 28450, 55161)
complete_matrix<-cbind(uni_matrix,tuition)
complete_matrix

## 6. Indexing Matrices By Element ##

complete_matrix <- cbind(uni_matrix, tuition)
oxford_influence<-complete_matrix['oxford','influence']
cam_stan_patents<-complete_matrix[c('cambridge','stanford'),'patents']
cam_stan_patents

## 7. Subsetting Matrices by Rows and Columns ##

oxford_rank<-complete_matrix['oxford',]
influence<-complete_matrix[,'influence']
harv_mit_rank<-complete_matrix[c('harvard','MIT'),]
influence_patents<-complete_matrix[,c('influence','patents')]

## 8. Ranking Universites ##

world_rank_rank<-rank(complete_matrix[,'world_rank'])
quality_of_education_rank<-rank(complete_matrix[,'quality_of_education'])
influence_rank<-rank(complete_matrix[,'influence'])
broad_impact_rank<-rank(complete_matrix[,'broad_impact'])
patents_rank<-rank(complete_matrix[,'patents'])
tuition_rank<-rank(complete_matrix[,'tuition'])

## 9. Scoring and Ranking Universities ##

ranks_matrix <- rbind(world_rank_rank, quality_of_education_rank, influence_rank, broad_impact_rank, patents_rank, tuition_rank)
sum(ranks_matrix[,('harvard')])
sum(ranks_matrix[,('stanford')])
sum(ranks_matrix[,('MIT')])
sum(ranks_matrix[,('cambridge')])
sum(ranks_matrix[,('oxford')])
sum(ranks_matrix[,('columbia')])


library(repr) ; options(repr.plot.res = 100, repr.plot.width=5, repr.plot.height= 5) # Change plot sizes (in cm) - this bit of code is only relevant if you are using a jupyter notebook - ignore otherwise

load('../data/mammals.Rdata')

model <- lm(logCvalue ~ TrophicLevel * GroundDwelling, data= mammals)
par(mfrow=c(2,2), mar=c(3,3,1,1), mgp=c(2, 0.8,0))
plot(model)

anova(model)

summary(model)

# a data frame of combinations of variables
gd <- rep(levels(mammals$GroundDwelling), times = 3)
print(gd)

tl <- rep(levels(mammals$TrophicLevel), each = 2)
print(tl)

# New data frame
predVals <- data.frame(GroundDwelling = gd, TrophicLevel = tl)

# predict using the new data frame
predVals$predict <- predict(model, newdata = predVals)
print(predVals)

odonata <- read.csv('../data/GenomeSize.csv')

odonata$logGS <- log(odonata$GenomeSize)
odonata$logBW <- log(odonata$BodyWeight)

odonModel <- lm(logBW ~ logGS * Suborder, data = odonata)

summary(odonModel)

anova(odonModel)

summary(odonModel)

#get the range of the data:
rng <- range(odonata$logGS)
#get a sequence from the min to the max with 100 equally spaced values:
LogGSForFitting <- seq(rng[1], rng[2], length = 100)

print(LogGSForFitting)

#get a data frame of new data for the order
ZygoVals <- data.frame(logGS = LogGSForFitting, Suborder = "Zygoptera")

#get the predictions and standard error
ZygoPred <- predict(odonModel, newdata = ZygoVals, se.fit = TRUE)

#repeat for anisoptera
AnisoVals <- data.frame(logGS = LogGSForFitting, Suborder = "Anisoptera")
AnisoPred <- predict(odonModel, newdata = AnisoVals, se.fit = TRUE)

# plot the scatterplot of the data
plot(logBW ~ logGS, data = odonata, col = Suborder)
# add the predicted lines
lines(AnisoPred$fit ~ LogGSForFitting, col = "black")
lines(AnisoPred$fit + AnisoPred$se.fit ~ LogGSForFitting, col = "black", lty = 2)
lines(AnisoPred$fit - AnisoPred$se.fit ~ LogGSForFitting, col = "black", lty = 2)


# ......................................................................................
# ........................Exercise 4 - Continuous random variable.......................
# ......................................................................................
# ......................................................................................

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

# **The content of this script is only as a supplementary illustration to the exercise,
# it is not necessary to know at the exam. It is important to be able to calculate
# manually.**
#
# * Numerical integration in R ####
#
# R function **integrate**integrate(f, a, b)=$\int_{a}^{b}f(x)dx$
#
# - **f** is a R function(defined by us) which has one input argument - a vector of
# values in which to return its values
#
# - **a** lower integration limit
#
# - **b** upper integration limit
#

f = function(x){return(x*x)} # x ^ 2
a = -1
b = 2
integrate(f, a, b)

x = seq(0,10,0.1)

y=x*x/100
plot(x,y)

(9*50-20^2)/9

#  Examples ####
#
# * Example 1. ####
#
# Random variable X has distribution function$F(x)=\begin{cases} 0    &      x \leq
# 0 \\ cx^2 &  0 < x \leq 1 \\ 1    &  1 < x \end{cases}$What values can the
# constant c take?
#

# derivative of F(x) is the density of density f(x)
# corresponding probability density at interval<0.1>
f = function(x){return(2*x)} # f(x)=2x
a = 0
b = 1
integrate(f, a, b)$value

# c=1, so the distribution function looks like this:
F.dist = function(x){
    res = x*x     # x ^ 2
    res[x<=0] = 0 # 0 for x<=0
    res[x>1] = 1  # 1 for x>1
    return(res)
}

x = seq(from = -1, to = 2, by = 0.01) # points on the x-axis
FX = F.dist(x) # values of F(x)
plot(x, FX, type = 'l') # draw as a line

# * Example 2. ####
#
# The distribution of a random variable X is given by the density$f(x)=\begin{cases}
# 2x+2 & x \in <-1;0> \\ 0    & x \notin <-1;0> \end{cases}$Specify:
#
# ** 2. a) ####
#
# $F(x)$,
#

f.dens = function(x){
    res = 2*x + 2
    # watch out for x<-1 because '<-' is in the assignment line
    res[x < -1] = 0 # 0 for x<=0
    res[x > 0] = 0  # 1 for x>1
    return(res)
}

x = seq(from = -2, to = 1, by = 0.01) # points on the x-axis
fx = f.dens(x) # values of f(x)
plot(x, fx, cex=0.2) # draw dots(cex is the size)

F.dist = function(x){
    res = x*x+2*x+1     # x ^ 2 + 2x + 1
    res[x < -1] = 0 # 0 for x<=0
    res[x > 0] = 1  # 1 for x>1
    return(res)
}

x = seq(from = -2, to = 1, by = 0.01) # points on the x-axis
FX = F.dist(x) # values of f(x)
plot(x, FX, type='l') # draw dots(cex is the size)

# ** 2. b) ####
#
# P(−2 ≤ X ≤ 0.5), P(−2 ≤ X ≤ −1), P(X>0.5), P(X=0.3)
#

# P(−2 ≤ X ≤.50.5)
integrate(f.dens, -2, -0.5)$value
integrate(f.dens, -1, -0.5)$value

# P(−2 ≤ X − −1)
integrate(f.dens, -2, -1)$value

# P(X>0.5)
integrate(f.dens, 0.5, 1e16)$value # This will not always work

# P(X=0.3)
integrate(f.dens, 0.3, 0.3)$value
# it is clear that this probability is 0
# corresponds to the integral sa=b, ie with zero size on the x-axis

# ** 2. c) ####
#
# mean, variance and standard deviation of the random variable X.
#

# E(X)
x_fx = function(x){
    fx = f.dens(x)
    return(x*fx)
}
# we integrate only where we know that f(x) is nonzero
E_X = integrate(x_fx, -1, 0)$value
E_X
-1/3

# E(X ^ 2)
xx_fx = function(x){
    fx = f.dens(x)
    return(x*x*fx)
}
# we integrate only where we know that f(x) is nonzero
E_XX = integrate(xx_fx, -1, 0)$value
E_XX
1/6

# D(X)
D_X = E_XX - E_X^2
D_X
1/18

# sigma(x)
std_X = sqrt(D_X)
std_X
sqrt(2)/6

# ** 2. d) ####
#
# mode $\hat{x}$
#

# mode=0

# ** 2. e) ####
#
# median $x_{0,5}$
#

x = seq(from = -2, to = 1, by = 0.001) # points on the x-axis
FX = F.dist(x)
plot(x, FX, type='l')
lines(c(-2, 1),c(0.5, 0.5))

x[FX >= 0.5][1] # first element zx for which F(x)>=0.5
(-2+sqrt(2))/2

# * Example 3. ####
#
# The random variable Y is defined as: Y=3X + 1, where X is the random variable from the
# previous example. Specify:
#
# ** 3. a) ####
#
# $F_Y(y)$
#

FY.dist = function(y){
    # calculated from the relation FY(y)=P(Y<y)=P(3X + 1<y)=...
    x = (y-1)/3
    FY = F.dist(x)
    return(FY)
}
y = seq(from = -3, to = 2, by = 0.001) # points on the x-axis
FY = FY.dist(y)
plot(y, FY, type='l')

# ** 3. b) ####
#
# $f_Y(y)$
#

# derivation of F_Y
fY.dens = function(y){
    res = 2/9*(y + 2)
    res[y < -2] = 0 # 0 for x<-2
    res[y > 1] = 0  # 1 for x>1
    return(res)
}
integrate(fY.dens,-2,1)$value # total integral check
y = seq(from = -3, to = 2, by = 0.001) # points on the x-axis
fY = fY.dens(y)
plot(y, fY, cex=0.2)

# ** 3. c) ####
#
# E(Y), D(Y), σ(Y)
#

# E(Y)
y_fy = function(y){
    fy = fY.dens(y)
    return(y*fy)
}
# we integrate only where we know that f(y) is nonzero
E_Y = integrate(y_fy, -2, 1)$value
E_Y
0

# alternatively
E_Y = 3*E_X + 1
E_Y

# E(Y ^ 2)
yy_fy = function(y){
    fy = fY.dens(y)
    return(y*y*fy)
}
# we integrate only where we know that f(y) is nonzero
E_YY = integrate(yy_fy, -2, 1)$value
E_YY
1/2

# D(Y)
D_Y = E_YY - E_Y^2
D_Y
1/2

# alternatively
D_Y = 3^2*D_X
D_Y

# sigma(Y)
sqrt(D_Y)
sqrt(2)/2

# * Example 4 ####
#
# Calculate $\omega$ such that a random variable X with probability
# density:$f(x)=\begin{cases} 0 & x < 0 \\ 3e^{-3x}    & x \geq 0 \end{cases}$is
# greater than $\omega$ with probability 0.3.
#

F.dist = function(x){
    res = 1 - exp(-3*x)
    res[x < 0] = 0 # 0 for x<=0
    return(res)
}

x = seq(from = -1, to = 3, by = 0.001) # points on the x-axis
FX = F.dist(x)
plot(x, FX, type='l')
lines(c(-1, 3),c(0.7, 0.7))

x[FX >= 0.7][1]

-1/3*log(0.3)


#Random design

'''
A fast food franchise is test marketing 3 new menu items.
To find out if they the same popularity, 18 franchisee
restaurants are randomly chosen for participation in t
he study. In accordance with the completely randomized design,
6 of the restaurants are randomly chosen to test market the
first new menu item, another 6 for the second menu item, and
the remaining 6 for the last menu item.
'''

'''
Suppose the following table represents the sales figures of
the 3 new menu items in the 18 restaurants after a week of
test marketing. At .05 level of significance, test whether
the mean sales volume for the 3 new menu items are all equal.

'''

#Cargar el archivo fastfood-1.txt

library(readr)
df1 <- read_csv('fastfood-1.csv')
View(dataset)

#Concatenar las filas
r = c(t(as.matrix(df1)))

f = c("Item1","Item2","Item3") #niveles de tratamiento
k = 3 #nro de niveles de tratamiento
n = 6# #obesrvaciones por tratamiento

#crear un vector de factores que corresponde a cada elemento de r en3 pasos

tm = gl(k, 1, n*k, factor(f))

#aplicamos aov
av = aov(formula formula = r ~ tm)

summary(av)

'''
            Df Sum Sq Mean Sq F value Pr(>F)
tm           2  745.4   372.7   2.541  0.112
Residuals   15 2200.2   146.7

Como pvalue = 0.112>.05 niveles de significancia, aceptamos la hipotesis
'''


#' @include Bayesian_Bricks.r

countFreq <- function(x,uniqx=NULL){
    if(!is.factor(x)){
        if(!is.null(uniqx)) x <- factor(x,levels=uniqx)
        else x <- factor(x)
    }
    as.numeric(tabulate(x,nbins = length(levels(x))))
}
countFreq_Weighted <- function(x,uniqx=NULL,w){
    if(length(x)!=length(w)) stop("length of x and w don't match")
    if(!is.factor(x)){
        if(!is.null(uniqx)) x <- factor(x,levels=uniqx)
        else x <- factor(x)
    }
    vapply(split(x=w,f=x),sum,FUN.VALUE = numeric(1),USE.NAMES = FALSE)
}

#' @title Random generation for Categorical distribution
#' @description
#' Generate random integer samples from a Categorical distribution. For a random variable x, the density function of categorical distribution is defined as
#'   \deqn{prod_{k in 1:K} p_k^{I(x=k)}}
#' Where K is the number of unique values.
#' @seealso \code{\link{dCategorical}}
#' @param n integer, number of samples.
#' @param p numeric, probabilities. length(p)=K.
#' @return An integer vector of length n.
#' @export
#' @examples
#' rCategorical(n=20,p=c(1,2))
rCategorical <- function(n,p){
    sample.int(n=length(p), size = n, replace = TRUE, prob = p)
}

#' @title Probability mass function for Categorical distribution
#' @description
#' Calculate probability masses for integer valued Categorical random samples.
#' For a random variable x, the density function of categorical distribution is defined as
#'   \deqn{prod_{k in 1:K} p_k^{I(x=k)}}
#' Where K is the number of unique values.
#' @seealso \code{\link{rCategorical}}
#' @param x integer, categorical samples.
#' @param p numeric, probabilities.
#' @return A numeric vector of the same length of 'x'.
#' @export
#' @examples
#' \donttest{
#' dCategorical(x=c(1L,2L,1L),p=c(1,2))
#' }
dCategorical <- function(x,p){
    p[x]
}

#' @title Random generation for Dirichelt distribution
#' @description
#' Generate random samples from Dirichlet distribution. For a random vector x, the density function is Dirichlet distribution is defined as:
#'   1/Beta(alpha) prod_{i=1:p}  x_i^{alpha_i -1}
#' Where Beta() is the beta function. p is the dimension of x.
#' @seealso \code{\link{dDir}}
#' @param n integer, number of samples.
#' @param alpha numeric, Dirichlet parameter.
#' @return A numeric matrix of n rows and length(alpha) columns.
#' @export
#' @examples
#' rDir(5,c(1,2,3)) #generate 5 samples with parameters c(1,2,3)
#' @import stats
rDir <- function(n, alpha){
    l <- length(alpha)
    x <- matrix(rgamma(l * n, alpha), ncol = l, byrow = TRUE)
    sm <- x %*% rep(1, l)
    x/as.vector(sm)
}

#' @title Density function for Dirichelt distribution
#' @description
#' Calculate the densities of a given set of Dirichlet samples. For a random vector x, the density function is defined as:
#'   1/Beta(alpha) prod_{i=1:p}  x_i^{alpha_i -1}
#' Where Beta() is the beta function. p is the dimension of x.
#' @seealso \code{\link{rDir}}
#' @param x matrix or numeric vector, if matrix every row of x is an observation, if numeric vector, it's the same as a matrix with only one row.
#' @param alpha numeric, Dirichlet parameter.
#' @param LOG logical, return the log density if set to "TRUE".
#' @return A numeric vector of density values.
#' @export
#' @examples
#' x <- rDir(5,c(1,2,3)) #generate 5 samples with parameters c(1,2,3)
#' dDir(x,c(1,2,3))
#' dDir(x,c(1,2,3),LOG=TRUE)
dDir <- function(x, alpha,LOG=FALSE){
    if(!is.matrix(x))
        if(is.numeric(x))
            x <- t(x)
        else
            stop("Error in ddir():x must be a matrix or an integer/numeric vector")
    if(length(alpha)==1) alpha <- rep(alpha,ncol(x))
    if(ncol(x)!=length(alpha))
        stop("Error in ddir(): columns of x and length of alpha don't match")
    out <- apply(x,1,function(l){
        s <- (alpha - 1) * log(l)
        s <- ifelse(alpha == 1 & l == 0, -Inf, s)
        sum(s)
    })
    logD <- sum(lgamma(alpha)) - lgamma(sum(alpha))
    out <- out- logD
    if(!LOG) out <- exp(out)
    return(out)
}

#' @title Create objects of type "CatDirichlet".
#' @description
#' Create an object of type "CatDirichlet", which represents the Categorical (Multinomial) and Dirichlet conjugate structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' The created object will be used as a place for recording and accumulating information in the related inference/sampling functions such as posterior(), posteriorDiscard(), MAP(), marginalLikelihood(), dPosteriorPredictive(), rPosteriorPredictive() and so on. A categorical distribution is defined on a set of unique labels, usually these labels are integers, they can also be characters and factors.
#' @seealso \code{\link{posterior.CatDirichlet}},\code{\link{posteriorDiscard.CatDirichlet}},\code{\link{MAP.CatDirichlet}},\code{\link{MPE.CatDirichlet}},\code{\link{marginalLikelihood.CatDirichlet}},\code{\link{rPosteriorPredictive.CatDirichlet}},\code{\link{dPosteriorPredictive.CatDirichlet}} ...
#' @param objCopy an object of type "CatDirichlet". If "objCopy" is not NULL, the function create a new "CatDirichlet" object by copying the content from objCopy, otherwise this new object will be created by using "ENV" and "gamma". Default NULL.
#' @param ENV environment, specify where the object will be created.
#' @param gamma list, a named list of parameters, gamma=list(alpha,uniqueLabels). Where gamma$alpha is a numeric vector specifying the parameters of the Dirichlet distribution, gamma$uniqueLabels is a integer/character vector specifying the unique category labels of the Categorical distribution.
#' @return An object of class "CatDirichlet".
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=c(1,2,1),uniqueLabels = letters[1:3]))
#' obj #print the content
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
CatDirichlet <- function(objCopy=NULL,ENV=parent.frame(),gamma=list(alpha=1,uniqueLabels=1L)){
    object <- BasicBayesian(ENV = ENV)

    if(!is.null(objCopy)){
        if(!.is(objCopy,"CatDirichlet")) stop("'objCopy' must be of class 'CatDirichlet'")
        object$gamma <- objCopy$gamma
        object$H <- objCopy$H
        object$F <- objCopy$F
    }else{
        if(!missing(gamma))
            if((!is.list(gamma)) |
               (!all(names(gamma) %in% c("alpha","uniqueLabels"))))
                stop("gamma must be list(alpha,uniqueLabels)")
        if(length(gamma$alpha)==1L) gamma$alpha <- rep(gamma$alpha,length(gamma$uniqueLabels))
        if(length(gamma$alpha)!=length(gamma$uniqueLabels)) stop("length of 'alpha' and 'uniqueLabels' in 'gamma' don't match!")
        object$gamma <- gamma
        object$H <- "Dirichlet"
        object$F <- "Categorical"
    }

    class(object) <- c("CatDirichlet",class(object))
    return(object)
}

#' @title Sufficient statistics of a "CatDirichlet" object
#' @description
#' For following Categorical-Dirichlet model structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' The sufficient statistics of a set of samples x is: \cr
#' \itemize{
#'  \item the effective counts of each unique label in x. i.e. T(x)[i] = sum(uniqueLabels[i]%in%x). Unique values of x must be in obj$gamma$uniqueLabels, where "obj" is a "CatDirichlet" object, see examples below.
#' }
#' @seealso \code{\link{CatDirichlet}}, \code{\link{sufficientStatistics_Weighted.CatDirichlet}}
#' @param obj A "CatDirichlet" object.
#' @param x numeric,integer or character, samples of the Categorical distribution.
#' @param foreach logical, specifying whether to return the sufficient statistics for each observation. Default FALSE.
#' @param ... Additional arguments to be passed to other inherited types.
#' @return An object of class "ssCat", the sufficient statistics of a set of categorical samples. Or an object of the same class as x if foreach=TRUE.
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=runif(26,1,2),uniqueLabels = letters))
#' x <- sample(letters,size = 20,replace = TRUE)
#' w <- runif(20)
#' sufficientStatistics(obj=obj,x=x)       #return the counts of each unique label
#' sufficientStatistics_Weighted(obj=obj,x=x,w=w) #return the weighted counts of each unique lable
#' sufficientStatistics(obj=obj,x=x,foreach = TRUE) #return the sample itself
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
sufficientStatistics.CatDirichlet <- function(obj,x,foreach=FALSE,...){
    if(missing(x)) stop("'x' must be specified")
    if(!is.vector(x)) x <- as.vector(x)
    if(foreach){
        x
    }else{
        ss <- countFreq(x=x,uniqx = obj$gamma$uniqueLabels)
        class(ss) <- "ssCat"
        ss
    }
}

#' @title Weighted sufficient statistics of a "CatDirichlet" object
#' @description
#' For following Categorical-Dirichlet model structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' the sufficient statistics of a set of samples x and weights w are: \cr
#'   the effective counts (in this case the sum of the weight w) of each unique label in x \cr
#' Unique values of x must be in obj$gamma$uniqueLabels, where "obj" is a "CatDirichlet" object, see examples below.
#'
#' @seealso \code{\link{sufficientStatistics.CatDirichlet}} \code{\link{CatDirichlet}}
#' @param obj A "CatDirichlet" object.
#' @param x numeric,integer or character, samples of the Categorical distribution.
#' @param w numeric, sample weights.
#' @param foreach logical, specifying whether to return the sufficient statistics for each observation. Default FALSE.
#' @param ... Additional arguments to be passed to other inherited types.
#' @return An object of class "ssCat", the sufficient statistics of a set of categorical samples. Or an object of the same class as x if foreach=TRUE.
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=runif(26,1,2),uniqueLabels = letters))
#' x <- sample(letters,size = 20,replace = TRUE)
#' w <- runif(20)
#' sufficientStatistics(obj=obj,x=x)       #return the counts of each unique label
#' sufficientStatistics_Weighted(obj=obj,x=x,w=w) #return the weighted counts of each unique lable
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
sufficientStatistics_Weighted.CatDirichlet <- function(obj,x,w,foreach=FALSE,...){
    if(missing(x)|missing(w)) stop("'x' and 'w' must be both specified")
    if(!is.vector(x)) x <- as.vector(x)
    if(!is.vector(w)) w <- as.vector(w)
    if(length(x)!=length(w)) stop("length of 'x' and 'w' don't match!")
    if(foreach){
        x
    }else{
        ss <- countFreq_Weighted(x=x,uniqx = obj$gamma$uniqueLabels,w=w)
        class(ss) <- "ssCat"
        ss
    }
}

#' @title Update a "CatDirichlet" object with sample sufficient statistics
#' @description
#' For the model structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' update alpha by adding the information of newly observed samples x. \cr
#' The model structure and prior parameters are stored in a "CatDirichlet" object, the prior parameters in this object will be updated after running this function.
#'
#' @seealso \code{\link{CatDirichlet}},\code{\link{posteriorDiscard.CatDirichlet}}
#' @param obj A "CatDirichlet" object.
#' @param ss Sufficient statistics of x. In Categorical-Dirichlet case the sufficient statistic of sample x can be either x itself, of an "ssCat" object generated by the function sufficientStatistics.CatDirichlet().
#' @param w Sample weights, default NULL.
#' @param ... Additional arguments to be passed to other inherited types.
#' @return None. the gamma stored in "obj" will be updated based on "ss".
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=rep(1,26),uniqueLabels = letters))
#' x <- sample(letters,size = 20,replace = TRUE)
#' w <- runif(20)
#' posterior(obj=obj,ss=x)
#' obj
#' posteriorDiscard(obj=obj,ss=x)
#' obj
#' ## weighted sample
#' posterior(obj=obj,ss=x,w=w)
#' obj
#' posteriorDiscard(obj=obj,ss=x,w=w)
#' obj
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
posterior.CatDirichlet <- function(obj,ss,w=NULL,...){
    if(missing(ss)) stop("'ss' must be specified")
    if(.is(ss,"ssCat")){
        posterior_bySufficientStatistics.CatDirichlet(obj=obj,ss=ss)
        invisible(return())
    }
    if(!is.vector(ss)) ss <- as.vector(ss)
    idx <- match(ss,obj$gamma$uniqueLabels,nomatch = NA)
    if(anyNA(idx)) stop("Detect un-recorded label!")
    if(!is.null(w)){
        if(!is.vector(w)) w <- as.vector(w)
        if(length(ss)!=length(w)) stop("length of 'ss' and 'w' don't match!")
        if(length(ss)==1L){
            obj$gamma$alpha[idx] <- obj$gamma$alpha[idx]+w
        }else{
            for(i in 1L:length(ss)) obj$gamma$alpha[idx[i]] <- obj$gamma$alpha[idx[i]]+w[i]
        }
    }else{
        if(length(ss)==1L){
            obj$gamma$alpha[idx] <- obj$gamma$alpha[idx]+1
        }else{
            for(id in idx) obj$gamma$alpha[id] <- obj$gamma$alpha[id]+1
        }
    }
}

#' @title Update a "CatDirichlet" object with sample sufficient statistics
#' @description Update a "CatDirichlet" object with sample sufficient statistics
#' @param obj A "CatDirichlet" object.
#' @param ss Sufficient statistics of x. In Categorical-Dirichlet case the sufficient statistic of sample x can be either x itself, of an "ssCat" object generated by the function sufficientStatistics.CatDirichlet().
#' @param ... Additional arguments to be passed to other inherited types.
#' @return None. the gamma stored in "obj" will be updated based on "ss".
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
posterior_bySufficientStatistics.CatDirichlet <- function(obj,ss,...){
    if(missing(ss)) stop("'ss' must be specified")
    if(!.is(ss,"ssCat")) stop("'ss' must be of class 'ssCat', you need to use sufficientStatistics() to generate 'ssCat' objects")

    if(length(ss)!=length(obj$gamma$alpha)) stop("length 'ss' and dirichlet parameters don't match")
    obj$gamma$alpha <- obj$gamma$alpha + as.numeric(ss)
}

#' @title Update a "CatDirichlet" object with sample sufficient statistics
#' @description
#' Contrary to posterior(), this function will update alpha by removing the information of observed samples x for the model structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' The model structure and prior parameters are stored in a "CatDirichlet" object, the prior parameters in this object will be updated after running this function.
#'
#' @seealso \code{\link{CatDirichlet}},\code{\link{posterior.CatDirichlet}}
#' @param obj A "CatDirichlet" object.
#' @param ss Sufficient statistics of x. In Categorical-Dirichlet case the sufficient statistic of sample x can be either x itself, of an "ssCat" object generated by the function sufficientStatistics.CatDirichlet().
#' @param w Sample weights,default NULL.
#' @param ... Additional arguments to be passed to other inherited types.
#' @return None. the prior parameters stored in "obj" will be updated with the information in "ss".
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=rep(1,26),uniqueLabels = letters))
#' x <- sample(letters,size = 20,replace = TRUE)
#' w <- runif(20)
#' posterior(obj=obj,ss=x)
#' obj
#' posteriorDiscard(obj=obj,ss=x)
#' obj
#' ## weighted sample
#' posterior(obj=obj,ss=x,w=w)
#' obj
#' posteriorDiscard(obj=obj,ss=x,w=w)
#' obj
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
posteriorDiscard.CatDirichlet <- function(obj,ss,w=NULL,...){
    if(missing(ss)) stop("'ss' must be specified")
    if(.is(ss,"ssCat")){
        posteriorDiscard_bySufficientStatistics.CatDirichlet(obj = obj,ss = ss)
        invisible(return())
    }
    if(!is.vector(ss)) ss <- as.vector(ss)
    idx <- match(ss,obj$gamma$uniqueLabels,nomatch = NA)
    if(anyNA(idx)) stop("Detect un-recorded label!")
    if(!is.null(w)){
        if(!is.vector(w)) w <- as.vector(w)
        if(length(ss)!=length(w)) stop("length of 'ss' and 'w' don't match!")
        if(length(ss)==1L){
            obj$gamma$alpha[idx] <- obj$gamma$alpha[idx]-w
        }else{
            for(i in 1L:length(ss)) obj$gamma$alpha[idx[i]] <- obj$gamma$alpha[idx[i]]-w[i]
        }
    }else{
        if(length(ss)==1L){
            obj$gamma$alpha[idx] <- obj$gamma$alpha[idx]-1
        }else{
            for(id in idx) obj$gamma$alpha[id] <- obj$gamma$alpha[id]-1
        }
    }

}

#' @title Update the prior Dirichlet distribution with sample sufficient statistics
#' @seealso \code{\link{posteriorDiscard}}
#' @param obj A "CatDirichlet" object.
#' @param ss Sufficient statistics of x. In Categorical-Dirichlet case the sufficient statistic of sample x can be either x itself, of an "ssCat" object generated by the function sufficientStatistics.CatDirichlet().
#' @param ... Additional arguments to be passed to other inherited types.
#' @return None. the gamma stored in "obj" will be updated based on "ss".
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
posteriorDiscard_bySufficientStatistics.CatDirichlet <- function(obj,ss,...){
    if(missing(ss)) stop("'ss' must be specified")
    if(!.is(ss,"ssCat")) stop("'ss' must be of class 'ssCat', you need to use sufficientStatistics() to generate 'ssCat' objects")
    if(length(ss)!=length(obj$gamma$alpha)) stop("length 'ss' and dirichlet parameters don't match")
    obj$gamma$alpha <- obj$gamma$alpha - as.numeric(ss)
}

#' @title MAP estimate of a "CatDirichlet" object
#' @description
#' Generate the MAP estimate of "pi" in following Categorical-Dirichlet structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' The model structure and prior parameters are stored in a "CatDirichlet" object. \cr
#' MAP is pi_MAP = argmax p(pi|alpha,x).
#' @seealso \code{\link{CatDirichlet}}
#' @param obj A "CatDirichlet" object.
#' @param ... Additional arguments to be passed to other inherited types.
#' @return A numeric vector, the MAP estimate of "pi".
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=rep(1,26),uniqueLabels = letters))
#' x <- sample(letters,size = 20,replace = TRUE)
#' w <- runif(20)
#' posterior(obj=obj,ss=x,w=w)
#' MAP(obj)
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
MAP.CatDirichlet <- function(obj,...){
    tmp <- obj$gamma$alpha-1
    tmp/sum(tmp)
}

#' @title MPE of a "CatDirichlet" object
#' @description
#' Generate the MPE of "pi" in following Categorical-Dirichlet structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' The model structure and prior parameters are stored in a "CatDirichlet" object. \cr
#' MPE is pi_MPE = E(pi|alpha,x), E() is the expectation function.
#' @seealso \code{\link{CatDirichlet}}
#' @param obj A "CatDirichlet" object.
#' @param ... Additional arguments to be passed to other inherited types.
#' @return A numeric vector, the MPE of "pi".
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=rep(1,26),uniqueLabels = letters))
#' x <- sample(letters,size = 20,replace = TRUE)
#' w <- runif(20)
#' posterior(obj=obj,ss=x,w=w)
#' MPE(obj)
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
MPE.CatDirichlet <- function(obj,...){
    obj$gamma$alpha/sum(obj$gamma$alpha)
}

#' @title Density function of the posterior distribution of a "CatDirichlet" object
#' @description
#' Generate the the density value of the posterior distribution of the following structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' The model structure and prior parameters are stored in a "CatDirichlet" object. \cr
#' Posterior density is the density function of Dir(pi|alpha).
#' @seealso \code{\link{CatDirichlet}}, \code{\link{rPosterior.CatDirichlet}}
#' @param obj A "CatDirichlet" object.
#' @param pi matrix or a numeric vector. When pi is a matrix, each row is an observation. When pi is a vector, it will be treated as only one observation.
#' @param LOG Return the log density if set to "TRUE".
#' @param ... Additional arguments to be passed to other inherited types.
#' @return numeric vector, the posterior densities for each row of pi.
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=runif(26),uniqueLabels = letters))
#' dPosterior(obj = obj,pi = runif(26))
#' dPosterior(obj = obj,pi = matrix(runif(26*10),nrow = 10))
dPosterior.CatDirichlet <- function(obj,pi,LOG=TRUE,...){
    if(is.vector(pi)) pi <- matrix(pi,nrow=1)
    if(ncol(pi)!=length(obj$gamma$alpha)) stop("Dimensions of pi and obj$gamma$alpha don't match!")
    dDir(x=pi,alpha = obj$gamma$alpha,LOG = LOG)
}

#' @title Generate ramdom samples from the posterior distribution of a "CatDirichlet" object
#' @description
#' Generate random samples from the posterior distribution of the following structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' The model structure and prior parameters are stored in a "CatDirichlet" object. \cr
#' Posterior distribution is Dir(pi|alpha).
#' @seealso \code{\link{CatDirichlet}}, \code{\link{dPosterior.CatDirichlet}}
#' @param obj A "CatDirichlet" object.
#' @param n integer, the number of samples to be generated.
#' @param ... Additional arguments to be passed to other inherited types.
#' @return A matrix, each row is a sample of pi.
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=rep(1,26),uniqueLabels = letters))
#' rPosterior(obj = obj,n=3)
rPosterior.CatDirichlet <- function(obj,n=1,...){
    rDir(n=n,alpha = obj$gamma$alpha)
}

#' @title Marginal likelihood of a "CatDirichlet" object
#' @description
#' Generate the marginal likelihood of the following model structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' The model structure and prior parameters are stored in a "CatDirichlet" object. \cr
#' Marginal likelihood is the likelihood of x|alpha.
#' @seealso \code{\link{CatDirichlet}}, \code{\link{marginalLikelihood_bySufficientStatistics.CatDirichlet}}
#' @param obj A "CatDirichlet" object.
#' @param x numeric/integer/character vector, observed Categorical samples.
#' @param LOG Return the log density if set to "TRUE".
#' @param ... Additional arguments to be passed to other inherited types.
#' @return numeric, the marginal likelihood.
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=runif(26,1,2),uniqueLabels = letters))
#' x <- sample(letters,size = 20,replace = TRUE)
#' marginalLikelihood(obj=obj,x=x,LOG = TRUE) #marginal likelihood
#' ss <- sufficientStatistics(obj = obj,x=x)
#' marginalLikelihood_bySufficientStatistics(obj=obj,ss = ss,LOG = TRUE)
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
marginalLikelihood.CatDirichlet <- function(obj,x,LOG=TRUE,...){
    if(missing(x)) stop("'x' must be specified")
    if(!is.vector(x)) x <- as.vector(x)
    ss <- countFreq(x=x,uniqx = obj$gamma$uniqueLabels)
    class(ss) <- "ssCat"
    marginalLikelihood_bySufficientStatistics.CatDirichlet(obj=obj,ss=ss,LOG = LOG)
}

#' @title Marginal likelihood of a "CatDirichlet" object, using sufficient statistics
#' @description
#' Generate the marginal likelihood of a set of observations of the following model structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' The model structure and prior parameters are stored in a "CatDirichlet" object. \cr
#' Marginal likelihood is the likelihood of x|alpha
#' @seealso \code{\link{CatDirichlet}}, \code{\link{marginalLikelihood.CatDirichlet}}
#' @param obj A "CatDirichlet" object.
#' @param ss Sufficient statistics of x. In Categorical-Dirichlet case the sufficient statistic of sample x can be either x itself, of an "ssCat" object generated by the function sufficientStatistics.CatDirichlet().
#' @param LOG Return the log density if set to "TRUE".
#' @param ... Additional arguments to be passed to other inherited types.
#' @return numeric, the marginal likelihood.
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=runif(26,1,2),uniqueLabels = letters))
#' x <- sample(letters,size = 20,replace = TRUE)
#' marginalLikelihood(obj=obj,x=x,LOG = TRUE) #marginal likelihood
#' ss <- sufficientStatistics(obj = obj,x=x)
#' marginalLikelihood_bySufficientStatistics(obj=obj,ss = ss,LOG = TRUE)
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
marginalLikelihood_bySufficientStatistics.CatDirichlet <- function(obj,ss,LOG=TRUE,...){
    if(missing(ss)) stop("'ss' must be specified")
    if(!.is(ss,"ssCat")){
        ss <- sufficientStatistics.CatDirichlet(obj = obj,x=ss,foreach = FALSE)
    }
    if(length(ss)!=length(obj$gamma$alpha)) stop("length 'ss' and dirichlet parameters don't match")
    a <- obj$gamma$alpha+as.numeric(ss)
    aa <- sum(a)
    aa0 <- sum(obj$gamma$alpha)
    logp <- lgamma(aa0) - lgamma(aa) + sum(lgamma(a)-lgamma(obj$gamma$alpha))
    if(!LOG) logp <- exp(logp)
    logp
}

#' @title Posterior predictive density function of a "CatDirichlet" object
#' @description
#' Generate the the density value of the posterior predictive distribution of the following structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' The model structure and prior parameters are stored in a "CatDirichlet" object. \cr
#' Posterior predictive is a distribution of x|alpha.
#' @seealso \code{\link{CatDirichlet}}, \code{\link{dPosteriorPredictive.CatDirichlet}}, \code{\link{marginalLikelihood.CatDirichlet}}
#' @param obj A "CatDirichlet" object.
#' @param x numeric/integer/character vector, observed Categorical samples.
#' @param LOG Return the log density if set to "TRUE".
#' @param ... Additional arguments to be passed to other inherited types.
#' @return A numeric vector, the posterior predictive density.
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=runif(26,1,2),uniqueLabels = letters))
#' x <- sample(letters,size = 20,replace = TRUE)
#' ## res1 and res2 should provide the same result
#' res1 <- dPosteriorPredictive(obj = obj,x=x,LOG = TRUE)
#' res2 <- numeric(length(x))
#' for(i in seq_along(x)) res2[i] <- marginalLikelihood(obj=obj,x=x[i],LOG = TRUE)
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
dPosteriorPredictive.CatDirichlet <- function(obj,x,LOG=TRUE,...){
    if(missing(x)) stop("'x' must be specified")
    if(!is.vector(x)) x <- as.vector(x)
    probs <- obj$gamma$alpha/sum(obj$gamma$alpha)
    out <- probs[match(x,obj$gamma$uniqueLabels)]
    if(LOG) out <- log(out)
    out
}

#' @title Generate random samples from the posterior predictive distribution of a "CatDirichlet" object
#' @description
#' Generate random samples from the posterior predictive distribution of the following structure:
#'      \deqn{pi|alpha \sim Dir(alpha)}
#'      \deqn{x|pi \sim Categorical(pi)}
#' Where Dir() is the Dirichlet distribution, Categorical() is the Categorical distribution. See \code{?dDir} and \code{dCategorical} for the definitions of these distribution. \cr
#' The model structure and prior parameters are stored in a "CatDirichlet" object \cr
#' posterior predictive is a distribution of x|alpha
#' @seealso \code{\link{CatDirichlet}}, \code{\link{dPosteriorPredictive.CatDirichlet}}
#' @param obj A "CatDirichlet" object.
#' @param n integer, number of samples.
#' @param ... Additional arguments to be passed to other inherited types.
#' @return A vector of the same type as obj$gamma$uniqueLabels.
#' @export
#' @examples
#' obj <- CatDirichlet(gamma=list(alpha=runif(26,1,2),uniqueLabels = letters))
#' rPosteriorPredictive(obj=obj,n=200)
#' @references Murphy, Kevin P. Machine learning: a probabilistic perspective. MIT press, 2012.
rPosteriorPredictive.CatDirichlet <- function(obj,n,...){
    if(missing(n)) stop("'n' must be specified")
    n <- as.integer(n)
    obj$gamma$uniqueLabels[sample.int(n=length(obj$gamma$uniqueLabels), size = n, replace = TRUE,prob = obj$gamma$alpha/sum(obj$gamma$alpha))]
}


A <- matrix(c(-8,1,-2,-20,2,-6,-1,-38,-3,-1,7,-34), 3, 4, byrow = T)
GaussForward <- function(A) {
  n <- nrow(A)
  m <- ncol(A)
  for(i in 1:n) {
    A[i,] <- A[i, ]/A[i,i]
    if (i==n) {
      break
    }
    for(j in i+1:(n-i)){
      A[j,i:m] <- A[j,i:m] - (A[j,i] * A[i, i:m])
    }
  }
  return(A)
}

GaussBackward <- function(A) {
  n <- nrow(A)
  m <- ncol(A)
  x <- vector()
  for(i in 1:n){
    c <- 0
    t <- 1
    for(j in (m-i):(m-1)){
      if((j) == (m-1)){
        break
      }
      c <- c + (x[i-t] * A[(n+1)-i,j+1])
      t <- t + 1
    }
    x[i] <- A[(n+1)-i,m] - c
  }
  print(A)
  for (i in n:1) {
    print(x[i])
  }
}


# Exploratory Data Analysis
library(UsingR)
library(rafalib)
x <- father.son$fheight
ps <- (seq(0,99) + 0.5)/100
qs <- quantile(x,ps)
normalqs <- qnorm(ps,mean(x),popsd(x))
plot(normalqs,qs,xlab="Normal percentiles",ylab="Height percentiles")
abline(0,1) ## identity line
qqnorm(x)
qqline(x)
library("rafalib", lib.loc="~/R/x86_64-pc-linux-gnu-library/3.3")
library("UsingR", lib.loc="~/R/x86_64-pc-linux-gnu-library/3.3")
x
ps
normalqs
plot(normalqs,qs,xlab="Normal percentiles",ylab="Height percentiles")
abline(0,1)
qqnorm(x)
qqline(x)
n <- 1000
x <- rnorm(x)
qqnorm(x)
qqline(x)
dfs <- c(3,6,12,30)
mypar(2,2)
for(df in dfs){
x <- rt(1000,df)
qqnorm(x,xlab="t quantiles",main=paste0("d.f=",df),ylim=c(-6,6))
qqline(x)
}
# Boxplots
mypar(1,2)
hist(exec.pay) # in UsingR package
qqnorm(exec.pay)
qqlinr(exec.pay)
qqline(exec.pay)
boxplot(exec.pay, ylab="10,000s of dollars", ylim=c(0,400))
# Scatterplots
data("father.son")
x=father.sons$height
x=father.son$height
x=father.son$fheight
y=father.som$sheight
y=father.son$sheight
plot(x,y,xlab="Father's height in inches",ylab="Son's height in inches",main=paste("correlation=",signif(cor(x,y),2)))
# Stratification
groups <- split(y,round(x))
boxplot(groups)
mypar(1)
boxplot(groups)
print(mean(y[round(x) == 72]))
groups <- plit(y,round(x))
groups <- split(y,round(x))
mypar(2,2)
for(i in c(5,8,11,14)){
qqnorm(groups[[i]], main=paste0("X=",names(groups)[i],"strata"), ylim=range(y),xlim=c(-2.5,2.5))
qqline(groups[[i]])
}
x=(x-mean(x))/sd(x)
y=(y-mean(y))/sd(y)
means=tapply(y, round(x*4)/4,mean)
fatherheights=as.numeric(names(means))
mypar(1,1)
plot(fatherheights, means, ylab="average of strata son heights", ylim=range(fatherheights))
abline(0, corr(x,y))
abline(0, cor(x,y))
# Plots To Avoid
pie(browsers,main="Browser Usage (August 2013)")
browser
url <- "https://github.com/kbroman/Talk_Graphs/raw/master/R/fig4.RData"
filename <- "fig4.RData"
if (!file.exists(filename))
dwnload(url,filename)
library(rafalib)
library(downloader)
if (!file.exists(filename))
download(url,filename)
load(filename)
mypar(1,2)
plot(x,y,lwd=2,type="n")
fit <- lm(y-x)
fit <- lm(y~x)
abline(fit$coef,lwd=2)
b <- round(fit$coed,4)
b <- round(fit$coef,4)
text(78, 200, paste("y =",b[1], "+", b[2], "x"), adj=c(0,0.5))
rhi <- round(cor(x,y),4)
text(78,187,expression(paste(rhi," = 0.8567")),adj=c(0,0.5))
plot(x,y,lwd=2)
fit <- lm(y~x)
abline(fir$coef,lwd=2)
abline(fit$coef,lwd=2)
# Comparison
set.seed(122011970)
before <- runif(6,5,8)
after <- rnorm(6, before*1.05, 2)
li <- range(c(before,after))
ymx <- max(abs(after-before))
mypar(1,2)
plot(before,after, xlab="Before", ylab="After", ylim=li, xlim=li)
plot(before, after=before, xlab="Before", ylim=c(-ymx, ymx), ylab="Change (After - Before)", lwd=2)
plot(before, after-before, xlab="Before", ylim=c(-ymx, ymx), ylab="Change (After - Before)", lwd=2)
plot(before, after-before, xlab="Before", ylim=c(-ymx, ymx), ylab="Change (After - Before)", lwd=2)
abline(h=0, lty=2, col=1)
z <- rep(c(0,1),rep(6,2))
mypar(1,2)
plot(z, c(before, after), xaxt="n", ylab="Response", xlab="", xlim=c(-0.5,1.5))
axis(side=1, at=c(0,1), c("Before","After"))
segments(rep(0,6), before, rep(1,6), after, col=1)
boxplot(before, after, names=c("Before","After"),ylab="Response")
# Avoid 3-D plots
filename <- "fig8dat.csv"
url <- "https://github.com/kbroman/Talk_Graphs/raw/master/R/fig8dat.RData"
if (!file.exists(filname))
download(url,filename)
if (!file.exists(filename))
download(url,filename)
url <- "https://github.com/kbroman/Talk_Graphs/raw/master/R/fig8dat.csv"
if (!file.exists(filename))
download(url,filename)
plot(x[,1],x[,2],xlab="log Dose",ylab="Proportion survived",ylim=c(0,1),type="l",lwd=2,col=1)
plot(x[,1],x[,1],xlab="log Dose",ylab="Proportion survived",ylim=c(0,1),type="l",lwd=2,col=1)
x <- read.table(filename)
x <- read.table(filename, sep",", header=TRUE)
x <- read.table(filename, sep=",", header=TRUE)
plot(x[,1],x[,1],xlab="log Dose",ylab="Proportion survived",ylim=c(0,1),type="l",lwd=2,col=1)
lines(x[,1],x[,3],lwd=2,col=2)
lines(x[,1],x[,4],lwd=2,col=3)
legend(1,0.4,c("Drug A","Drug B","Drug C"),lwd=2,col=1:3)
lines(x[,1],x[,2],lwd=2,col=1)
plot(x, y1, ylim=c(0,1),type="n", xlab="Dose", ylab="Response")
plot(x, y1, ylim=c(0,1),type="n", xlab="Dose", ylab="Response")
# Too many significant digits
heights <- cbind(rnorm(8,73,3),rnorm(8,73,3),rnorm(8,30,3), rnorm(8,78,3),rnorm(8,78,3))
colnames(heights) <- c("SG","PG","C"."PF","SF")
colnames(heights) <- c("SG","PG","C","PF","SF")
rownames(heights) <- paste("team".1:8)
rownames(heights) <- paste("team"=1:8)
paste("team",1:8)
heights
round(heights,1)
## Misunderstanding correlation (Advanced)
## Robust summaries
set.seed(1)
x=c(rnorm(100,0,1)) ##real distribution
x[23] <- 100 ## mistake made in 23rd measurement
boxplot(x)
cat("The average is",mean(x),"and the SD is",sd(x))
median(x)
y=c(rnorm(100,0,1))
mean(x)
mean(y)
## The mean absolute deviation
mad(x)
# Spearman correlation
set.seed(1)
x=c(rnorm(100,0,1)) ## real distribution with a surprise
x[23]
x[23] <- 100
y=c(rnorm(100,0,1)) # real distribution
y[23] <- 84 ## similar mistake in the 23rd measurement
library(rafalib)
mypar()
plot(x,y,main=paste0("correlation=",round(cor(x,y),3)),pch=21,bg=1,xlim=c(-3,100),ylim=c(-3,100))
abline(0,1)
mypar(1,2)
plot(x,y,main=paste0("correlation=",round(cor(x,y),3)),pch=21,bg=1,xlim=c(-3,100),ylim=c(-3,100))
plot(rank(x),rank(y),main=paste0("correlation=",round(corr(x,y,method="spearman"),3)),pch=21,bg=1,xlim=c(-3,100),ylim=c(-3,100))
plot(rank(x),rank(y),main=paste0("correlation=",round(cor(x,y,method="spearman"),3)),pch=21,bg=1,xlim=c(-3,100),ylim=c(-3,100))
plot(x,y,main=paste0("correlation=",round(cor(x,y),3)),pch=21,bg=1,xlim=c(-3,100),ylim=c(-3,100))
plot(x,y,main=paste0("correlation=",round(cor(x,y),3)),pch=21,bg=1,xlim=c(-3,100),ylim=c(-3,100))
plot(rank(x),rank(y),main=paste0("correlation=",round(cor(x,y,method="spearman"),3)),pch=21,bg=1,xlim=c(-3,100),ylim=c(-3,100))
abline(0,1)
# Symmetry of log ratios
x <- 2^(rnorm(100))
y <- 2^(rnorm(100))
ratios <- x/y
hist(ratios)
savehistory("~/repos/RLifeSciences/Chappie2/worklog.r")


fatorial <- function(n) {
  res = 1
  for(i in 1:n) {
    res = res*i
  }
  return(res)
}
#fatorial(5)
#res = 1
#i = 1
#res = res*1 = 1 (1)
#i = 2
#res = res*2 = 2 (1x2)
#i = 3
#res = res*3 = 6 (1x2x3)
#i = 4
#res = res*4 = 24 (1x2x3x4)
#i = 5
#res = res*5 = 120 (1x2x3x4x5)


mu <- pi
sigmaSq <- (1.3)^3

n <- 10
M <- 10000

svar <- function(x){
  n <- length(x)
  xb <- mean(x)
  sv <- sum((x-xb)^2)/n
  return(sv)
}

data.sets <- matrix(rnorm(n = n*M, mean = mu, sd = sqrt(sigmaSq)), ncol = n, nrow = M)

xbars <- apply(data.sets, 1, mean)
sbars <- apply(data.sets, 1, svar)

par(mfrow=c(1, 2))

hist(xbars, probability = TRUE, main = "Média amostral", xlab = expression(bar(X[n])))
curve(dnorm(x, mean = mu, sd = sqrt(sigmaSq/n)), min(xbars), max(xbars), lwd = 2, add = TRUE)

hist(sbars, probability = TRUE, main = "Variância amostral", xlab = expression(bar(S[n]^2)))
curve(dgamma(x, shape = (n-1)/2, rate = n/(2*sigmaSq) ), min(sbars), max(sbars), lwd = 2, add = TRUE)


#Suppose the mean weight of King Penguins found in an Antarctic colony
#last year was 15.4 kg. In a sample of 35 penguins same time this year in
#the same colony, the mean penguin weight is 14.6 kg. Assume the sample
#standard deviation is 2.5 kg. At .05 significance level, can we reject
#the null hypothesis that the mean penguin weight does not differ from last
#year?

xbar = 14.6

mu0 =15.4

s = 2.5

n = 35

t = (xbar-mu0)/(s/(sqrt(n)))

t #-1.89

#valores criticos
alpha = .05
t.half.aplha = qt(1-alpha,df = n-1)

#se rechaza la hipotesis
c(-t.half.aplha,t.half.aplha)

#pvalue

pval = 2*pt(t,df=n-1)

pval #0.0668

Parcial/1. Prueba de hipotesis/TwoTailedMeanUknownVariance.r


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

rm(list = ls())

observed <- c(1.0, 2.3, 4.2, 7.1, 10.4)

(k <- length(observed))
# 5

(lambda.hat <- 1 / mean(observed))
# 0.2

test <- ks.test(observed, pexp, rate = 1 / mean(observed))

(D <- test$statistic[[1]])
# 0.181269246922018

(criticvalue <- quantile(replicate(1000, ks.test(rexp(k, lambda.hat), pexp, rate = lambda.hat)$statistic), 0.95))
# 95%: 0.56811734613071

D > criticvalue
# FALSE (H0 no refused)


## 2. The Mean ##

distribution  <-  c(0,2,3,3,3,4,13)
mean  <-  sum(distribution) / length(distribution)
center  <-  FALSE

values_above  <-  distribution[distribution > mean]
values_below  <-  distribution[distribution < mean]

distances_above <- values_above - mean
distances_below <- mean - values_below

equal_distances  <-  sum(distances_above) == sum(distances_below)

## 3. Generating a distribution ##

set.seed(1)
distribution <- sample.int(100, size=10)
ndistribution <- replicate(n=50, expr=sample.int(25, size=5))

## 4. The Mean as a Balance Point ##

set.seed(1)

checkDist <- function(){
    distribution <- sample.int(1000, size=10)
    mean  <-  sum(distribution) / length(distribution)
    round(sum(distribution - mean)) == 0
}

equal_distances <- sum(replicate(n=5000, expr=checkDist()))

## 5. Defining the Mean Algebraically ##

one  <-  FALSE # we don't use the symbol mu for the sample mean
two  <-  FALSE # Should be N = 8, not n = 8
three  <-  FALSE # x-bar denotes the sample mean, not the population mean

## 6. An Alternative Definition ##

distribution_1  <-  c(42, 24, 32, 11)
distribution_2  <-  c(102, 32, 74, 15, 38, 45, 22)
distribution_3  <-  c(3, 12, 7, 2, 15, 1, 21)
compute_mean <- function(distribution) {
    N <- length(distribution)
    sum_of_the_distribution = 0
    for ( i in 1:N) {
        sum_of_the_distribution <- sum_of_the_distribution + distribution[i]
    }

    sum_of_the_distribution / N
}

mean_1  <-  compute_mean(distribution_1)
mean_2  <-  compute_mean(distribution_2)
mean_3  <-  compute_mean(distribution_3)

## 7. Introducing the Data ##

library(readr)
houses  <-  read_tsv('AmesHousing_1.txt')

one  <-  TRUE # every column that describes years is measured on an interval scale
two  <-  FALSE # `SalePrice` is measured on a ratio scale
three  <-  TRUE # The data set has less values than the initial one with 3970 rows which we don't know either whether it represents a population

## 8. Mean House Prices ##

compute_mean <- function(distribution) {
    N <- length(distribution)
    sum_of_the_distribution = 0
    for ( i in 1:N) {
        sum_of_the_distribution <- sum_of_the_distribution + distribution[i]
    }

    sum_of_the_distribution / N
}
computed_mean  <-  compute_mean(houses$SalePrice)
r_mean  <-  mean(houses$SalePrice)
means_are_equal  <-  (computed_mean == r_mean)

## 9. Challenge: Estimating the Population Mean ##

library(tibble)
library(ggplot2)
library(purrr)

set.seed(4)

parameter  <-  mean(houses$SalePrice)

sample_sizes  <-  seq(5, by=29, length.out=100)

sampling_errors <- map_dbl(sample_sizes,
                           function(x) parameter - mean(sample(houses$SalePrice,
                                                               size=x)) )

df <- tibble(x = sample_sizes, y = sampling_errors)

ggplot(data = df, aes(x = sample_sizes, y = sampling_errors)) +
    geom_point(size=2) +
    geom_hline(yintercept = 0) +
    geom_vline(xintercept = 2930) +
    labs(x = "Sample size",
         y = "Sampling error")

## 10. Estimates from Low-Sized Samples ##

library(tibble)
library(ggplot2)
set.seed(1)
mean_points <- replicate(n = 10000,
                         expr = mean(sample(houses$SalePrice,
                                            size = 100)))

ggplot(data = tibble(mean_points), aes(x = mean_points)) +
    geom_histogram(bins = 100,
                   position = "identity",
                   alpha = 0.5) +
    geom_vline(aes(xintercept = mean(houses$SalePrice))) +
    xlab("Sample mean") +
    ylab("Frequency") +
    xlim(0, 500000)

## 12. The Sample Mean as an Unbiased Estimator ##

population  <-  c(3, 7, 2)
library(purrr)

samples  <-  list(c(3, 7),
                  c(3, 2),
                  c(7, 2),
                  c(7, 3),
                  c(2, 3),
                  c(2, 7))

sample_means <- map_dbl(samples, function(x) mean(x))

population_mean  <-  mean(population)

mean_of_sample_means  <-  mean(sample_means)

unbiased  <-  (population_mean == mean_of_sample_means)

Data Analyst in R/Step 5 - Probability and Statistics/2. Statistics Intermediate in R Averages and Variability/1. The Mean.r


library(ggplot2)

# change these parameters if you want
max = 100
num_samples = 100

# generate 100 samples from 0 to 100
samples <- max * runif(num_samples)

# my power mean function
powermean <- function(samples, d) {
    if (d == 0) {
        exp(sum(log(samples)) / length(samples))
    } else {
        (sum(samples ^ d) / length(samples)) ^ (1 / d)
    }
}

# x axis goes from -10 to 5 skipping 0
d <- c(seq(-10,-0.01,by = 0.01), seq(0.01,10,by = 0.01))

# calculate all the power means
y <- sapply(d, function(d) powermean(samples, d))

myPlot <- ggplot() +
    geom_line(aes(x = d, y = y), color = "#56B4E9") +
    geom_point(size = 5,
               aes(x = -1, y = powermean(samples, -1),color = "#E69F00")) +
    geom_point(size = 5,
               aes(x = -0, y = powermean(samples, 0), color = "#009E73")) +
    geom_point(size = 5,
               aes(x = 1, y = powermean(samples, 1), color = "#F0E442")) +
    geom_point(size = 5,
               aes(x = 2, y = powermean(samples, 2), color = "#0072B2")) +
    scale_color_manual(values = c("#E69F00","#009E73","#F0E442","#0072B2"),
                       breaks = c("#E69F00", "#009E73", "#F0E442", "#0072B2"),
                       labels = c("harmonic",
                                  "geometric",
                                  "arithmetic",
                                  "quadratic")) +
    theme(axis.title.x = element_blank()) +
    theme(axis.title.y = element_blank()) +
    theme(legend.title = element_blank())

# ...profit!
plot(myPlot)


# spočítání pravděpodobnosti P(A) - věta o úplné pravděpodobnosti
uplna_pravdepodobnost = function(P_B, P_AB)
{   # uvažujeme P_B jako vektor hodnot P(B_i) a P_BA jako vektor hodnot P(A|B_i)
    P_A = 0
    for (i in 1:length(P_B))
    {
        P_A = P_A + P_B[i]*P_AB[i]
    }
    return(P_A)
}

# * Bayesova věta ####
# $P(B_k|A)=\frac{P(B_k)P(A|B_k)}{\sum_{i=1}^{n}P(B_i)P(A|B_i)}$

# spočítání podmíněné pravděpodobnosti P(B_k|A) - Bayesova věta
bayes = function(P_B, P_AB, k)
{   # uvažujeme P_B jako vektor hodnot P(B_i), P_BA jako vektor hodnot P(A|B_i)
    P_A = uplna_pravdepodobnost(P_B, P_AB)
    P_BkA = P_B[k]*P_AB[k]/P_A
    return(P_BkA)
}

souhrn=function(x,p){
  EX = sum(x*p)
  EX2 = sum(x*x*p)
  DX = EX2-EX^2
  sigma.X = sqrt(DX)
  # zápis výsledků do tabulky
  tab = rbind(EX, DX, sigma.X)
  tab.popis = c("str. hodnota","rozptyl","smer. odchylka")
  rownames(tab) = tab.popis
  return(tab)
}

# 1A
#       A   B   C
# spok  70  85  55
# nesp  30  15  45
# clk   30  38  32

0.3*0.3+0.15*0.38+0.45*0.32

# 1B
p = c(0.7,0.85,0.55)
c = c(0.3,0.38,0.32)
bayes(c, p, 2)

# 2A
xvalue = c(-2,1,3)
yvalue = c(0,1)
zero = c(1/3,1/6,0)
one = c(1/6,1/6,1/6)
sum(zero,one)

# 2B marginální pravděpodobnostní a distribuční funkce
# x -2  1   3
# p 3/6 2/6 1/6
x = c(zero[1]+one[1],zero[2]+one[2],zero[3]+one[3])
x
y = c(zero[1]+zero[2]+zero[3],one[1]+one[2]+one[3])
y

# 2C
# stř. hodnota =
sum(xvalue*x)
sum(yvalue*y)

# směr. odchylka
sqrt(sum(xvalue*xvalue*x)-sum(xvalue*x)^2)
sqrt(sum(yvalue*yvalue*y)-sum(yvalue*y)^2)

souhrn(xvalue,x)
souhrn(yvalue,y)

# 2D sdružená dist. funkce
# F(0,5;1) = 1/3

# 3A pravděpodobnostní funkce

x = seq(from = -1, to = 150, by = 1) # body na ose x
FX = dexp(x,1/45)
plot(x, FX, type='l', main="Distribucni funkce")

# 3B P(x > 68) = 1-P(x<68)
1-pexp(68,1/45)

# 3C z 30 baterií bude alespoň polovina s výdrží nad 68 měsíců
n = 30
p = 1-pexp(68,1/45)
1-pbinom(15,n,p)

# 3D 40 náhodně vybraných baterií bude průměrna výdrž větší než 43 měsíců

n = 40
sigma = 45
x = n*43
mi = n*sigma
rozptyl = n*sigma**2
1 - pnorm(x,mi,sqrt(rozptyl))


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

rm(list = ls())

la <- 10
lb <- 5
mu1 <- 3 / 60
mu2 <- 4 / 60

(Q <- matrix(c(-(la + lb),                 la,            lb,                0,
                    1/mu1, -(1/mu1 + lb + la),             0,          lb + la,
                    1/mu2,                  0, -(1/mu2 + la),               la,
                        0,              1/mu2,         1/mu1, -(1/mu1 + 1/mu2)),
             4, 4, byrow = TRUE))
# -15	 10  	5	  0
#  20	-35	  0	 15
#  15	  0	-25	 10
#   0	 15	 20	-35

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

(stationary <- solve(A)[nrow(A), ])
# 0.461538461538462 0.192307692307692 0.205128205128205 0.141025641025641

(la * (1 - (stationary[4])))
# 8.58974358974359

lb * (1 - (stationary[3] + stationary[4]))
# 3.26923076923077


'''
Suppose the food label on a cookie bag states that there is at most 2 grams of saturated fat in a single cookie.
In a sample of 35 cookies, it is found that the mean amount of saturated fat per cookie is 2.1 grams.Assume that
the population standard deviation is 0.25 grams. At .05 significance level, can we reject the
claim on food label?
'''

xbar=2.1
mu0=2
sigma = 0.25

n = 35

z = (xbar-mu0)/(sigma/sqrt(n))
z #2.2366

alpha = 0.05

z.alpha = qnorm(1-alpha)
z.alpha #1.644

#se rechaza la hipotesis

#pvalue
pvalue = pnorm(z,lower.tail = FALSE)

Parcial/1. Prueba de hipotesis/UpperTailMeanKnownVariance.r


# Example : 2   Chapter : 4.2     Page No: 209
# Find the projection matrix onto the line

projection_matrix<-function(a){
  a<-matrix(c(a),ncol=1)
  P<-a%*%t(a)
  temp<-t(a)%*%a
  temp<-1/temp
  t<-temp[1,1]
  P<-t*P
  return(P)
}
a<-c(1,2,2)
P<-projection_matrix(a)
print("The projection matrix is ")
print(P)
#The  answer may slightly vary due to  rounding off values


euclidean <- function(a, b) {
  return (sqrt(sum((a - b) ^ 2)))
}

kNN <- function(dataset, points, k, dist = euclidean) {
  answer <- array(dim=c(length(points[,1])))

  for (i in 1:length(points[,1])) {
    cat("\rPoint", i, "of", length(points[,1]))
    distance <- array(dim=dim(dataset)[1])
    for (j in 1:dim(dataset)[1]) {
      distance[j] <- dist(dataset[j, 3:4], points[i,])
    }
    sortedDataset <- dataset[order(distance),]

    classesCount <- c(0, 0, 0)
    names(classesCount) = unique(iris$Species)
    for (j in 1:k) {
      classesCount[sortedDataset$Species[j]] <- classesCount[sortedDataset$Species[j]] + 1
    }
    answer[i] = names(which.max(classesCount))[1]
  }

  return (answer)
}

par(mfrow=c(1,1), pty="s")

xs <- seq(from = 0.5, to = 7.5, by = 0.2)
ys <- seq(from = -2, to = 5, by = 0.2)

z <- array(dim = c(length(xs) * length(ys), 2))

index <- 1
for (i in xs) {
  for (j in ys) {
    z[index,] <- c(i, j)
    index <- index + 1
  }
}

result <- kNN(iris, z, 6)

colors <- c("setosa" = "blue", "virginica" = "red", "versicolor" = "green")
plot(iris[, 3:4], bg = colors[paste(iris$Species)], pch=23, asp=1)
points(z[,1], z[,2], col = colors[result], pch = 21)

1 - Nearest neighbors algorithm/knn-map.r


K = 5;
L = 6;

# 1. I.
n = K*20;
u = runif(n = n, min = 0, max = 1);
x = qexp(u, rate = L);

# 1. II.
hist(x = u, freq = FALSE);
hist(x = x, freq = FALSE);

xWidth = max(x) - min(x);
xGrid = seq(min(x) - 0.2 * xWidth, max(x) + 0.2 * xWidth, length = 30);
lines(xGrid, dexp(xGrid, rate = L), col='red', lw = 2, lty = 2);

# !. III.
plot(ecdf(x), verticals=TRUE, do.points = FALSE, main = "Empiricka distribucni funkce");
lines(xGrid, pexp(xGrid, rate = L), col='red', lw = 2, lty = 2);

# 1. IV.
y = rexp(1000, rate = L)
qqplot(x, y); abline(0,1, col='red', lwd=2);

# 1. V.

# 1. VI.
# H_0 data maji distribuci ~ exp(rate = L)
# H_a data nemaji tuto distribuci
# significance level = 0.05

prob.exp <- dexp(c(1:n), rate = L)
aaa=chisq.test(x, p=prob.exp, rescale.p = TRUE)

ret = ks.test(x, 'pexp', rate = L)$p.value
if(ret <= 0.05) {
  print('H_0 Rejected -> x doesn\'t have the exp distribution.');
} else {
  print("H_0 Can't be rejected, data may be exponential.");
}

return

# 2. I.
lambda = function(t) { 100 + 50/exp((t - 420)^2/(3600*L)) + 100/exp((L*(t - 480 - 30*L)^2)/360000)};

# 2. II.
t = 0;
i = 0;
totalArrivals = K*10;
arrivals = numeric(totalArrivals);
for(i in 1:totalArrivals) {
  t = t + rexp(1, rate = lambda(t));
  arrivals[i] = t;
}
yGrid = numeric(totalArrivals);
plot(arrivals, yGrid, type='p');

# 2. III.
totalTime = 24*60;
arrivals = numeric(totalTime);
while(t < totalTime) {
  t = t + rexp(1, rate = lambda(t));
  minute = t %/% 1;
  arrivals[minute] = arrivals[minute] + 1;
}
arrivals[totalTime] = arrivals[totalTime - 1];

xGrid = c(1:totalTime);
plot(xGrid, arrivals, type='l', col="grey");
curve(lambda, 1, totalTime, col='red', add=TRUE);

# 2. IV.
# Diskuze kvality dat

# 3. I.
ratio_courier = K/(K+L);
ratio_state = 1-ratio_courier;

# 3. II.
arrivals_courier = numeric(totalTime);
arrivals_state = numeric(totalTime);
for (i in (1:totalTime)) {
  arrivals_courier[i] = ratio_courier * arrivals[i];
  arrivals_state[i] = ratio_state * arrivals[i];
}

# 3. III.
lambda_courier = function(t) { lambda(t) * ratio_courier };
lambda_state = function(t) { lambda(t) * ratio_state };

plot(xGrid, arrivals_courier, type='l', col="grey");
curve(lambda_courier, 1, totalTime, col='red', add=TRUE);

plot(xGrid, arrivals_state, type='l', col="grey");
curve(lambda_state, 1, totalTime, col='red', add=TRUE);


#Dataframe 1
#https://www.rdocumentation.org/packages/geosphere/versions/1.5-14/topics/distm

library(geosphere)

# Example 1
xy <- rbind(c(0,0),c(90,90),c(10,10),c(-120,-45))

xy

distm(xy)

xy2 <- rbind(c(0,0),c(10,-10))
xy2

distm(xy, xy2)
distm(xy2, xy)

# Example 2

a<-structure(list(lat = c(50L),
                    lon = c(14L)),
               .Names = c("lat", "lon"),
               row.names = c(NA,  1L),
               class = "data.frame")
a

b<-structure(list(lat = c(40, 50),
                    lon = c(14, 12)),
               .Names = c("lat", "lon"),
               row.names = c(NA,  2L),
               class = "data.frame")
b

plot.new()
plot(a,col="red", type="p")
points(b,col = "blue")

distance.a.b <- distm(a[,c('lon','lat')], b[,c('lon','lat')], fun=distCosine)
distance.a.b

### example 3

df1<-structure(list(lat = c(54L, 55L, 51L),
                    lon = c(14L, 8L, 15L)),
               .Names = c("lat", "lon"),
               row.names = c(NA,  3L),
               class = "data.frame")

df2<-structure(list(lat = c(51, 52, 54.5, 51.2),
                    lon = c(9, 13, 14, 11)),
               .Names = c("lat", "lon"),
               row.names = c(NA,  4L),
               class = "data.frame")

df1
df2

plot.new()
plot(df1,col="red", type="p")
points(df2,col = "blue")

distance.df1.df2 <- distm(df1[,c('lon','lat')], df2[,c('lon','lat')], fun=distVincentyEllipsoid)

distance.df1.df2

row <- length(distance.df1.df2[,1])
row

column <- length(distance.df1.df2[1,])
column

x1<-matrix(double(1),nrow=row,ncol=1)
x2<-matrix(double(1),nrow=row,ncol=1)
x1
x2

a <- c(2,1,3,6)
a
which.min(a)
which.max(a)

distance.df1.df2
distance.df1.df2[1,]
distance.df1.df2[2,]
distance.df1.df2[3,]

which.min(distance.df1.df2[1,])
which.min(distance.df1.df2[2,])
which.min(distance.df1.df2[3,])

for (i in 1:row){
#  for (j in 1: column){
    x1[i] <- which.min(distance.df1.df2[i,])
    x2[i] <- distance.df1.df2[i,x1[i]]
#  }
}

x1
x2

x1.x2 <- cbind(x1,x2)

x1.x2

### adding more value

df3<-structure(list(lat = c(54L, 55L, 51L),
                    lon = c(14L, 8L, 15L),
                    house = c("house01", "house02", "house03")
                    ),
               .Names = c("lat", "lon","house"),
               row.names = c(NA,  3L),
               class = "data.frame")

df4<-structure(list(lat = c(51, 52, 54.5, 51.2),
                    lon = c(9, 13, 14, 11),
                            poi = c("poi01","poi02","poi03","poi04")),
               .Names = c("lat", "lon",'poi'),
               row.names = c(NA,  4L),
               class = "data.frame")

df3
df4

distance.df3.df4 <- distm(df3[,c('lon','lat')], df4[,c('lon','lat')], fun=distVincentyEllipsoid)

distance.df3.df4

row <- length(distance.df3.df4[,1])
column <- length(distance.df3.df4[1,])

x3<-matrix(double(1),nrow=row,ncol=1)
x4<-matrix(double(1),nrow=row,ncol=1)
for (i in 1:row){
  #  for (j in 1: column){
  x3[i] <- which.min(distance.df1.df2[i,])
  x4[i] <- distance.df1.df2[i,x1[i]]
  #  }
}

x3.x4 <- cbind(x3,x4)
x3.x4
df3

x5 <- df3
x5
x5$distance <- x3.x4[,2]
x5
x5$poi <-df4$poi[apply(distance.df3.df4, 1, which.min)]
x5


library('dplyr')
library('readr')

car_dataset <- read.csv("https://raw.githubusercontent.com/sit-2021-int214/007-Car-Prices-Dataset/master/term%20assignment/midterm/Cleaning%20Data/Car_Prices_Dataset_Clean_Update.csv")
glimpse(car_dataset)

mean(car_dataset$Mileage)

#sampledata
carInTent <- sample_n(car_dataset,350)
glimpse(carInTent)

#average milage of all cars is 100483, if we bought 350 cars to our tent
#and our cars average milage is not higher than all average? (alpha = 0.05)

#Ho : u <= 100483
#Ha : u > 100483

#assign variable
mue0 <- 100483
mean_intent <- mean(carInTent$Mileage) #97098.93
sd_intent <- sqrt(var(carInTent$Mileage)) #52544.04
n <- 350
alpha <- 0.05

#t-test
t_intent <- -1*(mean_intent-mue0)/(sd_intent/sqrt(n)) #1.204897

#p-value
p_value_intent <- pt(t_intent, n-1) #0.8854703

#cri
cri <- qt(alpha, n-1, lower.tail = FALSE) #1.649231

#conclusion
#with p-value
if(p_value_intent<=alpha){
  print("reject H0")
}else{
  print("accept H0")
}

#with critical-value
if(t_intent>=cri){
  print("reject H0")
}else{
  print("accept H0")
}


# Selecting seed to be reproducible
set.seed(42)

# "best" predictor/algorithm
# One can try to modify the denominator inside the cosine to change the complexity of f*
f = function(x){
  y=2+x^(.2)*cos(x/.15)/x^-.45
  return(y)
}
plot(f,0,5)

# Simulating data points: change n and sigma
N=400
#sigma=1.2
sigma=2.0
x=runif(N,0,5); x=sort(x)  # For convenience, the input x is sorted
y=rep(0,times=N)
for (i in 1:N) {
  y[i] = f(x[i]) + rnorm(1,0,sigma)  # rnorm(size, mean, std)
}
plot(x,y)
points(x,f(x), type="l", col=2, lwd=2)

# k-neighbors estimator
# k is number of neighbors and test=TRUE/FALSE tells if you estimate
# over any grid (FALSE) or over the x sampled in test data set (TRUE)
kn = function(k, test){
  if (test=="FALSE") {
    z = seq(0, 5, by=0.01)
    ll = length(z)
  }
  if (test=="TRUE"){
    z = x_test
    ll = length(z)
  }
  nk = rep(0, times=ll)
  for (j in 1:ll) {
    veci = which(abs(z[j]-x_train) %in% sort(abs(z[j]-x_train))[1:k])
    nk[j] = sum(y_train[veci])/k
  }
  return(nk)
}

# Sampling data between train and test
indices = sample(c(1:N), size=300)  # getting indices randmonly
x_train = x[indices]
y_train = y[indices]
x_test = x[-indices]
y_test = y[-indices]

# Plotting train and test data in same figure
plot(x_train, y_train)
points(x_test, y_test, col=2, pch=4)

# MSE computation (test data)
klist = 1:200  # List of k to test
MSE = rep(0, times=length(klist))  # I make a zeroes array with length of ksize to store MSEs
for (ki in klist) {
  y_pred = kn(ki, "TRUE")
  MSEi = mean(sum((y_test - y_pred)^2))
  MSE[ki] = MSEi
}

# Getting best k from MSE
plot(klist, MSE, xlab="k", ylab="MSE", main="MSE as a function of k")
kbest = which.min(MSE)
points(kbest, MSE[kbest], col=2, pch=8, cex=3.0)

# plot for N=600
plot(klist, MSE, xlab="k", ylab="MSE", main="MSE as a function of k (n=600)")

# Plotting best estimator
plot(x,y)
points(x, f(x), type="l", col=2, lwd=2)
points(x_test, kn(kbest,"TRUE"), type="l", col=3, lwd=2)

####### CROSS VALIDATION (4.3) #######

# k-fold cross validation
folds = 10  # ex. folds=10 means 10-fold CV
fold_size = N/10

klist = 1:200  # List of k to test
MSE_complete = list()  # List to store the MSE list of each k-fold iteration
indices = sample(c(1:N), size=400)  # getting indices randmonly
for (iteration in 1:folds){
  metaindices_test = ((iteration-1)*fold_size+1):(iteration*fold_size)  # Parenthesis are really important to separate :
  ss1 = indices[-metaindices_test] # Choosing indices for train (ss1) and test (ss2)
  ss2 = indices[metaindices_test]
  # choosing partition train/test data
  y_train=y[ss1]
  x_train=x[ss1]
  y_test=y[ss2]
  x_test=x[ss2]
  # Plotting train and test data in same figure
  #plot(x_train, y_train)
  #points(x_test, y_test, col=2, pch=4)
  #browser()  # breakpoint
  # MSE computation (test data)
  MSE = rep(0, times=length(klist))  # I make a zeroes array with length of ksize to store MSEs
  for (ki in klist) {
    y_pred = kn(ki, "TRUE")
    MSEi = mean(sum((y_test - y_pred)^2))
    MSE[ki] = MSEi
  }
  MSE_complete[[iteration]] <- MSE  # Store the MSE for this k in the complete MSE list.
}

# Plotting all MSE curves
for (i in 1:folds) {
  if (i==1){
    plot(klist, MSE_complete[[i]])
  }
  else{
    points(klist, MSE_complete[[i]])
  }
}

# Computing mean MSE curve
MSE_mean_10fold = list()
for (i in klist) {
  sum = 0
  for (j in 1:folds) {
    sum = sum + MSE_complete[[j]][i]
  }
  MSE_mean_10fold[i] <- sum/folds
}
# Plotting mean MSE curve
#points(klist, MSE_mean, col=2)
plot(klist, MSE_mean_10fold, xlab="k", ylab="MSE", main="MSE as a function of k for 10-fold CV")
# Taking the best k from mean MSE curve
kbest_10fold = which.min(MSE_mean_10fold)
points(kbest_10fold, MSE_mean_10fold[kbest_10fold], col=2, pch=8, cex=3.0)

# Plotting best estimator
plot(x,y)
points(x, f(x), type="l", col=2, lwd=2)
# Sorting x_test for plotting
x_test = sort(x_test)
points(x_test, kn(k_best,"TRUE"), col=3, pch=17)

#### Leave-one-out cross-validation ###
for (i in 1:N){
  x_train = x[-i]
  y_train = y[-i]
  x_test = x[i]
  y_test = y[i]
  MSE = rep(0, times=length(klist))  # I make a zeroes array with length of ksize to store MSEs
  for (ki in klist) {
    y_pred = kn(ki, "TRUE")
    MSEi = mean(sum((y_test - y_pred)^2))
    MSE[ki] = MSEi
  }
  MSE_complete[[i]] <- MSE  # Store the MSE for this k in the complete MSE list.
}

# Computing mean MSE curve
MSE_mean_loocv = list()
for (i in klist) {
  sum = 0
  for (j in 1:N) {
    sum = sum + MSE_complete[[j]][i]
  }
  MSE_mean_loocv[i] <- sum/folds
}
# Plot MSE curve
plot(klist, MSE_mean_loocv, xlab="k", ylab="MSE", main="MSE as a function of k for LOOCV")
# Taking the best k from mean MSE curve
kbest_LOOCV = which.min(MSE_mean_loocv)
points(kbest_LOOCV, MSE_mean_loocv[kbest_LOOCV], col=2, pch=8, cex=3.0)

# Plotting both mean_MSE curves
plot(klist, MSE_mean_10fold)
points(klist, MSE_mean_loocv, col=2, pch=4)
# adding legend
legend(150,80, legend=c("10-fold CV", "LOOCV"),
       col=c("black", "red"), lty=1:2, cex=1.0,
       box.lty=0)
### ###

####### END OF CROSS-VALIDATION (4.3) #######

####### EFFECT OF IRREDUCIBLE ERROR 4.4 #######

# Effect of irreducible error sigma^2
# The error is related to the sigma somehow...

# Effect of Irreducible error
# Irreducible error is sigma^2 in y = f(x) + sigma
sigma_list = seq(0.1, 4, by=0.1)  # sigma from 1 to 10 in steps of 0.1
kbest_list_10fold = rep(0, times=length(sigma_list))
kbest_list_loocv = rep(0, times=length(sigma_list))
folds=10
fold_size = N/folds
klist = 1:200

for (si in 1:length(sigma_list)) {
  MSE_complete_kfold = list()  # List to store the MSE list of each k-fold iteration
  MSE_complete_loocv = list()  # List to store the MSE list of each k-fold iteration
  y=rep(0,times=N)
  for (i in 1:N) {
    y[i] = f(x[i]) + rnorm(1,0,sigma_list[si])  # rnorm(size, mean, std)
  }
  indices = sample(c(1:N), size=400)  # getting indices randmonly
  ### KNN ###
  for (iteration in 1:folds){
    metaindices_test = ((iteration-1)*fold_size+1):(iteration*fold_size)  # Parenthesis are really important to separate :
    ss1 = indices[-metaindices_test] # Choosing indices for train (ss1) and test (ss2)
    ss2 = indices[metaindices_test]
    # choosing partition train/test data
    y_train=y[ss1]
    x_train=x[ss1]
    y_test=y[ss2]
    x_test=x[ss2]
    # Plotting train and test data in same figure
    #plot(x_train, y_train)
    #points(x_test, y_test, col=2, pch=4)
    #browser()  # breakpoint
    # MSE computation (test data)
    MSE = rep(0, times=length(klist))  # I make a zeroes array with length of ksize to store MSEs
    for (ki in klist) {
      y_pred = kn(ki, "TRUE")
      MSEi = mean(sum((y_test - y_pred)^2))
      MSE[ki] = MSEi
    }
    MSE_complete_kfold[[iteration]] <- MSE  # Store the MSE for this k in the complete MSE list.
  }
  # Computing mean MSE curve
  MSE_mean_10fold = list()
  for (i in klist) {
    sum = 0
    for (j in 1:folds) {
      sum = sum + MSE_complete_kfold[[j]][i]
    }
    MSE_mean_10fold[i] <- sum/folds
  }
  # Taking the best k from mean MSE curve
  kbest_10fold = which.min(MSE_mean_10fold)
  kbest_list_10fold[si] <- kbest_10fold
  ### ###
  #### Leave-one-out cross-validation ###
  for (i in 1:N){
    x_train = x[-i]
    y_train = y[-i]
    x_test = x[i]
    y_test = y[i]
    MSE = rep(0, times=length(klist))  # I make a zeroes array with length of ksize to store MSEs
    for (ki in klist) {
      y_pred = kn(ki, "TRUE")
      MSEi = mean(sum((y_test - y_pred)^2))
      MSE[ki] = MSEi
    }
    MSE_complete_loocv[[i]] <- MSE  # Store the MSE for this k in the complete MSE list.
  }

  # Computing mean MSE curve
  MSE_mean_loocv = list()
  for (i in klist) {
    sum = 0
    for (j in 1:N) {
      sum = sum + MSE_complete_loocv[[j]][i]
    }
    MSE_mean_loocv[i] <- sum/folds
  }
  kbest_LOOCV = which.min(MSE_mean_loocv)
  kbest_list_loocv[si] <- kbest_LOOCV
  ### ###
}

## Plotting results
plot(sigma_list, kbest_list_10fold, xlab="eps", ylab="k_best", main="Best k as a function of irreducible error.")
points(sigma_list, kbest_list_loocv, col="blue", pch=4)
# adding legend
legend(0.25,30, legend=c("10-fold CV", "LOOCV"),
       col=c("black", "blue"), lty=1:2, cex=1.0,
       box.lty=0)

# Doing a linear fit
lmfit = lm(c(kbest_list_10fold, kbest_list_loocv)~c(sigma_list,sigma_list))
abline(lmfit)
summary(lmfit)

####### END OF EFFECT OF IRREDUCIBLE ERROR 4.4 #######


#Copyright (c) 2016 Riccardo Francescato
a <- c(108,124,124,106,115,138,163,159,134,139)
#confidency level
alpha = .01
#type of test: 0 left tail 1 double tail 2 right tail
type = 2
#calculations....
n0 = length(a)		# number of reps for sample 0
xbar0 = mean(a)		# sample 0 mean
mu = 120			# given  mean
s0 = sd(a)			# sample 0 standard deviation
t = (xbar0−mu)/(s0/sqrt(n0))
if(type == 0){
	t.alpha = qt(1−alpha, df=n0−1)
	pval = pt(t, df=n0−1)
	cat("Results of lower tail\n")
	cat("Sample\n")
	cat(paste("# of elements: ", n0, " Mean: ", xbar0, " St Dev: ",s0))
	cat(paste("\nt0: ",t))
	cat(paste("\ntalpha: ",−t.alpha))
	cat(paste("\np-value: ",pval))
	if(t<−t.alpha) cat("\nREJECT H0\n") else cat("\nACCEPT H0\n")
}else if(type == 1){
	t.half.alpha = qt(1−alpha/2, df=n0−1)
	pval = 2 * pt(t, df=n0−1)
	cat("Results of 2-tail tail\n")
	cat("Sample\n")
	cat(paste("# of elements: ", n0, " Mean: ", xbar0, " St Dev: ",s0))
	cat(paste("\nt0: ",t))
	cat(paste("\ntalpha +: ",t.half.alpha))
	cat(paste("\ntalpha -: ",-t.half.alpha))
	cat(paste("\np-value: ",pval))
	if(t<-t.half.alpha || t>t.half.alpha) cat("\nREJECT H0\n") else cat("\nACCEPT H0\n")

}else if(type == 2){
	t.alpha = qt(1−alpha, df=n0−1)
	pval = pt(t, df=n0−1, lower.tail=FALSE)
	cat("Results of upper tail\n")
	cat("Sample\n")
	cat(paste("# of elements: ", n0, " Mean: ", xbar0, " St Dev: ",s0))
	cat(paste("\nt0: ",t))
	cat(paste("\ntalpha: ",t.alpha))
	cat(paste("\np-value: ",pval))
	if(t>t.alpha) cat("\nREJECT H0\n") else cat("\nACCEPT H0\n")
}


library(ARPPA)

nGene<-1000
nTreatment<-2   #number of different beta
sampleSize<-20 ##this is the number of repeats for each group

alpha.mean<-0  #variance for alpha prior
alpha.sigma<-5
beta.mean<-0
beta.sigma<-5  #variance for beta prior

#v0<-10  # the unscaled factor for gamma given gamma<=>0
gammaN0.sigma<-10

p_diff<-0.01

#priors for variance distribution
d0<-4
s0<-2

#call it
set.seed(2004);
dataExp<-simulateExpression(nGene, nTreatment, sampleSize,
					alpha.mean=alpha.mean, alpha.sigma=alpha.sigma,
					beta.mean=beta.mean, beta.sigma=beta.sigma,
					prob.nonZero=0.01, gamma.sigma=gammaN0.sigma,
					epsilon.d0=d0, epsilon.s0=s0
					)

##now start fitting the model to estimate the EBayes parameters
#defining a S3 function for calculating the prior variance and df
#based on the observed variance
calculatePriorVariance<-function (x,df)
{
	eg<-log(x)-digamma(df/2)+log(df/2)
	eg_bar<-mean(eg)
	tg_d02<-mean((eg-eg_bar)*(eg-eg_bar)*length(x)/(length(x)-1)-trigamma(df/2))
	d0<-trigammaInverse(tg_d02)*2
	s02<-exp(eg_bar+digamma(d0/2)-log(d0/2))

	prior<-list(d0=d0, s02=s02)

}

scaledChiSq_Pdf<-function(x, d0, s0)
{
	x_t<-d0*s0*s0/(x)
	#x_t<-sqrt(x_t)
	1/(2^(d0/2)*gamma(d0/2))*x_t^(d0/2-1)*exp(-1*x_t/2)

	#dchisq(x_t, d0)
}
scaledChiSq_Pdfr<-function(x, d0, s0)
{
	x_t<-d0*s0*s0/(x)
	#x_t<-sqrt(x_t)
	#1/(2^(d0/2)*gamma(d0/2))*x_t^(d0/2-1)*exp(-1*x_t/2)

	dchisq(x_t, d0)
}
scaledChiSq_PdfGamma<-function(x, d0, s0)
{
	#x_t<-d0*s0*s0/(x)
	#x_t<-sqrt(x_t)
	#1/((2/(d0*s0*s0))^(d0/2)*gamma(d0/2))*x^(-1*(d0/2-1))*exp(-1*(x^-1/(2/(d0*s0*s0))))

	1/((2/(d0*s0*s0))^(d0/2)*gamma(d0/2))*(x)^((d0/2-1))*exp(-1*(x/(2/(d0*s0*s0))))

	#dchisq(x_t, d0)
}
scaledChiSq_PdfGammaR<-function(x, d0, s0)
{
	#x_t<-d0*s0*s0/(x)
	#x_t<-sqrt(x_t)
	#1/((2/(d0*s0*s0))^(d0/2)*gamma(d0/2))*x^(-1*(d0/2-1))*exp(-1*(x^-1/(2/(d0*s0*s0))))

	#1/((2/(d0*s0*s0))^(d0/2)*gamma(d0/2))*(x)^((d0/2-1))*exp(-1*(x/(2/(d0*s0*s0))))
	dgamma(x,shape=d0/2 ,scale=2/(d0*s0*s0))
	#dchisq(x_t, d0)
}

rGamma<-function(n, d0, s0)
{
	#x_t<-d0*s0*s0/(x)
	#x_t<-sqrt(x_t)
	#1/((2/(d0*s0*s0))^(d0/2)*gamma(d0/2))*x^(-1*(d0/2-1))*exp(-1*(x^-1/(2/(d0*s0*s0))))

	#1/((2/(d0*s0*s0))^(d0/2)*gamma(d0/2))*(x)^((d0/2-1))*exp(-1*(x/(2/(d0*s0*s0))))
	rgamma(n,shape=d0/2 ,scale=2/(d0*s0*s0))
	#dchisq(x_t, d0)
}
invGamma_Pdf<-function(x, d0, s0)
{
	#x_t<-d0*s0*s0/(x)
	#x_t<-sqrt(x_t)
	#1/((2/(d0*s0*s0))^(d0/2)*gamma(d0/2))*x^(-1*(d0/2-1))*exp(-1*(x^-1/(2/(d0*s0*s0))))

	#1/((2/(d0*s0*s0))^(d0/2)*gamma(d0/2))*(x)^((d0/2-1))*exp(-1*(x/(2/(d0*s0*s0))))
	dinvgamma(x,alpha=d0/2 ,beta=(d0*s0*s0)/2)
	#dchisq(x_t, d0)
}

####testing code
###following the example for R help for eBayes
#  See also lmFit examples

Y_ijk<-dataExp$exp
tY<-data.frame(t(Y_ijk))
tY$group<-c(rep(1,sampleSize),rep(2,sampleSize))
varY<-aggregate(tY,by=list(tY$group),FUN=var) #by doing aggregate, the new dataframe is arranged to have first column for "by" criteria.
		#that is why in the next step, we need to get rid of the first column and last one, since the last one is the one we added as the group info.
varK<-varY[,c(-1,-nGene-2)]

x<-as.numeric(c(varK[1,],varK[2,]))
df<-rep(sampleSize-1,length(x))

r2<-calculatePriorVariance(x,df)

xx<-seq(0,60, by=0.1)

y<-scaledChiSq_Pdf(xx,d0, s0 )
yr<-scaledChiSq_Pdfr(xx,d0, s0 )
#plot(density((x)))
#lines((xx), y, col=2, lty=2)

yy<-rScaledChisq(1000000, d0, s0*s0)
yyg<-1/rGamma(1000000, d0, s0)
yg<-scaledChiSq_PdfGamma(1/xx,d0,s0)
ygr<-scaledChiSq_PdfGammaR(1/xx,d0,s0)
yig<-invGamma_Pdf(xx, d0, s0)
plot(c(0,60), c(0, 0.1),type="n", xlab="var", ylab="density")
hist(yy,breaks=100,prob=TRUE, xlim=c(0,60))
lines(density(yy))
lines(density(yyg), col=2, lwd=2)
lines((xx), y, col=2, lty=3)
lines((xx),yr,col=3, lty=2)
lines((xx), yig, col=4, lty=3, lwd=2)
#lines(xx,yg, col=3, lty=4, lwd=2)
lines(xx,ygr, col=2, lty=4, lwd=2)
#plot((xx), y, col=2, lty=2)

chisq_pdf<-function(x, d0)
{
	1/(2^(d0/2)*gamma(d0/2))*x^(d0/2-1)*exp(-1*x/2)

}
ychi<-rchisq(10000,2)
plot(density(ychi))
xxchi<-seq(1,50,by=0.1)
yychi<-chisq_pdf(xxchi, 2)
lines(xxchi,yychi, lty=2, col=2)

######################code to run normal distribution fitting density

 xseq<-seq(-10,10,.01)
 y<- rnorm(10000,2,5.5)

 hist(y, prob=TRUE,  breaks=20)#ylim=c(0,.06),)
 curve(dnorm(x, mean(y), sd(y)), add=TRUE, col="darkblue", lwd=2)
 curve(dnorm(x, 2, 5.5), add=TRUE, col="darkred", lwd=2)

 lines(xseq, dnorm(xseq, 2,5.5), col=2,lty=2)
 lines(density(y), col=3)
 lines(xseq, dnorm(xseq, 0, sqrt(5.5)), col=2)

normal_Pdf<-function(x, m,s2)
{
	1/sqrt(2*pi*s2)*exp(-1*(x-m)^2/(2*s2))
}
nxx<-seq(-10, 10, by=0.1)
ny<-normal_Pdf(nxx, 1, 2*2)
nx<-rnorm(1000000, 1,2)
plot(nxx, ny, col=2, lty=2)
lines(density(nx, n=16), col=3)

x<-hist(yy, breaks=2000000,plot=F)#, #prob=TRUE, xlim=c(0,20))
hwidth<-x$breaks[2]-x$breaks[1]
histArea<-hwidth*sum(x$counts)

barHeight<-x$counts/histArea
lines(x$breaks[-length(x$breaks)], barHeight, col=2, lwd=2)


set.seed(32)

m = 10000
a = 2.0
b = 1.0 / 3.0

theta = rgamma(n=m, shape=a, rate=b)

se = sd(theta) / sqrt(m)

hist(theta, freq=FALSE)
curve(dgamma(x,shape=a, rate=b),col="blue",add=TRUE)

# 2 standard errors
mean(theta) + (2 * se)
mean(theta) - (2 * se)

#indicator
ind = theta < 5
mean(ind)
pgamma(5.0, shape=a, rate=b)

se = sd(ind) / sqrt(m)

2*se


weight <-c (150,180,140,128,133,152,131)
height <-c (62,84,55,52,54,63,53)
model <- lm (height ~ weight)
print (model)

test <- data.frame (weight = 165)
result <- predict (model , test)
print (result)

plot ( weight, height, col = "red", main = "Example of Linear Regression" , abline (lm(height~weight)), cex = 1.3, pch = 16, xlab = "Weight" , ylab = "Height")


#### Suponha que x_1, ..., x_n ~ exponencial(theta)
#### A MLE de theta é theta_hat = n/sum(x)
#### Vamos derivar a distribuição amostral de theta_hat
#### Note que a soma de x_i, S, tem distribuição Gamma com parametros n e theta.
#### Depois note que 1/S tem distribuição gama inversa com parametros n e theta.
#### Por ultimo note que se X tem distribuição gama inversa com parametros a e b.
##### cX tem distribuição gama inversa com parametros a e cb.

library(invgamma)

computa_emv <- function(x){
  1/mean(x)
}

theta.vdd <- 2
M <- 10000
n <- 100

amostras <- matrix(NA, ncol = n, nrow = M)
for (j in 1:M){
  amostras[j, ] <- rexp(n = n, rate = theta.vdd)
}

EMVs <- apply(amostras, 1, computa_emv)

hist(EMVs, probability = TRUE)
curve(invgamma::dinvgamma(x, shape = n, rate = n*theta.vdd),
      min(EMVs), max(EMVs), add = TRUE, lwd = 2)


## simulate two clusters of data
x <- c(rnorm(20,0,1), rnorm(20,4,1))
y <- c(rnorm(20,0,1), rnorm(20,4,1))
X <- cbind(x,y)
ones <- matrix(1, dim(X)[1],1)

## set up some parameters for plotting
xlims <- c(min(x), max(x)) * 1.3
ylims <- c(min(y), max(y)) * 1.3

## plot the data
plot(X, xlim = xlims, ylim = ylims)

## And add some very silly seed points
mu1 <- c(0,6)
mu2 <- c(5,-2)
seed <- list(mu1 = mu1, mu2 = mu2)
points(rbind(seed$mu1, seed$mu2), pch = c(2,3),col = c("red", "black"))
legend("topright", pch = c(1,2,3), col = c("black", "red", "black"), legend = c("Data", "Seed 1", "Seed 2" ), cex = 0.5)
##mtext(paste("Seed points: \n Group 1 ", formatC(seed[[1]],2), "Group 2 ", formatC(seed[[2]],2)))

seed <- step(X, seed$mu1, seed$mu2)
seed <- step(X, seed$mu1, seed$mu2)
seed <- step(X, seed$mu1, seed$mu2)

step <- function(X, mu1, mu2){
## classify according to current seed point (expectation step)
one <- sqrt(rowSums((X - t(t(t(mu1)) %*% t(ones)))^2))
two <- sqrt(rowSums((X - t(t(t(mu2)) %*% t(ones)))^2))
plot(x,y, col = 1 + as.numeric(one < two), pch = 16, xlim = xlims, ylim = ylims )
legend("topright", pch = c(16,16,2,3), col = c("red", "black"), legend = c("Group1", "Group2", "Seed 1", "Seed 2" ), cex = 0.5)
points(rbind(seed$mu1, seed$mu2), pch = c(2,3), col = c("red", "black"))
fixed <- (mu1 + mu2)/2
slope <- -(mu1[1] - mu2[1])/(mu1[2] - mu2[2])
abline(c(fixed[2] - slope * fixed[1], slope))

## calculate new seed points (maximisation step)
mu1 <- colMeans(X[one < two,])
mu2 <- colMeans(X[one >= two,])
return(seed = list(mu1 = mu1, mu2 = mu2))
}

perp <- function(x, y) {
   m <- (x+y)/2
   s <- - (x[1] - y[1])/(x[2] - y[2])
   abline(c(m[2] - s*m[1], s))
   invisible()
}


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

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

# Calculate the loss from a log-return of -0.1 for all risk factors
lossop(rep(-0.1, 5))

# Apply lossop() to returns and plot hslosses
hslosses <- lossop(returns)
plot(hslosses)

# Form a Q-Q plot of hslosses against normal
qqnorm(hslosses)

# Plot the sample acf of hslosses and their absolute values
acf(hslosses)
acf(abs(hslosses))

# Estimate the 99th sample percentile of the distribution of hslosses
quantile(hslosses, 0.99)

# Estimate the 99% ES
mean(hslosses[hslosses >= quantile(hslosses, 0.99)])

# Estimate the mean and standard deviation of hslosses
mu <- mean(hslosses)
sigma <- sd(hslosses)

# Compute the 99% quantile of a normal distribution
qnorm(0.99, mean = mu, sd = sigma)

# Compute the 99% ES of a normal distribution
ESnorm(0.99, mu = mu, sd = sigma)


phi = (1+sqrt(5))/2
N = 501
a = (3-sqrt(5))*pi
n = 0:(N-1)
th = n*a
r = sqrt(n)

x = r*cos(th)
y = r*sin(th)
plot(x,y,asp = 1)

thc = seq(0,10*2*pi,length.out = 1000)
rc = sqrt(1/a)*sqrt(thc)
plot(rc*cos(thc),rc*sin(thc),col = "red",asp = 1,type = 'l')
points(x,y)
w = 3
points(x[seq(1,N,w)],y[seq(1,N,w)],col = "green")

fibo = function(n){
  a = c(1,1,rep(0,n-2))
  for(i in 3:n){
    a[i] = a[i-1]+a[i-2]
  }
  return(a)
}

s = fibo(50)

fb = 10#s[6]
#colors = brewer.pal(fb,"Paired")
colors = hsv(seq(0,1,length.out = fb+1),1,1)
plot(x,y,asp = 1)
z = sapply(1:fb,function(s){
  points(x[seq(s,N,fb)],y[seq(s,N,fb)],col = colors[s])
  lines(x[seq(s,N,fb)],y[seq(s,N,fb)],col = colors[s])})

q = sapply(5:25,function(fb){
#fb = 10#s[6]
#colors = brewer.pal(fb,"Paired")
colors = hsv(seq(0,1,length.out = fb+1),1,1)
plot(x,y,asp = 1)
z = sapply(1:fb,function(s){
  points(x[seq(s,N,fb)],y[seq(s,N,fb)],col = colors[s])
  lines(x[seq(s,N,fb)],y[seq(s,N,fb)],col = colors[s])})
})

ss = s[7:10]
plot(x,y,asp = 1)
colors = hsv(seq(0,1,length.out = length(ss)+1),1,1)
q = sapply(ss,function(fb){
  z = sapply(1:fb,function(s){
    lines(x[seq(s,N,fb)],y[seq(s,N,fb)],col = colors[ss == fb])})
})

library(tidyverse)
ds = data.frame(x = x, y= y)
ds$n = seq(1,length(x))

k = s[9]
ds$fb = factor(ds$n %% k)
colors = hsv(seq(0,1,length.out = k + 1),1,1)
ds$colors = factor(colors[ds$fb])

p = ggplot(ds) + geom_path(aes(x = x, y = y,color = colors))+ theme(legend.position = "none")+
 # geom_text(data = ds %>% filter(n <= k ),aes(x = x, y = y, label = n))+
  coord_fixed()+scale_color_manual(values = levels(ds$colors))#+theme_void()
print(p)

k = s[5]
ds$fb = factor(ds$n %% k)
colors = hsv(seq(0,1,length.out = k + 1),1,1)
ds$colors = factor(colors[ds$fb])

p = ggplot(ds) + geom_path(aes(x = x, y = y,color = fb),size = 0.2)+ theme(legend.position = "none")+
  # geom_text(data = ds %>% filter(n <= k ),aes(x = x, y = y, label = n))+
  coord_fixed()+scale_color_manual(values = levels(ds$colors))#+theme_void()
print(p)

fseq= 1:30
z = sapply(ds$n,function(x) x %% fseq) %>% t()  #%>% add_column(x = x, y = y)
colnames(z) = paste0("fn_",fseq)
z = as.data.frame(z)
dm = data.frame(x = x, y = y, n = 1:length(x),z)
tdm = gather(dm,key = "fn",value = "track",starts_with("fn"))
tdm$ff = as.numeric(sub("fn_","",tdm$fn))
tdm$colors = hsv(h = tdm$track/(tdm$ff+1))

tdm$fn = factor(tdm$fn,levels = paste0("fn_",fseq))
#tdm$track = factor(tdm$track )
p = ggplot(data = tdm) + geom_path(aes(x = x,y = y, color = colors),size = 0.2)+facet_wrap(~fn) +
      coord_fixed()+theme_void()+theme(legend.position = "none")
print(p)

p = ggplot(data = tdm) + geom_point(aes(x = x,y = y, color = colors),size = 0.2)+facet_wrap(~fn) +
  coord_fixed()+theme_void()+theme(legend.position = "none")
print(p)

k = s[9]
ds$fb = factor(ds$n %% k)
colors = hsv(seq(0,1,length.out = k + 1),1,1)
ds$colors = factor(colors[ds$fb])

d0 = data.frame(x = rep(0,k),y = rep(0,k),n = rep(0,k),fb = seq(0,k-1),colors = colors[1:k])

p = ggplot() +geom_path(data = rbind(d0,ds),aes(x = x, y = y,color = colors))+ theme(legend.position = "none")+
        coord_fixed()+scale_color_manual(values =levels(ds$colors))#+theme_void()
print(p)

N = 1501
a = (3-sqrt(5))*pi #137.5/180*pi
n = 0:(N-1)
th = n*a
r = sqrt(n)

x = r*cos(th)
y = r*sin(th)

thc = seq(0,500*2*pi,length.out = 6000)
rc = sqrt(1/a)*sqrt(thc)

w = 55    #34   #21     #13    #8   #5    # 3 #2
l = -1/2584 #1/987#-1/377 #-1/144#1/55#1/21 #1/8#1/3
plot(x,y,asp = 1,col = "gray")
#lines(rc*cos(thc),rc*sin(thc),col = "lightblue")
points(x[seq(1,N,w)],y[seq(1,N,w)],col = "red")
lines(rc*cos(thc*l),-rc*sin(thc*l),col = "black")
print(s)
#text(x[w+1],y[w+1],toString(w))

w = 55    #34   #21     #13    #8   #5    # 3 #2
l = -1/2584 #1/987#-1/377 #-1/144#1/55#1/21 #1/8#1/3
plot(x,y,asp = 1,col = "gray")
#lines(rc*cos(thc),rc*sin(thc),col = "lightblue")
points(x[seq(2,N,w)],y[seq(2,N,w)],col = "red")
lines(rc*cos(thc*l-a),-rc*sin(thc*l-a),col = "black")
print(s)
#text(x[w+1],y[w+1],toString(w))

w = 13    #34   #21     #13    #8   #5    # 3 #2
l = 1/144 #1/987#-1/377 #-1/144#1/55#1/21 #1/8#1/3
plot(x,y,asp = 1,col = "gray")
#lines(rc*cos(thc),rc*sin(thc),col = "lightblue")
points(x[seq(3,N,w)],y[seq(3,N,w)],col = "red")
lines(rc*cos(thc*l-2*a),-rc*sin(thc*l-2*a),col = "black")
print(s)
#text(x[w+1],y[w+1],toString(w))

s = fibo(50)
k = seq(0,1000)
ss = 5
theta = pi*(3-sqrt(5))*(ss + s[9]*k)
rho = sqrt(ss+s[3]*k)
xt = rho*cos(theta)
yt = rho*sin(theta)
plot(x,y,asp = 1, col = "gray")
points(xt,yt,col = "red")

N = 1501
a = (3-sqrt(5))*pi #137.5/180*pi
n = 0:(N-1)
th = n*a

ii = seq(2,20)
k = length(ii)
colors = hsv(h = seq(0,1,length.out = k +1))
for(j in seq(1,k)){
  ind = seq(1,N,ii[j])
  plot(th %% (2*pi),col = "gray",main = toString(ii[j]))
  points(ind, th[ind] %%(2*pi),col = colors[j],pch = 3)
  lines(ind,th[ind] %% (2*pi),col= colors[j])
  #points(ind, th[ind+1] %%(2*pi),col = colors[j],pch = 3)
}

j = 19
ind = seq(1,N,ii[j])
plot(th %% (2*pi),col = "gray",main = toString(ii[j]))
points(ind, th[ind] %%(2*pi),col = colors[j],pch = 3)
lines(ind, th[ind] %%(2*pi),col = colors[j])

w = 21
ind = seq(1,N,w)
plot(x,y,asp = 1, col = "gray",main = toString(w))
lines(x[ind],y[ind],pch = 3)
plot(th %% (2*pi),col = "gray",main = toString(w))
points(ind, th[ind] %%(2*pi),pch = 3)
lines(ind, th[ind] %%(2*pi),col = "gray")

w = s[7:10]
k = length(w)
colors = hsv(h = seq(0,1,length.out = k +1))
plot(th %% (2*pi),col = "gray")
for(j in 1:k ){
  ind = seq(1,N,w[j])
  lines(ind, th[ind] %%(2*pi),col = colors[j])
  cat(w[j])
  cat(" => ")
  print(diff(th[ind[1:3]] %% (2*pi)) %% (2*pi))
}

w = 55
ind = seq(1,N,w)
h = diff(th[ind[1:2]] %% (2*pi)) %% (2*pi)
if(h > 1) h = h - 2*pi
h = h/w

t = seq(0,N,length.out = 1e4)
thc = h*t
rc = sqrt(t)

plot(th %% (2*pi),col = "gray",main = toString(w))
points(ind, th[ind] %%(2*pi),pch = 3)
lines(ind, th[ind] %%(2*pi),col = "gray")
lines(t,thc,col = "red")

plot(x,y,asp = 1,col = "gray")
points(x[ind],y[ind],col = "red")
lines(rc*cos(thc),rc*sin(thc),col = "black")

w = 55
st = 44
ind = seq(st,N,w)
h = diff(th[ind[1:2]] %% (2*pi)) %% (2*pi)
if(h > 1) h = h - 2*pi
h = h/w
b = th[st] %% (2*pi)
t = seq(0,N,length.out = 1e4)
thc = h*(t-ind[1]) + b #t = ind[1] => thc = b with slop h
rc = sqrt(t)

plot(th %% (2*pi),col = "gray",main = toString(w))
points(ind, th[ind] %%(2*pi),pch = 3)
lines(ind, th[ind] %%(2*pi),col = "gray")
lines(t,thc,col = "red")

plot(x,y,asp = 1,col = "gray")
points(0,0,pch=3)
points(x[ind],y[ind],col = "red")
lines(rc*cos(thc),rc*sin(thc),col = "black")

w = 55
plot(x,y,asp = 1,col = "gray")
points(0,0,pch=3)
t = seq(0,N,length.out = 1e4)
colors = hsv(h = seq(0,1,length.out = w+1))
for(st in seq(1,w)){
  ind = seq(st,N,w)
  h = diff(th[ind[1:2]] %% (2*pi)) %% (2*pi)
  if(h > 1) h = h - 2*pi
  h = h/w
  print(paste0(st," => ", h))
  thc = h*(t-ind[1]) + th[st] %% (2*pi) #t = ind[1] => thc = b with slop h
  rc = sqrt(t)

  points(x[ind],y[ind],col = colors[st])
  lines(rc*cos(thc),rc*sin(thc),col = colors[st])
  #print(paste0(c("done with ",toString(st))))
}

u = 3-sqrt(5)
uu = u*seq(1,1000)
plot(uu %% 2,col = "gray")#,pch =20)
ind = seq(1,1000,11)
points(ind,uu[ind] %% 2,pch = 3)
lines(ind,uu[ind] %% 2,col = "blue")

phi = (1-sqrt(5))/2
phiz = phi %% 1
u = phi*seq(0,1000)
w = 17
ind = seq(1,1000,w)
plot(u %% 1,col = "gray",main = toString(w))
points(ind,u[ind] %% 1,pch = 3)
lines(ind,u[ind] %% 1,col = "blue")
h = diff(u[ind[1:5]]) %% 1
print(1 %/% h + 1)
if(h[1] > phiz) h = h - 1

phi = (1-sqrt(5))/2
phiz = phi %% 1
u = phi*seq(0,1000)
for(w in seq(2:60)){
  ind = seq(1,1000,w)
  plot(u %% 1,col = "gray",main = toString(w))
  points(ind,u[ind] %% 1,pch = 3)
  lines(ind,u[ind] %% 1,col = "blue")
  h = diff(u[ind[1:5]]) %% 1
  if(h[1] > phiz) h = h - 1
  hw = 1+ 1 %/% h
  if(h[1] <0 ) hw = (1 - 1 %/% h )
  if(hw[1] > 0){
    cat(paste0(w," => "))
    print(hw)
  }

}

N = 1000
u = seq(1,N)
plot(u,(phi*u) %% 1,col = "gray")
uu = seq(3,N,s[9])
points(uu,(phi*uu) %% 1,pch = 3)
v = (phi*u) %% 1
vs = sort(v,index.return=TRUE)

w = 3*55
st = 44
ind = seq(st,N,w)
h = diff(th[ind[1:2]] %% (2*pi)) %% (2*pi)
if(h > 1) h = h - 2*pi
h = h/w
b = th[st] %% (2*pi)
t = seq(0,N,length.out = 1e4)
thc = h*(t-ind[1]) + b #t = ind[1] => thc = b with slop h
rc = sqrt(t)

plot(th %% (2*pi),col = "gray",main = toString(w))
points(ind, th[ind] %%(2*pi),pch = 3)
lines(ind, th[ind] %%(2*pi),col = "gray")
lines(t,thc,col = "red")

plot(x,y,asp = 1,col = "gray")
points(0,0,pch=3)
points(x[ind],y[ind],col = "red")
lines(rc*cos(thc),rc*sin(thc),col = "black")

w = 11
st = 1
l = 10
ind = seq(st,N,w)
h = diff(th[ind],l) %% (2*pi)
h = h[1]
if(h > pi) h = h - 2*pi
h = h/w/l
b = th[st] %% (2*pi)
t = seq(0,N,length.out = 1e4)
thc = h*(t-ind[1]) + b #t = ind[1] => thc = b with slop h
rc = sqrt(t)

plot(th %% (2*pi),col = "gray",main = toString(w))
points(ind, th[ind] %%(2*pi),pch = 3)
lines(ind, th[ind] %%(2*pi),col = "gray")
lines(t+ind[2],thc+th[ind[2]] %% (2*pi),col = "red")

plot(x,y,asp = 1,col = "gray")
points(0,0,pch=3)
points(x[ind],y[ind],col = "red")
lines(rc*cos(thc),rc*sin(thc),col = "black")

w = 33
st = 3
ind = seq(st,N,w)
zl = min((w-1),length(ind)-1)
zm = sapply(1:zl, function(l){
  h = diff(th[ind],l) %% (2*pi)
  h = h[1]
  if(h > pi) h = h - 2*pi
  return(h)
})

hi = which.min(abs(zm)/(1:zl))
cat("# of branches:")
print(hi)
h = zm[hi]
h = h/w/hi
b = th[st] %% (2*pi)
t = seq(0,N,length.out = 1e4)
thc = h*(t-ind[1]) + b #t = ind[1] => thc = b with slop h
rc = sqrt(t)

plot(th %% (2*pi),col = "gray",main = toString(w))
points(ind, th[ind] %%(2*pi),pch = 3)
lines(ind, th[ind] %%(2*pi),col = "gray")
lines(t+ind[2],(-b+thc+th[ind[2]] )%% (2*pi),col = "red")

plot(x,y,asp = 1,col = "gray")
points(0,0,pch=3)
points(x[ind],y[ind],col = "red")
lines(rc*cos(thc),rc*sin(thc),col = "black")

plot(zm/(1:zl))

library(numbers)
primeFactors(610)

w = 61
N = 100*w + 10
a = (3-sqrt(5))*pi
n = 0:(N-1)
th = n*a
r = sqrt(n)

x = r*cos(th)
y = r*sin(th)
#plot(x,y,asp = 1)

w = 33
st = 1
l = 5
ind = seq(st,N,w)
h = diff(th[ind],l) %% (2*pi)
h = h[1]
if(h > pi) h = h - 2*pi
h = h/w/l
b = th[st] %% (2*pi)
t = seq(0,N,length.out = 1e4)
thc = h*(t-ind[1]) + b #t = ind[1] => thc = b with slop h
rc = sqrt(t)

plot(th %% (2*pi),col = "gray",main = toString(w))
points(ind, th[ind] %%(2*pi),pch = 3)
lines(ind, th[ind] %%(2*pi),col = "gray")
lines(t+ind[2],(-b+thc+th[ind[2]] )%% (2*pi),col = "red")

plot(x,y,asp = 1,col = "gray")
points(0,0,pch=3)
points(x[ind],y[ind],col = "red")

lines(rc*cos(thc),rc*sin(thc),col = "black")

w = 8*18
st = 3
ind = seq(st,N,w)
zl = min((w-1),length(ind)-1)
zm = sapply(1:zl, function(l){
  h = diff(th[ind],l) %% (2*pi)
  h = h[1]
  if(h > pi) h = h - 2*pi
  return(h)
})
plot(x[ind],y[ind],col = "red",asp = 1)

w =18
st = 3
ind = seq(st,N,w)
plot(x[ind],y[ind],col = "red",asp = 1,main = toString(w))
w =8
ind = seq(st,N,w)
points(x[ind],y[ind],pch = 3,col = "gray")
w =8*18
ind = seq(st,N,w)
points(x[ind],y[ind],pch = 2,col = "blue")

sprintf("%.50f",phi*8*18) #144
sprintf("%.50f",phi*233)

ps = c(2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97)

w = 377
sth = function(w){
  N = 30*w + 10
  #print(N)
  a = (3-sqrt(5))*pi
  n = 0:(N-1)
  th = n*a
  r = sqrt(n)

st = 1
ind = seq(st,N,w)
h = diff(th[ind[1:2]] %% (2*pi)) %% (2*pi)
if(h > pi) h = h - 2*pi
h = h/w
b = th[st] %% (2*pi)
t = seq(0,N,length.out = 1e4)
thc = h*(t-ind[1]) + b #t = ind[1] => thc = b with slop h
rc = sqrt(t)
x = r*cos(th)
y = r*sin(th)

#plot(th %% (2*pi),col = "gray",main = toString(w))
#points(ind, th[ind] %%(2*pi),pch = 3)
plot(ind, th[ind] %%(2*pi),pch = 3,main = toString(w))
#lines(ind, th[ind] %%(2*pi),col = "gray")
lines(t,thc %% (2*pi),col = "red")

#plot(x,y,asp = 1,col = "gray")
#points(0,0,pch=3)
#points(x[ind],y[ind],col = "red")
plot(x[ind],y[ind],col = "red",main = toString(w),asp = 1)
lines(rc*cos(thc),rc*sin(thc),col = "black")
}