# ......................................................................................
# ..........................Exercise 8. Sampling distributions..........................
# .....................................Michal Béreš.....................................
# ......................................................................................

# 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

#  Other selected continuous distributions ####
#
# * $\chi^2$ - Chi-square distribution(Pearns distribution) ####
#
# - Use: when estimating the standard deviation(using sampling)
#
# - Has a single parameter - the number of degrees of freedom
#
# - $\frac{S^2}{\sigma^2}(n-1) \sim \chi^2_{n-1}$
#
# - $S$ is the sample standard deviation
#

n =  5 # number of degrees of freedom
x = seq(from = 0, to = 30, by = 0.01) # x-axis
fx = dchisq(x = x, df = n) # chi-sq probability density. distribution

plot(x, fx, type='l')

Fx = pchisq(q = x, df = n) # distrib. f. of chi-sq. distribution

plot(x, Fx, type='l')

# * $t$ - Student's distribution ####
#
# - Application: when estimating the mean without exact knowledge of variance(sampling
# only)
#
# - $\frac{\bar X - \mu}{S}\sqrt{n} \sim t_{n-1} $
#
# - $\bar X$ is the sample average
#
# - $S$ is the sample standard deviation
#
# - converges to a normalized normal distribution with increasing number of degrees of
# freedom
#

n =  5 # number of degrees of freedom
x = seq(from = -3, to = 3, by = 0.01) # x-axis
fx = dt(x = x, df = n) # probability density of the student's distribution

plot(x, fx, type='l')

fnorm = dnorm(x, mean=0, sd=1)  # norm values. normal dist
lines(x, fnorm, col="red")      # to the last graph

Fx = pt(q = x, df = n) # probability density of the student's distribution

plot(x, Fx, type='l')

Fnorm = pnorm(x, mean=0, sd=1)  # norm values. normal birth
lines(x, Fnorm, col="red")      # to the last graph

# * $F$ - Fisher-Snedecor distribution ####
#
# - Used to test ratio of variances
#
# - $\frac{S_1^2/\sigma_1^2}{S_2^2/\sigma_2^2} \sim F_{n_1 - 1, n_2 - 1}$
#

n = 5  # number of degrees of freedom selection. 1
m = 6  # number of degrees of freedom selection. 2
x = seq(from = 0, to = 10, by = 0.01) # x-axis
fx = df(x = x, df1 = n, df2 = m) # chi-quad probability density. distribution

plot(x, fx, type='l')

Fx = pf(q = x, df1 = n, df2 = m) # chi-quad probability density. distribution

plot(x, Fx, type='l')

#  How does the average of the values from the normal distribution behave? ####
#
# The function **rnorm(n, mean, sd)** generates **n** values from the normal
# distribution with themeanvalue **mean** and the standard deviation **sd**.
#

selection_size = 30
mu = 10
sigma = 3
random_selection = rnorm(n=selection_size, mean=mu, sd=sigma)
random_selection

mean(random_selection)
sd(random_selection)

# ** Random variable: average of values ####
#

n_selections = 1000
means = numeric(n_selections) # numeric produces vector 0
st_deviations = numeric(n_selections)
for(i in 1:n_selections){
  random_selection = rnorm(n=selection_size,mean=mu,sd=sigma)
  means[i] = mean(random_selection)
  st_deviations[i] = sd(random_selection)
}

hist(means)

qqnorm(means)
qqline(means)

mean(means)
sd(means)
sigma/sqrt(selection_size)

#  How does the average of values from the uniform distribution behave? ####
#
# The function **runif(n, min, max)** generates **n** values from the uniform
# distribution U(**min, max**).
#

selection_size = 30
a = 1
b = 7
random_selection=runif(n=selection_size, min=a, max=b)
# random sample

hist(random_selection)

mu = (a+b)/2
mu
mean(random_selection)
sigma = sqrt((b-a)^2/12)
sigma
sd(random_selection)

# ** Random variable: average of values ####
#

n_selections = 1000
means = numeric(n_selections)
st_deviations = numeric(n_selections)
for(i in 1:n_selections){
  random_selection = runif(n=selection_size, min=a, max=b)
  means[i] = mean(random_selection)
  st_deviations[i] = sd(random_selection)
}

hist(means)

qqnorm(means)
qqline(means)

mean(means)
sd(means)
sigma/sqrt(selection_size)

#  Examples ####
#
# * Example 1. ####
#
# The load on an aircraft with 64 seats shall not exceed 6,000 kg. What is the
# probability that this value will be exceeded at full occupancy if the passenger mass
# has a mean value of 90 kg and a standard deviation of 10 kg?
#

# X... weight 64 passengers
# X~N(64 * 90; 64 * 100)
# P(X>6000)=1 - F(6000)

1 - pnorm(q=6000, mean=64*90, sd=sqrt(64*100))

# * Example 2. ####
#
# The consignment contains 300 products of a certain type. It is known that the
# probability of making a defective product of this type is 0.04.
#
# ** a) ####
#
# Estimate the probability that the proportion of defective products in the consignment
# (300 products) will differ from the probability of producing a defective product by
# less than 1% (i.e. $p-\pi \in <-0.01,0.01>$).
#

# p-pi from -0.01 to 0.01
# for pi = 0.04, p is from 0.03 to 0.05
# having 300 products, we should observe between 9 and 15 defective ones

# X...number of defective products out of 300
# X~Binom(n=300, pi=0.04)
# P(9 <= X <= 15)=P(X<=15)-P(X<9)
pbinom(15,300,0.04)-pbinom(9-1,300,0.04)

# X=(p - π)/sqrt(π*(1 - π)) * sqrt(n) ∼ N(0, 1)
# P(-0.01/sqrt(π*(1-π))*sqrt(n) < X < 0.01/sqrt(π*(1-π))*sqrt(n))
pi = 0.04
n = 300
bound = 0.01/sqrt(pi*(1-pi))*sqrt(n)
pnorm(q=bound, mean=0, sd=1) - pnorm(q=-bound, mean=0, sd=1)

# ** b) ####
#
# How will the result change if the shipment contains 3,000 products?
#

pbinom(150,3000,0.04)-pbinom(90-1,3000,0.04)

n = 3000
bound = 0.01/sqrt(pi*(1-pi))*sqrt(n)
pnorm(q=bound, mean=0, sd=1) - pnorm(q=-bound, mean=0, sd=1)

# * Example 3. ####
#
# Passenger regularly travel to and from work using public transport. It is known that
# the waiting time for the arrival of public transport ranges from 0 to 3 minutes. What
# is the probability that the total waiting time for a passenger during in 23 working
# days will be less than 80 minutes?
#

# Y... time of the i-th waiting for public transport
# y~R(0; 3)
# X... total waiting time in 23 days(round trip ⇒ 46 waitings)
# X~N(46 * EY; 46 * DY)
# P(X<80)

a = 0
b = 3
n = 46
EY = (a+b)/2
DY = (b-a)^2/12

pnorm(q=80, mean=n*EY, sd=sqrt(n*DY))

# * Example 4. ####
#
# Assume that the average electricity consumption of households in a given city in
# January is 120 kWh and the standard deviation of consumption is 100 kWh. Determine the
# probability that the average consumption of 100 randomly selected households will be
# greater than 140 kWh.

# Xi... consumption of the i-th household
# X... average consumption of 100 households
# X~N(EXi; Dxi/n)
# P(X>140)

EXi = 120
DXi = 100^2
n = 100
1 - pnorm(q=140, mean=EXi, sd=sqrt(DXi/n))

# * Example 5. ####
#
# The Acme Battery Company has developed a new type of mobile phone battery. On average,
# batteries last 60 minutes on a single charge. The standard deviation of this time is 4
# minutes. Assume that the production department runs a quality control test after 6
# months. They performed two random selections with a range of 10 batteries and in both
# found a standard deviation of battery life greater than 6 minutes. How likely were
# they to expect such a result?
#

# X=(n - 1) * S^2/σ^2
# X ∼ χ_n-1
# P(S>6)=P(X>...)

n = 10
S_obs = 6
sigma = 4
X_obs = (n - 1)*S_obs^2/sigma^2

P_one_observation = 1 - pchisq(q=X_obs, df=n-1)
P_one_observation
P_one_observation^2

# * Example 6. ####
#
# The mortality tables show a probability of 0.99 that a 35-year-old man will live
# another year. The annual premium for this age group is CZK 2,000, in the event of
# death the insurance company will pay CZK 100,000. What is the probability that the
# profit of the company insuring 500 men aged 35 will be at least CZK 500,000?(Solve in
# two ways - using the binomial distribution and using the binomial distribution
# approximation by the normal distribution.)

# X... number of men out of 500 who won't live to see another year
# X~Bi(500; 0.01)
# Z=500 · 2,000 - X · 100,000
# P(Z ≥ 500,000)=P(X ≤ 5)

pbinom(5, size=500, prob=0.01)

# X~Bi(500; 0.01)~N(500 * 0.01; 500 * 0.01*(1-0.01))
# P(X ≤ 5)~P(X<5.5)(continuity correction)

pnorm(5.5, mean=500*0.01, sd=sqrt(500*0.01*(1-0.01)))

# * Example 7. ####
#
# Assume that approximately 60% of young men in the population have higher than
# recommended serum cholesterol levels. In a random selection of 200 young men, how
# likely will more than 120 of them have higher than recommended serum cholesterol
# levels?
#

# X... number of young men out of 200 with higher than recommended serum cholesterol levels
# X ∼ Bi(200; 0.6)
# P(X>120)=1 - P(X ≤ 120)

1 - pbinom(120, size=200, prob=0.6)

# X~N(200 * 0.6; 200 * 0.6(1-0.6)), ie X ≈ N(120; 48)
# 1 - P(X ≤ 120)~1 - P(X<120.5)(continuity correction)

1 - pnorm(120.5, mean=200*0.6, sd=sqrt(200*0.6*(1-0.6)))


wavethresh = function(y, thresh.value="universal", sigma=NA, p=1, low.level=4, by.level=F, filter.number=2, family="DaubExPhase", bc="periodic"){
    # Wavelet-based smoothing by Lp penalized least squares
    # INPUT
    # y = noisy signal
    # thresh.value = "universal", "minimax", "SURE", "BIC", "SLIC"
    # sigma = standard deviation of noise
    # p in [0,1] (0=hard, 1=soft)
    # low.level = lowest level where to start thresholding
    # by.level = T (levelwise) or F (global)

    if(!is.na(p)){
      if(p==1) type="soft"
      if(p==0) type="hard"
    }
    else type="lpin01"

    N=length(y)
    if(!is.numeric(sigma)){
      ytHaar=wd(y,1,family="DaubExPhase")
      sigma=mad(accessD(ytHaar,log(N,2)-1),center=0)
    }
    y=y/sigma
    yt=wd(y, filter.number=filter.number, family=family, bc=bc)

    if(by.level==F){
      if(thresh.value=="universal") thresh.value=sqrt(2*log(N))
      if(thresh.value=="minimax") {
        Ns=2^c(6:16)
        tmmS=c(1.474,1.669,1.859,2.045,2.226,2.403,2.575,2.743,2.906,3.066,3.221)
        tmmH=c(2.697,2.913,3.117,3.312,3.497,3.674,3.844,4.008,4.166,4.319,4.467)
        if(type=="soft") thresh.value=tmmS[match(N,Ns)]
        if(type=="hard") thresh.value=tmmH[match(N,Ns)]
      }
      if((thresh.value=="SURE")&(type=="soft")){
        aMLE=rev(yt$D)
        ## DJ 1995 JASA's Hybrid method eq. 14 page 1208
        if(mean(aMLE^2-1)>(log(N,2)^(3/2)/sqrt(N))){
          aMLE=aMLE[-c(1:(2^low.level-1))]
          aMLEabssort = sort(abs(aMLE))
          aMLEabssort2 = aMLEabssort^2
          lambdas=aMLEabssort;
          ND=length(aMLE)
          tp1 = cumsum(aMLEabssort2)+((ND-1):0)*aMLEabssort2;
          risk_hatS = (ND - (2 * (1:ND)) + tp1)/ND;
          thresh.value = lambdas[which.min(risk_hatS)]
        }
        else thresh.value=sqrt(2*log(N))
      }
      if((thresh.value=="SLIC")&(type=="soft")){
        ND=length(yt$D)
        lambdaU=sqrt(2*log(ND))
        lambda0=lambdaU/2
        a.hat=lp_shrink(yt$D, 1, lambda0)
        l1mean=mean(abs(a.hat))
        again=T
        while(again){
          lambda1=lambdaU/(1+l1mean*lambdaU)
          again=((abs(lambda1-lambda0)/lambda1)>1.e-6)
          lambda0=lambda1
          a.hat=lp_shrink(yt$D, 1, lambda0)
          l1mean=mean(abs(a.hat))
        }
        thresh.value=lambda0
      }
      if((thresh.value=="BIC")&(type=="hard")) thresh.value=sqrt(log(N))

      ytthresh=threshold.wd(yt, levels=low.level:(yt$nlevels-1), type=type, policy="manual", value=thresh.value)
      ytthresh$D=ytthresh$D*sigma
      ytthresh$C=ytthresh$C*sigma
    }
    else{
      ###########################
      ## Levelwise thresholding
      ytthresh=yt
      for(level in low.level:(yt$nlevel-1)){
        ytj=accessD(yt,level)
        Nj=length(ytj)
        if(thresh.value=="universal") thresh.value.j=sqrt(2*log(Nj))
        if(thresh.value=="minimax") {
          Ns=2^c(3:16)
          # The first 4 values are extrapolated ones.
          tmmS=c(0.674,0.874,1.074,1.274,1.474,1.669,1.859,2.045,2.226,2.403,2.575,2.743,2.906,3.066,3.221)
          tmmH=c(1.757,2.007,2.247,2.477,2.697,2.913,3.117,3.312,3.497,3.674,3.844,4.008,4.166,4.319,4.467)
          if(type=="soft") thresh.value.j=tmmS[match(Nj,Ns)]
          if(type=="hard") thresh.value.j=tmmH[match(Nj,Ns)]
        }
        if((thresh.value=="SURE")&(type=="soft")){
          ## DJ 1995 JASA's Hybrid method eq. 14 page 1208
          if(mean(ytj^2-1)>(log(Nj,2)^(3/2)/sqrt(Nj))){
            aMLE=ytj
            aMLEabssort = sort(abs(aMLE))
            aMLEabssort2 = aMLEabssort^2
            lambdas=aMLEabssort;
            tp1 = cumsum(aMLEabssort2)+((Nj-1):0)*aMLEabssort2;
            risk_hatS = (Nj - (2 * (1:Nj)) + tp1)/Nj;
            thresh.value.j = lambdas[which.min(risk_hatS)]
          }
          else thresh.value.j=sqrt(2*log(Nj))
        }
        if((thresh.value=="SURE")&(type=="hard")){
          ## DJ 1995 JASA's Hybrid method eq. 14 page 1208
          if(mean(ytj^2-1)>(log(Nj,2)^(3/2)/sqrt(Nj))){
            aMLE=ytj
            aMLEabssort = sort(abs(aMLE))
            aMLEabssort2 = aMLEabssort^2
            risk_hatH=(Nj-(2 * (1:Nj)) + cumsum(aMLEabssort2))/Nj;
            ahatU=ytj*(abs(ytj)>sqrt(2*log(Nj)));
            for(n in 1:Nj){
              phi=aMLEabssort[n];
              risk_hatH[n]=risk_hatH[n]+2*phi/sqrt(2*pi)*mean(exp(-0.5*(-phi-ahatU)^2)+exp(-0.5*(phi-ahatU)^2))
            }
            thresh.value.j = aMLEabssort[which.min(risk_hatH)]
          }
          else thresh.value.j=sqrt(2*log(Nj))
        }
        if((thresh.value=="SLIC")&(type=="soft")){
          lambdaU=sqrt(2*log(Nj))
          lambda0=lambdaU/2
          ytj.hat=lp_shrink(ytj, 1, lambda0)
          l1mean=mean(abs(ytj.hat))
          again=T
          while(again){
            lambda1=lambdaU/(1+l1mean*lambdaU)
            again=((abs(lambda1-lambda0)/lambda1)>1.e-6)
            lambda0=lambda1
            ytj.hat=lp_shrink(ytj, 1, lambda0)
            l1mean=mean(abs(ytj.hat))
          }
          thresh.value.j=lambda0
        }
        if((thresh.value=="BIC")&(type=="hard")) thresh.value.j=sqrt(log(Nj))
        if((thresh.value=="SURE")&is.na(p)){
           outmin=nlminb(.5, SURE_lp, control=list(iter.max=20, x.tol=.05), lower=0, upper=1, yt=ytj, out_nb=1)
           p.j=outmin$par
           out=SURE_lp(p.j, ytj, 2)
           lambda.j=out$lambda_SURE
           thresh.value.j=(2-p.j)*(lambda.j*(2*(1-p.j))^(p.j-1))^(1/(2-p.j))
        }
        if((thresh.value=="SLIC")&is.na(p)){
          p1=1/log(Nj);
          phiU=sqrt(2*log(Nj));
          lambdapU=(phiU/(2-p1))^(2-p1)/(2-2*p1)^(p1-1)
          dyl = (2-2*p1)^((p1-1)/(2-p1))*lambdapU^((p1-1)/(2-p1));
          dyll= (2-2*p1)^((p1-1)/(2-p1))*(p1-1)/(2-p1)*lambdapU^((2*p1-3)/(2-p1));
          taupU=p1*phiU*lambdapU*(dyl)^2/(Nj*dyl+p1*lambdapU*dyll);
          ct0=phiU/taupU;ct1=0;low=lambdapU;high=lambdapU
          while(rootlambda(low,p1,ct0,ct1,Nj)<=0) {low=low/2}
          while(rootlambda(high,p1,ct0,ct1,Nj)>=0) {high=high*2}
          lambda1=uniroot(rootlambda,p=p1,ct0=ct0,ct1=ct1,N=Nj,interval=c(low,high));lambda1=lambda1$root

          MAXITER=20;
          again_p=1; again_lambda=1; iter=0;
          while((again_p|again_lambda)&(iter<MAXITER)) {
            iter=iter+1;
            lambda0=lambda1;
            p0=p1;
            ytj.hat = lp_shrink(ytj, p0, lambda0);
            outmin=nlminb(.5,condloglikinp,lower=1.e-6,upper=1,alpha=ytj.hat,lambda=lambda0,N=Nj,tau=taupU);
            p1=outmin$par
            again_p=(mean(abs((p1-p0)/p1))>.001);

            lambdapU=(phiU/(2-p1))^(2-p1)/(2-2*p1)^(p1-1);
            dyl=(2-2*p1)^((p1-1)/(2-p1))*lambdapU^((p1-1)/(2-p1));
            dyll=(2-2*p1)^((p1-1)/(2-p1))*(p1-1)/(2-p1)*lambdapU^((2*p1-3)/(2-p1));
            taupU=p1*phiU*lambdapU*(dyl)^2/(Nj*dyl+p1*lambdapU*dyll);

            Lp=mean((abs(ytj.hat))^p1);
            ct0=phiU/taupU;ct1=Lp;
            low=lambda0;
            while(rootlambda(low,p1,ct0,ct1,Nj)<=0) {low=low/2}
            high=lambdapU;
            while(rootlambda(high,p1,ct0,ct1,Nj)>=0) {high=high*2}
            lambda1=uniroot(rootlambda,p=p1,ct0=ct0,ct1=ct1,N=Nj,interval=c(low,high));lambda1=lambda1$root

            again_lambda=(mean(abs((lambda1-lambda0)/lambda1))>.01);
          }
          lambda.j=lambda1;
          p.j=p1;
          thresh.value.j=(2-p.j)*(lambda.j*(2*(1-p.j))^(p.j-1))^(1/(2-p.j))
        }
        if(!is.na(p)&((p==0)||(p==1))) ytthresh=threshold.wd(ytthresh, levels=level, type=type, policy="manual", value=thresh.value.j)
        else {
          ytthresh.j=lp_shrink(ytj, p.j,lambda.j)
          ytthresh=putD(ytthresh, level, ytthresh.j)
        }
      }
      ytthresh$D=ytthresh$D*sigma
      ytthresh$C=ytthresh$C*sigma
    }

    mu.hat=wr(ytthresh)

    out=NULL
    out$alpha.MLE=yt
    out$alpha.hat=ytthresh
    out$mu.hat=mu.hat
    out$sigma.hat=sigma
    return(out)
}

##########################################
## Two functions employed by SLIC: rootlambda and condloglikinp
rootlambda=function(lambda,p,ct0,ct1,N){

    tau=sqrt(2*log(N))/ct0;
    if(lambda<0){
      fl=1.e10;
    }
    else {
        dyll=(2-2*p)^((p-1)/(2-p))*(p-1)/(2-p)*lambda^((2*p-3)/(2-p));
        temp1=(2-2*p)^((p-1)/(2-p))*lambda^((p-1)/(2-p));
        fl=-ct1*lambda + 1/p - ct0*lambda/N*temp1 + lambda/N*dyll/temp1;
    }
    return(fl)
    }

###############################################
condloglikinp=function(p, alpha,lambda, N, tau){

  J=log(length(alpha))/log(2);
  Nm=length(alpha);
  Lp=sum((abs(alpha))^p);
  fp=Nm*lgamma(1/p+1)-Nm/p*log(lambda)+lambda*Lp;
  phi=(2-p)*(lambda*(2-2*p)^(p-1))^(1/(2-p));

  phiN=sqrt(2*log(N));
  dN=phiN-(log(log(N))+log(4*pi)-2*log(2))/2/phiN;
  ct1=phiN*(phi/tau-dN);
  logG1=log(phiN/tau)-exp(-ct1)-ct1;
  dyl=(2-2*p)^((p-1)/(2-p))*lambda^((p-1)/(2-p))
  logG1=logG1+log(dyl);

  fp=fp-logG1;

  return(fp)
}


df = NULL

# Fixed parameters
s <- .2
ga <- .02
gl <- .01
delta <- .05
alpha <- .3

# Initialize dynamic process
kycurr <- 2 # initial capital stock
kyalt <- 5 # initial capital stock

df = NULL # initialize a dataframe
dfalt = NULL # initialize a dataframe
name = "A"
namealt = "B"

for (t in 1:150) # do for this many periods
{
  gky <- s*(1/kycurr)^(1-alpha) - delta  #(1-alpha)*(s/kycurr - delta - ga - gl) # calculate growth in k given current k/al
  df = rbind(df, data.frame(t,kycurr,gky,name)) # add to dataframe
  kycurr <- (1+gky-ga-gl)*(kycurr)# update current k/y for next period
  gky <- s*(1/kyalt)^(1-alpha) - delta #(1-alpha)*(s/kyalt - delta - ga - gl)
  dfalt = rbind(dfalt, data.frame(t,kyalt,gky,namealt)) # add to dataframe
  kyalt <- (1+gky-ga-gl)*(kyalt)
}

colnames(dfalt) <- c("t","kycurr","gky","name")
dfgraph = rbind(df,dfalt)

# Initialize theoretical relationship
fig <- plot_ly(dfgraph,
    x = ~kycurr,
    y = ~gky,
    color = ~name,
    frame = ~t,
    text = ~t,
    hoverinfo = "text",
    type = 'scatter',
    mode = 'markers',
    marker = list(size = 15)
  )
fig <- fig %>% animation_slider(
  hide = T
)
fig <- fig %>% animation_button(
  x = 1, xanchor = "right", y = 0.4, yanchor = "bottom"
)
fig <- layout(fig, title = list(text = 'Dynamics of capital growth', x=0),
              xaxis = list(title = 'K/AL ratio', range=c(1.5,5.5),dtick=.5),
              yaxis = list (title = 'Growth rate of K', range=c(0,0.1),dtick=.01
              )
)
api_create(fig, filename = "me-gky-dynamics")

dfgraph <- dfgraph[with(dfgraph,order(kycurr)),]

fig <- plot_ly(dfgraph, x = ~kycurr, y = ~gky, type = 'scatter', mode = 'lines')
fig <- layout(fig, title = list(text = 'Relationship of growth and level of K/Y', x=0),
              xaxis = list(title = 'Capital/output ratio',range=c(0,4.5),dtick=.5),
              yaxis = list (title = 'Growth rate of capital/output ratio', range=c(-.1,0.25))
)
api_create(fig, filename = "me-gky-relationship")

## Create evolving frames for graphing changes in growth rate
df = NULL

for (t in 1:30)
{
  kycurr <- 2^(1-alpha)
  kyalt <- 5^(1-alpha)
  kybgp <- 2.5
  dftemp = NULL
  dfalt = NULL
  dfbgp = NULL

  for (k in 1:t) # do for this many periods
  {
    name <- "A"
    ky <- kycurr
    gky <- (1-alpha)*(s/ky - delta - ga - gl) # calculate growth in k/y given current k/y
    dftemp = rbind(dftemp, data.frame(t,k,ky,gky,name)) # add to dataframe
    kycurr <- (1+gky)*(ky) # update current k/y for next period
    name <- "B"
    ky <- kyalt
    gky <- (1-alpha)*(s/ky - delta - ga - gl)
    dfalt = rbind(dfalt, data.frame(t,k,ky,gky,name)) # add to dataframe
    kyalt <- (1+gky)*(ky) # update current k/y for next period
    name <- "BGP"
    ky <- kybgp
    gky <- (1-alpha)*(s/ky - delta - ga - gl)
    dfalt = rbind(dfalt, data.frame(t,k,ky,gky,name)) # add to dataframe
    kybgp <- (1+gky)*(ky) # update current k/y for next period
  }
  df = rbind(df,dftemp)
  df = rbind(df,dfalt)
  df = rbind(df,dfbgp)
}

df$lny <- (alpha/(1-alpha))*log(df$ky) + 4 + df$k*ga
df$gy <- ga + (alpha/(1-alpha))*df$gky

df <-df[order(df$name, df$t, df$k),]
fig <- plot_ly(df,
               x = ~k,
               y = ~lny,
               frame = ~t,
               color = ~name,
               hoverinfo = "text",
               type = 'scatter',
               mode = 'lines'
)
fig <- fig %>% animation_slider(
  hide = T
)
fig <- fig %>% animation_button(
  x = 1, xanchor = "right", y = 0.4, yanchor = "bottom"
)
fig <- layout(fig, title = list(text = 'Level of GDP per capita over time', x=0),
              xaxis = list(title = 'Time', range=c(0,30),dtick=5),
              yaxis = list (title = 'Log GDP per capita', range=c(4,5)
              )
)

api_create(fig, filename = "me-lny-animated")

fig <- plot_ly(df,
               x = ~k,
               y = ~gy,
               frame = ~t,
               color = ~name,
               hoverinfo = "text",
               type = 'scatter',
               mode = 'lines'
)
fig <- fig %>% animation_slider(
  hide = T
)
fig <- fig %>% animation_button(
  x = 1, xanchor = "right", y = 0.4, yanchor = "bottom"
)
fig <- layout(fig, title = list(text = 'Growth rate of GDP per capita over time', x=0),
              xaxis = list(title = 'Time', range=c(0,30),dtick=5),
              yaxis = list (title = 'Growth rate of GDP per capita', range=c(0,.05)
              )
)

api_create(fig, filename = "me-gy-animated")


# ......................................................................................
# ...................Exercise 11. Two-sample tests/Interval estimates ..................
# ..........................Michal Béreš, Martina Litschmannová.........................
# ......................................................................................

# 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

#  Overview of confidence intervals and hypothesis tests and their constructions ####
#
# * Two columns of data - pairs/independent ####
#
# - Paired data indicates data that are taken as two measurements of the same entities
# -> data columns are dependent.
#      - For paired data, we calculate the difference between the columns(or another
# function according to the input) and use one-sample tests for this difference.
#
# - If there is no dependency between values in the two columns the data are
# independent.
#     - Two-sample test is needed

# ** Examples of paired data: ####
#
# - measuring bulbs at two different temperatures(if each piece is measured twice - at
# temperature 1 and temperature 2)
#
# - be careful here, it can happen that the tests are eg. destructive and it is not
# possible to measure twice the same entity(product). Then we would consider two
# independent selections, each for one type of measurement -> independent data columns
# -> two-sample tests
#
# - measurement of the patient's blood values before and after drug administration
#
# - again pay attention to, for example, drug testing in two groups(placebo/real drug)
# ->two independent groups -> two-sample tests

# * In general for two-sample tests/CI ####
#
# - the test is always tied to the appropriate CI -> same conditions of use
#
# - if the test has conditions of use(eg: normality of data, symmetry of data) then this
# condition must be met **for both data columns**, if at least one does not meet, we
# consider the assumption to be broken
#
# - one of the very important assumptions is data independence
#
# - eg: measurement of products of manufacturer A and products of manufacturer B - here
# it is reasonable to assume that the products of manufacturer A are separate entities
# from the products of manufacturer B

# * Two-sample tests/IO - difference of position measures ####
#

# we create test data
data1 = rnorm(n = 30, mean = 105, sd = 10)
data2 = rnorm(n = 30, mean = 100, sd = 10)
boxplot(data1,data2)

# ** Two-sample Student's t-test ####
#
# - Tests/estimates difference of means: $H_0: \mu_{1} - \mu_{2} = a$
# - requirements:
#     - Data normality
#     - Homoskedasticity(scatter matching)
#     - independence of selections
# - the function must have the parameter var.equal=TRUE

# H0: mu1 - mu2=2
# HA: mu1 - mu2!=2

t.test(x = data1, y = data2, mu = 2, alternative = "two.sided",
       var.equal = TRUE, conf.level = 0.95)

# H0: mu1 - mu2=2
# HA: mu1 - mu2>2

t.test(x = data1, y = data2, mu = 2, alternative = "greater",
       var.equal = TRUE, conf.level = 0.95)

# H0: mu1 - mu2=2
# HA: mu1 - mu2<2

t.test(x = data1, y = data2, mu = 2, alternative = "less",
       var.equal = TRUE, conf.level = 0.95)

# ** Aspin-Welsh test ####
#
# - Tests/estimates the difference of means: $H_0: \mu_{1} - \mu_{2} = a$
# - requirements:
#     - Data normality
#     - independence of selections
# - the function must have the parameter var.equal=FALSE

# H0: mu1 - mu2=2
# HA: mu1 - mu2!=2

t.test(x = data1, y = data2, mu = 2, alternative = "two.sided",
       var.equal = FALSE, conf.level = 0.95)

# H0: mu1 - mu2=2
# HA: mu1 - mu2>2

t.test(x = data1, y = data2, mu = 0, alternative = "greater",
       var.equal = FALSE, conf.level = 0.95)

# H0: mu1 - mu2=2
# HA: mu1 - mu2<2

t.test(x = data1, y = data2, mu = 0, alternative = "less",
       var.equal = FALSE, conf.level = 0.95)

# ** Mann-Whitney test ####
#
# - Tests/estimates difference of medians: $H_0: X_{0.5,1} - X_{0.5,2} = a$
# - requirements:
#     - independence of selections
#     - (same shape of the distribution)
# - requires conf.int=TRUE, to calculate CI

# H0: X0.5,1 - X0.5,2=2
# HA: X0.5,1 - X0.5,2!=2

wilcox.test(x = data1, y = data2, mu = 2, alternative = "two.sided",
            conf.level=0.95, conf.int = TRUE)

# H0: X0.5,1 - X0.5,2=2
# HA: X0.5,1 - X0.5,2>2

wilcox.test(x = data1, y = data2, mu = 2, alternative = "greater",
            conf.level=0.95, conf.int = TRUE)

# H0: X0.5,1 - X0.5,2=2
# HA: X0.5,1 - X0.5,2<2

wilcox.test(x = data1, y = data2, mu = 2, alternative = "less",
            conf.level=0.95, conf.int = TRUE)

# * Two-sample tests/CI - proportion of variances ####
#
# ** F-test ####
#
# - Tests/estimates the ratio of variances: $H_0: \sigma^2_{1} / \sigma^2_{2} = a$
# - requirements:
#     - data normality
#     - independence of selections

# H0: sigma1 ^ 2/sigma2 ^ 2=1
# H0: sigma1 ^ 2/sigma2 ^ 2!=1

var.test(x = data1, y = data2, ratio = 1, alternative = "two.sided",
         conf.level = 0.95)

# H0: sigma1 ^ 2/sigma2 ^ 2=1
# H0: sigma1 ^ 2/sigma2 ^ 2>1

var.test(x = data1, y = data2, ratio = 1, alternative = "greater",
         conf.level = 0.95)

# H0: sigma1 ^ 2/sigma2 ^ 2=1
# H0: sigma1 ^ 2/sigma2 ^ 2<1

var.test(x = data1, y = data2, ratio = 1, alternative = "less",
         conf.level = 0.95)

# ** Levene's test ####
#
# - Tests equality of variances: $H_0: \sigma^2_{1} = \sigma^2_{2}$!
# - requirements:
#     - independence of selections
# - requires data in standard data format
# - leveneTest function in the car package

# we produce data in a standard data format

data1.df = as.data.frame(data1)
data1.df$typ = "d1"
colnames(data1.df) = c("data", "typ")

data2.df = as.data.frame(data2)
data2.df$typ = "d2"
colnames(data2.df) = c("data", "typ")

data = rbind(data1.df, data2.df)
data$typ = as.factor(data$typ)

head(data)

# install.packages("car")

# H0: sigma1 ^ 2=sigma2 ^ 2
# HA: sigma1 ^ 2!=Sigma2 ^ 2

car::leveneTest(data$data ~ data$typ)

# * Two-sample tests/CI - difference of probabilities ####
#
# ** Test of parameter of two binomial distributions ####
#
# - Tests if the probability matches: $H_0: \pi_{1} - \pi_{2} = 0$
# - requirements:
#     - sufficient selection size: $n_i>\frac{9}{p_i(1-p_i)}$
#     - independence of selections

# we will produce suitable data
pi1 = 0.4
pi2 = 0.3

dp1 = runif(n = 100, min = 0, max = 1) < pi1
dp2 = runif(n = 130, min = 0, max = 1) < pi2

x1 = sum(dp1)
n1 = length(dp1)

x2 = sum(dp2)
n2 = length(dp2)

x1
n1
x2
n2

# H0: pi1 - pi2=0
# HA: pi1 - pi2!=0

prop.test(x = c(x1, x2), n = c(n1, n2), alternative="two.sided",
          conf.level=0.95)

# H0: pi1 - pi2=0
# HA: pi1 - pi2>0

prop.test(x = c(x1, x2), n = c(n1, n2), alternative="greater",
          conf.level=0.95)

# H0: pi1 - pi2=0
# HA: pi1 - pi2<0

prop.test(x = c(x1, x2), n = c(n1, n2), alternative="less",
          conf.level=0.95)

#  Examples ####

library(dplyr)
library(rstatix)

#
# * Example 1. ####
#
# Data in the cholesterol2.xls file indicate the blood cholesterol level of men of two
# different age groups(20-30 years and 40-50 years). Verify at the significance level
# 0.05 the hypothesis that the cholesterol level in the blood of older men does not
# differ from the cholesterol level in the blood of younger men.

# Load data
chol = readxl::read_excel("data/testy_dvouvyberove.xlsx",
                  sheet = "cholesterol2",
                  skip = 1)
colnames(chol)=c("young","old")
head(chol)

# Convert to standard data format
chol.s = stack(chol)
chol.s = na.omit(chol.s)
colnames(chol.s) = c ("values","group")
head(chol.s)

# Exploratory analysis
boxplot(chol.s$values ~ chol.s$group)

# Elimination of outliars:
chol.s$id = seq(1,length(chol.s$values))

outliars = chol.s %>% group_by(group) %>% identify_outliers(values)
outliars

chol.s$values_cleared = ifelse(chol.s$id %in% outliars$id, NA, chol.s$values)

boxplot(chol.s$values_cleared~chol.s$group)

# be careful in the data we have NA
# eg for length determination

chol.s %>%  group_by(group) %>%
            summarise(count = sum(!is.na(values_cleared)),
                      mean = mean(values_cleared, na.rm = TRUE),
                      std = sd(values_cleared, na.rm = TRUE))

# rounding ->3 valid digits ->according to sd to thousands

# **Difference of Mean/median test**

# Verification of normality
chol.s %>%  group_by(group) %>%
            summarise(norm.pval = shapiro.test(values_cleared)$p.value)

# normality at significance 0.05 OK

# Exactly by F-test

# H0: sigma.old=sigma.young
# Ha: sigma.old<>sigma.young

# I select the required data
young = chol.s$values_cleared[chol.s$group == "young"]
old = chol.s$values_cleared[chol.s$group == "old"]

var.test(x = young, y = old, ratio = 1, conf.level=0.95)

# at. significance 0.05 we reject the assumption of same variances
# The observed discrepancy between the variances is significant at the significance level of 0.05
# Mark as statistically significant.

# Verification of same mean values(Aspin-Welch test)

# H0: mu.old - mu.young=0
# Ha: mu.old - mu.young!=0

t.test(x = old, y = young, mu = 0,
       alternative = "two.sided", var.equal=FALSE, conf.level=0.95)

# in hl. significance 0.05 we reject H0->there is a stat. significant difference.

# H0: mu.old=mu.young
# Ha: mu.old>mu.young

t.test(x = old, y = young, mu = 0, alternative = "greater",
       var.equal = FALSE, conf.level = 0.95)

# * Example 2. ####
#
# The data in the depression.xls file represent the length of remission in days from a
# simple random selection of two different groups of patients(patients with endogenous
# depression and patients with neurotic depression). Verify that the observed difference
# in mean remission length in these two groups of patients is statistically significant.
#

# Read data from xlsx file(using readxl package)
deprese = readxl::read_excel("data/testy_dvouvyberove.xlsx",
                     sheet = "deprese")
colnames(deprese)=c("endo","neuro")

head(deprese)

# Conversion to standard data format
deprese.s = stack(deprese)
deprese.s = na.omit(deprese.s)
colnames(deprese.s) = c ("values","group")

head(deprese.s)

# Exploratory analysis
boxplot(deprese.s$values~deprese.s$group)

# Data does not contain outliers

library(dplyr)

deprese.s %>%  group_by(group) %>%
                summarise(count = length(values),
                          mean = mean(values),
                          std = sd(values))

# rounding ->3 valid digits ->according to sd

# **Diference of Mean/median test**
#

# Normality verification
# We assume the assumption of normality by the Shapir - Wilk test.
deprese.s %>%  group_by(group) %>%
                summarise(norm.pval = shapiro.test(values)$p.value)

# at significance 0.05, we reject the assumption of normality

# at least as a guide, we check the similarity of the distribution

# we choose data for easier processing

neuro = deprese.s$values[deprese.s$group == "neuro"]
endo = deprese.s$values[deprese.s$group == "endo"]

par(mfrow = c(1,2))
hist(neuro)
hist(endo)

# Difference of median (Mann-Whitney test)

# According to the histograms, we assume that the data have the same type of distribution.

# H0: med.neuro=med.endo(med.neuro - med.endo=0)
# Ha: med.neuro!=Med.endo(med.neuro - med.endo!=0)

wilcox.test(x = neuro, y = endo, mu = 0, alternative = "two.sided",
            conf.level=0.95, conf.int = TRUE)

# at significance 0.05 we reject H0->there is a stat. significant difference

# H0: med.neuro=med.endo(med.neuro - med.endo=0)
# Ha: med.neuro>med.endo(med.neuro - med.endo>0)

wilcox.test(x = neuro, y = endo, mu = 0, alternative = "greater",
            conf.level=0.95, conf.int = TRUE)

# * Example 3. ####
#
# We monitor urine osmolality at the patient station at 08:00 and 11:00 for 16 men.
# Based on the results in the osmolality.xls file, verify that the osmolality has
# increased statistically significantly.
#

# Load data
osmolalita = readxl::read_excel("data/testy_dvouvyberove.xlsx",
                        sheet = "osmolalita", skip = 1)
osmolalita = osmolalita[,c(2,3)]
colnames(osmolalita)=c("o8","o11")
head(osmolalita)

# Calculation of osmolality increase
osmolalita$increase = osmolalita$o11 -  osmolalita$o8

# Exploratory analysis
par(mfrow = c(1,1))
boxplot(osmolalita$increase)

# Data contains outliars

# Elimination of outliars:
osmolalita$id = seq(1,length(osmolalita$increase))

outliars = osmolalita %>% identify_outliers(increase)
outliars
osmolalita$increase_cleared = ifelse(osmolalita$id %in% outliars$id, NA, osmolalita$increase)

boxplot(osmolalita$increase_cleared)

# Exploratory analysis for data without outliars
library(dplyr)

osmolalita %>% summarise(count = sum(!is.na(increase_cleared)),
                         mean = mean(increase_cleared, na.rm = TRUE),
                         std = sd(increase_cleared, na.rm = TRUE))

# rounding ->2 valid digits ->according to sd per unit

# Verification of normality
# The presumption of normality is verified by the Shapir - Wilk test.
shapiro.test(osmolalita$increase_cleared)

# Paired t-test
# H0: mu.increase=0 mm
# Ha: mu.increase>0 mm

t.test(osmolalita$increase_cleared, mu = 0, alternative = "greater")

# * Example 4. ####
#
# Semiconductor components of two manufacturers - MM and PP - were tested. MM claims
# that its products have a lower percentage of defective pieces. To verify this claim,
# 200 components were randomly selected from MM production, of which 14 were defective.
# A similar experiment was performed at PP with the result of 10 defective out of 100
# randomly selected components.
#
# ** a) ####
#
# Test MM's claim with a clean significance test.
#

x.MM = 14
n.MM = 200
p.MM = x.MM/n.MM
p.MM

x.PP = 10
n.PP = 100
p.PP = x.PP/n.PP
p.PP

# Verification of assumptions
9/(p.MM*(1-p.MM))
9/(p.PP*(1-p.PP))

# Pearson's X2 test
# H0: pi.PP=pi.MM
# Ha: pi.PP>pi.MM

prop.test(x = c(x.PP,x.MM),n = c(n.PP,n.MM), alternative = "greater",
          conf.level = 0.95)

# at significance 0.05 we do not reject H0 - ie assumption.
# identical error rates. Therefore, it cannot be said that MM has better production.

# Pearson's X2 test
# H0: pi.PP=pi.MM
# Ha: pi.PP!=Pi.MM

prop.test(x = c(x.PP,x.MM),n = c(n.PP,n.MM), alternative = "two.sided",
          conf.level = 0.95)

# ** b) ####
#
# Test MM's statement using an interval estimate of a significance level of 0.05.
#

# Based on 95% Clopper - Pearson right - hand interval estimation
# -0.036; 1,000) the observed difference in production quality can be described as
# not statistically significant. We can reach the same conclusions on the basis of
# Pearson's right-hand test
prop.test(x = c(x.PP,x.MM),n = c(n.PP,n.MM), alternative = "two.sided",
          conf.level = 0.95)


# Transform model output to the Akaike Information Criterion (AIC) and the
# Bayesian Information Criterion (BIC), as well as their respective transformations
# to Akaike weights and approximat posterior model probabilities.

# For details on Akaike Weights, see Wagenmakers, E.-J., & Farrell, S. (2004).
# Model selection using Akaike weights. Psychonomic Bulletin & Review, 11, 192-196.
# For details on the BIC-based approximation to posterior model probabilities,
# see Wasserman, L. (2000). Bayesian model selection and averaging.
# Journal of Mathematical Psychology, 44, 92-107.

source("chartr-HelperFunctions.r")
# Function to calculate model weights
#
#
pmp=function(IC) {
  # IC is the information criteria (AIC or BIC) for a set of models under comparison
  x=(IC-min(IC))
  # PMP is the posterior model probability
  pmp=exp(-.5*x)/sum(exp(-.5*x))
  pmp
}

calcIC = function(ll, npars, N)
{

  # Calculate the information criteria for the models
  # AIC just penalizes number of parameters
  AIC = 2*npars - 2*ll;

  # BIC also penalizes by number of parameters,but also includes
  # a penalty of the number of trials used for computing the penalty
  BIC = log(N)*npars - 2*ll;

  data.frame(AIC=AIC, BIC=BIC, LL=-2*ll, PenA = 2*npars,PenB=log(N)*npars);
}

# Calculate AIC/BIC and their conversion to model weights
#
#
modelSelection=function(models,data) {
  # models is a list where each element holds the output from a model fit
  # data is a single subjects data informations
  npars=sapply(models,function(x) length(x$pars))
  ll=sapply(models,function(x) x$reobj)
  N=sum(dat$n)
  AIC=2*npars - 2*ll
  logL = -2*ll
  BIC=log(N)*npars - 2*ll
  AICw=pmp(AIC)
  BICw=pmp(BIC)
  logLw=pmp(logL);
  data.frame(AIC,BIC,AICw,BICw, N, logL,logLw, npars)
}

# This formats columns of data frames with different columns having different numbers of digits if needed.
#
#
#
formatColumns = function(data, digits)
{
    "%,%" <- function(x,y)paste(x,y,sep="")
    nms <- names(data)
    nc <- ncol(data)
    nd <- length(digits)
    if(nc!=nd)
      stop("Argument 'digits' must be vector of length " %,%
             nc %,% ", the number of columns in 'data'.")
    out <- as.data.frame(sapply(1:nc,
                                FUN=function(x, d, Y)
                                  format(Y[,x], digits=d[x]), Y=tbl, d=digits))
    if(!is.null(nms)) names(out) <- nms
    out
}


### Code skeleton for Series 7, task 2

## Read in dataset, set seed, load package
Iris <- iris[,c("Petal.Length", "Petal.Width", "Species")]
grIris <- as.integer(Iris[, "Species"])
set.seed(16)
library(MASS)

## Read n
n <- nrow(Iris)

## Utility functiom for plotting boundaries
predplot <- function(object, x, gr = grIris, main = "", lines.only = FALSE,
                     len = 42, colcont = "black", ...)
{
  ##  gr : the true grouping/class vector
  stopifnot(length(gr) == nrow(x))
  xp <- seq(min(x[, 1]), max(x[, 1]), length = len)
  yp <- seq(min(x[, 2]), max(x[, 2]), length = len)
  grid <- expand.grid(xp, yp)
  colnames(grid) <- colnames(x)[-3]
  Z <- predict(object, grid, ...)
  zp <- as.numeric(Z$class)
  zp <- Z$post[, 3] - pmax(Z$post[, 2], Z$post[, 1])
  if(!lines.only)
    plot(x[,1], x[,2], col = gr, pch = gr,
         main = main, xlab = colnames(x)[1], ylab = colnames(x)[2])
  contour(xp, yp, matrix(zp, len),
          add = TRUE, levels = 0, drawlabels = FALSE, col = colcont)
  zp <- Z$post[, 1] - pmax(Z$post[, 2], Z$post[, 3])
  contour(xp, yp, matrix(zp, len),
          add = TRUE, levels = 0, drawlabels = FALSE, col = colcont)
}
## Bootstrap size
B <- 1000

###################################################
### TASK a)
###################################################

## Use function lda to fit data
class_lda <- lda(x = Iris[, -3], grouping = grIris)

## Use function predplot to plot the boundaries
predplot(class_lda, Iris, main = "Classification with LDA")

## Use function qda to fit data
class_qda <- qda(x = Iris[, -3], grouping = grIris)

## Use function predplot to plot the boundaries
predplot(class_qda, Iris, main = "Classification with QDA")

###################################################
### TASKS b)
###################################################

## Create a random index matrix with either functions sample or sample.int to generate bootstrap
## Each column corresponds to the n indices of one bootstrap sample
index <- matrix(sample.int(n, size = n * B, replace = TRUE), nrow=n, ncol=B)

## Initialize the list for LDA and QDA fits
fit_lda <- vector("list", B)
fit_qda <- vector("list", B)

## Use both methods on the bootstrap samples
for(i in 1:B) {
  ind <- index[, i]
  fit_lda[[i]] <- lda(x = Iris[ind, -3], grouping = grIris[ind])
  fit_qda[[i]] <- qda(x = Iris[ind, -3], grouping = grIris[ind])
}

## Initialize the mu_hat bootstrap estimates
mu_hat_1 <- mu_hat_2 <- mu_hat_3 <- matrix(0, ncol = B, nrow = 2)

## Determine the mu_hat bootstrap estimates

for(i in 1:B){
  ## Hint: look at fit_lda[[1]] and see how to extract the means
  mu_hat_all <- fit_lda[[i]]$means
  mu_hat_1[, i] <- mu_hat_all[1,]
  mu_hat_2[, i] <- mu_hat_all[2,]
  mu_hat_3[, i] <- mu_hat_all[3,]
}

## Plot the bootstrapped estimators
## define a suitable plotting range
xmin <- min(mu_hat_1[1,], mu_hat_2[1,], mu_hat_3[1,])
xmax <- max(mu_hat_1[1,], mu_hat_2[1,], mu_hat_3[1,])
ymin <- min(mu_hat_1[2,], mu_hat_2[2,], mu_hat_3[2,])
ymax <- max(mu_hat_1[2,], mu_hat_2[2,], mu_hat_3[2,])
## plot the estimated mean of each group
plot(mu_hat_1[1,], mu_hat_1[2,], xlim = c(xmin, xmax), ylim = c(ymin, ymax),
     xlab = colnames(Iris)[1], ylab = colnames(Iris)[2], pch = 4,
     main = "Bootstrap samples")
points(mu_hat_2[1,], mu_hat_2[2,], col = 2, pch = 4)
points(mu_hat_3[1,], mu_hat_3[2,], col = 3, pch = 4)

###################################################
### TASK c)
###################################################

## Plot the bootstrapped boundaries estimates with LDA
predplot(class_lda, Iris,
         main = "Bootstrapped boundaries estimates with LDA")
for(i in 1:B){
  fit <- fit_lda[[i]]
  predplot(fit, Iris, lines.only = TRUE, colcont = adjustcolor("gray", 0.25))
}

## Plot the bootstrapped boundaries estimates with QDA
predplot(class_qda, Iris,
         main= "Bootstrapped boundaries estimates with QDA")
for(i in 1:B){
  fit <- fit_qda[[i]]
  predplot(fit, Iris, lines.only = TRUE, colcont = adjustcolor("gray", 0.25))
}

###################################################
### TASK d)
###################################################

## write your own LOOCV code

cnt_lda = 0
cnt_qda = 0
for (i in 1:n){
  fit_lda_loocv <- lda(x = Iris[-i, -3], grouping = grIris[-i])
  cnt_lda = cnt_lda + as.integer(predict(fit_lda_loocv, Iris[i, -3])$class != grIris[i])
  fit_qda_loocv <- qda(x = Iris[-i, -3], grouping = grIris[-i])
  cnt_qda = cnt_qda + as.integer(predict(fit_qda_loocv, Iris[i, -3])$class != grIris[i])
}
print(cnt_lda)
print(cnt_qda)


primes <- c(2, 3, 5, 7, 11, 13)
isPrime <- function(a) {
  i <- 1
  while (a %% primes[i] > 0) {
    if (primes[i] * primes[i] > a) {
      primes <<- append(primes, a)
      return(TRUE)
    }
    i <- i + 1
  }
  FALSE
}

primeSeq <- function() {
  p0 <- 1
  i <- 0
  return(function() {
    if (p0 <= length(primes)) {
      i <<- primes[p0]
      p0 <<- p0 + 1
      return(i)
    }
    i <<- i + 2
    while (!isPrime(i)) {
      i <<- i + 2
    }
    p0 <<- p0 + 1
    return(i)
  })
}

primesum <- 0
nextPrime <- primeSeq()
for (i in 1:1000) {
  primesum = primesum + nextPrime()
}
cat(primesum, sep="\n")


#' Computes the dot product of two iterable objects
#'
#' Returns the dot product of two numeric iterables of equal length
#'
#' @importFrom iterators iter
#' @export
#' @param vec1 the first
#' @param vec2 the second iterable object
#' @return the dot product of the iterators
#'
#' @examples
#' it <- iterators::iter(1:3)
#' it2 <- iterators::iter(4:6)
#' dotproduct(it, it2) # 32
#'
#' it <- iterators::iter(1:4)
#' it2 <- iterators::iter(7:10)
#' dotproduct(1:4, 7:10) # 90
#'
dotproduct <- function(vec1, vec2) {
  vec1 <- iterators::iter(vec1)
  vec2 <- iterators::iter(vec2)
  it <- imap(prod, vec1, vec2)
  sum(sapply(it, identity))
}


# Goal: Simulate a dataset from the OLS model and obtain
#       obtain OLS estimates for it.

x <- runif(100, 0, 10)                  # 100 draws from U(0,10)
y <- 2 + 3*x + rnorm(100)               # beta = [2, 3] and sigma = 1

# You want to just look at OLS results?
summary(lm(y ~ x))

# Suppose x and y were packed together in a data frame --
D <- data.frame(x,y)
summary(lm(y ~ x, D))

# Full and elaborate steps --
d <- lm(y ~ x)
# Learn about this object by saying ?lm and str(d)
# Compact model results --
print(d)
# Pretty graphics for regression diagnostics --
par(mfrow=c(2,2))
plot(d)

d <- summary(d)
# Detailed model results --
print(d)
# Learn about this object by saying ?summary.lm and by saying str(d)
cat("OLS gave slope of ", d$coefficients[2,1],
    "and a error sigma of ", d$sigma, "\n")

## I need to drop down to a smaller dataset now --
x <- runif(10)
y <- 2 + 3*x + rnorm(10)
m <- lm(y ~ x)

# Now R supplies a wide range of generic functions which extract
# useful things out of the result of estimation of many kinds of models.

residuals(m)
fitted(m)
AIC(m)
AIC(m, k=log(10))                        # SBC
vcov(m)
logLik(m)

RFrontEndSolution/Tests Repo/Rscripts All (163 files)/o1.r


=begin
  # sample-m-polynomial01.rb

  require "algebra"
  P = MPolynomial(Integer)
  x, y, z, w = P.vars("xyz")
  p((-x + y + z)*(x + y - z)*(x - y + z))
  #=> -x^3 + x^2y + x^2z + xy^2 - 2xyz + xz^2 - y^3 + y^2z + yz^2 - z^3
((<_|CONTENTS>))
=end


## 2. Programming in R ##

125-3

## 3. R Syntax Rules ##

224+667
35/7
(22*5)+3

## 4. Exploring Data With R ##

(92 + 87 + 85) / 3 # math
(90 + 81 + 92) / 3 # chemistry
(84 + 95 + 79) / 3 # writing
(95 + 86 + 93) / 3 # art
(77 + 85 + 90) / 3 # history
(92 + 90 + 91) / 3 # music
(85 + 88 + 95) / 3 # physical education

## 5. Assigning Values to Variables ##

math <- 88
chemistry <- 87.66667
writing <- 86
art <- 91.33333
history <- 84
music <- 91
physical_education <- 89.33333

## 6. Programming With Variables ##

math <- 88
chemistry <- 87.66667
writing <-  86
art <- 91.33333
history <- 84
music <- 91
physical_education <- 89.33333
gpa<-(math+chemistry+writing+art+history+music+physical_education)/7

## 7. Vectors: Storage for Multiple Values ##

math <- 88
chemistry <- 87.66667
writing <- 86
art <- 91.33333
history <- 84
music <- 91
physical_education <- 89.33333
final_scores<-c(math,chemistry,writing,art,history,music,physical_education)

## 8. Efficient Programming with Functions and Vectors ##

final_scores <- c(math, chemistry, writing, art, history, music, physical_education)
gpa<-mean(final_scores)

## 9. Practice with Functions and Vectors ##

final_scores <- c(math, chemistry, writing, art, history, music, physical_education)
max(final_scores)
min(final_scores)
length(final_scores)


#' ---
#' title: "Uvod u R"
#' author:
#'    - "Milutin Pejovic, Petar Bursac"
#' date: "`r format(Sys.time(), '%d %B %Y')`"
#' output:
#'    html_document:
#'      keep_md: true
#'      theme: "simplex"
#'      highlight: tango
#'      toc: true
#'      toc_depth: 5
#'      toc_float: true
#'      fig_caption: yes
#' ---
#'
#' # Programsko okruzenje
#+ echo = FALSE, warning = FALSE, message = FALSE, fig.width = 10, fig.height = 8, fig.align='center'
knitr::include_graphics("Figures/01-RConsole.jpg")
knitr::include_graphics("Figures/02-RStudio.jpg")
#'
#'
#'
#'
#' # Osnovne matematicke operacije #
#'
#' R je moguce koristiti kao bilo koji kalculator koristeci osnovne komande:
#' Sabiranje
2+2
1+2+3+4+5
#'
#' Oduzimanje
10-1
5-6
#'
#' Mnozenje
2*2
1*2*3
#'
#' Deljenje
4/2
10/2/4
#'
#' Koriscenje zagrada:
10/2+2
10/(2+2)
(10/2)+2
#'
#'
#' Stepenovanje i korenovanje
2^2
3^4
1^0
sqrt(4)
#'
#'
#' >
Zadatak 1

#' > + Pronadji operator koji za rezultat operacije deljenja daje celobrojni deo rezultat (npr 111 `operator` 100 = 1).
#' > + Pronadji operator koji za rezultat operacije deljenja daje decimalni deo (npr 111 `operator` 100 = 0.11).
#'
#'
#'
#'
#' # Pozivanje funkcija u R-u
#'
#' Logaritmi:
log(0)
log(1)
#'
#' kao i logaritmi sa proizvoljnom osnovom (bazom):
log10(1)
log10(10)
log2(1)
log2(2)
logb(1,5) # Dva argumenta
logb(5,base=5) # Dva argumenta od kojih je jedan imenovan
#'
#' Prirodni eksponent:
exp(0)
exp(1)
#'
#' Kao i mnoge druge matematicke operacije:
#' Apsolutna vrednost
abs(-10)
#'
#' Faktorial:
factorial(10)
#'
#'
#' # Dodavanje komentara
#'
#' Dodavanje komentara je veoma vazan deo dokumentovanja koda.
#'
#'
#'
#' Svaki deo teksta koji je pracen sa (`#`) postaje komentar i `ne` izvrsava se od strane R-a.
2+2 # This is a comment. The code before the `#` is still evaluated by R.
#'
#' Neki programski jezici omogucavaju tzv. multi-line komentare. R ne podrzava tu opciju. U R-u svaki komentar je zaseban
#' R-studio podrzava `proglasavanje` vise linija koda komentarom pozivom jedne komande `ctrl+shift+c`.
#'
#'
#'
#'
#' # Promenljive ili objekti
#'
#'
#' R omogucuje da se svakoj vrednosti doda ime, kako bi se ona pozivanjem tog imena kasnije mogla upotrebiti. Dodeljivanjem imena nekoj vrednosti (moguce je dodati ime i nekoj funkciji ili skupu nekih vrednosti) na taj nacin kreiramo `promenljive`.
#' Na primer, umesto da odmah vidimo rezultat operacije `2+2`, mi mozemo sklaistiti taj rezultat pod nekim imenom i kasnije ga pogledati:
a <- 2+2
#' Ukoliko hocemo da vidimo rezultat koji se `krije` iza tog imena, mi cemo samo ukucati to ime i pristisnuti `enter`:
a
#' Kao sto ste mogli da vidite, operator za dodeljivanje imenta je `<-` i rezultatu operacije na desnoj strani dodeli ime koje je na levoj strani operatora.
#' Isti rezultat se dobija i sa znakom `=` (ali se zbog litljivosti koda i sireg koriscenja znaka jednakost on izbegava):
a = 2+2
a
#' Moguce je koristiti operator i u `suprotnom` smeru, ali to nije uobicajeno:
2+2 -> a
a
#'

#' Iz svega navedenog proizilazi da tako rezultat operacije koji je sacuvan pod nekim imenom mozemo pozivati u okviru drugih operacija:
#' Tako na primer, ako zelimo da rezultau prethodne operacije dodamo broj 4, pisacemo komandu:
#'
a + 4

#' Moguce je da isto ime iskoristimo i za skladistenje druge vrednosti. U tom slucaju gubimo prethodno sacuvan rezultat pod tim imenom.
a <- 2+2
a <- 3
a

#' Mozemo napraviti `kopiju` promenljive ali pod drugim imenom:
b <- a
b

#' Ako zelimo da uklonimo promeljivu `a`, pozvacemo komandu `rm` (skracemo od `remove`):
rm(a)

#' Ako zelimo da vidimo kakve smo sve promenljive napravili. Pozvacemo komandu `ls`.
ls()
#' Ova funkcija ce vam izlistati sve promenljive koje ste kreirali tokom R sesije. Jedno pokretanje R-a je jedna sesija. Sto vise promenljvih to je teze da znate sa cim baratate u tokom sesije. Memorija racuara se takode opterecuje vise sa vecim brojem promenljivih.

#' Ukoliko zeimo da uklonimo sve promenljive to mozemo uraditi pozivom komande `rm(list = ls())`

#' Takode, mozemo pozvati komandu:
b <- NULL
#' Ova komanda `ne brise` probmenljivu `b`, vec je samo ostavlja `praznom`.
#' Treba imati na umu da je `NULL` razlicito `NA`!
#' You can see this in the difference between the following two vectors:
#'
#' Postoji i drugi nacin dodeljivanja imena, odnosno kreiranja promenljivih, a to je pozivom komande `assign`:
assign("x",3)
x
#' To nije uobicajeno u pocetku, ali kasnije moze biti korisno.
#' ## Pravila nazivanja promenljivih ##
#'
#' U R-u postoje jednostavna pravila koja se moraju postovati prilikom nazivanja promenljivih:
#'
# +Imena promeljivih u R-u su `case sensitive`, sto znaci da `a` nije isto sto i `A`.
# +Imena promeljivih u R-u moraju pocinjati sa slovima.
# +Imena promeljivih u R-u mogu sadrzati slova, znake i brojeve, kao na primer (`.`) ili (`_`).
# +Pozeljno je izbegavati dugacka imena.
#'
#'
#'
#' # Help
#'
#' R omogucava brz i jednostavan poziv `help`-a za svaku funkciju. Help je veoma jednostavan i pregledan. Help se moze pozvati na jedan od sledecih nacina:
#+ eval = FALSE
help(lm)
#' ili
#+ eval = FALSE
?lm
#' Za odredeni operator mora se moraju se koristiti navodnici:
#+ eval = FALSE
?`+`
#'
#' # Uvod u strukture podataka u R-u
#'
#' R vam omogucava da kreirate promenljve od komlikovanijih struktura podataka, ne samo od jedne vrednosti. Na primer, vi mozete kreirati promenljviu koja sadrzi vektor, niz (array), matricu ili listu. Od vrste strukture podataka zavisi kako ce ona biti prikazana i koje operacije su nad njom moguce.
#'
#' ### Vektori, nizovi i matrice
#' Vektor i niz se skladiste na isti nacin, samo se uz niz vezuje i broj dimenzija, pa tako se on moze posmatrati kao visedimenzionalni vektor. Na primer, komandom `c` se kreira vektor, a komandom `array` se kreira niz.

v <- c(1,2,3,4,5,6,7,8,9,10,11,12)
v
a <- array(v, dim=c(3,4))
a
#'
#' >
Zadatak 2

#' > + Pronadjite funkciju koja kreira `2x6` matricu od vrednosti koje se nalaze u promenljvoj `v.
#' > + Kreirati vektor koji ce sadrzati imena studenata u ucionici.
#'
#' **Za vektore nizove i matrice je zajednicko da oni mogu skladistiti samo jednu vrstu podataka (najcesce numericke).**
#'
#'
#' ### Liste
#'
#' Lista je struktura podataka koja moze skladistiti razlicite vrste podataka
#'
e <- list(student="Milutin Pejovic", `broj indeksa` = 1018, `godina upisa` = 2012)
#'
#' >
Zadatak 3

#' > + Kreirati listu u kojoj ce prvi element sadrzati sva imena studenata, drugi element sve brojeve indeksa i treci element sve godine upisa.
#'
#' ### Data-frames
#'
#' `Dataframe` je tabelarna struktura podataka u kojoj svaka kolona moze da sadrzi razliciti tip podataka. Ona u stvari predstavlja listu gde je svaki element liste u stvari vektor sa istom duzimom. `dataframe` je najslicniji `excel` tabeli.

studenti <- data.frame(ime = c("Milutin", "Petar"), Prezime = c("Pejovic", "Bursac"), `Broj indeksa` = c(1018, 1023), `Godina upisa` = c(2002, 2013))
studenti
#'
#'
#' # R paketi
#'
#' ### R paketi prosiruju mogucnosti osnovne instalacije R-a.
#'
#'
#' R paketi su softverske jedinice koje su kreirane za resavanje odredenih problema. Tako na primer imamo pakete koji su namenjeni ucitavanju razlicitih formata podataka ili paketi koji su namenjeni ispisivanju dobijenih rezultata u razlicite vrste fajlova.
#'
#'
#' Instalacija paketa se vrsi pozivom komande:
#'
#+ echo = TRUE, eval = FALSE
install.packages("ime paketa")
#'
#'Ucitavanje paketa se vrsi komandom `
#'
#+ eval = FALSE
library()
#' Opis paketa se moze pogledati pozivom funkcije
#+ eval = FALSE
packageDescription("name-of-package")
#'
#'
#' Postoji ogroman broj paketa koji se skladiste na centralnom repozorijumu R-a koji se zove [CRAN/packages](https://cran.r-project.org/web/packages/index.html).
#'
#'
#'


# Goals: ARMA modeling - estimation, diagnostics, forecasting.

# 0. SETUP DATA
rawdata <- c(-0.21,-2.28,-2.71,2.26,-1.11,1.71,2.63,-0.45,-0.11,4.79,5.07,-2.24,6.46,3.82,4.29,-1.47,2.69,7.95,4.46,7.28,3.43,-3.19,-3.14,-1.25,-0.50,2.25,2.77,6.72,9.17,3.73,6.72,6.04,10.62,9.89,8.23,5.37,-0.10,1.40,1.60,3.40,3.80,3.60,4.90,9.60,18.20,20.60,15.20,27.00,15.42,13.31,11.22,12.77,12.43,15.83,11.44,12.32,12.10,12.02,14.41,13.54,11.36,12.97,10.00,7.20,8.74,3.92,8.73,2.19,3.85,1.48,2.28,2.98,4.21,3.85,6.52,8.16,5.36,8.58,7.00,10.57,7.12,7.95,7.05,3.84,4.93,4.30,5.44,3.77,4.71,3.18,0.00,5.25,4.27,5.14,3.53,4.54,4.70,7.40,4.80,6.20,7.29,7.30,8.38,3.83,8.07,4.88,8.17,8.25,6.46,5.96,5.88,5.03,4.99,5.87,6.78,7.43,3.61,4.29,2.97,2.35,2.49,1.56,2.65,2.49,2.85,1.89,3.05,2.27,2.91,3.94,2.34,3.14,4.11,4.12,4.53,7.11,6.17,6.25,7.03,4.13,6.15,6.73,6.99,5.86,4.19,6.38,6.68,6.58,5.75,7.51,6.22,8.22,7.45,8.00,8.29,8.05,8.91,6.83,7.33,8.52,8.62,9.80,10.63,7.70,8.91,7.50,5.88,9.82,8.44,10.92,11.67)

# Make a R timeseries out of the rawdata: specify frequency & startdate
gIIP <- ts(rawdata, frequency=12, start=c(1991,4))
print(gIIP)
plot.ts(gIIP, type="l", col="blue", ylab="IIP Growth (%)", lwd=2,
        main="Full data")
grid()

# Based on this, I decide that 4/1995 is the start of the sensible period.
gIIP <- window(gIIP, start=c(1995,4))
print(gIIP)
plot.ts(gIIP, type="l", col="blue", ylab="IIP Growth (%)", lwd=2,
        main="Estimation subset")
grid()

# Descriptive statistics about gIIP
mean(gIIP); sd(gIIP); summary(gIIP);
plot(density(gIIP), col="blue", main="(Unconditional) Density of IIP growth")
acf(gIIP)

# 1. ARMA ESTIMATION
m.ar2 <- arima(gIIP, order = c(2,0,0))
print(m.ar2)                       # Print it out

# 2. ARMA DIAGNOSTICS
tsdiag(m.ar2)                      # His pretty picture of diagnostics
## Time series structure in errors
print(Box.test(m.ar2$residuals, lag=12, type="Ljung-Box"));
## Sniff for ARCH
print(Box.test(m.ar2$residuals^2, lag=12, type="Ljung-Box"));
## Eyeball distribution of residuals
plot(density(m.ar2$residuals), col="blue", xlim=c(-8,8),
     main=paste("Residuals of AR(2)"))

# 3. FORECASTING
## Make a picture of the residuals
plot.ts(m.ar2$residual, ylab="Innovations", col="blue", lwd=2)
s <- sqrt(m.ar2$sigma2)
abline(h=c(-s,s), lwd=2, col="lightGray")

p <- predict(m.ar2, n.ahead = 12)         # Make 12 predictions.
print(p)

## Watch the forecastability decay away from fat values to 0.
## sd(x) is the naive sigma. p$se is the prediction se.
gain <- 100*(1-p$se/sd(gIIP))
plot.ts(gain, main="Gain in forecast s.d.", ylab="Per cent",
        col="blue", lwd=2)

## Make a pretty picture that puts it all together
ts.plot(gIIP, p$pred, p$pred-1.96*p$se, p$pred+1.96*p$se,
        gpars=list(lty=c(1,1,2,2), lwd=c(2,2,1,1),
          ylab="IIP growth (%)", col=c("blue","red", "red", "red")))
grid()
abline(h=mean(gIIP), lty=2, lwd=2, col="lightGray")
legend(x="bottomleft", cex=0.8, bty="n",
       lty=c(1,1,2,2), lwd=c(2,1,1,2),
       col=c("blue", "red", "red", "lightGray"),
       legend=c("IIP", "AR(2) forecasts", "95% C.I.", "Mean IIP growth"))

RFrontEndSolution/Tests Repo/Rscripts All (163 files)/t1.r


#
# University: Universidad de Valladolid
# Degree: Grado en Estadística
# Subject: Análisis de Datos
# Year: 2017/18
# Teacher: Miguel Alejandro Fernández Temprano
# Author: Sergio García Prado (garciparedes.me)
# Name: Correspondence Analysis - Sport
#
#

rm(list = ls())

library(ggplot2)
suppressMessages(library(gdata))

DATA <- read.xls('./../../datasets/sport.xls')

N <- as.matrix.data.frame(DATA[,2:6])
rownames(N) <- DATA[,1]
N <- t(N)

F <- N / sum(N)
F

Dc <- diag( colSums(N) / sum(N))
Dc

Dr <- diag( rowSums(N) / sum(N))
Dr

Pc <- solve(Dc) %*% t(F)
Pc

Pr <- solve(Dr) %*% F
Pr

X <- t(F) %*% solve(Dr) %*% F %*% solve(Dc)

X_eigen <- eigen(X)
X_lambda <- X_eigen$values
X_u_1 <- X_eigen$vectors

X_u_norm <- diag(t(X_u_1) %*% solve(Dc) %*% X_u_1)

X_u <- t(t(X_u_1) / sqrt(X_u_norm))

fact <-solve(Dc) %*% X_u

Proyec_r <- Pr %*% fact
Proyec_c <- t(sqrt(X_lambda) * t(fact))

Proyec_r_df <- as.data.frame(Proyec_r)
rownames(Proyec_r_df) <- rownames(N)

Proyec_c_df <- as.data.frame(Proyec_c)
rownames(Proyec_c_df) <- colnames(N)

Proyec_df <- rbind(Proyec_r_df, Proyec_c_df)

ggplot(data=Proyec_df, aes(x=V2, y=V3)) +
  geom_point() +
  geom_text(label=rownames(Proyec_df))


########################################################################
########################################################################
# Logistic regression example
########################################################################
########################################################################

# install.packages("aod")
# install.packages("ggplot2")
# install.packages("vctrs")
# install.packages("VGAM")
# install.packages("quantreg")

library(knitr)
library(vctrs)
library(aod)
library(ggplot2)

# Graduate school admissions data from UCLA
mydata <- read.csv("https://stats.idre.ucla.edu/stat/data/binary.csv")
# Saved at: \Consulting\Public Code Samples\DataScience\Data
# Alternate URL:  https://1drv.ms/u/s!AgXALnk1NWLck4JA_01l6gpD6pZxpQ

## view the first few rows of the data
head(mydata)
# The admit variable is a binary response variable
# We will use gre, gpa, and rank as predictor variables.
# gre and gpa are continuous; while rank is a four-level factor

# Here are some examinations of the data:
summary(mydata)
sapply(mydata, sd)
xtabs(~admit + rank, data = mydata)

# Factor the rank variable and create a logistic regretion using glm() - Generalized Linear Model
mydata$rank <- factor(mydata$rank)
mylogit <- glm(admit ~ gre + gpa + rank, data = mydata, family = "binomial")

# See regression results using summary
summary(mylogit)

# We can create confidence levels by log likelihood
confint(mylogit)
# or based on the standard errors:
confint.default(mylogit)

# The wald test will give us the overall effect of the rank variable on admit:
wald.test(b = coef(mylogit), Sigma = vcov(mylogit), Terms = 4:6)

# The chi-squared test statistic of 20.9 indicates that rank *is* statistically significant in predicting admit

# Let's focus on Rank by taking the mean of the other variables, breaking up by each factor level
newdata1 <- with(mydata, data.frame(gre = mean(gre), gpa = mean(gpa), rank = factor(1:4)))

## view data frame
newdata1

# Let's use predict() to see if we can model the rank variable
newdata1$rankP <- predict(mylogit, newdata = newdata1, type = "response")
newdata1

# In the above output we see that the predicted probability of being accepted into a
# graduate program is 0.52 for students from the highest prestige undergraduate
# institutions (rank=1), and 0.18 for students from the lowest ranked institutions
# (rank=4), holding gre and gpa at their means. We can do something very similar to
# create a table of predicted probabilities varying the value of gre and rank.

# This is a technique for isolating the predictive effect of a single explanatory variable on the response

# We are going to plot these, so we will create 100 values of gre between 200 and 800,
# at each value of rank (i.e., 1, 2, 3, and 4).

newdata2 <- with(mydata, data.frame(gre = rep(seq(from = 200, to = 800, length.out = 100),
                                              4), gpa = mean(gpa), rank = factor(rep(1:4, each = 100))))

# The code to generate the predicted probabilities (the first line below) is
# the same as before, except we are also going to ask for standard errors so we
# can plot a confidence interval.

# We get the estimates on the link scale and back transform both the predicted values
# and confidence limits into probabilities.

newdata3 <- cbind(newdata2, predict(mylogit, newdata = newdata2, type = "link",
                                    se = TRUE))
newdata3 <- within(newdata3, {
  PredictedProb <- plogis(fit)
  LL <- plogis(fit - (1.96 * se.fit))
  UL <- plogis(fit + (1.96 * se.fit))
})

## view first few rows of final dataset
head(newdata3)

# Below we make a plot with the predicted probabilities, and 95% confidence intervals.
ggplot(newdata3, aes(x = gre, y = PredictedProb)) +
                  geom_ribbon(aes(ymin = LL, ymax = UL, fill = rank), alpha = 0.2) +
                  geom_line(aes(colour = rank),size = 1)

# Some methods to test fit below
with(mylogit, null.deviance - deviance)
with(mylogit, df.null - df.residual)
with(mylogit, pchisq(null.deviance - deviance, df.null - df.residual, lower.tail = FALSE))

# The chi-square of 41.46 with 5 degrees of freedom and an associated p-value of
# less than 0.001 tells us that our model as a whole fits significantly better
# than an empty model.

#To see the model's log likelihood
logLik(mylogit)

########################################################################
########################################################################
# Multinomial regression example
########################################################################
########################################################################

require(foreign)
require(nnet)
require(ggplot2)
require(reshape2)

# A data set showing occupational outcomes for vocational or academic educational paths
ml <- read.dta("https://stats.idre.ucla.edu/stat/data/hsbdemo.dta")
# Saved at: \Consulting\Public Code Samples\DataScience\Data\UCLAHighSchoolVocationalSurvey.dta
# Alternate URL:  https://1drv.ms/u/s!AgXALnk1NWLck4JDxYy1aZKct65nOw?e=7JBQzi

# Have a look at the data:
with(ml, table(ses, prog))
with(ml, do.call(rbind, tapply(write, prog, function(x) c(M = mean(x), SD = sd(x)))))

# Let's use relevel to create a new variable weighing the "academic" prog variable response
ml$prog2 <- relevel(ml$prog, ref = "academic")
test <- multinom(prog2 ~ ses + write, data = ml) # multinom() does not require reshaping like mlogit() does
summary(test)
# Test is a multinom() output of our model using the releveled program

# We run a couple of tests on the model:
z <- summary(test)$coefficients/summary(test)$standard.errors
z
# 2-tailed z test
p <- (1 - pnorm(abs(z), 0, 1)) * 2
p

## extract the coefficients from the model and exponentiate
exp(coef(test))

# Use predicted probabilities to help understand the model. Calculate predicted probabilities for each of
# the outcome levels using the fitted() function.
#
# We can start by generating the predicted probabilities for the observations in our dataset and viewing
# the first few rows:

  head(pp <- fitted(test))

# To examine the changes in predicted probability associated with one of our two
# variables, we can create small datasets varying one variable while holding the
# other constant. We will first do this holding write at its mean and examining
# the predicted probabilities for each level of ses.

dses <- data.frame(ses = c("low", "middle", "high"), write = mean(ml$write))
predict(test, newdata = dses, "probs")

dwrite <- data.frame(ses = rep(c("low", "middle", "high"), each = 41), write = rep(c(30:70), 3))

## store the predicted probabilities for each value of ses and write
pp.write <- cbind(dwrite, predict(test, newdata = dwrite, type = "probs", se = TRUE))

## calculate the mean probabilities within each level of ses
by(pp.write[, 3:5], pp.write$ses, colMeans)

## melt data set to long for ggplot2
lpp <- melt(pp.write, id.vars = c("ses", "write"), value.name = "probability")
head(lpp)  # view first few rows

# Plot the predicted probabilities against the writing score using the predictions generated
# for the pp.write object above by the level of ses for different levels of the outcome variable.

ggplot(lpp, aes(x = write, y = probability, colour = ses)) + geom_line() + facet_grid(variable ~ ., scales = "free")

########################################################################
########################################################################
# Poisson regression example (Zero Truncated)
########################################################################
########################################################################
install.packages("rlang")
install.packages("knitr")
install.packages("vctrs")
install.packages("ggplot2")
install.packages("VGAM")
require(foreign)
require(ggplot2)
require(VGAM)
require(boot)

# Import data from hospital tracking patients who have died
dat <- read.dta("https://stats.idre.ucla.edu/stat/data/ztp.dta")
# Saved at: \Consulting\Public Code Samples\DataScience\Data\HospitalDeathTracking.dta
# Alternate URL:  https://1drv.ms/u/s!AgXALnk1NWLck4JBKcMG9lGWFR8TEA?e=jZf1H7

# Convert a couple of the variables we'll be working with to factors
dat <- within(dat, {
  hmo <- factor(hmo)
  died <- factor(died)
})

summary(dat)

# To really get a sense for the data, let's plot some graphs:
# Length of stay with died in facets
ggplot(dat, aes(stay)) +
  geom_histogram() +
  scale_x_log10() +
  facet_grid(hmo ~ died, margins=TRUE, scales="free_y")

# Examine how stay looks across age groups:
ggplot(dat, aes(factor(age), stay)) +
  geom_violin() + # Violin plot is a great choice for this data spread
  geom_jitter(size=1.5) +
  scale_y_log10() +
  stat_smooth(aes(x = age, y = stay, group=1), method="loess")

# Look at live/die *by hmo*
ggplot(dat, aes(age, fill=died)) +
  geom_histogram(binwidth=.5, position="fill") +
  facet_grid(hmo ~ ., margins=TRUE)

# Now let's create a model predicting stay (a count variable) by the other variables in our set
m1 <- vglm(stay ~ age + hmo + died, family = pospoisson(), data = dat)
summary(m1)

# plot of residuals versus fitted values
output <- data.frame(resid = resid(m1), fitted = fitted(m1))
ggplot(output, aes(fitted, resid)) +
  geom_jitter(position=position_jitter(width=.25), alpha=.5) +
  stat_smooth(method="loess")

# Fit lines using quantile regression:
ggplot(output, aes(fitted, resid)) +
  geom_jitter(position=position_jitter(width=.25), alpha=.5) +
  stat_quantile(method="rq")

# Here we see the spread narrowing at higher levels. Let's cut the data into
# intervals and check box plots for each. We will get the breaks from the algorithm
# for a histogram.

output <- within(output, {
  broken <- cut(fitted, hist(fitted, plot=FALSE)$breaks)
})

ggplot(output, aes(broken, resid)) +
  geom_boxplot() +
  geom_jitter(alpha=.25)

# 1) Get the coefficients from our original model to use as start values for
# the model to speed up the time it takes to estimate.
# 2) Write a short function that takes data and indices as input and returns the parameters
# we are interested in.
# 3) Pass that to the boot function and do 1200 replicates,
#   using snow to distribute across four cores.

dput(round(coef(m1),3)) # Coefficients
f <- function(data, i) {
  require(VGAM)
  m <- vglm(formula = stay ~ age + hmo + died, family = pospoisson(),
            data = data[i, ], coefstart = c(2.436, -0.014, -0.136, -0.204))
  as.vector(t(coef(summary(m))[, 1:2])) #Original model coeffs as starting point
}

set.seed(10)
res <- boot(dat, f, R = 1200, parallel = "snow", ncpus = 4) # 1200 repeats, "snow" parallel option, and 4 cores

## print results
res

## basic parameter estimates with percentile and bias adjusted CIs
parms <- t(sapply(c(1, 3, 5, 7), function(i) {
  out <- boot.ci(res, index = c(i, i + 1), type = c("perc", "basic"))
  with(out, c(Est = t0, pLL = percent[4], pUL = percent[5],
              basicLL = basic[4], basicLL = basic[5]))
}))

## add row names
row.names(parms) <- names(coef(m1))
## print results
parms

## exponentiated parameter estimates with percentile and bias adjusted CIs
expparms <- t(sapply(c(1, 3, 5, 7), function(i) {
  out <- boot.ci(res, index = c(i, i + 1), type = c("perc", "basic"), h = exp)
  with(out, c(Est = t0, pLL = percent[4], pUL = percent[5],
              basicLL = basic[4], basicLL = basic[5]))
}))

## add row names
row.names(expparms) <- names(coef(m1))
## print results
expparms

# In order to better understand our results and model, let's plot some predicted values.
# Because all of our predictors were categorical (hmo and died) or had a small
# number of unique values (age) we will get predicted values for all possible
# combinations.

# First we create a new data set using the expand.grid function,
# then estimate the predicted values using the predict function, and finally plot them.

newdata <- expand.grid(age = 1:9, hmo = factor(0:1), died = factor(0:1)) # New Data
newdata$yhat <- predict(m1, newdata, type = "response") # Predict values with our m1 model

ggplot(newdata, aes(x = age, y = yhat, colour = hmo))  + # Plot the results
  geom_point() +
  geom_line() +
  facet_wrap(~ died)

## function to return predicted values
fpred <- function(data, i, newdata) {
  require(VGAM)
  m <- vglm(formula = stay ~ age + hmo + died, family = pospoisson(),
            data = data[i, ], coefstart = c(2.436, -0.014, -0.136, -0.204))
  predict(m, newdata, type = "response")
}

## set seed and run bootstrap with 1,200 draws
set.seed(10)
respred <- boot(dat, fpred, R = 1200, newdata = newdata,
                parallel = "snow", ncpus = 4)

## get the bootstrapped percentile CIs
yhat <- t(sapply(1:nrow(newdata), function(i) {
  out <- boot.ci(respred, index = i, type = c("perc"))
  with(out, c(Est = t0, pLL = percent[4], pUL = percent[5]))
}))

## merge CIs with predicted values
newdata <- cbind(newdata, yhat)
## graph with CIs
ggplot(newdata, aes(x = age, y = yhat, colour = hmo, fill = hmo))  +
  geom_ribbon(aes(ymin = pLL, ymax = pUL), alpha = .25) +
  geom_point() +
  geom_line() +
  facet_wrap(~ died)

# And voila!  A Poisson prediction model predicts how many deaths (count) to expect by age for HMO and non-HMO patients.


---
title: "matrix"
author: "lois"
date: "11/25/2021"
output: pdf_document
---

```{r}
x <- (1:4)
y <- (5:8)
q = rbind(x, y)
rownames <- x("a", "b", "c", "d")
colnames <- x("e", "f", "g", "h")
```
```{r}
x <- 1:20

length(x)

x<-seq(1,9, by = 2)

x <- 0:6
class(x)

as.numeric(x)
as.logical(x)
as.character(x)
```
```{r}
x <- matrix(nrow = 2, ncol = 3)
x
dim(x)
attributes(x)

m <- matrix(1:6,nrow=2, ncol=3)
m
m <- matrix(1:6,nrow=2, ncol=3, byrow = TRUE)
m

x <- c(1,2,3,4,5,6,7,8,9,10)
x

dim(x) <- c(2,5)
x
```

```{r}
x<-4:6
y<-1:3
cbind(x,y)

rbind(x,y)

m<-matrix(1:4, nrow=2, ncol=2)
colnames(m)<-c("a","b")
rownames(m)<-c("c","d")
m

```
```{r}
#Task 1
x<-(1:4)
y<-(5:8)

M<- cbind(x,y)
M
Q <-rbind(x,y)
Q

colnames(M)<-c("a","b")
rownames(M)<-c("c","d","e","f")
M

colnames(Q)<-c("a","b","c","d")
rownames(Q)<-c("e","f")
Q
```
```{r}
#List
m <- list(50, "b", TRUE, 1 + 4i)
m

x <- list(a = 1, b = "c", c = 3)
x
```
```{r}
#Factor
gender <- c("male","male","female","female","male","female","male")
gender

as.factor(gender)
class(gender)
is.na(gender)
is.nan(gender)
```
```{r}
#Data Frame
emp.data <- data.frame( emp_id = c (1:5),
emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
emp_gender = c("Male", "Male", "Female", "Male", "Male"),
emp_age = c(50, 40, 26, 38, 30),
salary = c(623.3,515.2,611.0,729.0,843.25))
subset(emp.data, emp_id==1)
emp.data[3,]
emp.data[which(emp.data$gender=="Female" & emp.data$age==26),]
subset(emp.data, emp_age>=40, select = c(emp_id, emp_gender, salary, emp_name))
```

```{r}
#Data Frame Two
natives <- data.frame(cohort = c(1:9),
cohort_name = c("one", "two", "three", "four", "five", "six", "seven", "eight", "nine"),
cohort_num_of_natives = c(30, 20, 40, 53, 27, 20, 22, 29, 39))
natives$cohort_name
```
```{r}
x<-5:7
names(x)
names(x)<-c("five","six","seven")
x
names(x)
```
```{r}
x<-c("a","b","c","d")
x[3]
x[x>"b"]

x<-matrix(1:6,2,3)
x[1,2]
x[1,]
x[,3]
```
```{r}
#Subsetting  matrix
x<-matrix(1:12,3,4)
x
x[2:3,2:4]
```
```{r}
#subsetting drop
x <- matrix(1:6, 2, 3)
x[1, 2]
x
x[1, 2, drop = FALSE]
```
```{r}
y <-matrix(1:12,4,4)
colnames(y)<- c("col_one", "col_two", "col_three", "col_four")
y
y[1,2]
y[3:4,1:3]

```

R Data Science Project/Intoduction to data science.r


# KOLEKTIVNI MODEL TVEGANJA IN PANJERJEV ALGORITEM
# Finančni praktikum 2020/21
# Mitja Mandić

library(actuar)
vzorec <- scan("vzorec4.txt")
hist(vzorec)
hist <- recordPlot()

parameter <- mde(vzorec, pweibull, measure = "CvM", start = list(shape = 10, scale = 10))
shape_ocena <- parameter$estimate[1]
scale_ocena <-parameter$estimate[2]

hist(vzorec, breaks = 20,probability = TRUE, ylab = "Gostota")
curve(dweibull(x,shape_ocena,scale_ocena), from=2,to=7, add=TRUE, col = "red")
graf_prva <- recordPlot()

#vzorčna in izračunana porazdelitvena funkcija

plot(ecdf(vzorec), col = "blue", main = "", ylab = " ")
curve(pweibull(x,shape_ocena,scale_ocena), add = TRUE)
title("Vzorčna in porazdelitvena funkcija")
vzorcna_in_porazdelitvena <- recordPlot()

#PORAZDELITEV VSOTE

pv.n <- 25 * 0.5
v.n <- 25 * 0.5 * 0.5

#paramteri weibullove

pv.w <- scale * gamma(1+1/shape)
v.w <- scale^2 * (gamma(1+2/shape)-(gamma(1+1/shape))^2)

e.s <- pv.n * pv.w
v.s <- v.w * pv.n + pv.w^2 * v.n

#DRUGA NALOGA

#druga a

dolzina <- 5
korak <- 1/10
diskretna <- discretize(pweibull(x, shape = shape_ocena , scale=scale_ocena), from = 0, to = 5,
                        step = korak)

#diskretna

#druga b

curve(pweibull(x, shape = shape, scale = scale), from = 0, to = dolzina, xname = "x",ylab = " ")
plot(stepfun(x = seq(0, dolzina - korak, korak),  y = diffinv(diskretna)),add = TRUE)
title("Diskretizacija Weibullove porazdelitve in CDF")

#druga c

panjer <- aggregateDist(method = "recursive", model.freq = "binomial",model.sev = diskretna, size = 25, prob = 0.5,
                      x.scale = korak, tol = 0.001, maxit = 100000)

#druga d
#disperzija in upanje kumulativne škode
skoki <- knots(panjer)

pricakovana_vrednost.panjer <- sum(knots(panjer) * diff(panjer))

pricakovana_vrednost_kvadrat.panjer <- sum(skoki ^ 2 * diff(panjer))

varianca.panjer <- pricakovana_vrednost_kvadrat.panjer - pricakovana_vrednost.panjer^2

#TRETJA NALOGA

#tretja a

#simulacija vsot
vzorec_bin <- rbinom(10000,25,0.5)
simulacije <- as.data.frame(vzorec_bin)
colnames(simulacije) <- "binomska"
simulacije['vsota'] <- 0

i = 1
for (i in 1:10000){
  simulacije[i,"vsota"] <- sum(rweibull(simulacije[i,1],shape_ocena,scale_ocena))
  #i = i + 1
}

#tretja b

simulirana_pv <- mean(simulacije[,"vsota"]) #simulirana vrednost: 29.651; waldov obrazec: 29.7
simulirana_var <- var(simulacije[,"vsota"]) #simulirana vrednost: 37.257; waldov obrazec: 37.3

#tretja c

"Simulirana porazdelitev in porazdelitev kumulativne škode"
plot(ecdf(simulacije[,'vsota']), main = "")
plot(panjer, sub = "", add = TRUE, col = "Blue")
title("Simulirana porazdelitev in porazdelitev kumulativne škode")


# Assignment 3

library(neuralnet)
library(gtools)
library(glue)
printf <- defmacro(str, expr = {print(glue(str))})

# Creating output variable
output = list()

# Part 1
set.seed(1234567890)
Var <- runif(500, 0, 10)
mydata <- data.frame(Var, Sin=sin(Var))
tr <- mydata[1:25,] # Training
te <- mydata[26:500,] # Test

# Random initialization of the weights in the interval [-1, 1]
winit <- runif(n = 10, min = -1, max = 1)
nn <- neuralnet(Sin ~ Var, data=tr, hidden = c(10), startweights=winit)
output$o3.1 = printf("start weights: {nn$startweights}")

plot(tr, cex=2)
points(te, col = "blue", cex=1)
points(te[,1],predict(nn,te), col="red", cex=1)
title("Prediction neural network 0 to 10")
legend("bottomleft",
       inset=.02,
       title="Datapoints",
       c("Training","Testing","Predicted"),
       col=c("black","blue","red"),
       lwd=1,
       lty=c(0,0),
       pch=c(1,1,1))

#part 2

h1 <- function(x) x
h2 <- function(x) ifelse(x > 0, x, 0)
h3 <- function(x) log(1 + exp(x))

nn.h1 = neuralnet(Sin ~ Var, data=tr, hidden = c(10), startweights = winit, act.fct = h1)
nn.h2 = neuralnet(Sin ~ Var, data=tr, hidden = c(10), startweights = winit, act.fct = h2)
nn.h3 = neuralnet(Sin ~ Var, data=tr, hidden = c(10), startweights = winit, act.fct = h3)

par(mfrow=c(2,2))
plot(te, col = "blue", cex=1)
points(te[,1],predict(nn.h1,te), col="red", cex=1)
title("Linear")
plot(te, col = "blue", cex=1)
points(te[,1],predict(nn.h2,te), col="red", cex=1)
title("ReLU")
plot(te, col = "blue", cex=1)
points(te[,1],predict(nn.h3,te), col="red", cex=1)
title("Softplus")
plot(NULL,xaxt='n',yaxt='n',bty='n',ylab='',xlab='', xlim=0:1, ylim=0:1)
legend("topleft",
       legend =c("Sample", "Predicted"),
       title="Datapoints",
       pch=1, pt.cex=2, cex=1,
       col = c("blue", "red"))
par(mfrow=c(1,1))

# part 3

Var2 <- runif(500, 0, 50)
mydata2 <- data.frame(Var=Var2, Sin=sin(Var2))

plot(mydata2[,1],predict(nn,mydata2),
     col="red", cex=1,
     xlab="Var", ylab="Sin")
points(mydata2, col = "blue", cex=1)
legend("bottomleft",
       y=-6,
       legend =c("Sample", "Predicted"),
       title="Datapoints",
       pch=1, pt.cex=2, cex=1,
       col = c("blue", "red"))

# part 4
predict(nn,mydata2)
plot(nn)

conv.prediction = predict(nn,data.frame(Var=1000))

conv.w.L1 = nn$weights[[1]][[1]][2,]
conv.mask <- 0 < c(1, conv.w.L1)
conv.w.L2 = nn$weights[[1]][[2]]

conv.calculation = sum(conv.mask * conv.w.L2)
output$o3.4 = printf("Convergence of nn
        Calculation : {conv.calculation}
        Prediction  : {conv.prediction}
        ")

# part 5

set.seed(1234567890)
Var3 <- runif(500, 0, 10)
mydata3 <- data.frame(Var=Var3, Sin=sin(Var3))

nn.SinPredictVar <- neuralnet(Var ~ Sin,
                              data=mydata3,
                              hidden = c(10),
                              startweights = winit,
                              threshold = 0.1)

plot(predict(nn.SinPredictVar,mydata3), mydata3[,2],
     col="red", cex=1,
     xlab = "Var", ylab = "Sin")
points(mydata3, col = "blue", cex=1)


# Program to check if the input number is prime or not
# take input from the user
num = as.integer(readline(prompt="Enter a number: "))
flag = 0
# prime numbers are greater than 1
if(num > 1) {
# check for factors
flag = 1
for(i in 2:(num-1)) {
if ((num %% i) == 0) {
flag = 0
break
}
}
}
if(num == 2)    flag = 1
if(flag == 1) {
print(paste(num,"is a prime number"))
} else {
print(paste(num,"is not a prime number"))
}


# Goal: To do `moving window volatility' of returns.

library(zoo)

# Some data to play with (Nifty on all fridays for calendar 2004) --
p <- structure(c(1946.05, 1971.9, 1900.65, 1847.55, 1809.75, 1833.65, 1913.6, 1852.65, 1800.3, 1867.7, 1812.2, 1725.1, 1747.5, 1841.1, 1853.55, 1868.95, 1892.45, 1796.1, 1804.45, 1582.4, 1560.2, 1508.75, 1521.1, 1508.45, 1491.2, 1488.5, 1537.5, 1553.2, 1558.8, 1601.6, 1632.3, 1633.4, 1607.2, 1590.35, 1609, 1634.1, 1668.75, 1733.65, 1722.5, 1775.15, 1820.2, 1795, 1779.75, 1786.9, 1852.3, 1872.95, 1872.35, 1901.05, 1996.2, 1969, 2012.1, 2062.7, 2080.5), index = structure(c(12419, 12426, 12433, 12440, 12447, 12454, 12461, 12468, 12475, 12482, 12489, 12496, 12503, 12510, 12517, 12524, 12531, 12538, 12545, 12552, 12559, 12566, 12573, 12580, 12587, 12594, 12601, 12608, 12615, 12622, 12629, 12636, 12643, 12650, 12657, 12664, 12671, 12678, 12685, 12692, 12699, 12706, 12713, 12720, 12727, 12734, 12741, 12748, 12755, 12762, 12769, 12776, 12783), class = "Date"), frequency = 0.142857142857143, class = c("zooreg", "zoo"))

# Shift to returns --
r <- 100*diff(log(p))
head(r)
summary(r)
sd(r)

# Compute the moving window vol --
vol <- sqrt(250) * rollapply(r, 20, sd, align = "right")

# A pretty plot --
plot(vol, type="l", ylim=c(0,max(vol,na.rm=TRUE)),
     lwd=2, col="purple", xlab="2004",
     ylab=paste("Annualised sigma, 20-week window"))
grid()
legend(x="bottomleft", col=c("purple", "darkgreen"),
       lwd=c(2,2), bty="n", cex=0.8,
       legend=c("Annualised 20-week vol (left scale)", "Nifty (right scale)"))
par(new=TRUE)
plot(p, type="l", lwd=2, col="darkgreen",
     xaxt="n", yaxt="n", xlab="", ylab="")
axis(4)

RFrontEndSolution/Tests Repo/Rscripts All (163 files)/p4.r


llr = function(k) {2 * sum(k) * (H(k) - H(rowSums(k)) - H(colSums(k)))}
H = function(k) {N = sum(k) ; return (sum(k/N * log(k/N + (k==0))))}

rootLLR = function(k) {sqrt(llr(k)) * ifelse(k[1,1] > (k[1,1] + k[1,2])/sum(k) * (k[1,1]+k[2,1]), 1, -1)}


model = "model
{
    # Prior for all the parameters
    beta0 ~ dnorm(0, pow(1E3, -2))
    beta1 ~ dnorm(0, pow(1E3, -2))
    log_sigma ~ dunif(-10, 10)
    sigma <- exp(log_sigma)

    # Likelihood
    for(i in 1:N)
    {
        y[i] ~ dnorm(beta0 + beta1*x[i], pow(sigma, -2))
    }

	y_new ~ dnorm(beta0 + beta1*90, pow(sigma, -2))
}
"

# Load data from file
data = source('data.txt')$value

# Variables to monitor
variable_names = c('beta0', 'beta1', 'sigma', 'y_new')

# How many burn-in steps?
burn_in = 10000

# How many proper steps?
steps = 5000

# Thinning?
thin = 10

# NO NEED TO EDIT PAST HERE!!!
# Just run it all and use the results list.

library('rjags')

# Write model out to file
fileConn=file("model.temp")
writeLines(model, fileConn)
close(fileConn)

if(all(is.na(data)))
{
	m = jags.model(file="model.temp", inits=list(.RNG.seed=42, .RNG.name="base::Mersenne-Twister"))
} else
{
	m = jags.model(file="model.temp", data=data, inits=list(.RNG.seed=42, .RNG.name="base::Mersenne-Twister"))
}
update(m, burn_in)
draw = jags.samples(m, steps, thin=thin, variable.names = variable_names)
# Convert to a list
make_list <- function(draw)
{
	results = list()
	for(name in names(draw))
	{
		# Extract "chain 1"
		results[[name]] = as.array(draw[[name]][,,1])

		# Transpose 2D arrays
		if(length(dim(results[[name]])) == 2)
			results[[name]] = t(results[[name]])
	}
	return(results)
}
results = make_list(draw)

# Save as a text file
chains = array(NA, dim=c(500, 3))
chains[,1] = draw$beta0
chains[,2] = draw$beta1
chains[,3] = draw$sigma
write.table(chains, 'chains.txt', row.names=FALSE, col.names=FALSE)
write.table(results$y_new, 'prediction.txt', row.names=FALSE, col.names=FALSE)


# Master Thesis Project - Extreme Value Theory
# Getting the experimental data above the 95 %
# and fitting a GEV distribution to it

# Clear the environment
rm(list=ls())

# Close all already open graphic windows
graphics.off()

# Sourcing the auxiliary files
source("loadStockData_plain.r")

# Remark : the csv uses the metastock data format
#          7 columns : - Ticker (identifier of the stock
#                       and stockmarket on which it is listed)
#					   - Date (yyyymmdd)
#					   - Open
#					   - High
#					   - Low
#					   - Close
#					   - Volume
# By default, the highest price is used i.e. column 3.
CHOICE <- 3

# Loading the original data for the five stocks then
# getting the LVMH and the Total data
df_plain <- loadStockData_plain(CHOICE)

# Getting the log-returns
data_bnp <- df_plain[[1]]
data_bnp <- diff(log(data_bnp))

data_carrefour <- df_plain[[2]]
data_carrefour <- diff(log(data_carrefour))

data_lvmh <- df_plain[[3]]
data_lvmh <- diff(log(data_lvmh))

data_sanofi <- df_plain[[4]]
data_sanofi <- diff(log(data_sanofi))

data_total <- df_plain[[5]]
data_total <- diff(log(data_total))

# Computing the 95 % - quantiles for each of the stocks
quantiles <- c(quantile(data_bnp,0.99), quantile(data_carrefour,0.995), quantile(data_lvmh,0.995),
					quantile(data_sanofi,0.995), quantile(data_total,0.995))

# Getting the data above the threshold
data_bnp <- data_bnp[data_bnp > quantiles[1]]
data_carrefour <- data_carrefour[data_carrefour > quantiles[2]]
data_lvmh <- data_lvmh[data_lvmh > quantiles[3]]
data_sanofi <- data_sanofi[data_sanofi > quantiles[4]]
data_total <- data_total[data_total > quantiles[5]]

# Plotting the above-threshold data
x_label <- ""
y_label <- "Stock price"
title1 <- "BNP Paribas log-returns"
title2 <- "Carrefour log-returns"
title3 <- "LVMH  log-returns"
title4 <- "Sanofi  log-returns"
title5 <- "Total  log-returns"
quartz()
png(file = "aboveThresholdData.png")
par(mfrow = c(3,2))
plot(data_bnp, pch = 1, col = "black", type = 'p', xlab = x_label, ylab = y_label, main = title1)
plot(data_carrefour, pch = 1, col = "blue", type = 'p', xlab = x_label, ylab = y_label, main = title2)
plot(data_lvmh, pch = 1, col = "green", type = 'p', xlab = x_label, ylab = y_label, main = title3)
plot(data_sanofi, pch = 1, col = "purple", type = 'p', xlab = x_label, ylab = y_label, main = title4)
plot(data_total, pch = 1, col = "red", type = 'p', xlab = x_label, ylab = y_label, main = title5)
dev.off()
graphics.off()

print("##################### BNP Paribas #####################")
quartz()
png(file = "gev.diag BNP Paribas")
gev.diag(gev.fit(data_bnp))
dev.off()
graphics.off()

print("##################### Carrefour #####################")
quartz()
png(file = "gev.diag Carrefour")
gev.diag(gev.fit(data_carrefour))
dev.off()
graphics.off()

print("##################### LVMH #####################")
quartz()
png(file = "gev.diag LVMH")
gev.diag(gev.fit(data_lvmh))
dev.off()
graphics.off()

print("##################### Sanofi #####################")
quartz()
png(file = "gev.diag Sanofi")
gev.diag(gev.fit(data_sanofi))
dev.off()
graphics.off()

print("##################### Total #####################")
quartz()
png(file = "gev.diag Total")
gev.diag(gev.fit(data_total))
dev.off()
graphics.off()

print("##################### LVMH 2 #####################")
data_lvmh <- diff(log(df_plain[[3]]))
data_lvmh <- data_lvmh[data_lvmh > quantile(data_lvmh,0.95)]

quartz()
png(file = "gev.diag LVMH2")
gev.diag(gev.fit(data_lvmh))
dev.off()
graphics.off()

print("##################### BNP 2 #####################")
data_bnp <- diff(log(df_plain[[1]]))
data_bnp <- data_bnp[data_bnp > quantile(data_bnp,0.99)]

quartz()
png(file = "gev.diag BNP2")
gev.diag(gev.fit(data_total))
dev.off()
graphics.off()

print("#################################################")
print("#################################################")
print("#################################################")
data_lvmh <- as.numeric((read.csv("daily_LVMH_table.csv", header = FALSE))[[3]])
quartz()
png(file = "LVMH_daily.png")
plot(1:length(data_lvmh), data_lvmh)
dev.off()
graphics.off()

lvmh_quant <- quantile(data_lvmh, 0.99)
data_lvmh <- data_lvmh[data_lvmh > lvmh_quant]
data_lvmh <- diff(log(data_lvmh))

quartz()
png(file = "LVMH_daily_99quant.png")
plot(1:length(data_lvmh), data_lvmh)
dev.off()
graphics.off()

quartz()
png(file = "gev.diag LVMH3")
gev.diag(gev.fit(data_lvmh))
dev.off()
graphics.off()


#ex1

x=c(1, 8, 2, 6, 2, 8, 8, 5, 5, 5)
print(sum(x)/10)
log2(x)
max(x)-min(x)
y = (x - 5)/2.624669
print(y)
print(mean(y))
print(sd(y))

#ex2
factura = c(46, 33, 39, 37, 36, 30, 48, 32, 49, 35, 30, 48)
print(sum(factura))
print(min(factura))
print(max(factura))
nr_luni = length(factura[factura > 40])
print(nr_luni)
print(100 * nr_luni/length(factura))

#ex3
z<-scan()
print(min(z))
print(max(z))
print(mean(z))
print(median(z))
print(sd(z))
sort(z)
print(z)
norm = (z - mean(z))/sd(z)
print(norm)


#' Generate a vector of frequencies.
#'
#' @param N Number of elements in vector (must be even).
#' @param freq.max Value of largest frequency.
#'
#' @return Vector of frequencies.
#'
#' @examples
#' freq(10, freq.max = 5) # => c(-5, -4, -3, -2, -1, 1, 2, 3, 4, 5)
#'
#' @export
freq <- function(N, freq.max = 1/(2*pi)) {
    ## Input Validation ##

    if (N %% 2) {
        stop("'N' must be even")
    }

    ## Setup ##

    # Precompute N/2, which we know to be an integer.
    half.N <- N / 2
    # Increment between freq[i] and freq[i+1].
    freq.step <- freq.max / half.N

    ## Frequency Vectors ##

    # Obtain the positive frequencies by counting from the smallest
    # one to the maximum. Start counting from 'freq.step', which is
    # the increment between frequencies, as zero frequency is
    # undefined.
    freq.pos <- seq(from = freq.step,
                    to = freq.max,
                    length.out = half.N)
    # Obtain the negative frequencies by reversing the order on the
    # positive ones, and negating them.
    freq.neg <- -rev(freq.pos)
    # Concatenate the negative and positive frequencies to get the
    # full vector of frequencies.
    freq <- c(freq.neg, freq.pos)

    ## Return ##

    list(
      freq     = freq,
      freq.pos = freq.pos,
      freq.neg = freq.neg
    )
}


#ccc computes Lin's concordance correlation coefficient for the two vectors input
#returns a dataframe containing several parameters
#[1] ccc
#[2] mean-shift
#[3] var shift
#[4] pearson's correlation
ccc <- function(x,y)
  {
    #check vectors are same length
    if(length(x)!=length(y)) stop("Vectors must be same length")
    if(sum(c(x,y), na.rm=T)==0)
      {
        ccc <- 1
        u <- 0
        v <- 0
        p <- 1
      }
    else
      {
        m1 <- mean(x, na.rm=T)
        m2 <- mean(y, na.rm=T)
        v1 <- var(x, na.rm=T)
        v2 <- var(y, na.rm=T)
        sd1 <- sqrt(v1)
        sd2 <- sqrt(v2)

        u <- (m1-m2)/sqrt(sd1*sd2)
        v <- sd1/sd2
        Cb <- 1/((v+(1/v)+u^2)/2)

        p <- cor(x,y, use="complete.obs",method="pearson")

        B1 <- v*p
        B0 <- m1-(B1*m2)
        a <-(2*B1*v2)
        b <- v1+v2+(B0+(B1-1)*m2)^2
        ccc <- a/b
      }
    return(list(ccc=ccc, u=u, v=v, pearson=p))#, a=a, b=b, v1=v1, v2=v2, b0=B0, b1=B1, m2=m2))
  }


model_tavg <- function (tmin = 0.0,
         tmax = 0.0){
    #'- Name: Tavg -Version: 1.0, -Time step: 1
    #'- Description:
    #'            * Title: Mean temperature  calculation
    #'            * Author: STICS
    #'            * Reference: doi:http://dx.doi.org/10.1016/j.agrformet.2014.05.002
    #'            * Institution: INRA
    #'            * Abstract: It simulates the depth of snow cover and recalculate weather data
    #'- inputs:
    #'            * name: tmin
    #'                          ** description : current minimum air temperature
    #'                          ** inputtype : variable
    #'                          ** variablecategory : auxiliary
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : degC
    #'                          ** uri :
    #'            * name: tmax
    #'                          ** description : current maximum air temperature
    #'                          ** inputtype : variable
    #'                          ** variablecategory : auxiliary
    #'                          ** datatype : DOUBLE
    #'                          ** default : 0.0
    #'                          ** min : 0.0
    #'                          ** max : 100.0
    #'                          ** unit : degC
    #'                          ** uri :
    #'- outputs:
    #'            * name: tavg
    #'                          ** description : mean temperature
    #'                          ** variablecategory : auxiliary
    #'                          ** datatype : DOUBLE
    #'                          ** min : 0.0
    #'                          ** max : 500.0
    #'                          ** unit : degC
    #'                          ** uri :
    tavg <- (tmin + tmax) / 2
    return (list('tavg' = tavg))
}