solve_nocopy <- function(problemsize)
{
  N <- problemsize

  ### Don't want to divide by 0 if someone submits a tiny problem
  for (power in 0:6)
  {
    if (power == 6)
      stop("Your computer is from the future!")

    ordmag <- 10^power

    A <- matrix(rnorm(N*N), N, N)
    B <- matrix(rnorm(N*N), N, 1L)

    time <- mean(replicate(ordmag,
      system.time( X <- .Call(R_solve_nocopy, A, B) )[3])
    )

    rm(A);rm(B);invisible(gc())

    if (time > 1e-8) break
  }

  nops <- 2/3*N*N*N + 2*N*N
  flops <- nops / as.numeric(time)

  return(flops)
}

#' Linpack Benchmark
#'
#' The Linpack benchmark is the standard performance benchmark
#' for numerical computing.  Research institutions, governments,
#' and companies with very large computing resources "compete" to
#' build machines that will perform the best on the benchmark.
#' Results of this competition are released twice a year, in
#' June and in November, at the ISC and SC conferences, respectively.
#' Although it is generally understood that Linpack no longer
#' adequately measures the performance capabilities of a system
#' on real problems, it has remained an important measurement
#' all the same.  One of the most attractive things
#' about the Linpack benchmark is its host of historical data,
#' which dates back all the way to 1993.
#'
#' If you are even somewhat serious about using this as a test of
#' the host system's capabilities, I would strongly encourage you
#' to run this exclusively; that is, shut down all other
#' resource-intensive applications (web browsers, system updates,
#' antivirus, whatever).  If a lot of your ram is used up by
#' other utilities and the benchmarker has to swap them to disk,
#' the performance will degrade by several orders of magnitude.
#'
#' @param nmin
#' Minimum problem size.
#' @param nmax
#' Maximum problem size.  Value should either be an integer greater
#' than \code{nmin} or it should be the string "choose".  In the
#' former case, the supplied value will be the largest value
#' considered.  In the latter case, the largest problem size will
#' be 2/3 of max system ram.
#' @param by
#' How to get from nmin to nmax.  Value should either be a numeric
#' value greater than 0, or it should be the string "doubling".  In
#' the former case, \code{seq.int()} is used, while in the latter,
#' values starting with nmin will be doubled until nmax is
#' reached/surpassed.
#' @param warn
#' Logical; this controls the printing of a warning that I very
#' seriously want you to read.  Set \code{warnme=FALSE} to disable
#' after you have read it.
#' @param verbose
#' Logical; determines whether or not intermediate results should
#' be printed.
#'
#' @return
#' The return is a list (formally an S3 'linpack' object), containing:
#' \tabular{ll}{
#'    R.max \tab The max
#' }
#'
#' @references \url{http://www.top500.org/project/linpack/}
#'
#' @name linpack
#' @rdname linpack
#' @export
linpack <- function(nmin=1000, nmax="choose", by="doubling", warn=TRUE, verbose=TRUE)
{
  msg <- "
                    /!\\ Please read me /!\\\n
  Running this without very efficient BLAS (e.g., MKL, OpenBLAS, ...)
  is a waste of time and will not give you a good sense of the
  performance of your machine.  You are encouraged to investigate
  using OpenBLAS, or Revolution R Open.\n
  If you don't know which BLAS you're using, they're not efficient!\n"

  assert_type(warn, "logical")
  if (warn) cat(msg)
  assert_type(verbose, "logical")

  ### Checks
  assert_type(nmin, "int")
  assert_val(nmin > 0)
  N.bottom <- nmin

  if (is.character(nmax))
  {
    nmax <- match.arg(tolower(nmax), "choose")
    N.top <- as.integer(howmany(Sys.meminfo()$totalram/1.5))[1L]
    assert_val(N.top > 0, "Unable to determine max system ram")
  }
  else
  {
    assert_type(nmax, "int")
    assert_val(nmax > 0)
    assert_val(nmin <= nmax, "No valid test cases selsected:  nmin > nmax")

    N.top <- nmax
  }

  if (is.character(by))
  {
    by <- match.arg(tolower(by), "doubling")
    Ns <- a2b_int_doubling(N.bottom, N.top)
  }
  else
  {
    assert_type(by, "numeric")
    assert_val(by > 0)
    Ns <- round(seq.int(from=N.bottom, to=N.top, by=by))
  }

  ### benchmark
  R.max <- 0
  N.max <- 0

  if (verbose) cat("\n   N      R.max\n")

  for (N in Ns)
  {
    if (verbose) cat(N)

    test <- solve_nocopy(problemsize=N)

    if (test > R.max)
    {
      R.max <- test
      N.max <- N
    }

    if (verbose)
      cat("   ", R.max, "\n")

    N <- N*2L
  }

  if (verbose) cat("\n")

  R.max <- flops(R.max)
  R.peak <- cpu_clock()$peak

  ret <- list(R.max=R.max, N.max=N.max, R.peak=R.peak)
  class(ret) <- "linpack"

  return(ret)
}

#' @export
summary.linpack <- function(object, ..., digits=3)
{
  Pct <- unflop(object$R.max) / unflop(object$R.peak) * 100

  ret <- list(Pct=Pct)

  maxlen <- max(sapply(names(ret), nchar))
  names <- gsub(names(ret), pattern="_", replacement=" ")
  names <- title_case(names)
  spacenames <- simplify2array(lapply(names, function(str) paste0(str, ":", paste0(rep(" ", maxlen-nchar(str)), collapse=""))))

  cat(paste(spacenames, sapply(ret, round, digits=digits), sep=" ", collapse="\n"), "\n")

  return(invisible(ret))
}

#' Prints linpack objects
#'
#' @param x
#' A linpack object to print.
#' @param ...
#' Extra arguments (ignored).
#' @param digits
#' Number of digits to print.
#'
#' @name print-linpack
#' @rdname print-linpack
#' @method print linpack
#' @export
print.linpack <- function(x, ..., digits=3)
{
  maxlen <- max(sapply(names(x), nchar))
  names <- gsub(names(x), pattern="_", replacement=" ")
  names <- title_case(names)
  spacenames <- simplify2array(lapply(names, function(str) paste0(str, ":", paste0(rep(" ", maxlen-nchar(str)), collapse=""))))

  printfun <- function(x, digits)
  {
    if (class(x) == "flops")
      capture.output(print(x, digits=digits))
    else
      round(x, digits=digits)
  }

  cat(paste(spacenames, sapply(x, printfun, digits=digits), sep=" ", collapse="\n"), "\n")
  invisible()
}

#' Subsets linpack outputs.
#'
#' @param x
#' linpack object.
#' @param i
#' Index.
#'
#' @name subset-linpack
#' @rdname subset-linpack
#' @method [ linpack
#' @export
"[.linpack" <- function(x, i)
{
  class(x) <- NULL
  ret <- x[i]
  if (length(ret) > 0)
    class(ret) <- "linpack"
  else
    return(numeric(0))

  return(ret)
}


library(plyr)
library(ggplot2)
library(RColorBrewer)
library(grid)
library(RSQLite)

setwd(dirname(sys.frame(1)$ofile))
theme_update(plot.margin = unit(c(0,0,0,0), "cm"))

fname = "G:/tmp/noisy_logisticsurrogate_data_set/logisticTrainSignal.txt/vs/31"
fp = file(fname, "rb")
ints = as.numeric(readBin(fp, integer(), size=8, n=1000))
close(fp)

li = length(ints)
nsfirst = c(10,20,40,floor(li/10),li-1)
#df = data.frame(v = diff(ints[1:200]))
df = adply(nsfirst, 1, function(n) {
  data.frame(
    pfx=as.factor(rep(n, n)),
    vals=log2(abs(diff(ints[1:(n+1)])))
  )
})

#deltas are not always small log_2 powers...
ggplot(df) +
  stat_ecdf(aes(x=vals, group=pfx, color=pfx), binwidth=1, size=1) +
  scale_x_continuous("log base 2 of delta") +
  scale_y_continuous("cumulative density") +
  scale_color_hue("Prefix", h=c(20,200))
ggsave("figs/prefix-cdf.pdf",width=5,height=3.5)

#nasa_valve has columns with very low information
# (e.g., an entire column of 2.97363281250000000000)
fname = "G:/tmp/nasa_valve/COL-1-Shunt-COL-2-Temperature-COL-3-Hall-Effect-Sensor/Data Set 1/v37891 S000.TXT/vs/1"
fp = file(fname, "rb")
ints = as.numeric(readBin(fp, integer(), size=8, n=1000))
close(fp)

#inlineskating has data with lots of runs.
fname = "G:/tmp/inline_skating/inline_skating.dat/vs/15_discretizedgluteusmaximus"
fp = file(fname, "rb")
ints = as.numeric(readBin(fp, integer(), size=1, n=1000))
close(fp)

#all 2s and 3s... some sequence redundancy
fname = "G:/tmp/Discord_anomaly_detection/mitdbx_mitdbx_108.txt/vs/1"
fp = file(fname, "rb")
ints = as.numeric(readBin(fp, integer(), size=4, n=100))
close(fp)
ggplot(data.frame(x=seq(0,length(ints)-2),y=diff(ints)), aes(x,y)) + geom_line()

#hmm...
fname = "G:/tmp/Discord_anomaly_detection/qtdbsel102.txt/vs/2"
fp = file(fname, "rb")
ints = as.numeric(readBin(fp, integer(), size=2, n=100))
close(fp)
ggplot(data.frame(x=seq(0,length(ints)-2),y=diff(ints)), aes(x,y)) + geom_line()

#
fname = "G:/tmp/CMU_robot/cement.txt/vs/1"
fp = file(fname, "rb")
ints = as.numeric(readBin(fp, integer(), size=4, n=100000))
close(fp)
ggplot(data.frame(x=diff(ints)), aes(x)) + geom_histogram()


require(rms)
tt <- function() {
  dp <- function(...) {
    pdf('/tmp/z.pdf')
    print(...)
    dev.off()
  }
n <- 350     # define sample size
set.seed(17) # so can reproduce the results
age            <- rnorm(n, 50, 10)
blood.pressure <- rnorm(n, 120, 15)
cholesterol    <- rnorm(n, 200, 25)
sex            <- factor(sample(c('female','male'), n,TRUE))
label(age)            <- 'Age'      # label is in Hmisc
label(cholesterol)    <- 'Total Cholesterol'
label(blood.pressure) <- 'Systolic Blood Pressure'
label(sex)            <- 'Sex'
units(cholesterol)    <- 'mg/dl'   # uses units.default in Hmisc
units(blood.pressure) <- 'mmHg'

# Specify population model for log odds that Y=1
L <- .4*(sex=='male') + .045*(age-50) +
  (log(cholesterol - 10)-5.2)*(-2*(sex=='female') + 2*(sex=='male')) +
  .01 * (blood.pressure - 120)
# Simulate binary y to have Prob(y=1) = 1/[1+exp(-L)]
y <- ifelse(runif(n) < plogis(L), 1, 0)

ddist <<- datadist(age, blood.pressure, cholesterol, sex)
options(datadist='ddist')

fit <- lrm(y ~ blood.pressure + sex * (age + rcs(cholesterol,4)),
               x=TRUE, y=TRUE)
an <- anova(fit)
# Plot effects in two vertical sub-panels with continuous predictors on top
# ggplot(Predict(fit), sepdiscrete='vertical')
# Plot effects of all 4 predictors with test statistics from anova, and P
dp(ggplot(Predict(fit), anova=an, pval=TRUE))
# ggplot(Predict(fit), rdata=llist(blood.pressure, age))
# spike histogram plot for two of the predictors

# p <- Predict(fit, name=c('age','cholesterol'))   # Make 2 plots
# ggplot(p)

# p <- Predict(fit, age=seq(20,80,length=100), sex, conf.int=FALSE)
#                        # Plot relationship between age and log
                         # odds, separate curve for each sex,
# ggplot(p, subset=sex=='female' | age > 30)
# No confidence interval, suppress estimates for males <= 30

# p <- Predict(fit, age, sex)
# ggplot(p, rdata=llist(age,sex))
                         # rdata= allows rug plots (1-dimensional scatterplots)
                         # on each sex's curve, with sex-
                         # specific density of age
                         # If data were in data frame could have used that
# p <- Predict(fit, age=seq(20,80,length=100), sex='male', fun=plogis)
                         # works if datadist not used
# ggplot(p, ylab=expression(hat(P)))
                         # plot predicted probability in place of log odds
# per <- function(x, y) x >= 30
# ggplot(p, perim=per)       # suppress output for age < 30 but leave scale alone

# Do ggplot2 faceting a few different ways
p <- Predict(fit, age, sex, blood.pressure=c(120,140,160),
             cholesterol=c(180,200,215))
# ggplot(p)
dp(ggplot(p, cholesterol ~ blood.pressure))
# ggplot(p, ~ cholesterol + blood.pressure)
# color for sex, line type for blood.pressure:
dp(ggplot(p, groups=c('sex', 'blood.pressure')))
# Add legend.position='top' to allow wider plot
# Map blood.pressure to line thickness instead of line type:
# ggplot(p, groups=c('sex', 'blood.pressure'), aestype=c('color', 'size'))

# Plot the age effect as an odds ratio
# comparing the age shown on the x-axis to age=30 years

# ddist$limits$age[2] <- 30    # make 30 the reference value for age
# Could also do: ddist$limits["Adjust to","age"] <- 30
# fit <- update(fit)   # make new reference value take effect
# p <- Predict(fit, age, ref.zero=TRUE, fun=exp)
# ggplot(p, ylab='Age=x:Age=30 Odds Ratio',
#        addlayer=geom_hline(yintercept=1, col=gray(.8)) +
#                 geom_vline(xintercept=30, col=gray(.8)) +
#                 scale_y_continuous(trans='log',
#                       breaks=c(.5, 1, 2, 4, 8))))

# Compute predictions for three predictors, with superpositioning or
# conditioning on sex, combined into one graph

p1 <- Predict(fit, age, sex)
p2 <- Predict(fit, cholesterol, sex)
p3 <- Predict(fit, blood.pressure, sex)
p <- rbind(age=p1, cholesterol=p2, blood.pressure=p3)
dp(ggplot(p, groups='sex', varypred=TRUE, adj.subtitle=FALSE))
# ggplot(p, groups='sex', varypred=TRUE, adj.subtitle=FALSE, sepdiscrete='vert')

# Make an 'interaction plot', forcing the x-axis variable to be
# plotted at integer values but labeled with category levels
n <- 100
set.seed(1)
gender <- c(rep('male', n), rep('female',n))
m <- sample(c('a','b'), 2*n, TRUE)
d <<-  datadist(gender, m); options(datadist='d')
anxiety <- runif(2*n) + .2*(gender=='female') + .4*(gender=='female' & m=='b')
tapply(anxiety, llist(gender,m), mean)
f <- ols(anxiety ~ gender*m)
p <- Predict(f, gender, m)
# ggplot(p)     # horizontal dot chart; usually preferred for categorical predictors
# ggplot(p, flipxdiscrete=FALSE)  # back to vertical
dp(ggplot(p, groups='gender'))
dp(ggplot(p, ~ m, groups=FALSE, flipxdiscrete=FALSE))
}
print(system.time(tt()))


library(ARDL)
library(zoo) #  cbind.zoo
library(xts) #  xts
library(readxl)
library(urca)
library(stR) # decompose
library(stats)
library(ggplot2)
library(strucchange)
library(tidyverse)
library(tsoutliers)
library(car) # QQ plot
library(dynamac)

################################################################################
# TABLE 3 --- ADF AND PP TESTS --- PANEL A
################################################################################

time_series_data <- read.csv("data/dataset_complete_v2.csv")
time_series_data <- time_series_data[, c("date", "log_intra_year", "log_long_term", "log_1to3year",
                                         "i", "nethawkish", "log_nethawkish")]
time_series_data <- time_series_data %>%
  mutate(intra_year = exp(log_intra_year),
         long_term = exp(log_long_term),
         one_to_three_year = exp(log_1to3year))

# Outliers
series_to_adjust <- time_series_data$nethawkish
out <- tso(as.ts(series_to_adjust), types = "AO") # AO - additive outlier
h_adj <- out$yadj

time_series_data$nethawkish <- h_adj

#######################################
# THE SELECTED VARIABLE CAN BE SET HERE
#######################################

time_series <- time_series_data$intra_year
# plot(time_series, type = "l")
## ADF
### Level
summary(ur.df(time_series, type = c("drift"), lags=12, selectlags = "AIC"))
plot(ur.df(time_series, type = c("drift"), lags=12, selectlags = "AIC"))

### Difference
summary(ur.df(diff(time_series), type = c("drift"), lags=12, selectlags = "AIC"))
plot(ur.df(diff(time_series), type = c("drift"), lags=12, selectlags = "AIC"))

## Phillips - Perron teszt
### Level
summary(ur.pp(time_series, type = c("Z-tau"), model = c("constant")))
plot(ur.pp(time_series, type = c("Z-tau"), model = c("constant")))

## Difference
summary(ur.pp(diff(time_series), type = c("Z-tau"), model = c("constant")))
plot(ur.pp(diff(time_series, type = c("Z-tau"), model = c("constant"))))

################################################################################
# TABLE 3 --- ADF AND PP TESTS --- PANEL B
################################################################################

time_series_data <- read.csv("data/dataset_complete_v2.csv")
time_series_data <- time_series_data[, c("date", "log_intra_year", "log_long_term", "log_1to3year",
                                         "i", "nethawkish", "log_nethawkish")]
time_series_data <- time_series_data %>%
  mutate(intra_year = exp(log_intra_year),
         long_term = exp(log_long_term),
         one_to_three_year = exp(log_1to3year))

# Outliers
series_to_adjust <- time_series_data$nethawkish
out <- tso(as.ts(series_to_adjust), types = "AO") # AO - additive outlier
h_adj <- out$yadj

time_series_data$nethawkish <- h_adj

time_series_data <- time_series_data[1:89, ]

#######################################
# THE SELECTED VARIABLE CAN BE SET HERE
#######################################

time_series <- time_series_data$intra_year
# plot(time_series, type = "l")
## ADF
### Level
summary(ur.df(time_series, type = c("drift"), lags=12, selectlags = "AIC"))
plot(ur.df(time_series, type = c("drift"), lags=12, selectlags = "AIC"))

### Difference
summary(ur.df(diff(time_series), type = c("drift"), lags=12, selectlags = "AIC"))
plot(ur.df(diff(time_series), type = c("drift"), lags=12, selectlags = "AIC"))

## Phillips - Perron teszt
### Level
summary(ur.pp(time_series, type = c("Z-tau"), model = c("constant")))
plot(ur.pp(time_series, type = c("Z-tau"), model = c("constant")))

## Difference
summary(ur.pp(diff(time_series), type = c("Z-tau"), model = c("constant")))
plot(ur.pp(diff(time_series, type = c("Z-tau"), model = c("constant"))))

################################################################################
# TABLE 3 --- ADF AND PP TESTS --- PANEL C
################################################################################

time_series_data <- read.csv("data/dataset_complete_v2.csv")
time_series_data <- time_series_data[, c("date", "log_intra_year", "log_long_term", "log_1to3year",
                                         "i", "nethawkish", "log_nethawkish")]
time_series_data <- time_series_data %>%
  mutate(intra_year = exp(log_intra_year),
         long_term = exp(log_long_term),
         one_to_three_year = exp(log_1to3year))

# Outliers
series_to_adjust <- time_series_data$nethawkish
out <- tso(as.ts(series_to_adjust), types = "AO") # AO - additive outlier

h_adj <- out$yadj

time_series_data$nethawkish <- h_adj

time_series_data <- time_series_data[90:168, ]

#######################################
# THE SELECTED VARIABLE CAN BE SET HERE
#######################################

time_series <- time_series_data$intra_year
# plot(time_series, type = "l")
## ADF
### Level
summary(ur.df(time_series, type = c("trend"), lags=12, selectlags = "AIC"))
plot(ur.df(time_series, type = c("trend"), lags=12, selectlags = "AIC"))

### Difference
summary(ur.df(diff(time_series), type = c("trend"), lags=12, selectlags = "AIC"))
plot(ur.df(diff(time_series), type = c("trend"), lags=12, selectlags = "AIC"))

## Phillips - Perron teszt
### Level
summary(ur.pp(time_series, type = c("Z-tau"), model = c("trend")))
plot(ur.pp(time_series, type = c("Z-tau"), model = c("trend")))

## Difference
summary(ur.pp(diff(time_series), type = c("Z-tau"), model = c("trend")))
plot(ur.pp(diff(time_series, type = c("Z-tau"), model = c("trend"))))

################################################################################
# TABLE 4 PREPARATIONS
################################################################################
time_series_data <- read.csv("data/dataset_complete_v2.csv")
time_series_data <- time_series_data[, c("date", "log_intra_year", "log_long_term", "log_1to3year",
                                         "i", "nethawkish", "log_nethawkish")]
time_series_data <- time_series_data %>%
  mutate(intra_year = exp(log_intra_year),
         long_term = exp(log_long_term),
         one_to_three_year = exp(log_1to3year))

# Outliers
series_to_adjust <- time_series_data$nethawkish
out <- tso(as.ts(series_to_adjust), types = "AO") # AO - additive outlier

h_adj <- out$yadj

time_series_data$nethawkish <- h_adj

################################################################################
# TABLE 4 --- MODEL 1 --- LONG_TERM NETHAWKISH full time series
################################################################################

# nethawkish  i
## ARDL cointegration
### Order selection
ARDL_package_models <- auto_ardl(long_term ~ i  nethawkish,
                                 data = time_series_data, max_order = 12, selection = "AIC")
# model selection
ARDL_package_models$top_orders
# best model
best_ARDL <- ARDL_package_models$best_model

# best_ARDL <- ardl(long_term ~ i  nethawkish , data = time_series_data, order = c(1,1,1))

# output statistics
summary(best_ARDL)

## UNRESTRICTED ARDL MODELL
uecm <- uecm(best_ARDL, case = 3)
summary(uecm)

## RESTRICTED ARDL  MODELL
recm<- recm(best_ARDL, case = 3)
summary(recm)

    #####################################
    # TABLE 5 --- COLUMN 1/9
    #####################################

# Bounds tests - F-stat
# 1%
tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.01)
tbounds$tab
# 5%
tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.05)
tbounds$tab
# 10%
tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.1)
tbounds$tab

################################################################################
#
summary(uecm)

# seed
set.seed(020990)
dynamac_model <- dynardl(long_term ~ i  nethawkish, data = time_series_data,
                         lags = list("long_term" = 1, "i" = 1, "nethawkish" = 1),
                         diffs = c("i", "nethawkish"),
                         lagdiffs = list("i" = c(1:2)),
                         ec = TRUE, simulate = TRUE,
                         shockvar = "i", range = 20, sims = 10000)
summary(dynamac_model)

#
dynardl.auto.correlated(dynamac_model)

# QQ plot
qqPlot(dynamac_model$model$residuals, ylab="Model residuals")

# shock simulation
# with 95/90/75 ci
dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5)

# central values
dynamac_model$simulation$central

################################################################################
# TABLE 4 --- MODEL 2 --- LONG_TERM NETHAWKISH  i 1-89
################################################################################
      # Els� id�szak
      time_series_data <- time_series_data[1:89, ]
      #
      ## ARDL cointegration
      ### Order selection
      ARDL_package_models <- auto_ardl(long_term ~ i  nethawkish,
                                       data = time_series_data, max_order = 12, selection = "AIC")
      # model selection
      ARDL_package_models$top_orders
      # best model
      best_ARDL <- ARDL_package_models$best_model

      # best_ARDL <- ardl(long_term ~ i  nethawkish , data = time_series_data, order = c(1,1,1))

      # output statistics
      summary(best_ARDL)

      ## UNRESTRICTED ARDL MODELL
      uecm <- uecm(best_ARDL, case = 3)
      summary(uecm)

      ## RESTRICTED ARDL  MODELL
      recm<- recm(best_ARDL, case = 3)
      summary(recm)

            #####################################
            # TABLE 5 --- COLUMN 2/9
            #####################################

      # Bounds tests - F-stat
      # 1%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.01)
      tbounds$tab
      # 5%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.05)
      tbounds$tab
      # 10%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.1)
      tbounds$tab

      ################################################################################
      #
      summary(uecm)

      # seed
      set.seed(020990)
      dynamac_model <- dynardl(long_term ~ i  nethawkish, data = time_series_data,
                               lags = list("long_term" = 1, "i" = 1, "nethawkish" = 1),
                               diffs = c("i", "nethawkish"),
                               # lagdiffs = list("i" = c(1:2)),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "i", range = 20, sims = 10000)
      summary(dynamac_model)

      #
      dynardl.auto.correlated(dynamac_model)

      # QQ plot
      qqPlot(dynamac_model$model$residuals, ylab="Model residuals")

      # shock simulation
      # with 95/90/75 ci
      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5)

      # central values
      dynamac_model$simulation$central

################################################################################
# TABLE 4 --- MODEL 3 --- LONG_TERM NETHAWKISH  i 90-168
################################################################################

time_series_data <- read.csv("data/dataset_complete_v2.csv")
time_series_data <- time_series_data[, c("date", "log_intra_year", "log_long_term", "log_1to3year",
                                               "i", "nethawkish", "log_nethawkish")]
time_series_data <- time_series_data %>%
        mutate(intra_year = exp(log_intra_year),
               long_term = exp(log_long_term),
               one_to_three_year = exp(log_1to3year))

# outliers
series_to_adjust <- time_series_data$nethawkish
out <- tso(as.ts(series_to_adjust), types = "AO") # AO - additive outlier
# AO kiugr� �rt�kre sz�rt
h_adj <- out$yadj

# ts.plot(cbind(series_to_adjust, h_adj), col = c("blue", "red"))

time_series_data$nethawkish <- h_adj

# M�sodik id�szak
time_series_data <- time_series_data[90:168, ]

#
## ARDL cointegration
### Order selection
ARDL_package_models <- auto_ardl(long_term ~ i  nethawkish,
                                 data = time_series_data, max_order = 12, selection = "AIC")
# model selection
ARDL_package_models$top_orders

best_ARDL <- ardl(long_term ~ i  nethawkish , data = time_series_data, order = c(1,1,1))

# output statistics
summary(best_ARDL)

## UNRESTRICTED ARDL MODELL
uecm <- uecm(best_ARDL, case = 3)
summary(uecm)

## RESTRICTED ARDL  MODELL
recm<- recm(best_ARDL, case = 3)
summary(recm)

      #####################################
      # TABLE 5 --- COLUMN 3/9
      #####################################

# Bounds tests - F-stat
# 1%
tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.01)
tbounds$tab
# 5%
tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.05)
tbounds$tab
# 10%
tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.1)
tbounds$tab

################################################################################
#
summary(uecm)

## Interest rate shock responses
# seed
set.seed(020990)
## Interest rate shock responses
dynamac_model <- dynardl(long_term ~ i  nethawkish, data = time_series_data,
                         lags = list("long_term" = 1, "i" = 1, "nethawkish" = 1),
                         diffs = c("i", "nethawkish"),
                         # lagdiffs = list("i" = c(1:2)),
                         ec = TRUE, simulate = TRUE,
                         shockvar = "i", range = 30, sims = 10000)
summary(dynamac_model)

#
dynardl.auto.correlated(dynamac_model)

##################################
# FIG 6 --- QQ plot --- LONG TERM
##################################
qqPlot(dynamac_model$model$residuals, ylab="Model residuals")

# shock simulation
# with 95/90/75 ci
dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5,
                        xlab = "Periods", ylab = "Long_term yield values")

# central values
dynamac_model$simulation$central

## Nethawkish shock responses
dynamac_model <- dynardl(long_term ~ i  nethawkish, data = time_series_data,
                         lags = list("long_term" = 1, "i" = 1, "nethawkish" = 1),
                         diffs = c("i", "nethawkish"),
                         # lagdiffs = list("i" = c(1:2)),
                         ec = TRUE, simulate = TRUE,
                         shockvar = "nethawkish", range = 30, sims = 10000)

dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5,
                        xlab = "Periods", ylab = "Long_term yield values")

# central values
dynamac_model$simulation$central
################################################################################
################################################################################
################################################################################
################################################################################
################################################################################

      time_series_data <- read.csv("data/dataset_complete_v2.csv")
      time_series_data <- time_series_data[, c("date", "log_intra_year", "log_long_term", "log_1to3year",
                                               "i", "nethawkish", "log_nethawkish")]
      time_series_data <- time_series_data %>%
        mutate(intra_year = exp(log_intra_year),
               long_term = exp(log_long_term),
               one_to_three_year = exp(log_1to3year))

      # outliers
      series_to_adjust <- time_series_data$nethawkish
      out <- tso(as.ts(series_to_adjust), types = "AO") # AO - additive outlier

      h_adj <- out$yadj

      # ts.plot(cbind(series_to_adjust, h_adj), col = c("blue", "red"))

      time_series_data$nethawkish <- h_adj

################################################################################
# TABLE 4 --- MODEL 4 --- 1to3_year nethawkish  i, full time time series
################################################################################

      #
      ## ARDL cointegration
      ### Order selection
      ARDL_package_models <- auto_ardl(one_to_three_year ~ i  nethawkish,
                                       data = time_series_data, max_order = 12, selection = "AIC")
      # model selection
      ARDL_package_models$top_orders
      # best model
      best_ARDL <- ARDL_package_models$best_model

      # best_ARDL <- ardl(one_to_three_year ~ i  nethawkish , data = time_series_data, order = c(1,1,1))

      # output statistics
      summary(best_ARDL)

      ## UNRESTRICTED ARDL MODELL
      uecm <- uecm(best_ARDL, case = 3)
      summary(uecm)

      ## RESTRICTED ARDL  MODELL
      recm<- recm(best_ARDL, case = 3)
      summary(recm)

          #####################################
          # TABLE 5 --- COLUMN 4/9
          #####################################

      # Bounds tests - F-stat
      # 1%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.01)
      tbounds$tab
      # 5%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.05)
      tbounds$tab
      # 10%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.1)
      tbounds$tab

      ################################################################################
      #
      summary(uecm)

      # seed
      set.seed(020990)
      dynamac_model <- dynardl(one_to_three_year ~ i  nethawkish, data = time_series_data,
                               lags = list("one_to_three_year" = 1, "nethawkish" = 1, "i" = 1),
                               diffs = c("nethawkish", "i"),
                               lagdiffs = list("one_to_three_year" = c(1:3), "nethawkish" = c(1:3), "i" = c(1:4)),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "i", range = 20, sims = 10000)
      summary(dynamac_model)

      #
      dynardl.auto.correlated(dynamac_model)

      # QQ plot
      qqPlot(dynamac_model$model$residuals, ylab="Model residuals")

      # shock simulation
      # with 95/90/75 ci
      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5)

      # central values
      dynamac_model$simulation$central

################################################################################
# TABLE 4 --- MODEL 5 --- 1to3_year NETHAWKISH  i 1-89
################################################################################
      # Els� id�szak
      time_series_data <- time_series_data[1:89, ]

      #
      ## ARDL cointegration
      ### Order selection
      ARDL_package_models <- auto_ardl(one_to_three_year ~ i  nethawkish,
                                       data = time_series_data, max_order = 12, selection = "AIC")
      # model selection
      ARDL_package_models$top_orders

      # best model
      best_ARDL <- ARDL_package_models$best_model

      # output statistics
      summary(best_ARDL)

      ## UNRESTRICTED ARDL MODELL
      uecm <- uecm(best_ARDL, case = 3)
      summary(uecm)

      ## RESTRICTED ARDL  MODELL
      recm<- recm(best_ARDL, case = 3)
      summary(recm)

            #####################################
            # TABLE 5 --- COLUMN 5/9
            #####################################

      # Bounds tests - F-stat
      # 1%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.01)
      tbounds$tab
      # 5%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.05)
      tbounds$tab
      # 10%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.1)
      tbounds$tab

      ################################################################################
      #
      summary(uecm)

      ## Interest rate shock responses
      # seed
      set.seed(020990)
      ## Interest rate shock responses
      # one_to_three_year 1-89
      dynamac_model <- dynardl(one_to_three_year ~ i  nethawkish, data = time_series_data,
                               lags = list("one_to_three_year" = 1, "nethawkish" = 1, "i" = 1),
                               diffs = c("nethawkish", "i"),
                               lagdiffs = list("one_to_three_year" = c(1:2), "nethawkish" = c(1), "i" = c(1)),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "i", range = 20, sims = 10000)
      summary(dynamac_model)

      #
      dynardl.auto.correlated(dynamac_model)

      # QQ plot
      qqPlot(dynamac_model$model$residuals, ylab="Model residuals")

      # shock simulation
      # with 95/90/75 ci
      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5,
                              xlab = "Periods", ylab = "Long_term yield values")

      # central values
      dynamac_model$simulation$central

      ## Nethawkish shock responses
      dynamac_model <- dynardl(long_term ~ i  nethawkish, data = time_series_data,
                               lags = list("long_term" = 1, "i" = 1, "nethawkish" = 1),
                               diffs = c("i", "nethawkish"),
                               # lagdiffs = list("i" = c(1:2)),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "nethawkish", range = 30, sims = 10000)

      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5,
                              xlab = "Periods", ylab = "Long_term yield values")

      # central values
      dynamac_model$simulation$central

################################################################################
# TABLE 4 --- MODEL 6 --- 1to3_year NETHAWKISH  i 90-168
################################################################################

      time_series_data <- read.csv("data/dataset_complete_v2.csv")
      time_series_data <- time_series_data[, c("date", "log_intra_year", "log_long_term", "log_1to3year",
                                               "i", "nethawkish", "log_nethawkish")]
      time_series_data <- time_series_data %>%
        mutate(intra_year = exp(log_intra_year),
               long_term = exp(log_long_term),
               one_to_three_year = exp(log_1to3year))

      # outliers
      series_to_adjust <- time_series_data$nethawkish
      out <- tso(as.ts(series_to_adjust), types = "AO") # AO - additive outlier

      h_adj <- out$yadj

      # ts.plot(cbind(series_to_adjust, h_adj), col = c("blue", "red"))

      time_series_data$nethawkish <- h_adj

      # M�sodik id�szak
      time_series_data <- time_series_data[90:168, ]

      #
      ## ARDL cointegration
      ### Order selection
      ARDL_package_models <- auto_ardl(one_to_three_year ~ i  nethawkish,
                                       data = time_series_data, max_order = 12, selection = "AIC")
      # model selection
      ARDL_package_models$top_orders

      # best model
      best_ARDL <- ardl(one_to_three_year ~ i  nethawkish , data = time_series_data, order = c(1,1,1))

      # output statistics
      summary(best_ARDL)

      ## UNRESTRICTED ARDL MODELL
      uecm <- uecm(best_ARDL, case = 3)
      summary(uecm)

      ## RESTRICTED ARDL  MODELL
      recm<- recm(best_ARDL, case = 3)
      summary(recm)

          #####################################
          # TABLE 5 --- COLUMN 6/9
          #####################################

      # Bounds tests - F-stat
      # 1%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.01)
      tbounds$tab
      # 5%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.05)
      tbounds$tab
      # 10%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.1)
      tbounds$tab

      ################################################################################
      #
      summary(uecm)

      ## Interest rate shock responses
      # seed
      set.seed(020990)
      ## Interest rate shock responses
      # one_to_three_year 1-89
      dynamac_model <- dynardl(one_to_three_year ~ i  nethawkish, data = time_series_data,
                               lags = list("one_to_three_year" = 1, "nethawkish" = 1, "i" = 1),
                               diffs = c("nethawkish", "i"),
                               #lagdiffs = list("one_to_three_year" = c(1:2), "nethawkish" = c(1), "i" = c(1)),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "i", range = 40, sims = 10000)
      summary(dynamac_model)

      #
      dynardl.auto.correlated(dynamac_model)

      ##################################
      # FIG 5 --- QQ plot --- 1 TO 3 YEAR
      ##################################
      qqPlot(dynamac_model$model$residuals, ylab="Model residuals")

      # shock simulation -
      # with 95/90/75 ci
      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5,
                              xlab = "Period", ylab = "1to3year yield values")

      # central values
      dynamac_model$simulation$central

      ## Nethawkish shock responses
      dynamac_model <- dynardl(long_term ~ i  nethawkish, data = time_series_data,
                               lags = list("long_term" = 1, "i" = 1, "nethawkish" = 1),
                               diffs = c("i", "nethawkish"),
                               # lagdiffs = list("i" = c(1:2)),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "nethawkish", range = 30, sims = 10000)

      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5,
                              xlab = "Period", ylab = "1to3year yield values")

      # central values
      dynamac_model$simulation$central

################################################################################
# TABLE 4 --- MODEL 7 --- INTRA_YEAR nethawkish  i, full time time series
################################################################################

      time_series_data <- read.csv("data/dataset_complete_v2.csv")
      time_series_data <- time_series_data[, c("date", "log_intra_year", "log_long_term", "log_1to3year",
                                               "i", "nethawkish", "log_nethawkish")]
      time_series_data <- time_series_data %>%
        mutate(intra_year = exp(log_intra_year),
               long_term = exp(log_long_term),
               one_to_three_year = exp(log_1to3year))

      # outliers
      series_to_adjust <- time_series_data$nethawkish
      out <- tso(as.ts(series_to_adjust), types = "AO") # AO - additive outlier

      h_adj <- out$yadj

      # ts.plot(cbind(series_to_adjust, h_adj), col = c("blue", "red"))

      time_series_data$nethawkish <- h_adj

      #
      ## ARDL cointegration
      ### Order selection
      ARDL_package_models <- auto_ardl(intra_year ~ i  nethawkish,
                                       data = time_series_data, max_order = 12, selection = "AIC")
      # model selection
      ARDL_package_models$top_orders
      # best model
      best_ARDL <- ARDL_package_models$best_model

      # best_ARDL <- ardl(long_term ~ i  nethawkish , data = time_series_data, order = c(1,1,1))

      # output statistics
      summary(best_ARDL)

      ## UNRESTRICTED ARDL MODELL
      uecm <- uecm(best_ARDL, case = 3)
      summary(uecm)

      ## RESTRICTED ARDL  MODELL
      recm<- recm(best_ARDL, case = 3)
      summary(recm)

          #####################################
          # TABLE 5 --- COLUMN 7/9
          #####################################

      # Bounds tests - F-stat
      # 1%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.01)
      tbounds$tab
      # 5%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.05)
      tbounds$tab
      # 10%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.1)
      tbounds$tab

      ################################################################################
      #
      summary(uecm)

      # seed
      set.seed(020990)
      dynamac_model <- dynardl(intra_year ~ i  nethawkish, data = time_series_data,
                               lags = list("intra_year" = 1, "i" = 1, "nethawkish" = 1),
                               diffs = c( "i", "nethawkish"),
                               lagdiffs = list("i" = c(1:4), "nethawkish" = c(1:2), "intra_year" = c(1)),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "i", range = 20, sims = 10000)
      summary(dynamac_model)

      #
      dynardl.auto.correlated(dynamac_model)

      # QQ plot
      qqPlot(dynamac_model$model$residuals, ylab="Model residuals")

      # shock simulation
      # with 95/90/75 ci
      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5)

      # central values
      dynamac_model$simulation$central

################################################################################
# TABLE 4 --- MODEL 8 --- INTRA_YEAR NETHAWKISH  i 1-89
################################################################################
      # Els� id�szak
      time_series_data <- time_series_data[1:89, ]

      #
      ## ARDL cointegration
      ### Order selection
      ARDL_package_models <- auto_ardl(intra_year ~ i  nethawkish,
                                       data = time_series_data, max_order = 12, selection = "AIC")
      # model selection
      ARDL_package_models$top_orders
      # best model
      best_ARDL <- ARDL_package_models$best_model

      # best_ARDL <- ardl(long_term ~ i  nethawkish , data = time_series_data, order = c(1,1,1))

      # output statistics
      summary(best_ARDL)

      ## UNRESTRICTED ARDL MODELL
      uecm <- uecm(best_ARDL, case = 3)
      summary(uecm)

      ## RESTRICTED ARDL  MODELL
      recm<- recm(best_ARDL, case = 3)
      summary(recm)

          #####################################
          # TABLE 5 --- COLUMN 8/9
          #####################################

      # Bounds tests - F-stat
      # 1%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.01)
      tbounds$tab
      # 5%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.05)
      tbounds$tab
      # 10%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.1)
      tbounds$tab

      ################################################################################
      #
      summary(uecm)

      # seed
      set.seed(020990)
      dynamac_model <- dynardl(intra_year ~ i  nethawkish, data = time_series_data,
                               lags = list("intra_year" = 1, "i" = 1, "nethawkish" = 1),
                               diffs = c( "i", "nethawkish"),
                               lagdiffs = list("nethawkish" = c(1), "intra_year" = c(1:2)),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "i", range = 20, sims = 10000)
      summary(dynamac_model)

      #
      dynardl.auto.correlated(dynamac_model)

      # QQ plot
      qqPlot(dynamac_model$model$residuals, ylab="Model residuals")

      # shock simulation
      # with 95/90/75 ci
      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5)

      # central values
      dynamac_model$simulation$central

################################################################################
# TABLE 4 --- MODEL 9 --- INTRA_YEAR NETHAWKISH  i 90-168
################################################################################

      time_series_data <- read.csv("data/dataset_complete_v2.csv")
      time_series_data <- time_series_data[, c("date", "log_intra_year", "log_long_term", "log_1to3year",
                                               "i", "nethawkish", "log_nethawkish")]
      time_series_data <- time_series_data %>%
        mutate(intra_year = exp(log_intra_year),
               long_term = exp(log_long_term),
               one_to_three_year = exp(log_1to3year))

      # outliers
      series_to_adjust <- time_series_data$nethawkish
      out <- tso(as.ts(series_to_adjust), types = "AO") # AO - additive outlier

      h_adj <- out$yadj

      # ts.plot(cbind(series_to_adjust, h_adj), col = c("blue", "red"))

      time_series_data$nethawkish <- h_adj

      # Els� id�szak
      time_series_data <- time_series_data[90:168, ]

      #
      ## ARDL cointegration
      ### Order selection
      ARDL_package_models <- auto_ardl(intra_year ~ i  nethawkish,
                                       data = time_series_data, max_order = 12, selection = "AIC")
      # model selection
      ARDL_package_models$top_orders

      best_ARDL <- ardl(intra_year ~ i  nethawkish , data = time_series_data, order = c(1,1,1))

      # output statistics
      summary(best_ARDL)

      ## UNRESTRICTED ARDL MODELL
      uecm <- uecm(best_ARDL, case = 3)
      summary(uecm)

      ## RESTRICTED ARDL  MODELL
      recm<- recm(best_ARDL, case = 3)
      summary(recm)

            #####################################
            # TABLE 5 --- COLUMN 9/9
            #####################################

      # Bounds tests - F-stat
      # 1%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.01)
      tbounds$tab
      # 5%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.05)
      tbounds$tab
      # 10%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.1)
      tbounds$tab

      ################################################################################
      #
      summary(uecm)

      # seed
      set.seed(020990)
      dynamac_model <- dynardl(intra_year ~ i  nethawkish, data = time_series_data,
                               lags = list("intra_year" = 1, "i" = 1, "nethawkish" = 1),
                               diffs = c( "i", "nethawkish"),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "i", range = 30, sims = 10000)
      summary(dynamac_model)

      #
      dynardl.auto.correlated(dynamac_model)

      ##################################
      # FIG 4 --- QQ plot --- INTRA YEAR
      ##################################
      qqPlot(dynamac_model$model$residuals, ylab="Model residuals")

      #############################
      # FIG 3 --- I SHOCK
      #############################

      # shock simulation -
      # with 95/90/75 ci
      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5,
                              ylab = "Intra_year yield values", xlab = "Period")

      # central values
      dynamac_model$simulation$central

      # shock simulation - nethawhisk-ra
      dynamac_model <- dynardl(intra_year ~ i  nethawkish, data = time_series_data,
                               lags = list("intra_year" = 1, "i" = 1, "nethawkish" = 1),
                               diffs = c( "i", "nethawkish"),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "nethawkish", range = 30, sims = 10000)

      #############################
      # FIG 3 --- NETHAWKISH SHOCK
      #############################

      # with 95/90/75 ci
      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5,
                              ylab = "Intra_year yield values", xlab = "Period")

      # central values
      dynamac_model$simulation$central

################################################################################
# APPENDIX A --- TABLE 6 --- JOHANSEN TESTS
################################################################################

      time_series_data <- read.csv("data/dataset_complete_v2.csv")
      time_series_data <- time_series_data[, c("date", "log_intra_year", "log_long_term", "log_1to3year",
                                               "i", "nethawkish", "log_nethawkish")]
      time_series_data <- time_series_data %>%
        mutate(intra_year = exp(log_intra_year),
               long_term = exp(log_long_term),
               one_to_three_year = exp(log_1to3year))

      # outliers
      series_to_adjust <- time_series_data$nethawkish
      out <- tso(as.ts(series_to_adjust), types = "AO") # AO - additive outlier

      h_adj <- out$yadj

      # ts.plot(cbind(series_to_adjust, h_adj), col = c("blue", "red"))

      time_series_data$nethawkish <- h_adj

      time_series_data <- time_series_data[90:168, ]

# Johansen tests

      jotest <- ca.jo(time_series_data[, c("long_term", "i", "nethawkish")], type="trace",
                      K=2, ecdet="none", spec="longrun")
      summary(jotest)

      # Long term  i
      jotest <- ca.jo(time_series_data[, c("long_term", "i")], type="trace",
                      K=2, ecdet="none", spec="longrun")
      summary(jotest)

      # Long term  nethawkish
      jotest <- ca.jo(time_series_data[, c("long_term", "nethawkish")], type="trace",
                      K=2, ecdet="none", spec="longrun")
      summary(jotest)

      ###

      jotest <- ca.jo(time_series_data[, c("one_to_three_year", "i", "nethawkish")], type="trace",
                      K=2, ecdet="none", spec="longrun")
      summary(jotest)

      # one_to_three_year  i
      jotest <- ca.jo(time_series_data[, c("one_to_three_year", "i")], type="trace",
                      K=2, ecdet="none", spec="longrun")
      summary(jotest)

      # one_to_three_year  nethawkish
      jotest <- ca.jo(time_series_data[, c("one_to_three_year", "nethawkish")], type="trace",
                      K=2, ecdet="none", spec="longrun")
      summary(jotest)

      ###

      jotest <- ca.jo(time_series_data[, c("intra_year", "i", "nethawkish")], type="trace",
                      K=2, ecdet="none", spec="longrun")
      summary(jotest)

      # intra_year  i
      jotest <- ca.jo(time_series_data[, c("intra_year", "i")], type="trace",
                      K=2, ecdet="none", spec="longrun")
      summary(jotest)

      # intra_year  nethawkish
      jotest <- ca.jo(time_series_data[, c("intra_year", "nethawkish")], type="trace",
                      K=2, ecdet="none", spec="longrun")
      summary(jotest)

################################################################################
# APPENDIX B --- TABLE 7 --- ROBUSTNESS
################################################################################

      ################################################################################

      time_series_data <- read.csv("data/dataset_complete_v2.csv")
      time_series_data <- time_series_data[, c("date", "log_intra_year", "log_long_term", "log_1to3year",
                                               "i", "lm_baseline", "net_hawk_agh")]
      time_series_data <- time_series_data %>%
        mutate(intra_year = exp(log_intra_year),
               long_term = exp(log_long_term),
               one_to_three_year = exp(log_1to3year))

      # outliers
      series_to_adjust <- time_series_data$lm_baseline
      out <- tso(as.ts(series_to_adjust), types = "AO") # AO - additive outlier

      h_adj <- out$yadj

      ts.plot(cbind(series_to_adjust, h_adj), col = c("blue", "red"))

      time_series_data$lm_baseline <- h_adj

      # outliers
      series_to_adjust <- time_series_data$net_hawk_agh
      out <- tso(as.ts(series_to_adjust), types = "AO") # AO - additive outlier

      h_adj <- out$yadj

      ts.plot(cbind(series_to_adjust, h_adj), col = c("blue", "red"))

      time_series_data$net_hawk_agh <- h_adj

      time_series_data <- time_series_data[90:168, ]

      ################################################################################
      # ADF  PP tests - lm_baseline
      time_series <- time_series_data$lm_baseline
      # plot(time_series, type = "l")
      ## ADF
      ### Level
      summary(ur.df(time_series, type = c("trend"), lags=12, selectlags = "AIC"))

      ### Difference
      summary(ur.df(diff(time_series), type = c("trend"), lags=12, selectlags = "AIC"))

      ## Phillips - Perron teszt
      ### Level
      summary(ur.pp(time_series, type = c("Z-tau"), model = c("trend")))

      ### Difference
      summary(ur.pp(diff(time_series), type = c("Z-tau"), model = c("trend")))

      # ADF + PP tests - net_hawk_agh
      time_series <- time_series_data$net_hawk_agh
      # plot(time_series, type = "l")
      ## ADF
      ### Level
      summary(ur.df(time_series, type = c("trend"), lags=12, selectlags = "AIC"))

      ### Difference
      summary(ur.df(diff(time_series), type = c("trend"), lags=12, selectlags = "AIC"))

      ## Phillips - Perron teszt
      ### Level
      summary(ur.pp(time_series, type = c("Z-tau"), model = c("trend")))

      ### Difference
      summary(ur.pp(diff(time_series), type = c("Z-tau"), model = c("trend")))

      ################################################################################
      ################################################################################
      ################################################################################

      ## ARDL cointegration
      ### Order selection
      ARDL_package_models <- auto_ardl(intra_year ~ i  lm_baseline,
                                       data = time_series_data, max_order = 12, selection = "AIC")
      # model selection
      ARDL_package_models$top_orders

      best_ARDL <- ardl(intra_year ~ i  lm_baseline , data = time_series_data, order = c(1,1,1))

      # output statistics
      summary(best_ARDL)

      ## UNRESTRICTED ARDL MODELL
      uecm <- uecm(best_ARDL, case = 3)
      summary(uecm)

      ## RESTRICTED ARDL  MODELL
      recm<- recm(best_ARDL, case = 3)
      summary(recm)

      # Bounds tests - F-stat
      # 1%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.01)
      tbounds$tab
      # 5%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.05)
      tbounds$tab
      # 10%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.1)
      tbounds$tab

      ################################################################################
      #
      summary(uecm)

      # seed
      set.seed(020990)
      dynamac_model <- dynardl(intra_year ~ i  lm_baseline, data = time_series_data,
                               lags = list("intra_year" = 1, "i" = 1, "lm_baseline" = 1),
                               diffs = c( "i", "lm_baseline"),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "i", range = 30, sims = 10000)
      summary(dynamac_model)

      #
      dynardl.auto.correlated(dynamac_model)

      # QQ plot
      qqPlot(dynamac_model$model$residuals, ylab="Model residuals")

      # shock simulation -
      # with 95/90/75 ci
      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5,
                              ylab = "Intra_year yield values", xlab = "Period")

      # central values
      dynamac_model$simulation$central

      # shock simulation - nethawhisk-ra
      dynamac_model <- dynardl(intra_year ~ i  lm_baseline, data = time_series_data,
                               lags = list("intra_year" = 1, "i" = 1, "lm_baseline" = 1),
                               diffs = c( "i", "lm_baseline"),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "lm_baseline", range = 30, sims = 10000)

      # with 95/90/75 ci
      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5,
                              ylab = "Intra_year yield values", xlab = "Period")

      # central values
      dynamac_model$simulation$central

      ################################################################################
      ################################################################################
      ################################################################################
      # Modellez�s az "ARDL package" alapj�n - net_hawk_agh �s i is van benne
      ## ARDL cointegration
      ### Order selection
      ARDL_package_models <- auto_ardl(intra_year ~ i  net_hawk_agh,
                                       data = time_series_data, max_order = 12, selection = "AIC")
      # model selection
      ARDL_package_models$top_orders

      best_ARDL <- ardl(intra_year ~ i  net_hawk_agh , data = time_series_data, order = c(1,1,1))

      # output statistics
      summary(best_ARDL)

      ## UNRESTRICTED ARDL MODELL
      uecm <- uecm(best_ARDL, case = 3)
      summary(uecm)

      ## RESTRICTED ARDL  MODELL
      recm<- recm(best_ARDL, case = 3)
      summary(recm)

      # Bounds tests - F-stat
      # 1%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.01)
      tbounds$tab
      # 5%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.05)
      tbounds$tab
      # 10%
      tbounds <- bounds_f_test(uecm, case = 3, alpha = 0.1)
      tbounds$tab

      ################################################################################
      #
      summary(uecm)

      # seed
      set.seed(020990)
      dynamac_model <- dynardl(intra_year ~ i  net_hawk_agh, data = time_series_data,
                               lags = list("intra_year" = 1, "i" = 1, "net_hawk_agh" = 1),
                               diffs = c( "i", "net_hawk_agh"),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "i", range = 30, sims = 10000)
      summary(dynamac_model)

      #
      dynardl.auto.correlated(dynamac_model)

      # QQ plot
      qqPlot(dynamac_model$model$residuals, ylab="Model residuals")

      # shock simulation -
      # with 95/90/75 ci
      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5,
                              ylab = "Intra_year yield values", xlab = "Period")

      # central values
      dynamac_model$simulation$central

      # shock simulation - nethawhisk-ra
      dynamac_model <- dynardl(intra_year ~ i  net_hawk_agh, data = time_series_data,
                               lags = list("intra_year" = 1, "i" = 1, "net_hawk_agh" = 1),
                               diffs = c( "i", "net_hawk_agh"),
                               ec = TRUE, simulate = TRUE,
                               shockvar = "net_hawk_agh", range = 30, sims = 10000)

      # with 95/90/75 ci
      dynardl.simulation.plot(dynamac_model, type = "area", response = "levels", bw = TRUE, start.period = 5,
                              ylab = "Intra_year yield values", xlab = "Period")

      # central values
      dynamac_model$simulation$central


# Temperature change vs. depth in the trawl data

require(data.table)

load("data_dl/trawl/master_hauls_March7_2017.RData") # loads hauls
hauls <- data.table(hauls)

hauls[, log10depth := log10(depth)]

hauls[,plot(surftemp_orig, surftemp)] # 1:1

hauls[, dT := surftemp - bottemp]

hauls[,plot(depth, dT, cex=0.5, col=rgb(0,0,0,0.01))]
abline(h=0, col='red')

hauls[,hist(dT)]

# divide by region
quartz(width=7, height=5.5)
par(mfrow=c(3,4), mai=c(0.4, 0.4, 0.1, 0.05), mgp=c(2,1,0), las=1)
for(reg in hauls[,sort(unique(region))]){
	hauls[region==reg, scatter.smooth(depth, dT, cex=0.5, col=rgb(0,0,0,0.05), main=reg, lpars=list(col='red'))]
	abline(h=0, col='red', lty=2)
}

# a model
require(mgcv)
mod <- gam(dT ~ s(depth) + s(month) + s(surftemp), data=hauls)
	summary(mod)
	plot(mod, pages=1)

mod2 <- gam(dT ~ s(log10depth,surftemp), data=hauls)
	summary(mod2)
	plot(mod2, pages=1)

	vis.gam(mod2, view=c('log10depth', 'surftemp'), type='response', plot.type='contour', zlim=c(-10,18), levels=c(-10, 0, 5, 10))

mod3 <- gam(dT ~ s(log10depth,surftemp) + s(month), data=hauls)
	summary(mod3)
	plot(mod3, pages=1, scheme=2) # suggests 5 °C cooler is 100-300m deeper

	par(mfrow=c(2,3), mai=c(0.4,0.4,0.1,0.05), mgp=c(2,1,0), las=1)
	for(i in c(1,3,5,7,9,11)){
		vis.gam(mod3, view=c('log10depth', 'surftemp'), cond=list(month=i), type='response', plot.type='contour', zlim=c(-10,18), levels=c(-10, 0, 5, 10), main=paste('month', i))
	}

mod4 <- gam(dT ~ s(log10depth,surftemp,month), data=hauls)
	summary(mod4)

	par(mfrow=c(2,3), mai=c(0.4,0.4,0.1,0.05), mgp=c(2,1,0), las=1)
	for(i in c(1,3,5,7,9,11)){
		vis.gam(mod4, view=c('log10depth', 'surftemp'), cond=list(month=i), type='response', plot.type='contour', zlim=c(-10,18), levels=c(-10, 0, 5, 10), main=paste('month', i))
	}


# These have been taken from the EnvStats library (https://cran.r-project.org/web/packages/EnvStats/index.html)

#' @export
#' @keywords internal
#' @importFrom stats pgamma
pgammaAlt = function (q, mean, cv = 1, lower.tail = TRUE, log.p = FALSE)
{
    shape <- cv^-2
    scale <- mean/shape
    stats::pgamma(q = q, shape = shape, scale = scale, lower.tail = lower.tail,
        log.p = log.p)
}

#' @export
#' @keywords internal
#' @importFrom stats dgamma
dgammaAlt = function (x, mean, cv = 1, log = FALSE)
{
    shape <- cv^-2
    scale <- mean/shape
    stats::dgamma(x = x, shape = shape, scale = scale, log = log)
}

#' @export
#' @keywords internal
#' @importFrom stats rgamma
rgammaAlt = function (n, mean, cv = 1)
{
    shape <- cv^-2
    scale <- mean/shape
    stats::rgamma(n = n, shape = shape, scale = scale)
}


source("./utils.r")
comm.set.seed(1234, diff=FALSE)
if (storage == "float")
  comm.stop("float not supported for svm")

generator = function(m, n, means=c(0, 2))
{
  response = c(-1L, 1L)

  x = matrix(0.0, m, n+1)
  y = integer(m)

  for (i in 1:m)
  {
    group = sample(2, size=1)
    x[i, ] = c(1, rnorm(n, mean=means[group]))
    y[i] = response[group]
  }

  list(x=x, y=y)
}

data = generator(m.local, n)
m = allreduce(m.local)
x = shaq(data$x, nrows=m, ncols=n+1)
y = shaq(data$y, nrows=m, ncols=1)

time = comm.timer(svm(x, y, maxiter=500))
comm.print(time)

finalize()


G02AKJ Example Program Results

 NCM with rank constraint
          1       2       3       4
 1   1.0000 -0.9021  0.2448  0.1975
 2  -0.9021  1.0000 -0.6392  0.2448
 3   0.2448 -0.6392  1.0000 -0.9021
 4   0.1975  0.2448 -0.9021  1.0000

Number of subproblems solved:            4

Squared Frobenius norm of difference:    0.3082

Rank error:                              0.0000


# 4. faza: Analiza podatkov

library(GGally)
library(mgcv)
#podatki <- obcine %>% transmute(obcina, povrsina, gostota,
#                                gostota.naselij=naselja/povrsina) %>%
#  left_join(povprecja, by="obcina")
#row.names(podatki) <- podatki$obcina
#podatki$obcina <- NULL

# Število skupin
#n <- 5
#skupine <- hclust(dist(scale(podatki))) %>% cutree(n)

#napoved za naprej letalski promet v odvisnosti od železniškega (uvoz, blago)
lbuvoz <- letalski_blagovni_promet %>% filter( tovor == 'uvoz') %>% rename(letalski = tone)
zbuvoz <- zelezniski_blagovni_promet %>% filter( tovor == 'uvoz') %>% rename(zelezniski = tone)
e <- inner_join(lbuvoz, zbuvoz)[, -c(2)]

g <- ggplot(e, aes(x=letalski, y= zelezniski))+ xlim(500, 1100) + geom_point() +
  geom_smooth(method="loess", se= FALSE,
              fullrange= TRUE, color = 'red') +
  geom_smooth(method = 'lm', formula = y ~ x +I(x^2),
               se = FALSE, fullrange=TRUE, color= 'green')+
  ggtitle('Uvoz blaga letalskega prometa v odvisnosti od železniškega')+
  ylab('železniški')

#napoved za naprej letalski promet v odvisnosti od zeležniškega (uvoz, ljudi)
lpuvoz <- letalski_potniski_promet %>% filter( tovor == 'uvoz') %>% rename(letalski = potniki)
zpuvoz <- zelezniski_potniski_promet %>% filter( tovor == 'uvoz') %>% rename(zelezniski = potniki)
e2 <- inner_join(lpuvoz, zpuvoz)[, -c(2)]

g2 <- ggplot(e2, aes(x=letalski, y= zelezniski))+ xlim(3000, 9000) + geom_point() +
  geom_smooth(method="loess", se= FALSE,
              fullrange= TRUE, color = 'red') +
  geom_smooth(method = 'lm', formula = y ~ x +I(x^2),
              se = FALSE, fullrange=TRUE, color= 'blue')+
  ggtitle('Uvoz potnikov letalskega prometa v odvisnosti od železniškega')+
  ylab('železniški')

#napoved kako se bo spreminjal cestni blagovni promet uvoz

cestni_blagovni_promet$tone <- cestni_blagovni_promet$tone / 1000
cuvoz <- cestni_blagovni_promet %>%  filter(tovor == 'uvoz') %>% rename(cestni = tone)
prilagajanje <- lm(data = cuvoz, cestni~I(leto^2) +leto + 0)
gg <- data.frame(leto = seq(2010, 2020, 1))
napoved <- mutate(gg, cestni=predict(prilagajanje, gg))

graf_regresije_uvoz <- ggplot(cuvoz, aes(x=leto, y=cestni))+
  geom_point() + geom_smooth(method = lm, formula =y~ x + I(x^2), fullrange = TRUE, color = 'blue')+
  geom_point(data = napoved, aes(x= leto, y=cestni), color='red', size = 2) +
  scale_x_continuous(breaks=seq(2010, 2020, 2)) +
  ggtitle('Napoved rasti uvoza cestnega blagovnega prometa v Sloveniji')+
  ylab('cestni promet v tonah (1000)')

#napoved kako se spreminja cestni blagovni promet izvoz

cizvoz <- cestni_blagovni_promet %>%  filter(tovor == 'izvoz') %>% rename(cestni = tone)
prilagajanje2 <- lm(data = cizvoz, cestni~I(leto^2) +leto + 0)
gg2 <- data.frame(leto = seq(2010, 2020, 1))
napoved2 <- mutate(gg2, cestni=predict(prilagajanje2, gg2))

graf_regresije_izvoz <- ggplot(cizvoz, aes(x=leto, y=cestni))+
  geom_point() + geom_smooth(method = lm, formula =y~ x + I(x^2), fullrange = TRUE, color = 'green')+
  geom_point(data = napoved2, aes(x= leto, y=cestni), color='red', size = 2) +
  scale_x_continuous(breaks=seq(2010, 2020, 2))+
  ggtitle('Napoved rasti izvoza cestnega blagovnega prometa v Sloveniji')+
  ylab('cestni promet v tonah (1000)')


#autor:      Joao Sollari Lopes
#local:      INE, Lisboa
#Rversion:   3.6.1
#criado:     02.07.2017
#modificado: 09.12.2019

library("class")

trainset <- read.csv("../data/golf.csv",header=TRUE)
testset <- read.csv("../data/golf-testset.csv",header=TRUE)

#Test model
res <- knn(trainset[,c("Temperature","Humidity")], #attributes of training set
           testset[,c("Temperature","Humidity")],  #testing set
           trainset[,"Play"],                      #classes of trainset
           k=3,                                    #k-nearest neighbour
           prob=TRUE)                              #proportion of winning class

#Confusion Matrix
conf_mat <- table(testset[,"Play"],res)
conf_mat

#Error rate
err_rt <- 100*(sum(conf_mat) - sum(diag(conf_mat)))/sum(conf_mat)
err_rt


<!--
Next, a subset of people 25 or younger who smoked in the last 12 months is
created using the `subset` function.
Note that `SmokingStatus == 1` is used to see if subject has smoked in the past 12
months.

Notice, the missing values have been removed (since `NA`s are not less than or
equal to numbers).

```{R}
# the subset command below will not include a row that evalutes to NA for the
# specified subset.  For example:
(NA == 1)
# age and smoking subset
nesarc.sub <- subset(nesarc.sub
                    , subset = (Age <= 25)     # people 25 or younger
                             & (SmokingStatus == 1) # smoked in the past 12 months
                    )
dim(nesarc.sub)
summary(nesarc.sub)
```
-->

### Coding missing values

Recall that many variables are coded in the codebook.

From the codebook, these are the variables and the codes for the missing or `unknown` values.

```
CHECK321 (SmokingStatus)
     22 9. Unknown
S3AQ3B1 (SmokingFreq)
    102 9. Unknown
S3AQ3C1 (DailyCigsSmoked)
    262 99. Unknown
```

Replace the coded missing values with `NA`,
  then remove the remaining records with missing values.
Not all of these variables need this operation, since the previous subset commands
  removed missing values by chance.
However, I'm going to run each as an extra precaution.
Afterall, later, if we were to make different previous data decisions,
  it's possible we could end up with missing values at this point that
  are incorrectly coded without this step!

```{R}
# Note for this first variable, there are still three factor levels
str(nesarc.sub$SmokingStatus)
#   even though only the first category has observations.
summary(nesarc.sub$SmokingStatus)

# First, replace any values that are "9" with NA
nesarc.sub$SmokingStatus[nesarc.sub$SmokingStatus == 9] <- NA
summary(nesarc.sub$SmokingStatus)
# Then drop unused factor categories.
nesarc.sub$SmokingStatus <- factor(nesarc.sub$SmokingStatus)[, drop = TRUE]
summary(nesarc.sub$SmokingStatus)

# Repeat this for the other two variables, using summary() to see effect:
summary(nesarc.sub$SmokingFreq)
nesarc.sub$SmokingFreq[nesarc.sub$SmokingFreq == 9] <- NA
summary(nesarc.sub$SmokingFreq)
nesarc.sub$SmokingFreq <- factor(nesarc.sub$SmokingFreq)[, drop = TRUE]
summary(nesarc.sub$SmokingFreq)

# numeric variable, no levels to drop
nesarc.sub$DailyCigsSmoked[nesarc.sub$DailyCigsSmoked == 99] <- NA

summary(nesarc.sub)
```

Finally, use `na.omit()` to remove any records with missing values.
```{R}
dim(nesarc.sub)
# remove rows with missing values
nesarc.sub <- na.omit(nesarc.sub)
dim(nesarc.sub)
summary(nesarc.sub)
```

Now we have a dataset with no missing values.

## Creating new variables

Additional variables that we created from the original variables are listed in
  this ammendment to the original codebook.

```
CREATED VARIABLES

DaySmoke
  estimated number of days per month a subject smokes
  Continuous (due to way estimated), assumes 30 days per month using SmokingFreq)
        1-30.

TotalCigsSmoked
  estimated number of cigarettes per month a subject smokes (DaysSmoke * DailyCigsSmoked)
  Continuous
        0-large.

CigsSmokedFac
  quartiles of TotalCigsSmoked
  Ordinal
        ranges for each of the four quarters
```

`DaysSmoke` estimates the days per month a subject smokes
  by converting `SmokingFreq` (a factor with 6 levels) to a numeric variable using `as.numeric()`
  and multiplying by the midpoint of the range of `SmokingFreq`.

```{R}
nesarc.sub$DaysSmoke <- as.numeric(nesarc.sub$SmokingFreq)
nesarc.sub$DaysSmoke[nesarc.sub$DaysSmoke == 1] <- 30    # 1. Every day
nesarc.sub$DaysSmoke[nesarc.sub$DaysSmoke == 2] <- 4*5.5 # 2. 5 to 6 Day(s) a week
nesarc.sub$DaysSmoke[nesarc.sub$DaysSmoke == 3] <- 4*3.5 # 3. 3 to 4 Day(s) a week
nesarc.sub$DaysSmoke[nesarc.sub$DaysSmoke == 4] <- 4*1.5 # 4. 1 to 2 Day(s) a week
nesarc.sub$DaysSmoke[nesarc.sub$DaysSmoke == 5] <- 2.5   # 5. 2 to 3 Day(s) a month
nesarc.sub$DaysSmoke[nesarc.sub$DaysSmoke == 6] <- 1     # 6. Once a month or less
summary(nesarc.sub$DaysSmoke)
```

The variable `TotalCigsSmoked` estimates the monthly number of cigarettes
  a subject smokes per month by multiplying `DaysSmoke` times `DailyCigsSmoked`
  (the usual quantity smoked per day).

```{R}
nesarc.sub$TotalCigsSmoked <- nesarc.sub$DaysSmoke * nesarc.sub$DailyCigsSmoked
```

The numeric variable `TotalCigsSmoked` is converted into a factor
  with four roughly equivalent numbers (quartiles) stored in each level of the
  factor `CigsSmokedFac` using the `cut` function.

```{R}
quantile(nesarc.sub$TotalCigsSmoked, na.rm = TRUE)
nesarc.sub$CigsSmokedFac <- cut(nesarc.sub$TotalCigsSmoked
                              , breaks = quantile(nesarc.sub$TotalCigsSmoked, na.rm = TRUE)
                              , include.lowest = TRUE)

summary(nesarc.sub$CigsSmokedFac)
```

Look at the first 10 observations in the dataset, with special attention to the
new variables.

```{R}
head(nesarc.sub, 10)
```

### Labeling Variables

```{R}
# Informative labels are given to the variables.
library(Hmisc) # for label()
label(nesarc.sub$TobaccoDependence) <- "Tobacco Dependence past 12 Months"
label(nesarc.sub$SmokingStatus)     <- "Smoked Cigarettes in the Past 12 Months"
label(nesarc.sub$SmokingFreq)       <- "Usual Smoking Frequency"
label(nesarc.sub$DailyCigsSmoked)   <- "Usual Smoking Quantity"
```

Look at summary of dataset to see the state of the labelling before we make changes.

```{R}
summary(nesarc.sub)
```

Informative labels are given to the factor levels.
The order of the levels is also rearranged for the variables
  `SmokingFreq`, `TobaccoDependence`, and `Sex`.

```{R}
nesarc.sub$Depression <- factor(nesarc.sub$Depression
                              , labels = c("No Depression"
                                         , "Yes Depression"
                                ))

# first label the existing levels
nesarc.sub$Sex <- factor(nesarc.sub$Sex
                       , labels = c("Male"
                                  , "Female"
                                   )
                        )
# check ordering with a frequency table
table(nesarc.sub$Sex)
# then reorder the levels
nesarc.sub$Sex <- factor(nesarc.sub$Sex
                       , levels = c("Female"
                                  , "Male"
                                   )
                        )
# check ordering with a frequency table
table(nesarc.sub$Sex)

nesarc.sub$SmokingFreq <- factor(nesarc.sub$SmokingFreq
                               , labels = c("Every Day"
                                          , "5 to 6 Days/week"
                                          , "3 to 4 Days/week"
                                          , "1 to 2 Days/week"
                                          , "2 to 3 Days/month"
                                          , "Once a month or less"
                                          )
                                )
nesarc.sub$SmokingFreq <- factor(nesarc.sub$SmokingFreq
                               , levels = c("Once a month or less"
                                          , "2 to 3 Days/month"
                                          , "1 to 2 Days/week"
                                          , "3 to 4 Days/week"
                                          , "5 to 6 Days/week"
                                          , "Every Day"
                                          )
                                )

nesarc.sub$TobaccoDependence <- factor(nesarc.sub$TobaccoDependence
                                     , labels = c("No Nicotine Dependence"
                                                , "Nicotine Dependence"
                                                )
                                      )
nesarc.sub$TobaccoDependence <- factor(nesarc.sub$TobaccoDependence
                                     , levels = c("Nicotine Dependence"
                                                , "No Nicotine Dependence"
                                                 )
                                      )

nesarc.sub$Ethnicity <- factor(nesarc.sub$Ethnicity
                             , labels = c("Caucasian"
                                        , "African American"
                                        , "Native American"
                                        , "Asian"
                                        , "Hispanic"
                                         )
                              )

summary(nesarc.sub)
```

## Thursday --------

## Tables for categorical variables

Basic tables can be created using the functions `table` or `xtabs`.
Frequency tables are created for the variables
  `TobaccoDependence`, `CigsSmokedFac`, and `SmokingFreq`.
When only looking at one variable, `table` is the same as `xtabs`, but
  `xtabs` will make looking at two-way, three-way, and higher tables possible.

```{R}
table(nesarc.sub$TobaccoDependence)
T1 <- xtabs( ~ TobaccoDependence, data = nesarc.sub)
T1
T2 <- xtabs( ~ CigsSmokedFac, data = nesarc.sub)
T2
T3 <- xtabs( ~ SmokingFreq, data = nesarc.sub)
T3
```

(Look at the .Rmd code to see that these numbers in the next paragraph are
  calculated directly from the numbers summarized in the table!)

In the data frame `nesarc.sub`, there are
  `r T1[1]` nicotine dependent subjects and
  `r T1[2]` subjects that are not nicotine dependent.
A small number of smokers
  (`r T2[4]`) smoke over 600 cigarettes per month.
Most of the subjects in `nesarc.sub` are daily smokers
  (`r T3[6]`) with the remainder distributed uniformly across the
  first five levels of `SmokingFreq`.

## Graphing frequency tables

The barplots are all created with the package `ggplot2`.  The barplots start with the defaults for the `geom_bar` and add more detail to the plot with each graph.

```{R}
library(ggplot2)
p1 <- ggplot(data = nesarc.sub, aes(x = TobaccoDependence))
p1 <- p1 + geom_bar()
p1

p2 <- ggplot(data = nesarc.sub, aes(x = CigsSmokedFac))
p2 <- p2 + geom_bar()
p2

p3 <- ggplot(data = na.omit(nesarc.sub), aes(SmokingFreq))
p3 <- p3 + geom_bar()
p3 <- p3 + labs(x = "", y = "Total Number", title = "Smoking Frequency for Young Adults")
p3 <- p3 + theme_bw()
p3 <- p3 + theme(axis.text.x  = element_text(angle = 90, vjust = 0))
p3
```

## Graphing numeric variables

One popular way to graph a continuous variable is to use a histogram.
`R` has the base function `hist` which can be used for this purpose.
We will also use the package `ggplot2` to create histograms.
We start with a basic histogram of the variable `TotalCigsSmoked`.

```{R}
hist(nesarc.sub$TotalCigsSmoked)
```

Experiment with the code in the previous code chunk to change the color, the
title, and if needed the labels on the $x$- and $y$-axes.

```{R}
p <- ggplot(data = nesarc.sub, aes(x = TotalCigsSmoked))
p <- p + geom_histogram(binwidth = 200)
p <- p + geom_rug()
p <- p + labs(x = "Estimated Cigarettes Smoked per Month")
p <- p + theme_bw()
p
```

### Creating Density Plots

```{R}
p <- ggplot(data = nesarc.sub, aes(x = TotalCigsSmoked))
p <- p + geom_histogram(aes(y=..density..), binwidth = 200)
p <- p + geom_rug()
p <- p + geom_density(alpha=0.1, fill="white", adjust = 1.5)
p <- p + labs(x = "Estimated Cigarettes Smoked per Month")
p <- p + theme_bw()
p
```

### Shape, center, and spread

```{R}
summary(nesarc.sub$TotalCigsSmoked)
fivenum(nesarc.sub$TotalCigsSmoked)
median(nesarc.sub$TotalCigsSmoked, na.rm = TRUE)
IQR(nesarc.sub$TotalCigsSmoked, na.rm = TRUE)
```

The `shape` of the distribution for the estimated cigarettes smoked per month
  is skewed to the right.
The `center` (median) of the distribution is
  `r median(nesarc.sub$TotalCigsSmoked, na.rm = TRUE)`
  and the `spread` (interquartile range) for the distribution is
  `r IQR(nesarc.sub$TotalCigsSmoked, na.rm = TRUE)`.

----------------------------------------

# HW04: Bivariate summaries and data cleaning

## Tuesday --------

## Bivariate graphs

### Scatter plot (for regression): x = numerical, y = numerical

Research question:
With my questions, I don't have a meaningful question to ask that will relate
  two numeric variable.

An exploratory question whether there is a relationship between a person's age (`Age`)
  and total number of cigaretts smoked (`TotalCigsSmoked`).
Because age is an integer varible, I jitter the points,
  and I reduce the opacity (increase the transparancy) with `alpha = 1/4`
  to see the density of points better (1/4 means that it takes 4 overlayed points to be fully opaque).

__Interpretation:__
I added a linear regression smoother to see whether there was any linear trend with age.
The horizontal line suggests that there isn't a (linear) relationship here.

```{R}
library(ggplot2)
p <- ggplot(nesarc.sub, aes(x = Age, y = TotalCigsSmoked))
p <- p + geom_jitter(position = position_jitter(width = 0.1), alpha = 1/4)
p <- p + stat_smooth(method = lm)
p <- p + labs(title = "Age does not predict Total Cigarettes Smoked")
print(p)
```

### Box plots (for ANOVA): x = categorical, y = numerical

Research question:
1. Is there a relationship between depression (`Depression`) and total number of cigarettes smoked (`TotalCigsSmoked`)?

The $x$ variable should be a factor variable, and $y$ should be numeric.

__Interpretation:__
The boxplots indicate that the five number summary is about the same for both depression groups.
Also, the means are about the same, though slightly higher for the people with depression.

```{R}
library(ggplot2)
p <- ggplot(nesarc.sub, aes(x = Depression, y = TotalCigsSmoked))
p <- p + geom_boxplot(width = 0.5, alpha = 0.5)
p <- p + geom_jitter(position = position_jitter(width = 0.1), alpha = 1/4)
# diamond at mean for each group
p <- p + stat_summary(fun.y = mean, geom = "point", shape = 18, size = 6,
                      colour = "red", alpha = 0.8)
p <- p + labs(title = "Depression does not predict Total Cigarettes Smoked")
print(p)
```

### Mosaic plot or bivariate bar plots (for contingency tables): x = categorical, y = categorical

Research question:
Is there a relationship between depression status (`Depression`) and nicotine dependence (`TobaccoDependence`)?

This strategy uses the base graphics by plotting the tables directly as bar plots.
The next set of plots using `ggplot()` may be preferred.
```{R}
T1 <- xtabs(~ TobaccoDependence + Depression, data = nesarc.sub)
T1
barplot(T1)
T2 <- prop.table(T1, 2)
T2
barplot(T2)
```

The last graph needs a legend as well as a title.  While it is possible to
construct a legend and title for the last graph, it is much better to use an
approach that will generate the legend automatically.

__Interpretation:__
If a person has depression they are more likely to have nicotine dependence
  than if they do not have depression.

```{R}
library(ggplot2)
p <- ggplot(data = nesarc.sub, aes(x = Depression, fill = TobaccoDependence))
p <- p + geom_bar(position = "fill")
p <- p + theme_bw()
p <- p + labs(title = "Fraction of young adult smokers with and without\n nicotine dependence by depression status")
# the legend title can be modified, if desired (try this line)
# p <- p + scale_fill_discrete(name="Tobacco Addiction\nStatus")
print(p)
```

Does the a relationship between depression status (`Depression`) and nicotine dependence (`TobaccoDependence`)
  vary by sex?

__Interpretation:__
It appears that nicotine dependence is slightly higher for women with depression than for men with depression.

```{R}
library(ggplot2)
p <- ggplot(data = nesarc.sub, aes(x = Depression, fill = TobaccoDependence))
p <- p + geom_bar(position = "fill")
p <- p + theme_bw()
p <- p + labs(title = "Fraction of young adult smokers with and without\n nicotine dependence by depression status")

# added a row facets by Sex
p <- p + facet_grid(Sex ~ .)
# tilted the x-axis labels
p <- p + theme(axis.text.x  = element_text(angle = 90, vjust = 0.5))

p <- p + labs(title = "Fraction of young adult smokers with and without\n nicotine dependence by smoking frequency")
# the legend title can be modified, if desired (try this line)
p <- p + scale_fill_discrete(name="Tobacco Addiction\nStatus")
print(p)
```

```{R}
# ggplot(data = na.omit(nesarc.sub), aes(x = CigsSmokedFac, fill = TobaccoDependence)) +
#   geom_bar(position = "fill") +
#   theme_bw() + facet_grid(Sex ~ Depression) +
#   theme(axis.text.x  = element_text(angle = 85, vjust = 0.5)) +
#   labs(x = "Estimated Number of Cigarettes Smoked per Month", y = "", title = "Fraction of young adult smokers with and without\n nicotine dependence by smoking quantity") +
#   scale_fill_discrete(name="Tobacco Addiction\nStatus")
```

Research question:
Is there a relationship between smoking frequency (`SmokingFreq`) and nicotine dependence (`TobaccoDependence`)?

Also compare by sex.

```{R}
library(ggplot2)
p <- ggplot(data = nesarc.sub, aes(x = SmokingFreq, fill = TobaccoDependence))
p <- p + geom_bar(position = "fill")
p <- p + theme_bw()
# tilt axis labels
p <- p + theme(axis.text.x = element_text(angle = 45, vjust = 0.5))
p <- p + labs(x = "Smoking Frequency", y = "Percent")
print(p)

# also compare by sex
p <- p + facet_grid(Sex ~ .)
print(p)
```

#### Using Mosaic Plots

__Interpretation:__
If a person has depression they are more likely to have nicotine dependence
  than if they do not have depression.

```{R}
library(vcd)
mosaic(~TobaccoDependence + Depression, data = nesarc.sub)
mosaic(~TobaccoDependence + Depression, data = nesarc.sub, shade = TRUE)
mosaic(~TobaccoDependence + Depression + Sex, data = nesarc.sub, shade = TRUE)
```

It's easy to look at such a fine resolution that it's difficult to see what's happening
```{R, fig.width = 8, fig.height = 8}
mosaic(~TobaccoDependence + Depression + Sex + CigsSmokedFac, data = nesarc.sub, shade = TRUE)
```

### Logistic scatter plot (for logistic regression): x = numerical, y = categorical (binary)

Research question:
1. Frequency and quantity of smoking (`TotalCigsSmoked`) are markedly imperfect indices for
determining an individual's probability of exhibiting nicotine dependence (`TobaccoDependence`) (this
is true for other drugs as well).

```{R}
library(ggplot2)
p <- ggplot(nesarc.sub, aes(x = TotalCigsSmoked, y = TobaccoDependence))
p <- p + geom_jitter(position = position_jitter(height = 0.1), alpha = 1/4)
print(p)
```

To overlay a curve, we need to convert our response variable $y$ to be
  binary 0 or 1, where we let 1 indicate a "success" in the direction of interest.

__Interpretation:__
These two groups are quite balanced on the probability of tobacco dependence
  given the total number of cigarettes smoked,
  though they increase together slightly.

```{R}
# if "Nicotine Dependence", then code it as a 1, otherwise code as a 0
nesarc.sub$TobaccoDependence01 <- ifelse(nesarc.sub$TobaccoDependence == "Nicotine Dependence", 1, 0)

library(ggplot2)
p <- ggplot(nesarc.sub, aes(x = TotalCigsSmoked, y = TobaccoDependence01))
p <- p + geom_jitter(position = position_jitter(height = 0.1), alpha = 1/4)
# overlay a sigmodal curve to indicate direction of relationship
p <- p + stat_smooth(method="glm", family="binomial", se=FALSE)
print(p)
```

#### Example of collapsing a variable to binary.

It is convenient to collapse a continuous variable into a categorical variable
  (as I did in HW03 with the `cut()` command)
  or further collapse a categorical variable into a binary variable.

One strategy to create a binary variable is to use the `ifelse()` function.

Let's create a binary `Age` variable; if 21 years and older, than legal to purchase alcohol,
  otherwise it is illegal

```{R}
nesarc.sub$Alcohol.binary <- ifelse(nesarc.sub$Age >= 21, "Legal", "Illegal")
str(nesarc.sub$Alcohol.binary)
head(nesarc.sub[,c("Age", "Alcohol.binary")], 15)
```

## Thursday --------

<!---
## Data Cleaning

To do.

# Some Statistics (We have not discussed this yet)

```{R results='asis', echo = TRUE}
# library(moonBook)
# out <- mytable(Depression
#              + TobaccoDependence
#              ~
#                Age
#              + SmokingFreq
#              + DailyCigsSmoked
#              + Ethnicity
#              + Sex
#              + DaysSmoke
#              + TotalCigsSmoked
#              + CigsSmokedFac
#              , data = nesarc.sub)
# myhtml(out)
```

--->

End.

# SNIPPETS

```{R}
# the subset command below will not include a row that evalutes to NA for the
# specified subset.  For example:
(NA == 1)
# age and smoking subset
addhealth.sub <- subset(addhealth.sub
                    , subset = (HoursWorked > 0 | HoursWorked <= 50)     # Working between 1 and 50 hours
                             & (Working == 1) # Worked outside home in the past 4 weeks
                    )
dim(nesarc.sub)
summary(nesarc.sub)
```

# References (from HW02)


# This was written by Joshua Wiley, in the Psychology Department at UCLA.
#  Modified for one between and one within for King.dat by dch

### Howell Table 14.4 ###
## Repeated Measures ANOVA with 2 variables
## Read in data, convert to 'long' format, and factor()

dat <- read.table("http://www.uvm.edu/~dhowell/methods8/DataFiles/Tab14-4.dat", header = TRUE)

head(dat)

dat$subject <- factor(1:24)
datLong <- reshape(data = dat, varying = 2:7, v.names = "outcome", timevar
= "time", idvar = "subject", ids = 1:24, direction = "long")

datLong$Interval <- factor(rep(x = 1:6, each = 24), levels = 1:6, labels = 1:6)
datLong$Group <- factor(datLong$Group, levels = 1:3, labels = c("Control",
"Same", "Different"))

str(datLong)
attach(datLong)

cat("Group Means","\n")
cat(tapply(outcome, Group, mean),"\n")
cat("\nInterval Means","\n")
cat(tapply(outcome, Interval, mean),"\n")

# Actual formula and calculation
King.aov <- aov(outcome ~ (Group*Interval) + Error(subject/(Interval)), data = datLong)

# Present the summary table (ANOVA source table)
print(summary(King.aov))

interaction.plot(Interval, factor(Group), outcome, fun = mean, type="b", pch = c(2,4,6),
  legend = "F", col = c(3,4,6), ylab = "Mean of Outcome",)
legend(4, 300, c("Same", "Different", "Control"), col = c(4,6,3), text.col = "green4", lty = c(2, 1, 3), pch = c(4, 6, 2),merge = TRUE, bg = 'gray90')

detach(datLong)
### End ###

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


#' Seasonality Tests for The ATAforecasting
#'
#' @description This function is a class of seasonality tests using  \code{corrgram_test} from ATAforecasting package, \code{ndiffs} and \code{nsdiffs} functions from forecast package.
#' Also, this function is modified version of \code{ndiffs} and \code{nsdiffs} written by Hyndman et al. \code{forecast} package.
#' Please review manual and vignette documents of latest \code{forecast} package. According to \code{forecast} package,
#' \code{ndiffs} and \code{nsdiffs} functions to estimate the number of differences required to make a given time series stationary.
#' \code{ndiffs} uses unit root tests to determine the number of differences required for time series to be made trend stationary. Several different tests are available:
#' \itemize{
#' 	\item {uroot.test = 'kpss'}			: the KPSS test is used with the null hypothesis that \code{x} has a stationary root against a unit-root alternative. Then the test returns the least number of differences required to pass the test at the level \code{uroot.alpha}.
#' 	\item {uroot.test = 'adf'}			: the Augmented Dickey-Fuller test is used.
#' 	\item {uroot.test = 'pp'}			: the Phillips-Perron test is used. In both of these cases, the null hypothesis is that \code{x} has a unit root against a stationary root alternative. Then the test returns the least number of differences required to fail the test at the level \code{uroot.alpha}.
#' }
#' \code{nsdiffs} uses seasonal unit root tests to determine the number of seasonal differences required for time series to be made stationary. Several different tests are available:
#' \itemize{
#' 	\item {suroot.test = 'seas'}		: a measure of seasonal strength is used, where differencing is selected if the seasonal strength (Wang, Smith & Hyndman, 2006) exceeds 0.64 (based on minimizing MASE when forecasting using auto.arima on M3 and M4 data).
#' 	\item {suroot.test = 'ch'}			: the Canova-Hansen (1995) test is used (with null hypothesis of deterministic seasonality)
#' 	\item {suroot.test = 'hegy'}		: the Hylleberg, Engle, Granger & Yoo (1990) test is used.
#' 	\item {suroot.test = 'ocsb'}		: the Osborn-Chui-Smith-Birchenhall (1988) test is used (with null hypothesis that a seasonal unit root exists).
#' 	\item {suroot.test = 'correlogram'}	: this function is written based on M4 Competition Seasonality Test.
#' }
#'
#' @param input The data.
#' @param ppy Frequency of the data.
#' @param attr_set Assign from \code{ATA.SeasAttr} function. Attributes set for unit root, seasonality tests.
#'
#' @return \code{TRUE} if the serie has seasonality. Otherwise, \code{FALSE}.
#'
#' @author Ali Sabri Taylan and Hanife Taylan Selamlar
#'
#' @seealso \code{forecast}, \code{urca}, \code{tseries}, \code{uroot}, \code{stlplus}, \code{stR},
#' \code{\link[stats]{stl}}, \code{\link[stats]{decompose}}, \code{tbats}, \code{seasadj}.
#'
#' @keywords ata ADF Canova-Hansen correlogram HEGY KPSS Phillips-Perron OCSB seasonal unit-root
#'
#' @references
#'
#' #'\insertRef{dickey1979}{ATAforecasting}
#'
#' #'\insertRef{said1984}{ATAforecasting}
#'
#' #'\insertRef{dhf1984}{ATAforecasting}
#'
#' #'\insertRef{phillips1988}{ATAforecasting}
#'
#' #'\insertRef{ocsb1988}{ATAforecasting}
#'
#' #'\insertRef{hegy1990}{ATAforecasting}
#'
#' #'\insertRef{kpss1992}{ATAforecasting}
#'
#' #'\insertRef{ch1995}{ATAforecasting}
#'
#' #'\insertRef{seas2006}{ATAforecasting}
#'
#'
#' @importFrom forecast ndiffs nsdiffs
#' @importFrom Rdpack reprompt
#'
#' @export
#'
ATA.Seasonality <- function(input, ppy, attr_set)
{
  if (max(ppy)==1){
    test_seasonal <- FALSE
  }else {
    test <- attr_set$suroot.test
    if (test=="correlogram"){
      test_seasonal <- corrgram_test(input, ppy, attr_set)
    }else {
      if (length(ppy)>1){
        if (attr_set$multi.period=="max"){
          ppy <- max(ppy)
        }else {
          ppy <- min(ppy)
        }
      }
      if (attr_set$suroot.uroot==TRUE){
        uroot.test <- attr_set$uroot.test
        uroot.type <- attr_set$uroot.type
        uroot.alpha <- attr_set$uroot.alpha
        uroot.pkg <- attr_set$uroot.pkg
        uroot.maxd <- attr_set$uroot.maxd
        #Used to determine whether a time series is stationary (trend)
        if (uroot.pkg=="urca") {
          d <- forecast::ndiffs(input, alpha=uroot.alpha, test=uroot.test, type=uroot.type, max.d=uroot.maxd)
        }else {
          d <- ndiffs_tseries(input, alpha=uroot.alpha, test=uroot.test, max.d=uroot.maxd)
        }
        if (d > 0){
          input <- diff(input, differences=d, lag=1)
        }
      }
      suroot.alpha <- attr_set$suroot.alpha
      suroot.maxD <- attr_set$suroot.maxD
      suroot.m <- attr_set$suroot.m
      if (!is.null(attr_set$suroot.m)){
        D <- forecast::nsdiffs(input, alpha=suroot.alpha, m=suroot.m, test=test, max.D=suroot.maxD)
      }else {
        D <- forecast::nsdiffs(input, alpha=suroot.alpha, test=test, max.D=suroot.maxD)
      }
      test_seasonal <- ifelse(D==0, FALSE, TRUE)
    }
  }
}

#' @importFrom forecast ndiffs nsdiffs
#' @importFrom stats acf
corrgram_test <- function(input, ppy, attr_set)
{
  if (max(ppy)==1){
    test_seasonal <- FALSE
  }else {
    corrgram.tcrit <- attr_set$corrgram.tcrit
    uroot.test <- attr_set$uroot.test
    uroot.type <- attr_set$uroot.type
    uroot.alpha <- attr_set$uroot.alpha
    uroot.pkg <- attr_set$uroot.pkg
    uroot.maxd <- attr_set$uroot.maxd
    if (length(ppy) > 1){
      if (attr_set$multi.period=="max"){
        ppy <- max(ppy)
      }else {
        ppy <- min(ppy)
      }
    }
    #Used to determine whether a time series is stationary (trend)
    if (uroot.pkg=="urca") {
      d <- forecast::ndiffs(input, alpha=uroot.alpha, test=uroot.test, type=uroot.type, max.d=uroot.maxd)
    }else {
      d <- ndiffs_tseries(input, alpha=uroot.alpha, test=uroot.test, max.d=uroot.maxd)
    }
    if (d > 0){
      input <- diff(input, differences=d, lag=1)
    }
    #Used to determine whether a time series is seasonal
    if (length(input) < 3 * ppy){
      test_seasonal <- FALSE
    }else {
      if (stats::acf(input, plot = FALSE)$acf[1] == 1){
        xacf <- stats::acf(input, plot = FALSE)$acf[-1, 1, 1]
      }else {
        xacf <- stats::acf(input, plot = FALSE)$acf
      }
      clim <- corrgram.tcrit / sqrt(length(input)) * sqrt(cumsum(c(1, 2 * xacf^2)))
      test_seasonal <- (abs(xacf[ppy]) > clim[ppy])
      if (is.na(test_seasonal) == TRUE){
        test_seasonal <- FALSE
      }
    }
  }
  return(test_seasonal)
}

#' @importFrom stats acf na.omit
#' @importFrom forecast is.constant
#' @importFrom tseries adf.test kpss.test pp.test
ndiffs_tseries <- function(x, alpha = 0.05, test = c("kpss","adf","pp"), max.d=2)
{
  #ndiffs function using tseries package
  test <- match.arg(test)
  x <- c(na.omit(c(x)))
  d <- 0

  if(is.constant(x))
    return(d)

  if(test == "kpss")
    suppressWarnings(dodiff <- tseries::kpss.test(x)$p.value < alpha)
  else if(test == "adf")
    suppressWarnings(dodiff <- tseries::adf.test(x)$p.value > alpha)
  else if(test == "pp")
    suppressWarnings(dodiff <- tseries::pp.test(x)$p.value > alpha)
  else
    stop("This shouldn't happen")
  if(is.na(dodiff))
  {
    return(d)
  }
  while(dodiff & d < max.d)
  {
    d <- d+1
    x <- diff(x)
    if(is.constant(x))
      return(d)
    if(test == "kpss")
      suppressWarnings(dodiff <- tseries::kpss.test(x)$p.value < alpha)
    else if(test == "adf")
      suppressWarnings(dodiff <- tseries::adf.test(x)$p.value > alpha)
    else if(test == "pp")
      suppressWarnings(dodiff <- tseries::pp.test(x)$p.value > alpha)
    else
      stop("This shouldn't happen")
    if(is.na(dodiff))
      return(d-1)
  }
  return(d)
}


calc_shesd <- function(date, count,sentiment, alpha)
{
  scaled.sentiments <- data.frame(date =as.POSIXct(date), sent= sentiment)
  scaled.count <- data.frame(date =as.POSIXct(date), count= count)
  scaled.finalDF<-data.frame(date = as.POSIXct(date), sentiment = scaled.sentiments, count = scaled.count)

  res_Sentiment_SHESD = NULL
  tryCatch(
    expr = {
      res_Sentiment_SHESD = AnomalyDetectionTs(scaled.sentiments, max_anoms=0.1,alpha = alpha , direction='both', plot=TRUE)
      plot(res_Sentiment_SHESD$plot, main="S-H-ESD on Sentiment Time-Series")
    },
    error=function(e){
      print('Anom detection not applicable')
    }
  )

  res_Count_SHESD = NULL
  tryCatch(
    expr = {
      res_Count_SHESD = AnomalyDetectionTs(scaled.count, max_anoms=0.1,alpha = alpha , direction='both', plot=TRUE)
      plot(res_Count_SHESD$plot,main="S-H-ESD on Frequency Time-Series")
    },
    error=function(e){
      print('Anom detection not applicable')
    }
  )

  res_SHESD_UNION = NULL
  tryCatch(
    expr = {
      res_SHESD_UNION = union(res_Count_SHESD$anoms$timestamp, res_Sentiment_SHESD$anoms$timestamp)
    },
    error = function(e){
      res_SHESD_UNION = NULL
    }
  )
  res_SHESD_Intersect = intersect(res_Count_SHESD$anoms$timestamp,res_Sentiment_SHESD$anoms$timestamp)

  return(list(A=res_Count_SHESD$anoms$timestamp, B=res_Sentiment_SHESD$anoms$timestamp, union=res_SHESD_UNION,intersect=res_SHESD_Intersect,s_plot=res_Sentiment_SHESD$plot, c_plot = res_Count_SHESD$plot))
}


# Databricks notebook source
# MAGIC %md The notebook reads in the model and does some simple tests and write out the results to a file.

# COMMAND ----------

library("testthat")
context("Unit Tests Linear Regression Model")

# test_env is the test environment global var

# Set model(s) path
if(is_testing()){
  # If testing, get input model directory from test env passed in to script
  base_dir <- test_env$base_dir
  inputmodel_path <- paste(base_dir,"models","model.rds",sep = "/")
} else{
  # else load path manually for interactive/dev test
  inputmodel_path <- "/dbfs/mnt/adlsv2-databricks/build/RModel-Repo/454/models/model.rds"
}

# COMMAND ----------

# Load Model from mounted storage
model <- readRDS(inputmodel_path)

# Create Test Data Frame and Test Prediction
p <- data.frame(height = c(79), weight = c(0))
x <- data.frame(x = p$height)
y <- predict(model, x)
y

# COMMAND ----------

# Unit Test 1
test_that("Output Shape", {
    expect_that(length(y), equals(1))
    expect_that(class(y), equals("numeric"))
})

# COMMAND ----------

# Unit Test 2
test_that("Output Value Two Sides", {
    expect_gt(y[1], 192)
    expect_lt(y[1], 193)
})