rmarkdown::find_pandoc(dir  = "/usr/local/bin/")
knitr::opts_chunk$set(echo = FALSE)
library(ggplot2)
library(devtools)
library(data.table)
load_all()
df1 <- bikes_atom
df1[df1$t == 667, "lpdens"] <- 0 # sandy correction

Introduction

This compares the three agents to examine how they differ, for example in their predictive ability over the pooling space.

First, the predictive means of all agents (together with the truth), then the log predictive densities. Note that the lpdens of each model has been set to zero at the time point 667, as it otherwise would be around -300 there which fucks up the scale.

Predictive means - all agents

df <- cbind(df1, group = rep(1:10, each = 53))
a <- seq(min(df$t), max(df$t), 1) # Used for ticks and labels
ggplot(df, aes(y = pmean, x = t, color = method)) +
    geom_line() +
    geom_line(
        aes(y = ytrue, x = t),
        color = "black"
    ) +
    facet_wrap( ~ group, ncol = 1, scales = "free") +
    labs(
        title = "Predictive means, the truth is black",
        x = "Time",
        y = "pmean"
    ) +
    scale_x_continuous(breaks = a[a %% 5 == 0], minor_breaks = seq(min(df$t), max(df$t), 1)) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))

Log predictive density - all agents

ggplot(df, aes(y = lpdens, x = t, col = method)) +
    geom_line() +
    facet_wrap( ~ group, ncol = 1, scales = "free") +
    labs(
        title = "Log predictive densities",
        x = "Time",
        y = "lpdens"
    ) +
    scale_x_continuous(breaks = a[a %% 5 == 0], minor_breaks = seq(min(df$t), max(df$t), 1)) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))

Local predictive ability - all agents

sotw_all <- cbind(
    subset(bikes_d_log, select = c(t, temp, hum, windspeed)),
    time = bikes_d_log$t / sqrt(var(bikes_d_log$t))
)
lpplt <- local_predictive_ability(df1, sotw_all)
# lpplt[c(1:4)]

lpplt[c(1:4)]
lpplt[[5]]
lpplt[[6]]
lpplt[[7]]
lpplt[[8]]
lpplt[[9]]
lpplt[[10]]


ooelrich/oscbvar documentation built on Sept. 8, 2021, 3:31 p.m.