在时间序列中激活 pointClickCallback 以捕获峰值和谷值

Question

我正在尝试从使用 R 显示在 dygraph 上的时间序列中的嘈杂正弦信号中手动选择峰值和谷值。我在下面创建了一个简单的示例。

x=seq(0.1,10,by=0.01)
y=sin(x)
ts = data.frame(x,y)
dygraph(ts)
dyCallbacks(ts,pointClickCallback = function(e, pt){alert(this.getValue(pt.idx,1))})

但是，我无法使用 dycallbacks 调用记录峰谷的点击。我得到的错误信息是：

JS() 的参数必须是字符向量

Answer 1

错误正在上升，因为您将正确的参数提供给 dyCallbacks(dygraph, pointClickCallback)，这需要：

• dygraph ：要添加回调的 Dygraph。
• pointClickCallback ：单击数据点时调用的 (JS) 函数。以及被点击的点。即稍后将传递给 JS() 函数的字符向量。
• ....其他回调。

所以正确的代码是：

dy <- dygraph(ts)
dyCallbacks(dy ,pointClickCallback = "function(e, pt){alert(this.getValue(pt.idx,1))}")

将其写入文件：

我认为在这种情况下使用shiny 绝对是合理的，因为我们将可以轻松访问基本R 函数：

library(shiny)
# generating the user interface of the webpage
ui = fluidPage(
  mainPanel(
    # tells shiny to add a dygraph output
    dygraphOutput("dygraph"),
    # tells shiny to a <br/> element return to new line in html
    br(),
    # tells shiny to add a text output in here we will show the coordinates of the point that has been clicked.
    textOutput("clicked", inline = TRUE)
  )
)
server = function(input, output) {
  # generating the sinusoïdal time series
  x=seq(0.1,10,by=0.01)
  y=sin(x)
  ts = data.frame(x,y)

  # outputting the dygraph
  output$dygraph <- renderDygraph({
    dygraph(ts) 
  })

  # printing coordinates in HTML
  output$clicked <- renderText({
   # output text only if a point has been clicked
   if(!is.null(input$dygraph_click$x_closest_point)) paste0("x = ", input$dygraph_click$x_closest_point, ", y = ", input$dygraph_click$y_closest_point)
  })

  #printing the coordinates of the clicked point in console
  printPoint <- reactive({
    print(c(x=input$dygraph_click$x_closest_point, y=input$dygraph_click$y_closest_point))
  })

  # whenever the dygraph is clicked the expression {} is evaluated
  # basically printing the coordinates in console and adding them to the peaks csv file
  observeEvent(input$dygraph_click,{
      printPoint()
      write.table(data.frame(x=input$dygraph_click$x_closest_point, y=input$dygraph_click$y_closest_point), "peaks.csv", sep = ",", col.names = !file.exists("peaks.csv"), row.names=F, append = T)
    })
}

shinyApp(ui = ui, server = server)

仅使用回调和 js 的无光泽解决方案

js <- "function(e,vs){
    if(!window.points) {
        window.points = ['x,y'];
        var button = document.createElement('button');
        button.innerHTML = 'Download Data';
        button.style = 'position: absolute; top: 15px;left:40px;';
        button.id = 'download';
        document.body.appendChild(document.createElement('br'));
        document.body.appendChild(button);

        $('#download').click( function(){
            var csvContent = 'data:text/csv;charset=utf-8,' + window.points.join('\\n');
            var encodedUri = encodeURI(csvContent);
            window.open(encodedUri);
        });
    }
}"
x=seq(0.1,10,by=0.01)
y=sin(x)
ts = data.frame(x,y)
dy <- dygraph(ts)
dyCallbacks(dy, drawCallback=js, pointClickCallback = "function(e, pt){window.points.push(this.getValue(pt.idx,0)+\",\"+this.getValue(pt.idx,1))}")

peaks.csv 中的输出

"x","y"
5.05,-0.943548668635907
5.05,-0.943548668635907
4.26,-0.899405409685178