Quantcast
Channel: Active questions tagged r - Stack Overflow
Viewing all articles
Browse latest Browse all 201839

Reactive shiny modules sharing data

$
0
0

I'm trying to create a shiny app using modules. Two dataframes (tables a and b) are reactive and can be modified, a third dataframe (table c) is also reactive and is based on tables a and b.

I tried following this question which does the same with text input and not dataframes, but my code isn't working - I get an object of type closure is not subsettable error.

Thanks for any help.

### Libraries
library(shiny)
library(tidyverse)
library(DT)    

### Data----------------------------------------

table_a <- data.frame(
  id=seq(from=1,to=10),
  x_1=rnorm(n=10,mean=0,sd=10),
  x_2=rnorm(n=10,mean=0,sd=10),
  x_3=rnorm(n=10,mean=0,sd=10),
  x_4=rnorm(n=10,mean=0,sd=10)
) %>% 
  mutate_all(round,3)

table_b <- data.frame(
  id=seq(from=1,to=10),
  x_5=rnorm(n=10,mean=0,sd=10),
  x_6=rnorm(n=10,mean=0,sd=10),
  x_7=rnorm(n=10,mean=0,sd=10),
  x_8=rnorm(n=10,mean=0,sd=10)
)%>% 
  mutate_all(round,3)


### Modules------------------------------------ 

mod_table_a <- function(input, output, session, data_in,reset_a) {

  v <- reactiveValues(data = data_in)
  proxy = dataTableProxy("table_a")

  #set var 2
  observeEvent(reset_a(), {
    v$data[,"x_2"] <- round(rnorm(n=10,mean=0,sd=10),3)
    replaceData(proxy, v$data, resetPaging = FALSE) 
  })

  # render table
  output$table_a <- DT::renderDataTable({

    DT::datatable(
      data=v$data,
      editable = TRUE,
      rownames = FALSE,
      class="compact cell-border",
      selection = list(mode = "single", 
                       target = "row"
                       ),
      options = list(
        dom="t",
        autoWidth=TRUE,
        scrollX = TRUE,
        ordering=FALSE,
        bLengthChange= FALSE,
        searching=FALSE
      )
    )
  })

  return(v)

}

mod_table_b <- function(input, output, session, data_in,reset_b) {

  v <- reactiveValues(data = data_in)
  proxy = dataTableProxy("table_b")

  #reset var
  observeEvent(reset_b(), {
    v$data[,"x_6"] <- round(rnorm(n=10,mean=0,sd=10),3)
    replaceData(proxy, v$data, resetPaging = FALSE)  # replaces data displayed by the updated table
  })

  # render table
  output$table_b <- DT::renderDataTable({

    DT::datatable(
      data=v$data,
      editable = TRUE,
      rownames = FALSE,
      class="compact cell-border",
      selection = list(mode = "single", 
                       target = "row"
      ),
      options = list(
        dom="t",
        autoWidth=TRUE,
        scrollX = TRUE,
        ordering=FALSE,
        bLengthChange= FALSE,
        searching=FALSE
      )
    )
  })

  return(v)
}

mod_table_c <- function(input, output, session, tbl_a_proxy,tbl_b_proxy) {

  v <- reactive({
  table_c <- data.frame(id=seq(from=1,to=10)) %>%
    left_join(tbl_a_proxy$data,by="id") %>%
    left_join(tbl_b_proxy$data,by="id") %>%
    mutate(y_1=x_1+x_6)%>%
    select(x_2,x_6,y_1)
  })


  # render table
  output$table_c <- DT::renderDataTable({

    DT::datatable(
      data=v$table_c,
      editable = TRUE,
      rownames = FALSE,
      class="compact cell-border",
      selection = list(mode = "single", 
                       target = "row"
      ),
      options = list(
        dom="t",
        autoWidth=TRUE,
        scrollX = TRUE,
        ordering=FALSE,
        bLengthChange= FALSE,
        searching=FALSE
      )
    )
  })
}


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


### Shiny App---------
#ui----------------------------------
  ui <- fluidPage(
    fluidRow(
      br(),
      column(1,
             br(),
             actionButton(inputId = "reset_a", "Reset a")
             ),
      column(6,
             modFunctionUI("table_a")
      ),
      column(1),
      column(4)
    ),
    fluidRow(
      br(),
      br(),
      column(1,
             br(),
             actionButton(inputId = "reset_b", "Reset b")),
      column(6,
             modFunctionUI("table_b")
      ),
      column(5,
             modFunctionUI("table_c")
             )
    ),
    #set font size of tables
    useShinyjs(),
    inlineCSS(list("table" = "font-size: 10px"))
  )

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

    #table a
    tbl_a_proxy <- callModule(module=mod_table_a,
               id="table_a",
               data_in=table_a,
               reset_a = reactive(input$reset_a)
    )

    #table b
    tbl_b_proxy <- callModule(module=mod_table_b,
               id="table_b",
               data_in=table_b,
               reset_b = reactive(input$reset_b)
    )

    #table c
    callModule(module=mod_table_c,
               id="table_c",
               tbl_a_proxy,
               tbl_b_proxy
    )

  }  


  shinyApp(ui, server)

Viewing all articles
Browse latest Browse all 201839

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>