Интерактивное построение графика в блестящем режиме с помощью щелчков мыши

Question

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

Однако в этом я сталкиваюсь со следующей проблемой. Сначала я получаю результаты из db и делаю сюжет. После того, как этот график будет выполнен, я хочу, чтобы пользователь сделал два щелчка мыши на графике, на основании которого он должен принимать два значения как xlim и строить увеличенную версию предыдущего графика. Однако я не могу сделать это успешно.

Вот код, который я написал.

ui.R

library(shiny) 
shinyUI(fluidPage(
    titlePanel("LOAD AND PERFORMANCE DASHBOARD"), 

    sidebarLayout(
      sidebarPanel(
        fluidRow(
          selectInput("select", label = h3("Select type of testing"), 
             choices = list("Performance Testing"=1, "Capacity Testing"=2)), 
          radioButtons("radio", label = h3("Select parameter to plot"), 
             choices = list("Disk" = 1, "Flit" = 2,"CPU" = 3,"Egress" =4, 
                 "Memory" = 5)) 
        )), 
      mainPanel(
        plotOutput("plot",clickId="plot_click"), 
        textOutput("text1"), 
        plotOutput("plot2") 
        ) 
    ) 
)) 

server.R

library(shiny) 
library(rmongodb) 
cursor <- vector() 
shinyServer(function(input, output) { 

    initialize <- reactive({ 
      mongo = mongo.create(host = "localhost") 
    }) 

    calculate <- reactive({ 
      if(input$radio==1) 
        xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "disk") 
      else if(input$radio==2) 
        xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "flit") 
      else if(input$radio==3) 
        xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "cpu") 
      else if(input$radio==4) 
        xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "egress") 
      else if(input$radio==5) 
        xvalue <- mongo.distinct(mongo,ns = "mydb.vload", "memory") 
    }) 

    output$plot <- renderPlot({ 
      initialize() 
      value <- calculate() 
      plot(value,xlab="Time",ylab="% Consumed") 
      lines(value) 
      cursor <- value 
    })  

    output$text1 <- renderText({ 
      paste("You have selected",input$plot_click$x) 
    }) 

    output$plot2 <- renderPlot({ 
      plot(cursor[cursor<input$plot_click$x && cursor>first_click ],xlab="Time",ylab="% Consumed")    lines(cursor) 
      first_click <- input$plot_click$x 
    })   

}) 

Заранее спасибо за помощь :)

Answer 1

Вот простой пример, который демонстрирует поведение, которое вы хотите, просто запустите этот кода (или сохранить как файл и указать его). Этот код использует новую функцию registerEvent, дебютирующую в Shiny 0.11, которая просто ударила CRAN в выходные дни.

Основная идея состоит в том, что мы отслеживаем два реактивных значения: click1 и range. click1 представляет собой первый щелчок мыши, если он существует; и range представляет значения x обоих щелчков мыши. Щелчок по сюжету просто управляет этими двумя реактивными значениями, и операция построения графика читает их.

library(shiny) 

ui <- fluidPage(
    h1("Plot click demo"), 
    plotOutput("plot", clickId = "plot_click"), 
    actionButton("reset", "Reset zoom") 
) 

server <- function(input, output, session) { 
    v <- reactiveValues(
    click1 = NULL, # Represents the first mouse click, if any 
    range = NULL # After two clicks, this stores the range of x 
) 

    # Handle clicks on the plot 
    observeEvent(input$plot_click, { 
    if (is.null(v$click1)) { 
     # We don't have a first click, so this is the first click 
     v$click1 <- input$plot_click 
    } else { 
     # We already had a first click, so this is the second click. 
     # Make a range from the previous click and this one. 
     v$range <- range(v$click1$x, input$plot_click$x) 
     # And clear the first click so the next click starts a new 
     # range. 
     v$click1 <- NULL 
    } 
    }) 

    observeEvent(input$reset, { 
    # Reset both the range and the first click, if any. 
    v$range <- NULL 
    v$click1 <- NULL 
    }) 

    output$plot <- renderPlot({ 
    plot(cars, xlim = v$range) 
    if (!is.null(v$click1$x)) 
     abline(v = v$click1$x) 
    }) 
} 

shinyApp(ui, server)