Phil Lina
Phil Lina

Reputation: 1

Modularising Shiny Dynamic UI Input with Rhino

I have modularised my codes. I am using the Rhino framework. I have a logic module, a view and main. The idea is my logic uses tidyr to nest a dataframe that is supplied through fileinput as a csv and which includes several countries, with sales vs cost data for each country. So create_nested_df nests by country.

I am using bslib and bs4Dash for my UI.

# app/logic/wrangling_functions.R

#' @export
create_nested_df <- function(df){ 
    df |> group_by(country) |> nest()
}

#' @export
plot_country_df <- function(df, market){ 
    df |> filter(country==market) |> ggplot(aes(x=cost, y=sales)) + geom_point()
}

I want my view reactive module to send to my ui a vector of possible countries contained in df and for this to be the input for filtering the ggplot output.

# app/view/graph.R

#' @export
ui <- function(id){

ns <- NS(id)

uiOutput(ns("country_options"))

}

#' @export
server <- function(id, nested_df){
    moduleServer(id, function(input, output, session){

    output$country_options <- renderUI({
           req(nested_df())
           countries <- nested_df() |>
                pull(country) |>
                unique() |>
                sort()
 
             selectInput(inputId=session$ns("market"),
                "Select Market",
                choices=countries,
                selected = "GB")

           })


    output$GlobalPlot <- renderPlot({

            req(nested_df)

            tmp.df <- nested_country_df() |>
                filter(country==input$market)

            tmp.plot <- wrangling_functions$plot_country_df(df=tmp.df,
                                                    market=input$market)

            return(tmp.plot)
                
                    })

I have managed to make this work in monolith app.R scripts but modularising this complicates this step, what am I missing?

# app/main.R

box::use(app/logic/wrangling_functions,
         app/view/graph)


#' @export
ui <- function(id) {

  ns <- NS(id)

  dashboardPage(
    header=dashboardHeader(),
    sidebar=dashboardSidebar(),
    body=bs4TabItems(
      bs4TabItem(fluidRow(sidebar=boxSidebar(
              id="boxSidebar",
              startOpen=T,
              maximizable=T,
              width=25,
              icon=icon("filter"),
              h5("Refine your visualisation"),
              p("Use this to toggle the country"),
              graph$ui(ns("country_options")),
              card(
                   card_body(plotOutput(ns("globalPlot")))))
       )
   )
)

#' @export
server <- function(id){

  moduleServer(id, function(input, output, session){

# ------------------- READ IN DATA ------------------ #

    output$files <- renderTable(input$FileInput)

    raw_data <- reactive({
      read_functions$app_data(file_to_read=input$FileInput)
        })

    nested_country_df <- reactive({
      
      req(raw_data())

      wrangling_functions$create_nested_market_df(df=raw_data())
})


graph$server("globalPlot", nested_df=nested_country_df())

})
}

The above works in a monolith script, but when I've modularised I'm struggling to get the view's server module to filter, then send to the ui and then send back to server for visualisation, and to have this UI selectinput widget appear and work as expected on the UI in main.R. What am I missing?

Upvotes: 0

Views: 90

Answers (0)

Related Questions