Paste values from excel to selectinput - r

This is a sample application where in the table is displayed as per values selected from dropdown(more than 2 values).
Right now the user can select only from dropdown. But can we add additional feature where (say from excel there are values column wise
Now the user can copy this values and paste it on selectinput. Then these values should be taken in the selectinput.
Basically the user should be able to copy and paste values into selectinput widget
library(shiny)
library(DT)
dat <- mtcars
server <- function(input, output, session) {
output$ui_view_vars <- renderUI({
vars <- colnames(dat)
## using selectizeInput with drag_drop and DT
selectizeInput("view_vars", "Select variables to show:", choices = vars,
selected = "", multiple = TRUE,
options = list(plugins = list('drag_drop')))
})
output$dataviewer <- DT::renderDataTable({
if (is.null(input$view_vars)) return()
DT::datatable(dat[,input$view_vars])
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("ui_view_vars")
),
mainPanel(
tabPanel("View", DT::dataTableOutput("dataviewer"))
)
)
)
shinyApp(ui = ui, server = server)

Related

How to select columns from a dataframe in Shiny if the user writes more than 1 column?

I am trying to create an app where you are able to select the columns that you want to see.
This post helped me a lot: Shiny How to dynamically select columns of imported dataset for further analysis
However, I want to be able to select the columns if the user doesn't click on the options and writes the columns who wants to see.
Right now, in order to be able to select columns you need to click or write ONE column.
However when you try to write more than 1 column (like this: "cyl mpg hp", in the same line) it doesn't appear anything.
This is the code:
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("select", "Select columns to display", c('col1,col2'), multiple = TRUE),
actionButton("update", "Update Data set", class = "btn-primary",style='padding:4px; font-size:120%')
),
# Show a plot of the generated distribution
mainPanel(
h2('The Mydata'),
#tableOutput("mytable")
DT::dataTableOutput("mytable")
)
)
)
library(shiny)
library(DT)
server <- function(session, input, output) {
data <- reactive({
mtcars
})
filtereddata <- eventReactive({
input$update
data()
}, {
req(data())
if(is.null(input$select) || input$select == "")
data() else
data()[, colnames(data()) %in% input$select]
})
observeEvent(data(), {
updateSelectInput(session, "select", choices=colnames(data()))
})
output$mytable <- renderDataTable(filtereddata())
}
# Run the application
shinyApp(ui = ui, server = server)
I have tried doing in another way, like here: https://shiny.rstudio.com/reference/shiny/1.6.0/varSelectInput.html but I have the same problem.
Thanks in advance
Regards
I have a way to pick n number of columns with one string containing a space (or more if there's a typo) per column name, but it requires a textInput. SelectInput doesn't allow me to enter a string.
It will show an error if only one column is typed, but that can be modified with an if statement.
example code:
library(stringr)
library(shiny)
library(tidyverse)
library(rebus)
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
textInput('select_text', 'Type a column', placeholder = 'enter col names between spaces'),
actionButton("update", "Update Data set", class = "btn-primary",style='padding:4px; font-size:120%')
),
# Show a plot of the generated distribution
mainPanel(
h2('The Mydata'),
#tableOutput("mytable")
DT::dataTableOutput("mytable")
)
)
)
library(shiny)
library(DT)
server <- function(session, input, output) {
data <- reactive({
mtcars
})
filtereddata <- eventReactive(
input$update, {
cols_spaces <- str_split(input$select_text, rebus::one_or_more(rebus::SPACE),simplify = TRUE) #format the names to a vector
data()[, colnames(data()) %in% cols_spaces] #now they can be used to subset data()
}
)
observeEvent(data(), {
updateSelectInput(session, "select", choices=colnames(data()))
})
output$mytable <- renderDataTable(filtereddata())
}
# Run the application
shinyApp(ui = ui, server = server)

From two selectInputs in the server, how to make one dependent on another?

First of all, I am so sorry if the main question (the title) of the post is not clearly enough. I didn't how to write a question with my problem.
Well, the thing is that I have two select inputs. The main one: Dataset, which have 2 options: 1) Cars and 2) Iris.
The other select input, it has information from the Cars' dataset and information from the Iris one.
I need to show the information from Cars if I select Cars and the information from Iris if I select Iris.
Now, my code is not able to do that. Simply it shows you the options to choose the datasets but in the second select input only shows the information from Cars.
I don't know how to do it, I have been a lot of posts but I couldn't get what I want.
For example this post Filter one selectInput based on selection from another selectInput? was very similar and I thought that I could do something similar, but he doesn't use a dataset from R...
My code:
library(shiny)
ui <- fluidPage(
titlePanel("Select a dataset"),
sidebarLayout(
sidebarPanel(
selectInput("dataset", "Dataset",
choices = c("Cars" = "Cars", "Iris" = "Iris")),
uiOutput("select_cars"),
uiOutput("select_iris")
),
mainPanel(
verbatimTextOutput("text"),
verbatimTextOutput("text2")
)
)
)
server <- function(input, output) {
cars <- reactive({
data("mtcars")
cars <- rownames(mtcars)
return(cars)
})
iris <- reactive({
data("iris")
iris <- data.frame(unique(iris$Species))
colnames(iris) <- "iris"
return(iris)
})
output$select_cars <- renderUI({
selectInput(inputId = "options_cars", "Select one", choices = cars())
})
output$select_iris <- renderUI({
selectInput(inputId = "options_iris", "Select one iris", choices = iris())
})
output$text <- renderPrint(input$options_cars)
output$text2 <- renderPrint(input$options_iris)
}
#Run the app
shinyApp(ui = ui, server = server)
On the other hand I get an error: object of type ‘closure’ is not subsettable. But I don't know why.
Finally, I apologize if someone has already asked something similar before, I really have been looking all morning and I do not know how to solve it. (I am quite new at Shiny and I am trying to do my best).
Thanks very much in advance,
Regards
I have modified some of your code and added some JS functionality from shinyjs, which you may or may not find useful
You don't really need to create objects all the time if you only going to update the list, so we are going to use updateSelectInput to update the sliders
I used hidden functionality to hide the elements initially so they are invisible to begin with
I created dependency on input$dataset within observeEvent so we can update the sliders and hide and show both the sliders we dont want and the output we dont want
Also if your datasets are static, like mtcars and iris its best to take them outside the server.R so you dont do extra unnecessary work
Finally its always a good idea to add req so you're not creating any objects if they are NULL
Your original error was due to the fact that you were passing the dataframe and not the list or vector to the slider, try to print out the objects if you're unsure and see their types
library(shiny)
library(shinyjs)
ui <- fluidPage(
titlePanel("Select a dataset"),
useShinyjs(),
sidebarLayout(
sidebarPanel(
selectInput("dataset", "Dataset",
choices = c("Cars" = "Cars", "Iris" = "Iris")),
hidden(selectInput(inputId = "options_cars", "Select one", choices = NULL)),
hidden(selectInput(inputId = "options_iris", "Select one iris", choices = NULL))
),
mainPanel(
verbatimTextOutput("text_cars"),
verbatimTextOutput("text_iris")
)
)
)
cars_data <- unique(rownames(mtcars))
iris_data <- as.character(unique(iris$Species))
server <- function(input, output, session) {
observeEvent(input$dataset,{
if(input$dataset == "Cars"){
show('options_cars')
hide('options_iris')
show('text_cars')
hide('text_iris')
updateSelectInput(session,"options_cars", "Select one", choices = cars_data)
}else{
show('options_iris')
hide('options_cars')
show('text_iris')
hide('text_cars')
updateSelectInput(session,"options_iris", "Select one iris", choices = iris_data)
}
})
output$text_cars <- renderPrint({
req(input$options_cars)
input$options_cars
})
output$text_iris <- renderPrint({
req(input$options_iris)
input$options_iris
})
}
#Run the app
shinyApp(ui = ui, server = server)
Here is a code that allows the switch by selectInput
library(shiny)
library(datasets)
ui <- fluidPage(
titlePanel("Select a dataset"),
sidebarLayout(
sidebarPanel(
selectInput("dataset", "Dataset",
choices = c("Cars" = "Cars", "Iris" = "Iris")),
##------removed this---------------
# uiOutput("select_cars"),
#uiOutput("select_iris")
##------------------------------
uiOutput("select_by_input")
),
mainPanel(
verbatimTextOutput("text")
# verbatimTextOutput("text2")
)
)
)
server <- function(input, output) {
cars <- reactive({
data("mtcars")
cars <- rownames(mtcars)
return(cars)
})
iris <- reactive({
# data("iris")
# iris <- data.frame(unique(iris$Species))
data('iris')
#colnames(iris) <- "iris"
# iris_names <- as.character(unique(iris$Species) )
iris_names <- c('a','b','c')
return(iris_names)
})
##------removed this---------------
# output$select_cars <- renderUI({
# selectInput(inputId = "options_cars", "Select one", choices = cars())
# })
#
# output$select_iris <- renderUI({
# selectInput(inputId = "options_iris", "Select one iris", choices = iris())
# })
#-----------------------------
output$select_by_input <- renderUI({
if (input$dataset=='Cars'){
selectInput(inputId = "options_x", "Select one", choices = cars())
}else if (input$dataset=='Iris'){
selectInput(inputId = "options_x", "Select one iris", choices = iris())
}
})
output$text <- renderPrint(input$options_x)
}
#Run the app
shinyApp(ui = ui, server = server)
the object of type ‘closure’ is not subsettable. error is caused by the iris data not being loaded after running the app. I used iris_names <- c('a','b','c') to demonstrate the dynamic change by selectInput

Allow user to complete a list of columns to display based on checkboxGroupInput

#XiongbingJin's example on Stack Overflow allows the user first to display a full dataset and to second to change the columns to display with a checkboxGroupInput .
I would like some help to make something different :
What I want :
datatable displaying begins with an arbitrary list of column (ex :carb, wt, drat of mtars datset ) and not the full dataset.
The user can complete the list to display with the checkboxGroupInput. (ex: add vs).
#XiongbingJin example :
library(shiny)
runApp(list(
ui = basicPage(
selectInput("select", "Select columns to display", names(mtcars), multiple =
TRUE),
h2('The mtcars data'),
dataTableOutput('mytable')
),
server = function(input, output) {
output$mytable = renderDataTable({
columns = names(mtcars)
if (!is.null(input$select)) {
columns = input$select
}
mtcars[,columns,drop=FALSE]
})
}
))
As suggested by #Marc P, you can just focus on a subset of names(mtcars) by providing it to the selected argument. This has also the advantage to get rid of the case where input$select is null.
library(shiny)
ui = basicPage(
selectInput("select", "Select columns to display",
names(mtcars),
selected = names(mtcars)[c(1, 3)], # display 1st and 3rd variables
multiple = TRUE),
h2('The mtcars data'),
dataTableOutput('mytable')
)
server = function(input, output) {
output$mytable = renderDataTable({
mtcars[, input$select, drop=FALSE]
})
}
shinyApp(ui, server)

How To Display Data Selected Datasets' Feature With R Shiny

I want to display selected feature of selected data in R Shiny.
To select data I use select input (with reactivity) , and to choose features of selected dataset use checkboxGroupInput.
I know there is some mistake in my code. Here is my code how can I act it?
Server- Code
Data_to_display <<- reactive({
switch(input$Data,
"dt_1" = Data1,
"dt_2" = Data2)
})
output$DisplayData <- DT::renderDataTable({
DT::datatable(Data_to_display(), filter="top")
})
UI.Code
------
sidebarLayout(
sidebarPanel(
checkboxGroupInput("show_vars", "Gösterilecek özellikler:",
names(Data), selected = names(Data)),
selectInput("Data", "Choose data:", choices = c("dt_1","dt_2"), selected = "dt_1")
),
mainPanel(
DT::dataTableOutput("DisplayData")
)
Looks like you're calling a reactive input (Data) in the ui. To build dynamic UI that reacts to user input, you can create the UI element on the server and then output the element in the ui.
However, I'm not sure of your exact goal. If you'd like to hide/show columns in the datatable there is a DT extension (colvis) for exactly that purpose.
I've added two examples below -- one with dynamically rendered checkboxes and another with the DT extension for hiding/showing columns.
1) Dynamically created checkboxes:
Data1 <- iris
Data2 <- mtcars
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("Data", "Choose data:",
choices = c("dt_1","dt_2"), selected = "dt_1"),
## render dynamic checkboxes
uiOutput("show_vars")
),
mainPanel(
DT::dataTableOutput("DisplayData")
)
)
)
server <- function(input, output) {
Data_to_display <<- reactive({
switch(input$Data,
"dt_1" = Data1,
"dt_2" = Data2)
})
### create dynamic checkboxes
output$show_vars <- renderUI({
checkboxGroupInput("show_vars", "Gösterilecek özellikler:",
choices = names(Data_to_display()),
selected = names(Data_to_display()))
})
output$DisplayData <- DT::renderDataTable({
DT::datatable(Data_to_display(), filter="top")
})
}
shinyApp(ui, server)
2) DT extension colvis:
Data1 <- iris
Data2 <- mtcars
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("Data", "Choose data:",
choices = c("dt_1","dt_2"), selected = "dt_1")),
mainPanel(
DT::dataTableOutput("DisplayData")
)
)
)
server <- function(input, output) {
Data_to_display <<- reactive({
switch(input$Data,
"dt_1" = Data1,
"dt_2" = Data2)
})
### hide/show columns with built-in DT extension
output$DisplayData <- DT::renderDataTable({
DT::datatable(Data_to_display(), filter = "top",
extensions = 'Buttons',
options = list(dom = 'Bfrtip', buttons = I('colvis')))
})
}
shinyApp(ui, server)

pass object generated in server back to ui in shiny

I need to create an object (or variable( in my server part and pass back into ui checkboxGroupInput. My file is a little complicated. Here I just use diamonds data to illustrate what I'm trying to do, although what the app is doing is meaningless. I created a df, a subset of diamonds dataset. I'm trying to pass it back to the ui checkboxGroupInput, so that I can select what columns to show. My question is how do I pass df back to ui? thanks in advance.
Here is my app.r:
library(shiny)
library(ggplot2)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("nrow", label = h3("number of rows"),
choices = list(5, 10, 20),
selected = 5),
checkboxGroupInput("show_vars", "Columns in diamonds to show:",
names(df), selected = names(df))
),
mainPanel(
DT::dataTableOutput("mytable1")
)
)
)
server <- function(input, output) {
# choose rows to display
df = diamonds[sample(nrow(diamonds), input$nrow), ]
output$mytable1 <- DT::renderDataTable({
DT::datatable(df[, input$show_vars, drop = FALSE])
})
}
shinyApp(ui, server)
Error message:
Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
The specific error you're seeing is because you're trying to use input$nrow outside of any reactive context (as per the error) in this line.
df = diamonds[sample(nrow(diamonds), input$nrow), ]
So this needs to be move into some sort of reactive expression
Also, you can create the UI element inside the server using renderUI and uiOutput functions. That way it's easier to control the UI from the server.
library(shiny)
library(ggplot2)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("nrow", label = h3("number of rows"),
choices = list(5, 10, 20),
selected = 5),
uiOutput(outputId = "show_vars")
),
mainPanel(
DT::dataTableOutput("mytable1")
)
)
)
server <- function(input, output) {
# choose rows to display
df <- reactive({
diamonds[sample(nrow(diamonds), input$nrow), ]
})
output$show_vars <- renderUI({
checkboxGroupInput("show_vars", "Columns in diamonds to show:",
names(df()), selected = names(df()))
})
output$mytable1 <- DT::renderDataTable({
DT::datatable(diamonds[, input$show_vars, drop = FALSE])
})
}
shinyApp(ui, server)

Resources