feat: new gpt_history() and markdown2df() functions

NAMESPACE

@@ -92,6 +92,7 @@ export(gpt_classify)
 export(gpt_convert)
 export(gpt_extract)
 export(gpt_format)
+export(gpt_history)
 export(gpt_table)
 export(gpt_tag)
 export(gpt_translate)
@@ -131,6 +132,7 @@ export(loglossBinary)
 export(mae)
 export(mail_send)
 export(mape)
+export(markdown2df)
 export(missingness)
 export(model_metrics)
 export(model_preprocess)

R/cache.R

@@ -18,6 +18,7 @@
 #' if the cache should be used to proceed or ignored; when writing, (interactive)
 #' ask the user if the cache should be overwritten. Note that you can only ask for
 #' one cache file at a time because vectors are concatenated.
+#' @param ... Additional parameters.
 #' @return \code{cache_write}. No return value, called for side effects.
 #' @examples
 #' x <- list(a = 1, b = 2:4)
@@ -31,7 +32,8 @@ cache_write <- function(data,
                         base = "temp",
                         cache_dir = getOption("LARES_CACHE_DIR"),
                         ask = FALSE,
-                        quiet = FALSE) {
+                        quiet = FALSE,
+                        ...) {
   if (is.null(getOption("LARES_CACHE_DIR"))) {
     cache_dir <- tempdir()
   }
@@ -67,7 +69,8 @@ cache_write <- function(data,
 cache_read <- function(base,
                        cache_dir = getOption("LARES_CACHE_DIR"),
                        ask = FALSE,
-                       quiet = FALSE) {
+                       quiet = FALSE,
+                       ...) {
   base <- paste(base, collapse = ".")
   if (left(base, 12) != "lares_cache_") base <- paste0("lares_cache_", base)
   if (right(base, 4) == ".RDS") base <- gsub("\\.RDS", "", base)
@@ -95,7 +98,7 @@ cache_read <- function(base,
 #' @rdname cache_write
 #' @return \code{cache_exists}. Boolean. Result of \code{base} existence.
 #' @export
-cache_exists <- function(base = NULL, cache_dir = getOption("LARES_CACHE_DIR")) {
+cache_exists <- function(base = NULL, cache_dir = getOption("LARES_CACHE_DIR"), ...) {
   if (is.null(getOption("LARES_CACHE_DIR"))) {
     cache_dir <- tempdir()
   }
@@ -119,7 +122,7 @@ cache_exists <- function(base = NULL, cache_dir = getOption("LARES_CACHE_DIR"))
 #' @rdname cache_write
 #' @return \code{cache_clear}. Invisible vector containing cache file names removed.
 #' @export
-cache_clear <- function(cache_dir = getOption("LARES_CACHE_DIR"), quiet = FALSE) {
+cache_clear <- function(cache_dir = getOption("LARES_CACHE_DIR"), quiet = FALSE, ...) {
   if (is.null(cache_dir)) cache_dir <- tempdir()
   files <- list.files(cache_dir)
   caches <- files[startsWith(files, "lares_cache_")]

R/chatgpt.R

@@ -1,8 +1,14 @@
+hist_ask <- "GPT_HIST_ASK"
+hist_reply <- "GPT_HIST_REPLY"
+
 ####################################################################
 #' ChatGPT API Interaction with R
 #'
 #' This function lets the user ask ChatGPT via its API, and returns
-#' the rendered reply.
+#' the rendered reply. There are a couple of specific verbs (functions) with a
+#' preset prompt to help fetch the data in specific formats. We also
+#' store the prompts and replies in current session with their respective
+#' time-stamps so user can gather historical results.
 #'
 #' @family API
 #' @inheritParams db_download
@@ -49,14 +55,25 @@
 #' gpt_translate(
 #'   rep("I love you with all my heart", 5),
 #'   language = c("spanish", "chinese", "japanese", "russian", "german"))
+#'
+#' # Now let's read the historical prompts and replies from current session
+#' gpt_history()
 #' }
 #' @export
 gpt_ask <- function(ask,
-                        secret_key = get_credentials()$openai$secret_key,
-                        url = "https://api.openai.com/v1/chat/completions",
-                        model = "gpt-3.5-turbo",
-                        quiet = FALSE, ...) {
+                    secret_key = get_credentials()$openai$secret_key,
+                    url = Sys.getenv("LARES_GPT_URL"),
+                    model = Sys.getenv("LARES_GPT_MODEL"),
+                    quiet = FALSE, ...) {
+  ts <- Sys.time()
   if (length(ask) > 1) ask <- paste(ask, collapse = " + ")
+  # Save historical questions
+  if (cache_exists(hist_ask)){
+    cache <- cache_read(hist_ask, quiet = TRUE, ...)
+    cache <- rbind(cache, data.frame(ts = ts, prompt = ask))
+  } else cache <- data.frame(ts = ts, prompt = ask)
+  cache_write(distinct(cache), hist_ask, quiet = TRUE, ...)
+  # Ask ChatGPT using their API
   response <- POST(
     url = url, 
     add_headers(Authorization = paste("Bearer", secret_key)),
@@ -74,9 +91,29 @@ gpt_ask <- function(ask,
   if ("error" %in% names(ret)) warning(ret$error$message)
   if ("message" %in% names(ret$choices[[1]]) & !quiet)
     cat(stringr::str_trim(ret$choices[[1]]$message$content))
+  # Save historical answers
+  if (cache_exists(hist_ask)){
+    cache <- cache_read(hist_reply, quiet = TRUE, ...)
+    cache <- rbind(cache, data.frame(ts = ts, reply = ret))
+  } else cache <- data.frame(ts = ts, prompt = ret)
+  cache_write(distinct(cache), hist_reply, quiet = TRUE, ...)
   return(invisible(ret))
 }
 
+#' @rdname gpt_ask
+#' @export
+gpt_history <- function() {
+  asks <- cache_read(hist_ask, quiet = TRUE)
+  if (!is.null(asks)) {
+    replies <- cache_read(hist_reply, quiet = TRUE)
+    hist <- as_tibble(left_join(asks, replies, by = "ts")) %>%
+      select(.data$ts, .data$prompt, contains("message.content"), everything())
+    return(hist) 
+  } else {
+    warning("No historical prompts nor replies registered yet")
+  }
+}
+
 #' @param x Vector. List items you wish to process
 #' @param categories,tags Vector. List of possible categories/tags to consider.
 #' @rdname gpt_ask
@@ -160,15 +197,9 @@ gpt_prompt_builder <- function(type = "category", cols = c("item", type), x, y)
 
 gpt_markdown2df <- function(resp) {
   if ("message" %in% names(resp$choices[[1]])) {
-    df <- resp$choices[[1]]$message$content
-    # Convert markdown to data.frame
-    df <- removenacols(read.table(text = df, sep = "|", header = TRUE, strip.white = TRUE, quote="\""))
-    # Get rid of potential first row with all values set as --- or :---
-    if (all(stringr::str_split(df[1, 1], "-")[[1]] == "")) df <- df[-1, ]
-    if (substr(df[1, 1], 1, 4) == ":---") df <- df[-1, ]
-    rownames(df) <- NULL
-    df <- as_tibble(df)
-    attr(df, "response") <- resp
-    return(df)
-  } else return(resp)
+    resp <- resp$choices[[1]]$message$content
+  }
+  df <- try(markdown2df(resp))
+  attr(df, "response") <- df
+  return(df)
 }

R/other_functions.R

@@ -970,3 +970,22 @@ warnifnot <- function(...) if (!isTRUE(...)) warning(paste(deparse(...), "is not
 what_size <- function(x, units = "Mb", ...) {
   format(object.size(x), units = units, ...)
 }
+
+####################################################################
+#' Convert markdown string tables to data.frame
+#'
+#' @family Tools
+#' @param text Character. Markdown text representing a table.
+#' @examples
+#' txt <- "| Item | Value |\n|------|-------|\n| 50C  | 122F  |\n| 300K | 80.33F |"
+#' markdown2df(txt)
+#' @export
+markdown2df <- function(text) {
+  df <- removenacols(read.table(text = text, sep = "|", header = TRUE, strip.white = TRUE, quote="\""))
+  # Get rid of potential first row with all values set as --- or :---
+  if (all(stringr::str_split(df[1, 1], "-")[[1]] == "")) df <- df[-1, ]
+  if (substr(df[1, 1], 1, 4) == ":---") df <- df[-1, ]
+  rownames(df) <- NULL
+  df <- as_tibble(df)
+  return(df)
+}

R/zzz.R

@@ -1,5 +1,4 @@
 .onLoad <- function(libname, pkgname) {
-  # Old options: lares.font, lares.formatNum, lares.lang
   Sys.setenv(
     # So user can set another font be default on theme_lares()
     "LARES_FONT" = if (Sys.getenv("LARES_FONT") != "") {
@@ -24,6 +23,17 @@
       Sys.getenv("LARES_LANG")
     } else {
       "es"
+    },
+    # ChatGPT Default values
+    "LARES_GPT_MODEL" = if (Sys.getenv("LARES_GPT_MODEL") != "") {
+      Sys.getenv("LARES_GPT_MODEL")
+    } else {
+      "gpt-3.5-turbo"
+    },
+    "LARES_GPT_URL" = if (Sys.getenv("LARES_GPT_URL") != "") {
+      Sys.getenv("LARES_GPT_URL")
+    } else {
+      "https://api.openai.com/v1/chat/completions"
     }
   )
   options(