Mici funcții R inutile-utile – Are nevoie de Piramida inutilă a lui R

Ceea ce motivează comportamentul uman poate fi surprins în ierarhia nevoilor lui Maslow (sursa: Wiki). Maslow și psihologii au articulat aceste nevoi într-o formă de piramidă și, de când conceptul a fost adoptat pe scară largă (de asemenea, criticat), și totuși, o altă adaptare este Piramida nevoilor R.

Da, R are nevoie De ce este nevoie pentru a crea și scrie o funcție R inutilă-utilă. Ei bine, hai să ne aruncăm în prostiile astea reticente, cu un potențial obosit.

Funcția este o reprezentare pură a piramidei bazată pe ggplot. Prima versiune este blocuri stivuite, iar a doua versiune este poligon în formă de triunghi (seamănă cu piramida).

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)
}

Sau dacă doriți să fie mai netezită, liniară (sau continuă) și piramidală, aceasta este similară.

Pentru a rula funcția (în ambele cazuri), adăugați culori și legendele pentru piramidă:

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")
)

Verificați depozitul pentru actualizări viitoare!

Rămâi sănătos și fericit cu codificarea R!