How do I get output value in server based on selected input value in ui?

Question

I am trying to create a shiny app that works like a look up table -- I am using multiple columns from my data frame as input variables in the sidebar and based on the inputs the user selects from the dropdown, I am trying to get a corresponding output for two variables (one numeric and one character) which exist in the same table.

However, when I try to link my input to get the matching output in the server code, I get the following error for my numeric output variable: "Warning: Error in writeImpl: Text to be written must be a length-one character vector" and the following error for my character output variable: "operations are possible only for numeric, logical or complex types".

I need help in resolving this, thank you! I have attached my simplified code and data with two input and two output variables for reference.

This is my data:

"input1","input2","NumericOutput","CharacterOutput"
"precarious","precarious",0,"precarious"
"precarious","precarious",2.950337429,"precarious"
"precarious","precarious",4.827824883,"precarious"
"precarious","precarious",8.314587299,"precarious"
"precarious","precarious",7.276345388,"precarious"
"precarious","precarious",10.22668282,"precarious"
"precarious","precarious",12.10417027,"precarious"
"precarious","precarious",15.59093269,"precarious"
"precarious","precarious",0.622945146,"precarious"
"precarious","precarious",3.573282575,"precarious"
"precarious","precarious",5.450770029,"precarious"
"precarious","precarious",8.937532445,"precarious"
"precarious","precarious",7.899290535,"precarious"
"precarious","precarious",10.84962796,"precarious"
"precarious","precarious",12.72711542,"precarious"
"precarious","precarious",16.21387783,"precarious"
"precarious","precarious",3.737670877,"precarious"
"precarious","moderate",6.688008306,"precarious"
"good","precarious",8.565495761,"precarious"

This is my code:

## loading packages
{
  library(shiny)
  library(shinydashboard)
  library(htmltools)
  library(rvest)
  library(XML)
  library(measurements)
  library(ggplot2)
  library(ggrepel)
  library(plotly)
  library(shinyjs)
  library(shinyWidgets)
}

Test <- read.csv("Test.csv", stringsAsFactors = FALSE)
summary(Test)
lapply(Test,class)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    
    useShinyjs(), 
    
    selectInput ("a",label = colnames(Test[1]),
                 choices = (Test[[1]])),
    
    selectInput("b",colnames(Test[2]),
                choices = Test[[2]])
    
  ),
  
  dashboardBody(
    
    fluidRow(valueBoxOutput("info_box1", width = 6)),
    
    fluidRow(valueBoxOutput("info_box2", width = 6))
    
  )
)



server <- function(input, output) {
  
  output$info_box1 <- renderValueBox({
    valueBox(value = paste0("Score in %: ", 
                            Test$NumericOutput[Test$input1 == input$a]
                            & Test$NumericOutput[Test$input2 == input$b]),
             subtitle = NULL)  })
  
  
  output$info_box2 <- renderValueBox({
    valueBox(value = paste0("Assessment: ",(Test$CharacterOutput[Test$input1 == input$a])&
                              (Test$CharacterOutput[Test$input2 == input$b])),
             subtitle = NULL)
  })
  
  
}

shinyApp(ui, server)

Answer 1

I basically needed an output value for both my output variables by checking all conditions and not just fulfilling any one condition.

Instead of using Test$NumericOutput[Test$input1 == input$a] & Test$NumericOutput[Test$input2 == input$b]

I used Test$NumericOutput[Test$input1 == input$a & Test$input2 == input$b] and it worked.

Answer 2

Welcome to stackoverflow! The problem with the above code is, that the choices you are providing to populate the selectInput's aren't identifying a single row of your data.frame. However, valueBox's value-argument expects a single string.

I'm not sure what your expected result is, but maybe the following helps to understand what the issue is:

## loading packages
{
  library(shiny)
  library(shinydashboard)
  library(shinyjs)
}

Test <- data.frame(
  stringsAsFactors = FALSE,
  input1 = c("precarious","precarious",
             "precarious","precarious","precarious","precarious",
             "precarious","precarious","precarious","precarious",
             "precarious","precarious","precarious","precarious",
             "precarious","precarious","precarious","precarious","good"),
  input2 = c("precarious","precarious",
             "precarious","precarious","precarious","precarious",
             "precarious","precarious","precarious","precarious",
             "precarious","precarious","precarious","precarious",
             "precarious","precarious","precarious","moderate",
             "precarious"),
  NumericOutput = c(0,2.950337429,4.827824883,
                    8.314587299,7.276345388,10.22668282,12.10417027,
                    15.59093269,0.622945146,3.573282575,5.450770029,8.937532445,
                    7.899290535,10.84962796,12.72711542,16.21387783,
                    3.737670877,6.688008306,8.565495761),
  CharacterOutput = c("precarious","precarious",
                      "precarious","precarious","precarious","precarious",
                      "precarious","precarious","precarious","precarious",
                      "precarious","precarious","precarious","precarious",
                      "precarious","precarious","precarious","precarious",
                      "precarious")
)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    useShinyjs(),
    selectInput("a", label = colnames(Test[1]),
                choices = unique(Test[[1]])),
    selectInput("b", colnames(Test[2]),
                choices = unique(Test[[2]]))
  ),
  dashboardBody(fluidRow(valueBoxOutput("info_box1", width = 6)),
                fluidRow(valueBoxOutput("info_box2", width = 6)))
)

server <- function(input, output) {
  output$info_box1 <- renderValueBox({
    valueBox(
      value = paste0("Score in %: ",
                     Test$NumericOutput[Test$input1 == input$a],
                     Test$NumericOutput[Test$input2 == input$b], collapse = ", "),
      subtitle = NULL)
  })
  output$info_box2 <- renderValueBox({
    valueBox(value = paste0(
      "Assessment: ",
      Test$CharacterOutput[Test$input1 == input$a],
      Test$CharacterOutput[Test$input2 == input$b], collapse = ", "),
    subtitle = NULL)
  })
}

shinyApp(ui, server)