有多个地块时悬停消息的位置出错
在寻找自定义构建悬停消息时，并确保它们停留在屏幕上，我设法解决了CSS位置更新的问题：SO question， 但在我的真实应用中，可以由用户设置nr op图，该用户将自动缩放比例： 1-20个地块 1-4列
悬停时，两个图都会产生px垂直和水平位置的值，并且两个图似乎都给出相似的值。
然后，这会根据坐标所在的绘图部分（上/下，向左/向右，取决于绘图的哪四分之一）触发偏移校正计算
offX <- if(hover$left > 350) {-90} else {50}
offY <- if(hover$top > 350) {-270} else {30 }
演示应用程序显示，两个图均产生相同的校正值，应将其添加到e.offsetY和e.offsetX
这些绘图分别称为FP1Plot1和FP1Plot2，最后一个nr指示序列nr，第一部分显示它们所在的应用程序页面。
此块应为工具提示发送新坐标，但它们似乎始终与左侧的第一个图链接。这是因为它将其链接到分组的输出对象'FP1PlotDoubleplot'。我不知道如何将其链接到悬停当前所在的实际单个图上：
runjs(paste0( "$('[id^=FP1Plot]').off('mousemove.x').on('mousemove.x', function(e) {",
"$('#my_tooltip').show();",
"$('#my_tooltip').css({",
"top: (e.offsetY +", offY, " ) + 'px',",
"left: (e.offsetX +", 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('FP1PlotDoubleplot'),
uiOutput('my_tooltip'),
style = 'width:1250px'
)
)
server <- function(input, output, session) {
# ranges <- reactiveValues()
output$FP1Plot1 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point()
})
output$FP1Plot2 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point()
})
output$FP1PlotDoubleplot<- renderUI({
plot_output_list <- list()
for(i in 1:2) {
plot_output_list <- append(plot_output_list,list(
div(id = paste0('div', 'FP1Plot', i),
wellPanel(
plotOutput(paste0('FP1Plot', i),
width = 500,
height = 600,
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:', 680, 'px', sep = '')),
style = paste('display: inline-block; margin: 2px; width:', 540, 'px; height:', 680, '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:2)
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)
offX <- if(hover$left > 350) {-90} else {50}
offY <- if(hover$top > 350) {-270} else {30 }
output$leftPix <- renderPrint({ offX[1]})
output$topPix <- renderPrint({ offY[1]})
runjs(paste0( "$('[id^=FP1Plot]').off('mousemove.x').on('mousemove.x', function(e) {",
"$('#my_tooltip').show();",
"$('#my_tooltip').css({",
"top: (e.offsetY +", offY, " ) + 'px',",
"left: (e.offsetX +", 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(
dataTableOutput('GGHoverTable'),
style = 'background-color: #FFFFFFE6;padding:10px; width:400px;border-color:#339fff; width:auto')
})
}
shinyApp(ui, server)
与1个地块完美配合
require('shiny')
require('ggplot2')
require('DT')
require('shinyjs')
library('shinyBS')
ui <- pageWithSidebar(
headerPanel("Hover off the page"),
sidebarPanel(width = 2
),
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
}
')
),
plotOutput('FP1Plot1' ,
width = 1000,
height = 800,
hover = hoverOpts(id = 'FP1Plot_1_hover', delay = 0)
),
uiOutput('my_tooltip'),
style = 'width:1250px'
)
)
server <- function(input, output, session) {
output$FP1Plot1 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() #+
})
# turn the hovers into 1 single reactive containing the needed information
hoverReact <- reactive({
## in my real app I observer hover of all sub plots of all stages (7 pages with a multilot object)
## followed by code to store the page ID and plot NR as elements in hoverReact()
hover <- input[['FP1Plot_1_hover']]
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)
offX <- if(hover$left > 350) {-400} else {30}
offY <- if(hover$top > 350) {-290} else {10 }
runjs(paste0( "$('[id^=FP1Plot]').mousemove(function(e) {",
"$('#my_tooltip').show();",
"$('#my_tooltip').css({",
"top: (e.offsetY +", offY, " ) + 'px',",
"left: (e.offsetX +", 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, autowidth = T))
}
}
})
output$my_tooltip <- renderUI({
req(hoverData())
req(nrow(hoverData())>0 )
wellPanel(
dataTableOutput('GGHoverTable'),
style = 'background-color: #FFFFFFE6;padding:10px; width:400px;border-color:#339fff')
})
}
shinyApp(ui, server)
PS跟踪以使偏移更智能
我试图编写一些JavaScript来获取对象大小，以基于该大小为偏移翻转点，但到目前为止无法正常工作
sizejs <- function(ID){
sprintf(paste(
"var element = document.getElementById({id: %s);",
"var positionInfo = element.getBoundingClientRect();",
"var height = positionInfo.height;",
"var width = positionInfo.width;",
" Shiny.setInputValue(objectHeight, height);",
" Shiny.setInputValue(objectWidth, width);",
sep = "\n"
), ID)
}
，然后：
runjs(sizejs('TooltipDiv'))
获取工具提示的大小（重命名为div('TooltipDiv'...而不是wellPanel
但也希望检查图的大小（在动态布局中，这会随着图的nr改变）
编辑：当前最佳工作版本
移动到有关多列/行的详细信息的新问题，并且不会超出限制 到目前为止，我有2种情节场景
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('FP1PlotDoubleplot'),
uiOutput('my_tooltip'),
style = 'width:1250px'
)
)
server <- function(input, output, session) {
# ranges <- reactiveValues()
output$FP1Plot_1 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point()
})
output$FP1Plot_2 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point()
})
output$FP1PlotDoubleplot<- renderUI({
plot_output_list <- list()
for(i in 1:2) {
plot_output_list <- append(plot_output_list,list(
div(id = paste0('div', 'FP1Plot_', i),
wellPanel(
plotOutput(paste0('FP1Plot_', i),
width = 500,
height = 600,
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:', 680, 'px', sep = '')),
style = paste('display: inline-block; margin: 2px; width:', 540, 'px; height:', 680, '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:2)
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)
offX <- if(hover$left > 350) {-125} else {10}
offY <- if(hover$top > 350) {-290} else {10 }
output$leftPix <- renderPrint({ offX[1]})
output$topPix <- renderPrint({ offY[1]})
runjs(paste0( "$('[id=FP1PlotDoubleplot]').off('mousemove.x').on('mousemove.x', function(e) {",
"$('#my_tooltip').show();",
"$('#my_tooltip').css({",
"top: (e.offsetY + e.target.offsetTop+", offY, " ) + '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)
1 个答案:
答案 0 :(得分：1)
我必须将dataTableOutput替换为DT::dataTableOutput，否则工具提示为空。
通过以下操作似乎可以很好地定位工具提示：
offX <- if(hover$left > 350) {-90} else {0}
offY <- if(hover$top > 350) {-270} else {30 }
runjs(paste0( "$('[id=FP1PlotDoubleplot]').off('mousemove.x').on('mousemove.x', function(e) {",
"$('#my_tooltip').show();",
"$('#my_tooltip').css({",
"top: (e.offsetY +", offY, " ) + 'px',",
"left: (e.offsetX + e.target.offsetLeft +", offX, ") + 'px'",
"});",
"});") )
编辑
这是一种自动计算偏移量的方法：
offX <- if(hover$left > 270) {1000} else {0} # 270 = 540/2 (540 is the width of FP1PlotDoubleplot)
offY <- if(hover$top > 350) {1000} else {30}
runjs(paste0( "$('[id=FP1PlotDoubleplot]').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;",
" $('#my_tooltip').css({",
" top: e.offsetY + offY + 'px',",
" left: e.offsetX + e.target.offsetLeft + offX + 'px'",
" });",
"});") )
编辑
一种更好的方法，不需要输入图的尺寸：
observeEvent(hoverPos(), {
req(hoverPos())
hover <- hoverPos()
if(is.null(hover)) return(NULL)
runjs(paste0( "$('[id=FP1PlotDoubleplot]').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;",
" $('#my_tooltip').css({",
" top: e.offsetY + offY + 'px',",
" left: e.offsetX + e.target.offsetLeft + offX + 'px'",
" });",
"});") )
})
编辑
为确保工具提示不会超出绘图区域，
runjs(paste0( "$('[id=FP1PlotDoubleplot]').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'",
" });",
"});") )
编辑
我尝试将两块地块的四个地块布置在一起。这是我的解决方法。
require('shiny')
require('ggplot2')
require('DT')
require('shinyjs')
library('shinyBS')
ui <- pageWithSidebar(
headerPanel("Hover off the page"),
sidebarPanel(),
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('FP1PlotDoubleplot'),
uiOutput('my_tooltip'),
style = 'width:1250px'
)
)
server <- function(input, output, session) {
# ranges <- reactiveValues()
output$FP1Plot1 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point()
})
output$FP1Plot2 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point()
})
output$FP1Plot3 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point()
})
output$FP1Plot4 <- renderPlot({
ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point()
})
output$FP1PlotDoubleplot<- renderUI({
tagList(
fluidRow(
column(6,
wellPanel(
plotOutput('FP1Plot1',
width = 500,
height = 400,
hover = hoverOpts(id = paste('FP1Plot', 1, "hover", sep = '_'), delay = 0)
),
style = 'border-color:#339fff; border-width:2px; background-color: #fff;'
)
),
column(6,
wellPanel(
plotOutput('FP1Plot2',
width = 500,
height = 400,
hover = hoverOpts(id = paste('FP1Plot', 2, "hover", sep = '_'), delay = 0)
),
style = 'border-color:#339fff; border-width:2px; background-color: #fff;'
)
)
),
fluidRow(
column(6,
wellPanel(
plotOutput('FP1Plot3',
width = 500,
height = 400,
hover = hoverOpts(id = paste('FP1Plot', 3, "hover", sep = '_'), delay = 0)
),
style = 'border-color:#339fff; border-width:2px; background-color: #fff;'
)
),
column(6,
wellPanel(
plotOutput('FP1Plot4',
width = 500,
height = 400,
hover = hoverOpts(id = paste('FP1Plot', 4, "hover", sep = '_'), delay = 0)
),
style = 'border-color:#339fff; border-width:2px; background-color: #fff;'
)
)
)
)
})
# 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)
runjs(paste0( "$('[id=FP1PlotDoubleplot]').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+20 : 0;",
" var shiftY = e.offsetY + offY;",
" shiftY = shiftY + rect.height > imgHeight ? imgHeight - rect.height : shiftY;",
" shiftY = Math.max(0, shiftY);",
" $('#my_tooltip').css({",
" top: shiftY + e.target.getBoundingClientRect().top - document.getElementById('FP1PlotDoubleplot').getBoundingClientRect().top + 'px',",
" left: e.clientX + 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)
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？