Part 0. Objective take many argument function, where arguments are orthogonal, and make a pipable interface

pivot_count() create count table based on direct user inputs

library(tidyverse)
pivot_count <- function (data, rows = NULL, cols = NULL) {
    
  cols_quo <- rlang::enquo(cols)
  
  grouped <- data %>% dplyr::group_by(
    dplyr::across(c({{cols}}, {{rows}})))
  
  summarized <- grouped |> 
    dplyr::count() |> 
    dplyr::ungroup()

    if (rlang::quo_is_null(cols_quo)) {
        summarized
    }
    else {
        summarized %>% 
        tidyr::pivot_wider(names_from = {{cols}}, 
                           values_from = n)
    }
}

status quo usage: enter arguments at once

Titanic |> 
  data.frame() |>
  uncount(Freq) ->
tidy_titanic

pivot_count(data = tidy_titanic,
            rows = Survived,
            cols = c(Sex, Age))
## # A tibble: 2 × 5
##   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

Desired usage: Piped pivot ggtable

ggtable(tidy_titanic) |> # a count of observations
  set_rows(Survived) |> # a count by Survived
  set_cols(c(Sex, Age)) # count by Sex, Age and Survived

Part. 1. Implementation

Step 1. New 3S object Create new_tidypivot() which defines components in ‘tp’ a 3S object.

library(tidyverse)

new_tidypivot <- function(data = data.frame(),
                          rows = NULL,
                          columns = NULL,
                          value = NULL,
                          wt = NULL) {

  # table specification components !
  tp <- list(
    data = data,
    rows = rows,
    columns = columns,
    value = value,
    wt = wt
    # more 'slots' to be added
  )

  # declare class 'tidypivot'
  class(tp) <- "tidypivot"

  # Return the created object
  invisible(tp)

}



# # table specification components !
# tp <- list(
#     data,
#     rows,
#     columns,
#     value,
#     weight
#     # more 'slots' to be added
#   )
# 
# # declare class 'tidypivot'
# class(tp) <- "tp"

Step 2. Print: Once specification is defined, actually do manipulation to produce the table - we use a routine from the {tidypivot} package.

return_specified_table() create table based on table specification (tp)

return_specified_table = function(tp){

      out <- 'tidypivot::pivot_helper(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_or_null(out, "rows",  tp$rows)
      out <- str_replace_or_null(out, "cols",  tp$cols)
      out <- str_replace_or_null(out, "value",  tp$value)
      out <- str_replace_or_null(out, "wt",  tp$wt)
      out <- str_replace_or_null(out, "fun",  tp$fun)

      
      eval(parse(text = out))         
      
}

print.tidypivot declare print method for tp, the 3S objects

print.tidypivot <- function(tp){
  
  print(return_specified_table(tp))
  invisible(tp)
  
}

Step 3. user-facing functions!

ggtable() initiate table

ggtable <- function(data){
  
  thedata <<- data # don't love this

  tp <- new_tidypivot(deparse(substitute(thedata)))
  
  last_tp <<- tp
  
  tp

}

ggtable(cars)
## # A tibble: 1 × 1
##   value
##   <dbl>
## 1    50

set_rows(), (the other ‘set’ functions are hidden - set up the same way…)

set_rows <- function(tp, rows = NULL){
  
  tp$rows <- deparse(substitute(rows))
  
  last_tp <<- tp
  
  tp

  
}

last_table()

last_table <- function(){
  
  last_tp
  
}

Part 2. Test functionality!

Slow build with last_table()

Titanic |> 
  data.frame() |>
  uncount(Freq) ->
tidy_titanic

tidy_titanic |> tibble()
## # A tibble: 2,201 × 4
##    Class Sex   Age   Survived
##    <fct> <fct> <fct> <fct>   
##  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      
##  7 3rd   Male  Child No      
##  8 3rd   Male  Child No      
##  9 3rd   Male  Child No      
## 10 3rd   Male  Child No      
## # ℹ 2,191 more rows
tidy_titanic |>
  ggtable() 
## # A tibble: 1 × 1
##   value
##   <dbl>
## 1  2201
last_table() |> 
  set_rows(Survived)
## # A tibble: 2 × 2
##   Survived value
##   <fct>    <dbl>
## 1 No        1490
## 2 Yes        711
last_table() |> 
  set_cols(c(Sex))
## # A tibble: 2 × 3
##   Survived  Male Female
##   <fct>    <dbl>  <dbl>
## 1 No        1364    126
## 2 Yes        367    344
last_table() |>
  set_rows(Class)
## # A tibble: 4 × 3
##   Class  Male Female
##   <fct> <dbl>  <dbl>
## 1 1st     180    145
## 2 2nd     179    106
## 3 3rd     510    196
## 4 Crew    862     23
last_table() |>
  set_fun(sum)
## # A tibble: 4 × 3
##   Class  Male Female
##   <fct> <dbl>  <dbl>
## 1 1st     180    145
## 2 2nd     179    106
## 3 3rd     510    196
## 4 Crew    862     23

Piped |>

ggtable(mtcars) |> 
  set_rows(cyl) |> 
  set_cols(am) |>
  set_cols(c(gear, am)) 
## # A tibble: 3 × 5
##     cyl `3_0` `4_0` `4_1` `5_1`
##   <dbl> <dbl> <dbl> <dbl> <dbl>
## 1     4     1     2     6     2
## 2     6     2     2     2     1
## 3     8    12    NA    NA     2
last_table() |> str()
## List of 6
##  $ data   : chr "thedata"
##  $ rows   : chr "cyl"
##  $ columns: NULL
##  $ value  : NULL
##  $ wt     : NULL
##  $ cols   : chr "c(gear, am)"
##  - attr(*, "class")= chr "tidypivot"
ggtable(mtcars) |> 
  set_rows(cyl) |> 
  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
last_table() |>
  set_fun(mean) |> # sum by default
  set_value(mpg)   # 1 by default
## # A tibble: 3 × 3
##     cyl   `0`   `1`
##   <dbl> <dbl> <dbl>
## 1     4  22.9  28.1
## 2     6  19.1  20.6
## 3     8  15.0  15.4
tidytitanic::flat_titanic |>
  ggtable() |>
  set_cols(sex) |>
  set_value(freq)
## # A tibble: 1 × 2
##    Male Female
##   <dbl>  <dbl>
## 1  1731    470
tidytitanic::flat_titanic |>
  ggtable() |>
  set_cols(sex) |>
  set_wt(freq) # hmm.. should it be the same?
## # A tibble: 1 × 2
##    Male Female
##   <dbl>  <dbl>
## 1    16     16
palmerpenguins::penguins %>% 
  remove_missing() ->
penguins
## Warning: Removed 11 rows containing missing values or values outside the scale
## range.
# count table 
ggtable(penguins) 
## # A tibble: 1 × 1
##   value
##   <dbl>
## 1   333
# count by species, sex
last_table() |>
  set_rows(species)|>
  set_cols(sex) 
## # A tibble: 3 × 3
##   species   female  male
##   <fct>      <dbl> <dbl>
## 1 Adelie        73    73
## 2 Chinstrap     34    34
## 3 Gentoo        58    61
# average bill depth table
last_table() |>
  set_fun(mean) |>
  set_value(bill_depth_mm)
## # A tibble: 3 × 3
##   species   female  male
##   <fct>      <dbl> <dbl>
## 1 Adelie      17.6  19.1
## 2 Chinstrap   17.6  19.3
## 3 Gentoo      14.2  15.7

Part 3. Dispatch Define behavior when tps are piped to other environment

Future work