R Shiny selectize.js item creation - r

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))
)
)

Related

How do I change the selected rows of a DT::dataTable on server-side? How do make it jump to the correct view?

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)
)

Combining DT::datatable, DT::dataTableProxy and "SearchPanes" Extension in R Shiny

It appears that DT::dataTableProxy is not possible with SearchPanes extension because:
SearchPanes requires Select extension.
Select extension requires DT::renderDT(server = FALSE) option.
DT::dataTableProxy does not work on the client side and throws DT error.
library(shiny)
library(shinydashboard)
library(tidyverse)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
shiny::selectInput("rows", label = "Rows", choices = 1:nrow(mtcars)),
shiny::actionButton("new", label = "New Data")
),
dashboardBody(DT::dataTableOutput("cars"))
)
server <- function(input, output) {
rows <- reactive({ input$rows })
output$cars <- DT::renderDataTable(server = FALSE, {
expr = DT::datatable(
data = mtcars |> head(rows())
#,
#extensions = c("SearchPanes", "Select", "Buttons"),
#options = list(
# dom = "Btip",
# buttons = list("searchPanes")
#)
)
})
dtProxy <- DT::dataTableProxy("cars")
observeEvent(input$new, label = "Observe button proxy update", {
doubledata <- bind_rows(mtcars, mtcars)
DT::replaceData(proxy = dtProxy,
data = doubledata,
resetPaging = FALSE)
})
}
shinyApp(ui, server)
Try this code using server = FALSE, click New Data, you will receive DT Warning:
DataTables warning: table id=DataTables_Table_0 - Invalid JSON response. For more information about this error, please see http://datatables.net/tn/1
Remove server = FALSE and proxy runs.
Remove the commented section, and search panes appear, but with no actual filters represented, and message stating that if we really want to use select extension then set select = 'none'.
Here are some reference materials:
RStudio DT Extensions
Matt Herman Tutorial
What I ended up doing was use only the DT::datatableProxy feature, then use a custom button for the search panes. Custom button was found here How to add custom button in R Shiny datatable. This required making a new reactive which was invalidated by the first, and checking if the inputs had any new values. Then the proxy received the filtered data.
Maybe someday they will add support for search panes.
Add server-side support for SearchPanes extension #877

Show dropdown menu only when start typing in R Shinyapp

With Shiny when you use SelectizeInput with multiple = TRUE:
a dropdown menu with all the element appears as soon as you are in
that box.
Then, when you start typing, the result in the dropdown
menu are filtered depending on what you type.
When the list is very long, sometimes the point 1 is pointless. Is it possible to see the dropdown only when you start typing (only from point 2)?
Reproducible example:
ui <- fluidPage(
selectizeInput(
inputId = "TEST", label = NULL, choices = c("aa","ab","ac","dd","de","zzz"),
multiple = TRUE)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
selectizeInput has an options argument, which is a list of parameters to initialize the selectize input. One of these options is openOnFocus which is
Show the dropdown immediately when the control receives focus.
Turning off openOnFocus solves the issue.
selectizeInput(
inputId = "TEST", label = NULL, choices = c("aa","ab","ac","dd","de","zzz"),
multiple = TRUE,
options = list(openOnFocus = FALSE,
#If the user write aa then delete it all, the complete list will show up again,
#use maxOptions to solve this issue
maxOptions = 3))
See the full list here selectize
/
selectize.js.

Generate warning message on R Shiny Dashboard Sidebar using "SelectizeInput"

I would like to add a warning message, in my shiny dashboard sidebar, if user enters something that is not recognized. I found something very informative: Check Shiny inputs and generate warning on sidebar layout
But it is not exactly what I need, and would like to hear what you think. Below is my code
library(shiny)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectizeInput('email', 'Email', c("NYC#gmail.com", "LA#gmail.com","SF#gmail.com"), multiple = FALSE,
options = list(
placeholder = 'Email addresss',
onInitialize = I('function() { this.setValue(""); }')
)),
uiOutput('email_text')
),
dashboardBody()
)
server <- function(input, output) {
output$email_text <-
renderUI({
if(input$email == ""){
return(p("Please add your gmail e-mail address."))
}
#Update: Below checks for "gmail" - I would something to search list and return.
if(!grepl("gmail", input$email)){
return(p("Your email is not a gmail e-mail address!"))
}
})
}
shinyApp(ui = ui, server = server)
Current sidebar selection performs well to recognize email format, as long as I select from the dropdown list
However, what I also want to add in is, if I enter something that is not expected (not in the list given), the system can capture that and warn me (E.g. "Your email is not an expected email address!"). Currently, if I just enter some something not in the list, the system does not do anything:
I feel that comparing with post I mentioned above, my version has issue with "selectizeInput" function. It is designed to intake elements from the list, not everything user enters. Is there a way to work around it? I try to use validate() but had no luck.
Thanks so much in advance for your help!
By default selecticizeInput does not allow the user to enter new values. You have to enable this with options = list(create = TRUE). Once you have this option, you can check whether the newly created email is in the pre-defined list of emails using %in% and report a custom error message in the sidebar.
Here is the updated code:
library(shiny)
library(shinydashboard)
list_of_emails <- c("NYC#gmail.com", "LA#gmail.com", "SF#gmail.com")
ui <- dashboardPage(dashboardHeader(),
dashboardSidebar(
selectizeInput(
'email',
'Email',
c("NYC#gmail.com", "LA#gmail.com", "SF#gmail.com"),
multiple = FALSE,
options = list(
create=TRUE,
placeholder = 'Email addresss',
onInitialize = I('function() { this.setValue(""); }')
)
),
uiOutput('email_text')
),
dashboardBody())
server <- function(input, output) {
output$email_text <-
renderUI({
# print the input email to the console to help with debugging
message(input$email)
if (input$email == "") {
return(p("Please add your gmail e-mail address."))
}
#Update: Below checks for "gmail" - I would something to search list and return.
if (!input$email %in% list_of_emails) {
return(p("Your email is not in the list of emails!"))
}
})
}
runApp(list(ui = ui, server = server))

Rstudio Shiny reactive options list in renderDataTable

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.

Resources