{"spec_id":"bar-3d-categorical","library":"ggplot2","language":"r","code":"#' anyplot.ai\n#' bar-3d-categorical: 3D Bar Chart for Categorical Comparison\n#' Library: ggplot2 3.5.1 | R 4.4.1\n#' Quality: 90/100 | Created: 2026-09-04\n\nlibrary(ggplot2)\nlibrary(dplyr)\nlibrary(ragg)\n\nset.seed(42)\n\n# Theme tokens (see prompts/default-style-guide.md \"Background\" + \"Theme-adaptive Chrome\")\nTHEME       <- Sys.getenv(\"ANYPLOT_THEME\", \"light\")\nPAGE_BG     <- if (THEME == \"light\") \"#FAF8F1\" else \"#1A1A17\"\nELEVATED_BG <- if (THEME == \"light\") \"#FFFDF6\" else \"#242420\"\nINK         <- if (THEME == \"light\") \"#1A1A17\" else \"#F0EFE8\"\nINK_SOFT    <- if (THEME == \"light\") \"#4A4A44\" else \"#B8B7B0\"\n\n# Imprint palette — 8 hues, theme-independent, hybrid-v3 sort\nIMPRINT_PALETTE <- c(\n  \"#009E73\", \"#C475FD\", \"#4467A3\", \"#BD8233\",\n  \"#AE3030\", \"#2ABCCD\", \"#954477\", \"#99B314\"\n)\n\n# --- Data: crop yield across fertilizer x soil type (factorial design, 4 x 5 = 20 bars) ---\nfertilizer_types <- c(\"Organic\", \"Nitrogen\", \"Phosphate\", \"Compound\")\nsoil_types <- c(\"Clay\", \"Loam\", \"Sandy\", \"Silt\", \"Peat\")\n\nfertilizer_baseline <- c(Organic = 4.2, Nitrogen = 6.8, Phosphate = 5.5, Compound = 7.4)\nsoil_modifier <- c(Clay = -0.3, Loam = 0.6, Sandy = -0.8, Silt = 0.2, Peat = 0.1)\n\ntrial <- expand.grid(\n  fertilizer = fertilizer_types,\n  soil = soil_types,\n  stringsAsFactors = FALSE\n) |>\n  mutate(\n    fertilizer = factor(fertilizer, levels = fertilizer_types),\n    soil = factor(soil, levels = soil_types),\n    i = as.integer(fertilizer) - 1L,\n    j = as.integer(soil) - 1L,\n    yield = fertilizer_baseline[as.character(fertilizer)] +\n      soil_modifier[as.character(soil)] +\n      rnorm(n(), mean = 0, sd = 0.25)\n  )\n\n# --- Isometric projection: rotate by azimuth, tilt by elevation, drop depth ----\n# See specification.md \"Notes\": elevation ~30 deg, azimuth ~45 deg.\nAZIMUTH   <- 45 * pi / 180\nELEVATION <- 30 * pi / 180\n\nproject_iso <- function(gx, gy, gz) {\n  rx <- gx * cos(AZIMUTH) - gy * sin(AZIMUTH)\n  ry <- gx * sin(AZIMUTH) + gy * cos(AZIMUTH)\n  screen_x <- rx\n  screen_y <- ry * sin(ELEVATION) + gz * cos(ELEVATION)\n  list(x = screen_x, y = screen_y)\n}\n\nshade <- function(hex, amount) {\n  channel <- col2rgb(hex) / 255\n  if (amount >= 0) {\n    channel <- channel + (1 - channel) * amount\n  } else {\n    channel <- channel * (1 + amount)\n  }\n  rgb(channel[1], channel[2], channel[3])\n}\n\n# --- Bar geometry: footprint with spacing, height scaled to a comfortable range ---\nCELL <- 1.0\nBAR_W <- 0.62\nBAR_D <- 0.62\nMARGIN <- (CELL - BAR_W) / 2\nHEIGHT_SCALE <- 3.2 / max(trial$yield)\nfert_colors <- setNames(IMPRINT_PALETTE[seq_along(fertilizer_types)], fertilizer_types)\n\n# Painter's algorithm: draw far bars first so nearer bars occlude them correctly\ntrial <- trial |> arrange(desc(i + j))\n\nfaces <- vector(\"list\", nrow(trial) * 12)\nlabels_rows <- vector(\"list\", nrow(trial))\nslot <- 0\nfor (row in seq_len(nrow(trial))) {\n  bar <- trial[row, ]\n  x0 <- bar$i + MARGIN\n  x1 <- bar$i + MARGIN + BAR_W\n  y0 <- bar$j + MARGIN\n  y1 <- bar$j + MARGIN + BAR_D\n  h <- bar$yield * HEIGHT_SCALE\n  base_hex <- fert_colors[[as.character(bar$fertilizer)]]\n  poly_id_base <- row * 3\n\n  top_corners <- list(c(x0, y0, h), c(x1, y0, h), c(x1, y1, h), c(x0, y1, h))\n  left_corners <- list(c(x0, y0, 0), c(x0, y1, 0), c(x0, y1, h), c(x0, y0, h))\n  right_corners <- list(c(x0, y0, 0), c(x1, y0, 0), c(x1, y0, h), c(x0, y0, h))\n\n  face_specs <- list(\n    list(corners = top_corners, fill_hex = shade(base_hex, 0.35), poly_id = poly_id_base),\n    list(corners = left_corners, fill_hex = shade(base_hex, -0.10), poly_id = poly_id_base + 1),\n    list(corners = right_corners, fill_hex = shade(base_hex, -0.35), poly_id = poly_id_base + 2)\n  )\n  for (face in face_specs) {\n    for (order in seq_along(face$corners)) {\n      corner <- face$corners[[order]]\n      screen <- project_iso(corner[1], corner[2], corner[3])\n      slot <- slot + 1\n      faces[[slot]] <- data.frame(\n        poly_id = face$poly_id, order = order,\n        px = screen$x, py = screen$y, fill_hex = face$fill_hex\n      )\n    }\n  }\n\n  top_center <- project_iso((x0 + x1) / 2, (y0 + y1) / 2, h)\n  labels_rows[[row]] <- data.frame(px = top_center$x, py = top_center$y + 0.18, label = sprintf(\"%.1f\", bar$yield))\n}\nfaces_df <- bind_rows(faces)\nlabels_df <- bind_rows(labels_rows)\n\n# Isometric views can put two different grid cells on the same screen column\n# (cells sharing fertilizer_index - soil_index land on one diagonal); when their\n# heights are close, the value labels collide. Nudge later labels (bottom-to-top)\n# apart from earlier ones sharing a column so every value stays legible.\nMIN_LABEL_GAP <- 0.34\nlabel_order <- order(labels_df$py)\nfor (k in seq_along(label_order)[-1]) {\n  cur <- label_order[k]\n  for (prev in label_order[seq_len(k - 1)]) {\n    if (abs(labels_df$px[cur] - labels_df$px[prev]) < 0.45) {\n      gap <- labels_df$py[cur] - labels_df$py[prev]\n      if (gap < MIN_LABEL_GAP) {\n        labels_df$py[cur] <- labels_df$py[prev] + MIN_LABEL_GAP\n      }\n    }\n  }\n}\n\n# --- Base-plane grid lines (relate bars to their categorical position) --------\nn_fert <- length(fertilizer_types)\nn_soil <- length(soil_types)\ngrid_lines <- vector(\"list\", (n_fert + 1) + (n_soil + 1))\nslot <- 0\nfor (i in 0:n_fert) {\n  a <- project_iso(i, 0, 0)\n  b <- project_iso(i, n_soil, 0)\n  slot <- slot + 1\n  grid_lines[[slot]] <- data.frame(line_id = slot, px = c(a$x, b$x), py = c(a$y, b$y))\n}\nfor (j in 0:n_soil) {\n  a <- project_iso(0, j, 0)\n  b <- project_iso(n_fert, j, 0)\n  slot <- slot + 1\n  grid_lines[[slot]] <- data.frame(line_id = slot, px = c(a$x, b$x), py = c(a$y, b$y))\n}\ngrid_df <- bind_rows(grid_lines)\n\n# --- Category tick labels along the two front edges ---------------------------\nfert_ticks <- bind_rows(lapply(seq_along(fertilizer_types) - 1L, function(i) {\n  p <- project_iso(i + 0.5, -0.45, 0)\n  data.frame(px = p$x, py = p$y, label = fertilizer_types[i + 1])\n}))\nsoil_ticks <- bind_rows(lapply(seq_along(soil_types) - 1L, function(j) {\n  p <- project_iso(-0.35, j + 0.5, 0)\n  data.frame(px = p$x, py = p$y, label = soil_types[j + 1])\n}))\nfert_axis_label <- project_iso(n_fert / 2, -0.9, 0)\nsoil_axis_label <- project_iso(-0.9, n_soil / 2, 0)\n\n# --- Theme-adaptive chrome — bespoke isometric canvas (no meaningful cartesian axes) ---\nanyplot_theme <- theme_void(base_size = 8) +\n  theme(\n    plot.background    = element_rect(fill = PAGE_BG, color = PAGE_BG),\n    legend.background  = element_rect(fill = ELEVATED_BG, color = INK_SOFT),\n    legend.margin      = margin(t = 6, r = 12, b = 6, l = 8),\n    legend.text        = element_text(color = INK_SOFT, size = 7.5, margin = margin(r = 6)),\n    legend.title       = element_text(color = INK, size = 10),\n    plot.title         = element_text(color = INK, size = 12, face = \"bold\", hjust = 0.5),\n    plot.caption       = element_text(color = INK_SOFT, size = 7, hjust = 0.5),\n    legend.position    = \"right\"\n  )\n\np <- ggplot() +\n  geom_path(data = grid_df, aes(x = px, y = py, group = line_id), color = INK_SOFT, alpha = 0.2, linewidth = 0.4) +\n  geom_polygon(\n    data = faces_df, aes(x = px, y = py, group = poly_id, fill = fill_hex),\n    color = PAGE_BG, linewidth = 0.3, show.legend = FALSE\n  ) +\n  geom_point(\n    data = data.frame(fertilizer = factor(fertilizer_types, levels = fertilizer_types)),\n    aes(x = 0, y = 0, color = fertilizer), alpha = 0\n  ) +\n  geom_text(data = labels_df, aes(x = px, y = py, label = label), color = INK, size = 2.5, fontface = \"bold\") +\n  geom_text(data = fert_ticks, aes(x = px, y = py, label = label), color = INK_SOFT, size = 2.3, angle = 30) +\n  geom_text(data = soil_ticks, aes(x = px, y = py, label = label), color = INK_SOFT, size = 2.7, angle = -30) +\n  annotate(\"text\", x = fert_axis_label$x, y = fert_axis_label$y, label = \"Fertilizer\", color = INK, size = 3.0, angle = 30, fontface = \"italic\") +\n  annotate(\"text\", x = soil_axis_label$x, y = soil_axis_label$y, label = \"Soil Type\", color = INK, size = 3.0, angle = -30, fontface = \"italic\") +\n  scale_fill_identity() +\n  scale_color_manual(values = fert_colors, name = \"Fertilizer\", guide = guide_legend(override.aes = list(alpha = 1, size = 5, shape = 15))) +\n  coord_fixed(ratio = 1) +\n  labs(\n    title = \"bar-3d-categorical · r · ggplot2 · anyplot.ai\",\n    caption = \"Bar height = Crop yield (tons/hectare)\"\n  ) +\n  anyplot_theme\n\nggsave(\n  filename = sprintf(\"plot-%s.png\", THEME),\n  plot     = p,\n  device   = ragg::agg_png,\n  width    = 8,\n  height   = 4.5,\n  units    = \"in\",\n  dpi      = 400\n)\n"}