Intro Thoughts

Status Quo

https://github.com/EvaMaeRey/tidypivot?tab=readme-ov-file#tidypivot-object

library(tidyverse)
## Warning: package 'ggplot2' was built under R version 4.4.1
library(GGally)
## Warning: package 'GGally' was built under R version 4.4.1
pm <- ggpairs(tips, mapping = aes(color = sex), columns = c("total_bill", "time", "tip"))
pm
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.

ggpairs |> formals() |> names()
##  [1] "data"                  "mapping"               "columns"              
##  [4] "title"                 "upper"                 "lower"                
##  [7] "diag"                  "params"                "..."                  
## [10] "xlab"                  "ylab"                  "axisLabels"           
## [13] "columnLabels"          "labeller"              "switch"               
## [16] "showStrips"            "legend"                "cardinality_threshold"
## [19] "progress"              "proportions"           "legends"
new_tidypivot <- function(){}

formals(ggpairs)
## $data
## 
## 
## $mapping
## NULL
## 
## $columns
## 1:ncol(data)
## 
## $title
## NULL
## 
## $upper
## list(continuous = "cor", combo = "box_no_facet", discrete = "count", 
##     na = "na")
## 
## $lower
## list(continuous = "points", combo = "facethist", discrete = "facetbar", 
##     na = "na")
## 
## $diag
## list(continuous = "densityDiag", discrete = "barDiag", na = "naDiag")
## 
## $params
## deprecated()
## 
## $...
## 
## 
## $xlab
## NULL
## 
## $ylab
## NULL
## 
## $axisLabels
## c("show", "internal", "none")
## 
## $columnLabels
## colnames(data[columns])
## 
## $labeller
## [1] "label_value"
## 
## $switch
## NULL
## 
## $showStrips
## NULL
## 
## $legend
## NULL
## 
## $cardinality_threshold
## [1] 15
## 
## $progress
## NULL
## 
## $proportions
## NULL
## 
## $legends
## deprecated()
formals(new_tidypivot) <- formals(ggpairs)
# formals(new_tidypivot)$data <- tips #
formals(new_tidypivot)$upper <- "blank" #
formals(new_tidypivot)$lower <- "blank" #


body(new_tidypivot) <- quote({
  
  pairs_obj <- list(
    # data = data,
    # mapping = mapping,
    # columns = columns,
    # title = title,
    upper = upper,
    lower = lower
  )

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

  # Return the created object
  invisible(pairs_obj)
  
})
#' @export
print.tidypivot <- function(pairs_obj){
  
  print(do.call(ggpairs, pairs_obj))
  
  invisible(pairs_obj)
  
}

#' @export
ggpairs_piped <- function(data = NULL){
  
  # thedata <<- data # don't love this
  data <- data %||% data.frame()
  
  pairs_obj <- new_tidypivot()
  
  pairs_obj$data <- data
  
  last_pairs_obj <<- pairs_obj
  
  pairs_obj

}


#' @export
last_ggpairs <- function(){
  
  last_pairs_obj
  
}


set_columns <- function(pairs_obj, columns = NULL){
  pairs_obj$columns <- columns
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_mapping <- function(pairs_obj, mapping = NULL){
  pairs_obj$mapping <- mapping
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_upper <- function(pairs_obj, upper = formals(ggpairs)$upper){
  pairs_obj$upper <- upper
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_lower <- function(pairs_obj, lower = formals(ggpairs)$lower){
  pairs_obj$lower <- lower
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_diag <- function(pairs_obj, diag = NULL){
  pairs_obj$diag <- diag
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_xlab <- function(pairs_obj, xlab = NULL){
  pairs_obj$xlab <- xlab
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_ylab <- function(pairs_obj, ylab = NULL){
  pairs_obj$ylab <- ylab
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_columnLabels <- function(pairs_obj, columnLabels = NULL){
  pairs_obj$columnLabels <- columnLabels
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_labeller <- function(pairs_obj, labeller = NULL){
  pairs_obj$labeller <- labeller
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_switch <- function(pairs_obj, switch = NULL){
  pairs_obj$switch <- switch
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_showStrips <- function(pairs_obj, showStrips = NULL){
  pairs_obj$showStrips <- showStrips
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_legend <- function(pairs_obj, legend = NULL){
  pairs_obj$legend <- legend
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_cardinality_threshold <- function(pairs_obj, cardinality_threshold = NULL){
  pairs_obj$cardinality_threshold <- cardinality_threshold
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_progress <- function(pairs_obj, progress = NULL){
  pairs_obj$progress <- progress
  last_pairs_obj <<- pairs_obj
  pairs_obj
}

set_proportions <- function(pairs_obj, proportions = NULL){
  pairs_obj$proportions <- proportions
  last_pairs_obj <<- pairs_obj
  pairs_obj
}



set_title <- function(pairs_obj, title = NULL){

  pairs_obj$title <- title

  last_pairs_obj <<- pairs_obj

  pairs_obj
  
}


collect <- function(pairs_obj){
  
  do.call(ggpairs, pairs_obj)
  
}
# ggpairs()

ggpairs_piped(tips) 

last_ggpairs() |>
  set_columns(c("total_bill", "time", "tip")) 

last_ggpairs() |>
  set_columnLabels(c("Total Bill", "Lunch or Dinner", "Tip"))

last_ggpairs() |> 
  set_lower()  # brings in ggpairs defaults
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.

last_ggpairs() |> 
  set_mapping(aes(color = time, alpha = I(.7)))
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.

last_ggpairs() |> 
  set_upper()
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.

last_ggpairs() |>
  set_title("A ggpairs plot!")
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.

ggpairs_piped(tips) |> # simple start univariate plots 
  # to ggpairs - pairwise plots
  set_lower() |> 
  set_upper() |>
  # Columns and Mapping
  set_columns(c("tip", "total_bill", 
                "time", "smoker")) |> 
  set_columns(c( 2, 1, 6, 4)) |>
  set_columnLabels( c("Tip", "Total Bill", 
                      "Time of Day", "Smoker")) |>
  set_mapping(aes(color = time)) |> 
  set_mapping(aes(color = time, alpha = I(.7))) |> 
  # Matrix Sections
  set_lower(list(continuous = "smooth", 
                 combo = "facetdensity",
                 discrete = "crosstable", 
                 mapping = aes(color = NULL))) |>
  set_upper("blank") |>
  set_diag("blank") |>
  collect() ->
pairs


pairs[2, 1] +
  theme_dark() ->
pairs[2, 1]
  
pairs