inst/apps/sortable-table/app.R

In MayaGans/TableGenerator: Drag and Drop Elements in 'Shiny' using 'Dragula Javascript Library'

## Example shiny app with bucket list
#remotes::install_github("rstudio/sortable")

library(shiny)
library(sortable)

source("global.R")


ui <- fluidPage(
  tags$head(
    tags$style(HTML(".bucket-list-container { min-height: 10px; }"))
  ),

  fluidRow(
    column(
      width = 12,
      bucket_list(
        header = " ",
        group_name = "bucket_list_group_1",
        orientation = "horizontal",
        add_rank_list(
          text = "ROWS",
          labels = list(
            "age",
            "ethnicity"
          ),
          input_id = "rank_list_1"
        ),
        add_rank_list(
          text = "AGGREGATE",
          labels = list(
            "mean/sd",
            "Frequency",
            "Frequency",
            "mean/sd"
          ),
          input_id = "rank_list_2"
        )
      )
    )
  ),

  fluidRow(
    width = 12,
    bucket_list(
      header = "Group By:",
      group_name = "bucket_list_group_1",
      orientation = "horizontal",
      add_rank_list(
        text = "Row1",
        labels = NULL,
        input_id = "row_1"
      ),
      add_rank_list(
        text = "Agg1",
        labels = NULL,
        input_id = "agg_1"
      ),
      add_rank_list(
        text = "Row2",
        labels = NULL,
        input_id = "row_2"
      ),
      add_rank_list(
        text = "Agg2",
        labels = NULL,
        input_id = "agg_2"
      )
    )),


  fluidRow(
    width = 12,
    bucket_list(
      header = "Group By:",
      group_name = "bucket_list_group_2",
      orientation = "horizontal",
      add_rank_list(
        text = " ",
        labels = list(
          "treatment",
          "dose"
        ),
        input_id = "rank_list_4"
      ),
      add_rank_list(
        text = "to here",
        labels = NULL,
        input_id = "col"
      )
  )),

  fluidRow(tableOutput("table"))
)

server <- function(input,output) {

  output$table <-  renderTable({

    COLUMN <- reactive({
      if (is.null(input$col) || length(input$col) == 0) {
        COLUMN <- FALSE
      } else {
        COLUMN <- TRUE
      }
      return(COLUMN)
    })

    ROW <- reactive({
      if (is.null(input$row_1) || length(input$row_1) == 0) {
        ROW <- FALSE
      } else {
        ROW <- TRUE
      }
      return(ROW)
    })

    AGG <- reactive({
      if (is.null(input$agg_1) || length(input$agg_1) == 0) {
        AGG <- FALSE
      } else {
        AGG <- TRUE
      }
      return(AGG)
    })

      row_choice <- reactive({
        ROW_FUNCTION(input$row_1)
      })

      agg_choice <- reactive ({
        AGG_FUNCTION(input$agg_1, input$row_1)
      })

      col_choice <- reactive({
        COLUMN_FUNCTION(input$agg_1, input$col, input$row_1)
      })

      df <- reactive ({
        if (AGG() == FALSE && ROW() == TRUE) {
          table <- row_choice()
        } else if (AGG() == TRUE && ROW() == TRUE && COLUMN() == FALSE) {
          table <- agg_choice()
        } else {
          table <- col_choice()
        }
        return(table)
      })

      TWO_INPUTS <- reactive({
        if (is.null(input$row_2) || length(input$row_2) == 0) {
          TWO_INPUTS <- FALSE
        } else {
          TWO_INPUTS <- TRUE
        }
        return(TWO_INPUTS)
      })

      to_bind <- reactive({

        if (TWO_INPUTS() == TRUE) {
          if (is.null(input$agg_2) || length(input$agg_2) == 0) {
            table <- bind_rows(df(), TITLE_ROW(CapStr(input$row_2)))
          } else {
            table <- bind_rows(df(), COLUMN_FUNCTION(input$agg_2, input$col, input$row_2))
          }
        } else {
         table <- df()
        }

      })

      to_bind()

  })

}


shinyApp(ui, server)