Блог

Главная - Вопросы по программированию - Shiny: ввод текста с помощью ползунка пользователем для фильтрации данных в ggplot

Shiny: ввод текста с помощью ползунка пользователем для фильтрации данных в ggplot

#r #shiny #shiny-reactivity

#r #блестящий #shiny- реактивность

Вопрос:

Я пытаюсь использовать 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
Summeramp;Fall2018 7.166666667 246 STEMLearningCenter  AllUsers    AllUsers    3
2019   7.759036145 249 STEMLearningCenter  AllUsers    AllUsers    4
Summeramp;Fall2019 11.97986577 149 STEMLearningCenter  AllUsers    AllUsers    5
2017 8.769230769 104 STEMLearningCenter  STEMUsers   STEMUsers   1
2018   8.563380282 142 STEMLearningCenter  STEMUsers   STEMUsers   2
Summeramp;Fall2018 9.51497006  167 STEMLearningCenter  STEMUsers   STEMUsers   3
2019   9.675824176 182 STEMLearningCenter  STEMUsers   STEMUsers   4
Summeramp;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 Usersn")   
      
      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)

Комментарии:

1. У вас была возможность проверить мой ответ? Пожалуйста, отметьте это как принятое, если оно удовлетворяет вашим потребностям, или оставьте комментарий в противном случае

Ответ №1:

Я бы предложил использовать level информацию и извлечь which выбранные. Это должно соответствовать значениям коэффициентов. Обратите внимание, что вы должны убедиться, что они расположены в хронологическом порядке, поэтому я добавил их специально при первом вызове mutate factor .

Другая проблема была в ggplot, где вы определяете Year по оси x. Это опрометчиво, поскольку вы фактически отображаете здесь информацию о 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
Summeramp;Fall2018 7.166666667 246 STEMLearningCenter  AllUsers    AllUsers    3
2019   7.759036145 249 STEMLearningCenter  AllUsers    AllUsers    4
Summeramp;Fall2019 11.97986577 149 STEMLearningCenter  AllUsers    AllUsers    5
2017 8.769230769 104 STEMLearningCenter  STEMUsers   STEMUsers   1
2018   8.563380282 142 STEMLearningCenter  STEMUsers   STEMUsers   2
Summeramp;Fall2018 9.51497006  167 STEMLearningCenter  STEMUsers   STEMUsers   3
2019   9.675824176 182 STEMLearningCenter  STEMUsers   STEMUsers   4
Summeramp;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 Usersn")  
            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)