闪亮的服务器函数中,我必须对不同的输入(列名)(例如'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
('')的问题吗?
我不想介绍/使用全局变量!
答案 0 :(得分:1)
由于您没有提供可复制的示例,所以我只能猜测您要尝试执行的操作。在我看来,您正在使用自定义函数根据用户输入在反应表达式中聚合数据(这是一个猜测,它没有写在您提供的代码片段中)。
假设您确实要运行一个基于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