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

来源：互联网发布：base64.decode java 编辑：程序博客网时间：2024/05/17 04:43

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 RUNplotOutput('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)

1 0