在闪亮的服务器功能中应用自己的 R 功能

Question

在闪亮的 server 函数中，我必须针对不同的输入（列名）重复以下步骤，例如 'LGD-Class'：

    #Begin the server.R     
    function(input, output) {
.
.
.
       if(dataRating() == "LGD-Class"){
          data1<- data[,list('MW (%)'=sum(as.numeric(Marktwert))/mw.ganz),by='LGD-Class']
          data2<- data[,list('EL (%)'=sum(as.numeric(`EL absolut`))/EL.ganz),by='LGD-Class']
          data3<- data[,list('VaR (%)'=sum(`VaR Beitrag absolut`)/Var.ganz),by='LGD-Class']
          # absolute values
          data5<-data[,list(MW.Abs=sum(as.numeric(Marktwert))),by='LGD-Class']
          data6<-data[,list(EL.Abs=sum(as.numeric(`EL absolut`))),by='LGD-Class']
          data7<- data[,list(VaR.Abs=sum(`VaR Beitrag absolut`)),by='LGD-Class']
          # relative values
          data4<-merge(data1,data2,by='LGD-Class')
          data.rel<-merge(data4,data3,by='LGD-Class')
          # absolute values
          data8<-merge(data5,data6,by='LGD-Class')
          data.abs<-merge(data8,data7,by='LGD-Class')
          data<-merge(data.rel,data.abs,by='LGD-Class')

        }... 
    } #end of server.R

因此我在 server 函数中编写了一个函数（紧接在 server.R 的开头），其中变量 'LGD-Class' 被通用变量 x 替换：

  my.aggregate<-function(x,data){x.c<-as.character(x)
    if(dataRating() ==x.c){ 
      va=get(x)
    data1<- data[,list('MW (%)'=sum(as.numeric(Marktwert))/mw.ganz),by=va]
    data2<- data[,list('EL (%)'=sum(as.numeric(`EL absolut`))/EL.ganz),by=va]
    data3<- data[,list('VaR (%)'=sum(`VaR Beitrag absolut`)/Var.ganz),by=va]
    # absolute values
    data5<-data[,list(MW.Abs=sum(as.numeric(Marktwert))),by=va]
    data6<-data[,list(EL.Abs=sum(as.numeric(`EL absolut`))),by=va]
    data7<- data[,list(VaR.Abs=sum(`VaR Beitrag absolut`)),by=va]
    # relative values
    data4<-merge(data1,data2,by=va)
    data.rel<-merge(data4,data3,by=va)
    # absolute values  
    data8<-merge(data5,data6,by=va)
    data.abs<-merge(data8,data7,by=va)
    data<-merge(data.rel,data.abs,by=va)

    return(data)

  }}

data作为函数变量，指的是我调用my.aggregate之前读取的数据框

data<-fread(paste0('C:/Users/data/','31032019KRB.CSV'),header=TRUE, sep=";",stringsAsFactors = FALSE)
    mw.ganz<-sum(as.numeric(data$MV))
    Var.ganz<-sum(as.numeric(data$`VaR absolut`))
    EL.ganz<-sum(as.numeric(data$`EL absolut`))

my.aggregate("LGD-Class",data)

我收到以下错误：

Warning in is.na(data) :
  is.na() applied to non-(list or vector) of type 'closure'
Warning: Error in get: object 'LGD-Class' not found

任何想法，我该如何解决这个问题？问题是我同时使用character (" ") 和variable name (' ') 吗？ 我不想引入/使用全局变量！

Answer 1

由于您没有提供可重现的示例，我只能猜测您要做什么。在我看来，您正在使用自定义函数根据用户输入在反应式表达式中聚合数据（这是一个猜测，它没有写在您提供的代码 sn-p 中）。

假设你真的想运行一个基于 data.table 的自定义函数来聚合你闪亮的服务器函数中的数据。然后似乎va = get(x) 导致了错误，因为您使用字符串„LGD-Class“ 调用自定义函数，而不是对象名称。

您可以通过直接在 data.table 调用中调用 x 来轻松解决此问题，因为 by 参数可以处理字符串。下面我提供了一个最小示例 (A)，它显示了闪亮的服务器语句中的此类函数如何使用用户输入来调用自定义函数。该函数本身非常简单，但它应该很容易适应您的问题。

虽然这可能会解决您的问题，但我想知道您是否真的需要一个自定义函数，因为您可以直接在反应式表达式中使用输入变量来生成与自定义函数相同的聚合数据。我还为这种数据聚合提供了一个示例 (B)。

示例 A（在服务器部分具有自定义 data.table 功能的闪亮应用）

library("shiny")
library("data.table")

# Generate data
testDT <- data.table(a1 = c(rep("group1",4),rep("group2",4),rep("group3",4)),
                     a2 = rep(c("red","blue","green"),4),
                     x1 = c(5,6,7,3,4,5,2,3,4,2,1,7),
                     x2 = c(1,2,3,2,3,2,1,4,6,7,3,4),
                     x3 = c(12,43,64,34,93,16,32,74,84,89,45,67)
)

shinyApp(

ui = fluidPage( # user interface

  sidebarLayout( # layout with Sidebar

    sidebarPanel( # input sidebarPanel

        selectInput(inputId = "group", label = "Choose grouping variable",
                    choices = c("Variable a1" = "a1",
                                "Variable a2" = "a2"),
                    selected = "a1")

        ), # closes sidebarPanel

  mainPanel( # Output in mainPabel

            tableOutput("table")

           ) # closes mainPanel

  ) # closes sidebarLayout

  ), # closes fluidPage

server = function(input, output) {

  create.DT <- function(DT, x) { # custom data.table function

    data <- DT[,.(x1 = mean(x1)
    ),
    by = c(x)]

    return(data)

  }

  react_testDT <- reactive({

    t <- create.DT(testDT, input$group) # function call with user input

  })

  output$table <- renderTable({

    react_testDT()

  })

  }

) # closes shinyApp

示例 B（用户在反应式表达式中输入聚合数据）

library("shiny")
library("data.table")

# Generate data
testDT <- data.table(a1 = c(rep("group1",4),rep("group2",4),rep("group3",4)),
                     a2 = rep(c("red","blue","green"),4),
                     x1 = c(5,6,7,3,4,5,2,3,4,2,1,7),
                     x2 = c(1,2,3,2,3,2,1,4,6,7,3,4),
                     x3 = c(12,43,64,34,93,16,32,74,84,89,45,67)
)

shinyApp(

ui = fluidPage( # user interface

  sidebarLayout( # layout with Sidebar

    sidebarPanel( # input sidebarPanel

        selectInput(inputId = "group", label = "Choose grouping variable",
                    choices = c("Variable a1" = "a1",
                                "Variable a2" = "a2"),
                    selected = "a1")

        ), # closes sidebarPanel

  mainPanel( # Output in mainPabel

            tableOutput("table")

           ) # closes mainPanel

  ) # closes sidebarLayout

  ), # closes fluidPage

server = function(input, output) {

  react_testDT <- reactive({

  testDT[, .(x1_mean = mean(x1)), by = c(input$group)]

  })

  output$table <- renderTable({

   react_testDT()

  })

  }

) # closes shinyApp