英文:
R DT filter for comma-separated text with multi-select
问题
我有一个包含星期几列的数据框。该列中可以是一个星期几，也可以是多个星期几，以逗号分隔。
我想要在表格上显示一个筛选器，星期几列应该像因子筛选器一样运行，因此可以弹出包含7个可能星期几的多选框。
我尝试使用yadcf Datatables插件：https://github.com/vedmack/yadcf/
library(shiny)
ui <- fluidPage(
tags$head(
tags$link(href="jquery.dataTables.yadcf.css", rel = "stylesheet"),
tags$script(src="jquery.dataTables.yadcf.js"),
),
dataTableOutput("sometable")
)
jsc <- '
function(settings, json) {
var table = settings.oInstance.api();
yadcf.init(table, [{
column_number : 2,
column_data_type: "text",
data: [{"label": "Montag", "value": 1}, {"label": "Dienstag", "value": 2}, {"label": "Mittwoch", "value": 3},
{"label": "Donnerstag", "value": 4}, {"label": "Freitag", "value": 5}, {"label": "Samstag", "value": 6}, {"label": "Sonntag", "value": 7}],
omit_default_label: true,
text_data_delimiter: ",",
}]);
}
'
server <- function(input, output) {
output$sometable <- renderDataTable({
df <- data.frame(ID = 1:6,
Weekdays = c("Montag", "Dienstag,Mittwoch", "Mittwoch,Samstag",
"Donnerstag", "Montag,Freitag", "Samstag,Sonntag"))
datatable(df, filter = "top",
options = list(
initComplete = JS(jsc))
)
})
}
shinyApp(ui, server)
编辑：这个JS代码有效，但我希望多选框看起来更好，像普通的选择输入，并且我希望它替换默认的filter="top"。
jsc <- '
function(settings, json) {
var table = settings.oInstance.api();
yadcf.init(table, [{
column_number : 2,
column_data_type: "text",
data: ["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag","Sonntag"],
sort_as: "num",
omit_default_label: true,
filter_type: "multi_select",
text_data_delimiter: ",",
}]);
}
'
编辑2：理想情况下，我希望在Tags列中的示例中看到的行为，链接如下：https://yadcf-showcase.appspot.com/cumulative_filtering.html
英文:
I have a dataframe with a weekday column. In it can be one weekday or multiple weekdays, comma separated.
I want to show the table with the filter on top and the weekdays column should behave like a factor filter, so the multi-select pops-up with the 7 possible weekdays.
I tried with the yadcf Datatables plugin: https://github.com/vedmack/yadcf/
library(shiny)
ui <- fluidPage(
tags$head(
tags$link(href="jquery.dataTables.yadcf.css", rel = "stylesheet"),
tags$script(src="jquery.dataTables.yadcf.js"),
),
dataTableOutput("sometable")
)
jsc <- '
function(settings, json) {
var table = settings.oInstance.api();
yadcf.init(table, [{
column_number : 2,
column_data_type: "text",
data: [{"label": "Montag", "value": 1}, {"label": "Dienstag", "value": 2}, {"label": "Mittwoch", "value": 3},
{"label": "Donnerstag", "value": 4}, {"label": "Freitag", "value": 5}, {"label": "Samstag", "value": 6}, {"label": "Sonntag", "value": 7}],
omit_default_label: true,
//filter_type: "multi_select",
text_data_delimiter: ","
}]);
}
'
server <- function(input, output) {
output$sometable <- renderDataTable({
df <- data.frame(ID = 1:6,
Weekdays = c("Montag", "Dienstag,Mittwoch", "Mittwoch,Samstag",
"Donnerstag", "Montag,Freitag", "Samstag,Sonntag"))
datatable(df, filter = "top",
options = list(
initComplete = JS(jsc))
)
})
}
shinyApp(ui, server)
EDIT: This JS works, but I would like the multi-select to look nicer, like a normal select input and actually I would like that select instead of the default one from filter="top".
jsc <- '
function(settings, json) {
var table = settings.oInstance.api();
yadcf.init(table, [{
column_number : 2,
column_data_type: "text",
data: ["Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag","Sonntag"],
sort_as: "num",
omit_default_label: true,
filter_type: "multi_select",
text_data_delimiter: ","
}]);
}
'
EDIT 2:
Ideally I would like the behaviour in this example in the Tags column
https://yadcf-showcase.appspot.com/cumulative_filtering.html
答案1
得分: 2
I removed data and omit_default_label and it works fine. Is it what you want?
library(DT)
js <- '
yadcf.init(table, [
{
column_number : 2,
column_data_type: "text",
//data: [{"label": "Montag", "value": 1}, {"label": "Dienstag", "value": 2}, {"label": "Mittwoch", "value": 3},
// {"label": "Donnerstag", "value": 4}, {"label": "Freitag", "value": 5}, {"label": "Samstag", "value": 6}, {"label": "Sonntag", "value": 7}],
//omit_default_label: true,
text_data_delimiter: ","
}
]);
'
df <- data.frame(ID = 1:6,
Weekdays = c("Montag", "Dienstag,Mittwoch", "Mittwoch,Samstag",
"Donnerstag", "Montag,Freitag", "Samstag,Sonntag"))
dtable <- datatable(
df, #filter = "top",
callback = JS(js)
)
dep <- htmltools::htmlDependency(
"yadcf", "0.9.3",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/yadcf/0.9.3/"),
script = "jquery.dataTables.yadcf.min.js",
stylesheet = "jquery.dataTables.yadcf.min.css")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
"jquery-ui", "1.12.1",
src = "www/shared/jqueryui/",
script = "jquery-ui.js",
stylesheet = "jquery-ui.css",
package = "shiny")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
"moment", "2.27.0",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/moment.js/2.27.0/"),
script = "moment.min.js")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dtable
英文:
I removed data and omit_default_label and it works fine. Is it what you want?
library(DT)
js <- '
yadcf.init(table, [
{
column_number : 2,
column_data_type: "text",
//data: [{"label": "Montag", "value": 1}, {"label": "Dienstag", "value": 2}, {"label": "Mittwoch", "value": 3},
// {"label": "Donnerstag", "value": 4}, {"label": "Freitag", "value": 5}, {"label": "Samstag", "value": 6}, {"label": "Sonntag", "value": 7}],
//omit_default_label: true,
text_data_delimiter: ","
}
]);
'
df <- data.frame(ID = 1:6,
Weekdays = c("Montag", "Dienstag,Mittwoch", "Mittwoch,Samstag",
"Donnerstag", "Montag,Freitag", "Samstag,Sonntag"))
dtable <- datatable(
df, #filter = "top",
callback = JS(js)
)
dep <- htmltools::htmlDependency(
"yadcf", "0.9.3",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/yadcf/0.9.3/"),
script = "jquery.dataTables.yadcf.min.js",
stylesheet = "jquery.dataTables.yadcf.min.css")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
"jquery-ui", "1.12.1",
src = "www/shared/jqueryui/",
script = "jquery-ui.js",
stylesheet = "jquery-ui.css",
package = "shiny")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
"moment", "2.27.0",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/moment.js/2.27.0/"),
script = "moment.min.js")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dtable
Edit
To get the desired order:
library(DT)
js <- '
yadcf.init(table, [
{
column_number : 2,
column_data_type: "text",
data: [
{"label": "Montag", "value": "Montag"},
{"label": "Dienstag", "value": "Dienstag"},
{"label": "Mittwoch", "value": "Mittwoch"},
{"label": "Donnerstag", "value": "Donnerstag"},
{"label": "Freitag", "value": "Freitag"},
{"label": "Samstag", "value": "Samstag"},
{"label": "Sonntag", "value": "Sonntag"}
],
//omit_default_label: true,
filter_type: "select",
select_type: "jquery-ui",
text_data_delimiter: /,/
}
]);
'
df <- data.frame(ID = 1:6,
Weekdays = c("Montag", "Dienstag,Mittwoch", "Mittwoch,Samstag",
"Donnerstag", "Montag,Freitag", "Samstag,Sonntag"))
dtable <- datatable(
df, #filter = "top",
callback = JS(js)
)
dep <- htmltools::htmlDependency(
"yadcf", "0.9.3",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/yadcf/0.9.3/"),
script = "jquery.dataTables.yadcf.min.js",
stylesheet = "jquery.dataTables.yadcf.min.css")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
"jquery-ui", "1.12.1",
src = "www/shared/jqueryui/",
script = "jquery-ui.js",
stylesheet = "jquery-ui.css",
package = "shiny")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
"moment", "2.27.0",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/moment.js/2.27.0/"),
script = "moment.min.js")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dtable
Edit: nice multi select
If you want to have a nice multi select, you have to set the option select_type=select2 but you also have to include the select2 library.
library(DT)
js <- '
yadcf.init(table, [
{
column_number : 2,
column_data_type: "text",
data: [
{"label": "Montag", "value": "Montag"},
{"label": "Dienstag", "value": "Dienstag"},
{"label": "Mittwoch", "value": "Mittwoch"},
{"label": "Donnerstag", "value": "Donnerstag"},
{"label": "Freitag", "value": "Freitag"},
{"label": "Samstag", "value": "Samstag"},
{"label": "Sonntag", "value": "Sonntag"}
],
//omit_default_label: true,
filter_type: "multi_select",
select_type: "select2",
text_data_delimiter: /,/
}
]);
'
df <- data.frame(ID = 1:6,
Weekdays = c("Montag", "Dienstag,Mittwoch", "Mittwoch,Samstag",
"Donnerstag", "Montag,Freitag", "Samstag,Sonntag"))
dtable <- datatable(
df, #filter = "top",
callback = JS(js)
)
dep <- htmltools::htmlDependency(
"yadcf", "0.9.3",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/yadcf/0.9.3/"),
script = "jquery.dataTables.yadcf.min.js",
stylesheet = "jquery.dataTables.yadcf.min.css")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
"jquery-ui", "1.12.1",
src = "www/shared/jqueryui/",
script = "jquery-ui.js",
stylesheet = "jquery-ui.css",
package = "shiny")
dep <- htmltools::htmlDependency(
"select2_js", "4.0.13",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/"),
script = "js/select2.min.js",
stylesheet = "css/select2.min.css")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dep <- htmltools::htmlDependency(
"moment", "2.27.0",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/moment.js/2.27.0/"),
script = "moment.min.js")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dtable
Edit: in Shiny
library(DT)
library(shiny)
js <- '
yadcf.init(table, [
{
column_number : 2,
column_data_type: "text",
data: [
{"label": "Montag", "value": "Montag"},
{"label": "Dienstag", "value": "Dienstag"},
{"label": "Mittwoch", "value": "Mittwoch"},
{"label": "Donnerstag", "value": "Donnerstag"},
{"label": "Freitag", "value": "Freitag"},
{"label": "Samstag", "value": "Samstag"},
{"label": "Sonntag", "value": "Sonntag"}
],
//omit_default_label: true,
filter_type: "multi_select",
select_type: "select2",
text_data_delimiter: /,/
}
]);
'
df <- data.frame(ID = 1:6,
Weekdays = c("Montag", "Dienstag,Mittwoch", "Mittwoch,Samstag",
"Donnerstag", "Montag,Freitag", "Samstag,Sonntag"))
dtable <- datatable(
df, #filter = "top",
callback = JS(js)
)
ui <- fluidPage(
tagList(
htmltools::htmlDependency(
"yadcf", "0.9.3",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/yadcf/0.9.3/"),
script = "jquery.dataTables.yadcf.min.js",
stylesheet = "jquery.dataTables.yadcf.min.css"),
htmltools::htmlDependency(
"select2_js", "4.0.13",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/"),
script = "js/select2.min.js",
stylesheet = "css/select2.min.css"),
htmltools::htmlDependency(
"moment", "2.27.0",
c(href = "https://cdnjs.cloudflare.com/ajax/libs/moment.js/2.27.0/"),
script = "moment.min.js")
),
DTOutput("dtable")
)
server <- function(input, output, session) {
output[["dtable"]] <- renderDT({
dtable
}, server = FALSE)
}
shinyApp(ui, server)
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论