使用鼠标点击进行交互式绘图

时间:2015-01-19 11:14:56

标签: r shiny

我正在做一个项目,我使用闪亮的服务器并将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
    })           

})

提前感谢您的帮助:)

1 个答案:

答案 0 :(得分:11)

这是一个演示您想要的行为的简单示例,只需运行此代码(或另存为文件并将其作为源代码)。这段代码使用了新的observeEvent函数,该函数在Shiny 0.11中首次亮相,该函数仅在周末点击CRAN。

基本思路是我们跟踪两个被动值click1rangeclick1代表第一次鼠标点击(如果存在);并且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)