I am trying to develop a Shiny app, a simple one. My intention at this point is to create a table and filter that table by various inputs.
Right now this is my code:
library("shiny")
library("gapminder")
library("ggplot2")
library("colourpicker")
library("plotly")
ui <- fluidPage(
h1("Demo"),
sliderInput(inputId = "valor", label = "Rango ",
min = min(data$value), max = max(data$value),
value = c(min(data$value), max(data$value))),
selectInput(inputId = "opc", label = "Measurements", choices = levels(data$measurement)),
tableOutput("table")
)
server <- function(input, output) {
output$table <- renderTable({
data <- data
data <- subset(
data,
value >= input$valor[1] & value <= input$valor[2]
)
data <- subset(
data,
measurement == input$opc
)
data
})
}
levels(data$measurement)
shinyApp(ui, server)
as you can see, very simple. However, this code returns the table empty and the selectInput with no options of selection. However, if I put the values of the column by hand, the code works fine!
selectInput(inputId = "opc", label = "Measurements", choices = c("heart_rate","oxygen_saturation")),
The code above works great, the table suddenly displays data again and it filters correctly. I just don't get it! The sliderInput works great as well. The data set has been included as an enviroment variable.
This are the two different outputs (first picture with written values, second picture using levels(data$measurement)):
Why is this happening to me?!
I have a double problem creating a simple Shiny app. I know this topic was covered in several other questions, but having studied them, I havent found a question that would fully cover my problems.
I want to render mtcars table (full 32 rows as a default option) and then I want to apply a reactive filter on the number of gears with multiple selection allowed.
The following code doesnt work in a number of ways:
The mtcars table is not rendered unless filter on gears is set. Instead -I got an error message in the app: "Result must have length 32, not 0"
Choosing multiple gears levels does not add up correctly. When I select each gear number separately, the table is rendered correctly, but, lets say, when I combine to show gear number 3 and 4, I got only 10 rows return, which is incorrect.
I appreciate your help in advance.
ui <- fluidPage(
sidebarLayout(
mainPanel(
selectInput("pickvalue", label = "Gears", mtcars$gear,
selected = NULL, multiple = T)),
tableOutput("tableOut")
)
)
server <- function(input, output, session){
gears <- reactive({
mtcars %>% filter(gear == input$pickvalue) %>% select(-gear)
})
output$tableOut<- renderTable({gears()
})
}
shinyApp(ui = ui, server=server)
The key to your problems are
Create an if statement when your input is NULL (i.e. when you first open the app) that will just spit out the dataset
When selecting multiple inputs, you need to use %in% operator
See code below:
ui <- fluidPage(
sidebarLayout(
mainPanel(
selectInput("pickvalue", label = "Gears", unique(mtcars$gear),
selected = NULL, multiple = T)),
tableOutput("tableOut")
)
)
server <- function(input, output, session){
gears <- reactive({
dat <- mtcars
if (!is.null(input$pickvalue)){dat <- dat %>% filter(gear %in% input$pickvalue)}
dat <- dat %>% select(-gear)
return(dat)
})
output$tableOut<- renderTable({gears()})
}
shinyApp(ui = ui, server=server)
I've created an R Shiny application to help me streamline some common data cleaning tasks for working with high dimensional chemical composition data. Specifically, this app uses the fluidPage ui and ggplot/plotly interface to create a biplot with user selected X and Y variables and color/symbol attributes. The event_data function allows users to see attributes associated with points they interactively select via the rectangular selection or lasso. I'm new to Shiny so the code is not very elegant but I've managed to do all of the above.
I'm hoping to add one additional feature and I'm stuck on the best way to approach this. Specifically I'd like to be able to change one field in the dataset for points that are currently selected on a given plot. My current idea is to have a text field input that will allow me to type in what I'd like the new value in the field and have the change execute with an actionButton.
I found the answers to the question linked here quite useful but I still haven't managed to get this to work. Below is my current application script and a screenshot of the output as it stands now.
Any help or suggestions for new approaches would be greatly appreciated.
library(plotly)
library(shiny)
library(knitr)
library(kableExtra)
myApp <- function(attributes,dat1) {
dataset <- cbind(attributes,dat1)
ui <- fluidPage(
plotlyOutput('plot', width='1000px', height='600px'),
fluidRow(
column(2,
selectInput('xvar','X',names(dat1)),
selectInput('yvar','Y',names(dat1))),
column(3,offset=0.5,
selectInput('Code','GROUP',names(attributes)),
checkboxInput('Conf','Confidence Hull',value=TRUE)),
column(3,offset=0.5,
actionButton('Change','Change Group Assignment'),
textInput('NewGroup', label = 'Enter new group designation')),
column(3,offset=0.5,
actionButton("exit", label = "Return to R and write data"))),
verbatimTextOutput('brush')
)
server <- function(input, output) {
data.sel <- reactive({
dataset[,c(input$xvar,input$yvar,input$Code)]
})
output$plot <- renderPlotly({
p <- ggplot(data.sel(), aes(x=data.sel()[,1], y=data.sel()[,2],
color=data.sel()[,3], shape=data.sel()[,3])) +
geom_point() +
labs(x=input$xvar,y=input$yvar)
if(input$Conf) {p <- p + stat_ellipse(level=0.95)}
ggplotly(p) %>% layout(dragmode = 'select')
})
output$brush <- renderPrint({
d <- event_data('plotly_selected')
dd <- round(cbind(d[[3]],d[[4]]),3)
vv <- attributes[which(round(data.sel()[,1],3) %in% dd[,1] &
round(data.sel()[,2],3) %in% dd[,2]),]
if (is.null(d)) 'Click and drag events (i.e., select/lasso) appear here
(double-click to clear)' else kable(vv)
})
observe({
if(input$exit > 0)
stopApp()})
}
runApp(shinyApp(ui, server))
return(dataset)
}
In order to test this you can use a modified version of the iris data as I show below. Essentially, I'd like to be able to change the text in the new variable I'm adding to the iris data.
iris2 <- cbind(iris,rep('A',150))
names(iris2)[6] <- 'Assignment'
myApp(iris2[,5:6],iris2[,-(5:6)])
Here is a screenshot of the app in action. I've included the buttons to go along with my proposed solution but they currently do nothing.
Screenshot:
I was able to get this working as I originally intended once I understood how scoping assignment works in Shiny in relation to reactive statements. This app now mostly does everything I want it do, though I feel the code is really just cobbled together at this point and needs to be fixed in many areas. In particular I have a very janky solution to finding the selected items in my original dataframe as I really don't like the curvenumber/pointnumber index system.
library(plotly)
library(shiny)
library(knitr)
library(kableExtra)
theme_set(theme_light())
myApp <- function(attributes,dat1) {
dataset <- cbind(attributes,dat1)
vv <- NULL
ui <- fluidPage(
plotlyOutput('plot', width='1000px', height='600px'),
fluidRow(
column(2,
selectInput('xvar','X',names(dat1),selected='cs'),
selectInput('yvar','Y',names(dat1),selected='ta')),
column(3,offset=0.5,
selectInput('Code','GROUP',names(attributes),selected='CORE'),
checkboxInput('Conf','Confidence Elipse',value=TRUE),
sliderInput('int.set','Set Confidence Interval',min=0.80,max=0.99,step=0.01,value=0.95)),
column(3,offset=0.5,
br(),
actionButton('Change','Change Group Assignment'),
textInput('NewGroup', label = 'Enter new group designation')),
column(3,offset=0.5,
br(),
actionButton('refresh', label='Refresh Plot with New Assignments'),
br(),br(),
actionButton("exit", label = "Return to R and write data"))),
verbatimTextOutput('brush')
)
server <- function(input, output) {
values <- reactiveValues(vv = NULL)
data.sel <- reactive({
dataset[,c(input$xvar,input$yvar,input$Code)]
})
output$plot <- renderPlotly({
g1 <- data.sel()
p <- ggplot(g1, aes(x=g1[,1], y=g1[,2], color=g1[,3], shape=g1[,3])) +
geom_point() +
labs(x=input$xvar,y=input$yvar,color=input$Code,shape=input$Code)
if(input$Conf) {p <- p + stat_ellipse(level=input$int.set)}
ggplotly(p) %>% layout(dragmode = 'select')
})
output$brush<- renderPrint({
g1 <- data.sel()
d <- event_data('plotly_selected')
dd <- round(cbind(d[[3]],d[[4]]),3)
vv <- attributes[which(round(g1[,1],3) %in% dd[,1] & round(g1[,2],3) %in% dd[,2]),]
vv <<- vv
if (is.null(vv)) "Click and drag events (i.e., select/lasso) appear here (double-click to clear)" else kable(vv)
})
observeEvent(input$Change > 0, {
if (!is.null(vv)) {
dataset[which(row.names(dataset) %in% row.names(vv)),]$CORE <<-
input$NewGroup
}})
observe({
if(input$exit > 0)
stopApp()})
}
runApp(shinyApp(ui, server))
return(dataset)
}
And some test data
data(iris)
iris2 <- cbind(iris,rep('a',nrow(iris)))
names(iris2)[6] <- 'CORE'
out <- myApp(iris2[,5:6],iris2[,1:4])
I'm building a dashboard with a bar graph that displays the average score in a certain skill or group of skills. The data needs to be filtered by several characteristics chosen in selectInput menus, as in this example (http://shiny.rstudio.com/gallery/movie-explorer.html).
Since the menu options are slightly different from the levels of the variable, I'm using the answer to this question as a guide (Filtering from selectInput in R shiny). Using the code below, I get the error in the title: "Error in UseMethod: no applicable method for 'format_vec_csv' applied to an object of class "logical"."
It's a class issue, which seems to be backed up by the one Google result I found for this error (https://github.com/rstudio/ggvis/issues/303). I'm not sure how to go about fixing it.
Ultimately, I'd also like to have the option of presenting choices different from the levels in the data. Found this discussion (Setting shiny selectInput from data.frame) but haven't been able to implement it.
Fake data:
library(dplyr)
SurvDoer <- c(rep("self", 4), rep("coach", 4), rep("mentor", 4))
Competency <- c(rep("vision", 6), rep("goals", 6))
Score <- rep(c(2,3,4,5), 3)
fake<-data_frame(SurvDoer, Competency, Score)
Code:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("choose_source")
),
mainPanel(
ggvisOutput("avg_bar")
)
)
)
server <- function(input, output, session) {
#Data
db <- reactive ({
fake <- fake %>%
group_by(Competency) %>%
summarise_(avg = interp(~ mean(x, na.rm=TRUE), x=as.name("Score")))
data.frame(fake)
})
#Render selectInput
output$choose_source <- renderUI({
sourceOpts <- as.vector(unique(db()$SurvDoer))
selectInput("source", "Survey Respondent", choices=sourceOpts, multiple=TRUE)
})
dataset <- reactive({
subset(db(), SurvDoer %in% input$source)
})
vis <- reactive({
dataset %>%
ggvis(~Competency, ~avg) %>%
layer_bars()
})
vis %>% bind_shiny("avg_bar")
}
shinyApp(ui, server)
PROBLEM SYNOPSIS: I have a shiny app I am building where I am trying to support database calls that drive dynamic lists of choices for selectInputs and where that dynamic input drives what a ggvis plot shows. The dynamic selectInput is not correctly selected and filtering the ggvis plot
QUESTION: How can I support dynamic drop down lists while still ensuring my ggvis plot filters based on the chosen item?
PROBLEM DETAIL:
Within my Server.R file I have a reactive that grabs a slice of data from the database. The get_chunk function is a call to NEO4J that I know works:
shinyServer( function(input, output, session) {
CURRENT_CHUNK <- reactive({
#call NEO4J
chunk <- get_chunk(some_list = input$chunk)
return(chunk)
})
I also have a reactive that simply filters down the data based on the ui choices on the front end. The input$A value is the chosen value from a dynamically built dropdown list. The filter_reactive is below. NOTE: I've separated these two so I don't have to call the database all the time; only when I choose a different CHUNK. The filter reactive looks like the following:
NO_DB_REACTIVE <- reactive({
#react to current_chunk and pull back a chunk.
filter_down <- CURRENT_CHUNK()
#check for nulls
if (!is.null(chunk)) {
if (input$A != "All") {filter_down <- filter_down %>% filter(A == input$A)}
return(filter_down)
}
return(filter_down)
})
The input$A value is generated dynamically as follows within the server.R file:
# reactively /dynamically generated the choices for the channel owners
output$owner_choices <- renderUI({ selectInput("A", "FOR Owner"
, as.list(c("All",unique(CURRENT_CHUNK()[,'owner'] )))
, "All") })
I also have a reactive that generates my GGVIS plot that looks like the following:
#All of the visualizations
MY_VIS <- reactive({
# Lables for axes
yvar_name <- names(display_choices)[display_choices == input$yvar]
xvar_name <- names(cat_choices)[cat_choices == input$xvar]
#retrieving
yvar <- prop("y", as.symbol(input$yvar))
xvar <- prop("x", as.symbol(input$xvar))
CURRENT_CHUNK %>%
ggvis(x = xvar, y = yvar) %>%
layer_bars() %>%
add_axis("x", title = xvar_name, properties = axis_props(labels = list(angle = 45, align = "left", fontSize = 10))) %>%
add_axis("y", title = yvar_name) %>%
set_options(width = 900, height = 300)
})
I tried to slim this down as much as possible. There is some dynamic choosing of axes there but you get the point. Notice I currently call CURRENT CHUNK within the MY_VIS reactive. And the end of the file has these:
output$table <- renderDataTable({ NO_DB_REACTIVE() })
MY_VIS %>% bind_shiny("my_vis")
When I filter items this way I get no errors. My table filters on input$A changes and the vis does not; I want the vis to change based on what input$A is as well.
I originally tried having MY_VIS depend on NO_DB_REACTIVE. This fails as input$A is never generated. I guess because CURRENT_CHUNK never runs as it doesn't have to. Notice the output$owner_choices is generated by reacting to CURRENT_CHUNK() not NO_DB_REACTIVE().
KEY QUESTION: How can I set this up so my input$A value is available when I want to filter my ggvis plot?