悬停消息的灵活位置，同时防止消息超出对象限制 [英] Flexibel location of hover message while preventing message to reach beyond object limits
问题描述
在一个具有在固定div内绘制和缩放的动态图数的应用程序中，我试图解决最终方案，即在多列和多行的图布置中，消息不应最终消失在分组对象之外.
In an app with dynamic number of plots rendered and scaled inside a fixed div I'm trying to solve the final scenario, where in an arrangement of plots over multiple columns and multiple rows, the message should not end up going outside the grouping object.
到目前为止，为了通过ggplots发出悬停消息，我已经实现了以下问题:
In an attempt to make hover messages over ggplots I have so far achieved the following with previous questions:
将鼠标悬停在单个图上而无需离开屏幕 Question2 并尝试改善屏幕关闭时的校正.我在此处发布了当前工作效果最好的版本，然后尝试在其中使用评论中发布的最后一个编辑，但是代码似乎更正了一些. 消息几乎总是以垂直居中的方式排在第一行图的上方.
Hover over a single plot without going off screen Question i.e. Hover over multiple plots Question2 and an attempt to improve the correction for going off screen. I posted the current best working version there, and then tried to use the last edit posted in the comments there, but the code seems to be correcting a bit too much. The message almost always ends up vertically centered above the top row plot.
-
与其纠正消息何时与整个多面板重叠，不如对任何单个图的底部重叠做出反应
instead of correcting when the message would overlap the entire multi panel, it seems to react to overlapping the bottom of any single plot
更正会将其发送到图的第一行坐标，而不是我们悬停在图的相关行.
the correction sends it to coordinates in the top row of plots rather than the relevant row of plots we are hovering over.
该版本的javascript(目前无法正常运行)
That version of the javascript (not working a intended) looks like this currently:
runjs(paste0( "$('[id=FP1PlotMultiplot]').off('mousemove.x').on('mousemove.x', function(e) {",
" $('#my_tooltip').show();",
" var tooltip = document.getElementById('my_tooltip');",
" var rect = tooltip.getBoundingClientRect();",
" var hoverLeft = ", hover$left, ";",
" var hoverTop = ", hover$top, ";",
" var imgWidth = e.target.width;",
" var imgHeight = e.target.height;",
" var offX = 2*hoverLeft > imgWidth ? -rect.width : 0;",
" var offY = 2*hoverTop > imgHeight ? -rect.height+30 : 30;",
" var shiftY = e.offsetY + offY;",
" shiftY = shiftY + rect.height > imgHeight ? 20 + imgHeight - rect.height : shiftY;",
" shiftY = Math.max(20, shiftY);",
" $('#my_tooltip').css({",
" top: shiftY + 'px',",
" left: e.offsetX + e.target.offsetLeft + offX + 'px'",
" });",
"});") )
从某种意义上说，我们不需要预先确定任何大小是一件好事，但是如下图所示，它并不能完全满足我的要求.
Which in a way is nice that we don't need to predetermine any sizes, but as the images below show, doesn't exactly do what I am looking for.
以前的版本可以很好地翻转图，但是在锚点和多图对象(FP1PlotMultiplot)的边缘之间翻转后，并没有检查消息是否真正适合
The previous version worked nice for flipping the plots, but did not check whether the message would actually fit after flipping it between the anchor point and the edge of the multiplot object (FP1PlotMultiplot)
#width per plot = 1000 / nr of cols
#height per plot = 600 / nr of rows
Ylim <- 250 # half of the height per plot
Ylim <- 150 #half the height per plot
offX <- if(hover$left > Xlim) {1000} else {30}
offY <- if(hover$top > Ylim) {1000} else {50}
runjs(paste0( "$('[id=FP1PlotMultiplot]').off('mousemove.x').on('mousemove.x', function(e) {",
" $('#my_tooltip').show();",
" var tooltip = document.getElementById('my_tooltip');",
" var rect = tooltip.getBoundingClientRect();",
" var offX = ", offX, ";",
" var offY = ", offY, ";",
" offX = offX === 1000 ? -rect.width : offX;",
" offY = offY === 1000 ? -rect.height +30 : offY;",
" offY = e.offsetY +e.target.offsetTop + rect.height >= 640 ? -rect.height +30 :offY;",
" $('#my_tooltip').css({",
" top: e.offsetY + e.target.offsetTop + offY + 'px',",
" left: e.offsetX + e.target.offsetLeft + offX + 'px'",
" });",
"});") )
全面测试应用程序，显示即将运行"版本
require('shiny')
require('ggplot2')
require('DT')
require('shinyjs')
library('shinyBS')
ui <- pageWithSidebar(
headerPanel("Hover off the page"),
sidebarPanel(width = 2,
verbatimTextOutput('leftPix'),
verbatimTextOutput('topPix')
),
mainPanel(
shinyjs::useShinyjs(),
tags$head(
tags$style('
#my_tooltip {
position: absolute;
pointer-events:none;
width: 10;
z-index: 100;
padding: 0;
font-size:10px;
line-height:0.6em
}
')
),
uiOutput('FP1PlotMultiplot'),
uiOutput('my_tooltip'),
style = 'width:1250px'
)
)
server <- function(input, output, session) {
output$FP1Plot_1 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() +
theme(legend.position = "none")
})
output$FP1Plot_2 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() +
theme(legend.position = "none")
})
output$FP1Plot_3 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() +
theme(legend.position = "none")
})
output$FP1Plot_4 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() +
theme(legend.position = "none")
})
output$FP1PlotMultiplot<- renderUI({
plot_output_list <- list()
for(i in 1:4) {
plot_output_list <- append(plot_output_list,list(
div(id = paste0('div', 'FP1Plot_', i),
wellPanel(
plotOutput(paste0('FP1Plot_', i),
width = 500,
height = 300,
hover = hoverOpts(id = paste('FP1Plot', i, "hover", sep = '_'), delay = 0)
),
style = paste('border-color:#339fff; border-width:2px; background-color: #fff; width:', 540, 'px; height:', 340, 'px', sep = '')),
style = paste('display: inline-block; margin: 2px; width:', 540, 'px; height:', 340, 'px', sep = ''))
))
}
do.call(tagList, plot_output_list)
})
# turn the hovers into 1 single reactive containing the needed information
hoverReact <- reactive({
eg <- expand.grid(c('FP1Plot'), 1:4)
plotids <- sprintf('%s_%s', eg[,1], eg[,2])
names(plotids) <- plotids
hovers <- lapply(plotids, function(key) input[[paste0(key, '_hover')]])
notNull <- sapply(hovers, Negate(is.null))
if(any(notNull)){
plotid <- names(which(notNull))
plothoverid <- paste0(plotid, "_hover")
hover <- input[[plothoverid]]
if(is.null(hover)) return(NULL)
hover
}
})
## debounce the reaction to calm down shiny
hoverReact_D <- hoverReact %>% debounce(100) ## attempt to stop hoverData <- reactive({}) from firing too often, which is needed when you have 10k point scatter plots.....
hoverData <- reactive({
hover <- hoverReact_D()
if(is.null(hover)) return(NULL)
## in my multi plot multi data frame I look up which dataframe to grab based on hover$plot_id as well as which x and y parameter are plotted
hoverDF <- nearPoints(mtcars, coordinfo = hover, threshold = 15, maxpoints = 1, xvar = 'wt', yvar = 'mpg')
hoverDF
})
hoverPos <- reactive({
## here I look up the position information of the hover whenevver hoverReact_D and hoverData change
hover <- hoverReact_D()
hoverDF <- hoverData()
if(is.null(hover)) return(NULL)
if(nrow(hoverDF) == 0) return(NULL)
## in my real app the data is already
X <- hoverDF$wt[1]
Y <- hoverDF$mpg[1]
left_pct <-
(X - hover$domain$left) / (hover$domain$right - hover$domain$left)
top_pct <-
(hover$domain$top - Y) / (hover$domain$top - hover$domain$bottom)
left_px <-
(hover$range$left + left_pct * (hover$range$right - hover$range$left)) /
hover$img_css_ratio$x
top_px <-
(hover$range$top + top_pct * (hover$range$bottom - hover$range$top)) /
hover$img_css_ratio$y
list(top = top_px, left = left_px)
})
observeEvent(hoverPos(), {
req(hoverPos())
hover <- hoverPos()
if(is.null(hover)) return(NULL)
#width per plot = 1000 / nr of cols
#height per plot = 600 / nr of rows
offX <- if(hover$left > 250) {1000} else {30} # 270 = 540/2 (540 is the width of FP1PlotDoubleplot)
offY <- if(hover$top > 150) {1000} else {50}
runjs(paste0( "$('[id=FP1PlotMultiplot]').off('mousemove.x').on('mousemove.x', function(e) {",
" $('#my_tooltip').show();",
" var tooltip = document.getElementById('my_tooltip');",
" var rect = tooltip.getBoundingClientRect();",
" var hoverLeft = ", hover$left, ";",
" var hoverTop = ", hover$top, ";",
" var imgWidth = e.target.width;",
" var imgHeight = e.target.height;",
" var offX = 2*hoverLeft > imgWidth ? -rect.width : 0;",
" var offY = 2*hoverTop > imgHeight ? -rect.height+30 : 30;",
" var shiftY = e.offsetY + offY;",
" shiftY = shiftY + rect.height > imgHeight ? 20 + imgHeight - rect.height : shiftY;",
" shiftY = Math.max(20, shiftY);",
" $('#my_tooltip').css({",
" top: shiftY + 'px',",
" left: e.offsetX + e.target.offsetLeft + offX + 'px'",
" });",
"});") )
})
output$GGHoverTable <- DT::renderDataTable({
df <- hoverData()
if(!is.null(df)) {
if(nrow(df)){
df <- df[1,]
DT::datatable(t(df), colnames = rep("", nrow(df)),
options = list(dom='t',ordering=F))
}
}
})
output$my_tooltip <- renderUI({
req(hoverData())
req(nrow(hoverData())>0 )
wellPanel(
DT::dataTableOutput('GGHoverTable'),
style = 'background-color: #FFFFFFE6;padding:10px; width:400px;border-color:#339fff; width:auto')
})
}
shinyApp(ui, server)
推荐答案
好的，我设法对其进行了一些修改: 现在，它包含一个if语句，用于检查结果是否不会导致锚点的坐标为<0或>对象高度
OK, I managed to get it working with some more modification: It now includes an if statement to check if the result doesn't cause coordinates for the anchor point to be either <0 or >object height
我唯一仍要更改的内容(如果可能的话，是对javascript中FP1PlotMultiplot的引用，因为我想将此脚本应用于7个不同的对象，它们的名称仅在javascript的第一行中列出，例如这个:
The only thing I would still want to change (if possible is the references to FP1PlotMultiplot inside the javascript because I want to apply this script to 7 different objects where their names are only listed in the first line of the javascript like this:
$('[id=FP1PlotMultiplot], [id=FP2PlotMultiplot],[id=CRFPlotMultiplot]').off('mousemove.x').on('mousemove.x', ......
因此，用类似于'e.target'的名称替换基于名称的方法，但随后替换主输出对象的ID
so, to replace the name based approach by something similar to 'e.target' but then for the main output object's ID
runjs(paste0( "$('[id=FP1PlotMultiplot]').off('mousemove.x').on('mousemove.x', function(e) {",
" $('#my_tooltip').show();",
" var tooltip = document.getElementById('my_tooltip');",
" var rect = tooltip.getBoundingClientRect();",
" var FrameID = document.getElementById('FP1PlotMultiplot');",
" var frame = FrameID.getBoundingClientRect();",
" var hoverLeft = ", hover$left, ";",
" var hoverTop = ", hover$top, ";",
" var imgWidth = e.target.width;",
" var imgHeight = e.target.height;",
" var offX = 2 * hoverLeft > imgWidth ? -rect.width -10 : 10;",
" var offY = 2 * hoverTop > imgHeight ? -rect.height + 10 : 10;",
" var shiftY = e.offsetY + e.target.offsetTop + offY;",
" if (offY === 10) {",
" shiftY = shiftY + rect.height > frame.height ? -rect.height + 10 + e.offsetY + e.target.offsetTop : shiftY",
" } else {",
" shiftY = shiftY < 0 ? e.offsetY + e.target.offsetTop + 10 : shiftY",
" };",
" $('#my_tooltip').css({",
" top: shiftY + 'px',",
" left: e.offsetX + e.target.offsetLeft + offX + 'px'",
" });",
"});") )
更新:当前版本，最后剩余的问题
以下是当前最佳工作版本.我仍在尝试改善一些问题.
Below is the current best working version. There are a few issues I'm still trying to improve.
1)当代码决定向上翻转消息，但只有1个图时，shiftY值当前可以导致位于总图对象顶部边缘上方的位置，例如: 然后决定将其向下放置，只要绘制1个图，它就可以超出底部.
1) When the code decides to flip the message upward, but there is only 1 plot, the shiftY value can currently result in a position that is above the top edge of the total plot object such as here: and then deciding to put it downwards, with 1 plot it can reach beyond the bottom.
造成这种情况的原因是，该消息无法从当前悬停的位置向上或向下放置，因此javascript需要另一条规则来解决此问题，如果是，请将消息放置在该位置的顶部下方10像素总对象.我尝试了各种方法，但最终还是将消息始终放在同一位置，或者没有结果，因为我无法弄清楚如何计算消息是在当前if (offY ...确定shiftY的语句.
The cause of this is that the message doesn't fit upward or downward from the current hover place, and somehow the javascript needs another rule to figure this out, and if so, place the message i.e. 10 pixels below the top of total object. I tried various things, but I either ended up with messages always in the same place, or no result, as I couldn't quite figure out how to calculate whether the message ends up above, or below the total plot area after the current if (offY ... statement to determin shiftY.
2)第二个主要问题是，如果用户大量移动鼠标(在具有数千个数据点的绘图中，这会变得更加明显)，该应用似乎似乎无法计算新表.因此，如果鼠标从点A移到点，则代码会对A和B之间的许多悬停位置做出反应，从而触发了很长的计算队列，最后才显示出鼠标停止"或停止的点B的实际信息.停顿了.我一直在玩延迟和反跳，但是没有找到一个可行的解决方案来阻止应用进行不必要的计算，这在我的实际应用中比测试应用对R的要求更高/要求更高.
2) The second major issue is that the app seems to get hung up on calculating new tables if the user moves the mouse a lot (in a plot with a few thousand data points this becomes more evident). So, if the mouse went from point A to point, the code reacts to a lot of hover positions between A and B causing a long queue of calculations to be triggered before finally showing the actual information of point B where the mouse 'stopped' or paused. I have been playing with delay and debounce, but did not find a working solution to stop the app from going through unnecessary calculations, which in my real app are more intensive /demanding on R than the test app.
当前版本的演示应用程序:
require('shiny')
require('ggplot2')
require('DT')
require('shinyjs')
library('shinyBS')
ui <- pageWithSidebar(
headerPanel("Hover off the page"),
sidebarPanel(width = 2,
sliderInput(inputId = 'NrOfPlots', label = 'Nr of Plots', min = 1, max = 20, value = 1),
verbatimTextOutput('leftPix'),
verbatimTextOutput('topPix')
),
mainPanel(
shinyjs::useShinyjs(),
tags$head(
tags$style('
#my_tooltip {
position: absolute;
pointer-events:none;
width: 10;
z-index: 100;
padding: 0;
font-size:10px;
line-height:0.6em
}
')
),
uiOutput('FP1PlotMultiplot'),
uiOutput('my_tooltip'),
style = 'width:1250px'
)
)
server <- function(input, output, session) {
observe({
lapply(1:input$NrOfPlots, function(i) {
output[[paste0('FP1Plot_', i)]] <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() +
theme(legend.position = "none")
})
})
})
output$FP1PlotMultiplot<- renderUI({
n <- input$NrOfPlots
n_cols <- if(n == 1) {
1
} else if (n %in% c(2,4)) {
2
} else if (n %in% c(3,5,6,9)) {
3
} else {
4
}
Pwidth <- 1000/n_cols
Pheight <- 450/ceiling(n/n_cols) # calculate number of rows
Pwidth2 <- Pwidth+40
Pheight2 <- Pheight+80
plot_output_list <- list()
for(i in 1:input$NrOfPlots) {
plot_output_list <- append(plot_output_list,list(
div(id = paste0('div', 'FP1Plot_', i),
wellPanel(
plotOutput(paste0('FP1Plot_', i),
width = Pwidth,
height = Pheight,
hover = hoverOpts(id = paste('FP1Plot', i, "hover", sep = '_'), delay = 0)
),
style = paste('border-color:#339fff; border-width:2px; background-color: #fff; width:', Pwidth2, 'px; height:', Pheight2, 'px', sep = '')),
style = paste('display: inline-block; margin: 2px; width:', Pwidth2, 'px; height:', Pheight2, 'px', sep = ''))
))
}
do.call(tagList, plot_output_list)
})
# turn the hovers into 1 single reactive containing the needed information
hoverReact <- reactive({
eg <- expand.grid(c('FP1Plot'), 1:input$NrOfPlots)
plotids <- sprintf('%s_%s', eg[,1], eg[,2])
names(plotids) <- plotids
hovers <- lapply(plotids, function(key) input[[paste0(key, '_hover')]])
notNull <- sapply(hovers, Negate(is.null))
if(any(notNull)){
plotid <- names(which(notNull))
plothoverid <- paste0(plotid, "_hover")
hover <- input[[plothoverid]]
if(is.null(hover)) return(NULL)
hover
}
})
## debounce the reaction to calm down shiny
hoverReact_D <- hoverReact %>% debounce(100) ## attempt to stop hoverData <- reactive({}) from firing too often, which is needed when you have 10k point scatter plots.....
hoverData <- reactive({
hover <- hoverReact_D()
if(is.null(hover)) return(NULL)
## in my multi plot multi data frame I look up which dataframe to grab based on hover$plot_id as well as which x and y parameter are plotted
hoverDF <- nearPoints(mtcars, coordinfo = hover, threshold = 15, maxpoints = 1, xvar = 'wt', yvar = 'mpg')
hoverDF
})
hoverPos <- reactive({
## here I look up the position information of the hover whenevver hoverReact_D and hoverData change
hover <- hoverReact_D()
hoverDF <- hoverData()
if(is.null(hover)) return(NULL)
if(nrow(hoverDF) == 0) return(NULL)
## in my real app the data is already
X <- hoverDF$wt[1]
Y <- hoverDF$mpg[1]
left_pct <-
(X - hover$domain$left) / (hover$domain$right - hover$domain$left)
top_pct <-
(hover$domain$top - Y) / (hover$domain$top - hover$domain$bottom)
left_px <-
(hover$range$left + left_pct * (hover$range$right - hover$range$left)) /
hover$img_css_ratio$x
top_px <-
(hover$range$top + top_pct * (hover$range$bottom - hover$range$top)) /
hover$img_css_ratio$y
list(top = top_px, left = left_px)
})
observeEvent(hoverPos(), {
req(hoverPos())
hover <- hoverPos()
if(is.null(hover)) return(NULL)
runjs(paste0( "$('[id=FP1PlotMultiplot]').off('mousemove.x').on('mousemove.x', function(e) {",
" $('#my_tooltip').show();",
" var tooltip = document.getElementById('my_tooltip');",
" var rect = tooltip.getBoundingClientRect();",
" var FrameID = document.getElementById('FP1PlotMultiplot');",
" var frame = FrameID.getBoundingClientRect();",
" var hoverLeft = ", hover$left, ";",
" var hoverTop = ", hover$top, ";",
" var imgWidth = e.target.width;",
" var imgHeight = e.target.height;",
" var offX = 2 * hoverLeft > imgWidth ? -rect.width -10 : 10;",
" var offY = 2 * hoverTop > imgHeight ? -rect.height + 10 : 10;",
" var shiftY = e.offsetY + e.target.offsetTop + offY;",
" if (offY === 10) {",
" shiftY = shiftY + rect.height > frame.height ? -rect.height + 10 + e.offsetY + e.target.offsetTop : shiftY",
" } else {",
" shiftY = shiftY < 0 ? e.offsetY + e.target.offsetTop + 10 : shiftY",
" };",
" $('#my_tooltip').css({",
" top: shiftY + 'px',",
" left: e.offsetX + e.target.offsetLeft + offX + 'px'",
" });",
"});") )
})
output$GGHoverTable <- renderTable({
df <- hoverData()
if(!is.null(df)) {
if(nrow(df)){
df <- df[1,]
t(df)
}
}
})
output$my_tooltip <- renderUI({
req(hoverData())
req(nrow(hoverData())>0 )
wellPanel(
tableOutput('GGHoverTable'),
style = 'background-color: #FFFFFFE6;padding:10px; width:400px;border-color:#339fff; width:auto')
})
}
shinyApp(ui, server)
这篇关于悬停消息的灵活位置，同时防止消息超出对象限制的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
