0

我正在尝试使用 2 个嵌套模块为简单的数据输入构建一个闪亮的应用程序。用户提供具有特定列类型的数据框，应用程序将允许您向其中添加更多行。第一个模块（“输入”）将根据列类型创建输入小部件。第二个模块（“表格”）显示表格，并允许添加额外的行。我在模块 2 中嵌套了模块 1 作为模式弹出窗口。

我遇到的问题是我无法访问第一个模块中的输入（“输入”）。我可以看到变量的名称，这是一个 ReactiveValues 对象，但一切都是 NULL。

任何帮助将不胜感激（为长代码道歉，这是我可以制作的最短的可重现示例）。

library(shiny)
library(DT)
library(data.table)

df<-data.frame(
  a=as.character(NA),
  b=as.numeric(NA)
)


# Module for creating input fileds ----------------------------------------
input_UI<-function(id,df) {
  ns<-NS(id)
  
  tagList(
    lapply(1:ncol(df),function(x){
    switch(class(df[,x][[1]]),
           numeric=numericInput(
             inputId = ns(paste0(colnames(df)[x])),
             label=paste0(colnames(df)[x]),
             value=0
           ),
           character=textInput(
             inputId = ns(paste0(colnames(df)[x])),
             label=paste0(colnames(df)[x]),
             value=""
           )
    )
  })
  )
}

input_server<-function(id,df,debug=F) {
  moduleServer(
    id,
    function(input, output, session) {
      dataframe=reactive({
        if (debug==T){
          browser() #this is where I am having trouble accessing input
        }
        inputlist<-lapply(1:ncol(df), function(x){
          switch(class(df[,x][[1]]),
                 numeric=as.numeric(input[[paste0(id,"-",colnames(df)[[x]])]]),
                 character=as.character(input[[paste0(id,"-",colnames(df)[[x]])]])
                 )
        })

        df_temp<-data.frame(inputlist)
        colnames(df_temp)=colnames(df)
        df_temp
      })
      return(dataframe)
    }
  )
}


# module for showing data, and adding rows --------------------------------
table_UI<-function(id){
  ns<-NS(id)
  tagList(
    uiOutput(ns("MainBody_dataEntry"))
  )
}

table_sever<-function(id,df){
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns
      
      data_vals<-reactiveValues()
      data_vals$Data<-df
      
      output$MainBody_dataEntry<-renderUI({
        fluidPage(
          hr(),
          column(6,offset = 6,
                 actionButton(inputId = ns("Add_row_head"),label = "Add", class="btn-primary")
          ),
          column(12,dataTableOutput(ns("Main_table"))),
        ) 
      })
      
      output$Main_table<-renderDataTable({
        DT=data.table(data_vals$Data)
        datatable(DT)
      })
      
      observeEvent(input$Add_row_head, {
        showModal(modalDialog(title = "Add a new row",
                              input_UI(ns("add_row"),df=data_vals$Data),
                              easyClose = F,
                              footer = actionButton(ns("confirm_newrow"), "Add item") ))
        
      })
      observeEvent(input$confirm_newrow, {
        datafile <- input_server(ns("add_row"),df=data_vals$Data,debug=T)
        new_row=data.frame(datafile())
        data_vals$Data<-rbind(data_vals$Data, new_row )
        removeModal()
      })
      
    }
  )
}

ui<-shinyUI(fluidPage(
  table_UI("test")
))

server<-shinyServer(function(input, output, session){
  table_sever("test",df)
})


shinyApp(ui, server)
4

0 回答 0