2
votes

The objective of the application is for the user to select some variables from the selectinput function in rshiny and based on whatever variables are selected there should be a corresponding numericinput box which takes the weightage of that variable as input.

So for example if I select four variable from the selectinput function then there should be 4 numericinput boxes which would prompt the user to enter the corresponding weightages.

I am able to do this using the checkbox option instead of selectinput function, but since the number of variables are huge checkbox option is not viable.

Using checkbox function the codes is as follows:

checkboxInput("pick", "Picked_up"),
      conditionalPanel(
        condition = "input.pick == true",
        numericInput("var1","Enter the weightage of the variable","")
      ),

      br(),
      checkboxInput("c2", "%C2"),
      conditionalPanel(
        condition = "input.c2 == true",
        numericInput("var2","Enter the weightage of the variable","")
      ),
      br(),
      checkboxInput("newfill", "Perc_Newfill"),
      conditionalPanel(
        condition = "input.newfill == true",
        numericInput("var3","Enter the weightage of the variable","")
      ),

      br(),
      checkboxInput("rts", "%RTS"),
      conditionalPanel(
        condition = "input.rts == true",
        numericInput("var4","Enter the weightage of the variable","")
      )

I want to implement the same functionality for selectinput function, the code I tried is as follows:

ui.r

uiOutput('select_value'),
uiOutput('input_value'),

server.r

output$select_value <- renderUI({
    selectInput('var_name','choose variables',names(descriptive_data),multiple = TRUE)
  })



  runInput2<- observeEvent(input$var_name,{


      for(i in 1:length(input$var_name))
      {
      output$input_value <- renderUI({
        mydata <- input$var_name[1]
        numericInput('var', 'input weightage',"")

      })
      }
  })

I am new to Rshiny and hence would be open to inputs suggestions as to what I am doing wrong and how can i implement this.

1

1 Answers

1
votes

Here is a solution for your problem. It creates a numericInput for each variable selected. Instead of using a for loop, it uses a lapply function which return a list with all the UI elements created (this is the best way to group multiple UI elements). Finally, to avoid create multiple observers to get the values of the numericInput's, it uses an action button to recover the values only if the variable was selected. At the beginning of the server function, a vector was created to store the predefined weight values, it also is useful to restore the value of a numericInput previously assigned by the user. This is necessary because every time a new variable is selected, the full mainPanel is rendered again.

library(shiny)

ui <- fluidPage(
  sidebarPanel(uiOutput('select_value')),
  mainPanel(uiOutput('input_value'))
)

server <- function(input , output){
  descriptive_data <- mtcars
  # initial value for weights and to keep track of value
  weightages <- rep(0, ncol(descriptive_data))
  # set names to simplify recover/storing value
  names(weightages) <- names(descriptive_data)

  output$select_value <- renderUI({
    div(
      selectInput('var_name', 'choose variables',
        names(descriptive_data), multiple = TRUE),
      actionButton("get", "Get weightages"),
      tableOutput('table')
    )
  })

  output$input_value <- renderUI({
    var_name <- input$var_name
    if (!is.null(var_name)) {
      # lapply will return a list
      lapply(1:length(var_name), function(k) { 
          numericInput(paste0("var", k), 
            paste('input weightage for', 
            # assign stored value
            var_name[k]), weightages[[var_name[k]]])
      })
    }    
  })

  observeEvent(input$get, {
    # to avoid create one observer per numeric input
    # we use a action button to trigger the recovering 
    # of weights.
    var_name <- input$var_name
    if (!is.null(var_name)) {
      for(k in 1:length(var_name)) { 
        # only recover/update value is the numeric input exists
        if (!is.null(input[[paste0("var", k)]]))
          weightages[[var_name[k]]] <<- input[[paste0("var", k)]]
      }
    }
    # show current weights 
    output$table <- renderTable(data.frame(
                        variable = names(descriptive_data),
                        weightages))

  })

}

shinyApp(ui = ui , server = server)