In hiplot/bs4Dash2: A 'Bootstrap 4' Version of 'shinydashboard'

knitr::opts_chunk$set(echo = TRUE)

Accordion

Accordions are a category of collapsible elements. While collapsible items do not alter the state of other items in the same collapsible container, each accordion item will toggle any other opened accordion, to ensure that only 1 item is visible at once. accordion() expects to contain accordionItems(). Importantly, to guaranty the uniqueness of each accordion, we must provide an id parameter. This parameter allows to programmatically toggle any accordion item, through an updateAccordion() function.

library(shiny)
library(bs4Dash)

 shinyApp(
  ui = dashboardPage(
    dashboardHeader(),
    dashboardSidebar(),
    dashboardBody(
      radioButtons("controller", "Controller", choices = c(1, 2)),
      br(),
      accordion(
       id = "accordion1",
        accordionItem(
          title = "Accordion 1 Item 1",
          status = "danger",
          collapsed = TRUE,
          "This is some text!"
        ),
        accordionItem(
          title = "Accordion 1 Item 2",
          status = "warning",
          collapsed = FALSE,
          "This is some text!"
        )
      ),
      accordion(
       id = "accordion2",
        accordionItem(
          title = "Accordion 2 Item 1",
          status = "info",
          collapsed = TRUE,
          "This is some text!"
        ),
        accordionItem(
          title = "Accordion 2 Item 2",
          status = "success",
          collapsed = FALSE,
          "This is some text!"
        )
      )
    ),
    title = "Accordion"
  ),
  server = function(input, output, session) {
    observeEvent(input$controller, {
      updateAccordion(id = "accordion1", selected = input$controller)
    })

    observe(print(input$accordion1))

    observeEvent(input$accordion1, {
      toast(sprintf("You selected accordion N° %s", input$accordion1))
    })
  }
 )

User messages

{bs4Dash} make it possible to create an entire chat system within a Shiny app. userMessages() is the main container, userMessage() being the message element. updateUserMessages() looks for the userMessages() id so as to:

• Remove an existing message.
• Add a new message.
• Edit an existing message.

Importantly, we assume that a message structure is composed as follows:

list(
  author = "David",
  date = "Now",
  image = "https://i.pinimg.com/originals/f1/15/df/f115dfc9cab063597b1221d015996b39.jpg",
  type = "received",
  text = tagList(
    sliderInput(
      "obs", 
      "Number of observations:",
      min = 0, 
      max = 1000, 
      value = 500
    ),
    plotOutput("distPlot")
  )

The type parameter controls the message background color. For a sent message, the color is inherited from the userMessages() status, while for a received message, the color is gray by default. The text argument refers to the message content. It may be simple text, shiny tags or event any combinations of shiny inputs/ouput, as shown in the below example.

shinyApp(
  ui = dashboardPage(
    dashboardHeader(),
    dashboardSidebar(),
    dashboardBody(
      fluidRow(
        actionButton("remove", "Remove message"),
        actionButton("add", "Add message"),
        actionButton("update", "Update message")
      ),
      numericInput("index", "Message index:", 1, min = 1, max = 3),
      br(),
      br(),
      userMessages(
        width = 6,
        status = "danger",
        id = "message",
        userMessage(
          author = "Alexander Pierce",
          date = "20 Jan 2:00 pm",
          image = "https://adminlte.io/themes/AdminLTE/dist/img/user1-128x128.jpg",
          type = "received",
          "Is this template really for free? That's unbelievable!"
        ),
        userMessage(
          author = "Sarah Bullock",
          date = "23 Jan 2:05 pm",
          image = "https://adminlte.io/themes/AdminLTE/dist/img/user3-128x128.jpg",
          type = "sent",
          "You better believe it!"
        )
      )
    ),
    title = "user Message"
  ),
  server = function(input, output, session) {
    observeEvent(input$remove, {
      updateUserMessages("message", action = "remove", index = input$index)
    })
    observeEvent(input$add, {
      updateUserMessages(
        "message", 
        action = "add", 
        content = list(
          author = "David",
          date = "Now",
          image = "https://i.pinimg.com/originals/f1/15/df/f115dfc9cab063597b1221d015996b39.jpg",
          type = "received",
          text = tagList(
           sliderInput(
            "obs", 
            "Number of observations:",
            min = 0, 
            max = 1000, 
            value = 500
           ),
           plotOutput("distPlot")
          )
        )
      )
    })

    output$distPlot <- renderPlot({
     hist(rnorm(input$obs))
    })

    observeEvent(input$update, {
      updateUserMessages(
        "message", 
        action = "update", 
        index = input$index,
        content = list(
         text = tagList(
          appButton(
           inputId = "reload",
           label = "Click me!", 
           icon = icon("sync"), 
           dashboardBadge(1, color = "danger")
          )
         )
        )
      )
    })

    observeEvent(input$reload, {
      toast(title = "Yeah")
    })
  }
)

hiplot/bs4Dash2 documentation built on Dec. 20, 2021, 3:51 p.m.