From 1fbd8785f65a88d6806aed9a32430af304faf34a Mon Sep 17 00:00:00 2001 From: laresbernardo Date: Mon, 15 May 2023 11:15:32 -0500 Subject: [PATCH] CRAN 5.2.2 --- DESCRIPTION | 2 +- R/audio.R | 6 +++-- R/chatgpt.R | 48 ++++++++++++++++++++------------- R/credentials.R | 4 ++- R/currency.R | 27 +++++++++---------- R/facebook.R | 65 +++++++++++++++++++++++++++------------------ R/frequencies.R | 4 +-- R/model_plots.R | 4 ++- R/other_functions.R | 2 +- R/stocks.R | 3 ++- man/freqs_df.Rd | 2 -- man/gpt_ask.Rd | 16 ++++++----- 12 files changed, 105 insertions(+), 78 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8e88430dd..a282d7c4f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: lares Type: Package Title: Analytics & Machine Learning Sidekick -Version: 5.2.2.9000 +Version: 5.2.2 Authors@R: c( person("Bernardo", "Lares", , "laresbernardo@gmail.com", c("aut", "cre"))) Maintainer: Bernardo Lares diff --git a/R/audio.R b/R/audio.R index f860d8317..70f811565 100644 --- a/R/audio.R +++ b/R/audio.R @@ -86,8 +86,10 @@ get_mp3 <- function(id, stop(msg) } ) - - if (1 %in% ret) return(invisible(NULL)) + + if (1 %in% ret) { + return(invisible(NULL)) + } f <- listfiles(getwd(), recursive = FALSE) %>% filter(grepl("\\.info\\.json", .data$filename)) %>% diff --git a/R/chatgpt.R b/R/chatgpt.R index 570afc8b7..2591287b7 100644 --- a/R/chatgpt.R +++ b/R/chatgpt.R @@ -25,7 +25,7 @@ hist_reply <- "GPT_HIST_REPLY" #' api_key <- get_credentials()$openai$secret_key #' # Open question: #' gpt_ask("Can you write an R function to plot a dummy histogram?", api_key) -#' +#' #' ##### The following examples return dataframes: #' # Classify each element based on categories: #' gpt_classify(1:10, c("odd", "even")) @@ -33,28 +33,32 @@ hist_reply <- "GPT_HIST_REPLY" #' # Add all tags that apply to each element based on tags: #' gpt_tag( #' c("I love chocolate", "I hate chocolate", "I like Coke"), -#' c("food", "positive", "negative", "beverage")) +#' c("food", "positive", "negative", "beverage") +#' ) #' #' # Extract specific information: #' gpt_extract( #' c("My mail is 123@@test.com", "30 Main Street, Brooklyn, NY, USA", "+82 2-312-3456", "$1.5M"), -#' c("email", "full state name", "country of phone number", "amount as number")) -#' +#' c("email", "full state name", "country of phone number", "amount as number") +#' ) +#' #' # Format values #' gpt_format( #' c("March 27th, 2021", "12-25-2023 3:45PM", "01.01.2000", "29 Feb 92"), -#' format = "ISO Date getting rid of timestamps") -#' +#' format = "ISO Date getting rid of timestamps" +#' ) +#' #' # Convert units #' gpt_convert(c("50C", "300K"), "Fahrenheit") -#' +#' #' # Create a table with data #' gpt_table("5 random people's address in South America, email, phone, age between 18-30") -#' +#' #' # Translate text to any language #' gpt_translate( #' rep("I love you with all my heart", 5), -#' language = c("spanish", "chinese", "japanese", "russian", "german")) +#' language = c("spanish", "chinese", "japanese", "russian", "german") +#' ) #' #' # Now let's read the historical prompts and replies from current session #' gpt_history() @@ -68,34 +72,39 @@ gpt_ask <- function(ask, ts <- Sys.time() if (length(ask) > 1) ask <- paste(ask, collapse = " + ") # Save historical questions - if (cache_exists(hist_ask)){ + 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) + } 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, + url = url, add_headers(Authorization = paste("Bearer", secret_key)), httr::content_type_json(), encode = "json", body = list( model = model, messages = list(list( - role = "user", + role = "user", content = ask )) ) ) ret <- content(response) if ("error" %in% names(ret)) warning(ret$error$message) - if ("message" %in% names(ret$choices[[1]]) & !quiet) + 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)){ + 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) + } else { + cache <- data.frame(ts = ts, prompt = ret) + } cache_write(distinct(cache), hist_reply, quiet = TRUE, ...) return(invisible(ret)) } @@ -108,7 +117,7 @@ gpt_history <- function() { 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) + return(hist) } else { warning("No historical prompts nor replies registered yet") } @@ -186,13 +195,14 @@ gpt_translate <- function(x, language, quiet = TRUE, ...) { df <- gpt_markdown2df(resp) return(df) } - + gpt_prompt_builder <- function(type = "category", cols = c("item", type), x, y) { paste( "Return a structured markdown table with", length(cols), "columns named", v2t(cols, and = "and"), ". Consider the following items:", v2t(x, quotes = FALSE), ". For each respective item, what", type, "represent each item using:", v2t(y, quotes = FALSE), - ". If you don't know any item, replace with NA") + ". If you don't know any item, replace with NA" + ) } gpt_markdown2df <- function(resp) { diff --git a/R/credentials.R b/R/credentials.R index 8d20b69cf..a4f0bedb0 100644 --- a/R/credentials.R +++ b/R/credentials.R @@ -55,7 +55,9 @@ get_credentials <- function(from = NA, dir = NA, filename = "config.yml", env = "LARES_CREDS", ...) { - if (is.list(dir)) return(dir) + if (is.list(dir)) { + return(dir) + } if (isTRUE(is.na(dir)) || isTRUE(is.null(dir))) { dir <- Sys.getenv(env) if (dir == "") { diff --git a/R/currency.R b/R/currency.R index dc7944fe1..048cb4d36 100644 --- a/R/currency.R +++ b/R/currency.R @@ -39,23 +39,20 @@ get_currency <- function(currency_pair, if (from == to) to <- from + 1 if (to > Sys.Date()) to <- Sys.Date() - if (Sys.Date() == from) { - x <- suppressWarnings(getQuote(string, auto.assign = FALSE)) + x <- try(data.frame(suppressWarnings(getSymbols( + string, + env = NULL, + from = from, to = to, + src = "yahoo" + )))) + if ("try-error" %in% class(x)) { + warning(x) + return(x) + } + if (substr(rownames(x), 1, 1)[1] == "X") { + x <- x[1, ] rownames(x) <- Sys.Date() - x[, 1] <- NULL - } else { - x <- data.frame(suppressWarnings(getSymbols( - string, - env = NULL, - from = from, to = to, - src = "yahoo" - ))) - if (substr(rownames(x), 1, 1)[1] == "X") { - x <- x[1, ] - rownames(x) <- Sys.Date() - } } - rate <- data.frame(date = as.Date(rownames(x)), rate = x[, 1]) if (fill) { diff --git a/R/facebook.R b/R/facebook.R index 5c61b1a4e..0dac7db91 100644 --- a/R/facebook.R +++ b/R/facebook.R @@ -42,7 +42,8 @@ fb_process <- function(input, paginate = TRUE, sleep = 0, quiet = FALSE, ...) { "\n1. Within the Graph API Explorer, select an Application.", "\n2. Go to Get Token and select the Page Acces Token needed.", "Note that there are navigation arrows if there are lots of accounts.", - "\n3. Copy and use the Acces Token created.")) + "\n3. Copy and use the Acces Token created." + )) browseURL("https://developers.facebook.com/tools/explorer") } } @@ -57,8 +58,10 @@ fb_process <- function(input, paginate = TRUE, sleep = 0, quiet = FALSE, ...) { # Deal with GET + response vs jsonlite out <- fromJSON(toJSON(import)) - if (all(lapply(out, length) == 1)) return(out) - + if (all(lapply(out, length) == 1)) { + return(out) + } + # First pagination results <- list() i <- 1 @@ -80,11 +83,14 @@ fb_process <- function(input, paginate = TRUE, sleep = 0, quiet = FALSE, ...) { } while (exists("next", out$paging) && (i < as.integer(paginate) || isTRUE(paginate))) { i <- i + 1 - res <- try({ - out <- fromJSON(out$paging[["next"]]) - results[[i]] <- list_flattener(out$data, i) - if (!quiet) show_pag_status(results, i, sleep, quiet) - }, silent = TRUE) + res <- try( + { + out <- fromJSON(out$paging[["next"]]) + results[[i]] <- list_flattener(out$data, i) + if (!quiet) show_pag_status(results, i, sleep, quiet) + }, + silent = TRUE + ) if (inherits(res, "try-error")) { warning(paste0("Returning partial results given last pagination (", i, ") returned error")) break @@ -102,7 +108,7 @@ fb_process <- function(input, paginate = TRUE, sleep = 0, quiet = FALSE, ...) { mutate_at(vars(contains("url")), list(as.character)) %>% mutate_at(vars(contains("name")), list(as.character)) %>% as_tibble() - + # Save last pagination and if it returned complete results attr(ret, "paging_done") <- !("next" %in% names(out[["paging"]])) attr(ret, "paging") <- out[["paging"]] @@ -126,7 +132,7 @@ show_pag_status <- function(results, i = 1, sleep = 0, quiet = FALSE) { } else { flush.console() total <- sum(unlist(lapply(results, nrow))) - cat(paste(sprintf("\r>>> Pagination imported: %s | Total rows: %s", i, total))) + cat(paste(sprintf("\r>>> Pagination imported: %s | Total rows: %s", i, total))) } } Sys.sleep(sleep) @@ -466,7 +472,8 @@ fb_rf <- function(token, destination_ids = toJSON(as.character(destination_ids)), target_spec = ts, access_token = token - )), encode = "json")[[1]] + ) + ), encode = "json")[[1]] if ("message" %in% names(prediction)) { message(paste( @@ -548,15 +555,15 @@ fb_accounts <- function(token, set_config(config(http_version = 0)) api_version <- ifelse(is.null(api_version), META_API_VER, api_version) output <- NULL - + # Select which type of ad accounts type <- paste0(type, "_ad_accounts") - + for (i in seq_along(type)) { message(paste(">>> Fetching", type[i])) URL <- paste(META_GRAPH_URL, api_version, business_id, type[i], sep = "/") continue <- TRUE - + # Call insights import <- GET( URL, @@ -568,17 +575,17 @@ fb_accounts <- function(token, encode = "json" ) ret <- fb_process(import, quiet = TRUE, ...) - + if (inherits(ret, "data.frame")) { ret$type <- type[i] output <- bind_rows(output, ret) } } - + if (!inherits(output, "data.frame")) { return(invisible(NULL)) } - + # Account status dictionary output <- mutate(output, account_status = case_when( account_status == "1" ~ "ACTIVE", @@ -592,12 +599,14 @@ fb_accounts <- function(token, account_status == "201" ~ "ANY_ACTIVE", account_status == "202" ~ "ANY_CLOSED" )) - + output <- suppressMessages(type.convert( - output, numerals = "no.loss", as.is = TRUE)) %>% + output, + numerals = "no.loss", as.is = TRUE + )) %>% arrange(desc(.data$amount_spent)) %>% as_tibble() - + return(output) } @@ -667,7 +676,7 @@ fb_creatives <- function(token, which, ...) { set_config(config(http_version = 0)) api_version <- ifelse(is.null(api_version), META_API_VER, api_version) - + fields <- c( "account_id", "object_type", "name", "status", "campaign_id", "call_to_action_type", "image_url", "thumbnail_url" @@ -684,7 +693,9 @@ fb_creatives <- function(token, which, token ) import <- GET(linkurl) - if (!process) return(import) + if (!process) { + return(import) + } ret <- fb_process(import, ...) return(ret) } @@ -723,14 +734,14 @@ fb_ads <- function(token, ...) { set_config(config(http_version = 0)) api_version <- ifelse(is.null(api_version), META_API_VER, api_version) - + if (is.na(fields[1])) { fields <- paste( "account_id, campaign, campaign_id, objective, adset_id, id,", "name, source_ad, cpm, spend, recommendations" ) } - + import <- GET( glued("{META_GRAPH_URL}/{api_version}/{which}/ads"), query = list( @@ -744,8 +755,10 @@ fb_ads <- function(token, ), encode = "json" ) - - if (!process) return(import) + + if (!process) { + return(import) + } ret <- fb_process(import, ...) return(ret) } diff --git a/R/frequencies.R b/R/frequencies.R index 38a339fce..871e55a69 100644 --- a/R/frequencies.R +++ b/R/frequencies.R @@ -305,11 +305,9 @@ scale_x_reordered <- function(..., sep = "___") { #' @return Plot when \code{plot=TRUE} and data.frame with grouped frequency results #' when \code{plot=FALSE}. #' @examples -#' \donttest{ #' data(dft) # Titanic dataset #' freqs_df(dft) #' freqs_df(dft, plot = TRUE) -#' } #' @export freqs_df <- function(df, max = 0.9, min = 0.0, novar = TRUE, @@ -327,7 +325,7 @@ freqs_df <- function(df, names <- lapply(df, function(x) length(unique(x))) unique <- as.data.frame(names) colnames(unique) <- names(names) - which <- rownames(t(-sort(unique))) + which <- names(sort(-rank(unique, ties.method = "first"))) # Too much variance no <- names(unique)[unique > nrow(df) * max] diff --git a/R/model_plots.R b/R/model_plots.R index 952da9cc2..2f4721c29 100644 --- a/R/model_plots.R +++ b/R/model_plots.R @@ -165,7 +165,9 @@ mplot_importance <- function(var, save = FALSE, subdir = NA, file_name = "viz_importance.png") { - if (is.null(imp)) return(NULL) + if (is.null(imp)) { + return(NULL) + } if (length(var) != length(imp)) { message("The variables and importance values vectors should be the same length.") stop(message(paste("Currently, there are", length(var), "variables and", length(imp), "importance values!"))) diff --git a/R/other_functions.R b/R/other_functions.R index 67316f8e7..95f32debb 100644 --- a/R/other_functions.R +++ b/R/other_functions.R @@ -981,7 +981,7 @@ what_size <- function(x, units = "Mb", ...) { #' markdown2df(txt) #' @export markdown2df <- function(text) { - df <- removenacols(read.table(text = text, sep = "|", header = TRUE, strip.white = TRUE, quote="\"")) + 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, ] diff --git a/R/stocks.R b/R/stocks.R index 94f6392f1..2f4d4298c 100644 --- a/R/stocks.R +++ b/R/stocks.R @@ -113,7 +113,8 @@ stocks_quote <- function(symbols) { "longName,regularMarketPrice,regularMarketChange,regularMarketTime&formatted=false&symbols=" ) for (i in seq_along(symbols)) { - z <- fromJSON(paste(qRoot, paste(symbols[i], collapse = ","), sep = "")) + z <- try(fromJSON(paste(qRoot, paste(symbols[i], collapse = ","), sep = ""))) + if ("try-error" %in% class(z)) return(invisible(ret)) if (length(z$quoteResponse$result) > 0) { cols <- c( "symbol", "quoteType", "regularMarketTime", diff --git a/man/freqs_df.Rd b/man/freqs_df.Rd index 12a176160..9e47b9b2b 100644 --- a/man/freqs_df.Rd +++ b/man/freqs_df.Rd @@ -47,12 +47,10 @@ This function lets the user analize data by visualizing the frequency of each value of each column from a whole data frame. } \examples{ -\donttest{ data(dft) # Titanic dataset freqs_df(dft) freqs_df(dft, plot = TRUE) } -} \seealso{ Other Frequency: \code{\link{freqs_list}()}, diff --git a/man/gpt_ask.Rd b/man/gpt_ask.Rd index c5c59455a..9cfb06c61 100644 --- a/man/gpt_ask.Rd +++ b/man/gpt_ask.Rd @@ -85,28 +85,32 @@ gpt_classify(1:10, c("odd", "even")) # Add all tags that apply to each element based on tags: gpt_tag( c("I love chocolate", "I hate chocolate", "I like Coke"), - c("food", "positive", "negative", "beverage")) + c("food", "positive", "negative", "beverage") +) # Extract specific information: gpt_extract( c("My mail is 123@test.com", "30 Main Street, Brooklyn, NY, USA", "+82 2-312-3456", "$1.5M"), - c("email", "full state name", "country of phone number", "amount as number")) + c("email", "full state name", "country of phone number", "amount as number") +) # Format values gpt_format( c("March 27th, 2021", "12-25-2023 3:45PM", "01.01.2000", "29 Feb 92"), - format = "ISO Date getting rid of timestamps") - + format = "ISO Date getting rid of timestamps" +) + # Convert units gpt_convert(c("50C", "300K"), "Fahrenheit") - + # Create a table with data gpt_table("5 random people's address in South America, email, phone, age between 18-30") # Translate text to any language gpt_translate( rep("I love you with all my heart", 5), - language = c("spanish", "chinese", "japanese", "russian", "german")) + language = c("spanish", "chinese", "japanese", "russian", "german") +) # Now let's read the historical prompts and replies from current session gpt_history()