rstats-tips.net

About

Sun, 20 Aug 2017 21:38:52 +0800

This page ist maintained by

Martin Stingl
Dresdener Straße 34
61137 Schöneck
rstats.tips@gmail.com

How to access HomeAssistant's InfluxDB from R

Sun, 16 Nov 2025 00:00:00 +0000

I’m running a HomeAssistant instance at home. I’ve configured it to log data into an InfluxDB database, so I can retrieve historical data for analysis later on. In default mode HomeAssistant would aggregate historical data for storage reasons.

So now I want to access the InfluxDB database from R to perform custom analyses. HomeAssistant is still using InfluxDB version 1. To connect to InfluxDB from R, I thought I can use the influxdbr package. But I got some errors because this package seems to be outdated.

Here’s what I get, when fetching data:

library(influxdbr)
library(tidyverse)

influx_con <- influx_connection(
  scheme = "http", host = "my_influx_host", port = 8086,
  user = "my_influx_user", pass = "my_influx_pass"
) 
            
query <- 'SELECT entity_id, value FROM "autogen"."°C" WHERE time > now() - 5d'                    

influx_query(influx_con, 
             db = "my_influx_db", 
             query = query,
)

The error message is:

Error in `purrr::map()`:
ℹ In index: 1.
Caused by error in `purrr::map()`:
ℹ In index: 1.
ℹ With name: results.
Caused by error in `purrr::map()`:
ℹ In index: 1.
Caused by error:
! The `validate` argument of `as_tibble()` was deprecated in tibble 2.0.0 and is now defunct.
ℹ Please use the `.name_repair` argument instead.
Run `rlang::last_trace()` to see where the error occurred.

It seems that the influxdbr package is not compatible with the current version of the tibble package. The latest commit is 5 years old.

So I decided to use the httr package to send HTTP requests directly to the InfluxDB API. Here’s how to do it:

library(tidyverse)
library(httr)
library(jsonlite)

query <- 'SELECT entity_id, value FROM "autogen"."°C" WHERE time > now() - 5d'


response <- GET(
  url = paste0("my_influx_host", "/query"),
  query = list(
    db = "my_influx_db",
    q = query,
    u = "my_influx_user",
    p = "my_influx_pass"
  ),
  config = config(ssl_verifypeer = TRUE)  
)

if (response$status_code == 200) {
  data_raw <- content(response, as = "text", encoding = "UTF-8") %>%  fromJSON(flatten = TRUE)
}

The data structure looks a little bit complicated:

`1`	`data_raw %>% str()`

## List of 1
##  $ results:'data.frame':	1 obs. of  2 variables:
##   ..$ statement_id: int 0
##   ..$ series      :List of 1
##   .. ..$ :'data.frame':	1 obs. of  3 variables:
##   .. .. ..$ name   : chr "°C"
##   .. .. ..$ columns:List of 1
##   .. .. .. ..$ : chr [1:3] "time" "entity_id" "value"
##   .. .. ..$ values :List of 1
##   .. .. .. ..$ : chr [1:44176, 1:3] "2025-11-11T13:20:31.171165Z" "2025-11-11T13:20:43.741052Z" "2025-11-11T13:20:43.741159Z" "2025-11-11T13:20:44.552422Z" ...

But here starts the magic of tidyverse. The interesting data is stored in data_raw$results[[1]]$series[[1]]$values[[1]]. We can get it using pluck() and convert it to a data.frame:

1
2
3

data_raw_df <- data_raw %>%
  pluck("results", "series", 1, "values", 1) %>% 
  as.data.frame(stringsAsFactors = FALSE)

1
2

data_raw_df %>%
  head(10)

##                             V1      V2      V3
## 1  2025-11-11T13:20:31.171165Z  Temp_5  25.875
## 2  2025-11-11T13:20:43.741052Z Temp_11  30.625
## 3  2025-11-11T13:20:43.741159Z Temp_10   48.75
## 4  2025-11-11T13:20:44.552422Z  Temp_8   28.25
## 5  2025-11-11T13:20:44.552522Z  Temp_9   28.25
## 6  2025-11-11T13:20:50.225514Z  Temp_2    19.8
## 7   2025-11-11T13:21:07.61594Z Temp_15 26.5625
## 8  2025-11-11T13:21:07.616039Z Temp_14 22.9375
## 9  2025-11-11T13:21:10.101543Z Temp_13   26.75
## 10 2025-11-11T13:21:10.911298Z Temp_12    23.5

Now we can change the column names (they are stored in data_raw %>% pluck("results", "series", 1, "columns", 1)) and convert the time column to POSIXct:

data_raw_df %>% 
   set_names(data_raw %>% pluck("results", "series", 1, "columns", 1)) %>%
   mutate(
      time = as.POSIXct(time, format = "%Y-%m-%dT%H:%M:%OSZ", tz = "UTC"),
      value = as.numeric(value)
    ) %>% 
  str()

## 'data.frame':	44176 obs. of  3 variables:
##  $ time     : POSIXct, format: "2025-11-11 13:20:31" "2025-11-11 13:20:43" ...
##  $ entity_id: chr  "Temp_5" "Temp_11" "Temp_10" "Temp_8" ...
##  $ value    : num  25.9 30.6 48.8 28.2 28.2 ...

Piwik Pro doesn't offer a free plan anymore

Sat, 27 Sep 2025 00:00:00 +0000

Unformatunately Piwik Pro has discontinued their free plan as of the end of 2025. If I wanted to user Piwik Pro I would have to pay at least 420,00 € per year.

As the author of the CRAN-hosted R-package piwikproR I have to decide whether I should continue maintaining the package or not.

My employer still uses Piwik Pro and I will continue using the package for my work but I can’t guarentee that I will continue maintaining the package because I can’t test it anymore at home.

gt() doesn't show Euro-Sign € in PDF, showing EUR instead

Sat, 15 Feb 2025 00:00:00 +0000

When it comes to using tidyverse in non-American contexts it gets often a little bit tricky. The last time I encountered a problem was when I tried to show the Euro-sign (€) in a PDF created with quarto and the gt-package.

Using html as output format everything was fine, but when I tried to create a PDF the Euro-sign was replaced by EUR.

There’s already an open issue at github ([ https://github.com/rstudio/gt/issues/1345]). But it’s getting pushed further and further down on the list of expected release versions.

So I had to find a workaround. The easiest way for me was to use fmt_number() followed by text_transfor() instead of fmt_currency().

So I format the columns with fmt_number() and then add the Euro-sign using paste0() and the unicode for the Euro-sign (\u20AC).

data %>%
  gt() %>%
  fmt_number(
    columns = c(some_currency_column, another_currency_column),
    sep_mark = ".",
    dec_mark = ",",
  ) %>% 
  text_transform(
    fn = function(x) paste0(x, " \u20AC"),
    locations = cells_body(
      columns = c(some_currency_column, another_currency_column)
    )

forcats::fct_lump_n() with weights "overall"

Sat, 14 Sep 2024 00:00:00 +0000

Sometimes I want to summarize some categories which don’t have much impact on my analysis. So the best way to do this is using some of the forcats::fct_lump*() functions. But I often struggle to find the way using the weights to order the categories. That’s because the main use case of fct_lump() is a vector of a factor containing several values and getting the most n and the rest combined as “other”.

Example

Let’s look at an example:

library(tidyverse)
set.seed(42)
values <- sample(letters[1:10], 40, replace = TRUE)
values

1
2
3

##  [1] "a" "e" "a" "i" "j" "d" "b" "j" "a" "h" "g" "d" "i" "e" "d" "j" "b" "c" "i"
## [20] "i" "d" "e" "e" "d" "b" "h" "c" "j" "a" "j" "h" "f" "j" "h" "d" "d" "f" "b"
## [39] "e" "d"

So values is a vector with 40 letters. Now we want to see the 5 most used letters and combine all other letters as “other”.

`1`	`forcats::fct_lump(values, 5)`

##  [1] a     e     a     i     j     d     b     j     a     h     Other d    
## [13] i     e     d     j     b     Other i     i     d     e     e     d    
## [25] b     h     Other j     a     j     h     Other j     h     d     d    
## [37] Other b     e     d    
## Levels: a b d e h i j Other

`1`	`forcats::fct_lump(values, 5) %>% table()`

1
2
3

## .
##     a     b     d     e     h     i     j Other 
##     4     4     8     5     4     4     6     5

Because of ties there are more than 5 letters. But that’s okay. There are options to handle ties.

Weights

Instead of simple counting it’s also possible to use weights. But in my regular cases I have to compute those weights.

Here’s my case. Let’s say I’m analyzing pageviews of a websites per browser. So I get for each day and browser a value.

set.seed(42)
chrome <- tibble(day = seq(1:5), useragent = "chrome", pageviews = round(rnorm(5, 1000, 100)))
firefox <- tibble(day = seq(1:5), useragent = "firefox", pageviews = round(rnorm(5, 600, 100)))
edge <- tibble(day = seq(1:5), useragent = "edge", pageviews = round(rnorm(5, 600, 100)))
junk_1 <- tibble(day = seq(1:5), useragent = "junk 1", pageviews = round(rnorm(5, 100, 20)))
junk_2 <- tibble(day = seq(1:5), useragent = "junk 2", pageviews = round(rnorm(5, 100, 20)))
junk_3 <- tibble(day = seq(1:5), useragent = "junk 3", pageviews = round(rnorm(5, 100, 20)))

data <- chrome %>% 
  rbind(firefox) %>% 
  rbind(edge) %>% 
  rbind(junk_1) %>% 
  rbind(junk_2) %>% 
  rbind(junk_3)

data %>% 
  arrange(day) %>% 
  head()

## # A tibble: 6 × 3
##     day useragent pageviews
##   <int> <chr>         <dbl>
## 1     1 chrome         1137
## 2     1 firefox         589
## 3     1 edge            730
## 4     1 junk 1          113
## 5     1 junk 2           94
## 6     1 junk 3           91

For each day there are lots of different browsers. Here I have three main browsers (chrome, firefox and edge) and three obscure ones (called junk 1 to junk 3). Those obscure ones I want to combine as “other” because I’m only interested in the main (or top) three browsers.

I like to rank my browsers by their total pageviews and then lump them.

data_lumped <- data %>% 
  group_by(useragent) %>% 
  mutate(browser_total = sum(pageviews)) %>% 
  ungroup() %>% 
  mutate(
    ua = fct_lump_n(f = useragent, n = 3, w = browser_total)
  ) %>% 
  arrange(day, ua)
data_lumped

## # A tibble: 30 × 5
##      day useragent pageviews browser_total ua     
##    <int> <chr>         <dbl>         <dbl> <fct>  
##  1     1 chrome         1137          5220 chrome 
##  2     1 edge            730          3179 edge   
##  3     1 firefox         589          3327 firefox
##  4     1 junk 1          113           431 Other  
##  5     1 junk 2           94           517 Other  
##  6     1 junk 3           91           447 Other  
##  7     2 chrome          944          5220 chrome 
##  8     2 edge            829          3179 edge   
##  9     2 firefox         751          3327 firefox
## 10     2 junk 1           94           431 Other  
## # ℹ 20 more rows

Now it’s simple grouping and summarizing:

data_lumped %>% 
  group_by(day, ua) %>% 
  summarise(pageviews = sum(pageviews), .groups = "drop") %>% 
  arrange(day, ua)

## # A tibble: 20 × 3
##      day ua      pageviews
##    <int> <fct>       <dbl>
##  1     1 chrome       1137
##  2     1 edge          730
##  3     1 firefox       589
##  4     1 Other         298
##  5     2 chrome        944
##  6     2 edge          829
##  7     2 firefox       751
##  8     2 Other         253
##  9     3 chrome       1036
## 10     3 edge          461
## 11     3 firefox       591
## 12     3 Other         209
## 13     4 chrome       1063
## 14     4 edge          572
## 15     4 firefox       802
## 16     4 Other         284
## 17     5 chrome       1040
## 18     5 edge          587
## 19     5 firefox       594
## 20     5 Other         351

JSON, NULL values and as_tibble

Sat, 07 Sep 2024 00:00:00 +0000

When working with data provided by common APIs you will almost always get in contact with JSON formatted data. Using R’s rjson::fromJSON will transform JSON to R’s lists. So far so good. Converting those lists to tibble using tibble::as_tibble will fail when the JSON (and therefor the list) contains NULL values. So you havve to replace them before building the tibble.

Example

But let’s start with an example:

library(tidyverse)
library(rjson)

data_json <- '
[
  {
    "name": "Tim",
    "age": 34,
    "hobby": "footbal"
  },
  {
    "name": "Tom",
    "age": 22,
    "hobby": "baseball"
  },    
  {
    "name": "Shelly",
    "age": 21,
    "hobby": "cycling"
  }  
]
'
parsed_json <- rjson::fromJSON(data_json)

parsed_json %>% str()

## List of 3
##  $ :List of 3
##   ..$ name : chr "Tim"
##   ..$ age  : num 34
##   ..$ hobby: chr "footbal"
##  $ :List of 3
##   ..$ name : chr "Tom"
##   ..$ age  : num 22
##   ..$ hobby: chr "baseball"
##  $ :List of 3
##   ..$ name : chr "Shelly"
##   ..$ age  : num 21
##   ..$ hobby: chr "cycling"

In in this example we parse the JSON using rjson::fromJSON() into a list of lists. Each sublist contains the value of a person.

We can convert this list of lists into a tibble with some purrr::map_dfr() magic:

1
2

parsed_json %>% 
  purrr::map_dfr(~ tibble::as_tibble(.x))

## # A tibble: 3 × 3
##   name     age hobby   
##   <chr>  <dbl> <chr>   
## 1 Tim       34 footbal 
## 2 Tom       22 baseball
## 3 Shelly    21 cycling

Example with null-values

But what happens if there are null-values in the JSON file?

data_json <- '
[
  {
    "name": "Tim",
    "age": 34,
    "hobby": "footbal"
  },
  {
    "name": "Tom",
    "age": null,
    "hobby": "baseball"
  },    
  {
    "name": "Shelly",
    "age": 21,
    "hobby": null
  }  
]
'
parsed_json <- rjson::fromJSON(data_json)

parsed_json %>% str()

## List of 3
##  $ :List of 3
##   ..$ name : chr "Tim"
##   ..$ age  : num 34
##   ..$ hobby: chr "footbal"
##  $ :List of 3
##   ..$ name : chr "Tom"
##   ..$ age  : NULL
##   ..$ hobby: chr "baseball"
##  $ :List of 3
##   ..$ name : chr "Shelly"
##   ..$ age  : num 21
##   ..$ hobby: NULL

As you can see the age of the second entry and the hobby of the third one are null. They get parsed to NULL.

These lead to an error when converting the list of list to a tibble:

1
2

parsed_json %>% 
  purrr::map_dfr(~ tibble::as_tibble(.x))

## Error in `map()`:
## ℹ In index: 2.
## Caused by error in `tibble::as_tibble()`:
## ! All columns in a tibble must be vectors.
## ✖ Column `age` is NULL.

Solution

So I suggest to use a custom function which converts NULL values to NAs and then converts the entry to a tibble

fix_NULL <- function(variables) {
  variables <- variables %>%
    map(~ ifelse(is.null(.x), NA, .x))
  tibble::as_tibble(variables)
}

parsed_json %>% 
  purrr::map_dfr(~ fix_NULL(.x))

## # A tibble: 3 × 3
##   name     age hobby   
##   <chr>  <dbl> <chr>   
## 1 Tim       34 footbal 
## 2 Tom       NA baseball
## 3 Shelly    21 <NA>

Query BigQuery throws error: Error in strsplit(name, ".", fixed = TRUE) : non-character argument

Sun, 26 Nov 2023 00:00:00 +0000

Lately I tried to query BigQuery using bigrquery. Unfortunately I got an error: Error in strsplit(name, ".", fixed = TRUE) : non-character argument

Updating to the latest packages on CRAN doesn’t solve the problem. So I had to dig deeper.

The solution was installing the latest version of bigrquery from Github (which is 1.4.2.9000) using

devtools::install_github("r-dbi/bigrquery")

How to use nflfastR with Google BigQuery?

Sun, 06 Nov 2022 00:00:00 +0000

Lately I wanted to play around with nflfastR. That’s a great package giving you access to NFL’s play-by-play data since 1999. It let’s you download all the data and store it in several different databases.

Unfortunately I ran into trouble when I tried to import the data to Google’s BigQuery.

Two problems

I’ve identified to problems.

The first one occured when the destination table doesn’t exist in BigQuery.
The second one occured when the 2001 season was imported.

My solutions

The open source way

The solution for the first bug was relative simple: Check if the table exists. If not don’t set the append parameter to TRUE when calling DBI::dbWriteTable(). (See here).

The other one was a little bit more tricky. As it turned out the new table is created by using data consisting of

the first season loaded (usually 1999) and
a default_play. Both are binded together (see here) and then given to DBI::dbWriteTable().

The default_play is somehow created by the package author.

So DBI (or the database) guesses what column type should be created for each column by this data. And that’s where the trouble starts:

The column weather is empty for seasons 1999 and 2000. So the only value provided for this column is in default_play. The value is a very long string of repeating “NA”.

As it turned out DBI::dbWriteTable() or BigQuery uses column type BYTES as the best fitting type for this value. (Why this happens is not quite clear. It depends on the length of the string. See my question here.) Unfortunately this column types can’t handle Unicode values which are used in the weather-column in seasons 2001 and younger.

So I provided two ways for fixing this issue:

Change the value of default_play$weather, see commit
Load the data in reverse order so you provide at creation time correct data, see commit

Both solutions were rejected by the package maintainers. They argue that the DBI-implementation for BigQuery is the reason for the problems. This might be true. But it doesn’t help someone who wants to use nflfastR with BigQuery.

What to do else?

So if you want to use nflfastR with BigQuery you can either use my fork of this package. I’ll try to update it when the upstream package is updated.

Pre-Import Script

But I looked for another solution tackling the main reason why the original packages fails.

The main reason the import of the data fails is that the database guesses what the best column types are for our data. I think that’s bad habit. I think it’s much better to be precise. So tell the database the correct column types for the new table. If this would be done in the original package all problems would be gone.

So here’s my script you can run before importing the data:

library(tidyverse)
library(DBI)


project <- "bigquery-project-name"
dataset <- "bigquery-dataset-name"
billing <- "bigquery-project-name"

table_name <- "bigquery-table-name"

# Connection for DBI
con <- DBI::dbConnect(
  bigrquery::bigquery(),
  project = project,
  dataset = dataset,
  billing = project
)



field_types <- structure(list(name = c("play_id", "game_id", "old_game_id", 
                                       "home_team", "away_team", "season_type", "week", "posteam", "posteam_type", 
                                       "defteam", "side_of_field", "yardline_100", "game_date", "quarter_seconds_remaining", 
                                       "half_seconds_remaining", "game_seconds_remaining", "game_half", 
                                       "quarter_end", "drive", "sp", "qtr", "down", "goal_to_go", "time", 
                                       "yrdln", "ydstogo", "ydsnet", "desc", "play_type", "yards_gained", 
                                       "shotgun", "no_huddle", "qb_dropback", "qb_kneel", "qb_spike", 
                                       "qb_scramble", "pass_length", "pass_location", "air_yards", "yards_after_catch", 
                                       "run_location", "run_gap", "field_goal_result", "kick_distance", 
                                       "extra_point_result", "two_point_conv_result", "home_timeouts_remaining", 
                                       "away_timeouts_remaining", "timeout", "timeout_team", "td_team", 
                                       "td_player_name", "td_player_id", "posteam_timeouts_remaining", 
                                       "defteam_timeouts_remaining", "total_home_score", "total_away_score", 
                                       "posteam_score", "defteam_score", "score_differential", "posteam_score_post", 
                                       "defteam_score_post", "score_differential_post", "no_score_prob", 
                                       "opp_fg_prob", "opp_safety_prob", "opp_td_prob", "fg_prob", "safety_prob", 
                                       "td_prob", "extra_point_prob", "two_point_conversion_prob", "ep", 
                                       "epa", "total_home_epa", "total_away_epa", "total_home_rush_epa", 
                                       "total_away_rush_epa", "total_home_pass_epa", "total_away_pass_epa", 
                                       "air_epa", "yac_epa", "comp_air_epa", "comp_yac_epa", "total_home_comp_air_epa", 
                                       "total_away_comp_air_epa", "total_home_comp_yac_epa", "total_away_comp_yac_epa", 
                                       "total_home_raw_air_epa", "total_away_raw_air_epa", "total_home_raw_yac_epa", 
                                       "total_away_raw_yac_epa", "wp", "def_wp", "home_wp", "away_wp", 
                                       "wpa", "vegas_wpa", "vegas_home_wpa", "home_wp_post", "away_wp_post", 
                                       "vegas_wp", "vegas_home_wp", "total_home_rush_wpa", "total_away_rush_wpa", 
                                       "total_home_pass_wpa", "total_away_pass_wpa", "air_wpa", "yac_wpa", 
                                       "comp_air_wpa", "comp_yac_wpa", "total_home_comp_air_wpa", "total_away_comp_air_wpa", 
                                       "total_home_comp_yac_wpa", "total_away_comp_yac_wpa", "total_home_raw_air_wpa", 
                                       "total_away_raw_air_wpa", "total_home_raw_yac_wpa", "total_away_raw_yac_wpa", 
                                       "punt_blocked", "first_down_rush", "first_down_pass", "first_down_penalty", 
                                       "third_down_converted", "third_down_failed", "fourth_down_converted", 
                                       "fourth_down_failed", "incomplete_pass", "touchback", "interception", 
                                       "punt_inside_twenty", "punt_in_endzone", "punt_out_of_bounds", 
                                       "punt_downed", "punt_fair_catch", "kickoff_inside_twenty", "kickoff_in_endzone", 
                                       "kickoff_out_of_bounds", "kickoff_downed", "kickoff_fair_catch", 
                                       "fumble_forced", "fumble_not_forced", "fumble_out_of_bounds", 
                                       "solo_tackle", "safety", "penalty", "tackled_for_loss", "fumble_lost", 
                                       "own_kickoff_recovery", "own_kickoff_recovery_td", "qb_hit", 
                                       "rush_attempt", "pass_attempt", "sack", "touchdown", "pass_touchdown", 
                                       "rush_touchdown", "return_touchdown", "extra_point_attempt", 
                                       "two_point_attempt", "field_goal_attempt", "kickoff_attempt", 
                                       "punt_attempt", "fumble", "complete_pass", "assist_tackle", "lateral_reception", 
                                       "lateral_rush", "lateral_return", "lateral_recovery", "passer_player_id", 
                                       "passer_player_name", "passing_yards", "receiver_player_id", 
                                       "receiver_player_name", "receiving_yards", "rusher_player_id", 
                                       "rusher_player_name", "rushing_yards", "lateral_receiver_player_id", 
                                       "lateral_receiver_player_name", "lateral_receiving_yards", "lateral_rusher_player_id", 
                                       "lateral_rusher_player_name", "lateral_rushing_yards", "lateral_sack_player_id", 
                                       "lateral_sack_player_name", "interception_player_id", "interception_player_name", 
                                       "lateral_interception_player_id", "lateral_interception_player_name", 
                                       "punt_returner_player_id", "punt_returner_player_name", "lateral_punt_returner_player_id", 
                                       "lateral_punt_returner_player_name", "kickoff_returner_player_name", 
                                       "kickoff_returner_player_id", "lateral_kickoff_returner_player_id", 
                                       "lateral_kickoff_returner_player_name", "punter_player_id", "punter_player_name", 
                                       "kicker_player_name", "kicker_player_id", "own_kickoff_recovery_player_id", 
                                       "own_kickoff_recovery_player_name", "blocked_player_id", "blocked_player_name", 
                                       "tackle_for_loss_1_player_id", "tackle_for_loss_1_player_name", 
                                       "tackle_for_loss_2_player_id", "tackle_for_loss_2_player_name", 
                                       "qb_hit_1_player_id", "qb_hit_1_player_name", "qb_hit_2_player_id", 
                                       "qb_hit_2_player_name", "forced_fumble_player_1_team", "forced_fumble_player_1_player_id", 
                                       "forced_fumble_player_1_player_name", "forced_fumble_player_2_team", 
                                       "forced_fumble_player_2_player_id", "forced_fumble_player_2_player_name", 
                                       "solo_tackle_1_team", "solo_tackle_2_team", "solo_tackle_1_player_id", 
                                       "solo_tackle_2_player_id", "solo_tackle_1_player_name", "solo_tackle_2_player_name", 
                                       "assist_tackle_1_player_id", "assist_tackle_1_player_name", "assist_tackle_1_team", 
                                       "assist_tackle_2_player_id", "assist_tackle_2_player_name", "assist_tackle_2_team", 
                                       "assist_tackle_3_player_id", "assist_tackle_3_player_name", "assist_tackle_3_team", 
                                       "assist_tackle_4_player_id", "assist_tackle_4_player_name", "assist_tackle_4_team", 
                                       "tackle_with_assist", "tackle_with_assist_1_player_id", "tackle_with_assist_1_player_name", 
                                       "tackle_with_assist_1_team", "tackle_with_assist_2_player_id", 
                                       "tackle_with_assist_2_player_name", "tackle_with_assist_2_team", 
                                       "pass_defense_1_player_id", "pass_defense_1_player_name", "pass_defense_2_player_id", 
                                       "pass_defense_2_player_name", "fumbled_1_team", "fumbled_1_player_id", 
                                       "fumbled_1_player_name", "fumbled_2_player_id", "fumbled_2_player_name", 
                                       "fumbled_2_team", "fumble_recovery_1_team", "fumble_recovery_1_yards", 
                                       "fumble_recovery_1_player_id", "fumble_recovery_1_player_name", 
                                       "fumble_recovery_2_team", "fumble_recovery_2_yards", "fumble_recovery_2_player_id", 
                                       "fumble_recovery_2_player_name", "sack_player_id", "sack_player_name", 
                                       "half_sack_1_player_id", "half_sack_1_player_name", "half_sack_2_player_id", 
                                       "half_sack_2_player_name", "return_team", "return_yards", "penalty_team", 
                                       "penalty_player_id", "penalty_player_name", "penalty_yards", 
                                       "replay_or_challenge", "replay_or_challenge_result", "penalty_type", 
                                       "defensive_two_point_attempt", "defensive_two_point_conv", "defensive_extra_point_attempt", 
                                       "defensive_extra_point_conv", "safety_player_name", "safety_player_id", 
                                       "season", "cp", "cpoe", "series", "series_success", "series_result", 
                                       "order_sequence", "start_time", "time_of_day", "stadium", "weather", 
                                       "nfl_api_id", "play_clock", "play_deleted", "play_type_nfl", 
                                       "special_teams_play", "st_play_type", "end_clock_time", "end_yard_line", 
                                       "fixed_drive", "fixed_drive_result", "drive_real_start_time", 
                                       "drive_play_count", "drive_time_of_possession", "drive_first_downs", 
                                       "drive_inside20", "drive_ended_with_score", "drive_quarter_start", 
                                       "drive_quarter_end", "drive_yards_penalized", "drive_start_transition", 
                                       "drive_end_transition", "drive_game_clock_start", "drive_game_clock_end", 
                                       "drive_start_yard_line", "drive_end_yard_line", "drive_play_id_started", 
                                       "drive_play_id_ended", "away_score", "home_score", "location", 
                                       "result", "total", "spread_line", "total_line", "div_game", "roof", 
                                       "surface", "temp", "wind", "home_coach", "away_coach", "stadium_id", 
                                       "game_stadium", "aborted_play", "success", "passer", "passer_jersey_number", 
                                       "rusher", "rusher_jersey_number", "receiver", "receiver_jersey_number", 
                                       "pass", "rush", "first_down", "special", "play", "passer_id", 
                                       "rusher_id", "receiver_id", "name", "jersey_number", "id", "fantasy_player_name", 
                                       "fantasy_player_id", "fantasy", "fantasy_id", "out_of_bounds", 
                                       "home_opening_kickoff", "qb_epa", "xyac_epa", "xyac_mean_yardage", 
                                       "xyac_median_yardage", "xyac_success", "xyac_fd", "xpass", "pass_oe"
), type = c("FLOAT", "STRING", "STRING", "STRING", "STRING", 
            "STRING", "INTEGER", "STRING", "STRING", "STRING", "STRING", 
            "FLOAT", "STRING", "FLOAT", "FLOAT", "FLOAT", "STRING", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "STRING", "STRING", 
            "FLOAT", "FLOAT", "STRING", "STRING", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "STRING", "STRING", "FLOAT", 
            "FLOAT", "STRING", "STRING", "STRING", "FLOAT", "STRING", "STRING", 
            "FLOAT", "FLOAT", "FLOAT", "STRING", "STRING", "STRING", "STRING", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "STRING", "STRING", 
            "FLOAT", "STRING", "STRING", "FLOAT", "STRING", "STRING", "FLOAT", 
            "STRING", "STRING", "FLOAT", "STRING", "STRING", "FLOAT", "STRING", 
            "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", 
            "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", 
            "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", 
            "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", 
            "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", 
            "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", 
            "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", 
            "STRING", "STRING", "STRING", "STRING", "FLOAT", "STRING", "STRING", 
            "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", 
            "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", 
            "STRING", "FLOAT", "STRING", "STRING", "STRING", "FLOAT", "STRING", 
            "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", 
            "STRING", "FLOAT", "STRING", "STRING", "STRING", "FLOAT", "FLOAT", 
            "STRING", "STRING", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "STRING", 
            "STRING", "INTEGER", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "STRING", 
            "FLOAT", "STRING", "STRING", "STRING", "STRING", "STRING", "STRING", 
            "FLOAT", "STRING", "FLOAT", "STRING", "STRING", "STRING", "FLOAT", 
            "STRING", "STRING", "FLOAT", "STRING", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "STRING", "STRING", "STRING", "STRING", 
            "STRING", "STRING", "FLOAT", "FLOAT", "INTEGER", "INTEGER", "STRING", 
            "INTEGER", "INTEGER", "FLOAT", "FLOAT", "INTEGER", "STRING", 
            "STRING", "INTEGER", "INTEGER", "STRING", "STRING", "STRING", 
            "STRING", "FLOAT", "FLOAT", "STRING", "INTEGER", "STRING", "INTEGER", 
            "STRING", "INTEGER", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", 
            "STRING", "STRING", "STRING", "STRING", "INTEGER", "STRING", 
            "STRING", "STRING", "STRING", "STRING", "FLOAT", "FLOAT", "FLOAT", 
            "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT", "FLOAT"
)), class = "data.frame", row.names = c(NA, -372L))

data_source <- bigrquery::bq_table(project, dataset, table_name)

# create table in BigQuery
bigrquery::bq_table_create(data_source, 
                           fields = bigrquery::as_bq_fields(
                             field_types %>% purrr::pmap(list)
                             )
                           )

This might be a little bit tedious but it’s precise. The table is created in the way we want it to be.

Now we can use the original package and import all the data.

# Load data in BigQuery using nflfastR
nflfastR::update_db(
  tblname = table_name,
  db_connection = con
)

Where does bigrquery store credential-tokens on a Mac?

Sat, 15 Oct 2022 00:00:00 +0000

This blogpost is mainly a reminder for myself where I can delete this information.

But what’s all about?

Recently I installed bigrquery and ran queries against Google’s BigQuery cloud-database before I had installed gcloud (and did the authorization as described at https://docs.getdbt.com/reference/warehouse-setups/bigquery-setup#local-oauth-gcloud-setup).

So R asked me to authorize the session in a browser. So far so good.

But every time I started a new R session I was asked if I want to use the well known account or another one.

So I was wondering where this account information was stored and how I could delete this information.

So the search did start. First I thought there must be somewhere a .httr-oauth file lying around.

No way!

It was stored in a file in ~/Library/Caches/gargle named after the Google account I was using.

Strange warning after loading own package

Fri, 16 Sep 2022 00:00:00 +0000

After upgrading my local R version to version 4.2.1 I always got an annoying warning after loading my own package. This only occurred using RStudio.

1
2
3

Warning message:
In length(steps) == 0 || nchar(steps) == 0 :
  'length(x) = 2 > 1' in coercion to 'logical(1)'

“Okay, that’s something new in R 4.2.0”, I thought and found https://stackoverflow.com/questions/72848442/r-warning-lengthx-2-1-in-coercion-to-logical1

But my code doesn’t use the cited code. Outside of RStudio, the warning doesn’t appear. So I cloned the repo again. No warning.

When I copied .Rprofile.user into the new directory the warning appeared again. So I explored the files step by step.

There was a file that seems to contain breakpoints. When deleting this file by calling Debug -> Clear All Breakpoints... the warning disappeared.

pkgdown and GDPR - How to host a pkgdown site in Germany

Fri, 02 Sep 2022 00:00:00 +0000

pkgdown is a great tool for generating a website with documentation for an R package.

Unfortunately, pkgdown uses CDNs (content delivery networks) like Cloudflare to embed often used JavaScript libraries into the generated website. Also, fonts are included in such a way. That’s a good idea when these files are cached over websites away.

But in Germany due to GDPR, it’s only allowed to do so after the user has given his consent.

There was a verdict in Germany that you need the consent of the user before you are allowed to embed Google fonts (see German article https://www.golem.de/news/landgericht-muenchen-einbindung-von-google-fonts-ist-rechtswidrig-2202-162826.html). It’s expected that this is also true for other resources delivered by CDNs.

So I was looking for a simple solution to host a pkgdown site in Germany.

The solution is a custom theme that contains all critical files and doesn’t reference to CDNs. And how do you use such a custom theme? ** Build a package! **

So I wrote pkgdown4gdpr: https://github.com/rstats-tips/pkgdown4gdpr

It only overwrites the critical files of the original theme.

Using the package is simple. After installing it locally you only need to add this to your _pkgdown.yml:

1
2
3

template:
  bootstrap: 5
  package: pkgdown4gdpr

Disclaimer

This package is still work in progress. It works for me. There may be configurations or options which trigger downloading further files. So please double-check on your own when using this package.

Iterating over the rows of a data.frame with purrr -- Part 2

Fri, 22 Apr 2022 00:00:00 +0000

A year ago I already wrote an article how to iterate over the rows of a data.frame. Now I’ve run into another special case. Last year we used pmap_dfr() to pass each element of a row as single parameter to our custom function.

But what should you do if your function accepts a data.frame (or list) as one single parameter?

The function …

But let’s look at our example first:

my_function <- function(repeated = 1, text = "a", number_rows = 2) {
  row <- data.frame(
    `repeated` = repeated,
    `text`   = text,
    `number_rows`  = number_rows, 
    generated_text = paste(replicate(repeated, text), collapse = "")
  )
  return(do.call("rbind", replicate(number_rows, row, simplify = FALSE)))
}

my_function(3, "Hello ", 4)

##   repeated   text number_rows     generated_text
## 1        3 Hello            4 Hello Hello Hello 
## 2        3 Hello            4 Hello Hello Hello 
## 3        3 Hello            4 Hello Hello Hello 
## 4        3 Hello            4 Hello Hello Hello

Let’s change this function a little bit:

my_new_function <- function(input_data) {
  row <- data.frame(
    `repeated` = input_data$repeated,
    `text`   = input_data$text,
    `number_rows`  = input_data$number_rows, 
    generated_text = paste(replicate(input_data$repeated, input_data$text), collapse = "")
  )
  return(do.call("rbind", replicate(input_data$number_rows, row, simplify = FALSE)))
}

input_data <- data.frame(
  repeated = 3,
  text = "Hello ",
  number_rows = 4
)
my_new_function(input_data)

##   repeated   text number_rows     generated_text
## 1        3 Hello            4 Hello Hello Hello 
## 2        3 Hello            4 Hello Hello Hello 
## 3        3 Hello            4 Hello Hello Hello 
## 4        3 Hello            4 Hello Hello Hello

… and its parameters

Now we want to call the function my_new_function with each row of the following data.frame as parameter:

options(tidyverse.quiet = TRUE)
library(tidyverse, warn.conflicts = FALSE)
parameters <- tribble(
  ~repeated, ~text, ~number_rows,
  1, "one", 3,
  2, "two", 2,
  3, "three", 1
) %>% 
  as.data.frame()

parameters

##   repeated  text number_rows
## 1        1   one           3
## 2        2   two           2
## 3        3 three           1

Iterating again

Using purrr::pmap_dfr() won’t work because our function expects one single argument.

So we use purrr::pmap() to convert each row into a data.frame and combine these data.frames to a list. Then we can use purrr::map_dfr().

1
2
3

parameters %>% 
  purrr::pmap(data.frame) %>% 
  purrr::map_dfr(my_new_function)

##   repeated  text number_rows  generated_text
## 1        1   one           3             one
## 2        1   one           3             one
## 3        1   one           3             one
## 4        2   two           2          twotwo
## 5        2   two           2          twotwo
## 6        3 three           1 threethreethree

Notes

When I had found the above solution for my problem I googled for a solution with one single purrr function call. During this search I found this page by Jenny Bryan who is very inspiring for all purrr related stuff.

Lists to Data.Frames with imap

Thu, 17 Feb 2022 00:00:00 +0000

When working with data which is a result of json-data converted to a list of lists of lists of lists … (you know what mean ;-)) I often want to convert it a data.frame.

Unfortunately there’s often a list in the source data which is unnamed. Or the list in one row is longer than the one in another row. So converting it straight forward into a data.frame or tibble fails with the error message Tibble columns must have compatible sizes.

So what to do? Just leave lists as values in the cells of the data.frame.

Let’s have a look at some sample data:

Sample data

options(tidyverse.quiet = TRUE)
library(tidyverse)

row_1 <- list(
  a = 42, 
  b = list("one", "two", "three", "four"),
  c = list("R", "python")
)

row_2 <- list(
  a = 3.14159, 
  b = list("A", "B"),
  c = list("Montana", "Ohio", "California")
)

source <- list(row_1, row_2)

So we have a list source which contains two entries. Both are lists on its own: row_1 and row_2.

Goal

As a result we want to get a data.frame (or tibble):

target <- tribble(
  ~a, ~b, ~c,
  42, list("one", "two", "three", "four"), list("R", "python"),
  3.14159, list("A", "B"), list("Montana", "Ohio", "California")
)

target

## # A tibble: 2 × 3
##       a b          c         
##   <dbl> <list>     <list>    
## 1 42    <list [4]> <list [2]>
## 2  3.14 <list [2]> <list [3]>

purrr::imap

Let’s start with a single row.

The idea is to iterate over each element of the the row_1. So purrr::map* seems to be the function-family of choice. But these functions iterate only over the values of the list. They don’t pass the name of each element.

So we need purrr::imap. This function takes two arguments, the value and the name, and puts them into the processing function:

1
2

row_1 %>% 
  purrr::imap_dfc(~ tibble({{.y}} := list(.x)))

## # A tibble: 1 × 3
##   a         b          c         
##   <list>    <list>     <list>    
## 1 <dbl [1]> <list [4]> <list [2]>

Okay, that seems pretty good. But the first column shouldn’t be a list. Here we want a normal column.

1
2

row_1 %>% 
  purrr::imap_dfc(~ tibble({{.y}} := ifelse(length(.x) > 1, list(.x), .x)))

## # A tibble: 1 × 3
##       a b          c         
##   <dbl> <list>     <list>    
## 1    42 <list [4]> <list [2]>

That’s really nice. So how do we process the whole list source? We use another instance of purrr::map*.

result <- source %>% 
  purrr::map_dfr(
    ~.x %>% purrr::imap_dfc(~ tibble({{.y}} := ifelse(length(.x) > 1, list(.x), .x)))
  )
result

## # A tibble: 2 × 3
##       a b          c         
##   <dbl> <list>     <list>    
## 1 42    <list [4]> <list [2]>
## 2  3.14 <list [2]> <list [3]>

Accessing Snowflake with R

Mon, 07 Feb 2022 00:00:00 +0000

Snowflake is a well known cloud-based database. It’s used for Data Warehouses and other big data applications.

In this article and the following ones I want to show how to setup and access a snowflake database from various clients such as R, Tableau and PowerBI.

So let’s start using R.

Setup Snowflake

Assuming that we already have access to an instance of Snowflake we first setup a new environment for our tests. This environment consists of a warehouse, a database and an user.

Note: I will name all things we will create EXAMPLE_something. So we can recognize our new items.

Create Warehouse

A warehouse represents the computing power. A warehouse has a specific size which determines the computing power (and the price you pay for it). You only pay for the time the warehouse is used.

So switch to SYSADMIN role and create a new warehouse. We call it EXAMPLE_WH.

Don’t press Finish. Instead click onto Show SQL.

As you can see we can use SQL-commands (or SQL-like commands) to create this warehouse. Actually we’ll do this.

Copy this SQL-command and switch to Worksheets. As you can see we choose a smaller timeout for AUTO_SUSPEND. We also lower the value for STATEMENT_TIMEOUT_IN_SECONDS. That’s like a safety net in case something runs amok.

CREATE WAREHOUSE EXAMPLE_WH WITH WAREHOUSE_SIZE = 'XSMALL' WAREHOUSE_TYPE = 'STANDARD' AUTO_SUSPEND = 60 AUTO_RESUME = TRUE;

alter warehouse "EXAMPLE_WH" set STATEMENT_TIMEOUT_IN_SECONDS = 60;

show parameters in warehouse "EXAMPLE_WH";

Create Database

Using the worksheet we can create a database, too. We call it EXAMPLE_DB.

`1`	`CREATE DATABASE EXAMPLE_DB;`

Create Role

We also create a role called EXAMPLE_ROLE. This role will be used to manage permissions.

1
2

use role USERADMIN;
CREATE ROLE EXAMPLE_ROLE;

Create User

Now we can switch our own role to ACCOUNTADMIN and create a new user called EXAMPLE_USER.

As you can see it’s also possible to create a user using SQL-commands.

1
2

CREATE USER EXAMPLE_USER PASSWORD = '****' DEFAULT_ROLE = "EXAMPLE_ROLE" DEFAULT_WAREHOUSE = 'EXAMPLE_WH' MUST_CHANGE_PASSWORD = FALSE;
GRANT ROLE "EXAMPLE_ROLE" TO USER EXAMPLE_USER;

Grant permissions to Role

Now grant permissions for the database to our new role.

Also grant permissions for the warehouse to the role.

Create Schema

Now we should grant EXAMPLE_ROLE to SYSADMIN role because we can use our default user and switch to EXAMPLE_ROLE and create a schema within the database.

The new schema is called EXAMPLE_SCHEMA.

1
2
3

use role EXAMPLE_ROLE;
use database EXAMPLE_DB;
CREATE SCHEMA "EXAMPLE_DB"."EXAMPLE_SCHEMA";

Create tables

Within the newly created schema we create two empty tables.

`1`	`CREATE TABLE "EXAMPLE_DB"."EXAMPLE_SCHEMA"."TABLE_A" ("ID_1" INTEGER NOT NULL, "ID_2" STRING NOT NULL, "VALUE_1" STRING NOT NULL, "VALUE_2" INTEGER NOT NULL);`

`1`	`CREATE TABLE "EXAMPLE_DB"."EXAMPLE_SCHEMA"."TABLE_B" ("ID_1" INTEGER NOT NULL, "ID_2" STRING NOT NULL, "VALUE_1" STRING NOT NULL, "VALUE_2" INTEGER NOT NULL);`

Accessing Snowflake from R

So now it’s time to connect to Snowflake from R:

Connection via DBI

You have to setup an odbc-connection to access Snowflake from R. The way to do this depends on your operation system. So have a look at the manual at Snowflake, please.

library(tidyverse)
library(dbplyr)
library(DBI)

db_connection <- DBI::dbConnect(odbc::odbc(),
                         Driver="Snowflake",
                         Server="MY_SNOWFLAKE_SERVER.snowflakecomputing.com",
                         Database="EXAMPLE_DB",
                         SCHEMA="EXAMPLE_SCHEMA",
                         UID="EXAMPLE_USER",
                         PWD="MY_SECRET_PASSWORD",
                         WAREHOUSE="EXAMPLE_WH"
)

Writing some data

Let’s generate some sample data and push it to Snowflake.

n_rows <- 12
set.seed(0815)
data_a <- data.frame(
  ID_1 = 1:n_rows,
  ID_2 = c("a", "b", "c"),
  VALUE_1 = sample(c("Apple", "Pear", "Banana"), n_rows, replace = TRUE),
  VALUE_2 = round(runif(n_rows, max = 100))
)
copy_to(db_connection, data_a, "TABLE_A", overwrite = TRUE)

ids <- 12
n_rows <- ids * 10
set.seed(0815)
data_b <- data.frame(
  ID_1 = 1:ids,
  ID_2 = c("a", "b", "c"),
  VALUE_1 = sample(c("Jim", "Max", "Hanna", "Maria", "Lucy", "John"), n_rows, replace = TRUE),
  VALUE_2 = round(runif(n_rows, max = 100))
)
copy_to(db_connection, data_b, "TABLE_B", overwrite = TRUE)

As you can see we use copy_to() to push a data.frame into a Snowflake database. That’s not the preferred way. For small data it’s acceptable and a fast way to get some data to Snowflake.

Reading some data

Reading from Snowflake is as simple as working with data.frames. We just bind a table to an R object using tbl().

1
2
3

a <- tbl(db_connection, "TABLE_A")
a %>%
  collect()

# A tibble: 12 × 4
    ID_1 ID_2  VALUE_1 VALUE_2
   <dbl> <chr> <chr>     <dbl>
 1     1 a     Pear         64
 2    12 c     Pear         67
 3    11 b     Banana       91
 4    10 a     Banana        4
 5     9 c     Pear         65
 6     8 b     Pear         67
 7     7 a     Banana       20
 8     6 c     Pear         33
 9     5 b     Banana       32
10     4 a     Pear         33
11     3 c     Pear         43
12     2 b     Apple        91

Complex statements

Even complext statements you use within tidyverse are possible.

a %>%
  select(ID_1, ID_2, VALUE_1) %>% 
  left_join(b, by = c("ID_1" = "ID_1", "ID_2" = "ID_2")) %>%
  group_by(ID_1, ID_2, VALUE_1.x, VALUE_1.y) %>% 
  summarize(VALUE_2 = sum(VALUE_2)) %>% 
  arrange(ID_1) %>%
  collect()

# A tibble: 59 × 5
# Groups:   ID_1, ID_2, VALUE_1.x [12]
    ID_1 ID_2  VALUE_1.x VALUE_1.y VALUE_2
   <dbl> <chr> <chr>     <chr>       <dbl>
 1     1 a     Pear      John           58
 2     1 a     Pear      Hanna         174
 3     1 a     Pear      Jim            85
 4     1 a     Pear      Max            30
 5     1 a     Pear      Maria         171
 6     2 b     Apple     Hanna         261
 7     2 b     Apple     John          116
 8     2 b     Apple     Lucy          162
 9     2 b     Apple     Jim           170

The last command collect() fetches the data from the database. Until this command nothing has happend.

SQL

Before calling collect() we can inspect the SQL-code which will be send to Snowflake.

Therefor you can call show_query().

query <- a %>%
  select(ID_1, ID_2, VALUE_1) %>%
  left_join(b, by = c("ID_1" = "ID_1", "ID_2" = "ID_2")) %>%
  group_by(ID_1, ID_2, VALUE_1.x, VALUE_1.y) %>%
  summarize(VALUE_2 = sum(VALUE_2)) %>%
  arrange(ID_1)

query %>% show_query()

<SQL>
SELECT "ID_1", "ID_2", "VALUE_1.x", "VALUE_1.y", SUM("VALUE_2") AS "VALUE_2"
FROM (SELECT "LHS"."ID_1" AS "ID_1", "LHS"."ID_2" AS "ID_2", "LHS"."VALUE_1" AS "VALUE_1.x", "RHS"."VALUE_1" AS "VALUE_1.y", "VALUE_2"
FROM (SELECT "ID_1", "ID_2", "VALUE_1"
FROM "TABLE_A") "LHS"
LEFT JOIN "TABLE_B" AS "RHS"
ON ("LHS"."ID_1" = "RHS"."ID_1" AND "LHS"."ID_2" = "RHS"."ID_2")
) "q01"
GROUP BY "ID_1", "ID_2", "VALUE_1.x", "VALUE_1.y"
ORDER BY "ID_1"

Here’s the SQL-command which Snowflake shows in its history: It’s identical.

The next articles will show how to access this data from Tableau and PowerBI.

Custom Formats in gt Tables

Sat, 27 Nov 2021 00:00:00 +0000

The “grammar of tables” is used to build tables with the R-package gt. Thomas Mock published an extension package called gtExtras which is used all over in tweets about NFL and Fantasy Football such as win and loss history information in a table.

gt follows a similar philosophy such as ggplot2. On the one hand there is the data to be shown (in a table resp. a plot). On the other hand there is the description how to visualize the data: What is the table header, are there subheaders, how are the cells grouped and formated?

So it was time to check out gt. During my tryouts I came across one demand I haven’t found an in-built solution for: I wanted to format a column with respect to the value of another column. Here’s the way I solved it:

Sample data

Let’s start with some sample data

options(tidyverse.quiet = TRUE)
library(tidyverse)

set.seed(42)
data <- tibble(
  case = letters[1:5],
  value = rnorm(5, 5, 10),
  status = c("ok", "unknown", "ok", "not ok", "unknown")
)

First gt-table

and create a simple gt-table

library(gt)

data %>% 
  gt()

case	value	status
a	18.7095845	ok
b	-0.6469817	unknown
c	8.6312841	ok
d	11.3286260	not ok
e	9.0426832	unknown

That’s great! That’s a pretty table with just one command!

Colored column based on its own values

Now let’s format the column value depending on its value:

data %>% 
  gt() %>% 
  data_color(
    columns = value,
    colors  = c("red", "orange", "yellow", "green")
  )

case	value	status
a	18.7095845	ok
b	-0.6469817	unknown
c	8.6312841	ok
d	11.3286260	not ok
e	9.0426832	unknown

Colored column based on value of another column

But now we want to format the column depending on the value in column status: When status is ok show a green background in column value, in case of “not okay” a red one, otherwise show a yellow background.

custom_tab_style <- function(data, column, status_column) {
  condition_green = glue::glue("{status_column} == 'ok'")
  condition_red = glue::glue("{status_column} == 'not ok'")
  condition_yellow = glue::glue("{status_column} == 'unknown'")
  data %>% 
    tab_style(
      style = cell_fill(color = 'lightgreen'),
      locations = cells_body(
        columns = all_of(column),
        rows = eval(parse(text = condition_green))
      )
    ) %>% 
    tab_style(
      style = list(cell_fill(color = 'red'), cell_text(color = 'white')),
      locations = cells_body(
        columns = all_of(column),
        rows = eval(parse(text = condition_red))
      )
    ) %>% 
    tab_style(
      style = cell_fill(color = 'yellow'),
      locations = cells_body(
        columns = all_of(column),
        rows = eval(parse(text = condition_yellow))
      )
    )
}

data %>% 
  gt() %>% 
  custom_tab_style("value", "status")

case	value	status
a	18.7095845	ok
b	-0.6469817	unknown
c	8.6312841	ok
d	11.3286260	not ok
e	9.0426832	unknown

As you can see I built a custom function custom_tab_style. Within this function I used the function tab_style and a arbitrary conditions to format the cells depending on the condition.

Hide the status column

Last we want to hide the column status. We can achieve this by using cols_hide()

data %>% 
  gt() %>% 
  custom_tab_style("value", "status") %>% 
  cols_hide(columns = "status")

case	value
a	18.7095845
b	-0.6469817
c	8.6312841
d	11.3286260
e	9.0426832

Update to piwikproR: fetching DateTimes via API

Sun, 17 Oct 2021 00:00:00 +0000

Last weekend I fixed some issues with my R-package piwikproR

The new version 0.3.1 is now available at CRAN

So let’s have a look at the changes:

The main change is that you now can fetch DateTime values from PIWIK PRO when you are using the API-endpoints /sessions or /events. The previous version just removed the time component and converted the timestamp column to just Date.

That may be important if you are using piwikproR to transfer all raw data from PIWIK PRO to your own data lake for further analysis.

The second change is a bug fix regarding these two API-endpoints. Now you can split the requests in daily chunks as you are used to with the endpoint /query.

The last change prevents caching of a request when an error has occured.

Working with tree-based hierarchies using data.tree

Sat, 31 Jul 2021 00:00:00 +0000

Lately I tried to visualize an hierarchy with Tableau Desktop. The problem was that the hierarchy had a variable depth because it was tree-based. Each row had an id and a parent_id. Normally hierarchies in Tableau are defined by pulling some fields together, such as product category, product group and product id.

Handling tree-based hierarchies seems to be a lot more complex. I found a plugin at https://github.com/tableau/extension-hierarchy-navigator-sandboxed but this only works online.

So I asked myself how I can handle this using R. I found the R-package data.tree at https://github.com/gluc/data.tree. I want to describe how I use this package to preprocess my data.

Some tree-based data

Let’s create some tree-based data.

options(tidyverse.quiet = TRUE)
library(tidyverse)

geography <- tribble(
  ~id, ~parent_id, ~area, ~some_additional_data,
  1, NA, "Europe", "That's a continent",
  2, 1, "Germany", "That's a country",
  3, 1, "France",  "Oh, yeah, another country",
  4, 1, "Denmark", "Oh dear, how many contries do you know",
  5, 2, "Hesse",   "ah, that's called Bundesland",
  6, 5, "Wiesbaden", "and that's the capital of Hesse",
  7, 2, "Berlin", "that's the capital of Germany and also a Bundesland",
  8, 5, "Main-Kinzig-Kreis", "that's a Landkreis",
  9, 8, "Gelnhausen", "and the Landkreis does have a capital called Kreisstadt",
 10, 3, "Paris", "The city of Love",
 11, 2, "Bavaria", "another Bundesland",
 12, 11, "Munich", "and its capital"
)

geography

## # A tibble: 12 x 4
##       id parent_id area            some_additional_data                         
##    <dbl>     <dbl> <chr>           <chr>                                        
##  1     1        NA Europe          That's a continent                           
##  2     2         1 Germany         That's a country                             
##  3     3         1 France          Oh, yeah, another country                    
##  4     4         1 Denmark         Oh dear, how many contries do you know       
##  5     5         2 Hesse           ah, that's called Bundesland                 
##  6     6         5 Wiesbaden       and that's the capital of Hesse              
##  7     7         2 Berlin          that's the capital of Germany and also a Bun…
##  8     8         5 Main-Kinzig-Kr… that's a Landkreis                           
##  9     9         8 Gelnhausen      and the Landkreis does have a capital called…
## 10    10         3 Paris           The city of Love                             
## 11    11         2 Bavaria         another Bundesland                           
## 12    12        11 Munich          and its capital

The Task

So the first two columns id and parent_id define the tree. How can we convert this format into a format where the hierarchy consists of n columns with the highest level in column Level_1, the second highest in Level_2 and so on?

The code should not depend on a given level of depth.

data.tree

Let’s take a look at data.tree:

1
2
3

library(data.tree)

FromDataFrameNetwork(geography)

1
2

##   levelName
## 1        NA

That doesn’t look promising. But wait, let’s replace NA by 0 and for further investigation let’s save id in another column called my_id:

geography %>% 
  replace_na(list(parent_id = 0)) %>%
  mutate(my_id = id) %>% 
  FromDataFrameNetwork()

##                levelName
## 1  0                    
## 2   °--1                
## 3       ¦--2            
## 4       ¦   ¦--5        
## 5       ¦   ¦   ¦--6    
## 6       ¦   ¦   °--8    
## 7       ¦   ¦       °--9
## 8       ¦   ¦--7        
## 9       ¦   °--11       
## 10      ¦       °--12   
## 11      ¦--3            
## 12      ¦   °--10       
## 13      °--4

Oh great, that’s the tree structure we had in mind. Now let’s build a data.frame:

geography %>% 
  replace_na(list(parent_id = 0)) %>%
  mutate(my_id = id) %>% 
  FromDataFrameNetwork() %>% 
  ToDataFrameTree("level", "area", "my_id")

##                levelName level              area my_id
## 1  0                         1              <NA>    NA
## 2   °--1                     2            Europe     1
## 3       ¦--2                 3           Germany     2
## 4       ¦   ¦--5             4             Hesse     5
## 5       ¦   ¦   ¦--6         5         Wiesbaden     6
## 6       ¦   ¦   °--8         5 Main-Kinzig-Kreis     8
## 7       ¦   ¦       °--9     6        Gelnhausen     9
## 8       ¦   ¦--7             4            Berlin     7
## 9       ¦   °--11            4           Bavaria    11
## 10      ¦       °--12        5            Munich    12
## 11      ¦--3                 3            France     3
## 12      ¦   °--10            4             Paris    10
## 13      °--4                 3           Denmark     4

Now we have the level of the hierarchy stored in column level and the value or name of the level in area.

Pivoting this data.frame should do the rest:

geography %>% 
  replace_na(list(parent_id = 0)) %>%
  mutate(my_id = id) %>% 
  FromDataFrameNetwork() %>% 
  ToDataFrameTree("level", "area", "my_id") %>% 
  select(-levelName) %>%
  mutate(level = glue::glue("Level_{level}")) %>%
  pivot_wider(names_from = level, values_from = area)

## # A tibble: 13 x 7
##    my_id Level_1 Level_2 Level_3 Level_4 Level_5           Level_6   
##    <dbl> <chr>   <chr>   <chr>   <chr>   <chr>             <chr>     
##  1    NA <NA>    <NA>    <NA>    <NA>    <NA>              <NA>      
##  2     1 <NA>    Europe  <NA>    <NA>    <NA>              <NA>      
##  3     2 <NA>    <NA>    Germany <NA>    <NA>              <NA>      
##  4     5 <NA>    <NA>    <NA>    Hesse   <NA>              <NA>      
##  5     6 <NA>    <NA>    <NA>    <NA>    Wiesbaden         <NA>      
##  6     8 <NA>    <NA>    <NA>    <NA>    Main-Kinzig-Kreis <NA>      
##  7     9 <NA>    <NA>    <NA>    <NA>    <NA>              Gelnhausen
##  8     7 <NA>    <NA>    <NA>    Berlin  <NA>              <NA>      
##  9    11 <NA>    <NA>    <NA>    Bavaria <NA>              <NA>      
## 10    12 <NA>    <NA>    <NA>    <NA>    Munich            <NA>      
## 11     3 <NA>    <NA>    France  <NA>    <NA>              <NA>      
## 12    10 <NA>    <NA>    <NA>    Paris   <NA>              <NA>      
## 13     4 <NA>    <NA>    Denmark <NA>    <NA>              <NA>

As we can see the first level Level_1 is always empty but we will need it later. Let’s solve this by reducing each level before pivoting.

geopgraphy_data.frame <- geography %>% 
  replace_na(list(parent_id = 0)) %>%
  mutate(my_id = id) %>% 
  FromDataFrameNetwork() %>% 
  ToDataFrameTree("level", "area", "my_id") %>% 
  select(-levelName) %>%
  mutate(level = level -1) %>%
  mutate(level = glue::glue("Level_{level}")) %>%
  pivot_wider(names_from = level, values_from = area) 

geopgraphy_data.frame

## # A tibble: 13 x 7
##    my_id Level_0 Level_1 Level_2 Level_3 Level_4           Level_5   
##    <dbl> <chr>   <chr>   <chr>   <chr>   <chr>             <chr>     
##  1    NA <NA>    <NA>    <NA>    <NA>    <NA>              <NA>      
##  2     1 <NA>    Europe  <NA>    <NA>    <NA>              <NA>      
##  3     2 <NA>    <NA>    Germany <NA>    <NA>              <NA>      
##  4     5 <NA>    <NA>    <NA>    Hesse   <NA>              <NA>      
##  5     6 <NA>    <NA>    <NA>    <NA>    Wiesbaden         <NA>      
##  6     8 <NA>    <NA>    <NA>    <NA>    Main-Kinzig-Kreis <NA>      
##  7     9 <NA>    <NA>    <NA>    <NA>    <NA>              Gelnhausen
##  8     7 <NA>    <NA>    <NA>    Berlin  <NA>              <NA>      
##  9    11 <NA>    <NA>    <NA>    Bavaria <NA>              <NA>      
## 10    12 <NA>    <NA>    <NA>    <NA>    Munich            <NA>      
## 11     3 <NA>    <NA>    France  <NA>    <NA>              <NA>      
## 12    10 <NA>    <NA>    <NA>    Paris   <NA>              <NA>      
## 13     4 <NA>    <NA>    Denmark <NA>    <NA>              <NA>

That’s nice.

Filling missing values of the hierarchy levels

Now we need to fill the missing value by using the right value of the line above. But wait, we have to group by each level and do this for each level.

That’s a great example for using purrr::reduce. We apply a function fill_level for each level and put the result as argument of the next call with next level.

# group by the parent level of the given level_name and fill the level
fill_level <- function(data, level_name) {
  grouping_level_id <- max(as.numeric(str_extract(level_name, "[0-9]+")) - 1, 0)
  previous_level <- glue::glue("Level_{grouping_level_id}")
  data %>%
    group_by(.data[[previous_level]]) %>%
    fill({{ level_name }}, .direction = "down")
}

# get all level names
level_names <- data.frame(names = names(geopgraphy_data.frame)) %>%
  filter(grepl("Level_", names)) %>%
  pull(names)

# use reduce to apply fill_level for each level to the result of the previous
# result
geopgraphy_data.frame <- reduce(level_names, fill_level, .init = geopgraphy_data.frame) %>%
  select(starts_with("Level_"), everything()) %>% 
  select(-Level_0)

geopgraphy_data.frame

## # A tibble: 13 x 6
## # Groups:   Level_4 [4]
##    Level_1 Level_2 Level_3 Level_4           Level_5    my_id
##    <chr>   <chr>   <chr>   <chr>             <chr>      <dbl>
##  1 <NA>    <NA>    <NA>    <NA>              <NA>          NA
##  2 Europe  <NA>    <NA>    <NA>              <NA>           1
##  3 Europe  Germany <NA>    <NA>              <NA>           2
##  4 Europe  Germany Hesse   <NA>              <NA>           5
##  5 Europe  Germany Hesse   Wiesbaden         <NA>           6
##  6 Europe  Germany Hesse   Main-Kinzig-Kreis <NA>           8
##  7 Europe  Germany Hesse   Main-Kinzig-Kreis Gelnhausen     9
##  8 Europe  Germany Berlin  <NA>              <NA>           7
##  9 Europe  Germany Bavaria <NA>              <NA>          11
## 10 Europe  Germany Bavaria Munich            <NA>          12
## 11 Europe  France  <NA>    <NA>              <NA>           3
## 12 Europe  France  Paris   <NA>              <NA>          10
## 13 Europe  Denmark <NA>    <NA>              <NA>           4

Adding other fancy columns

Now we can add all the other columns our original data has, currently just some_additional_data:

1
2
3

geopgraphy_data.frame %>% 
  left_join(geography %>% select(-parent_id, -area), by = c('my_id' = 'id')) %>% 
  filter(! is.na(Level_1)) # get rid of this line with all NAs

## # A tibble: 12 x 7
## # Groups:   Level_4 [4]
##    Level_1 Level_2 Level_3 Level_4    Level_5  my_id some_additional_data       
##    <chr>   <chr>   <chr>   <chr>      <chr>    <dbl> <chr>                      
##  1 Europe  <NA>    <NA>    <NA>       <NA>         1 That's a continent         
##  2 Europe  Germany <NA>    <NA>       <NA>         2 That's a country           
##  3 Europe  Germany Hesse   <NA>       <NA>         5 ah, that's called Bundesla…
##  4 Europe  Germany Hesse   Wiesbaden  <NA>         6 and that's the capital of …
##  5 Europe  Germany Hesse   Main-Kinz… <NA>         8 that's a Landkreis         
##  6 Europe  Germany Hesse   Main-Kinz… Gelnhau…     9 and the Landkreis does hav…
##  7 Europe  Germany Berlin  <NA>       <NA>         7 that's the capital of Germ…
##  8 Europe  Germany Bavaria <NA>       <NA>        11 another Bundesland         
##  9 Europe  Germany Bavaria Munich     <NA>        12 and its capital            
## 10 Europe  France  <NA>    <NA>       <NA>         3 Oh, yeah, another country  
## 11 Europe  France  Paris   <NA>       <NA>        10 The city of Love           
## 12 Europe  Denmark <NA>    <NA>       <NA>         4 Oh dear, how many contries…

So now we have a data.frame we can use in Tableau. Our script doesn’t depend on the overall depth of the hierarchy or the depth of one special branch.

Maybe there’s a simpler way to build this data.frame. If so, let me know, please. :-)

Update (2021-08-06)

I’ve got an interesting feedback from Fabio. He’s got another much more elegant way to convert the data.

He uses the pathString attribute of a data.tree.

Therefor he converts the orginal data with to self-joins to get rid of the ids and replacing them with their names:

www <- geography %>% 
  replace_na(list(parent_id = 0)) %>%
  left_join(geography %>% select(id, area), by="id", suffix=c("", "_id")) %>%
  left_join(geography %>% select(id, area), by=c("parent_id"="id"), suffix=c("", "_pid")) %>% 
  replace_na(list(area_pid = "World")) %>% 
  mutate(my_id = id) %>% 
  select(area_id, area_pid, area, my_id) %>%
  FromDataFrameNetwork()
www

##                            levelName
## 1  World                            
## 2   °--Europe                       
## 3       ¦--Germany                  
## 4       ¦   ¦--Hesse                
## 5       ¦   ¦   ¦--Wiesbaden        
## 6       ¦   ¦   °--Main-Kinzig-Kreis
## 7       ¦   ¦       °--Gelnhausen   
## 8       ¦   ¦--Berlin               
## 9       ¦   °--Bavaria              
## 10      ¦       °--Munich           
## 11      ¦--France                   
## 12      ¦   °--Paris                
## 13      °--Denmark

Here is now the trick with pathString:

`1`	`ToDataFrameTree(www, "pathString", "my_id")`

##                            levelName
## 1  World                            
## 2   °--Europe                       
## 3       ¦--Germany                  
## 4       ¦   ¦--Hesse                
## 5       ¦   ¦   ¦--Wiesbaden        
## 6       ¦   ¦   °--Main-Kinzig-Kreis
## 7       ¦   ¦       °--Gelnhausen   
## 8       ¦   ¦--Berlin               
## 9       ¦   °--Bavaria              
## 10      ¦       °--Munich           
## 11      ¦--France                   
## 12      ¦   °--Paris                
## 13      °--Denmark                  
##                                                 pathString my_id
## 1                                                    World    NA
## 2                                             World/Europe     1
## 3                                     World/Europe/Germany     2
## 4                               World/Europe/Germany/Hesse     5
## 5                     World/Europe/Germany/Hesse/Wiesbaden     6
## 6             World/Europe/Germany/Hesse/Main-Kinzig-Kreis     8
## 7  World/Europe/Germany/Hesse/Main-Kinzig-Kreis/Gelnhausen     9
## 8                              World/Europe/Germany/Berlin     7
## 9                             World/Europe/Germany/Bavaria    11
## 10                     World/Europe/Germany/Bavaria/Munich    12
## 11                                     World/Europe/France     3
## 12                               World/Europe/France/Paris    10
## 13                                    World/Europe/Denmark     4

As you can see pathString contains the path from top to bottom for the each entry. Now we str_split and unnest_wider (what a great function :-)) these values and get the similar as above.

The last step is another join to rejoin the other columns (here only some_additional_data).

ToDataFrameTree(www, "pathString", "my_id") %>% 
    mutate(path=stringr::str_split(pathString, "/")) %>% 
    unnest_wider(path, names_sep="_Level_") %>% 
    left_join(geography %>% select(-parent_id, -area), by = c('my_id' = 'id'))

## # A tibble: 13 x 10
##    levelName      pathString        my_id path_Level_1 path_Level_2 path_Level_3
##    <chr>          <chr>             <dbl> <chr>        <chr>        <chr>       
##  1 "World       … World                NA World        <NA>         <NA>        
##  2 " °--Europe  … World/Europe          1 World        Europe       <NA>        
##  3 "     ¦--Germ… World/Europe/Ger…     2 World        Europe       Germany     
##  4 "     ¦   ¦--… World/Europe/Ger…     5 World        Europe       Germany     
##  5 "     ¦   ¦  … World/Europe/Ger…     6 World        Europe       Germany     
##  6 "     ¦   ¦  … World/Europe/Ger…     8 World        Europe       Germany     
##  7 "     ¦   ¦  … World/Europe/Ger…     9 World        Europe       Germany     
##  8 "     ¦   ¦--… World/Europe/Ger…     7 World        Europe       Germany     
##  9 "     ¦   °--… World/Europe/Ger…    11 World        Europe       Germany     
## 10 "     ¦      … World/Europe/Ger…    12 World        Europe       Germany     
## 11 "     ¦--Fran… World/Europe/Fra…     3 World        Europe       France      
## 12 "     ¦   °--… World/Europe/Fra…    10 World        Europe       France      
## 13 "     °--Denm… World/Europe/Den…     4 World        Europe       Denmark     
## # … with 4 more variables: path_Level_4 <chr>, path_Level_5 <chr>,
## #   path_Level_6 <chr>, some_additional_data <chr>

Thanks to Fabio for the great feedback!

Adding lines or other geoms to a ggplot by calling a custom function

Sun, 11 Jul 2021 00:00:00 +0000

Sometimes you generate lots of ggplots of a similar kind, e.g. visualizations of different timeseries. Then you want to highlight some dates where something special had happened and you want to show that the value you are plotting changed at these dates.

So it would be nice if we can refactor these geom_vline or geom_hline calls into one single function.

Unfortunately the straight way using

add_lines <- function() {
  geom_vline(xintercept = ymd("2019-07-01"), color = "green") +
  geom_vline(xintercept = ymd("2021-01-01"), color = "red") + 
  geom_hline(yintercept = c(0, 12), color = "blue")
}

does not work:

But let’s start with an example:

library(ggplot2)
library(dplyr, warn.conflicts = FALSE)
library(lubridate, warn.conflicts = FALSE)

data <- tibble(
  date = seq(from = ymd("2019-01-01"), to = ymd("2021-06-30"), by = "week"),
) %>% 
  rowwise() %>% 
  mutate(
    value = month(date) + rnorm(1, mean = 0, sd = 3)
  )

plot <- data %>% 
  ggplot(aes(date, value)) +
  geom_point()

plot

Now we want to add some vertical and horizontal lines to plot:

plot +
  geom_vline(xintercept = ymd("2019-07-01"), color = "green") +
  geom_vline(xintercept = ymd("2021-01-01"), color = "red") + 
  geom_hline(yintercept = c(0, 12), color = "blue")

So let’s try it and use a function for adding these lines:

`1`	`plot + add_lines()`

`1`	`## Error: Cannot add ggproto objects together. Did you forget to add this object to a ggplot object?`

So we have to choose another way. The function should return instead of the sum of the function calls a list of these geom-calls!

add_lines_to_plot <- function() {
  list(
    geom_vline(xintercept = ymd("2019-07-01"), color = "green"),
    geom_vline(xintercept = ymd("2021-01-01"), color = "red"),
    geom_hline(yintercept = c(0, 12), color = "blue")
  )
}

plot + add_lines_to_plot()

Now it’s easy to reuse this function and add the same lines to other plots.

Simple tricks for Debugging Pipes (within magrittr, base R or ggplot2)

Sun, 06 Jun 2021 00:00:00 +0000

You know it, I’m sure: You are developing a data transformation using lots of pipes. Then you need to remove one or more lines. You do this using comments.

So far so good. But if it’s the last line you want to remove a simple comment will produce an error because of the trailing pipe symbol at the end of the second to last line.

Here’s a solution:

Pipes

Magrittr

Let’s say you are computing something like this:

options(tidyverse.quiet = TRUE)
library(tidyverse)
options(dplyr.summarise.inform = FALSE)

starwars %>% 
  mutate(
   mean_height = mean(height, na.rm = TRUE)
  ) %>% 
  group_by(species, gender) %>% 
  summarize(
    mean_height_species_gender = mean(height, na.rm = TRUE),
    mean_height = first(mean_height)
  ) %>% 
  mutate(
    diff_mean_height = mean_height_species_gender - mean_height
  ) %>% 
  select(gender, species, diff_mean_height) %>% 
  pivot_wider(names_from = 'gender', values_from = 'diff_mean_height', values_fill = NA)

## # A tibble: 38 x 4
## # Groups:   species [38]
##    species   masculine feminine  `NA`
##    <chr>         <dbl>    <dbl> <dbl>
##  1 Aleena       -95.4     NA       NA
##  2 Besalisk      23.6     NA       NA
##  3 Cerean        23.6     NA       NA
##  4 Chagrian      21.6     NA       NA
##  5 Clawdite      NA       -6.36    NA
##  6 Droid        -34.4    -78.4     NA
##  7 Dug          -62.4     NA       NA
##  8 Ewok         -86.4     NA       NA
##  9 Geonosian      8.64    NA       NA
## 10 Gungan        34.3     NA       NA
## # … with 28 more rows

Now you want to skip the last step pivoting the result. If you just comment out the last line, you’ll get an error:

starwars %>% 
  mutate(
   mean_height = mean(height, na.rm = TRUE)
  ) %>% 
  group_by(species, gender) %>% 
  summarize(
    mean_height_species_gender = mean(height, na.rm = TRUE),
    mean_height = first(mean_height)
  ) %>% 
  mutate(
    diff_mean_height = mean_height_species_gender - mean_height
  ) %>% 
  select(gender, species, diff_mean_height) %>% 
  # pivot_wider(names_from = 'gender', values_from = 'diff_mean_height', values_fill = NA)

## Error: <text>:15:0: unexpected end of input
## 13:   select(gender, species, diff_mean_height) %>% 
## 14:   # pivot_wider(names_from = 'gender', values_from = 'diff_mean_height', values_fill = NA) 
##    ^

But if you use identity() as your last step everything is fine:

starwars %>% 
  mutate(
   mean_height = mean(height, na.rm = TRUE)
  ) %>% 
  group_by(species, gender) %>% 
  summarize(
    mean_height_species_gender = mean(height, na.rm = TRUE),
    mean_height = first(mean_height)
  ) %>% 
  mutate(
    diff_mean_height = mean_height_species_gender - mean_height
  ) %>% 
  select(gender, species, diff_mean_height) %>% 
  # pivot_wider(names_from = 'gender', values_from = 'diff_mean_height', values_fill = NA) %>% 
  identity()

## # A tibble: 42 x 3
## # Groups:   species [38]
##    gender    species   diff_mean_height
##    <chr>     <chr>                <dbl>
##  1 masculine Aleena              -95.4 
##  2 masculine Besalisk             23.6 
##  3 masculine Cerean               23.6 
##  4 masculine Chagrian             21.6 
##  5 feminine  Clawdite             -6.36
##  6 feminine  Droid               -78.4 
##  7 masculine Droid               -34.4 
##  8 masculine Dug                 -62.4 
##  9 masculine Ewok                -86.4 
## 10 masculine Geonosian             8.64
## # … with 32 more rows

Base R (R >= 4.1.0)

This trick will also work with the new base R pipes:

starwars |> 
  mutate(
   mean_height = mean(height, na.rm = TRUE)
  ) |> 
  group_by(species, gender) |> 
  summarize(
    mean_height_species_gender = mean(height, na.rm = TRUE),
    mean_height = first(mean_height)
  ) |>
  mutate(
    diff_mean_height = mean_height_species_gender - mean_height
  ) |>
  select(gender, species, diff_mean_height) |>
  # pivot_wider(names_from = 'gender', values_from = 'diff_mean_height', values_fill = NA) |>
  identity()

## # A tibble: 42 x 3
## # Groups:   species [38]
##    gender    species   diff_mean_height
##    <chr>     <chr>                <dbl>
##  1 masculine Aleena              -95.4 
##  2 masculine Besalisk             23.6 
##  3 masculine Cerean               23.6 
##  4 masculine Chagrian             21.6 
##  5 feminine  Clawdite             -6.36
##  6 feminine  Droid               -78.4 
##  7 masculine Droid               -34.4 
##  8 masculine Dug                 -62.4 
##  9 masculine Ewok                -86.4 
## 10 masculine Geonosian             8.64
## # … with 32 more rows

ggplot2

The same problem may occur building ggplots:

iris %>% 
  ggplot(aes(Sepal.Length, Sepal.Width, color = Species, group = Species)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE, formula = "y ~ x") +
  # facet_wrap(~Species) +
  NULL

As you can see, I’ve added NULl at the end of the ggplot2-pipe. So I comment out the line before without trouble.

RStudio Plugin breakerofchains

There’s also a plugin for RStudio called breakerofchains. Using this plugin you can set your cursor onto any line of sequence of pipes. When you call the plugin the code is run up to the line your cursor is.

Using R 4.1.0 and R 4.0.5 on MacOS using RSwitch

Sat, 22 May 2021 00:00:00 +0000

Lately R version 4.1.0 was released on CRAN (see https://cran.r-project.org).

The MacOS version was one day late. But yesterday it was released, too. So I wanted to test the new version without being able to go back. “No problem”, I thought “I’m already using RSwitch”. RSwitch is a tiny Mac program which allows you to switch between installed R versions.

But unfornately RSwitch told me that R version 4.0.5 was incomplete after I’ve installed version 4.1.0.

What’s going on?

I took a look at /Library/Frameworks/R.framework/Versions where the different R versions are installed. And indeed in the directory 4.0 most of the files and symbolic where missing.

I installed version 4.0.5 and the same happened to version 4.1.0 – but I could use version 4.0.5 again.

My Solution

So I backed up the directory under /Library/Frameworks/R.framework/Versions using tar (you could also use cp -a etc.), installed version 4.1.0 again and restored my backup.

Now I can use both versions.

User-based Library

But there was still something odd. Using version 4.0.5 I used to install new R-packages in my user-directory beneath ~/Library/R/4.0/library.

So I set up an anlogous directory ~/Library/R/4.1/library and was surprised that .libPaths() doesn’t show me this directory.

So I took a look at the global config-file at /Library/Frameworks/R.framework/Versions/4.1/Resources/etc/Renviron. The environment variable R_LIBS_USER was set to ${R_LIBS_USER-'~/Library/R/x86_64/4.1/library'}. So I removed the /x86_64 part and everythins was fine.

Transerfering Installed Packages

Next I wanted to transfer all my installed packages. So I exported a csv-file with all my installed packages using the old R-version running the following code

library(tidyverse)

installed.packages() %>% 
  as_tibble() %>%  
  filter(!grepl("^/Library", LibPath)) %>% 
  write_csv2(file = "packages.csv")

So I got a list of my installed packages. Some of these packages were installed only from local repositories so I removed them manually off the list.

The resulting huge list of package names was installed with install.packages().

rstats-tips.net

About

How to access HomeAssistant's InfluxDB from R

Piwik Pro doesn't offer a free plan anymore

gt() doesn't show Euro-Sign € in PDF, showing EUR instead

forcats::fct_lump_n() with weights "overall"

Example

Weights

JSON, NULL values and as_tibble

Example

Example with null-values

Solution

Query BigQuery throws error: Error in strsplit(name, ".", fixed = TRUE) : non-character argument

How to use nflfastR with Google BigQuery?

Two problems

My solutions

The open source way

What to do else?

Pre-Import Script

Where does bigrquery store credential-tokens on a Mac?

Strange warning after loading own package

pkgdown and GDPR - How to host a pkgdown site in Germany

Disclaimer

Iterating over the rows of a data.frame with purrr -- Part 2

The function …

… and its parameters

Iterating again

Notes

Lists to Data.Frames with imap

Sample data

Goal

purrr::imap

Accessing Snowflake with R

Setup Snowflake

Create Warehouse

Create Database

Create Role

Create User

Grant permissions to Role

Create Schema

Create tables

Accessing Snowflake from R

Connection via DBI

Writing some data

Reading some data

Complex statements

SQL

Next Articles

Custom Formats in gt Tables

Sample data

First gt-table

Colored column based on its own values

Colored column based on value of another column

Hide the status column

Update to piwikproR: fetching DateTimes via API

Working with tree-based hierarchies using data.tree

Some tree-based data

The Task

data.tree

Filling missing values of the hierarchy levels

Adding other fancy columns

Update (2021-08-06)

Adding lines or other geoms to a ggplot by calling a custom function

Simple tricks for Debugging Pipes (within magrittr, base R or ggplot2)

Pipes

Magrittr

Base R (R >= 4.1.0)

ggplot2

RStudio Plugin breakerofchains

Using R 4.1.0 and R 4.0.5 on MacOS using RSwitch

What’s going on?

My Solution

User-based Library

Transerfering Installed Packages