Search code examples
rdplyrshinyshinydashboard

Text not displayed correctly in R Shiny app (although no code error is shown but it's not doing what I write)


I am building a simple income-search tool where individuals can enter their job title, monthly wage, and city, and as an output they can learn how their wages compare to the median wage of other individuals in their geographic area controlling for their job title. print data

dput(df[1:10,c(1,2,3,4,5,6)]) 

output:

structure(list(grp = c("Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant"), monthly_income = c(8000, 2500, 8500, 4500, 35000, 5500, 10000, 7000, 12000, 4000), yrs_experience = c(5, NA, NA, NA, 5, NA, 0, 3, 3, NA), location = c("Portland", "Portland", "Seattle", "Portland", "Seattle", "Seattle", "Portland", "Portland", "Portland", "Seattle"), qualifications = c("no_qual_preference", "no_qual_preference", "no_qual_preference", "no_qual_preference", "BA", "no_qual_preference", "BA", "no_qual_preference", "BA", "no_qual_preference"), gender_preferences = c("no_gender_preference", "female", "female", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference")), row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame")) 

Here is the current code, which I have edited to incorporate the useful suggestions below and it works well without errors but it's not displaying the text I would like to see for each job title.

library(shiny)
# library(shinydashboard)
# library(shinyWidgets)
#library(readxl)


ui <- fluidPage(sidebarLayout(
  sidebarPanel(
    #textInput("grp", "Occupation"), # dropdown menu for job titles
    selectizeInput(
      "grp",
      "Occupation",
      sort(salary_test_data$grp), 
      choices = append("", sort(unique(
        salary_test_data$grp
      ))),
      selected = "",
      multiple = F
    ),
    #choices = sort(unique(salary_test_data$grp)),
    selectizeInput("qualifications",
                   "Qualifications",
                   choices = append("", sort(
                     unique(salary_test_data$qualifications)
                   ))),
    verbatimTextOutput("comparison_results"),
    sliderInput(
       "yrs_experience",
      "Years of Experience",
       min = 0,
       max = 9,
       value = 0,
       post = " Year(s)"
     ),
    selectizeInput("location",
                   "City",
                   choices = append("", sort(
                     unique(salary_test_data$location)
                   ))),
    numericInput("monthly_income", "Monthly Pay", value = 0),
    actionButton("compare_btn", "Compare Salary")
  ),

mainPanel(plotOutput("salary_plot")
)
))


server <- function(input, output) {
  comparison_results <-
    eventReactive(input$compare_btn, {
      user_Occupation <- input$grp
      user_experience <- input$yrs_experience
      user_monthly_pay <- input$monthly_income
      user_location <- input$location
      user_qualification <- input$qualifications
      
      filtered_data <- salary_test_data[salary_test_data$grp == user_Occupation &
                                          salary_test_data$location == user_location &
                                          salary_test_data$qualifications == user_qualification &
                                          salary_test_data$yrs_experience == user_experience, ]
      
      if (nrow(filtered_data) > 0) {
        if (user_monthly_pay >= median(filtered_data$monthly_income)) {
          "Your monthly salary is above the median income of workers employed in your profession,
        who share your qualifications, & city"  
        } else {
          "Your monthly salary is below the median income of workers employed in your profession,
        who share your qualifications, & city"
        }
      } else {
        "No data found for the given job title and/or city"
      }
    })
  
  output$comparison_results <- renderText({
    comparison_results()
  })
  
}

Solution

  • The issue is that there is no output with name comparison_results only a variable with that name created inside the observeEvent. Instead you could use eventReactive and a renderText to create output$comparison_results which will then be displayed in your UI:

    salary_test_data <- structure(list(grp = c("Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant", "Accountant"), monthly_income = c(8000, 2500, 8500, 4500, 35000, 5500, 10000, 7000, 12000, 4000), yrs_experience = c(5, NA, NA, NA, 5, NA, 0, 3, 3, NA), location = c("Portland", "Portland", "Seattle", "Portland", "Seattle", "Seattle", "Portland", "Portland", "Portland", "Seattle"), qualifications = c("no_qual_preference", "no_qual_preference", "no_qual_preference", "no_qual_preference", "BA", "no_qual_preference", "BA", "no_qual_preference", "BA", "no_qual_preference"), gender_preferences = c("no_gender_preference", "female", "female", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference", "no_gender_preference")), row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"))
    
    library(shiny)
    library(dplyr)
    
    ui <- fluidPage(
      sidebarLayout(
        sidebarPanel(
          selectizeInput(
            "grp",
            "Occupation",
            sort(salary_test_data$grp),
            choices = append("", sort(unique(
              salary_test_data$grp
            ))),
            selected = "",
            multiple = F
          ),
          selectizeInput("qualifications",
            "Qualifications",
            choices = append("", sort(
              unique(salary_test_data$qualifications)
            ))
          ),
          sliderInput(
            "yrs_experience",
            "Years of Experience",
            min = 0,
            max = 9,
            value = 0,
            post = " Year(s)"
          ),
          selectizeInput("location",
            "City",
            choices = append("", sort(
              unique(salary_test_data$location)
            ))
          ),
          numericInput("monthly_income", "Monthly Pay", value = 0),
          actionButton("compare_btn", "Compare Salary")
        ),
        mainPanel(
          verbatimTextOutput("comparison_results")
        )
      )
    )
    
    
    server <- function(input, output) {
      comparison_results <-
        eventReactive(input$compare_btn, {
          user_Occupation <- input$grp
          user_experience <- input$yrs_experience
          user_monthly_pay <- input$monthly_income
          user_location <- input$location
          user_qualification <- input$qualifications
    
          filtered_data <- salary_test_data[salary_test_data$grp == user_Occupation &
            salary_test_data$location == user_location &
            salary_test_data$qualifications == user_qualification &
            salary_test_data$yrs_experience == user_experience, ]
    
          if (nrow(filtered_data) > 0) {
            if (user_monthly_pay >= median(filtered_data$monthly_income)) {
              "Your monthly salary is above the median income of workers employed in your profession,
            who share your qualifications, & city in Saudi Arabia"
            } else {
              "Your monthly salary is below the median income of workers employed in your profession,
            who share your qualifications, & city in Saudi Arabia"
            }
          } else {
            "No data found for the given job title and/or city"
          }
        })
    
      output$comparison_results <- renderText({
        comparison_results()
      })
    }
    
    shinyApp(ui, server)
    

    enter image description here