我正在构建一个简单的收入搜索工具,个人可以在其中输入他们的职称、月薪和城市,作为输出,他们可以了解自己的工资与控制其职称的地理区域内其他个人的工资中位数的比较. 打印数据

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

输出:

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(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()
  })
  
}

推荐答案

问题是没有名为comparison_resultsoutput,只有在observeEvent中创建的同名变量.相反,您可以使用eventReactiverenderText来创建output$comparison_results,然后将其显示在您的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

R相关问答推荐

具有相同条宽 * 和 ** 在 * 多个 * 图上相同条距的条图

从cv.glmnet R包中查找培训SSE

按列A中的值进行子集化,并获得列C中对应于R中列B的最大值行的值?使用循环自动化此操作

通过R访问MoveApps API

使用scale_x_continuous复制ggplot 2中的离散x轴

从多个前置日期中获取最长日期

按R中的组查找相邻列的行累积和的最大值

用相同方法得到不同函数的ROC最优截断值

在嵌套列表中查找元素路径的最佳方法

从圆到R中的多边形的标绘雷达图

基于R中的间隔扩展数据集行

R -在先前group_by级别汇总时获取最大大小子组的计数

悬崖三角洲超大型群数计算导致整数溢出

查找所有站点的最小值

将多个变量组合成宽格式

如何在ggplot2中创建多个y轴(每个变量一个)

将数据集旋转到长格式,用于遵循特定名称模式的所有变量对

如何移动点以使它们的打印不重叠

如何在内联代码中添加额外的空格(R Markdown)

我正在try 创建一个接近cos(X)的值的While循环,以便它在-或+1-E10范围内