I have simple Shiny app with DT table
library(shiny)
library(DT)
iris2 = head(iris, 30)
server <- function(input, output) {
output$tb <-DT::renderDataTable(server=FALSE,{
datatable(
iris2,
colnames = c(colnames(iris2)), extensions = 'RowReorder',
options = list(rowReorder = TRUE))
})
}
ui <- fluidPage(dataTableOutput('tb', width = '200px', height = '200px'))
shinyApp(ui, server)
However, when I try to adjust the table row only the first column changes the position. It is probably related to the configuration of the ReorderRow, as described here. Unfortunately, I don't know how to implement JavaScript into the Shiny app, especially datatable options.
One has to add the row names and sort the table on them, as mentioned in the github issue. The working solutions requires only adding order = list(list(0, 'asc')) in the DT options:
library(shiny)
library(DT)
iris2 = head(iris, 30)
server <- function(input, output) {
output$tb <-DT::renderDataTable(server=FALSE,{
datatable(
iris2,
colnames = c(colnames(iris2)), extensions = 'RowReorder',
options = list(order = list(list(0, 'asc')), rowReorder = TRUE))
})
}
ui <- fluidPage(dataTableOutput('tb', width = '200px', height = '200px'))
shinyApp(ui, server)
Related
Let's say that I have a shiny app displaying a data table like the following:
library(shiny)
library(tidyverse)
library(datasets)
library(DT)
data<- as.data.frame(USArrests)
#data<- cbind(state = rownames(data), data)
ui <- fluidPage(
dataTableOutput("preview")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$preview<- renderDataTable(
datatable(data, options = list(searching = T, pageLength = 10, lengthMenu = c(5,10,15, 20), scrollY = "600px", scrollX = T ))
)
}
# Run the application
shinyApp(ui = ui, server = server)
Let's say I then type in "Iowa" into the search box. I would like to save that filtered datatable into a seperate dataframe within the app. I would like it to be dynamic as well so if I typed "Kentucky", it would save Kentucky's filtered data into the dataframe instead. Is there a way to do this?
NOTE: this is a DT datatable
Maybe this type of solution. It is possible to add further conditions like checking the first letter in upper case, but the main idea is to check each column and search for the pattern entered inside the datatable searchbox. This may or may not result in more than one dataset to print (depending if the string is partially matched in multiple columns (this is also solvable with rbind function.
code:
library(shiny)
library(tidyverse)
library(datasets)
library(DT)
data <- as.data.frame(USArrests)
data <- cbind(state = rownames(data), data)
ui <- fluidPage(
dataTableOutput("preview"),
tableOutput('filtered_df')
)
# Define server logic required to draw a histogram
server <- function(input, output) {
df <- reactiveValues()
output$preview<- renderDataTable(
datatable(data, options = list(searching = T, pageLength = 10, lengthMenu = c(5,10,15, 20), scrollY = "600px", scrollX = T ))
)
observeEvent(input$preview_search, {
searched_string <- map(data, ~str_subset(.x, input$preview_search)) %>% discard(~length(.x) == 0)
df$filtered <- syms(names(data)) %>%
map(~ filter(data, !!.x %in% searched_string)) %>%
discard(~ nrow(.x) == 0)
})
output$filtered_df <- renderTable({df$filtered})
}
# Run the application
shinyApp(ui = ui, server = server)
I am developing a shiny app where user can select multiple columns in a big dataset to create a subset of this dataset. I use the package DT to render the table nicely in the shiny app.
I previously used version 0.2 of DT package where the following code was working :
library("DT")
library("shiny")
ui <- fluidPage(
DT::dataTableOutput('table1'),
DT::dataTableOutput("table2")
)
server <- function(input, output) {
output$table1 <- DT::renderDataTable({
datatable(mtcars, extensions = 'Select', selection = 'none', options = list(ordering = FALSE, searching = FALSE, pageLength = 25, select = list(style = 'os', items = 'column')),
callback = JS(
"table.on( 'click.dt', 'tbody td', function (e) {",
"var type = table.select.items();",
"var idx = table[type + 's']({selected: true}).indexes().toArray();",
"var DT_id = table.table().container().parentNode.id;",
"Shiny.onInputChange(DT_id + '_columns_selected', idx);",
"})"
))
})
output$table2 <- DT::renderDataTable({
subset_table <- mtcars[,input$table1_columns_selected]
datatable(subset_table)
})
}
shinyApp(ui = ui, server = server)
Unfortunately, this code is not working anymore (I am now under version 0.4). The input$table1_columns_selected does not render the indices of the selected columns.
According to this https://rstudio.github.io/DT/shiny.html there is now a functionnality to select multiples rows, but I can't figure out how to do the same with columns.
Any idea ?
Thank you very much for your help !
I am not sure why you need to use the callback argument to do this. Here's a simplified approach -
library("DT")
library("shiny")
ui <- fluidPage(
DT::dataTableOutput('table1'),
DT::dataTableOutput("table2")
)
server <- function(input, output) {
output$table1 <- DT::renderDataTable({
datatable(mtcars, extensions = 'Select', selection = list(target = "column"), options = list(ordering = FALSE, searching = FALSE, pageLength = 25))
})
output$table2 <- DT::renderDataTable({
subset_table <- mtcars[, input$table1_columns_selected, drop = F]
datatable(subset_table)
})
}
shinyApp(ui = ui, server = server)
Note the change in the datatable arguments in output$table1. Hope this is what you were looking for.
I have tested your code and its working fine for me (see picture below) and i am also using DT package version 0.4.
So my guess is that, its not DT package problem but something else in your global configuration that is causing the issue.
I'm looking to customized the output of a data table in one of my shiny applications. I'd like to only keep the "next page" button on the bottom of the data table, but cannot figure out how to do so. I know you can customize the output using options = list(dom = ...) but cannot figure out how to produce the output I would like. Is this something that will only be able to be accomplished using java script? Example below, where Previous 1, 2, etc. is what I would like to keep. Thank you!
library(DT)
library(shiny)
ui <- fluidPage(
dataTableOutput(outputId = "dat")
)
server <- function(input, output, session) {
tb = iris
tb = datatable(tb, list(pageLength = 10))
output$dat = renderDataTable({
tb
})
}
shinyApp(ui, server)
To learn about all datatable options see this (datatables documentation). The option you are interested in is pagingType. So just do
library(DT)
library(shiny)
ui <- fluidPage(
DT::dataTableOutput(outputId = "dat")
)
server <- function(input, output, session) {
tb = iris
tb = DT::datatable(tb, list(pageLength = 10,pagingType = 'simple'))
output$dat = DT::renderDataTable(
{tb}
)
}
shinyApp(ui, server)
The answer is probably obvious but i've been looking into using the backgroundColor attribute in the DT package to change the color of the full row instead of only the value that i use to select the row and I didn't manage to do it.
So basically in my Shiny app, I have a DataTable output in my server file where i wrote this :
output$tableMO <- DT::renderDataTable({
datatable(DFSurvieMO,
options =
list( displayStart= numerMO()-2,
pageLength = 15,
lengthChange = FALSE, searching =FALSE),rownames= FALSE) %>% formatStyle(
c(1:2),
backgroundColor =
if(numerMO()>1) {
styleInterval(c(DFSurvieMO[,1][numerMO()-1],DFSurvieMO[,1][numerMO()]), c('blank','lightblue', 'blank'))
}
else {
styleInterval(DFSurvieMO[,1][numerMO()], c('lightblue', 'blank'))}
)
})
And what i get in my app is a DataTable with only a single cell colored. I tried using target = 'row' but either I didn't put it in the right place or it does not work. So how can i get it to color the whole row ?
Thank You.
You can write some custom JS function using rowCallback. Below I have written a reactive which will listen to the slider and if the slider values in the mtcars dataset are bigger than your value it will repaint the row. Note that the aData[1] is the column called cyl within the mtcars dataset.
Apologies for not using your code as I wanted to make a more generic example
rm(list = ls())
library(shiny)
library(DT)
ui <- basicPage(
sliderInput("trigger", "Trigger",min = 0, max = 10, value = 6, step= 1),
mainPanel(DT::dataTableOutput('my_table'))
)
server <- function(input, output,session) {
my_callback <- reactive({
my_callback <- 'function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {if (parseFloat(aData[1]) >= TRIGGER)$("td", nRow).css("background-color", "#9BF59B");}'
my_callback <- sub("TRIGGER",input$trigger,my_callback)
my_callback
})
output$my_table = DT::renderDataTable(
datatable(mtcars,options = list(
rowCallback = JS(my_callback()),searching = FALSE,paging = FALSE),rownames = FALSE)
)
}
runApp(list(ui = ui, server = server))
I am unable to control the width of a datatable I have added to a shiny app using the function dataTableOutput(). I've tried to use the width parameter within the function but it changes nothing in the output and there is no error ~ it's not telling me that it's ignoring the width parameter.
library(shiny)
library(shinythemes)
ui <- fluidPage(theme = shinytheme("Spacelab"),
fluidRow(
column(6,dataTableOutput(outputId = "table")),
column(6,p(textOutput("para")))
)
)
server <- function(input, output){
df <- as.data.frame(matrix(0, ncol = 15, nrow = 20))
output$table <- renderDataTable({df})
output$para <- renderText({
text <- rep(x = "Hello World",1000)
})
}
shinyApp(ui = ui,server = server)
dataTableOutput does not have an argument width. You can use column within a fluidRow with argument width, supplying an integer between 1 and 12.
library(shinythemes)
ui <- fluidPage(theme = shinytheme("Spacelab"),
fluidRow(
column(
dataTableOutput(outputId = "table"), width = 6)
)
)
server <- function(input, output){
df <- as.data.frame(matrix(0, ncol = 20, nrow = 5))
output$table <- renderDataTable({df},
options = list(scrollX = TRUE))
}
shinyApp(ui = ui,server = server)
Options from the JavaScript library DataTable can be passed directly via renderDataTable argument options. For example, setting scrollX to be true allows tables to scroll.
If you use the "DT" R package, and the respective DT::dataTableOutput and DT::renderDataTable, you can use a "width" option with those calls, which apparently can be either a % (e.g. width = "100%") or pixels (width = 300) which should get you the control you want.
See:
https://rstudio.github.io/DT/shiny.html
Note from that page:
Important: Be sure to use the DT:: prefix when calling dataTableOutput
and renderDataTable so that the DT versions of these functions are
guaranteed to be called, instead of the deprecated Shiny versions. If
you make sure to library(DT) after library(shiny), normally the DT
versions should just override the shiny versions if you do not use the
DT:: prefix (when in doubt, use this prefix, until we completely
remove these functions from shiny)