rewrite correlation script with qstat() and qlayer()

[EvaMaeRey]

https://evamaerey.github.io/statistics/covariance_correlation.html#56

mysetseed(199402)
create_x_y(relationship = .5) %>%
data_create_scatterplot() %>%
plot_draw_mean_x() %>%
plot_draw_mean_y() %>%
plot_draw_differences_x() %>%
plot_draw_differences_y() %>%
plot_multiply_differences() %>%
plot_take_average_rectangle()

Assume qlayer() and qstat() exists:

compute_group_xmean <- function(data, scales){data |> mutate(xintercept = mean(x))
geom_xmean <- function(...){qlayer(geom = GeomVline, stat = qstat(compute_group_xmean), ...)}

compute_group_ymean <- function(data, scales){data |> mutate(yintercept = mean(y))
geom_ymean <- function(...){qlayer(geom = GeomVline, stat = qstat(compute_group_ymean), ...)}

compute_group_xmeandiff <- function(data, scales){data |> mutate(xend = mean(x), yend = y, xdiff = x - mean(x)}
geom_xmeandiff <- function(...){geom_segment(stat = qstat(compute_group_xmeandiff, default_aes = aes(color = after_stat(sign(xdiff))), ...)}

compute_group_ymeandiff <- function(data, scales){data |> mutate(yend = mean(y), xend = x, ydiff = y - mean(y))}
geom_ymeandiff <- function(...){geom_segment(stat = qstat(compute_group_ymeandiff, default_aes = aes(color = after_stat(sign(ydiff)))), ...)}

compute_group_xymeandiffs <- function(data, scales){data |> mutate(xmin = mean(x), ymin = mean(y), xmax = x, ymax = y, area = (xmax- xmin)*(ymax-ymin), ...)}
geom_xydiffs <- function(...){geom_rect(stat = qstat(compute_group_xymeandiffs, default_aes = aes(fill = after_stat(sign(area)), alpha = .2 )...) }

compute_average_of_xymeandiffs <- function(data, scales){data |> summarize ... A little tricky to think about. Come back.

[EvaMaeRey]

liking it.

library(tidyverse)

qstat <- function(compute_group, ...){ggproto("StatTemp", Stat, compute_group = compute_group, ...)}

qlayer <- function (mapping = NULL, data = NULL, geom = "point", stat = "identity", position = "identity", 
    ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) 
{
    layer(data = data, mapping = mapping, stat = stat, geom = geom, 
        position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
        params = rlang::list2(na.rm = na.rm, ...))
}


# https://evamaerey.github.io/statistics/covariance_correlation.html#56

# mysetseed(199402)
# create_x_y(relationship = .5) %>%
# data_create_scatterplot() %>%
# plot_draw_mean_x() %>%
# plot_draw_mean_y() %>%
# plot_draw_differences_x() %>%
# plot_draw_differences_y() %>%
# plot_multiply_differences() %>%
# plot_take_average_rectangle()

# Assume qlayer() and qstat() exists:

compute_group_xmean <- function(data, scales){data |> mutate(xintercept = mean(x))}
geom_xmean <- function(...){qlayer(geom = GeomVline, stat = qstat(compute_group_xmean), ...)}

compute_group_ymean <- function(data, scales){data |> mutate(yintercept = mean(y))}
geom_ymean <- function(...){qlayer(geom = GeomHline, stat = qstat(compute_group_ymean), ...)}

compute_group_xmeandiff <- function(data, scales){data |> mutate(xend = mean(x), yend = y, xdiff = x - mean(x), sign = factor(sign(xdiff)))}
geom_xmeandiff <- function(...){geom_segment(stat = qstat(compute_group_xmeandiff, default_aes = aes(color = after_stat(sign))), ...)}

compute_group_ymeandiff <- function(data, scales){data |> mutate(yend = mean(y), xend = x, ydiff = y - mean(y), 
                                                                 sign = factor(sign(ydiff)))}
geom_ymeandiff <- function(...){geom_segment(stat = qstat(compute_group_ymeandiff, default_aes = aes(color = after_stat(sign))), ...)}

compute_group_xymeandiffs <- function(data, scales){data |> mutate(xmin = mean(x), ymin = mean(y), xmax = x, ymax = y, area = (xmax-xmin)*(ymax-ymin), sign = factor(sign(area)))}
geom_xydiffs <- function(alpha = .2, ...){geom_rect(
  stat = qstat(compute_group_xymeandiffs, 
               default_aes = aes(fill = after_stat(sign))), alpha = alpha, ...)}

compute_average_of_xymeandiffs <- function(data, scales){
   
  xmean = mean(data$x)
  ymean = mean(data$y)
  xsd = sd(data$x)
  
  data |> 
    mutate(xdiff = x - mean(x),                                      ydiff = y - mean(y),   
           area = xdiff * ydiff) %>% 
    summarize(mean_area = mean(area)) %>% 
    pull(mean_area) ->
    mean_area
  
  data.frame(x = xmean, y = ymean,
             xmin = xmean, ymin = ymean,
             xmax = xmean + xsd, ymax = ymean + mean_area/xsd,
             sign = factor(sign(mean_area)))
  
}
  
  
geom_xydiffs_means <- function(...){
  
  geom_rect(stat = qstat(compute_average_of_xymeandiffs,
                         default_aes = aes(fill = after_stat(sign))), ...)
  
}  
  

cars %>% 
  ggplot() + 
  aes(x = speed, y = dist) +
  geom_point() + 
  geom_xmean() + 
  geom_ymean() + 
  geom_xmeandiff() + 
  geom_ymeandiff() + 
  geom_xydiffs() + 
  geom_xydiffs_means(color = "black") + 
  geom_smooth(method = lm)
#> `geom_smooth()` using formula = 'y ~ x'

^{Created on 2024-09-20 with reprex v2.1.0}