I am trying to format a SPECIFIC cell in a R shiny dashboard data table (using renderDT).
In the UI I use the following line of code:
DTOutput('dt_vols')
I also include this line in the UI as I dont want to display column names (not sure if that is relevant to the problem)
tags$head(tags$style(type = "text/css", "#dt_vols th {display:none;}")),
In the server code, I first create the following reactive 2x2 matrix (called dt_vols) - I've simplified the matrix in the example
dt_vols <- reactive({
mtx_vols <- matrix(1:4, nrow = 2, ncol = 2)
return(mtx_vols)
})
Then I render the DT table as follows:
output$dt_vols = renderDT(
dt_vols(), options = list(pageLength = 4, dom = 't', autoWidth = FALSE), rownames= FALSE,
formatStyle(dt_vols(), columns = 1, border = '1px solid #ddd')
)
It works until I add the formatstyle line. I am not sure how to get this line right and to get it pointing a specific cell (for example row1, column2). It seems to have a problem with the column argument. If i run the below I get the following error:
Warning: Error in : $ operator is invalid for atomic vectors
formatStyle expects a table object created from datatable() as input - you passed a matrix, which results in the error.
Please check the following:
library(shiny)
library(DT)
ui <- fluidPage(DTOutput('dt_vols'),
tags$head(tags$style(type = "text/css", "#dt_vols th {display:none;}")))
server <- function(input, output, session) {
dt_vols <- reactive({
mtx_vols <- matrix(1:4, nrow = 2, ncol = 2)
return(mtx_vols)
})
output$dt_vols = renderDT({
myTable <- datatable(dt_vols(),
options = list(pageLength = 4, dom = 't', autoWidth = FALSE),
rownames = FALSE
)
formatStyle(myTable, columns = 1, border = '10px solid #ddd')
})
}
shinyApp(ui, server)
Related
I have code to present a table in my R Shiny application. There is a character column where the value within a given cell can be a large number of characters. I use the following code to create the table:
output$data_table <- DT::renderDataTable({
req(data_go_go())
data_go_go()
},rownames = FALSE,filter = "top")
Then display the table with:
DT::dataTableOutput("data_table")
This code results in the following table:
You can see the string in the last column is causing the table to extend very far to the right. Is there a way I can prevent the column from displaying the entire string, and let it display the whole text if you hover over the particular cell?
Here is one option, borrowed heavily from this SO answer written by Stéphane Laurent (R shiny DT hover shows detailed table)
library(shiny)
library(DT)
g = data.frame(
TermID = c("GO:0099536", "GO:0009537", "GO:0007268"),
TermLabel = rep("synaptic signaling",times=3),
Reference= c(907,878,869),
Genes=c(78,74,72),
FoldEnrichment=c(13.69,17.11,14.22),
AdjPValue = c(0,0,0),
`Gene Info` = "Gene Information",
GenesDetail= replicate(paste0(sample(c(" ", letters),100,replace=TRUE), collapse=""),n=3)
)
callback <- c(
"table.on('mouseover', 'td', function(){",
" var index = table.cell(this).index();",
" Shiny.setInputValue('cell', index, {priority: 'event'});",
"});"
)
ui <- fluidPage(DTOutput("geneTable"))
server <- function(input, output, session){
output[["geneTable"]] <- renderDT({
datatable(g[,1:7],callback = JS(callback))
})
filteredData <- eventReactive(input[["cell"]], {
if(input[["cell"]]$column == 7){
return(g[input[["cell"]]$row + 1, "GenesDetail", drop = FALSE])
}
})
output[["tblfiltered"]] <- renderDT({
datatable(filteredData(),fillContainer = TRUE, options=list(dom='t'),rownames = F)
})
observeEvent(filteredData(), {
showModal(modalDialog(
DTOutput("tblfiltered"), size = "l",easyClose = TRUE)
)
})
}
shinyApp(ui, server)
The easiest way is to use the ellipsis plugin:
library(DT)
dat <- data.frame(
A = c("fnufnufroufrcnoonfrncacfnouafc", "fanunfrpn frnpncfrurnucfrnupfenc"),
B = c("DZDOPCDNAL DKODKPODPOKKPODZKPO", "AZERTYUIOPQSDFGHJKLMWXCVBN")
)
datatable(
dat,
plugins = "ellipsis",
options = list(
columnDefs = list(list(
targets = c(1,2),
render = JS("$.fn.dataTable.render.ellipsis( 17, false )")
))
)
)
In the below MWE code, I'm trying to insert a reactive value "periods" (generated from the slider input and as defined in the Server section) into the first row and first column of a user-input matrix that appears in the UI section. As you can see below, current setting for that first row/column of matrix is "1". I'd like it to instead be the same value as in "periods", and vary reactively with changes in periods effected by the user moving the slider at the top.
I'm sure this requires some proficiency with Reactivity/observeEvent that I don't yet have. I have fooled with these parameters to no avail.
Also see images below to better explain.
library(shiny)
library(shinyMatrix)
ui <- fluidPage(style = "margin-top:10px;",
column(3,
fluidRow(
sliderInput("periods", "Nbr of periods (X):",min = 1, max = 120, value = 60)),
fluidRow(
matrixInput(
"vector_input",
label = "Generate matrix:",
value = matrix(c(1, # << this 1 value needs to be reactive input$periods value
0.2),
1, 2, dimnames = list(NULL, c("Y", "Z"))),
rows = list(extend = TRUE, names = FALSE),
cols = list(extend = FALSE, names = TRUE, editableNames = FALSE),
class = "numeric"),
textOutput("selected_var")
)),
column(9,))
server <- function(input, output) {
output$selected_var <- renderText({paste("Number of periods: ", input$periods)})
vals <- reactiveValues()
observe({vals$periods <- input$periods})
vector_input <- reactive(input$vector_input)
} # close server
shinyApp(ui = ui, server = server)
This is what appears when running the code as drafted and what I am trying to do. In the second image I show the user changing the periods input from 60 to 20, and how I would like the 1st row in column Y of the matrix to reflect that change:
The updateMatrixInput function gives you a simple solution. Replace your current server function with
server <- function(input, output, session) {
output$selected_var <- renderText({paste("Number of periods: ", input$periods)})
observeEvent(input$periods, {
updateMatrixInput(session, "vector_input", value=matrix(c(input$periods, 0.2), 1, 2))
})
}
And I believe you get the functionality you want. Note the addition of the session parameter to the definition of the server function.
I have used the directions in this other question to create a datatable with buttons inside.
I added some formatting to the renderTable() call to highlight in yellow motivation == 3
output$data <- DT::renderDataTable(
datatable(df$data) %>% formatStyle(
'Motivation',
target = 'row',
backgroundColor = styleEqual(c(3), c('yellow'))
),
server = FALSE, escape = FALSE, selection = 'none'
)
This highlights the correct row:
The problem is that color formatting messes up with the buttons. I find the same problem when trying to format dates (datatable automatically shows them in UTC and I want them on local time). Are both formatting and buttons inside the table incompatible?
I get the following warning
renderDataTable ignores ... arguments when expr yields a datatable object; see ?renderDataTable
Here's the code for the app:
library(shiny)
library(DT)
shinyApp(
ui <- fluidPage(
DT::dataTableOutput("data"),
textOutput('myText')
),
server <- function(input, output) {
myValue <- reactiveValues(employee = '')
shinyInput <- function(FUN, len, id, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), ...))
}
inputs
}
df <- reactiveValues(data = data.frame(
Name = c('Dilbert', 'Alice', 'Wally', 'Ashok', 'Dogbert'),
Motivation = c(62, 73, 3, 99, 52),
Actions = shinyInput(actionButton, 5, 'button_', label = "Fire", onclick = 'Shiny.onInputChange(\"select_button\", this.id)' ),
stringsAsFactors = FALSE,
row.names = 1:5
))
output$data <- DT::renderDataTable(
datatable(df$data) %>% formatStyle(
'Motivation',
target = 'row',
backgroundColor = styleEqual(c(3), c('yellow'))
),
server = FALSE, escape = FALSE, selection = 'none'
)
observeEvent(input$select_button, {
selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
myValue$employee <<- paste('click on ',df$data[selectedRow,1])
})
output$myText <- renderText({
myValue$employee
})
}
)
You should look at this answer. Applying his advice to your problem, I move escape = FALSE, selection = 'none' in datatable(df$data) and it works (you need to remove server = FALSE, which is not accepted in datatable):
output$data <- DT::renderDataTable(
datatable(df$data, escape = FALSE, selection = 'none') %>% formatStyle(
'Motivation',
target = 'row',
backgroundColor = styleEqual(c(3), c('yellow'))
)
)
In case the answer I refer above is deleted (don't know if it can be), I also put it here:
You are getting this error because you are returning a DT::datatable AND you are also specifying filter='top' as one of the ... arguments to DT::renderDataTable. As the message is trying to tell you ... arguments are ignored since you are returning a DT::datatable. This is because the ... arguments are intended to be passed through to the DT:datatable constructor.
Either move filter='top' inside the DT::datatable constructor or return a data.frame and the filter='top will be used when DT::renderDataTable constructs a DT::datatable with your specified data.frame.
I've been struggling for a few hours with such a task:
in R Shiny I need to display a table which contains of a single column of integers with the definite (relatively large) spacing between rows.
There is the spacing argument in the renderTable() function, but even setting it to the biggest value 'l' is still not enough for my purpose.
I've tried to do that using xtable and taking into account the example from Adjust row height xtable R , but with no result (I don't know CSS).
The most natural way I've found in the web is to use DT package along with the Scroller extension, but the following code still gives no results
ui.R:
fluidPage(
sidebarLayout(
sidebarPanel(
dataTableOutput('dtable', width = '50%') # argument 'height' does not work here
),
mainPanel()
)
)
server.R:
library(shiny)
library(DT)
function(input, output) {
output$dtable <- DT::renderDataTable({
data.frame(SSD = c(2, 17, 19, 35))
},
extensions = 'Scroller',
options = list(
dom = 't',
ordering = FALSE,
scroller = list(rowHeight = 100)
)
)
}
The output of that gives only column name (what is wrong??), but without Scroller extensions it displays the expected table - of course with too small spacing...
You want to use the rowCallback option and attach a style to each row:
server.R
library(shiny)
library(DT)
function(input, output) {
output$dtable <- DT::renderDataTable({
data.frame(SSD = c(2, 17, 19, 35))
},
options = list(
dom = 't',
ordering = FALSE,
rowCallback = JS("function(r,d) {$(r).attr('height', '100px')}")
)
)
}
Note that this may result in increased render time as the number of rows raises
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))