从反应表达式中的不同数据框中减去列

时间:2020-11-12 11:01:19

标签: r shiny reactive

这里是RShiny的新手,希望能提供一些指导。

我正在尝试构建一个简单的闪亮应用程序,该应用程序允许用户上传两个csv文件,从另一个数据包(A)减去一个数据帧(B)的特定列[都具有相同的列结构],并将这些结果合并到df A的相应列。然后应在用户界面中显示此更新数据框的结果。

当我尝试运行该应用程序时,出现以下错误:

Error in .getReactiveEnvironment()$currentContext() : 
  Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

我曾认为,在导入文件A和B时使用反应式语句意味着功能的其余部分是在反应式表达式中完成的……也许我错了头。感谢任何建议吗?

服务器功能如下:

server <- function(input, output) {
    #fileA import
    A <- reactive(
        read.csv(
            input$fileA$datapath,
            header = input$header,
            sep = input$sep,
            quote = input$quote
        )
    )
    #FileB import
    B <- reactive(
        read.csv(
            input$fileB$datapath,
            header = input$header,
            sep = input$sep,
            quote = input$quote
        )
    )
    
    ##subtract B from A (columns 2 and 4)
    A()[,2] <- as.numeric(A()[,2])
    B()[,2] <- as.numeric(B()[,2])
    A()[,4] <- as.numeric(A()[,4])
    B()[,4] <- as.numeric(B()[,4])
    
    Finalcosts_AB2 <- A()[,2]-B()[,2]
    Finalcosts_AB4 <- A()[,4]-B()[,4]
    
    A()[,2] <- Finalcosts_AB2
    A()[,4] <- Finalcosts_AB4
    
    output$ABdiff <- renderTable({
        req(input$filaA)
        req(input$fileB)
        return(A())})

}

#Run the application 
shinyApp(ui = ui, server = server)

我一直在用户界面中使用以下方法:


    ui <- fluidPage(

    titlePanel("testfile"),
    
    sidebarPanel(
        #Input: select file A----
        fileInput(
            "fileA",
            "Upload fileA results (.CSV format)",
            multiple = FALSE,
            accept = c("text/csv", "text/comma-separated-values,
                                    text/plain", ".csv")
        ),
        #Horizontal line
        tags$hr(),
        #Input: select file B----
        fileInput(
            "fileB",
            "Upload fileB results (.CSV format)",
            multiple = FALSE,
            accept = c("text/csv", "text/comma-separated-values,
                                    text/plain", ".csv")
        ),
        #Horizontal line
        tags$hr(),
        #settings
        # Input: Checkbox if file has header ----
        checkboxInput("header", "Header", TRUE),
        
        # Input: Select separator ----
        radioButtons(
            "sep",
            "Separator",
            choices = c(
                Comma = ",",
                Semicolon = ";",
                Tab = "\t"
            ),
            selected = ","
        ),
        
        # Input: Select quotes ----
        radioButtons(
            "quote",
            "Quote",
            choices = c(
                None = "",
                "Double Quote" = '"',
                "Single Quote" = "'"
            ),
            selected = '"'
        ),
        
        # Horizontal line ----
        tags$hr(),
        
        # Input: Select number of rows to display ----
        radioButtons(
            "disp",
            "Display",
            choices = c(Head = "head",
                        All = "all"),
            selected = "head"
        )
    ),
    mainPanel(
        #header
        h3("Results"),
        #Output: HTML table of results----
        tableOutput("ABdiff")
    )
    
    )

1 个答案:

答案 0 :(得分:0)

请尝试避免修改反应性数据帧。如下所示修改服务器代码后,它就可以正常工作。

server <- function(input, output) {
  #fileA import
  A <- reactive({
    da <- read.csv(
      req(input$fileA$datapath),
      header = input$header,
      sep = input$sep,
      quote = input$quote
    )
    da[,2] <- as.numeric(da[,2])
    da[,4] <- as.numeric(da[,4])
    da
  })
  
  #FileB import
  B <- reactive({
    db <- read.csv(
      req(input$fileB$datapath),
      header = input$header,
      sep = input$sep,
      quote = input$quote
    )
    db[,2] <- as.numeric(db[,2])
    db[,4] <- as.numeric(db[,4])
    db
  })
  
  output$ABdiff <- renderTable({
    req(A(),B())
    Finalcosts_AB2 <- A()[,2]-B()[,2]
    Finalcosts_AB4 <- A()[,4]-B()[,4]
    AA <- A()
    AA[,2] <- Finalcosts_AB2
    AA[,4] <- Finalcosts_AB4
    return(AA)
  })
  
}