Shiny应用基础（7）：图像互动

shiny应用程序中的图像互动目前主要有两种类型：

R绘图：完全由R在服务器端生成图像并产生互动效果
js绘图：服务器端R处理并提供数据到客户端，由客户端浏览器通过js插件完成绘图和互动

js图像互动方法跟R图形系统毛关系都没有，但和R绘图相比，它的数据传输量小速度快，很适合网络展示，感兴趣的可以看看
rCharts 。本文只关心原生的R绘图互动效果的产生方法。但应用这种方法之前首先警告：

纯R绘图产生的每次“互动”都要重新绘制图像，需要考虑流量和速度的场合一定要谨慎使用！！

原因是什么，你看完就知道了。

1 鼠标动作与坐标捕获

我们重新看看shiny中plotOutput和imageOutput这两个图像输出控件函数的参数：

library('shiny')
args(plotOutput)

## function (outputId, width = "100%", height = "400px", click = NULL,
##     dblclick = NULL, hover = NULL, hoverDelay = NULL, hoverDelayType = NULL,
##     brush = NULL, clickId = NULL, hoverId = NULL, inline = FALSE)
## NULL

args(imageOutput)

## function (outputId, width = "100%", height = "400px", click = NULL,
##     dblclick = NULL, hover = NULL, hoverDelay = NULL, hoverDelayType = NULL,
##     brush = NULL, clickId = NULL, hoverId = NULL, inline = FALSE)
## NULL

它们的参数是完全一样的。这里我们要注意四个参数： click ， dblclick ， hover 和brush ，分别表示鼠标的单击、双击、悬停和刷取区域这四种动作，参数的值可使用clickOpts(),
hoverOpts() 或burshOpts() 函数设定。

以上四个参数的作用只有一个：获取鼠标在图像上的位置（或区域）坐标并传递给服务器。坐标信息需要一个变量来传递，这个变量的名称就是 xxxOpts() 函数的id参数的设定值，或者参数值仅写id名称。下面两个语句等价：

## NOT RUN
plotOutput('pl', click=clickOpts(id='pl_click'))
plotOutput('pl', click='pl_click')

在server端，已捕获的鼠标位置可通过input列表读取。为方便以后编写应用程序代码，我们下面程序可用于查看和分析四种不同鼠标动作的返回值：

shinyApp(
ui = fixedPage(
plotOutput('pl', click='pl_click', dblclick='pl_dclick', hover='pl_hover', brush='pl_brush'),
column(3, textOutput('dtclk', container=pre)),
column(3, textOutput('dtdcl', container=pre)),
column(3, textOutput('dthov', container=pre)),
column(3, textOutput('dtbsh', container=pre))
),
server = function(input, output, session) {
output$pl <- renderPlot({
plot(1:10)
})
output$dtclk <- renderPrint({
str(input$pl_click)
})
output$dtdcl <- renderPrint({
str(input$pl_dclick)
})
output$dthov <- renderPrint({
str(input$pl_hover)
})
output$dtbsh <- renderPrint({
str(input$pl_brush)
})
}
)

运行程序，发现下面情况：

在图像上单击鼠标，发生改变的数据有click和hover
在图像上双击鼠标，发生改变的数据有dblclick和hover
在图像上移动鼠标，发生改变的只有hover
在图像上刷取一个矩形区域，发生改变的有click、hover和brush

2 更新图像

有了图像坐标信息，接下来的工作应该很容易了。比如在鼠标处显示坐标数字：

shinyApp(
ui = fixedPage(
plotOutput('pl', click='pl_click')
),
server = function(input, output, session) {
cords <- reactive({
if(is.null(input$pl_click)) return(NULL)
clk <- input$pl_click
list(x=clk$x, y=clk$y)
})
output$pl <- renderPlot({
plot(1:10)
xy <- cords()
if(!is.null(xy)) text(xy, labels=paste(xy, collapse=', '))
})
}
)

代码看起来没什么问题，但运行后你会发现图像上 text 语句输出的坐标信息总是一闪而过。 把click换成dblclick或hover也一样的效果。

到底怎么回事？我们再次分析鼠标动作导致图像更新后客户端返回的值，代码仅比前面的多了一个语句（因为每种动作都会有hover动作）：

shinyApp(
ui = fixedPage(
plotOutput('pl', click='pl_click', dblclick='pl_dclick', hover='pl_hover', brush='pl_brush'),
column(3, textOutput('dtclk', container=pre)),
column(3, textOutput('dtdcl', container=pre)),
column(3, textOutput('dthov', container=pre)),
column(3, textOutput('dtbsh', container=pre))
),
server = function(input, output, session) {
output$pl <- renderPlot({
input$pl_hover  ## 新增语句
plot(1:10)
})
output$dtclk <- renderPrint({
str(input$pl_click)
})
output$dtdcl <- renderPrint({
str(input$pl_dclick)
})
output$dthov <- renderPrint({
str(input$pl_hover)
})
output$dtbsh <- renderPrint({
str(input$pl_brush)
})
}
)

测试结果显示，图像更新后：

hover、click、dblclick等数据被清除
brush数据仍然保留

再回到前一个例子的代码分析，由于hover、click、dblclick清除也是“变化”，而服务器端绘图响应是针对“变化”的，图像对鼠标响应的过程是这样的：

鼠标动作使图像重新绘制
上一步图像更新导致鼠标动作变化（清除），再绘制一个图像
图像更新导致鼠标动作清除，但和上一步状态相同（处于清除状态），不再更新图像

所以每次点击鼠标要绘制两个图，最终得到的仍是没有鼠标点击的图像。

也就是说，不能直接使用hover、click、dblclick触发重新绘图。如果要在随后的图像中使用本次hover、click或dblclick的返回数据，必需在图像更新前先暂时保存它们的值。

只要设一个中间变量过滤无效的鼠标动作，就可以实现在图像中显示鼠标点的坐标：

shinyApp(
ui = fixedPage(
plotOutput('pl', click='pl_click')
),
server = function(input, output, session) {
cords <- reactiveValues(xy=NULL)
observeEvent(  ## 不要使用observe，否则pl_click和cords都会触发响应，可能产生死循环
input$pl_click,
{
if(!is.null(input$pl_click))
cords$xy <- input$pl_click[c('x', 'y')]
})
output$pl <- renderPlot({
plot(1:10)
xy <- cords$xy
if(!is.null(xy)) text(xy, labels=paste(as.list(xy), collapse=', '), xpd=TRUE, adj=c(0.5,-2))
})
}
)

上面程序中plotOutput参数click换成dblclick或hover都是可以的。由于brush数据在图像更新后仍然存在，不需要设置中间变量。

但中间变量只能解决部分问题，如果多个鼠标动作同时在一个图像中使用，“频闪”问题可能会不断。期待将来的shiny版本可以彻底解决这些问题。

3 反向获取数据

nearPoints()和burshedPoints()分别用于获取鼠标附近或已刷取区域内的数据点。它们的使用参数为：

library('shiny')
args(nearPoints)

## function (df, coordinfo, xvar = NULL, yvar = NULL, panelvar1 = NULL,
##     panelvar2 = NULL, threshold = 5, maxpoints = NULL, addDist = FALSE,
##     allRows = FALSE)
## NULL

args(brushedPoints)

## function (df, brush, xvar = NULL, yvar = NULL, panelvar1 = NULL,
##     panelvar2 = NULL, allRows = FALSE)
## NULL

df：是要查询的数据，需要转成 data.frame 类型
coordinfo：从ui端传过来的鼠标input，如上面的 input$pl_click
xvar/yvar：如果不是用ggplot2绘图，或者df用于绘制x/y轴数据的名称不是‘x’/‘y’，则必需指定x/y数据在df中的列名称
panelvar1/2：ggplot2中为facet变量，其他绘图类似于subset功能
addDist：TRUE/FALSE，是否在原df中添加距离计算结果（列，像素表示）
allRows：如果为FALSE（默认），返回值为仅包含临近点所在行的数据框；如果为TRUE，返回值是添加了selected列的原数据框df
threshold, maxpoints：设定最大距离阈值和最多选取的点数（默认最多5个点）

最后请看一个例子：

set.seed(100)
dt <- data.frame(x=1:20, y=abs(rnorm(20) * 100))
shinyApp(
ui = fixedPage(
plotOutput('pl', click='pl_click', brush='pl_brush')
),
server = function(input, output, session) {
pts <- reactiveValues(sel=rep(FALSE, nrow(dt)))
observeEvent(
input$pl_click,
{
if(!is.null(input$pl_click)) {
df <- nearPoints(dt, input$pl_click, x='x', y='y', allRows=TRUE)
pts$sel <- xor(pts$sel, df$selected)
}
})
observeEvent(
input$pl_brush,
{
if(!is.null(input$pl_click)) { ## 此处判断的是pl_click!
df <- brushedPoints(dt, input$pl_brush, x='x', y='y', allRows=TRUE)
pts$sel <- xor(pts$sel, df$selected)
}
})
output$pl <- renderPlot({
plot(dt, cex=ifelse(pts$sel, 10, 1))
})
}
)

为什么brush中还要判断click？我懒得分析了，反正它们俩共用时如果不判断就会出现“频闪”。

4 SessionInfo

print(sessionInfo(), locale=FALSE)

## R version 3.2.2 (2015-08-14)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Debian GNU/Linux 8 (jessie)
##
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base
##
## other attached packages:
## [1] shiny_0.12.2 zblog_0.1.0  knitr_1.11
##
## loaded via a namespace (and not attached):
##  [1] R6_2.1.1        magrittr_1.5    formatR_1.2     htmltools_0.2.6
##  [5] tools_3.2.2     Rcpp_0.12.0     stringi_0.5-5   highr_0.5
##  [9] digest_0.6.8    stringr_1.0.0   xtable_1.7-4    httpuv_1.3.3
## [13] mime_0.4        evaluate_0.7.2

作者: ZGUANG@LZU
Created: 2015-09-16 三 18:25
Emacs 24.4.1 (Org mode 8.2.10)