Little useless-useful R functions – Useless Pyramid of R needs

What motivates human behaviour can be captured in the Maslow’s hierarchy of needs (source: Wiki). Maslow and psychologists have articulated these needs in a form of a Pyramid, and ever since the concept had been widely adopted (also criticised), and yet, another adaptation is the Pyramid of R needs

Yes, R needs What does it take to create and write an useless-useful R function. Well, let’s dive into this reluctant nonsense, with a weary potential.

The function is pure ggplot based depiction of pyramid. First version is stacked blocks and the second version is polygon in shape of triangle (resembling the pyramid).

useless_needs_pyramid <- function(
    levels  = c("L1","L2","L3","L4","L5"),
    palette = c("#8e24aa","#3f51b5","#2196f3","#4caf50","#fbc02d")
) {

  tiers <- 5
  H  <- tiers * 1.0   
  BW <- 3.4            

  w_at <- function(y) (BW/2) * (1 - y / H)
  y_breaks <- seq(0, H, length.out = tiers + 1)
  poly_list <- lapply(seq_len(tiers), function(i) {
    ymin <- y_breaks[i]
    ymax <- y_breaks[i + 1]
    wt   <- w_at(ymax)
    wb   <- w_at(ymin)
    data.frame(
      tier = i,
      x = c(-wt, wt, wb, -wb),
      y = c(ymax, ymax, ymin, ymin)
    )
  })
  poly_df <- do.call(rbind, poly_list)

  # ToDO: Add delimiters for text!
  lab_df <- data.frame(
    tier  = seq_len(tiers),
    ymin  = y_breaks[-(tiers + 1)],
    ymax  = y_breaks[-1]
  )
  
  lab_df$y_mid <- (lab_df$ymin + lab_df$ymax) / 2
  lab_df$w_mid <- w_at(lab_df$y_mid)
  lab_df$label <- rev(levels)                
  lab_df$fill  <- palette
  lab_df$label_x <- -lab_df$w_mid + 0.2
  

  # wrap long labels
  wrap_width = 25
  wrap_fun <- function(s, w) paste(strwrap(s, width = w), collapse = "\n")
  lab_df$label_wrapped <- vapply(lab_df$label, wrap_fun, character(1), w = wrap_width)
  

  add_alpha <- function(col, alpha) {
    rgb <- grDevices::col2rgb(col, TRUE)/255
    grDevices::rgb(rgb[1], rgb[2], rgb[3], alpha = alpha)
  }
  
  poly_df <- merge(poly_df, transform(lab_df, tier = tier, fill = fill), by = "tier", sort = FALSE)
  
  p <- ggplot() +
    geom_polygon(
      data = poly_df,
      aes(x = x, y = y, group = tier, fill = I(fill)),
      color = "white", linewidth = 1
    ) +
    geom_label(
      data = lab_df,
      aes(x = label_x, y = y_mid, label = label_wrapped),
      hjust = 0, vjust = 0.5,
      label.size = 0,
      fill = add_alpha("white", 0.22),
      label.padding = unit(6, "pt"),
      size = 5,
      lineheight = 1.05,
      color = "black"
    ) +
    coord_equal(
      xlim = c(-BW/2 - 0.2, BW/2 + 0.5), ylim = c(0, H),
      expand = FALSE
    ) +
    labs( title    = "Useless Pyramid of R Needs",
          subtitle = "From useless to useful R functions",
      x = NULL, y = NULL) +
    theme_void(base_size = 13) +
    theme(
      plot.title    = element_text(face = "bold", size = 18, hjust = 0.5),
      plot.subtitle = element_text(margin = margin(t = 4, b = 10), hjust = 0.5),
      panel.background = element_rect(fill = "#0f0f12", color = NA),
      plot.background  = element_rect(colour = "gray", fill = NA),
      plot.margin = margin(20, 20, 20, 20)
    )
  
  print(p)
}

Or if you would like it more smoothed, linear (or continuous) and pyramid-kind-a-look this is similar.

To run the function (in both cases), add colours and the captions for the pyramid:

useeless_needs_pyramid(
  levels = c(
    "Gathering ideas for writing useless-useful R functions",
    "Applying interesting math problems",
    "Writing quarky and niffty R code",
    "Getting new knowledge",
    "Engaging community"
  ),
  palette = c("mediumpurple","yellowgreen","yellow","gold","red")
)

As always, the complete code is available on GitHub in  Useless_R_function repository. The first version is here (filename: Maslow_needs.R) and the second is here (filename: Maslow_needs_2.R)

Check the repository for future updates!

Stay healthy and happy R-coding!