apply own R-function within server function in shiny

Question

Within server function in shiny I have to repeat following steps for different inputs (column names) like '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

therefore I wrote a function within server function (immediately after beginning of the server.R )in which the variable 'LGD-Class' is replaced by a general variable 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 as a function variable, refers to the the data frame, which I read before I call 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)

I get the following error:

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

any idea, how can I solve the problem? Is the problem, that I use character (" ") and variable name (' ') simultaneously? I wouldn't like to introduce/use global variable!

Answer 1

Since you have not provided a reproducible example I can only guess what you are trying to do. It seems to me, that you are using the custom function to aggregate data in a reactive expression based on user input (this is a guess, its not written in the code snippet you provided).

Let’s assume you really want to run a custom function based on data.table to aggregate data in your shiny server function. Then it seems like va = get(x) is causing the error, since you are calling your custom function with a string „LGD-Class“, not an object name.

You can easily fix this by calling x directly in the data.table call, since the by argument can handle strings. Below I provide a minimal example (A) which shows how such a function in a shiny server statement would look like using user input for the call to the custom function. The function itself is very simple, but it should be easily adaptable to your problem.

Although this might solve you problem, I wonder wether you really need a custom function in the first place, since you can use the input variable directly in the reactive expression to generate the same aggregated data the custom function would produce. I also provide an example (B) for this kind of data aggregation.

Example A (shiny app with custom data.table function in server section)

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

Example B (user input in reactive expression to aggregate data)

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