I'm experimenting with the shinyjqui package:
One particularly interesting function is orderInput()
. With the connect
argument, we can drag and drop items, as demonstrated here: https://cran.r-project.org/web/packages/shinyjqui/vignettes/orderInput.html
I'm attempting to drag and drop items into a grid table, but unfortunately, it's not functioning as expected.
Here's the code I've developed thus far:
library(shiny)
library(shinyjqui)
connections <- c('my_grid') # id of the grid table
ui <- fluidPage(
# some styling
tags$head(
tags$style(HTML("
.grid-table {
width: 150px;
border-collapse: collapse;
}
.grid-cell {
width: 100%;
height: 50px;
border: 1px solid black;
background-color: white;
text-align: center;
margin: 0;
padding: 0;
}
.grid-cell-text {
display: flex;
align-items: center;
justify-content: center;
height: 100%;
background-color: steelblue;
color: white;
font-size: 18px;
}
.droppable-cell {
background-color: lightgray;
}
.table-container {
display: flex;
position: absolute;
left: 550px;
top: 30px;
margin-top: 0px;
overflow: hidden;
}
"))
),
div(class = "table-container",
div(class = "grid-table", id = "my_grid",
div(class = "grid-row",
div(class = "grid-cell grid-cell-text", "my_grid"),
div(id = "droppable_cell_1", class = "grid-cell droppable-cell", ""),
div(id = "droppable_cell_2", class = "grid-cell droppable-cell", ""),
div(id = "droppable_cell_3", class = "grid-cell droppable-cell", ""),
div(id = "droppable_cell_4", class = "grid-cell droppable-cell", ""),
div(id = "droppable_cell_5", class = "grid-cell droppable-cell", ""),
div(id = "droppable_cell_6", class = "grid-cell droppable-cell", ""),
div(id = "droppable_cell_7", class = "grid-cell droppable-cell", "")
)
),
orderInput('letters', 'Letters', items = LETTERS[1:7],
connect = connections) # defined above
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
Here is one example which has two changes: First, the connections
parameter of the orderInput
should not refer to the grid table, but rather to the grid cells:
connections <- paste0("droppable_cell_", 1:7)
Second, each of the grid cells has to be a sortable
which is connected to letters
and has an append()
when dropping the letters on it. Since I currently do not get this to run with shinyjqui
build-in functions, I implement it with a small custom JS
:
$(function() {
$('[id^=droppable_cell]').sortable({
connectWith: '#letters',
drop: function(event, ui) {
$(this).append(ui.draggable);
}
})
});
I also set padding
to 5px
in the style of the .grid-cell
such that the letters appear in the middle of the cells.
library(shiny)
library(shinyjqui)
connections <- paste0("droppable_cell_", 1:7) # id of the grid cells
ui <- fluidPage(
tags$head(tags$script(
JS(
"
$(function() {
$('[id^=droppable_cell]').sortable({
connectWith: '#letters',
drop: function(event, ui) {
$(this).append(ui.draggable);
}
})
});
"
)
),
# some styling
tags$style(
HTML(
"
.grid-table {
width: 150px;
border-collapse: collapse;
}
.grid-cell {
width: 100%;
height: 50px;
border: 1px solid black;
background-color: white;
text-align: center;
margin: 0;
padding: 5px;
}
.grid-cell-text {
display: flex;
align-items: center;
justify-content: center;
height: 100%;
background-color: steelblue;
color: white;
font-size: 18px;
}
.droppable-cell {
background-color: lightgray;
}
.table-container {
display: flex;
position: absolute;
left: 550px;
top: 30px;
margin-top: 0px;
overflow: hidden;
}
"
)
)),
div(
class = "table-container",
div(
class = "grid-table",
id = "my_grid",
div(
class = "grid-row",
div(class = "grid-cell grid-cell-text", "my_grid"),
div(id = "droppable_cell_1", class = "grid-cell droppable-cell", ""),
div(id = "droppable_cell_2", class = "grid-cell droppable-cell", ""),
div(id = "droppable_cell_3", class = "grid-cell droppable-cell", ""),
div(id = "droppable_cell_4", class = "grid-cell droppable-cell", ""),
div(id = "droppable_cell_5", class = "grid-cell droppable-cell", ""),
div(id = "droppable_cell_6", class = "grid-cell droppable-cell", ""),
div(id = "droppable_cell_7", class = "grid-cell droppable-cell", "")
)
),
orderInput('letters', 'Letters', items = LETTERS[1:7],
connect = connections) # defined above
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)