Альтернативное управление sliderInput между производным значением и выбранным пользователем значением
У меня есть очень простое приложение Shiny, в котором у меня есть набор данных о прошлых клиентах и набор данных о 3 новых клиентах. Все мои данные состоят только из 2 переменных: возраст и оценка.
Цель состоит в том, чтобы выбрать одного из 3 новых клиентов, и посмотреть, как забили прошлые клиенты того же возраста. Мы делаем это с помощью простой диаграммы рассеяния.
Например, поскольку новому клиенту № 1 исполнилось 30 лет, мы увидим, как все прошлые клиенты в возрасте от 25 до 35 лет набрали:
(мои извинения за маленькое изображение)
Все отлично работает Проблема начинается, когда я добавляю ползунок возраста с намерением позволить пользователю переопределить представление по умолчанию, предоставляемое за кулисами возрастом нового клиента.
Для продолжения примера, скажем, нам любопытно посмотреть, как забивали прошлые клиенты, скажем, в возрасте от 18 до 40 лет, а не только в возрасте от 25 до 35 лет.
Почему-то мне нужно реализовать двухэтапный процесс:
подмножество данных должно начинаться с жесткого кода + - 5 в зависимости от возраста нового выбранного клиента.NEXT - подмножество данных должно контролироваться с помощью ползунка на интерфейсе пользователя.Я сталкиваюсь с фундаментальной проблемой - сказать Shiny об обмене данными между пользовательским интерфейсом и данными двумя разными способами, в разное время. Любые идеи о том, как я могу пройти через это?
Полный код, чтобы следовать ... но я думаю здесь вслух: мне как-то нужно изменить:
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)