shinyDragAndDrop/dragAndDrop2.R at master · geoabi/shinyDragAndDrop · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
# Drag and drop a set of images using SortableJS
#
# Images can only be dropped in a container of the same group, e.g. Class_A1 and Class_A2 have
# the group "groupA".
#
# May 12, 2019
# Geovany A. Ramirez

library(shiny)

ui <- fluidPage(
  title = "Shiny Drag and Drop",

  # add custom CSS and javascript code
  tags$head(
    tags$link(rel = "stylesheet", type = "text/css", href = "styles.css"),
    tags$script(type = "text/javascript", src = "Sortable.js"),
    tags$script(type = "text/javascript", src = "drag_drop_binding.js")
  ),

  uiOutput("main_UI")
)

server <- function(input, output, session) {

  # location of images
  imagesDir <- "./images"
  # web directory
  imagesDirWeb <- "imgs"

  # make the directory web accesible
  addResourcePath(imagesDirWeb, imagesDir)

  # display a set of images
  showImages <- function(fileName) {
    # read list of images
    allImgs <- read.csv(fileName)
    lapply(1:nrow(allImgs), function(i) {
      srcName <- paste0(imagesDirWeb, '/', allImgs$images[i])
      img(src = srcName, data = allImgs$images[i], class = "grid-square")
    })
  }

  # create a container of draggable elements in a grid
  createGridDrag <- function(id, ..., group = "shared") {
    # to call the renderValue function in drag_drop_binding.js and
    # send the group name
    output[[id]] <- function(){ group }

    div(id = id, class = "grid_drag_drop group_border", ... )
  }

  output$main_UI <- renderUI({
    div(
      fluidRow(
        column(4, h3("Class A1", style = "text-align: center;"),
          createGridDrag(id = "class_A1", group = "groupA",
            showImages("imagesA.csv")
          ),
          verbatimTextOutput("elements_A1")
        ),
        column(4, h3("Class B1", style = "text-align: center;"),
          createGridDrag(id = "class_B1", group = "groupB",
            showImages("imagesB.csv")),
          verbatimTextOutput("elements_B1")
        ),
        column(4, h3("Class C1", style = "text-align: center;"),
          createGridDrag(id = "class_C1", group = "groupC",
            showImages("imagesC.csv")),
          verbatimTextOutput("elements_C1")
        )
      ),
      hr(),
      fluidRow(
        column(4, h3("Class A2", style = "text-align: center;"),
          createGridDrag(id = "class_A2", group = "groupA"),
          verbatimTextOutput("elements_A2")
        ),
        column(4, h3("Class B2", style = "text-align: center;"),
          createGridDrag(id = "class_B2", group = "groupB"),
          verbatimTextOutput("elements_B2")
        ),
        column(4, h3("Class C2", style = "text-align: center;"),
          createGridDrag(id = "class_C2", group = "groupC"),
          verbatimTextOutput("elements_C2")
        )
      )
    )
  })

  # display the elements in each container
  output$elements_A1 <- renderPrint({ input$class_A1 })
  output$elements_B1 <- renderPrint({ input$class_B1 })
  output$elements_C1 <- renderPrint({ input$class_C1 })
  output$elements_A2 <- renderPrint({ input$class_A2 })
  output$elements_B2 <- renderPrint({ input$class_B2 })
  output$elements_C2 <- renderPrint({ input$class_C2 })
}

shinyApp(ui = ui, server = server)