generated from posit-conf-2023/workshop-template
-
Notifications
You must be signed in to change notification settings - Fork 12
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
4 changed files
with
135 additions
and
3 deletions.
There are no files selected for viewing
14 changes: 14 additions & 0 deletions
14
_freeze/materials/d1-9002-async/codealong-1/execute-results/html.json
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,14 @@ | ||
{ | ||
"hash": "c12dcd124a82cea6178e9a18ef6d6d65", | ||
"result": { | ||
"markdown": "---\ntitle: Asynchronous Processing of LEGO Model Prediction\nformat:\n html:\n code-line-numbers: false\n execute:\n echo: true\n eval: false\n---\n\n\n## Requirements\n\nThe current version of our Shiny application contains a module for generating predictions of the number of LEGO parts in a set using the number of unique colors and number of unique part categories. The API is executed and processed using the [`{httr2}`](https://httr2.r-lib.org/) package. Here is the function wrapping the API execution:\n\n\n::: {.cell}\n\n```{.r .cell-code}\n#' @importFrom httr2 request req_body_json req_perform resp_body_json\nrun_prediction <- function(df, endpoint_url, back_transform = TRUE, round_result = TRUE) {\n # create request object\n req <- request(endpoint_url)\n\n # perform request\n resp <- req |>\n req_body_json(df) |>\n req_perform()\n\n # extract predictions from response\n pred_values <- resp_body_json(resp)$.pred |> unlist()\n\n # back-transform log10 value of predicted number of parts if requested\n if (back_transform) {\n pred_values <- 10 ^ pred_values\n }\n\n # round result up to nearest integer if requested\n if (round_result) pred_values <- ceiling(pred_values)\n\n # append predictions to supplied data frame\n dplyr::mutate(df, predicted_num_parts = pred_values)\n}\n```\n:::\n\n\nUnfortunately, the prediction API call takes a bit of time to execute due to some **extremely sophisticated processing** 😅. As a result, any interactions within the application will not be processed until the prediction call completes. Our goal is to convert the prediction processing from *synchronous* to *asynchronous* using `{crew}`\n\n## Plan\n\n1. Establish reactive values for tracking the status of the prediction calls\n1. Create a new controller to launch new R processes when new prediction tasks are launched\n1. Modify the existing `observeEvent` to push the prediction task to the controller, ensuring the key objects and required packages are passed on to the controller.\n1. Create a poll that's invalidated every 100 milliseconds to query the status of the submitted tasks in the controller and update the prediction result reactive value when complete.\n\n## Solution \n\nFirst we create the following `reactiveVal` objects to keep track of the prediction state:\n\n\n::: {.cell}\n\n```{.r .cell-code}\npred_status <- reactiveVal(\"No prediction submitted yet.\")\npred_poll <- reactiveVal(FALSE)\n```\n:::\n\n\nNext we set up a new controller:\n\n\n::: {.cell}\n\n```{.r .cell-code}\n# establish async processing with crew\ncontroller <- crew_controller_local(workers = 4, seconds_idle = 10)\ncontroller$start()\n\n# make sure to terminate the controller on stop #NEW\nonStop(function() controller$terminate())\n```\n:::\n\n\nInside the `observeEvent` for the user clicking the prediction button, we update the logic to push the prediction task to the controller:\n\n\n::: {.cell}\n\n```{.r .cell-code}\ncontroller$push(\n command = run_prediction(df),\n data = list(\n run_prediction = run_prediction,\n df = pred_data_rv$data\n ),\n packages = c(\"httr2\", \"dplyr\")\n)\n\npred_poll(TRUE)\n```\n:::\n\n\nLastly, we create a new `observe` block that periodically checks whether the running `{crew}` tasks have completed, ensuring that this is only executed when a prediction has been launched:\n\n\n::: {.cell}\n\n```{.r .cell-code}\nobserve({\n req(pred_poll())\n\n invalidateLater(millis = 100)\n result <- controller$pop()$result\n\n if (!is.null(result)) {\n pred_data_rv$data <- result[[1]]\n print(controller$summary()) \n }\n\n if (isFALSE(controller$nonempty())) {\n pred_status(\"Prediction Complete\")\n pred_poll(controller$nonempty())\n removeNotification(id = \"pred_message\")\n }\n})\n```\n:::\n", | ||
"supporting": [], | ||
"filters": [ | ||
"rmarkdown/pagebreak.lua" | ||
], | ||
"includes": {}, | ||
"engineDependencies": {}, | ||
"preserve": {}, | ||
"postProcess": true | ||
} | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,107 @@ | ||
--- | ||
title: Asynchronous Processing of LEGO Model Prediction | ||
format: | ||
html: | ||
code-line-numbers: false | ||
execute: | ||
echo: true | ||
eval: false | ||
--- | ||
|
||
## Requirements | ||
|
||
The current version of our Shiny application contains a module for generating predictions of the number of LEGO parts in a set using the number of unique colors and number of unique part categories. The API is executed and processed using the [`{httr2}`](https://httr2.r-lib.org/) package. Here is the function wrapping the API execution: | ||
|
||
```{r} | ||
#' @importFrom httr2 request req_body_json req_perform resp_body_json | ||
run_prediction <- function(df, endpoint_url, back_transform = TRUE, round_result = TRUE) { | ||
# create request object | ||
req <- request(endpoint_url) | ||
# perform request | ||
resp <- req |> | ||
req_body_json(df) |> | ||
req_perform() | ||
# extract predictions from response | ||
pred_values <- resp_body_json(resp)$.pred |> unlist() | ||
# back-transform log10 value of predicted number of parts if requested | ||
if (back_transform) { | ||
pred_values <- 10 ^ pred_values | ||
} | ||
# round result up to nearest integer if requested | ||
if (round_result) pred_values <- ceiling(pred_values) | ||
# append predictions to supplied data frame | ||
dplyr::mutate(df, predicted_num_parts = pred_values) | ||
} | ||
``` | ||
|
||
Unfortunately, the prediction API call takes a bit of time to execute due to some **extremely sophisticated processing** 😅. As a result, any interactions within the application will not be processed until the prediction call completes. Our goal is to convert the prediction processing from *synchronous* to *asynchronous* using `{crew}` | ||
|
||
## Plan | ||
|
||
1. Establish reactive values for tracking the status of the prediction calls | ||
1. Create a new controller to launch new R processes when new prediction tasks are launched | ||
1. Modify the existing `observeEvent` to push the prediction task to the controller, ensuring the key objects and required packages are passed on to the controller. | ||
1. Create a poll that's invalidated every 100 milliseconds to query the status of the submitted tasks in the controller and update the prediction result reactive value when complete. | ||
|
||
## Solution | ||
|
||
First we create the following `reactiveVal` objects to keep track of the prediction state: | ||
|
||
```{r} | ||
pred_status <- reactiveVal("No prediction submitted yet.") | ||
pred_poll <- reactiveVal(FALSE) | ||
``` | ||
|
||
Next we set up a new controller: | ||
|
||
```{r} | ||
# establish async processing with crew | ||
controller <- crew_controller_local(workers = 4, seconds_idle = 10) | ||
controller$start() | ||
# make sure to terminate the controller on stop #NEW | ||
onStop(function() controller$terminate()) | ||
``` | ||
|
||
Inside the `observeEvent` for the user clicking the prediction button, we update the logic to push the prediction task to the controller: | ||
|
||
```{r} | ||
controller$push( | ||
command = run_prediction(df), | ||
data = list( | ||
run_prediction = run_prediction, | ||
df = pred_data_rv$data | ||
), | ||
packages = c("httr2", "dplyr") | ||
) | ||
pred_poll(TRUE) | ||
``` | ||
|
||
Lastly, we create a new `observe` block that periodically checks whether the running `{crew}` tasks have completed, ensuring that this is only executed when a prediction has been launched: | ||
|
||
```{r} | ||
observe({ | ||
req(pred_poll()) | ||
invalidateLater(millis = 100) | ||
result <- controller$pop()$result | ||
if (!is.null(result)) { | ||
pred_data_rv$data <- result[[1]] | ||
print(controller$summary()) | ||
} | ||
if (isFALSE(controller$nonempty())) { | ||
pred_status("Prediction Complete") | ||
pred_poll(controller$nonempty()) | ||
removeNotification(id = "pred_message") | ||
} | ||
}) | ||
``` | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters