英文:
R shiny Drop down list for columns in rendered table
问题
我正在尝试创建一个下拉列表,以查看每一列中的值,类似于Excel中的方式。但我无法创建下拉列表。我不知道在哪里进行更改以创建这个列表。任何建议都将不胜感激。
代码:
Server.R
library(shiny)
library(DT)
shinyServer(function(input, output, session) {
mtcars2 = data.frame(
name = rownames(mtcars), mtcars[, c('mpg', 'hp')],
stringsAsFactors = FALSE
)
output$tbl = DT::renderDataTable(
mtcars2, filter = 'top', server = TRUE, rownames = FALSE,
options = list(autoWidth = TRUE)
)
})
ui.r
library(shiny)
shinyUI(fluidPage(
title = 'Column Filters on the Server Side',
fluidRow(
DT::dataTableOutput('tbl')
)
))
注意:以上为您提供的代码部分的翻译。
英文:
I am trying to create a drop down list to view the values within each column, similar to in excel. But I am unable to create the dropdown list. I am unable to understand where to make changes to create this list. Any suggestions, highly appreciated.
code:
Server.R
library(shiny)
library(DT)
shinyServer(function(input, output, session) {
mtcars2 = data.frame(
name = rownames(mtcars), mtcars[, c('mpg', 'hp')],
stringsAsFactors = FALSE
)
output$tbl = DT::renderDataTable(
mtcars2, filter = 'top', server = TRUE, rownames = FALSE,
options = list(autoWidth = TRUE)
)
})
ui.r
library(shiny)
shinyUI(fluidPage(
title = 'Column Filters on the Server Side',
fluidRow(
DT::dataTableOutput('tbl')
)
))
答案1
得分: 1
以下是翻译好的代码部分:
library(shiny)
library(DT)
dat <- mtcars
sketch <- htmltools::tags$table(
tableHeader(c("", names(dat))),
tableFooter(rep("", 1+ncol(dat)))
)
js <- c(
"function(){",
" this.api().columns().every(function(i){",
" var column = this;",
" var select = $('<select><option value=\"\"></option></select>')",
" .appendTo( $(column.footer()).empty() )",
" .on('change', function(){",
" select.val(null);",
" });",
" var data = column.data();",
" if(i == 0){",
" data.each(function(d, j){",
" select.append('<option value=\"'+d+'\">'+d+'</option>');",
" });",
" }else{",
" data.unique().sort().each(function(d, j){",
" select.append('<option value=\"'+d+'\">'+d+'</option>');",
" });",
" }",
" select.select2({width: '100%'});",
" });",
"}"
)
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/css/select2.min.css"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/js/select2.min.js")
),
br(),
DTOutput("dtable")
)
server <- function(input, output, session){
output[["dtable"]] <- renderDT({
datatable(
dat, container=sketch,
options = list(
initComplete = JS(js),
columnDefs = list(
list(targets = "_all", className = "dt-center")
)
)
)
}, server = FALSE)
}
shinyApp(ui, server)
library(shiny)
library(DT)
library(htmltools)
dat <- mtcars
sketch <- tags$table(
tags$thead(
tags$tr(
tags$th(),
lapply(names(dat), tags$th)
),
tags$tr(
tags$th(id = "th0"),
tags$th(id = "th1"),
tags$th(id = "th2"),
tags$th(id = "th3"),
tags$th(id = "th4"),
tags$th(id = "th5"),
tags$th(id = "th6"),
tags$th(id = "th7"),
tags$th(id = "th8"),
tags$th(id = "th9"),
tags$th(id = "th10"),
tags$th(id = "th11")
)
)
)
js <- c(
"function(){",
" this.api().columns().every(function(i){",
" var column = this;",
" var select = $('<select><option value=\"\"></option></select>')",
" .appendTo( $('#th'+i).empty() )",
" .on('change', function(){",
" select.val(null);",
" });",
" var data = column.data();",
" if(i == 0){",
" data.each(function(d, j){",
" select.append('<option value=\"'+d+'\">'+d+'</option>');",
" });",
" }else{",
" data.unique().sort().each(function(d, j){",
" select.append('<option value=\"'+d+'\">'+d+'</option>');",
" });",
" }",
" select.select2({width: '100%'});",
" });",
"}"
)
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/css/select2.min.css"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/js/select2.min.js")
),
br(),
DTOutput("dtable")
)
server <- function(input, output, session) {
output[["dtable"]] <- renderDT({
datatable(
dat, container=sketch,
options = list(
orderCellsTop = TRUE,
initComplete = JS(js),
columnDefs = list(
list(targets = "_all", className = "dt-center")
)
)
)
}, server = FALSE)
}
shinyApp(ui, server)
英文:
Try this.
library(shiny)
library(DT)
dat <- mtcars
sketch <- htmltools::tags$table(
tableHeader(c("", names(dat))),
tableFooter(rep("", 1+ncol(dat)))
)
js <- c(
"function(){",
" this.api().columns().every(function(i){",
" var column = this;",
" var select = $('<select><option value=\"\"></option></select>')",
" .appendTo( $(column.footer()).empty() )",
" .on('change', function(){",
" select.val(null);",
" });",
" var data = column.data();",
" if(i == 0){",
" data.each(function(d, j){",
" select.append('<option value=\"'+d+'\">'+d+'</option>');",
" });",
" }else{",
" data.unique().sort().each(function(d, j){",
" select.append('<option value=\"'+d+'\">'+d+'</option>');",
" });",
" }",
" select.select2({width: '100%'});",
" });",
"}")
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/css/select2.min.css"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/js/select2.min.js")
),
br(),
DTOutput("dtable")
)
server <- function(input, output, session){
output[["dtable"]] <- renderDT({
datatable(
dat, container=sketch,
options = list(
initComplete = JS(js),
columnDefs = list(
list(targets = "_all", className = "dt-center")
)
)
)
}, server = FALSE)
}
shinyApp(ui, server)
Edit: dropdowns at the top of the table
library(shiny)
library(DT)
library(htmltools)
dat <- mtcars
sketch <- tags$table(
tags$thead(
tags$tr(
tags$th(),
lapply(names(dat), tags$th)
),
tags$tr(
tags$th(id = "th0"),
tags$th(id = "th1"),
tags$th(id = "th2"),
tags$th(id = "th3"),
tags$th(id = "th4"),
tags$th(id = "th5"),
tags$th(id = "th6"),
tags$th(id = "th7"),
tags$th(id = "th8"),
tags$th(id = "th9"),
tags$th(id = "th10"),
tags$th(id = "th11")
)
)
)
js <- c(
"function(){",
" this.api().columns().every(function(i){",
" var column = this;",
" var select = $('<select><option value=\"\"></option></select>')",
" .appendTo( $('#th'+i).empty() )",
" .on('change', function(){",
" select.val(null);",
" });",
" var data = column.data();",
" if(i == 0){",
" data.each(function(d, j){",
" select.append('<option value=\"'+d+'\">'+d+'</option>');",
" });",
" }else{",
" data.unique().sort().each(function(d, j){",
" select.append('<option value=\"'+d+'\">'+d+'</option>');",
" });",
" }",
" select.select2({width: '100%'});",
" });",
"}")
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/css/select2.min.css"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/js/select2.min.js")
),
br(),
DTOutput("dtable")
)
server <- function(input, output, session) {
output[["dtable"]] <- renderDT({
datatable(
dat, container=sketch,
options = list(
orderCellsTop = TRUE,
initComplete = JS(js),
columnDefs = list(
list(targets = "_all", className = "dt-center")
)
)
)
}, server = FALSE)
}
shinyApp(ui, server)
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论