Различные функции над списком столбцов и автоматическое создание новых имен столбцов с помощью data.table - PullRequest
Новая
       15

Различные функции над списком столбцов и автоматическое создание новых имен столбцов с помощью data.table

1 голос
/ 11 марта 2019

В моем приложении Shiny есть раздел, который генерирует список.

имена в списке являются именами столбцов dataframe, на которые мы будем рассчитывать, элементы списка содержат расчеты, которые мы хотим

Хотите сделать это:
apply ко всем list именам:
для listname (column) x рассчитать function n,m,o более df column x
и назовите получившийся столбец 'x.n', т.е. cyl.mean', 'mpg.sum'
чтобы получить dataframe сводной статистики на группу (mtcars $ cyl) в этом случае как пример

Он связан с этим вопросом, но в этом примере data использовал отдельные list из column имен, и apply одинаковые functions для всех этих columns от другого list. Я с нетерпением жду перехода к apply unique наборам functions к другим columns

Список, который выкладывает мое приложение, выглядит следующим образом: 

mylist


$disp
[1] "sum"  "mean"

$hp
[1] "sd"

$drat
[1] "sum"  "mean"

$wt
[1] "max"

ожидаемый результат: 

cyl    disp.sum  hp.sd  drat.sum  drat.mean wt.max    
4        x ....  
6        x ....  
8        x  ....

Маленькое блестящее приложение для создания списка: 

library(shiny)
library(data.table)
library(shinyjs)

Channels <- names(mtcars)[3:8]

ui <- fluidPage(
  shinyjs::useShinyjs(),
  h5('Channels', style = 'font-weight:bold'),
  uiOutput('ChannelCheckboxes'),
  h5('Statistics', style = 'font-weight:bold'),
  uiOutput('CalculationCheckboxes')

)


server <- function(input, output, session) {

  values <- reactiveValues(Statisticlist = list())
  ## build observer to deselect all sub category checkboxes if channel is deselected
  lapply(Channels, function(x) {
    observeEvent(input[[paste('Channel', x, sep = '')]], {
      if(!input[[paste('Channel', x, sep = '')]]) {
        shinyjs::disable(paste("Calculations", x, sep = ''))
        updateCheckboxGroupInput(session, inputId = paste("Calculations", x, sep = ''), selected=character(0))

      } else {
        shinyjs::enable(paste("Calculations", x, sep = ''))

        }
    })
  })

  output$ChannelCheckboxes <- renderUI({
    fluidRow(
    lapply(Channels, function(x) {
      column(2,
             checkboxInput(inputId = paste('Channel', x, sep = ''), label = x)
        )
    })
  )
  })

output$CalculationCheckboxes <- renderUI({
  fluidRow(
    lapply(Channels, function(x) {
      column(2,
             checkboxGroupInput(inputId = paste("Calculations", x, sep = ''),  label = NULL, c('sum', 'mean', 'length', 'max', 'min', 'sd')) ) })
  )
})


  lapply(Channels, function(x) {
    observe({
      req(input[[paste('Channel', x, sep = '')]])
      if(input[[paste('Channel', x, sep = '')]] & !is.null(input[[paste("Calculations", x, sep = '')]])){
     values$Statisticlist[[paste(x)]] <- input[[paste("Calculations", x, sep = "")]]

      }
    })
  })


  observeEvent(values$Statisticlist, { print(values$Statisticlist)
    mylist <<- values$Statisticlist
    })
}

shinyApp(ui, server)

Ответы [ 2 ]

1 голос
/ 12 марта 2019

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

Имена столбцов и функций, к которым они применяются, приведены в виде списка mylist, который создается приложением блестящей.

Среди различных подходов я предпочитаю вычислять на языке , то есть создавать полное выражение из содержимого mylist и оценивать его: 

library(magrittr)
library(data.table)
mylist %>%
  names() %>% 
  lapply(
    function(.col) lapply(
      mylist[[.col]], 
      function(.fct) sprintf("%s.%s = %s(%s)", .col, .fct, .fct, .col))) %>% 
  unlist() %>% 
  paste(collapse = ", ") %>% 
  sprintf("as.data.table(mtcars)[, .(%s), by = cyl]", .) %>% 
  parse(text = .) %>% 
  eval()

, который дает ожидаемый результат 

   cyl disp.sum disp.mean    hp.sd drat.sum drat.mean wt.max
1:   6   1283.2  183.3143 24.26049    25.10  3.585714  3.460
2:   4   1156.5  105.1364 20.93453    44.78  4.070909  3.190
3:   8   4943.4  353.1000 50.97689    45.21  3.229286  5.424

Анализируемая строка символов создается 

mylist %>%
  names() %>% 
  lapply(
    function(.col) lapply(
      mylist[[.col]], 
      function(.fct) sprintf("%s.%s = %s(%s)", .col, .fct, .fct, .col))) %>% 
  unlist() %>% 
  paste(collapse = ", ") %>% 
  sprintf("as.data.table(mtcars)[, .(%s), by = cyl]", .)

и выглядит так, как если бы она была закодирована вручную: 

[1] "as.data.table(mtcars)[, .(disp.sum = sum(disp), disp.mean = mean(disp), hp.sd = sd(hp), drat.sum = sum(drat), drat.mean = mean(drat), wt.max = max(wt)), by = cyl]"

Данные

Для демонстрации mylist предоставляется «жестко»: 

mylist <- list(
  disp = c("sum", "mean"),
  hp = "sd",
  drat = c("sum", "mean"),
  wt = "max")
0 голосов
/ 12 марта 2019

Чтобы превратить ответ Уве в функцию, я сделал это: 

Summarystats <- function(statlist, dataframe, group) { 
    statlist %>%
        names() %>% 
        lapply(
            function(.col) lapply(
                statlist[[.col]], 
                function(.fct) sprintf("%s.%s = %s(%s)", .col, .fct, .fct, .col))) %>% 
        unlist() %>% 
        paste(collapse = ", ") %>% 
        sprintf("as.data.table(dataframe)[, .(%s), by = group]", .) %>% 
        parse(text = .) %>% 
        eval()
    }

Теперь я могу позвонить: 

Summarystats(mylist, mtcars, 'cyl')

Позволяет мне вызывать сводную таблицу для любого фрейма данных и группировать пользователя в моем приложении Shiny.

...