当根据类别对点进行着色时，在散点图中使用plotlyProxy对迹线进行重新样式化是不稳定的

如何解决当根据类别对点进行着色时，在散点图中使用plotlyProxy对迹线进行重新样式化是不稳定的

我有一个Shiny应用程序，它可以通过散点图通过plotlyProxy重新设置标记轮廓来构建散点图并突出显示单击的点。该应用程序还可以对数据进行子集处理，并将与单击的点相对应的条目从原始“数据表”移到“异常表”。

当标记都具有相同的颜色或使用连续变量进行标记时，这似乎很好用。但是，当我使用分类变量（例如“种类”）为点着色时，它具有怪异的行为，将每个类别的标记重新设置为样式，而不是单击的类别。数据子集正确。

我认为，除非另有说明，否则restyle函数应该更新所有跟踪，所以我不确定问题出在哪里。

这是我的代码：

library(plotly)
library(DT)

    ui <- fluidPage(
     mainPanel(
      fluidRow(
       div(
        column(
            width = 2,uiOutput('chartOptions')),column(width = 5,h3("Scatter plot"),plotlyOutput("scatterplot"),verbatimTextOutput("click")
        )
      )
),hr(),div(
        column(width = 6,h2("Data Table"),div(
                   DT::dataTableOutput(outputId = "table_keep"),style = "height:auto; overflow-y: scroll;overflow-x: scroll;")),column(width = 6,h2("Outlier Data"),div(
                   DT::dataTableOutput(outputId = "table_outliers"),style = "height:auto; overflow-y: scroll;overflow-x: scroll;"))
    )
 ))
server <- function(input,output,session){
  datasetInput <- reactive({
     df <- iris
       return(df)
  })

output$chartOptions <- renderUI({#choose variables to plot
    if(is.null(datasetInput())){}
    else {
        list(
            selectizeInput("xAxisSelector","X Axis Variable",colnames(datasetInput())),selectizeInput("yAxisSelector","Y Axis Variable",selectizeInput("colorBySelector","Color By:",c(c("Do not color",colnames(datasetInput()))))
        )      
    }
})

vals <- reactiveValues(#define reactive values for:
    data = NULL,data_keep = NULL,data_exclude = NULL)

observe({
    vals$data <- datasetInput()
    vals$data_keep <- datasetInput()
    
})

## Datatable 
output$table_keep <- renderDT({
    vals$data_keep      
},options = list(pageLength = 5))

output$table_outliers <- renderDT({
    vals$data_exclude      
},options = list(pageLength = 5))

# mechanism for managing selected points
keys <- reactiveVal()

observeEvent(event_data("plotly_click",source = "outliers",priority = "event"),{
    req(vals$data)
    is_outlier <- NULL
    key_new <- event_data("plotly_click",source = "outliers")$key
    key_old <- keys()
    if (key_new %in% key_old){
        keys(setdiff(key_old,key_new))
    } else {
        keys(c(key_new,key_old))
    }
    is_outlier <- rownames(vals$data) %in% keys()
    
    vals$data_keep <- vals$data[!is_outlier,]
    vals$data_exclude <- vals$data[is_outlier,]
    
    plotlyProxy("scatterplot",session) %>%
        plotlyProxyInvoke(
            "restyle",list(marker.line = list(
                    color = as.vector(ifelse(is_outlier,'black','grey')),width = 2
                
            ))
        )
})

observeEvent(event_data("plotly_doubleclick",source = "outliers"),{
    req(vals$data)
    keys(NULL)
    vals$data_keep <- vals$data
    vals$data_exclude <- NULL
    plotlyProxy("scatterplot",list(marker.line = list(
                    color = 'grey',width = 2
                )
            ))
        
})

output$scatterplot <- renderPlotly({
    req(vals$data,input$xAxisSelector,input$yAxisSelector)
    dat <- vals$data
    key <- rownames(vals$data)
    x <- input$xAxisSelector
    y <- input$yAxisSelector
    
    if(input$colorBySelector != "Do not color"){
        color <-  dat[,input$colorBySelector] 
    }else{
        color <- "orange"
    }
    
    scatterplot <- dat %>%
        plot_ly(x = dat[,x],y = dat[,y],source = "outliers") %>%
        add_markers(key = key,color = color,marker = list(size = 10,line = list(
                        color = 'grey',width = 2
                    ))) %>%
        layout(showlegend = FALSE)
    
    return(scatterplot)
})


output$click <- renderPrint({#click event data
    d <- event_data("plotly_click",source = "outliers")
    if (is.null(d)) "click events appear here (double-click to clear)" else d
})
}
 shinyApp(ui,server)

解决方法

您上面的代码存在的问题是没有为temp_df = audiob_adv['Listening Time'].str.extract(r'(\d+)[^\d]+(\d+)').astype('int32') audiob_adv["Time"] = temp_df.iloc[:,0]*60 + temp_df.iloc[:,1]提供traceIndices参数。请参阅this。

在您的示例中，一旦您将颜色切换为因子restyle，就不会再创建一条迹线，而是创建三条迹线。这是在JS中发生的，因此计数是从0到2。

要Species这些迹线，您可以通过curveNumber（在这种情况下为restyle）和pointNumber（每条迹线0:2中有50个数据点）对其进行寻址

使用一条跟踪，您的示例就可以像0:49一样工作，并且跟踪的长度相同（150）。

由于您提供的代码很长，因此我只关注“种类”问题。在所有其他情况下都无法使用，但是您应该可以从中推断出更通用的方法：

key

作为一种快速的解决方法，为避免创建3条痕迹，我只将分配给color的类别变量转换为数字，然后隐藏了colorbar，所以输出如下所示：

 output$scatterplot <- renderPlotly({
    req(vals$data,input$xAxisSelector,input$yAxisSelector)
    dat <- vals$data
    key <- rownames(vals$data)
    x <- input$xAxisSelector
    y <- input$yAxisSelector
    
    if(input$colorBySelector != "Do not color"){
        color <-  as.numeric(dat[,input$colorBySelector])
    }else{
        color <- "orange"
    }
    
    scatterplot <- dat %>%
        plot_ly(x = dat[,x],y = dat[,y],source = "outliers") %>%
        add_markers(key = key,color = color,marker = list(size = 10,line = list(
                        color = 'grey',width = 2
                    ))) %>%
        layout(showlegend = FALSE) %>%
        hide_colorbar()%>% 
        event_register("plotly_click")
    
    return(scatterplot)
})

更新：

我发现的另一个解决方案是为click事件中的每个跟踪/类别创建一个绘图代理循环。因此，点击事件如下所示：

observeEvent(event_data("plotly_click",source = "outliers",priority = "event"),{
    req(vals$data)

    is_outlier <- NULL
    key_new <- event_data("plotly_click",source = "outliers")$key
    key_old <- keys()
    #keys(c(key_new,key_old))
    if (key_new %in% key_old){
        keys(setdiff(key_old,key_new))
    } else {
        keys(c(key_new,key_old))
    }
    is_outlier <- rownames(vals$data) %in% keys()
    
    vals$data_keep <- vals$data[!is_outlier,]
    vals$data_exclude <- vals$data[is_outlier,]
    indices <- list()
    p <- plotlyProxy("scatterplot",session) 
         
    
    if(input$colorBySelector != "Do not color"){
        if(is.factor(vals$data[,input$colorBySelector])){
            for (i in 1:length(levels(vals$data[,input$colorBySelector]))){

                indices[[i]] <- rownames(vals$data[which(vals$data[,input$colorBySelector] == levels(vals$data[,input$colorBySelector])[i]),])     #retrieve indices for each category
                   
                 plotlyProxyInvoke(p,"restyle",list(marker.line = list(
                            color = as.vector(ifelse(is_outlier[as.numeric(indices[[i]])],'black','grey')),width = 2

                        )),c(i-1)   #specify the trace (traces are indexed from 0)
                    )

            }
        }else{
            p %>%
                plotlyProxyInvoke(
                    "restyle",list(marker.line = list(
                        color = as.vector(ifelse(is_outlier,width = 2

                    ))
                )
        }
    }else{
        p %>%
            plotlyProxyInvoke(
                "restyle",list(marker.line = list(
                    color = as.vector(ifelse(is_outlier,width = 2

                ))
            )
    }
    
})

当根据类别对点进行着色时，在散点图中使用plotlyProxy对迹线进行重新样式化是不稳定的

如何解决当根据类别对点进行着色时，在散点图中使用plotlyProxy对迹线进行重新样式化是不稳定的

解决方法

相关推荐