Is there a way to highlight a row based on the search criteria in a data table in R Shiny??
On using Data table, we get the search bar on the top that filters the rows accordingly.. I want to highlight the part in the row which is matching the search criteria.
Thank you.
How to do datatable highlighting in R. The shiny implementation should be straight forward.
library(DT)
mtcars2 = head(mtcars[, 1:5], 20)
mtcars2$model = rownames(mtcars2)
rownames(mtcars2) = NULL
options(DT.options = list(pageLength = 5))
# global search
datatable(mtcars2, options = list(searchHighlight = TRUE, search = list(search = 'da')))
See here: R Studio DT Explanation
EDIT:
Small shiny example
server.R:
shinyServer(function(input, output) {
output$testme <- renderDataTable({
mtcars2 = head(mtcars[, 1:5], 20)
mtcars2$model = rownames(mtcars2)
rownames(mtcars2) = NULL
options(DT.options = list(pageLength = 5))
# global search
datatable(mtcars2, options = list(searchHighlight = TRUE, search =
list(search = 'da')))
})
})
ui.R:
library(shiny)
library(DT)
shinyUI(fluidPage(
DT::dataTableOutput(outputId = "testme")
)
)
Related
Was hoping someone can help sort a column by absolute value in a Shiny app in the datatable() function? Tried multiple methods (dplyr, arrange, etc) but for some reason it's not clicking with me. It's a three column datatable, trying to sort column 2/val2 by the absolute value.
table_stage <- reactive ({
tbl <- datatable(tabledat(),
rownames = FALSE,
options = list(
columnDefs = list(list(className = "dt-center", targets = 2)),
order = list(list(2, "asc"))
)) %>%
formatRound("val", 2) %>%
formatRound("val2", 2)
return(tbl)
})
This is definitely wrong, did not work at all.
table_stage <- reactive ({
tbl <- datatable(tabledat(),
rownames = FALSE,
options = list(
columnDefs = list(list(className = "dt-center", targets = 2)),
order = list(list((arrange(abs(2)), "desc"))
)) %>%
formatRound("val", 2) %>%
formatRound("val2", 2)
return(tbl)
})
The code runs without problems when using dataTableOutput in a UI context and renderDataTable in the Server function.
This script works with order by mpg (the first column in the example table) and if mtcars is a data frame, it works too.
library(data.table)
library(shiny)
library(dplyr)
library(DT)
if (interactive()) {
ui <- fluidPage(
dataTableOutput("table")
)
#optional test data
tabledat <- data.table::as.data.table(mtcars)
server <- function(input, output) {
output$table <-
renderDataTable({
tabledat %>%
datatable(
rownames = FALSE,
options = list(
columnDefs = list(list(className = "dt-center", targets = 2)),
order = list(list(1, "asc"))
)
)
},
)
}
shinyApp(ui, server)
}
You need to use the render option:
library(DT)
js <- "
function(data, type, row, meta) {
if(type === 'sort') {
data = Math.abs(data);
}
return data;
}
"
mydata <- as.data.frame(
matrix(runif(40, -10000, 10000), nrow = 10, ncol = 4)
)
datatable(
mydata,
options = list(
"columnDefs" = list(
list(
"targets" = 1,
"render" = JS(js)
)
)
)
)
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 )")
))
)
)
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 trying to add an option for DataTable in Shiny using some of the expanded options that are found in DataTables.
I want to implement the opetion SearchBuilder.columns so that the search box can only search in the "id" column
https://datatables.net/reference/option/searchBuilder.columns
How does one implement this option into R Shiny? What is the syntax?
The code below did not work.
output$table_pred <- DT::renderDataTable(df, options = list(pageLength =5), searchBuilder.columns = df$id)
Here is the full code:
library(shinythemes)
library(shiny)
library(DT)
setwd("c:/Desktop/datasets/")
df <- read.csv("prediction_data.csv")
df2 <- read.csv("test_data.csv")
ui <- fluidPage(
fluidRow(
column(12,
dataTableOutput('table_pred')
)
),
fluidRow(
column(12,
dataTableOutput('table_test')
)
)
)
server <- function(input, output, session) {
#rendering the datatable for rediction data
output$table_pred <- DT::renderDataTable(df, options = list(pageLength =5), searchBuilder.columns = df$id)
output$table_test <- DT::renderDataTable(df2,options = list(pageLength =10))
}
shinyApp(ui, server)
Awesome extension!
It is not available in the 'DT' package. Here is how you can use it.
Firstly, download the JavaScript file and the CSS file.
Then, here is the R code:
library(DT)
library(htmltools)
dat <- data.frame(
x = c(0, 1, 2, 3, 4),
id = c("sub0", "sub0", "sub1", "sub1", "sub2")
)
dtable <- datatable(
dat,
options = list(
dom = "Qlfrtip",
searchBuilder = list(
columns = list(2) # 2 is the index of the 'id' column
)
)
)
path_to_searchBuilder <- # path to the folder containing the two searchBuilder files
normalizePath("~/Work/R/DT/searchBuilder/")
dep <- htmlDependency(
name = "searchBuilder",
version = "1.0.0",
src = path_to_searchBuilder,
script = "dataTables.searchBuilder.min.js",
stylesheet = "searchBuilder.dataTables.min.css",
all_files = FALSE
)
dtable$dependencies <- c(dtable$dependencies, list(dep))
dtable
I want to select data after putting in some keywords. I want to keep repeating that process of select data after putting in some keywords.
For example, I want to select Mazda cars and Maserati cars. I don't want to put in Mazda keywords and Maserati keywords together to get the data. I want to key in the Mazda keyword and select data and then delete Mazda and key in the Maserati keyword in the search box above the data.
The problem with my code is if I delete Mazda and key in Maserati, the selected row before this is deleted.
Here is my code:
library(shiny)
library(tidyverse)
library(readxl)
library(DT)
library(shinydashboard)
mtcars_df <- rownames_to_column(mtcars)
names(mtcars_df)[1] <- "Name"
mtcars_df$Keywords <- ""
for (i in 1:nrow(mtcars_df)){
temp1 <- strsplit(as.character(tolower(str_squish(mtcars_df$Name[i])))," ")[[1]]
for (j in 1:length(temp1)){
mtcars_df$Keywords[i] <- paste0(mtcars_df[i, "Keywords"], trimws(gsub(",$","",temp1[j])), ", ")
}
}
keywordschoice <- sort(trimws(unique(tolower(gsub(",$","",unlist(strsplit(mtcars_df$Keywords, ",")))))))
## create the interactive
ui <- fluidRow(column(9, offset = 1,
selectizeInput(inputId = "keywords", label = "Select keyword(s)", choices = keywordschoice, selected = "Mazda", multiple = T),
br(),
DT::dataTableOutput("table"),
br(),
br(),
DT::dataTableOutput("table2"),
br(),
actionButton("gobutton","Configure"),
br(),
br(),
htmlOutput("updated.df"),
br()
))
server <- shinyServer (
function (input, output, session) {
dataoftable <- reactive({
database <- mtcars_df
keywords <- c(input$keywords)
if (is.null(keywords)){
all_df_display <- mtcars_df
} else {
all_df <- data.frame()
for (i in 1:length(keywords)){
df <- mtcars_df[grepl(keywords[i], mtcars_df$Keywords, perl = TRUE), ]
all_df <- rbind(all_df, df)
}
all_df <- distinct(all_df)
all_df$num <- str_count(all_df$Keywords, paste(keywords, collapse = "|"))
all_df_display <- all_df %>% arrange(desc(num))
}
all_df_display
})
output$table <- DT::renderDataTable(dataoftable() , server = TRUE, options = list(searching = FALSE))
dataoftable2 <- reactive({
s <- input$table_rows_selected
df_input <- dataoftable()
if(length(dataoftable())){
df_input <- df_input[s, ]
}
df_input
})
output$table2 <- DT::renderDataTable(dataoftable2(), server = FALSE, options = list(searching = FALSE), editable = list(target = 'cell', disable = list(columns = c(1,2)))) ###
}
)
shinyApp(ui = ui, server = server)
Is there any other way that I can do it?
Please let me know if anything not clear.
Thank you.
Make the changes to the dataframe you are using in outputs as
output$table <- DT::renderDataTable(mtcars_df , server = TRUE, options = list(searching = FALSE))
output$table2 <- DT::renderDataTable(dataoftable(), server = FALSE, options = list(searching = FALSE), editable = list(target = 'cell', disable = list(columns = c(1,2))))
Then it works fine. Also, I do not see table_rows_selected being defined anywhere in the ui. So, I am not sure how dataoftable2 could have been defined. Hence, it was empty.