Shiny R: Как изменить непрозрачность сюжета на основе ввода?

Question

В моем проекте ползунок управляет размером смоделированного набора данных, и диапазон размеров составляет [5,10000].

Поскольку точки данных могут перекрываться, я надеюсь получить более высокую непрозрачность при маленьком размере и меньшую непрозрачность при большом размере.

Я попытался использовать reactiveValue и ObservationEvent, но непрозрачность не изменилась при 0,2:

o<- reactiveValues(data = NULL)
observeEvent(input$size<100,{
  o$data<-1
})
observeEvent(input$size>=100,{
  o$data<-0.2
})

p<-plot_ly()%>%
    add_trace(x=x,y=y1,type = 'scatter',mode = 'lines', name = "y1=a1+b1*x",line = list(color = 'rgb(255, 129, 10)'))%>%
    add_trace(x=round(random_x,4),y= round(y1_data,4),  opacity=o$data,name = 'y1_data',type = 'scatter',mode = 'markers',marker = list(size = 5, color ='rgb(255, 129, 10)')         

Вот соответствующий код:

sliderInput("size", "Select the sample size",min = 5,max = 10000,value = NULL,step = 1)

        random_x<- rnorm(input$size,mean = 0, 3)
        random_num1<- rnorm(input$size, mean=0, sd=input$sd1)
        random_num2<- rnorm(input$size, mean=0, sd=input$sd2)

        y1_data<- random_num1 + random_x*input$b1+input$a1
        y2_data<- 1/(1+exp(random_num2-input$a2-input$b2 * random_x))


        x<- seq(-10,10,0.1)
        y1<- x*input$b1+input$a1
        y2<- 1/(1+exp(-input$a2-input$b2*x))

        #plot
        p<-plot_ly()%>%
            layout(xaxis = list(range=c(-10,10)), yaxis = list(range=c(-32,32)))

        if (input$simple){
            p<-p%>%
                add_trace(x=x,y=y1,type = 'scatter', mode = 'lines', name = "y1=a1+b1*x",line = list(color = 'rgb(255, 129, 10)'))%>%
                add_trace(x=round(random_x,4),y= round(y1_data,4), name = 'y1_data',
                          type = 'scatter',mode = 'markers',marker = list(size = 5, color ='rgb(255, 129, 10)'))
            }

        if (input$logistic) {
            p<-p%>%
                add_trace(x=x,y=y2,type = 'scatter', mode = 'lines', name = "y2=1/(exp(-a2-b2*x))", line = list(color = 'rgb(22, 96, 167)'))%>%
                add_trace(x=round(random_x,4),y= round(y2_data,4), name = 'y2_data',
                          type = 'scatter',mode = 'markers',marker = list(size = 5, color ='rgb(22, 96, 167)'))
        }

Answer 1

Я подозреваю, что оба ваших observeEvent метода вызываются, когда ползунок меняет значение. Тогда, даже если ваш reactiveValues o$data изменится на 1 на один observeEvent, он будет немедленно перезаписан с .2 другим observeEvent. Вместо этого, можете ли вы упростить до одного оператора observeEvent (или до одного observe)? Попробуйте что-нибудь подобное ниже и посмотрите, будет ли вести себя так, как вы хотите.

library(shiny)

ui <- fluidPage(
  sliderInput("size", "Select the sample size", min = 5, max = 1000, value = NULL, step = 1)
)

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

  o <- reactiveValues(data = NULL)

  observe({
    if (input$size < 100) {
      o$data <- 1
    } else {
      o$data <- .2
    }
    print(o$data)
  })

}

shinyApp(ui, server)