temp-bikes/6b-bikes-aggregate-cont.R

In ooelrich/oscbvar: Stuff for Bayesian vector autoregressions

############################################################
### GENERATE A SMOOTHING FRAME, REMOVING WORST SANDY DAY ###
############################################################

sotw_cont <- subset(bikes_d_log, select = c(t, temp, hum, windspeed))

# Matchningsvariabler. Family day är thanks giving, juldag, julafton
matchi <- data.frame(t = 1:730, family_day = 0)
matchi[c(327, 357:358, 691, 723:724), 2] <- 1

#############################################################
### GENERATE BASELINE PREDS AND A COLLECTION OF DIFFERENT ###
### CALIPER AGGREGATIONS                                  ###
#############################################################

df_agg_base <- gen_agg_preds(
    atomic_df = bikes_atom,
    start_agg = 401,
    sotw = sotw_cont,
    baseline = TRUE,
    caliper = FALSE,
    mahala = FALSE,
    cw = 0.01,
    mvc = 1,
    matching_vars = matchi
)

# add a cw column that is just NA for the baseline
df_agg_base <- cbind(df_agg_base, calw = NA)
df_all <- df_agg_base

cwl <- seq(0, 1.5, by = 1)
aaa <- Sys.time()
for (i in seq_len(length(cwl))) {
    cw <- cwl[i]
    df_agg <- gen_agg_preds(
        atomic_df = bikes_atom,
        start_agg = 725,
        sotw = sotw_cont,
        baseline = FALSE,
        caliper = TRUE,
        mahala = FALSE,
        cw = cw,
        mvc = 1,
        matching_vars = matchi
    )
    print(sprintf("done with cw %.2f", cw))
    df_agg <- cbind(df_agg, calw = cw)
    df_all <- rbind(df_all, df_agg)
}
Sys.time() - aaa
# Tog 50 minuter för tre olika cw
df_all[calw >= 0, .(predab = mean(lpdens)), by =.(calw)]

head(df_all)
df_all <- cbind(df_all, group = rep(1:3, each = 110))
dft <- df_all # safety save stupid

dft$method <- apply( dft[ , c(3, 6)], 1, paste, collapse = "_") # to that grouping works
data.table(dft[, .(meanlpdens = mean(lpdens)), by = .(method)])

ggplot(dft, aes(y = lpdens, x = t, color = method)) +
    geom_line() +
    facet_wrap(~group, ncol = 1, scales = "free") +
    labs(
        title = "Log pred density smoothing with continuous vars",
        x = "Time",
        y = "lpdens"
    )
ggplot2::ggsave("temp/aggpreds-cont.pdf")