synopsis

Tidypivot function proposes group, compute and pivot to table in a succinct function, eg:

pivot_count(data = titanic, rows = survived, cols = c(sex, age))

Uses R6 to update table specification and creates user facing functions to incrementally build tables, eg:

ggtable(data = tidytitanic::tidy_titanic) |> # overall count
  set_rows(sex) |> # within sex
  set_cols(age) |> # within age and sex
  set_rows(NULL) |> # overwrites previous declarations
  set_rows(c(sex,survived)) |> 
  set_cols(c(age, class))

all in one count and pivot function.

Here we write a nice declarative (describe it and get it) table making function… This one just counts. More functionality is worked out in the pivotr function here: https://github.com/EvaMaeRey/tidypivot.

pivot_count <- function(data, rows = NULL, cols = NULL){
  
  cols_quo <- rlang::enquo(cols)
  rows_quo <- rlang::enquo(rows)

  if(rlang::quo_is_null(cols_quo) & rlang::quo_is_null(rows_quo)){
    data %>% 
      count() ->
    outdata
    
  }else{
  data %>% 
    group_by(across(c({{rows}}, {{cols}}))) %>% 
    count() ->
  outdata
  }
  
  if(!rlang::quo_is_null(cols_quo)){
   outdata %>%
      pivot_wider(names_from = {{cols}}, values_from = n) ->
    outdata
  }
  
  outdata
}

let’s use it on a version of the Titanic data (‘titanic’)

library(tidyverse)
Titanic %>% 
  data.frame() %>% 
  uncount(Freq) ->
titanic

names(titanic) <- tolower(names(titanic))

head(titanic)
##   class  sex   age survived
## 1   3rd Male Child       No
## 2   3rd Male Child       No
## 3   3rd Male Child       No
## 4   3rd Male Child       No
## 5   3rd Male Child       No
## 6   3rd Male Child       No

Example 1

pivot_count(data = titanic, rows = survived, cols = sex)
## # A tibble: 2 × 3
## # Groups:   survived [2]
##   survived  Male Female
##   <fct>    <int>  <int>
## 1 No        1364    126
## 2 Yes        367    344

Example 2

pivot_count(data = titanic, cols = sex)
## # A tibble: 1 × 2
##    Male Female
##   <int>  <int>
## 1  1731    470

Example 3

pivot_count(data = titanic) 
##      n
## 1 2201

Example 4

pivot_count(data = titanic, rows = survived, cols = c(sex, age))
## # A tibble: 2 × 5
## # Groups:   survived [2]
##   survived Male_Child Male_Adult Female_Child Female_Adult
##   <fct>         <int>      <int>        <int>        <int>
## 1 No               35       1329           17          109
## 2 Yes              29        338           28          316

Making declarations incremental with OOP

But we might want to do step-wise (piped) declarations, this will require OOP. I choose R6 encapsulated/classical. I think people find it easier just starting off as is my case!

library(R6)
Pivot <- R6Class("Pivot",
  public = list(
    data = NULL,
    rows = NULL,
    cols = NULL,
    value = NULL,
    wt = NULL,
    fun = NULL,
    initialize = function(data = NULL, 
                          rows = NULL, 
                          cols = NULL, 
                          value = NULL, 
                          wt = NULL,
                          fun = NULL){
      self$data <- data
      self$rows <- rows
      self$cols <- cols
      self$value <- value
      self$wt <- wt
      self$fun <- fun
      
      theData <<- data   # hacky?

    }, 
    set_data = function(val){
      self$data <- val
      
      theData <<- self$data  # hacky?

    },
    set_rows = function(val){
      self$rows <- val
    },
    set_cols = function(val){
      self$cols <- val
    },
    set_value = function(val){
      self$value <- val
    },
    set_wt = function(val){
      self$wt <- val
    },
    set_fun = function(val){
      self$fun <- val
    },
    return_table_code = function(){

      # out <- 'pivot_count(data = theData, rows, cols)' 
      
      out <- 'tidypivot::pivot_helper(data = theData, rows, cols, value, wt, fun)'
      
      str_replace_or_null <- function(x, pattern, replacement){
        
        if(is.null(replacement)){x %>% str_replace(pattern, 'NULL')}
        else{x %>% str_replace(pattern, replacement)}
        
      }
      
      # out <- str_replace(out, "data", self$data)
      out <- str_replace_or_null(out, "rows", self$rows)
      out <- str_replace_or_null(out, "cols", self$cols)
      out <- str_replace_or_null(out, "fun", self$fun)
      out <- str_replace_or_null(out, "value", self$value)
      out <- str_replace_or_null(out, "wt", self$wt)
      out <- str_replace_or_null(out, "fun", self$fun)

      eval(parse(text = out))    # hacky?
      
    }
    
    ),
  
  
  )

Let’s try it out

Step 1: Declare new table specification

table_specification <- Pivot$new()
table_specification
## <Pivot>
##   Public:
##     clone: function (deep = FALSE) 
##     cols: NULL
##     data: NULL
##     fun: NULL
##     initialize: function (data = NULL, rows = NULL, cols = NULL, value = NULL, 
##     return_table_code: function () 
##     rows: NULL
##     set_cols: function (val) 
##     set_data: function (val) 
##     set_fun: function (val) 
##     set_rows: function (val) 
##     set_value: function (val) 
##     set_wt: function (val) 
##     value: NULL
##     wt: NULL

Step 2: Set data

table_specification$set_data(tidytitanic::tidy_titanic)
table_specification
## <Pivot>
##   Public:
##     clone: function (deep = FALSE) 
##     cols: NULL
##     data: data.frame
##     fun: NULL
##     initialize: function (data = NULL, rows = NULL, cols = NULL, value = NULL, 
##     return_table_code: function () 
##     rows: NULL
##     set_cols: function (val) 
##     set_data: function (val) 
##     set_fun: function (val) 
##     set_rows: function (val) 
##     set_value: function (val) 
##     set_wt: function (val) 
##     value: NULL
##     wt: NULL
table_specification$return_table_code()
## # A tibble: 1 × 1
##   value
##   <dbl>
## 1  2201

Step 3: Set Rows

table_specification$set_rows("survived")
table_specification
## <Pivot>
##   Public:
##     clone: function (deep = FALSE) 
##     cols: NULL
##     data: data.frame
##     fun: NULL
##     initialize: function (data = NULL, rows = NULL, cols = NULL, value = NULL, 
##     return_table_code: function () 
##     rows: survived
##     set_cols: function (val) 
##     set_data: function (val) 
##     set_fun: function (val) 
##     set_rows: function (val) 
##     set_value: function (val) 
##     set_wt: function (val) 
##     value: NULL
##     wt: NULL
table_specification$return_table_code()
## # A tibble: 2 × 2
##   survived value
##   <fct>    <dbl>
## 1 No        1490
## 2 Yes        711

Step 4: Set Cols

table_specification$set_cols("sex")
table_specification
## <Pivot>
##   Public:
##     clone: function (deep = FALSE) 
##     cols: sex
##     data: data.frame
##     fun: NULL
##     initialize: function (data = NULL, rows = NULL, cols = NULL, value = NULL, 
##     return_table_code: function () 
##     rows: survived
##     set_cols: function (val) 
##     set_data: function (val) 
##     set_fun: function (val) 
##     set_rows: function (val) 
##     set_value: function (val) 
##     set_wt: function (val) 
##     value: NULL
##     wt: NULL
table_specification$return_table_code()
## # A tibble: 2 × 3
##   survived  Male Female
##   <fct>    <dbl>  <dbl>
## 1 No        1364    126
## 2 Yes        367    344

Step 5: Over write which var defines rows

table_specification$set_rows("age")
table_specification
## <Pivot>
##   Public:
##     clone: function (deep = FALSE) 
##     cols: sex
##     data: data.frame
##     fun: NULL
##     initialize: function (data = NULL, rows = NULL, cols = NULL, value = NULL, 
##     return_table_code: function () 
##     rows: age
##     set_cols: function (val) 
##     set_data: function (val) 
##     set_fun: function (val) 
##     set_rows: function (val) 
##     set_value: function (val) 
##     set_wt: function (val) 
##     value: NULL
##     wt: NULL
table_specification$return_table_code()
## # A tibble: 2 × 3
##   age    Male Female
##   <fct> <dbl>  <dbl>
## 1 Child    64     45
## 2 Adult  1667    425

Now try to create user-facing interface for piping

ggtable <- function(data, rows = NULL, cols = NULL){

  # ts <- Pivot$new()
  ts$initialize()
  ts$set_data(data)
  ts$set_rows(deparse(substitute(rows)))   # hacky?
  ts$set_cols(deparse(substitute(cols)))

  print(ts$return_table_code())
  
  invisible(ts)

}


set_rows <- function(piping_spacer, # hacky?
                     vars){
  
  ts$set_rows(val = deparse(substitute(vars)))
  ts$return_table_code()
  
  print(ts$return_table_code())
  
  invisible(ts)

}


set_cols <- function(piping_spacer, vars){
  
  ts$set_cols(val = deparse(substitute(vars)))
  ts$return_table_code()

  print(ts$return_table_code())
  
  invisible(ts)

}


set_value <- function(piping_spacer, vars){
  
  ts$set_value(val = deparse(substitute(vars)))
  ts$return_table_code()

  print(ts$return_table_code())
  
  invisible(ts)

}

set_wt <- function(piping_spacer, vars){
  
  ts$set_wt(val = deparse(substitute(vars)))
  ts$return_table_code()

  print(ts$return_table_code())
  
  invisible(ts)

}

set_fun <- function(piping_spacer, fun){
  
  ts$set_fun(val = deparse(substitute(fun)))
  ts$return_table_code()

  print(ts$return_table_code())
  
  invisible(ts)

}


last_table <- function(){
  
  print(ts$return_table_code())
  
  invisible(ts)
  
}

Try it out

Step 1: Set data featuring ugly prestep

# it seemed like I needed this before any of the following would get going
ts <- Pivot$new()    # hacky? ugly?

ggtable(data = tidytitanic::tidy_titanic)
## # A tibble: 1 × 1
##   value
##   <dbl>
## 1  2201

Step 2: Set rows

ggtable(data = tidytitanic::tidy_titanic) |>
  set_rows(sex) 
## # A tibble: 2 × 2
##   sex    value
##   <fct>  <dbl>
## 1 Male    1731
## 2 Female   470

Step 3: Set cols

ggtable(data = tidytitanic::tidy_titanic) |>
  set_rows(sex) |>
  set_cols(survived)
## # A tibble: 2 × 3
##   sex       No   Yes
##   <fct>  <dbl> <dbl>
## 1 Male    1364   367
## 2 Female   126   344

Step 4: Reset cols

ggtable(data = tidytitanic::tidy_titanic) |>
  set_rows(sex) |>
  set_cols(survived) |>
  set_cols(age)
## # A tibble: 2 × 3
##   sex    Child Adult
##   <fct>  <dbl> <dbl>
## 1 Male      64  1667
## 2 Female    45   425

Step 5: NULL rows

ggtable(data = tidytitanic::tidy_titanic) |>
  set_rows(sex) |>
  set_cols(survived) |>
  set_cols(age) |>
  set_rows(NULL)
## # A tibble: 1 × 2
##   Child Adult
##   <dbl> <dbl>
## 1   109  2092

Step 6: Reset to multiple rows

ggtable(data = tidytitanic::tidy_titanic) |>
  set_rows(sex) |>
  set_cols(survived) |>
  set_cols(age) |>
  set_rows(NULL) |>
  set_rows(c(sex,survived))
## # A tibble: 4 × 4
##   sex    survived Child Adult
##   <fct>  <fct>    <dbl> <dbl>
## 1 Male   No          35  1329
## 2 Male   Yes         29   338
## 3 Female No          17   109
## 4 Female Yes         28   316

Step 7: Reset to multiple cols

ggtable(data = tidytitanic::tidy_titanic) |>
  set_rows(sex) |>
  set_cols(survived) |>
  set_cols(age) |>
  set_rows(NULL) |>
  set_rows(c(sex, survived)) |>
  set_cols(c(age, class))
## # A tibble: 4 × 10
##   sex    survived Child_1st Child_2nd Child_3rd Child_Crew Adult_1st Adult_2nd
##   <fct>  <fct>        <dbl>     <dbl>     <dbl>      <dbl>     <dbl>     <dbl>
## 1 Male   No               0         0        35          0       118       154
## 2 Male   Yes              5        11        13          0        57        14
## 3 Female No               0         0        17          0         4        13
## 4 Female Yes              1        13        14          0       140        80
## # ℹ 2 more variables: Adult_3rd <dbl>, Adult_Crew <dbl>

Step 8: not piping

ggtable(data = tidytitanic::tidy_titanic, age, class)
## # A tibble: 2 × 5
##   age   `1st` `2nd` `3rd`  Crew
##   <fct> <dbl> <dbl> <dbl> <dbl>
## 1 Child     6    24    79     0
## 2 Adult   319   261   627   885

Step 9: Another dataset: mtcars

ggtable(data = mtcars, rows = cyl)
## # A tibble: 3 × 2
##     cyl value
##   <dbl> <dbl>
## 1     4    11
## 2     6     7
## 3     8    14

Step 9: using last_table() to print a family of tables

ggtable(data = titanic)
## # A tibble: 1 × 1
##   value
##   <dbl>
## 1  2201
last_table() |>
  set_cols(sex)
## # A tibble: 1 × 2
##    Male Female
##   <dbl>  <dbl>
## 1  1731    470
last_table() |>
  set_rows(survived)
## # A tibble: 2 × 3
##   survived  Male Female
##   <fct>    <dbl>  <dbl>
## 1 No        1364    126
## 2 Yes        367    344
last_table() |>
  set_cols(NULL)
## # A tibble: 2 × 2
##   survived value
##   <fct>    <dbl>
## 1 No        1490
## 2 Yes        711

Step 10: Definitely not doing print the right way…

print is not done in the right way yet. A collect function will be nice to output the printed table, versus the specification.

my_table <- ggtable(data = mtcars, rows = cyl) # shouldn't print
## # A tibble: 3 × 2
##     cyl value
##   <dbl> <dbl>
## 1     4    11
## 2     6     7
## 3     8    14
str(my_table) # object is specification yay!
## Classes 'Pivot', 'R6' <Pivot>
##   Public:
##     clone: function (deep = FALSE) 
##     cols: NULL
##     data: data.frame
##     fun: NULL
##     initialize: function (data = NULL, rows = NULL, cols = NULL, value = NULL, 
##     return_table_code: function () 
##     rows: cyl
##     set_cols: function (val) 
##     set_data: function (val) 
##     set_fun: function (val) 
##     set_rows: function (val) 
##     set_value: function (val) 
##     set_wt: function (val) 
##     value: NULL
##     wt: NULL
my_table |>       # pipes in okay way.
  set_cols(am)
## # A tibble: 3 × 3
##     cyl   `0`   `1`
##   <dbl> <dbl> <dbl>
## 1     4     3     8
## 2     6     4     3
## 3     8    12     2

Step 11: Nice to have in the future… on the fly variable definition - like ggplot2

ggtable(data = mtcars, rows = cyl)

last_table() |>
  set_cols(ifelse(am, "manual", "auto"))

Functions, weighting

# ts <- Pivot$new()    # hacky? ugly?

ggtable(mtcars) |>
  set_value(mpg)
## # A tibble: 3 × 3
##     cyl   `0`   `1`
##   <dbl> <dbl> <dbl>
## 1     4  68.7 225. 
## 2     6  76.5  61.7
## 3     8 181.   30.8

References