From 2cdd05596088592be15cb29a05090106fe5b973c Mon Sep 17 00:00:00 2001
From: emse-p4a-gwu <john.helveston@gmail.com>
Date: Thu, 26 Sep 2024 21:58:02 -0400
Subject: [PATCH 1/9] working on speed

---
 NEWS.md    |   2 +-
 R/server.R | 148 ++++++++++++++++++++++-------------------------------
 2 files changed, 61 insertions(+), 89 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 36444bbd..84481142 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,7 +2,7 @@
 
 - Modified the `refresh_interval` argument in `sd_get_data()` as defaulting to `NULL`, which means the data will not be reactively fetched, regardless of the context it is used in. The data will only continuously refresh if `sd_get_data()` is called within a reactive context and `refresh_interval > 0`.
 - Modified messaging from `sd_set_password()` to not print out user's password and provide clearer instructions.
-- `sd_show_password()` to show stored password. The user will be prompted to double confirm. If there is no password, the user will be prompted so, along with a message of using `sd_set_password()` to create the password.
+- `sd_show_password()` added to show a stored password. The user will be prompted to double confirm that they want to show it. If there is no password, the user will be prompted so, along with a message of using `sd_set_password()` to create the password.
 
 # surveydown 0.3.0
 
diff --git a/R/server.R b/R/server.R
index 9a9feaba..929d6308 100644
--- a/R/server.R
+++ b/R/server.R
@@ -98,7 +98,22 @@ sd_server <- function(
     )
 
     # Set up show_if conditions
-    if (!is.null(show_if)) { set_show_if_conditions(show_if) }
+    show_if_results <- if (!is.null(show_if)) {
+        set_show_if_conditions(show_if)
+    } else {
+        shiny::reactive(list())
+    }
+    # Create an observer to handle visibility
+    shiny::observe({
+        results <- show_if_results()
+        for (target in names(results)) {
+            if (results[[target]]) {
+                shinyjs::show(target)
+            } else {
+                shinyjs::hide(target)
+            }
+        }
+    })
 
     # Initialize local variables ----
 
@@ -113,6 +128,7 @@ sd_server <- function(
     start_page   <- config$start_page
     admin_page   <- config$admin_page
     question_required <- config$question_required
+    page_id_to_index <- setNames(seq_along(page_ids), page_ids)
 
     # Pre-compute timestamp IDs
     page_ts_ids     <- paste0("time_p_", page_ids)
@@ -133,6 +149,7 @@ sd_server <- function(
 
     # Function to update the data
     update_data <- function() {
+        # Then get the latest data
         data_list <- latest_data()
         if (ignore_mode) {
             if (file.access('.', 2) == 0) {  # Check if current directory is writable
@@ -240,11 +257,22 @@ sd_server <- function(
                 as.character(question_vals[[local_id]])
             })
 
-            # Update data
-            update_data()
+            # Trigger show_if evaluation
+            show_if_results()
+
+            # Update data after a short delay
+            shiny::invalidateLater(100)
         }, ignoreNULL = FALSE, ignoreInit = TRUE)
     })
 
+    # Observer to update the data upon changes in the input
+    observe({
+        for(id in question_ids) {
+            input[[id]]
+        }
+        update_data()
+    })
+
     # Page rendering ----
 
     # Create reactive values for the current page ID
@@ -280,39 +308,39 @@ sd_server <- function(
 
     # Page navigation ----
 
-    # Determine which page is next, then update current_page_id() to it
-    shiny::observe({
-        lapply(pages, function(page) {
-            shiny::observeEvent(input[[page$next_button_id]], {
-
-                # Get current and next pages
-                current_page_id <- page$id
-                next_page_id <- get_default_next_page(page, page_ids)
-
-                # Determine next page based on the current page and skip logic
-                next_page_id <- handle_skip_logic(
-                    input, skip_if, current_page_id, next_page_id
-                )
+    check_required <- function(page) {
+        all(vapply(page$required_questions, function(q) {
+            is_visible <- is_question_visible(q)
+            !is_visible || check_answer(q, input)
+        }, logical(1)))
+    }
 
-                if (!is.null(next_page_id)) {
+    is_question_visible <- function(q) {
+        results <- show_if_results()
+        !q %in% names(results) || results[[q]]
+    }
 
-                    # Check if all required questions are answered
-                    required_answered <- check_required(page, input, show_if)
+    # Determine which page is next, then update current_page_id() to it
+    observe({
+        lapply(pages, function(page) {
+            observeEvent(input[[page$next_button_id]], {
+                shiny::isolate({
+                    current_page_id <- page$id
+                    next_page_id <- get_default_next_page(page, page_ids, page_id_to_index)
+                    next_page_id <- handle_skip_logic(input, skip_if, current_page_id, next_page_id)
 
-                    if (required_answered) {
-                        # Update the current page ID, then update the data
+                    if (!is.null(next_page_id) && check_required(page)) {
                         current_page_id(next_page_id)
-                        # Update timestamp for the next page
                         next_ts_id <- page_ts_ids[which(page_ids == next_page_id)]
                         timestamps[[next_ts_id]] <- get_utc_timestamp()
                         update_data()
-                    } else {
+                    } else if (!is.null(next_page_id)) {
                         shiny::showNotification(
                             "Please answer all required questions before proceeding.",
                             type = "error"
                         )
                     }
-                }
+                })
             })
         })
     })
@@ -416,9 +444,8 @@ sd_show_if <- function(...) {
 set_show_if_conditions <- function(show_if) {
     conditions <- show_if$conditions
 
-    # Check if conditions is empty
     if (length(conditions) == 0) {
-      return()
+        return(shiny::reactive(list()))
     }
 
     # Group conditions by target
@@ -444,23 +471,9 @@ set_show_if_conditions <- function(show_if) {
         })
     })
 
-    # Create a single observer to handle all condition groups
-    shiny::observe({
-        for (target in names(grouped_conditions)) {
-            condition_met <- condition_reactives[[target]]()
-
-            if (condition_met) {
-                shinyjs::runjs(sprintf("
-                    $('#%s').closest('.question-container').show();
-                    $('#%s').show();
-                ", target, target))
-            } else {
-                shinyjs::runjs(sprintf("
-                    $('#%s').closest('.question-container').hide();
-                    $('#%s').hide();
-                ", target, target))
-            }
-        }
+    # Return a reactive that contains all condition results
+    shiny::reactive({
+        lapply(condition_reactives, function(r) r())
     })
 }
 
@@ -550,16 +563,15 @@ format_question_value <- function(val) {
     }
 }
 
-get_default_next_page <- function(page, page_ids) {
-    if (is.null(page$next_page_id)) { return(NULL) }
+get_default_next_page <- function(page, page_ids, page_id_to_index) {
+    if (is.null(page$next_page_id)) return(NULL)
     next_page_id <- page$next_page_id
     if (next_page_id == "") {
-        # No next page specified, so just go to the next one
-        index <- which(page_ids == page$id) + 1
+        index <- page_id_to_index[page$id] + 1
         if (index <= length(page_ids)) {
             return(page_ids[index])
         } else {
-            return(NULL)  # No next page if we're on the last page
+            return(NULL)
         }
     }
     return(next_page_id)
@@ -592,46 +604,6 @@ handle_skip_logic <- function(input, skip_if, current_page_id, next_page_id) {
     return(next_page_id)
 }
 
-check_required <- function(page, input, show_if) {
-    results <- vapply(page$questions, function(q) {
-        if (!q %in% page$required_questions) return(TRUE)
-        is_visible <- is_question_visible(q, show_if, input)
-        if (!is_visible) return(TRUE)
-        return(check_answer(q, input))
-    }, logical(1))
-    return(all(results))
-}
-
-is_question_visible <- function(q, show_if, input) {
-    if (is.null(show_if)) return(TRUE)
-
-    # Get all conditions for this question
-    question_conditions <- get_conditions_for_question(show_if$conditions, q)
-
-    # If there are no conditions, the question is always visible
-    if (length(question_conditions) == 0) return(TRUE)
-
-    # Check if any of the conditions are met
-    is_visible <- any(sapply(question_conditions, function(rule) {
-        tryCatch({
-            evaluate_condition(rule)
-        }, error = function(e) {
-            warning(sprintf(
-                "Error evaluating condition for question '%s': %s",
-                q, conditionMessage(e)
-            ))
-            FALSE
-        })
-    }))
-
-    return(is_visible)
-}
-
-# Helper function to get conditions for a specific question
-get_conditions_for_question <- function(conditions, q) {
-    Filter(function(rule) rule$target == q, conditions)
-}
-
 # Check if a single question is answered
 check_answer <- function(q, input) {
     answer <- input[[q]]

From 631a8114ed7c18f677ab55a1be88891d26c95667 Mon Sep 17 00:00:00 2001
From: emse-p4a-gwu <john.helveston@gmail.com>
Date: Fri, 27 Sep 2024 05:49:49 -0400
Subject: [PATCH 2/9] set up general observer to just observe changes in data

---
 R/server.R | 17 ++++++-----------
 1 file changed, 6 insertions(+), 11 deletions(-)

diff --git a/R/server.R b/R/server.R
index 929d6308..a9e66aec 100644
--- a/R/server.R
+++ b/R/server.R
@@ -148,9 +148,7 @@ sd_server <- function(
     }
 
     # Function to update the data
-    update_data <- function() {
-        # Then get the latest data
-        data_list <- latest_data()
+    update_data <- function(data_list) {
         if (ignore_mode) {
             if (file.access('.', 2) == 0) {  # Check if current directory is writable
                 tryCatch({
@@ -265,12 +263,10 @@ sd_server <- function(
         }, ignoreNULL = FALSE, ignoreInit = TRUE)
     })
 
-    # Observer to update the data upon changes in the input
+    # Observer to update the data upon any change in the data
     observe({
-        for(id in question_ids) {
-            input[[id]]
-        }
-        update_data()
+        data_list <- latest_data()
+        update_data(data_list)
     })
 
     # Page rendering ----
@@ -328,12 +324,10 @@ sd_server <- function(
                     current_page_id <- page$id
                     next_page_id <- get_default_next_page(page, page_ids, page_id_to_index)
                     next_page_id <- handle_skip_logic(input, skip_if, current_page_id, next_page_id)
-
                     if (!is.null(next_page_id) && check_required(page)) {
                         current_page_id(next_page_id)
                         next_ts_id <- page_ts_ids[which(page_ids == next_page_id)]
                         timestamps[[next_ts_id]] <- get_utc_timestamp()
-                        update_data()
                     } else if (!is.null(next_page_id)) {
                         shiny::showNotification(
                             "Please answer all required questions before proceeding.",
@@ -355,7 +349,8 @@ sd_server <- function(
     # Ensure final update on session end
     shiny::onSessionEnded(function() {
         shiny::isolate({
-            update_data()
+            data_list <- latest_data()
+            update_data(data_list)
         })
     })
 

From 6713460e110163cd116673174806914b74cd8c28 Mon Sep 17 00:00:00 2001
From: emse-p4a-gwu <john.helveston@gmail.com>
Date: Sat, 28 Sep 2024 05:10:59 -0400
Subject: [PATCH 3/9] no longer deletes html file when app launches and
 `use_html = FALSE`

---
 NEWS.md    |  1 +
 R/config.R | 21 ++-------------------
 R/util.R   | 26 --------------------------
 3 files changed, 3 insertions(+), 45 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 84481142..24f7f2e4 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,6 @@
 # surveydown (development version)
 
+- Modified default rendering behavior to not delete the rendered html file.
 - Modified the `refresh_interval` argument in `sd_get_data()` as defaulting to `NULL`, which means the data will not be reactively fetched, regardless of the context it is used in. The data will only continuously refresh if `sd_get_data()` is called within a reactive context and `refresh_interval > 0`.
 - Modified messaging from `sd_set_password()` to not print out user's password and provide clearer instructions.
 - `sd_show_password()` added to show a stored password. The user will be prompted to double confirm that they want to show it. If there is no password, the user will be prompted so, along with a message of using `sd_set_password()` to create the password.
diff --git a/R/config.R b/R/config.R
index 0c84020d..800ddc6a 100644
--- a/R/config.R
+++ b/R/config.R
@@ -64,25 +64,8 @@ run_config <- function(
 }
 
 get_html_content <- function(survey_file) {
-    # Check if the file exists
-    if (!file.exists(survey_file)) {
-        stop("The specified survey file does not exist.")
-    }
-
-    # Get the file extension
-    file_ext <- tools::file_ext(survey_file)
-
-    # Process based on file type
-    if (file_ext == "qmd") {
-        temp_html <- quarto_render_temp(survey_file)
-        html_content <- rvest::read_html(temp_html)
-        unlink(temp_html)
-    } else if (file_ext == "html") {
-        html_content <- rvest::read_html(survey_file)
-    } else {
-        stop("Invalid file type. Please provide either a .qmd or .html file.")
-    }
-    return(html_content)
+    if (survey_file == 'survey.qmd') { quarto::quarto_render(survey_file) }
+    return(rvest::read_html('survey.html'))
 }
 
 extract_html_pages <- function(
diff --git a/R/util.R b/R/util.R
index d1329ae9..1a0db986 100644
--- a/R/util.R
+++ b/R/util.R
@@ -162,32 +162,6 @@ tibble_to_list_of_lists <- function(tbl) {
   })
 }
 
-# Function to render Quarto document to a temporary file
-quarto_render_temp <- function(input) {
-
-    # Create a temporary directory
-    temp_dir <- tempdir()
-
-    # Get the output file path in the original directory
-    x <- quarto::quarto_inspect(input)
-    output_format <- names(x$formats)
-    original_output <- x$formats[[output_format]]$pandoc$`output-file`
-    original_output_path <- file.path(dirname(input), original_output)
-
-    # Render the Quarto document
-    quarto::quarto_render(input)
-
-    # Define the path for the temporary file
-    temp_output_path <- file.path(temp_dir, "temp_output.html")
-
-    # Copy the rendered file to the temporary location and delete the original
-    file.copy(from = original_output_path, to = temp_output_path, overwrite = TRUE)
-    file.remove(original_output_path)
-
-    # Return the path to the temporary file
-    return(temp_output_path)
-}
-
 #' Create a new survey template
 #'
 #' This function creates a new survey template by copying files from the package's

From 4ea6507dd79102754e11344a1c4d8c5c9c238752 Mon Sep 17 00:00:00 2001
From: emse-p4a-gwu <john.helveston@gmail.com>
Date: Sat, 28 Sep 2024 05:40:21 -0400
Subject: [PATCH 4/9] simplify the data list into one object called `all_data`

---
 R/server.R | 110 +++++++++++++++++++++++++----------------------------
 1 file changed, 52 insertions(+), 58 deletions(-)

diff --git a/R/server.R b/R/server.R
index a9e66aec..3c17f386 100644
--- a/R/server.R
+++ b/R/server.R
@@ -133,7 +133,7 @@ sd_server <- function(
     # Pre-compute timestamp IDs
     page_ts_ids     <- paste0("time_p_", page_ids)
     question_ts_ids <- paste0("time_q_", question_ids)
-    all_ts_ids      <- c(page_ts_ids, question_ts_ids)
+    all_ts_ids      <- c(page_ts_ids, question_ts_ids, 'time_last_interaction')
 
     # Initialize local functions ----
 
@@ -179,23 +179,21 @@ sd_server <- function(
     # Create admin page if admin_page is TRUE
     if (isTRUE(config$admin_page)) admin_enable(input, output, session, db)
 
-    # Data tracking ----
-
-    # Format static data
-    static_list <- list(
-        session_id = session_id,
-        time_start = time_start
-    )
-    static_list <- c(static_list, get_stored_vals(session))
-
     # Initialize values for progressbar
     load_js_file("update_progress.js")
     max_progress <- shiny::reactiveVal(0)
     last_answered_question <- shiny::reactiveVal(0)
 
-    # Initialize timestamps and question values
-    timestamps <- initialize_timestamps(page_ts_ids, question_ts_ids, time_start)
-    question_vals <- initialize_question_vals(question_ids)
+    # Data tracking ----
+
+    # Format static data
+    static_list <- list(session_id = session_id, time_start = time_start)
+    static_list <- c(static_list, get_stored_vals(session))
+
+    # Initialize the all_data reactive values
+    all_data <- initialize_all_data(
+        static_list, question_ids, question_ts_ids, page_ts_ids, time_start
+    )
 
     # Database table initialization
     if (!ignore_mode) {
@@ -203,11 +201,7 @@ sd_server <- function(
             DBI::dbExistsTable(conn, db$table)
         })
         time_ids <- c(all_ts_ids, 'time_last_interaction')
-        initial_data <- c(
-            static_list,
-            setNames(lapply(question_ids, function(id) NA), question_ids),
-            setNames(lapply(time_ids, function(id) NA), time_ids)
-        )
+        initial_data <- reactiveValuesToList(all_data)
         if (!table_exists) {
             create_table(initial_data, db$db, db$table)
         }
@@ -215,22 +209,24 @@ sd_server <- function(
         check_and_add_columns(initial_data, db$db, db$table)
     }
 
-    # Create a reactive expression for the latest data
     latest_data <- shiny::reactive({
         # Update timestamp of last interaction
-        timestamps$time_last_interaction <- get_utc_timestamp()
-        # Merge all lists
-        data <- c(
-            static_list,
-            reactiveValuesToList(question_vals),
-            reactiveValuesToList(timestamps)
-        )
+        all_data$time_last_interaction <- get_utc_timestamp()
+
+        # Convert reactiveValues to a regular list
+        data <- reactiveValuesToList(all_data)
+
         # Ensure all elements are of length 1, use "" for empty or NULL values
         data <- lapply(data, function(x) {
             if (length(x) == 0 || is.null(x) || (is.na(x) && !is.character(x))) "" else as.character(x)[1]
         })
-        data <- data[names(data) != ""]
-        return(data)
+
+        data[names(data) != ""]
+    })
+
+    # Observer to update the data upon any change in the data
+    observe({
+        update_data(latest_data())
     })
 
     # Main question observers ----
@@ -242,17 +238,17 @@ sd_server <- function(
 
         observeEvent(input[[local_id]], {
             # Update question value
-            question_vals[[local_id]] <- format_question_value(input[[local_id]])
+            all_data[[local_id]] <- format_question_value(input[[local_id]])
 
             # Update timestamp and progress if interacted
             if (!is.null(input[[paste0(local_id, "_interacted")]])) {
-                timestamps[[local_ts_id]] <- get_utc_timestamp()
+                all_data[[local_ts_id]] <- get_utc_timestamp()
                 update_progress_bar(index)
             }
 
             # Make value accessible in the UI
             output[[paste0(local_id, "_value")]] <- renderText({
-                as.character(question_vals[[local_id]])
+                as.character(all_data[[local_id]])
             })
 
             # Trigger show_if evaluation
@@ -263,12 +259,6 @@ sd_server <- function(
         }, ignoreNULL = FALSE, ignoreInit = TRUE)
     })
 
-    # Observer to update the data upon any change in the data
-    observe({
-        data_list <- latest_data()
-        update_data(data_list)
-    })
-
     # Page rendering ----
 
     # Create reactive values for the current page ID
@@ -327,7 +317,7 @@ sd_server <- function(
                     if (!is.null(next_page_id) && check_required(page)) {
                         current_page_id(next_page_id)
                         next_ts_id <- page_ts_ids[which(page_ids == next_page_id)]
-                        timestamps[[next_ts_id]] <- get_utc_timestamp()
+                        all_data[[next_ts_id]] <- get_utc_timestamp()
                     } else if (!is.null(next_page_id)) {
                         shiny::showNotification(
                             "Please answer all required questions before proceeding.",
@@ -339,6 +329,7 @@ sd_server <- function(
         })
     })
 
+    # Observer to max out the progress bar when we reach the last page
     shiny::observe({
         page <- get_current_page()
         if (is.null(page$next_page_id)) {
@@ -349,8 +340,7 @@ sd_server <- function(
     # Ensure final update on session end
     shiny::onSessionEnded(function() {
         shiny::isolate({
-            data_list <- latest_data()
-            update_data(data_list)
+            update_data(latest_data())
         })
     })
 
@@ -519,32 +509,36 @@ get_utc_timestamp <- function() {
     return(format(Sys.time(), tz = "UTC", usetz = TRUE))
 }
 
-# Initialize timestamps for pages and questions
-initialize_timestamps <- function(page_ts_ids, question_ts_ids, time_start) {
-    timestamps <- shiny::reactiveValues()
+initialize_all_data <- function(
+    static_list, question_ids, question_ts_ids, page_ts_ids, time_start
+) {
+    all_data <- shiny::reactiveValues()
 
-    # Initialize page timestamps
-    for (i in seq_along(page_ts_ids)) {
-        timestamps[[page_ts_ids[i]]] <- if (i == 1) get_utc_timestamp() else ""
+    # Initialize with static data
+    for (name in names(static_list)) {
+        all_data[[name]] <- static_list[[name]]
+    }
+
+    # Initialize question values
+    for (id in question_ids) {
+        all_data[[id]] <- ""
     }
 
     # Initialize question timestamps
-    for (ts_id in question_ts_ids) {
-        timestamps[[ts_id]] <- ""
+    for (id in question_ts_ids) {
+        all_data[[id]] <- ""
     }
 
-    # Initialize time of last interaction
-    timestamps[['time_last_interaction']] <- time_start
+    # Initialize page timestamps
+    for (id in page_ts_ids) {
+        all_data[[id]] <- ""
+    }
 
-    return(timestamps)
-}
+    # Initialize time of first page and last interaction
+    all_data[[page_ts_ids[1]]] <- time_start
+    all_data[['time_last_interaction']] <- time_start
 
-initialize_question_vals <- function(question_ids) {
-    vals <- shiny::reactiveValues()
-    for (id in question_ids) {
-        vals[[id]] <- ""  # Empty string instead of NA
-    }
-    return(vals)
+    return(all_data)
 }
 
 # Helper function to format a single question value

From ad4607b2501248ff57478f8711a43dada2ded6b7 Mon Sep 17 00:00:00 2001
From: emse-p4a-gwu <john.helveston@gmail.com>
Date: Sat, 28 Sep 2024 08:09:46 -0400
Subject: [PATCH 5/9] only update the changed fields

---
 NEWS.md    |  1 +
 R/db.R     | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++---
 R/server.R | 24 +++++++++++++++++----
 3 files changed, 79 insertions(+), 7 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 24f7f2e4..5ba1bf77 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,6 @@
 # surveydown (development version)
 
+- Improved efficiency in `database_uploading()` so only the changed fields get written.
 - Modified default rendering behavior to not delete the rendered html file.
 - Modified the `refresh_interval` argument in `sd_get_data()` as defaulting to `NULL`, which means the data will not be reactively fetched, regardless of the context it is used in. The data will only continuously refresh if `sd_get_data()` is called within a reactive context and `refresh_interval > 0`.
 - Modified messaging from `sd_set_password()` to not print out user's password and provide clearer instructions.
diff --git a/R/db.R b/R/db.R
index dea96baa..6e6d1886 100644
--- a/R/db.R
+++ b/R/db.R
@@ -303,7 +303,57 @@ sqlInterpolateList <- function(conn, sql, vars=list(), list_vars=list()) {
     DBI::sqlInterpolate(conn, sql, .dots=vars)
 }
 
-database_uploading <- function(data_list, db, table) {
+# database_uploading <- function(data_list, db, table) {
+#     if(is.null(db)) {
+#         return(warning("Databasing is not in use"))
+#     }
+#
+#     tryCatch({
+#         pool::poolWithTransaction(db, function(conn) {
+#             # Get the actual columns in the table
+#             existing_cols <- DBI::dbListFields(conn, table)
+#
+#             # Filter data_list to only include existing columns
+#             data_list <- data_list[names(data_list) %in% existing_cols]
+#
+#             # Ensure session_id is the first column
+#             cols <- c("session_id", setdiff(names(data_list), "session_id"))
+#             data_list <- data_list[cols]
+#
+#             # Prepare the placeholders
+#             placeholders <- paste0("?", names(data_list))
+#
+#             # Prepare the update set
+#             update_cols <- setdiff(cols, "session_id")
+#             update_set <- paste(sapply(update_cols, function(col) {
+#                 sprintf('"%s" = EXCLUDED."%s"', col, col)
+#             }), collapse = ", ")
+#
+#             # Prepare the SQL query template
+#             query_template <- sprintf(
+#                 'INSERT INTO "%s" ("%s") VALUES (%s) ON CONFLICT (session_id) DO UPDATE SET %s',
+#                 table,
+#                 paste(cols, collapse = '", "'),
+#                 paste(placeholders, collapse = ", "),
+#                 update_set
+#             )
+#
+#             # Use sqlInterpolateList to safely insert values
+#             query <- sqlInterpolateList(
+#                 conn,
+#                 query_template,
+#                 list_vars = data_list
+#             )
+#
+#             # Execute the query
+#             DBI::dbExecute(conn, query)
+#         })
+#     }, error = function(e) {
+#         warning("Error in database operation: ", e$message)
+#         print(e)  # Print the full error for debugging
+#     })
+
+database_uploading <- function(data_list, db, table, changed_fields) {
     if(is.null(db)) {
         return(warning("Databasing is not in use"))
     }
@@ -313,8 +363,13 @@ database_uploading <- function(data_list, db, table) {
             # Get the actual columns in the table
             existing_cols <- DBI::dbListFields(conn, table)
 
-            # Filter data_list to only include existing columns
-            data_list <- data_list[names(data_list) %in% existing_cols]
+            # Filter data_list to only include existing columns and changed fields
+            data_list <- data_list[names(data_list) %in% c("session_id", intersect(changed_fields, existing_cols))]
+
+            # If there's nothing to update (only session_id), return early
+            if (length(data_list) <= 1) {
+                return()
+            }
 
             # Ensure session_id is the first column
             cols <- c("session_id", setdiff(names(data_list), "session_id"))
diff --git a/R/server.R b/R/server.R
index 3c17f386..38cdfa00 100644
--- a/R/server.R
+++ b/R/server.R
@@ -147,8 +147,7 @@ sd_server <- function(
         }
     }
 
-    # Function to update the data
-    update_data <- function(data_list) {
+    update_data <- function(data_list, changed_fields) {
         if (ignore_mode) {
             if (file.access('.', 2) == 0) {  # Check if current directory is writable
                 tryCatch({
@@ -165,8 +164,10 @@ sd_server <- function(
                 message("Running in a non-writable environment.")
             }
         } else {
-            database_uploading(data_list, db$db, db$table)
+            database_uploading(data_list, db$db, db$table, changed_fields)
         }
+        # Reset changed_fields after updating the data
+        changed_fields(character(0))
     }
 
     # Initial settings ----
@@ -209,6 +210,7 @@ sd_server <- function(
         check_and_add_columns(initial_data, db$db, db$table)
     }
 
+    # Reactive expression that returns a list of the latest data
     latest_data <- shiny::reactive({
         # Update timestamp of last interaction
         all_data$time_last_interaction <- get_utc_timestamp()
@@ -226,9 +228,13 @@ sd_server <- function(
 
     # Observer to update the data upon any change in the data
     observe({
-        update_data(latest_data())
+        data <- latest_data()
+        update_data(data, changed_fields())
     })
 
+    # Reactive value to track which fields have changed
+    changed_fields <- shiny::reactiveVal(character(0))
+
     # Main question observers ----
     # (one created for each question)
 
@@ -240,9 +246,13 @@ sd_server <- function(
             # Update question value
             all_data[[local_id]] <- format_question_value(input[[local_id]])
 
+            # Update tracker of which fields changed
+            changed_fields(c(changed_fields(), local_id))
+
             # Update timestamp and progress if interacted
             if (!is.null(input[[paste0(local_id, "_interacted")]])) {
                 all_data[[local_ts_id]] <- get_utc_timestamp()
+                changed_fields(c(changed_fields(), local_ts_id))
                 update_progress_bar(index)
             }
 
@@ -315,9 +325,15 @@ sd_server <- function(
                     next_page_id <- get_default_next_page(page, page_ids, page_id_to_index)
                     next_page_id <- handle_skip_logic(input, skip_if, current_page_id, next_page_id)
                     if (!is.null(next_page_id) && check_required(page)) {
+                        # Set the current page as the next page
                         current_page_id(next_page_id)
+
+                        # Update the page time stamp
                         next_ts_id <- page_ts_ids[which(page_ids == next_page_id)]
                         all_data[[next_ts_id]] <- get_utc_timestamp()
+
+                        # Update tracker of which fields changed
+                        changed_fields(c(changed_fields(), next_ts_id))
                     } else if (!is.null(next_page_id)) {
                         shiny::showNotification(
                             "Please answer all required questions before proceeding.",

From b36e100e1761844c7ce54f311ea62f13def6e5ed Mon Sep 17 00:00:00 2001
From: emse-p4a-gwu <john.helveston@gmail.com>
Date: Sun, 29 Sep 2024 05:37:01 -0400
Subject: [PATCH 6/9] streamlined data handling

---
 R/config.R |  5 ++++
 R/server.R | 74 ++++++++++++++++++++----------------------------------
 2 files changed, 32 insertions(+), 47 deletions(-)

diff --git a/R/config.R b/R/config.R
index 800ddc6a..49b41825 100644
--- a/R/config.R
+++ b/R/config.R
@@ -45,6 +45,11 @@ run_config <- function(
         stop("The specified start_page does not exist - check that you have not mis-spelled the id")
     }
 
+    # Set the start page
+    if (is.null(start_page)) {
+        start_page <- page_ids[1]
+    }
+
     # Check skip_if and show_if inputs
     check_skip_show(question_ids, question_values, page_ids, skip_if, show_if)
 
diff --git a/R/server.R b/R/server.R
index 38cdfa00..17d64960 100644
--- a/R/server.R
+++ b/R/server.R
@@ -133,7 +133,8 @@ sd_server <- function(
     # Pre-compute timestamp IDs
     page_ts_ids     <- paste0("time_p_", page_ids)
     question_ts_ids <- paste0("time_q_", question_ids)
-    all_ts_ids      <- c(page_ts_ids, question_ts_ids, 'time_last_interaction')
+    start_page_ts_id <- page_ts_ids[which(page_ids == start_page)]
+    all_ids <- c('time_end', question_ids, question_ts_ids, page_ts_ids)
 
     # Initialize local functions ----
 
@@ -147,7 +148,13 @@ sd_server <- function(
         }
     }
 
-    update_data <- function(data_list, changed_fields) {
+    update_data <- function(data_list, changed_fields = NULL, time_last = FALSE) {
+        if (is.null(changed_fields)) {
+            changed_fields = names(data_list)
+        }
+        if (time_last) {
+            data_list[['time_end']] <- get_utc_timestamp()
+        }
         if (ignore_mode) {
             if (file.access('.', 2) == 0) {  # Check if current directory is writable
                 tryCatch({
@@ -187,22 +194,17 @@ sd_server <- function(
 
     # Data tracking ----
 
-    # Format static data
-    static_list <- list(session_id = session_id, time_start = time_start)
-    static_list <- c(static_list, get_stored_vals(session))
-
     # Initialize the all_data reactive values
-    all_data <- initialize_all_data(
-        static_list, question_ids, question_ts_ids, page_ts_ids, time_start
+    initial_data <- get_initial_data(
+        session, session_id, time_start, all_ids, start_page_ts_id
     )
+    all_data <- do.call(shiny::reactiveValues, initial_data)
 
     # Database table initialization
     if (!ignore_mode) {
         table_exists <- pool::poolWithTransaction(db$db, function(conn) {
             DBI::dbExistsTable(conn, db$table)
         })
-        time_ids <- c(all_ts_ids, 'time_last_interaction')
-        initial_data <- reactiveValuesToList(all_data)
         if (!table_exists) {
             create_table(initial_data, db$db, db$table)
         }
@@ -212,9 +214,6 @@ sd_server <- function(
 
     # Reactive expression that returns a list of the latest data
     latest_data <- shiny::reactive({
-        # Update timestamp of last interaction
-        all_data$time_last_interaction <- get_utc_timestamp()
-
         # Convert reactiveValues to a regular list
         data <- reactiveValuesToList(all_data)
 
@@ -271,13 +270,9 @@ sd_server <- function(
 
     # Page rendering ----
 
-    # Create reactive values for the current page ID
-    current_page_id <- shiny::reactiveVal(page_ids[1])
-
-    # Start from start_page (if specified)
-    if (!is.null(start_page)) {
-        current_page_id(start_page)
-    }
+    # Create reactive values for the start page ID
+    # (defaults to first page if NULL...see run_config() function)
+    current_page_id <- shiny::reactiveVal(start_page)
 
     get_current_page <- reactive({
         pages[[which(sapply(pages, function(p) p$id == current_page_id()))]]
@@ -356,7 +351,7 @@ sd_server <- function(
     # Ensure final update on session end
     shiny::onSessionEnded(function() {
         shiny::isolate({
-            update_data(latest_data())
+            update_data(latest_data(), time_last = TRUE)
         })
     })
 
@@ -525,36 +520,21 @@ get_utc_timestamp <- function() {
     return(format(Sys.time(), tz = "UTC", usetz = TRUE))
 }
 
-initialize_all_data <- function(
-    static_list, question_ids, question_ts_ids, page_ts_ids, time_start
+get_initial_data <- function(
+    session, session_id, time_start, all_ids, start_page_ts_id
 ) {
-    all_data <- shiny::reactiveValues()
-
     # Initialize with static data
-    for (name in names(static_list)) {
-        all_data[[name]] <- static_list[[name]]
-    }
-
-    # Initialize question values
-    for (id in question_ids) {
-        all_data[[id]] <- ""
-    }
-
-    # Initialize question timestamps
-    for (id in question_ts_ids) {
-        all_data[[id]] <- ""
-    }
-
-    # Initialize page timestamps
-    for (id in page_ts_ids) {
-        all_data[[id]] <- ""
-    }
+    data <- c(
+        list(session_id = session_id, time_start = time_start),
+        get_stored_vals(session)
+    )
 
-    # Initialize time of first page and last interaction
-    all_data[[page_ts_ids[1]]] <- time_start
-    all_data[['time_last_interaction']] <- time_start
+    # Initialize question & timestamp values
+    for (id in all_ids) { data[[id]] <- "" }
+    data[[start_page_ts_id]] <- time_start
+    data[['time_end']] <- ""
 
-    return(all_data)
+    return(data)
 }
 
 # Helper function to format a single question value

From a50fe1a8db7b125da68c506338cd6182e1bc40a9 Mon Sep 17 00:00:00 2001
From: emse-p4a-gwu <john.helveston@gmail.com>
Date: Sun, 29 Sep 2024 05:41:20 -0400
Subject: [PATCH 7/9] add time start

---
 R/server.R | 1 +
 1 file changed, 1 insertion(+)

diff --git a/R/server.R b/R/server.R
index 17d64960..4c14d627 100644
--- a/R/server.R
+++ b/R/server.R
@@ -531,6 +531,7 @@ get_initial_data <- function(
 
     # Initialize question & timestamp values
     for (id in all_ids) { data[[id]] <- "" }
+    data[['time_start']] <- time_start
     data[[start_page_ts_id]] <- time_start
     data[['time_end']] <- ""
 

From 13eb5aaf12df069682e3c43c6bfc47ed84b11a12 Mon Sep 17 00:00:00 2001
From: emse-p4a-gwu <john.helveston@gmail.com>
Date: Sun, 29 Sep 2024 08:10:32 -0400
Subject: [PATCH 8/9] clean up table starting

---
 R/db.R     | 115 +----------------------------------------------------
 R/server.R |   6 +--
 2 files changed, 3 insertions(+), 118 deletions(-)

diff --git a/R/db.R b/R/db.R
index 6e6d1886..8967822b 100644
--- a/R/db.R
+++ b/R/db.R
@@ -219,72 +219,9 @@ create_table <- function(data_list, db, table) {
         DBI::dbExecute(conn, paste0('ALTER TABLE "', table, '" ENABLE ROW LEVEL SECURITY;'))
     })
 
-    message("Table created (or already exists) in your Supabase database.")
+    message(paste("Table", table, "created in the database."))
 }
 
-check_and_add_columns <- function(data_local, db, table) {
-    pool::poolWithTransaction(db, function(conn) {
-        existing_cols <- DBI::dbListFields(conn, table)
-        new_cols <- setdiff(names(data_local), existing_cols)
-        for (col in new_cols) {
-            r_type <- typeof(data_local[[col]])
-            sql_type <- r_to_sql_type(r_type)
-            query <- paste0('ALTER TABLE "', table, '" ADD COLUMN "', col, '" ', sql_type, ';')
-            DBI::dbExecute(conn, query)
-        }
-    })
-}
-
-# Less secure approach - vulnerable to SQL injection
-# database_uploading <- function(data_list, db, table) {
-#     if(is.null(db)) {
-#         return(warning("Databasing is not in use"))
-#     }
-#
-#     tryCatch({
-#         pool::poolWithTransaction(db, function(conn) {
-#             # Get the actual columns in the table
-#             existing_cols <- DBI::dbListFields(conn, table)
-#
-#             # Filter data_list to only include existing columns
-#             data_list <- data_list[names(data_list) %in% existing_cols]
-#
-#             # Prepare the update query
-#             cols <- names(data_list)
-#             update_cols <- setdiff(cols, "session_id")
-#
-#             # Create value string, properly escaping and quoting values
-#             values <- sapply(data_list, function(x) {
-#                 if (is.character(x)) {
-#                     paste0("'", gsub("'", "''", x), "'")
-#                 } else if (is.numeric(x)) {
-#                     as.character(x)
-#                 } else {
-#                     "NULL"
-#                 }
-#             })
-#             values_str <- paste(values, collapse = ", ")
-#
-#             update_set <- paste(sapply(update_cols, function(col) {
-#                 paste0('"', col, '" = EXCLUDED."', col, '"')
-#             }), collapse = ", ")
-#
-#             update_query <- paste0(
-#                 'INSERT INTO "', table, '" ("', paste(cols, collapse = '", "'), '") ',
-#                 'VALUES (', values_str, ') ',
-#                 'ON CONFLICT (session_id) DO UPDATE SET ',
-#                 update_set
-#             )
-#
-#             # Execute the query
-#             DBI::dbExecute(conn, update_query)
-#         })
-#     }, error = function(e) {
-#         warning("Error in database operation: ", e$message)
-#         print(e)  # Print the full error for debugging
-#     })
-# }
-
 # Solution found in this issue:
 # https://github.com/r-dbi/DBI/issues/193
 sqlInterpolateList <- function(conn, sql, vars=list(), list_vars=list()) {
@@ -303,56 +240,6 @@ sqlInterpolateList <- function(conn, sql, vars=list(), list_vars=list()) {
     DBI::sqlInterpolate(conn, sql, .dots=vars)
 }
 
-# database_uploading <- function(data_list, db, table) {
-#     if(is.null(db)) {
-#         return(warning("Databasing is not in use"))
-#     }
-#
-#     tryCatch({
-#         pool::poolWithTransaction(db, function(conn) {
-#             # Get the actual columns in the table
-#             existing_cols <- DBI::dbListFields(conn, table)
-#
-#             # Filter data_list to only include existing columns
-#             data_list <- data_list[names(data_list) %in% existing_cols]
-#
-#             # Ensure session_id is the first column
-#             cols <- c("session_id", setdiff(names(data_list), "session_id"))
-#             data_list <- data_list[cols]
-#
-#             # Prepare the placeholders
-#             placeholders <- paste0("?", names(data_list))
-#
-#             # Prepare the update set
-#             update_cols <- setdiff(cols, "session_id")
-#             update_set <- paste(sapply(update_cols, function(col) {
-#                 sprintf('"%s" = EXCLUDED."%s"', col, col)
-#             }), collapse = ", ")
-#
-#             # Prepare the SQL query template
-#             query_template <- sprintf(
-#                 'INSERT INTO "%s" ("%s") VALUES (%s) ON CONFLICT (session_id) DO UPDATE SET %s',
-#                 table,
-#                 paste(cols, collapse = '", "'),
-#                 paste(placeholders, collapse = ", "),
-#                 update_set
-#             )
-#
-#             # Use sqlInterpolateList to safely insert values
-#             query <- sqlInterpolateList(
-#                 conn,
-#                 query_template,
-#                 list_vars = data_list
-#             )
-#
-#             # Execute the query
-#             DBI::dbExecute(conn, query)
-#         })
-#     }, error = function(e) {
-#         warning("Error in database operation: ", e$message)
-#         print(e)  # Print the full error for debugging
-#     })
-
 database_uploading <- function(data_list, db, table, changed_fields) {
     if(is.null(db)) {
         return(warning("Databasing is not in use"))
diff --git a/R/server.R b/R/server.R
index 4c14d627..59a61179 100644
--- a/R/server.R
+++ b/R/server.R
@@ -149,7 +149,7 @@ sd_server <- function(
     }
 
     update_data <- function(data_list, changed_fields = NULL, time_last = FALSE) {
-        if (is.null(changed_fields)) {
+        if (length(changed_fields) == 0) {
             changed_fields = names(data_list)
         }
         if (time_last) {
@@ -200,7 +200,7 @@ sd_server <- function(
     )
     all_data <- do.call(shiny::reactiveValues, initial_data)
 
-    # Database table initialization
+    # Initialize database table
     if (!ignore_mode) {
         table_exists <- pool::poolWithTransaction(db$db, function(conn) {
             DBI::dbExistsTable(conn, db$table)
@@ -208,8 +208,6 @@ sd_server <- function(
         if (!table_exists) {
             create_table(initial_data, db$db, db$table)
         }
-        # Check if there are any new columns, update DB accordingly
-        check_and_add_columns(initial_data, db$db, db$table)
     }
 
     # Reactive expression that returns a list of the latest data

From 2127a31863a290b848054a5a9f6412226a3b8723 Mon Sep 17 00:00:00 2001
From: emse-p4a-gwu <john.helveston@gmail.com>
Date: Sun, 29 Sep 2024 08:13:21 -0400
Subject: [PATCH 9/9] bump to v0.3.1

---
 DESCRIPTION | 2 +-
 NEWS.md     | 4 +++-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 74aeb5b2..c5f65100 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: surveydown
 Title: Markdown-Based Surveys Using Quarto Shiny Documents
-Version: 0.3.0
+Version: 0.3.1
 Authors@R: c(
     person(given   = "John Paul",
            family  = "Helveston",
diff --git a/NEWS.md b/NEWS.md
index 5ba1bf77..b165f9cf 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,6 +1,8 @@
 # surveydown (development version)
 
-- Improved efficiency in `database_uploading()` so only the changed fields get written.
+# surveydown 0.3.1
+
+- Improved efficiency in `database_uploading()` so only the changed fields get written, and also the writing happens after checking the `show_if` conditions (addresses #100).
 - Modified default rendering behavior to not delete the rendered html file.
 - Modified the `refresh_interval` argument in `sd_get_data()` as defaulting to `NULL`, which means the data will not be reactively fetched, regardless of the context it is used in. The data will only continuously refresh if `sd_get_data()` is called within a reactive context and `refresh_interval > 0`.
 - Modified messaging from `sd_set_password()` to not print out user's password and provide clearer instructions.