web-dev-qa-db-ja.com

ggplot2でホバーしながらツールチップにy値を表示する方法

グラフ内のポイントにマウスを置いたときにy値を表示したい。私のプロットのコードは次のようになります。

_output$graph <- renderPlot({
  p1 <- ggplot(data, aes(x= date)) + 
  geom_line(aes(y=Height, colour = "Height"), size=1) + 
  geom_point(aes(y=Height, colour = "Height", text = paste("Weight/Height:", Height)))
  plot(p1)
})
_

私はいくつかの調査を行い、aesのtext = paste("Weight/Height:", Height)部分がテキストが表示されることを確認すると思いました。残念ながら何も表示されません。誰が私が間違ったことを知っていますか？

rggplot2shiny
17
Hav11

残念ながらggplotはインタラクティブではありませんが、 plotly パッケージで簡単に「修正」できます。 plotOutputをplotlyOutputに置き換えてから、renderPlotlyでプロットをレンダリングするだけです。

例1：plotly

library(shiny)
library(ggplot2)
library(plotly)

ui <- fluidPage(
    plotlyOutput("distPlot")
)

server <- function(input, output) {
   output$distPlot <- renderPlotly({
      ggplot(iris, aes(Sepal.Width, Petal.Width)) + 
       geom_line() + 
       geom_point()
   })
}

shinyApp(ui = ui, server = server)


例2：plotOutput（...、hover = "plot_hover"）：

ただし、グラフにインタラクティブ機能を導入するために特別なパッケージを使用する必要はありません。必要なのは、素敵な光沢のあるshinyだけです！たとえば、plotOutput、click、またはhoverなどのdblclickオプションを使用して、プロットをインタラクティブにすることができます。 （光沢のあるギャラリーのその他の例を参照）

以下の例では、hover = "plot_hover"による「ホバリング」を追加し、デフォルトで300ミリ秒の遅延を指定します。

plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0)

その後、input$plot_hoverを介して値にアクセスし、関数nearPointsを使用して、ポイントに近い値を表示できます。

ui <- fluidPage(
  selectInput("var_y", "Y-Axis", choices = names(iris)),
  plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0),
  uiOutput("dynamic")

)

server <- function(input, output) {

  output$distPlot <- renderPlot({
    req(input$var_y)
    ggplot(iris, aes_string("Sepal.Width", input$var_y)) + 
      geom_point()
  })

  output$dynamic <- renderUI({
    req(input$plot_hover) 
    verbatimTextOutput("vals")
  })

  output$vals <- renderPrint({
    hover <- input$plot_hover 
    # print(str(hover)) # list
    y <- nearPoints(iris, input$plot_hover)[input$var_y]
    req(nrow(y) != 0)
    y
  })

}
shinyApp(ui = ui, server = server)

例3：カスタムggplot2ツールチップ：

2番目の解決策はうまく機能しますが、はい...私たちはそれをより良くしたいです！そして、はい...私たちはもっとうまくやることができます！ （... javaScriptを使用しているが、psssssssが誰にも通知しない場合！）。

library(shiny)
library(ggplot2)

ui <- fluidPage(

  tags$head(tags$style('
     #my_tooltip {
      position: absolute;
      width: 300px;
      z-index: 100;
      padding: 0;
     }
  ')),

  tags$script('
    $(document).ready(function() {
      // id of the plot
      $("#distPlot").mousemove(function(e) { 

        // ID of uiOutput
        $("#my_tooltip").show();         
        $("#my_tooltip").css({             
          top: (e.pageY + 5) + "px",             
          left: (e.pageX + 5) + "px"         
        });     
      });     
    });
  '),

  selectInput("var_y", "Y-Axis", choices = names(iris)),
  plotOutput("distPlot", hover = "plot_hover", hoverDelay = 0),
  uiOutput("my_tooltip")


)

server <- function(input, output) {


  output$distPlot <- renderPlot({
    req(input$var_y)
    ggplot(iris, aes_string("Sepal.Width", input$var_y)) + 
      geom_point()
  })

  output$my_tooltip <- renderUI({
    hover <- input$plot_hover 
    y <- nearPoints(iris, input$plot_hover)[input$var_y]
    req(nrow(y) != 0)
    verbatimTextOutput("vals")
  })

  output$vals <- renderPrint({
    hover <- input$plot_hover 
    y <- nearPoints(iris, input$plot_hover)[input$var_y]
    req(nrow(y) != 0)
    y
  })  
}
shinyApp(ui = ui, server = server)


例4：ggvisおよびadd_tooltip：

ggvisパッケージも使用できます。このパッケージは素晴らしいですが、まだ十分に成熟していません。

更新：ggvisは現在休止中です： https://github.com/rstudio/ggvis#status

library(ggvis)

ui <- fluidPage(
  ggvisOutput("plot")
)

server <- function(input, output) {

  iris %>%
    ggvis(~Sepal.Width, ~Petal.Width) %>%
    layer_points() %>%
    layer_lines() %>% 
    add_tooltip(function(df) { paste0("Petal.Width: ", df$Petal.Width) }) %>%
    bind_shiny("plot")
}

shinyApp(ui = ui, server = server)

[〜＃〜]編集済み[〜＃〜]

例5：

この投稿の後、インターネットを検索して、例3よりもうまく実行できるかどうかを確認しました。 this ggplotのすばらしいカスタムツールチップを見つけましたが、それ以上の改善はほとんどできないと思います。

37
Michal Majka