Использование tapply в Shiny для нахождения среднего значения столбца

У меня возникают проблемы с использованием функции tapply. Я извлекаю два вектора из одного и того же фрейма данных, который был создан из реактивной переменной. Первый я вызываю из введенного пользователем выбора, а второй — тот, который я создал, чтобы мой код можно было обобщить и использовать в моей функции сортировки. Мой пример кода показан ниже на примере r-bloggers. Данные здесь. https://redirect.viglink.com/?format=go&jsonp=vglnk_150821851345614&key=949efb41171ac6ec1bf7f206d57e90b8&libId=j8v6cnh201021u9s000DAhzunvtas&loc=https%3A%2F%2Fwww.tutorial%2F&v=1&out=http%3A%2F%2Fdeanattali.com%2Ffiles%2Fbcl-data.csv&ref=https%3A%2F%2Fduckduckgo.com%2F&title=Building%20Shiny%20apps%20%E2%80%93%20an%20interactive%20tutorial%20%7C%20R-bloggers&txt=here

Ошибка, которую он выдает, заключается в том, что они не имеют одинаковой длины, хотя их атрибуты и распечатки классов точно такие же. Я знаю, что это не лучший код в мире, но я просто собрал быстрый пример.

    library(shiny)
library(tidyverse)
bcl <- read.csv("bcl-data.csv", stringsAsFactors = FALSE)

ui <- fluidPage(titlePanel("Sampling Strategies"),
                sidebarLayout(
                  sidebarPanel(
                    selectInput("XDATA","xdata",
                                choices = c(names(bcl))),
                    selectInput("YDATA","ydata",
                                choices = c(names(bcl)))
                  ),

                  mainPanel(
                    tabsetPanel(
                      tabPanel("The table",tableOutput("mytable"))
                    ))
                ))

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

  filtered <- reactive({
    bcl <- bcl %>% mutate(ID = 1:nrow(bcl))
  })

  output$mytable <- renderTable({
    dataset <- filtered() %>% mutate(sampled = "white")
    sample.rows <- sample(dataset$ID, 5, replace = FALSE)
    dataset$sampled[sample.rows] <- "black"
    final <- tapply(dataset[input$XDATA], list(dataset$sampled),mean)[["black"]]

    return(final)
  })
}

shinyApp(ui = ui, server = server)

Cheers Edit * Извините, мой плохой, забыл изменить коды выпадающего списка. Меня интересует только один общий вектор xdata, который можно выбрать из загруженного набора данных. Затем я делаю выборку и хочу найти среднее значение из выбранных индексов.


person user259933    schedule 17.10.2017    source источник
comment
Я думаю, что вместо data.frame(dataset$sampled) должно быть list(dataset$sampled) Кроме того, ваш первый аргумент, кажется, data.frame. Пожалуйста, поясните, что вы хотели, на воспроизводимом примере   -  person akrun    schedule 17.10.2017
comment
Что это за xdata, ydata?   -  person akrun    schedule 17.10.2017
comment
Отредактировано. Все, что я хочу, это вернуть мне среднее значение выбранных индексов из столбца, обозначенного как input$XDATA.   -  person user259933    schedule 17.10.2017


Ответы (1)


Одна из проблем заключается в подмножестве. [ по-прежнему возвращает data.frame. Итак, нам нужно [[. Если мы посмотрим на ?tapply

tapply(X, INDEX, FUN = NULL, ..., по умолчанию = NA, упрощение = TRUE)

куда

X — атомарный объект, обычно вектор


ui <- fluidPage(titlePanel("Sampling Strategies"),
                sidebarLayout(
                  sidebarPanel(
                    selectInput("XDATA","xdata",
                                choices = c(names(bcl)[5:7])),
                    selectInput("YDATA","ydata",
                                choices = c(names(bcl)))
                  ),

                  mainPanel(
                    tabsetPanel(
                      tabPanel("The table",tableOutput("mytable"))
                    ))
                ))


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

  filtered <- reactive({
    bcl <- bcl %>% mutate(ID = row_number())
  })



  output$mytable <- renderTable({

    dataset <- filtered() %>% mutate(sampled = "white")
    sample.rows <- sample(dataset$ID, 20, replace = FALSE)
    dataset$sampled[sample.rows] <- "black"
    final <- tapply(dataset[[input$XDATA]], list(dataset$sampled),mean, na.rm = TRUE, simplify = TRUE)

    return(final)


  })

}

shinyApp(ui = ui, server = server)

-выход

введите здесь описание изображения

person akrun    schedule 17.10.2017
comment
Большое тебе спасибо. Я пробовал двойные скобки, но с набором данных $ в качестве фрейма данных. Проводил проверки, и они подходили точно так же с точки зрения атрибутов. Спасибо за помощь! Проголосовал, но я новичок в SO, так что это не считается. Прости за это. - person user259933; 17.10.2017