применить собственную R-функцию внутри функции сервера в shiny

ProgramBox

применить собственную R-функцию внутри функции сервера в shiny

Post author:admin
Запись опубликована:3 февраля, 2023
Post category:Вопросы по программированию

#r #shiny

#r #блестящий

Вопрос:

В функции сервера в shiny я должен повторить следующие шаги для разных входных данных (имен столбцов), например '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.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 (‘ ‘) одновременно?
Я бы не хотел вводить / использовать глобальную переменную!

1. На всякий случай, объявлена ли эта функция над shinyServer оболочкой? а LGD-Class внутри shinyServer ?

2. все происходит внутри серверной функции, как объявление функции, так и вызов функции my.aggregate(«LGD-Class»,данные)

3. Похоже, что «LGD-Class» недоступен в этой области действия функции. Попробуйте, может get("LGD-Class", envir = .GlobalEnv) быть. Заставьте get заглянуть в глобальную среду. Если это не сработает, попробуйте использовать другие envir аргументы.

4. Было бы полезно, если бы можно было избежать глобальных переменных и функций!

5. Я предлагаю вам найти, в какой области get просматривается и в какой области LGD-Class объявлено. Здесь есть отличная ссылка на среду: adv-r.had.co.nz/Environments.html .

Ответ №1:

Поскольку вы не предоставили воспроизводимый пример, я могу только догадываться, что вы пытаетесь сделать. Мне кажется, что вы используете пользовательскую функцию для объединения данных в реактивное выражение на основе пользовательского ввода (это предположение, оно не написано в предоставленном вами фрагменте кода).

Предположим, вы действительно хотите запустить пользовательскую функцию на основе data.table для агрегирования данных в вашей функции shiny server. Тогда кажется va = get(x) , что это вызывает ошибку, поскольку вы вызываете свою пользовательскую функцию со строкой „LGD-Class“ , а не с именем объекта.

Вы можете легко исправить это, вызвав x непосредственно в вызове data.table, поскольку аргумент by может обрабатывать строки. Ниже я привожу минимальный пример (A), который показывает, как такая функция в операторе shiny server будет выглядеть с использованием пользовательского ввода для вызова пользовательской функции. Сама функция очень проста, но она должна быть легко адаптирована к вашей проблеме.

Хотя это может решить вашу проблему, мне интересно, действительно ли вам нужна пользовательская функция в первую очередь, поскольку вы можете использовать входную переменную непосредственно в реактивном выражении для генерации тех же агрегированных данных, которые будет генерировать пользовательская функция. Я также привожу пример (B) для такого рода агрегирования данных.

Пример A (блестящее приложение с пользовательской функцией data.table в разделе server)

 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

1. не могли бы вы получить тот же результат, если вы создадите пользовательскую функцию в начале своего скрипта? то есть, имеет ли значение, где вы ее определяете?

2. Если вы вызываете приложение с помощью shinyApp(), как указано выше, в одном файле, то установка пользовательской функции в начале скрипта также работает. Смотрите Также здесь для получения дополнительной информации о области видимости.