在lapply(... paste())函数中创建名称的Shiny中的React值

xwbd5t1u 于 2023-04-27 发布在 React

关注(0)|答案(1)|浏览(134)

我试图创建一个闪亮的应用程序，其中React值的名称在apply()中创建。
我已经把下面的概念应用程序放在一起，但它我得到了一个错误。我很难弄清楚如何调用一个React函数，它的名字是用paste()函数创建的。
以下是概念App：

library(shiny)
library(DT)

# create a shiny app with multiple DT tables for each unique cyl value
ui <- fluidPage(
  lapply(unique(mtcars$cyl), function(cyl_val) {
    fluidRow(
      h2(paste0("DT table for cyl=", cyl_val)),
      dataTableOutput(paste0("dt_", cyl_val))
    )
  })
)

server <- function(input, output) {
  # define a reactive value for mtcars dataset
  rv_mtcars <- reactiveVal(mtcars)
  
  # split mtcars dataset into a list of data frames by cyl value
  cyl_split <- reactive({
    split(rv_mtcars(), f = rv_mtcars()$cyl)
    # split(mtcars, f = mtcars$cyl)
  })
  
  # generate separate DT tables for each list element
  lapply(unique(mtcars$cyl), function(cyl_val) {
    output[[paste0("dt_", cyl_val)]] <- renderDataTable({
      cyl_split()[[as.character(cyl_val)]] %>% 
        slice(0) %>% 
        datatable(
          selection = list(target = 'row', mode = 'single')
        )
    })
    
    assign(
      paste0("r_mtcars_sub_", cyl_val), 
      reactive({
        rv_mtcars() %>% 
          filter(cyl == cyl_val) %>% 
          return()
      })
    )
    
    observeEvent( paste0("r_mtcars_sub_", cyl_val) , {
      paste0("r_mtcars_sub_", cyl_val) %>% print()
      # paste0("proxy_dt_", cyl_val)
      proxy <- paste0("proxy_dt_", cyl_val)
      proxy %>% print()
      updated_tbl <- paste0("r_mtcars_sub_", cyl_val)()
      updated_tbl %>% print()
      replaceData(proxy, updated_tbl, resetPaging = FALSE, rownames = FALSE)
    })
    
    assign(paste0("proxy_dt_", cyl_val), DT::dataTableProxy(paste0("dt_", cyl_val)), envir = .GlobalEnv)
    # paste0("proxy_dt_", cyl_val) <<- DT::dataTableProxy(paste0("dt_", cyl_val))
    # proxy_switch_same_qty_DT <- DT::dataTableProxy('switch_same_qty_DT')
    
    # observe event triggered when a row is selected in one of the DT tables
    observeEvent(input[[paste0("dt_", cyl_val, "_rows_selected")]], {
      selected_row <- input[[paste0("dt_", cyl_val, "_rows_selected")]]
      if(length(selected_row) > 0) {
        selected_df <- cyl_split()[[as.character(cyl_val)]][selected_row, ]
        # print(paste0("Selected row in DT table for cyl=", cyl_val, ":"))
        
        # print(selected_df)
        car <- selected_df %>% rownames() #%>% print()
        
        mydata <- rv_mtcars()
        mydata[car, "cyl"] <- 6
        rv_mtcars(mydata)
        
        
      }
    })
  })
}

shinyApp(ui, server)

我相信我的代码面临的挑战在下面的代码块中：

observeEvent( paste0("r_mtcars_sub_", cyl_val) , {
  paste0("r_mtcars_sub_", cyl_val) %>% print()
  # paste0("proxy_dt_", cyl_val)
  proxy <- paste0("proxy_dt_", cyl_val)
  proxy %>% print()
  updated_tbl <- paste0("r_mtcars_sub_", cyl_val)()
  updated_tbl %>% print()
  replaceData(proxy, updated_tbl, resetPaging = FALSE, rownames = FALSE)
})

r

来源：https://stackoverflow.com/questions/76113531/reactive-values-in-shiny-that-have-names-that-are-created-in-an-lapply-paste

1条答案

按热度按时间

jdzmm42g1#

我没有深入研究你的代码。但乍一看，你的代码需要模块化的方法。这样做可以大大简化你的代码，即不需要使用paste0来创建output或input名称，不需要assign，... ..基本上这归结为只为一个cyl创建一个应用程序：

library(shiny)
library(DT)

dataTableUI <- function(id, cyl_val) {
  ns <- NS(id)
  tagList(
    h2(paste0("DT table for cyl = ", cyl_val)),
    DTOutput(ns("dt"))
  )
}

dataTableServer <- function(id, cyl_val, init, rv_mtcars) {
  moduleServer(id, function(input, output, session) {
    r_mtcars_sub <- reactive({
      subset(rv_mtcars(), cyl == cyl_val)
    })

    output[["dt"]] <- renderDT({
      init |>
        datatable(
          selection = list(target = "row", mode = "single")
        )
    })

    proxy_dt <- DT::dataTableProxy("dt")
    observe({
      replaceData(proxy_dt, r_mtcars_sub(), resetPaging = FALSE)
    })

    observeEvent(input[["dt_rows_selected"]], {
      selected_row <- input[["dt_rows_selected"]]
      if (length(selected_row) > 0) {
        selected_df <- r_mtcars_sub()[selected_row, ]

        car <- rownames(selected_df)

        mydata <- rv_mtcars()
        mydata[car, "cyl"] <- 6

        rv_mtcars(mydata)
      }
    })
  })
}

dataTableApp <- function() {
  cyl_split <- split(mtcars, mtcars$cyl)
  rv_mtcars <- reactiveVal(mtcars)

  ui <- fluidPage(
    lapply(unique(mtcars$cyl), function(cyl) {
      fluidRow(
        dataTableUI(paste0("cyl", cyl), cyl)
      )
    })
  )
  server <- function(input, output, session) {
    lapply(unique(mtcars$cyl), function(cyl) {
      dataTableServer(paste0("cyl", cyl), cyl, cyl_split[[as.character(cyl)]], rv_mtcars)
    })
  }

  shinyApp(ui, server)
}

dataTableApp()

这是在选择气缸4和8的一组行之后的示例输出，其结果显示在气缸6的表中：

赞(0）回复(0）举报 2023-04-27

我来回答

在lapply(... paste())函数中创建名称的Shiny中的React值

1条答案

相关问题

热门标签

最新问答