From 6935c6b0c3569becb0379591c143db064c3f5cbe Mon Sep 17 00:00:00 2001 From: SAADAT-Abu Date: Mon, 6 Oct 2025 20:36:57 +0200 Subject: [PATCH 1/3] Added Interactive plot support with plotly and plot Download button --- DESCRIPTION | 9 +- NAMESPACE | 2 + R/ggbot2.R | 183 +++++++++++++++++++++++++++++++++++++++-- inst/prompts/prompt.md | 30 +++++-- 4 files changed, 209 insertions(+), 15 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 509ca73..e46e21b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,10 +19,15 @@ Imports: withr Suggests: dplyr, - maps + htmlwidgets, + kaleido, + maps, + plotly, + webshot, + webshot2 Remotes: posit-dev/shinyrealtime/pkg-r License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 diff --git a/NAMESPACE b/NAMESPACE index 9d19fda..a3c55e3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,8 @@ import(bslib) import(ellmer) import(ggplot2) import(shiny) +importFrom(grDevices,dev.off) +importFrom(grDevices,png) importFrom(shinychat,markdown_stream) importFrom(shinychat,output_markdown_stream) importFrom(shinyrealtime,realtime_server) diff --git a/R/ggbot2.R b/R/ggbot2.R index 6b7cd74..88669c9 100644 --- a/R/ggbot2.R +++ b/R/ggbot2.R @@ -4,6 +4,7 @@ #' @import ggplot2 #' @importFrom shinychat markdown_stream output_markdown_stream #' @importFrom shinyrealtime realtime_ui realtime_server +#' @importFrom grDevices png dev.off NULL globalVariables("yield") @@ -48,8 +49,15 @@ ggbot <- function(df, debug = FALSE) { ), card( full_screen = TRUE, - card_header("Plot"), - card_body(padding = 0, plotOutput("plot", fill = TRUE)), + card_header( + "Plot", + class = "d-flex justify-content-between align-items-center", + downloadButton("download_plot", "Download PNG", class = "btn-sm") + ), + card_body( + padding = 0, + uiOutput("plot_container") + ), height = "66%" ), layout_columns( @@ -65,14 +73,26 @@ ggbot <- function(df, debug = FALSE) { style = "z-index: 100000; margin-left: auto; margin-right: auto;", right = NULL ), - hidden_audio_el("shutter", system.file("shutter.mp3", package = "ggbot2")) + hidden_audio_el("shutter", system.file("shutter.mp3", package = "ggbot2")), + tags$script(HTML(" + // Fix initial mic button state to match muted status + setTimeout(function() { + var micBtn = document.querySelector('.mic-toggle-btn'); + if (micBtn) { + micBtn.classList.remove('active', 'btn-danger'); + micBtn.classList.add('btn-secondary'); + } + }, 100); + ")) ) server <- function(input, output, session) { last_code <- reactiveVal() + last_plotly_code <- reactiveVal() + plot_type <- reactiveVal("static") # "static" or "plotly" running_cost <- reactiveVal(0) # Cost of tokens used in the session, in dollars - greeting <- "Welcome to Shiny Realtime!\n\nYou're currently muted; click the mic button to unmute, click-and-hold the mic for push-to-talk, or hold the spacebar key for push-to-talk." + greeting <- "Welcome to ggbot2!\n\nClick the mic button to start talking. You can also click-and-hold the mic button (or hold spacebar) for push-to-talk mode." append_transcript <- function(text, clear = FALSE) { markdown_stream( @@ -87,7 +107,9 @@ ggbot <- function(df, debug = FALSE) { run_r_plot_code <- function(code) { attr(code, "rnd") <- stats::runif(1) # Force re-evaluation even if code is the same + plot_type("static") last_code(code) + last_plotly_code(NULL) # Ideally we'd run the code here to check for errors and let the model # know about success/failure in a tool response. But we only want to run @@ -96,6 +118,14 @@ ggbot <- function(df, debug = FALSE) { NULL } + run_r_plotly_code <- function(code) { + attr(code, "rnd") <- stats::runif(1) # Force re-evaluation even if code is the same + plot_type("plotly") + last_plotly_code(code) + last_code(NULL) + NULL + } + run_r_plot_code_tool <- ellmer::tool( run_r_plot_code, "Run R code that generates a static plot", @@ -106,11 +136,21 @@ ggbot <- function(df, debug = FALSE) { ) ) + run_r_plotly_code_tool <- ellmer::tool( + run_r_plotly_code, + "Run R code that generates an interactive plotly plot", + arguments = list( + code = type_string( + "The R code to run that generates an interactive plotly plot. This should use plotly::ggplotly() to convert a ggplot object to plotly, or use plotly functions directly. The last expression should be the plotly object." + ) + ) + ) + realtime_controls <- realtime_server( "realtime1", voice = "cedar", instructions = prompt, - tools = list(run_r_plot_code_tool), + tools = list(run_r_plot_code_tool, run_r_plotly_code_tool), speed = 1.1, debug = debug ) @@ -199,8 +239,29 @@ ggbot <- function(df, debug = FALSE) { output_audio = 20 / 1e6 ) + output$plot_container <- renderUI({ + if (plot_type() == "plotly") { + req(last_plotly_code()) + if (!requireNamespace("plotly", quietly = TRUE)) { + stop("plotly package is required for interactive plots. Install it with install.packages('plotly')") + } + tagList( + plotly::plotlyOutput("interactive_plot", width = "100%", height = "100%"), + tags$script(HTML(" + setTimeout(function() { + var audio = document.getElementById('shutter'); + if (audio) audio.play(); + }, 500); + ")) + ) + } else { + plotOutput("plot", fill = TRUE, width = "100%", height = "100%") + } + }) + output$plot <- renderPlot(res = 96, { req(last_code()) + req(plot_type() == "static") on.exit(session$sendCustomMessage( "play_audio", list(selector = "#shutter") @@ -222,14 +283,122 @@ ggbot <- function(df, debug = FALSE) { ) }) + output$interactive_plot <- plotly::renderPlotly({ + req(last_plotly_code()) + req(plot_type() == "plotly") + if (!requireNamespace("plotly", quietly = TRUE)) { + stop("plotly package is required for interactive plots") + } + eval(parse(text = last_plotly_code()), envir = new.env(parent = globalenv())) + }) + output$code_text <- renderText({ - req(last_code()) - last_code() + if (plot_type() == "static") { + req(last_code()) + last_code() + } else { + req(last_plotly_code()) + last_plotly_code() + } }) output$session_cost <- renderText({ paste0(sprintf("$%.4f", running_cost())) }) + + output$download_plot <- downloadHandler( + filename = function() { + paste0("ggbot_plot_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".png") + }, + content = function(file) { + current_plot_type <- isolate(plot_type()) + + if (current_plot_type == "static") { + code <- isolate(last_code()) + + if (is.null(code) || code == "") { + stop("No plot available to download. Please generate a plot first.") + } + + # 300 DPI with typical plot size (10" x 8") + grDevices::png(file, width = 3000, height = 2400, res = 300) + tryCatch({ + result <- eval(parse(text = code), envir = new.env(parent = globalenv())) + # Explicitly print if it's a ggplot object + if (inherits(result, "ggplot")) { + print(result) + } + }, error = function(e) { + if (length(grDevices::dev.list()) > 0) { + grDevices::dev.off() + } + stop("Error generating plot: ", e$message) + }, finally = { + if (length(grDevices::dev.list()) > 0) { + grDevices::dev.off() + } + }) + + } else if (current_plot_type == "plotly") { + code <- isolate(last_plotly_code()) + + if (is.null(code) || code == "") { + stop("No plot available to download. Please generate a plot first.") + } + + if (!requireNamespace("plotly", quietly = TRUE)) { + stop("plotly package is required") + } + + # For plotly, we need to use kaleido for export + plotly_obj <- eval(parse(text = code), envir = new.env(parent = globalenv())) + + # Try kaleido first (modern approach) + kaleido_worked <- FALSE + if (requireNamespace("kaleido", quietly = TRUE)) { + tryCatch({ + kaleido::save_image(plotly_obj, file, width = 3000, height = 2400) + kaleido_worked <- TRUE + }, error = function(e) { + warning("kaleido export failed: ", e$message) + }) + } + + # If kaleido didn't work, try plotly's built-in save_image + if (!kaleido_worked) { + tryCatch({ + # plotly::save_image uses kaleido under the hood + plotly::save_image(plotly_obj, file, width = 3000, height = 2400) + }, error = function(e1) { + # Last fallback: use webshot + if (requireNamespace("webshot2", quietly = TRUE) || requireNamespace("webshot", quietly = TRUE)) { + temp_html <- tempfile(fileext = ".html") + tryCatch({ + if (!requireNamespace("htmlwidgets", quietly = TRUE)) { + stop("htmlwidgets package is required for this export method") + } + htmlwidgets::saveWidget(plotly_obj, temp_html, selfcontained = TRUE) + if (requireNamespace("webshot2", quietly = TRUE)) { + webshot2::webshot(temp_html, file, vwidth = 3000, vheight = 2400) + } else { + webshot::webshot(temp_html, file, vwidth = 3000, vheight = 2400) + } + }, finally = { + if (file.exists(temp_html)) { + unlink(temp_html) + } + }) + } else { + stop("Cannot export plotly plot to PNG. Please install one of: kaleido, webshot2, or webshot.\n", + "Recommended: install.packages('kaleido')") + } + }) + } + } else { + stop("No plot available to download. Please generate a plot first.") + } + } + ) } shinyApp(ui, server) diff --git a/inst/prompts/prompt.md b/inst/prompts/prompt.md index 9db95da..c5a14e6 100644 --- a/inst/prompts/prompt.md +++ b/inst/prompts/prompt.md @@ -12,18 +12,30 @@ Respond using the same language as the user, or if in doubt, respond using Engli You're a helpful, casual, friendly AI that helps generate plotting code using ggplot2 or other R plotting libraries. The user will ask you -various plotting tasks, which you should fulfill by calling the -`run_r_plot_code` function. This code should either plot as a side effect, or -have its last expression be a ggplot or similar object that plots when printed. +various plotting tasks, which you should fulfill by calling either the +`run_r_plot_code` function for static plots or the `run_r_plotly_code` function +for interactive plots. -When you call this function, the user will see the generated plot in real-time. +For static plots, the code should either plot as a side effect, or have its last +expression be a ggplot or similar object that plots when printed. + +For interactive plots, use the `run_r_plotly_code` function. The code should use +plotly::ggplotly() to convert a ggplot object to an interactive plotly plot, or +use plotly functions directly. The last expression should be the plotly object. + +When you call these functions, the user will see the generated plot in real-time. Each generated plot will replace the previous one, so you don't need to worry about keeping track of old plots. -Each time you call this function, think of it as a new R session. No variables +Each time you call these functions, think of it as a new R session. No variables from previous calls will be available. You should always include any necessary library imports, dataset loading, and intermediate calculations in your code, -every time you call `run_r_plot_code`. +every time you call `run_r_plot_code` or `run_r_plotly_code`. + +Choose `run_r_plotly_code` when the user explicitly asks for an interactive plot, +or when interactivity would be particularly useful (e.g., for exploring data with +many points, zooming, tooltips, etc.). Otherwise, use `run_r_plot_code` for +standard static plots. If the user asks for a plot that you cannot generate, you should respond saying why you can't fulfill the request. Stay on task, and refuse to engage in any @@ -36,5 +48,11 @@ library(ggplot2) library(dplyr) ``` +For interactive plots, the plotly package is available. You will need to load it explicitly: + +```r +library(plotly) +``` + Don't change the theme or set any plot colours unless the user explicitly asks for it. From 99790843e4481fa4079b1499a838c113c8b2f34b Mon Sep 17 00:00:00 2001 From: SAADAT-Abu Date: Mon, 6 Oct 2025 21:47:42 +0200 Subject: [PATCH 2/3] Added dark mode and plot history --- CLAUDE.md | 164 ++++++++++++++++++++++++++++++++++++++++++++++++++++ DESCRIPTION | 1 + R/ggbot2.R | 153 ++++++++++++++++++++++++++++++++++-------------- 3 files changed, 273 insertions(+), 45 deletions(-) create mode 100644 CLAUDE.md diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 0000000..3410b93 --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1,164 @@ +# CLAUDE.md + +This file provides guidance to Claude Code (claude.ai/code) when working with code in this repository. + +## Overview + +ggbot2 is a voice assistant for ggplot2 that uses OpenAI's GPT-4o Realtime API through Shiny. Users speak commands, and the assistant generates R plotting code that executes in real-time. + +## Prerequisites + +- OpenAI API key with paid account (a few dollars minimum) +- Set `OPENAI_API_KEY` in `.Renviron` or `.env` file + +## Development Commands + +### Installation +```r +# Install from GitHub +pak::pak("tidyverse/ggbot2") + +# Install with dependencies for local development +pak::pak(".") +``` + +### Running the App +```r +# Launch with a data frame +ggbot2::ggbot(mtcars) + +# Enable debug mode for verbose logging +ggbot2::ggbot(mtcars, debug = TRUE) +``` + +### Documentation +```r +# Generate/update documentation +devtools::document() +``` + +## Architecture + +### Core Components + +**Main Function: `ggbot()` (R/ggbot2.R:24-236)** +- Entry point that validates data frame input and launches Shiny app +- Validates OPENAI_API_KEY via `ensure_openai_api_key()` +- Builds prompt with data frame metadata via `build_prompt()` +- Creates 3-panel UI: sidebar (transcript), plot viewer, code viewer + +**Realtime Integration** +- Uses `shinyrealtime` package for WebSocket connection to OpenAI Realtime API +- Voice input → GPT-4o Realtime → R code generation → immediate plot execution +- Event-driven architecture with listeners for conversation items, responses, and usage tracking + +**Tool System** +- Two tools exposed to AI: + - `run_r_plot_code_tool`: Generates static ggplot2 plots + - `run_r_plotly_code_tool`: Generates interactive plotly plots +- Tools receive R code string and store in reactive values (`last_code` or `last_plotly_code`) +- Code executes in isolated environment via `renderPlot()` or `plotly::renderPlotly()` +- Each execution is a fresh environment; no state persists between calls +- AI intelligently chooses tool based on user request and data characteristics + +**Prompt Construction: `build_prompt()` (R/ggbot2.R:305-336)** +- Loads base instructions from inst/prompts/prompt.md +- Appends data frame preview (first 6 rows), structure, and summary +- Uses string interpolation to inject df_name and metadata + +**System Prompt (inst/prompts/prompt.md)** +- Defines AI personality: warm, engaging, playful, quick-talking +- Constrains AI to plotting tasks only +- Assumes ggplot2 and dplyr are pre-loaded +- Emphasizes fresh R session per function call + +### Key Technical Details + +**Plot History System** +- All generated plots stored in reactive list `plot_history` +- Each history item contains: code, plot_type ("static" or "plotly"), timestamp +- `history_position` tracks current position (0 = latest, incrementing for older plots) +- Prev/next navigation buttons in plot card header +- Seamlessly handles transitions between static and interactive plots +- History info displays "1/5", "2/5", etc. showing current position + +**Dark Mode** +- Uses bslib's `input_dark_mode()` for light/dark theme toggle +- Toggle button in sidebar next to session cost +- Automatically applies to all UI components (cards, sidebar, buttons) +- Leverages Bootstrap 5.3 color mode system + +**Download Functionality** +- Static plots: Download as high-resolution PNG (3000×2400px at 300 DPI) +- Interactive plots: Download as self-contained HTML with full interactivity +- Filename includes timestamp for easy organization +- Uses `htmlwidgets::saveWidget()` for plotly exports + +**Cost Tracking** +- Tracks token usage per response (text, audio, cached) at R/ggbot2.R:168-181 +- Pricing matrix at R/ggbot2.R:183-200 for GPT-4o Realtime +- Running cost displayed in sidebar via `running_cost` reactive value + +**Error Handling** +- Plot code errors caught in tryCatch at R/ggbot2.R:208-222 +- Errors displayed but not sent back to AI (see comment at R/ggbot2.R:212-219) +- API key validation with helpful error messages at R/ggbot2.R:257-293 + +**Audio Feedback** +- Shutter sound effect (inst/shutter.mp3) plays after each plot render +- Embedded as base64 data URI via `hidden_audio_el()` at R/ggbot2.R:238-248 + +**Notifications** +- Shows "Generating code..." when function call starts +- Auto-removes notification when function call completes +- Event handlers at R/ggbot2.R:119-134 + +### Dependencies + +**Critical Packages** +- `shinyrealtime` (>= 0.1.0.9000): WebSocket bridge to OpenAI Realtime API +- `ellmer` (>= 0.3.0): Tool definition system for AI function calling +- `shinychat`: Markdown streaming for transcript display +- `bslib`: Modern UI components (sidebar, cards, layouts, dark mode) +- `shinyjs`: UI element manipulation (button enable/disable for history navigation) + +**Optional Packages** +- `plotly`: Interactive plot rendering +- `htmlwidgets`: Export interactive plots to HTML +- `dplyr`: Data manipulation in generated code + +**Data Handling** +- Assumes user provides actual data frame variable (not NULL) +- Variable name captured via `deparse(substitute(df))` at R/ggbot2.R:31 +- Data frame must be in-memory; no lazy evaluation support + +## Common Modifications + +### Changing AI Behavior +Edit `inst/prompts/prompt.md` to modify: +- Personality and tone +- Plotting constraints +- Default assumptions (e.g., pre-loaded packages) + +### Adding New Tools +Add tool definitions in `ggbot()` server function: +1. Create tool function +2. Wrap with `ellmer::tool()` +3. Add to `tools` list in `realtime_server()` call at R/ggbot2.R:113 + +### Modifying UI Layout +Edit `ui` definition in `ggbot()`: +- Sidebar: transcript, cost tracker, and dark mode toggle +- Plot card header: history navigation (prev/next), history info, download button +- Main area: 66% plot card, 34% code card +- Realtime UI: floating mic button + +### Working with Plot History +History is stored as a list where position 0 is the latest plot: +- New plots are prepended to `plot_history()` list +- `history_position(0)` represents the live/latest plot +- Navigation increments/decrements position to load older/newer plots +- Buttons auto-disable when at boundaries (oldest or newest) + +### Cost Calculation +Update pricing matrix at R/ggbot2.R:183-200 if OpenAI changes rates. \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index e46e21b..5f334e5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,6 +15,7 @@ Imports: ellmer (>= 0.3.0), shiny, shinychat, + shinyjs, shinyrealtime (>= 0.1.0.9000), withr Suggests: diff --git a/R/ggbot2.R b/R/ggbot2.R index 88669c9..87626ee 100644 --- a/R/ggbot2.R +++ b/R/ggbot2.R @@ -43,8 +43,13 @@ ggbot <- function(df, debug = FALSE) { title = "ggbot2", fillable = TRUE, style = "--bslib-spacer: 1rem; padding-bottom: 0;", + shinyjs::useShinyjs(), sidebar = sidebar( - helpText("Session cost:", textOutput("session_cost", inline = TRUE)), + div( + style = "display: flex; justify-content: space-between; align-items: center; margin-bottom: 1rem;", + helpText("Session cost:", textOutput("session_cost", inline = TRUE)), + input_dark_mode(id = "dark_mode", mode = "light") + ), output_markdown_stream("response_text") ), card( @@ -52,7 +57,13 @@ ggbot <- function(df, debug = FALSE) { card_header( "Plot", class = "d-flex justify-content-between align-items-center", - downloadButton("download_plot", "Download PNG", class = "btn-sm") + div( + style = "display: flex; gap: 0.5rem;", + actionButton("history_prev", icon("chevron-left"), class = "btn-sm"), + textOutput("history_info", inline = TRUE), + actionButton("history_next", icon("chevron-right"), class = "btn-sm"), + downloadButton("download_plot", "Download", class = "btn-sm") + ) ), card_body( padding = 0, @@ -92,6 +103,10 @@ ggbot <- function(df, debug = FALSE) { plot_type <- reactiveVal("static") # "static" or "plotly" running_cost <- reactiveVal(0) # Cost of tokens used in the session, in dollars + # History system + plot_history <- reactiveVal(list()) # List of history items: list(code, plot_type, timestamp) + history_position <- reactiveVal(0) # 0 = latest/live, 1 = one back, etc. + greeting <- "Welcome to ggbot2!\n\nClick the mic button to start talking. You can also click-and-hold the mic button (or hold spacebar) for push-to-talk mode." append_transcript <- function(text, clear = FALSE) { @@ -111,6 +126,12 @@ ggbot <- function(df, debug = FALSE) { last_code(code) last_plotly_code(NULL) + # Add to history + history <- plot_history() + history <- c(list(list(code = code, plot_type = "static", timestamp = Sys.time())), history) + plot_history(history) + history_position(0) # Reset to latest + # Ideally we'd run the code here to check for errors and let the model # know about success/failure in a tool response. But we only want to run # this code once, and with the environment set up correctly as renderPlot @@ -123,6 +144,13 @@ ggbot <- function(df, debug = FALSE) { plot_type("plotly") last_plotly_code(code) last_code(NULL) + + # Add to history + history <- plot_history() + history <- c(list(list(code = code, plot_type = "plotly", timestamp = Sys.time())), history) + plot_history(history) + history_position(0) # Reset to latest + NULL } @@ -239,6 +267,76 @@ ggbot <- function(df, debug = FALSE) { output_audio = 20 / 1e6 ) + # History navigation + observeEvent(input$history_prev, { + pos <- history_position() + history <- plot_history() + if (pos < length(history) - 1) { + new_pos <- pos + 1 + history_position(new_pos) + # Load plot from history + item <- history[[new_pos + 1]] # +1 because R is 1-indexed + if (item$plot_type == "static") { + plot_type("static") + last_code(item$code) + last_plotly_code(NULL) + } else { + plot_type("plotly") + last_plotly_code(item$code) + last_code(NULL) + } + } + }) + + observeEvent(input$history_next, { + pos <- history_position() + if (pos > 0) { + new_pos <- pos - 1 + history_position(new_pos) + # Load plot from history + history <- plot_history() + item <- history[[new_pos + 1]] # +1 because R is 1-indexed + if (item$plot_type == "static") { + plot_type("static") + last_code(item$code) + last_plotly_code(NULL) + } else { + plot_type("plotly") + last_plotly_code(item$code) + last_code(NULL) + } + } + }) + + # Update button states + observe({ + pos <- history_position() + history <- plot_history() + + # Disable prev if at oldest plot + if (pos >= length(history) - 1 || length(history) <= 1) { + shinyjs::disable("history_prev") + } else { + shinyjs::enable("history_prev") + } + + # Disable next if at newest plot + if (pos <= 0) { + shinyjs::disable("history_next") + } else { + shinyjs::enable("history_next") + } + }) + + output$history_info <- renderText({ + pos <- history_position() + history <- plot_history() + if (length(history) == 0) { + return("") + } + paste0((pos + 1), "/", length(history)) + }) + output$plot_container <- renderUI({ if (plot_type() == "plotly") { req(last_plotly_code()) @@ -308,7 +406,9 @@ ggbot <- function(df, debug = FALSE) { output$download_plot <- downloadHandler( filename = function() { - paste0("ggbot_plot_", format(Sys.time(), "%Y%m%d_%H%M%S"), ".png") + current_plot_type <- isolate(plot_type()) + extension <- if (current_plot_type == "plotly") ".html" else ".png" + paste0("ggbot_plot_", format(Sys.time(), "%Y%m%d_%H%M%S"), extension) }, content = function(file) { current_plot_type <- isolate(plot_type()) @@ -350,50 +450,13 @@ ggbot <- function(df, debug = FALSE) { stop("plotly package is required") } - # For plotly, we need to use kaleido for export - plotly_obj <- eval(parse(text = code), envir = new.env(parent = globalenv())) - - # Try kaleido first (modern approach) - kaleido_worked <- FALSE - if (requireNamespace("kaleido", quietly = TRUE)) { - tryCatch({ - kaleido::save_image(plotly_obj, file, width = 3000, height = 2400) - kaleido_worked <- TRUE - }, error = function(e) { - warning("kaleido export failed: ", e$message) - }) + if (!requireNamespace("htmlwidgets", quietly = TRUE)) { + stop("htmlwidgets package is required to save interactive plots") } - # If kaleido didn't work, try plotly's built-in save_image - if (!kaleido_worked) { - tryCatch({ - # plotly::save_image uses kaleido under the hood - plotly::save_image(plotly_obj, file, width = 3000, height = 2400) - }, error = function(e1) { - # Last fallback: use webshot - if (requireNamespace("webshot2", quietly = TRUE) || requireNamespace("webshot", quietly = TRUE)) { - temp_html <- tempfile(fileext = ".html") - tryCatch({ - if (!requireNamespace("htmlwidgets", quietly = TRUE)) { - stop("htmlwidgets package is required for this export method") - } - htmlwidgets::saveWidget(plotly_obj, temp_html, selfcontained = TRUE) - if (requireNamespace("webshot2", quietly = TRUE)) { - webshot2::webshot(temp_html, file, vwidth = 3000, vheight = 2400) - } else { - webshot::webshot(temp_html, file, vwidth = 3000, vheight = 2400) - } - }, finally = { - if (file.exists(temp_html)) { - unlink(temp_html) - } - }) - } else { - stop("Cannot export plotly plot to PNG. Please install one of: kaleido, webshot2, or webshot.\n", - "Recommended: install.packages('kaleido')") - } - }) - } + # Save interactive plotly as HTML to preserve interactivity + plotly_obj <- eval(parse(text = code), envir = new.env(parent = globalenv())) + htmlwidgets::saveWidget(plotly_obj, file, selfcontained = TRUE) } else { stop("No plot available to download. Please generate a plot first.") } From a446c155c78cc39ba42eb32056fd0328a9092ade Mon Sep 17 00:00:00 2001 From: Abu Saadat <103253429+SAADAT-Abu@users.noreply.github.com> Date: Mon, 6 Oct 2025 21:48:59 +0200 Subject: [PATCH 3/3] Delete --- CLAUDE.md | 164 ------------------------------------------------------ 1 file changed, 164 deletions(-) delete mode 100644 CLAUDE.md diff --git a/CLAUDE.md b/CLAUDE.md deleted file mode 100644 index 3410b93..0000000 --- a/CLAUDE.md +++ /dev/null @@ -1,164 +0,0 @@ -# CLAUDE.md - -This file provides guidance to Claude Code (claude.ai/code) when working with code in this repository. - -## Overview - -ggbot2 is a voice assistant for ggplot2 that uses OpenAI's GPT-4o Realtime API through Shiny. Users speak commands, and the assistant generates R plotting code that executes in real-time. - -## Prerequisites - -- OpenAI API key with paid account (a few dollars minimum) -- Set `OPENAI_API_KEY` in `.Renviron` or `.env` file - -## Development Commands - -### Installation -```r -# Install from GitHub -pak::pak("tidyverse/ggbot2") - -# Install with dependencies for local development -pak::pak(".") -``` - -### Running the App -```r -# Launch with a data frame -ggbot2::ggbot(mtcars) - -# Enable debug mode for verbose logging -ggbot2::ggbot(mtcars, debug = TRUE) -``` - -### Documentation -```r -# Generate/update documentation -devtools::document() -``` - -## Architecture - -### Core Components - -**Main Function: `ggbot()` (R/ggbot2.R:24-236)** -- Entry point that validates data frame input and launches Shiny app -- Validates OPENAI_API_KEY via `ensure_openai_api_key()` -- Builds prompt with data frame metadata via `build_prompt()` -- Creates 3-panel UI: sidebar (transcript), plot viewer, code viewer - -**Realtime Integration** -- Uses `shinyrealtime` package for WebSocket connection to OpenAI Realtime API -- Voice input → GPT-4o Realtime → R code generation → immediate plot execution -- Event-driven architecture with listeners for conversation items, responses, and usage tracking - -**Tool System** -- Two tools exposed to AI: - - `run_r_plot_code_tool`: Generates static ggplot2 plots - - `run_r_plotly_code_tool`: Generates interactive plotly plots -- Tools receive R code string and store in reactive values (`last_code` or `last_plotly_code`) -- Code executes in isolated environment via `renderPlot()` or `plotly::renderPlotly()` -- Each execution is a fresh environment; no state persists between calls -- AI intelligently chooses tool based on user request and data characteristics - -**Prompt Construction: `build_prompt()` (R/ggbot2.R:305-336)** -- Loads base instructions from inst/prompts/prompt.md -- Appends data frame preview (first 6 rows), structure, and summary -- Uses string interpolation to inject df_name and metadata - -**System Prompt (inst/prompts/prompt.md)** -- Defines AI personality: warm, engaging, playful, quick-talking -- Constrains AI to plotting tasks only -- Assumes ggplot2 and dplyr are pre-loaded -- Emphasizes fresh R session per function call - -### Key Technical Details - -**Plot History System** -- All generated plots stored in reactive list `plot_history` -- Each history item contains: code, plot_type ("static" or "plotly"), timestamp -- `history_position` tracks current position (0 = latest, incrementing for older plots) -- Prev/next navigation buttons in plot card header -- Seamlessly handles transitions between static and interactive plots -- History info displays "1/5", "2/5", etc. showing current position - -**Dark Mode** -- Uses bslib's `input_dark_mode()` for light/dark theme toggle -- Toggle button in sidebar next to session cost -- Automatically applies to all UI components (cards, sidebar, buttons) -- Leverages Bootstrap 5.3 color mode system - -**Download Functionality** -- Static plots: Download as high-resolution PNG (3000×2400px at 300 DPI) -- Interactive plots: Download as self-contained HTML with full interactivity -- Filename includes timestamp for easy organization -- Uses `htmlwidgets::saveWidget()` for plotly exports - -**Cost Tracking** -- Tracks token usage per response (text, audio, cached) at R/ggbot2.R:168-181 -- Pricing matrix at R/ggbot2.R:183-200 for GPT-4o Realtime -- Running cost displayed in sidebar via `running_cost` reactive value - -**Error Handling** -- Plot code errors caught in tryCatch at R/ggbot2.R:208-222 -- Errors displayed but not sent back to AI (see comment at R/ggbot2.R:212-219) -- API key validation with helpful error messages at R/ggbot2.R:257-293 - -**Audio Feedback** -- Shutter sound effect (inst/shutter.mp3) plays after each plot render -- Embedded as base64 data URI via `hidden_audio_el()` at R/ggbot2.R:238-248 - -**Notifications** -- Shows "Generating code..." when function call starts -- Auto-removes notification when function call completes -- Event handlers at R/ggbot2.R:119-134 - -### Dependencies - -**Critical Packages** -- `shinyrealtime` (>= 0.1.0.9000): WebSocket bridge to OpenAI Realtime API -- `ellmer` (>= 0.3.0): Tool definition system for AI function calling -- `shinychat`: Markdown streaming for transcript display -- `bslib`: Modern UI components (sidebar, cards, layouts, dark mode) -- `shinyjs`: UI element manipulation (button enable/disable for history navigation) - -**Optional Packages** -- `plotly`: Interactive plot rendering -- `htmlwidgets`: Export interactive plots to HTML -- `dplyr`: Data manipulation in generated code - -**Data Handling** -- Assumes user provides actual data frame variable (not NULL) -- Variable name captured via `deparse(substitute(df))` at R/ggbot2.R:31 -- Data frame must be in-memory; no lazy evaluation support - -## Common Modifications - -### Changing AI Behavior -Edit `inst/prompts/prompt.md` to modify: -- Personality and tone -- Plotting constraints -- Default assumptions (e.g., pre-loaded packages) - -### Adding New Tools -Add tool definitions in `ggbot()` server function: -1. Create tool function -2. Wrap with `ellmer::tool()` -3. Add to `tools` list in `realtime_server()` call at R/ggbot2.R:113 - -### Modifying UI Layout -Edit `ui` definition in `ggbot()`: -- Sidebar: transcript, cost tracker, and dark mode toggle -- Plot card header: history navigation (prev/next), history info, download button -- Main area: 66% plot card, 34% code card -- Realtime UI: floating mic button - -### Working with Plot History -History is stored as a list where position 0 is the latest plot: -- New plots are prepended to `plot_history()` list -- `history_position(0)` represents the live/latest plot -- Navigation increments/decrements position to load older/newer plots -- Buttons auto-disable when at boundaries (oldest or newest) - -### Cost Calculation -Update pricing matrix at R/ggbot2.R:183-200 if OpenAI changes rates. \ No newline at end of file