I am trying to change the options of a renderDataTable call in Shiny to depend on the value of an input variable, in this case a checkbox.
The first checkbox successfully alters the content of the table, adding one more column if checked.
The second checkbox does not alter the options of the table. See code below, I am loading an updated version of datatables and other extensions, but that does not seem to have any effect here.
The third checkbox also does not alter the formatting of the entries in the table, which is what I ultimately would like to do.
Any ideas?
# server.R
library("ggplot2")
shinyServer(function(input, output, session) {
bold = reactive ({
bold = ''
bold = paste0(bold,'function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {')
bold = ifelse(input$checkbox3,paste0(bold),paste0(bold,'if (parseFloat(aData[0]) >= 0.1) { $("td:eq(0)", nRow).css("font-weight", "bold"); }'))
bold = paste0(bold,'}')
return(bold)
})
output$mytable = renderDataTable({
diamonds[,1:ifelse(input$checkbox1,6,5)]
}, options = list(fnRowCallback = I(bold()),aaSorting=list(list(2, ifelse(input$checkbox2,"asc","desc"))))
)
}
)
# ui.R
shinyUI({
pageWithSidebar(
h1('Diamonds DataTable with TableTools'),
tagList(
singleton(tags$head(tags$script(src='jquery.dataTables.min.js',type='text/javascript'))),
singleton(tags$head(tags$script(src='TableTools.min.js',type='text/javascript'))),
singleton(tags$head(tags$script(src='dataTables.colReorder.min.js',type='text/javascript'))),
singleton(tags$head(tags$script(src='colvis.js',type='text/javascript'))),
singleton(tags$head(tags$script(src='ZeroClipboard.min.js',type='text/javascript'))),
singleton(tags$head(tags$link(href='TableTools.min.css',rel='stylesheet',type='text/css'))),
singleton(tags$head(tags$link(href='ColVis.css',rel='stylesheet',type='text/css')))
, tags$head(
tags$style(HTML("
.cvclear{
text-align:right}")
)
)
),
tabPanel("foo",
checkboxInput("checkbox1", "add one more column", FALSE),
checkboxInput("checkbox2", "sort [desc] or [asc]", FALSE),
checkboxInput("checkbox3", "no bold", FALSE),
dataTableOutput("mytable")
)
)
})
The option is declared as:
"aaSorting": [[2,'asc']]
which in R is
options = list(aaSorting = list(list(2, 'asc')))
so you need to swap your c for a list. However the logic is wrong here.
If sorting is enabled, then DataTables will perform a first pass sort on initialisation. You can define which column(s) the sort is performed upon, and the sorting direction, with this variable. The aaSorting array should contain an array for each column to be sorted initially containing the column's index and a direction string ('asc' or 'desc').
So this option will only work on the initialisation of the table. I dont think Shiny reinitialises the table once it has been formed so this wont work as a reactive only working the first time the table is initialised. Your more complex example may work however and it may just be the list(list(...)) that is the problem.
Related
I want to output a dataTable and preselect a row. This row can have a higher number than 10, in which case I want it to be shown in the dataTable. I have read you could use a dataTableProxy but it does not jump to the correct row. Is there an easy way to do this?
Here a minimal example:
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("dtout")
)
server <- function(input, output, session) {
output$dtout<- DT::renderDT(iris)
dtproxy<-DT::dataTableProxy(session = session,outputId = "dtout")
DT::selectRows(dtproxy,14)
}
shinyApp(ui, server)
This is the result:
This is what I want to be shown directly:
Is there an easy way to do so?
You can achieve that by using the Select extension. But you have to know in advance the number of the page to be displayed (maybe there's a way to get it automatically, I don't know).
library(DT)
callback <- "
table.row(':eq(13)', {page: 'all'}).select(); // select row 13+1
table.page(1).draw('page'); // jump to page 1+1
"
datatable(
iris,
extensions = "Select", selection = "none",
callback = JS(callback)
)
Question
In R Shiny, when using
renderUI
uiOutput
to dynamically generate sets of controls, such as:
checkboxes
radiobuttons
text boxes
how can I harvest those values or populate input by causing events?
As-is, those generated controls appear to be "display only". Making a selection, marking a checkbox, or entering data only updates the display, but no Event is created and the values are not populated into the "input" variable ( ReactiveValues ); thus, nothing is received by the Shiny server process.
If these control inputs are in-fact isolated, it completely undermines the point of dynamically creating controls.
Obviously, I'm hoping that this issue has been addressed, but my searches haven't turned it up.
In my specific case, the UI allows the user to:
Select and upload a CSV file.
The logic identifies numerical, date, and grouping columns, and produces 3 sets of radiobutton control sets. The idea is that you pick which columns you are interested in.
Picking a grouping column SHOULD return that columnID back to the server, where it will display a discrete list of groups from which to select. This fails, as the selections do not generate an Event, and the input variable (provided to server.R) only contains the ReactiveValues from the static controls.
That said, the display of the controls looks fine.
Step#0 screenshot:
Step#1 screenshot:
On the server.R side, I'm using code as below to create the radioButtons.
output$radioChoices <- reactive({
...
inputGroup <- renderUI({
input_list <- tagList(
radioButtons(inputId = "choiceGrp", label = "Available Grouping Columns", choices = grpColumnNames, inline = TRUE, selected = selectedGrp),
radioButtons(inputId = "choiceNumb",label = "Available Numerical Columns",choices = numColumnNames, inline = TRUE, selected = selectedNum),
radioButtons(inputId = "choiceDate",label = "Available Date Columns", choices = dateColumnNames, inline = TRUE, selected = selectedDate),
hr()
)
do.call(tagList, input_list)
})
print(inputGroup)
output$radioChoices <- inputGroup
})
I have played around with a Submit button and ActionButtons to try and force an Event, but no dice. My skull-storming is now going to places like "do I need to somehow use Javascript here?"
Many thanks to all of you who are lending me your cycles on this matter.
I'm not sure I understand your problem. Here's a MWE that accesses the value of a widget created by uiOutput/renderUI. The values of widgets created by uiOutput/renderUIcan be accessed just like those of any other widget.
If this doesn't give you what you want, please provide more details.
library(shiny)
ui <-
fluidPage(
uiOutput("dataInput"),
textOutput("result")
)
server <- function(input, output, session) {
output$dataInput <- renderUI({
selectInput("beatles", "Who's your favourite Beatle?", choices=c("- Select one -"="", "John", "Paul", "George", "Ringo"))
})
output$result <- renderText({
req(input$beatles)
paste0("You chose ", input$beatles)
})
}
shinyApp(ui, server)
Issue:
I'm looking to remove the showing 1 to n of n entries field in shiny DT. Please see picture below of what I would like to REMOVE.
Any insight is much appreciated.
You can use the dom option to determine which elements of the data table are shown. In the call to data table, you pass a named list of options to the options argument. dom accepts a character string where each element corresponds to one DOM element.
# only display the table, and nothing else
datatable(head(iris), options = list(dom = 't'))
# the filtering box and the table
datatable(head(iris), options = list(dom = 'ft'))
In your case, i is the table information summary: that's the one you want to leave out. You can also use this method to remove other elements like the search box or pagination controls.
See section 4.2 on this page for how to do this in R: https://rstudio.github.io/DT/options.html
This page in the Datatables manual discusses the DOM option: https://datatables.net/reference/option/dom
You can pass the info option directly using options
library(shiny)
library(DT)
ui <- fluidPage(
dataTableOutput('myTable')
)
server <- function(input, output, session) {
output$myTable <- renderDataTable(mtcars,
options = list(pageLength = 15, info = FALSE)
)
}
shinyApp(ui, server)
Description
I have a textAreaInput box that I want to start with a default value. The user can click 2 actionButtons (Submit & Random Comment). Submit updates the comment from the textAreaInput for further processing (plot, etc.) while Random Comment sends a new random value to textAreaInput (the user may type in the textAreaInput box as well). I almost have it but can't get the app to update textAreaInput's value until the Submit button is pressed.
Question
I want it to be updated when Random Comment is pressed but still allow the user to erase the text box and type their own text. How can I make the app do this?
MWE
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
output$randcomment <- renderUI({
commentUi()
})
comment_value <- reactiveValues(default = 0)
observeEvent(input$submit,{
comment_value$default <- input$randtext
})
renderText(input$randtext)
commentUi <- reactive({
if (comment_value$default == 0) {
com <- stri_rand_lipsum(1)
} else {
com <- stri_rand_lipsum(1)
}
textAreaInput("comment", label = h3("Enter Course Comment"),
value = com, height = '300px', width = '300px')
})
output$commenttext <- renderText({ input$comment })
}
)
I'd approach this a little bit differently. I would use reactiveValues to populate both of the fields, and then use two observeEvents to control the contents of the reactiveValues.
I don't think you need a reactive at all in this situation. reactive is good when you want immediate processing. If you want to maintain control over when the value is processed, use reactiveValues.
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
# Reactive lists -------------------------------------------------------
# setting the initial value of each to the same value.
initial_string <- stri_rand_lipsum(1)
comment_value <- reactiveValues(comment = initial_string,
submit = initial_string)
# Event observers ----------------------------------------------------
observeEvent(input$randtext,
{
comment_value$comment <- stri_rand_lipsum(1)
}
)
# This prevents the comment_value$submit from changing until the
# Submit button is clicked. It changes to the value of the input
# box, which is updated to a random value when the Random Comment
# button is clicked.
observeEvent(input$submit,
{
comment_value$submit <- input$comment
}
)
# Output Components -------------------------------------------------
# Generate the textAreaInput
output$randcomment <- renderUI({
textAreaInput("comment",
label = h3("Enter Course Comment"),
value = comment_value$comment,
height = '300px',
width = '300px')
})
# Generate the submitted text display
output$commenttext <-
renderText({
comment_value$submit
})
}
)
Some comments on your code
I struggled a little with determining what your code was doing. Part of the reason was that your server function was organized a bit chaotically. Your components are
output
reactive list
observer
output (but not assigned to a slot...superfluous)
reactive object
output
I'd recommend grouping your reactives together, your observers together, and your outputs together. If you have truly separate systems, you can break the systems into different sections of code, but have them follow a similar pattern (I would claim that these two boxes are part of the same system)
Your commentUi reactive has a strange if-else construction. It always sets com to a random string. What's more, the if-else construction isn't really necessary because no where in your code do you ever update comment_value$default--it is always 0. It looks like you may have been trying to base this off of an action button at some point, and then concluded (rightly) that that wasn't a great option.
Also, I would advise against building UI components in your reactive objects. You'll find your reactives are much more flexible and useful if they return values and then build any UI components within the render family of functions.
selectize.js has an item creation option as mentioned on http://brianreavis.github.io/selectize.js/. I'm trying to add the same feature in an R Shiny implementation of selectize but unable to figure out how.
Thanks for your help!
PS: Some more details about what exactly I'm doing - I have some sort of free text vector that I let the user add to. However, I want Shiny to prompt the user with the existing free text values that have previously been added in case the user wants to repeat one of them.
All you have to do is to set create option to true:
library(shiny)
shinyApp(
server = function(input, output, session) {
observe({ print(input$foo) })
},
ui = fluidPage(
selectizeInput(
"foo", "foo", c(), selected = NULL, multiple = TRUE,
options = list(create = TRUE))
)
)