大家看惯R语言朴素的外表后，可能觉得一些高大上的气息好像和R语言没啥关系。今天我们为大家就展示下R语言在图像的交互中帅气一面。话不多说，进入我们的主题：网页可互动图像的绘制。首先我们还是需要安装一个R包：plotly。此包存在于R语言的CRAN上，所以直接安装就好。其依赖的包包括了shiny在内的大量绘图工具。最后我们还要加载另一个包DT。载入包
接下来我们，看看它是如何实现互动图像绘制的：
我们利用其自带的数据包进行绘制，首先看下绘制函数：plot_ly
其中主要的参数是type可以进行选择我们想绘制的图像的类型。
接下来我们直接看下例子，它是怎么实现图像绘制功能的：
1. 散点图的绘制
p <- plot_ly(x = c(1,2,3,4), y =c(2,4,1,3), type = 'scatter', mode = 'lines')
2. 表格数据的输出：
plot_ly(economics) %>% add_table()
3. 热图的绘制：
m <- matrix(rnorm(9), nrow = 3, ncol =3)
p <- plot_ly(
x= c("a", "b", "c"), y = c("d","e", "f"),
z= m, type = "heatmap"
)
4. 多图的拼接：
首先我们介绍下一个主要拼接函数subplot
其主要的参数nrows，通过它我们可以确定图形分布的行数，从而可以确定每行几个图形。
p1 <- plot_ly(economics, x = ~date, y =~unemploy) %>%
add_lines(name = ~"unemploy")
p2 <- plot_ly(economics, x = ~date, y =~uempmed) %>%
add_lines(name = ~"uempmed")
p <- subplot(p1, p2)
5. 图形中分组的数据绘制：
p <- plot_ly(
type = 'scatter',
x =mtcars$hp,
y =mtcars$qsec,
text = paste("Make: ", rownames(mtcars),
"<br>hp: ", mtcars$hp,
"<br>qsec: ",mtcars$qsec,
"<br>Cyl: ",mtcars$cyl),
hoverinfo = 'text',
mode = 'markers',
transforms = list(
list(
type = 'groupby',
groups = mtcars$cyl,
styles = list(
list(target = 4, value = list(marker =list(color = 'blue'))),
list(target = 6, value = list(marker =list(color = 'red'))),
list(target = 8, value = list(marker =list(color = 'black')))
)
)
)
)
6. 为图形添加按钮，改变其对应的线的颜色：
这里我们用到的主要的函数是plot_ly中的button参数，细化主要是通过
list(method = "restyle",
args = list("line.color", "red"),
label = "Red")))
下面函数其中args去调节对应的参数。
整体的实现代码：
x <- seq(-2*pi, 2*pi, length.out = 1000)
df <- data.frame(x, y1 = sin(x))
p <- plot_ly(df, x = ~x) %>%
add_lines(y = ~y1)
p <- p %>% layout(
title = "Button Restyle",
xaxis = list(domain = c(0.1, 1)),
yaxis = list(title = "y"),
updatemenus = list(
list(
type = "buttons",
y = 0.8,
buttons = list(
list(method = "restyle",
args = list("line.color", "blue"),
label = "Blue"),
list(method = "restyle",
args = list("line.color", "red"),
label = "Red")))
))
包还可以进行动画演示，由于展示效果有限，我们在此不做讲解。接下来看下，我们的这个包的大招，那就是整合多图像以及数据进行整体展示：
library(shiny)
library(DT)
library(plotly)
library(crosstalk)
m <- mtcars %>%
tibble::rownames_to_column()
ui <- fluidPage(
h1("Plotly & DT",),
plotlyOutput("x2"),
DT::dataTableOutput("x1"),
fluidRow(
p(class = 'text-center', downloadButton('x3', 'Download Filtered Data'))
)
)
server <- function(input, output) {
d<- SharedData$new(m, ~rowname)
#highlight selected rows in the scatterplot
output$x2 <- renderPlotly({
s<- input$x1_rows_selected
if (!length(s)) {
p <- d %>%
plot_ly(x = ~mpg, y = ~disp, mode = "markers", color =I('black'), name = 'Unfiltered') %>%
layout(showlegend = T) %>%
highlight("plotly_selected", color = I('red'), selected =attrs_selected(name = 'Filtered'))
}else if (length(s)) {
pp <- m %>%
plot_ly() %>%
add_trace(x = ~mpg, y = ~disp, mode = "markers", color =I('black'), name = 'Unfiltered') %>%
layout(showlegend = T)
# selected data
pp <- add_trace(pp, data = m[s, , drop = F], x = ~mpg, y = ~disp,mode = "markers",
color = I('red'), name ='Filtered')
}
})
#highlight selected rows in the table
output$x1 <- DT::renderDataTable({
m2 <- m[d$selection(),]
dt <- DT::datatable(m)
if (NROW(m2) == 0) {
dt
}else {
DT::formatStyle(dt, "rowname", target = "row",
color =DT::styleEqual(m2$rowname, rep("white", length(m2$rowname))),
backgroundColor =DT::styleEqual(m2$rowname, rep("black", length(m2$rowname))))
}
})
#download the filtered data
output$x3 = downloadHandler('mtcars-filtered.csv', content =function(file) {
s<- input$x1_rows_selected
if (length(s)) {
write.csv(m[s, , drop = FALSE], file)
}else if (!length(s)) {
write.csv(m[d$selection(),], file)
}
})
}
shinyApp(ui, server)
如果大家觉得有疑问可以直接访问官方教程那里会有更详细的讲解，链接：https://plot.ly/r/
欢迎大家学习交流！
