1

我正在尝试使用 selectTextInput 来允许修改图形的 x 轴。一切正常，除了我不知道如何过滤以包括所选范围之间的所有点。目前，只有滑块刻度上的两个点被选中。

由于变量 term_year_fct 是一个因子变量，我知道我不能使用filter(between)来实现我的结果。例如，如果我要使用 selectInput（而不是 selectTextInput），则可以使用它。

 # dat <- dat %>% filter(between(term_year_fct, input$year[1],input$year[2]))

我尝试将 term_year_fct 转换为对应于数字变量（请参阅 Year 变量），以便我可以使用 SelectInput 但这不起作用，因为滑块显示显示 1、2、3 等，我想查看真实标签在滑块上。

有什么建议么？？

library(shiny)
library(shinythemes)
library(readr)
library(dplyr)
library(ggplot2)
library(shinyWidgets)
library(string)

dat_in <- read_table2("term_year_fct   mean    value   Program name    subgroup_fct    Year
2017 7.647482014 139 STEMLearningCenter  AllUsers    AllUsers    1
2018   6.34741784  213 STEMLearningCenter  AllUsers    AllUsers    2
Summer&Fall2018 7.166666667 246 STEMLearningCenter  AllUsers    AllUsers    3
2019   7.759036145 249 STEMLearningCenter  AllUsers    AllUsers    4
Summer&Fall2019 11.97986577 149 STEMLearningCenter  AllUsers    AllUsers    5
2017 8.769230769 104 STEMLearningCenter  STEMUsers   STEMUsers   1
2018   8.563380282 142 STEMLearningCenter  STEMUsers   STEMUsers   2
Summer&Fall2018 9.51497006  167 STEMLearningCenter  STEMUsers   STEMUsers   3
2019   9.675824176 182 STEMLearningCenter  STEMUsers   STEMUsers   4
Summer&Fall2019 12.44680851 141 STEMLearningCenter  STEMUsers   STEMUsers   5
") %>% mutate(term_year_fct =as.factor(term_year_fct))





ui <- fluidPage(theme = shinytheme("superhero"),  # shinythemes::themeSelector(), #
                
                
                br(),
                br(),
                headerPanel(h2(" ", align = 'center')),
                br(),
                sidebarLayout(
                  sidebarPanel(

                    uiOutput("choose_year"),
                    br(),
                  ),
                  
                  mainPanel(
                    plotOutput("plot"),

                  )
                )
                
)






## THE SERVER OBJECT ## 


server <- function(input, output) {
  

  
  output$choose_year <- renderUI({
    sliderTextInput(
      inputId = "year",
      label = HTML('<FONT color="orange"><FONT size="4pt">Select years of interest:'),
      choices = unique(as.character(dat_in$term_year_fct)),
      selected  = unique(as.character(dat_in$term_year_fct))
    )
  })
  
  
  
  
  # Create the plot on the right 
  output$plot <- renderPlot({
    
    # The data is sliced based on the selection of the user 
    dat <-subset(dat_in, term_year_fct %in% input$year) 
    
    # If I used selectInput instead, I could this this
    # dat <- dat %>% filter(between(term_year_fct, input$year[1],input$year[2]))
    
    # plot the data using ggplot 
    dat %>% 
      ggplot(aes(x=Year,y = value,fill = subgroup_fct)) + 
      geom_area(aes(colour = subgroup_fct, fill = subgroup_fct), color = "white", position = "identity") +

      
      scale_y_continuous(limits = c(0, 300), expand = c(0, 20)) +
      
      scale_x_continuous(limits = c(1, 5), breaks = c(1:5),
                         labels = str_wrap(levels(dat$term_year_fct),
                                           width = 15)) +
      scale_fill_manual(#breaks = levels(dat$name),
        drop = FALSE,
        values = c("#285560", "#57a6b9", "#8fa13a")) +
      xlab("") + 
      ylab("Count of \nUnique Users\n") + 
      
      geom_text(aes(label = ifelse(name == "All Users", value, "")),
                hjust = 0.5, vjust = -0.4, show.legend = FALSE, size = 5, color ="white")  +
      geom_text(aes(label = ifelse(name == "STEM Users", value, "")),
                hjust = 0.5, vjust = 1.2, show.legend = FALSE, size = 5, color ="white") +
      geom_text(aes(label = ifelse(name == "Frequent Users", value, "")),
                hjust = 0.5, vjust = -0.25, show.legend = FALSE, size = 5, color ="white") #+

    
    
  }, bg = "transparent")
  
}  








shinyApp(ui = ui, server = server)
4

1 回答 1

1

我建议使用level信息并选择提取which。这应该对应于因子值。请注意，您必须确保它们按时间顺序排列，这就是为什么我在第一个 mutate 调用中专门添加了它们factor。

Year另一个问题是在您在 x 轴上定义的 ggplot 中。这是不明智的，因为您实际上在这里绘制了 temp_year 信息。即使它可能产生相同的结果，使用一个变量并使用另一个变量的标签似乎也容易出错。

library(shiny)
library(shinythemes)
library(readr)
library(dplyr)
library(ggplot2)
library(shinyWidgets)
library(stringr)

dat_in <- read_table2("term_year_fct   mean    value   Program name    subgroup_fct    Year
2017 7.647482014 139 STEMLearningCenter  AllUsers    AllUsers    1
2018   6.34741784  213 STEMLearningCenter  AllUsers    AllUsers    2
Summer&Fall2018 7.166666667 246 STEMLearningCenter  AllUsers    AllUsers    3
2019   7.759036145 249 STEMLearningCenter  AllUsers    AllUsers    4
Summer&Fall2019 11.97986577 149 STEMLearningCenter  AllUsers    AllUsers    5
2017 8.769230769 104 STEMLearningCenter  STEMUsers   STEMUsers   1
2018   8.563380282 142 STEMLearningCenter  STEMUsers   STEMUsers   2
Summer&Fall2018 9.51497006  167 STEMLearningCenter  STEMUsers   STEMUsers   3
2019   9.675824176 182 STEMLearningCenter  STEMUsers   STEMUsers   4
Summer&Fall2019 12.44680851 141 STEMLearningCenter  STEMUsers   STEMUsers   5
") %>% mutate(term_year_fct =as.factor(term_year_fct))

ui <- fluidPage(theme = shinytheme("superhero"),  # shinythemes::themeSelector(), #
                br(),
                br(),
                headerPanel(h2(" ", align = 'center')),
                br(),
                sidebarLayout(
                    sidebarPanel(
                        uiOutput("choose_year"),
                        br(),
                    ),
                    mainPanel(
                        plotOutput("plot"),
                    )
                )
)

## THE SERVER OBJECT ##
server <- function(input, output) {

    output$choose_year <- renderUI({
        sliderTextInput(
            inputId = "year",
            label = HTML('<FONT color="orange"><FONT size="4pt">Select years of interest:'),
            choices = unique(as.character(sort(dat_in$term_year_fct))),
            selected  = unique(as.character(dat_in$term_year_fct))
        )
    })

    # Create the plot on the right
    output$plot <- renderPlot({

        # The data is sliced based on the selection of the user

        # If I used selectInput instead, I could this this
        fctr <- dat_in$term_year_fct
        levs_selected <- which(levels(fctr) %in% input$year)
        dat <- dat_in %>% filter(between(as.numeric(dat_in$term_year_fct), levs_selected[1],levs_selected[2]))

        # plot the data using ggplot
        dat %>%
            ggplot(aes(x=as.numeric(term_year_fct),y = value,fill = subgroup_fct)) +
            geom_area(aes(colour = subgroup_fct, fill = subgroup_fct), color = "white", position = "identity") +
            scale_y_continuous(limits = c(0, 300), expand = c(0, 20)) +
            scale_x_continuous(limits = c(1, 5), breaks = c(1:5),
                               labels = str_wrap(levels(dat$term_year_fct),
                                                 width = 15)) +
            scale_fill_manual(#breaks = levels(dat$name),
                drop = FALSE,
                values = c("#285560", "#57a6b9", "#8fa13a")) +
            xlab("") +
            ylab("Count of \nUnique Users\n") +
            geom_text(aes(label = ifelse(name == "All Users", value, "")),
                      hjust = 0.5, vjust = -0.4, show.legend = FALSE, size = 5, color ="white")  +
            geom_text(aes(label = ifelse(name == "STEM Users", value, "")),
                      hjust = 0.5, vjust = 1.2, show.legend = FALSE, size = 5, color ="white") +
            geom_text(aes(label = ifelse(name == "Frequent Users", value, "")),
                      hjust = 0.5, vjust = -0.25, show.legend = FALSE, size = 5, color ="white") 
    }, bg = "transparent")

}
shinyApp(ui = ui, server = server)
于 2021-03-19T23:23:44.507 回答