I'm trying to add an X scroll bar for datatable when it's wrapped around a fixedPanel. See the following example:
library(shiny)
library(shinydashboard)
library(DT)
ui <- function(request) {
dashboardPage(
skin = "black",
dashboardHeader(),
dashboardSidebar(disable = TRUE),
dashboardBody(
fluidRow(
uiOutput("table")
),
fluidRow(
DT::dataTableOutput("data2")
)
)
)
}
server <- function(input, output, session) {
output[["data"]] <-
DT::renderDataTable({
cbind(iris, iris, iris, iris, iris)[1, ]
},
selection = "none",
options = list(
searching = FALSE,
lengthChange = FALSE,
paginate = FALSE,
scroller = TRUE,
scrollX = TRUE
))
output[["table"]] <-
renderUI({
fixedPanel(
wellPanel(div(style = 'overflow-x: scroll', DT::dataTableOutput("data"))),
style = "z-index: 10;"
)
})
output[["data2"]] <-
DT::renderDataTable({
cbind(iris, iris, iris, iris, iris)
},
options = list(
scroller = TRUE,
scrollX = TRUE,
pageLength = 25
))
}
shinyApp(ui, server)
In the opposite I could use the shiny box object and the scrolling works but then I don't have this datatable on top of other ui (style = "z-index: 10;") that I need in my app:
output[["table"]] <-
renderUI({
box(div(style = 'overflow-x: scroll', DT::dataTableOutput("data")),
width = 12,
style = "z-index: 10;") # this line doesn't work
})
Is it possible to combine the two? I'd rather use fixedPanel than box, but I need both components from datatable: scrolling and being on top of other ui output.
See this post: https://stackoverflow.com/a/55574864/3439739
renderUI({
fixedPanel(
wellPanel(div(style = 'overflow-x: scroll', DT::dataTableOutput("data"))),
style = "z-index: 10; left:0; right:0; overflow-y:hidden; overflow-xy:auto"
)
})
seems to do the job.
Related
Is there any way, in R Shiny, to set the scroll bar from a datatable automatically to the right side when rendered (i.e. to the last column), instead of the left side as it is set by default ?
Base example :
library(shiny)
runApp(shinyApp(
ui = fluidPage(
DT::dataTableOutput("results", width = 300)
),
server = function(input, output, session) {
output$results <- DT::renderDataTable(
mtcars,
options = list(scrollX = TRUE, bPaginate = F)
)
}
))
library(shiny)
runApp(shinyApp(
ui = fluidPage(
tags$div(id = "parent",
DT::dataTableOutput("results", width = 300)
),
tags$style("
#parent {direction: rtl; max-height: 80vh; overflow: auto; margin: 0 auto}
#results {direction: ltr; float: left}")
),
server = function(input, output, session) {
output$results <- DT::renderDataTable(
mtcars,
options = list(scrollX = TRUE, bPaginate = F)
)
}
))
EDIT
Here is what you want:
library(shiny)
library(DT)
callback <- "
$('div.dataTables_scrollBody').animate({scrollLeft: '+=500'}, 1000);
"
runApp(shinyApp(
ui = fluidPage(
DTOutput("results", width = 300)
),
server = function(input, output, session) {
output$results <- renderDT(
datatable(
mtcars,
callback = JS(callback),
options = list(scrollX = TRUE)
)
)
}
))
1000 is 1000ms, this is the duration of the animation. I don't understand why +=300 is not enough.
Add this line in the ui: tags$style('#results {direction: rtl;}')
library(shiny)
runApp(shinyApp(
ui = fluidPage(
DT::dataTableOutput("results", width = 300),
tags$style('#results {direction: rtl;}')
),
server = function(input, output, session) {
output$results <- DT::renderDataTable(
mtcars,
options = list(scrollX = TRUE, bPaginate = F)
)
}
))
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)
I have a shiny app with a DT::DataTable element in which the first column is a row header and the second column contains data. How can I change the color of the first column to be white text on a black background? If found ways to change the column headers (section 4.3 here), but I how do I get the same effect applied to the first column?
Here's some example code showing a very simplified version of the table without the desired effect. I'm certain that adding something to the options list in the renderDataTable function will solve it, but I don't know what to add.
EDIT: Below is a solution suggested by #Stéphane Laurent, which answers my original question. However, it makes the change to all tables present on the app. In my modified code, below, the global change is shown, but how do I target just one of the two tables?
library(shiny)
library(DT)
CSS <- HTML(
"td.firstcol {color: white; background-color: black}"
)
ui <- fluidPage(
tags$head(
tags$style(CSS)
),
fluidRow(
column(3,
DTOutput(outputId = 'tbl')
),
column(3,
DTOutput(outputId = 'tbl2')
)
)
)
server <- function(input, output) {
output$tbl<- renderDT({
datatable(
data.frame(
Label = c('Label1', 'Label2', 'Label3', 'Label4'),
Data = c('Data1', 'Data2', 'Data3', 'Data4')
),
rownames = FALSE,
colnames = "",
options = list(
dom = 't',
columnDefs = list(
list(targets = 0, className = "firstcol")
)
)
)
})
output$tbl2 <- renderDT({
datatable(
data.frame(
Label = c('Label1', 'Label2', 'Label3', 'Label4'),
Data = c('Data1', 'Data2', 'Data3', 'Data4')
),
rownames = FALSE,
colnames = "",
options = list(
dom = 't',
columnDefs = list(
list(targets = 0, className = "firstcol")
)
)
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
library(shiny)
library(DT)
CSS <- HTML(
"td.firstcol {color: white; background-color: black}"
)
ui <- fluidPage(
tags$head(
tags$style(CSS)
),
fluidRow(
column(3,
DTOutput(outputId = 'tbl')
)
)
)
server <- function(input, output) {
output$tbl<- renderDT({
datatable(
data.frame(
Label = c('Label1', 'Label2', 'Label3', 'Label4'),
Data = c('Data1', 'Data2', 'Data3', 'Data4')
),
rownames = FALSE,
colnames = "",
options = list(
dom = 't',
columnDefs = list(
list(targets = 0, className = "firstcol")
)
)
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am using DT::datatable() in an R Shiny app to render a table with the header and first column fixed. My app has multiple tabs. I've tried two different approaches but both have bugs that make them unusable. I'm aware that these issues have been reported but I was wondering if anyone knows a workaround that would work in my case.
Approach # 1: scrollY
Here I set scrollY = "500px" in options. The problem is that when I change the number of entries to something other than 10, when I scroll to the bottom, the first column is misaligned with the other columns.
require(shiny)
require(DT)
shinyApp(
ui = tabsetPanel(
tabPanel(
title = "Tab 1",
fluidPage(
DTOutput("table1")
)
),
tabPanel(
title = "Tab 2",
fluidPage(
plotOutput("myPlot"),
DTOutput("table2")
)
)
),
server = function(input, output, session) {
output$table1 <- DT::renderDataTable({
myData <- cbind(iris, iris, iris, iris)
colnames(myData) <- paste0("Column ", 1:ncol(myData))
DT::datatable(
data = myData,
extensions = "FixedColumns",
rownames = F,
options = list(
scrollX = T,
scrollY = "500px",
fixedColumns = list(leftColumns = 1)
)
)
})
output$myPlot <- renderPlot({
plot(1:10, 1:10)
})
output$table2 <- DT::renderDataTable({
DT::datatable(iris)
})
}
)
Approach # 2: FixedHeader extension
Here I use the FixedHeader extension and set fixedHeader = T in options. This avoids the issue with approach # 1, but it has a more serious issue. The fixed header from the table appears on other tabs. In this example, if I scroll down the table on Tab 1, the headers remain fixed as expected, but when I switch to Tab 2 and scroll down, the fixed headers from the table on Tab 1 appear on Tab 2.
require(shiny)
require(DT)
shinyApp(
ui = tabsetPanel(
tabPanel(
title = "Tab 1",
fluidPage(
DTOutput("table1")
)
),
tabPanel(
title = "Tab 2",
fluidPage(
plotOutput("myPlot"),
DTOutput("table2")
)
)
),
server = function(input, output, session) {
output$table1 <- DT::renderDataTable({
myData <- cbind(iris, iris, iris, iris)
colnames(myData) <- paste0("Column ", 1:ncol(myData))
DT::datatable(
data = myData,
extensions = c("FixedColumns", "FixedHeader"),
rownames = F,
options = list(
scrollX = T,
fixedHeader = T,
fixedColumns = list(leftColumns = 1)
)
)
})
output$myPlot <- renderPlot({
plot(1:10, 1:10)
})
output$table2 <- DT::renderDataTable({
DT::datatable(iris)
})
}
)
Updating DT from version 0.19 to version 0.20 (released 11/15/2021) fixed the issue so approach #1 works correctly.
my server.R
shinyServer(function(input, output) {
output$table0 <- renderPrint({
confusionMatrix(sms_results$predict_type,
sms_results$actual_type, positive = "spam")
})
output$table <- renderDataTable({
table(sms_results$actual_type, sms_results$predict_type)
})
output$table1 <- renderDataTable({
CrossTable(sms_test_pred, sms_test_labels,
prop.chisq = FALSE, prop.t = FALSE, prop.r = FALSE,
dnn = c('predicted', 'actual'))
})
ui.R
shinyUI(fluidPage(
# Application title
titlePanel("Evaluating Model Performance"),
mainPanel(
plotOutput("plot"),
column(12,
dataTableOutput('table')
)
),
dataTableOutput('table0')
)
)
So, how to external view Crosstable and confusion matrix in shiny?
presuming all global variable loaded and library, runapp with this code
uir.r
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Machine Learning - Evaluating Model Performance"),
br(),br(),
sidebarLayout(
sidebarPanel(
h2("Davin", align = "center"),
h2("(>..<)", align = "center", style = "color:blue"),
img(src = "40.png", height = 150, width = 300,style="display: block; margin-left: auto; margin-right: auto;")
),
mainPanel(
plotOutput("plot"),
column(12,dataTableOutput('table')),
h2("Kappa Table", align = "center"),verbatimTextOutput('tabkapp'),
h2("xTable", align = "center"),verbatimTextOutput('table1'),
h2("ROC prob", align = "center"),
column(12,dataTableOutput('tables'))
))))
# column(12,tableOutput('tables'))
with verbatimtextoutput seems can show this server.r
shinyServer(function(input, output) {
output$table1 <- renderPrint({
ctab <- CrossTable(sms_test_pred, sms_test_labels,
prop.chisq = FALSE, prop.t = FALSE, prop.r = FALSE,
dnn = c('predicted', 'actual'))
})
output$tabkapp <- renderPrint({
tbkp <- Kappa(table(sms_results$actual_type, sms_results$predict_type))
tbkp
})
})
to web external view
output in web external view
output in web external view
any way to make it better ? its on ascii style (i think)... i want it like "datatableoutput"
i am okay