I am having problems rendering any visualizations on Shiny. I tried many different plots, none of them worked. Here is the code:
library(shiny)
ui <- fluidPage("Comex",
selectInput("paises","Selecione o Destino da Exportação",PAISES$NO_PAIS, selected = PAISES$NO_PAIS[55]),
plotlyOutput(outputId = "table"))
server <- function(input, output){
output$table <- renderTable({
p <- RPostgres::dbGetQuery(con, paste0("SELECT CO_ANO, NO_PAIS, SUM(VL_FOB)
FROM comex
INNER JOIN paises ON comex.CO_PAIS = paises.CO_PAIS
WHERE (SG_UF_MUN = 'AL') AND (NO_PAIS = '",input$paises,"')
GROUP BY NO_PAIS, CO_ANO"))
View(p)
})}
shinyApp(ui, server)
The SQL command seems fine, as I successfully extracted data with this very code outside the shinyApp structure.
The return value from View(.) is NULL, so your renderTable will always be blank; just make it p.
If your ui contains plotlyOutput then replace renderTable with plotly::renderPlotly. The ui-component for shiny::renderTable is shiny::tableOutput.
renderTable is intended for a tabular display of data.frame-like data, not a plot.
Choose either:
ui <- fluidPage(
...,
tableOutput("table")
...
)
server <- function(input, output, session) {
output$table <- renderTable({
# code that returns a data.frame
})
}
or
ui <- fluidPage(
...,
plotlyOutput("myplot")
...
)
server <- function(input, output, session) {
output$myplot <- plotly::renderPlotly({
# ...
plot_lt(...)
})
}
Related
How do I replace the callModule() in this example with the recommended use where the moduleServer is wrapped in another function as the syntax is easier to read than the callModule.
This is the advise on the help page:
Starting in Shiny 1.5.0, we recommend using moduleServer instead of
callModule(), because the syntax is a little easier to understand, and
modules created with moduleServer can be tested with testServer().
The goal is to pass the data.frame created in the module to the parent shiny server function is that it can be used there and in other modules. Any suggestions on how to improve the code below?
# Module UI
moduleUI <- function(id) {
ns <- NS(id)
fluidRow(
actionButton(ns("generate_data"), "Generate data"),
dataTableOutput(ns("data_table"))
)
}
# Module server
moduleServer <- function(input, output, session) {
data_reactive <- reactive({
if(input$generate_data == 0) return(NULL)
data.frame(x = rnorm(10), y = rnorm(10))
})
output$data_table <- renderDataTable({
data_reactive()
})
return(data_reactive)
}
# Parent UI
ui <- fluidPage(
moduleUI("data_module"),
tableOutput("data_table")
)
# Parent server
server <- function(input, output, session) {
data_module <- callModule(moduleServer, "data_module")
output$data_table <- renderTable({
data_module()
})
}
shinyApp(ui, server)
moduleServer is the name of a function in Shiny, do not use it as a personal function. Here is how to use it:
myModuleServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
data_reactive <- reactive({
if(input$generate_data == 0) return(NULL)
data.frame(x = rnorm(10), y = rnorm(10))
})
output$data_table <- renderDataTable({
data_reactive()
})
return(data_reactive)
}
)
}
Then call myModuleServer("data_module") in the main server function.
Suppose I have the following shiny app that renders a data table from the package DT:
library(shiny)
ui <- fluidPage(uiOutput("abc"))
server <- function(input, output, session) {
output$abc <- renderUI({DT::dataTableOutput("dt_output")}) # line 4
output$dt_output <- DT::renderDataTable({data.table(a = 1:3, b = 4:6)}) # line 5
}
runApp(list(ui = ui, server = server))
How would you combine lines 4 and 5, with the constraint that output$abc must remain a uiOutput?
My attempt at combining (the code below) led to an error, "cannot coerce type closure":
output$abc <- renderUI({DT::dataTableOutput(
DT::renderDataTable({data.table(a = 1:3, b = 4:6)}))})
This should work:
library(shiny)
ui <- fluidPage(
uiOutput("abc")
)
server <- function(input, output, session) {
output$abc <- renderUI({
output$aa <- DT::renderDataTable(head(mtcars))
DT::dataTableOutput("aa")
})
}
runApp(list(ui = ui, server = server))
I'm making an app in which the user can create as many tables as he/she wants and display the code necessary to remake each individual table using shinymeta. I can generate the code for each of these tables but I have a problem when I want to create a complete modal that shows every code for each table.
To be clearer, here's a reproducible example:
library(shiny)
library(dplyr)
library(shinymeta)
module_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("show_table"), "Show table"),
actionButton(ns("show_code"), "Show code"),
tableOutput(ns("table"))
)
)
}
module_server <- function(input, output, session){
data <- metaReactive2({
req(input$show_table)
isolate(metaExpr({
mtcars
}))
})
data2 <- metaReactive({
..(data()) %>%
select(mpg)
})
output$table <- renderTable({
data2()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data(), data2())
})
))
})
return(data())
}
ui <- fluidPage(
actionButton("launch", "Launch"),
actionButton("show_full_code", "Show the full code (at least 2 'launch' before)")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#show_full_code",
where = "afterEnd",
ui = module_ui(paste0("x", count$value)))
callModule(module_server, paste0("x", count$value))
})
#### "Merge" the single code modals in one big
observeEvent(input$show_full_code, {
showModal(modalDialog(
renderPrint({
expandChain(x1_data)
})
))
})
}
shinyApp(ui, server)
When you click on "Launch", two buttons are generated and you can display a table ("Show table") and the code to remake this table ("Show code"). You can click on "Launch" indefinitely and the table will be named x1_data, x2_data, etc.
However, when I try to generate the code that unites every individual code (by clicking on "Show the full code"), x1_data is not found. Using x1_data() does not work either. I'm not a fan of asking two questions in one post but I will do this now:
How can I access the reactive elements created inside modules?
How can I "merge" every individual code in a big one?
Also asked on RStudio Community
Edit: following a comment, I add a second reactive expression in my example, so that I can't use return on both of them.
Ok, I came up with an answer that has the module return the expandChain() results rather than trying to render them again in the server:
library(shiny)
library(dplyr)
library(shinymeta)
module_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("show_table"), "Show table"),
actionButton(ns("show_code"), "Show code"),
tableOutput(ns("table"))
)
)
}
module_server <- function(input, output, session){
data <- metaReactive2({
req(input$show_table)
isolate(metaExpr({
mtcars
}))
})
data2 <- metaReactive({
..(data()) %>%
select(mpg)
})
output$table <- renderTable({
data2()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data(), data2())
})
))
})
########################################
### create list of reactive objects ####
########################################
return(list(
expandChain(data(), data2())
)
)
}
ui <- fluidPage(
actionButton("launch", "Launch"),
actionButton("show_full_code", "Show the full code (at least 2 'launch' before)")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#show_full_code",
where = "afterEnd",
ui = module_ui(paste0("x", count$value)))
callModule(module_server, paste0("x", count$value))
})
#### "Merge" the single code modals in one big list object
my_data <- reactive({
req(count$value)
my_set <- 1:count$value
### lapply through the different name spaces so all are captured ###
final <- lapply(my_set, function(x){
temp <- callModule(module_server, paste0("x", x))
return(temp)
})
return(final)
})
#### "Merge" the single code modals in one big
observeEvent(input$show_full_code, {
showModal(modalDialog(
renderPrint({
temp <- sapply(unlist(my_data()), function(x){
print(x)
})
})
))
})
}
shinyApp(ui, server)
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)
In figuring out how to use the new shiny modules, I would like to emulate the following app. When the rows of the datatable are clicked and unclicked, it updates the entries in the selectInput box, using updateSelectInput.
library(shiny)
## prepare dataframe -----------------------------------------------------------
df <- mtcars
df$model <- rownames(df)
rownames(df) <- NULL
df <- df[1:10, c(12, 1:5)]
car_names <- data.frame(df$model)
## app -------------------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput('car_input', 'Select car:', df$model, multiple = TRUE)
),
mainPanel(
DT::dataTableOutput('table')
)
)
)
server <- function(input, output, session, ...) {
output$table <- DT::renderDataTable(df)
car_rows_selected <- reactive(car_names[input$table_rows_selected, ])
observe({ updateSelectInput(session, 'car_input', selected = car_rows_selected()) })
}
shinyApp(ui = ui, server = server)
I have got most of the way there, but am having difficulty with updating the input box. I wonder if it has something to do with the way the namespaces work, and perhaps requires a nested call to the DFTable module within the Car module, but I'm not sure. I am able to add a textOutput element that prints the expected information from the selected table rows. My code for a single file app is below:
library(shiny)
## prepare dataframe -----------------------------------------------------------
df <- mtcars
df$model <- rownames(df)
rownames(df) <- NULL
df <- df[1:10, c(12, 1:5)]
car_names <- data.frame(df$model)
## select module ---------------------------------------------------------------
CarInput <- function(id){
ns <- NS(id)
selectInput(ns('car_input'), 'Select car:', df$model, multiple = TRUE)
}
Car <- function(input, output, session, ...) {
# I was thinking perhaps I needed to call the DFTable module as a nested module within this Car module
car_rows_selected <- callModule(DFTable, 'id_inner')
observe({ updateSelectInput(session, 'car_input', selected = car_rows_selected()) })
}
## datatable module ------------------------------------------------------------
DFTableOutput <- function(id){
ns <- NS(id)
DT::dataTableOutput(ns('table'))
}
DFTable <- function(input, output, session, ...){
output$table <- DT::renderDataTable(df)
return(reactive(car_names[input$table_rows_selected, ]))
}
## app -------------------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
CarInput('id_car'),
textOutput('selected') # NB. this outputs expected values
),
mainPanel(
DFTableOutput('id_table')
)
)
)
server <- function(input, output, session, ...) {
callModule(Car, 'id_car')
callModule(DFTable, 'id_table')
output$selected <- callModule(DFTable, 'id_table') # NB this works as expected (see textOutput in ui section above)
car_rows_selected <- callModule(DFTable, 'id_table')
observe({ updateSelectInput(session, 'car_input', selected = car_rows_selected()) })
}
shinyApp(ui = ui, server = server)
Any help would be greatly appreciated
OK, a little more trial and error got me to the right answer - the car_rows_selected item needed to be given the double arrow <<- operator in the app server function in order for it to be useable in the Car module: look for the car_rows_selected <<- callModule(DFTable, 'id_table') in the server function
library(shiny)
## prepare dataframe -----------------------------------------------------------
df <- mtcars
df$model <- rownames(df)
rownames(df) <- NULL
df <- df[1:10, c(12, 1:5)]
car_names <- data.frame(df$model)
## select module ---------------------------------------------------------------
CarInput <- function(id){
ns <- NS(id)
selectInput(ns('car_input'), 'Select car:', df$model, multiple = TRUE)
}
Car <- function(input, output, session, ...) {
observe({ updateSelectInput(session, 'car_input', selected = car_rows_selected()) })
}
## datatable module ------------------------------------------------------------
DFTableOutput <- function(id){
ns <- NS(id)
DT::dataTableOutput(ns('table'))
}
DFTable <- function(input, output, session, ...){
output$table <- DT::renderDataTable(df)
reactive(car_names[input$table_rows_selected, ])
}
## app -------------------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
CarInput('id_car')
),
mainPanel(
DFTableOutput('id_table')
)
)
)
server <- function(input, output, session, ...) {
callModule(Car, 'id_car')
car_rows_selected <<- callModule(DFTable, 'id_table')
}
shinyApp(ui = ui, server = server)
I'm still getting my head around the way module namespaces work - perhaps this isn't the most "correct" approach but at least it works - happy to accept a more appropriate answer if someone posts one later