Load environment

# Knitr option set
knitr::opts_chunk$set(warning = FALSE, message = FALSE)

# Packages
library(tidyverse)
library(toolbox)

Load and process dataset

# Process table
df = mtcars %>% 
   mutate(pond = rnorm(n = nrow(.)) %>% scales::rescale(to = c(0,1))) %>% 
   as_tibble()

# View
df

Weighted cross table

ts = table.freq.cross.weighted(df, var = "cyl", crossvar = "gear", pond = "pond")

# Print 
ts

# Plot it 
table.freq.cross.weighted.plot(ts, var = "cyl", path = "")

Weighted cross table across multiple columns

# Select columns 
vars = c("cyl", "vs", "am")

# Apply function 
lst = sapply(vars, function(x) table.freq.cross.weighted(df, x, crossvar = "gear", pond = "pond"),simplify = F)

# Rename list 
names(lst) = vars 

# Print 
lst

# Plot it
lapply(vars, function(x) table.freq.cross.weighted.plot(lst, x, path = ""))
library(ggmosaic)

g = df %>%
   select(cyl, gear, pond) %>%
   mutate_at(vars(-pond), as.character) %>%
   ggplot() +
   geom_mosaic(aes( x = product(cyl, gear), fill = cyl, weight = pond), na.rm = TRUE) +
   theme_minimal() +
   theme(axis.text.x = element_text(angle = 45, vjust = 1, size = 12, hjust = 1),
         legend.position = "none") +
   labs(y = NULL, x = NULL)

temp = ggplot_build(g)$data %>%
   as.data.frame %>%
   transmute(
      prop = paste0(as.character(round((ymax - ymin) * 100)), "%"),
      x.position = (xmax + xmin) / 2,
      y.position = (ymax + ymin) / 2
   ) %>%
   filter(!prop == "0%") %>%
   cbind(distinct(df, cyl, gear)) %>%
   left_join(df)

g + geom_text(
   x = temp$x.position,
   y = temp$y.position,
   label = temp$prop
)


AlexisMayer/toolbox documentation built on Aug. 25, 2020, 3:56 p.m.