Predictive regressions: univariate learning

We start by loading the required packages & functions.

rm(list = ls())
library(tidyverse)
library(Rcpp)
library(mvtnorm)
library(reshape2)
library(cowplot)
library(latex2exp)
sourceCpp("c_functions.cpp")
source("R_functions.R")

First, a test.

quad_err_C_uni(a_y = 0, r_y = 0.97, s_y = 0.1, TT = 5, k = 1, n_sim = 10^5)

[1] 0.01851007

quad_err_C_2d2(a_x = 0, a_y = 0, r_x = 0.97, r_y = 0.97, s_x = 0.1, s_y = 0.1, cor = 0.1, TT = 5, k = 1, n_sim = 10^5)

[1] 0.02408703

Next, wrapping the functions.

univ <- function(r_y, TT, k){
    return(quad_err_C_uni(a_y = 0, r_y = r_y, s_y = 1, TT = TT, k = k, n_sim = 10^6))
}

biv <- function(r_x, r_y, cor, TT, k){
    return(quad_err_C_2d2(a_x = 0, a_y = 0, r_x = r_x, r_y = r_y, s_x = 1, s_y = 1, 
                          cor = cor, TT = TT, k = k, n_sim = 10^6))
}

Then, the parameters.

k <- c(1, 12, 24)
TT <- c(6, 9, 12, 15, 18, 21, 24, 30, 36, 48, 60, 90, 120)
#TT <- c(7,8,10,11,13,14,16,17)
r_y <- c(0.3, 0.9)
pars_univ <- expand.grid(r_y, TT, k)
r_y <- pars_univ[,1]
TT <- pars_univ[,2]
k <- pars_univ[,3]
res_univ <- pmap(list(r_y, TT, k), univ) %>% melt() %>% bind_cols(pars_univ)


k <- c(1, 12, 24) # BEWARE
TT <- c(6, 9, 12, 15, 18, 21, 24, 30, 36, 48, 60, 90, 120)
r_y <- c(0.3, 0.9)
r_x <- c(0, 0.5, 0.9, 0.95, 0.99)
cor <- c(0, 0.5, 0.9)
pars_biv <- expand.grid(r_y, r_x, cor, TT, k)
r_y <- pars_biv[,1]
r_x <- pars_biv[,2]
cor <- pars_biv[,3]
TT <- pars_biv[,4]
k <- pars_biv[,5]
res_biv <- pmap(list(r_x, r_y, cor, TT, k), biv) %>% melt() %>% bind_cols(pars_biv)

Some data wrangling.

res_biv <- res_biv %>%
    select(-L1)
colnames(res_biv) <- c("MSE", "r_y", "r_x", "cor", "TT", "k")
res_univ <- res_univ %>%
    select(-L1)
colnames(res_univ) <- c("MSE", "r_y", "TT", "k")
res_univ <- res_univ %>%
    mutate(r_x = NA,  cor = NA) %>%
    select("MSE", "r_y", "r_x", "cor", "TT", "k")


res_univ$type <- "univariate"
res_biv$type <- "bivariate"
res <- bind_rows(res_univ, res_biv) 
#save(res, file = "res_uni.RData")

Some graphs below.

res <- res %>% mutate(R2 = 1-(1-r_y)*MSE)
cor_g <- 0.5
k_g <- 1
r_y_g <- 0.3
T_thresh <- 6
size <- 1.6
g1 <- res %>% 
    filter(TT > T_thresh) %>%
    ggplot(aes(x = TT, y = R2)) + 
    geom_point(data = res %>% filter(type == "bivariate", k == k_g, r_y == r_y_g, cor == cor_g), 
               aes(color = as.factor(r_x)), size = size) +
    geom_line(data = res %>% filter(type == "univariate", k == k_g, r_y == r_y_g), color = "black") +
    theme(legend.position = "none") +
    ggtitle(TeX("$\\rho_y$=0.3")) +
    theme(plot.title = element_text(hjust = 0.6, vjust = -1)) +
    ylab("k=1") + xlab("T")


k_g <- 1
r_y_g <- 0.9
g2 <- res %>% 
    filter(TT > T_thresh) %>%
    ggplot(aes(x = TT, y = R2)) + 
    geom_point(data = res %>% filter(type == "bivariate", k == k_g, r_y == r_y_g, cor == cor_g), 
               aes(color = as.factor(r_x)), size = size) +
    geom_line(data = res %>% filter(type == "univariate", k == k_g, r_y == r_y_g), color = "black") +
    theme(legend.position = "none") +
    ylab(element_blank()) + xlab("T") +
    theme(plot.title = element_text(hjust = 0.6, vjust = -1)) +
    ggtitle(TeX("$\\rho_y$=0.9"))

k_g <- 12
r_y_g <- 0.3
g3 <- res %>% 
    filter(TT > T_thresh) %>%
    ggplot(aes(x = TT, y = R2)) + 
    geom_point(data = res %>% filter(type == "bivariate", k == k_g, r_y == r_y_g, cor == cor_g), 
               aes(color = as.factor(r_x)), size = size) +
    geom_line(data = res %>% filter(type == "univariate", k == k_g, r_y == r_y_g), color = "black") +
    theme(legend.position = c(0.8, 0.2)) +
    ylab("k=12") + xlab("T") +
    labs(color = TeX("$\\rho_x"))

k_g <- 12
r_y_g <- 0.9
g4 <- res %>% 
    filter(TT > T_thresh) %>%
    ggplot(aes(x = TT, y = R2)) + 
    geom_point(data = res %>% filter(type == "bivariate", k == k_g, r_y == r_y_g, cor == cor_g), 
               aes(color = as.factor(r_x)), size = size) +
    geom_line(data = res %>% filter(type == "univariate", k == k_g, r_y == r_y_g), color = "black") +
    theme(legend.position = "none") +
    ylab(element_blank()) + xlab("T")

k_g <- 24
r_y_g <- 0.3
g5 <- res %>%
    filter(TT > T_thresh) %>%
    ggplot(aes(x = TT, y = R2)) + 
    geom_point(data = res %>% filter(type == "bivariate", k == k_g, r_y == r_y_g, cor == cor_g), 
               aes(color = as.factor(r_x)), size = size) +
    geom_line(data = res %>% filter(type == "univariate", k == k_g, r_y == r_y_g), color = "black") +
    theme(legend.position = "none") +
    ylab("k=24") + xlab("T") +
    labs(color = TeX("$\\rho_x"))

k_g <- 24
r_y_g <- 0.9
g6 <- res %>% 
    filter(TT > T_thresh) %>%
    ggplot(aes(x = TT, y = R2)) + 
    geom_point(data = res %>% filter(type == "bivariate", k == k_g, r_y == r_y_g, cor == cor_g), 
               aes(color = as.factor(r_x)), size = size) +
    geom_line(data = res %>% filter(type == "univariate", k == k_g, r_y == r_y_g), color = "black") +
    theme(legend.position = "none") +
    ylab(element_blank()) + xlab("T")

plot_grid(g1, g2, g3, g4, g5, g6, ncol = 2)

# ggsave("univ.pdf", width = 7, height = 5)