How to pass reactive function into module in shiny?

[llyvslly]

Hi there,

I wonder how to pass reactive function into module in shiny? It always throw me error: 'data' must be 2-dimensional (e.g. data frame or matrix).

my purpose is to use the "editable Data Table Module" to edit the output of my function.
Any help is much appreciated!!!

library(shiny)
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(data.table)
#> 
#> Attaching package: 'data.table'
#> The following objects are masked from 'package:dplyr':
#> 
#>     between, first, last
library(tidyr)

raw1<-data.frame("Network"=c("50K","50K","50K","50K", "45K","45K","45K","45K", "40K","40K","40K","40K","30K","30K","30K","30K"), 
                "BG"=c("B","B", "G","G","B","B", "G","G","B","B", "G","G","B","B", "G","G"), 
                "RD"=c("R","D","R","D","R","D","R","D","R","D","R","D","R","D","R","D"))

raw2<- data.frame("Year"=c(2021,2022,2023,2024),
                 "Rate"=c(0.1,0.2,0.3,0.4))

raw<-merge(raw1,raw2)


### Module
modFunction <- function(input, output, session, data,reset) {

  v <- reactiveValues(data = data)

  proxy = dataTableProxy("mod_table")

  observeEvent(input$mod_table_cell_edit, {
    print(names(v$data))
    info = input$mod_table_cell_edit
    str(info)
    i = info$row
    j = info$col
    k = info$value
    str(info)
    v$data[i, j] <<- DT::coerceValue(k, v$data[i, j])
    replaceData(proxy, v$data, resetPaging = FALSE)  # replaces data displayed by the updated table
  })

  ### Reset Table
  observeEvent(reset(), {
    v$data <- data # your default data
  })

  print(isolate(colnames(v$data)))
  output$mod_table <- DT::renderDataTable({
    DT::datatable(v$data, editable = TRUE)

  })
}

modFunctionUI <- function(id) {
  ns <- NS(id)
  DT::dataTableOutput(ns("mod_table"))

}



ui <- fluidPage(
  titlePanel("Input"),
  sidebarLayout(
    sidebarPanel(
      selectInput("Network","Choose a network:",
                  choices = c(unique(toupper(raw$Network))),
                  selected = '50K'),
      selectInput("BG","Choose B or G:",
                  choices = c(unique(raw$BG)),
                  selected = "B"),
      selectInput("RD","Choose R or D:",
                  choices = c(unique(raw$RD)),
                  selected = "R")),

    mainPanel(
      actionButton("reset", "Reset"),
      tags$hr(),
      modFunctionUI("editable")
    )
  )
)



# Define server logic for random distribution app ----
server <- function(input, output) {
  
  
  df<-function(input){
    
    raw<-raw %>% filter(Network %in% input$Network,BG %in% input$BG, RD %in% input$RD) 
    
    raw<-raw %>% spread(key=Year, value=Rate, fill = FALSE) 
  }
    
  data<-reactive({
    df(input)
  })
  
  demodata<-data
  callModule(modFunction,"editable", demodata,
             reset = reactive(input$reset))

}

shinyApp(ui=ui, server = server)

Shiny applications not supported in static R Markdown documents

^{Created on 2020-10-16 by the reprex package (v0.3.0)}

[daattali]

You almost have it right. I had to namespace dataTableProxy with DT:: by the way.

data is a reactive, so v$data is still a reactive rather than the value you want. What you want to do is v <- reactiveValues(data = data()) (notice the ()). However, this must be done inside a reactive context since we're accessing a reactive value and the incoming data reactive might change over time, so your definition becomes:

  v <- reactiveValues(data = NULL)
  observeEvent(data(), {
    v$data <- data()
  })

With this addition, your code works.

[llyvslly]

It works! Thank you so much!!! I've been struggling it for a long time and eventually figured it out!

library(shiny)
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(data.table)
#> 
#> Attaching package: 'data.table'
#> The following objects are masked from 'package:dplyr':
#> 
#>     between, first, last
library(tidyr)

raw1<-data.frame("Network"=c("50K","50K","50K","50K", "45K","45K","45K","45K", "40K","40K","40K","40K","30K","30K","30K","30K"), 
                "BG"=c("B","B", "G","G","B","B", "G","G","B","B", "G","G","B","B", "G","G"), 
                "RD"=c("R","D","R","D","R","D","R","D","R","D","R","D","R","D","R","D"))

raw2<- data.frame("Year"=c(2021,2022,2023,2024),
                 "Rate"=c(0.1,0.2,0.3,0.4))

raw<-merge(raw1,raw2)


### Module
modFunction <- function(input, output, session, data,reset) {

  v <- reactiveValues(data = NULL)
  
  observeEvent(data(), {
    v$data <- data()
  })

  proxy =  DT::dataTableProxy("mod_table")

  observeEvent(input$mod_table_cell_edit, {
    info = input$mod_table_cell_edit
    str(info)
    i = info$row
    j = info$col
    k = info$value
    str(info)
    v$data[i, j] <<- DT::coerceValue(k, v$data[i, j])
    replaceData(proxy, v$data, resetPaging = FALSE)  # replaces data displayed by the updated table
  })

  ### Reset Table
  observeEvent(reset(), {
    v$data <- data # your default data
  })

  print(isolate(colnames(v$data)))
  output$mod_table <- DT::renderDataTable({
    DT::datatable(v$data, editable = TRUE)

  })
}

modFunctionUI <- function(id) {
  ns <- NS(id)
  DT::dataTableOutput(ns("mod_table"))

}



ui <- fluidPage(
  titlePanel("Input"),
  sidebarLayout(
    sidebarPanel(
      selectInput("Network","Choose a network:",
                  choices = c(unique(toupper(raw$Network))),
                  selected = '50K'),
      selectInput("BG","Choose B or G:",
                  choices = c(unique(raw$BG)),
                  selected = "B"),
      selectInput("RD","Choose R or D:",
                  choices = c(unique(raw$RD)),
                  selected = "R")),

    mainPanel(
      actionButton("reset", "Reset"),
      tags$hr(),
      modFunctionUI("editable")
    )
  )
)



# Define server logic for random distribution app ----
server <- function(input, output) {
  
  
  df<-function(input){
    
    raw<-raw %>% filter(Network %in% input$Network,BG %in% input$BG, RD %in% input$RD) 
    
    raw<-raw %>% spread(key=Year, value=Rate, fill = FALSE) 
  }
    
  data1<-reactive({
    df(input)
  })
  
  
  demodata<-data1
  callModule(modFunction,"editable", demodata,
             reset = reactive(input$reset))

}

shinyApp(ui=ui, server = server)

Shiny applications not supported in static R Markdown documents

^{Created on 2020-10-16 by the reprex package (v0.3.0)}