r - 我的闪亮代码的功能（单独的面板过滤器并为 radioButtons 选项插入 popify）

Question

朋友们我有两个问题希望得到您的帮助：首先，我想将我的两个过滤器和面板上的滑块输入分开。他们都在一起。我想让它们用一些水平线或一个特定的标签分开，使这种分离。第二个是我使用 popify 来描述使用的过滤器。在这种情况下，我使用单选按钮。但是，我想单独为过滤器选项做这件事。例如，对于过滤器 1，我还想为“所有属性”和“排除属性”选项插入 popify。那么，为同一个过滤器分开三个popify，这可能吗？可执行代码如下。

library(shinyBS)
library(shiny)

ui <- fluidPage(


  titlePanel("Old Faithful Geyser Data"),

  sidebarLayout(
    sidebarPanel(


      popify(  
      radioButtons("filter1", h3("Select properties"),
                     choices = list("All properties" = 1, 
                                    "Exclude properties" = 2),
                     selected = 1),
      title= "Select Proprierties",
      content = paste0("Filter 1 refers to.....")),


      popify(  
        radioButtons("filter2", h3("Select farms"),
                     choices = list("All farms" = 1, 
                                    "Exclude farms" = 2),
                     selected = 1),
        title= "Select farms",
        content = paste0("Filter 2 refers to.....")),

      popify(
        sliderInput("bins",
                    "Number of bins:",
                    min = 1,
                    max = 20,
                    value = 30),
        title = "Number of bins",
        content = paste0("Number of bins refers to.....")),


      ),

    mainPanel(
      plotOutput("distPlot")
    )
  )
)

server <- function(input, output) {

  output$distPlot <- renderPlot({
    # generate bins based on input$bins from ui.R
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)

    # draw the histogram with the specified number of bins
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

非常感谢你！！

标签： rshiny

Answer 1

这是一种方法。它使用 JavaScript 为每个单选按钮分配一个 ID。然后addPopover就可以使用了。

js <- "
$(document).ready(function(){
  $('#dist input[type=radio]~span').each(function(i, $el){
    $(this).attr('id', 'dist' + i);
  });
});
"

library(shiny)
library(shinyBS) 

ui <- fluidPage(
  tags$head(tags$script(HTML(js))),
  radioButtons("dist", "Distribution type:",
               c("Normal" = "norm",
                 "Uniform" = "unif",
                 "Log-normal" = "lnorm",
                 "Exponential" = "exp")),
  plotOutput("distPlot"),
  popify(span(), title = "") # an empty shinyBS component, in order to use addPopover
)

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

  output$distPlot <- renderPlot({
    dist <- switch(input$dist,
                   norm = rnorm,
                   unif = runif,
                   lnorm = rlnorm,
                   exp = rexp,
                   rnorm)
    hist(dist(500))
  })
  
  addPopover(
    session, 
    id = "dist0", 
    title = "Normal distribution",
    content = "It is also called the Gaussian distribution",
    placement = "right"
  )
  
  addPopover(
    session, 
    id = "dist1", 
    title = "Uniform distribution",
    content = "All outcomes are equally probable",
    placement = "right"
  )
  
  addPopover(
    session, 
    id = "dist2", 
    title = "Log-normal distribution",
    content = "The exponential of the normal distribution",
    placement = "right"
  )
  
  addPopover(
    session, 
    id = "dist3", 
    title = "Exponential distribution",
    content = "It is memoryless",
    placement = "right"
  )
  
}

shinyApp(ui, server)

您必须根据inputId您的单选按钮组更改 JS 代码，并将生成的 id 的前缀设置为您想要的前缀：

js <- "
$(document).ready(function(){
  $('#YOUR_inputId_GOES_HERE input[type=radio]~span').each(function(i, $el){
    $(this).attr('id', 'THE_PREFIX_YOU_WANT' + i);
  });
});
"

这生成了 ids THE_PREFIX_YOU_WANT0,THE_PREFIX_YOU_WANT1等。用于addPopover：

addPopover(session, id = "THE_PREFIX_YOU_WANT0", ......)