Merge branch 'update_trust' into public-view

# Conflicts:
#	R/app_server.R

API_url_tracker.Rmd

@@ -1,6 +1,6 @@
 ---
 title: "API URL tracker"
-author: "Oluwasegun Apejoye"
+author: "Experiences Dashboard"
 date: "2023-09-04"
 output: html_document
 ---
@@ -25,6 +25,12 @@ conn <- odbc::dbConnect(
   Port = 3306
 )
 
+# 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,
   dbplyr::in_schema(
@@ -44,7 +50,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")

DESCRIPTION

@@ -29,12 +29,13 @@ Imports:
     lubridate,
     magrittr,
     memoise,
-    NHSRplotthedots,
     odbc,
     pander,
+    pins,
     plotly,
     pool,
     purrr,
+    reactable,
     rlang,
     rmarkdown,
     shiny,
@@ -44,7 +45,6 @@ Imports:
     stringr,
     tidyr,
     tidyselect,
-    tm,
     writexl,
     xml2
 Suggests: 
@@ -59,8 +59,6 @@ Suggests:
     withr
 VignetteBuilder: 
     knitr
-Remotes: 
-    nhs-r-community/NHSRtheme
 Config/testthat/edition: 3
 Encoding: UTF-8
 Language: en-gb

Local_API_url_tracker.qmd

@@ -0,0 +1,91 @@
+---
+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. 
+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
+
+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, ]
+    job_id <- as.character(job["job_id"])
+    trust_id <- as.character(job["trust_id"])
+    board_path <- as.character(job["pin_path"])
+
+    # get the prediction from the board
+    prediction <- pins::pin_read(board, board_path)
+
+    # update the main table on the database
+    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_path)
+    DBI::dbExecute(
+      conn,
+      sprintf("UPDATE api_jobs SET pin_path ='%s' WHERE job_id = %s", NA, job_id)
+    )
+
+    cat("Job", job_id, "prediction has been successfully written to database \n")
+  }
+} else {
+  cat("No uncompleted job")
+}
+```

R/app_server.R

@@ -29,6 +29,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 %>%
@@ -278,7 +287,7 @@ app_server <- function(input, output, session) {
         dplyr::arrange(date)
     }
 
-    # Transform the sentiment column
+    # Transform the sentiment 
     return_data <- return_data %>% 
       transform_sentiment() %>% 
       drop_na_by_col(c('category', 'super_category', 'sentiment'))

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,15 @@ 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) {
+      board_path <- pins::pin_write(board, x = prediction, name = board_name, 
+                      type = "rds", versioned = FALSE)
+      DBI::dbExecute(conn, sprintf("UPDATE api_jobs SET pin_path ='%s' WHERE job_id = %s", board_path, job_id))
+    }
 
     # update the main table
     cat("Updating database with prediction \n")
@@ -151,8 +163,18 @@ track_api_job <- function(job, conn, write_db = 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 trust's prediction from the board if successfully written to database
+    if (write_to_board) {
+      pins::pin_delete(board, board_path)
+      DBI::dbExecute(
+        conn, 
+        sprintf("UPDATE api_jobs SET pin_path ='%s' WHERE job_id = %s", NA, job_id)
+        )
+    }
+
     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 {

R/golem_utils_server.R

@@ -79,7 +79,7 @@ header_links <- function() {
     ),
     tags$li(
       a(
-        onclick = "onclick =window.open('mailto:[email protected][email protected]')",
+        onclick = "onclick =window.open('mailto:[email protected]')",
         href = NULL,
         icon("envelope", prefer_type = "solid"),
         title = "Contact Project Team",

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-disabled"), "Upload new data",

R/tidy_upload.R

@@ -1,17 +1,19 @@
 # function to do trust specific data cleaning
-tidy_trust_gosh <- function(db_tidy) {
+tidy_trust_nuh <- function(db_tidy) {
   db_tidy %>%
     dplyr::mutate(age = as.integer(age)) %>%
     dplyr::mutate(
       age = dplyr::case_when(
-        age < 12 ~ "0 - 11",
-        age < 18 ~ "12 - 17",
-        age < 26 ~ "18 - 25",
-        age < 40 ~ "26 - 39",
-        age < 65 ~ "40 - 64",
-        age < 80 ~ "65 - 79",
-        age > 79 ~ "80+",
-        TRUE ~ as.character(age)
+        age < 8 ~ "0 - 7",
+        age < 12 ~ "8 - 11",
+        age < 16 ~ "12 - 15",
+        age < 26 ~ "16 - 25",
+        age < 36 ~ "26 - 35",
+        age < 46 ~ "36 - 45",
+        age < 56 ~ "46 - 55",
+        age < 66 ~ "56 - 65",
+        age > 65 ~ "Over 65",
+        TRUE ~ NA_character_
       )
     )
 }
@@ -150,7 +152,7 @@ upload_data <- function(data, conn, trust_id, user, write_db = TRUE) {
     ) 
 
   # do trust specific data cleaning ----
-  if (trust_id == "trust_GOSH") db_tidy <- db_tidy %>% tidy_trust_gosh()
+  if (trust_id == "trust_NUH") db_tidy <- db_tidy %>% tidy_trust_nuh()
   if (trust_id == "trust_NEAS") db_tidy <- db_tidy %>% tidy_trust_neas()
   if (trust_id == "trust_NTH") db_tidy <- db_tidy %>% tidy_trust_nth()
 
@@ -178,10 +180,13 @@ upload_data <- function(data, conn, trust_id, user, write_db = TRUE) {
   } else {
     tidy_data <- tidy_data %>%
       dplyr::filter(question_type == api_question_code(get_golem_config("comment_1")))
+
+    db_tidy <- db_tidy %>%
+      dplyr::filter(comment_type == "comment_1")
   }
 
   ## get prediction url ----
-  cat("Making sentiment and label predictions for", nrow(db_tidy), "comments from pxtextming API \n")
+  cat("Making sentiment and label predictions for", nrow(tidy_data), "comments from pxtextming API \n")
   api_result <- get_api_pred_url(tidy_data, Sys.getenv("API_key"))
 
   ## update api job table ----

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:[email protected]) if you need additional help implementing this solution locally.
+Please [get in touch](mailto:[email protected]) if you need additional help implementing this solution locally.
 
 ## Code of Conduct
 

dev/02_dev.R

@@ -27,7 +27,6 @@ usethis::use_package("readr")
 usethis::use_package("stringr")
 usethis::use_package("forcats")
 usethis::use_package("reactable")
-usethis::use_package("tidytext")
 usethis::use_package("UpSetR")
 usethis::use_package("tibbletime")
 usethis::use_package("shinydashboard")
@@ -43,21 +42,19 @@ usethis::use_package("odbc")
 usethis::use_package("DBI")
 usethis::use_package("dbplyr")
 usethis::use_package("datamods")
-usethis::use_package("experienceAnalysis")
-usethis::use_package("textdata")
 usethis::use_package("here")
 usethis::use_package("shinycssloaders")
 usethis::use_package("xml2")
 usethis::use_package("plotly")
-usethis::use_package("NHSRplotthedots")
 usethis::use_package("fresh")
 usethis::use_package("writexl")
 usethis::use_package("memoise")
 usethis::use_package("data.validator")
 usethis::use_package("pool")
+usethis::use_package("pins")
 
 ## Add one line by package you want to add as dependency - Non-CRAN e.g. GitHub
-usethis::use_dev_package("NHSRtheme")
+# usethis::use_dev_package("")
 
 ## Amend DESCRIPTION with dependencies read from package code parsing
 attachment::att_amend_desc()
@@ -131,6 +128,7 @@ usethis::use_test("general_helpers")
 usethis::use_test("mod_data_management_fct_helper")
 usethis::use_test("app_server")
 usethis::use_test("app_ui")
+usethis::use_test("table_schemas")
 
 # Documentation