Shiny は R のパッケージの一つで、 このパッケージを使うと R を用いて対話的に操作する Web アプリケーションを作成することができます。Web 上のユーザーインタフェース部分を司る ui.R と、内部動作を司る server.R の二つの R 言語スクリプトで、サーバーサイドのコンテンツを作成できることが大きな特徴です。
RjpWiKi より引用
ggplot2 でツールチップを表示する
参考サイト [1] に、ggplot2 で描画したプロットのデータポイントにマウスのポインタを持っていくと、データポイントの内容をツールチップで表示するスクリプトが紹介されていました。これはインタラクティブにデータ解析をするのに是非活用できるようにしたい機能です。そこで、前回のブログ記事 [2] で紹介した簡単な Shiny アプリ iris-explorer にこのツールチップ機能を加えてみました。
ui.R を下記に示しました。
リスト:ui.R
fluidPage( titlePanel("Iris explorer"), sidebarLayout( sidebarPanel( selectInput( inputId = "varX", label = "Select the X variable", choices = get.choices()), selectInput( inputId = "varY", label = "Select the Y variable", choices = get.choices(), selected = 2) ), mainPanel( plotOutput( "plot", dblclick = "plot_dblclick", brush = brushOpts( id = "plot_brush", resetOnNew = TRUE ), hover = hoverOpts("plot_hover", delay = 100, delayType = "debounce") ), uiOutput("hover_info") ) ) )
server.R を下記に示しました。
リスト:server.R
function(input, output) {
ranges <- reactiveValues(x = NULL, y = NULL)
var.x <- reactive(iris[, as.numeric(input$varX)])
var.y <- reactive(iris[, as.numeric(input$varY)])
label.x <- reactive(names(iris[as.numeric(input$varX)]))
label.y <- reactive(names(iris[as.numeric(input$varY)]))
output$plot <- renderPlot({
ggplot(iris, aes(x = var.x(), y = var.y(), colour = Species)) +
xlab(label.x()) + ylab(label.y()) +
coord_cartesian(xlim = ranges$x, ylim = ranges$y, expand = FALSE) +
geom_point(size = 4) + gtheme
})
observeEvent(input$plot_dblclick, {
brush <- input$plot_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
}
})
output$hover_info <- renderUI({
hover <- input$plot_hover
point <- nearPoints(iris, hover, xvar = label.x(), yvar = label.y(), threshold = 5, maxpoints = 1, addDist = TRUE)
if (nrow(point) == 0) return(NULL)
wellPanel(
style = get.style(hover),
p(HTML(paste0("<b> Species: </b>", point$Species, "<br/>",
"<b> ", label.x(), ": </b>", point[, label.x()], "<br/>",
"<b> ", label.y(), ": </b>", point[, label.y()], "<br/>")))
)
})
}
global.R を下記に示しました。
リスト:global.R
library(shiny)
library(ggplot2)
gtheme <- theme(
axis.title = element_text(size = 16),
axis.text = element_text(size = 16),
axis.line = element_line(),
legend.title = element_text(size = 14),
legend.text = element_text(size = 14),
panel.grid.major = element_line(colour="grey",size = rel(0.5)),
panel.grid.minor = element_blank(),
panel.background = element_rect(fill = "whitesmoke")
)
get.choices <- function() {
part.iris <- list()
for (item in names(iris)) {
if (item != "Species") {
part.iris[[item]] <- grep(item, names(iris))
}
}
return(part.iris)
}
get.left_px <- function(hover) {
left_pct <- (hover$x - hover$domain$left) / (hover$domain$right - hover$domain$left)
left_px <- hover$range$left + left_pct * (hover$range$right - hover$range$left)
return(left_px)
}
get.top_px <- function(hover) {
top_pct <- (hover$domain$top - hover$y) / (hover$domain$top - hover$domain$bottom)
top_px <- hover$range$top + top_pct * (hover$range$bottom - hover$range$top)
return(top_px)
}
get.style <- function(hover) {
style <- paste0("position: absolute; z-index: 100; ",
"left:", get.left_px(hover) + 2, "px; ",
"top:", get.top_px(hover) + 2, "px; ",
"background-color: rgba(245, 245, 245, 0.75); ",
"font-family: monospace;")
return(style)
}
下記に実行例を示しました。
ツールチップを表示した例
まだ十分に使いこなせるレベルにありませんが、shiny の web アプリでデータ解析をするときに、ズームと併せて必須の機能だと思っていますので、備忘録としてまとめました。
参考サイト
- Custom interactive CSS/HTML tooltips with ggplot, shiny and R (ggvis like). ($16220) · Snippets · GitLab
- bitWalk's: R Shiny でプロットのズーム [2019-10-09]
にほんブログ村
0 件のコメント:
コメントを投稿