chapter_3_lesson_1_handout.qmd

---
title: "Leading Variables and Associated Variables"
subtitle: "Chapter 3: Lesson 1 Handout"
format: html
editor: source
sidebar: false
---

```{r}
#| include: false
source("common_functions.R")
```

```{=html}
<script type="text/javascript">
 function showhide(id) {
    var e = document.getElementById(id);
    e.style.display = (e.style.display == 'block') ? 'none' : 'block';
 }
 
 function openTab(evt, tabName) {
    var i, tabcontent, tablinks;
    tabcontent = document.getElementsByClassName("tabcontent");
    for (i = 0; i < tabcontent.length; i++) {
        tabcontent[i].style.display = "none";
    }
    tablinks = document.getElementsByClassName("tablinks");
    for (i = 0; i < tablinks.length; i++) {
        tablinks[i].className = tablinks[i].className.replace(" active", "");
    }
    document.getElementById(tabName).style.display = "block";
    evt.currentTarget.className += " active";
 }    
</script>
```


<!-- Check Your Understanding -->

<!-- ::: {.callout-tip icon=false title="Check Your Understanding"} -->


```{r}
#| include: false

set.seed(2887) # Gives integer mean for y
n <- 10
k <- 2

# x <- c(17, 18, 21, 23, 16, 17, 20, 23, 24, 21, 18, 17)

x <- rep(20, n + k)
for(i in 2:length(x)) {
  x[i] = x[i-1] + sample(-3:3, 1)
}

z <- sample(-2:2, n + k, replace = TRUE)
toy_df <- data.frame(x = x, z = z) |>
  mutate(y = round(1.5 * lag(x, k) + z - 15), 0) |>
  mutate(t = row_number()) |>
  na.omit() |>
  dplyr::select(t, x, y)

# mean(toy_df$x)
# mean(toy_df$y)

toy_ts <- toy_df |>
  mutate(
    dates = yearmonth( my(paste(row_number(), year(now()) - 1) ) )
  ) |>
  as_tsibble(index = dates)

toy_ts |>
  autoplot(.vars = x) +
  geom_line(data = toy_ts, aes(x = dates, y = y), color = "#E69F00") +
    labs(
      x = "Time",
      y = "Value of x (in black) and y (in orange)",
      title = paste0("Two Time Series Illustrating a Lag")
    ) +
    theme(
      plot.title = element_text(hjust = 0.5)
    )
  
```

Complete Tables 1 and 2 to calculate $c_k$ for the given values of $k$.

```{r}
#| echo: false

make_ck_table <- function (df) {
  temp <- df |>
    mutate(t = as.character(row_number())) |>
    mutate(xx = x - mean(x)) |>
    mutate(xx2 = (x - mean(x))^2) |>
    mutate(yy = y - mean(y)) |>
    mutate(yy2 = yy^2) |>
    mutate(x_4y = (lag(x,4) - mean(x)) * (y - mean(y))) |>
    mutate(x_3y = (lag(x,3) - mean(x)) * (y - mean(y))) |>
    mutate(x_2y = (lag(x,2) - mean(x)) * (y - mean(y))) |>
    mutate(x_1y = (lag(x,1) - mean(x)) * (y - mean(y))) |>
    mutate(x0y = (lag(x,0) - mean(x)) * (y - mean(y))) |>
    mutate(x1y = (lead(x,1) - mean(x)) * (y - mean(y))) |>
    mutate(x2y = (lead(x,2) - mean(x)) * (y - mean(y))) |>
    mutate(x3y = (lead(x,3) - mean(x)) * (y - mean(y))) |>
    mutate(x4y = (lead(x,4) - mean(x)) * (y - mean(y)))
  
  c0xx_times_n <- sum(temp$xx2)
  c0yy_times_n <- sum(temp$yy2)
  sum <- sum_of_columns(temp)
  c_k <- sum_of_columns_divided_by_n(temp, "$$c_k$$")
  r_k <- sum_of_columns_divided_by_n(temp, "$$r_k$$", sqrt(c0xx_times_n * c0yy_times_n))
  
  out_df <- temp |>
    bind_rows(sum) |>
    bind_rows(c_k) |>
    bind_rows(r_k) |>
    convert_df_to_char() |>
    mutate_if(is.character, replace_na, "—") |>
    rename(
      "$$t$$" = t,
      "$$x_t$$" = x,
      "$$y_t$$" = y,
      "$$x_t - \\bar x$$" = xx,
      "$$(x_t - \\bar x)^2$$" = xx2,
      "$$y_t - \\bar y$$" = yy,
      "$$(y_t - \\bar y)^2$$" = yy2,
      "$$~k=-4~$$" = x_4y,
      "$$~k=-3~$$" = x_3y,
      "$$~k=-2~$$" = x_2y,
      "$$~k=-1~$$" = x_1y,
      "$$~k=0~$$" = x0y,
      "$$~k=1~$$" = x1y,
      "$$~k=2~$$" = x2y,
      "$$~k=3~$$" = x3y,
      "$$~k=4~$$" = x4y
    ) %>% 
    blank_out_one_cell_in_df(row_num = nrow(.)-1, col_num = 2) %>% 
    blank_out_one_cell_in_df(row_num = nrow(.)-1, col_num = 3) %>% 
    blank_out_one_cell_in_df(row_num = nrow(.)-1, col_num = 4) %>% 
    blank_out_one_cell_in_df(row_num = nrow(.)-1, col_num = 5) %>% 
    blank_out_one_cell_in_df(row_num = nrow(.)-1, col_num = 6) %>% 
    blank_out_one_cell_in_df(row_num = nrow(.)-1, col_num = 7) %>% 
    blank_out_one_cell_in_df(row_num = nrow(.), col_num = 2) %>% 
    blank_out_one_cell_in_df(row_num = nrow(.), col_num = 3) %>% 
    blank_out_one_cell_in_df(row_num = nrow(.), col_num = 4) %>% 
    blank_out_one_cell_in_df(row_num = nrow(.), col_num = 5) %>% 
    blank_out_one_cell_in_df(row_num = nrow(.), col_num = 6) %>% 
    blank_out_one_cell_in_df(row_num = nrow(.), col_num = 7) 
  
  return(out_df)
}

toy_solution <- make_ck_table(toy_df)
```

#### Table 1: Computation of squared deviations

```{r}
#| echo: false

toy_solution[,1:7] |> 
  head(-2) |> 
  blank_out_cells_in_df(ncols_to_keep = 5, nrows_to_keep = 0) |>
  display_table()
```

<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>

#### Table 2: Computation of $c_k$ and $r_k$ for select values of $k$

```{r}
#| echo: false

temp_df <- toy_solution[,c(1,4,6,8:16)] 
temp_df[,4:9] <- ""
temp <- df <- temp_df |> 
  blank_out_cells_in_df(ncols_to_keep = 3, nrows_to_keep = 10) 
temp_df[1,8] <- "-1"
temp_df |>
  display_table()
```



<!-- -   Use the figure below as a guide to plot the ccf values. -->

#### Figure 2: Plot of the Sample CCF

```{r, fig.width=6, fig.asp=0.6, fig.align='center'}
#| echo: false

df <- data.frame(x = -4:4)
ggplot(data = df, aes(x = x, y = acf(x, plot = FALSE)$acf)) +
  # geom_col() +
  ylim(-1, 1) +
  scale_x_continuous(breaks = -4:4) + 
  # geom_segment(aes(x = 0, y = 0, xend = -4, yend = 1)) + 
  # geom_segment(aes(x = 0, y = 0, xend = 4, yend = 0)) + ## Hack
  geom_hline(yintercept = 0, linetype = "solid", linewidth=1, color = "black") +
  geom_hline(yintercept = (0.62), linetype = "dashed", linewidth=1, color = "#0072B2") +  # Texbooks says these lines should be at (-0.1 +/- 2/sqrt(10)). Used +/-(2.6/4.2), based on measurements made visually with a ruler from the figure generated by R.
  geom_hline(yintercept = (-0.62), linetype = "dashed", linewidth=1, color = "#0072B2") +
  labs(x = "Lag", y = "CCF") +
  # theme_bw()   
  # theme(panel.grid.major.x = element_blank(), panel.grid.major.y = element_blank())
  theme_bw() +
  theme(
    panel.grid.major.x = element_blank(),
    panel.grid.minor.x = element_blank(),
    panel.grid.major.y = element_blank(),
    panel.grid.minor.y = element_blank()
  )
```

<!-- -   Are any of the ccf values statistically significant? If so, which one(s)? -->

<!-- ::: -->