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)
Related
I'm hoping to insert an rclipboard::rclipButton() into a DataTable in RShiny and am having trouble figuring out how to do it. Have tried the following (based on: Using renderDataTable within renderUi in Shiny):
library(shiny); library(tidyverse); library(rclipboard)
ui <- fluidPage(
mainPanel(
rclipboardSetup(),
uiOutput('myTable')
)
)
server <- function(input, output) {
output$myTable <- renderUI({
output$myTable <- renderUI({
iris <- iris %>% filter(row_number()==1:2)
iris$button <- rclipButton(
inputId = "clipbtn",
label = "Copy",
clipText = "test",
icon = icon("clipboard")
)
output$aa <- renderDataTable(iris)
dataTableOutput("aa")
})
})
}
shinyApp(ui, server)
But looks like this:
"[object Object]"
Have also tried paste0()'ing the rclipButton() into the DataTable but that just renders as a long string of HTML.
Any suggestions much appreciated!
Well, rclipButton() call will generate shiny.tag objects, and you need to change it to string so DT can parse it. Then the key is to use escape = F in datatable.
I also rewrite the way to generate the DT table.
library(shiny); library(tidyverse); library(rclipboard)
ui <- fluidPage(
mainPanel(
rclipboardSetup(),
DT::dataTableOutput("aa")
)
)
server <- function(input, output) {
output$aa <- DT::renderDataTable({
iris2 <- iris %>% filter(row_number()==1:2)
iris2$button <- rclipButton(
inputId = "clipbtn",
label = "Copy",
clipText = "test",
icon = icon("clipboard")
) %>% as.character()
DT::datatable(iris2, escape = F)
})
}
shinyApp(ui, server)
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)
In the following app, I would like to add a global button, to save the tables in the 2 panels at the same time.
Ideally, they should be saved to an xlsx file, in tabs named after the corresponding tabs.
Please note that the tabs were created using a module.
Many thanks!!
library(shiny)
library(DT)
modDtUi <- function(id){ # UI module
ns = NS(id)
DT::dataTableOutput(ns('x1'))
}
modDt <- function(input, output, session, data, globalSession){ # Server module
x <- data
output$x1 <- DT::renderDataTable(x, selection = 'none', editable = TRUE)
proxy <- dataTableProxy('x1', session = globalSession)
}
ui <- fluidPage(
mainPanel(
tabsetPanel(
tabPanel("Table1", modDtUi("editable")),
tabPanel("Table2", modDtUi("editable2"))
)
)
)
server <- function(input, output, session) {
callModule(modDt,"editable", data = head(iris,10), globalSession = session)
callModule(modDt,"editable2", data = tail(iris,5), globalSession = session)
}
shinyApp(ui = ui, server = server)
I believe this demo works.
I used reactiveValues v$data to store the data inside the module. The module will return v$data so it can be retrieved when you want to save the data in the shiny server.
I also added an observeEvent to detect changes in the data, and update the data table with replaceData.
The excel file is created using the writexl library, but you could substitute with others of course.
Let me know if this works for you. I imagine there are some elements of this answer that can be improved upon - and if we can identify them, would like to edit further.
library(shiny)
library(DT)
library(writexl)
modDtUi <- function(id){ # UI module
ns = NS(id)
DT::dataTableOutput(ns(id))
}
modDt <- function(input, output, session, data, id, globalSession){ # Server module
v <- reactiveValues(data = data)
output[[id]] <- DT::renderDataTable(v$data, selection = 'none', editable = TRUE)
proxy <- dataTableProxy(id, session = globalSession)
id_input = paste(id, "cell_edit", sep = "_")
# Could add observeEvent here to detect edit event
observeEvent(input[[id_input]], {
info = input[[id_input]]
if (!is.null(info)) {
v$data[info$row, info$col] <<- DT::coerceValue(info$value, v$data[info$row, info$col])
}
replaceData(proxy, v$data, resetPaging = FALSE)
})
return(data = reactive({v$data}))
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
width = 2,
actionButton("btn", "Save Both")
),
mainPanel(
tabsetPanel(
tabPanel("Table1", modDtUi("editable1")),
tabPanel("Table2", modDtUi("editable2"))
)
)
)
)
server <- function(input, output, session) {
e1 <- callModule(modDt, "editable1", data = head(iris,10), id = "editable1", globalSession = session)
e2 <- callModule(modDt, "editable2", data = tail(iris,5), id = "editable2", globalSession = session)
observeEvent(input$btn, {
print("Saving...")
sheets <- list("e1" = e1(), "e2" = e2())
write_xlsx(sheets, "test.xlsx")
})
}
shinyApp(ui = ui, server = server)
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)
How can I extract selected option from r markdown selectInput drop down menu? I have reactive input on my web page something like the following:
aggdata <- data.frame(
"Experiment" = c("One","Two","Three"),
"AnythingElse" = c(1,2,3)
)
selectInput("Experiment1","Choose the first experiment",
choices = unique(aggdata$Experiment),
selected = unique(aggdata$Experiment)[1])
reactiveData <- reactive(as.data.frame(subset(aggdata, Experiment == input$Experiment1)))
firstExperiment_aggData <- reactive(reactiveData())
And I'd like to write somewhere to the text reactively, what was user's selection. Do you happen to know, how can I do that. Many thanks in advance.
As far as Shiny is concerned, you could start with this. Does that help you?
library(shiny)
aggdata <- data.frame(
"Experiment" = c("One","Two","Three"),
"AnythingElse" = c(1,2,3)
)
ui <- shinyUI(
fluidPage(
selectInput("Experiment1","Choose the first experiment",
choices = unique(aggdata$Experiment),
selected = unique(aggdata$Experiment)[1]),
tableOutput("table1")
)
)
server <- shinyServer(function(input, output, session) {
reactiveData <- reactive({
return(as.data.frame(subset(aggdata, Experiment == input$Experiment1)))
})
output$table1 <- renderTable({
return( reactiveData() )
})
})
shinyApp(ui = ui, server = server)