dqshiny

Enhance Shiny Apps with Customizable Modules

https://github.com/daqana/dqshiny
https://cran.r-project.org/web/packages/dqshiny/index.html
(https://cran.r-project.org/web/packages/dqshiny/dqshiny.pdf)
https://www.rdocumentation.org/packages/dqshiny/versions/0.0.3
https://www.rdocumentation.org/packages/dqshiny/versions/0.0.3/source
https://www.daqana.org/

rhandsontable paging & enhance

# UI —————————————————————————
header       <- dashboardHeaderPlus(fixed=T, enable_rightsidebar=T, rightSidebarIcon="gears")
sidebar      <- dashboardSidebar(uiOutput("sidebarMenu"))
rightsidebar <- rightSidebar(uiOutput("rightsidebarMenu"))
footer       <- dashboardFooter()

ui <- dashboardPagePlus(
  header, sidebar, rightsidebar,
  body = dashboardBody(
    useShinyjs(),
    tags$head(tags$style(HTML(".content { margin-top: 50px;}"))),
    
    #rHandsontableOutput("tableData")
    dq_handsontable_output("tableData", width=12L, offset=0L)
  ),
  footer
)
# SERVER ———————————————————————–
server <- function(input, output, session) {
  dd = data.table(
    val = 1:10, 
    bool = TRUE, 
    big = LETTERS[1:10],
    small = letters[1:10],
    dt = seq(from = Sys.Date(), by = "days", length.out = 10)
  )
  
  # output$tableData <- renderRHandsontable(
  #   rhandsontable(dd)
  # )
  "tableData" %>% dq_render_handsontable(data=dd,
    filters = c("Sel", "Text", NA, "Auto"),
    sorting = TRUE,
    page_size = c(16L, 500L, 1000L),
    col_param = list(list(col = 3L, format = "0.00")),
    cell_param = list(list(row = 2:9, col = 2L, readOnly = TRUE))
  )
}
shinyApp(ui, server)

filters = c(“A”, NA, NA, NA),

filters = list(list(type = “T”, value = “init”), NA, “T”, …)

sorting = c(dir = “up”, col = “B”),

col_param = list(list(col = 1L, type = “dropdown”, source = letters)),

cell_param = list(list(row = 2:9, col = 1:2, readOnly = TRUE))

대량 selectInput

# create 100k random words
opts <- sapply(1:100000, function(i) paste0(sample(letters, 7), collapse=""))

shinyApp(
  ui = fluidPage(
    fluidRow(
      column(3,
        # feel free to test this with select... and may get yourself a coffee
        # , selectInput("sel", "Select:", opts)
        autocomplete_input("auto1", "Unnamed:", max_options=1000,
                           options=opts),
        autocomplete_input("auto2", "Named:",   max_options=1000,
                           options=structure(opts, names=opts[order(opts)]))
      ), 
      column(3,
        tags$label("Value:"), verbatimTextOutput("val1", placeholder=T),
        tags$label("Value:"), verbatimTextOutput("val2", placeholder=T)
      )
    )
  ),
  server = function(input, output) {
    output$val1 <- renderText(as.character(input$auto1))
    output$val2 <- renderText(as.character(input$auto2))
  }
)

Child box

library(shiny)
library(dqshiny)

shinyApp(
  ui = fluidPage(
    fluidRow(
      dq_box(title="child boxes", collapsed=F, fill=F,
        dq_infobox(icon=icon("hashtag"), title="Hello", value=2, subtitle="World", bg_color="black", color="#D00"),
        dq_box(title="Box in the box", width=8, bg_color="red",  dq_space())
      )
    )
  ),
  server = function(input, output) {}
)

change an elements classes

ui = fluidPage(
  tags$head(tags$style(".orange{background:#ff8f00}")),
  
  actionButton("add",         "Add Class"),
  actionButton("remove",      "Remove Class"),
  actionButton("toggle",      "Toggle Class"),
  actionButton("toggle_cond", "Toggle Class with Condition"),
  
  checkboxInput("condition", "orange"),
  
  fluidRow(id = "row",
    dq_space(),                   # this is needed to make everything work
    actionButton("example", "EXAMPLE"),
    dq_space()                    # this is just for the alignment ;)
  )
)
server = function(input, output) {
  observeEvent(input$add,         add_class("row", "orange"))
  observeEvent(input$remove,      remove_class("row", "orange"))
  observeEvent(input$toggle,      toggle_class("row", "orange"))
  observeEvent(input$toggle_cond, toggle_class("row", "orange", input$condition))
}
shinyApp(ui, server)

Adds JS function

ui = fluidPage(
  actionButton("btn1", "Add Values"),
  add_js(type="addValues", "function(params) {
            alert('Result is: '+(parseInt(params[0])+parseInt(params[1])));
          }"),
  actionButton("btn2", "What's my name?"),
  add_js(type="myName", "function(params) {
            alert('My name is ' + params.name);
          }")
)
server = function(input, output) {
  observeEvent(input$btn1, run_js(type="addValues", 17, 25))
  observeEvent(input$btn2, run_js(type="myName", name="Paul"))
}
shinyApp(ui, server)

ui = fluidPage(
  numericInput("clickBtn", "Click Btn Nr:", value=1, min=1, max=3, step=1),
  actionButton("btn1", "1"),
  actionButton("btn2", "2"),
  actionButton("btn3", "3"), 
  dq_space(),
  textOutput("result")
)
server = function(input, output) {
  observeEvent(input$clickBtn, ignoreInit=T,
               click(str_c("btn", input$clickBtn))
  )
  output$result <- renderText(
    str_c("Buttons clicked:", toString(c(input$btn1, input$btn2, input$btn3)))
  )
}
shinyApp(ui, server)