在派生值和用户选择的值之间对sliderInput的替代控制 [英] Alternate control of a sliderInput between a derived value and user selected value
问题描述
我有一个非常简单的Shiny应用程序，其中有一组有关过去客户的数据，以及一组有关3个新客户的数据。我所有的数据仅包含两个变量：年龄和得分。
I have a very simple Shiny app, wherein I have a set of data on past customers, and a set of data on 3 new customers. All my data consists only of 2 variables: age and score.
目的是从3个新客户中选择一个，并查看过去类似年龄的客户的得分方式。我们用一个简单的散点图来做到这一点。
The purpose is to select one of the 3 new customers, and see how the past customers of similar ages scored. We do this with a simple scatterplot.
例如，由于新客户＃1已经有30岁了，因此我们来看看过去25-35岁的所有客户如何得分：
For example, since new customer #1 is 30 years old, we get to see how all the past customers of ages 25 - 35 scored:
（我为这张小图片表示歉意）
(my apologies for the small image)
一切正常。当我添加一个年龄滑块以使用户能够根据新客户的年龄覆盖幕后提供的默认视图时，麻烦就开始了。
Everything works fine. The trouble begins when I add an age slider with the intentions of allowing the user to override the default view supplied behind the scenes by the new customer's age.
要继续使用例如，说我们很好奇，看看18至40岁的过去顾客如何得分，而不再是25至35岁。
To continue with the example, say we are curious to see how past customers of, say ages 18 - 40 scored, no longer just ages 25 - 35.
以某种方式，我需要实现一个分两步进行：
Somehow, I need to implement a two-step process:
- 数据子集需要以硬编码+ -5开头，与所选新客户的年龄有关。
- 下一个-数据的子集需要由UI上的滑块控制。
我面临着一个基本问题，那就是要告诉Shiny在不同的时间以两种不同的方式在UI和数据之间进行通信。关于如何解决这个问题的任何想法？
I'm facing a fundamental issue of telling Shiny to communicate between the UI and the data two different ways, at different times. Any ideas on how I can get through this?
要遵循的完整代码...但是我在这里大声思考：我不知何故需要更改：
Full code to follow...but I'm thinking out loud here: I somehow need to change:
subset_historic_customers<-反应性（{
DF< -history_customers [which（（（historic_customers $ age> = get_selected_customer（）$ age- 5）&（historic_customers $ age< = get_selected_customer（）$ age + 5）），]
return（DF）
}）
至
subset_historic_customers<-react（{
＃与上面相同：
DF<-Historic_customers [which（（（historic_customers $ age> = get_selected_customer（）$ age-5）&（historic_customers $ age< = get_selected_customer（）$ age + 5）），]
返回（DF）
＃...但如果有人使用年龄选择滑块，则：
DF< -historical_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)
推荐答案
我相信这是您想要的代码。不太复杂，希望对您有帮助
I believe this is the code you want. It's not too complicated, I hope it helps
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的替代控制的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
