Controle alternativo de um controle deslizanteEntrada entre um valor derivado e o valor selecionado pelo usuário
Eu tenho um aplicativo Shiny muito simples, no qual tenho um conjunto de dados de clientes anteriores e um conjunto de dados de 3 novos clientes. Todos os meus dados consistem apenas em 2 variáveis: idade e pontuação.
O objetivo é selecionar um dos três novos clientes e ver como os clientes anteriores de idades semelhantes foram pontuados. Fazemos isso com um gráfico de dispersão simples.
Por exemplo, como o novo cliente nº 1 tem 30 anos, podemos ver como todos os clientes anteriores das idades de 25 a 35 tiveram sua pontuação:
(minhas desculpas pela imagem pequena)
Tudo funciona bem. O problema começa quando adiciono um controle deslizante de idade com a intenção de permitir que o usuário substitua a exibição padrão fornecida nos bastidores pela idade do novo cliente.
Para continuar com o exemplo, digamos que estamos curiosos para ver como os clientes anteriores, digamos, entre 18 e 40 anos, obtiveram pontuação, não mais apenas entre 25 e 35 anos.
De alguma forma, preciso implementar um processo de duas etapas:
O subconjunto dos dados precisa COMEÇAR com um + - 5 codificado em relação à idade do novo cliente selecionado.NEXT - o subconjunto dos dados precisa ser controlado pelo controle deslizante na interface do usuário.Estou enfrentando uma questão fundamental de dizer ao Shiny para se comunicar entre a interface do usuário e os dados de duas maneiras diferentes, em momentos diferentes. Alguma idéia de como posso superar isso?
Código completo a seguir ... mas estou pensando em voz alta aqui: preciso de alguma forma mudar:
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) })
para
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])), ] })
Obrigado!
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)