我已经构建了一个使用运行时闪亮的交互式 Flexdashboard，我想创建一个用户身份验证登录模块/页面。我偶然发现保罗·坎贝尔 (Paul Campbell) 的闪亮作者包 https://paul.rbind.io/2018/11/04/introducing-shinyauthr/这似乎可以做到这一点，但对于闪亮的仪表板，我想为我的 Flexdashboard 调整此代码。我尝试将其应用到我的 Rmarkdown 文档中，但它仅导致登录模块显示在侧边栏面板中或显示在显示屏右侧主面板中的图表上方。无论哪种方式，该模块都无法达到阻止用户在输入用户名和密码之前使用仪表板的预期目的。下面是一个最小的可重现示例，说明如何在闪亮的应用程序中使用身份验证模块。有人可以建议如何修改 Flexdashboard 的代码吗？
library(shiny)
library(shinyauthr)
library(shinyjs)
# dataframe that holds usernames, passwords and other user data
user_base <- data.frame(
user = c("user1", "user2"),
password = c("pass1", "pass2"),
permissions = c("admin", "standard"),
name = c("User One", "User Two"),
stringsAsFactors = FALSE
)
ui <- fluidPage(
# must turn shinyjs on
shinyjs::useShinyjs(),
# add logout button UI
div(class = "pull-right", shinyauthr::logoutUI(id = "logout")),
# add login panel UI function
shinyauthr::loginUI(id = "login"),
# setup table output to show user info after login
tableOutput("user_table")
)
server <- function(input, output, session) {
# call the logout module with reactive trigger to hide/show
logout_init <- callModule(shinyauthr::logout,
id = "logout",
active = reactive(credentials()$user_auth))
# call login module supplying data frame, user and password cols
# and reactive trigger
credentials <- callModule(shinyauthr::login,
id = "login",
data = user_base,
user_col = user,
pwd_col = password,
log_out = reactive(logout_init()))
# pulls out the user information returned from login module
user_data <- reactive({credentials()$info})
output$user_table <- renderTable({
# use req to only render results when credentials()$user_auth is TRUE
req(credentials()$user_auth)
user_data()
})
}
shinyApp(ui = ui, server = server)
Update:在尝试找到实现shinyauthr代码的方法失败后，我尝试了闪亮的管理器包 https://github.com/datastorm-open/shinymanager并调整代码以与 Flexdashboard 一起使用bthieurmel 在 github 上的帮助 https://github.com/datastorm-open/shinymanager/issues/51。所以他们的解决方案将是以下步骤。希望这对其他人有帮助！
- 使用自定义 css 设置 flexdashboard。
---
title: "Old Faithful Eruptions"
output:
flexdashboard::flex_dashboard:
css: styles-auth.css
runtime: shiny
---
- 您需要添加一个 css 文件，其中至少包含以下内容。将 css 文件保存到项目目录中名为“styles-auth.css”的文件夹中。
.panel-auth {
position: fixed;
top:0;
bottom: 0;
left: 0;
right: 0;
background-color: #FFF;
opacity: 1;
z-index: 99997;
overflow-x: hidden;
overflow-y: scroll;
}
- 然后在全局块中，加载shinymanager并定义凭据。
```{r global, include=FALSE}
# load data in 'global' chunk so it can be shared by all users of the dashboard
library(datasets)
library(shinymanager)
data(faithful)
# define some credentials (you can also use sqlite database)
credentials <- data.frame(
user = c("shiny", "shinymanager"),
password = c("azerty", "12345"),
stringsAsFactors = FALSE
)
```
- 最后，在任何地方调用这两个模块：
```{r}
auth_ui(id = "auth")
auth <- callModule(
module = auth_server,
id = "auth",
check_credentials = check_credentials(credentials) # data.frame
# check_credentials = check_credentials("path/to/credentials.sqlite", passphrase = "supersecret") # sqlite
)
```
完整的解决方案：因此完整的示例如下所示。显然，不可能在 flexdashboard 中使用这个包的管理模式，这对我来说很好，但我还没有了解如何使用这个包的 SQLite 功能，因为我对此很陌生，所以关于这方面的任何其他建议会有帮助的。
---
title: "Old Faithful Eruptions"
output:
flexdashboard::flex_dashboard:
css: styles-auth.css
runtime: shiny
---
```{r global, include=FALSE}
# load data in 'global' chunk so it can be shared by all users of the dashboard
library(datasets)
library(shinymanager)
data(faithful)
# define some credentials (you can also use sqlite database)
credentials <- data.frame(
user = c("shiny", "shinymanager"),
password = c("azerty", "12345"),
stringsAsFactors = FALSE
)
```
Column {.sidebar}
-----------------------------------------------------------------------
Waiting time between eruptions and the duration of the eruption for the
Old Faithful geyser in Yellowstone National Park, Wyoming, USA.
```{r}
selectInput("n_breaks", label = "Number of bins:",
choices = c(10, 20, 35, 50), selected = 20)
sliderInput("bw_adjust", label = "Bandwidth adjustment:",
min = 0.2, max = 2, value = 1, step = 0.2)
```
Column
-----------------------------------------------------------------------
### Geyser Eruption Duration
```{r}
renderPlot({
hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(input$n_breaks),
xlab = "Duration (minutes)", main = "Geyser Eruption Duration")
dens <- density(faithful$eruptions, adjust = input$bw_adjust)
lines(dens, col = "blue")
})
auth_ui(id = "auth")
auth <- callModule(
module = auth_server,
id = "auth",
check_credentials = check_credentials(credentials) # data.frame
# check_credentials = check_credentials("path/to/credentials.sqlite", passphrase = "supersecret") # sqlite
)
```
