vendredi 3 mai 2019

Unable to Update text input across Shiny modules within If statement

I am trying to updateTextinput for an input in ui.r (admin.r in this case) using an if statement in server.r For some reason, i keep getting an error saying that "argument is of length zero", call = if (input$lam_type == "full") The other If statements that i have been using are working fine. It is only the ones that are within the observe that are causing issues.

ui.r

library(shiny)
library(shinydashboard)
library(shinyjs)
library(V8)
library(shinyWidgets)
library(data.table)
library(rsconnect)



shinyUI( 
  dashboardPage(
    dashboardHeader( title=textOutput("title")),
    dashboardSidebar(uiOutput("side")),
    dashboardBody(
      uiOutput("page")

    )
  )

)


server.r

library(shiny)
library(shinydashboard)
library(shinyjs)
library(V8)
library(shinyWidgets)
library(data.table)
library(rsconnect)
source("user.R")
source("admin.R")
library(shinyTime)
library(gtools)

my_username <- c("test","a")
my_password <- c("test","a")



get_role=function(user){

  if(user=="test") {

    return("TEST")
  }else{

    return("ADMIN")
  }
}

get_ui=function(role){
  itog=list()
  if(role=="TEST"){
    itog$title=test_title
    itog$main=test_main
    itog$side=test_side
    return(itog)
  }else{
    itog$title=admin_title
    itog$main=admin_main
    itog$side=admin_side
    return(itog)
  }
}


shinyServer(function(input, output) {

  USER <- reactiveValues(Logged = FALSE)

  ui1 <- function(){
    renderUI(
      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: -10px;margin-left: -150px;}")
    )}


  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
              USER$role=get_role(Username)

            }
          } 
        }
      }
    }
  })
  observe({
    if (USER$Logged == FALSE) {

      output$page <- renderUI({
        box(
          div(class="outer",do.call(bootstrapPage,c("",ui1()))))
      })
    }
    if (USER$Logged == TRUE)    {
      itog=get_ui(USER$role)
      output$title<- renderText({
        itog$title
      })
      output$side <- renderUI({
        itog$side
      })
      output$page <- renderUI({
        itog$main
      })
    }
  })



    ####################################### Part that is causing issues##############################
     # observeEvent({ input$submit
     #   if (input$lam_type == "full") {
     #    # tests1 <- input$n_input1
     #    # p(tests1)
     #     updateNumericInput(session, "width2", NULL, 0)
     #   }})



    #Force values to 0

    # lapply(
    #   x <- c("n_input1", "n_input2"),
    # 
    #   FUN = function(i){
    #     reactive({
    #       if (is.na(input[[i]])) {
    #         renderText(i, 0)
    #       }
    #     }) })

    #########################End of part causing issues #########################################     

          })


admin.r


admin_title="Customer Quote Automation"
admin_side=list(sidebarMenu(
  sidebarMenu( style = "position: fixed;, overflow: visible;",
               id = "tabs",

               menuItem('Lamination', tabName = "fabric_lamination", icon = icon('line-chart'))

  )))
admin_main=list(




  tabItem(tabName = "fabric_lamination",
          h2("Lamination Options"),
          radioButtons(inputId = "lamination",
                       label = "Product Lamination Required? ",
                       choices = c("Yes" = "lam_yes",
                                   "No" = "lam_no"),
                       selected = "lam_yes"),

          conditionalPanel(condition = "input.lamination == 'lam_yes'",
                           numericInput("n_input1", "Enter Number here", value = 0),
                           numericInput("n_input2", "Enter Number here", value = 0),

                           radioButtons(inputId = "lam_type",
                                        label = "Lam type? ",
                                        choices = c("Full" = "full",
                                                    "No" = "lam_no2")),               
          conditionalPanel(condition = "input.lamination == 'lam_yes'",
                          numericInput(inputId = "width2", label = "Enter Width (in CM): ", value = 0)),
          uiOutput("Test"),
          actionButton("submit", "Submit")


                           )),
  dateInput("date", "Date:", value = Sys.Date())                              


  )



user.r

test_title="Decison Support System"
test_side=list(sidebarMenu(
  menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))))

test_main=list(

  tabItems(
    tabItem(tabName = "dashboard", list(h1("test123456"),h2("test")))
  ))


What I am trying to do is update inputs in admin.r based on the if statements that i have set up in server.r

Any help would be greatly appreciated.

Thank you.

Aucun commentaire:

Enregistrer un commentaire