## ----------------------------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", echo = FALSE ) ## ----------------------------------------------------------------------------- # library(shinychat) # library(ellmer) # library(weathR) # for forecasts via `point_tomorrow()` # # get_weather_forecast <- tool( # function(lat, lon) { # point_tomorrow(lat, lon, short = FALSE) # }, # name = "get_weather_forecast", # description = "Get the weather forecast for a location.", # arguments = list( # lat = type_number("Latitude"), # lon = type_number("Longitude") # ) # ) ## ----------------------------------------------------------------------------- # chat <- ellmer::chat("openai/gpt-4.1-nano", echo = "output") # chat$register_tool(get_weather_forecast) # chat$chat("What's the weather in Boston like today?") ## ----------------------------------------------------------------------------- knitr::include_graphics("images/tool-ui/basic-running.png") ## ----------------------------------------------------------------------------- knitr::include_graphics("images/tool-ui/basic-settled.png") ## ----------------------------------------------------------------------------- knitr::include_graphics("images/tool-ui/basic-error.png") ## ----------------------------------------------------------------------------- # server <- function(input, output, session) { # client <- ellmer::chat("openai/gpt-4.1-nano") # client$register_tool(get_weather_forecast) # # observeEvent(input$chat_user_input, { # stream <- client$stream_async(input$chat_user_input, stream = "content") # chat_append("chat", stream) # }) # } ## ----------------------------------------------------------------------------- # get_weather_forecast <- tool( # function(lat, lon) { # point_tomorrow(lat, lon, short = FALSE) # }, # name = "get_weather_forecast", # description = "Get the weather forecast for a location.", # arguments = list( # lat = type_number("Latitude"), # lon = type_number("Longitude") # ), # annotations = tool_annotations( # title = "Getting weather forecast", # icon = bsicons::bs_icon("cloud-sun") # ) # ) ## ----------------------------------------------------------------------------- knitr::include_graphics("images/tool-ui/annotations-running.png") ## ----------------------------------------------------------------------------- knitr::include_graphics("images/tool-ui/annotations-settled.png") ## ----------------------------------------------------------------------------- # get_weather_forecast <- tool( # function(lat, lon, location_name) { # forecast <- point_tomorrow(lat, lon, short = FALSE) # # icon <- if (any(forecast$temp > 70)) { # bsicons::bs_icon("sun-fill") # } else if (any(forecast$temp < 45)) { # bsicons::bs_icon("snow") # } else { # bsicons::bs_icon("cloud-sun-fill") # } # # ContentToolResult( # forecast, # extra = list( # display = tool_result_display( # title = paste("Got weather forecast for", location_name), # icon = icon, # label = location_name, # value_preview = paste(nrow(forecast), "hourly readings") # ) # ) # ) # }, # name = "get_weather_forecast", # description = "Get the weather forecast for a location.", # arguments = list( # lat = type_number("Latitude"), # lon = type_number("Longitude"), # location_name = type_string("Name of the location for display to the user") # ), # annotations = tool_annotations( # title = "Getting weather forecast", # icon = bsicons::bs_icon("cloud-sun") # ) # ) ## ----------------------------------------------------------------------------- knitr::include_graphics("images/tool-ui/result-fields.png") ## ----------------------------------------------------------------------------- # tool_random_number <- tool( # function(`_intent`) { # runif(1) # }, # name = "tool_random_number", # description = "Generate a random number.", # arguments = list( # `_intent` = type_string( # "A short snippet used for display purposes to explain the call to the user." # ) # ), # annotations = tool_annotations( # title = "Generating random number", # icon = bsicons::bs_icon("dice-3-fill") # ) # ) ## ----------------------------------------------------------------------------- knitr::include_graphics("images/tool-ui/intent.png") ## ----------------------------------------------------------------------------- # get_weather_forecast <- tool( # function(lat, lon, location_name) { # forecast_data <- point_tomorrow(lat, lon, short = FALSE) # forecast_table <- gt::as_raw_html(gt::gt(forecast_data)) # # ContentToolResult( # forecast_data, # extra = list( # display = tool_result_display( # html = forecast_table, # title = paste("Got weather forecast for", location_name), # label = location_name, # value_preview = paste(nrow(forecast_data), "hourly readings"), # show_request = FALSE, # open = TRUE, # full_screen = TRUE, # footer = htmltools::tags$small("Forecast data from weather.gov"), # open_style = "framed" # ) # ) # ) # }, # name = "get_weather_forecast", # description = "Get the weather forecast for a location.", # arguments = list( # lat = type_number("Latitude"), # lon = type_number("Longitude"), # location_name = type_string("Name of the location for display to the user") # ), # annotations = tool_annotations( # title = "Getting weather forecast", # icon = bsicons::bs_icon("cloud-sun") # ) # ) ## ----------------------------------------------------------------------------- knitr::include_graphics("images/tool-ui/rich-html.png") ## ----------------------------------------------------------------------------- # get_weather_forecast <- tool( # function(lat, lon, location_name) { # forecast_data <- point_tomorrow(lat, lon, short = FALSE) # # temp_current <- forecast_data$temp[1] # skies_current <- forecast_data$skies[[1]] # # temp_high <- max(forecast_data$temp) # temp_low <- min(forecast_data$temp) # # humidity <- round(mean(forecast_data$humidity), 1) # skies <- table(forecast_data$skies) # skies <- names(skies)[which.max(skies)] # # forecast_summary <- glue::glue( # "In **{location_name}**, it's currently {temp_current}°F with _{tolower(skies_current)}_ skies. ", # "Today's high will be {temp_high}°F and the low will be {temp_low}°F. ", # "Humidity is around {humidity}%. ", # "Look for **{tolower(skies)}** skies throughout the day." # ) # # ContentToolResult( # forecast_data, # extra = list( # display = tool_result_display( # markdown = forecast_summary, # title = paste("Got weather forecast for", location_name) # ) # ) # ) # }, # name = "get_weather_forecast", # description = "Get the weather forecast for a location.", # arguments = list( # lat = type_number("Latitude"), # lon = type_number("Longitude"), # location_name = type_string("Name of the location for display to the user") # ), # annotations = tool_annotations( # title = "Getting weather forecast", # icon = bsicons::bs_icon("cloud-sun") # ) # ) ## ----------------------------------------------------------------------------- knitr::include_graphics("images/tool-ui/rich-markdown.png") ## ----------------------------------------------------------------------------- # chat_ui("chat", tool_grouping = "tool") ## ----------------------------------------------------------------------------- # get_weather_forecast <- tool( # function(lat, lon) { # point_tomorrow(lat, lon, short = FALSE) # }, # name = "get_weather_forecast", # description = "Get the weather forecast for a location.", # arguments = list( # lat = type_number("Latitude"), # lon = type_number("Longitude") # ), # annotations = tool_annotations( # title = "Getting weather forecast", # grouping = "all" # ) # )