Merge pull request #171 from CDU-data-science-team/development

Update documentation
The-Strategy-Unit · Jul 20, 2023 · e0eb5c6 · e0eb5c6
2 parents 718783d + 7d4eeac
commit e0eb5c6
Show file tree

Hide file tree

Showing 26 changed files with 4,061 additions and 92 deletions.
diff --git a/.Rprofile b/.Rprofile
@@ -0,0 +1 @@
+source("renv/activate.R")
diff --git a/.github/workflows/deploy-dev.yaml b/.github/workflows/deploy-dev.yaml
@@ -17,20 +17,9 @@ jobs:
         with:
           use-public-rspm: true
 
-      # install dependency from DESCRIPTION file and some extra dependencies required to lunch to rsconnect
+        # install dependency from renv.lock
       - name: Install dependencies 
-        uses: r-lib/actions/setup-r-dependencies@v2 
-        with:
-          extra-packages: |
-            any::rsconnect
-            any::BH
-            any::cpp11
-            any::prettyunits
-            any::progress 
-            
-      - name: Update MASS
-        shell: Rscript {0}
-        run: pak::pkg_install("[email protected]")
+        uses: r-lib/actions/setup-renv@v2
 
         # file required by Connect for deploying content programmatically.
       - name: Generate manifest.json 

diff --git a/.gitignore b/.gitignore
@@ -8,9 +8,6 @@ inst/doc
 doc
 Meta
 scratch.R
-renv/
-renv*
-.Rprofile
 trial_scripts/
 inst/app/www/*.docx
 secret-data/
diff --git a/R/app_server.R b/R/app_server.R
@@ -279,7 +279,7 @@ app_server <- function(input, output, session) {
 
   # modules----
   ## add information to dashboard header ----
-  mod_header_message_server("messageMenu", db_data, data_exists)
+  mod_header_message_server("messageMenu", pool, db_data, data_exists)
 
   ## combine ALL sub-modules----
   mod_patient_experience_server("patient_experience_ui_1")

diff --git a/R/fct_nhs_shiny_theme.R b/R/fct_nhs_shiny_theme.R
@@ -13,7 +13,7 @@ nhs_shiny_theme <- function() {
     fresh::adminlte_sidebar(
       width = "250px",
       dark_hover_bg = "#41B6E6",
-      dark_bg = "#D8DEE9",
+      dark_bg = "#E8EDEE",
     ),
     fresh::adminlte_global(
       content_bg = "#FFF",

diff --git a/R/mod_data_management.R b/R/mod_data_management.R
@@ -66,7 +66,7 @@ mod_data_management_server <- function(id, db_conn, filter_data, data_exists) {
         "extra_variable_1" = get_golem_config("extra_variable_1"),
         "extra_variable_2" = get_golem_config("extra_variable_2"),
         "extra_variable_3" = get_golem_config("extra_variable_3"),
-        "pt_id" = "Patient ID"
+        "pt_id" = "Responder ID"
       )
     )
 
@@ -233,11 +233,19 @@ mod_data_management_server <- function(id, db_conn, filter_data, data_exists) {
 
       rowselected <- dt_out$data[input$pat_table_rows_selected, "comment_id"] %>% unlist(use.name = FALSE)
 
-      # update database
-      query <- glue::glue_sql("UPDATE {`get_golem_config('trust_name')`} SET hidden = 1 WHERE comment_id IN ({ids*})",
+      # Instead of actually deleting the rows from the database, we Set the hidden flag to 1 (for all the deleted rows). 
+      # Only rows with hidden == 0 are loaded into the dashboard. By doing this the data can be recovered if needed
+      query <- glue::glue_sql(
+        "UPDATE {`get_golem_config('trust_name')`} SET hidden = 1 WHERE comment_id IN ({ids*})",
         ids = rowselected, .con = db_conn
       )
       DBI::dbExecute(db_conn, query)
+
+      # Update the edit date for the deleted rows 
+      query <- glue::glue_sql("UPDATE {`get_golem_config('trust_name')`} SET last_edit_date = {as.POSIXlt(Sys.time(), tz = 'UTC')} WHERE comment_id IN ({ids*})",
+                              ids = rowselected, .con = db_conn
+      )
+      DBI::dbExecute(db_conn, query)
 
       # update UI
       dt_out$data <- dt_out$data %>% dplyr::filter(!comment_id %in% rowselected)
@@ -288,6 +296,9 @@ mod_data_management_server <- function(id, db_conn, filter_data, data_exists) {
     })
 
     # Save (write edited data to source) ####
+    ### The save functionalities doesn't work for now. The handling of the list columns 
+    ### (category and super_category) after users press ENTER is causing the issue 
+    ### This will need revisiting if we need this data editing functionality
 
     observeEvent(input$save_to_db, {
       if (length(dt_out$index) < 1) {
@@ -319,10 +330,17 @@ mod_data_management_server <- function(id, db_conn, filter_data, data_exists) {
           dplyr::rows_update(trust_db, dt_out$data %>% dplyr::filter(comment_id %in% unlist(dt_out$index)),
             by = "comment_id", copy = TRUE, unmatched = "ignore", in_place = TRUE
           )
+
+          # Update the edit date for the edited rows 
+          query2 <- glue::glue_sql(
+            "UPDATE {`get_golem_config('trust_name')`} SET last_edit_date = {as.POSIXlt(Sys.time(), tz = 'UTC')} WHERE comment_id IN ({ids*})",
+            ids = unlist(dt_out$index, use.names = FALSE), .con = db_conn
+          )
+          DBI::dbExecute(db_conn, query2)
 
           showModal(modalDialog(
             title = "Success!",
-            p(paste("Record of", length(dt_out$index), "Patient(s) have been successfully updated.")),
+            p(paste("Record of", length(dt_out$index), "Responder(s) have been successfully updated.")),
             em("Please refresh your browser to visualise the update"),
             easyClose = TRUE
           ))

diff --git a/R/mod_demographics.R b/R/mod_demographics.R
@@ -58,8 +58,9 @@ mod_demographics_server <- function(id, filter_data, data_exists) {
           }
         ),
         hr(),
-        h3("Categories with fewer than 10 individuals are excluded"),
-        p("The below chart shows the average percentage of maximum FFT score for each category."),
+        pre("The below chart shows the average percentage of FFT score for each group in the demographic feature.",
+            "Note: Categories with fewer than 10 individuals are excluded",
+            style = "background-color:#005EB8; color:#fff"),
         fluidRow(
           if (has_demography_1) {
             column(width, plotly::plotlyOutput(ns("compare_demography_1")))

diff --git a/R/mod_documentation_page.R b/R/mod_documentation_page.R
@@ -42,10 +42,6 @@ mod_documentation_page_server <- function(id) {
 
     # table
     output$framework_table <- DT::renderDT({
-      # framework <- readxl::read_excel(here::here(app_sys(), "app/www", "FFT-QDC Framework v5 - 20230428.xlsx"),
-      #                               sheet=2) %>%
-      # dplyr::arrange(Category, `Sub-category`) %>%
-      # dplyr::select(-Examples)
 
       # JaveScript code to collapse the table
       callback_js <- DT::JS(

diff --git a/R/mod_header_message.R b/R/mod_header_message.R
@@ -14,20 +14,22 @@ mod_header_message_ui <- function(id) {
 #' header_message Server Functions
 #'
 #' @noRd
-mod_header_message_server <- function(id, db_data, data_exists) {
+mod_header_message_server <- function(id, pool, db_data, data_exists) {
   moduleServer(id, function(input, output, session) {
     ns <- session$ns
 
     output$dynamic_messageMenu <- renderMenu({
       req(data_exists)
 
       isolate({
-        last_upload_date <- unique(dplyr::pull(db_data, last_upload_date)) %>% na.omit()
-        last_upload_date <- if (length(last_upload_date) < 1) "No edit yet" else strptime(max(last_upload_date), format = "%Y-%m-%d %H:%M")
-
-        last_date_edit <- unique(dplyr::pull(db_data, last_edit_date)) %>% na.omit()
-        last_date_edit <- if (length(last_date_edit) < 1) "No edit yet" else strptime(max(last_date_edit), format = "%Y-%m-%d %H:%M")
-
+        last_upload_date <- DBI::dbGetQuery(pool, paste0("SELECT MAX(last_upload_date) FROM ",
+                                                         get_golem_config('trust_name')))$`MAX(last_upload_date)`
+        last_upload_date <- if (is.na(last_upload_date)) "No edit yet" else paste(strptime(last_upload_date, format = "%Y-%m-%d %H:%M"), "GMT")
+
+        last_date_edit <- DBI::dbGetQuery(pool, paste0("SELECT MAX(last_edit_date) FROM ", 
+                                                       get_golem_config('trust_name')))$`MAX(last_edit_date)`
+        last_date_edit <- if (is.na(last_date_edit)) "No edit yet" else paste(strptime(last_date_edit, format = "%Y-%m-%d %H:%M"), "GMT")
+
         total_users <- db_data %>%
           dplyr::pull(pt_id) %>%
           unique() %>%
@@ -41,17 +43,15 @@ mod_header_message_server <- function(id, db_data, data_exists) {
         messageItem(
           from = strong(total_users, style = "color: #005EB8;"),
           message = p("Total number of responders"),
-          icon = icon("users", style = "color: #005EB8;"),
-          time = Sys.Date()
+          icon = icon("users", style = "color: #005EB8;")
         ),
         messageItem(
-          from = strong(paste(last_upload_date), style = "color: #005EB8;"),
+          from = strong(last_upload_date, style = "color: #005EB8;"),
           message = p("Date data was last uploaded"),
-          icon = icon("file-pen", style = "color: #005EB8;"),
-          time = Sys.Date()
+          icon = icon("file-pen", style = "color: #005EB8;")
         ),
         messageItem(
-          from = strong(paste(last_date_edit), style = "color: #005EB8;"),
+          from = strong(last_date_edit, style = "color: #005EB8;"),
           message = p("Date data was last editted"),
           icon("calendar", style = "color: #005EB8;")
         )

diff --git a/R/mod_overlap_1.R b/R/mod_overlap_1.R
@@ -113,8 +113,7 @@ mod_overlap_1_server <- function(id, filter_data, input_select_super_category, i
     # server codes - the overlapping plot / upset plot ----
     upset_data <- reactive({
       filter_data()$single_labeled_filter_data %>%
-        dplyr::rename(value = category) %>%
-        one_hot_labels(column = "value") # apply one hot encoding to the single label column
+        one_hot_labels(column = "category") # apply one hot encoding to the single label column
     })
 
 

diff --git a/R/mod_report_builder.R b/R/mod_report_builder.R
@@ -118,7 +118,7 @@ mod_report_builder_server <- function(id, filter_data,
             params <- list(
               dates = dates,
               inputs = all_inputs(),
-              data = filter_data()$filter_data,
+              data = filter_data()$unique_data,
               single_label_data = filter_data()$single_labeled_filter_data,
               options = input$report_components,
               comment_1 = get_golem_config("comment_1"),

diff --git a/R/tidy_upload.R b/R/tidy_upload.R
@@ -188,6 +188,9 @@ upload_data <- function(data, conn, trust_id, write_db = TRUE) {
         )
       ) |>
       dplyr::select(comment_id, comment_text, question_type)
+  } else{
+    tidy_data <- tidy_data %>% 
+      dplyr::filter(question_type == api_question_code(get_golem_config("comment_1")))
   }
 
   cat("Making predictions for ", nrow(db_tidy), "comments from pxtextming API \n")

diff --git a/README.md b/README.md
@@ -9,33 +9,138 @@
 experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental)
 <!-- badges: end -->
 
-## Installation
+## About
 
-The development version is available from GitHub with:
+This read me is based on version [0.7.2](https://github.com/CDU-data-science-team/experiencesdashboard/tree/0.7.2)
+
+The Experience dashboard is the front end tool (Shiny App) for the [Patient Experience Qualitative Data Categorisation project](https://cdu-data-science-team.github.io/PatientExperience-QDC/), funded by NHS England and hosted by Nottinghamshire Healthcare NHS Foundation Trust. It ties a machine learning back-end, the [Pxtextmining](https://cdu-data-science-team.github.io/pxtextmining/reference/API/API/), to the data source via an API and present metrics and graphs to help clinical staffs and managers quickly gain insight from patient experience data collected via the [NHS England Friends and Family Test](https://www.england.nhs.uk/fft/).
+
+A hosted version can be found [here](https://feedbackmatters.uk/rsconnect/experience_a/). Please note that some of the data has been modified for the purposes of
+demonstration so it should NOT be used for reporting and is not accurate
+in several important ways.
+
+### Folder Stucture
+
+This shiny app is built using [golem](https://engineering-shiny.org/golem.html#golem) and follows the advised [folder structure](https://engineering-shiny.org/golem.html#understanding-golem-app-structure). Because a golem application is an R package, this package incorporates all the benefits that comes with R package development and management process. 
+
+Below is the folder structure and general description of the content of each important folder.
 
 ``` r
-# install.packages("devtools")
-devtools::install_github("CDU-data-science-team/experiencesdashboard")
+fs::dir_tree(recurse = 0)
 ```
 
-## Running
+```
+experiencesdashboard
+├── .github/workflows
+├── LICENSE
+├── LICENSE.md
+├── NEWS.md
+├── README.md
+├── CODE_OF_CONDUCT.md
+├── app.R
+├── DESCRIPTION
+├── NAMESPACE
+├── vignettes/
+├── R/
+├── dev/
+├── inst/
+├── tests/
+├── data/
+├── data-raw/
+├── man/
+└── rsconnect/
+```
+
+------
+
+| 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 |
+| 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 |
+| 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 |
+| rsconnect/ | [[Link](rsconnect/)]  |  Contains posit connect deployment files |
+
+### Built With
+
+- [golem](https://github.com/ThinkR-open/golem)
+- [R](https://www.r-project.org/)
+- [GitHub Actions](https://github.com/features/actions)
+- [pxtextmining API](https://cdu-data-science-team.github.io/pxtextmining/reference/API/API/)
+
+## Using this Solution
+
+The implementation you will follow will depend on your use case and if you have access to the project database (for internal users).
+
+### A. Installation: 
+
+Follow this approach if you have the right access to this project database
 
-Run with:
+#### Install the package
+
+{experiencesdashboard} is not currently on CRAN, so you will have to install it directly from Github.
 
 ``` r
-library(experiencesdashboard)
-run_app()
+# install.packages("devtools")
+devtools::install_github("CDU-data-science-team/experiencesdashboard")
 ```
 
-A hosted version can be found
-[here](https://feedbackmatters.uk/rsconnect/experience_a/).
-Please note the some of the data has been modified for the purposes of
-demonstration so it should NOT be used for reporting and is not accurate
-in several important ways.
+#### Run the app 
+``` r
+library(experiencesdashboard) # load the package
+# usethis::edit_r_environ() # add the environment variables to connect to the database. see `get_pool()`
+Sys.setenv("R_CONFIG_ACTIVE" = "my_config") # set the configuration to use inline with the `golem-config.yml` file
+run_app() # run the app
+```
+
+### B. Local Implementation with your own data
+
+This package uses data from a database to populate the dashboard. The [`get_pool()`](R/fct_app_server-helpers.R) set up the DB connection. To use this package locally and on your own dataset, you will need to do the following:
+
+1. Clone the repo. [cloning-a-repository](https://docs.github.com/en/repositories/creating-and-managing-repositories/cloning-a-repository)
+
+2. Connect your data either  
+    a. _**Via Database Connection**_: Set the environmental variables needed to establish a Database connection (see [`get_pool()`](R/fct_app_server-helpers.R)) 
+    b. _**Via Local file**_: Read in your data into the `db_data` object in the [`app_server.R`](R/app_server.R) by replacing `db_data <- get_db_data(pool, get_golem_config("trust_name")))` with e.g. `db_data <- read.csv(''my_data_path.csv)`. With this you can safely ignore the preceding codes that creates the db connection.
+
+3. Set up your data/app configuration: If you need to use this app locally, then you will need to set up a configuration for your use case in the [`golem-config.yml`](inst/golem-config.yml) ([get help here](https://engineering-shiny.org/golem.html#golem-config))
+
+5. choose your configuration: run `Sys.setenv("R_CONFIG_ACTIVE" = "my_config")` and run the app with `run_app()`. please see sample code in the [`run_dev.R`](dev/run_dev.R)
+
+
+#### Format your data for the app
+
+Your data type must follow the schema in [Database table schema](data-raw\phase_2_schema.csv) before you can load the data into the app in step 2 above. Though not all the columns are required but to ignore any will depend on your configuration in step 3 above. 
+
+  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:
+
+  ```
+  my_config:
+    trust_name: my_config
+    comment_1: Why did you answer this way?
+    comment_2: What could be improved?
+    question_1: fft
+    location_1: Division
+  ```
+Please [get in touch](mailto:[email protected]) if you need additional help implementing this solution locally.
 
 ## Code of Conduct
 
 Please note that the experiencesdashboard project is released with a
 [Contributor Code of
 Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html).
 By contributing to this project, you agree to abide by its terms.
+
+## License
+
+Distributed under a MIT License. _See [LICENSE.md](/LICENSE.md) for more information._
diff --git a/data-raw/phase_2_schema.csv b/data-raw/phase_2_schema.csv
@@ -0,0 +1,25 @@
+"Field","Type","Null","Key","Default","Extra"
+"comment_id","int unsigned","NO","PRI",NA,"auto_increment"
+"date","date","YES","",NA,""
+"pt_id","int","YES","",NA,""
+"location_1","text","NO","",NA,""
+"location_2","text","YES","",NA,""
+"location_3","text","YES","",NA,""
+"comment_type","text","YES","",NA,""
+"comment_txt","text","YES","",NA,""
+"fft","double","YES","",NA,""
+"sex","text","YES","",NA,""
+"gender","text","YES","",NA,""
+"age","text","YES","",NA,""
+"ethnicity","text","YES","",NA,""
+"sexuality","text","YES","",NA,""
+"disability","text","YES","",NA,""
+"religion","text","YES","",NA,""
+"category","text","YES","",NA,""
+"super_category","text","YES","",NA,""
+"last_upload_date","datetime","NO","",NA,""
+"last_edit_date","datetime","YES","",NA,""
+"extra_variable_1","text","YES","",NA,""
+"extra_variable_2","text","YES","",NA,""
+"extra_variable_3","text","YES","",NA,""
+"hidden","int","NO","","0",""