Commit 241d2a07 authored by mrsuperficial's avatar mrsuperficial
Browse files

Merge branch 'main' of https://git.scc.kit.edu/ng3223/ptsfc_results into main

parents 45420867 256345cc
"model","n_eval_cases","mean_rk_wind","mean_rk_temp","mean_rk_dax","mean_rk_overall"
"AryaStark",35,7.5,9,6.4,7.63333333333333
"Bronn",35,16.8,15.8,20.2,17.6
"CaptainRaymondHolt",35,7,8.4,11.2,8.86666666666667
"ChandlerBing",35,9.8,5.8,6.4,7.33333333333333
"DexterJettster",35,16.4,10,3,9.8
"DougJudy",35,9.2,9.4,7,8.53333333333333
"GeneralGrievous",35,19.4,20.6,12.6,17.5333333333333
"GinaLinetti",35,21,1.8,15.4,12.7333333333333
"HanSolo",35,2.4,19.2,13.8,11.8
"HotPie",35,11.6,5.8,6.2,7.86666666666667
"JabbaTheHutt",35,11.6,11,5.2,9.26666666666667
"Joey",35,8.2,11,12.6,10.6
"Joffrey_Baratheon",35,19,8.6,16.4,14.6666666666667
"KyloRen",35,8,6.8,12.6,9.13333333333333
"ObiWanKenobi",35,8.2,9,7.8,8.33333333333333
"PhoebeBuffay",35,3.4,13.2,7.6,8.06666666666667
"RossGeller",35,15.6,18.6,16.2,16.8
"SamwellTarly",35,16.6,15.4,20.6,17.5333333333333
"Shaggydog",35,6,13.2,17.2,12.1333333333333
"UglyNakedGuy",35,5.8,9.4,6.4,7.2
"Yoda",35,7.5,9,6.2,7.56666666666667
"AryaStark",48,5,9.8,6,6.93333333333333
"Bronn",48,15.6,14.8,19.2,16.5333333333333
"CaptainRaymondHolt",48,5.8,6.6,10.4,7.6
"ChandlerBing",48,7.2,4.6,5.8,5.86666666666667
"DexterJettster",48,15.6,9.8,2.8,9.4
"DougJudy",48,10.8,8.2,6.6,8.53333333333333
"GeneralGrievous",48,19.8,20.6,17.8,19.4
"GinaLinetti",48,21,15.4,14.6,17
"HanSolo",48,5,18.2,12.8,12
"HotPie",48,12,5.6,4.4,7.33333333333333
"JabbaTheHutt",48,12.6,10,11.8,11.4666666666667
"Joey",48,8.6,11.8,10.8,10.4
"Joffrey_Baratheon",48,17.8,7.6,15,13.4666666666667
"KyloRen",48,9.4,6.2,11.6,9.06666666666667
"ObiWanKenobi",48,8.6,7.8,7.4,7.93333333333333
"PhoebeBuffay",48,4,11.2,6,7.06666666666667
"RossGeller",48,19.2,19.8,18.6,19.2
"SamwellTarly",48,15.2,14.8,19.6,16.5333333333333
"Shaggydog",48,4,11,15.6,10.2
"UglyNakedGuy",48,7,9.4,6.4,7.6
"Yoda",48,6.8,7.8,7.8,7.46666666666667
This diff is collapsed.
"time","value"
2021-06-21 00:00:00,24.1
2021-06-21 12:00:00,28.7
2021-06-22 00:00:00,20.7
2021-06-22 12:00:00,18.5
2021-06-23 00:00:00,14.5
2021-06-23 12:00:00,19.8
2021-06-24 00:00:00,14.7
2021-06-24 12:00:00,19.9
2021-06-25 00:00:00,17.3
2021-06-25 12:00:00,23.3
2021-06-26 00:00:00,18.7
2021-06-26 12:00:00,25.4
2021-06-27 00:00:00,15.9
......@@ -299,3 +289,13 @@
2021-11-16 12:00:00,7.7
2021-11-17 00:00:00,5.7
2021-11-17 12:00:00,5.3
2021-11-18 00:00:00,6.8
2021-11-18 12:00:00,9.8
2021-11-19 00:00:00,9.7
2021-11-19 12:00:00,12.1
2021-11-20 00:00:00,11.9
2021-11-20 12:00:00,11.7
2021-11-21 00:00:00,9.9
2021-11-21 12:00:00,8.7
2021-11-22 00:00:00,4.9
2021-11-22 12:00:00,5.8
"time","value"
2021-06-19 12:00:00,9
2021-06-20 00:00:00,8.28
2021-06-20 12:00:00,17.28
2021-06-21 00:00:00,9.72
2021-06-21 12:00:00,13.32
2021-06-22 00:00:00,16.56
2021-06-22 12:00:00,13.32
2021-06-23 00:00:00,3.24
2021-06-23 12:00:00,13.32
2021-06-24 00:00:00,8.28
2021-06-24 12:00:00,11.16
2021-06-25 00:00:00,2.88
2021-06-25 12:00:00,11.52
......@@ -299,3 +289,13 @@
2021-11-16 12:00:00,8.64
2021-11-17 00:00:00,7.2
2021-11-17 12:00:00,14.4
2021-11-18 00:00:00,16.2
2021-11-18 12:00:00,18.72
2021-11-19 00:00:00,21.96
2021-11-19 12:00:00,21.6
2021-11-20 00:00:00,22.32
2021-11-20 12:00:00,18.36
2021-11-21 00:00:00,18
2021-11-21 12:00:00,12.24
2021-11-22 00:00:00,10.8
2021-11-22 12:00:00,17.28
......@@ -53,7 +53,7 @@ cols_transp <- gsub(")", ", 0.5)", cols_transp, fixed = TRUE)
dat_truth <- list()
# DAX data:
getSymbols('^GDAXI',src='yahoo', from = as.Date("2021-09-01"))
getSymbols('^GDAXI',src='yahoo', from = as.Date("2021-09-01"))
dat_truth$DAX <- data.frame(date(GDAXI), value = GDAXI$GDAXI.Close)
colnames(dat_truth$DAX) <- c("time", "value")
dat_truth$DAX$time <- as.POSIXlt(dat_truth$DAX$time, "GMT") + 17.5*60*60
......@@ -84,7 +84,7 @@ for(i in seq_along(available_plot_data)){
# Define server logic:
shinyServer(function(input, output, session) {
# listen to "skip backward" button
observe({
# if pressed decreas input by 7 days
......@@ -93,13 +93,13 @@ shinyServer(function(input, output, session) {
if(!is.null(input$select_date) & input$skip_backward > 0){
new_date <- as.Date(input$select_date) - 7
if(as.character(new_date) %in% available_dates){
updateSelectInput(session = session, inputId = "select_date",
updateSelectInput(session = session, inputId = "select_date",
selected = as.character(new_date))
}
}
})
})
# listen to "skip forward" button
observe({
# if pressed increase input by 7 days
......@@ -108,30 +108,30 @@ shinyServer(function(input, output, session) {
if(!is.null(input$select_date) & input$skip_forward > 0){
new_date <- as.Date(input$select_date) + 7
if(as.character(new_date) %in% available_dates){
updateSelectInput(session = session, inputId = "select_date",
updateSelectInput(session = session, inputId = "select_date",
selected = as.character(new_date))
}
}
})
})
####### reactive handling of data sets:
# prepare data for plotting:
plot_data <- reactiveValues()
observe({
# a mapping to determine which trace corresponds to what (needed to replace things below)
temp <- list("selected_date" = 1, # 0 is grey area
"truth" = 14) # truth plotted on top of everything else
# indices of different forecasts: always one for shaded area, one for point forecast:
for(i in seq_along(plot_data$select_models)) temp[[plot_data$select_models[i]]] <- 2*i + 1 - 1:0
plot_data$mapping <- temp
# truth data as of selected date:
plot_data$truth <- NULL
# use the truth date corresponding to the input:
if(input$select_target == "DAX"){
# for DAX we need to take into account the value at the respective forecast date:
......@@ -141,15 +141,15 @@ shinyServer(function(input, output, session) {
colnames(truth_temp) <- c("time", "value")
plot_data$truth <- truth_temp
}
if(input$select_target == "temperature"){
plot_data$truth <- dat_truth$temperature
}
if(input$select_target == "wind"){
plot_data$truth <- dat_truth$wind
}
# get selected models from input:
plot_data$select_models <- c(input$select_models1,
input$select_models2,
......@@ -157,7 +157,7 @@ shinyServer(function(input, output, session) {
input$select_models4,
input$select_models5,
input$select_models6)
# y axis limit depending on target:
yl <- NULL
if(input$select_target == "DAX"){
......@@ -170,7 +170,7 @@ shinyServer(function(input, output, session) {
yl <- c(-20, 50)
}
plot_data$ylim <- yl
ylab <- NULL
if(input$select_target == "DAX"){
ylab <- paste("cumulative log return relative to", input$select_date)
......@@ -182,20 +182,20 @@ shinyServer(function(input, output, session) {
ylab <- "wind speed (km/h)"
}
plot_data$ylab <- ylab
# prepare plotting data for forecasts
if(!is.null(input$select_date)){
# run through models:
for(mod in models){
# only if not already loaded
#if(!is.null(forecast_data[[input$select_date]])){
# subset to required info:
subs <- subset(forecast_data[[input$select_date]],
target == input$select_target &
model == mod)
if(nrow(subs) > 0){
# prepare list of simple data frames for plotting:
points <- subs[, c("target_end_date", "q0.5")]
......@@ -212,11 +212,11 @@ shinyServer(function(input, output, session) {
lower <- subs[, c("target_end_date", "q0.025")]
upper <- subs[, c("target_end_date", "q0.975")]
}
colnames(points) <- colnames(lower) <- colnames(upper) <-
colnames(scores) <- c("x", "y")
intervals <- rbind(lower, upper[nrow(upper):1, ])
# store:
plot_data[[mod]] <- list(points = points, intervals = intervals, scores = scores)
}else{
......@@ -224,15 +224,15 @@ shinyServer(function(input, output, session) {
}
}
}
})
# initial plot:
output$tsplot <- renderPlotly({
# only run at start of app, rest is done in updates below
isolate({
# initialize plot:
p <- plot_ly(mode = "lines", hovertemplate = '%{y}', source = "tsplot") %>% # last argument ensures labels are completely visible
layout(yaxis = list(title = plot_data$ylab), # axis + legend settings
......@@ -249,7 +249,7 @@ shinyServer(function(input, output, session) {
line = list(color = 'rgb(0.5, 0.5, 0.5)', dash = "dot"),
showlegend = FALSE) # %>%
# event_register(event = "plotly_click") # enable clicking to select date
# add forecasts: run through models
for(m in seq_along(plot_data$select_models)){
mod <- plot_data$select_models[m]
......@@ -285,7 +285,7 @@ shinyServer(function(input, output, session) {
color = cols[m]),
legendgroup = mod, showlegend = show_nowcast)
}
# trace for most truth data on top
p <- p %>% add_lines(x = plot_data$truth$time,
y = plot_data$truth$value,
......@@ -298,11 +298,11 @@ shinyServer(function(input, output, session) {
p
})
})
# register proxy (necessary to modify plotly objsect):
myPlotProxy <- plotlyProxy("tsplot", session)
# update shaded area to mark selected date:
observe({
plotlyProxyInvoke(myPlotProxy, "restyle", list(x = list(rep(as.Date(input$select_date) + 1, 2)),
......@@ -313,14 +313,14 @@ shinyServer(function(input, output, session) {
y = list(rep(plot_data$ylim, each = 2))),
list(0))
})
# update truth as of selected date:
observe({
plotlyProxyInvoke(myPlotProxy, "restyle", list(x = list(plot_data$truth$time),
y = list(plot_data$truth$value)),
list(plot_data$mapping$truth))
})
# update forecasts:
observe({
for(mod in c(paste0("empty", 1:6), models)){
......@@ -354,9 +354,9 @@ shinyServer(function(input, output, session) {
showlegend = show_nowcast),
list(plot_data$mapping[[mod]][2]))
}
})
# update ylim
observe({
# y axis limit
......@@ -372,13 +372,13 @@ shinyServer(function(input, output, session) {
}
plot_data$ylim <- yl
})
observe({
plotlyProxyInvoke(myPlotProxy, "relayout",
list(yaxis = list(title = plot_data$ylab)))
})
# table with scores:
# output table:
output$tab <- DT::renderDataTable({
......@@ -386,14 +386,14 @@ shinyServer(function(input, output, session) {
sub[, c("ae", "mean_qscore", "interval_coverage_0.5", "interval_coverage_0.95", "scores_imputed")] <-
round(sub[, c("ae", "mean_qscore", "interval_coverage_0.5", "interval_coverage_0.95", "scores_imputed")], 2)
datatable(sub, filter = "top",
colnames = c("", "model", "target", "horizon", "MAE", "MQS", "C0.5", "C0.95", "n", "imputed"))
colnames = c("", "model", "target", "horizon", "AE_Skill", "Quantile_Skill", "C0.5", "C0.95", "n", "imputed"))
})
# table with ranks:
# output table:
output$tab_rankings <- DT::renderDataTable({
datatable(rankings[, -2], filter = "top",
colnames = c("", "model", "av. rank wind", "av. rank temperature", "av. rank DAX", "av. rank overall"))
})
})
......@@ -15,19 +15,19 @@ default_shown <- sample(models[models != "median_ensemble"], 4)
# Define UI for application
shinyUI(fluidPage(
# Application title
titlePanel("Probabilistic Time Series Forecasting Challenge"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
strong("Select forecast date"),
br(),
div(style="display: inline-block;vertical-align:top;", actionButton("skip_backward", "<")),
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_date",
label = NULL,
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_date",
label = NULL,
choices = rev(available_dates))),
div(style="display: inline-block;vertical-align:top;", actionButton("skip_forward", ">")),
selectizeInput("select_target",
......@@ -35,33 +35,34 @@ shinyUI(fluidPage(
choices = c("DAX" = "DAX",
"Temperature" = "temperature",
"Wind" = "wind"), width = "200px"),
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_models1", "Model 1:", choices = models, multiple = FALSE,
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_models1", "Model 1:", choices = models, multiple = FALSE,
selected = c("median_ensemble"))),
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_models2", "Model 2:", choices = c("(none selected)" = "empty2", models), multiple = FALSE,
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_models2", "Model 2:", choices = c("(none selected)" = "empty2", models), multiple = FALSE,
selected = "(none selected)")),
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_models3", "Model 3:", choices = c("(none selected)" = "empty3", models), multiple = FALSE,
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_models3", "Model 3:", choices = c("(none selected)" = "empty3", models), multiple = FALSE,
selected = "(none selected)")),
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_models4", "Model 4:", choices = c("(none selected)" = "empty4", models), multiple = FALSE,
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_models4", "Model 4:", choices = c("(none selected)" = "empty4", models), multiple = FALSE,
selected = "(none selected)")),
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_models5", "Model 5:", choices = c("(none selected)" = "empty5", models), multiple = FALSE,
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_models5", "Model 5:", choices = c("(none selected)" = "empty5", models), multiple = FALSE,
selected = "(none selected)")),
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_models6", "Model 6:", choices = c("(none selected)" = "empty6", models), multiple = FALSE,
div(style="display: inline-block;vertical-align:top;width:200px",
selectizeInput("select_models6", "Model 6:", choices = c("(none selected)" = "empty6", models), multiple = FALSE,
selected = "(none selected)")),
radioButtons("select_interval", label = "Show prediction interval:",
radioButtons("select_interval", label = "Show prediction interval:",
choices = c("95%", "50%", "none"), selected = "95%", inline = TRUE)
),
# Show a plot of the generated distribution
mainPanel(
h4("Forecast visualization"),
plotlyOutput("tsplot", height = "600px"),
h4("Average evaluation scores by target and horizon"),
h4("Forecast evaluation by target and horizon"),
h6("Larger skill scores are better. 1 = perfect performance, 0 = performance equal to benchmark. C0.5 and C0.95 denote coverage of 50% and 95% prediction intervals."),
dataTableOutput("tab"),
h4("Rankings"),
dataTableOutput("tab_rankings")
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment