用 Shiny 离散化连续变量

Question

我正在尝试创建一个灵活的 Shiny 接口来离散化连续变量。例如，我希望用户查看mtcars$mpg，选择n 级别，为每个n 级别选择min 和max，然后给出新离散变量的直方图。显然，cuts 是 R 中的主要功能，但主要挑战是创建足够灵活的界面。

这是我尝试过的：

server <- function(input, output) {

output$sliders <- renderUI({
    n <- input$levels
    lapply(1:n,function(i) {
      if (i==1) {
# first slider can take on any mpg
      sliderInput(paste0("slider",i),paste0("Select range for level",i),
                  min=min(mtcars$mpg),max=max(mtcars$mpg),value=max(mtcars$mpg))
      } else {
# subsequent sliders limited to values greater than previous slider's selected value 
# here is where my problems are
        sliderInput(paste0("slider",i),paste0("Select range for level",i),
                    min=as.numeric(input[,paste0("slider",i-1)]),max=max(mtcars$mpg),value=NULL)
      }
    })
  })
  output$histo <- renderPlot({
    n <- input$levels

    steps <- c(min(mtcars$mpg))
    for (i in 1:n) {
      steps <- c(steps, input[,paste0("slider",n)])
    }

    dat <- cut(mtcars$mpg,steps)
    hist(dat)

  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      numericInput("levels", "Number of levels:", 1,min=1,max=10)
    ),
    mainPanel(h1("Discretize mpg"),uiOutput("sliders"),
              renderPlot('histo'))

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

问题是我似乎无法让后续的sliderInput 根据之前的sliderInput 的值动态呈现。重要的是每个sliderInput 都是互斥的，所以我尝试强制每个滑块的最小值为前一个滑块的值，这样就不会有重叠的间隔。

我的方法是否可行，或者我需要采取不同的方式吗？我将如何生成相互依赖的n 输入？

问候

Answer 1

这是您的output$sliders 的解决方案：

output$sliders <- renderUI({
                n <- input$levels
                lapply(1:n,function(i) {
                        if (i==1) {
                                # first slider can take on any mpg
                                sliderInput(paste0("slider",i),paste0("Select range for level",i),
                                            min=min(mtcars$mpg),max=max(mtcars$mpg),value=input[[paste0("slider",i)]])
                        } else {
                                if(input[[paste0("slider",i-1)]]!=max(mtcars$mpg)){
                                # subsequent sliders limited to values greater than previous slider's selected value 
                                # here is where my problems are
                                sliderInput(paste0("slider",i),paste0("Select range for level",i),
                                            min=as.numeric(input[[paste0("slider",i-1)]]),max=max(mtcars$mpg),value=input[[paste0("slider",i)]])
                                }
                        }
                })
    })

我做了一些更改：

将第一个滑块的值改为min(input$mpg)而不是max(mtcars$mpg)，否则第二个滑块没有范围。

还将其他滑块的值更改为input[[paste0("slider",i)]]，以便在更改另一个滑块时保持当前值。

你的renderPlot 也有问题，你不能用切割制作直方图，你需要输入hist 函数数据并使用break 参数定义切割。

Answer 2

这让我有几个滑动条

    library(shiny)
server <- function(input, output) {

        output$sliders <- renderUI({
                n <- input$levels
                lapply(1:n,function(i) {
                        if (i==1) {
                                # first slider can take on any mpg
                                sliderInput(paste0("slider",i),paste0("Select range for level",i),
                                            min=min(mtcars$mpg),max=max(mtcars$mpg),value=max(mtcars$mpg))
                        } else {
                                # subsequent sliders limited to values greater than previous slider's selected value 
                                # here is where my problems are
                                sliderInput(paste0("slider",i),paste0("Select range for level",i),
                                            min=as.numeric(eval(paste0("input$","slider",i-1))),max=max(mtcars$mpg),value=NULL)
                        }
                })
        })
        output$histo <- renderPlot({
                n <- input$levels

                steps <- c(min(mtcars$mpg))
                for (i in 1:n) {
                        steps <- c(steps, eval(paste0("input$","slider",n)))
                }

                dat <- cut(mtcars$mpg,steps)
                hist(dat)

        })
}

ui <- fluidPage(
        sidebarLayout(
                sidebarPanel(
                        numericInput("levels", "Number of levels:", 1,min=1,max=10)
                ),
                mainPanel(h1("Discretize mpg"),uiOutput("sliders"),
                          renderPlot('histo'))

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