Alternate Steuerung eines sliderInput zwischen einem abgeleiteten Wert und einem benutzerdefinierten Wert

Ich habe eine sehr einfache Shiny-App, in der ich eine Reihe von Daten zu früheren Kunden und eine Reihe von Daten zu drei neuen Kunden habe. Alle meine Daten bestehen nur aus 2 Variablen: Alter und Punktzahl.

Der Zweck ist es, einen der 3 neuen Kunden auszuwählen und zu sehen, wie die früheren Kunden ähnlichen Alters abschnitten. Wir machen das mit einem einfachen Streudiagramm.

Da beispielsweise Neukunde Nr. 1 30 Jahre alt ist, können wir sehen, wie alle früheren Kunden im Alter von 25 bis 35 Jahren bewertet wurden:

(Ich entschuldige mich für das kleine Bild)

Alles funktioniert gut. Das Problem beginnt, wenn ich einen Altersregler hinzufüge, um dem Benutzer zu ermöglichen, die vom Alter des neuen Kunden hinter den Kulissen bereitgestellte Standardansicht zu überschreiben.

Um mit dem Beispiel fortzufahren, sagen wir, wir sind neugierig zu sehen, wie frühere Kunden mit einem Alter von beispielsweise 18 bis 40 Jahren nicht mehr nur mit einem Alter von 25 bis 35 Jahren bewertet wurden.

Irgendwie muss ich einen zweistufigen Prozess implementieren:

Untersetzung der Daten muss mit einem fest codierten + - 5 in Bezug auf das Alter des ausgewählten Neukunden beginnen.NEXT - Die Teilmenge der Daten muss über den Schieberegler auf der Benutzeroberfläche gesteuert werden.

Ich stehe vor dem grundsätzlichen Problem, Shiny anzuweisen, auf zwei verschiedene Arten und zu unterschiedlichen Zeiten zwischen der Benutzeroberfläche und den Daten zu kommunizieren. Irgendwelche Ideen, wie ich das durchstehen kann?

Full Code zu folgen ... aber ich denke laut hier: Ich muss irgendwie ändern:

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) })

z

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])), ] })

Vielen Dank

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)

Antworten auf die Frage(2)

Ihre Antwort auf die Frage