Merge pull request #166 from RE-QDA/advanced-memos-v1

- refactored backend
- new features
- UI changes
- important bug fixes

See NEWS.md for more details

Author: hlageek

.Rprofile

@@ -1 +1,3 @@
 source("renv/activate.R")
+options(shiny.port = 6090)
+options(tibble.print_max = 100)

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: requal
 Title: Shiny Application for Computer-Assisted Qualitative Data Analysis
-Version: 1.1.5.9001
+Version: 1.2.3
 Authors@R:
     c(
      person(given = "Radim",
@@ -34,7 +34,7 @@ Imports:
     config (>= 0.3.1),
     DBI,
     dbplyr,
-    dplyr,
+    dplyr (>= 1.1.4),
     DT,
     fs,
     ggplot2,

NEWS.md

@@ -2,8 +2,26 @@
 
 - Codebook import
   - code names, descriptions, and colors can be imported via a CSV file
+- Segment memos
+  - memos can be added to any transcript segment
+- UI changes
+  - new tab for memo overview
+  - new subtab for segment memos in annotation tab
+  - selected memos can be pinned to screen
+  - new universal memo editor 
+  - improved linking between memoed and coded segments and source documents
+  - more information on codes accessible from the annotation tab
+  - collapse/expand codes and categories boxes
+- Backend changes
+  - more efficient and straightforward calculation of overlaps
+  - refactored generation of valid html for transcript
+  - more metadata included in displayed transcripts
 - Contextual help
-  - functionality to display contextual help 
+  - functionality to display contextual help
+- Fixed bugs
+  - foreign keys now enforced in SQLite
+  - default document encoding is now processed explicitly
+  - other minor fixes
 
 # requal 1.1.3 Rieppeleon
 

R/app_server.R

@@ -32,7 +32,7 @@ app_server <- function(input, output, session) {
 
   observeEvent(glob$active_project, {
     updateControlbar("control_bar")
-    shinyjs::show(id = "btn-memo")
+    shinyjs::show(id = "btn-free_memo")
     shinyjs::show(selector = "div.tab-content")
     glob$users_observer <- 0
     glob$segments_observer <- 0
@@ -51,7 +51,7 @@ app_server <- function(input, output, session) {
   mod_data_server("data_1", glob)
 
   # attributes ----
-  mod_attributes_server("attributes_1", glob)
+  mod_attributes_server("attributes_ui_1", glob)
 
   # codebook  ----
   # output: glob$codebook
@@ -77,6 +77,8 @@ app_server <- function(input, output, session) {
 
   # memo
   mod_memo_server("memo_ui_1", glob)
+  ## free memo
+  mod_memo_free_server("free_memo_ui_1", glob)
 
   # show admin interface
   observeEvent(glob$user$is_admin, {
@@ -90,10 +92,9 @@ app_server <- function(input, output, session) {
     updateTabsetPanel(session, "tab_menu", input$analyze_link$tab_menu)
     glob$analyze_link <- list(
       doc_id = input$analyze_link$doc_id,
-      segment_start = input$analyze_link$segment_start
+      segment_id = input$analyze_link$segment_id
     )
   })
-
   # Observers for the help system
   observeEvent(input$show_help, {
     item <- input$show_help$item

R/app_ui.R

@@ -22,12 +22,12 @@ app_ui <- function(request, mode = NULL, access = NULL) {
           ), "requal"
         ),
         controlbarIcon = icon("ellipsis-v", id = "launchpad_icon"),
-        dropdownBlock2(
-          id = "btn-memo",
+        dropdownBlock(
+          id = "btn-free_memo",
           badgeStatus = NULL,
           icon = shiny::icon("sticky-note", verify_fa = FALSE),
-          mod_memo_ui("memo_ui_1")
-        ) %>% tagAppendAttributes(class = "memo", style = "display:none;", title = "Free memo"),
+          mod_memo_free_ui("free_memo_ui_1")
+        ) %>% tagAppendAttributes(class = "free_memo", title = "Free memo"),
         tags$li(mod_user_ui("user_ui_1")) %>%
           tagAppendAttributes(class = "dropdown"),
         tags$li(actionLink(

R/db_startup.R

@@ -303,7 +303,8 @@ db_call_df_ordered <- tibble::tibble(
     "segments", 
     "memos", 
     "attributes", 
-    "attribute_values"
+    "attribute_values",
+    "memos_segments_map"
   ))
 
 db_call_df <- dplyr::full_join(
@@ -317,33 +318,6 @@ db_call_df_unordered <- tibble::tibble(
   sql = db_call
 )
 
-# Arrange by priority as required by postgres
-db_call_df_ordered <- tibble::tibble(
-  table = c(
-    "projects", 
-    "requal_version", 
-    "users", 
-    "user_permissions", 
-    "logs",
-    "documents", 
-    "codes", 
-    "categories", 
-    "categories_codes_map", 
-    "cases", 
-    "cases_documents_map", 
-    "segments", 
-    "memos", 
-    "attributes", 
-    "attribute_values"
-  ))
-
-db_call_df <- dplyr::full_join(
-  db_call_df_ordered,
-  db_call_df_unordered,
-  by = "table"
-)
-
-
 
 create_db_schema <- function(pool) {
 

R/mod_agreement.R

@@ -107,7 +107,7 @@ mod_agreement_server <- function(id, glob) {
         segments <- load_all_segments_db(
           pool = glob$pool,
           active_project = glob$active_project
-        ) %>% dplyr::filter(user_id %in% as.numeric(input$repro_coders))
+        ) %>% dplyr::filter(user_id %in% as.numeric(input$repro_coders)) 
 
         if (length(unique(segments$user_id)) > 1) {
           overlap_df <- calculate_code_overlap_by_users(segments) %>%
@@ -133,7 +133,7 @@ mod_agreement_server <- function(id, glob) {
         segments <- load_all_segments_db(
           pool = glob$pool,
           active_project = glob$active_project
-        ) %>% dplyr::filter(user_id %in% as.numeric(input$repro_coders))
+        ) %>% dplyr::filter(user_id %in% as.numeric(input$repro_coders)) 
 
         if (length(unique(segments$user_id)) > 1) {
           segment_summary <- segments %>% 
@@ -167,7 +167,7 @@ mod_agreement_server <- function(id, glob) {
         segments <- load_all_segments_db(
           pool = glob$pool,
           active_project = glob$active_project
-        ) %>% dplyr::filter(user_id %in% as.numeric(input$repro_coders))
+        ) %>% dplyr::filter(user_id %in% as.numeric(input$repro_coders)) 
 
         codes <- load_codes_names(
           active_project = glob$active_project,
@@ -212,7 +212,7 @@ mod_agreement_server <- function(id, glob) {
         segments <- load_all_segments_db(
           pool = glob$pool,
           active_project = glob$active_project
-        ) %>% dplyr::filter(user_id %in% as.numeric(input$repro_coders))
+        ) %>% dplyr::filter(user_id %in% as.numeric(input$repro_coders)) 
 
         codes <- load_codes_names(
           active_project = glob$active_project,
@@ -262,7 +262,7 @@ mod_agreement_server <- function(id, glob) {
         segments <- load_all_segments_db(
           pool = glob$pool,
           active_project = glob$active_project
-        ) %>% dplyr::filter(user_id %in% as.numeric(input$repro_coders))
+        ) %>% dplyr::filter(user_id %in% as.numeric(input$repro_coders)) 
 
         users <- load_users_names(
           pool = glob$pool,

R/mod_agreement_utils_agreement.R

@@ -33,14 +33,15 @@ load_all_segments_db <- function(pool, active_project) {
 
         segments <- dplyr::tbl(pool, "segments") %>%
             dplyr::filter(.data$project_id == as.integer(active_project)) %>%
+            dplyr::filter(!is.na(.data$code_id)) %>% # remove memoed segments
             dplyr::select(user_id, 
                           code_id,
                           doc_id, 
                           segment_id, 
                           segment_start,
                           segment_end) %>%
             dplyr::left_join(., users, by = "user_id", suffix = c(".x", ".y")) %>% 
-            dplyr::collect()
+            dplyr::collect()  
 
         return(segments)
     } else {""}

R/mod_analysis.R

@@ -24,7 +24,7 @@ mod_analysis_ui <- function(id) {
     fluidRow(
       class = "module_content",
         uiOutput(ns("segments")) %>%
-          tagAppendAttributes(class = "scrollable90")
+          tagAppendAttributes(class = "scrollable80")
       )
     # ###########
     #   column(
@@ -200,15 +200,15 @@ mod_rql_button_server(
       if (nrow(loc$segments_df) > 0) {
         loc$segments_taglist <- purrr::pmap(
           list(
-            loc$segments_df$segment_start,
+            loc$segments_df$segment_id,
             loc$segments_df$segment_text,
             loc$segments_df$doc_id,
             loc$segments_df$doc_name,
             loc$segments_df$code_name,
             loc$segments_df$code_color
           ),
           ~ format_segments(
-            segment_start = ..1,
+            segment_id = ..1,
             segment_text = ..2,
             segment_document_id = ..3,
             segment_document_name = ..4,

R/mod_analysis_utils_analysis.R

@@ -50,7 +50,7 @@ load_segments_analysis <- function(pool,
 
 
 
-format_segments <- function(segment_start, segment_text, segment_document_id, segment_document_name, segment_code, segment_color) {
+format_segments <- function(segment_id, segment_text, segment_document_id, segment_document_name, segment_code, segment_color) {
 
 
   tags$div(
@@ -60,8 +60,8 @@ format_segments <- function(segment_start, segment_text, segment_document_id, se
 
 tags$div(
   tags$div(class = "segment_badge",
-       actionLink(paste0("segment_start-", segment_start), label = segment_document_name, 
-       onclick =  paste0("Shiny.setInputValue('analyze_link', {tab_menu: 'Annotate', doc_id: ", segment_document_id,", segment_start: ", segment_start, "}, {priority: 'event'});")
+       actionLink(paste0("segment_id-", segment_id), label = segment_document_name, 
+       onclick =  paste0("Shiny.setInputValue('analyze_link', {tab_menu: 'Annotate', doc_id: ", segment_document_id,", segment_id: ", segment_id, "}, {priority: 'event'});")
       )
        ),