在Shiny中使用tapply来查找列的平均值

时间:2017-10-17 05:43:20

标签: r shiny tapply

我使用tapply函数遇到了麻烦。我从同一数据框中提取两个向量,这是从一个反应变量创建的。我从用户输入的选择调用的第一个,第二个是我创建的用于保持我的代码通用并在我的排序功能中使用的。我的示例代码如下所示,使用r-bloggers示例。数据在这里。 https://redirect.viglink.com/?format=go&jsonp=vglnk_150821851345614&key=949efb41171ac6ec1bf7f206d57e90b8&libId=j8v6cnh201021u9s000DAhzunvtas&loc=https%3A%2F%2Fwww.r-bloggers.com%2Fbuilding-shiny-apps-an-interactive-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)

干杯 编辑*对不起我的坏,忘了改变下拉列表代码。我感兴趣的是一个通用的xdata向量,可以从加载的数据集中选择。然后我对其进行采样,并希望从采样的索引中找到平均值。

1 个答案:

答案 0 :(得分:0)

其中一个问题是子集化。 [仍会返回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)

-output

enter image description here