#r #shiny #r-plotly
#r #блестящий #r-плотный
Вопрос:
Я уже некоторое время пытаюсь отладить свой блестящий гаджет, но все еще не могу с ним справиться. Действительно ценю любую помощь.
Мой гаджет состоит из диаграммы рассеяния, сгенерированной с помощью Plotly. Пользователь может щелкнуть одну из точек, что позволит вам изменить некоторые параметры, связанные с этой точкой. Чтобы подчеркнуть тот факт, что пользователь выбрал эту точку, я хотел выделить выбранную точку.
Кроме того, пользователь также может выбрать точку из выпадающего меню, в котором также должна быть выделена соответствующая точка.
В качестве дополнительной функции я хочу дополнительно выделить точки, которые находятся ниже определенного порога на оси x. Этот порог представлен пунктирной линией, которую вы можете включать и выключать, а также перемещать значение порога.
Таким образом, все точки на графике должны быть синими кружками, за исключением следующих двух случаев:
- если щелкнуть по ней, т. Е. Это «активная точка» (это должно создать красную рамку вокруг точки)
- если оно ниже порогового значения по оси 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())
}
Комментарии:
1. Я воспроизвел это, и это выглядит довольно странно — я начинаю думать, что это ошибка в пакете plotly. Если вы удалите
symbol = ~Correlation < input$locorval, symbols = symbs, color = ~Correlation < input$locorval, colors = pcols
, то все будет работать нормально. Что-то связанное с тем, как он разделяет данные, чтобы справиться с этими неравенствами.2. Спасибо, что взглянули. Да, это странно. Данные о щелчке по графику также иногда случайным образом меняются на список, а не на строку символов. В любом случае я ценю ваши усилия.