我对这个应用程序有一个问题,它包含一个用于用户界面部分的 javascript 文件,它可以启用更多选项卡。但是,当我们包含 javascript 文件时,服务器部分不起作用。我在这里对 mtcars 数据集有一个简单的反应性来展示这个问题。当我禁用“includeScript(“script.js”)”时,只需将#放在它前面,应用程序就可以工作,所以问题与这部分有关。所以我的问题是,我怎样才能解决这个问题,同时将 javascript 部分保留在闪亮的应用程序中。
感谢您的所有帮助。
编辑:现在我用 tags$head(tags$script(src="./script.js")) 替换了 includeScript("script.js"),它似乎可以工作,但是反应非常慢,我有在看到东西之前等待几乎 1-2 分钟。有什么建议吗,或者你也经历过吗?
library(shiny)
library(shinythemes)
library(shinymanager)
library(dplyr)
脚本.js
$(document).ready(function(){
$('.dropdown').on('click', function(e){
$(this).toggleClass('open');
e.stopPropagation();
e.preventDefault();
});
$('[data-toggle=tab]').on('click', function(e){
let dv = ($(this).attr('data-value'));
//Set active element in tabcontents
$('.tab-pane').removeClass('active');
$('.tab-pane[data-value="' + dv + '"]').addClass('active');
//Set active element in navbar
$('a[data-toggle=tab]').parent().removeClass('active');
$('a[data-value="' + dv + '"]').parent().addClass("active");
//Close the dropdowns
$('.dropdown').removeClass('open');
e.stopPropagation();
e.preventDefault();
});
});
证书
credentials <- data.frame(
user = c("Jhon", "Erik"), # mandatory
password = c("1", "1"), # mandatory
start = c("2022-02-14"), # optinal (all others)
expire = c(NA, "2022-12-31"),
admin = c(TRUE, TRUE),
comment = "Model Performance application",
stringsAsFactors = FALSE
)
用户界面
ui <- fluidPage(
includeScript("script.js"),
navbarPage("Shiny",
collapsible = TRUE,
theme = shinytheme('yeti'),
tabPanel("Information" ,icon = icon("info"),
tags$h2("Information about the current user"),
verbatimTextOutput("auth_output")
),
tabPanel("Simulation 1",
tags$h2("Simulation"),
tags$hr(),
selectInput("vars", "Variables", names(mtcars), multiple = T),
tableOutput("data")
),
tabPanel("Upload",icon = icon("upload"),
tags$h2("Upload datasets"),
tags$hr(),
),
tabPanel("Simulation 2",
tags$h2("Simulation"),
tags$hr()
),
navbarMenu("Statistical outputs",
tabPanel("One"
),
tabPanel("Two"
),
tabPanel("Three"
),
tabPanel("Four"
),
tabPanel("Report"
),
navbarMenu("More",
tabPanel("Statistical", icon = icon("info")
),
tabPanel("Info",
icon = icon("info-circle")
),
tabPanel("Subpart 4", "Subpart 4"),
tabPanel("Subpart 5", "Subpart 5")
)
)
)
)
用secure_app包裹你的UI
ui <- secure_app(ui)
服务器
server <- function(input, output, session) {
# call the server part
# check_credentials returns a function to authenticate users
res_auth <- secure_server(
check_credentials = check_credentials(credentials)
)
output$auth_output <- renderPrint({
reactiveValuesToList(res_auth)
})
output$data <-renderTable({
req(input$vars)
mtcars %>% select(all_of(input$vars))
})
}
shiny::shinyApp(ui, server)