Блог

Я пытаюсь вручную выбрать пики и впадины из зашумленного синусоидального сигнала во временном ряду, который отображается на диграфе, используя R. Я создаю простой пример ниже.

 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() должны быть символьным вектором

Ошибка возрастает, потому что вы указываете правильные параметры, для 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