Question

我正在构建一个闪亮的应用程序，允许用户查看Web中的所有内容，除了一个选项卡，只有管理员可以访问（谁知道登录信息）。

我找到了类似的帖子here并对其进行了一些修改，以便只有在登录后才能显示注册标签。为了做到这一点，我做了

ui1是登录页面
ui2是shinydashboard，注册标签是登录页面
ui3是登录页面的整个shinydashboard

我让应用程序以ui2代码开始，用户在单击sign_up选项卡时会被定向到登录页面。如果用户成功登录，则会将其定向到ui3 shinydashboard，其中包含其他信息而不是登录页面。除了注册标签中的内容之外，ui2和ui3的所有内容都相同。

然而，当我启动应用程序并点击＆＃34;注册＆＃34;选项卡，它显示错误错误：无法找到功能＆＃34; ui1＆＃34;

以下是我在ui.R文件中的内容：

library(shiny)
library(shinydashboard)
library(shinyjs)
library(googleVis)
library(flexdashboard)
library(DT)
library(dimple)
library(dplyr)

ui1 <-tagList(
  div(id = "login",
  wellPanel(textInput("userName", "Username"),
            passwordInput("passwd", "Password"),
            br(),actionButton("Login", "Log in"))),
  tags$style(type="text/css", "#login {font-size:10px;   text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}")
)

ui2<- dashboardPage(
  dashboardHeader(title="S-League X Shoot!"),
  dashboardSidebar(
gaugeOutput("plt1",height='130px'),
sidebarMenu(
  menuItem("Shoot 소개", tabName = "shoot_info", icon= icon("heart", lib= "glyphicon")),
  menuItem("점수순위 및 분석", tabName = "leaderboard", icon= icon("bar-chart-o")),
  menuItem("참가신청서", tabName = "signup", icon=icon("pencil", lib= "glyphicon"),
           badgeLabel = "관리자", badgeColor = "red")
),
uiOutput("checkbox")
  ),
  dashboardBody(
tabItems(
  tabItem(tabName = "shoot_info",
          fluidRow(
            tabBox(
              id= "tabtab1", width = 12,
              tabPanel("Shoot 소개",
                       fluidRow(div(img(src="1.jpg"), img(src="2.jpg"), img(src="3.jpg"))),
                       fluidRow(div(img(src="4.jpg"), img(src="5.jpg"), img(src="6.jpg")))
              ),
              tabPanel("소아암 소개 및 후원",
                       fluidRow(tags$a(img(src="66.jpg"),href="http://www.soaam.or.kr/donation/introduction.php?PHPSESSID=80f03a3e88d2ee7137d904c22e00a75b")),
                       fluidRow(div(img(src="11.jpg"))),
                       fluidRow(div(img(src="22.png"))),
                       fluidRow(div(img(src="33.png"))),
                       fluidRow(div(img(src="44.png"))),
                       fluidRow(div(img(src="55.png")))
              ),
              tabPanel("2016년도 Shoot 활동",
                       fluidRow(div(img(src="111.jpg"))),
                       fluidRow(div(img(src="222.jpg"))),
                       fluidRow(div(img(src="333.jpg"))),
                       fluidRow(div(img(src="444.jpg"))),
                       fluidRow(div(img(src="555.jpg"))),
                       fluidRow(div(img(src="666.jpg")))
              )
            )
          )
  ),
  tabItem(tabName = "leaderboard",
          fluidRow(
            tabBox(
              id= "tabtab2", width = 12,
              tabPanel("선수별순위",
                       dataTableOutput("content"),
                       dimpleOutput("distPlot1"),
                       width=12),
              tabPanel("팀별순위",
                       uiOutput("summa2"), 
                       dimpleOutput("distPlot2"),
                       width=6),
              tabPanel("단과대별순위",
                       uiOutput("summa3"), 
                       dimpleOutput("distPlot3"),
                       width=6)
            )
          )
  ),
  tabItem(tabName = "signup",
          uiOutput("page") #This is the only difference between ui2 and ui3
  )

))
)

ui3<- dashboardPage(
  dashboardHeader(title="S-League X Shoot!"),
  dashboardSidebar(
gaugeOutput("plt1",height='130px'),
sidebarMenu(
  menuItem("Shoot 소개", tabName = "shoot_info", icon= icon("heart", lib= "glyphicon")),
  menuItem("점수순위 및 분석", tabName = "leaderboard", icon= icon("bar-chart-o")),
  menuItem("참가신청서", tabName = "signup", icon=icon("pencil", lib= "glyphicon"),
           badgeLabel = "관리자", badgeColor = "red")
),
uiOutput("checkbox")
  ),
  dashboardBody(
tabItems(
  tabItem(tabName = "shoot_info",
          fluidRow(
            tabBox(
              id= "tabtab1", width = 12,
              tabPanel("Shoot 소개",
                       fluidRow(div(img(src="1.jpg"), img(src="2.jpg"), img(src="3.jpg"))),
                       fluidRow(div(img(src="4.jpg"), img(src="5.jpg"), img(src="6.jpg")))
              ),
              tabPanel("소아암 소개 및 후원",
                       fluidRow(tags$a(img(src="66.jpg"),href="http://www.soaam.or.kr/donation/introduction.php?PHPSESSID=80f03a3e88d2ee7137d904c22e00a75b")),
                       fluidRow(div(img(src="11.jpg"))),
                       fluidRow(div(img(src="22.png"))),
                       fluidRow(div(img(src="33.png"))),
                       fluidRow(div(img(src="44.png"))),
                       fluidRow(div(img(src="55.png")))
              ),
              tabPanel("2016년도 Shoot 활동",
                       fluidRow(div(img(src="111.jpg"))),
                       fluidRow(div(img(src="222.jpg"))),
                       fluidRow(div(img(src="333.jpg"))),
                       fluidRow(div(img(src="444.jpg"))),
                       fluidRow(div(img(src="555.jpg"))),
                       fluidRow(div(img(src="666.jpg")))
              )
            )
          )
  ),
  tabItem(tabName = "leaderboard",
          fluidRow(
            tabBox(
              id= "tabtab2", width = 12,
              tabPanel("선수별순위",
                       dataTableOutput("content"),
                       dimpleOutput("distPlot1"),
                       width=12),
              tabPanel("팀별순위",
                       uiOutput("summa2"), 
                       dimpleOutput("distPlot2"),
                       width=6),
              tabPanel("단과대별순위",
                       uiOutput("summa3"), 
                       dimpleOutput("distPlot3"),
                       width=6)
            )
          )
  ),
  tabItem(tabName = "signup",
          fluidRow(
            tabBox(
              id= "tabset1", width = 12,
              tabPanel("참가신청서", textInput("name",  "이름"),
                       radioButtons("gender", "성별", list("남자","여자")),
                       selectInput("college", "대학",
                                   choices = list("간호대학", "경영대학",
                                                  "공과대학", "농업생명과학대학",
                                                  "미술대학", "법과대학",
                                                  "사범대학", "사회과학대학",
                                                  "수의과대학", "생활과학대학",
                                                  "약학대학", "음악대학",
                                                  "인문대학", "의과대학",
                                                  "자연과학대학", "기타"),
                                   selected = 1),
                       selectInput("team", "교내 소속축구팀",
                                   choices = list("싸커21", "아르마다",
                                                  "에코플러스", "아크로",
                                                  "P.O.S", "공대",
                                                  "자연대", "관악사",
                                                  "농대축구부 휘모리", "지오싸카스",
                                                  "새츠", "샥스",
                                                  "FC SEES", "Cells United",
                                                  "프리템포", "남풍",
                                                  "없음")),
                       textInput("score", "점수"),
                       actionButton("click_counter","Submit"), width=12),
              tabPanel("참가자 삭제", textInput("delete_name", "삭제할 참가자 이름을 아래 박스에 기입한 뒤, 삭제 버튼을 눌러주세요."),
                       actionButton("delete_button","삭제"), 
                       h4("주의사항: 동명이인이 있을시, 모두가 삭제되므로 삭제하지 않고자 하는 참가자의 정보를 다시 '참가신청서' tab에서 기입해줘야 함."),width=12)
            )
          ),
          fluidRow(
            box(dataTableOutput("nText"), width=12)
          )
  )

))
)

这就是我在server.R文件中的内容：

server <- shinyServer(function(input, output, session) {

  Logged = FALSE;
  my_username <- "test"
  my_password <- "test"

  USER <- reactiveValues(Logged = Logged)



  observe({ 
if (USER$Logged == FALSE) {
  if (!is.null(input$Login)) {
    if (input$Login > 0) {
      Username <- isolate(input$userName)
      Password <- isolate(input$passwd)
      Id.username <- which(my_username == Username)
      Id.password <- which(my_password == Password)
      if (length(Id.username) > 0 & length(Id.password) > 0) {
        if (Id.username == Id.password) {
          USER$Logged <- TRUE
        } 
      }
    } 
  }
}    
  })

  output$page <- renderUI({
if (USER$Logged == FALSE){
  output$page <- renderUI({
    div(class="outer",do.call(bootstrapPage,c("",ui1())))
  })
}
if (USER$Logged == TRUE)
  ui3
  })
})

shinyApp(ui = ui2, server = server)

Answer 1

这是一项有趣的技术，一旦我开始工作，修复并不难，并添加您需要的功能。这是代码：

library(shiny)
library(shinydashboard)
library(ShinyDash)
library(rcdimple)

ui1 <-tagList(
  div(id = "login",
      wellPanel(textInput("userName", "Username"),
                passwordInput("passwd", "Password"),
                br(),actionButton("Login", "Log in"))),
  tags$style(type="text/css", "#login {font-size:10px;   text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}")
)

ui33 <-tagList(
  wellPanel("Admin-참가신청서", textInput("name",  "이름"),
                     radioButtons("gender", "성별", list("남자","여자")),
                     selectInput("college", "대학",
                                 choices = list("간호대학", "경영대학",
                                                "공과대학", "농업생명과학대학",
                                                "미술대학", "법과대학",
                                                "사범대학", "사회과학대학",
                                                "수의과대학", "생활과학대학",
                                                "약학대학", "음악대학",
                                                "인문대학", "의과대학",
                                                "자연과학대학", "기타"),
                                 selected = 1),
                     selectInput("team", "교내 소속축구팀",
                                 choices = list("싸커21", "아르마다",
                                                "에코플러스", "아크로",
                                                "P.O.S", "공대",
                                                "자연대", "관악사",
                                                "농대축구부 휘모리", "지오싸카스",
                                                "새츠", "샥스",
                                                "FC SEES", "Cells United",
                                                "프리템포", "남풍",
                                                "없음")),
                     textInput("score", "점수"),
                     actionButton("click_counter","Submit"), width=12),
            tabPanel("참가자 삭제", textInput("delete_name", "삭제할 참가자 이름을 아래 박스에 기입한 뒤, 삭제 버튼을 눌러주세요."),
                     actionButton("delete_button","삭제"), 
                     h4("주의사항: 동명이인이 있을시, 모두가 삭제되므로 삭제하지 않고자 하는 참가자의 정보를 다시 '참가신청서' tab에서 기입해줘야 함."),width=12)
          )



ui2<- dashboardPage(
  dashboardHeader(title="S-League X Shoot!"),
  dashboardSidebar(
    gaugeOutput("plt1",height='130px'),
    sidebarMenu(
      menuItem("Shoot 소개", tabName = "shoot_info", icon= icon("heart", lib= "glyphicon")),
      menuItem("점수순위 및 분석", tabName = "leaderboard", icon= icon("bar-chart-o")),
      menuItem("참가신청서", tabName = "signup", icon=icon("pencil", lib= "glyphicon"),
               badgeLabel = "관리자", badgeColor = "red")
    ),
    uiOutput("checkbox")
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "shoot_info",
              fluidRow(
                tabBox(
                  id= "tabtab1", width = 12,
                  tabPanel("Shoot 소개",
                           fluidRow(div(img(src="1.jpg"), img(src="2.jpg"), img(src="3.jpg"))),
                           fluidRow(div(img(src="4.jpg"), img(src="5.jpg"), img(src="6.jpg")))
                  ),
                  tabPanel("소아암 소개 및 후원",
                           fluidRow(tags$a(img(src="66.jpg"),href="http://www.soaam.or.kr/donation/introduction.php?PHPSESSID=80f03a3e88d2ee7137d904c22e00a75b")),
                           fluidRow(div(img(src="11.jpg"))),
                           fluidRow(div(img(src="22.png"))),
                           fluidRow(div(img(src="33.png"))),
                           fluidRow(div(img(src="44.png"))),
                           fluidRow(div(img(src="55.png")))
                  ),
                  tabPanel("2016년도 Shoot 활동",
                           fluidRow(div(img(src="111.jpg"))),
                           fluidRow(div(img(src="222.jpg"))),
                           fluidRow(div(img(src="333.jpg"))),
                           fluidRow(div(img(src="444.jpg"))),
                           fluidRow(div(img(src="555.jpg"))),
                           fluidRow(div(img(src="666.jpg")))
                  )
                )
              )
      ),
      tabItem(tabName = "leaderboard",
              fluidRow(
                tabBox(
                  id= "tabtab2", width = 12,
                  tabPanel("선수별순위",
                           dataTableOutput("content"),
                           dimpleOutput("distPlot1"),
                           width=12),
                  tabPanel("팀별순위",
                           uiOutput("summa2"), 
                           dimpleOutput("distPlot2"),
                           width=6),
                  tabPanel("단과대별순위",
                           uiOutput("summa3"), 
                           dimpleOutput("distPlot3"),
                           width=6)
                )
              )
      ),
      tabItem(tabName = "signup",
              uiOutput("page") #This is the only difference between ui2 and ui3
      )

    ))
)


server <- shinyServer(function(input, output, session) {

  Logged = FALSE;
  my_username <- "test"
  my_password <- "test"

  USER <- reactiveValues(Logged = Logged)

  observe({ 
    if (USER$Logged == FALSE) {
      if (!is.null(input$Login)) {
        if (input$Login > 0) {
          Username <- isolate(input$userName)
          Password <- isolate(input$passwd)
          Id.username <- which(my_username == Username)
          Id.password <- which(my_password == Password)
          if (length(Id.username) > 0 & length(Id.password) > 0) {
            if (Id.username == Id.password) {
              USER$Logged <- TRUE
            } 
          }
        } 
      }
    }    
  })

  output$page <- renderUI({
    if (USER$Logged){
      return({  div(class="outer",do.call(bootstrapPage,c("",ui33)))  })
    } else {
      return({  div(class="outer",do.call(bootstrapPage,c("",ui1)))    })
    }
  })
})

shinyApp(ui = ui2, server = server)

这是管理员登录：

以下是登录后的图片：

最后我只需要

摆脱Shiny output$page renderUI代码块中的函数调用（parens），
将您的标签生成输入剪切为闪亮，并将其放入名为u33的新闪亮输入函数中。
更改output$page中的逻辑以返回相应的闪亮输入函数 - u1或u33 - 具体取决于登录是否发生。

Shiny运行时与典型的R程序略有不同。这些反应块由特殊的Shiny处理程序设置和执行，这些处理程序会提前评估所需的UI功能。因此，当反应块执行时，函数ui1实际上不存在，这解释了关于缺少u1函数的错误消息。

闪亮的R：登录后可以访问标签

1 个答案: