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
- ui1 to be a login page
- ui2 to be the shinydashboard with the signup tab to be a login page
- 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)
