Activate pointClickCallback in a time series to capture peaks and valleys

172 Views Asked by At

I am trying to select manually the peaks and valleys from a noisy sinusoidal signal within a time series which is displayed on a dygraph using R. I create a simple example below.

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))})

However I am not able to record the clicks on the peaks and valleys with the dycallbacks call. The error message I get is:

The arguments for JS() must be a character vector

1

There are 1 best solutions below

10
On BEST ANSWER

The error is rising because you're giving the correct params to dyCallbacks(dygraph, pointClickCallback) which takes :

  • dygraph : Dygraph to add callbacks to.
  • pointClickCallback : A (JS) function to call when a data point is clicked. and the point that was clicked. i.e a character vector to be later on passed to JS() function.
  • .... other callbacks.

So the correct code is :

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

Writing it to a file:

I think using shiny is definitely justifiable in this case as we're going to have easy access to base R functions:

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)

Non-shiny solution using only callbacks and 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))}")

Output in peaks.csv

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