javascript - 当仅绘制某些观察值时，框选择时返回不正确的行索引 - Plotly、htmlWidgets、Shiny

Question

我正在编写一个 Shiny 的应用程序，其中用户有两个 slider 输入 - 一个用于“倍数更改”，另一个用于“p 值”。有一个数据集包含 10 个观测值，每个观测值都发生倍数变化和 p 值。在给定时间仅绘制 p 值小于“p 值” slider 输入且倍数变化大于“倍数变化” slider 输入的点。

我到目前为止所写的内容如下 -

library(ggplot2)
library(plotly)
library(htmlwidgets)

ui <- shinyUI(fluidPage(
  sliderInput("threshP", "P-value:", min = 0, max = 1, value=0.05, step=0.05),
  sliderInput("threshFC", "Fold change:", min = 0, max = 10, value=5, step=0.5),
  plotlyOutput("plot1"),
  textOutput("selectedValues")
))

server <- shinyServer(function(input, output) {
  set.seed(1)
  threshP <- reactive(input$threshP)
  threshFC <- reactive(input$threshFC)

  dat <- data.frame(ID = paste0("ID",1:10), FC=runif(10,0,10), pval=runif(10,0,1))
  dat$ID <- as.character(dat$ID)

  # x-axis FC, y-axis pval
  xMax = max(dat$FC)
  xMin = min(dat$FC)
  yMax = max(dat$pval)
  yMin = min(dat$pval)

  df <- data.frame()
  p <- ggplot(df) + geom_point() + xlim(xMin, xMax) + ylim(yMin, yMax)
  gp <- ggplotly(p)

  output$plot1 <- renderPlotly({
    gp %>% onRender("
      function(el, x, data) {
      var dat = data.dat
      var selFC = [];
      var selP = [];
      dat.forEach(function(row){
        rowFC = row['FC']
        rowP = row['pval']
        if (rowP <= data.thP && data.thFC <= rowFC){
          selFC.push(rowFC);
          selP.push(rowP);
        }
      });

      var Traces = [];
      var tracePoints = {
        x: selFC,
        y: selP,
        mode: 'markers',
        marker: {
          color: 'black',
          size: 6
        },
      };
      Traces.push(tracePoints);
      Plotly.addTraces(el.id, Traces);

      var idRows = []
      for (a=0; a<data.dat.length; a++){
        idRows.push(data.dat[a]['ID'])
      }
      console.log(idRows)

      el.on('plotly_selected', function(e) {
        numSel = e.points.length
        Points = e.points
        selID = []
        for (a=0; a<numSel; a++){
          PN = Points[a].pointNumber
          selRow = idRows[PN]
          selID.push(selRow)
        }
        Shiny.onInputChange('selID', selID);
      })
      }", data = list(dat = dat, thP=threshP(), thFC=threshFC()))})

    selID <- reactive(input$selID)
    selDat <- reactive(dat[which(dat$ID %in% selID()), ])
    output$selectedValues <- renderPrint({str(selDat())})
})

shinyApp(ui, server)

如果绘制了所有十个点(当“p 值” slider 位于 1，并且“倍数变化” slider 位于 0 时)，这将创建正确的输出。例如，在下图中，绘制了所有 10 个数据点，并且用户选择了 p 值(y 轴)接近 1 的数据点。图下方是返回的行，其中有一个折叠 -更改(x 轴)值为 6.61，p 值(y 轴)值为 0.992。似乎正在发挥作用。

但是，如果未绘制所有十个点，则会给出不正确的输出。例如，在下图中，只绘制了 6 个数据点，用户选择了 p 值(y 轴)接近 1 的数据点。图下方是返回的行，其中有一个折叠 -将(x 轴)值更改为 2.02，将 p 值(y 轴)值更改为 0.77。它似乎不起作用。

我意识到/相信问题正在发生，因为当未绘制所有 10 个点时，返回的行索引只能在 1-c 之间，其中 c 是小于 10 的某个数字。因此，行索引不再匹配与原始数据框一致。但是，我不知道如何解决这个问题。

关于如何解决这个问题有什么建议吗？谢谢。

编辑:

感谢有用的调试建议，我认为问题可能会得到解决。技巧是使用 pointNumber 作为包含正在绘制的数据帧子集的数组变量中的索引。在这里，这是 sselID 对象。

library(ggplot2)
library(plotly)
library(htmlwidgets)

ui <- shinyUI(fluidPage(
  sliderInput("threshP", "P-value:", min = 0, max = 1, value=1, step=0.05),
  sliderInput("threshFC", "Fold change:", min = 0, max = 10, value=0, step=0.5),
  plotlyOutput("plot1"),
  verbatimTextOutput("selectedValues")
))

server <- shinyServer(function(input, output) {
  set.seed(1)
  threshP <- reactive(input$threshP)
  threshFC <- reactive(input$threshFC)

  dat <- data.frame(ID = paste0("ID",1:10), FC=runif(10,0,10), pval=runif(10,0,1))
  dat$ID <- as.character(dat$ID)
  print(dat)

  # x-axis FC, y-axis pval
  xMax = max(dat$FC)
  xMin = min(dat$FC)
  yMax = max(dat$pval)
  yMin = min(dat$pval)

  df <- data.frame()
  p <- ggplot(df) + geom_point() + xlim(xMin, xMax) + ylim(yMin, yMax)
  gp <- ggplotly(p)

  output$plot1 <- renderPlotly({
    gp %>% onRender("
      function(el, x, data) {
      var dat = data.dat
      var selFC = [];
      var selP = [];
      var sselID = [];
      dat.forEach(function(row){
        rowFC = row['FC']
        rowP = row['pval']
        rowID = row['ID']
        if (rowP <= data.thP && data.thFC <= rowFC){
          selFC.push(rowFC);
          selP.push(rowP);
          sselID.push(rowID);
        }
      });

console.log(sselID)

      var Traces = [];
      var tracePoints = {
        x: selFC,
        y: selP,
        text: sselID,
        mode: 'markers',
        marker: {
          color: 'black',
          size: 6
        },
      };
      Traces.push(tracePoints);
      Plotly.addTraces(el.id, Traces);

      el.on('plotly_selected', function(e) {

      console.log(e.points)
      numSel = e.points.length
      Points = e.points
      selID = []
      for (a=0; a<numSel; a++){
        PN = Points[a].pointNumber
        selRow = sselID[PN]
        selID.push(selRow)
      }
      Shiny.onInputChange('selID', selID);
      })
      }", data = list(dat = dat, thP=threshP(), thFC=threshFC()))})

  selID <- reactive(input$selID)
  selDat <- reactive(dat[which(dat$ID %in% selID()), ])
  output$selectedValues <- renderPrint({selDat()})
  })

shinyApp(ui, server) 

Answer 1

你有一些有趣的问题...

我做了一些小改动来帮助了解发生了什么:

• 调整了输入 slider 的初始值
• 将输出更改为选择数据帧的 verbatumTextOutput
• 通过在跟踪定义中包含文本字段，向工具提示(ID 变量)添加了更多信息。
• 在 JavaScript 控制台打印出事件数据

从那里我可以看到，经常(几乎总是，但并非总是)有一种虚拟点作为第一个点。方便的是，它的 curveNumber 始终为零

• 所以我添加了一个守卫，将其从您选择的列表中排除。

我认为这解决了问题。

library(ggplot2)
library(plotly)
library(htmlwidgets)

ui <- shinyUI(fluidPage(
  sliderInput("threshP", "P-value:", min = 0, max = 1, value=1, step=0.05),
  sliderInput("threshFC", "Fold change:", min = 0, max = 10, value=0, step=0.5),
  plotlyOutput("plot1"),
  verbatimTextOutput("selectedValues")
))

server <- shinyServer(function(input, output) {
  set.seed(1)
  threshP <- reactive(input$threshP)
  threshFC <- reactive(input$threshFC)

  dat <- data.frame(ID = paste0("ID",1:10), FC=runif(10,0,10), pval=runif(10,0,1))
  dat$ID <- as.character(dat$ID)
  print(dat)

  # x-axis FC, y-axis pval
  xMax = max(dat$FC)
  xMin = min(dat$FC)
  yMax = max(dat$pval)
  yMin = min(dat$pval)

  df <- data.frame()
  p <- ggplot(df) + geom_point() + xlim(xMin, xMax) + ylim(yMin, yMax)
  gp <- ggplotly(p)

  output$plot1 <- renderPlotly({
    gp %>% onRender("
                    function(el, x, data) {
                    var dat = data.dat
                    var selFC = [];
                    var selP = [];
                    var sselID = [];
                    dat.forEach(function(row){
                    rowFC = row['FC']
                    rowP = row['pval']
                    rowID = row['ID']
                    if (rowP <= data.thP && data.thFC <= rowFC){
                    selFC.push(rowFC);
                    selP.push(rowP);
                    sselID.push(rowID);
                    }
                    });

                    var Traces = [];
                    var tracePoints = {
                    x: selFC,
                    y: selP,
                    text: sselID,
                    mode: 'markers',
                    marker: {
                    color: 'black',
                    size: 6
                    },
                    };
                    Traces.push(tracePoints);
                    Plotly.addTraces(el.id, Traces);

                    var idRows = []
                    for (a=0; a<data.dat.length; a++){
                    idRows.push(data.dat[a]['ID'])
                    }
                    console.log(idRows)

                    el.on('plotly_selected', function(e) {
                      console.log(e.points)
                      numSel = e.points.length
                      Points = e.points
                      selID = []
                      for (a=0; a<numSel; a++){
                      CN = Points[a].curveNumber
                      if (CN>0){
                        PN = Points[a].pointNumber
                        selRow = idRows[PN]
                        selID.push(selRow)
                      } 
                    }
                    Shiny.onInputChange('selID', selID);
                    })
                    }", data = list(dat = dat, thP=threshP(), thFC=threshFC()))})

  selID <- reactive(input$selID)
  selDat <- reactive(dat[which(dat$ID %in% selID()), ])
  output$selectedValues <- renderPrint({selDat()})
  })

shinyApp(ui, server)

屏幕截图:

JavaScript 控制台中 eventData 的屏幕截图:

对于那些想知道如何访问 javascript 控制台的人，您可以:

• 右键单击 R-studio(或浏览器) Shiny 窗口。
• 选择“检查”
• 选择“控制台”条目
• 查看 console.log 输出(您可以深入查看对象)