Кнопка действия внутри tabItem не работает в R Shinydahboard - PullRequest
0 голосов
/ 02 мая 2019

Я новичок в R, и это мое первое приложение в программировании на R.Мое приложение запускается с экрана входа в систему. Как только пользователь вошел в систему, на главном экране появилось боковое меню с 4 панелями элементов меню: Профиль, Рекомендации, Опрос. Первые 3 пункта меню отображают вывод таблицы для пользователя, работая как положено.Последний должен получить ввод от пользователя через опцию SelectInput и ActionButton.Проблема в том, что ActionButton не работает вообще.Даже после выбора опции в SelectInput, по кнопке ActionButton ничего не происходит. Пожалуйста, объясните мне это.

Вот код:

ui.R

shinyUi<- dashboardPage(
  dashboardHeader(
    title="Course Recommender System",
    titleWidth = 400
  ),


  dashboardSidebar(
    width = 200,
    sidebarMenu(id="tabs",sidebarMenuOutput("menu"))
  ),

  dashboardBody(
    tagList(
      tags$head(
        tags$link(rel="stylesheet", type="text/css",href="style.css"),
        tags$script(type="text/javascript", src = "md5.js"),
        tags$script(type="text/javascript", src = "passwdInputBinding.js"),
        #########################################################################
        tags$style(type="text/css",
                   ".shiny-output-error { visibility: hidden; }",
                   ".shiny-output-error:before { visibility: hidden; }"
        )
      )
    ),

    div(class = "login",
        uiOutput("uiLogin"),
        textOutput("pass")
    ),      
    uiOutput("body")
  )
)




Server.R


  USER <- reactiveValues(Logged = Logged)
  USER1 <- reactiveValues(REGISTERED = REGISTERED)
  passwdInput <- function(inputId, label) {
    tagList(
      tags$label(label),
      tags$input(id = inputId, type="password", value="")
    )
  }

  output$uiLogin <- renderUI({
    if (USER$Logged == FALSE) {
      box(
        textInput("userName", "User Name:",width = "200px"),
        passwdInput("passwd", "Pass word:"),
        br(),
        textOutput("text1"),
        actionButton("Login", "Log in")

      )
    }
  })

  output$pass <- renderText ({  


    if (USER$Logged == FALSE) {
      if (!is.null(input$Login)) {
        if (input$Login > 0) {
          selQuery <- "select * from student_login;"
          df = dbSendQuery(con,selQuery)
          PASSWORD = dbFetch(df,n=-1)
          PASSWORD <- as.data.frame(PASSWORD)

          Username <- isolate(input$userName)
          Password <- isolate(input$passwd)

          Id.username <- which(PASSWORD$user_name == Username)
          Id.password <- which(PASSWORD$password  == Password)

          if (length(Id.username) > 0 & length(Id.password) > 0) {
            if (Id.username == Id.password) {
              USER$Logged <- TRUE

            } 
          } 
          else if (length(Id.username) <= 0 & length(Id.password) <= 0) {
            output$text1 <- renderText({ 
              "Please Register your details"
            })
          }
          else{
            output$text1 <- renderText({ 
              "Wrong Username or Password"
            })
          }
        } 
      }

    }
  })


 observe(

    if (USER$Logged == TRUE) { 
      output$menu <- renderMenu({
        sidebarMenu(id="menu",
                    menuItem(text="Dashboard", tabName = "dashboard",selected="TRUE"),
                    menuItem(text="Academic Profile", tabName = "results"),
                    menuItem(text="Course Recommendations", tabName = "recommend"),
                    menuItem(text="Complete Survey", tabName = "survey",selected = "FALSE")
        )

      })

      output$body <- renderUI({

        tabItems(
          tabItem(tabName="dashboard",
                  fluidRow( 
                    box(
                      status = "primary",title = "Personal Information",
                      solidHeader = TRUE,
                      #  tableOutput("personalinfo")
                      textOutput("myname"),
                      textOutput("myage"),
                      textOutput("mymobile")
                    )
                  )
          ),
          tabItem(tabName="results",
                  fluidRow( 
                    box(
                      status = "warning",title = "FIRST SEMESTER RESULTS",
                      solidHeader = TRUE,width = 6,
                      tableOutput("mysem1")
                    ),
                    box(
                      status = "warning",title = "SECOND SEMESTER RESULTS",
                      solidHeader = TRUE,width = 6,
                      tableOutput("mysem2")
                    )
                  )
          ),
          tabItem(tabName="recommend",
                  fluidRow( 
                    box(
                      status="warning",title = "ELECTIVE COURSE LIST FOR THIS SEMESTER",
                      solidHeader = TRUE,width = 6,
                      dataTableOutput("elec_cse_list")
                    ),
                    box(
                      status = "warning",title = "RECOMMENDED COURSE LIST",
                      solidHeader = TRUE,width = 6,
                      dataTableOutput("rec_cse_list")
                    )
                  )

          ),
          tabItem(tabName="survey",
                  box( 
                    selectInput("ch","Engg Knowledge",
                                c("No_impact"="no",
                                  "Major_impact"="major",
                                  "Minor_impact"="minor")),
                    actionButton("sub","Submit"),
                    textOutput("res")
                  )
           )


###Code for other tabs fetching data from backend database and displaying table output


        output$res<-eventReactive(input$sub,
        {renderText(input$ch)} )

      }
      )

    }
  )
  isolate({updateTabItems(session, "tabs", "dashboard")})    

  cancel.onSessionEnded <- session$onSessionEnded(function() { dbDisconnect(con) })
}

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...