plotly:可以只使某些图形对象交互吗?
plotly: possible to make only certain graphical objects interactive?
我有一个 ggplot,我想将其变为交互式。但是,我不希望所有对象都具有交互性,因为有些对象实际上是用作一种背景图(在这种情况下,是一排排温室植物)。
上面方块中的数据应该是交互的,但绿色植物点或灰色行不是。
这甚至可以用 plotly 实现吗?如果是这样:如何?
我的代码和结果(我添加了 theme_update()
所以复制品看起来和我的一模一样,尽管它不太重要):
代码
# counts in greenhouse
Wtot <- c(10,65,139,87)
plant <- c(15,15,30,30)
row <- c(10,20,10,20)
df <- data.frame(Wtot,plant,row)
# df for greenhouse background
nrows = 40
nplants = 50
greenh <- data.frame(
Row <- rep(1:nrows, each=nplants),
Plant <- rep(1:nplants, times=nrows),
Plantnr <- paste("plant",1:(nrows*nplants))
)
# plottheme
theme_set(theme_bw())
theme_update(axis.title.x = element_text(size = 16, colour = 'black'),
axis.title.y = element_text(size = 16, colour = 'black', angle = 90),
axis.text.x = element_text(size = 12, colour = 'black'),
axis.text.y = element_text(size = 12, colour = 'black'),
legend.text = element_text(size = 14, colour = 'black'),
legend.title = element_blank(),
legend.position = "right",
legend.box = "vertical",
strip.text.x = element_text(size = 14, colour = 'black'),
strip.text.y = element_text(size = 14, colour = 'black', angle = -90),
panel.background = element_rect(fill = "gray94"),
panel.grid.minor = element_blank(),
panel.grid.major = element_blank())
# plot
p <- ggplot(data=df, aes(row, plant, colour=Wtot)) +
xlim(0,nrows) +
ylim(0,nplants) +
coord_equal() +
geom_vline(xintercept=1:nrows, colour="darkgrey", alpha=0.5, size=0.7) +
geom_point(data=greenh, aes(x=Row, y=Plant), colour="darkgreen", alpha=0.3) +
geom_point(aes(fill=Wtot, size=Wtot), colour="black", pch=22) +
scale_fill_gradient2(low="green", mid="yellow", high="red", na.value="grey",
limits=c(0,300), midpoint=150, breaks=c(0,75,150,225,300)) +
scale_size_continuous(range=c(3,6), limits=c(0,300), breaks=c(0,75,150,225,300)) +
guides(fill=guide_legend(), size = guide_legend())
图表
您有两个选择:
选项 1:使用 ggplotly
您将失去传奇。但是您必须手动添加积分。
# p <- ggplot(data=df, aes(row, plant, colour=Wtot)) +
p <- ggplot(data=greenh, aes(x=Row, y=Plant)) +
xlim(0,nrows) +
ylim(0,nplants) +
coord_equal() +
geom_vline(xintercept=1:nrows, colour="darkgrey", alpha=0.5, size=0.7) +
geom_point(colour="darkgreen", alpha=0.3) +
#geom_point(aes(fill=Wtot, size=Wtot), colour="black", pch=22) +
scale_fill_gradient2(low="green", mid="yellow", high="red", na.value="grey",
limits=c(0,300), midpoint=150, breaks=c(0,75,150,225,300)) +
scale_size_continuous(range=c(3,6), limits=c(0,300), breaks=c(0,75,150,225,300)) +
guides(fill=guide_legend(), size = guide_legend())
pp <- ggplotly(p, tooltip = "none")
pp %>% add_markers(x = c(10, 20, 10, 20), y = c(15, 15, 30, 30), color = I("green"), text = c(10, 65, 139, 87), symbol = I('square'), marker = list(size = c(14, 13, 15, 12)))
选项 2:使用 plot_ly
您可以获得与图例类似的内容。您只需根据需要设置颜色和尺寸。
plot_ly(data=greenh, x=~Row, y= ~Plant) %>%
add_markers(showlegend = FALSE, color = I("green"), hoverinfo = "none") %>%
add_markers(data=df, x=~row, y= ~plant, showlegend = TRUE, color = ~ Wtot, size = ~ Wtot)
所以我找到了解决方案,并且还认为我遗漏了 quite 关键信息:我在 flexdashboard 中使用这个交互式绘图。我省略了那部分以使示例简单,但显然它掌握了关键!
这个问题的答案让我走上正轨:
使用 shiny 函数 plotOutput()
和 renderPlot()
时,您可以通过 plotOutput
中的参数 hover =
添加 hover-function。 Flexdashboards 没有单独的 ui 和服务器部分,因此不使用 plotOutput()
。这意味着您需要单独指定悬停选项,然后通过参数 outputArgs =
(更多信息:https://shiny.rstudio.com/articles/output-args.html).
# specify hover details
HO <- hoverOpts(id = "plot_hover", delay = 300, delayType = c("debounce", "throttle"),
clip = TRUE, nullOutside = TRUE)
# reactive plot function
renderPlot({
ggplot(data=df, aes(row, plant, colour=Wtot)) +
xlim(0,40) +
ylim(0,50) +
coord_equal() +
geom_vline(xintercept=1:nrows, colour="darkgrey", alpha=0.5, size=0.7) +
geom_point(data=greenh, aes(x=Row, y=Plant), colour="darkgreen", alpha=0.3) +
geom_point(aes(fill=Wtot, size=Wtot), colour="black", pch=22) +
scale_fill_gradient2(low="green", mid="yellow", high="red", na.value="grey",
limits=c(0,300), midpoint=150, breaks=c(0,75,150,225,300)) +
scale_size_continuous(range=c(3,6), limits=c(0,300), breaks=c(0,75,150,225,300)) +
guides(fill=guide_legend(), size = guide_legend())
}, outputArgs = list(hover = HO)) # include hover options
现在绘图已准备好显示悬停信息,但还没有显示任何内容。您必须指定要查看的信息。在这里我可以告诉它只显示正方形的信息而不是温室元素的信息:
# shown hover results
renderPrint({
hover <- input$plot_hover
y <- nearPoints(df, input$plot_hover)
req(nrow(y) != 0)
y
})
您可以进一步调整代码以将信息显示为工具提示(参见上面提到的线程)。
希望对其他人有所帮助!
我有一个 ggplot,我想将其变为交互式。但是,我不希望所有对象都具有交互性,因为有些对象实际上是用作一种背景图(在这种情况下,是一排排温室植物)。 上面方块中的数据应该是交互的,但绿色植物点或灰色行不是。
这甚至可以用 plotly 实现吗?如果是这样:如何?
我的代码和结果(我添加了 theme_update()
所以复制品看起来和我的一模一样,尽管它不太重要):
代码
# counts in greenhouse
Wtot <- c(10,65,139,87)
plant <- c(15,15,30,30)
row <- c(10,20,10,20)
df <- data.frame(Wtot,plant,row)
# df for greenhouse background
nrows = 40
nplants = 50
greenh <- data.frame(
Row <- rep(1:nrows, each=nplants),
Plant <- rep(1:nplants, times=nrows),
Plantnr <- paste("plant",1:(nrows*nplants))
)
# plottheme
theme_set(theme_bw())
theme_update(axis.title.x = element_text(size = 16, colour = 'black'),
axis.title.y = element_text(size = 16, colour = 'black', angle = 90),
axis.text.x = element_text(size = 12, colour = 'black'),
axis.text.y = element_text(size = 12, colour = 'black'),
legend.text = element_text(size = 14, colour = 'black'),
legend.title = element_blank(),
legend.position = "right",
legend.box = "vertical",
strip.text.x = element_text(size = 14, colour = 'black'),
strip.text.y = element_text(size = 14, colour = 'black', angle = -90),
panel.background = element_rect(fill = "gray94"),
panel.grid.minor = element_blank(),
panel.grid.major = element_blank())
# plot
p <- ggplot(data=df, aes(row, plant, colour=Wtot)) +
xlim(0,nrows) +
ylim(0,nplants) +
coord_equal() +
geom_vline(xintercept=1:nrows, colour="darkgrey", alpha=0.5, size=0.7) +
geom_point(data=greenh, aes(x=Row, y=Plant), colour="darkgreen", alpha=0.3) +
geom_point(aes(fill=Wtot, size=Wtot), colour="black", pch=22) +
scale_fill_gradient2(low="green", mid="yellow", high="red", na.value="grey",
limits=c(0,300), midpoint=150, breaks=c(0,75,150,225,300)) +
scale_size_continuous(range=c(3,6), limits=c(0,300), breaks=c(0,75,150,225,300)) +
guides(fill=guide_legend(), size = guide_legend())
图表
您有两个选择:
选项 1:使用 ggplotly
您将失去传奇。但是您必须手动添加积分。
# p <- ggplot(data=df, aes(row, plant, colour=Wtot)) +
p <- ggplot(data=greenh, aes(x=Row, y=Plant)) +
xlim(0,nrows) +
ylim(0,nplants) +
coord_equal() +
geom_vline(xintercept=1:nrows, colour="darkgrey", alpha=0.5, size=0.7) +
geom_point(colour="darkgreen", alpha=0.3) +
#geom_point(aes(fill=Wtot, size=Wtot), colour="black", pch=22) +
scale_fill_gradient2(low="green", mid="yellow", high="red", na.value="grey",
limits=c(0,300), midpoint=150, breaks=c(0,75,150,225,300)) +
scale_size_continuous(range=c(3,6), limits=c(0,300), breaks=c(0,75,150,225,300)) +
guides(fill=guide_legend(), size = guide_legend())
pp <- ggplotly(p, tooltip = "none")
pp %>% add_markers(x = c(10, 20, 10, 20), y = c(15, 15, 30, 30), color = I("green"), text = c(10, 65, 139, 87), symbol = I('square'), marker = list(size = c(14, 13, 15, 12)))
选项 2:使用 plot_ly
您可以获得与图例类似的内容。您只需根据需要设置颜色和尺寸。
plot_ly(data=greenh, x=~Row, y= ~Plant) %>%
add_markers(showlegend = FALSE, color = I("green"), hoverinfo = "none") %>%
add_markers(data=df, x=~row, y= ~plant, showlegend = TRUE, color = ~ Wtot, size = ~ Wtot)
所以我找到了解决方案,并且还认为我遗漏了 quite 关键信息:我在 flexdashboard 中使用这个交互式绘图。我省略了那部分以使示例简单,但显然它掌握了关键!
这个问题的答案让我走上正轨:
使用 shiny 函数 plotOutput()
和 renderPlot()
时,您可以通过 plotOutput
中的参数 hover =
添加 hover-function。 Flexdashboards 没有单独的 ui 和服务器部分,因此不使用 plotOutput()
。这意味着您需要单独指定悬停选项,然后通过参数 outputArgs =
(更多信息:https://shiny.rstudio.com/articles/output-args.html).
# specify hover details
HO <- hoverOpts(id = "plot_hover", delay = 300, delayType = c("debounce", "throttle"),
clip = TRUE, nullOutside = TRUE)
# reactive plot function
renderPlot({
ggplot(data=df, aes(row, plant, colour=Wtot)) +
xlim(0,40) +
ylim(0,50) +
coord_equal() +
geom_vline(xintercept=1:nrows, colour="darkgrey", alpha=0.5, size=0.7) +
geom_point(data=greenh, aes(x=Row, y=Plant), colour="darkgreen", alpha=0.3) +
geom_point(aes(fill=Wtot, size=Wtot), colour="black", pch=22) +
scale_fill_gradient2(low="green", mid="yellow", high="red", na.value="grey",
limits=c(0,300), midpoint=150, breaks=c(0,75,150,225,300)) +
scale_size_continuous(range=c(3,6), limits=c(0,300), breaks=c(0,75,150,225,300)) +
guides(fill=guide_legend(), size = guide_legend())
}, outputArgs = list(hover = HO)) # include hover options
现在绘图已准备好显示悬停信息,但还没有显示任何内容。您必须指定要查看的信息。在这里我可以告诉它只显示正方形的信息而不是温室元素的信息:
# shown hover results
renderPrint({
hover <- input$plot_hover
y <- nearPoints(df, input$plot_hover)
req(nrow(y) != 0)
y
})
您可以进一步调整代码以将信息显示为工具提示(参见上面提到的线程)。
希望对其他人有所帮助!