Pre-select rows of a dynamic DT in shiny
To allow reactive on selected evaluation, you need to call datatable from within renderDataTable:
output$x1 = renderDataTable(
datatable( data(),
selection = list(mode = 'multiple', selected = all_rows())),
server = FALSE)
Dynamically pre-select row using DT in shiny
It is written in the other post to wrap it within datatable() then it works :)
output$myTable <- DT::renderDataTable ({
datatable(
mtcars[,1:5],
rownames = T,
filter = "top",
selection = list(mode='multiple',
selected = selRows$row)
)
})
How to pre-select rows in Shiny DT datatables
This feature has been added to DT (>= 0.1.3). Examples:
library(shiny)
if (packageVersion('DT') < '0.1.3') devtools::install_github('rstudio/DT')
library(DT)
shinyApp(
ui = fluidPage(
fluidRow(
h1('Client-side processing'),
DT::dataTableOutput('x1'),
h1('Server-side processing'),
DT::dataTableOutput('x2')
)
),
server = function(input, output, session) {
output$x1 = DT::renderDataTable(
iris, server = FALSE,
selection = list(mode = 'multiple', selected = c(1, 3, 8, 12))
)
output$x2 = DT::renderDataTable(
iris, server = TRUE,
selection = list(mode = 'multiple', selected = rownames(iris)[c(1, 3, 8, 12)])
)
}
)
R Shiny - Pre-selection of rows in Select extension for Datatables
There's no select.rows option. You can use a callback:
output[["table"]] <- renderDT({
datatable(
dat,
callback = JS("table.rows([0,1,2]).select();"),
options = list(select = list(
style = "multi",
selector = "td:not(.notselectable)")),
extensions = "Select", selection = "none")
}, server = FALSE)
Shiny DT - Select row after selected row by using a button
I have a feeling (could be wrong) that this might be a case of XY Problem trap i.e. you are asking for help with your attempt at solving a problem rather than with the underlying problem itself. If this is the case, you are better off asking another question explaining your core requirement which might yield a simpler overall solution. Although my solution is pretty straightforward the whole thing just feels like an unnecessary complication.
Anyways, here's one way to do this. You can get the current order of rows on the datatable using input$tableId_rows_all which gives the indices of rows on all pages (after the table is filtered by the search strings). output$test shows this order in real-time. Now you just need to cycle through this order every time user hits next_doc action button.
This solution will work even if you reorder your rows or manually change selected row.
library(shiny)
library(DT)
ui <- tagList(
ui <- basicPage(
h2("My Table"),
DT::dataTableOutput("DT_show_docs"),
textOutput("printScore"),
actionButton("next_doc", "Next Document"),
verbatimTextOutput("test")
)
)
# Server
server <- function(input, output, session) {
doc_overview <- reactive({
df <- data.frame(Doc_ID = seq(1,12),
Filename = paste0("File_",seq(1,12)),
Score = sample(1:10,12,replace=TRUE),
Approved = rep(c("No", "Yes"), times = c(5,7)),
Date = rep(seq(as.Date("2018/01/01"), as.Date("2018/1/10"), "days"), length.out=12))
return(df)
})
output$DT_show_docs <- renderDataTable({
DT::datatable(doc_overview(),
options = list(
searching = FALSE,
order = list(list(3, 'desc'))),
selection = "single")
})
row_index <- reactiveValues(index = 1)
observe({ # reset row_index when you manually select any row
row_index$index <- which(input$DT_show_docs_rows_selected == input$DT_show_docs_rows_all)
})
DT_show_docs_proxy <- dataTableProxy("DT_show_docs")
output$printScore <- renderText({
row <- input$DT_show_docs_rows_selected
text <- doc_overview()[row, "Filename"]
})
observeEvent(input$next_doc, {
# Function to select next row/document from datatable. When the button is clicked,
# and the first row is selected at this moment, I want to select/print the second
# row and so on.
req(input$DT_show_docs_rows_selected) # must select some row before using next_doc button
row_order <- input$DT_show_docs_rows_all # gives current order of rows
row_index$index <- isolate(row_index$index) + 1 # cycles throw the order one by one when you click next_button
selectRows(DT_show_docs_proxy, selected = row_order[row_index$index]) # selects the row of current index
})
output$test <- renderPrint({
input$DT_show_docs_rows_all # shows the order of rows in real time
})
}
# app
shinyApp(ui = ui, server = server)
R Shiny - Pre-selecting the row and page of a datatable inside a modalDialog
I guess this is what you're looking for. Your first problem was that you had to convert rv$selectedRow to numeric. Secondly it you were re-rendering your datatable everytime you pressed the "view" button. And thirdly you didn't do anything with your selectInput ("data").
I transformed rv$selectedRow to a numeric, moved your showModal to the ui and created an observer for your selectInput. In addition, I wrapped your datafarme in the datatable function, which I think is a bit more convenient.
Working example:
library(shiny)
library(DT)
library(shinyBS)
datasets = data.frame(cbind(id = seq_len(4), name = c('iris', 'mtcars', 'satellite', 'credit')))
# UI ----------------------------------------------------------------------
ui = fluidPage(
selectInput('data', 'Select dataset:', choices = datasets$id),
actionButton('view', 'View details'),
tags$head(tags$style("#df_popup .modal-footer{ display:none}
#df_popup .modal-header .close{display:none}")),
bsModal("df_popup", title='Available datasets', trigger='view',
tags$b('Click on a row to select a dataset.'),
br(),
br(),
DT::dataTableOutput('dfs'),
column(12, align='right',
modalButton('Cancel'),
bsButton('select', 'Select')
)
)
)
# SERVER ------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {
rv = reactiveValues(selectedRow = NULL, selectedPage = NULL)
# Rendering the DT - pre-selection of row not working
output$dfs <- renderDT({
print(paste("selectedRow on 'renderDT':", rv$selectedRow))
datatable(datasets, options = list(
# displayStart = selectedPage,
pageLength = 2
),
filter = 'top',
selection = list(mode = 'single', selected=c(as.numeric(rv$selectedRow))),
rownames = F)
},
)
# Saving the selected row and updating the selectInput
observeEvent(input$select, {
rv$selectedRow = req(input$dfs_rows_selected)
print(paste("selectedRow on 'Select':", rv$selectedRow))
updateSelectInput(session = session, inputId = 'data', selected = datasets[rv$selectedRow, 1])
toggleModal(session, 'df_popup')
})
observeEvent(input$data, {
rv$selectedRow = input$data
print(paste("selectedRow on 'data':", rv$selectedRow))
})
})
shinyApp(ui, server)
Shiny with DT Select rows, keep cell color
You can define a CSS class for the background color (red below) and add it to the desired cells with a rowCallback. Then add this CSS:
.red {
background-color: #e34755;
}
table.dataTable tr.selected td.red {
background-color: #e34755 !important;
}
The app:
library(shiny)
library(DT)
rowCallback <- c(
"function(row, dat, displayNum, index){",
" if(dat[1] < 5){",
" $('td:eq(1)', row).addClass('red');",
" }",
"}"
)
css <- "
.red {
background-color: #e34755;
}
table.dataTable tr.selected td.red {
background-color: #e34755 !important;
}
"
ui <- fluidPage(
tags$head(
tags$style(HTML(css))
),
title = 'Select Table Rows',
fluidRow(
column(6, DTOutput('x1')),
column(6, plotOutput('x2', height = 500))
)
)
server <- function(input, output) {
output$x1 <- renderDT({
datatable(cars,
options = list(
columnDefs = list(list(targets = 3,visible = FALSE)),
rowCallback = JS(rowCallback)
)
)
})
# highlight selected rows in the scatterplot
output$x2 <- renderPlot({
s <- input$x1_rows_selected
par(mar = c(4, 4, 1, .1))
plot(cars[ ,-3])
if (length(s)) points(cars[s, , drop = FALSE], pch = 19, cex = 2)
})
}
shinyApp(ui, server)
R Shiny DataTable dynamic row selection with filtered data
Figured it out myself:
to get rid of the selected row dependancy I splitted the observer() into two observeEvent() functions, one for selected IDs and one for setting the filter on the selected IDs.
library(shiny)
library(DT)
options(shiny.reactlog=TRUE)
shinyApp(
ui = fluidPage(
tags$span(icon('toggle-off'), style = "display: none;") ,
tags$head(tags$style(".fa-toggle-off {color:#9b1f23}")),
tags$head(tags$style(".fa-toggle-on {color:#a2ad00}")),
selectizeInput("choose_grp","choose grp", choices = c("No Filter" = "", 1:20), multiple = T),
DT::dataTableOutput('x1'), verbatimTextOutput('x2'), verbatimTextOutput('x3')),
server = function(input, output, session) {
# a sample data frame
N <- 100
res = data.frame(
v1 = paste0('test', 1:N),
v2 = ifelse(!duplicated(rep(1:20,each = 5)), rep(1:20,each = 5), NA),
v2_grp = rep(1:20,each = 5),
r_g = rep('r', N),
r_g_grp = rep('r', N),
v3 = ifelse(!duplicated(rep(1:20,each = 5)),
as.character(icon('toggle-off')), NA),
ID = 1: N,
stringsAsFactors = FALSE
)
# reactive values to store selected rows
sel_all <- reactiveValues(all = data.frame(ID = res$ID, sel = rep(F,N)))
save_sel_vals <- reactiveValues(a = c(), d = c())
# observer selected rows/groups
observeEvent(input$x1_cell_clicked$row,{
res_old <- res
if (is.null(input$choose_grp)){
res <- res
} else if (any(input$choose_grp != "")){
res <- res[res$v2_grp %in% as.numeric(input$choose_grp),]
}
a_sel <- sel_all$all$sel[sel_all$all$ID %in% res$ID]
a <- data.frame(IDs = res$ID,
sel = a_sel)
if (is.null(input$x1_cell_clicked$row)) {
a[, 'sel'] <- F
} else if (isTRUE(a[input$x1_cell_clicked$row, 'sel'])){
a[input$x1_cell_clicked$row, 'sel'] <- F
} else if (!isTRUE(a[input$x1_cell_clicked$row, 'sel'])){
a[input$x1_cell_clicked$row, 'sel'] <- T
}
sel_all$all$sel[sel_all$all$ID %in% a$IDs] <- a$sel
isolate(a2 <- sel_all$all$sel[sel_all$all$ID %in% a$IDs])
isolate(d <- input$x1_cell_clicked$row -1)
save_sel_vals$a <- a2
save_sel_vals$d <- d
}, ignoreNULL = TRUE)
# observer IDs of filtered data
observeEvent(input$choose_grp, {
res_old <- res
if (is.null(input$choose_grp)){
res <- res
} else if (any(input$choose_grp != "")){
res <- res[res$v2_grp %in% as.numeric(input$choose_grp),]
}
a_sel <- sel_all$all$sel[sel_all$all$ID %in% res$ID]
a <- data.frame(IDs = res$ID,
sel = a_sel)
isolate(a2 <- sel_all$all$sel[sel_all$all$ID %in% a$IDs])
save_sel_vals$a <- a2
}, ignoreNULL = FALSE)
# render the table containing shiny inputs
output$x1 = DT::renderDataTable({
if (is.null(input$choose_grp)){
res <- res
} else if (any(input$choose_grp != "")){
res <- res[res$v2_grp %in% as.numeric(input$choose_grp),]
}
sel_rows <- save_sel_vals$a
res$r_g[sel_rows] <- 'g'
res$r_g_grp <- ifelse(res$v2_grp %in% res$v2_grp[sel_rows], 'g', 'r')
res$v3 <- ifelse(!is.na(res$v3), ifelse(
(res$v2_grp %in% res$v2_grp[sel_rows]), as.character(icon('toggle-on')), as.character(icon('toggle-off'))),
NA)
datatable(res, extensions = c('Scroller'), escape = F,
selection = list(mode = "multiple", target= 'row', selected = (1:nrow(res))[sel_rows]),
options = list(scrollX = T,
autoWidth = F,
deferRender = TRUE,
scrollY = 500,
scroller = T,
paging = T
), callback = JS(paste0('table.row(',save_sel_vals$d,').scrollTo(false);'))
) %>%
formatStyle(
columns = c("v3"), valueColumns = 'r_g_grp',
target = 'cell',
backgroundColor = styleEqual(c('r','g'), c('#e1a593','#d8dea8'))
)
} , server = F
)
# print the values of inputs
output$x2 = renderPrint({
data.frame(selected_row = input$x1_rows_selected,
selected_grp = res$v2_grp[input$x1_rows_selected]
)
})
output$x3 = renderPrint({
sel_all$all[1:10,]
})
}
)
Shiny DT::datatable - Change table content when lines are selected
You almost got it right! You have to put wrap your table with datatable:
output$mytable <- DT::renderDataTable(
datatable(cbind(mymtcars, v=rowSelect()),
options = list(dom = "t",ordering = FALSE),
selection = list(mode = "multiple",
selected =(1:5)[rowSelect()],
target = "row"))
)
Related Topics
Extract English Words from a Text in R
Solve Homogenous System Ax = 0 for Any M * N Matrix a in R (Find Null Space Basis for A)
Counting the Number of Values Greater Than 0 in R in Multiple Columns
Function for Polynomials of Arbitrary Order (Symbolic Method Preferred)
How to Edit Column Names in Datatable Function When Running R Shiny App
Visual Bug When Changing Robinson Projection's Central Meridian with Ggplot2
Code Folding for Individual Chunks in R Markdown
Usage of Dot/Period in R Functions
R: "Make" Not Found When Installing a R-Package from Local Tar.Gz
R Table Function - How to Remove 0 Counts
How to Annotate Ggplot2 Qplot Outside of Legend and Plotarea? (Similar to Mtext())
How to Display Line Numbers for Code Chunks in Rmarkdown HTML and PDF
How to Pass R Variable into SQLdf
Total Mean & Mean by Groups in R with Dplyr
How to Pass Multiple Group_By Arguments and a Dynamic Variable Argument to a Dplyr Function