below there is a shiny app that renders a datatable using DT. Rather than have the table start the display at row 1 I'd like to have the table render with a specific top row selected by the user (using input$startRow in this example).
E.g., if the user chose 50 in the slider the first row shown in the table would be row 50 rather than row 1.
Any tips for getting a dynamic starting row appreciated.
Edit for clarity: I do not want to subset the table, I want to display to begin at input$startRow but the user could scroll up and down and still see the entire dataset (e.g., faithful in this example).
Edit 2: It looks like the issue is that the displayStart option is what I want but that there is a known bug as of May 21 with Scroller starting the display mid table.
library(shiny)
library(DT)
data("faithful")
ui <- fluidPage(
h2("Select the first row of the table to show"),
sliderInput(inputId="startRow",
label="Choose a row to start the datatable display",
min = 1,
max = 200,
value = 100,
step=5),
# show a datatable
h2("Show a table"),
dataTableOutput("table1")
)
server <- function(input, output) {
output$table1 <- renderDataTable({
# use input$startRow to begin the table display?
datatable(faithful,
extensions = "Scroller",
options = list(scrollY = 300,
scroller = TRUE))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Success. Following the link in the comment. I was able to use initComplete to start the table on the row from input$startRow. This appears to work.
library(shiny)
library(DT)
data("faithful")
ui <- fluidPage(
h2("Select the first row of the table to show"),
sliderInput(inputId="startRow",
label="Choose a row to start the datatable display",
min = 1,
max = 200,
value = 10,
step=5),
# show a datatable
h2("Show a table"),
dataTableOutput("table1")
)
server <- function(input, output) {
output$table1 <- renderDataTable({
datatable(faithful,
extensions = "Scroller",
options = list(scrollY = 300,
scroller = TRUE,
initComplete = JS('function() {this.api().table().scroller.toPosition(',
input$startRow-1,');}')))})
}
shinyApp(ui = ui, server = server)
Yes, use input$startRow to begin the table display to generate the selected table.
library(shiny)
library(DT)
data("faithful")
ui <- fluidPage(
h2("Select the first row of the table to show"),
sliderInput(inputId="startRow",
label="Choose a row to start the datatable display",
min = 1,
max = 200,
value = 100,
step=5),
# show a datatable
h2("Show a table"),
dataTableOutput("table1")
)
server <- function(input, output) {
topDF <- reactive({
# use input$startRow to begin the table display
topRow <- input$startRow
selectedDf <- faithful[-(1:(topRow-1)), ]
return(selectedDf)
})
output$table1 <- renderDataTable({
datatable(topDF(),
extensions = "Scroller",
options = list(scrollY = 300,
scroller = TRUE))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
I have been trying to create ActionButtons to allow a user to 'Select all rows in view' in a reactive, filtering datatable.
Currently the button does this using tableid_rows_current; however, I also want to add in a table proxy so that it doesn't reset to the first page of results if you're on another page, but I can't figure out the syntax after much googling (see attempts commented out in code). Also if you manually select some rows, it no longer works.
Another ActionButton that allows a user to 'add all rows in view to selection'. That is to add all current rows in view to your previous selection. This one I'm not even sure where to start, so any ideas are appreciated.
(Not included here, but I do have functioning 'clear selection' and 'clear filter' buttons already, if anyone is interested)
Minimum reproducible code below. The app is meant to display the images for the selected rows, but not a big deal here that you won't have actual images displaying.
library(DT)
library(shiny)
dat <- data.frame(
type = c("car", "truck", "scooter", "bike"),
frontimage = c("carf.jpg", "truckf.jpg", "scooterf.jpg", "bikef")
)
# ----UI----
ui <- fluidPage(
titlePanel("Buttons 'select all' and 'add to select'"),
mainPanel(
DTOutput("table"),
actionButton("select_all_current", "Select All Rows in View"),
actionButton("add_to_selection", "Add All Rows in View to Selection"),
uiOutput("img1")
)
)
# ----Server----
server = function(input, output, session){
# Action button to select all rows in current view
var <- reactiveValues()
tableProxy <- dataTableProxy('table')
observeEvent(input$select_all_current, {
print("select_all_current")
# tableProxy %>% selectRows(1:nrow(input$table_rows_current))
# var$selected <- tableProxy %>% input$table_rows_current
tableProxy <- #I want the table proxy to be whatever the current selection and filters are and the current page view to stay the same after selecting
var$selected <- input$table_rows_current
})
# Action button to add all rows in current view to previous selection
observeEvent(input$add_to_selection, {
print("select_all_current")
})
# Data table with filtering
output$table = DT::renderDT({
datatable(dat, filter = list(position = "top", clear = FALSE),
selection = list(target = 'row', selected = var$selected),
options = list(
autowidth = TRUE,
pageLength = 2,
lengthMenu = c(2, 4)
))
})
# Reactive call that only renders images for selected rows
df <- reactive({
dat[input[["table_rows_selected"]], ]
})
# Front image output
output$img1 = renderUI({
imgfr <- lapply(df()$frontimage, function(file){
tags$div(
tags$img(src=file, width="100%", height="100%")
)
})
do.call(tagList, imgfr)
})
}
# ----APP----
# Run the application
shinyApp(ui, server)
Does this do what you're looking for?
library(DT)
library(shiny)
dat <- data.frame(
type = c("car", "truck", "scooter", "bike"),
frontimage = c("carf.jpg", "truckf.jpg", "scooterf.jpg", "bikef")
)
# ----UI----
ui <- fluidPage(
titlePanel("Buttons 'select all' and 'add to select'"),
mainPanel(
DTOutput("table"),
actionButton("select_all_current", "Select All Rows in View"),
actionButton("add_to_selection", "Add All Rows in View to Selection"),
uiOutput("img1")
)
)
# ----Server----
server = function(input, output, session){
# Action button to select all rows in current view
var <- reactiveValues()
tableProxy <- dataTableProxy('table')
observeEvent(input$select_all_current, {
print("select_all_current")
# tableProxy %>% selectRows(1:nrow(input$table_rows_current))
# var$selected <- tableProxy %>% input$table_rows_current
# tableProxy <- #I want the table proxy to be whatever the current selection and filters are and the current page view to stay the same after selecting
# var$selected <- input$table_rows_current
selectRows(proxy = tableProxy,
selected = input$table_rows_current)
})
# Action button to add all rows in current view to previous selection
observeEvent(input$add_to_selection, {
print("select_all_current")
selectRows(proxy = tableProxy,
selected = c(input$table_rows_selected, input$table_rows_current))
})
# Data table with filtering
output$table = DT::renderDT({
datatable(dat, filter = list(position = "top", clear = FALSE),
selection = list(target = 'row'),#, selected = var$selected),
options = list(
autowidth = TRUE,
pageLength = 2,
lengthMenu = c(2, 4)
))
})
# Reactive call that only renders images for selected rows
df <- reactive({
dat[input[["table_rows_selected"]], ]
})
# Front image output
output$img1 = renderUI({
imgfr <- lapply(df()$frontimage, function(file){
tags$div(
tags$img(src=file, width="100%", height="100%")
)
})
do.call(tagList, imgfr)
})
}
# ----APP----
# Run the application
shinyApp(ui, server)
I am creating a shiny machine learning application. I am displaying data in datatables and want to pass the data to machine learning model by selecting the row and clicking the button to get result.
How can it be done in shiny ?
I think I understand what you are trying to do. Hope this minimal example I made will help you. Use DT for table rendering and row selection (here i suppressed the selection of more than one row because I deduced that is what you want). Use button and isolate to run model only if row is selected and button is pressed. I didn't fit a model here, instead I made a plot with highlited row data, but the principle is exactly the same.
library(shiny)
library(DT)
server <- function(input, output, session) {
output$x1 = DT::renderDataTable(mtcars, server = FALSE, selection = "single")
# client-side processing
output$x2 = renderPrint({
s = input$x1_rows_selected
if (length(s)) {
cat('These rows were selected:\n\n')
cat(s, sep = ', ')
}
})
# highlight selected rows in the scatterplot - here you add your model
output$x3 = renderPlot({
input$run_model # button input
s = isolate(input$x1_rows_selected) # use isolate to run model only on button press
par(mar = c(4, 4, 1, .1))
plot(mtcars[, 2:3])
if (length(s)) points(mtcars[s, 2:3, drop = FALSE], pch = 19, cex = 2)
})
}
ui <- fluidPage(
title = 'Select Table Rows',
h1('A Client-side Table'),
fluidRow(
column(9, DT::dataTableOutput('x1')),
column(3, verbatimTextOutput('x2'))
),
hr(),
h1('Model'),
fluidRow(
column(6, actionButton("run_model", "Go")),
column(9, plotOutput('x3', height = 500))
)
)
shinyApp(ui = ui, server = server)
I'm trying to create a shiny app where user is able to add text comment to a table.
I created a dataframe with 3 columns: num, id and val. I want my shiny app to do the following:
select an value from id column (selectInput).
add text comment in a text box (textInput)
click on an action button
A new column called comment is created in the data table, text comments are added to the comment column in the row where id equals the value selected.
My shiny app code is below. When I select an value from selectinput, add some comment in the text box and click on `add comment' button, my shiny app window shut down by itself.
Does anyone know why that happens?
Thanks a lot in advance!
library(shiny)
library(DT)
df = data.frame(num=1:10, id=LETTERS[1:10], val=rnorm(10))
ui = fluidPage(
fluidRow(
column(2, selectInput(inputId = 'selectID',
label = 'Select ID2',
choices = LETTERS[1:10],
selected='',
multiple=TRUE)),
column(6, textInput(inputId = 'comment',
label ='Please add comment in the text box:',
value = "", width = NULL,
placeholder = NULL)),
column(2, actionButton(inputId = "button",
label = "Add Comment"))
),
fluidRow (
column(12, DT::dataTableOutput('data') )
)
)
server <- function(input, output, session) {
observeEvent(input$button, {
df[id==input$selectID, 'Comment']=input$comment
})
output$data <- DT::renderDataTable({
DT::datatable(df,
options = list(orderClasses = TRUE,
lengthMenu = c(5, 10, 20), pageLength = 5))
})
}
shinyApp(ui=ui, server=server)
The column id is not recognized as a column of the data.frame df in df[id == input$selectId, "Comment], replacing id by df$id fixes the error.
In order to rerender the datatable after updating df, df should be a reactive object.
To handle multiple selected id's in the selectInput selectId, you might want to replace df$id == input$selectId by df$id %in% input$selectId
This updated server function should help you with these issues:
server <- function(input, output, session) {
## make df reactive
df_current <- reactiveVal(df)
observeEvent(input$button, {
req(df_current())
## update df by adding comments
df_new <- df_current()
df_new[df_current()$id %in% input$selectID, "Comment"] <- input$comment
df_current(df_new)
})
output$data <- DT::renderDataTable({
req(df_current())
DT::datatable(df_current(),
options = list(orderClasses = TRUE,
lengthMenu = c(5, 10, 20), pageLength = 5))
})
}
I'm trying to add a "save inputs" feature to my Shiny app where the saved inputs would be saved in a DT data table. If a user clicks an Add button, the inputs would be appended to a data table. A user then can delete a row from this data table by selecting a row and clicking the Delete button. I also need to have this table's values be saved as a global variable so it stays persistent across all sessions.
The example code is shown below. When I close the session, the table (this_table) is correctly updated, however, those changes don't appear realtime during the app. I've tried putting both of these input buttons in an eventReactive function, but this did not work when one of the buttons was selected more than once.
Any ideas?
Global table:
this_table = data.frame(bins = c(30, 50), cb = c(T, F))
Shiny app code:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
checkboxInput("cb", "T/F"),
actionButton("add_btn", "Add"),
actionButton("delete_btn", "Delete")
),
mainPanel(
DTOutput("shiny_table")
)
)
)
server <- function(input, output) {
observeEvent(input$add_btn, {
t = rbind(data.frame(bins = input$bins,
cb = input$cb), this_table)
this_table <<- t
})
observeEvent(input$delete_btn, {
t = this_table
print(nrow(t))
if (!is.null(input$shiny_table_rows_selected)) {
t <- t[-as.numeric(input$shiny_table_rows_selected),]
}
this_table <<- t
})
output$shiny_table <- renderDT({
datatable(this_table, selection = 'single', options = list(dom = 't'))
})
}
shinyApp(ui = ui, server = server)
You can use reactiveVal to add server side variables that are observable and mutable at the same time. The syntax for those variables is to initialize them as
rV <- reactiveValue("init_value")
and update them with
rV("new_value")
Those variables can be accessed inside reactive contexts (basically like inputs) with
rV()
The syntax is quite unusual for R and might take time to get used to, but it is definitely the recommended way to solve issues like these. You might also want to take a look at reactiveValues for a similar functionality but with a semantic closer to the R class list.
Here is how this technique can be applied to your question
library(shiny)
library(DT)
this_table = data.frame(bins = c(30, 50), cb = c(T, F))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
checkboxInput("cb", "T/F"),
actionButton("add_btn", "Add"),
actionButton("delete_btn", "Delete")
),
mainPanel(
DTOutput("shiny_table")
)
)
)
server <- function(input, output) {
this_table <- reactiveVal(this_table)
observeEvent(input$add_btn, {
t = rbind(data.frame(bins = input$bins,
cb = input$cb), this_table())
this_table(t)
})
observeEvent(input$delete_btn, {
t = this_table()
print(nrow(t))
if (!is.null(input$shiny_table_rows_selected)) {
t <- t[-as.numeric(input$shiny_table_rows_selected),]
}
this_table(t)
})
output$shiny_table <- renderDT({
datatable(this_table(), selection = 'single', options = list(dom = 't'))
})
}
shinyApp(ui = ui, server = server)
Finally, I would like to add that # Vishesh Shrivastavs recommendation to use the rhandsontable package is also a viable approach, although you will definitely loose some flexibility in doing so.
I'm having trouble iteratively loading and filtering a datatable in Shiny. The ideal workflow would be as follows:
User pushes button to confirm loading data
Data is retrieved from MySql query. Note this should only occur once
(optional) filter buttons/sliders become visible/available
User interacts with buttons/sliders to filter datatable
1 and 2 work fine, but I am having particular issue with 4 (also any input for 3 would be appreciated as well).
The initial code that is not working is as follows:
get_data=function(){ # note that this is for sample purpose, real function is MySQL query
df=data.frame(x=1:10,Age=1:100)
print("loading data...")
return(df)
}
ui = bootstrapPage(
fluidPage(
fluidRow(
actionButton(
inputId = "confirm_button",
label = "Confirm"
)
)
,
fluidRow(
column(4,
sliderInput("slider_age", label = h4("Age"), min = 0,
max = 100, value = c(0, 100))
)
),
hr(),
fluidRow(
DT::dataTableOutput("all_background_table")
)
)
)
server = function(input, output){
observeEvent(input$confirm_button, {
req(input$confirm_button)
output$all_background_table <- DT::renderDataTable({
all_background=get_data() # <- MySQL function to laod data
# if all_background filter function put here:
#--> data is re-loaded by MySQL query
# if all_background filter function is put here surrounded by observeEvent(input$slider_age, {...:
#--> there is no change when input$slider_age is changed
datatable(all_background,
rownames = FALSE,
style = "bootstrap")
})
})
observeEvent(input$slider_age, {
## this will throw an error requiring all_background
#--> Error in observeEventHandler: object 'all_background' not found
req(input$confirmation_load_pts)
all_background=all_background[(all_background$Age > as.numeric(input$slider_age[1]) & all_background$Age < as.numeric(input$slider_age[2])),]
})
}
shinyApp(ui, server)
I am not sure about get_data(), but I will be using df to make it easier. With eventReactive you can create a new data frame after using the slider and only after clicking on the confirm button. Your observeEventwould not be necessary for this scenario.
library(shiny)
library(DT)
get_data=function(){ # note that this is for sample purpose, real function is MySQL query
df=data.frame(x=1:10,Age=1:100)
print("loading data...")
return(df)
}
ui = bootstrapPage(
fluidPage(
fluidRow(
actionButton(
inputId = "confirm_button",
label = "Confirm"
)
)
,
fluidRow(
column(4,
sliderInput("slider_age", label = h4("Age"), min = 0,
max = 100, value = c(0, 100))
)
),
hr(),
fluidRow(
DT::dataTableOutput("all_background_table")
)
)
)
server = function(input, output){
test <- eventReactive(input$confirm_button, {
df=get_data()
})
observeEvent(input$confirm_button, {
output$all_background_table <- DT::renderDataTable({
df=test()
all_background2=df[(df$Age > as.numeric(input$slider_age[1]) & df$Age < as.numeric(input$slider_age[2])),]
datatable(all_background2,
rownames = FALSE,
style = "bootstrap")
})
})
}
shinyApp(ui, server)