Skip to content
Snippets Groups Projects
Commit 95552c39 authored by Benjamin Knight's avatar Benjamin Knight
Browse files

drag and drop implemented for variables

parent 05c640c8
Branches
Tags
No related merge requests found
......@@ -147,134 +147,200 @@ server <- function(input, output, session) {
shinyjs::enable("subset_csv_btn")
removeModal()
})
#############################
## FILTER REFACTOR SECTION ##
#############################
# Use unique IDs for each filter row.
# "filterList" holds the current (active) filter rows.
# "filterIdCounter" is used to generate new unique IDs.
# "savedFilters" stores the filters the user has saved.
filterList <- reactiveVal(list())
filterIdCounter <- reactiveVal(0)
savedFilters <- reactiveVal(list())
# ----------------------------
# Render UI for Filter Rows
# ----------------------------
output$filter_rows_ui <- renderUI({
req(original_obj())
filters <- filterList()
if (length(filters) == 0) return(NULL)
# Build a fluidRow for each filter based on its unique ID
ui_list <- lapply(names(filters), function(id) {
filter_entry <- filters[[id]]
fluidRow(
id = paste0("filter_row_", id),
column(4,
selectInput(paste0("filter_var_", id), "Variable",
choices = giveChoicesMeta(original_obj()@meta.data),
selected = filter_entry$var)
),
column(6,
uiOutput(paste0("filter_value_ui_", id))
),
column(2,
actionButton(paste0("remove_filter_", id), label = "Remove")
#############################
## FILTER REFACTOR SECTION ##
#############################
# Reactive values to hold active filter rows, a counter for unique IDs, and saved filters.
filterList <- reactiveVal(list())
filterIdCounter <- reactiveVal(0)
savedFilters <- reactiveVal(list())
# ----------------------------
# Render UI for Filter Rows
# ----------------------------
output$filter_rows_ui <- renderUI({
req(original_obj())
filters <- filterList()
if (length(filters) == 0) return(NULL)
# Each filter row gets a unique fluidRow with id "filter_row_<id>"
ui_list <- lapply(names(filters), function(id) {
filter_entry <- filters[[id]]
fluidRow(
id = paste0("filter_row_", id),
column(4,
selectInput(paste0("filter_var_", id), "Variable",
choices = giveChoicesMeta(original_obj()@meta.data),
selected = filter_entry$var)
),
column(6,
uiOutput(paste0("filter_value_ui_", id))
),
column(2,
actionButton(paste0("remove_filter_", id), label = "Remove")
)
)
)
})
do.call(tagList, ui_list)
})
do.call(tagList, ui_list)
})
# ----------------------------
# Render dynamic UI for each filter's value
# ----------------------------
observe({
filters <- filterList()
req(original_obj())
for (id in names(filters)) {
local({
my_id <- id
output[[paste0("filter_value_ui_", my_id)]] <- renderUI({
req(input[[paste0("filter_var_", my_id)]])
var_name <- input[[paste0("filter_var_", my_id)]]
meta_data <- original_obj()@meta.data[[var_name]]
# Use the saved value from the filter entry
saved_val <- filters[[my_id]]$val
# ----------------------------
# Render dynamic UI for each filter's value
# ----------------------------
observe({
filters <- filterList()
req(original_obj())
for (id in names(filters)) {
local({
my_id <- id
output[[paste0("filter_value_ui_", my_id)]] <- renderUI({
req(input[[paste0("filter_var_", my_id)]])
var_name <- input[[paste0("filter_var_", my_id)]]
meta_data <- original_obj()@meta.data[[var_name]]
saved_val <- filters[[my_id]]$val
if (is.numeric(meta_data)) {
slider_min <- min(meta_data, na.rm = TRUE) - 1
slider_max <- max(meta_data, na.rm = TRUE) + 1
sliderInput(paste0("filter_value_", my_id),
"Select range",
min = slider_min,
max = slider_max,
value = if (!is.null(saved_val) && is.numeric(saved_val)) saved_val else c(slider_min, slider_max))
} else {
# For categorical variables, force any numeric saved value to be empty
if (!is.null(saved_val) && is.numeric(saved_val)) saved_val <- character(0)
# Default selection is empty if nothing is saved
default_sel <- if (is.null(saved_val)) character(0) else saved_val
tagList(
fluidRow(
column(6,
h4(paste("Available", var_name)),
tags$ul(
id = paste0("avail_", var_name, "_", my_id),
class = "sortable-list droptrue available-values",
# Show only those not selected.
lapply(setdiff(as.character(unique(meta_data)), default_sel), function(val) {
tags$li(val, class = "sortable-item", `data-value` = val)
})
)
),
column(6,
h4(paste("Selected", var_name)),
tags$ul(
id = paste0("sel_", var_name, "_", my_id),
class = "sortable-list droptrue selected-values",
style = "min-height:50px;",
# If there are selected values, show them; otherwise, a default message.
if (length(default_sel) > 0) {
lapply(default_sel, function(val) {
tags$li(val, class = "sortable-item", `data-value` = val)
})
} else {
tags$li("Drop here", class = "default-message")
}
),
# Use a text input (hidden by CSS) so Shiny binds its value.
tags$input(id = paste0("hidden_", var_name, "_", my_id),
type = "text",
value = if (length(default_sel) > 0) paste(default_sel, collapse = ",") else "",
style = "display:none;")
)
)
)
}
})
# When the variable selection changes, reinitialize the sortable lists.
observeEvent(input[[paste0("filter_var_", my_id)]], {
session$onFlushed(function(){
session$sendCustomMessage("reinitSortable", list(id = paste0("filter_row_", my_id)))
})
})
# Also send the reinitialization message once when the UI is first rendered.
session$onFlushed(function(){
session$sendCustomMessage("reinitSortable", list(id = paste0("filter_row_", my_id)))
}, once = TRUE)
})
}
})
# ----------------------------
# Build Live Filters and Preview
# ----------------------------
live_filters <- reactive({
req(current_obj())
filters <- filterList()
crit <- list()
for (id in names(filters)) {
var_name <- input[[paste0("filter_var_", id)]]
if (!is.null(var_name)) {
meta_data <- original_obj()@meta.data[[var_name]]
if (is.numeric(meta_data)) {
slider_min <- min(meta_data, na.rm = TRUE) - 1
slider_max <- max(meta_data, na.rm = TRUE) + 1
sliderInput(paste0("filter_value_", my_id),
"Select range",
min = slider_min,
max = slider_max,
value = if (!is.null(saved_val)) saved_val else c(slider_min, slider_max))
var_val <- input[[paste0("filter_value_", id)]]
} else {
checkboxGroupInput(paste0("filter_value_", my_id),
"Select values",
choices = unique(meta_data),
selected = if (!is.null(saved_val)) saved_val else unique(meta_data))
var_val_str <- input[[paste0("hidden_", var_name, "_", id)]]
cat("For categorical variable", var_name, "in filter", id, "hidden input value is: '", var_val_str, "'\n")
if (!is.null(var_val_str) && var_val_str != "") {
var_val <- strsplit(var_val_str, ",")[[1]]
var_val <- trimws(var_val)
} else {
var_val <- character(0)
}
}
})
})
}
})
# ----------------------------
# Modal Dialog: Proactively build UI from savedFilters
# ----------------------------
observeEvent(input$filter_button, {
# Check if there are saved filters
if (length(savedFilters()) == 0) {
cat("Live filter for", var_name, "in filter", id, "is:", var_val, "\n")
# Only add the filter if there's at least one value (or a valid range)
if (!is.null(var_val) && (is.numeric(var_val) || length(var_val) > 0)) {
crit[[var_name]] <- var_val
}
}
}
cat("The crit is:\n")
print(crit)
cat("The length of crit is:", length(crit), "\n")
crit
})
# ----------------------------
# Modal Dialog: Build and show UI from savedFilters
# ----------------------------
observeEvent(input$filter_button, {
if (length(savedFilters()) == 0) {
showNotification("No saved filters found. Please add filters.", type = "warning")
} else {
} else {
showNotification("Opening filter modal with saved filters.", type = "message")
print("the saved filters are")
print(savedFilters())
}
# Convert savedFilters() to a named list if not already named
modal_filters <- if (length(savedFilters()) > 0) {
}
modal_filters <- if (length(savedFilters()) > 0) {
filters <- savedFilters()
# If names are missing or empty, use each filter's id as its name
if (is.null(names(filters)) || any(names(filters) == "")) {
names(filters) <- sapply(filters, function(x) x$id)
names(filters) <- sapply(filters, function(x) x$id)
}
filters
} else {
# No saved filters: create one default filter row
# new_id <- as.character(filterIdCounter() + 1)
#filterIdCounter(as.numeric(new_id))
#list(list(id = new_id,
# var = names(current_obj()@meta.data)[1],
# val = NULL)) %>% setNames(new_id)
} else {
list()
}
# Update our reactive filter list with the modal filters
filterList(modal_filters)
showModal(modalDialog(
}
filterList(modal_filters)
showModal(modalDialog(
title = "Subset & Filter Data",
size = "l",
easyClose = TRUE,
footer = tagList(
modalButton("Close"),
actionButton("apply_filters", "Save"),
actionButton("reset_filters", "Clear"),
modalButton("Close"),
actionButton("apply_filters", "Save"),
actionButton("reset_filters", "Clear")
),
fluidRow(
# Left column: dynamic filter rows and "+ Add Filter" button.
column(7,
column(7,
div(id = "filter_container", uiOutput("filter_rows_ui")),
br(),
actionButton("add_filter", label = "+ Add Filter")
),
# Right column: live summary of filters and cell count preview.
column(5,
),
column(5,
div(style = "border-left: 2px solid #ccc; margin-left: 15px; padding-left: 15px;",
h4("Current Filters:"),
uiOutput("current_filters"),
......@@ -282,114 +348,115 @@ server <- function(input, output, session) {
h4("Cells Remaining:"),
textOutput("num_cells")
)
)
)
)
))
))
})
# ----------------------------
# Add New Filter Row
# ----------------------------
observeEvent(input$add_filter, {
# First update the current selections from all active filter rows.
current_filters <- filterList()
updated_filters <- lapply(names(current_filters), function(id) {
current_filters[[id]]$var <- input[[paste0("filter_var_", id)]]
current_filters[[id]]$val <- input[[paste0("filter_value_", id)]]
current_filters[[id]]
})
names(updated_filters) <- names(current_filters)
# Generate a new unique ID for the new filter row.
new_id <- as.character(filterIdCounter() + 1)
filterIdCounter(as.numeric(new_id))
# Exclude already-used variables to determine a default variable for the new filter.
used_vars <- sapply(updated_filters, function(x) x$var)
available_vars <- setdiff(names(original_obj()@meta.data), used_vars)
default_var <- if (length(available_vars) > 0) available_vars[1] else names(original_obj()@meta.data)[1]
new_filter <- list(id = new_id, var = default_var, val = NULL)
updated_filters[[new_id]] <- new_filter
filterList(updated_filters)
})
# ----------------------------
# Remove a Filter Row Dynamically
# ----------------------------
observe({
filters <- filterList()
for (id in names(filters)) {
local({
my_id <- id
observeEvent(input[[paste0("remove_filter_", my_id)]], {
new_filters <- filterList()
new_filters[[my_id]] <- NULL
filterList(new_filters)
}, ignoreInit = TRUE)
# ----------------------------
# Add New Filter Row
# ----------------------------
observeEvent(input$add_filter, {
current_filters <- filterList()
# Update each filter's saved value appropriately.
updated_filters <- lapply(names(current_filters), function(id) {
var_name <- input[[paste0("filter_var_", id)]]
current_filters[[id]]$var <- var_name
meta_data <- original_obj()@meta.data[[var_name]]
if (is.numeric(meta_data)) {
current_filters[[id]]$val <- input[[paste0("filter_value_", id)]]
} else {
current_filters[[id]]$val <- input[[paste0("hidden_", var_name, "_", id)]]
}
current_filters[[id]]
})
}
})
# ----------------------------
# Build Live Filters and Preview
# ----------------------------
live_filters <- reactive({
req(current_obj())
filters <- filterList()
crit <- list()
for (id in names(filters)) {
var_name <- input[[paste0("filter_var_", id)]]
var_val <- input[[paste0("filter_value_", id)]]
if (!is.null(var_name) && !is.null(var_val)) {
crit[[var_name]] <- var_val
names(updated_filters) <- names(current_filters)
new_id <- as.character(filterIdCounter() + 1)
filterIdCounter(as.numeric(new_id))
used_vars <- sapply(updated_filters, function(x) x$var)
available_vars <- setdiff(names(original_obj()@meta.data), used_vars)
default_var <- if (length(available_vars) > 0) available_vars[1] else names(original_obj()@meta.data)[1]
new_filter <- list(id = new_id, var = default_var, val = NULL)
updated_filters[[new_id]] <- new_filter
filterList(updated_filters)
})
# ----------------------------
# Remove a Filter Row Dynamically
# ----------------------------
observe({
filters <- filterList()
for (id in names(filters)) {
local({
my_id <- id
observeEvent(input[[paste0("remove_filter_", my_id)]], {
new_filters <- filterList()
new_filters[[my_id]] <- NULL
filterList(new_filters)
}, ignoreInit = TRUE)
})
}
}
crit
})
filtered_preview <- reactive({
req(original_obj())
subsetSeuratByCriteria(original_obj(), live_filters())
})
output$num_cells <- renderText({
req(filtered_preview())
paste("Cells Remaining:", ncol(filtered_preview()))
})
output$current_filters <- renderUI({
crit <- live_filters()
if (length(crit) == 0) return(NULL)
filters_list <- lapply(names(crit), function(var) {
tags$p(strong(var), ": ", paste(crit[[var]], collapse = ", "))
})
do.call(tagList, filters_list)
})
# ----------------------------
# Save Filters from Modal
# ----------------------------
observeEvent(input$apply_filters, {
shinyjs::disable("subset_csv_btn")
filters <- filterList()
updated_filters <- lapply(names(filters), function(id) {
filters[[id]]$var <- input[[paste0("filter_var_", id)]]
filters[[id]]$val <- input[[paste0("filter_value_", id)]]
filters[[id]]
# ----------------------------
# Save Filters from Modal
# ----------------------------
observeEvent(input$apply_filters, {
shinyjs::disable("subset_csv_btn")
filters <- filterList()
updated_filters <- lapply(names(filters), function(id) {
var_name <- input[[paste0("filter_var_", id)]]
filters[[id]]$var <- var_name
meta_data <- original_obj()@meta.data[[var_name]]
if (is.numeric(meta_data)) {
filters[[id]]$val <- input[[paste0("filter_value_", id)]]
} else {
filters[[id]]$val <- input[[paste0("hidden_", var_name, "_", id)]]
}
filters[[id]]
})
savedFilters(updated_filters)
removeModal()
})
savedFilters(updated_filters)
removeModal()
})
observeEvent(input$reset_filters, {
savedFilters(list())
filterList(list())
showNotification("Filters have been reset.", type = "message")
shinyjs::enable("subset_csv_btn")
})
# ----------------------------
# Reset Filters from Modal
# ----------------------------
observeEvent(input$reset_filters, {
savedFilters(list())
filterList(list())
showNotification("Filters have been reset.", type = "message")
shinyjs::enable("subset_csv_btn")
})
filtered_preview <- reactive({
req(original_obj())
subsetSeuratByCriteria(original_obj(), live_filters())
})
output$num_cells <- renderText({
req(filtered_preview())
paste("Cells Remaining:", ncol(filtered_preview()))
})
output$current_filters <- renderUI({
crit <- live_filters()
print("the crit is")
print(crit)
print("The length of crit is")
print(length(crit))
if (length(crit) == 0) return(NULL)
filters_list <- lapply(names(crit), function(var) {
tags$p(strong(var), ": ", paste(crit[[var]], collapse = ", "))
})
do.call(tagList, filters_list)
})
# ----------------------------
# Apply Changes: Update current object using saved filters
# ----------------------------
......
......@@ -17,7 +17,8 @@ ui <- fluidPage(
# Include your custom JS (sidebar.js) which contains the toggle and resizable code
tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/jqueryui/1.12.1/jquery-ui.min.css"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/jqueryui/1.12.1/jquery-ui.min.js"),
tags$script(src = "sidebar.js")
tags$script(src = "sidebar.js"),
tags$script(src ="filter.js")
),
useShinyjs(),
......
// Helper function to escape special characters in selectors.
function escapeSelector(selector) {
return selector.replace(/([ #;&,.+*~\':"!^$[\]()=>|\/@])/g, '\\$1');
}
function initStaticSortables() {
$("#static_available, #static_selected").sortable({
connectWith: "ul",
placeholder: "sortable-placeholder",
update: function(event, ui) {
if ($(this).attr("id") === "static_selected") {
if ($(this).children("li.sortable-item").length === 0) {
if ($(this).children("li.default-message").length === 0) {
$(this).append('<li class="default-message">Drop here</li>');
}
} else {
$(this).find("li.default-message").remove();
}
var selected = $(this).children("li.sortable-item").map(function() {
return $(this).data("value");
}).get();
$("#static_hidden").val(selected.join(',')).trigger('change');
console.log("Updated static selection: " + $("#static_hidden").val());
}
}
}).disableSelection();
}
function initSortableForRow(rowID) {
// Strip the "filter_row_" prefix to get the actual filter ID.
var filterID = rowID.replace("filter_row_", "");
// Find all available lists in the row whose id starts with "avail_"
$("#" + rowID).find("ul[id^='avail_']").each(function() {
var availList = $(this);
// Expected id format: "avail_<varSelected>_<filterID>"
var idParts = availList.attr("id").split("_");
if (idParts.length < 3) {
console.log("Unexpected ID format for available list: " + availList.attr("id"));
return;
}
var varSelected = idParts[1];
var rawAvailID = "avail_" + varSelected + "_" + filterID;
var rawSelID = "sel_" + varSelected + "_" + filterID;
var rawHiddenID = "hidden_" + varSelected + "_" + filterID;
// Escape IDs to handle special characters (e.g. dots)
var availSelector = "#" + escapeSelector(rawAvailID);
var selSelector = "#" + escapeSelector(rawSelID);
var hiddenSelector = "#" + escapeSelector(rawHiddenID);
console.log("Initializing dynamic row: " + rowID + " for variable: " + varSelected);
console.log("Available list selector: " + availSelector, $(availSelector).prop("outerHTML"));
console.log("Selected list selector: " + selSelector, $(selSelector).prop("outerHTML"));
// If sortable is already initialized, destroy it.
if ($(availSelector).hasClass("ui-sortable")) {
$(availSelector).sortable("destroy");
}
if ($(selSelector).hasClass("ui-sortable")) {
$(selSelector).sortable("destroy");
}
// Initialize the available list.
$(availSelector).sortable({
connectWith: "ul",
placeholder: "sortable-placeholder"
}).disableSelection();
// Initialize the selected list.
$(selSelector).sortable({
connectWith: "ul",
placeholder: "sortable-placeholder",
update: function(event, ui) {
if ($(this).children("li.sortable-item").length === 0) {
if ($(this).children("li.default-message").length === 0) {
$(this).append('<li class="default-message">Drop here</li>');
}
} else {
$(this).find("li.default-message").remove();
}
var selected = $(this).children("li.sortable-item").map(function() {
return $(this).data("value");
}).get();
var selectedStr = selected.join(',');
$(hiddenSelector).val(selectedStr).trigger('change');
console.log("Updated hidden input " + hiddenSelector + " with value: " + selectedStr);
}
}).disableSelection();
});
}
$(document).on("shown.bs.modal", "#subset_filter_modal", function() {
console.log("Custom modal shown; initializing static sortables");
initStaticSortables();
var targetNode = document.getElementById("dynamic_container");
if (targetNode) {
var config = { childList: true };
var observer = new MutationObserver(function(mutationsList, observer) {
mutationsList.forEach(function(mutation) {
mutation.addedNodes.forEach(function(node) {
if (node.nodeType === Node.ELEMENT_NODE && $(node).hasClass("dynamic-filter-row")) {
var rowID = $(node).attr("id");
console.log("New dynamic filter row inserted with id: " + rowID);
initSortableForRow(rowID);
}
});
});
});
observer.observe(targetNode, config);
} else {
console.log("Dynamic container #dynamic_container not found.");
}
});
Shiny.addCustomMessageHandler("reinitSortable", function(message) {
if (message.id) {
setTimeout(function(){
console.log("Custom message: Reinitializing sortables for dynamic row: " + message.id);
initSortableForRow(message.id);
}, 200);
} else {
console.log("Custom message: No dynamic row id provided; reinitializing static sortables");
initStaticSortables();
}
});
......@@ -34,7 +34,6 @@ body, html {
content: "";
display: block;
height: 4px;
background: linear-gradient(to right, #ffffff, #f5f7fa);
}
/* Flex container for sidebar and main content */
......@@ -179,3 +178,79 @@ body, html {
background-color: rgba(0,0,0,0.5);
z-index: 99998 !important;
}
/* Enhanced styling for the categorical filter drag-and-drop UI */
/* Container for the categorical filter block */
/* Enlarge the modal dialog */
.modal-dialog {
width: 90%;
}
/* Container for the categorical filter block */
.filter-categorical-container {
border: 1px solid #ccc;
padding: 15px;
margin-bottom: 20px;
border-radius: 6px;
background-color: #fff;
box-shadow: 0 2px 6px rgba(0,0,0,0.1);
}
/* Make the available and selected lists larger */
.available-values, .selected-values {
border: 1px dashed #bbb;
min-height: 150px;
padding: 15px;
margin-bottom: 15px;
background-color: #fefefe;
border-radius: 6px;
}
/* The overall sortable list container */
.sortable-list {
list-style: none;
padding: 15px;
margin: 15px 0;
background-color: #fff;
border: 1px solid #ddd;
border-radius: 6px;
min-height: 150px;
box-shadow: 0 2px 4px rgba(0,0,0,0.05);
}
/* Make the list items (draggable elements) smaller */
.sortable-item {
display: inline-block;
padding: 4px 8px;
margin: 3px;
border: 1px solid #ccc;
background-color: #f8f9fa;
cursor: move;
border-radius: 4px;
font-size: 12px;
color: #333;
transition: background-color 0.2s ease, transform 0.2s ease;
box-shadow: 0 1px 2px rgba(0,0,0,0.1);
}
.sortable-item:hover {
background-color: #e2e6ea;
transform: scale(1.05);
}
.sortable-item:active {
opacity: 0.9;
}
.sortable-item {
pointer-events: auto !important;
}
/* Style for the placeholder during drag-and-drop */
.sortable-placeholder {
background-color: #d6d8db;
border: 2px dashed #bbb;
min-height: 50px;
margin: 5px;
border-radius: 4px;
}
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment