diff --git a/R/llm-classify.R b/R/llm-classify.R index a71cea1..c3be452 100644 --- a/R/llm-classify.R +++ b/R/llm-classify.R @@ -18,6 +18,45 @@ #' Applies to vector function only. #' @returns `llm_classify` returns a `data.frame` or `tbl` object. #' `llm_vec_classify` returns a vector that is the same length as `x`. +#' @examples +#' \dontrun{ +#' library(mall) +#' +#' llm_use("ollama", "llama3.1", seed = 100, .silent = TRUE) +#' +#' reviews <- data.frame(review = c( +#' "This has been the best TV I've ever used. Great screen, and sound.", +#' "I regret buying this laptop. It is too slow and the keyboard is too noisy", +#' "Not sure how to feel about my new washing machine. Great color, but hard to figure" +#' )) +#' +#' llm_classify(reviews, review, c("appliance", "computer")) +#' +#' # Use 'pred_name' to customize the new column's name +#' llm_classify( +#' reviews, +#' review, +#' c("appliance", "computer"), +#' pred_name = "prod_type" +#' ) +#' +#' # Pass custom values for each classification +#' llm_classify(reviews, review, c("appliance" ~ 1, "computer" ~ 2)) +#' +#' # For character vectors, instead of a data frame, use this function +#' llm_vec_classify( +#' c("this is important!", "just whenever"), +#' c("urgent", "not urgent") +#' ) +#' +#' #' # For character vectors, instead of a data frame, use this function +#' llm_vec_classify( +#' c("this is important!", "just whenever"), +#' c("urgent", "not urgent"), +#' preview = TRUE +#' ) +#' +#' } #' @export llm_classify <- function(.data, col, diff --git a/R/llm-sentiment.R b/R/llm-sentiment.R index 7491db9..0aaca0e 100644 --- a/R/llm-sentiment.R +++ b/R/llm-sentiment.R @@ -24,6 +24,9 @@ #' #' llm_sentiment(reviews, review) #' +#' # Use 'pred_name' to customize the new column's name +#' llm_sentiment(reviews, review, pred_name = "review_sentiment") +#' #' # Pass custom sentiment options #' llm_sentiment(reviews, review, c("positive", "negative")) #' @@ -32,6 +35,10 @@ #' #' # For character vectors, instead of a data frame, use this function #' llm_vec_sentiment(c("I am happy", "I am sad")) +#' +#' #' # For character vectors, instead of a data frame, use this function +#' llm_vec_sentiment(c("I am happy", "I am sad"), preview = TRUE) +#' #' } #' @export llm_sentiment <- function(.data, diff --git a/_freeze/reference/llm_classify/execute-results/html.json b/_freeze/reference/llm_classify/execute-results/html.json index de3a24a..bbf36fe 100644 --- a/_freeze/reference/llm_classify/execute-results/html.json +++ b/_freeze/reference/llm_classify/execute-results/html.json @@ -1,8 +1,8 @@ { - "hash": "0cd7aa0f5859119d46e18cab84883e84", + "hash": "9989e0fa332b64d7df96afcee5b53cf0", "result": { "engine": "knitr", - "markdown": "---\ntitle: \"Categorize data as one of options given\"\nexecute:\n eval: true\n freeze: true\n---\n\n\n\n\n\n[R/llm-classify.R](https://github.com/edgararuiz/mall/blob/main/R/llm-classify.R)\n\n## llm_classify\n\n## Description\n Use a Large Language Model (LLM) to classify the provided text as one of the options provided via the `labels` argument. \n\n\n## Usage\n```r\n \nllm_classify( \n .data, \n col, \n labels, \n pred_name = \".classify\", \n additional_prompt = \"\" \n) \n \nllm_vec_classify(x, labels, additional_prompt = \"\", preview = FALSE) \n```\n\n## Arguments\n|Arguments|Description|\n|---|---|\n| .data | A `data.frame` or `tbl` object that contains the text to be analyzed |\n| col | The name of the field to analyze, supports `tidy-eval` |\n| labels | A character vector with at least 2 labels to classify the text as |\n| pred_name | A character vector with the name of the new column where the prediction will be placed |\n| additional_prompt | Inserts this text into the prompt sent to the LLM |\n| x | A vector that contains the text to be analyzed |\n| preview | It returns the R call that would have been used to run the prediction. It only returns the first record in `x`. Defaults to `FALSE` Applies to vector function only. |\n\n\n\n## Value\n `llm_classify` returns a `data.frame` or `tbl` object. `llm_vec_classify` returns a vector that is the same length as `x`. \n\n\n\n\n", + "markdown": "---\ntitle: \"Categorize data as one of options given\"\nexecute:\n eval: true\n freeze: true\n---\n\n\n\n\n\n[R/llm-classify.R](https://github.com/edgararuiz/mall/blob/main/R/llm-classify.R)\n\n## llm_classify\n\n## Description\n Use a Large Language Model (LLM) to classify the provided text as one of the options provided via the `labels` argument. \n\n\n## Usage\n```r\n \nllm_classify( \n .data, \n col, \n labels, \n pred_name = \".classify\", \n additional_prompt = \"\" \n) \n \nllm_vec_classify(x, labels, additional_prompt = \"\", preview = FALSE) \n```\n\n## Arguments\n|Arguments|Description|\n|---|---|\n| .data | A `data.frame` or `tbl` object that contains the text to be analyzed |\n| col | The name of the field to analyze, supports `tidy-eval` |\n| labels | A character vector with at least 2 labels to classify the text as |\n| pred_name | A character vector with the name of the new column where the prediction will be placed |\n| additional_prompt | Inserts this text into the prompt sent to the LLM |\n| x | A vector that contains the text to be analyzed |\n| preview | It returns the R call that would have been used to run the prediction. It only returns the first record in `x`. Defaults to `FALSE` Applies to vector function only. |\n\n\n\n## Value\n `llm_classify` returns a `data.frame` or `tbl` object. `llm_vec_classify` returns a vector that is the same length as `x`. \n\n\n## Examples\n\n\n::: {.cell}\n\n```{.r .cell-code}\n \nlibrary(mall) \n \nllm_use(\"ollama\", \"llama3.1\", seed = 100, .silent = TRUE) \n \nreviews <- data.frame(review = c( \n \"This has been the best TV I've ever used. Great screen, and sound.\", \n \"I regret buying this laptop. It is too slow and the keyboard is too noisy\", \n \"Not sure how to feel about my new washing machine. Great color, but hard to figure\" \n)) \n \nllm_classify(reviews, review, c(\"appliance\", \"computer\")) \n#> # A tibble: 3 × 2\n#> review .classify\n#> \n#> 1 This has been the best TV I've ever use… appliance\n#> 2 I regret buying this laptop. It is too … computer \n#> 3 Not sure how to feel about my new washi… appliance\n \n# Use 'pred_name' to customize the new column's name \nllm_classify( \n reviews, \n review, \n c(\"appliance\", \"computer\"), \n pred_name = \"prod_type\" \n ) \n#> # A tibble: 3 × 2\n#> review prod_type\n#> \n#> 1 This has been the best TV I've ever use… appliance\n#> 2 I regret buying this laptop. It is too … computer \n#> 3 Not sure how to feel about my new washi… appliance\n \n# Pass custom values for each classification \nllm_classify(reviews, review, c(\"appliance\" ~ 1, \"computer\" ~ 2)) \n#> # A tibble: 3 × 2\n#> review .classify\n#> \n#> 1 This has been the best TV I've ever use… 1\n#> 2 I regret buying this laptop. It is too … 2\n#> 3 Not sure how to feel about my new washi… 1\n \n# For character vectors, instead of a data frame, use this function \nllm_vec_classify( \n c(\"this is important!\", \"just whenever\"), \n c(\"urgent\", \"not urgent\") \n ) \n#> [1] \"urgent\" \"not urgent\"\n \n#' # For character vectors, instead of a data frame, use this function \nllm_vec_classify( \n c(\"this is important!\", \"just whenever\"), \n c(\"urgent\", \"not urgent\"), \n preview = TRUE \n ) \n#> ollamar::chat(messages = list(list(role = \"user\", content = \"You are a helpful classification engine. Determine if the text refers to one of the following: urgent, not urgent. No capitalization. No explanations. The answer is based on the following text:\\nthis is important!\")), \n#> output = \"text\", model = \"llama3.1\", seed = 100)\n```\n:::\n", "supporting": [], "filters": [ "rmarkdown/pagebreak.lua" diff --git a/_freeze/reference/llm_sentiment/execute-results/html.json b/_freeze/reference/llm_sentiment/execute-results/html.json index 8ab9b76..d80745c 100644 --- a/_freeze/reference/llm_sentiment/execute-results/html.json +++ b/_freeze/reference/llm_sentiment/execute-results/html.json @@ -1,8 +1,8 @@ { - "hash": "e934c7f880a22b53e4d67f4e0568c0f7", + "hash": "1bda1dfe3201dd34f5b5c04c7452c657", "result": { "engine": "knitr", - "markdown": "---\ntitle: \"Sentiment analysis\"\nexecute:\n eval: true\n freeze: true\n---\n\n\n\n\n\n[R/llm-sentiment.R](https://github.com/edgararuiz/mall/blob/main/R/llm-sentiment.R)\n\n## llm_sentiment\n\n## Description\n Use a Large Language Model (LLM) to perform sentiment analysis from the provided text \n\n\n## Usage\n```r\n \nllm_sentiment( \n .data, \n col, \n options = c(\"positive\", \"negative\", \"neutral\"), \n pred_name = \".sentiment\", \n additional_prompt = \"\" \n) \n \nllm_vec_sentiment( \n x, \n options = c(\"positive\", \"negative\", \"neutral\"), \n additional_prompt = \"\", \n preview = FALSE \n) \n```\n\n## Arguments\n|Arguments|Description|\n|---|---|\n| .data | A `data.frame` or `tbl` object that contains the text to be analyzed |\n| col | The name of the field to analyze, supports `tidy-eval` |\n| options | A vector with the options that the LLM should use to assign a sentiment to the text. Defaults to: 'positive', 'negative', 'neutral' |\n| pred_name | A character vector with the name of the new column where the prediction will be placed |\n| additional_prompt | Inserts this text into the prompt sent to the LLM |\n| x | A vector that contains the text to be analyzed |\n| preview | It returns the R call that would have been used to run the prediction. It only returns the first record in `x`. Defaults to `FALSE` Applies to vector function only. |\n\n\n\n## Value\n `llm_sentiment` returns a `data.frame` or `tbl` object. `llm_vec_sentiment` returns a vector that is the same length as `x`. \n\n\n## Examples\n\n\n::: {.cell}\n\n```{.r .cell-code}\nlibrary(mall)\n\nllm_use(\"ollama\", \"llama3.1\", seed = 100, .silent = TRUE)\n\nreviews <- data.frame(review = c(\n \"This has been the best TV I've ever used. Great screen, and sound.\",\n \"I regret buying this laptop. It is too slow and the keyboard is too noisy\",\n \"Not sure how to feel about my new washing machine. Great color, but hard to figure\"\n))\n\nllm_sentiment(reviews, review)\n#> # A tibble: 3 × 2\n#> review .sentiment\n#> \n#> 1 This has been the best TV I've ever use… positive \n#> 2 I regret buying this laptop. It is too … negative \n#> 3 Not sure how to feel about my new washi… neutral\n\n# Pass custom sentiment options\nllm_sentiment(reviews, review, c(\"positive\", \"negative\"))\n#> # A tibble: 3 × 2\n#> review .sentiment\n#> \n#> 1 This has been the best TV I've ever use… positive \n#> 2 I regret buying this laptop. It is too … negative \n#> 3 Not sure how to feel about my new washi… negative\n\n# Specify values to return per sentiment\nllm_sentiment(reviews, review, c(\"positive\" ~ 1, \"negative\" ~ 0))\n#> # A tibble: 3 × 2\n#> review .sentiment\n#> \n#> 1 This has been the best TV I've ever use… 1\n#> 2 I regret buying this laptop. It is too … 0\n#> 3 Not sure how to feel about my new washi… 0\n\n# For character vectors, instead of a data frame, use this function\nllm_vec_sentiment(c(\"I am happy\", \"I am sad\"))\n#> [1] \"positive\" \"negative\"\n```\n:::\n", + "markdown": "---\ntitle: \"Sentiment analysis\"\nexecute:\n eval: true\n freeze: true\n---\n\n\n\n\n\n[R/llm-sentiment.R](https://github.com/edgararuiz/mall/blob/main/R/llm-sentiment.R)\n\n## llm_sentiment\n\n## Description\n Use a Large Language Model (LLM) to perform sentiment analysis from the provided text \n\n\n## Usage\n```r\n \nllm_sentiment( \n .data, \n col, \n options = c(\"positive\", \"negative\", \"neutral\"), \n pred_name = \".sentiment\", \n additional_prompt = \"\" \n) \n \nllm_vec_sentiment( \n x, \n options = c(\"positive\", \"negative\", \"neutral\"), \n additional_prompt = \"\", \n preview = FALSE \n) \n```\n\n## Arguments\n|Arguments|Description|\n|---|---|\n| .data | A `data.frame` or `tbl` object that contains the text to be analyzed |\n| col | The name of the field to analyze, supports `tidy-eval` |\n| options | A vector with the options that the LLM should use to assign a sentiment to the text. Defaults to: 'positive', 'negative', 'neutral' |\n| pred_name | A character vector with the name of the new column where the prediction will be placed |\n| additional_prompt | Inserts this text into the prompt sent to the LLM |\n| x | A vector that contains the text to be analyzed |\n| preview | It returns the R call that would have been used to run the prediction. It only returns the first record in `x`. Defaults to `FALSE` Applies to vector function only. |\n\n\n\n## Value\n `llm_sentiment` returns a `data.frame` or `tbl` object. `llm_vec_sentiment` returns a vector that is the same length as `x`. \n\n\n## Examples\n\n\n::: {.cell}\n\n```{.r .cell-code}\n \nlibrary(mall) \n \nllm_use(\"ollama\", \"llama3.1\", seed = 100, .silent = TRUE) \n \nreviews <- data.frame(review = c( \n \"This has been the best TV I've ever used. Great screen, and sound.\", \n \"I regret buying this laptop. It is too slow and the keyboard is too noisy\", \n \"Not sure how to feel about my new washing machine. Great color, but hard to figure\" \n)) \n \nllm_sentiment(reviews, review) \n#> # A tibble: 3 × 2\n#> review .sentiment\n#> \n#> 1 This has been the best TV I've ever use… positive \n#> 2 I regret buying this laptop. It is too … negative \n#> 3 Not sure how to feel about my new washi… neutral\n \n# Use 'pred_name' to customize the new column's name \nllm_sentiment(reviews, review, pred_name = \"review_sentiment\") \n#> # A tibble: 3 × 2\n#> review review_sentiment\n#> \n#> 1 This has been the best TV I've ever use… positive \n#> 2 I regret buying this laptop. It is too … negative \n#> 3 Not sure how to feel about my new washi… neutral\n \n# Pass custom sentiment options \nllm_sentiment(reviews, review, c(\"positive\", \"negative\")) \n#> # A tibble: 3 × 2\n#> review .sentiment\n#> \n#> 1 This has been the best TV I've ever use… positive \n#> 2 I regret buying this laptop. It is too … negative \n#> 3 Not sure how to feel about my new washi… negative\n \n# Specify values to return per sentiment \nllm_sentiment(reviews, review, c(\"positive\" ~ 1, \"negative\" ~ 0)) \n#> # A tibble: 3 × 2\n#> review .sentiment\n#> \n#> 1 This has been the best TV I've ever use… 1\n#> 2 I regret buying this laptop. It is too … 0\n#> 3 Not sure how to feel about my new washi… 0\n \n# For character vectors, instead of a data frame, use this function \nllm_vec_sentiment(c(\"I am happy\", \"I am sad\")) \n#> [1] \"positive\" \"negative\"\n \n#' # For character vectors, instead of a data frame, use this function \nllm_vec_sentiment(c(\"I am happy\", \"I am sad\"), preview = TRUE) \n#> ollamar::chat(messages = list(list(role = \"user\", content = \"You are a helpful sentiment engine. Return only one of the following answers: positive, negative, neutral. No capitalization. No explanations. The answer is based on the following text:\\nI am happy\")), \n#> output = \"text\", model = \"llama3.1\", seed = 100)\n```\n:::\n", "supporting": [], "filters": [ "rmarkdown/pagebreak.lua" diff --git a/man/llm_classify.Rd b/man/llm_classify.Rd index 294557a..46ce064 100644 --- a/man/llm_classify.Rd +++ b/man/llm_classify.Rd @@ -43,3 +43,43 @@ Applies to vector function only.} Use a Large Language Model (LLM) to classify the provided text as one of the options provided via the \code{labels} argument. } +\examples{ +\dontrun{ +library(mall) + +llm_use("ollama", "llama3.1", seed = 100, .silent = TRUE) + +reviews <- data.frame(review = c( + "This has been the best TV I've ever used. Great screen, and sound.", + "I regret buying this laptop. It is too slow and the keyboard is too noisy", + "Not sure how to feel about my new washing machine. Great color, but hard to figure" +)) + +llm_classify(reviews, review, c("appliance", "computer")) + +# Use 'pred_name' to customize the new column's name +llm_classify( + reviews, + review, + c("appliance", "computer"), + pred_name = "prod_type" + ) + +# Pass custom values for each classification +llm_classify(reviews, review, c("appliance" ~ 1, "computer" ~ 2)) + +# For character vectors, instead of a data frame, use this function +llm_vec_classify( + c("this is important!", "just whenever"), + c("urgent", "not urgent") + ) + +#' # For character vectors, instead of a data frame, use this function +llm_vec_classify( + c("this is important!", "just whenever"), + c("urgent", "not urgent"), + preview = TRUE + ) + +} +} diff --git a/man/llm_sentiment.Rd b/man/llm_sentiment.Rd index ea0418e..1e7054d 100644 --- a/man/llm_sentiment.Rd +++ b/man/llm_sentiment.Rd @@ -62,6 +62,9 @@ reviews <- data.frame(review = c( llm_sentiment(reviews, review) +# Use 'pred_name' to customize the new column's name +llm_sentiment(reviews, review, pred_name = "review_sentiment") + # Pass custom sentiment options llm_sentiment(reviews, review, c("positive", "negative")) @@ -70,5 +73,9 @@ llm_sentiment(reviews, review, c("positive" ~ 1, "negative" ~ 0)) # For character vectors, instead of a data frame, use this function llm_vec_sentiment(c("I am happy", "I am sad")) + +#' # For character vectors, instead of a data frame, use this function +llm_vec_sentiment(c("I am happy", "I am sad"), preview = TRUE) + } } diff --git a/reference/index.qmd b/reference/index.qmd index 92ecfbd..772514f 100644 --- a/reference/index.qmd +++ b/reference/index.qmd @@ -4,11 +4,11 @@ description: Run multiple 'Large Language Model' predictions against a table, or --- Function(s) | Description |---|---| -|[llm_classify() \| llm_vec_classify()](/reference/llm_classify.html)|Categorize data as one of options given| -|[llm_custom() \| llm_vec_custom()](/reference/llm_custom.html)|Send a custom prompt to the LLM| -|[llm_extract() \| llm_vec_extract()](/reference/llm_extract.html)|Extract entities from text| -|[llm_sentiment() \| llm_vec_sentiment()](/reference/llm_sentiment.html)|Sentiment analysis| -|[llm_summarize() \| llm_vec_summarize()](/reference/llm_summarize.html)|Summarize text| -|[llm_translate() \| llm_vec_translate()](/reference/llm_translate.html)|Translates text to a specific language| -|[llm_use()](/reference/llm_use.html)|Specify the model to use| -|[m_backend_prompt() \| m_backend_submit()](/reference/m_backend_submit.html)|Functions to integrate different back-ends| +|[llm_classify() \| llm_vec_classify()](reference/llm_classify.html)|Categorize data as one of options given| +|[llm_custom() \| llm_vec_custom()](reference/llm_custom.html)|Send a custom prompt to the LLM| +|[llm_extract() \| llm_vec_extract()](reference/llm_extract.html)|Extract entities from text| +|[llm_sentiment() \| llm_vec_sentiment()](reference/llm_sentiment.html)|Sentiment analysis| +|[llm_summarize() \| llm_vec_summarize()](reference/llm_summarize.html)|Summarize text| +|[llm_translate() \| llm_vec_translate()](reference/llm_translate.html)|Translates text to a specific language| +|[llm_use()](reference/llm_use.html)|Specify the model to use| +|[m_backend_prompt() \| m_backend_submit()](reference/m_backend_submit.html)|Functions to integrate different back-ends| diff --git a/reference/llm_classify.qmd b/reference/llm_classify.qmd index c87d355..1c4814c 100644 --- a/reference/llm_classify.qmd +++ b/reference/llm_classify.qmd @@ -49,5 +49,46 @@ llm_vec_classify(x, labels, additional_prompt = "", preview = FALSE) `llm_classify` returns a `data.frame` or `tbl` object. `llm_vec_classify` returns a vector that is the same length as `x`. +## Examples +```{r} + +library(mall) + +llm_use("ollama", "llama3.1", seed = 100, .silent = TRUE) + +reviews <- data.frame(review = c( + "This has been the best TV I've ever used. Great screen, and sound.", + "I regret buying this laptop. It is too slow and the keyboard is too noisy", + "Not sure how to feel about my new washing machine. Great color, but hard to figure" +)) + +llm_classify(reviews, review, c("appliance", "computer")) + +# Use 'pred_name' to customize the new column's name +llm_classify( + reviews, + review, + c("appliance", "computer"), + pred_name = "prod_type" + ) + +# Pass custom values for each classification +llm_classify(reviews, review, c("appliance" ~ 1, "computer" ~ 2)) + +# For character vectors, instead of a data frame, use this function +llm_vec_classify( + c("this is important!", "just whenever"), + c("urgent", "not urgent") + ) + +#' # For character vectors, instead of a data frame, use this function +llm_vec_classify( + c("this is important!", "just whenever"), + c("urgent", "not urgent"), + preview = TRUE + ) + + +``` diff --git a/reference/llm_sentiment.qmd b/reference/llm_sentiment.qmd index 4448968..3662d0c 100644 --- a/reference/llm_sentiment.qmd +++ b/reference/llm_sentiment.qmd @@ -56,26 +56,35 @@ llm_vec_sentiment( ## Examples ```{r} -library(mall) - -llm_use("ollama", "llama3.1", seed = 100, .silent = TRUE) - -reviews <- data.frame(review = c( - "This has been the best TV I've ever used. Great screen, and sound.", - "I regret buying this laptop. It is too slow and the keyboard is too noisy", - "Not sure how to feel about my new washing machine. Great color, but hard to figure" -)) - -llm_sentiment(reviews, review) - -# Pass custom sentiment options -llm_sentiment(reviews, review, c("positive", "negative")) - -# Specify values to return per sentiment -llm_sentiment(reviews, review, c("positive" ~ 1, "negative" ~ 0)) - -# For character vectors, instead of a data frame, use this function -llm_vec_sentiment(c("I am happy", "I am sad")) + +library(mall) + +llm_use("ollama", "llama3.1", seed = 100, .silent = TRUE) + +reviews <- data.frame(review = c( + "This has been the best TV I've ever used. Great screen, and sound.", + "I regret buying this laptop. It is too slow and the keyboard is too noisy", + "Not sure how to feel about my new washing machine. Great color, but hard to figure" +)) + +llm_sentiment(reviews, review) + +# Use 'pred_name' to customize the new column's name +llm_sentiment(reviews, review, pred_name = "review_sentiment") + +# Pass custom sentiment options +llm_sentiment(reviews, review, c("positive", "negative")) + +# Specify values to return per sentiment +llm_sentiment(reviews, review, c("positive" ~ 1, "negative" ~ 0)) + +# For character vectors, instead of a data frame, use this function +llm_vec_sentiment(c("I am happy", "I am sad")) + +#' # For character vectors, instead of a data frame, use this function +llm_vec_sentiment(c("I am happy", "I am sad"), preview = TRUE) + + ``` diff --git a/utils/_qmd-reference/pkgdown.R b/utils/_qmd-reference/pkgdown.R deleted file mode 100644 index 5ad1f42..0000000 --- a/utils/_qmd-reference/pkgdown.R +++ /dev/null @@ -1,87 +0,0 @@ -match_env <- function(topics) { - out <- rlang::env(rlang::empty_env(), - "-" = function(x) -x, - "c" = function(...) c(...) - ) - - topic_index <- seq_along(topics$name) - - # Each \alias{} is matched to its position - topics$alias <- lapply(topics$alias, unique) - aliases <- rlang::set_names( - rep(topic_index, lengths(topics$alias)), - unlist(topics$alias) - ) - rlang::env_bind(out, !!!aliases) - - # As is each \name{} - we bind these second so that if \name{x} and \alias{x} - # are in different files, \name{x} wins. This doesn't usually matter, but - # \name{} needs to win so that the default_reference_index() matches the - # correct files - rlang::env_bind(out, !!!rlang::set_names(topic_index, topics$name)) - - # dplyr-like matching functions - - any_alias <- function(f, ..., .internal = FALSE) { - alias_match <- topics$alias %>% - unname() %>% - map(f, ...) %>% - map_lgl(any) - - name_match <- topics$name %>% - map_lgl(f, ...) - - which((alias_match | name_match) & is_public(.internal)) - } - - is_public <- function(internal) { - if (!internal) !topics$internal else rep(TRUE, nrow(topics)) - } - out$starts_with <- function(x, internal = FALSE) { - any_alias(~ grepl(paste0("^", x), .), .internal = internal) - } - out$ends_with <- function(x, internal = FALSE) { - any_alias(~ grepl(paste0(x, "$"), .), .internal = internal) - } - out$matches <- function(x, internal = FALSE) { - any_alias(~ grepl(x, .), .internal = internal) - } - out$contains <- function(x, internal = FALSE) { - any_alias(~ grepl(x, ., fixed = TRUE), .internal = internal) - } - out$has_keyword <- function(x) { - which(map_lgl(topics$keywords, ~ any(. %in% x))) - } - out$has_concept <- function(x, internal = FALSE) { - match <- topics$concepts %>% - map(~ str_trim(.) == x) %>% - map_lgl(any) - - which(match & is_public(internal)) - } - out$lacks_concepts <- function(x, internal = FALSE) { - nomatch <- topics$concepts %>% - map(~ match(str_trim(.), x, nomatch = FALSE)) %>% - map_lgl(~ length(.) == 0L | all(. == 0L)) - - which(nomatch & is_public(internal)) - } - out$lacks_concept <- out$lacks_concepts - out -} - -is_infix <- function(x) { - if (is.null(x)) { - return(FALSE) - } - - x <- as.character(x) - ops <- c( - "+", "-", "*", "^", "/", - "==", ">", "<", "!=", "<=", ">=", - "&", "|", - "[[", "[", "$" - ) - - grepl("^%.*%$", x) || x %in% ops -} diff --git a/utils/_qmd-reference/reference.R b/utils/_qmd-reference/reference.R deleted file mode 100644 index 9323b3e..0000000 --- a/utils/_qmd-reference/reference.R +++ /dev/null @@ -1,32 +0,0 @@ -source("utils/qmd-reference/utils-reference-index.R") -source("utils/qmd-reference/utils-reference-list.R") -source("utils/qmd-reference/utils-reference-pages.R") -source("utils/qmd-reference/utils-context.R") -source("utils/qmd-reference/pkgdown.R") -library(pkgdown) -library(magrittr) -suppressPackageStartupMessages(library(purrr)) -library(fs) -library(cli) - -pkg <- as_pkgdown(".") - -try(dir_create("reference")) - -ref_path <- path("reference", "index", ext = "qmd") -try(file_delete(ref_path)) -writeLines(reference_index(pkg, "reference"), ref_path) -cli_inform(col_green(ref_path)) - -walk( - pkg$topics$file_in, - \(x) { - p <- path_ext_remove(x) - p <- paste0("reference/", p, ".qmd") - qmd <- reference_to_qmd(x, pkg) - try(file_delete(p)) - writeLines(qmd, p) - cli_inform(col_green(p)) - } -) - diff --git a/utils/_qmd-reference/utils-context.R b/utils/_qmd-reference/utils-context.R deleted file mode 100644 index 8b1ea6b..0000000 --- a/utils/_qmd-reference/utils-context.R +++ /dev/null @@ -1,64 +0,0 @@ -ecodown_context <- new.env(parent = emptyenv()) - -ecodown_context_set <- function(id, vals = list()) { - ecodown_context[[id]] <- vals -} - -ecodown_context_get <- function(id) { - if (id == "") { - return(NULL) - } - ecodown_context[[id]] -} - -get_verbosity <- function() { - x <- ecodown_context_get("verbosity") - if (is.null(x)) x <- "verbose" - x[[1]] -} - -set_verbosity <- function(x) { - ecodown_context_set("verbosity", x[[1]]) - invisible() -} - -is_summary <- function() { - get_verbosity() == "summary" -} - -get_clone_header <- function() { - x <- ecodown_context_get("clone_header") - if (is.null(x)) x <- 0 - x[[1]] -} - -clone_header <- function() { - get_clone_header() == 0 -} - -set_clone_header <- function(x = 1) { - ecodown_context_set("clone_header", x) -} - -get_package_header <- function() { - x <- ecodown_context_get("package_header") - if (is.null(x)) x <- 0 - x[[1]] -} - -package_header <- function() { - get_package_header() == 0 -} - -set_package_header <- function(x = 1) { - ecodown_context_set("package_header", x) -} - -set_package_name <- function(x) { - ecodown_context_set("package_name", x) -} - -get_package_name <- function() { - ecodown_context_get("package_name") -} - diff --git a/utils/_qmd-reference/utils-reference-index.R b/utils/_qmd-reference/utils-reference-index.R deleted file mode 100644 index 5ca41e6..0000000 --- a/utils/_qmd-reference/utils-reference-index.R +++ /dev/null @@ -1,99 +0,0 @@ -reference_index <- function(pkg = NULL, quarto_sub_folder = "", version_folder = "", - reference_folder = "", vignettes_folder, output = "qmd", - package_description = NULL) { - if (is.character(pkg)) pkg <- pkgdown::as_pkgdown(pkg) - - ref_list <- reference_to_list_index(pkg) - - dir_out <- path("/", quarto_sub_folder, version_folder, reference_folder) - - ref_convert <- reference_index_convert(ref_list, dir_out) - - res <- purrr::imap(ref_convert, ~ { - if (.y == 1) { - .x - } else { - c(" ", paste("##", .y), " ", .x) - } - }) - - res <- reduce(res, c) - - if (output == "qmd") { - if (is.null(package_description)) package_description <- pkg$desc$get_field("Title") - res <- c( - "---", - paste0("title: ", pkg$package), - paste0("description: ", package_description), - "---", - res - ) - } - - res -} - -reference_index_convert <- function(index_list, dir_out = "") { - out <- map(index_list, ~ map(.x, ~ { - # Manual fixes of special characters in funs variable - - funcs <- .x$funs - if (length(funcs) == 0) funcs <- .x$alias - funcs <- gsub("<", "<", funcs) - funcs <- gsub(">", ">", funcs) - funcs <- paste0(funcs, collapse = " \\| ") - - file_out <- path(dir_out, .x$file_out) - desc <- .x$title - c( - paste0("[", funcs, "](", file_out, ")"), - desc - ) - })) - header <- c("Function(s) | Description", "|---|---|") - map(out, ~ c(header, map_chr(.x, ~ paste0("|", .x[[1]], "|", .x[[2]], "|")))) -} - -reference_to_list_index <- function(pkg) { - if (is.character(pkg)) pkg <- as_pkgdown(pkg) - pkg_ref <- pkg$meta$reference - - pkg_topics <- pkg$topics - topics_env <- match_env(pkg_topics) - - if (is.null(pkg_ref)) { - x <- list(data.frame(contents = pkg_topics$name)) - } else { - x <- pkg_ref - } - - sections_list <- map( - seq_along(x), - ~ { - ref <- x[[.x]] - topic_list <- map( - ref$contents, - ~ { - item_numbers <- NULL - try( - item_numbers <- eval(parse(text = paste0("`", .x, "`")), topics_env), - silent = TRUE - ) - if (is.null(item_numbers)) { - item_numbers <- eval(parse(text = .x), topics_env) - } - item_numbers - } - ) - topic_ids <- as.numeric(list_c(topic_list)) - transpose(pkg_topics[topic_ids, ]) - } - ) - - if (!is.null(pkg_ref)) { - sections_title <- map_chr(pkg_ref, ~ .x$title) - names(sections_list) <- sections_title - } - - sections_list -} diff --git a/utils/website/README.md b/utils/website/README.md new file mode 100644 index 0000000..c74032e --- /dev/null +++ b/utils/website/README.md @@ -0,0 +1,6 @@ +## Build reference, and render site + +```r +source("utils/website/build_reference.R") +quarto::quarto_render(as_job = FALSE) +``` \ No newline at end of file diff --git a/utils/_qmd-reference/reference.qmd b/utils/website/_reference.qmd similarity index 100% rename from utils/_qmd-reference/reference.qmd rename to utils/website/_reference.qmd diff --git a/utils/website/build_reference.R b/utils/website/build_reference.R new file mode 100644 index 0000000..db334ee --- /dev/null +++ b/utils/website/build_reference.R @@ -0,0 +1,33 @@ +source("utils/website/index-page.R") +source("utils/website/list-to-qmd.R") +source("utils/website/rd-to-list.R") +suppressPackageStartupMessages(library(purrr)) +library(fs) +library(cli) + +build_reference_index <- function(pkg = ".", folder = "reference") { + if (is.character(pkg)) pkg <- pkgdown::as_pkgdown(pkg) + try(dir_create(folder)) + ref_path <- path(folder, "index", ext = "qmd") + try(file_delete(ref_path)) + writeLines(reference_index(folder = folder), ref_path) + cli_inform(col_green(ref_path)) +} + +build_reference <- function(pkg = ".", folder = "reference") { + if (is.character(pkg)) pkg <- pkgdown::as_pkgdown(pkg) + walk( + pkg$topics$file_in, + \(x) { + p <- path_ext_remove(x) + p <- paste0(folder, "/", p, ".qmd") + qmd <- reference_to_qmd(x, pkg) + try(file_delete(p)) + writeLines(qmd, p) + cli_inform(col_green(p)) + } + ) +} + +build_reference_index() +build_reference() diff --git a/utils/website/index-page.R b/utils/website/index-page.R new file mode 100644 index 0000000..d683d25 --- /dev/null +++ b/utils/website/index-page.R @@ -0,0 +1,92 @@ +reference_index <- function(pkg = ".", folder = "/reference") { + if (is.character(pkg)) pkg <- pkgdown::as_pkgdown(pkg) + ref_list <- reference_to_list_index(pkg) + dir_out <- path(folder) + ref_convert <- reference_index_convert(ref_list, dir_out) + res <- imap( + ref_convert, + \(.x, .y) { + if (.y == 1) { + .x + } else { + c(" ", paste("##", .y), " ", .x) + } + } + ) + res <- reduce(res, c) + c( + "---", + paste0("title: ", pkg$package), + paste0("description: ", pkg$desc$get_field("Title")), + "---", + res + ) +} + +reference_index_convert <- function(index_list, dir_out = "") { + out <- map(index_list, \(.x) map(.x, reference_links, dir_out)) + header <- c("Function(s) | Description", "|---|---|") + map( + out, + \(.x) { + c( + header, + map_chr(.x, \(.x) paste0("|", .x[[1]], "|", .x[[2]], "|")) + ) + } + ) +} + +reference_links <- function(x, dir_out) { + # Manual fixes of special characters in funs variable + funcs <- x$funs + if (length(funcs) == 0) funcs <- x$alias + funcs <- gsub("<", "<", funcs) + funcs <- gsub(">", ">", funcs) + funcs <- paste0(funcs, collapse = " \\| ") + file_out <- path(dir_out, x$file_out) + desc <- x$title + c( + paste0("[", funcs, "](", file_out, ")"), + desc + ) +} + +reference_to_list_index <- function(pkg) { + if (is.character(pkg)) pkg <- as_pkgdown(pkg) + pkg_ref <- pkg$meta$reference + pkg_topics <- pkg$topics + topics_env <- pkgdown:::match_env(pkg_topics) + if (is.null(pkg_ref)) { + x <- list(data.frame(contents = pkg_topics$name)) + } else { + x <- pkg_ref + } + sections_list <- map( + seq_along(x), + \(.x) { + ref <- x[[.x]] + topic_list <- map( + ref$contents, + ~ { + item_numbers <- NULL + try( + item_numbers <- eval(parse(text = paste0("`", .x, "`")), topics_env), + silent = TRUE + ) + if (is.null(item_numbers)) { + item_numbers <- eval(parse(text = .x), topics_env) + } + item_numbers + } + ) + topic_ids <- as.numeric(list_c(topic_list)) + transpose(pkg_topics[topic_ids, ]) + } + ) + if (!is.null(pkg_ref)) { + sections_title <- map_chr(pkg_ref, \(.x) .x$title) + names(sections_list) <- sections_title + } + sections_list +} diff --git a/utils/_qmd-reference/utils-reference-pages.R b/utils/website/list-to-qmd.R similarity index 86% rename from utils/_qmd-reference/utils-reference-pages.R rename to utils/website/list-to-qmd.R index 688c052..5081855 100644 --- a/utils/_qmd-reference/utils-reference-pages.R +++ b/utils/website/list-to-qmd.R @@ -1,9 +1,10 @@ -reference_to_qmd <- function(file_in, pkg, template = NULL) { +reference_to_qmd <- function(file_in, pkg = ".", template = NULL) { + if (is.character(pkg)) pkg <- pkgdown::as_pkgdown(pkg) parsed <- reference_to_list_page(file_in, pkg) con <- reference_convert(parsed) if (is.null(template)) { - template_path <- "utils/qmd-reference/reference.qmd" + template_path <- "utils/website/_reference.qmd" } else { template_path <- template } @@ -11,12 +12,11 @@ reference_to_qmd <- function(file_in, pkg, template = NULL) { template <- readLines(template_path) - template |> - map(parse_line_tag, con) %>% - discard(is.null) %>% - list_flatten() %>% - list_c() %>% - as.character() + out <- map(template, parse_line_tag, con) + out <- discard(out, is.null) + out <- list_flatten(out) + out <- list_c(out) + as.character(out) } parse_line_tag <- function(line, con) { @@ -31,9 +31,7 @@ parse_line_tag <- function(line, con) { if (grepl(start_tag, line)) { start_half <- strsplit(line, start_tag)[[1]] - parsed <- start_half %>% - strsplit(end_tag) %>% - list_c() + parsed <- list_c(strsplit(start_half, end_tag)) pm <- map(parsed, ~ { yes_title <- substr(.x, 1, 6) == "title." @@ -54,8 +52,8 @@ parse_line_tag <- function(line, con) { no_lines = length(x), tag = tag ) - }) %>% - transpose() + }) + pm <- transpose(pm) if (all(map_lgl(pm$content, is.null))) { tag_content <- NULL @@ -136,10 +134,9 @@ reference_convert <- function(x, output = "qmd") { if (curr_name == "arguments") out <- reference_arguments(curr) if (curr_name == "section") { - out <- curr %>% - map(~ c(paste("##", .x$title), .x$contents)) %>% - list_c() %>% - reduce(function(x, y) c(x, "", y), .init = NULL) + out <- map(curr, ~ c(paste("##", .x$title), .x$contents)) + out <- list_c(out) + out <- reduce(out, function(x, y) c(x, "", y), .init = NULL) } if (is.null(out)) { diff --git a/utils/_qmd-reference/utils-reference-list.R b/utils/website/rd-to-list.R similarity index 77% rename from utils/_qmd-reference/utils-reference-list.R rename to utils/website/rd-to-list.R index 43e8593..b80be5d 100644 --- a/utils/_qmd-reference/utils-reference-list.R +++ b/utils/website/rd-to-list.R @@ -1,54 +1,11 @@ reference_to_list_page <- function(file_in, pkg) { if (is.character(pkg)) pkg <- as_pkgdown(pkg) - # set_package_name(pkg$package) - out <- file_in %>% - tags_get(pkg) %>% - tags_process() - + out <- tags_process(tags_get(file_in, pkg)) out$repo <- pkg$repo$url$home - # set_package_name(NULL) - ln <- find_in_script(out, pkg) - out$alias_line <- ln - out -} - -find_in_script <- function(x, pkg) { - out <- "" - if (is.null(x$source)) { - return(out) - } - script <- path(pkg$src_path, x$source) - - if (file_exists(script)) { - script_lines <- script %>% - readLines() %>% - map_chr(trimws) - - res <- c( - paste0("`", x$alias, "`", " <-"), - paste0(x$alias, " <-"), - paste0("#' @name ", x$alias) - ) %>% - map(~ { - out <- NULL - cr <- .x - scrip_sub <- map_chr(script_lines, ~ substr(.x, 1, nchar(cr))) - find_func <- which(scrip_sub == cr) - if (length(find_func)) out <- find_func[[1]] - out - }) %>% - list_c() %>% - as.numeric() - - if (length(res) > 0) out <- res[[1]] - } - out } tags_get <- function(file_in, pkg) { - if (is.character(pkg)) pkg <- as_pkgdown(pkg) - pkg_topics <- pkg$topics topic_row <- pkg_topics[pkg_topics$file_in == file_in, ] topic <- transpose(topic_row) @@ -56,7 +13,6 @@ tags_get <- function(file_in, pkg) { tag_names <- map_chr(topic_rd, ~ class(.)[[1]]) tag_split <- split(topic_rd, tag_names) tag_split <- tag_split[names(tag_split) != "TEXT"] - imap( tag_split, ~ { @@ -69,7 +25,6 @@ tags_get <- function(file_in, pkg) { tags_process <- function(x) { out <- map(x, ~ tag_convert(.x)) - comment <- NULL comment <- names(out) == "COMMENT" if (length(comment) > 0) { @@ -77,10 +32,8 @@ tags_process <- function(x) { reg_list <- out[!comment] out <- c(comment_list, reg_list) } - new_names <- substr(names(out), 5, nchar(names(out))) names(out) <- new_names - out } @@ -93,7 +46,6 @@ tag_convert <- function(x) { tag_convert_default <- function(x) { x <- x[[1]] rf <- tag_flatten(x) - rf_cr <- NULL cr <- NULL for (i in seq_along(rf)) { @@ -155,26 +107,11 @@ tag_convert.tag_examples <- function(x) { if (all(examples_run == " ")) examples_run <- NULL if (all(examples_dont_run == " ")) examples_dont_run <- NULL list( - code_run = add_library(examples_run), - code_dont_run = add_library(examples_dont_run) + code_run = examples_run, + code_dont_run = examples_dont_run ) } -add_library <- function(x) { - if (is.null(x)) { - return(x) - } - pkg_library <- NULL - pkg_name <- get_package_name() - if (!is.null(pkg_name)) { - pkg_library <- paste0("library(", pkg_name, ")") - if (!any(map_lgl(x, ~ trimws(.x) == pkg_library))) { - x <- c(pkg_library, x) - } - } - x -} - s3_label <- "## S3 method for class '" tag_convert.tag_usage <- function(x) { @@ -279,10 +216,8 @@ tag_single <- function(x, rm_return = TRUE) { } tag_flatten <- function(x) { - x %>% - map(tag_single) %>% - list_c() %>% - c(., new_paragraph_symbol) + x <- list_c(map(x, tag_single)) + c(x, new_paragraph_symbol) } new_paragraph_symbol <- "<<<<<<<<<<<<<<<<<<<<<<<<<" @@ -311,28 +246,20 @@ remove_generic <- function(x) { ## -------------------------- Atomic RD tag functions --------------------------- tag_LIST <- function(x) { - x %>% - map(tag_single) %>% - paste(collapse = "") %>% - paste0("\n") + paste0(paste(map(x, tag_single), collapse = ""), "\n") } tag_describe <- function(x) { - out <- x %>% - list_c() %>% - map(~ .x[[1]]) %>% - map(tag_single) + out <- map(list_c(x), \(.x) .x[[1]]) + out <- map(out, tag_single) out_nulls <- !map_lgl(out, is.null) out <- out[out_nulls] - reduce(out, function(x, y) c(x, new_paragraph_symbol, y)) } tag_dontrun <- function(x) { - x %>% - map(tag_single) %>% - list_c() %>% - c(do_not_run_symbol, .) + out <- list_c(map(x, tag_single)) + c(do_not_run_symbol, out) } tag_sub_section <- function(x) { @@ -342,32 +269,24 @@ tag_sub_section <- function(x) { } else { out <- map(x, tag_single) } - - out %>% - list_c() %>% - map(remove_return) %>% - c(., new_paragraph_symbol) + out <- map(list_c(out), remove_return) + c(out, new_paragraph_symbol) } tag_itemize1 <- function(x) { - x %>% - map(tag_single, FALSE) %>% - list_c() %>% - map(remove_return) %>% - c(., new_paragraph_symbol) + x <- map(x, tag_single, FALSE) + x <- map(list_c(x), remove_return) + c(x, new_paragraph_symbol) } tag_code <- function(x) { - x %>% - map(tag_single) %>% - reduce(paste0) %>% - paste0("`", ., "`") + x <- reduce(map(x, tag_single), paste0) + paste0("`", x, "`") } tag_preformatted <- function(x) { - as.character(x) %>% - reduce(function(x, y) c(x, new_paragraph_symbol, y)) %>% - c("```", new_paragraph_symbol, ., new_paragraph_symbol, "```") + x <- reduce(as.character(x), function(x, y) c(x, new_paragraph_symbol, y)) + c("```", new_paragraph_symbol, x, new_paragraph_symbol, "```") } tag_url <- function(x) {