Auto complete and selection of multiple values in text box shiny - r

Is it possible to select multi values using auto complete strings similar to google search and stack overflow tags selection in shiny text box.
dataset<-cbind("John Doe","Ash","Ajay sharma","Ken Chong","Will Smith","Neo"....etc)
I want to select multiple variables from the above dataset as a auto fill in my textbox and pass it to my server.R
ui.R
shinyUI(fluidPage(
titlePanel("test"),
sidebarLayout(
sidebarPanel(
helpText("text"),
textInput("txt","Enter the text",""),
#Pass the dataset here for auto complete
),
mainPanel(
tabsetPanel(type="tab",tabPanel("Summary"),textOutput("text2"))
)
)
))
server.R
# server.R
shinyServer(function(input, output) {
output$text2<- renderText({
paste("hello",input$txt)
})
}
)
EDITED
I have used select2input from shinysky for selecting mulitiple varialbes but now I have added submit button to get selected values together.
#ui.R
select2Input("txt","This is a multiple select2Input",choices=c("a","b","c"),selected=c("")),
actionButton("go","submit")
I want to bind selected option lets say user selected a and c then new variable is
#server.R
input$go #if pressed submit button
var<-cbind("a","c")
output$text<-renderText({ print ("var")})
but this is not working

Look into shinysky package and textInput.typeahead. You can further customize the style of the textinput yourself. Edit: I added example with select2Input from the shinysky package also for reference
rm(list = ls())
library(shinysky)
library(shiny)
my_autocomplete_list <- c("John Doe","Ash","Ajay sharma","Ken Chong","Will Smith","Neo")
ui <- shinyUI(
fluidPage(tags$style(type="text/css",".shiny-output-error { visibility: hidden; }",".shiny-output-error:before { visibility: hidden; }"),
tags$style(type="text/css","#search { top: 50% !important;left: 50% !important;margin-top: -100px !important;margin-left: -250px
!important; color: blue;font-size: 20px;font-style: italic;}"),
mainPanel(
# one way of doing it
textInput.typeahead(id="search",
placeholder="Type your name please",
local=data.frame(name=c(my_autocomplete_list)),
valueKey = "name",
tokens=c(1:length(my_autocomplete_list)),
template = HTML("<p class='repo-language'>{{info}}</p> <p class='repo-name'>{{name}}</p>")
),
br(),br(),
# using select2Input
select2Input("select2Input1","",choices=c(my_autocomplete_list),type = c("input", "select"))
)
)
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
Edit 2 as per request. Please wrap your objects in a reactive expressions as I did e.g. var <- reactive({...}) so you can re-use those later
rm(list = ls())
library(shinysky)
library(shiny)
my_autocomplete_list <- c("John Doe","Ash","Ajay sharma","Ken Chong","Will Smith","Neo")
ui <- shinyUI(
fluidPage(sidebarPanel(select2Input("txt","",choices=c("a","b","c"),selected=c("")), br(),actionButton("go","submit"), width =2),
mainPanel(textOutput('text'))
)
)
server <- function(input, output, session) {
var <- reactive({
if(input$go==0){return()}
isolate({
input$go
cbind("a","c")
})
})
output$text <- renderText({var()})
}
shinyApp(ui = ui, server = server)

A much easier approach imho is to use shiny::selectizeInput(). It allows you to autocomplete inputs with via the choices argument.
rm(list = ls())
library(shiny)
my_autocomplete_list <- c("John Doe","Ash","Ajay sharma",
"Ken Chong","Will Smith","Neo")
ui <- shinyUI(
selectizeInput(
inputId = 'search',
label = 'Search',
choices = my_autocomplete_list,
selected = NULL,
multiple = TRUE, # allow for multiple inputs
options = list(create = FALSE) # if TRUE, allows newly created inputs
)
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)

Related

Fixing top section in shiny

Is there a way to fix the top section of the dashboard here. Right now, the widgets (selectinput) are fixed, but when the user scroll down, it gets covered by the datatable. Can we not make sure this does not get covered and only datatable moves down?
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
titlePanel(fluidRow(
div(column(12, align="center",
selectInput("rmd1", "RMDw", choices = c(1,2)),
selectInput("rmd2", "RMD2", choices = c(1,2))
), style = "position:fixed; width:inherit;")
)),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),
dataTableOutput("uioutput", height = "2000px")
))
server <- function(input, output, session) {
output$uioutput <- renderDataTable({
datatable(iris)
})
}
shinyApp(ui, server)
You can use the CSS z-index property to control the stack order the HTML elements:
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
titlePanel(fluidRow(
div(column(12, align="center",
selectInput("rmd1", "RMDw", choices = c(1,2)),
selectInput("rmd2", "RMD2", choices = c(1,2))
), style = "position:fixed; width:inherit; z-index: 1; background-color: white;")
)),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),
dataTableOutput("uioutput", height = "2000px")
))
server <- function(input, output, session) {
output$uioutput <- renderDataTable({
datatable(iris)
})
}
shinyApp(ui, server)
Another approach is using position: sticky;.
Changing the style line to position:absolute makes it so that the selection boxes scroll up and out of the page when you scroll down, if that's what you were looking for.
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
titlePanel(fluidRow(
div(column(12, align="center",
selectInput("rmd1", "RMDw", choices = c(1,2)),
selectInput("rmd2", "RMD2", choices = c(1,2))
), style = "position:absolute; width:inherit;")
)),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),
dataTableOutput("uioutput", height = "2000px")
))
server <- function(input, output, session) {
output$uioutput <- renderDataTable({
datatable(iris)
})
}
shinyApp(ui, server)
If you're trying to make the table stay in place and scroll down through the table, use DTOutput() and renderDataTable() instead of dataTableOutput() and renderDataTable(). Then, get rid of datatable() inside renderDT() and just use 'iris'. Finally, you can add the Scroller extension and an options list with scrollY and scroller. Others may be able to explain the difference between DT and DataTable (this page might help as well: https://rstudio.github.io/DT/shiny.html), but I believe DTOutput and renderDT are more flexible. Note: you can add horizontal scrollbars as well with scrollX if you use a table with more fields in the future.
Updated code is below.
Hope either of these helps!
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
titlePanel(fluidRow(
div(column(12, align="center",
selectInput("rmd1", "RMDw", choices = c(1,2)),
selectInput("rmd2", "RMD2", choices = c(1,2))
), style = "position:absolute; width:inherit;")
)),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),
DTOutput("uioutput", height = "600px")
))
server <- function(input, output, session) {
output$uioutput <- renderDT({
iris
},
extensions = c('Scroller'),
fillContainer = T,
options = list(deferRender = T,
scrollY = 400,
scroller = T)
)
}
shinyApp(ui, server)

Shiny - Go to another section in same page

I am using below code and try to do below action.
Click on action button to go to next table. How can I do this?
library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- fluidPage(
fluidRow(box(
actionButton("btn1", "Go to Next Table"),
tableOutput("tbl1")
)),
fluidRow(box(
tableOutput("tbl2")
))
)
server <- function(input, output, session) {
output$tbl1 <- renderTable(mtcars)
output$tbl2 <- renderTable(mpg)
}
shinyApp(ui, server)
Here's one solution:
library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- fluidPage(
fluidRow(box(
actionButton("btn1", "Go to Next Table",
onclick = "location.href='#table2';"),
tableOutput("tbl1")
)),
fluidRow(id = "table2", box(
tableOutput("tbl2")
))
)
server <- function(input, output, session) {
output$tbl1 <- renderTable(mtcars)
output$tbl2 <- renderTable(mpg)
}
shinyApp(ui, server)
I've added a unique ID to the location in the UI - here the 2nd fluidRow, then added an onclick javascript function to the actionButton also in the UI. No server function means all the work is done by the user's browser which is handy sometimes.
You can add infinite complexity to the Javascript here to customise it to fit your needs.

How to add a button to an item in a to do list in shiny

I am using shinydashboardplus.
I'd like to use the to do list but the example in the gallery is limited to just showing a list without any functionality.
To track a todo list for a user I am reading and writing to a csv for the moment.
I can read the csv to dynamically populate the list. Now I'd like to be able to strike through an item to indicate it is completed using the checked parameter.
The checked items should be removed from the csv.
Ill work on the adding items another day I think....
Here is my example (not reading from csv but from iris for this example).
library(shiny)
library(shinydashboardPlus)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
useShinydashboardPlus(),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
box(
"Sortable todo list demo",
status = "warning",
todoList(
apply(mtcars,1, function(x)
todoListItem(
label = x[1],
x[2]
)
)
)
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
}
# Run the application
shinyApp(ui = ui, server = server)
Here is an approach using renderUI and a reactive data.frame:
library(shiny)
library(shinydashboardPlus)
library(shinyWidgets)
css <- "
.inlinecheckbox .shiny-input-container {
display: inline-block;
width: auto;
}
"
ui <- fluidPage(
tags$style(css),
titlePanel("Dynamic to do list"),
useShinydashboardPlus(),
sidebarLayout(
sidebarPanel(),
mainPanel(
box(
"Sortable todo list demo",
status = "warning",
uiOutput("myToDoList")
)
)
)
)
checkboxIDs <- paste0("checkbox", seq_len(nrow(mtcars)))
mtcars$checked <- FALSE
# Define server logic required to draw a histogram
server <- function(input, output) {
reactiveMtcars <- reactiveVal(mtcars)
observe({
for (i in seq_along(checkboxIDs)) {
if(!is.null(input[[checkboxIDs[1]]])){
mtcars$checked[i] <- input[[checkboxIDs[i]]]
}
}
reactiveMtcars(mtcars)
})
output$myToDoList <- renderUI({
req(reactiveMtcars())
todoListItems <- list()
for(i in seq_len(nrow(reactiveMtcars()))){
todoListItems[[i]] <- todoListItem(
label = div(rownames(reactiveMtcars())[i], style = ""),
span(class = "inlinecheckbox", checkboxInput(inputId = paste0("checkbox", i), label = NULL, value = reactiveMtcars()$checked[i])),
checked = reactiveMtcars()$checked[i],
)
}
todoList(todoListItems)
})
}
shinyApp(ui = ui, server = server)

Show box only when tableoutput is ready in shiny app

I want to generate a boxPlus around my DT-Output. Now when I start my APP, the frame of the box is already there. How do I manage that the box is only displayed when the tableoutput is finished? As input I use a text input.
In my UI I use for the Input:
textInput("name", "Insert Number:")
the final box I create with:
uiOutput("box")
On Serverside I do:
output$name <- renderText(input$name)
New_input <- reactive({
list(input$name)
})
and the box I create like this:
output$box <- renderUI({
boxPlus(
div(style = 'overflow-x: scroll;'), dataTableOutput("table")
)
})
I tried it with: Similar Problem but I can not resolve the problem. Without the box everything works fine.
Never use reactive expressions inside a renderText function.
You have to wrap tagList around your two elements to return a SINGLE element (a list in your case).
Here is a reproduceable example.
library(shiny)
library(shinydashboardPlus)
library(dplyr)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Hide box"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
textInput("name", "Insert Number to filter cyl:")
),
mainPanel(
uiOutput("box")
)
)
)
server <- function(input, output) {
resultdf <- reactive({
mtcars %>%
filter(cyl > input$name)
})
output$box <- renderUI({
output$table <- renderDataTable({
resultdf()
})
if(input$name == "") {
return(NULL)
} else {
return(
tagList(
boxPlus(
div(style = 'overflow-x: scroll;'), dataTableOutput("table")
)
)
)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)

Using renderDataTable within renderUi in Shiny

I'm experimenting a Shiny App to show dynamic contexts, but I cannot get renderDataTable working into a renderUi component.
Below two simple replicable tests: the first one is not working, the second one without renderUi works fine, of course.
What is the conceptually difference between this two, and why the first one cannot work in Shiny?
This one not works: note that the uiOutput myTable, contains two reactive component, a selectInput and a renderDataTable, but only the selectInput is rendered.
library(shiny)
runApp(list(
ui = fluidPage(
fluidRow(h2("where is the table?")),
uiOutput('myTable')
),
server = function(input, output) {
output$myTable <- renderUI({
fluidPage(
fluidRow(selectInput("test", "test", c(1,2,3))),
fluidRow(renderDataTable(iris))
)
})
}
))
This is fine, both selectInput and renderDataTable are rendered:
library(shiny)
runApp(list(
ui = fluidPage(
fluidRow(h2("where is the table?")),
fluidRow(selectInput("test", "test", c(1,2,3))),
fluidRow(dataTableOutput('myTable'))
),
server = function(input, output) {
output$myTable = renderDataTable(iris)
}
))
How to get the first scenario working?
Thanks.
EDITING after Yihui comment (thanks Yihui):
In renderUi has to be used some ui function, and not some render function:
changed the sample code in the correct way, the result does not change: still no data is shown.
library(shiny)
runApp(list(
ui = basicPage(
uiOutput('myTable')
),
server = function(input, output) {
output$myTable <- renderUI({dataTableOutput(iris)
})
}
))
EDIT n.2
Just solved, got it working so:
library(shiny)
runApp(list(
ui = fluidPage(
mainPanel(
uiOutput('myTable')
)
),
server = function(input, output) {
output$myTable <- renderUI({
output$aa <- renderDataTable(iris)
dataTableOutput("aa")
})
}
))
I have to save the renderTableOutput in a output variable first, and then feeding it to dataTableOutput.
Thanks for pointing me to: here
It would be clearer if you split the part of datatable generation and ui generation :
library(shiny)
runApp(list(
ui = fluidPage(
mainPanel(
uiOutput('myTable')
)
),
server = function(input, output) {
output$aa <- renderDataTable({iris})
output$myTable <- renderUI({
dataTableOutput("aa")
})
}
))

Resources