12 days of Christmas tibble

I'm interested in making a tibble that represents all of the gifts in the 12 days of Christmas. For those unfamiliar with the song, each day in the song includes a new gift, and all of the previous day's gifts (similar to purrr::accumulate)

For example, the first day just has 1 Partridge in a Pear Tree; the second day has 2 Turtle Doves and 1 Partridge in a Pear Tree; the third day has 3 French Hens, 2 Turtle Doves, 1 Partridge in a Pear Tree; ..., and so forth.

On the final twelfth day of Christmas has:

  • 12 Drummers Drumming
  • 11 Pipers Piping
  • 10 Lords a Leaping
  • 9 Ladies Dancing
  • 8 Maids a Milking
  • 7 Swans a Swimming
  • 6 Geese a Laying
  • 5 Golden Rings
  • 4 Calling Birds
  • 3 French Hens
  • 2 Turtle Doves
  • and a Partridge in a Pear Tree

I am wondering what the most "elegant" way to populate a tibble of the 12 days of Christmas is.

If day 1 is:

tibble(partridge = 1,
       doves = 0,
       hens = 0,
       birds = 0,
       rings = 0,
       geese = 0,
       swans = 0,
       maids = 0,
       ladies = 0,
       lords = 0,
       pipers = 0,
       drummers = 0)

and day 12 is:

tibble(partridge = 1,
       doves = 2,
       hens = 3,
       birds = 4,
       rings = 5,
       geese = 6,
       swans = 7,
       maids = 8,
       ladies = 9,
       lords = 10,
       pipers = 11,
       drummers = 12)

What's a clever way to make a tibble that has all 12 days?

2 Likes

Here's one way... there's probably a slicker way to do it, but this is the best I could figure out :smile:

library(tidyverse)

partridge <- rep(1,12)
dove <- c(0, rep(2,11))
hen <- c(rep(0,2), rep(3,10))
bird <- c(rep(0,3), rep(4,9))
ring <- c(rep(0,4), rep(5,8))
geese <- c(rep(0,5), rep(6,7))
swan <- c(rep(0,6), rep(7,6))
maid <- c(rep(0,7), rep(8,5))
ladies <- c(rep(0,8), rep(9,4))
lords <- c(rep(0,9), rep(10,3))
pipers <- c(rep(0,10), rep(11,2))
drummers <- c(rep(0,11), rep(12,1))

christmas <- as.data.frame(cbind(partridge, dove, hen, bird, ring, geese, swan, maid, ladies, lords, pipers, drummers))

christmasCount <- christmas %>% summarize_all(list(sum = sum)) %>% pivot_longer(cols = 1:12, names_to = "gift")
1 Like

Base R, double for loop. Easy to modify with different numbers of days and gifts.

Gifts <- list("partridge", "dove", "hen", "bird", "ring", "geese", 
           "swan", "maid", "ladies", "lords", "pipers", "drummers")
Days <- 12
christmas <- matrix(data = 0, 
                    nrow = Days, ncol = length(Gifts),
                    dimnames = list(1:Days, Gifts))

for (gift_i in 1:length(Gifts)) {
  for(day in 1:Days) {
    if (gift_i <= day) { # partridge (gift 1) leq day 1, drummer (gift 12) leq day 12
      christmas[day, gift_i] = gift_i # gift amount equal to gift number, otherwise could have vector of gift amounts
    }}}

tibble::as_tibble(christmas, rownames = "day") # since you want a tibble
3 Likes
library(tidyverse)

matrix(data = rep(1:12, 12), nrow = 12) %>%
  t() %>%
  as_tibble() %>%
  mutate(rownum = row_number()) %>%
  mutate_if(
    is.integer,
    ~ ifelse(. > rownum, 0, .)
  ) %>%
  setNames(c(
    "partridge", "dove", "hen", "bird", "ring", "geese",
    "swan", "maid", "ladies", "lords", "pipers", "drummers", "Day"
  )) %>%
  relocate(Day, .before = partridge)
2 Likes

Here is a version that uses a function to do everything in a map. It is technically equivalent to the double for loop, but uses a functional approach and slicing to avoid the explicit loops.

library(tidyverse)

make_col <- function(cur_day, n_days){
  n_gift <- rep(cur_day, n_days)
  n_gift[seq_len(cur_day-1)] <- 0
  n_gift
}

gifts <-set_names(1:12,
                  c("partridge", "dove", "hen", "bird", "ring", "geese",
                    "swan", "maid", "ladies", "lords", "pipers", "drummers"))


map_dfc(gifts, make_col, length(gifts))
#> # A tibble: 12 x 12
#>    partridge  dove   hen  bird  ring geese  swan  maid ladies lords pipers
#>        <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>  <dbl> <dbl>  <dbl>
#>  1         1     0     0     0     0     0     0     0      0     0      0
#>  2         1     2     0     0     0     0     0     0      0     0      0
#>  3         1     2     3     0     0     0     0     0      0     0      0
#>  4         1     2     3     4     0     0     0     0      0     0      0
#>  5         1     2     3     4     5     0     0     0      0     0      0
#>  6         1     2     3     4     5     6     0     0      0     0      0
#>  7         1     2     3     4     5     6     7     0      0     0      0
#>  8         1     2     3     4     5     6     7     8      0     0      0
#>  9         1     2     3     4     5     6     7     8      9     0      0
#> 10         1     2     3     4     5     6     7     8      9    10      0
#> 11         1     2     3     4     5     6     7     8      9    10     11
#> 12         1     2     3     4     5     6     7     8      9    10     11
#> # ... with 1 more variable: drummers <dbl>

Created on 2020-12-23 by the reprex package (v0.3.0)

And here is another one that tries to follow a bit more the logic of the song: let's assume we don't know in advance what each column in supposed to look like, and we fill in the results day after day, with gifts that we may not know in advance. And in that case I can as well make a version that actually takes user input and builds the result when prompted a gift:

max_days <- 12

res <- matrix(rep(0, max_days**2), nrow = max_days)
rownames(res) <- seq_len(max_days)
gifts <- character(max_days)
cur_day <- 0
while (cur_day < max_days) {
  cur_day <- cur_day + 1
  cat("Gift for day ",cur_day,": ")
  gifts[[cur_day]] <- readLines(n=1)
  
  colnames(res) <- gifts
  
  cur_gifts <- setNames(seq_len(cur_day),
                        gifts[seq_len(cur_day)])
  res[cur_day,cur_gifts] <- cur_gifts
  
  print(res[1:cur_day,1:cur_day])
}
2 Likes
library(tidyverse)
tibble(gifts = c("partridge",
                 "doves",
                 "hens",
                 "birds",
                 "rings",
                 "geese",
                 "swans",
                 "maids",
                 "ladies",
                 "lords",
                 "pipers",
                 "drummers"),
       number = 1:12) %>%
  uncount(12, .id = "day") %>%
  filter(number <= day)
5 Likes

Big fan of this tidy approach, most elegant to me !
I will add just a fragment to be piped on after that will give it the same (un)tidy structure that other solutions provided (as this was implied by the original poster)

%>% pivot_wider(
  names_from  = gifts,
  values_from = number) %>%
  mutate_all(~replace(., is.na(.), 0))
3 Likes

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.