library("car")
data("Leinhardt")

head(Leinhardt)
str(Leinhardt)
pairs(Leinhardt)

plot(infant ~ income, data=Leinhardt)
hist(Leinhardt$infant)
hist(Leinhardt$income)

Leinhardt$loginfant = log(Leinhardt$infant)
Leinhardt$logincome = log(Leinhardt$income)

plot(loginfant ~ logincome, data=Leinhardt)

###Modeling
lmod = lm(loginfant ~ logincome, data=Leinhardt)
summary(lmod) # estimates of coefficents very large in comparison to their standard error, showing statistical significance
              #r-squared tells us how much of the variability is explained by model

dat = na.omit(Leinhardt)
#Leinhardt

library("rjags")

# likelyhood is a normal distribution  p(y|mu)
# use a linearn model to draw mu
# prior on the leniar model coeficents is a normal distribution with 2 coefecients, mean =0 and a variance = 1m
# sig^2: inverse gamma for the variance == gamma prior on precision
# lower the sample size of prior if we are not so confident in guess
mod2_string =" model {
    for (i in 1:n){
        y[i] ~ dnorm(mu[i], prec)
        mu[i] = b[1] + b[2]*log_income[i] + b[3]*is_oil[i]
    }

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

    prec ~ dgamma(5.0/2.0, 5.0*10.0/2.0)
    sig2 = 1.0 / prec
    sig = sqrt(sig2)

} "

set.seed(75)
data2_jags = list(y=dat$loginfant, n=nrow(dat), log_income=dat$logincome, is_oil=as.numeric(dat$oil=="yes"))

data2_jags$is_oil

# choose to monitor standard dev
params2 = c("b", "sig")

inits2 = function() {
    inits = list("b"=rnorm(3, 0.0, 100.0), "prec"=rgamma(1,1.0,1.0))
}

# run the model with 3 chains each starting with inits1 params
mod2 = jags.model(textConnection(mod2_string), data=data2_jags, inits=inits2, n.chains=3)

dic.samples(mod1, n.iter=1e3)

# burn in period
update(mod2, 1000)

mod2_sim = coda.samples(model=mod2, variable.names=params2, n.iter=5e3)

# stack matrices vertically
mod2_csim = do.call(rbind, mod2_sim)

### Convergence
plot(mod2_sim)
gelman.diag(mod2_sim)
autocorr.diag(mod2_sim)
effectiveSize(mod2_sim)
summary(mod2_sim)
summary(lmod)

### Residuals differece between response the actual obsevation and the models prediction for each value
# very important as they revieal violations with our assumptions to specify mode
# looking for signs of non liniarity, not normally distributed, obsevation are not independent from one another
lmod0 = lm(infant ~ income, data=Leinhardt)
plot(resid(lmod0)) # assume independence if no patterns seen
plot(predict(lomd0), resid(lmod0)) # want to see randomness
qqnorm(resid(lmod0)) # check for normality, if nomal posint follow straight line, curves shows squew

X = cbind(rep(1.0, dat2_jags$n), data2_jags$log_income, data2_jags$is_oil)

pm_params2 = colMeans(mod2_csim)

yhat = drop(X %*% pm_params2[1:3]) #vector of predicated values from model
resid2 = data2jags$y - yhat

plot(resid2)
plot(yhat, resid2)
qqnorm(resid2)

head(rownames(dat)[order(resid2, decreasing=TRUE)])

#tau = scale parameter
# df= degrees of freedom, smaller give heavier tail
# for the model (likeylihood) to have a mea nand variance we force the df to be greater than 2
mod3_string =" model {
    for (i in 1:n){
        y[i] ~ dt(mu[i], rau, df)
        mu[i] = b[1] + b[2]*log_income[i] + b[3]*is_oil[i]
    }

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

    df = nu + 2.0
    nu ~ dexp(1.0)

    tau ~ dgamma(5.0/2.0, 5.0*10.0/2.0)
    sig = sqrt(1.0/tau * df/(df-2.0))
} "


gig_lpdf <- function(x,p,a,b) {
  (p * 0.5 * log(a / b)
      - log(2 * besselK(sqrt(a * b), p))
      + (p - 1) * log(x)
      - (a * x + b / x) * 0.5
  )
}

x <- exp(seq(-10,log(10),length.out=200))
plot(x,exp(gig_lpdf(x,2,1,1)))


# Thanks: Kai Chen. M.D.
# Resident
# Dept of Breast surgery,
# Breast Tumor Center;
# Sun Yat-sen Memorial Hospital
# chenkai23@mail.sysu.edu.cn

# Fit logistic model on 100 observations simulated from the actual
# model given by Prob(Y=1 given X1, X2, X3) = 1/(1+exp[-(-1 + 2X1)]),
# where X1 is a random uniform [0,1] variable.  Hence X2 and X3 are
# irrelevant.  After fitting a linear additive model in X1, X2,
# and X3, the coefficients are used to predict Prob(Y=1) on a
# separate sample of 100 observations.  Note that data splitting is
# an inefficient validation method unless n > 20,000.

require(rms)
set.seed(1)
n <- 200
x1 <- runif(n)
x2 <- runif(n)
x3 <- runif(n)
logit <- 2*(x1-.5)
P <- 1/(1+exp(-logit))
y <- ifelse(runif(n)<=P, 1, 0)
d <- data.frame(x1,x2,x3,y)
f <- lrm(y ~ x1 + x2 + x3, subset=1:100)
pred.logit <- predict(f, d[101:200,])
phat <- 1/(1+exp(-pred.logit))

val.prob(phat, y[101:200], m=20, cex=.5)  # subgroups of 20 obs.

val.prob(x2[101:200], y[101:200], m=20, cex=.5)  # subgroups of 20 obs.


# A minimalistic Echo State Networks demo with Mackey-Glass (delay 17) data
# in "plain" R.
# by Mantas Lukosevicius 2012-2018
# http://mantas.info

# load the data
trainLen = 2000
testLen = 2000
initLen = 100
data = as.matrix(read.table('MackeyGlass_t17.txt'))

# plot some of it
while( dev.cur() != 1 ) dev.off() # close all previous plots
dev.new()
plot(data[1:1000],type='l')
title(main='A sample of data')

# generate the ESN reservoir
inSize = outSize = 1
resSize = 1000
a = 0.3 # leaking rate

set.seed(42)
Win = matrix(runif(resSize*(1+inSize),-0.5,0.5),resSize)
W = matrix(runif(resSize*resSize,-0.5,0.5),resSize)

# normalizing and setting spectral radius
cat('Computing spectral radius...')
rhoW = abs(eigen(W,only.values=TRUE)$values[1])
print('done.')
W = W * 1.25 / rhoW

# allocated memory for the design (collected states) matrix
X = matrix(0,1+inSize+resSize,trainLen-initLen)
# set the corresponding target matrix directly
Yt = matrix(data[(initLen+2):(trainLen+1)],1)

# run the reservoir with the data and collect X
x = rep(0,resSize)
for (t in 1:trainLen){
    u = data[t]
    x = (1-a)*x + a*tanh( Win %*% rbind(1,u) + W %*% x )
    if (t > initLen)
        X[,t-initLen] = rbind(1,u,x)
}

# train the output
reg = 1e-8  # regularization coefficient
X_T = t(X)
Wout = Yt %*% X_T %*% solve( X %*% X_T + reg*diag(1+inSize+resSize) )

# run the trained ESN in a generative mode. no need to initialize here,
# because x is initialized with training data and we continue from there.
Y = matrix(0,outSize,testLen)
u = data[trainLen+1]
for (t in 1:testLen){
    x = (1-a)*x + a*tanh( Win %*% rbind(1,u) + W %*% x )
    y = Wout %*% rbind(1,u,x)
    Y[,t] = y
    # generative mode:
    u = y
    # this would be a predictive mode:
    #u = data[trainLen+t+1]
}

# compute MSE for the first errorLen time steps
errorLen = 500
mse = ( sum( (data[(trainLen+2):(trainLen+errorLen+1)] - Y[1,1:errorLen])^2 )
	/ errorLen )
print( paste( 'MSE = ', mse ) )

# plot some signals
dev.new()
plot( data[(trainLen+1):(trainLen+testLen+1)], type='l', col='green' )
lines( c(Y), col='blue' )
title(main=expression(paste('Target and generated signals ', bold(y)(italic(n)),
	' starting at ', italic(n)==0 )))
legend('bottomleft',legend=c('Target signal', 'Free-running predicted signal'),
	col=c('green','blue'), lty=1, bty='n' )

dev.new()
matplot( t(X[(1:20),(1:200)]), type='l' )
title(main=expression(paste('Some reservoir activations ', bold(x)(italic(n)))))

dev.new()
barplot( Wout )
title(main=expression(paste('Output weights ', bold(W)^{out})))


# library(rgl)

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

w1 <- function(k, dist) {
  return (1 ^ k)
}

kwNN <- function(dataset, points, k, dist = euclidean, weight = w1) {
  answer <- array(dim = c(length(points[,1])))
  classes = unique(dataset$class)

  for (i in 1:length(points[,1])) {
    distance <- array(dim = c(length(dataset[,1])))
    for (j in 1:length(dataset[,1])) {
      distance[j] = dist(points[i, ], dataset[j, 1:2])
    }
    sortedDataset <- dataset[order(distance),]
    distance <- sort(distance)

    scores <- rep(x = 0, times = length(classes))
    names(scores) = classes
    for (j in 1:k) {
      scores[sortedDataset$class[j]] = scores[sortedDataset$class[j]] + weight(j, distance[j])
    }

    answer[i] = names(which.max(scores))[1]
  }

  return (answer)
}

kwNN_point <- function(dataset, point, k, dist = euclidean, weight = w1) {
  distances <- array(dim = c(length(dataset[,1])))
  for (i in 1:length(distances)) {
    distances[i] <- dist(point[,3:4], dataset[i,3:4])
  }

  sortedDataset <- dataset[order(distances),]
  distances <- sort(distances)
  scores <- array(0L, length(unique(dataset$Species)))
  names(scores) = unique(dataset$Species)
  for (i in 1:k) {
    scores[sortedDataset$Species[i]] = scores[sortedDataset$Species[i]] + weight(i, distances[i])
  }

  return (names(which.max(scores)))
}

kwnn_loo <- function(k, dset) {

  classes = unique(dset$class)
  qs <- seq(from = 0.0, to = 1.0, by = 0.05)
  result <- array(0L, dim = c(length(qs)))
  for (i in 1:length(dset[,1])) {
    cat("\rProcessing sample", i, "of", length(dset[,1]))
    dataset <- dset[-i,]
    distance <- array(dim=c(length(dataset[,1])))
    for (j in 1:(length(dataset[,1]))) {
      distance[j] <- euclidean(dataset[j, 1:2], dset[i, 1:2])
    }
    sortedDataset <- dataset[order(distance),]
    distance <- sort(distance)

    classesCount <- array(0L, dim = c(length(classes)))
    dimnames(classesCount) = list(classes)

    classesCount <- array(0L, dim = c(length(classes), length(qs)))
    dimnames(classesCount) = list(classes)
    for (j in 1:k) { # k's
      index <- 1
      for (q in qs) {
        classesCount[sortedDataset$class[j],index] <- classesCount[sortedDataset$class[j],index] + (q ^ j)
        classForCurrentK = names(which.max(classesCount[,index]))[1]

        index <- index + 1
      }
    }
    for (j in 1:length(qs)) {
      ans = names(which.max(classesCount[,j]))[1]

      if (ans == paste(dset$class[i])) {
        result[j] <- result[j] + 1
      }
    }
  }
  cat("\n")

  for (i in 1:length(result)) {
    result[i] <- result[i] / length(dset[,1])
  }

  return (result)
}

df = data.frame(x = double(), y = double(), class = character())

df <- rbind(df, data.frame(x = 122, y = 2208, class = "class-1"))
df <- rbind(df, data.frame(x = 148, y = 1136, class = "class-2"))
df <- rbind(df, data.frame(x = 270, y = 2186, class = "class-1"))
df <- rbind(df, data.frame(x = 271, y = 2016, class = "class-1"))
df <- rbind(df, data.frame(x = 306, y = 1023, class = "class-2"))
df <- rbind(df, data.frame(x = 413, y = 1153, class = "class-2"))
df <- rbind(df, data.frame(x = 503, y = 2013, class = "class-1"))
df <- rbind(df, data.frame(x = 541, y = 971, class = "class-2"))
df <- rbind(df, data.frame(x = 706, y = 1018, class = "class-2"))
df <- rbind(df, data.frame(x = 837, y = 867, class = "class-2"))
df <- rbind(df, data.frame(x = 875, y = 1011, class = "class-2"))
df <- rbind(df, data.frame(x = 927, y = 1915, class = "class-1"))
df <- rbind(df, data.frame(x = 997, y = 897, class = "class-2"))
df <- rbind(df, data.frame(x = 1005, y = 529, class = "class-2"))
df <- rbind(df, data.frame(x = 1028, y = 1176, class = "class-2"))
df <- rbind(df, data.frame(x = 1050, y = 1429, class = "class-1"))
df <- rbind(df, data.frame(x = 1125, y = 781, class = "class-2"))
df <- rbind(df, data.frame(x = 1144, y = 1061, class = "class-2"))
df <- rbind(df, data.frame(x = 1146, y = 1751, class = "class-1"))
df <- rbind(df, data.frame(x = 1192, y = 1601, class = "class-1"))
df <- rbind(df, data.frame(x = 1264, y = 888, class = "class-2"))
df <- rbind(df, data.frame(x = 1275, y = 1412, class = "class-1"))
df <- rbind(df, data.frame(x = 1329, y = 576, class = "class-2"))
df <- rbind(df, data.frame(x = 1366, y = 1586, class = "class-1"))
df <- rbind(df, data.frame(x = 1405, y = 386, class = "class-2"))
df <- rbind(df, data.frame(x = 1432, y = 1226, class = "class-1"))
df <- rbind(df, data.frame(x = 1597, y = 279, class = "class-2"))
df <- rbind(df, data.frame(x = 1615, y = 1604, class = "class-1"))
df <- rbind(df, data.frame(x = 1631, y = 1200, class = "class-1"))
df <- rbind(df, data.frame(x = 1638, y = 1365, class = "class-1"))
df <- rbind(df, data.frame(x = 1765, y = 1262, class = "class-1"))
df <- rbind(df, data.frame(x = 1806, y = 1444, class = "class-1"))
df <- rbind(df, data.frame(x = 1821, y = 1056, class = "class-1"))
df <- rbind(df, data.frame(x = 1896, y = 877, class = "class-1"))
df <- rbind(df, data.frame(x = 1993, y = 695, class = "class-1"))
df <- rbind(df, data.frame(x = 2027, y = 1415, class = "class-1"))
df <- rbind(df, data.frame(x = 2087, y = 889, class = "class-1"))
df <- rbind(df, data.frame(x = 2189, y = 674, class = "class-1"))

z = array(c(c(1164, 1232)), dim = c(1,2))

# m <- fast_cvloo_kwnn()
k <- 6

qs <- (seq(from = 0.0, to = 1.0, by = 0.05))
acc = kwnn_loo(6, df)

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

print(qs[which.max(acc)])

plot(qs, acc, type = "l", xlab = "q", ylab="Accuracy")
points(qs[which.max(acc)], max(acc), pch = 19, col = "red")

bestQ <- qs[which.max(acc)]

cat("Best accuracy:", max(acc), "for q =", qs[which.max(acc)])

colors <- c("class-1" = "blue", "class-2" = "red")
plot(df[, 1:2], bg = colors[paste(df$class)], pch=23, asp=1)

result <- kwNN(df, z, 5, euclidean, function(k, dist) { return(bestQ ^ k) })
points(z[,1], z[,2], bg = colors[result], pch = 22)

1 - Nearest neighbors algorithm/kwnn-loocv-img-exp.r


library(nloptr)
library(rlist)

get_expected_I = function(N0, C0, beta, gamma, lambda) {
  "
  Calculates expected new case counts for each step in the time series.

  Parameters
  ----------
  N0 : numeric
    Initial number of contagious patients.
  C0 : numeric
    Initial number of infected but non-contagious patients.
  beta : numeric vector
    Expected number of cases stemming from a single person in a single day.
    Lagged one step (beta[1] = beta(0) in our notation).
  gamma : numeric
    Probability that an infected, non-contagious patient will turn infectious in
    the next time step.
  lambda : numeric
    (1 / mean) number of days an individual will continue to be infectious.

  Returns
  -------
  expected_I : numeric vector
    Daily expected number of new cases.
  "
  steps = length(beta)
  expected_I = rep(0, steps)
  expected_N = rep(0, steps)
  expected_C = rep(0, steps)
  N_previous = N0
  C_previous = C0
  for(t in 1:steps) {
    expected_I[t] = gamma * C_previous
    expected_N[t] = N_previous * pexp(1, rate=lambda, lower.tail=FALSE) + expected_I[t]
    expected_C[t] = (1 - gamma) * C_previous + beta[t] * N_previous
    N_previous = expected_N[t]
    C_previous = expected_C[t]
  }
  return(expected_I)
}

fit = function(observed_I, beta0, beta_min, beta_max, gamma0, gamma_min,
               gamma_max, lambda0, lambda_min, lambda_max, N00, N0_min, N0_max,
               C00, C0_min, C0_max, alpha, ignore_beta_diff) {
  "
  Fits the model to observed daily new case counts.

  Parameters
  ----------
  observed_I : numeric vector
    Daily observed number of new cases.
  beta0 : numeric vector
    Initial value for beta; the expected number of cases stemming from a single
    person in a single day.
  beta_min : numeric
    Beta lower bound.
  beta_max : numeric
    Beta upper bound.
  ignore_beta_diff : numeric vector
    List of beta indices for which differences should be ignored while
    calculating the loss function. This amounts to moments in time in which we
    allow the beta series to be discontinuous.

  Returns
  -------
  beta : numeric vector
    Expected number of cases stemming from a single person in a single day.
  "
  # concatenate initial parameters into a single vector for optimization
  x0 = c(beta0, gamma0, lambda0, N00, C00)
  steps = length(observed_I)
  lb = c(rep(beta_min, steps), gamma_min, lambda_min, N0_min, C0_min)
  ub = c(rep(beta_max, steps), gamma_max, lambda_max, N0_max, C0_max)
  # set optimization parameters
  opts = list("algorithm" = "NLOPT_LN_BOBYQA", "xtol_rel" = 1.0e-7,
              "maxeval" = 10000000)
  # define loss function
  loss = function(x) {
    # unpack values
    beta = x[1:steps]
    gamma = x[steps + 1]
    lambda = x[steps + 2]
    N0 = x[steps + 3]
    C0 = x[steps + 4]
    # calculate loss
    expected_I = get_expected_I(N0, C0, beta, gamma, lambda)
    beta_diff = diff(beta)
    beta_diff = beta_diff[!1:length(beta_diff) %in% ignore_beta_diff]
    loss = mean((expected_I - observed_I) ^ 4) + alpha * mean(beta_diff ^ 2)
  }
  result = nloptr(x0=x0, eval_f=loss, eval_grad_f=NULL, lb=lb, ub=ub, opts=opts)
  model = list()
  model$beta = result$solution[1:steps]
  model$gamma = result$solution[steps + 1]
  model$lambda = result$solution[steps + 2]
  model$N0 = result$solution[steps + 3]
  model$C0 = result$solution[steps + 4]
  model$loss = result$objective
  return(model)
}


isLeapYear <- function(year) {
    ifelse(year%%100==0, year%%400==0, year%%4==0)
}

for (y in c(1900, 1994, 1996, 1997, 2000)) {
  cat(y, ifelse(isLeapYear(y), "is", "isn't"), "a leap year.\n")
}


#' Path costs based on BPR link cost function
#'
#' This function calculates the path costs as a function of link flows over network. BPR link cost functions are assumed.
#' @param x Traffic flow on all links of network
#' @param A link-path incidence matrix
#' @param Alpha Vector of free flow travel time parameters for each link
#' @param Beta Vector of capacity parameters for each link
#' @param pow Polynomial order of cost function for each link. Defaults to 4.
#' @return Vector of path costs
#' @keywords path route cost
#' @examples
#' A <- matrix(c(0,1,0,0,1,0,0,0,0,1,1,0,0,0,1,0,0,0,0,1,1,0,0,0,0,0,0,1),ncol=4,byrow=T)
#' Alpha <- rep(10,7)
#' Beta <- rep(2,7)
#' pow <- rep(4,7)
#' path_flow <- c(10,20,15,15)
#' x <- A%*%path_flow
#' PathCost(x,A,Alpha,Beta)
#' @export

PathCost <- function(x,A=diag(length(x)),Alpha,Beta,pow=4){
 	c(t(A)%*%LinkCost(A%*%x,Alpha,Beta,pow=pow))
}


library(shiny)
library(matrixcalc)
library(plotly)

gaussPdf <- function (x, mu, E) {
  k <- length(x)
  ans <- exp(-0.5 * t(x - mu) %*% solve(E) %*% (x - mu)) /
    sqrt((2 * pi) ^ k * det(E))
  return (ans)
}

function(input, output, session, ...) {
  output$err <- function() {
    E <- matrix(c(input$E1, input$E3, input$E2, input$E4), nrow = 2)
    if (!matrixcalc::is.positive.definite(E)) {
      return("Error: covariance matrix has to be positive definite.")
    }
    return("")
  }

  output$p <- renderPlotly({
    mu = c(input$mu1, input$mu2)
    E <- matrix(c(input$E1, input$E3, input$E2, input$E4), nrow = 2)

    if (!matrixcalc::is.positive.definite(E)) {
      plot_ly()
      return()
    }

    xs <- seq(from = mu[1] - 5, to = mu[1] + 5, by = 0.1)
    ys <- seq(from = mu[2] - 5, to = mu[2] + 5, by = 0.1)
    z <- c()

    for (y in ys) {
      curr <- c()
      for (x in xs) {
        arg <- c(x, y)
        value <- gaussPdf(arg, mu, E)

        curr <- c(curr, value)
      }
      z <- rbind(z, curr)
    }

    fig <- plot_ly(
      type = 'surface',
      x = ~xs,
      y = ~ys,
      z = ~z) %>% add_surface(
        contours = list(
          z = list(
            show=TRUE,
            usecolormap=TRUE,
            highlightcolor="#ff0000",
            project=list(z=TRUE)
          )
        )
      )
    fig
  })
}

5 - Contour lines of the Gaussian distribution PDF/shiny/server.r


baseball <- read.csv("baseball.csv")
str(baseball)

moneyball <- subset(baseball, Year < 2002)
str(moneyball)

moneyball$RD <- moneyball$RS - moneyball$RA
str(moneyball)

plot(moneyball$RD, moneyball$W)
WinsReg <- lm(W ~ RD, data = moneyball)
summary(WinsReg)

# W = 80.88 + 0.105*(RD)
# 80.88 + 0.1058(RD) >= 95, hence RD >= 135 =)

# Quiz


=begin
  # sample-groebner03.rb

  require "algebra"
  F5 = ResidueClassRing(Integer, 2)
  F = AlgebraicExtensionField(F5, "a") {|a| a**3 + a + 1}
  a = F.var
  P = MPolynomial(F)

  x, y, z = P.vars("xyz")
  f1 = x + y**2 + z**2 - 1
  f2 = x**2 + z**2 - y * a
  f3 = x - z - a

  f = x**3 + y**3 + z**3
  q, r = f.divmod_s(f1, f2, f3)
  p f == q.inner_product([f1, f2, f3]) + r #=> true
((<_|CONTENTS>))
=end


#############
# ARS for the sampling of alpha in GMM and IGMM
############
library(ars)

# function
f_y <- function(y, K=3, U=10){
  y*(K-3/2) - 1/(2*exp(y)) + lgamma(exp(y)) - lgamma(exp(y)+U)
}

# first derivative function
f_y_prima <- function(y, K=3, U=10){
  (K-3/2) + 1/(2*exp(y)) + exp(y)*digamma(exp(y)) - exp(y)*digamma(exp(y)+U)
}

# Wrapper for ARS function
sample_alpha <- function(K=3, U=10){
  y <- ars2(1, f_y, f_y_prima, x=c(-2,0,30), K=K, U=U)
  exp(y)
}

###############################################################################
# Hack ARS function so that it returns the ifault codes and not just print them
# so that we can handle it like an exception
###############################################################################

ars2 <- function (n = 1, f, fprima, x = c(-4, 1, 4), ns = 100, m = 3,
                  emax = 64, lb = FALSE, ub = FALSE, xlb = 0, xub = 0, ...)
{
  mysample <- rep(0, n)
  iwv <- rep(0, ns + 7)
  rwv <- rep(0, 6 * (ns + 1) + 9)
  hx <- f(x, ...)
  hpx <- fprima(x, ...)
  initial <- .C("initial_", as.integer(ns), as.integer(m),
                as.double(emax), as.double(x), as.double(hx), as.double(hpx),
                as.integer(lb), as.double(xlb), as.integer(ub), as.double(xub),
                ifault = as.integer(0), iwv = as.integer(iwv), rwv = as.double(rwv))
  if (initial$ifault == 0) {
    h <- function(x) f(x, ...)
    hprima <- function(x) fprima(x, ...)
    for (i in 1:n) {
      sample <- .C("sample_", as.integer(initial$iwv),
                   as.double(initial$rwv), h, hprima, new.env(),
                   beta = as.double(0), ifault = as.integer(0))
      if (sample$ifault == 0) {
        if (i < ns) {
          x <- c(x, sample$beta)
          h <- function(x) f(x, ...)
          hprima <- function(x) fprima(x, ...)
        }
        mysample[i] <- sample$beta
      }
      else {
        cat("\nError in sobroutine sample_...")
        cat("\nifault=", sample$ifault, "\n")
        stop(paste("\nError in sobroutine sample_...", sample$ifault))
      }
    }
  }
  else {
    cat("\nError in sobroutine initial_...")
    cat("\nifault=", initial$ifault, "\n")
    stop(paste("\nError in sobroutine initial_...", initial$ifault))
  }
  return(mysample)
}

environment(ars2) <- environment(ars)


#Code for calculating the area under curve using Trapezoidal Integration
#Input File has single column containing Values

args <- commandArgs(trailingOnly = TRUE);
raw_data = read.csv(args[1])
data <- cbind(1:dim(raw_data)[1],raw_data)
require(pracma)
AUC = trapz(as.vector(t(data[1])),as.vector(t(data[2])))
disp(AUC)


# 4. faza: Analiza podatkov

#6 Napoved števila igralcev tedna za centre

tabela_centri_vmesno <- igralci_tedna %>% filter(Pozicija == "C")
stetje <- count(tabela_centri_vmesno, Sezona_okrajsano)
tabela_centri <- as.data.frame(stetje)

pril_lm <- lm(data=tabela_centri, n ~ Sezona_okrajsano)
nova_leta <- data.frame(Sezona_okrajsano=seq(2019,2022,1))
napoved <- mutate(nova_leta, n=predict(pril_lm, nova_leta))

graf_napoved <- ggplot(tabela_centri, aes(Sezona_okrajsano,n)) + geom_smooth(method="lm", fullrange=TRUE, alpha = 0.3, color = "dodgerblue2", size = 0.6)+
  geom_point(data=napoved,aes(Sezona_okrajsano,n),color="red", size=2)+ theme_bw() +
  geom_point(color="dodgerblue4", size = 2) + ggtitle("Napoved števila centrov kot igralcev tedna") + xlab("Sezona")+ylab("Število")

#7 Primerjava dveh igralcev

tabela_harden2 <- tabela_harden[,-c(2,3,4,5,6,7,8,9,10,11,13)]
tabela_harden2$Year <- as.numeric(tabela_harden2$Year)
tabela_harden2 <- as.data.frame(tabela_harden2)

pril_lmh <- lm(data=tabela_harden2,P_WEEK ~ Year)
nova_letah <- data.frame(Year=19)
napovedh <- mutate(nova_letah, P_WEEK=predict(pril_lmh,nova_letah))

tabela_curry2 <- tabela_curry[,-c(2,3,4,5,6,7,8,9,10,11,13)]
tabela_curry2$Year <- as.numeric(tabela_curry2$Year)
tabela_curry2 <- as.data.frame(tabela_curry2)

pril_lmc <- lm(data=tabela_curry2,P_WEEK ~ Year)
nova_letac <- data.frame(Year=19)
napovedc <- mutate(nova_letac, P_WEEK=predict(pril_lmc,nova_letac))

pril_lmh2 <- loess(data=tabela_harden2,P_WEEK ~ Year,control=loess.control(surface="direct"))
nova_letah2 <- data.frame(Year=19)
napovedh2 <- mutate(nova_letah2, P_WEEK=predict(pril_lmh2,nova_letah2))

pril_lmc2 <- loess(data=tabela_curry2,P_WEEK ~ Year,control=loess.control(surface="direct"))
nova_letac2 <- data.frame(Year=19)
napovedc2 <- mutate(nova_letac2, P_WEEK=predict(pril_lmc2,nova_letac2))
napovedc2[1,2] <- 0   # Ker vrednost ne more biti manjša od 0

graf_harden_curry2 <- ggplot(data=zdruzena, aes(Year,P_WEEK)) + geom_point(data = zdruzena %>% filter (Name =="Harden"), color="red", size=2.8) +
  geom_smooth(data = zdruzena %>% filter (Name =="Harden"), color="red", fill="indianred1", size=1, alpha = 0.2, method="loess") +
  geom_point(data= zdruzena %>% filter (Name == "Curry"), color = "darkgoldenrod", size =2.8) + theme_bw()+
  geom_smooth(data= zdruzena %>% filter (Name == "Curry"), color = "darkgoldenrod", fill="goldenrod1", size=1, alpha= 0.2, method="loess") +
  geom_point(data=napovedh,aes(Year,P_WEEK), color="tomato",size=6,shape=16)+
  geom_point(data=napovedh,aes(Year,P_WEEK), color="black",size=5,shape=49)+
  geom_point(data=napovedc,aes(Year,P_WEEK), color="goldenrod1",size=6,shape=16)+
  geom_point(data=napovedc,aes(Year,P_WEEK), color="black",size=5,shape=49)+
  geom_point(data=napovedh2, aes(Year, P_WEEK), color="tomato",size=6,shape=16)+
  geom_point(data=napovedh2, aes(Year, P_WEEK), color="black",size=5,shape=50)+
  geom_point(data=napovedc2,aes(Year,P_WEEK), color="goldenrod1",size=6,shape=16)+
  geom_point(data=napovedc2,aes(Year,P_WEEK), color="black",size=5,shape=50)+
  xlab("Sezona") + ylab("Igralec tedna") +
  ggtitle("Primerjava in napoved števila osvojenih nazivov igralca tedna") + theme(legend.position = "right") +
  annotate("text", x=16.8, y=7, label= "James Harden", color="red", size=5) +
  annotate("text",x=14,y=-2,label="Stephen Curry", color="darkgoldenrod", size=5)


=begin
  # sample-quotientfield04.rb

  require "algebra"

  F13 = ResidueClassRing(Integer, 13)
  F = RationalFunctionField(F13, "x")
  x = F.var
  AF = AlgebraicExtensionField(F, "a") {|a| a**2 - 2*x}
  a = AF.var

  p( (a/4*x + AF.unity/2)/(x**2 + a*x + 1) +
    (-a/4*x + AF.unity/2)/(x**2 - a*x + 1) )
  #=> (-x^3 + x^2 + 1)/(x^4 + 11x^3 + 2x^2 + 1)
((<_|CONTENTS>))
=end