R 闪亮的嵌套模块，输入不可用

问题描述

我正在尝试使用 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])),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[,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,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,session){
  table_sever("test",df)
})


shinyApp(ui,server)

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）