This is my drag and drop app:
library(shiny)
library(shinyjqui)
library(shinyjs)
library(dplyr)
###### part 1 ------------------------------------------------------------------
#creating the list of items
df <- structure(list(AG = c("A", "B", "C", "D")),
row.names = c(NA,-4L), class = "data.frame")
# cells of table
connections1 <- paste0("droppable_cell", ifelse(1:2 == 1, "", 1:2), "_1")
connections2 <- paste0("droppable_cell", ifelse(1:2 == 1, "", 1:2), "_2")
connections <- c(connections1, connections2)
# Define a named list for vec_suggestion1
vec_suggestion1 <- list(
droppable_cell_1 = c("A", "B", "A", "B"),
droppable_cell_2 = c("A", "B", "B", "A")
)
# Create the data frame
my_df <- data.frame(connections = connections,
stringsAsFactors = FALSE
)
my_df$vec_suggestion1 <- vec_suggestion1[my_df$connections]
###### part 2 ------------------------------------------------------------------
myComplexTableUI <- div(id = "capture", class = "table-container",
div(class = "grid-table",
id = "montag",
div(class = "grid-row",
div(class = "grid-cell grid-cell-text", "Montag"),
lapply(1:2, function(i) {
div(id = paste0("droppable_cell_", i), class = "grid-cell droppable-cell", "")
})
)
)
)
###### part 3 ------------------------------------------------------------------
# my js
jsCode <- "
$(function() {
function createSortable(day) {
$('[id^=droppable_cell' + day + '_]').sortable({
connectWith: '#A, #B, [id^=droppable_cell' + day + '_]',
drop: function(event, ui) {
$(this).append(ui.draggable);
}
});
}
createSortable('1'); // For day1
createSortable('2'); // For day2
$('[id^=droppable_cell]').on('sortupdate', function(e, ui) {
var cellId = $(this).attr('id');
var item = ui.item.text();
Shiny.setInputValue('dropEvent', {cell: cellId, item: item}, {priority: 'event'});
});
});
shinyjs.pageCol = function(params) {
$('[id^=droppable_cell]').sortable({
connectWith: '#A, #B, [id^=droppable_cell_1], [id^=droppable_cell_2]',
drop: function(event, ui) {
$(this).append(ui.draggable);
}
});
var dataArray = Object.values(params[0]);
dataArray = dataArray[0].map((col, i) => dataArray.map(row => row[i]));
console.log('dataArray: ', dataArray);
var cacheA = $('#A').html();
var cacheB = $('#B').html();
var cacheGridCells1 = $('[id^=droppable_cell_1]').html();
shinyjs.setSuggestion = function (idxSuggestion) {
$.each(dataArray, function (index, value) {
var cellSelector = '#' + dataArray[index][0];
var classIndex = idxSuggestion === 1 ? 1 : 2;
// Retrieve the items for the current cell from dataArray
var items = dataArray[index][idxSuggestion];
if (typeof items === 'string') {
items = [items]; // Convert to array if there is only one item
}
// Clear the cell content
$(cellSelector).html('');
// Append each item to the cell
$.each(items, function (i, item) {
if (item === null) {
return true;
}
// Determine the style based on the item value
var itemStyle = '';
if (item === 'A') {
itemStyle = 'background-color: #ffcc66;'; // Corresponding to Bootstrap's warning color
} else if (item === 'B') {
itemStyle = 'background-color: #5cb85c;'; // Corresponding to Bootstrap's success color
}
var cellHTML = '<div data-value="' + item
+ '" class="btn btn-default ui-sortable-handle" style="' + itemStyle + ' margin: 1px;" jqui_sortable_idx="letters__'
+ (index + 1).toString()
+ '">'
+ item
+ '</div>';
$(cellSelector).append(cellHTML);
});
});
}
shinyjs.resetDnD = function (params) {
$('#A').html(cacheA).sortable('refresh');
$('#B').html(cacheB).sortable('refresh');
$('[id^=droppable_cell_1]').html(cacheGridCells1).sortable('refresh');
}
};
"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jsCode, functions = c("pageCol", "setSuggestion")),
###### part 4 ------------------------------------------------------------------
# css table design
tags$head(
tags$style(
HTML("
.custom-title-panel button {
margin-left: 10px;
margin-top: 10px;
}
.grid-table {
width: 220px;
border-collapse: collapse;
}
.grid-cell {
width: 100%;
height: 210px;
border: 1px solid black;
background-color: white;
text-align: left;
margin: 0;
padding: 5px;
}
.grid-cell-text {
display: flex;
align-items: center;
justify-content: center;
height: 50px;
background-color: steelblue;
color: white;
font-size: 18px;
}
.table-container {
display: flex;
position: absolute;
left: 260px;
top: 20px;
margin-top: 0px;
overflow: hidden;
}
")
)
),
##################################################################################
# btn reset
tags$script(
HTML(
"$(document).ready(function() {
$('#btn_resetDnD').click(function() {
$('.droppable-cell').html(''); // Remove content from all elements with the class 'droppable_cell'
});
});"
)
),
# my items:
tags$div(
style = "position: relative; height: 50px;", # Setting a height to contain the buttons
tags$div(style = "position: absolute; top: 30px; left: 20px;",
orderInput("A", "", items = df$AG[1], as_source = TRUE, connect = connections, width = "100%", item_class = "warning")
),
tags$div(style = "position: absolute; top: 30px; left: 65px;",
orderInput("B", "", items = df$AG[2], as_source = TRUE, connect = connections, width = "100%", item_class = "success")
)
),
# my table:
myComplexTableUI,
# my buttons:
tags$div(style = "position: absolute; top: 500px; left: 260px; display: flex; flex-direction: row;",
actionButton("btn_suggestion1", "Suggestion1"),
actionButton("btn_resetDnD", "Reset")
)
)
server <- function(input, output, session) {
shinyjs::js$pageCol(my_df)
observeEvent(input$btn_suggestion1, {
shinyjs::disable("btn_suggestion1")
shinyjs::js$setSuggestion(1)
shinyjs::enable("btn_suggestion1")
})
}
shinyApp(ui, server)
The app is doing basically this:
I would like to dynamically create the ‘vec_suggestion1’ input, which is currently hardcoded. I want the system to recognize and save the user’s input when they drag it to ‘droppable_cell1’.
vec_suggestion1 <- list(
droppable_cell_1 = c("A", "B", "A", "B"),
droppable_cell_2 = c("A", "B", "B", "A")
)
I am aiming to provide the user with the ability to drag and drop their ideal combinations of A and B. This information should be dynamically saved to ‘vec_suggestion2’. Subsequently, any additional combinations of A’s and B’s should also be saved, but to ‘vec_suggestion3’, ‘vec_suggestion4’, and so on. Along with the creation of each new vector, a corresponding new button should be added, such as ‘btn_suggestion2’, ‘btn_suggestion3’, etc.
2
Answers
There are a few steps you can follow to achieve this in R Shiny
Create a reactiveValues object to store the combination vectors, then to update when the user drags and drops. could be initiated as empty list.
now to update the reactiveValues object in the "sortupdate" event: In the "sortupdate" event, retrieve the cell id and the item dragged, and then use the
update
function to update thevalues$suggestions
object with the new combination. now adding a button and corresponding action usingrenderUI
anduiOutput
functions. WithinrenderUI
now usingobserveEvent
function for defining actions for all buttonsIn event, using the
renderUI
function to generate a new list of items fordroppable_cell1
anddroppable_cell2
based on values invalues$suggestions
for particular combination index.Hope this helps!
The following approach drops the custom JS and uses an
orderInput
for each cell, which simplifies keeping track of the lists. For now I dropped theitem_class
to keep things simple (We could save lists of divs to save the styling). However, the procedure to save custom combinations sould be clear: