R shinyapp selecting pre-stored data set from checkbox - r

ui <- fluidPage(
checkboxGroupInput("data", "Select data:",
c("Iris" = "iris",
"Cars" = "mtcars")),
plotOutput("myPlot")
)
server <- function(input, output) {
output$myPlot <- renderPlot({
plot(Sepal.Width ~ Sepal.Length, data = input$data)
})
}
shinyApp(ui, server)
I have a shinyApp where I want the user to select a data set. From there, I want to use that data set to make a simple plot. However, it seems that the user input into the checkbox didn't pass in successfully to the server. How can I get around this?

The typical way to do this in shiny is with switch(), which means you don't need to specify the dataset in your input, you can do it all in the server. In your context:
library(shiny)
ui <- fluidPage(
checkboxGroupInput("data", "Select data:",
c("Iris" = "iris",
"Cars" = "mtcars")),
plotOutput("myPlot")
)
server <- function(input, output) {
dat <- reactive({
switch()
})
output$myPlot <- renderPlot({
dat <- switch(input$data,
"iris" = iris,
"mtcars" = mtcars)
plot(Sepal.Width ~ Sepal.Length, data = get(input$data))
})
}
shinyApp(ui, server)
Note that you could use any strings in the checkboxGroupInput, which makes this a more flexible way to work.

Related

Autoplot in shiny with Select Input not working

I'm trying to create an autoplot that will show a plot based on what variable the user selects, but it just shows up as a straight line even though the name on the y axis does change depening on what the user chooses. Here is a basic version of the code:
library(shiny)
library(fpp3)
ui <- fluidPage(
selectInput("select", "Choose variable", choices = names(aus_production)),
plotOutput("plot")
)
server <- function(input,output){
output$plot <- renderPlot({
aus_production %>% autoplot(input$select)
})
}
shinyApp(ui = ui,server = server)
You are calling ?autoplot.tbl_ts and that method requires an expressio for the variable, not a string which is what input$select returns. Instead you can use the .data pronoun
server <- function(input,output){
output$plot <- renderPlot({
aus_production %>% autoplot(.data[[input$select]])
})
}

Can we check shiny applications using testthat and usethis

is there a way to check the below applications. This is a sample application to display selected rows. But in general is there a way to acheive this. For example the below code is perfect. Suppose I may some errors in this and I need to check all in once. Can we do that? I have also pasted the error code down
Correct
library(shiny)
library(DT)
ui <- basicPage(
mainPanel(DT::dataTableOutput('mytable')),
textOutput("selected")
)
server <- function(input, output,session) {
mydata <- reactive({mtcars})
output$mytable = DT::renderDataTable(
datatable(mydata())
)
selectedRow <- eventReactive(input$mytable_rows_selected,{
row.names(mtcars)[c(input$mytable_rows_selected)]
})
output$selected <- renderText({
selectedRow()
})
}
runApp(list(ui = ui, server = server))
Wrong/Error code
library(shiny)
library(DT)
ui <- basicPage(
mainPanel(DT::dataTableOutput('mytable')),
textOutput("selected")
)
server <- function(input, output,session) {
mydata <- reactive({mtcars})
output$mytable = DT::renderDataTable(
datatable(mydata())
)
selectedRow <- eventReactive(input$mytable_rows_selected,{
row.names(mtcars)[c(input$[mytable_rows_selected])]
})
output$selected <- renderText({
selectedRow
})
}
runApp(list(ui = ui, server = server))
I use the package shinytest to test my shiny apps. shinytest uses phantomJS to manipulate the app (i.e. simulate button presses etc.)
An entry in testthat/test-shinyapp.R looks something like:
test_that("Shiny template works", {
app <- shinytest::ShinyDriver$new("Path_To_ShinyApp/"))
# plot changes
# first click makes plot
testthat::expect_false(length(grepl("^(data:image/png;base64)",
app$getAllValues()$output$plot1$src)) > 0)
app$setInputs(apply = "click")
testthat::expect_true(length(grepl("^(data:image/png;base64)",
app$getAllValues()$output$plot1$src)) > 0)
testthat::expect_true(grepl("^(data:image/png;base64)",
app$getAllValues()$output$plot1$src))
# are subsequent changes applied?
testthat::expect_identical(app$getAllValues()$input$xVar, "mpg")
testthat::expect_true(
grepl(" mpg cyl", app$getAllValues()$output$summary1))
app$setInputs(xVar = "drat")
app$setInputs(apply = "click")
testthat::expect_true(
grepl(" drat cyl", app$getAllValues()$output$summary1))
# # test for reactive
# shinytest::expectUpdate(app, xVar = "wt", output = "plot1" )
# shinytest::expectUpdate(app, yVar = "drat", output = "plot1" )
# shinytest::expectUpdate(app, xVar = "cyl", output = "summary1" )
# shinytest::expectUpdate(app, yVar = "mpg", output = "summary1" )
# cleanup
app$stop()
unlink(paste0(ws2us(testDir),"_ShinyApp"), recursive = TRUE)
})

In an Shiny App, I want a plot to update, based on the search results in a datatable.

Say I have a Shiny app with a datatable and a plot. I want to be able to search/filter the datatable, and have a plot reflect the results.
How do I do this? Is this even possible? Is there any way to output the filtered datatable to an object I can use?
Here is a basic shiny application which does not work.
library(DT)
ui <- basicPage(
h2("The mtcars data"),
DT::dataTableOutput("mytable"),
plotOutput('plot1')
)
server <- function(input, output) {
output$mytable = DT::renderDataTable({
datatable(mtcars,filter = 'top')
})
output$plot1 <- renderPlot({
plot(input$mytable$wt, input$mytable$mpg)
})
}
shinyApp(ui, server)
I have edited your code a bit since your way has some mistakes as pointed out by #r2evans.
Anyways, you can get the filtered rows of a datatable using input$tableId_rows_all. It gives the indices of rows on all pages (after the table is filtered by the search strings).
In my code filtered_table() gives you a dataframe object after all search filters are applied. output$test shows this table in real-time.
library(shiny)
library(DT)
ui <- basicPage(
h2("The mtcars data"),
DT::dataTableOutput("mytable"),
verbatimTextOutput("test"),
plotOutput('plot1')
)
server <- function(input, output) {
mc <- head(mtcars) # could be reactive in real world case
output$mytable = DT::renderDataTable({
datatable(mc, filter = 'top')
})
filtered_table <- reactive({
req(input$mytable_rows_all)
mc[input$mytable_rows_all, ]
})
output$plot1 <- renderPlot({
plot(filtered_table()$wt, filtered_table()$mpg, col = "red", lwd = 10)
})
output$test <- renderPrint({
filtered_table()
})
}
shinyApp(ui, server)
Suggestions:
Tour input$mytable reference in output$plot1 is just a string, not a frame like you'd hope, so this needs to be replaced. You can hard-code mtcars, but hard-coding data doesn't really lend to an extensible and interactive experience.
Additionally, since you are going to be showing the same data in two different blocks ($mytable and $plot1), I suggest breaking the data into its own reactive block and referencing that block in the others.
Lastly, I think it's good defensive practice to use req(...) in blocks so that they do not try to execute before the data is available (common when reactive pathways are unclear or the inputs are not set yet).
Try this:
library(DT)
library(shiny)
ui <- basicPage(
h2("The mtcars data"),
DT::dataTableOutput("mytable"),
plotOutput('plot1')
)
server <- function(input, output) {
mydat <- reactive({
# eventually you'll support filtering here
mtcars
})
output$mytable = DT::renderDataTable({
req(mydat())
datatable(mydat(), filter = 'top')
})
output$plot1 <- renderPlot({
req(mydat())
plot(mydat()$wt, mydat()$mpg)
})
}
shinyApp(ui, server)

attempt to apply non-function

I'm trying to build a simple application that draws a histogram of a selected variable based on a subset filtered by the other input. I get the error in the line hist(dataX()$datasetInput()) which should return dataX$mpg. How can I fix it?
Full code:
library(shiny)
u <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(
selectInput("variable", "Variable:",
list("Milles/gallon",
"Horse power")
),
textInput("nc","Number of cylinders",value = 6)
),
mainPanel(
plotOutput("Plot")
)
))
s <- shinyServer(function(input, output)
{
dataX <- reactive({mtcars[mtcars$cyl==input$nc,,drop = FALSE]})
datasetInput <- reactive({
switch(input$variable,
"Milles/gallon" = mpg,
"Horse power" = hp)
})
output$Plot <- renderPlot({
hist(dataX()$datasetInput())
})
})
shinyApp(u,s)
You complicated the simple app.
You do not need to list all the columns in selectInput. You can just render it from the server side.
Same applies to the cylinders
Shortcuts like u and sare acceptable, but just stick to the naming conventions. It makes your life easy.
Below is a complete working app
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(uiOutput("SelectColname"),
uiOutput("Cylinders")),
mainPanel(plotOutput("Plot"))
))
server <- shinyServer(function(input, output){
# Create a reactive dataset
dataX <- reactive({
mtcars
})
# Output number cylinders as select box
output$Cylinders <- renderUI({
selectInput("cylinders", "cylinders:", unique(dataX()$cyl))
})
# Output column names as selectbox
output$SelectColname <- renderUI({
selectInput("variable", "Variable:", colnames(dataX()[,c(1,4)]))
})
# Based on the selection by user, create an eventreactive plotdata object
plotdata <- eventReactive(input$cylinders, {
plotdata = dataX()[dataX()$cyl == input$cylinders, , drop = FALSE]
})
# Render the plot, the plot changes when new cylinder is selected
output$Plot <- renderPlot({
if (is.null(plotdata()))
return(NULL)
hist(
plotdata()[, input$variable],
xlab = input$variable,
main = paste(
"Histogram of" ,
input$variable
)
)
})
})
shinyApp(ui, server)

Mouse click event in rshiny

I'm trying to use click events using the plot_click option in RShiny. What I want to do is:I want to select a particular bubble from the first chart and then the chart below should be populated only for the above selected car. How to do this? Here is my code :
ui <- basicPage(
plotOutput("plot1", click = "plot_click"),
plotOutput("plot2")
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(mt$wt, mt$mpg)
})
output$plot2 <- renderPlot({
test <- data.frame(nearPoints(mt, input$plot_click, xvar = "wt", yvar = "mpg"))
test2 <- filter(test,Car_name)
car <- test2[1,1]
mt2 <- filter(mt,Car_name == car)
plot(mt2$wt,mt2$mpg)
})
}
shinyApp(ui, server)
I rearranged your server-function a bit. I moved the selected points to a reactive Value, which can be used by print/plot outputs.
Furthermore, i am not exactly sure what you want to achievewith all that filtering. Maybe you could change your original question an make a reproducible example out of it with the mtcars-data, as it seems you are using that.
library(shiny)
ui <- basicPage(
plotOutput("plot1", click = "plot_click"),
verbatimTextOutput("info"),
plotOutput("plot2")
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(mtcars$wt, mtcars$mpg)
})
selected_points <- reactiveValues(pts = NULL)
observeEvent(input$plot_click, {
x <- nearPoints(mtcars, input$plot_click, xvar = "wt", yvar = "mpg")
selected_points$pts <- x
})
output$info <- renderPrint({
selected_points$pts
})
output$plot2 <- renderPlot({
req(input$plot_click)
test <- selected_points$pts
plot(test$wt,test$mpg)
})
}
shinyApp(ui, server)
The clicked points are stored in the selected_points reactive Value, which is assigned in the observeEvent function.
If you filter a lot in the plot2-function, you would have to use req() or validate(), as it may be possible that no value is left over and therefore nothing can be plotted.
I hope that helps.

Resources