In karsfri/HMSr: Theme and functions for HMS

knitr::opts_chunk$set(
  message= FALSE,
  warning = FALSE,
  fig.path = "man/figures/README-",
  out.width = "100%",
  dpi = 300
)

HMSr

NOTE: MOST OF THE FUNCTION HAVE NO PRACTICAL USE OUTSIDE HMS

This pacake will include:

• Graphical theme
• Common helper functions
  • Tidy seasonal adjustment with X13
• Tools for getting and handling data from the datawarehouse
• functions to get external data

Installation

NOTE: MIGHT NOT WORK IN MAC BECAUSE OF THE FOLLOWING CODE IN theme.R

# Load fonts
  # grDevices::windowsFonts(Setimo = windowsFont("Setimo"))
  # grDevices::windowsFonts(SetimoLight = windowsFont("Setimo Light"))

You can install the development version from GitHub with:

# install.packages("devtools")
remotes::install_github("karsfri/HMSr")

Theme

NOTE: color palette will improve! Waiting for more colors

The default template in ggplot2 is readable, but ugly:

library(tidyverse)
library(patchwork)
library(lubridate)
library(HMSr)
data("economics")

economics %>%
  filter(date == lubridate::floor_date(date, "year"), year(date) > 2000) %>%
  gather(var, val, -date) %>%
  ggplot(aes(date, val, color = var)) +
  geom_col(width = 0.3) +
  geom_point() +
  labs(
    title = "Lollipops and stuff",
    subtitle = "With default colors :(",
    x = NULL,
    y = NULL,
    caption = "Source: None of your business :P"
  ) +
  facet_wrap(~var, scales = "free_y")

The theme_set_hms() function sets theme_hms as the default theme, along with default colors for some of the more popular geoms.

Notice also the helper function, label_isl().

theme_set_hms()

economics %>%
  filter(date == lubridate::floor_date(date, "year"), year(date) > 2000) %>%
  gather(var, val, -date) %>%
  ggplot(aes(date, val, color = var)) +
  geom_col(width = 0.3) +
  geom_point() +
  theme_hms() +
  scale_color_manual(values = palette_dark) +
  scale_y_continuous(labels = label_isl()) +
  labs(
    title = "Lollipops and stuff",
    subtitle = "With HMS colors :)",
    x = NULL,
    y = NULL,
    caption = "Source: None of your business :P"
  ) +
  facet_wrap(~var, scales = "free_y")

  economics %>%
    filter(date == floor_date(date, "year"), year(date) > 2000) %>%
    gather(var, val, -date) %>%
    ggplot(aes(date, val, fill = var)) +
    geom_col() +
    theme_hms() +
    scale_color_manual(values = palette_dark) +
    scale_y_continuous(labels = label_isl()) +
    labs(
      title = "Bars and stuff",
      subtitle = "With HMS colors",
      x = NULL,
      y = NULL,
      caption = "Source: None of your business :P"
    ) +
    facet_wrap(~var, scales = "free_y")

  economics %>%
    filter(date == floor_date(date, "year"), year(date) > 2000) %>%
    gather(var, val, -date) %>%
    ggplot(aes(date, val, fill = var, color = var)) +
    geom_area(alpha = 0.5, color = NA) +
    geom_line() +
    theme_hms() +
    scale_color_manual(values = palette_dark) +
    scale_y_continuous(labels = label_isl()) +
    labs(
      title = "Area and stuff",
      subtitle = "With HMS colors",
      x = NULL,
      y = NULL,
      caption = "Source: None of your business :P"
    ) +
    facet_wrap(~var, scales = "free_y")

Palettes

WAITING FOR PERMANENT PALETTES

Labels

There are four functions to control the labels of the y-axis and the x-axis. They use comma as a decimal mark and point as a grouping mark. Usually they are used inside scale_y_continous() eða scale_x_continous, en hér eru þau sýnd inní demo_continous sem sýnir bara einn ás.

scales::demo_continuous(c(0, 1000000), labels = label_isk()) 

scales::demo_continuous(c(0, 1000000), labels = label_isl())

scales::demo_continuous(c(0, 1), labels = label_percent_isl(accuracy = 0.1))

Caption strings

Strings for common sources to put in caption (for use for the caption argument in labs()):

```r c( cap_hms, cap_hagstofa, cap_hms_hagstofa, cap_thjodskra, cap_hms_thjodskra, cap_sedlo, cap_hms_sedlo ) %>% knitr::kable()

## save functions
The functions `ggsave_png`, `ggsave_svg` and `ggsave_both` are thin wrappers around `ggsave`, with default resolution and size set. There are two commonly used length and width parameters in *HMS* documents, and those are provided as objects and they have the following values in cm:

```r
c(
  width_narrow,
  width_wide,
  height_regular,
  height_full
) %>% 
  knitr::kable()

Seasonal adjustment

NOT READY

Group of functions that make X13-ARIMA seasonal adjustment easier on the fly.

• seas_seasonally_adjusted()
• seas_trend()
• seas_seasonal_components()
• seas_irregular()
• seas_irregular()

trade <- read_hagstofan_alt("https://px.hagstofa.is:443/pxis/sq/8ad42406-35c1-442b-a556-1498992b56ed")

The data is different components of international trade:

trade %>%
  mutate(Mánuður = lubriYYYYMM(Mánuður)) %>%
  ################# Magic :) #################################################
  mutate(
    `Útflutningur fob - Árstíðarleiðrétt` = seas_seasonally_adjusted(`Útflutningur fob`, Mánuður)
    ) %>%
  ##############################################################################
  select(Mánuður, `Útflutningur fob`, `Útflutningur fob - Árstíðarleiðrétt` ) %>%
  gather(var, val, -Mánuður) %>%
  ggplot(aes(Mánuður, val, color = var)) +
  geom_line()

the trend component:

trade %>%
  mutate(Mánuður = lubriYYYYMM(Mánuður)) %>%
  ################# Magic :) #################################################
  mutate(
    `Útflutningur fob - Trend` = seas_trend(`Útflutningur fob`, Mánuður)
    ) %>%
  ##############################################################################
  select(Mánuður, `Útflutningur fob`,  `Útflutningur fob - Trend` ) %>%
  gather(var, val, -Mánuður) %>%
  ggplot(aes(Mánuður, val, color = var)) +
  geom_line()

Many groups

trade_long <- trade %>%
  mutate(Mánuður = lubriYYYYMM(Mánuður)) %>%
  gather(variable, value, -Mánuður) 

trade_long %>% 
  head() %>% 
  knitr::kable()

If the data is in a long format or tidy format, make sure to group the variables in such a way that all the dates are distinct within each group:

trade_long %>% 
  group_by(variable) %>% 
  mutate(trend = seas_trend(value, Mánuður)) %>% 
  ggplot(aes(Mánuður, trend, color = variable)) +
  geom_line()

Failing to do so will result in an error:

trade_long %>% 
  # group_by(variable) %>% 
  mutate(trend = seas_trend(value, Mánuður)) %>% 
  ggplot(aes(Mánuður, trend, color = variable)) +
  geom_line()

It is possible to get all the different components from the seasonal::seas() function with map_seas() but it's

still experimental. It might result in unexpected behaviour if the data structure is different from this example.

trade_seas <- trade_long %>% 
  group_by(variable) %>% 
  map_seas(value, Mánuður) 

trade_seas%>% 
  filter(seasonal_component %in% c("trend", "final", "value")) %>% 
  ggplot(aes(Mánuður, seasonal_value, color = seasonal_component)) +
  geom_line() +
  facet_wrap(~variable, scales = "free_y")

trade_seas%>% 
  filter(seasonal_component %in% c("seasonal")) %>% 
  ggplot(aes(Mánuður, seasonal_value, color = seasonal_component)) +
  geom_line() +
  facet_wrap(~variable, scales = "free_y")

Dates

The lubriyear converts numeric vector containing years to a date variable at January first of the corrisponding year:

x <- tibble(year = 2010:2017)

x %>% 
  mutate(timi = lubriyear(year)) %>% 
  knitr::kable()

It also has optional argument, month:

x %>% 
  mutate(
    month = rep_len(rep(1:12), 8),
    timi = lubriyear(year, month)
    )

lubriYYYYMM works the same, but is made specially for the MMMMYY variable from the datawarehouse (and some tables from hagstofan.is):

lubriYYYYMM("2017M03") %>% 
  knitr::kable()

Automated graphics

Here is an example of how to use a automatically updated plotting functions. The function yfirverd, found in demo_automation.R, prints out a plot and returns the data used:

df <- yfirverd()

The function yfirverd also accepts group variables as an argument:

df_landshluti <- yfirverd(Landshluti)

With the argument eftir it's possible to add the names of the groups to the title:

df3 <- yfirverd(SerbyliFjolbyli, eftir = "tegund húsnæðis")

To prevent the plot from printing, set print_plot = FALSE. Then the function only returns the data used:

yfirverd(print_plot = FALSE, Landshluti) %>% 
  head() %>% 
  knitr::kable()

This can be helpful, e.g. when making a custumized plot or make further calculations. It's also possible to use plot_yfirverd to get the plot object, but without facets, for better custumizations:

yfirverd(Landshluti, print_plot = FALSE) %>% 
  plot_yfirverd(title = "This is a title") +
  facet_wrap(~Landshluti, ncol = 2)

or:

windowsFonts(Chiller = windowsFont("Chiller"))


yfirverd(Landshluti, print_plot = FALSE) %>% 
  plot_yfirverd(title = "This is a title") +
  facet_wrap(~Landshluti, ncol = 2) +
  scale_fill_viridis_d(option = "C") + 
  theme(
    text = element_text(family = "Chiller"),
    plot.title = element_text(family = "Chiller"),
    plot.subtitle = element_text(family = "Chiller"),
    strip.text = element_text(family = "Chiller"),
    strip.text.x = element_text(family = "Chiller"),
    plot.caption = element_text(family = "Chiller"),
    )

You can add filters to the data with the filters argument, but the filters need to be enclosed in a quos function call for it to work.

df3 <- yfirverd(
  SerbyliFjolbyli, 
  eftir = "tegund húsnæðis", 
  filters = quos(
    SerbyliFjolbyli != "Annað", 
    SerbyliFjolbyli != "Sérhæft íbúðarhúsnæði")
  )

Saving the graphs

The save_both function from theme_hms is a wrapper for ggsave and saves the last plot, both as svg and as a png at a specified size.

# ggsave_both("yfir")

Finally, the function yfirverd_get_data shows the data that the function yfirverd gets from the datawarehouse.

karsfri/HMSr documentation built on Feb. 26, 2020, 10:36 a.m.