Home > Software engineering >  Shiny Dynamic Variable Plotting Using Modularity
Shiny Dynamic Variable Plotting Using Modularity

Time:10-20

I am trying to make a Shiny dashboard that lets the user select a variable for a scatter plot using modules. I have five files/modules to separate different tabs:

global.R

server_tab1.R

server.R

ui_tab1.R

ui.R

Only the first tab is shown here but you get the idea. I think I may have messed up with the namespace but I am lost here. input$metric from server_tab1.R is the part that is not working.

#### 1. global.R
### Packages
library(shiny)
library(shinydashboard) 
library(shinycssloaders) 
library(shinyWidgets) 
library(reactable)
library(tidyverse)
library(ggplot2)
library(plotly)

### Import modules
## Tab 1
source("ui_tab1.R", local = T)
source("server_tab1.R", local = T)

### Custom variable names for plotting
varnames <- c(
  "Sepal Length" = "Sepal.Length",
  "Sepal Width" = "Sepal.Width",
  "Petal Length" = "Petal.Length",
  "Petal Width" = "Petal.Width"
)

### Functions
fun1 <- function(df, var1, var2) {
  req(df, var1, var2)
  ggplot(df, aes_string(var1, var2))  
    geom_point()  
    labs(x = var1, y = names(varnames[which(varnames == var2)])) 
}
#### 2. server_tab1.R
### Plot
plotTab1Server <- function(id) {
  moduleServer(id, function(input, output, session) {
    output$plot_tab1 <- renderPlotly({
      # fun1(df = iris, var1 = "Sepal.Length", var2 = "Sepal.Width") # Works without using input$metric
      fun1(df = iris, var1 = "Sepal.Length", var2 = input$metric) # Does not work
    })
    
  })
}
#### 3. server.R
plotTab1Server("plot_ui_tab1")
#### 4. ui_tab1.R
### Inputs
metricDropdownTab1UI <- function(id) {
  ns <- NS(id)
  
  pickerInput(
    ns("metric"),
    "Metric:",
    choices = varnames
  )
}

### Plot
plotTab1UI <- function(id) {
  ns <- NS(id)
  
  tagList(
    plotlyOutput(ns("plot_tab1"))
  )
}
#### 5. ui.R
dashboardPage(
  
  ### Upper navigation bar
  dashboardHeader(
    title = "Title",
    titleWidth = 230
  ),
  
  ### Left side bar
  dashboardSidebar(
    collapsed = F,
    
    sidebarMenu(
      menuItem("tab1", tabName = "tab1", icon = icon("table"))
    )
  ),
  
  ### Body
  dashboardBody(
    shinyjs::useShinyjs(),
    
    tabItems(
      tabItem(
        tabName = "tab1",
        
        metricDropdownTab1UI("metric_dropdown_ui_tab1"), 
        plotTab1UI("plot_ui_tab1")
        
      ) # tab1 - tabItem
    ) # tab1 - tabItems
  ) # dashboardBody
) # dashboardPage

CodePudding user response:

The issue is that you use a different id in metricDropdownTab1UI than in the module server, i.e. it should be "plot_ui_tab1" instead of "metric_dropdown_ui_tab1".

library(shiny)
library(shinydashboard) 
library(shinyWidgets)
library(tidyverse)
library(ggplot2)
library(plotly)

### Custom variable names for plotting
varnames <- c(
  "Sepal Length" = "Sepal.Length",
  "Sepal Width" = "Sepal.Width",
  "Petal Length" = "Petal.Length",
  "Petal Width" = "Petal.Width"
)

### Functions
fun1 <- function(df, var1, var2) {
  req(df, var1, var2)
  ggplot(df, aes_string(var1, var2))  
    geom_point()  
    labs(x = var1, y = names(varnames[which(varnames == var2)])) 
}

plotTab1Server <- function(id) {
  moduleServer(id, function(input, output, session) {
    output$plot_tab1 <- renderPlotly({
      fun1(df = iris, var1 = "Sepal.Length", var2 = input$metric)
    })
    
  })
}

metricDropdownTab1UI <- function(id) {
  ns <- NS(id)
  
  pickerInput(
    ns("metric"),
    "Metric:",
    choices = varnames
  )
}

plotTab1UI <- function(id) {
  ns <- NS(id)
  
  tagList(
    plotlyOutput(ns("plot_tab1"))
  )
}

ui <- dashboardPage(
  dashboardHeader(
    title = "Title",
    titleWidth = 230
  ),
  dashboardSidebar(
    collapsed = F,
    
    sidebarMenu(
      menuItem("tab1", tabName = "tab1", icon = icon("table"))
    )
  ),
  dashboardBody(
    shinyjs::useShinyjs(),
    
    tabItems(
      tabItem(
        tabName = "tab1",
        metricDropdownTab1UI("plot_ui_tab1"), 
        plotTab1UI("plot_ui_tab1")
        
      ) # tab1 - tabItem
    ) # tab1 - tabItems
  ) # dashboardBody
) # dashboardPage

server <- function(input, output, session) {
  plotTab1Server("plot_ui_tab1")
}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:5359

  • Related