##### Importing the necessary libraries
library(readr)
library(dplyr)
library(tidyr)
library(knitr)
library(TSA)
library(tseries)
library(car)
library(dynlm)
library(Hmisc)
library(forecast)
library(xts)
library(ggplot2)
library(AER)
library(x12)
library(dLagM)
library(kableExtra)

##### Function Definations

# Descriptive Analysis function
descriptive_analysis <- function(ts, object)
{
  plot(ts,
       ylab = c(paste0(toString(object))),
       main = c(paste0("Time Series Plot of ",toString(object))),
       type="o")

  par(mfrow=c(2,1))
  acf(ts,
      lag.max = 48,
      main = c(paste0("ACF plot of ",toString(object))))

  pacf(ts,
      lag.max = 48,
      main = c(paste0("PACF plot of ",toString(object))))
  par(mfrow=c(1,1))

  print(adf.test(ts))
  print(pp.test(ts))

}

# Function for Decomposition
decom <- function(ts, ts_series)
{
  decomposition <- stl(ts, t.window=15, s.window = "periodic", robust=TRUE)
  plot(decomposition,
       main = c(paste0("Weekly ", toString(ts_series)), " STL Decomposed Series"))
}

# Function for Summary and Residual Analysis
summary_residual_analysis <-  function(m)
{
  summary(m, diagnostics = TRUE)
  checkresiduals(m$model)
  print(bgtest(m$model))
  print(vif(m$model))
  print(shapiro.test(m$model$residuals))
}

#---------------------------------------------
#------------------ Task-1--------------------
#---------------------------------------------

## Data Preparation

mort <- read.csv("mort.csv")
head(mort)
class(mort)
mort <- mort[,-c(1)]
mort_TS <- ts(mort, start = c(2010,1), frequency = 52)

mortality_TS <- ts(mort$mortality, start = c(2010,1), frequency = 52)
temp_TS <- ts(mort$temp, start = c(2010,1), frequency = 52)
chem_1_TS <- ts(mort$chem1, start = c(2010,1), frequency = 52)
chem_2_TS <- ts(mort$chem2, start = c(2010,1), frequency = 52)
particle_size_TS <- ts(mort$particle.size, start = c(2010,1), frequency = 52)

mort_TS %>% head()
class(mort_TS)

##### 1. Mortality
head(mortality_TS)
class(mortality_TS)

##### 2. Temperature
head(temp_TS)
class(temp_TS)

##### 3. Chemical 1
head(chem_1_TS)
class(chem_1_TS)

##### 4. Chemical 2
head(chem_2_TS)
class(chem_2_TS)

##### 5. Partical Size
head(particle_size_TS)
class(particle_size_TS)

## Descriptive Analysis

##### 1. Mortality
descriptive_analysis(mortality_TS, "Averaged weekly disease specific mortality")

##### 2. Temperature
descriptive_analysis(temp_TS, "Averaged weekly temperature")

##### 3. Chemical 1
descriptive_analysis(chem_1_TS, "Averaged weekly Chem1 Emissions")

##### 4. Chemical 2
descriptive_analysis(chem_2_TS, "Averaged weekly Chem2 Emissions")

##### 5. Partical Size
descriptive_analysis(particle_size_TS, "Averaged weekly Pollutants Particle Size")

##### 6. Combined Scaled Time Series Plot
combined <- scale(mort_TS)

plot(combined,
     plot.type="s",
     col = c("#05386b","#f01b1d","#5c3c92","#d2601a","#1b6535"),
     main = "Scaled Time Series Plot of Mortality, Paris's Climate and pollutanats")

legend("topleft",
       lty=1,
       col = c("#05386b","#f01b1d","#5c3c92","#d2601a","#1b6535"),
c("Mortality", "Temperature", "Chemical 1", "Chemical 2" , "Partical Size"))

# Correlation
cor(mort_TS) %>% round(3)

## Decomposition
##### 1. Mortality
decom(mortality_TS, "Average Weekly Disease Specific Mortality")

##### 2. Temperature
decom(temp_TS, "Average Weekly Temperature")

##### 3. Chemical 1
decom(temp_TS, "Average Weekly Chemical 1 Emissions")

##### 4. Chemical 2
decom(temp_TS, "Average Weekly Chemical 2 Emissions")

##### 5. Partical Size
decom(particle_size_TS, "Average Weekly Pollutants Particle Size")

## Time Series Regression Methods
### Finite Distributed Lag Model
for (i in 1:8)
{
  model_dlm <- dlm(formula = mortality ~ temp + chem1 + chem2 + particle.size, data = data.frame(mort), q = i)
  cat("q = ", i,
      "AIC = ", AIC(model_dlm$model),
      "BIC = ", BIC(model_dlm$model),
      "MASE = ", MASE(model_dlm)$MASE, "\n")
}

task1_model1_1 <- dlm(formula = mortality ~ temp + chem1 + chem2 + particle.size,
                      data = data.frame(mort),
                      q = 8)

summary_residual_analysis(task1_model1_1)

for (i in 1:8)
{
  model_dlm <- dlm(formula = mortality ~ temp + chem1, data = data.frame(mort), q = i)
  cat("q = ", i,
      "AIC = ", AIC(model_dlm$model),
      "BIC = ", BIC(model_dlm$model),
      "MASE = ", MASE(model_dlm)$MASE, "\n")
}

task1_model1_2 <- dlm(formula = mortality ~ temp + chem1,
                      data = data.frame(mort),
                      q = 8)

summary_residual_analysis(task1_model1_2)

### PolyNomial Distributed Lag Model
task_1_model2 = polyDlm(y = as.vector(mort$mortality),
                        x = as.vector(mort$chem1) + as.vector(mort$temp),
                        q = 8,
                        k = 2,
                        show.beta = TRUE)

summary_residual_analysis(task_1_model2)

### Koyck Distributed Lag Model
task_1_model3 = koyckDlm(as.vector(mort$chem1) + as.vector(mort$temp),
                         y = as.vector(mort$mortality))
summary_residual_analysis(task_1_model3)

### Autoregressive Distributed Lag Model
for (i in 1:5)
{
  for(j in 1:5)
  {
    model_ardlm <- ardlDlm(formula = mortality ~ temp + chem1,
                           data = data.frame(mort),
                           p = i,
                           q = j)
    cat("p =", i,
        "q =" , j,
        "AIC =", AIC(model_ardlm$model),
        "BIC =", BIC(model_ardlm$model),
        "MASE =", MASE(model_ardlm)$MASE, "\n")
  }
}

#ardlDLM(3,2)
task_1_model4_1 = ardlDlm(formula = mortality ~ temp + chem1,
                          data = data.frame(mort),
                          p = 3,
                          q = 2)

summary_residual_analysis(task_1_model4_1)

#ardlDLM(4,2)
task_1_model4_2 = ardlDlm(formula = mortality ~ temp + chem1,
                          data = data.frame(mort),
                          p = 4,
                          q = 2)

summary_residual_analysis(task_1_model4_2)

#ardlDLM(5,2)
task_1_model4_3 = ardlDlm(formula = mortality ~ temp + chem1,
                          data = data.frame(mort),
                          p = 5,
                          q = 2)

summary_residual_analysis(task_1_model4_3)

### Dynamic Models
#dynlm_1
task_1_model5_1 = dynlm(mortality_TS ~ L(mortality_TS , k = 1 ) + trend(mortality_TS))
summary(task_1_model5_1)
checkresiduals(task_1_model5_1)

#dynlm_2
task_1_model5_2 = dynlm(mortality_TS ~ L(mortality_TS , k = 1) + season(mortality_TS))
summary(task_1_model5_2)
checkresiduals(task_1_model5_2)

#dynlm_3
task_1_model5_3 = dynlm(mortality_TS ~ L(mortality_TS , k = 1 ) + trend(mortality_TS) + season(mortality_TS))
summary(task_1_model5_3)
checkresiduals(task_1_model5_3)

#dynlm_4
task_1_model5_4 = dynlm(mortality_TS ~ L(mortality_TS , k = 1 ) + L(mortality_TS , k = 2 ) + trend(mortality_TS) + season(mortality_TS))
summary(task_1_model5_4)
checkresiduals(task_1_model5_4)

#dynlm_5
task_1_model5_5 = dynlm(mortality_TS ~ L(mortality_TS , k = 1 ) + L(mortality_TS , k = 2 ) + temp_TS + trend(mortality_TS) + season(mortality_TS))
summary(task_1_model5_5)
checkresiduals(task_1_model5_5)

#dynlm_6
task_1_model5_6 = dynlm(mortality_TS ~ L(mortality_TS , k = 1 ) + L(mortality_TS , k = 2 ) + season(mortality_TS) + trend(mortality_TS) + temp_TS + L(temp_TS , k = 1 ))
summary(task_1_model5_6)
checkresiduals(task_1_model5_6)

#dynlm_7
task_1_model5_7 = dynlm(mortality_TS ~ L(mortality_TS , k = 1 ) + L(mortality_TS , k = 2 ) +  L(mortality_TS , k = 3 ) + trend(mortality_TS) + chem_1_TS + temp_TS + L(chem_1_TS, k=1))
summary(task_1_model5_7)
checkresiduals(task_1_model5_7)

#Model Comparison
attr(task_1_model3$model,"class") = "lm"
T1_models <- c("Finite DLM (all predictors)", "Finite DLM (chem1 + temp)", "Poly DLM", "Koyck", "ARDL_3_2", "ARDL_4_2", "ARDL_5_2", "dynlm_1", "dynlm_2", "dynlm_3", "dynlm_4", "dynlm_5" ,"dynlm_6", "dynlm_7")

T1_aic <- AIC(task1_model1_1$model, task1_model1_2$model, task_1_model2$model, task_1_model3$model, task_1_model4_1$model, task_1_model4_2$model, task_1_model4_3$model, task_1_model5_1,task_1_model5_2,task_1_model5_3, task_1_model5_4, task_1_model5_5, task_1_model5_6, task_1_model5_7)$AIC

T1_bic <- BIC(task1_model1_1$model, task1_model1_2$model, task_1_model2$model, task_1_model3$model, task_1_model4_1$model, task_1_model4_2$model, task_1_model4_3$model, task_1_model5_1,task_1_model5_2,task_1_model5_3, task_1_model5_4, task_1_model5_5, task_1_model5_6, task_1_model5_7)$BIC

T1_mase <- MASE(task1_model1_1$model, task1_model1_2$model, task_1_model2$model, task_1_model3$model, task_1_model4_1, task_1_model4_2, task_1_model4_3, lm(task_1_model5_1), lm(task_1_model5_2), lm(task_1_model5_3), lm(task_1_model5_4), lm(task_1_model5_5), lm(task_1_model5_6), lm(task_1_model5_7))$MASE

T1_Model_Comparison <- data.frame(T1_models, T1_mase, T1_aic, T1_bic)
colnames(T1_Model_Comparison) <- c("Model","MASE","AIC", "BIC")

kbl(T1_Model_Comparison) %>% kable_paper()

## Exponential smoothing methods
yearly_mortality_TS = aggregate(zoo(mortality_TS),as.yearmon,sum)
yearly_mortality_TS

yearly_mortality_TS[yearly_mortality_TS == 171.34] <- NA
yearly_mortality_TS = na.omit(yearly_mortality_TS)
yearly_mortality_TS

T1_HW_models = c("Holt_Winter additive method",
                 "Holt_Winter multiplicative method with exponential trend",
                 "Holt_Winter multiplicative method",
                 "Holt_Winter additive method",
                 "Holt_Winter multiplicative method with exponential trend",
                 "Holt_Winter multiplicative method")

T1_exponential = c(TRUE,FALSE)
T1_seasonality = c("additive","multiplicative")
T1_damped = c(TRUE,FALSE)
T1_exponential_models <- expand.grid(T1_exponential, T1_seasonality, T1_damped)
T1_exponential_models <- T1_exponential_models[-c(1,5),]

T1_HW_AIC <- array(NA, 6)
T1_HW_BIC <- array(NA, 6)
T1_HW_MASE <- array(NA, 6)
T1_levels <- array(NA, dim=c(6,3))

for (i in 1:6)
{
  T1_HW_model <- hw(yearly_mortality_TS,
                    exponential = T1_exponential_models[i,1],
                    seasonal = toString(T1_exponential_models[i,2],
                                        damped = T1_exponential_models[i,3]))
  T1_HW_AIC[i] <- T1_HW_model$model$aic
  T1_HW_BIC[i] <- T1_HW_model$model$bic
  T1_HW_MASE[i] <- accuracy(T1_HW_model)[6]
  T1_levels[i,1] <- T1_exponential_models[i,1]
  T1_levels[i,2] <- toString(T1_exponential_models[i,2])
  T1_levels[i,3] <- T1_exponential_models[i,3]
  summary(T1_HW_model)
  checkresiduals(T1_HW_model)
  print(shapiro.test(T1_HW_model$model$residuals))
}

T1_results_HW = data.frame(T1_HW_models, T1_levels, T1_HW_MASE, T1_HW_AIC, T1_HW_BIC)
colnames(T1_results_HW) = c("Model", "Exponential","Seasonality","Damped","MASE","AIC", "BIC")

kbl(T1_results_HW) %>% kable_paper()

#Formating T1_results_HW table
T1_results_HW$Damped <- factor(T1_results_HW$Damped,
                               levels = c(TRUE, FALSE),
                               labels = c("damped"," "))

T1_results_HW <- unite(T1_results_HW,
                       "Model", c("Model","Damped"), sep = "_")

T1_results_HW <- T1_results_HW[,-c(2,3)]
kbl(T1_results_HW) %>% kable_paper()

## State-space Models
T1_ets_models = c("AAA", "MAA", "MAM", "MMM")
T1_damped = c(TRUE,FALSE)
T1_ETS_models <- expand.grid(T1_ets_models, T1_damped)

T1_ETS_AIC <- array(NA, 8)
T1_ETS_BIC <- array(NA, 8)
T1_ETS_MASE <- array(NA, 8)
T1_levels <- array(NA, dim=c(8,2))

for (i in 1:8)
{
  T1_ETS <- ets(yearly_mortality_TS,
                model = toString(T1_ETS_models[i, 1]), damped = T1_ETS_models[i,2])
  T1_ETS_AIC[i] <- T1_ETS$aic
  T1_ETS_BIC[i] <- T1_ETS$bic
  T1_ETS_MASE[i] <- accuracy(T1_ETS)[6]
  T1_levels[i,1] <- toString(T1_ETS_models[i,1])
  T1_levels[i,2] <- T1_ETS_models[i,2]
  summary(T1_ETS)
  checkresiduals(T1_ETS)
  print(shapiro.test(T1_ETS$residuals))
}

T1_results_ETS = data.frame(T1_levels, T1_ETS_MASE, T1_ETS_AIC, T1_ETS_BIC)
colnames(T1_results_ETS) = c("Model","Damped","MASE","AIC", "BIC")

kbl(T1_results_ETS) %>% kable_paper()

#Formating T1_results_ETS table
T1_results_ETS$Damped <- factor(T1_results_ETS$Damped,
                                levels = c(TRUE, FALSE),
                                labels = c("damped"," "))

T1_results_ETS <- unite(T1_results_ETS,
                        "Model", c("Model","Damped"), sep = "_")

kbl(T1_results_ETS) %>% kable_paper()

## Model Comparison
T1_Model_Comparison <- rbind(T1_Model_Comparison, T1_results_ETS, T1_results_HW)

T1_sorted_MASE <- T1_Model_Comparison %>% arrange(MASE)
kbl(T1_sorted_MASE) %>%
  kable_paper()

## Forecasting
### Monthly Forcasting from ETS model

#Comparison of Charts
prediction <- ets(yearly_mortality_TS,
                  model="MAM",
                  damped = T)
prediction <- forecast(prediction)

prediction1 <- ets(yearly_mortality_TS,
                   model="MAA",
                   damped = TRUE)
prediction1 <- forecast(prediction1)

plot(prediction,
     main = "Next Two years prediction of mortality using ETS",
     ylab = "Mortality Rate",
     fcol = "#f01b1d")

lines(fitted(prediction1), col = "#05386b")

lines(fitted(prediction), col = "#f01b1d")

legend("topleft",
       lty = 1,
       col = c("black", "#f01b1d", "#05386b"),
       c("Data", "MAM_damped", "MAA_damped"))

#Prediction Chart
plot(prediction1, fcol = "#b20238",
     main = "Forecasting of Mortality in 2019 and 2020",
     ylab = "Radiation")
lines(fitted(prediction1), col = "#f01b1d")

legend("topleft",
       lty = 1,
       col = c("black", "#f01b1d"),
       c("Data", "Prediction"))

#Prediction Points
kbl(prediction) %>% kable_paper()

### weekly Forcasting from dylnm model
#Prediction Chart
q = 4
n = nrow(task_1_model5_6$model)
m.frc = array(NA , (n + q))
m.frc[1:n] = mortality_TS[3:length(mortality_TS)]
trend = array(NA,q)
trend.start = task_1_model5_6$model[n,"trend(mortality_TS)"]
trend = seq(trend.start , trend.start + q/12, 1/12)

for(i in 1:q){
  weeks = array(0,51)
  weeks[(i-12)%%52] = 1
  print(weeks)

  data.new =c(1,m.frc[n-1+i],m.frc[n-2+i],weeks,trend[i],1,1)
  m.frc[n+i] = as.vector(task_1_model5_6$coefficients) %*% data.new
}

plot(mortality_TS,
     ylab='Mortality Rate',
     xlab='Year',
     main = "Next 4 weeks (41 - 44) prediction of disease specific Mortality Rate in Paris")

lines(ts(m.frc[(n+1):(n+q)],
         start=c(2019,41), frequency = 52),
      col = "#f01b1d")

legend("topleft",
       lty = 1,
       col = c("black", "#f01b1d"),
       c("Data", "Prediction"))

#Prediction Points
t1_Time_point <- c("41, 2019", "42, 2019", "43, 2019", "44, 2019")
t1_points <- m.frc[(n+1):(n+q)]

t1_prediction_points <- data.frame(t1_Time_point, t1_points)
colnames(t1_prediction_points) = c("Time","Point Forecast")

kable(t1_prediction_points) %>% kable_paper()

#------------------------------------------------------#
#----------------------Task - 2------------------------#
#------------------------------------------------------#

## Data Preparation

FFD_df <- read_csv("FFD.csv")
FFD_prediction <- read_csv("Covariate x-values for Task 2.csv")
FFD_prediction = na.omit(FFD_prediction)

head(FFD_df)
class(FFD_df)

FFD_df <- FFD_df[,-c(1)]
FFD_df_TS <- ts(FFD_df, start = 1984)

temp_2_TS <- ts(FFD_df$Temperature, start = 1984)
rain_TS <- ts(FFD_df$Rainfall, start = 1984)
radiation_TS <- ts(FFD_df$Radiation, start = 1984)
humidity_TS <- ts(FFD_df$RelHumidity, start = 1984)
FFD_TS <- ts(FFD_df$FFD, start = 1984)

temp_next <- ts(FFD_prediction$Temperature,start =2015)
rain_next <- ts(FFD_prediction$Rainfall,start =2015)
rad_next <- ts(FFD_prediction$Radiation,start =2015)
hum_next <- ts(FFD_prediction$RelHumidity,start =2015)

FFD_df_TS %>% head()
class(FFD_df_TS)

##### 1. Temperature
temp_2_TS %>% head()
class(temp_2_TS)

##### 2. Rainfall
rain_TS %>% head()
class(rain_TS)

##### 3. Radiation Level
radiation_TS %>% head()
class(radiation_TS)

##### 4. Relative Humidity
humidity_TS %>% head()
class(humidity_TS)

##### 5. Fist Day of Flowering
FFD_TS %>% head()
class(FFD_TS)

## Descriptive Analysis

##### 1. First Day of Flowering
descriptive_analysis(FFD_TS, "day of first flowering")

##### 2. Temperature
descriptive_analysis(temp_2_TS, "Averaged yearly temperature")

##### 3. Rainfall
descriptive_analysis(rain_TS, "Averaged  yearly rainfall")

##### 4. Radiation Level
descriptive_analysis(radiation_TS, "Averaged yearly radiation level")

##### 5. Relative Humidity
descriptive_analysis(humidity_TS, "Averaged yearly relative humidity")

##### 6. Combine Scaled Time Series Plot
combined <- scale(FFD_df_TS)

plot(combined,
     plot.type="s",
     col = c("#05386b","#f01b1d","#5c3c92","#d2601a","#1b6535"),
     main = "Scaled Time Series Plot of plant's day of first flowering and
     contemporaneous averaged yearly climate variables")

legend("topleft",
       lty=1,
       col = c("#05386b","#f01b1d","#5c3c92","#d2601a","#1b6535"),
       c("Temperature", "Rainfall", "Radiation Level", "Relative Humidity" , "FFD"))

#Correlation
cor(FFD_df_TS) %>% round(3)

## Time Series Regression Methods
### Finite Distributed Lag Model
##### 1.Temperature
for (i in 1:8)
{
  model_dlm <- dlm(formula = FFD ~ Temperature, data = data.frame(FFD_df), q = i)
  cat("q = ", i,
      "AIC = ", AIC(model_dlm$model),
      "BIC = ", BIC(model_dlm$model),
      "MASE = ", MASE(model_dlm)$MASE, "\n")
}

task2_temp1 <- dlm(formula = FFD ~ Temperature,
                   data = data.frame(FFD_df),
                   q = 8)

summary_residual_analysis(task2_temp1)

#Temperature without Intercept
task2_temp1_a <- dlm(formula = FFD ~ Temperature -1,
                     data = data.frame(FFD_df),
                     q = 8)

summary_residual_analysis(task2_temp1_a)

##### 2.Rainfall
for (i in 1:8)
{
  model_dlm <- dlm(formula = FFD ~ Rainfall, data = data.frame(FFD_df), q = i)
  cat("q = ", i,
      "AIC = ", AIC(model_dlm$model),
      "BIC = ", BIC(model_dlm$model),
      "MASE = ", MASE(model_dlm)$MASE, "\n")
}

task2_rain1 <- dlm(formula = FFD ~ Rainfall,
                   data = data.frame(FFD_df),
                   q = 8)

summary_residual_analysis(task2_rain1)

#Rainfall without Intercept
task2_rain1_a <- dlm(formula = FFD ~ Rainfall -1,
                     data = data.frame(FFD_df),
                     q = 8)

summary_residual_analysis(task2_rain1_a)

##### 3.Radiation Level
for (i in 1:8)
{
  model_dlm <- dlm(formula = FFD ~ Radiation, data = data.frame(FFD_df), q = i)
  cat("q = ", i,
      "AIC = ", AIC(model_dlm$model),
      "BIC = ", BIC(model_dlm$model),
      "MASE = ", MASE(model_dlm)$MASE, "\n")
}

task2_rad1 <- dlm(formula = FFD ~ Radiation,
                  data = data.frame(FFD_df),
                  q = 8)

summary_residual_analysis(task2_rad1)

#Radiation Level without Intercept
task2_rad1_a <- dlm(formula = FFD ~ Radiation -1,
                    data = data.frame(FFD_df),
                    q = 8)

summary_residual_analysis(task2_rad1_a)

##### 4.Relative Humidity
for (i in 1:8)
{
  model_dlm <- dlm(formula = FFD ~ RelHumidity, data = data.frame(FFD_df), q = i)
  cat("q = ", i,
      "AIC = ", AIC(model_dlm$model),
      "BIC = ", BIC(model_dlm$model),
      "MASE = ", MASE(model_dlm)$MASE, "\n")
}

task2_hum1 <- dlm(formula = FFD ~ RelHumidity,
                  data = data.frame(FFD_df),
                  q = 8)

summary_residual_analysis(task2_hum1)

#Relative Humidity without Intercept
task2_hum1_a <- dlm(formula = FFD ~ RelHumidity -1,
                    data = data.frame(FFD_df),
                    q = 8)

summary_residual_analysis(task2_hum1_a)

#### Model Comparison
DLM_models <- c("Temperature", "Temperature without Intercept",
                "Rainfall", "Rainfall without Intercept",
                "Radiation Level" , "Radiation Level without Intercept",
                "Relative Humidity","Relative Humidity without Intercept")

DLM_aic <- AIC(task2_temp1$model, task2_temp1_a$model, task2_rain1$model, task2_rain1_a$model, task2_rad1$model,
               task2_rad1_a$model, task2_hum1$model, task2_hum1_a$model)$AIC

DLM_bic <- BIC(task2_temp1$model, task2_temp1_a$model, task2_rain1$model, task2_rain1_a$model, task2_rad1$model,
               task2_rad1_a$model, task2_hum1$model, task2_hum1_a$model)$BIC

DLM_mase <- MASE(task2_temp1$model, task2_temp1_a$model, task2_rain1$model, task2_rain1_a$model, task2_rad1$model,
                 task2_rad1_a$model, task2_hum1$model, task2_hum1_a$model)$MASE

DLM_Model_Comparison <- data.frame(DLM_models, DLM_mase, DLM_aic, DLM_bic)
colnames(DLM_Model_Comparison) <- c("DLM Model","MASE","AIC", "BIC")

kbl(DLM_Model_Comparison) %>% kable_paper()

### PolyNomial Distributed Lag Model
##### 1.Temperature
task_2_temp2 = polyDlm(y = as.vector(FFD_df$FFD),
                       x = as.vector(FFD_df$Temperature),
                       q = 8,
                       k = 2,
                       show.beta = TRUE)

summary_residual_analysis(task_2_temp2)

##### 2.Rainfall
task_2_rain2 = polyDlm(y = as.vector(FFD_df$FFD),
                       x = as.vector(FFD_df$Rainfall),
                       q = 8,
                       k = 2,
                       show.beta = TRUE)

summary_residual_analysis(task_2_rain2)

##### 3. Radiation Level
task_2_rad2 = polyDlm(y = as.vector(FFD_df$FFD),
                      x = as.vector(FFD_df$Radiation),
                      q = 8,
                      k = 2,
                      show.beta = TRUE)

summary_residual_analysis(task_2_rad2)

##### 4. Relative Humidity
task_2_hum2 = polyDlm(y = as.vector(FFD_df$FFD),
                      x = as.vector(FFD_df$RelHumidity),
                      q = 8,
                      k = 2,
                      show.beta = TRUE)

summary_residual_analysis(task_2_hum2)

#### Model Comparison
poly_models <- c("Temperature", "Rainfall", "Radiation Level", "Relative Humidity")

poly_aic <- AIC(task_2_temp2$model, task_2_rain2$model, task_2_rad2$model, task_2_hum2$model)$AIC

poly_bic <- BIC(task_2_temp2$model, task_2_rain2$model, task_2_rad2$model, task_2_hum2$model)$BIC

poly_mase <- MASE(task_2_temp2$model, task_2_rain2$model, task_2_rad2$model, task_2_hum2$model)$MASE

poly_Model_Comparison <- data.frame(poly_models, poly_mase, poly_aic, poly_bic)
colnames(poly_Model_Comparison) <- c("Poly Model","MASE","AIC", "BIC")

kbl(poly_Model_Comparison) %>% kable_paper()

### Koyck Distributed Lag Model
##### 1.Temperature
task_2_temp3 = koyckDlm(x = as.vector(FFD_df$Temperature),
                        y = as.vector(FFD_df$FFD))
summary_residual_analysis(task_2_temp3)

##### 2.Rainfall
task_2_rain3 = koyckDlm(x = as.vector(FFD_df$Rainfall),
                        y = as.vector(FFD_df$FFD))
summary_residual_analysis(task_2_rain3)

##### 3.Radiation Level
task_2_rad3 = koyckDlm(x = as.vector(FFD_df$Radiation),
                       y = as.vector(FFD_df$FFD))
summary_residual_analysis(task_2_rad3)

##### 4.Relative Humidity
task_2_hum3 = koyckDlm(x = as.vector(FFD_df$RelHumidity),
                       y = as.vector(FFD_df$FFD))
summary_residual_analysis(task_2_hum3)

#### Model Comparison
koyck_models <- c("Temperature", "Rainfall", "Radiation Level", "Relative Humidity")

koyck_aic <- c(AIC(task_2_temp3), AIC(task_2_rain3), AIC(task_2_rad3), AIC(task_2_hum3))

koyck_bic <- c(BIC(task_2_temp3), BIC(task_2_rain3), BIC(task_2_rad3), BIC(task_2_hum3))

koyck_mase <- MASE(lm(task_2_temp3$model), lm(task_2_rain3$model), lm(task_2_rad3$model), lm(task_2_hum3$model))$MASE

koyck_Model_Comparison <- data.frame(koyck_models, koyck_mase, koyck_aic, koyck_bic)
colnames(koyck_Model_Comparison) <- c("Koyck Model","MASE","AIC", "BIC")

kbl(koyck_Model_Comparison) %>% kable_paper()

### Autoregressive Distributed Lag Model
##### 1. Temperature
for (i in 1:5)
{
  for(j in 1:5)
  {
    model_ardlm <- ardlDlm(formula = FFD ~ Temperature,
                           data = data.frame(FFD_df),
                           p = i,
                           q = j)
    cat("p =", i,
        "q =" , j,
        "AIC =", AIC(model_ardlm$model),
        "BIC =", BIC(model_ardlm$model),
        "MASE =", MASE(model_ardlm)$MASE, "\n")
  }
}

#ardlDLM(3,1)
task_2_temp4_1 = ardlDlm(formula = FFD ~ Temperature,
                         data = data.frame(FFD_df),
                         p = 3,
                         q = 1)

summary_residual_analysis(task_2_temp4_1)

task_2_temp4_1_a = ardlDlm(formula = FFD ~ Temperature -1,
                           data = data.frame(FFD_df),
                           p = 3,
                           q = 1)

summary_residual_analysis(task_2_temp4_1_a)

#ardlDLM(4,1)
task_2_temp4_2 = ardlDlm(formula = FFD ~ Temperature,
                         data = data.frame(FFD_df),
                         p = 4,
                         q = 1)

summary_residual_analysis(task_2_temp4_2)

task_2_temp4_2_a = ardlDlm(formula = FFD ~ Temperature -1,
                           data = data.frame(FFD_df),
                           p = 4,
                           q = 1)

summary_residual_analysis(task_2_temp4_2_a)

#ardlDLM(5,1)
task_2_temp4_3 = ardlDlm(formula = FFD ~ Temperature,
                         data = data.frame(FFD_df),
                         p = 5,
                         q = 1)

summary_residual_analysis(task_2_temp4_3)

task_2_temp4_3_a = ardlDlm(formula = FFD ~ Temperature - 1,
                           data = data.frame(FFD_df),
                           p = 5,
                           q = 1)

summary_residual_analysis(task_2_temp4_3_a)

##### 2.Rainfall
for (i in 1:5)
{
  for(j in 1:5)
  {
    model_ardlm <- ardlDlm(formula = FFD ~ Rainfall,
                           data = data.frame(FFD_df),
                           p = i,
                           q = j)
    cat("p =", i,
        "q =" , j,
        "AIC =", AIC(model_ardlm$model),
        "BIC =", BIC(model_ardlm$model),
        "MASE =", MASE(model_ardlm)$MASE, "\n")
  }
}

#ardlDLM(3,1)
task_2_rain4_1 = ardlDlm(formula = FFD ~ Rainfall,
                         data = data.frame(FFD_df),
                         p = 3,
                         q = 1)

summary_residual_analysis(task_2_rain4_1)

task_2_rain4_1_a = ardlDlm(formula = FFD ~ Rainfall -1,
                           data = data.frame(FFD_df),
                           p = 3,
                           q = 1)

summary_residual_analysis(task_2_rain4_1_a)

#ardlDLM(4,1)
task_2_rain4_2 = ardlDlm(formula = FFD ~ Rainfall,
                         data = data.frame(FFD_df),
                         p = 4,
                         q = 1)

summary_residual_analysis(task_2_rain4_2)

task_2_rain4_2_a = ardlDlm(formula = FFD ~ Rainfall -1,
                           data = data.frame(FFD_df),
                           p = 4,
                           q = 1)

summary_residual_analysis(task_2_rain4_2_a)

#ardlDLM(5,1)
task_2_rain4_3 = ardlDlm(formula = FFD ~ Rainfall,
                         data = data.frame(FFD_df),
                         p = 5,
                         q = 1)

summary_residual_analysis(task_2_rain4_3)

task_2_rain4_3_a = ardlDlm(formula = FFD ~ Rainfall -1,
                           data = data.frame(FFD_df),
                           p = 5,
                           q = 1)

summary_residual_analysis(task_2_rain4_3_a)

##### 3.Radiation Level
for (i in 1:5)
{
  for(j in 1:5)
  {
    model_ardlm <- ardlDlm(formula = FFD ~ Radiation,
                           data = data.frame(FFD_df),
                           p = i,
                           q = j)
    cat("p =", i,
        "q =" , j,
        "AIC =", AIC(model_ardlm$model),
        "BIC =", BIC(model_ardlm$model),
        "MASE =", MASE(model_ardlm)$MASE, "\n")
  }
}
#ardlDLM(3,1)
task_2_rad4_1 = ardlDlm(formula = FFD ~ Radiation,
                        data = data.frame(FFD_df),
                        p = 3,
                        q = 1)

summary_residual_analysis(task_2_rad4_1)

task_2_rad4_1_a = ardlDlm(formula = FFD ~ Radiation -1,
                          data = data.frame(FFD_df),
                          p = 3,
                          q = 1)

summary_residual_analysis(task_2_rad4_1_a)

#ardlDLM(4,1)
task_2_rad4_2 = ardlDlm(formula = FFD ~ Radiation,
                        data = data.frame(FFD_df),
                        p = 4,
                        q = 1)

summary_residual_analysis(task_2_rad4_2)

task_2_rad4_2_a = ardlDlm(formula = FFD ~ Radiation -1,
                          data = data.frame(FFD_df),
                          p = 4,
                          q = 1)

summary_residual_analysis(task_2_rad4_2_a)

#ardlDLM(5,1)
task_2_rad4_3 = ardlDlm(formula = FFD ~ Radiation,
                        data = data.frame(FFD_df),
                        p = 5,
                        q = 1)

summary_residual_analysis(task_2_rad4_3)

task_2_rad4_3_a = ardlDlm(formula = FFD ~ Radiation,
                          data = data.frame(FFD_df),
                          p = 5,
                          q = 1)

summary_residual_analysis(task_2_rad4_3_a)

##### 4.Relative Humidity
for (i in 1:5)
{
  for(j in 1:5)
  {
    model_ardlm <- ardlDlm(formula = FFD ~ RelHumidity,
                           data = data.frame(FFD_df),
                           p = i,
                           q = j)
    cat("p =", i,
        "q =" , j,
        "AIC =", AIC(model_ardlm$model),
        "BIC =", BIC(model_ardlm$model),
        "MASE =", MASE(model_ardlm)$MASE, "\n")
  }
}

#ardlDLM(3,1)
task_2_hum4_1 = ardlDlm(formula = FFD ~ RelHumidity,
                        data = data.frame(FFD_df),
                        p = 3,
                        q = 1)

summary_residual_analysis(task_2_hum4_1)

task_2_hum4_1_a = ardlDlm(formula = FFD ~ RelHumidity -1,
                          data = data.frame(FFD_df),
                          p = 3,
                          q = 1)

summary_residual_analysis(task_2_hum4_1_a)

#ardlDLM(4,1)
task_2_hum4_2 = ardlDlm(formula = FFD ~ RelHumidity,
                        data = data.frame(FFD_df),
                        p = 4,
                        q = 1)

summary_residual_analysis(task_2_hum4_2)

task_2_hum4_2_a = ardlDlm(formula = FFD ~ RelHumidity -1,
                          data = data.frame(FFD_df),
                          p = 4,
                          q = 1)

summary_residual_analysis(task_2_hum4_2_a)

#ardlDLM(5,1)
task_2_hum4_3 = ardlDlm(formula = FFD ~ RelHumidity,
                        data = data.frame(FFD_df),
                        p = 5,
                        q = 1)

summary_residual_analysis(task_2_hum4_3)

task_2_hum4_3_a = ardlDlm(formula = FFD ~ RelHumidity -1,
                          data = data.frame(FFD_df),
                          p = 5,
                          q = 1)

summary_residual_analysis(task_2_hum4_3_a)

#### Model Comparison
ARDL_models <- c("Temperature(3,1)", "Temperature(3,1) without Intercept",
                 "Temperature(4,1)", "Temperature(4,1) without Intercept",
                 "Temperature(5,1)", "Temperature(5,1) without Intercept",
                 "Rainfall(3,1)", "Rainfall(3,1) without Intercept",
                 "Rainfall(4,1)", "Rainfall(4,1) without Intercept",
                 "Rainfall(5,1)", "Rainfall(5,1) without Intercept",
                 "Radiation Level(3,1)", "Radiation Level(3,1) without Intercept",
                 "Radiation Level(4,1)", "Radiation Level(4,1) without Intercept",
                 "Radiation Level(5,1)", "Radiation Level(5,1) without Intercept",
                 "Relative Humidity(3,1)", "Relative Humidity(3,1) without Intercept",
                 "Relative Humidity(4,1)", "Relative Humidity(4,1) without Intercept",
                 "Relative Humidity(5,1)", "Relative Humidity(5,1) without Intercept")

ARDL_aic <- AIC(task_2_temp4_1$model, task_2_temp4_1_a$model,
                task_2_temp4_2$model, task_2_temp4_2_a$model,
                task_2_temp4_3$model, task_2_temp4_3_a$model,
                task_2_rain4_1$model, task_2_rain4_1_a$model,
                task_2_rain4_2$model, task_2_rain4_2_a$model,
                task_2_rain4_3$model, task_2_rain4_3_a$model,
                task_2_rad4_1$model, task_2_rad4_1_a$model,
                task_2_rad4_2$model, task_2_rad4_2_a$model,
                task_2_rad4_3$model, task_2_rad4_3_a$model,
                task_2_hum4_1$model, task_2_hum4_1_a$model,
                task_2_hum4_2$model, task_2_hum4_2_a$model,
                task_2_hum4_3$model, task_2_hum4_3_a$model)$AIC

ARDL_bic <- BIC(task_2_temp4_1$model, task_2_temp4_1_a$model,
                task_2_temp4_2$model, task_2_temp4_2_a$model,
                task_2_temp4_3$model, task_2_temp4_3_a$model,
                task_2_rain4_1$model, task_2_rain4_1_a$model,
                task_2_rain4_2$model, task_2_rain4_2_a$model,
                task_2_rain4_3$model, task_2_rain4_3_a$model,
                task_2_rad4_1$model, task_2_rad4_1_a$model,
                task_2_rad4_2$model, task_2_rad4_2_a$model,
                task_2_rad4_3$model, task_2_rad4_3_a$model,
                task_2_hum4_1$model, task_2_hum4_1_a$model,
                task_2_hum4_2$model, task_2_hum4_2_a$model,
                task_2_hum4_3$model, task_2_hum4_3_a$model)$BIC

ARDL_mase <- MASE(task_2_temp4_1, task_2_temp4_1_a,
                  task_2_temp4_2, task_2_temp4_2_a,
                  task_2_temp4_3,task_2_temp4_3_a,
                  task_2_rain4_1, task_2_rain4_1_a,
                  task_2_rain4_2, task_2_rain4_2_a,
                  task_2_rain4_3, task_2_rain4_3_a,
                  task_2_rad4_1, task_2_rad4_1_a,
                  task_2_rad4_2, task_2_rad4_2_a,
                  task_2_rad4_3, task_2_rad4_3_a,
                  task_2_hum4_1, task_2_hum4_1_a,
                  task_2_hum4_2, task_2_hum4_2_a,
                  task_2_hum4_3, task_2_hum4_3_a)$MASE

ARDL_Model_Comparison <- data.frame(ARDL_models, ARDL_mase, ARDL_aic, ARDL_bic)
colnames(ARDL_Model_Comparison) <- c("ARDL Model","MASE","AIC", "BIC")

kbl(ARDL_Model_Comparison) %>% kable_paper()

### Dynamic Models

##### 1.FFD
#dynlm_1
task_2_model5_1 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + trend(FFD_TS))
summary(task_2_model5_1)
checkresiduals(task_2_model5_1)

task_2_model5_1_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + trend(FFD_TS) -1)
summary(task_2_model5_1_a)
checkresiduals(task_2_model5_1_a)

#dynlm_2
task_2_model5_2 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + trend(FFD_TS))
summary(task_2_model5_2)
checkresiduals(task_2_model5_2)

task_2_model5_2_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + trend(FFD_TS) -1)
summary(task_2_model5_2_a)
checkresiduals(task_2_model5_2_a)

##### 2.Temperature
#dynlm_3
task_2_temp5_1 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + temp_2_TS + trend(FFD_TS))
summary(task_2_model5_1)
checkresiduals(task_2_model5_1)

task_2_temp5_1_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + temp_2_TS + trend(FFD_TS) -1)
summary(task_2_model5_1_a)
checkresiduals(task_2_model5_1_a)

#dynlm_4
task_2_temp5_2 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + temp_2_TS)
summary(task_2_temp5_2)
checkresiduals(task_2_temp5_2)

task_2_temp5_2_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + temp_2_TS -1)
summary(task_2_temp5_2_a)
checkresiduals(task_2_temp5_2_a)

##### 3.Rainfall
#dynlm_5
task_2_rain5_1 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + rain_TS + trend(FFD_TS))
summary(task_2_rain5_1)
checkresiduals(task_2_rain5_1)

task_2_rain5_1_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + rain_TS + trend(FFD_TS) -1)
summary(task_2_rain5_1_a)
checkresiduals(task_2_rain5_1_a)

#dynlm_6
task_2_rain5_2 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + rain_TS + trend(FFD_TS) )
summary(task_2_rain5_2)
checkresiduals(task_2_rain5_2)

task_2_rain5_2_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + rain_TS + trend(FFD_TS) -1)
summary(task_2_rain5_2_a)
checkresiduals(task_2_rain5_2_a)

#dynlm_7
task_2_rain5_3 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + rain_TS + L(rain_TS, k = 1) + trend(FFD_TS) )
summary(task_2_rain5_3)
checkresiduals(task_2_rain5_3)

task_2_rain5_3_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + rain_TS + L(rain_TS, k = 1) + trend(FFD_TS) -1)
summary(task_2_rain5_3_a)
checkresiduals(task_2_rain5_3_a)

##### 4.Radiation Level
#dynlm_8
task_2_rad5_1 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + radiation_TS + trend(FFD_TS))
summary(task_2_rad5_1)
checkresiduals(task_2_rad5_1)

task_2_rad5_1_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + radiation_TS + trend(FFD_TS) -1)
summary(task_2_rad5_1_a)
checkresiduals(task_2_rad5_1_a)

#dynlm_9
task_2_rad5_2 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + radiation_TS)
summary(task_2_model5_2)
checkresiduals(task_2_rad5_2)

task_2_rad5_2_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + radiation_TS -1)
summary(task_2_model5_2_a)
checkresiduals(task_2_rad5_2_a)

##### 5.Relative Humidity
#dynlm_10
task_2_hum5_1 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + humidity_TS + trend(FFD_TS))
summary(task_2_hum5_1)
checkresiduals(task_2_hum5_1)

task_2_hum5_1_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + humidity_TS + trend(FFD_TS) -1)
summary(task_2_hum5_1_a)
checkresiduals(task_2_hum5_1_a)

#dynlm_11
task_2_hum5_2 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + humidity_TS)
summary(task_2_hum5_2)
checkresiduals(task_2_hum5_2)

task_2_hum5_2_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + humidity_TS -1)
summary(task_2_hum5_2_a)
checkresiduals(task_2_hum5_2_a)

##### 6.Combination of Predictors
#dynlm_12
task_2_comb5_1 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + temp_2_TS + rain_TS + trend(FFD_TS))
summary(task_2_comb5_1)
checkresiduals(task_2_comb5_1)

task_2_comb5_1_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + temp_2_TS + rain_TS + trend(FFD_TS) -1)
summary(task_2_comb5_1_a)
checkresiduals(task_2_comb5_1_a)

#dynlm_13
task_2_comb5_2 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + temp_2_TS + rain_TS)
summary(task_2_comb5_2)
checkresiduals(task_2_comb5_2

task_2_comb5_2_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + temp_2_TS + rain_TS -1)
summary(task_2_comb5_2_a)
checkresiduals(task_2_comb5_2_a)

#dynlm_14
task_2_comb5_3 = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + temp_2_TS + rain_TS + trend(FFD_TS))
summary(task_2_comb5_3)
checkresiduals(task_2_comb5_3)

task_2_comb5_3_a = dynlm(FFD_TS ~ L(FFD_TS , k = 1 ) + L(FFD_TS , k = 2 ) + temp_2_TS + rain_TS + trend(FFD_TS) -1)
summary(task_2_comb5_3_a)
checkresiduals(task_2_comb5_3_a)

#### Model Comparison
dynlm_models <- c("dynlm_1", "dynlm_1 without Intercept",
                  "dynlm_2", "dynlm_2 without Intercept",
                  "dynlm_3", "dynlm_3 without Intercept",
                  "dynlm_4", "dynlm_4 without Intercept",
                  "dynlm_5", "dynlm_5 without Intercept",
                  "dynlm_6", "dynlm_6 without Intercept",
                  "dynlm_7", "dynlm_7 without Intercept",
                  "dynlm_8", "dynlm_8 without Intercept",
                  "dynlm_9", "dynlm_9 without Intercept",
                  "dynlm_10", "dynlm_10 without Intercept",
                  "dynlm_11", "dynlm_11 without Intercept",
                  "dynlm_12", "dynlm_12 without Intercept",
                  "dynlm_13", "dynlm_13 without Intercept",
                  "dynlm_14", "dynlm_14 without Intercept")

dynlm_x <- c(rep("FFD", 4), rep("Temperature", 4), rep("Rainfall", 6), rep("Radiation Level", 4),
             rep("Relative Humidity", 4), rep("Temperature + Rainfall", 6))

dynlm_aic <- c(AIC(task_2_model5_1), AIC(task_2_model5_1_a),
               AIC(task_2_model5_2), AIC(task_2_model5_2_a),
               AIC(task_2_temp5_1), AIC(task_2_temp5_1_a),
               AIC(task_2_temp5_2), AIC(task_2_temp5_2_a),
               AIC(task_2_rain5_1), AIC(task_2_rain5_1_a),
               AIC(task_2_rain5_2), AIC(task_2_rain5_2_a),
               AIC(task_2_rain5_3), AIC(task_2_rain5_3_a),
               AIC(task_2_rad5_1), AIC(task_2_rad5_1_a),
               AIC(task_2_rad5_2), AIC(task_2_rad5_2_a),
               AIC(task_2_hum5_1), AIC(task_2_hum5_1_a),
               AIC(task_2_hum5_2), AIC(task_2_hum5_2_a),
               AIC(task_2_comb5_1), AIC(task_2_comb5_1_a),
               AIC(task_2_comb5_2), AIC(task_2_comb5_2_a),
               AIC(task_2_comb5_3), AIC(task_2_comb5_3_a))

dynlm_bic <- c(BIC(task_2_model5_1), BIC(task_2_model5_1_a),
               BIC(task_2_model5_2), BIC(task_2_model5_2_a),
               BIC(task_2_temp5_1), BIC(task_2_temp5_1_a),
               BIC(task_2_temp5_2), BIC(task_2_temp5_2_a),
               BIC(task_2_rain5_1), BIC(task_2_rain5_1_a),
               BIC(task_2_rain5_2), BIC(task_2_rain5_2_a),
               BIC(task_2_rain5_3), BIC(task_2_rain5_3_a),
               BIC(task_2_rad5_1), BIC(task_2_rad5_1_a),
               BIC(task_2_rad5_2), BIC(task_2_rad5_2_a),
               BIC(task_2_hum5_1), BIC(task_2_hum5_1_a),
               BIC(task_2_hum5_2), BIC(task_2_hum5_2_a),
               BIC(task_2_comb5_1), BIC(task_2_comb5_1_a),
               BIC(task_2_comb5_2), BIC(task_2_comb5_2_a),
               BIC(task_2_comb5_3), BIC(task_2_comb5_3_a))

dynlm_mase <- c(MASE(lm(task_2_model5_1))$MASE, MASE(lm(task_2_model5_1_a))$MASE,
                MASE(lm(task_2_model5_2))$MASE, MASE(lm(task_2_model5_2_a))$MASE,
                MASE(lm(task_2_temp5_1))$MASE, MASE(lm(task_2_temp5_1_a))$MASE,
                MASE(lm(task_2_temp5_2))$MASE, MASE(lm(task_2_temp5_2_a))$MASE,
                MASE(lm(task_2_rain5_1))$MASE, MASE(lm(task_2_rain5_1_a))$MASE,
                MASE(lm(task_2_rain5_2))$MASE, MASE(lm(task_2_rain5_2_a))$MASE,
                MASE(lm(task_2_rain5_3))$MASE, MASE(lm(task_2_rain5_3_a))$MASE,
                MASE(lm(task_2_rad5_1))$MASE, MASE(lm(task_2_rad5_1_a))$MASE,
                MASE(lm(task_2_rad5_2))$MASE, MASE(lm(task_2_rad5_2_a))$MASE,
                MASE(lm(task_2_hum5_1))$MASE, MASE(lm(task_2_hum5_1_a))$MASE,
                MASE(lm(task_2_hum5_2))$MASE, MASE(lm(task_2_hum5_2_a))$MASE,
                MASE(lm(task_2_comb5_1))$MASE, MASE(lm(task_2_comb5_1_a))$MASE,
                MASE(lm(task_2_comb5_2))$MASE, MASE(lm(task_2_comb5_2_a))$MASE,
                MASE(lm(task_2_comb5_3))$MASE, MASE(lm(task_2_comb5_3_a))$MASE)

dynlm_Model_Comparison <- data.frame(dynlm_models, dynlm_x, dynlm_mase, dynlm_aic, dynlm_bic)
colnames(dynlm_Model_Comparison) <- c("dynlm Model","Predictors","MASE","AIC", "BIC")

kbl(dynlm_Model_Comparison) %>% kable_paper()

## Exponential smoothing methods
T2_holt_models = c("Damped Holt's method with exponential trend",
                   "Damped Holt's method",
                   "Holt's method with exponential trend",
                   "Holt's method")

T2_exponential = c(TRUE,FALSE)
T2_damped = c(TRUE,FALSE)
T2_exponential_models <- expand.grid(T2_exponential, T2_damped)
T2_Holt_AIC <- array(NA, 4)
T2_Holt_BIC <- array(NA, 4)
T2_Holt_MASE <- array(NA, 4)
T2_levels <- array(NA, dim=c(4,2))

for (i in 1:4)
{
  T2_Holt_model <- holt(FFD_TS,
                        exponential = T2_exponential_models[i,1],
                        damped = T2_exponential_models[i,2],
                        h = 4)

  T2_Holt_AIC[i] <- T2_Holt_model$model$aic
  T2_Holt_BIC[i] <- T2_Holt_model$model$bic
  T2_Holt_MASE[i] <- accuracy(T2_Holt_model)[6]
  T2_levels[i,1] <- T2_exponential_models[i,1]
  T2_levels[i,2] <- T2_exponential_models[i,2]
  summary(T2_Holt_model)
  checkresiduals(T2_Holt_model)
  print(shapiro.test(T2_Holt_model$model$residuals))
}

T2_results_Holt = data.frame(T2_holt_models, T2_levels, T2_Holt_MASE, T2_Holt_AIC, T2_Holt_BIC)
colnames(T2_results_Holt) = c("Model", "Exponential","Damped","MASE","AIC", "BIC")

kbl(T2_results_Holt) %>% kable_paper()

#Formating T2_results_Holt table
T2_results_Holt$Damped <- factor(T2_results_Holt$Damped,
                                 levels = c(TRUE, FALSE),
                                 labels = c("damped"," "))

T2_results_Holt <- unite(T2_results_Holt,
                         "Model", c("Model","Damped"), sep = "_")

T2_results_Holt <- T2_results_Holt[,-c(2)]
kbl(T2_results_Holt) %>% kable_paper()

## State-space Models

T2_ets_models = c("AAN", "MAN", "MMN")
T2_damped = c(TRUE,FALSE)
T2_ETS_models <- expand.grid(T2_ets_models, T2_damped)

T2_ETS_AIC <- array(NA, 6)
T2_ETS_BIC <- array(NA, 6)
T2_ETS_MASE <- array(NA, 6)
T2_levels <- array(NA, dim=c(6,2))

for (i in 1:6){
  T2_ETS <- ets(FFD_TS,
                model = toString(T2_ETS_models[i, 1]),
                damped = T2_ETS_models[i,2])
  T2_ETS_AIC[i] <- T2_ETS$aic
  T2_ETS_BIC[i] <- T2_ETS$bic
  T2_ETS_MASE[i] <- accuracy(T2_ETS)[6]
  T2_levels[i,1] <- toString(T2_ETS_models[i,1])
  T2_levels[i,2] <- T2_ETS_models[i,2]
  print(summary(T2_ETS))
  checkresiduals(T2_ETS)
  print(shapiro.test(T2_ETS$residuals))
}

T2_results_ETS = data.frame(T2_levels, T2_ETS_MASE, T2_ETS_AIC, T2_ETS_BIC)
colnames(T2_results_ETS) = c("Model","Damped","MASE","AIC", "BIC")

kbl(T2_results_ETS) %>% kable_paper()

#Formating T2_results_ETS table
T2_results_ETS$Damped <- factor(T2_results_ETS$Damped,
                                levels = c(TRUE, FALSE),
                                labels = c("damped"," "))

T2_results_ETS <- unite(T2_results_ETS,
                        "Model", c("Model","Damped"), sep = "_")

kbl(T2_results_ETS) %>% kable_paper()

## Forecasting
### Finite Distributed Lag Model
#Following table display the Finite Distributed Lag modesl with respective `MASE, AIC, BIC`  in ascending order of `MASE`
DLM_sorted_MASE <- DLM_Model_Comparison %>% arrange(MASE)

kbl(DLM_sorted_MASE) %>% kable_paper()

Finite DLM model with Intercept and `Rainfall` as predictor gives the lowest `MASE(), AIC(), BIC()`

Prediction Chart

DLM_forecasting <-dLagM::forecast(task2_rain1,x = as.vector(rain_next),h=4)

plot(ts(c(as.vector(FFD_TS), as.vector(DLM_forecasting$forecasts)),start =1984),
     col ="#f01b1d",
     xlim = c(1984,2019.5),type = 'l',
     ylab ="FFD",
     main ="Forecast of Fisrt Flowreing Day(DLM), x=rainfall")

lines(FFD_TS,type = 'l')

legend("topleft",
       lty = 1,
       col = c("black", "#f01b1d"),
       c("Data", "Prediction"))

#Prediction Points
t2_Time_point <- c("2015", "2016", "2017", "2018")
t2_DLM_points <- DLM_forecasting$forecasts

t2_DLM_prediction_points <- data.frame(t2_Time_point, t2_DLM_points)
colnames(t2_DLM_prediction_points) = c("Time","Point Forecast")

kable(t2_DLM_prediction_points) %>% kable_paper()

### PolyNomial Distributed Lag Model
#Following table display the Polynomial Distributed Lag modesl with respective `MASE, AIC, BIC`  in ascending order of `MASE`
poly_sorted_MASE <- poly_Model_Comparison %>% arrange(MASE)

kbl(poly_sorted_MASE) %>% kable_paper()

#Prediction Chart
poly_forecasting <- dLagM::forecast(task_2_rain2,x = as.vector(rain_next),h=4)

plot(ts(c(as.vector(FFD_TS), as.vector(poly_forecasting$forecasts)),start =1984),
     col ="#f01b1d",
     xlim = c(1984,2019.5),type = 'l',
     ylab ="FFD",
     main ="Forecast of Fisrt Flowreing Day (polyDLM), x=rainfall")

lines(FFD_TS,type = 'l')

legend("topleft",
       lty = 1,
       col = c("black", "#f01b1d"),
       c("Data", "Prediction"))

#Prediction Points
t2_interval_poly = dLagM::forecast(interval = TRUE, task_2_rain2, x = as.vector(rain_next),h=4)
t2_interval_poly$forecasts

### Koyck Distributed Lag Model
#Following table display the Koyck Distributed Lag modesl with respective `MASE, AIC, BIC`  in ascending order of `MASE`
koyck_sorted_MASE <- koyck_Model_Comparison %>% arrange(MASE)

kbl(koyck_sorted_MASE) %>% kable_paper()

#Prediction Chart
koyck_forecasting <- dLagM::forecast(task_2_temp3,x = as.vector(temp_next),h=4)

plot(ts(c(as.vector(FFD_TS), as.vector(koyck_forecasting$forecasts)),start =1984),
     col ="#f01b1d",
     xlim = c(1984,2019.5),type = 'l',
     ylab ="FFD",
     main ="Forecast of Fisrt Flowreing Day (Koyck DLM), x=temp")

lines(FFD_TS,type = 'l')

legend("topleft",
       lty = 1,
       col = c("black", "#f01b1d"),
       c("Data", "Prediction"))

#Prediction Points

t2_interval_koyck = dLagM::forecast(interval = TRUE, task_2_temp3, x = as.vector(temp_next),h=4)
t2_interval_koyck$forecasts

### Autoregressive Distributed Lag Model
#Following table display the Autoregressive Distributed Lag modesl with respective `MASE, AIC, BIC`  in ascending order of `MASE`
ARDL_sorted_MASE <- ARDL_Model_Comparison %>% arrange(MASE)

kbl(ARDL_sorted_MASE) %>% kable_paper()

ardlDLM(3,1) with Intercept and `x = temperature` gives the `lowest MASE()`, `2nd lowest AIC()` and `3rd lowest BIC()`
Prediction Chart

ardl_forecasting <- dLagM::forecast(task_2_temp4_1,x = as.vector(temp_next),h=4)

plot(ts(c(as.vector(FFD_TS), as.vector(ardl_forecasting$forecasts)),start =1984),
     col ="#f01b1d",
     xlim = c(1984,2019.5),type = 'l',
     ylab ="FFD",
     main ="Forecast of Fisrt Flowreing Day (ARDL DLM(3,1), x=temp)")

lines(FFD_TS,type = 'l')

legend("topleft",
       lty = 1,
       col = c("black", "#f01b1d"),
       c("Data", "Prediction"))

#Prediction Points

t2_interval_ardl = dLagM::forecast(interval = TRUE, task_2_temp4_1, x = as.vector(temp_next),h=4)
t2_interval_ardl$forecasts

### Dynamic Models
#Following table display the Dynamic Lag modesl with respective `MASE, AIC, BIC`  in ascending order of `MASE`
dynlm_sorted_MASE <- dynlm_Model_Comparison %>% arrange(MASE)

kbl(dynlm_sorted_MASE) %>% kable_paper()

# Prediction Chart
q = 4
n = nrow(task_2_rain5_3$model)
ffd.frc = array(NA , (n + q))
ffd.frc[1:n] = FFD_TS[3:length(FFD_TS)]
trend = array(NA,q)
trend.start = task_2_rain5_3$model[n,"trend(FFD_TS)"]
trend = seq(trend.start , trend.start + q/12, 1/12)

for(i in 1:q){
  data.new = c(1,ffd.frc[n-1+i],ffd.frc[n-2+i],1,1,trend[i])
  ffd.frc[n+i] = as.vector(task_2_rain5_3$coefficients) %*% data.new
}

plot(FFD_TS,xlim=c(1984,2018),
     ylab='FFD',xlab='Year',
     main = "Next 4 years prediction of First Flowering Day in specific plant")

lines(ts(ffd.frc[(n+1):(n+q)],start=c(2015)),col="#f01b1d")

legend("topleft",
       lty = 1,
       col = c("black", "#f01b1d"),
       c("Data", "Prediction"))

#Prediction Points
t2_points_dynlm <- ffd.frc[(n+1):(n+q)]

t2_dynlm_prediction_points <- data.frame(t2_Time_point, t2_points_dynlm)
colnames(t2_dynlm_prediction_points) = c("Time","Point Forecast")

kable(t2_dynlm_prediction_points) %>% kable_paper()

t2_points_dynlm

### Exponential Smoothing Models
#Following table display the Exponential Smoothing modesl with respective `MASE, AIC, BIC`  in ascending order of `MASE`
Holt_sorted_MASE <- T2_results_Holt %>% arrange(MASE)

kbl(Holt_sorted_MASE) %>% kable_paper()

#Prediction Chart
prediction_holt <- holt(FFD_TS,
                        damped = FALSE,
                   h = 4)

plot(prediction_holt,
     main = "Next four years prediction of FFD using Exponential Smoothing Model",
     ylab = "FFD",
     fcol = "#f01b1d")

legend("topleft",
       lty = 1,
       col = c("black", "#f01b1d"),
       c("Data", "Prediction"))

#Prediction Points
kbl(prediction_holt) %>% kable_paper()

### State-Space Models
#Following table display the State space modesl with respective `MASE, AIC, BIC`  in ascending order of `MASE`
ETS_sorted_MASE <- T2_results_ETS %>% arrange(MASE)

kbl(ETS_sorted_MASE) %>% kable_paper()

#Prediction Chart
prediction_ETS_2 <- ets(FFD_TS,
                        model="AAN",
                        damped = F)
prediction_ETS_2 <- forecast(prediction_ETS_2)

plot(prediction_ETS_2,
     main = "Next four years prediction of FFD using ETS(A,A,N) model",
     ylab = "FFD",
     fcol = "#f01b1d")

legend("topleft",
       lty = 1,
       col = c("black", "#f01b1d"),
       c("Data", "Prediction"))

#Prediction Points
kbl(prediction_ETS_2) %>% kable_paper()

#-----------------------------------------------------------#
#------------------------Task - 3(a)------------------------#
#-----------------------------------------------------------#

## Data Preparation
RBO_df <- read_csv("D:/Study_Material/SEM_4/Forecasting/Assignment3/RBO.csv")
RBO_prediction <- read_csv("D:/Study_Material/SEM_4/Forecasting/Assignment3/Covariate x-values for Task 3.csv")

RBO_prediction = na.omit(RBO_prediction)

head(RBO_df)
class(RBO_df)

RBO_df <- RBO_df[,-c(1)]
RBO_df_TS <- ts(RBO_df, start = 1984)

RBO_TS <- ts(RBO_df$RBO, start = 1984)
temp_3_TS <- ts(RBO_df$Temperature, start = 1984)
rain_2_TS <- ts(RBO_df$Rainfall, start = 1984)
radiation_2_TS <- ts(RBO_df$Radiation, start = 1984)
humidity_2_TS <- ts(RBO_df$RelHumidity, start = 1984)

temp_2_next <- ts(RBO_prediction$Temperature,start =2015)
rain_2_next <- ts(RBO_prediction$Rainfall,start =2015)
rad_2_next <- ts(RBO_prediction$Radiation,start =2015)
hum_2_next <- ts(RBO_prediction$RelHumidity,start =2015)

RBO_df_TS %>% head()
class(RBO_df_TS)

##### 1.Temperature
temp_3_TS %>% head()
class(temp_3_TS)

##### 2.Rainfall
rain_2_TS %>% head()
class(rain_2_TS)

##### 3.Radiation Level
radiation_2_TS %>% head()
class(radiation_2_TS)

##### 4.Relative Humidity
humidity_2_TS %>% head()
class(humidity_2_TS)

##### 5.Rank-based Flowering-Order similarity metric (RBO)
RBO_TS %>% head()
class(RBO_TS)

## Descriptive Analysis
##### 1.Rank-based Flowering-Order (RBO)
descriptive_analysis(RBO_TS, "Rank-based Flowering-Order similarity metric (RBO)")

##### 2. Temperature
descriptive_analysis(temp_3_TS, "Averaged yearly temperature")

##### 3. Rainfall
descriptive_analysis(rain_2_TS, "Averaged  yearly rainfall")

##### 4. Radiation Level
descriptive_analysis(radiation_2_TS, "Averaged yearly radiation level")

##### 5. Relative Humidity
descriptive_analysis(humidity_2_TS, "Averaged yearly relative humidity")

##### 6. Combine Scaled Time Series Plot
combined <- scale(RBO_df_TS)

plot(combined,
     plot.type="s",
     col = c("#05386b","#f01b1d","#5c3c92","#d2601a","#1b6535"),
     main = "Scaled Time Series Plot of RBO similarity values and
     contemporaneous averaged yearly climate variables")

legend("topleft",
       lty=1,
       col = c("#05386b","#f01b1d","#5c3c92","#d2601a","#1b6535"),
       c("RBO","Temperature", "Rainfall", "Radiation Level", "Relative Humidity"))

#Correlation
cor(RBO_df_TS) %>% round(3)

## Time Series Regression Methods
### Finite Distributed Lag Model
##### 1.Temperature
for (i in 1:8)
{
  model_dlm <- dlm(formula = RBO ~ Temperature, data = data.frame(RBO_df), q = i)
  cat("q = ", i,
      "AIC = ", AIC(model_dlm$model),
      "BIC = ", BIC(model_dlm$model),
      "MASE = ", MASE(model_dlm)$MASE, "\n")
}

task3_temp1 <- dlm(formula = RBO ~ Temperature,
                   data = data.frame(RBO_df),
                   q = 8)

summary_residual_analysis(task3_temp1)

##### 2.Rainfall
for (i in 1:8)
{
  model_dlm <- dlm(formula = RBO ~ Rainfall, data = data.frame(RBO_df), q = i)
  cat("q = ", i,
      "AIC = ", AIC(model_dlm$model),
      "BIC = ", BIC(model_dlm$model),
      "MASE = ", MASE(model_dlm)$MASE, "\n")
}

task3_rain1 <- dlm(formula = RBO ~ Rainfall,
                   data = data.frame(RBO_df),
                   q = 8)

summary_residual_analysis(task3_rain1)

##### 3.Radiation Level
for (i in 1:8)
{
  model_dlm <- dlm(formula = RBO ~ Radiation, data = data.frame(RBO_df), q = i)
  cat("q = ", i,
      "AIC = ", AIC(model_dlm$model),
      "BIC = ", BIC(model_dlm$model),
      "MASE = ", MASE(model_dlm)$MASE, "\n")
}

task3_rad1 <- dlm(formula = RBO ~ Radiation,
                  data = data.frame(RBO_df),
                  q = 8)

summary_residual_analysis(task3_rad1)

##### 4.Relative Humidity
for (i in 1:8)
{
  model_dlm <- dlm(formula = RBO ~ RelHumidity, data = data.frame(RBO_df), q = i)
  cat("q = ", i,
      "AIC = ", AIC(model_dlm$model),
      "BIC = ", BIC(model_dlm$model),
      "MASE = ", MASE(model_dlm)$MASE, "\n")
}

task3_hum1 <- dlm(formula = RBO ~ RelHumidity,
                  data = data.frame(RBO_df),
                  q = 8)

summary_residual_analysis(task3_hum1)

### PolyNomial Distributed Lag Model
##### 1.Temperature
task_3_temp2 = polyDlm(y = as.vector(RBO_df$RBO),
                       x = as.vector(RBO_df$Temperature),
                       q = 8,
                       k = 2,
                       show.beta = TRUE)

summary_residual_analysis(task_3_temp2)

##### 2.Rainfall
task_3_rain2 = polyDlm(y = as.vector(RBO_df$RBO),
                       x = as.vector(RBO_df$Rainfall),
                       q = 8,
                       k = 2,
                       show.beta = TRUE)

summary_residual_analysis(task_3_rain2)

##### 3. Radiation Level
task_3_rad2 = polyDlm(y = as.vector(RBO_df$RBO),
                      x = as.vector(RBO_df$Radiation),
                      q = 8,
                      k = 2,
                      show.beta = TRUE)

summary_residual_analysis(task_3_rad2)

##### 4. Relative Humidity
task_3_hum2 = polyDlm(y = as.vector(RBO_df$RBO),
                      x = as.vector(RBO_df$RelHumidity),
                      q = 8,
                      k = 2,
                      show.beta = TRUE)

summary_residual_analysis(task_3_hum2)

### Koyck Distributed Lag Model
##### 1.Temperature
task_3_temp3 = koyckDlm(x = as.vector(RBO_df$Temperature),
                        y = as.vector(RBO_df$RBO))
summary_residual_analysis(task_3_temp3)

##### 2.Rainfall
task_3_rain3 = koyckDlm(x = as.vector(RBO_df$Rainfall),
                        y = as.vector(RBO_df$RBO))
summary_residual_analysis(task_3_rain3)

##### 3.Radiation Level
task_3_rad3 = koyckDlm(x = as.vector(RBO_df$Radiation),
                       y = as.vector(RBO_df$RBO))
summary_residual_analysis(task_3_rad3)

##### 4.Relative Humidity
task_3_hum3 = koyckDlm(x = as.vector(RBO_df$RelHumidity),
                       y = as.vector(RBO_df$RBO))
summary_residual_analysis(task_3_hum3)

### Autoregressive Distributed Lag Model
##### 1. Temperature
for (i in 1:5)
{
  for(j in 1:5)
  {
    model_ardlm <- ardlDlm(formula = RBO ~ Temperature,
                           data = data.frame(RBO_df),
                           p = i,
                           q = j)
    cat("p =", i,
        "q =" , j,
        "AIC =", AIC(model_ardlm$model),
        "BIC =", BIC(model_ardlm$model),
        "MASE =", MASE(model_ardlm)$MASE, "\n")
  }
}

#ardlDLM(1,3)
task_3_temp4_1 = ardlDlm(formula = RBO ~ Temperature,
                         data = data.frame(RBO_df),
                         p = 1,
                         q = 3)

summary_residual_analysis(task_3_temp4_1)

#ardlDLM(2,3)
task_3_temp4_2 = ardlDlm(formula = RBO ~ Temperature,
                         data = data.frame(RBO_df),
                         p = 2,
                         q = 3)

summary_residual_analysis(task_3_temp4_2)

#ardlDLM(3,3)
task_3_temp4_3 = ardlDlm(formula = RBO ~ Temperature,
                         data = data.frame(RBO_df),
                         p = 3,
                         q = 3)

summary_residual_analysis(task_3_temp4_3)

##### 2.Rainfall
for (i in 1:5)
{
  for(j in 1:5)
  {
    model_ardlm <- ardlDlm(formula = RBO ~ Rainfall,
                           data = data.frame(RBO_df),
                           p = i,
                           q = j)
    cat("p =", i,
        "q =" , j,
        "AIC =", AIC(model_ardlm$model),
        "BIC =", BIC(model_ardlm$model),
        "MASE =", MASE(model_ardlm)$MASE, "\n")
  }
}

#ardlDLM(1,3)
task_3_rain4_1 = ardlDlm(formula = RBO ~ Rainfall,
                         data = data.frame(RBO_df),
                         p = 1,
                         q = 3)

summary_residual_analysis(task_3_rain4_1)

#ardlDLM(2,3)
task_3_rain4_2 = ardlDlm(formula = RBO ~ Rainfall,
                         data = data.frame(RBO_df),
                         p = 2,
                         q = 3)

summary_residual_analysis(task_3_rain4_2)

#ardlDLM(3,3)
task_3_rain4_3 = ardlDlm(formula = RBO ~ Rainfall,
                         data = data.frame(RBO_df),
                         p = 3,
                         q = 3)

summary_residual_analysis(task_3_rain4_3)

##### 3.Radiation Level
for (i in 1:5)
{
  for(j in 1:5)
  {
    model_ardlm <- ardlDlm(formula = RBO ~ Radiation,
                           data = data.frame(RBO_df),
                           p = i,
                           q = j)
    cat("p =", i,
        "q =" , j,
        "AIC =", AIC(model_ardlm$model),
        "BIC =", BIC(model_ardlm$model),
        "MASE =", MASE(model_ardlm)$MASE, "\n")
  }
}

#ardlDLM(1,3)
task_3_rad4_1 = ardlDlm(formula = RBO ~ Radiation,
                        data = data.frame(RBO_df),
                        p = 1,
                        q = 3)

summary_residual_analysis(task_3_rad4_1)

#ardlDLM(2,3)
task_3_rad4_2 = ardlDlm(formula = RBO ~ Radiation,
                        data = data.frame(RBO_df),
                        p = 2,
                        q = 3)

summary_residual_analysis(task_3_rad4_2)

#ardlDLM(3,2)
task_3_rad4_3 = ardlDlm(formula = RBO ~ Radiation,
                        data = data.frame(RBO_df),
                        p = 3,
                        q = 2)

summary_residual_analysis(task_3_rad4_3)

##### 4.Relative Humidity
for (i in 1:5)
{
  for(j in 1:5)
  {
    model_ardlm <- ardlDlm(formula = RBO ~ RelHumidity,
                           data = data.frame(RBO_df),
                           p = i,
                           q = j)
    cat("p =", i,
        "q =" , j,
        "AIC =", AIC(model_ardlm$model),
        "BIC =", BIC(model_ardlm$model),
        "MASE =", MASE(model_ardlm)$MASE, "\n")
  }
}

#ardlDLM(1,2)
task_3_hum4_1 = ardlDlm(formula = RBO ~ RelHumidity,
                        data = data.frame(RBO_df),
                        p = 1,
                        q = 2)

summary_residual_analysis(task_3_hum4_1)

#ardlDLM(2,3)
task_3_hum4_2 = ardlDlm(formula = RBO ~ RelHumidity,
                        data = data.frame(RBO_df),
                        p = 2,
                        q = 3)

summary_residual_analysis(task_3_hum4_2)

#ardlDLM(3,2)
task_3_hum4_3 = ardlDlm(formula = RBO ~ RelHumidity,
                        data = data.frame(RBO_df),
                        p = 3,
                        q = 2)

summary_residual_analysis(task_3_hum4_3)

## Model Comparison
attr(task_3_temp3$model,"class") = "lm"
attr(task_3_rain3$model,"class") = "lm"
attr(task_3_rad3$model,"class") = "lm"
attr(task_3_hum3$model,"class") = "lm"

T3_models <- c(rep("Finite DLM",4), rep("Poly DLM",4), rep("Koyck", 4), rep("ARDL",12))

T3_x <- c(rep(c("Temperature", "Rainfall", "Radiation Level", "Relative Humidity"),3),
          "temp(1,3)", "temp(2,3)", "temp(3,3)",
          "rain(1,3)", "rain(2,3)", "rain(3,3)",
          "rad(1,3)", "rad(2,3)", "rad(3,2)",
          "hum(1,2)", "temp(2,3)", "hum(3,2)")

T3_aic <- AIC(task3_temp1$model, task3_rain1$model, task3_rad1$model, task3_hum1$model,
              task_3_temp2$model, task_3_rain2$model, task_3_rad2$model, task_3_hum2$model,
              task_3_temp3$model, task_3_rain3$model, task_3_rad3$model, task_3_hum3$model,
              task_3_temp4_1$model, task_3_temp4_2$model, task_3_temp4_3$model,
              task_3_rain4_1$model, task_3_rain4_2$model, task_3_rain4_3$model,
              task_3_rad4_1$model, task_3_rad4_2$model, task_3_rad4_3$model,
              task_3_hum4_1$model, task_3_hum4_2$model, task_3_hum4_3$model)$AIC

T3_bic <- BIC(task3_temp1$model, task3_rain1$model, task3_rad1$model, task3_hum1$model,
              task_3_temp2$model, task_3_rain2$model, task_3_rad2$model, task_3_hum2$model,
              task_3_temp3$model, task_3_rain3$model, task_3_rad3$model, task_3_hum3$model,
              task_3_temp4_1$model, task_3_temp4_2$model, task_3_temp4_3$model,
              task_3_rain4_1$model, task_3_rain4_2$model, task_3_rain4_3$model,
              task_3_rad4_1$model, task_3_rad4_2$model, task_3_rad4_3$model,
              task_3_hum4_1$model, task_3_hum4_2$model, task_3_hum4_3$model)$BIC

T3_mase <- MASE(task3_temp1$model, task3_rain1$model, task3_rad1$model, task3_hum1$model,
                task_3_temp2$model, task_3_rain2$model, task_3_rad2$model, task_3_hum2$model,
                task_3_temp3$model, task_3_rain3$model, task_3_rad3$model, task_3_hum3$model,
                task_3_temp4_1, task_3_temp4_2, task_3_temp4_3,
                task_3_rain4_1, task_3_rain4_2, task_3_rain4_3,
                task_3_rad4_1, task_3_rad4_2, task_3_rad4_3,
                task_3_hum4_1, task_3_hum4_2, task_3_hum4_3)$MASE

T3_Model_Comparison <- data.frame(T3_models, T3_x, T3_mase, T3_aic, T3_bic)
colnames(T3_Model_Comparison) <- c("Model","Predictors", "MASE","AIC", "BIC")

kbl(T3_Model_Comparison) %>% kable_paper()

## Forecasting
### MASE as optimal Measure
T3_sorted_MASE <- T3_Model_Comparison %>% arrange(MASE)
kbl(T3_sorted_MASE) %>% kable_paper()

#Prediction Chart
DLM_forecasting_2 <-dLagM::forecast(task3_rad1,x = as.vector(rad_2_next),h=3)

plot(ts(c(as.vector(RBO_TS), as.vector(DLM_forecasting_2$forecasts)),start =1984),
     col ="#f01b1d",
     xlim = c(1984,2019.5),type = 'l',
     ylab = "RBO",
     main = "Next 3 years Forecasting of Flowering-Order (RBO) using Finite DLM (Radiation Level)")

lines(RBO_TS,type = 'l')

legend("topright",
       lty = 1,
       col = c("black", "#f01b1d"),
       c("Data", "Prediction"))

#Prediction Points
t3_DLM_points <- DLM_forecasting_2$forecasts

t3_DLM_prediction_points <- data.frame(t2_Time_point[1:3], t3_DLM_points)
colnames(t3_DLM_prediction_points) = c("Time","Point Forecast")

kable(t3_DLM_prediction_points) %>% kable_paper()

### AIC  as optimal Measure
T3_sorted_AIC <- T3_Model_Comparison %>% arrange(AIC)
kbl(T3_sorted_AIC) %>% kable_paper()

# Predication Chart
DLM_forecasting_3 <-dLagM::forecast(task_3_rad4_1,x = as.vector(rad_2_next),h=3)

plot(ts(c(as.vector(RBO_TS), as.vector(DLM_forecasting_3$forecasts)),start =1984),
     col = "#f01b1d",
     xlim = c(1984,2019.5),type = 'l',
     ylab = "RBO",
     main = "3 years Forecasting of Flowering-Order (RBO) using ARDL (Radiation Level)")

lines(RBO_TS,type = 'l')

legend("topright",
       lty = 1,
       col = c("black", "#f01b1d"),
       c("Data", "Prediction"))

#Prediction Points
t3_interval_AIC = dLagM::forecast(interval = TRUE,task_3_rad4_1, x = as.vector(rad_2_next),h=4)
t3_interval_AIC$forecasts

#---------------------------------------------------------#
#----------------------- Task - 3(b)----------------------#
#---------------------------------------------------------#

## Dynamic Models
T = 12
S.T = (1*seq(RBO_TS)>=T)
S.T.1 = Lag(S.T, +1)

#dynlm_1
task_3_model5_1 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + trend(RBO_TS) + S.T )
summary(task_2_model5_1)
checkresiduals(task_2_model5_1)

#dynlm_2
task_3_model5_2 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + trend(RBO_TS) + S.T + S.T.1)
summary(task_3_model5_2)
checkresiduals(task_3_model5_2)

##### 1.Temperature
#dynlm_3
task_3_temp5_1 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + temp_3_TS + trend(RBO_TS) + S.T)
summary(task_3_temp5_1)
checkresiduals(task_3_temp5_1)

#dynlm_4
task_3_temp5_2 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + temp_3_TS + S.T)
summary(task_3_temp5_2)
checkresiduals(task_3_temp5_2)

#dynlm_5
task_3_temp5_3 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + temp_3_TS + L(temp_3_TS, k = 1) + trend(RBO_TS) + S.T)
summary(task_3_temp5_3)
checkresiduals(task_3_temp5_3)

#dynlm_6
task_3_temp5_4 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + temp_3_TS + L(temp_3_TS, k = 1) + S.T + S.T.1 + L(temp_3_TS, k = 2) + trend(RBO_TS))
summary(task_3_temp5_4)
checkresiduals(task_3_temp5_4)

#dynlm_7
task_3_temp5_5 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + L(RBO_TS , k = 3 ) + temp_3_TS + L(temp_3_TS, k = 1) + L(temp_3_TS, k = 2) + S.T + S.T.1)
summary(task_3_temp5_5)
checkresiduals(task_3_temp5_5)

##### 2.Rainfall
#dynlm_8
task_3_rain5_1 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + rain_2_TS + trend(RBO_TS) + S.T)
summary(task_3_rain5_1)
checkresiduals(task_3_rain5_1)

#dynlm_9
task_3_rain5_2 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + rain_2_TS + trend(RBO_TS) + S.T + S.T.1)
summary(task_3_rain5_2)
checkresiduals(task_3_rain5_2)

#dynlm_10
task_3_rain5_3 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + rain_2_TS + L(rain_2_TS, k = 1) + trend(RBO_TS) + S.T)
summary(task_3_rain5_3)
checkresiduals(task_3_rain5_3)

#dynlm_11
task_3_rain5_4 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + L(RBO_TS , k = 3 ) + rain_2_TS + trend(RBO_TS) + S.T)
summary(task_3_rain5_4)
checkresiduals(task_3_rain5_4)

#dynlm_12
task_3_rain5_5 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + L(RBO_TS , k = 3 ) + rain_2_TS + L(rain_2_TS, k = 1) + trend(RBO_TS) + S.T + S.T.1)
summary(task_3_rain5_5)
checkresiduals(task_3_rain5_5)

##### 3.Radiation Level
#dynlm_13
task_3_rad5_1 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + radiation_2_TS + trend(RBO_TS) + S.T)
summary(task_3_rad5_1)
checkresiduals(task_3_rad5_1)

#dynlm_14
task_3_rad5_2 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + radiation_2_TS + trend(RBO_TS) + S.T + S.T.1)
summary(task_3_rad5_2)
checkresiduals(task_3_rad5_2)

#dynlm_15
task_3_rad5_3 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + radiation_2_TS + L(radiation_2_TS, k = 1) + trend(RBO_TS) + S.T + S.T.1)
summary(task_3_rad5_3)
checkresiduals(task_3_rad5_3)

#dynlm_16
task_3_rad5_4 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + L(RBO_TS , k = 3 ) + radiation_2_TS + trend(RBO_TS)+ S.T)
summary(task_3_rad5_4)
checkresiduals(task_3_rad5_4)

#dynlm_17
task_3_rad5_5 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + L(RBO_TS , k = 3 ) + radiation_2_TS + L(radiation_2_TS, k = 1) + S.T + S.T.1 + trend(RBO_TS))
summary(task_3_rad5_5)
checkresiduals(task_3_rad5_5)

#dynlm_18
task_3_rad5_6 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + L(RBO_TS , k = 3 ) + L(RBO_TS , k = 4 ) + radiation_2_TS + L(radiation_2_TS, k = 1) + trend(RBO_TS) + S.T + S.T.1)
summary(task_3_rad5_6)
checkresiduals(task_3_rad5_6)

#dynlm_19
task_3_rad5_7 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + L(RBO_TS , k = 3 ) + L(RBO_TS , k = 4 ) + radiation_2_TS + L(radiation_2_TS, k = 1) + L(radiation_2_TS, k = 2) + trend(RBO_TS) + S.T + S.T.1)
summary(task_3_rad5_7)
checkresiduals(task_3_rad5_7)

##### 4.Relative Humidity
#dynlm_20
task_3_hum5_1 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + humidity_2_TS + trend(RBO_TS) + S.T)
summary(task_3_hum5_1)
checkresiduals(task_3_hum5_1)

#dynlm_21
task_3_hum5_2 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + humidity_2_TS + trend(RBO_TS) + S.T)
summary(task_3_hum5_2)
checkresiduals(task_3_hum5_2)

#dynlm_22
task_3_hum5_3 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + humidity_2_TS + L(humidity_2_TS, k = 1) + trend(RBO_TS) + S.T + S.T.1)
summary(task_3_hum5_3)
checkresiduals(task_3_hum5_3)

#dynlm_23
task_3_hum5_4 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + L(RBO_TS , k = 3 ) + humidity_2_TS + S.T + S.T.1)
summary(task_3_hum5_4)
checkresiduals(task_3_hum5_4)

#dynlm_24
task_3_hum5_5 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + L(RBO_TS , k = 3 ) + humidity_2_TS + L(humidity_2_TS, k = 1) + S.T + S.T.1)
summary(task_3_hum5_5)
checkresiduals(task_3_hum5_5)

#dynlm_25
task_3_hum5_6 = dynlm(RBO_TS ~ L(RBO_TS , k = 1 ) + L(RBO_TS , k = 2 ) + L(RBO_TS , k = 3 ) + humidity_2_TS + L(humidity_2_TS, k = 1) + trend(RBO_TS) + S.T + S.T.1)
summary(task_3_hum5_6)
checkresiduals(task_3_hum5_6)

## Model Comparison
T3_b_models <- c("dynlm_1", "dynlm_2", "dynlm_3", "dynlm_4", "dynlm_5",
                 "dynlm_6", "dynlm_7", "dynlm_8", "dynlm_9", "dynlm_10",
                 "dynlm_11", "dynlm_12", "dynlm_13", "dynlm_14", "dynlm_15",
                 "dynlm_16", "dynlm_17", "dynlm_18", "dynlm_19", "dynlm_20",
                 "dynlm_21", "dynlm_22", "dynlm_23", "dynlm_24", "dynlm_25")

T3_b_x <- c(rep("FFD", 2), rep("Temperature", 5), rep("Rainfall", 5), rep("Radiation Level", 7), rep("Relative Humidity", 6))

T3_b_aic <- AIC(task_3_model5_1, task_3_model5_2,
                task_3_temp5_1, task_3_temp5_2, task_3_temp5_3, task_3_temp5_4, task_3_temp5_5,
                task_3_rain5_1, task_3_rain5_2, task_3_rain5_3, task_3_rain5_4, task_3_rain5_5,
                task_3_rad5_1, task_3_rad5_2, task_3_rad5_3, task_3_rad5_4, task_3_rad5_5, task_3_rad5_6, task_3_rad5_7,
                task_3_hum5_1, task_3_hum5_2, task_3_hum5_3, task_3_hum5_4, task_3_hum5_5, task_3_hum5_6)$AIC

T3_b_bic <- BIC(task_3_model5_1, task_3_model5_2, task_3_temp5_1,
                task_3_temp5_2, task_3_temp5_3, task_3_temp5_4, task_3_temp5_5,
                task_3_rain5_1, task_3_rain5_2, task_3_rain5_3, task_3_rain5_4, task_3_rain5_5,
                task_3_rad5_1, task_3_rad5_2, task_3_rad5_3, task_3_rad5_4, task_3_rad5_5, task_3_rad5_6, task_3_rad5_7,
                task_3_hum5_1, task_3_hum5_2, task_3_hum5_3, task_3_hum5_4, task_3_hum5_5, task_3_hum5_6)$BIC

T3_b_mase <- MASE(lm(task_3_model5_1), lm(task_3_model5_2), lm(task_3_temp5_1),
                  lm(task_3_temp5_2), lm(task_3_temp5_3), lm(task_3_temp5_4), lm(task_3_temp5_5),
                  lm(task_3_rain5_1), lm(task_3_rain5_2), lm(task_3_rain5_3), lm(task_3_rain5_4), lm(task_3_rain5_5),
                  lm(task_3_rad5_1), lm(task_3_rad5_2), lm(task_3_rad5_3), lm(task_3_rad5_4), lm(task_3_rad5_5), lm(task_3_rad5_6), lm(task_3_rad5_7),
                  lm(task_3_hum5_1), lm(task_3_hum5_2), lm(task_3_hum5_3), lm(task_3_hum5_4), lm(task_3_hum5_5), lm(task_3_hum5_6))$MASE

T3_b_Model_Comparison <- data.frame(T3_b_models, T3_b_x, T3_b_mase, T3_b_aic, T3_b_bic)
colnames(T3_b_Model_Comparison) <- c("Model","Predictors","MASE","AIC", "BIC")
kbl(T3_b_Model_Comparison) %>% kable_paper()

## Forecasting
T3_b_sorted_MASE <- T3_b_Model_Comparison %>% arrange(MASE)
kbl(T3_b_sorted_MASE) %>% kable_paper()

#Prediction Chart
q = 3
n = nrow(task_3_rad5_7$model)
rbo.frc = array(NA , (n + q))
rbo.frc[1:n] = RBO_TS[5:length(RBO_TS)]
trend = array(NA,q)
trend.start = task_3_rad5_7$model[n,"trend(RBO_TS)"]
trend = seq(trend.start , trend.start + q/12, 1/12)

for(i in 1:q){
  data.new =c(1,rbo.frc[n-1+i],rbo.frc[n-2+i],rbo.frc[n-3+i],rbo.frc[n-4+i],1,1,1,trend[i],1,1)
  rbo.frc[n+i] = as.vector(task_3_rad5_7$coefficients) %*% data.new
}

plot(RBO_TS,xlim=c(1984,2018),
     ylab='RBO',xlab='Year',
     main = "Next 3 years forecasting of RBO using dynlm_19 model")

lines(ts(rbo.frc[(n+1):(n+q)],start=c(2015)),col="#f01b1d")

legend("topright",
       lty = 1,
       col = c("black", "#f01b1d"),
       c("Data", "Prediction"))

#Prediction Points
t3_points_dynlm <- rbo.frc[(n+1):(n+q)]

t3_dynlm_prediction_points <- data.frame(t2_Time_point[1:3], t3_points_dynlm)
colnames(t3_dynlm_prediction_points) = c("Time","Point Forecast")

kable(t3_dynlm_prediction_points) %>% kable_paper()


# ......................................................................................
# ...............................Cvičení 1 - Kombinatorika..............................
# ..................Adéla Vrtková, Michal Béreš, Martina Litschmannová..................
# ......................................................................................

# Nezobrazuje-li se vám text korektně, nastavte File \ Reopen with Encoding... na UTF-8
# Pro zobrazení obsahu skriptu použijte CTRL+SHIFT+O
# Pro spouštění příkazů v jednotlivých řádcích použijte CTRL+ENTER

# * Variace ####
#
# V(n,k) - variace bez opakování, první argument bude celkový počet entit, druhý
# argument velikost výběru

# funkce se vytváří příkazem fucntion, je to objekt jehož jméno je dáno až proměnnou
# do které tento objekt přiřadím
variace = function(n,k) # zde zadávám počet parametrů a jejich jména
{ # celé tělo funkce je uzavřeno mezi závorkami {...}
    citatel = factorial(n)  # faktoriál v originálním Rku existuje tak jej použijeme
    jmenovatel = factorial(n-k)
    return(citatel/jmenovatel)    # to co funkce vrátí se dává do příkazu return(...)
}

# V*(n,k) - variace s opakováním

variace_opak = function(n,k)
{
  return(n^k)
}

# * Permutace ####
#
# P(n)=V(n,n) - permutace

permutace = function(n)
{
  return(variace(n,n))
}

# P*(n1,n2,n3,....,nk) - permutace s opakováním, vstup bude vektor s jednotlivými počty
# unikátních entit

permutace_opak = function(vec_n) # vec_n je vektro počtů hodnot př.: vec_n = c(2,2,2,4,3)
{
    n = sum(vec_n) # spočteme kolik máme hodnot celkem
    res_temp=factorial(n) #jejich faktoriál = hodnota v čitateli
    # jednoduchý cyklus začíná příkazem for, pak v závorkách následuje název iterátoru a z
    # jakého seznamu bude brán
    for(pocet in vec_n) # pocet je iterátor a postupně bude nabývat hodnot z vektoru vec_n
    {
        # postupně dělíme faktoriálem každého počtu unikátních entit
        res_temp=res_temp/factorial(pocet)
    }
    return(res_temp)
}

# * Kombinace ####
#
# C(n,k) - kombinace

kombinace = function(n,k)
{
  return(choose(n,k)) # funkce for kombinace už existuje v Rku a jmenuje se choose
}

# C*(n,k) - kombinace s opakováním

kombinace_opak = function(n,k)
{
  return(choose(n+k-1,k)) # použijeme známý vzorec
}

#  Úlohy na cvičení ####
#
# * Příklad 1. ####
#
# V prodejně mají k dispozici tři typy zámků. Pro otevření prvního
# zámku je nutno zmáčknout čtyři z deseti tlačítek označených číslicemi 0 až 9. (Na
# pořadí nezáleží - tlačítka zůstávají zmáčknuta.)
# Druhý zámek se otevře pokud zmáčkneme šest tlačítek z deseti.
# Pro otevření třetího zámku je nutno nastavit správnou kombinaci
# na čtyřech kotoučích. Který z těchto zámků nejlépé chrání před
# zloději?

z1=kombinace(10,4)
z2=kombinace(10,6)
z3=variace_opak(10,4)
paste("pocet kombinaci: ",z1,",",z2,",",z3)
paste("pradvedepodobnost nahodnehootevreni: ",1/z1,",",1/z2,",",1/z3)

# * Příklad 2. ####
#
# V prodejně nabízejí dva druhy zamykání kufříku. První kufřík se zamyká šifrou, která
# se skládá
# z šesti číslic. Druhý kufřík se zamyká dvěma zámky, které se otevírají současně. Šifra
# každého
# z nich se skládá ze tří číslic. Určete pro každý kufřík pravděpodobnost otevření
# zlodějem při
# prvním pokusu. Který typ zámku je bezpečnější?

z1=variace_opak(10,6);
z2=variace_opak(10,3)*variace_opak(10,3);
z2_v2=variace_opak(10,3)+variace_opak(10,3);
paste("pocet kombinaci: ",z1,",",z2,",druha varianta - ",z2_v2)

# * Příklad 3. ####
#
# V urně je 40 koulí - 2 červené a 38 bílých. Z urny náhodně vytáhneme 2 koule. S jakou
# pravděpodobností budou obě červené?

poc_moz=kombinace(40,2);
poc_priz=kombinace(2,2);
prob=poc_priz/poc_moz;
paste("pravdepodobnost je: ",prob)

# * Příklad 4. ####
#
# Student si měl ke zkoušce připravit odpovědi na 40 otázek. Na dvě otázky, které mu dal
# zkoušející, neuměl odpovědět a tak řekl „To mám smůlu! To jsou jediné dvě otázky, na
# které neumím odpovědět.“ S jakou pravděpodobností mluví pravdu?

# * Příklad 5.  ####
#
# Test z chemie žák složí, pokud v seznamu 40 chemických sloučenin podtrhne jediné dva
# aldehydy, které v seznamu jsou. Jaká je pravděpodobnost, že test složí žák, který
# provede výběr
# sloučenin náhodně?

# * Příklad 6. ####
#
# Ze zahraničí se vracela skupina 40 turistů a mezi nimi byli 2 pašeráci. Na hranici
# celník 2 turisty
# vyzval k osobní prohlídce a ukázalo se, že oba dva jsou pašeráci. Zbylí turisté na to
# reagovali:
# „Celník měl opravdu štěstí!“, „Pašeráky někdo udal!“, . . .. Jak se postavit k těmto
# výrokům?
# Je oprávněné podezření, že pašeráky někdo udal?

# * Příklad 7. ####
#
# Z urny se třemi koulemi, dvěma červenými a jednou bílou, budou současně vybrány dvě
# koule.
# Student a učitel uzavřou sázku. Pokud budou obě koule stejné barvy, vyhraje student.
# Pokud
# budou mít koule různou barvu, vyhraje učitel. Je hra férová? Jaké jsou
# pravděpodobnosti výhry
# učitele a studenta?

# funkce combn vyrobí kombinace o předepsané velikosti - první parametr je vektor hodnot, druhý velikost výběru
combn(c('cerna','cerna','cervena'),2)

# * Příklad 8. ####
#
#
# Hra popsaná v příkladu 7 nebyla férová. Jakou kouli (červenou nebo bílou) musíme do
# urny přidat, aby hra férová byla?

combn(c('cerna','cerna','cerna','cervena'),2)
combn(c('cerna','cerna','cervena','cervena'),2)

# * Příklad 9. ####
#
# Chcete hrát Člověče nezlob se, ale ztratila se hrací kostka. Čím a jak lze nahradit
# hrací kostku,
# máte-li k dispozici hrací karty (balíček 32 karet) a 4 různobarevné kuličky?

# * Příklad 10. ####
#
# Chcete hrát Člověče nezlob se, ale ztratila se hrací kostka. Jak lze nahradit hrací
# kostku, máte-li
# k dispozici 3 různobarevné kuličky?

# * Příklad 11. ####
#
# V prodejně vozů Škoda mají v měsíci únoru prodejní akci. Ke standardnímu vybavení
# nabízejí
# 3 položky z nadstandardní výbavy zdarma. Nadstandardní výbava zahrnuje 7 položek:
# - tempomat, vyhřívání sedadel, zadní airbagy, xenonová světla, stropní okénko,
# bezpečnostní
# zámek převodovky, speciální odolný metalízový lak.
#
# Kolik možností má zákazník, jak zvolit 3 položky z nadstandardní výbavy?

kombinace(7,3)

# * Příklad 12. ####
#
#  Při zkoušce si do 5. řady sedlo 12 studentů. Zkoušející chce určit sám, jak tyto
# studenty v řadě
# rozesadit.
# - Kolik je možností jak studenty rozesadit?
# - Student Brahý žádá, aby mohl sedět na kraji a odejít dříve, aby stihl vlak. Kolik je
# možností jak studenty rozesadit, chce-li zkoušející vyhovět požadavku studenta
# Brahého?
# - Kolik je možností jak studenty rozesadit, nesmějí-li Pažout a Horáček sedět vedle
# sebe?

#a
permutace(12)
prazdnych_sedadel=8
permutace_opak(c(1,1,1,1,1,1,1,1,1,1,1,1,prazdnych_sedadel))
#b
1*permutace(11)+permutace(11)*1
#c
vedle_sebe=permutace(11)+permutace(11)
permutace(12)-vedle_sebe

# * Příklad 13. ####
#
# Kolik anagramů lze vytvořit ze slova STATISTIKA?

statistika=c(2,3,2,2,1)
permutace_opak(statistika)

# * Příklad 14. ####
#
# V Tescu dostali nové zboží – 6 druhů chlapeckých trik. Od každého druhu mají alespoň 7
# kusů.
# Maminka chce synovi koupit 4 trika. Kolik je možností, jak je vybrat
# - mají-li být všechna různá?
# - připouští-li, že mohou být všechna stejná?

#a
kombinace(6,4)
#b
kombinace_opak(6,4)

# * Příklad 15. ####
# Kolik hesel délky 5 můžeme vytvořit ze znaků abecedy
# - nejsou-li rozlišována velká a malá písmena?
# - jsou-li rozlišována velká a malá písmena?

#a
variace_opak(26,5)
#b
variace_opak(52,5)


#The built-in standard deviation function applies the Bessel correction.  To reverse this, we can apply an uncorrection.
#If na.rm is true, missing data points (NA values) are removed.
 reverseBesselCorrection <- function(x, na.rm=FALSE)
 {
   if(na.rm) x <- x[!is.na(x)]
   len <- length(x)
   if(len < 2) stop("2 or more data points required")
   sqrt((len-1)/len)
 }
 testdata <- c(2,4,4,4,5,5,7,9)
 reverseBesselCorrection(testdata)*sd(testdata) #2


sample_size=c(6,6,6,6,6)

# l=y1bar-(y2bar+y3bar+y4bar+y5bar)/4

# thus we identify a1 = 4, a2 = -1, a3 =-1, a4 = -1 , a5=-1
a=c(4,-1,-1,-1,-1)

test=0
i=1
while(i<=length(sample_size)){
  test=test+a[i]^2
  i=i+1
}
print(test)
y1bar=1.175
y2bar=1.293
y3bar=1.328
y4bar=1.415
y5bar=1.500
l=4*y1bar-y2bar-y3bar-y4bar-y5bar
print(l)
# we can obtain the sum of squares associated with the contrast from
SSC1=(sample_size[1]*(l^2))/test
print(SSC1)

a=c(0,1,1,-1,-1)
test=0
i=1
while(i<=length(sample_size)){
  test=test+a[i]^2
  i=i+1
}
l=0*y1bar+y2bar+y3bar-y4bar-y5bar
# we can obtain the sum of squares associated with the contrast from
SSC2=(sample_size[2]*(l^2))/test
print(SSC2)

a=c(0,1,-1,0,0)
test=0
i=1
while(i<=length(sample_size)){
  test=test+a[i]^2
  i=i+1
}
l=0*y1bar+y2bar-y3bar+0*y4bar+0*y5bar
# we can obtain the sum of squares associated with the contrast from
SSC3=(sample_size[2]*(l^2))/test
print(SSC3)

a=c(0,0,0,1,-1)
test=0
i=1
while(i<=length(sample_size)){
  test=test+a[i]^2
  i=i+1
}
l=0*y1bar+0*y2bar+0*y3bar+y4bar-y5bar
# we can obtain the sum of squares associated with the contrast from
SSC4=(sample_size[2]*(l^2))/test
print(SSC4)


x = c(-3, -1, 1, 3, 5, 7)
y = c(14, 4, 2, 8, 22, 44)

n = length(x)

num = sum(x * y) - sum(x) * sum(y) / n
den = sum(x * x) - sum(x) * sum(x) / n

B1 = num / den
B0 = (sum(y) - (B1 * sum(x))) / n

png('images/disp_diagram.png')
plot(x, y)
dev.off()

B0
B1

print('For x = 0 predicted value is')
print(B1 * 0 + B0)

print('For x = 2 predicted value is')
print(B1 * 2 + B0)


library(dplyr)
library(rafalib)

data <- read.csv("week2/mice_pheno.csv") %>%
  na.omit

y <- filter(data,
            Sex == "M",
            Diet == "chow"
            ) %>%
  select(Bodyweight) %>%
  unlist

z_scores <- (y - mean(y)) / popsd(y)

# Q4
mean(abs(z_scores) <= 1)

# Q5
mean(abs(z_scores) <= 2)

# Q6
mean(abs(z_scores) <= 3)

# Q7
qqnorm(z_scores)
abline(0, 1)

# Q9
avgs <- replicate(10000,
                  mean(sample(y, 25))
                  )
mypar(1,2)
hist(avgs)
qqnorm(avgs)
qqline(avgs)

mean(avgs)

# Q10
popsd(avgs)


softmax <- function (x) {
    m <- max(x)
    exps <- exp(x - m)
    s <- sum(exps)
    return(exps / s)
}


## 1. Indexing a Vector By Position ##

final_scores <- c(88, 87.66667, 86, 91.33333, 84, 91, 89.33333)

third <- final_scores[3]
print(third)

## 2. Understanding Numeric Data Types ##

final_scores <- c(88, 87.66667, 86, 91.33333, 84, 91, 89.33333)

class(final_scores)

## 3. Understanding Character Data Types ##

class_names <- c("math", "chemistry", "writing", "art", "history", "music", "physical_education")
print(class(class_names))

## 4. Naming Values ##

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

names(final_scores) <- class_names
named_final_scores <- final_scores
print(named_final_scores)

## 5. Indexing Vectors using Names ##

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

history <- final_scores["history"]
print(history)
art <- final_scores["art"]
print(art)
music <- final_scores["music"]
print(music)

## 6. Comparing Values And Logical Data Types ##

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

history_math <- final_scores["history"] > final_scores["math"]
writing_art <- final_scores["writing"] <= final_scores["art"]
music_chem <- final_scores["music"] == final_scores["chemistry"]

## 7. Comparing Single Values against Vectors ##

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

lowest_score <- min(final_scores)
lowest_logical <- lowest_score == final_scores

## 8. Indexing using Logical Data Types ##

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

lowest_score <- min(final_scores)
lowest_logical <- lowest_score == final_scores

lowest_class <- final_scores[lowest_logical]
print(lowest_class)

## 9. Performing Arithmetic with a Vector ##

tests <- c(76, 89, 78, 88, 79, 93, 89)
homework <- c(85, 90, 88, 79, 88, 95, 74)
sum <- tests + homework

projects <- c(77, 93, 87, 90, 77, 82, 80)
johnny_scores <- (projects + sum)/3
johnny_overall <- mean(johnny_scores)

## 10. Vector Recycling Rule ##

tests <- c(76, 89, 78)
homework <- c(85, 90, 88, 79, 88, 95, 74)
recycling <- tests + homework

## 11. Appending Data To A Vector ##

tests <- c(76, 89, 78)
tests <- c(tests,88, 79, 93, 89)

R Fundamentals/Introduction to Vectors-311.r


library(Biodem)
m <- matrix(c(3,2,2,1), nrow=2)
mtx.exp(m, 0)
#      [,1] [,2]
# [1,]    1    0
# [2,]    0    1
mtx.exp(m, 1)
#      [,1] [,2]
# [1,]    3    2
# [2,]    2    1
mtx.exp(m, 2)
#      [,1] [,2]
# [1,]   13    8
# [2,]    8    5
mtx.exp(m, 3)
#      [,1] [,2]
# [1,]   55   34
# [2,]   34   21
mtx.exp(m, 10)
#         [,1]   [,2]
# [1,] 1346269 832040
# [2,]  832040 514229


## Recursive FT plotting
plotftree <- function(x, y, a, d, c) {
x2=y2=0; d2r=pi/180.0; a1 <- a*d2r; d1=0;
if(d<=0) {return()}
if(d>0)
  { d1=d*10.0;
    x2=x+cos(a1)*d1;
    y2=y+sin(a1)*d1;
    segments(x*c, y*c, x2*c, y2*c, col='darkgreen');
    plotftree(x2,y2,a-20,d-1,c);
    plotftree(x2,y2,a+20,d-1,c);
    #return(2);
  }
}
## Plotting Fractal Tree. aev 3/27/17
## ord - order/depth, c - scale, xsh - x-shift, fn - file name,
##  ttl - plot title.
pFractalTree <- function(ord, c=1, xsh=0, fn="", ttl="") {
  cat(" *** START FRT:", date(), "\n");
  m=640;
  if(fn=="") {pf=paste0("FRTR", ord, ".png")} else {pf=paste0(fn, ".png")};
  if(ttl=="") {ttl=paste0("Fractal tree, order - ", ord)};
  cat(" *** Plot file -", pf, "title:", ttl, "\n");
  ##plot(NA, xlim=c(0,m), ylim=c(-m,0), xlab="", ylab="", main=ttl);
  plot(NA, xlim=c(0,m), ylim=c(0,m), xlab="", ylab="", main=ttl);
  plotftree(m/2+xsh,100,90,ord,c);
  dev.copy(png, filename=pf, width=m, height=m);
  dev.off(); graphics.off();
  cat(" *** END FRT:",date(),"\n");
}
## Executing:
pFractalTree(9);
pFractalTree(12,0.6,210);
pFractalTree(15,0.35,600);


#' The Epanechnikov kernel
#' @param R vector of distances to convert to weights
#' @param bw bandwidth of the kernel
#' @return vector of kernel weights, given by \eqn{1 - (R / bw)^2} if \eqn{R < bw}; otherwise 0
#' @export
epanechnikov = function(R, bw) {
    ifelse( R < bw, 1-(R/bw)**2, 0)
}

#' The cubic kernel
#' @param d vector of distances to convert to weights
#' @param bw bandwidth of the kernel
#' @return vector of kernel weights, given by \eqn{1 - (7 * (d / bw)^2 - 8.75 * (d / bw)^3 + 3.5 * (d / bw)^5 - 0.75 * (d / bw)^7} if \eqn{d < bw}; otherwise 0
#' @export
cubic = function(d, bw) {
    ifelse(d<bw, 1 - (7*(d/bw)**2 - 8.75*(d/bw)**3 + 3.5*(d/bw)**5 - 0.75*(d/bw)**7), 0)
}

#' The spherical kernel
#' @param d vector of distances to convert to weights
#' @param bw bandwidth of the kernel
#' @return vector of kernel weights, given by \eqn{1 - 1.5 * (d / bw) + 0.5 * (d / bw)^3} if \eqn{d < bw}; otherwise 0
#' @export
spherical = function(d, bw) {
    ifelse(d<bw, 1 - 1.5*(d/bw) + 0.5*(d/bw)**3, 0)
}

#' The bisquare kernel
#' @param R vector of distances to convert to weights
#' @param bw bandwidth of the kernel
#' @return vector of kernel weights, given by \eqn{(1 - (R / bw)^2)^2} if \eqn{R < bw}; otherwise 0
#' @export
bisquare = function(R, bw) {
    ifelse( R < bw, (1 - (R/bw)**2)**2, 0)
}


=begin
  ----------^ sample-jordanform01.rb
  require "algebra"

  M4 = SquareMatrix(Rational, 4)
  m = M4[
      [-1, 1, 2, -1],
      [-5, 3, 4, -2],
      [3, -1, 0, 1],
      [5, -2, -2, 3]
  ]
  m.jordan_form.display; #=>
  #  2,   0,   0,   0
  #  0,   1,   1,   0
  #  0,   0,   1,   1
  #  0,   0,   0,   1
  puts

  #------------------------------------------------------------
  m = M4[
    [3, 1, -1, 1],
    [-3, -1, 3, -1],
    [-2, -2, 0, 0],
    [0, 0, -4, 2]
  ]
  jf, pt, qt, field, modulus  = m.jordan_form_info
  print "extention = "; p modulus #=> [a^2 + 4]
  jf.display; puts #=>
  #  2,   1,   0,   0
  #  0,   2,   0,   0
  #  0,   0,   a,   0
  #  0,   0,   0,  -a

  m = m.convert_to(jf.type)
  p jf == pt * m * qt #=> true

  #------------------------------------------------------------
  m = M4[
      [-1, 1, 2, -1],
      [-5, 3, 4, -2],
      [3, -1, 0, 1],
      [5, -2, -2, 0]
  ]
  jf, pt, qt, field, modulus  = m.jordan_form_info
  print "extention = "; p modulus #=> [a^3 + 3a - 1, b^2 + ab + a^2 + 3]
  jf.display; puts #=>
  #  2,   0,   0,   0
  #  0,   a,   0,   0
  #  0,   0,   b,   0
  #  0,   0,   0, -b - a

  m = m.convert_to(jf.type)
  p jf == pt * m * qt #=> true
  ----------$ sample-jordanform01.rb
=end


# Example : 2.5A   Chapter : 2.5   Pageno : 87
# Inverse of difference matrix is Sum matrix
A<-matrix(c(1,-1,0,0,1,-1,0,0,1),ncol=3)
A1<-solve(A)
print("Inverse of the difference matrix is singular ")
print(A1)


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

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

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

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

  return (answer)
}

fast_cvloo_knn <- function() {
  maxK <- length(iris[,1]) - 1
  classes = unique(iris$Species)

  ans <- rep(x = 0, times = maxK)
  for (i in 1:length(iris[,1])) {
    # for (i in 1:10) {
    cat("\r", "Processing sample ", i, " of ", length(iris[,1]))
    dataset <- iris[-i,]
    # print(dataset)
    distance <- array(dim=c(length(dataset[,1])))
    for (j in 1:(length(dataset[,1]))) {
      distance[j] <- euclidean(dataset[j, 3:4], iris[i, 3:4])
    }
    sortedDataset <- dataset[order(distance),]

    classesCount <- rep(x = 0, times = length(classes))
    names(classesCount) = classes
    for (j in 1:maxK) {
      classesCount[sortedDataset$Species[j]] <- classesCount[sortedDataset$Species[j]] + 1

      classForCurrentK = names(which.max(classesCount))[1]
      if (classForCurrentK == iris$Species[i]) {
        ans[j] = ans[j] + 1
      }
    }

  }
  cat("\n")
  for (i in 1:length(ans)) {

    ans[i] = ans[i] / length(iris[,1] - 1)
  }

  return (ans)
}

par(mfrow=c(1,2), pty="s")
# LOO CV, looking for the best k
stats <- fast_cvloo_knn()
plot(1:(length(iris[,1]) - 1), stats, type="l", xlab="k", ylab="Accuracy")

maxPoint = which(stats == max(stats))
points((1:(length(iris[,1]) - 1))[maxPoint], stats[maxPoint], pch = 19, col = "red")

bestK <- which.max(stats)
cat("Best K =", bestK, "\n")

# k-NN demo
z <- array(dim=c(10, 2))
for (i in 1:length(z[,1])) {
  z[i,] = c(runif(1, min = 1, max = 7), runif(1, min = 0, max = 2.5))
}

print(z)

result <- kNN(iris, z, 5)

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


## Dale W.R. Rosenthal, 2018
## You are free to distribute and use this code so long as you attribute
## it to me or cite the text.
## The legal disclaimer in _A Quantitative Primer on Investments with R_
## applies to this code.  Use or distribution without these comment lines
## is forbidden.

rf <- 0.02  # 2% interest rates
num.sims <- 100000 # 100,000 simulations
s0 <- 90  # underlier price at t=0
s.bar <- 95
K <- 102  # strike price
sigma <- 0.25  # volatility of underlier log-returns
T <- 2  # 2 years = option expiry
tau <- 1  # mid-life of one-year bond
lambda <- 2  # mean reversion rate; 2 => half-life = ln(2)/2 = 0.35 years

## arithmetic Brownian motion; normal underlier price
w1 <- rnorm(num.sims) # simulated W_T values
sigma.abm <- sigma*s0  # rescale volatility for initial prife level
s.sim.abm <- s0 + rf*T + sigma.abm*sqrt(T)*w1
opt.payoff.abm <- pmax(s.sim.abm - K, 0)
opt.value.abm <- mean(opt.payoff.abm)*exp(-rf*T)

## geometric Brownian motion; normal underlier log-returns
w2 <- rnorm(num.sims) # simulated W_T values
s.sim.gbm <- s0*exp((rf-sigma^2/2)*T + sigma*sqrt(T)*w2)
opt.payoff.gbm <- pmax(s.sim.gbm - K, 0)
opt.value.gbm <- mean(opt.payoff.gbm)*exp(-rf*T)

## Ornstein-Uhlenbeck process for underlier price
w3 <- rnorm(num.sims) # simulated W_T values
s.sim.ou <- s.bar + exp(-lambda*T)*(s0-s.bar) + sigma*s.bar*
        sqrt((1-exp(-2*lambda*T))/(2*lambda))*w3
opt.payoff.ou <- pmax(s.sim.ou - K, 0)
opt.value.ou <- mean(opt.payoff.ou)*exp(-rf*T)

## Brownian bridge; two-year bond maturing at 100
## option is struck at 102 in year 1
## FYI: vol of 0.25 is very high for a two-year bond
w4 <- rnorm(num.sims) # simulated W_tau values
s.bar.bb <- s0 + (100-s0)*tau/T
s.sim.bb <- s.bar.bb + sigma*s.bar.bb*sqrt(tau/T*(T-tau)/T)*w4
opt.payoff.bb <- pmax(s.sim.bb - K, 0)
opt.value.bb <- mean(opt.payoff.bb)*exp(-rf*tau)


x = (sample(-1000.00:1000.00,100))
y = (sample(-1000.00:1000.00,length(x)))
cp = closest.pairs(x,y)
#cp = closestPair(x,y)
plot(x,y,pch=19,col='black',main="Closest Pair", asp=1)
points(cp["x1.x"],cp["y1.y"],pch=19,col='red')
points(cp["x2.x"],cp["y2.y"],pch=19,col='red')
#closest_pair_brute(x,y,T)

Performance
system.time(closest_pair_brute(x,y), gcFirst = TRUE)
Shortest path found =
 From:          (32,-987)
 To:            (25,-993)
 Distance:      9.219544

   user  system elapsed
   0.35    0.02    0.37

system.time(closest.pairs(x,y), gcFirst = TRUE)
The closest pair is:
        Point 1: 32.000, -987.000
        Point 2: 25.000, -993.000
        Distance: 9.220.

   user  system elapsed
   0.08    0.00    0.10

system.time(closestPair(x,y), gcFirst = TRUE)
The closest pair is:
        Point 1: 32, -987
        Point 2: 25, -993
        Distance: 9.219544

   user  system elapsed
   0.17    0.00    0.19