Блог

Я уже некоторое время пытаюсь отладить свой блестящий гаджет, но все еще не могу с ним справиться. Действительно ценю любую помощь.

Мой гаджет состоит из диаграммы рассеяния, сгенерированной с помощью Plotly. Пользователь может щелкнуть одну из точек, что позволит вам изменить некоторые параметры, связанные с этой точкой. Чтобы подчеркнуть тот факт, что пользователь выбрал эту точку, я хотел выделить выбранную точку.

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

В качестве дополнительной функции я хочу дополнительно выделить точки, которые находятся ниже определенного порога на оси x. Этот порог представлен пунктирной линией, которую вы можете включать и выключать, а также перемещать значение порога.

Таким образом, все точки на графике должны быть синими кружками, за исключением следующих двух случаев:

1. если щелкнуть по ней, т. Е. Это «активная точка» (это должно создать красную рамку вокруг точки)
2. если оно ниже порогового значения по оси x (точка должна превратиться в оранжевый квадрат)

Если он активен и ниже порогового значения, он должен быть оранжевым квадратом с красной рамкой, как и следовало ожидать.

Мой гаджет вроде как работает. Но в некоторых случаях нет. В приведенном ниже примере одна из точек уже находится ниже порогового значения, но когда я выбираю эту точку, красный маркер появляется в другой точке! Несмотря на то, что активная переменная является правильной.

Я также получаю странное поведение, когда точки становятся фиолетовыми, если пороговое значение ниже всех точек. Но если я переместу пороговое значение выше одной из точек, цвета будут исправлены.

У меня есть подозрение, что это как-то связано с тем, что точки находятся на разных трассах? Поэтому, когда я пытаюсь выделить определенные точки, возможно, я не индексирую вектор так, как ожидаю. Но я нахожу, что действительно сложно отлаживать внутри Shiny и Plotly, и я плохо понимаю объект Plotly, поэтому я не очень понимаю, что происходит.

Приведенный ниже код является воспроизводимым примером. Вы должны запустить «dat1» через функцию «rew8r». Я убрал другие функции приложения, чтобы попытаться сосредоточиться на проблеме. Большое спасибо всем, кто мог бы найти время, чтобы взглянуть на это и дать какие-либо подсказки!

 library(plotly)
library(dplyr)
library(shiny)
library(reactable)

dat1 <- data.frame(
  Indicator = c("v1","v2","v3"),
  Weight = rep(1,3),
  Correlation = c(0.1, 0.8, 0.6) )

rew8r <- function(dat){

# get indicator names
inames <- dat$Indicator

## Create the shiny UI layout
ui <- fluidPage(
  # the side panel
  sidebarPanel(
    selectInput("vseldrop", "Select indicator here or by clicking a point on plot.",
                c("<Select>",inames)),
    hr(style = "border-top: 1px solid #000000;"),
    fluidRow(
      column(6,numericInput("locorval", "Low correlation threshold:", 0.2, min = -1, max = 1, step = 0.05)),
      column(6,br(),checkboxInput("locorsw", "Enable", value = FALSE)))
    
  ),
  # the main panel (graph, table, etc)
  mainPanel(
    plotlyOutput("corrplot"),
    textOutput("info")
  )
)

## Create the Shiny Server layout
server <- function(input, output, session) {
  
  # this is the plotly click data
  event.data <- reactive({event_data(event = "plotly_click", source = "scplot")})
  
  # First, monitor which variable is active
  # Create reactive value for active var
  acvar <- reactiveVal(NULL)
  # update active variable via plot click
  observeEvent(event.data(),{
               acvar(event.data()$key)})
  # update active variable via dropdown
  observeEvent(input$vseldrop,
               acvar(input$vseldrop))
  
  ## Create the plotly plot that compares price vs scoops
  output$corrplot <- renderPlotly({
    
    # colours around markers when selected or not
    lincol <- ifelse(inames %in% acvar(), "red", "blue")
    # size of line around marker (set to 0 if not selected)
    linsize <- ifelse(inames %in% acvar(), 3, 0)

    # symbol when above/below corr threshold
    symbs <- if(input$locorsw==TRUE){c(16,15)}else{c(16,16)}
    # colour when above/below threshold
    pcols <- if(input$locorsw==TRUE){c("blue", "orange")}else{c("blue", "blue")}
    
    # generate main plot
    p <- plot_ly(dat, x = ~Correlation, y = ~Weight, type = "scatter", mode = "markers",
            text = ~Indicator, key = ~Indicator, source = "scplot",
            marker = list(size = 10, line = list(color = lincol, width = linsize)),
            symbol = ~Correlation < input$locorval, symbols = symbs,
            color = ~Correlation < input$locorval, colors = pcols) %>%
      layout(showlegend = FALSE, yaxis = list(
        range = c(0, 1.25),
        autotick = FALSE,
        dtick = 0.25),
        xaxis = list(
          range = c(-0.5, 1),
          autotick = FALSE,
          dtick = 0.2))
    
    # add low correlation line, if activated
    if(input$locorsw==TRUE){
      p <- p %>% add_segments(x = input$locorval, xend = input$locorval, y = 0, yend = 1.25,
                              marker = list(color = 'red', opacity=0),
                              line = list(dash = 'dash')) %>%
        layout(showlegend = FALSE)
    }

    p
    
  })
  
  # Text info
  output$info <- renderText({
    paste(acvar(), class(acvar()))
  })
  
  # update dropdown menu
  observeEvent(acvar(),{
    updateSelectInput(session, "vseldrop", selected = acvar())
  })
  
}

runGadget(ui, server, viewer = browserViewer())

}