Related
I am rendering the full column with checkboxes, each checkbox has its individual id so I can play with the different options and catch the relative states.
in the example below as you can see all the checkboxes will be named chkbx_ the rownumber, e.g. for row1 in the column newvar I'll have a checkbox with id chkbx_1.
now let's say that I want the first checkbox to be disabled, this should be easily achievable as far as I know with ShinyJS (I am doing that for some buttons outside from the DT and it works).
So I am calling the disable function on id chkbx_1, but for some reasons the checkbox is still selectable.
Any idea on how to proceed?
here below the sample code to quickly replicate the issue.
library("DT")
library("shinyjs")
ui <- basicPage(
h2("The mtcars data"),
useShinyjs(),
DT::dataTableOutput("mytable")
)
server <- function(input, output) {
shinyInput <- function(FUN, len, id, ...) {
inputs <- as.character(FUN(paste0(id,'_', len), ...))
inputs
}
mtcarsx <- data.frame(mtcars)
for(myrow in 1:nrow(mtcarsx)){
mtcarsx[myrow,"newvar"]=toString(shinyInput(checkboxInput,toString(myrow),"chkbx",label="",value=FALSE,width=NULL))
}
shinyjs::disable("chkbx_1")
output$mytable = DT::renderDataTable({
DT::datatable(mtcarsx,
escape = FALSE,
selection = 'none',
rownames = TRUE,
extensions = c('FixedColumns'),
options = list(searching = FALSE,
ordering = FALSE,
autoWidth = TRUE,
scrollX = TRUE,
FixedColumns = list(leftColumns = c(2))
))
})
}
shinyApp(ui, server)
Try this
library("DT")
library("shinyjs")
ui <- basicPage(
h2("The mtcars data"),
useShinyjs(),
DT::dataTableOutput("mytable")
)
server <- function(input, output) {
shinyInput <- function(FUN, len, id, ...) {
inputs <- as.character(FUN(paste0(id,'_', len), ...))
inputs
}
mtcarsx <- data.frame(mtcars)
for(myrow in 1:nrow(mtcarsx)){
mtcarsx[myrow,"newvar"]=toString(shinyInput(checkboxInput,toString(myrow),"chkbx",label="",value=FALSE,width=NULL))
}
observe({
shinyjs::disable("chkbx_1")
print(input$chkbx_2)
})
output$mytable = DT::renderDataTable({
DT::datatable(mtcarsx,
escape = FALSE,
selection = 'none',
rownames = TRUE,
extensions = c('FixedColumns'),
options = list(searching = FALSE,
ordering = FALSE,
autoWidth = TRUE,
scrollX = TRUE,
FixedColumns = list(leftColumns = c(2)),
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
))
})
}
shinyApp(ui, server)
I have problem with my Shiny App.
In my app I have many DT, Boxes, sometimes DT in Box so I decided to create functions to do my code more clean.
My function to create DT get data which I want to visualize
My function to create Box get title of box, information if is should be
collapsed, and UI - what box should contain (for example few
elements like
fluidRow(
column(6, uiOutput("aaa")),
column(6, uiOutput("bbb"))
)
I also created function to create DT in Box which is based on the previously described functions.
As I understand, the problem is the way data is transferred, but I cannot solve it.
I prepared example of functionality I would like to achieve but doesn't work.
library(shiny)
library(shinydashboard)
library(DT)
Create_DT <- function(dataSource){
datatable(
dataSource,
rownames = FALSE,
selection = 'none',
class = 'cell-border stripe',
extensions = 'Buttons',
options = list(
buttons = list('copy', 'print', list(extend = 'collection',buttons = c('csv', 'excel', 'pdf'),text = 'Download')),
dom = 'Bfrtip',
info = FALSE,
lengthChange = FALSE,
paging = FALSE,
searching = FALSE,
scrollX = TRUE,
columnDefs = list(list(className = 'dt-center', targets = "_all"))
)
) %>% formatStyle(colnames(dataSource),"white-space"="nowrap")
}
Create_Box <- function(description, collapsed, ui){
box(
width = 12,
title = strong(description),
color = "primary",
collapsible = TRUE,
collapsed = collapsed,
ui
)
}
Create_DTinBox <- function(description, collapsed, ui){
Create_Box(description, collapsed, ui)
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
uiOutput("result")
)
)
server <- function(input, output){
reactiveValues(iris = iris)
output$result <- renderUI({
Create_DTinBox(
description = "test",
collapsed = TRUE,
ui = column(6, offset = 3, Create_DT(reactiveValues$iris))
)
})
}
shinyApp(ui, server)
Any Idea how this app should look like to work fine while maintaining the structure of the function from the example?
You need to render the datatable. Also, your reactiveValues need to be defined properly. Try this
library(shiny)
library(shinydashboard)
library(DT)
Create_DT <- function(dataSource){
datatable(
dataSource,
rownames = FALSE,
selection = 'none',
class = 'cell-border stripe',
extensions = 'Buttons',
options = list(
buttons = list('copy', 'print', list(extend = 'collection',buttons = c('csv', 'excel', 'pdf'),text = 'Download')),
dom = 'Bfrtip',
info = FALSE,
lengthChange = FALSE,
paging = FALSE,
searching = FALSE,
scrollX = TRUE,
columnDefs = list(list(className = 'dt-center', targets = "_all"))
)
) %>% formatStyle(colnames(dataSource),"white-space"="nowrap")
}
Create_Box <- function(description, collapsed, ui){
box(
width = 12,
title = strong(description),
color = "primary",
collapsible = TRUE,
collapsed = collapsed,
ui
)
}
Create_DTinBox <- function(description, collapsed, ui){
Create_Box(description, collapsed, ui)
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
uiOutput("result")
)
)
server <- function(input, output){
rv <- reactiveValues(df = iris)
output$result <- renderUI({
Create_DTinBox(
description = "test",
collapsed = TRUE,
ui = column(8, offset = 3, renderDT(Create_DT(rv$df)))
)
})
}
shinyApp(ui, server)
This is my code, I want copy or print all, but it only print current page, thank you!
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput("tt")
)
server <- function(input, output, session) {
iris2 = head(iris, 20)
output$tt <- DT::renderDataTable(
iris2,
extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('copy', 'print')
)
)
}
shinyApp(ui, server)
The easiest way is to use the option server = FALSE.
output$tt <- renderDT({
datatable(
iris2,
extensions = 'Buttons',
options = list(
dom = 'Bfrtip',
buttons = c('copy', 'print')
)
)
}, server = FALSE)
I'm trying to do something like is seen here, but I'm having trouble figuring out how to do it in Shiny. As an example, it would be great to have a filter for mtcars of "efficient" (cars with at least 15 mpg) or "inefficient" (cars with less than 15 mpg).
Here is some code:
library(shiny)
library(DT)
ui <- shinyUI(
fluidPage(DT::dataTableOutput("mtcars_table"))
)
server <- shinyServer(function(input, output, session) {
output$mtcars_table <-
DT::renderDT({
DT::datatable(
mtcars,
options = list(dom = 'Pfrtip',
columnDefs = list(
list(
searchPanes = list(show = TRUE), targets = 1
),
list(
searchPanes = list(show = FALSE), targets = 2:11
))),
extensions = c('Select', 'SearchPanes'),
selection = 'none'
)
}, server = FALSE)
})
shinyApp(ui = ui, server = server)
Here is something to try based on the DataTables example with custom filtering options.
For the additional list options, I included a label like "Efficient", as well as a javascript function for value (rowData[1] should reference the first column, mpg).
library(shiny)
library(DT)
ui <- shinyUI(
fluidPage(DT::dataTableOutput("mtcars_table"))
)
server <- shinyServer(function(input, output, session) {
output$mtcars_table <-
DT::renderDT({
DT::datatable(
mtcars,
options = list(
dom = 'Pfrtip',
columnDefs = list(
list(
searchPanes = list(
show = TRUE,
options = list(
list(
label = "Efficient",
value = JS(
"function(rowData, rowIdx) { return rowData[1] >= 15; }"
)
),
list(
label = "Inefficient",
value = JS(
"function(rowData, rowIdx) { return rowData[1] < 15; }"
)
)
)
),
targets = 1
),
list(
searchPanes = list(show = FALSE), targets = 2:11
)
)
),
extensions = c('Select', 'SearchPanes'),
selection = 'none'
)
}, server = FALSE)
})
shinyApp(ui = ui, server = server)
I have a shiny app that is currently working and I would like to add the lenghtMenu option in the datatable. It seems it is not working. I am not so sure if I place it in the wrong place in the R code. Thank you for looking into this.
Here is my code:
output$sbirx.view <- DT::renderDataTable(
{
input$submit1
if (input$submit1==0) return()
isolate({
datatable(dataset.filter(),
rownames=FALSE,
extensions = c("FixedColumns", "FixedHeader", "Scroller"),
options = list(searching=TRUE,
autoWidth=TRUE,
scroller=TRUE,
scrollX=TRUE,
#scrollY="500px",
scrollY=paste0(factor*nrow(dataset.filter()),"px"),
fixedHeader=TRUE,
class='cell-border stripe',
lengthMenu = c(5, 30, 50), pageLength = 5,
fixedColumns=list(leftColumns=2,heightMatch='none')
)
)
})
})
According to your comments this might help you:
The factor you have to choose according to your needs i guess.
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
dataTableOutput('table')
)
)
),
server = function(input, output) {
output$table <- renderDataTable(iris,
rownames=FALSE,
extensions = c("FixedColumns", "FixedHeader", "Scroller"),
options = list(searching=TRUE,
# autoWidth=TRUE,
scroller=TRUE,
scrollX=TRUE,
scrollY=paste0(4*nrow(iris),"px"),
fixedHeader=TRUE,
class='cell-border stripe',
fixedColumns=list(leftColumns=2,heightMatch='none')
)
)
}
)