diff --git a/assignments/A1.R b/assignments/A1.R new file mode 100644 index 0000000..0234488 --- /dev/null +++ b/assignments/A1.R @@ -0,0 +1,69 @@ +library(tidyverse) + +# Load some functions +source(here::here("assignments/A1_functions.R")) + +# Read responses +ass1 <- readRDS(here::here("assignments/A1_responses.rds")) + +# Actual values +q1 <- q2 <- q3 <- q4 <- q5 <- NULL +q1 <- 149.68 # https://finance.yahoo.com/quote/GOOG/history +q2 <- 17.6 #http://www.bom.gov.au/climate/dwo/IDCJDW3049.latest.shtml +q3 <- 0 +q4 <- 14.300000 #https://www.abs.gov.au/ausstats/abs@.nsf/mf/6202.0 +#q5 <- ???? # https://finance.yahoo.com/quote/GOOG/history + +# Create leaderboard +leaders <- tibble( + Name = ass1[["Name"]], + ) |> + bind_cols( + score(1, q1, ass1[["Q1F"]], ass1[["Q1L"]], ass1[["Q1U"]]), + score(2, q2, ass1[["Q2F"]], ass1[["Q2L"]], ass1[["Q2U"]]), + score(3, q3, ass1[["Q3F"]], ass1[["Q3L"]], ass1[["Q3U"]]), + score(4, q4, ass1[["Q4F"]], ass1[["Q4L"]], ass1[["Q4U"]]), + score(5, q5, ass1[["Q5F"]], ass1[["Q5L"]], ass1[["Q5U"]]) + ) |> + rowwise() |> + mutate(Score = sum(c_across(-Name))) |> + select(Name, Score, everything()) |> + arrange(Score, Name) + +# Save leaderboard +saveRDS(leaders, here::here("assignments/A1_leaderboard.rds")) + +# Plotting +ggplot2::theme_set( + theme_get() + theme(text = element_text(family = 'Fira Sans')) +) + +# Plot responses +savepng(here::here("assignments/Q1"), height = 80, width = 15) +ass1 |> plotass1(F = Q1F, L = Q1L, U = Q1U, Actual = q1, xlab = "US dollars") + + ggtitle("Google stock price 20 March 2024") +dev.off() + +savepng(here::here("assignments/Q2"), height = 80, width = 15) +ass1 |> plotass1(F = Q2F, L = Q2L, U = Q2U, Actual = q2, xlab = "degrees C") + + ggtitle("Maximum temp at airport on 10 April 2024") +dev.off() + +savepng(here::here("assignments/Q3"), height = 80, width = 15) +ass1 |> plotass1( + F = Q3F, L = Q3L, U = Q3U, Actual = q3, + xlab = "Point difference (Collingwood - Essendon)" +) + + ggtitle("Difference in points Anzac Day match") +dev.off() + +savepng(here::here("assignments/Q4"), height = 80, width = 15) +ass1 |> plotass1(F = Q4F, L = Q4L, U = Q4U, Actual = q4, xlab = "Millions") + + ggtitle("Seasonally adjusted total employment in April 2024") + + coord_cartesian(xlim=c(12, 15)) +dev.off() + +savepng(here::here("assignments/Q5"), height = 80, width = 15) +ass1 |> plotass1(F = Q5F, L = Q5L, U = Q5U, Actual = q5, xlab = "US dollars") + + ggtitle("Google stock price 22 May 2024") +dev.off() diff --git a/assignments/A1.qmd b/assignments/A1.qmd index 9f86d95..c8c4c09 100644 --- a/assignments/A1.qmd +++ b/assignments/A1.qmd @@ -27,12 +27,15 @@ submit(schedule, "Assignment 1") ## Results -* [Q1](https://robjhyndman.com/etc3550/Q1.png) -* [Q2](https://robjhyndman.com/etc3550/Q2.png) -* [Q3](https://robjhyndman.com/etc3550/Q3.png) -* [Q4](https://robjhyndman.com/etc3550/Q4.png) -* [Q5](https://robjhyndman.com/etc3550/Q5.png) +* [Q1](Q1.png) +* [Q2](Q2.png) +* [Q3](Q3.png) +* [Q4](Q4.png) +* [Q5](Q5.png) ## Leaderboard - +```{r} +readRDS(here::here("assignments/A1_leaderboard.rds")) |> + DT::datatable() +``` diff --git a/assignments/A1_functions.R b/assignments/A1_functions.R new file mode 100644 index 0000000..052df49 --- /dev/null +++ b/assignments/A1_functions.R @@ -0,0 +1,98 @@ +# Functions used for plotting and scoring Assignment 1 results + +plotass1 <- function(data, F, L, U, Actual = NULL, xlab = NULL) { + Fquo <- rlang::as_label(enquo(F)) + p <- ass1 %>% + arrange({{ F }}) %>% + mutate( + Name = factor(Name, ordered = TRUE, levels = data$Name[order(data[[Fquo]])]) + ) %>% + filter(!is.na({{ F }})) %>% + ggplot(aes(y = Name)) + + geom_linerange(aes(xmin = {{ L }}, xmax = {{ U }})) + + geom_point(aes(x = {{ F }}), col = "blue", size = .5) + + scale_x_continuous(sec.axis = dup_axis()) + if (!is.null(Actual)) { + p <- p + + geom_vline(xintercept = Actual, col = "red") + xlab <- paste0(xlab, ". Actual = ", Actual) + } + if (!is.null(xlab)) { + p <- p + xlab(xlab) + } + xlim <- data %>% + summarise( + lower = quantile(c({{F}},{{L}}), 0.01, na.rm=TRUE), + upper = quantile(c({{F}},{{U}}), 0.99, na.rm=TRUE) + ) %>% + as.numeric() + p <- p + coord_cartesian(xlim=xlim) + + return(p) +} + + +### Function to save eps or pdf figures + +savefig <- function(filename, height = 10, width = (1 + sqrt(5)) / 2 * height, + type = c("pdf", "eps", "jpg", "png"), pointsize = 10, family = "Helvetica", + sublines = 0, toplines = 0, leftlines = 0, res = 300, ...) { + type <- match.arg(type) + filename <- paste(filename, ".", type, sep = "") + if (type == "eps") { + postscript( + file = filename, horizontal = FALSE, + width = width / 2.54, height = height / 2.54, pointsize = pointsize, + family = family, onefile = TRUE, print.it = FALSE + ) + } + else if (type == "pdf") { + pdf( + file = filename, width = width / 2.54, height = height / 2.54, pointsize = pointsize, + family = family, onefile = TRUE + ) + } + else if (type == "jpg") { + ragg::agg_jpeg(filename = filename, width = width, height = height, res = res, quality = 100, units = "cm") # , pointsize=pointsize*50) + } + else if (type == "png") { + ragg::agg_png(filename = filename, width = width, height = height, res = res, units = "cm") # , pointsize=pointsize*50) + } + else { + stop("Unknown file type") + } + par(mgp = c(2.2, 0.45, 0), tcl = -0.4, mar = c( + 3.2 + sublines + 0.25 * (sublines > 0), + 3.5 + leftlines, 1 + toplines, 1 + ) + 0.1) + par(pch = 1) + invisible() +} + +savepng <- function(...) { + savefig(..., type = "png") +} + +# Scoring function +score <- function(question, actual, forecast, lower, upper) { + if(is.null(actual)) { + return(NULL) + } else { + # Correct reversal of upper and lower bounds + switch <- lower > upper + switch[is.na(switch)] <- FALSE + tmp <- upper + upper[switch] <- lower[switch] + lower[switch] <- tmp[switch] + # Point forecast score + rank1 <- rank(abs(actual - forecast)) + # Interval forecast score + interval_score <- (upper - lower) + + 10 * pmax(0, lower - actual) + 10 * pmax(0, actual - upper) + rank2 <- rank(interval_score) + # Return results + out <- as_tibble(cbind(point = rank1, interval = rank2)) + colnames(out) <- paste0("Q", question, "_", colnames(out)) + return(out) + } +} diff --git a/assignments/A1_leaderboard.rds b/assignments/A1_leaderboard.rds new file mode 100644 index 0000000..6a8efad Binary files /dev/null and b/assignments/A1_leaderboard.rds differ diff --git a/assignments/A1_responses.rds b/assignments/A1_responses.rds new file mode 100644 index 0000000..aa72be8 Binary files /dev/null and b/assignments/A1_responses.rds differ diff --git a/assignments/Q1.png b/assignments/Q1.png new file mode 100644 index 0000000..7ee67e9 Binary files /dev/null and b/assignments/Q1.png differ diff --git a/assignments/Q2.png b/assignments/Q2.png new file mode 100644 index 0000000..cee43ae Binary files /dev/null and b/assignments/Q2.png differ diff --git a/assignments/Q3.png b/assignments/Q3.png new file mode 100644 index 0000000..fcda90b Binary files /dev/null and b/assignments/Q3.png differ diff --git a/assignments/Q4.png b/assignments/Q4.png new file mode 100644 index 0000000..91a7a51 Binary files /dev/null and b/assignments/Q4.png differ diff --git a/assignments/Q5.png b/assignments/Q5.png new file mode 100644 index 0000000..84ad029 Binary files /dev/null and b/assignments/Q5.png differ diff --git a/renv.lock b/renv.lock index 971715f..f2d6198 100644 --- a/renv.lock +++ b/renv.lock @@ -27,6 +27,23 @@ ], "Hash": "164809cd72e1d5160b4cb3aa57f510fe" }, + "DT": { + "Package": "DT", + "Version": "0.33", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "crosstalk", + "htmltools", + "htmlwidgets", + "httpuv", + "jquerylib", + "jsonlite", + "magrittr", + "promises" + ], + "Hash": "64ff3427f559ce3f2597a4fe13255cb6" + }, "GGally": { "Package": "GGally", "Version": "2.2.1", @@ -554,6 +571,19 @@ ], "Hash": "e8a1e41acf02548751f45c718d55aa6a" }, + "crosstalk": { + "Package": "crosstalk", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R6", + "htmltools", + "jsonlite", + "lazyeval" + ], + "Hash": "ab12c7b080a57475248a30f4db6298c0" + }, "curl": { "Package": "curl", "Version": "5.2.1", @@ -1270,6 +1300,36 @@ ], "Hash": "81d371a9cc60640e74e4ab6ac46dcedc" }, + "htmlwidgets": { + "Package": "htmlwidgets", + "Version": "1.6.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grDevices", + "htmltools", + "jsonlite", + "knitr", + "rmarkdown", + "yaml" + ], + "Hash": "04291cc45198225444a397606810ac37" + }, + "httpuv": { + "Package": "httpuv", + "Version": "1.6.15", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "Rcpp", + "later", + "promises", + "utils" + ], + "Hash": "d55aa087c47a63ead0f6fc10f8fa1ee0" + }, "httr": { "Package": "httr", "Version": "1.4.7", @@ -1421,6 +1481,17 @@ ], "Hash": "f8901f44aedb6d7e7d03b5533986bd97" }, + "later": { + "Package": "later", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Rcpp", + "rlang" + ], + "Hash": "a3e051d405326b8b0012377434c62b37" + }, "latex2exp": { "Package": "latex2exp", "Version": "0.9.6", @@ -1843,6 +1914,22 @@ ], "Hash": "ac50c4ffa8f6a46580dd4d7813add3c4" }, + "promises": { + "Package": "promises", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R6", + "Rcpp", + "fastmap", + "later", + "magrittr", + "rlang", + "stats" + ], + "Hash": "434cd5388a3979e74be5c219bcd6e77d" + }, "proxy": { "Package": "proxy", "Version": "0.4-27",