R Shiny – 使用 CSS 滚动时让 wellPanel 弹出窗口跟随
Mik*_*ada 6 javascript css r shiny
问题： R Shiny – 使用 CSS 滚动时让 wellPanel 弹出窗口跟随
嗨堆栈用户，
我创建了一个闪亮的应用程序，它有一个数据表，其中当用户单击一行时，它旁边会弹出一个隐藏的 wellPanel，以显示与该行相关的更多详细信息。
弹出的wellPanel的长度很长，但是表格的长度更长（行数不可协商）。我想让 wellPanel 在滚动时跟随，直到 wellPanel 的顶部到达页面的顶部可见部分。此时，wellPanel 会一直粘到页面底部（请参阅下面的首选状态图像）。
使用 CSSposition: fixed并不能解决问题，因为在表格和面板上方有针对目标用户的说明。因此，position: fixed仅使用将 wellPanel 永久粘贴到网页的一部分，并且一些信息会被删除（请参阅下面的示例应用程序）。
现在，我不是一名 Web 开发人员/设计师，所以我对 CSS 的了解非常少，但我希望上一篇文章中的 CSS 解决方案（How do you make a div follow as you scroll? /）具体来说：https://www.w3schools.com/css/css_positioning.asp）使用position: sticky可以工作，但仍然没有成功。
希望听到社区专家的意见。谢谢！
米克洛斯
我的应用程序的简化示例以及显示首选状态的图像如下：
安装程序.R
#### LOAD PACKAGES ######################
require(shiny)
require(shinyjs)
require(data.table)
require(dplyr)
require(DT)
#### PREPARE DATA ######################
id <- c('10001','10002','10003','10004','10005',
'10006','10007','10008','10009','10010',
'10011','10012','10013','10014','10015',
'10016','10017','10018','10019','10020',
'10021','10022','10023','10024','10025',
'10026','10027','10028','10029','10030',
'10031','10032','10033','10034','10035',
'10036','10037','10038','10039','10040'
)
info <- c('Info','Info','Info','Info','Info',
'Info','Info','Info','Info','Info',
'Info','Info','Info','Info','Info',
'Info','Info','Info','Info','Info',
'Info','Info','Info','Info','Info',
'Info','Info','Info','Info','Info',
'Info','Info','Info','Info','Info',
'Info','Info','Info','Info','Info'
)
info2 <- sample(1:100,40,replace=T)
info3 <- sample(1:100,40,replace=T)
info4 <- sample(1:100,40,replace=T)
info5 <- sample(1:100,40,replace=T)
info6 <- sample(1:100,40,replace=T)
info7 <- sample(1:100,40,replace=T)
info8 <- sample(1:100,40,replace=T)
info9 <- sample(1:100,40,replace=T)
info10 <- sample(1:100,40,replace=T)
info11 <- sample(1:100,40,replace=T)
info12 <- sample(1:100,40,replace=T)
info13 <- sample(1:100,40,replace=T)
info14 <- sample(1:100,40,replace=T)
info15 <- sample(1:100,40,replace=T)
info16 <- sample(1:100,40,replace=T)
dt <- data.table(id=id,info=info,info2=info2,
info3=info3,info4=info4,info5=info5,
info6=info6,info7=info7,info8=info8,
info9=info9,info10=info10,info11=info11,
info12=info12,info13=info13,info14=info14,
info15=info15,info16=info16
)
#### INSTANTIATE FUNCTIONS ######################
get_instructions <- function() {
"Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.
"
}
render_my_table <- function(dt, sel) {
if(missing(sel)) {
sel = list(mode='single')
} else {
sel = list(mode='single', selected = sel)
}
return (DT::datatable(dt[, list("ID" = id, "Info"=info)],
selection = sel, filter="top",
options = list(sDom = '<"top">lrt<"bottom">ip',
lengthChange = FALSE,
pageLength = 40)))
}
generate_popup_details <- function(user) {
c(
paste("Info 2: ", user$info2),
paste("Info 3: ", user$info3),
paste("Info 4: ", user$info4),
paste("Info 5: ", user$info5),
paste("Info 6: ", user$info6),
paste("Info 7: ", user$info7),
paste("Info 8: ", user$info8),
paste("Info 9: ", user$info9),
paste("Info 10: ", user$info10),
paste("Info 11: ", user$info11),
paste("Info 12: ", user$info12),
paste("Info 13: ", user$info13),
paste("Info 14: ", user$info14),
paste("Info 15: ", user$info15),
paste("Info 16: ", user$info16)
)
}
ui.R
source("setup.R")
shinyUI(fluidPage(
useShinyjs(),
titlePanel("My Shiny Application"),
hr(),
h3("Some Instructions to Users:"),
h5(get_instructions()),
hr(),
mainPanel("",
fluidRow(
splitLayout(div(DT::dataTableOutput('my_table')),
div(
shinyjs::hidden(
wellPanel(id="my_panel", style = "position:fixed;",
h3("More Information",align="center"),
htmlOutput("my_popup")
)
)
)
)
)
)
))
服务器R
source("setup.R")
function(input, output, session) {
output$my_table = DT::renderDataTable({
render_my_table(dt)
}, server=TRUE)
observeEvent(input$my_table_cell_clicked, {
row = as.numeric(input$my_table_rows_selected)
user = dt[row]
if(nrow(user) == 0) {
return ()
}
output$my_popup <- renderUI({
HTML(paste(generate_popup_details(user) ,collapse="<br/>"))
})
shinyjs::showElement(id= "my_panel")
})
}
首选状态：
加载时的应用程序
用户到达页面底部，wellPanel 停留在可见页面的顶部
使用以下 JavaScript 代码：
js <- "
$(document).ready(function(){
var tbl = document.getElementById('my_table');
$('#my_panel').css('top', tbl.getBoundingClientRect().top);
$(window).scroll(function() {
var tbltop = tbl.getBoundingClientRect().top;
var x = tbltop < 0 ? 0 : tbltop;
$('#my_panel').css('top', x);
});
});"
要包含在应用程序中，如下所示：
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
useShinyjs(),
......
（不要更改任何其他内容）。
