Skip to content

Instantly share code, notes, and snippets.

@MayaGans
Last active January 23, 2020 22:48
Show Gist options
  • Save MayaGans/14fa2bca7dcf3605c85a205f4852919c to your computer and use it in GitHub Desktop.
Save MayaGans/14fa2bca7dcf3605c85a205f4852919c to your computer and use it in GitHub Desktop.
library(shiny)
# dummy list of dataframes
test <- data.frame("A" = NA, "B" = NA, "X" = NA)
test2 <- data.frame("D" = NA, "E" = NA, "F" = NA)
test3 <- data.frame("G" = NA, "H" = NA, "X" = NA)
combined_tests <- list(test = test, test2 = test2, test3 = test3)
# Turn list of dataframes into buckets of draggable blocks
rowBlock <- function(name) {
tags$li(
class = "block", id = name,
div(name))
}
rowPallete <- function(data) {
Map(function(x, y)
div(h5(x), tags$ul(class = 'all_blocks', lapply(colnames(y), rowBlock))),
names(data),
data)
}
rowArea <- function(bins) {
column(1, offset = 0, style='padding:0px;',
rowPallete(bins)
)
}
ui <- fluidPage(
tags$head(
tags$link(rel = "//code.jquery.com/ui/1.12.1/themes/base/jquery-ui.css"),
tags$script(src = "https://code.jquery.com/ui/1.12.1/jquery-ui.js"),
tags$link(href = "styles.css", rel = "stylesheet")
),
fluidRow(
column(6, div(h1("Reactive, Can't Sort"), uiOutput("all_rows"))),
column(6, div(h1("Using script.js"), rowArea(combined_tests)))),
tags$script(src = "script.js")
)
server <- function(input, output) {
output$all_rows <- renderUI({
rowArea(combined_tests)
})
}
shinyApp(ui = ui, server = server)
$(function() {
$(".all_blocks").sortable();
$(".all_blocks").disableSelection();
});
#block {
list-style-type: none;
margin: 0;
padding-bottom: 2px;
}
ul {
list-style: none;
padding-left: 0;
}
li {
list-style-type: none;
padding-bottom: 2px;
}
.all_blocks li,
#block li {
border: 1px solid lightgray;
border-radius: 15px;
margin-bottom: 2px;
padding-left: 3px;
text-align: center;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment