From 68137fb38d077d6a70518080daf67795765e8dfb Mon Sep 17 00:00:00 2001 From: asegun-cod Date: Mon, 13 Nov 2023 15:49:48 +0000 Subject: [PATCH 01/23] update readme --- R/app_server.R | 18 +++++++++--------- R/golem_utils_server.R | 2 +- README.md | 8 ++++---- tests/testthat/_snaps/app_ui.md | 2 +- 4 files changed, 15 insertions(+), 15 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index e8b54507..9a58686e 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -12,15 +12,6 @@ app_server <- function(input, output, session) { Sys.setenv("R_CONFIG_ACTIVE" = set_trust_config(session$groups)) } cat("Trust name:", get_golem_config("trust_name"), " \n") - - # determine if user has admin right - if to show the data-management tab - if (!isTRUE(getOption('golem.app.prod'))) { - admin_user <- TRUE # set to true in development env - } else{ - # get from session data of Connect environment - in production env - admin_user <- is_admin_user(session$groups) - } - cat("Admin right:", admin_user, " \n") # Create DB connection pool pool <- get_pool() @@ -34,6 +25,15 @@ app_server <- function(input, output, session) { # get the current user user <- if (is.null(session$user)) "demo user" else session$user + + # determine if user has admin right - if to show the data-management tab + if (!isTRUE(getOption('golem.app.prod'))) { + admin_user <- TRUE # set to true in development env + } else{ + # get from session data of Connect environment - in production env + admin_user <- is_admin_user(session$groups) + } + cat("Admin right:", admin_user, " \n") # find out if there is data in the table data_exists <- db_data %>% diff --git a/R/golem_utils_server.R b/R/golem_utils_server.R index 6ebb5208..8472c182 100644 --- a/R/golem_utils_server.R +++ b/R/golem_utils_server.R @@ -79,7 +79,7 @@ header_links <- function() { ), tags$li( a( - onclick = "onclick =window.open('mailto:chris.beeley1@nhs.net?cc=oluwasegun.apejoye2@nottshc.nhs.uk')", + onclick = "onclick =window.open('mailto:chris.beeley1@nhs.net')", href = NULL, icon("envelope", prefer_type = "solid"), title = "Contact Project Team", diff --git a/README.md b/README.md index bc9ece11..111b1976 100644 --- a/README.md +++ b/README.md @@ -56,13 +56,13 @@ experiencesdashboard | Name | Link | Description | | ---- | ---- | ----------- | | .github/workflows | [[Link](/.github/workflows)] | Github Action workflow files that automate the `R CMD check` and `deployment` process | -| app.R | [[Link](.)] | A `golem` file that contains the function to deploy the app on Posit platforms | +| app.R | [[Link](.)] | A `golem` file that contains the set of functions needed to deploy the app on any platform such as Posit Connect, etc | | DESCRIPTION | [[Link](.)] | A standard `R` package file containing series of metadata about the package including the package dependencies required to run the app. It forms a key part of the dependency management | | NAMESPACE | [[Link](.)] | A standard `R` package file that contains functions to import and from which package and what functions to export | | R/ | [[Link](R/)] | Standard `R` package folder holding all the package functions. It contains the functions required for the app core functionality such as the Server function `app_server.R`, UI function `app_ui.R`, all the modules `mod_*` files and utilitarian/business logic functions `fct_*.R` or `*utils*.R`/ or other `.R` files. It also contains an important file, `run_app.R`, which in turn contains the [`run_app()`](R/run_app.R) function that is called to launch the app | | dev/ | [[Link](dev/)] | This folder contains utilitarian files used during development phase only and not core functionalities of the app. | | inst/ | [[Link](inst)] | It contains the [`golem-config.yml`](inst/golem-config.yml) file and [`inst/app/www/`](inst/app/www/) files. [`inst/app/www/`](inst/app/www/) contains all files that are made available at application run time, while [`golem-config.yml`](inst/golem-config.yml) is an important yaml file to configure the app. | -| test/ | [[Link](test/)] | This folder contains the unit test infrastructure codes | +| test/ | [[Link](tests/)] | This folder contains the codes for the unit test infrastructure | | data/ | [[Link](data/)] | Contains `.rda` data used by the app during runtime | | data-raw/ | [[Link](data-raw/)] | It contains scripts to prepare dataset in the `data` folder. We also store some data in there that are not required at runtime | | man/ | [[Link](man/)] | This is a standard `R` package folder containing automatically filled files for function documentations | @@ -123,7 +123,7 @@ Your data type must follow the schema in [Database table schema](data-raw/phase_ i. You can safely ignore these columns without any modification: `'extra_variable_1', 'extra_variable_2', 'extra_variable_3'` ii. To ignore the following columns ` - 'location_2', 'location_3', 'sex', 'gender', 'age', 'ethnicity', 'sexuality', 'disability', 'religion',`, You need to set your configuration file accordingly. A sample configuation is this: + 'location_2', 'location_3', 'sex', 'gender', 'age', 'ethnicity', 'sexuality', 'disability', 'religion'`, You need to set your configuration file accordingly. A sample configuation is this: ``` my_config: @@ -133,7 +133,7 @@ Your data type must follow the schema in [Database table schema](data-raw/phase_ question_1: fft location_1: Division ``` -Please [get in touch](mailto:PHUdatascience@nottshc.nhs.uk) if you need additional help implementing this solution locally. +Please [get in touch](mailto:chris.beeley@gmail.com) if you need additional help implementing this solution locally. ## Code of Conduct diff --git a/tests/testthat/_snaps/app_ui.md b/tests/testthat/_snaps/app_ui.md index 28efa17d..053d1058 100644 --- a/tests/testthat/_snaps/app_ui.md +++ b/tests/testthat/_snaps/app_ui.md @@ -24,7 +24,7 @@
  • - +
    • From af59857c6fdeb70d79b448ba864c694f5df5c22c Mon Sep 17 00:00:00 2001 From: asegun-cod Date: Mon, 13 Nov 2023 23:42:27 +0000 Subject: [PATCH 02/23] update user prompt --- R/mod_data_management.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/mod_data_management.R b/R/mod_data_management.R index af4d8c46..2689e8b5 100644 --- a/R/mod_data_management.R +++ b/R/mod_data_management.R @@ -13,10 +13,10 @@ mod_data_management_ui <- function(id) { fluidPage( tags$br(), fluidRow( - p(" - This page is for users who wants to upload new data or amend the - existing data in the dashboard - "), + strong(" + This page is only for users who wants to upload new data or amend the + existing data in the dashboard. + ") |> p(), column( width = 1, actionButton(ns("upload_new_data"), "Upload new data", From 48c940ca4e79f1b05b2938b80990fcf5926e8183 Mon Sep 17 00:00:00 2001 From: asegun-cod Date: Tue, 14 Nov 2023 14:59:25 +0000 Subject: [PATCH 03/23] write prediction connect pin board temporarily --- API_url_tracker.Rmd | 6 ++- Local_API_url_tracker.qmd | 81 +++++++++++++++++++++++++++++++++++++++ R/app_server.R | 6 ++- R/fct_api_pred.R | 19 ++++++++- 4 files changed, 107 insertions(+), 5 deletions(-) create mode 100644 Local_API_url_tracker.qmd diff --git a/API_url_tracker.Rmd b/API_url_tracker.Rmd index 458f3f1c..4e3880f5 100644 --- a/API_url_tracker.Rmd +++ b/API_url_tracker.Rmd @@ -25,6 +25,9 @@ conn <- odbc::dbConnect( Port = 3306 ) +# connect to a pin board to save the prediction incase database writing fails +board <- pins::board_connect() + pending_jobs <- dplyr::tbl( conn, dbplyr::in_schema( @@ -44,7 +47,8 @@ Sys.sleep(2) # Sleep for 5 seconds to allow any pending tasks to start in the AP if (nrow(pending_jobs) > 0) { pending_jobs |> apply(1, track_api_job, - conn = conn, write_db = TRUE + conn = conn, write_db = TRUE, + board = board ) } else { paste("No pending job") diff --git a/Local_API_url_tracker.qmd b/Local_API_url_tracker.qmd new file mode 100644 index 00000000..c3b16c9b --- /dev/null +++ b/Local_API_url_tracker.qmd @@ -0,0 +1,81 @@ +--- +title: "Write the predictions for all completed jobs to Database" +author: "Experiences dashboard" +date: 2023/11/14 +format: + html: + embed-resources: true +--- + +```{r} +#| include: false + +library(DBI) +library(odbc) +library(dplyr) +library(pins) +``` + + + +## Intro + +Use this Script to manually write the prediction for all completed jobs that couldn't be auto written to the database by the scheduled API_url_tracker on Connect + +```{r} +#| message: false + +conn <- odbc::dbConnect( + drv = odbc::odbc(), + driver = Sys.getenv("odbc_driver"), + server = Sys.getenv("HOST_NAME"), + UID = Sys.getenv("DB_USER"), + PWD = Sys.getenv("MYSQL_PASSWORD"), + database = "TEXT_MINING", + Port = 3306, + encoding = "UTF-8" +) + +# connect to strategy unit Connect server +board <- pins::board_connect() + +pending_jobs <- dplyr::tbl( + conn, + dbplyr::in_schema( + "TEXT_MINING", + "api_jobs" + ) +) |> + dplyr::filter(status == "completed") |> + dplyr::collect() +``` + + +```{r} +if (nrow(pending_jobs) > 0) { + + for (i in 1:nrow(pending_jobs)) { + + job <- pending_jobs[i,] + trust_id <- as.character(job["trust_id"]) + developer_username <- "oluwasegun.apejoye" + board_name = sprintf("%s/%s_prediction", developer_username, trust_id) + prediction <- pins::pin_read(board, board_name) + + dplyr::rows_update( + dplyr::tbl(conn, trust_id), + prediction, + by = "comment_id", + unmatched = "ignore", + copy = TRUE, + in_place = TRUE + ) + + # update the job status as uploaded (successfully write prediction to main table) + DBI::dbExecute(conn, paste("UPDATE api_jobs SET status='uploaded' WHERE job_id =", job_id)) + + # delete the prediction from the board + pins::pin_delete(board, board_name) + } +} +``` \ No newline at end of file diff --git a/R/app_server.R b/R/app_server.R index e8b54507..c21ee3e0 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -283,10 +283,12 @@ app_server <- function(input, output, session) { dplyr::arrange(date) } - # Transform the sentiment column + # Transform the sentiment and convert the category and super_category + # column from raw (see `transform_prediction_for_database()`) return_data <- return_data %>% transform_sentiment() %>% - drop_na_by_col(c('category', 'super_category', 'sentiment')) + drop_na_by_col(c('category', 'super_category', 'sentiment')) %>% + dplyr::mutate(across(c(category, super_category), ~ purrr::map(.x, rawToChar))) # also return a dataset with unique individuals unique_data <- return_data %>% diff --git a/R/fct_api_pred.R b/R/fct_api_pred.R index 7922b557..037bc97b 100644 --- a/R/fct_api_pred.R +++ b/R/fct_api_pred.R @@ -100,13 +100,16 @@ transform_prediction_for_database <- function(prediction) { #' @param job an instance of the api job table #' @param conn database connection #' @param write_db logical should the prediction data be written to the database or returned as a dataframe? -#' +#' @param board a pin board to temporary write the prediction incase database writing fails +#' #' @return dataframe (if `write_db` is FALSE) #' @export -track_api_job <- function(job, conn, write_db = TRUE) { +track_api_job <- function(job, conn, write_db = TRUE, board = NULL) { job_id <- as.character(job["job_id"]) url <- as.character(job["url"]) trust_id <- as.character(job["trust_id"]) + board_name <- paste0(trust_id, "_prediction") + write_to_board <- !is.null(board) cat("Checking Job", job_id, "\n") prediction <- NULL @@ -136,6 +139,14 @@ track_api_job <- function(job, conn, write_db = TRUE) { prediction <- prediction |> transform_prediction_for_database() + + # write the prediction to a board in case it fails to write to database. + # it will be deleted if database writing is successful but if not + # it can then be picked up later for local database writing + if (write_to_board) { + pins::pin_write(board, x = prediction, name = board_name, + type = "rds", versioned = FALSE) + } # update the main table cat("Updating database with prediction \n") @@ -153,6 +164,10 @@ track_api_job <- function(job, conn, write_db = TRUE) { DBI::dbExecute(conn, paste("UPDATE api_jobs SET status='uploaded' WHERE job_id =", job_id)) cat("Job", job_id, "prediction has been successfully written to database \n") + + # delete the trust's prediction from the board if successfully written to database + if (write_to_board) pins::pin_delete(board, board_name) + } else if (is.character(prediction)) { cat("Job", job_id, "is still busy \n") } else { From 3e0814ee97db00519f3f90cab2b411c0da23cb6a Mon Sep 17 00:00:00 2001 From: asegun-cod Date: Tue, 14 Nov 2023 15:29:06 +0000 Subject: [PATCH 04/23] update dependencies --- renv.lock | 33 ++++++++++++++++++++++++++++++--- 1 file changed, 30 insertions(+), 3 deletions(-) diff --git a/renv.lock b/renv.lock index 6a2e967a..91ff6e87 100644 --- a/renv.lock +++ b/renv.lock @@ -773,8 +773,8 @@ "RemoteHost": "api.github.com", "RemoteRepo": "experiencesdashboard", "RemoteUsername": "CDU-data-science-team", - "RemoteRef": "HEAD", - "RemoteSha": "cf5573fa7cfb4e022cb0365b8a9f065904edd832", + "RemoteRef": "fix-data-upload", + "RemoteSha": "48c940ca4e79f1b05b2938b80990fcf5926e8183", "Requirements": [ "ComplexUpset", "DBI", @@ -814,7 +814,7 @@ "writexl", "xml2" ], - "Hash": "cd3886b31934799c6f136eefed593c44" + "Hash": "ec69101546cb250acdfedf417ce0fada" }, "fansi": { "Package": "fansi", @@ -1509,6 +1509,33 @@ ], "Hash": "15da5a8412f317beeee6175fbc76f4bb" }, + "pins": { + "Package": "pins", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "digest", + "ellipsis", + "fs", + "generics", + "glue", + "httr", + "jsonlite", + "lifecycle", + "magrittr", + "purrr", + "rappdirs", + "rlang", + "tibble", + "whisker", + "withr", + "yaml" + ], + "Hash": "e240e373ac8805080423d0fb985d87b0" + }, "pkgbuild": { "Package": "pkgbuild", "Version": "1.4.2", From 583c4dce0719ba5189c7a64ce4f7abc25485c5a9 Mon Sep 17 00:00:00 2001 From: asegun-cod Date: Tue, 14 Nov 2023 15:47:02 +0000 Subject: [PATCH 05/23] update file --- API_url_tracker.Rmd | 5 +++- Local_API_url_tracker.qmd | 24 ++++++++++++------- R/fct_api_pred.R | 4 ++-- .../oluwasegun.apejoye/api_url_tracker.dcf | 2 +- 4 files changed, 23 insertions(+), 12 deletions(-) diff --git a/API_url_tracker.Rmd b/API_url_tracker.Rmd index 4e3880f5..1fd28b1d 100644 --- a/API_url_tracker.Rmd +++ b/API_url_tracker.Rmd @@ -25,8 +25,11 @@ conn <- odbc::dbConnect( Port = 3306 ) -# connect to a pin board to save the prediction incase database writing fails +# connect to a pin board to save the prediction in case database writing fails. board <- pins::board_connect() +# OR +# # Set board to Null if database writing is no longer an issue +# board = NULL pending_jobs <- dplyr::tbl( conn, diff --git a/Local_API_url_tracker.qmd b/Local_API_url_tracker.qmd index c3b16c9b..07c488f4 100644 --- a/Local_API_url_tracker.qmd +++ b/Local_API_url_tracker.qmd @@ -20,7 +20,8 @@ library(pins) ## Intro -Use this Script to manually write the prediction for all completed jobs that couldn't be auto written to the database by the scheduled API_url_tracker on Connect +Use this Script to manually write the prediction for all completed jobs that couldn't be auto written to the database by the scheduled API_url_tracker on Connect. +This Script won't be needed if the [issue with the database upload](https://github.com/CDU-data-science-team/experiencesdashboard/issues/200) has been resolved. ```{r} #| message: false @@ -53,15 +54,18 @@ pending_jobs <- dplyr::tbl( ```{r} if (nrow(pending_jobs) > 0) { - for (i in 1:nrow(pending_jobs)) { - job <- pending_jobs[i,] + job <- pending_jobs[i, ] + job_id <- as.character(job["job_id"]) trust_id <- as.character(job["trust_id"]) developer_username <- "oluwasegun.apejoye" - board_name = sprintf("%s/%s_prediction", developer_username, trust_id) - prediction <- pins::pin_read(board, board_name) + board_name <- sprintf("%s/%s_prediction", developer_username, trust_id) + # get the prediction from the board + prediction <- pins::pin_read(board, board_name) + + # update the main table on the database dplyr::rows_update( dplyr::tbl(conn, trust_id), prediction, @@ -70,12 +74,16 @@ if (nrow(pending_jobs) > 0) { copy = TRUE, in_place = TRUE ) - + # update the job status as uploaded (successfully write prediction to main table) DBI::dbExecute(conn, paste("UPDATE api_jobs SET status='uploaded' WHERE job_id =", job_id)) - + # delete the prediction from the board pins::pin_delete(board, board_name) + + cat("Job", job_id, "prediction has been successfully written to database \n") } +} else { + cat("No uncompleted job") } -``` \ No newline at end of file +``` diff --git a/R/fct_api_pred.R b/R/fct_api_pred.R index 037bc97b..218b3a17 100644 --- a/R/fct_api_pred.R +++ b/R/fct_api_pred.R @@ -162,12 +162,12 @@ track_api_job <- function(job, conn, write_db = TRUE, board = NULL) { # update the job status as uploaded (successfully write prediction to main table) DBI::dbExecute(conn, paste("UPDATE api_jobs SET status='uploaded' WHERE job_id =", job_id)) - - cat("Job", job_id, "prediction has been successfully written to database \n") # delete the trust's prediction from the board if successfully written to database if (write_to_board) pins::pin_delete(board, board_name) + cat("Job", job_id, "prediction has been successfully written to database \n") + } else if (is.character(prediction)) { cat("Job", job_id, "is still busy \n") } else { diff --git a/rsconnect/documents/API_url_tracker.Rmd/connect.strategyunitwm.nhs.uk/oluwasegun.apejoye/api_url_tracker.dcf b/rsconnect/documents/API_url_tracker.Rmd/connect.strategyunitwm.nhs.uk/oluwasegun.apejoye/api_url_tracker.dcf index 57da9d0f..9bc8eee8 100644 --- a/rsconnect/documents/API_url_tracker.Rmd/connect.strategyunitwm.nhs.uk/oluwasegun.apejoye/api_url_tracker.dcf +++ b/rsconnect/documents/API_url_tracker.Rmd/connect.strategyunitwm.nhs.uk/oluwasegun.apejoye/api_url_tracker.dcf @@ -5,7 +5,7 @@ account: oluwasegun.apejoye server: connect.strategyunitwm.nhs.uk hostUrl: https://connect.strategyunitwm.nhs.uk/__api__ appId: 149 -bundleId: 930 +bundleId: 1069 url: https://connect.strategyunitwm.nhs.uk/api_tracker/ version: 1 asMultiple: FALSE From a860c9c9fbb45259cb86a6f562e030b7448d41b3 Mon Sep 17 00:00:00 2001 From: asegun-cod Date: Tue, 14 Nov 2023 16:31:14 +0000 Subject: [PATCH 06/23] update deployment file --- .../oluwasegun.apejoye/api_url_tracker.dcf | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rsconnect/documents/API_url_tracker.Rmd/connect.strategyunitwm.nhs.uk/oluwasegun.apejoye/api_url_tracker.dcf b/rsconnect/documents/API_url_tracker.Rmd/connect.strategyunitwm.nhs.uk/oluwasegun.apejoye/api_url_tracker.dcf index 9bc8eee8..2f7ebd49 100644 --- a/rsconnect/documents/API_url_tracker.Rmd/connect.strategyunitwm.nhs.uk/oluwasegun.apejoye/api_url_tracker.dcf +++ b/rsconnect/documents/API_url_tracker.Rmd/connect.strategyunitwm.nhs.uk/oluwasegun.apejoye/api_url_tracker.dcf @@ -5,7 +5,7 @@ account: oluwasegun.apejoye server: connect.strategyunitwm.nhs.uk hostUrl: https://connect.strategyunitwm.nhs.uk/__api__ appId: 149 -bundleId: 1069 +bundleId: 1073 url: https://connect.strategyunitwm.nhs.uk/api_tracker/ version: 1 asMultiple: FALSE From 866a823b91e0810bd413108df1b73a1fb7fff22c Mon Sep 17 00:00:00 2001 From: asegun-cod Date: Tue, 14 Nov 2023 17:08:16 +0000 Subject: [PATCH 07/23] update snapshot --- tests/testthat/_snaps/app_ui.md | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/tests/testthat/_snaps/app_ui.md b/tests/testthat/_snaps/app_ui.md index 28efa17d..69704d05 100644 --- a/tests/testthat/_snaps/app_ui.md +++ b/tests/testthat/_snaps/app_ui.md @@ -95,9 +95,11 @@

    - This page is for users who wants to upload new data or amend the - existing data in the dashboard -

    + + This page is only for users who wants to upload new data or amend the + existing data in the dashboard. + +