用Shiny去除连续变量

时间:2016-02-09 00:18:40

标签: r shiny

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

以下是我的尝试:

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输入?

此致

2 个答案:

答案 0 :(得分: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参数定义切割

答案 1 :(得分:0)

这让我有几个滑动条

    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)