在派生值和用户选择的值之间交替控制 sliderInput

Question

我有一个非常简单的 Shiny 应用程序，其中我有一组关于过去客户的数据，以及一组关于 3 个新客户的数据。我所有的数据只包含 2 个变量：年龄和分数。

目的是select3个新顾客之一，看看过去年龄相仿的顾客打分如何。我们用一个简单的散点图来做到这一点。

例如，由于新客户 #1 是 30 岁，我们可以看到所有年龄在 25 - 35 岁之间的过去客户的得分：

（我为小图片道歉）

一切正常。当我添加一个年龄滑块以允许用户覆盖由新客户的年龄在幕后提供的默认视图时，问题就开始了。

继续这个例子，假设我们很想知道年龄在 18 到 40 岁之间的过去顾客的评分，而不仅仅是年龄在 25 到 35 岁之间的顾客。

不知何故，我需要实施一个两步过程：

数据的子集化需要从硬编码的 +- 5 开始，相对于 selected 新客户的年龄。
NEXT -- 数据的子集化需要通过UI上的滑块来控制。

我面临一个基本问题，即告诉 Shiny 在不同时间以两种不同方式在 UI 和数据之间进行通信。关于如何度过难关，我有什么想法吗？

要遵循的完整代码...但我在这里大声思考：我不知何故需要更改：

subset_historic_customers <- reactive({ DF <- historic_customers[which((historic_customers$age >= get_selected_customer()$age-5) & (historic_customers$age <= get_selected_customer()$age+5)), ] return(DF) })

到

subset_historic_customers <- reactive({ # start the same as above: DF <- historic_customers[which((historic_customers$age >= get_selected_customer()$age-5) & (historic_customers$age <= get_selected_customer()$age+5)), ] return(DF) # ...but if someone uses the age selection slider, then: DF <- historic_customers[which((historic_customers$age >= input$age[1]) & (historic_customers$age <= input$age[2])), ] })

谢谢！

app.R

## app.R ##
server <- function(input, output) {

  new_customers <- data.frame(age=c(30, 35, 40), score=c(-1.80,  1.21, -0.07))
  historic_customers <- data.frame(age=sample(18:55, 500, replace=T), score=(rnorm(500)))

  get_selected_customer <- reactive({cust <- new_customers[input$cust_no, ]
                                     return(cust)})


  subset_historic_customers <- reactive({
    DF <- historic_customers[which((historic_customers$age >= get_selected_customer()$age-5) & (historic_customers$age <= get_selected_customer()$age+5)), ]
#    DF <- historic_customers[which((historic_customers$age >= input$age[1]) & (historic_customers$age <= input$age[2])), ]

    return(DF)
    })

  output$distPlot <- renderPlot({
    plotme <<- subset_historic_customers()
    p <- ggplot(data=plotme, aes(x=plotme$age, y=plotme$score))+ geom_point()
    my_cust_age <- data.frame(get_selected_customer())
    p <- p + geom_vline(data=my_cust_age, aes(xintercept=age))
    print(p)
    })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      numericInput(inputId="cust_no", label="Select new customer:", value=1),
      sliderInput(inputId="age", "Age of historic customer:", min=18, max = 55, value=c(18, 55), step=1, ticks=TRUE)
    ),
    mainPanel(plotOutput("distPlot"))
  )
)

shinyApp(ui = ui, server = server)

Answer 1

我相信这就是您想要的代码。不太复杂，希望对你有帮助

new_customers <- data.frame(age=c(30, 35, 40), score=c(-1.80,  1.21, -0.07))
historic_customers <- data.frame(age=sample(18:55, 500, replace=T), score=(rnorm(500)))

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

  get_selected_customer <- reactive({
    new_customers[input$cust_no, ]
  })

  observe({
    cust <- get_selected_customer()
    updateSliderInput(session, "age", value = c(cust$age - 5, cust$age + 5))
  })

  subset_historic_customers <- reactive({
    DF <- historic_customers[which((historic_customers$age >= input$age[1]) &
                                     (historic_customers$age <= input$age[2])), ]
    DF
  })

  output$distPlot <- renderPlot({
    plotme <- subset_historic_customers()
    p <- ggplot(data=plotme, aes(x=age, y=score))+ geom_point()
    my_cust_age <- data.frame(get_selected_customer())
    p <- p + geom_vline(data=my_cust_age, aes(xintercept=age))
    p
  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      numericInput(inputId="cust_no", label="Select new customer:", value=1),
      sliderInput(inputId="age", "Age of historic customer:", min=18, max = 55, value=c(18, 55), step=1, ticks=TRUE)
    ),
    mainPanel(plotOutput("distPlot"))
  )
)

shinyApp(ui = ui, server = server)

在派生值和用户选择的值之间交替控制 sliderInput

Alternate control of a sliderInput between a derived value and user selected value

r

shiny

data-visualization