R和Shiny:当悬停在Shiny上的绘图上时显示ggplot2数据值

时间:2018-03-01 03:28:39

标签: r ggplot2 shiny

我有绘图,旁边是一个交互式绘图,用户在绘图时刷新坐标限制。我需要交互式图表(在图上)显示悬停时的数据点值(例如"数据属于ID X"。有人有这样的问题吗? 我包含了一个可重现的代码块,并尝试使其完全相关,但您只能专注于输出$ text 。 非常感谢任何帮助。 感谢

require(shiny)
require(ggplot2)


dat <-data.frame(seq(1,50, 1), seq(0,100,length.out = 50), sapply(seq(0,100,length.out = 50), function(x) x+3*rnorm(1,0,4)))
varlist <- c("ID", "IPRED", "DV")
names(dat) <- varlist

ui <- fluidPage(
  selectInput("y", "Y Variable", choices = varlist, selected = "IPRED" ),
  selectInput("x", "X Variable", choices = varlist, selected = "DV"),
  checkboxInput("dvpred", "Show Unity Line", value = TRUE),
  column(width=6,
         plotOutput("p1",
                    dblclick = "plot1_dblclick",
                    brush = brushOpts(
                      id = "plot1_brush",
                      resetOnNew = TRUE))
  ),
  column(width = 6,
         plotOutput("p12", hover = hoverOpts("p12_hover", delay = 100, delayType = "debounce"))),
  uiOutput("txt")
)

server <- function(input, output){

  pxy <- function(dataset, xvar, yvar, xlim=NULL, ylim=NULL){

    dat = subset(dataset, dat$DV<500)
    vmax <- max(max(dat[[xvar]]),max(dat[[yvar]]))
    vmin <- min(min(dat[[xvar]]),min(dat[[yvar]]))
    p <- ggplot(data = dat) + 
      geom_point(aes_string(x=xvar, y=yvar), size=2,shape=21, fill="blue") +
      labs(x=xvar, y=yvar) + ggtitle(paste0(yvar, " vs ", xvar)) +
      geom_hline(yintercept=0) +
      coord_cartesian(xlim = xlim, ylim = ylim, expand = TRUE)
    if ( input$dvpred)(p <- p  + xlim(vmin, vmax)+ ylim(vmin, vmax) + geom_abline(slope=1) )
    return(p)
  }
  output$p1 <- renderPlot({
    xlength <- length(unique(dat[[input$x]]))
    if (xlength>12){
      return(pxy(dat, input$x, input$y))}
    else 
      return (bxplotxy(dat, input$x, input$y))
  })
  output$txt <- 
    renderPrint({
      if(!is.null(input$p21_hover)){
        hover=input$p21_hover
        dat$dist<-sqrt((hover$x-dat$DV)^2+(hover$y-dat$IPRED)^2)
        if (min(subset(dat, !is.na(dist))$dist)<4)
          cat("This Data Point Belongs to the Patient ID: ", dat$ID[which.min(dat$dist)])
      }


    })
  ranges <- reactiveValues(x = NULL, y = NULL)
  output$p12 <- renderPlot({
    xlength <- length(unique(dat[[input$x]]))
    if (xlength>12){
      return(pxy(dat, input$x, input$y, ranges$x, ranges$y))}
    else 
      return (NULL)
  }) 
  observe({
    brush <- input$plot1_brush
    if (!is.null(brush)) {
      ranges$x <- c(brush$xmin, brush$xmax)
      ranges$y <- c(brush$ymin, brush$ymax)

    } else {
      ranges$x <- NULL
      ranges$y <- NULL
    }
  })

}
shinyApp(ui, server)

1 个答案:

答案 0 :(得分:0)

我认为您应该将verbatimTextOutput("txt")output$txt <- renderPrint({ ... })一起使用,而不是uiOutput("txt")。但是这会给你一个在情节之外的文字输出,这听起来并不像你想要的那样......?

hovered points information would show in the verbatimTextOutput below the graphs, rather than on the graphs

如果您希望在悬停时文本显示在光标旁边,则会出现名为ggiraph:http://davidgohel.github.io/ggiraph/index.html的ggplot2扩展名。但我不确定它是否与刷牙相容。

所以我同意李克强关于使用情节的建议。刷新的信息与ggplot不同,因此您可能会发现此示例很有用:https://plot.ly/r/shinyapp-linked-brush/

祝你好运!