如何在 r Shiny 中使用 daterangeinput 按名称具有月份和年份的列进行过滤？
How to use daterangeinput in r Shiny to filter by columns that have months and years by name?
我有一份人员名单以及他们每个月从事的项目数量。我希望我闪亮的应用程序的用户 select 日期范围输入显示的月份。
library(dplyr)
testdata <- tibble(employee = c("Justin", "Corey","Sibley"),
apr_2021 = c(10, 100, 101),
may_2021 = c(1, 4, 7),
jun_2021 = c(4, 5, 6),
jul_2021 = c(11, 11, 45),
aug_2021 = c(4, 5, 7),
sep_2021 = c(2, 1, 0),
oct_2021 = c(4, 5, 8),
nov_2021 = c(4, 1, 1))
我将我的 daterangeinput() 配置为 M-YYYY 格式，或 Oct_2021。当我尝试调整 date_filter 输入时，出现该列不存在的错误（例如，当用户输入 2021 年 8 月 3 日时：
Warning: Error in : Can't subset columns that don't exist.
x Column `2021_03` doesn't exist.
有两种解决方案之一。理想情况下，我想知道为什么 R 正在更改我在 daterangeinput 中指定的格式以及如何修复它，以便我可以保留我当前的代码（如下）。我不确定这是否与我使用 today() 函数有关，但我需要 R 来获取当前的月份和年份。
如果这不可能的话，第二个解决方案是如何将这些字符串转换为 R 尝试使用的新格式（似乎是 YYYY-mm-dd）。
这是一个可重现的例子：
library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
library(htmltools)
library(lubridate)
library(stringr)
ui = fluidPage(
tabsetPanel(
tabPanel("View 1", fluid = TRUE,
sidebarLayout(
sidebarPanel(
h4("Select Your Desired Filters"),
div(id = "inputs",
dateRangeInput(
inputId = "date_filter",
label = "Filter by Month and Year",
start = today(),
end = (today() + 90),
min = "Apr-2021",
max = NULL,
format = "M-yyyy",
startview = "month",
weekstart = 0,
language = "en",
separator = " to ",
width = NULL,
autoclose = TRUE
),
br()),
),
mainPanel(
DT::dataTableOutput("mytable")
)
)
)
)
)
server = function(input, output, session) {
#Here's the dataset
testdata <- tibble(employee = c("Justin", "Corey","Sibley"),
apr_2021 = c(10, 100, 101),
may_2021 = c(1, 4, 7),
jun_2021 = c(4, 5, 6),
jul_2021 = c(11, 11, 45),
aug_2021 = c(4, 5, 7),
sep_2021 = c(2, 1, 0),
oct_2021 = c(4, 5, 8),
nov_2021 = c(4, 1, 1))
select_values <- reactive({
from_date <- as.character(input$date_filter[1])
from_date <- tolower(str_replace_all(from_date, "-..-", "_"))
to_date <- as.character(input$date_filter[2])
to_date <- tolower(str_replace_all(to_date, "-..-", "_"))
testdata %>%
dplyr::select(employee, from_date:to_date)
})
output$mytable = DT::renderDataTable({
datatable(select_values())
})
}
shinyApp(ui = ui, server = server)
可能不是最严格的代码，但我让它工作了。
最初我没有将每个日期都视为一个字符串，而是将它们变成了一个简单的 1x1 tibble，这样我就可以使用 case_when()、separate()，然后 unite() 适当的字符串订单。
library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
library(htmltools)
library(lubridate)
library(stringr)
ui = fluidPage(
tabsetPanel(
tabPanel("View 1", fluid = TRUE,
sidebarLayout(
sidebarPanel(
h4("Select Your Desired Filters"),
div(id = "inputs",
dateRangeInput(
inputId = "date_filter",
label = "Filter by Month and Year",
start = today(),
end = (today() + 90),
min = "Apr-2021",
max = NULL,
format = "M-yyyy",
startview = "month",
weekstart = 0,
language = "en",
separator = " to ",
width = NULL,
autoclose = TRUE
),
br()),
),
mainPanel(
DT::dataTableOutput("mytable")
)
)
)
)
)
server = function(input, output, session) {
#Here's the dataset
testdata <- tibble(employee = c("Justin", "Corey","Sibley"),
apr_2021 = c(10, 100, 101),
may_2021 = c(1, 4, 7),
jun_2021 = c(4, 5, 6),
jul_2021 = c(11, 11, 45),
aug_2021 = c(4, 5, 7),
sep_2021 = c(2, 1, 0),
oct_2021 = c(4, 5, 8),
nov_2021 = c(4, 1, 1))
select_values <- reactive({
from_date <- tibble(date = as.character(input$date_filter[1]))
from_date <- from_date %>%
mutate(date = str_remove_all(date, "-..$")) %>%
separate(date, into = c("year", "month"), sep = "-") %>%
mutate(month = case_when(
month == "01" ~ "jan",
month == "02" ~ "feb",
month == "03" ~ "mar",
month == "04" ~ "apr",
month == "05" ~ "may",
month == "06" ~ "jun",
month == "07" ~ "jul",
month == "08" ~ "aug",
month == "09" ~ "sep",
month == "10" ~ "oct",
month == "11" ~ "nov",
month == "12" ~ "dec",
TRUE~ "ERROR"
)) %>%
unite("month_year", c(month, year), sep = "_")
from_date <- parse_character(from_date$month_year)
to_date <- tibble(date = as.character(input$date_filter[2]))
to_date <- to_date %>%
mutate(date = str_remove_all(date, "-..$")) %>%
separate(date, into = c("year", "month"), sep = "-") %>%
mutate(month = case_when(
month == "01" ~ "jan",
month == "02" ~ "feb",
month == "03" ~ "mar",
month == "04" ~ "apr",
month == "05" ~ "may",
month == "06" ~ "jun",
month == "07" ~ "jul",
month == "08" ~ "aug",
month == "09" ~ "sep",
month == "10" ~ "oct",
month == "11" ~ "nov",
month == "12" ~ "dec",
TRUE~ "ERROR"
)) %>%
unite("month_year", c(month, year), sep = "_")
to_date <- parse_character(to_date$month_year)
testdata %>%
dplyr::select(employee, from_date:to_date)
})
output$mytable = DT::renderDataTable({
datatable(select_values())
})
}
shinyApp(ui = ui, server = server)
我有一份人员名单以及他们每个月从事的项目数量。我希望我闪亮的应用程序的用户 select 日期范围输入显示的月份。
library(dplyr)
testdata <- tibble(employee = c("Justin", "Corey","Sibley"),
apr_2021 = c(10, 100, 101),
may_2021 = c(1, 4, 7),
jun_2021 = c(4, 5, 6),
jul_2021 = c(11, 11, 45),
aug_2021 = c(4, 5, 7),
sep_2021 = c(2, 1, 0),
oct_2021 = c(4, 5, 8),
nov_2021 = c(4, 1, 1))
我将我的 daterangeinput() 配置为 M-YYYY 格式，或 Oct_2021。当我尝试调整 date_filter 输入时，出现该列不存在的错误（例如，当用户输入 2021 年 8 月 3 日时：
Warning: Error in : Can't subset columns that don't exist.
x Column `2021_03` doesn't exist.
有两种解决方案之一。理想情况下，我想知道为什么 R 正在更改我在 daterangeinput 中指定的格式以及如何修复它，以便我可以保留我当前的代码（如下）。我不确定这是否与我使用 today() 函数有关，但我需要 R 来获取当前的月份和年份。
如果这不可能的话，第二个解决方案是如何将这些字符串转换为 R 尝试使用的新格式（似乎是 YYYY-mm-dd）。
这是一个可重现的例子：
library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
library(htmltools)
library(lubridate)
library(stringr)
ui = fluidPage(
tabsetPanel(
tabPanel("View 1", fluid = TRUE,
sidebarLayout(
sidebarPanel(
h4("Select Your Desired Filters"),
div(id = "inputs",
dateRangeInput(
inputId = "date_filter",
label = "Filter by Month and Year",
start = today(),
end = (today() + 90),
min = "Apr-2021",
max = NULL,
format = "M-yyyy",
startview = "month",
weekstart = 0,
language = "en",
separator = " to ",
width = NULL,
autoclose = TRUE
),
br()),
),
mainPanel(
DT::dataTableOutput("mytable")
)
)
)
)
)
server = function(input, output, session) {
#Here's the dataset
testdata <- tibble(employee = c("Justin", "Corey","Sibley"),
apr_2021 = c(10, 100, 101),
may_2021 = c(1, 4, 7),
jun_2021 = c(4, 5, 6),
jul_2021 = c(11, 11, 45),
aug_2021 = c(4, 5, 7),
sep_2021 = c(2, 1, 0),
oct_2021 = c(4, 5, 8),
nov_2021 = c(4, 1, 1))
select_values <- reactive({
from_date <- as.character(input$date_filter[1])
from_date <- tolower(str_replace_all(from_date, "-..-", "_"))
to_date <- as.character(input$date_filter[2])
to_date <- tolower(str_replace_all(to_date, "-..-", "_"))
testdata %>%
dplyr::select(employee, from_date:to_date)
})
output$mytable = DT::renderDataTable({
datatable(select_values())
})
}
shinyApp(ui = ui, server = server)
可能不是最严格的代码，但我让它工作了。
最初我没有将每个日期都视为一个字符串，而是将它们变成了一个简单的 1x1 tibble，这样我就可以使用 case_when()、separate()，然后 unite() 适当的字符串订单。
library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
library(htmltools)
library(lubridate)
library(stringr)
ui = fluidPage(
tabsetPanel(
tabPanel("View 1", fluid = TRUE,
sidebarLayout(
sidebarPanel(
h4("Select Your Desired Filters"),
div(id = "inputs",
dateRangeInput(
inputId = "date_filter",
label = "Filter by Month and Year",
start = today(),
end = (today() + 90),
min = "Apr-2021",
max = NULL,
format = "M-yyyy",
startview = "month",
weekstart = 0,
language = "en",
separator = " to ",
width = NULL,
autoclose = TRUE
),
br()),
),
mainPanel(
DT::dataTableOutput("mytable")
)
)
)
)
)
server = function(input, output, session) {
#Here's the dataset
testdata <- tibble(employee = c("Justin", "Corey","Sibley"),
apr_2021 = c(10, 100, 101),
may_2021 = c(1, 4, 7),
jun_2021 = c(4, 5, 6),
jul_2021 = c(11, 11, 45),
aug_2021 = c(4, 5, 7),
sep_2021 = c(2, 1, 0),
oct_2021 = c(4, 5, 8),
nov_2021 = c(4, 1, 1))
select_values <- reactive({
from_date <- tibble(date = as.character(input$date_filter[1]))
from_date <- from_date %>%
mutate(date = str_remove_all(date, "-..$")) %>%
separate(date, into = c("year", "month"), sep = "-") %>%
mutate(month = case_when(
month == "01" ~ "jan",
month == "02" ~ "feb",
month == "03" ~ "mar",
month == "04" ~ "apr",
month == "05" ~ "may",
month == "06" ~ "jun",
month == "07" ~ "jul",
month == "08" ~ "aug",
month == "09" ~ "sep",
month == "10" ~ "oct",
month == "11" ~ "nov",
month == "12" ~ "dec",
TRUE~ "ERROR"
)) %>%
unite("month_year", c(month, year), sep = "_")
from_date <- parse_character(from_date$month_year)
to_date <- tibble(date = as.character(input$date_filter[2]))
to_date <- to_date %>%
mutate(date = str_remove_all(date, "-..$")) %>%
separate(date, into = c("year", "month"), sep = "-") %>%
mutate(month = case_when(
month == "01" ~ "jan",
month == "02" ~ "feb",
month == "03" ~ "mar",
month == "04" ~ "apr",
month == "05" ~ "may",
month == "06" ~ "jun",
month == "07" ~ "jul",
month == "08" ~ "aug",
month == "09" ~ "sep",
month == "10" ~ "oct",
month == "11" ~ "nov",
month == "12" ~ "dec",
TRUE~ "ERROR"
)) %>%
unite("month_year", c(month, year), sep = "_")
to_date <- parse_character(to_date$month_year)
testdata %>%
dplyr::select(employee, from_date:to_date)
})
output$mytable = DT::renderDataTable({
datatable(select_values())
})
}
shinyApp(ui = ui, server = server)