Развернуть коробку на блестящей панели R на клавиатуре - PullRequest
Новая
       15

Развернуть коробку на блестящей панели R на клавиатуре

1 голос
/ 17 марта 2019

Исходя из этого вопроса R Свернуть окно блестящей панели блеска при вводе кнопки действия и вопрос Как вручную свернуть окно в блестящей панели управления , я хотел бы заменить actionButton на radioButtons (или selectInput). Ниже воспроизводимый пример. Когда я нажимаю «да», я хочу, чтобы окно id = B2 и id = B3 свернулось, когда я нажимаю «нет», поле id = B1 и id = B3 свернулось, а когда возможно щелкнули, поле id = B1 и id = B2 свернулось. С кодом ниже, есть сбой, но он не работает, как задумано. 

library(shiny)
library(shinyBS)
library(dplyr)
library(shinydashboard)


# javascript code to collapse box
jscode <- "
shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"

#Design sidebar
sidebar <- dashboardSidebar(width = 225, collapsed=F, 
                            sidebarMenu(id="tabs",
                                        menuItem("zz", tabName = "zz", selected=TRUE)))

#Design body 
body <- dashboardBody(shinyjs:::useShinyjs(), 
                      shinyjs:::extendShinyjs(text = jscode),
                      tabItems(
                        tabItem(tabName = "zz", 
                                fluidRow(box(radioButtons('go','Go', choices = c("yes", "no", "maybe"))),
                                         box(id="B1", collapsible=T,  status = "primary", color="blue", solidHeader = T, 
                                             title="Test"),
                                         box(id="B2", collapsible=T,  status = "primary", color="blue", solidHeader = T, 
                                             title="Test2"),
                                         box(id="B3", collapsible=T,  status = "primary", color="blue", solidHeader = T, 
                                             title="Test3")

                                         ))
                        ))

Header <- dashboardHeader()

#Show title and the page (includes sidebar and body)
ui <- dashboardPage(Header, sidebar, body)


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

  observeEvent(input$go == "yes",

               {js$collapse("B2", "B3")}

  )
  #
  observeEvent(input$go == "no",

               {js$collapse("B1", "B3")}
  )

  observeEvent(input$go == "maybe",

               {js$collapse("B1", "B2")}
  )

})

shinyApp( ui = ui, server = server)

1 Ответ

1 голос
/ 18 марта 2019

Функция свертывания, которую вы дали, фактически переключает блоки, а не только сворачивает их.Поэтому прежде чем вы захотите применить эту функцию, вы должны сначала проверить, свернулся ли ящик.Это можно сделать с помощью описанной здесь функции: Как проверить, не свернулась ли блестящая коробка со стороны сервера .

Если вы также хотите открыть оставшееся окно, вы можете использоватьта же функциональность.

Кроме того, вы можете поместить все в одного наблюдателя, чтобы сделать ваш код более согласованным.

Рабочий пример: 

library(shiny)
library(shinyBS)
library(dplyr)
library(shinydashboard)
library(shinyjs)

# javascript code to collapse box
jscode <- "
shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"

collapseInput <- function(inputId, boxId) {
  tags$script(
    sprintf(
      "$('#%s').closest('.box').on('hidden.bs.collapse', function () {Shiny.onInputChange('%s', true);})",
      boxId, inputId
    ),
    sprintf(
      "$('#%s').closest('.box').on('shown.bs.collapse', function () {Shiny.onInputChange('%s', false);})",
      boxId, inputId
    )
  )
}

#Design sidebar
sidebar <- dashboardSidebar(width = 225, collapsed=F, 
                            sidebarMenu(id="tabs",
                                        menuItem("zz", tabName = "zz", selected=TRUE)))

#Design body 
body <- dashboardBody(shinyjs:::useShinyjs(), 
                      shinyjs:::extendShinyjs(text = jscode),
                      tabItems(
                        tabItem(tabName = "zz", 
                                fluidRow(box(radioButtons('go','Go', choices = c("yes", "no", "maybe"))),
                                         box(id="B1", collapsible=T,  status = "primary", color="blue", solidHeader = T, 
                                             title="Test"),
                                         collapseInput(inputId = "iscollapsebox1", boxId = "B1"),
                                         box(id="B2", collapsible=T,  status = "primary", color="blue", solidHeader = T, 
                                             title="Test2"),
                                         collapseInput(inputId = "iscollapsebox2", boxId = "B2"),
                                         box(id="B3", collapsible=T,  status = "primary", color="blue", solidHeader = T, 
                                             title="Test3"),
                                         collapseInput(inputId = "iscollapsebox3", boxId = "B3")
                                ))
                      ))

Header <- dashboardHeader()

#Show title and the page (includes sidebar and body)
ui <- dashboardPage(Header, sidebar, body)

server <- shinyServer(function(input, output, session){
  observeEvent(input$go,{
    box1_collapsed = F
    box2_collapsed = F
    box3_collapsed = F
    if (!is.null(input$iscollapsebox1)){
      box1_collapsed <- input$iscollapsebox1
    }
    if (!is.null(input$iscollapsebox2)){
      box2_collapsed <- input$iscollapsebox2
    }
    if (!is.null(input$iscollapsebox3)){
      box3_collapsed <- input$iscollapsebox3
    }
    if (input$go == 'yes'){
      if (!box2_collapsed){
        js$collapse("B2")}
      if (!box3_collapsed){
        js$collapse("B3")}
      # if you want to open B1
      if (box1_collapsed){
        js$collapse("B1")}
    } else if (input$go == 'no'){
      if (!box1_collapsed){
        js$collapse("B1")}
      if (!box3_collapsed){
        js$collapse("B3")}
      # if you want to open B2
      if (box2_collapsed){
        js$collapse("B2")}
    } else if (input$go == 'maybe'){
      if (!box1_collapsed){
        js$collapse("B1")}
      if (!box2_collapsed){
        js$collapse("B2")}
      # if you want to open B3
      if (box3_collapsed){
        js$collapse("B3")}
    }
  })
})

shinyApp( ui = ui, server = server)
...