I'm trying to get the label output in shiny using textOutput function with var_label from the labelled package. I tried a couple of things but I'm not able to view the label in the output. The error I'm getting is Error in var_label.data.frame: object 'var1' not found.
Code:
library(shiny)
library(labelled)
library(haven)
dat <- read_spss("http://staff.bath.ac.uk/pssiw/stats2/SAQ.sav")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("var1", "Frequency Table", choices = names(dat), selected = NULL)
),
mainPanel(
verbatimTextOutput("name"),
textOutput("label")
)
)
)
server <- function(input, output) {
output$name <- renderPrint({
input$var1
})
output$label <- renderText({
var_label(input$var1)
})
}
shinyApp(ui = ui, server = server)
The issue is that input$var1 is the name of the variable. It does not contain any information about the variable in your dataset. To get the label associated with the variable called input$var1 use var_label(dat[[input$var1]]).
Related
G'day awesome community
I am trying to make a dashboard of a dataframe that allows one to filter the dataframe by the levels within a column selected. This means a first pickerInput where the user selects the column, and then a second child pickerInput where the options are generated based on the column selected. I have figured out one way to make the pickerInputs dependent on each other, but for some reason when I try to apply the filtering, my dataframe has zero values and I cant see why?
Please see the reprex created with the mtcars dataset
library(shiny)
library(shinyWidgets)
library(dplyr)
library(DT)
data(mtcars)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(uiOutput('select_filter'),
uiOutput('filter')),
mainPanel(
dataTableOutput('table')
),
))
server <- function(input, output, session) {
data<-mtcars
categories<-c('cyl','vs','am','gear','carb')
output$select_filter <- renderUI({
pickerInput("select_filter", "Select flexi filter",
choices = levels(as.factor(categories))
)})
output$filter <- renderUI({
pickerInput("filter", "Flexi filter",
choices = unique(data[,input$select_filter]),
options = list('actions-box'=TRUE), multiple= TRUE,
selected = unique(data[,input$select_filter]))
})
filtered_data<-
#
reactive ({data %>% filter(input$select_filter %in% input$filter)
})
output$table<-renderDataTable(filtered_data())
}
shinyApp(ui, server)
Any help will be greatly appreciated! If any further information is required please let me know.
Cheers
In filter, use .data to get the column value using select_filter variable. Also included req so that it doesn't error out at the start when the input$select_filter is NULL.
filtered_data <-
reactive ({
req(input$select_filter)
data %>% filter(.data[[input$select_filter]] %in% input$filter)
})
Complete app code -
library(shiny)
library(shinyWidgets)
library(dplyr)
library(DT)
data(mtcars)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(uiOutput('select_filter'),
uiOutput('filter')),
mainPanel(
dataTableOutput('table')
),
))
server <- function(input, output, session) {
data<-mtcars
categories<-c('cyl','vs','am','gear','carb')
output$select_filter <- renderUI({
pickerInput("select_filter", "Select flexi filter",
choices = levels(as.factor(categories))
)})
output$filter <- renderUI({
pickerInput("filter", "Flexi filter",
choices = unique(data[,input$select_filter]),
options = list('actions-box'=TRUE), multiple= TRUE,
selected = unique(data[,input$select_filter]))
})
filtered_data<-
#
reactive ({
req(input$select_filter)
data %>% filter(.data[[input$select_filter]] %in% input$filter)
})
output$table<-renderDataTable(filtered_data())
}
shinyApp(ui, server)
I want to be able to design a set of UI that can call R's built-in functions, but the current problem lies in the data selection when calling the function. I need to return the calculation result of a function to my UI interface so that another function can be arbitrary Select the variables in the current environment as the input of the function. This is my current code. Can anyone give me some suggestions or some cases?
library(shiny)
function_choose = c("sin","cos")
ui <- fluidPage(
selectInput('f', 'function_choose', function_choose,
selected = function_choose[[1]]),
sidebarPanel(
conditionalPanel(condition = "input.f=='sin'",
mainPanel(
selectInput('sin_dat','data',c("I want to show all the variables in the workspace here ")),
actionButton(inputId = "sin_run",label = "RUN")
)
),
conditionalPanel(condition = "input.f=='cos'",
mainPanel(
selectInput('workspace','data',c("I want to show all the variables in the workspace here "))),
actionButton(inputId = "cos_run",label = "RUN")
)
),
mainPanel(
textOutput("text")
)
)
server <- function(input, output,session) {
data <- c(0.1,0.2,0.3)
observeEvent(input$sin_run,{
data_sined <- sin(data)
output$text <- renderText({
"data_sined is created"
})
})
observeEvent(input$cos_run,{
data_cosed<- cos(data)
output$text <- renderText({
"data_cosed is created"
})
})
}
shinyApp(ui = ui, server = server)
I changed the logic of your app to make it less complicated, I hope this is still ok for your purpose. We can use ls() to get a character vector of all variables in the global (or any other) environment. If we define a vector function_choose in the global environment, then this will be available too. We could easily circumvent this by defining the choices argument inside selectInput or by specifying a names pattern that is selected by ls(). Once we have selected a variable, the input$data returns a character vector. To access the underyling data based on a character vector we use get().
library(shiny)
function_choose = c("sin","cos")
shinyApp(
ui = fluidPage(
sidebarPanel(
selectInput('f', 'function_choose', choices = function_choose,
selected = function_choose[1]),
selectInput('data','data', choices = ls()),
actionButton(inputId = "run",label = "RUN")
),
mainPanel(
textOutput("text")
)
),
server = function(input, output,session) {
res <- eventReactive(input$run, {
dat <- get(input$data)
switch(input$f,
sin = sin(dat),
cos = cos(dat)
)
})
output$text <- renderText({
res()
})
})
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
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)
I want to print data set values in R shiny web app. But below code is printing the name of dataset in UI output. How can I print values of dataset?
library(MASS)
library(shinythemes)
library(shiny)
library(ggplot2)
mass.tmp <- data(package = "MASS")[3]
mass.datasets <- as.vector(mass.tmp$results[,3])
ui <- fluidPage(
theme = shinytheme("superhero"),
titlePanel("Linear Regression Modelling"),
sidebarLayout(
sidebarPanel(
selectInput("dsname", "Dataset:",choices = c(mass.datasets))
,
uiOutput("x_axis")
,
tableOutput("tab")
),
mainPanel(
tags$br(),
tags$br()
)
)
)
server <- function(input, output) {
num_ds <- function(ds)
{
nums <- sapply(ds,is.numeric)
num_ds <- ds[,nums]
return(num_ds)
}
ds_ext <- reactive({ num_ds(input$dsname) })
output$tab <- renderTable({ eval(input$dsname) })
# output$x_axis <- renderUI({
# col_opts <- get(ds_ext())
# selectInput("x_axis2", "Independent Variable:", choices = names(col_opts))
# })
}
shinyApp(ui = ui, server = server)
This is full code. I am trying to display data set from MASS package as you see in the code above.