The Art of Visualization with ggplot2

## ============================================================================
## CRAFT — ggplot2 Visualization (Single Function)   [R port of Plotly version]
##   Context · Reference · Aesthetic · Framing · Telling (Storytelling)
## ============================================================================
##
## FUNCTION SIGNATURE
##   craft_plot(data, numeric, categorical, chart, title, label, color, shape)
##
## ARGUMENTS
##   data        data.frame
##   numeric     character vector | NULL      e.g. "age"  or  c("age","bmi")
##   categorical character vector | NULL      e.g. "sex"  or  c("sex","smoker")
##   chart       character  — see CHART MENU below
##   title       character
##   label       named character vector — c(col = "Display Name")
##
##   color       character  -> column name   : encode that variable by color
##                           -> palette name  : apply that palette (e.g. "Set2")
##                           -> hex / named   : single color (e.g. "#636EFA")
##                           -> scale name    : continuous scale (e.g. "viridis")
##               list        -> list(col = "sex", palette = "Set2")
##                              encode col + apply palette (R equivalent of the
##                              Python tuple  color=('sex','Set2') )
##
##   shape       character  -> column name   : encode that variable by marker shape
##                           -> symbol name   : fixed symbol for all markers
##                              e.g. "circle","square","diamond","cross","x",
##                                   "triangle-up","triangle-down","star","pentagon"
##               list        -> list(col = "smoker", symbols = c("diamond","circle"))
##                              encode col + map symbols in factor-level order
##                              (R equivalent of shape=('smoker', ['diamond','circle']))
##               applies to: scatter, facet_scatter only
##
## CHART MENU
##   Univariate numeric      numeric = col
##     histogram | box | violin | ecdf | kde
##
##   Univariate categorical  categorical = col
##     bar | pie | donut
##
##   Bivariate num x num     numeric = c(x, y)
##     scatter | line | hexbin
##
##   Bivariate num x cat     numeric = col, categorical = col
##     box | violin | strip | bar | stacked_bar | grouped_bar
##
##   Bivariate cat x cat     categorical = c(c1, c2)
##     heatmap | bar | stacked_bar | grouped_bar
##
##   Multivariate  (3+ variables, any mix)
##     facet_histogram | facet_box | facet_scatter
##     facet_bar | facet_violin | corr_heatmap
## ============================================================================

## Required packages -----------------------------------------------------------
## install.packages(c("ggplot2","dplyr","tidyr","RColorBrewer",
##                     "viridisLite","GGally","hexbin","scales"))
library(ggplot2)
library(dplyr)
library(tidyr)
library(RColorBrewer)
library(scales)

# ── palette / symbol registries ──────────────────────────────────────────────

.CRAFT_PALETTES <- list(
  Plotly  = c("#636EFA","#EF553B","#00CC96","#AB63FA","#FFA15A",
              "#19D3F3","#FF6692","#B6E880","#FF97FF","#FECB52"),
  Set1    = brewer.pal(9,  "Set1"),
  Set2    = brewer.pal(8,  "Set2"),
  Set3    = brewer.pal(12, "Set3"),
  Pastel  = brewer.pal(9,  "Pastel1"),
  Pastel1 = brewer.pal(9,  "Pastel1"),
  Pastel2 = brewer.pal(8,  "Pastel2"),
  Dark2   = brewer.pal(8,  "Dark2"),
  Accent  = brewer.pal(8,  "Accent"),
  Paired  = brewer.pal(12, "Paired")
)

.CRAFT_CONT_SCALES <- c("viridis","magma","plasma","inferno","cividis",
                        "blues","reds","greens","rdbu","spectral")

.CRAFT_SYMBOL_MAP <- c(               # named symbol -> base R pch code
  circle = 16, square = 15, diamond = 18, cross = 3, x = 4,
  `triangle-up` = 17, `triangle-down` = 6, `triangle-left` = 5,
  `triangle-right` = 2, pentagon = 9, hexagon = 8, star = 8,
  hourglass = 27, bowtie = 7, asterisk = 8, hash = 35
)

# ── helpers ───────────────────────────────────────────────────────────────────

.is_palette_name <- function(x) is.character(x) && length(x) == 1 &&
  tolower(x) %in% tolower(names(.CRAFT_PALETTES))

.get_palette <- function(name) {
  hit <- names(.CRAFT_PALETTES)[tolower(names(.CRAFT_PALETTES)) == tolower(name)]
  .CRAFT_PALETTES[[hit[1]]]
}

.is_cont_scale <- function(x) is.character(x) && length(x) == 1 &&
  tolower(x) %in% .CRAFT_CONT_SCALES

.is_valid_color <- function(x) {
  tryCatch({ grDevices::col2rgb(x); TRUE }, error = function(e) FALSE)
}

.lab <- function(col, label) {
  if (!is.null(label) && !is.na(label[col]) && col %in% names(label)) label[[col]] else col
}

# color -> list(col, seq, cont, fixed)
.parse_color <- function(color, df) {
  out <- list(col = NULL, seq = NULL, cont = NULL, fixed = NULL)
  if (is.null(color)) return(out)
  
  if (is.list(color)) {                       # list(col=, palette=)
    out$col <- color[[1]]
    style   <- color[[2]]
    out$seq <- if (.is_palette_name(style)) .get_palette(style) else style
    return(out)
  }
  if (color %in% names(df)) { out$col <- color; return(out) }
  if (.is_palette_name(color)) { out$seq <- .get_palette(color); return(out) }
  if (.is_cont_scale(color))   { out$cont <- color; return(out) }
  out$fixed <- color                          # plain hex / named color
  out
}

# shape -> list(col, symbols)
.parse_shape <- function(shape, df) {
  out <- list(col = NULL, symbols = NULL)
  if (is.null(shape)) return(out)
  
  if (is.list(shape)) {                       # list(col=, symbols=)
    out$col     <- shape[[1]]
    out$symbols <- shape[[2]]
    return(out)
  }
  if (shape %in% names(df)) { out$col <- shape; return(out) }
  if (tolower(shape) %in% names(.CRAFT_SYMBOL_MAP)) {
    out$symbols <- shape                      # fixed symbol, all points
    return(out)
  }
  stop(sprintf(
    "shape='%s' is not a column name or a known symbol.\nKnown symbols: %s",
    shape, paste(sort(names(.CRAFT_SYMBOL_MAP)), collapse = ", ")))
}

# ── main function ─────────────────────────────────────────────────────────────

craft_plot <- function(data, numeric = NULL, categorical = NULL, chart = NULL,
                       title = NULL, label = NULL, color = NULL, shape = NULL) {
  
  df <- data
  num_cols <- numeric
  cat_cols <- categorical
  
  cc <- .parse_color(color, df)
  sh <- .parse_shape(shape, df)
  
  group_palette <- if (!is.null(cc$seq)) cc$seq else .CRAFT_PALETTES$Plotly
  single_clr    <- if (!is.null(cc$fixed)) cc$fixed else "#636EFA"
  L <- function(col) .lab(col, label)
  
  theme_craft <- theme_bw(base_size = 12) +
    theme(plot.title = element_text(face = "bold"))
  
  apply_shape_scale <- function(p) {
    if (is.null(sh$symbols)) return(p)
    if (length(sh$symbols) > 1 && !is.null(sh$col)) {
      lv <- levels(factor(df[[sh$col]]))
      vals <- .CRAFT_SYMBOL_MAP[tolower(sh$symbols)]
      names(vals) <- lv[seq_along(vals)]
      p + scale_shape_manual(values = vals, name = L(sh$col))
    } else {
      p  # fixed single symbol already applied at geom level
    }
  }
  
  # ══════════════════════════════════════════════════════════════════════════
  # UNIVARIATE NUMERIC
  # ══════════════════════════════════════════════════════════════════════════
  if (length(num_cols) == 1 && length(cat_cols) == 0) {
    col <- num_cols[1]
    chart <- chart %||% "histogram"
    
    if (chart == "histogram") {
      p <- ggplot(df, aes(x = .data[[col]])) +
        geom_histogram(bins = 30, fill = single_clr, color = "white")
      
    } else if (chart == "box") {
      p <- ggplot(df, aes(y = .data[[col]])) +
        geom_boxplot(fill = single_clr, outlier.shape = 16)
      
    } else if (chart == "violin") {
      p <- ggplot(df, aes(x = "", y = .data[[col]])) +
        geom_violin(fill = single_clr) +
        geom_boxplot(width = 0.1, fill = "white")
      
    } else if (chart == "ecdf") {
      p <- ggplot(df, aes(x = .data[[col]])) +
        stat_ecdf(geom = "step", color = single_clr, linewidth = 1) +
        geom_point(stat = "ecdf", color = single_clr, size = 1)
      
    } else if (chart == "kde") {
      p <- ggplot(df, aes(x = .data[[col]])) +
        geom_density(color = single_clr, fill = single_clr, alpha = 0.15, linewidth = 1) +
        ylab("Density")
      
    } else {
      stop("Univariate numeric -> histogram | box | violin | ecdf | kde")
    }
    p <- p + labs(title = title, x = L(col)) + theme_craft
    
    # ══════════════════════════════════════════════════════════════════════════
    # UNIVARIATE CATEGORICAL
    # ══════════════════════════════════════════════════════════════════════════
  } else if (length(num_cols) == 0 && length(cat_cols) == 1) {
    col <- cat_cols[1]
    counts <- df %>% count(.data[[col]], name = "count")
    chart <- chart %||% "bar"
    
    if (chart == "bar") {
      p <- ggplot(counts, aes(x = .data[[col]], y = count, fill = .data[[col]])) +
        geom_col() +
        scale_fill_manual(values = group_palette) +
        labs(title = title, x = L(col), y = "count") + theme_craft
      
    } else if (chart == "pie") {
      counts$ymax <- cumsum(counts$count)
      counts$ymin <- c(0, head(counts$ymax, -1))
      p <- ggplot(counts, aes(ymax = ymax, ymin = ymin, xmax = 4, xmin = 0,
                              fill = .data[[col]])) +
        geom_rect() +
        coord_polar(theta = "y") +
        xlim(c(0, 4)) +
        scale_fill_manual(values = group_palette) +
        labs(title = title, fill = L(col)) +
        theme_void() + theme(plot.title = element_text(face = "bold", hjust = 0.5))
      
    } else if (chart == "donut") {
      counts$ymax <- cumsum(counts$count)
      counts$ymin <- c(0, head(counts$ymax, -1))
      p <- ggplot(counts, aes(ymax = ymax, ymin = ymin, xmax = 4, xmin = 2,
                              fill = .data[[col]])) +
        geom_rect() +
        coord_polar(theta = "y") +
        xlim(c(0, 4)) +
        scale_fill_manual(values = group_palette) +
        labs(title = title, fill = L(col)) +
        theme_void() + theme(plot.title = element_text(face = "bold", hjust = 0.5))
      
    } else {
      stop("Univariate categorical -> bar | pie | donut")
    }
    
    # ══════════════════════════════════════════════════════════════════════════
    # BIVARIATE NUM x NUM
    # ══════════════════════════════════════════════════════════════════════════
  } else if (length(num_cols) == 2 && length(cat_cols) == 0) {
    x <- num_cols[1]; y <- num_cols[2]
    chart <- chart %||% "scatter"
    
    if (chart == "scatter") {
      p <- ggplot(df, aes(x = .data[[x]], y = .data[[y]]))
      
      point_params <- list(size = 2.2)
      
      if (!is.null(cc$col)) {
        p <- p + aes(color = .data[[cc$col]])
      } else {
        point_params$color <- single_clr
      }
      
      if (!is.null(sh$col)) {
        p <- p + aes(shape = .data[[sh$col]])
      } else if (!is.null(sh$symbols) && length(sh$symbols) == 1) {
        point_params$shape <- .CRAFT_SYMBOL_MAP[[tolower(sh$symbols)]]
      } else {
        point_params$shape <- 16
      }
      
      p <- p + do.call(geom_point, point_params)
      if (!is.null(cc$seq))  p <- p + scale_color_manual(values = cc$seq)
      if (!is.null(cc$cont)) p <- p + scale_color_viridis_c(option = tolower(cc$cont))
      p <- apply_shape_scale(p)
      p <- p + labs(title = title, x = L(x), y = L(y)) + theme_craft
      
    } else if (chart == "line") {
      p <- ggplot(df %>% arrange(.data[[x]]), aes(x = .data[[x]], y = .data[[y]])) +
        geom_line(color = single_clr, linewidth = 1) +
        labs(title = title, x = L(x), y = L(y)) + theme_craft
      
    } else if (chart == "hexbin") {
      p <- ggplot(df, aes(x = .data[[x]], y = .data[[y]])) +
        geom_hex(bins = 30) +                       # requires library(hexbin)
        scale_fill_viridis_c(option = if (!is.null(cc$cont)) tolower(cc$cont) else "viridis") +
        labs(title = title, x = L(x), y = L(y)) + theme_craft
      
    } else {
      stop("Bivariate num x num -> scatter | line | hexbin")
    }
    
    # ══════════════════════════════════════════════════════════════════════════
    # BIVARIATE NUM x CAT
    # ══════════════════════════════════════════════════════════════════════════
  } else if (length(num_cols) == 1 && length(cat_cols) == 1) {
    num <- num_cols[1]; cat <- cat_cols[1]
    chart <- chart %||% "box"
    grp   <- if (!is.null(cc$col)) cc$col else cat
    
    if (chart == "box") {
      p <- ggplot(df, aes(x = .data[[cat]], y = .data[[num]], fill = .data[[grp]])) +
        geom_boxplot()
      
    } else if (chart == "violin") {
      p <- ggplot(df, aes(x = .data[[cat]], y = .data[[num]], fill = .data[[grp]])) +
        geom_violin() +
        geom_boxplot(width = 0.1, fill = "white", position = position_dodge(0.9))
      
    } else if (chart == "strip") {
      p <- ggplot(df, aes(x = .data[[cat]], y = .data[[num]], color = .data[[grp]])) +
        geom_jitter(width = 0.2, size = 1.8) +
        scale_color_manual(values = group_palette)
      
    } else if (chart == "bar") {
      agg <- df %>% group_by(.data[[cat]]) %>%
        summarise(mean = mean(.data[[num]], na.rm = TRUE),
                  sd   = sd(.data[[num]],  na.rm = TRUE), .groups = "drop")
      p <- ggplot(agg, aes(x = .data[[cat]], y = mean, fill = .data[[cat]])) +
        geom_col() +
        geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = 0.2) +
        scale_fill_manual(values = group_palette) +
        ylab(paste("Mean of", L(num)))
      
    } else if (chart == "stacked_bar") {
      stack_by <- if (!is.null(cc$col)) cc$col else cat
      agg <- df %>% group_by(.data[[cat]], .data[[stack_by]]) %>%
        summarise(total = sum(.data[[num]], na.rm = TRUE), .groups = "drop")
      p <- ggplot(agg, aes(x = .data[[cat]], y = total, fill = .data[[stack_by]])) +
        geom_col(position = "stack") + ylab(L(num))
      
    } else if (chart == "grouped_bar") {
      grp_by <- if (!is.null(cc$col)) cc$col else cat
      agg <- df %>% group_by(.data[[cat]], .data[[grp_by]]) %>%
        summarise(avg = mean(.data[[num]], na.rm = TRUE), .groups = "drop")
      p <- ggplot(agg, aes(x = .data[[cat]], y = avg, fill = .data[[grp_by]])) +
        geom_col(position = "dodge") + ylab(paste("Mean of", L(num)))
      
    } else {
      stop("Bivariate num x cat -> box | violin | strip | bar | stacked_bar | grouped_bar")
    }
    if (exists("group_palette") && chart %in% c("box","violin"))
      p <- p + scale_fill_manual(values = group_palette)
    if (chart %in% c("stacked_bar","grouped_bar"))
      p <- p + scale_fill_manual(values = group_palette)
    p <- p + labs(title = title, x = L(cat)) + theme_craft
    
    # ══════════════════════════════════════════════════════════════════════════
    # BIVARIATE CAT x CAT
    # ══════════════════════════════════════════════════════════════════════════
  } else if (length(num_cols) == 0 && length(cat_cols) == 2) {
    c1 <- cat_cols[1]; c2 <- cat_cols[2]
    chart <- chart %||% "heatmap"
    
    if (chart == "heatmap") {
      ct <- as.data.frame(table(df[[c1]], df[[c2]]))
      names(ct) <- c(c1, c2, "count")
      p <- ggplot(ct, aes(x = .data[[c2]], y = .data[[c1]], fill = count)) +
        geom_tile() +
        geom_text(aes(label = count)) +
        scale_fill_gradient(low = "#EFF3FF", high = "#08519C") +
        labs(title = title, x = L(c2), y = L(c1)) + theme_craft
      
    } else if (chart %in% c("bar", "grouped_bar")) {
      grp <- df %>% count(.data[[c1]], .data[[c2]], name = "count")
      p <- ggplot(grp, aes(x = .data[[c1]], y = count, fill = .data[[c2]])) +
        geom_col(position = "dodge") +
        scale_fill_manual(values = group_palette) +
        labs(title = title, x = L(c1)) + theme_craft
      
    } else if (chart == "stacked_bar") {
      grp <- df %>% count(.data[[c1]], .data[[c2]], name = "count")
      p <- ggplot(grp, aes(x = .data[[c1]], y = count, fill = .data[[c2]])) +
        geom_col(position = "stack") +
        scale_fill_manual(values = group_palette) +
        labs(title = title, x = L(c1)) + theme_craft
      
    } else {
      stop("Bivariate cat x cat -> heatmap | bar | stacked_bar | grouped_bar")
    }
    
    # ══════════════════════════════════════════════════════════════════════════
    # MULTIVARIATE
    # ══════════════════════════════════════════════════════════════════════════
  } else if ((length(num_cols) + length(cat_cols)) >= 3) {
    
    chart <- chart %||% (
      if (length(num_cols) >= 3 && length(cat_cols) == 0) "facet_scatter"
      else if (length(num_cols) > 0 && length(cat_cols) > 0) "facet_violin"
      else "facet_bar"
    )
    
    if (chart == "facet_histogram") {
      long <- df %>% select(all_of(num_cols)) %>%
        pivot_longer(everything(), names_to = "variable", values_to = "value")
      p <- ggplot(long, aes(x = value, fill = variable)) +
        geom_histogram(bins = 25, show.legend = FALSE) +
        facet_wrap(~ variable, scales = "free") +
        scale_fill_manual(values = group_palette) +
        labs(title = title, x = NULL) + theme_craft
      
    } else if (chart == "facet_box") {
      long <- df %>% select(all_of(num_cols)) %>%
        pivot_longer(everything(), names_to = "variable", values_to = "value")
      p <- ggplot(long, aes(x = variable, y = value, fill = variable)) +
        geom_boxplot(show.legend = FALSE) +
        facet_wrap(~ variable, scales = "free") +
        scale_fill_manual(values = group_palette) +
        labs(title = title, x = NULL) + theme_craft
      
    } else if (chart == "facet_scatter") {
      # scatter-matrix equivalent — requires library(GGally)
      # NOTE: use aes_string() here, not aes(.data[[...]]) — ggpairs() deparses
      # the mapping internally to build each sub-panel, and the .data[[]]
      # pronoun form breaks that deparsing in many GGally versions, throwing
      # "'aes' is not an exported object from 'namespace:GGally'".
      mapping <- if (!is.null(cc$col)) ggplot2::aes_string(color = cc$col) else NULL
      p <- GGally::ggpairs(df, columns = num_cols, mapping = mapping,
                           upper = list(continuous = "blank"),
                           diag  = list(continuous = "blankDiag")) +
        labs(title = title) + theme_craft
      if (!is.null(cc$seq)) {
        for (i in seq_along(p$plots)) {
          p[i, ] <- p[i, ] + scale_color_manual(values = cc$seq) +
            scale_fill_manual(values = cc$seq)
        }
      }
      return(p)  # GGally object; skip common styling below
      
    } else if (chart == "facet_bar") {
      long <- df %>% select(all_of(cat_cols)) %>%
        pivot_longer(everything(), names_to = "variable", values_to = "value")
      p <- ggplot(long, aes(x = value, fill = variable)) +
        geom_bar(show.legend = FALSE) +
        facet_wrap(~ variable, scales = "free") +
        scale_fill_manual(values = group_palette) +
        labs(title = title, x = NULL) + theme_craft
      
    } else if (chart == "facet_violin") {
      pairs <- expand.grid(num = num_cols, cat = cat_cols, stringsAsFactors = FALSE)
      long <- bind_rows(lapply(seq_len(nrow(pairs)), function(i) {
        n <- pairs$num[i]; c <- pairs$cat[i]
        data.frame(facet = paste(L(n), "by", L(c)),
                   group = as.character(df[[c]]), value = df[[n]])
      }))
      n_groups <- length(unique(long$group))
      fill_pal <- if (n_groups <= length(group_palette)) {
        group_palette[seq_len(n_groups)]
      } else {
        colorRampPalette(group_palette)(n_groups)   # recycle/interpolate as needed
      }
      p <- ggplot(long, aes(x = group, y = value, fill = group)) +
        geom_violin() +
        geom_boxplot(width = 0.1, fill = "white") +
        facet_wrap(~ facet, scales = "free") +
        scale_fill_manual(values = fill_pal) +
        labs(title = title, x = NULL) + theme_craft
      
    } else if (chart == "corr_heatmap") {
      corr <- cor(df[num_cols], use = "pairwise.complete.obs")
      long <- as.data.frame(as.table(corr))
      names(long) <- c("Var1", "Var2", "r")
      p <- ggplot(long, aes(x = Var2, y = Var1, fill = r)) +
        geom_tile() +
        geom_text(aes(label = round(r, 2))) +
        scale_fill_gradient2(low = "#B2182B", mid = "white", high = "#2166AC",
                             midpoint = 0, limits = c(-1, 1)) +
        labs(title = title, x = NULL, y = NULL) + theme_craft
      
    } else {
      stop(paste("Multivariate -> facet_histogram | facet_box | facet_scatter |",
                 "facet_bar | facet_violin | corr_heatmap"))
    }
    
  } else {
    stop("Cannot infer situation. Pass at least one column to numeric or categorical.")
  }
  
  p
}

`%||%` <- function(a, b) if (is.null(a)) b else a

# Univariate numeric
craft_plot(df, numeric = num_var1, chart = "histogram",
           color = "#63AAAA", title = "Histogram chart")

# Univariate categorical
craft_plot(df, categorical = cat_var1, chart = "pie",
           color = "Pastel", title = "Pie chart")

# Bivariate num x num
craft_plot(df, numeric = c(num_var1, num_var2), chart = "scatter",
           color = "black", title = "Bivariate num x num chart")

# Bivariate num x cat
craft_plot(df, numeric = num_var2, categorical = cat_var1, chart = "box",
           color = "Set2", title = "Bivariate num x cat chart")

# Bivariate cat x cat
craft_plot(df, categorical = c(cat_var1, cat_var2), chart = "stacked_bar",
           title = "Bivariate cat x cat chart")

# Multivariate — grid of histograms (all numeric)
craft_plot(df, numeric = c(num_var1, num_var2, num_var3),
           chart = "facet_histogram", color = "Plotly",
           title = "Grid of histograms (all numeric)")

# Multivariate — scatter matrix (all numeric pairs)
craft_plot(df, numeric = c(num_var1, num_var2, num_var3),
           chart = "facet_scatter", color = cat_var2,
           title = "Scatter matrix (all numeric pairs)")

# Multivariate — box grid (numeric x categorical)
craft_plot(df, numeric = c(num_var1, num_var2), categorical = c(cat_var1, cat_var3),
           chart = "facet_violin", color = "Set2",
           title = "Box grid (numeric x categorical)")

# Multivariate — bar grid (all categorical)
craft_plot(df, categorical = c(cat_var1, cat_var2, cat_var3),
           chart = "facet_bar", color = "Pastel",
           title = "Bar grid (all categorical)")

# Multivariate — correlation heatmap
craft_plot(df, numeric = c(num_var1, num_var2, num_var3),
           chart = "corr_heatmap", title = "Correlation Matrix")

# color list: col + palette (R equivalent of Python's tuple)
craft_plot(df, numeric = c(num_var1, num_var2), chart = "scatter",
           color = list(cat_var1, "Set2"), shape = "diamond",
           title = "Multivariate scatter plot")

# shape as column (ggplot picks default shapes)
craft_plot(df, numeric = c(num_var1, num_var2), chart = "scatter",
           color = list(cat_var1, "Set2"),
           shape = list(cat_var4, c("square", "star")),
           title = "Multivariate scatter plot")