闪亮：用户滑块文本输入以过滤 ggplot 中的数据
Shiny: User slider text input to filter data in ggplot
我正在尝试使用 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)
我建议使用 level 信息并选择提取 which。这应该对应于因子值。请注意，您必须确保它们按时间顺序排列，这就是为什么我在 factor.
的第一个 mutate 调用中专门添加它们的原因
另一个问题是在 ggplot 中，您在 x 轴上定义了 Year。这是不明智的，因为您实际上在此处绘制了 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)
我正在尝试使用 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)
我建议使用 level 信息并选择提取 which。这应该对应于因子值。请注意，您必须确保它们按时间顺序排列，这就是为什么我在 factor.
另一个问题是在 ggplot 中，您在 x 轴上定义了 Year。这是不明智的，因为您实际上在此处绘制了 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)