Question

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

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

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值”滑块为1且“折叠变化”滑块为0时），则创建正确的输出。例如，在下图中，绘制了所有10个数据点，并且用户选择了具有接近值1的p值（y轴）的数据点。在图下面是返回的行，其具有折叠 - 变化（x轴）值为6.61，p值（y轴）值为0.992。它似乎工作。

但是，如果不所有十个点都被绘制，则会给出错误的输出。例如，在下图中，仅绘制了6个数据点，并且用户选择了具有接近值1的p值（y轴）的数据点。在图下面是返回的行，其具有折叠 - 变化（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

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

我做了一些小改动，以帮助了解发生了什么：

调整了输入滑块的初始值
将输出更改为选择数据框的verbatumTextOutput
通过在跟踪定义中包含text字段，向工具提示（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（或浏览器）闪亮的窗口。
选择了“Inspect”
选择“控制台”条目
请参阅console.log输出（您可以深入查看对象）

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

1 个答案: