shiny R: making a tab to be accessible after loginng in

I am building a shiny app that allows users to look around everything in the web except for one tab, which is accessible to the administrator only (who knows login info).

I have found a similar post here and modified it a little bit to make the signup tab to be displayed only after logging in. In order to do that, I made

1. ui1 to be a login page


2. ui2 to be the shinydashboard with the signup tab to be a login page


3. ui3 to be the entire shinydashboard with login page

I made the app to start with ui2 code, where the user is directed to a login page when he clicks the sign_up tab. If the user successfully logs in, he is directed to the ui3 shinydashboard which has other information instead of the login page. Other than what's in the signup tab, everything is the same for ui2 and ui3.

However, when I start the app and click the "signup" tab, it displays an error saying Error: could not find function "ui1"

Here is what I have in the ui.R file:

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)
          )
  )

))
)

This is what I have in the server.R file:

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

It is an interesting technique, and once I got it working it was not that hard to fix, and add the functionality you need. Here is the code:

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)

And here is the admin login:

And here is the image after login:

In the end I only had to

• get rid of the function call (the parens) in the Shiny output$page renderUI code block,


• cut out your tab generation input shiny and put that in a new shiny input function called u33.



• change the logic in output$page to return the appropriate shiny input function - u1 or u33 - depending on whether or not login had happened.

The Shiny runtime is a bit different than your typical R program. Those reactive blocks are setup and executed by special Shiny handlers that evaluate the UI functions that are needed ahead of time. So the function ui1 actually does not exist when the reactive block is executing, which explains the error message about a missing u1 function.