module as R6 object - how it works?

[tomasz]

Hi All,

Simple app with modules as R6 class
There are two list and two plots on page.

here is what i can see in console when start app

runApp('/media/test_R6')

Listening on http://127.0.0.1:3113
[1] "main-plot1 2"
[1] "main-plot2 2"

when I three times select on left list
[1] "main-plot1 3"
[1] "main-plot2 3"
[1] "main-plot1 4"
[1] "main-plot2 4"
[1] "main-plot1 5"
[1] "main-plot2 5"

when i three time select on right list
[1] "main-plot1 6"
[1] "main-plot2 6"
[1] "main-plot1 7"
[1] "main-plot2 7"
[1] "main-plot1 8"
[1] "main-plot2 8"

first I though that both 'Variables' objects has access to one instance of self$triggers$plot
but it cant be true. they must to have their own triggers$plot but they are both executing trigger_plot() nomatter which one list was used.

my question is why is that? if I had 100 plots and 100lists on page they alway will be all reloaded??? is it possible to separate it somehow?

Thank you,
tj

dataManager.R

library(R6)
library(shiny)
library(AmesHousing)


DataManager <- R6::R6Class(
  classname = "DataManager",
  public = list(
    dataset = make_ames()
  )
)

scatterplot.R

library(shiny)
library(scales)
library(ggplot2)


plot_labeller <- function(l, varname) {
  if (varname == "Sale_Price") {
    res <- dollar(l)
  } else {
    res <- comma(l)
  }
  return(res)
}


scatter_sales <- function(dataset, xvar, yvar) {
  x <- rlang::sym(xvar)
  y <- rlang::sym(yvar)
  
  p <- ggplot(dataset, aes(x = !!x, y = !!y)) +
    geom_point() +
    scale_x_continuous(labels = function(l) plot_labeller(l, varname = xvar)) +
    scale_y_continuous(labels = function(l) plot_labeller(l, varname = yvar)) +
    theme(axis.title = element_text(size = rel(1.2)),
          axis.text = element_text(size = rel(1.1)))
  
  return(p)
}


scatterplot_ui <- function(id) {
  ns <- NS(id)
  bootstrapPage(
    plotOutput(ns("plot"))
  )
}


scatterplot_server <- function(id, variables, data) {
  moduleServer(id, function(input, output, session) {
    output$plot <- renderPlot({
      print(paste0(id," ",variables$triggers$plot))
      variables$triggers$plot
      scatter_sales(data$dataset, xvar = variables$varX, yvar = variables$varY)
    })
  })
}

variablesManager.R

library(R6)
library(shiny)


Variables <- R6::R6Class(
  classname = "Variables",
  public = list(
    triggers = reactiveValues(plot = 0),
    trigger_plot = function() {
      self$triggers$plot <- self$triggers$plot + 1
    },
    
    varX = NULL,
    varY = NULL,
    set_vars = function(varX, varY) {
      self$varX <- varX
      self$varY <- varY
    }
  )
)

varselect.R

library(shiny)


varselect_ui <- function(id) {
  ns <- NS(id)
  
  # define choices for X and Y variable selection
  var_choices <- list(
    `Sale price` = "Sale_Price",
    `Total basement square feet` = "Total_Bsmt_SF",
    `First floor square feet` = "First_Flr_SF",
    `Lot Frontage` = "Lot_Frontage",
    `Lot Area` = "Lot_Area"
  )
  
  # assemble UI elements
  tagList(
    selectInput(
      ns("xvar"),
      "Select X variable",
      choices = var_choices,
      selected = "Lot_Area"
    ),
    selectInput(
      ns("yvar"),
      "Select Y variable",
      choices = var_choices,
      selected = "Sale_Price"
    )
  )
}


varselect_server <- function(id, variables) {

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

    observeEvent(list(input$xvar, input$yvar), {
      variables$set_vars(input$xvar, input$yvar)
      variables$trigger_plot()
    })

  })

}

app.R

library(shiny)

source("variablesManager.R")
source("dataManager.R")
source("scatterplot.R")
source("varselect.R")


ns <- NS("main")

ui <-  bootstrapPage(

    titlePanel("Ames Housing Data Explorer"),
    fluidRow(
      column(
        width = 3,
        wellPanel(
         varselect_ui(ns("plot1_vars"))
        )
      ),
      column(
        width = 3,
        scatterplot_ui(ns("plot1"))
      ),
      column(
        width = 3,
        scatterplot_ui(ns("plot2"))
      ),
      column(
        width = 3,
        wellPanel(
          varselect_ui(ns("plot2_vars"))
        )
      )
    )
  )


server <- function(input, output, session) {

    DataManager <- DataManager$new()
    
    Variables1 <- Variables$new()
    Variables2 <- Variables$new()
    
    varselect_server(ns("plot1_vars"), Variables1)
    varselect_server(ns("plot2_vars"), Variables2)
    
    scatterplot_server(ns("plot1"), Variables1, DataManager)
    scatterplot_server(ns("plot2"), Variables2, DataManager)

}

shinyApp(ui=ui, server=server)