Skip to content

Commit f352432

Browse files
hlageekhlageek
authored
Updates to memo table and dynamic code frequencies (#174)
* dynamic frequency updates * add user to memo table * add memo reload button * update readme with new install instructions * bump version counter --------- Co-authored-by: hlageek <[email protected]>
1 parent e8f09e9 commit f352432

File tree

8 files changed

+1032
-200
lines changed

8 files changed

+1032
-200
lines changed

‎.gitignore‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,3 +19,5 @@ tests/test.requal
1919
# dev stuff
2020
test-iframe.R
2121
wip.R
22+
23+
/.quarto/

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: requal
22
Title: Shiny Application for Computer-Assisted Qualitative Data Analysis
3-
Version: 1.2.4.9001
3+
Version: 1.2.4.9005
44
Authors@R:
55
c(
66
person(given = "Radim",

‎R/mod_document_code.R‎

Lines changed: 44 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -236,6 +236,7 @@ mod_document_code_server <- function(id, glob) {
236236
loc$codes_menu_observer <- loc$codes_menu_observer + 1 # must run first
237237
loc$text_observer <- loc$text_observer + 1
238238
removeUI("#code_extra_div") # remove code extra div so values can recalculate
239+
loc$selected_code_extra <- NULL # reset code extra div observer
239240
})
240241

241242
## Observe refresh ----
@@ -522,18 +523,47 @@ mod_document_code_server <- function(id, glob) {
522523
})
523524

524525
## Codes extras -----
525-
observeEvent(req(input$selected_code_extra), {
526+
# Observe changes to input$selected_code_extra and update the reactive value
527+
observeEvent(input$selected_code_extra, {
528+
loc$selected_code_extra <- input$selected_code_extra
529+
})
530+
# When selected_code_extra changes generate code extra UI
531+
observeEvent(req(loc$code_extra_sel), {
526532
req(glob$doc_selector)
527533
removeUI("#code_extra_div")
534+
generate_code_extra_LF()
535+
loc$code_extra_sel <- NULL
536+
})
537+
observeEvent(c(loc$selected_code_extra, glob$segments_observer), {
538+
req(loc$selected_code_extra)
539+
loc$segments_count <- dplyr::tbl(glob$pool, "segments") %>%
540+
dplyr::filter(project_id == local(as.integer(glob$active_project))) %>%
541+
dplyr::filter(code_id == local(as.integer(loc$selected_code_extra))) %>%
542+
dplyr::collect() %>%
543+
dplyr::summarise(
544+
document_freq = sum(doc_id == local(as.integer(glob$doc_selector))),
545+
total_freq = dplyr::n()
546+
)
528547
loc$code_extra_sel <- paste0(
529548
"#",
530-
ns(paste0("more-", input$selected_code_extra))
549+
ns(paste0("more-", loc$selected_code_extra))
550+
)
551+
shinyjs::html(
552+
"code_extra_freq",
553+
loc$segments_count$document_freq,
554+
asis = TRUE
555+
)
556+
shinyjs::html(
557+
"code_extra_total_freq",
558+
loc$segments_count$total_freq,
559+
asis = TRUE
531560
)
532-
generate_code_extra_LF()
533561
})
534562
observeEvent(req(input$close_code_extra_div), {
535563
removeUI("#code_extra_div")
536564
loc$backlight_code_id <- NULL
565+
loc$selected_code_extra <- NULL
566+
loc$code_extra_sel <- NULL
537567
})
538568

539569
# Segment removal ----------
@@ -830,22 +860,13 @@ mod_document_code_server <- function(id, glob) {
830860

831861
## generate_code_extra_LF -------------------
832862
generate_code_extra_LF <- function() {
833-
doc_group <- NULL
834-
selected_code_extra <- as.integer(input$selected_code_extra)
835-
active_project <- as.integer(glob$active_project)
836-
active_doc <- as.integer(glob$doc_selector)
863+
selected_code_extra <- as.integer(loc$selected_code_extra)
864+
837865
code_info <- glob$codebook %>%
838866
dplyr::filter(
839867
code_id == selected_code_extra
840868
)
841-
segments_count <- dplyr::tbl(glob$pool, "segments") %>%
842-
dplyr::filter(project_id == active_project) %>%
843-
dplyr::filter(code_id == selected_code_extra) %>%
844-
dplyr::collect() %>%
845-
dplyr::summarise(
846-
document_freq = sum(doc_id == active_doc),
847-
total_freq = dplyr::n()
848-
)
869+
849870
insertUI(
850871
selector = loc$code_extra_sel,
851872
where = "afterEnd",
@@ -865,10 +886,16 @@ mod_document_code_server <- function(id, glob) {
865886
tags$b(code_info$code_name),
866887
br(),
867888
"Document frequency:",
868-
tags$b(segments_count$document_freq),
889+
tags$b(tags$span(
890+
id = "code_extra_freq",
891+
loc$segments_count$document_freq
892+
)),
869893
br(),
870894
"Total frequency:",
871-
tags$b(segments_count$total_freq),
895+
tags$b(tags$span(
896+
id = "code_extra_total_freq",
897+
loc$segments_count$total_freq
898+
)),
872899
br(),
873900
actionButton(
874901
ns("code_extra_backlight"),

‎R/mod_memo.R‎

Lines changed: 62 additions & 92 deletions
Original file line numberDiff line numberDiff line change
@@ -11,25 +11,38 @@ mod_memo_ui <- function(id) {
1111
ns <- NS(id)
1212
fluidRow(
1313
div(
14-
style = "display: flex; align-items: flex-start; margin-left: 30px;",
14+
style = "display: flex; align-items: flex-start; justify-content: space-between; width: 100%;",
1515
div(
16-
style = "min-width: 40vh;",
17-
mod_memo_editor_ui(ns("memo_main_editor"))
16+
style = "display: flex; align-items: flex-start; margin-left: 30px;",
17+
div(
18+
style = "min-width: 40vh;",
19+
mod_memo_editor_ui(ns("memo_main_editor"))
20+
),
21+
div(
22+
style = "display: flex; align-items: center; margin-left: 10px;",
23+
actionButton(
24+
ns("pin"),
25+
"",
26+
title = "Pin memo",
27+
icon = icon("thumbtack"),
28+
class = "pinned"
29+
)
30+
)
1831
),
1932
div(
20-
style = "display: flex; align-items: center; margin-left: 10px;", # Use flexbox for alignment
21-
actionButton(ns("pin"), "", title = "Pin memo", icon = icon("thumbtack"), class = "pinned"),
33+
style = "margin-right: 30px;",
34+
actionButton(
35+
ns("reload_memo_table"),
36+
NULL,
37+
icon = icon("sync")
38+
)
2239
)
2340
),
2441
hr(),
2542
fluidRow(
26-
div(
27-
style = "margin-left: 30px; max-width: 80vh;",
28-
DT::dataTableOutput(ns("memo"))
29-
)
43+
style = "margin-left: 30px;",
44+
div(style = "width: 60vw;", DT::dataTableOutput(ns("memo")))
3045
)
31-
# downloadButton(ns("export_memo"), label = "Export memos") %>%
32-
# tagAppendAttributes(style = "display: inline-block; float: right", class = "scrollable80")
3346
)
3447
}
3548

@@ -39,17 +52,17 @@ mod_memo_ui <- function(id) {
3952
mod_memo_server <- function(id, glob) {
4053
moduleServer(id, function(input, output, session) {
4154
ns <- session$ns
42-
loc <- reactiveValues()
43-
loc$memo_observer <- 0
55+
loc <- reactiveValues(memo_observer = 0)
56+
4457
mod_memo_editor_server("memo_main_editor", glob, type = "free_memo")
58+
4559
observeEvent(glob$active_project, {
4660
loc$memo_observer <- loc$memo_observer + 1
4761
})
48-
## Observe free_memo_edit_click ----
62+
4963
observeEvent(input$text_memo_click, {
50-
req(input$text_memo_click)
51-
req(glob$free_memo_observer > 0)
52-
loc$memo_id <- parse_memo_id(input$text_memo_click) # grab the active memo id for this module
64+
req(input$text_memo_click, glob$free_memo_observer > 0)
65+
loc$memo_id <- parse_memo_id(input$text_memo_click)
5366
golem::invoke_js(
5467
"updateEditorInput",
5568
list(
@@ -63,101 +76,58 @@ mod_memo_server <- function(id, glob) {
6376
)
6477
})
6578

66-
observeEvent(c(loc$memo_observer, glob$memo_segment_observer, glob$free_memo_observer), {
67-
output$memo <- DT::renderDataTable({
68-
if (isTruthy(glob$active_project)) {
79+
observeEvent(
80+
c(
81+
loc$memo_observer,
82+
glob$memo_segment_observer,
83+
glob$free_memo_observer,
84+
input$reload_memo_table
85+
),
86+
{
87+
output$memo <- DT::renderDataTable({
88+
req(glob$active_project)
6989
memo_table <- list_memo_records(glob$pool, glob$active_project)
70-
if (glob$user$data$memo_other_view == 0 && nrow(memo_table) > 0) {
71-
memo_table <- memo_table %>%
72-
dplyr::filter(user_id == glob$user$user_id)
90+
if (glob$user$data$memo_other_view == 0) {
91+
memo_table <- dplyr::filter(
92+
memo_table,
93+
user_id == glob$user$user_id
94+
)
7395
}
7496
req(nrow(memo_table) > 0)
75-
memos_segments_map <- dplyr::tbl(glob$pool, "memos_segments_map") %>%
76-
dplyr::filter(memo_id %in% !!memo_table$memo_id) %>%
77-
dplyr::collect()
78-
segment_df <- dplyr::tbl(glob$pool, "segments") %>%
79-
dplyr::select(segment_id, doc_id, segment_text) %>%
80-
dplyr::filter(.data$segment_id %in% !!memos_segments_map$segment_id) %>%
81-
dplyr::collect()
82-
documents_df <- dplyr::tbl(glob$pool, "documents") %>%
83-
dplyr::select(doc_id, doc_name) %>%
84-
dplyr::filter(.data$doc_id %in% !!segment_df$doc_id) %>%
85-
dplyr::collect()
86-
loc$enriched_memo_table <- memo_table %>%
87-
dplyr::left_join(
88-
memos_segments_map,
89-
by = "memo_id"
90-
) %>%
91-
dplyr::left_join(
92-
segment_df,
93-
by = "segment_id"
94-
) %>%
95-
dplyr::left_join(
96-
documents_df,
97-
by = "doc_id"
98-
) %>%
99-
dplyr::mutate(
100-
memo_title = memo_link(ns("text_memo_click"), memo_id, memo_name),
101-
memo_type = purrr::map2_chr(doc_id, segment_id, memo_segment_link)
102-
) %>%
103-
dplyr::arrange(dplyr::desc(memo_id)) %>%
104-
dplyr::select(memo_id, memo_title, memo_type, doc_name, memo_text, segment_text)
97+
98+
enriched_memo_table <- enrich_memo_table(memo_table, glob$pool, ns)
99+
loc$enriched_memo_table <- enriched_memo_table
105100

106101
DT::datatable(
107-
loc$enriched_memo_table,
102+
enriched_memo_table,
108103
rownames = FALSE,
109-
width = "800px",
110-
colnames = c("ID" = "memo_id", "Title" = "memo_title", "Type" = "memo_type", "Document" = "doc_name"),
104+
width = "100%",
105+
colnames = c(
106+
"ID" = "memo_id",
107+
"Title" = "memo_title",
108+
"Type" = "memo_type",
109+
"Document" = "doc_name",
110+
"Creator" = "user_name",
111+
"Creator ID" = "user_id"
112+
),
111113
filter = "top",
112114
escape = FALSE,
113115
extensions = c("Buttons"),
114116
options = dt_memo_options(),
115117
class = "display",
116118
selection = "none"
117119
)
118-
}
119-
})
120-
})
120+
})
121+
}
122+
)
121123

122-
# pin ----
123124
observeEvent(input$pin, {
124125
req(loc$memo_id)
125-
pin_id <- paste0("pin_id-", loc$memo_id)
126-
pinned_text <- read_memo_by_id(glob$pool, glob$active_project, loc$memo_id) %>%
127-
dplyr::pull(memo_text)
128-
129-
insertUI(
130-
selector = "div.content-wrapper", where = "afterBegin",
131-
div(
132-
id = pin_id, class = "pinned_memo",
133-
div(
134-
id = "pin_header", class = "pin_header", icon("thumbtack"),
135-
div(
136-
class = "unpin",
137-
actionButton(paste0("unpin_", pin_id), "", icon("xmark"), class = "unpin_btn", `data-id` = pin_id, onclick = "Shiny.setInputValue('memo_ui_1-unpin', this.dataset.id, {priority: 'event'})")
138-
),
139-
),
140-
div(class = "inner_pin", pinned_text),
141-
div(id = "resize_handle", class = "resizer")
142-
)
143-
)
144-
golem::invoke_js("makeDraggable", list(id = pin_id))
126+
pin_memo(loc$memo_id, glob$pool, glob$active_project, ns)
145127
})
146128

147-
# unpin -----
148129
observeEvent(input$unpin, {
149130
removeUI(paste0("#", input$unpin))
150131
})
151-
152-
# # Memo export ----
153-
# output$export_memo <- downloadHandler(
154-
# filename = function() {
155-
# "requal_memo_export.csv"
156-
# },
157-
# content = function(file) {
158-
# memos <- export_memos(glob$pool, glob$active_project)
159-
# utils::write.csv(memos, file)
160-
# }
161-
# )
162132
})
163133
}

0 commit comments

Comments
 (0)