shinyWidgets::prettyRadioButtons() and shinydashboard::updateTabItems()

Q1: shiny::tabsetPanel() and shiny::updateTabsetPanel working fine as refer to some references, however shinydashboard::dashboardSidebar() and shinydashboard::updateTabItems() sounds do not work... wonder how to use updatePrettyRadioButtons.

Q2: shinyWidgets::prettyRadioButtons() doesn't working fine as The alignment of Label on Radio Button · Issue #484 · dreamRs/shinyWidgets · GitHub, htmltools::tags()inside prettyRadioButtons()created an extra <div>...</div> section.

??updateTabItems

Examples

## Only run this example in interactive R sessions
if (interactive()) {

ui <- dashboardPage(
  dashboardHeader(title = "Simple tabs"),
  dashboardSidebar(
    sidebarMenu(
      id = "tabs",
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Widgets", tabName = "widgets", icon = icon("th"))
    ),
    actionButton('switchtab', 'Switch tab')
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "dashboard",
        h2("Dashboard tab content")
      ),
      tabItem(tabName = "widgets",
        h2("Widgets tab content")
      )
    )
  )
)

server <- function(input, output, session) {
  observeEvent(input$switchtab, {
    newtab <- switch(input$tabs,
      "dashboard" = "widgets",
      "widgets" = "dashboard"
    )
    updateTabItems(session, "tabs", newtab)
  })
}

shinyApp(ui, server)
}

By refer to above example, I try to move the switchtab to panel, and then the switch button doesn't work. Wanna use radio buttons to link to specific tab accordingly...

ui.R

require('shiny')
require('shinythemes')
require('shinydashboard')
require('dashboardthemes')
require('shinyWidgets')
require('shinyjs')
require('memoise')
if(!require('XML')) devtools::install_github('omegahat/XML')
require('XML')

### creating custom logo object
logo <- shinyDashboardLogoDIY(
  boldText = 'ξηg', 
  mainText = 'Lιαη Ημ', 
  textSize = 16, 
  badgeText = '🐉 ®γσ', 
  badgeTextColor = 'white', 
  badgeTextSize = 2, 
  badgeBackColor = "#40E0D0", 
  badgeBorderRadius = 3)

alignCenter <- memoise(function(el) {
  htmltools::tagAppendAttributes(el, style="width:500vw;height:100vh;background-color:#fff;display:flex;align-items:center;justify-content:center;")
})

ui <- shinyUI(
  dashboardPage(
  dashboardHeader(title = logo),
  
  dashboardSidebar(
    sidebarMenu(id = 'tabs', 
      menuItem('®️Studio ☁️', tabName = 'menu', 
               ## https://getbootstrap.com/docs/3.4/components/#glyphicons
               ## https://fontawesome.com/icons
               icon = icon('fa-brand fa-linux'), startExpanded = TRUE, 
               menuSubItem('🏠 Home', tabName = 'home'),
               menuSubItem('🇬🇧 ENGLISH', tabName = 'en'), 
               menuSubItem('🇨🇳 简体中文', tabName = 'cn'), 
               menuSubItem('🇹🇼 繁体中文', tabName = 'tw'),
               menuSubItem('🇯🇵 日本語', tabName = 'jp'),
               menuSubItem('🇰🇷 한국어', tabName = 'kr'),
               menuSubItem('🇩🇪 Deutsch', tabName = 'de'),
               menuSubItem('🇫🇷 français', tabName = 'fr'),
               menuSubItem('🇮🇹 Italiano', tabName = 'it'))#,
      #menuItem('Appendices', icon = icon('th'), tabName = 'append', 
      #         menuSubItem('Author', tabName = 'author'))
      )),
  dashboardBody(
    shinyDashboardThemes(theme = 'blue_gradient'), 
    tabItems(
      tabItem(tabName = 'home', h2('®️Studio ☁️'), alignCenter(
        prettyRadioButtons(
          inputId = 'rb', label = '', 
          choices = c('🇬🇧 ENGLISH' = 'en',
                      '🇨🇳 简体中文' = 'cn', 
                      '🇹🇼 繁体中文' = 'tw', 
                      '🇯🇵 日本語' = 'jp', 
                      '🇰🇷 한국어' = 'kr', 
                      '🇩🇪 Deutsch' = 'de', 
                      '🇫🇷 Français' = 'fr', 
                      '🇮🇹 Italiano' = 'it'), 
          shape = 'curve', animation = 'pulse', 
          selected = character(0), status = 'primary', 
          thick = TRUE, width = '100%', bigger = TRUE, 
          icon = icon('registered'))
        )), 
      tabItem(tabName = 'en', h2('🇬🇧 ENGLISH'), 
              tags$iframe(src = 'http://rpubs.com/englianhu/ryo-en', 
                          height = 800, width = '100%', frameborder = 0)#, 
              #HTML(readLines('www/ryo-en.html')), 
              #fluidPage(includeHTML('www/ryo-en.html'))
              ), 
      tabItem(tabName = 'cn', h2('🇨🇳 简体中文'), 
              #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-cn', 
              #            height = 800, width = '100%', frameborder = 0), 
              #HTML(readLines('www/ryo-cn.html')), 
              fluidPage(includeHTML('www/ryo-cn.html'))), 
      tabItem(tabName = 'tw', h2('🇹🇼 繁体中文'), 
              #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-tw', 
              #            height = 800, width = '100%', frameborder = 0), 
              #HTML(readLines('www/ryo-tw.html')), 
              fluidPage(includeHTML('www/ryo-tw.html'))), 
      tabItem(tabName = 'jp', h2('🇯🇵 日本語'), 
              #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-jp', 
              #            height = 800, width = '100%', frameborder = 0), 
              #HTML(readLines('www/ryo-jp.html')), 
              fluidPage(includeHTML('www/ryo-jp.html'))),
      tabItem(tabName = 'kr', h2('🇰🇷 한국어'), 
              #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-kr', 
              #            height = 800, width = '100%', frameborder = 0), 
              #HTML(readLines('www/ryo-kr.html')), 
              #fluidPage(includeHTML('www/ryo-kr.html'))
              ), 
      tabItem(tabName = 'de', h2('🇩🇪 Deutsch'), 
              #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-de', 
              #            height = 800, width = '100%', frameborder = 0), 
              #HTML(readLines('www/ryo-de.html')), 
              #fluidPage(includeHTML('www/ryo-de.html'))
              ), 
      tabItem(tabName = 'fr', h2('🇫🇷 Français'), 
              #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-fr', 
              #            height = 800, width = '100%', frameborder = 0), 
              #HTML(readLines('www/ryo-fr.html')), 
              #fluidPage(includeHTML('www/ryo-fr.html'))
              ), 
      tabItem(tabName = 'it', h2('🇮🇹 Italiano'), 
              #tags$iframe(src = 'https://rpubs.com/englianhu/ryo-fr', 
              #            height = 800, width = '100%', frameborder = 0), 
              #HTML(readLines('www/ryo-fr.html')), 
              #fluidPage(includeHTML('www/ryo-fr.html'))
              )), 
    br(), 
    p('Powered by - Copyright® Intellectual Property Rights of ', 
      tags$a(href='https://www.scibrokes.com', target = '_blank', 
             tags$img(height = '20px', alt = 'scibrokes', #align='right', 
                      src='www/Scibrokes.png')), 
      HTML("<a href='https://www.scibrokes.com'>Sςιβrοκεrs Trαdιηg®</a>")))))

#shinyApp(server = server, ui = ui)

server.R

require('shiny')
require('shinythemes')
require('shinydashboard')
require('dashboardthemes')
require('shinyWidgets')
require('shinyjs')
if(!require('XML')) devtools::install_github('omegahat/XML')
require('XML')

server <- shinyServer(function(input, output, session) {
  
  #observeEvent(input$rb, {
  #       newtab <- switch(input$tabs, 
  #                        "en" = "en", 
  #                        "cn" = "cn", 
  #                        "tw" = "tw", 
  #                        "jp" = "jp")
  #       updateTabItems(session, "tabs", newtab)
  #    })
  
  #output$cv_page <- renderUI({
  #  
  #  page = switch(input$rb, 
  #                en = 'www/ryo-en.html',
  #                cn = 'www/ryo-cn.html',
  #                tw = 'www/ryo-tw.html',
  #                jp = 'www/ryo-jp.html')
  #  
    #HTML(markdown::markdownToHTML('ryo-en.md'))
    #HTML(rmarkdown::render(knit('ryo-en.Rmd')))
  #  includeHTML(page)
  #})
  
  #observeEvent(input$rb, {
  #  newtab <- switch(input$tabs,
  #                   "home" = "home",
  #                   "en" = "en", 
  #                   "cn" = "cn",
  #                   "tw" = "tw", 
  #                   "jp" = "jp",
  #                   "author" = "author")
  #  updateTabItems(session, "tabs", newtab)
  #})
  
  #observeEvent(input$rb == 'en', {
  #  updateTabItems(session, "tabs", selected = "en")
  #})
  
  #observeEvent(input$rb == 'cn', {
  #  updateTabItems(session, "tabs", selected = "cn")
  #})
  
  #observeEvent(input$rb == 'tw', {
  #  updateTabItems(session, "tabs", selected = "tw")
  #})
  
  #observeEvent(input$rb == 'jp', {
  #  updateTabItems(session, "tabs", selected = "jp")
  #})
  
  #output$ryo_en <- renderUI({
  #  #HTML(markdown::markdownToHTML('ryo-en.md'))
  #  #HTML(rmarkdown::render(knit('ryo-en.Rmd')))
  #  includeHTML("ryo-en.html")
  #})
  
  #output$ryo_cn <- renderUI({
  #  #HTML(markdown::markdownToHTML('ryo-en.md'))
  #  #HTML(rmarkdown::render(knit('ryo-en.Rmd')))
  #  includeHTML("ryo-cn.html")
  #})
  
  #output$ryo_tw <- renderUI({
  #  #HTML(markdown::markdownToHTML('ryo-en.md'))
  #  #HTML(rmarkdown::render(knit('ryo-en.Rmd')))
  #  includeHTML("ryo-tw.html")
  #})
  
  #output$ryo_jp <- renderUI({
  #  #HTML(markdown::markdownToHTML('ryo-en.md'))
  #  #HTML(rmarkdown::render(knit('ryo-en.Rmd')))
  #  includeHTML("ryo-jp.html")
  #})
  
  #observeEvent(input$rb, {
  #  updateTabItems(session, input$rb,
  #                    selected = input$rb)
  #})
  
  observeEvent(input$rb, {
    #tbs <- c('en', 'cn', 'tw', 'jp', 'kr', 'de', 'fr', 'it')
    newtab <- switch(input$tabs, 
                     'en' = 'en', 
                     'cn' = 'cn', 
                     'tw' = 'tw', 
                     'jp' = 'jp', 
                     'kr' = 'kr', 
                     'de' = 'de', 
                     'fr' = 'fr', 
                     'it' = 'it')
    updateTabItems(session, 'tabs', newtab)#, selected = input$rb)
  })
})

#shinyApp(server = server, ui = ui)
shinyApp(server = server, ui = ui)

Reference


Current output as above, the choices do not align same line with radio buttons


Expected output as above, the choices do align same line with radio buttons


Expected output as above will be BEST, the choices do align same line with radio buttons with stepwise effect (animated bounce-in or fly-in will be wonderful)


Question : shinyWidgets::prettyRadioButtons() The alignment of Choices on Radio Button #484

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.