在 Shiny 中使用 tapply 求列的均值
Using tapply in Shiny to find mean of a column
我 运行 在使用 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
它抛出的错误是它们的长度不同,即使它们的属性和 class 打印输出完全相同。
我知道这不是世界上最好的代码,但我只是拼凑了一个简单的例子。
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 向量,可以从加载的数据集中选择。然后我对其进行采样,并希望从采样的指数中找到平均值。
其中一个问题是子集化。 [
还是 returns 一个 data.frame
。所以,我们需要[[
。如果我们看 ?tapply
tapply(X, INDEX, FUN = NULL, ..., default = NA, simplify = TRUE)
哪里
X is an atomic object, typically a vector
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)
-输出
我 运行 在使用 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
它抛出的错误是它们的长度不同,即使它们的属性和 class 打印输出完全相同。 我知道这不是世界上最好的代码,但我只是拼凑了一个简单的例子。
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 向量,可以从加载的数据集中选择。然后我对其进行采样,并希望从采样的指数中找到平均值。
其中一个问题是子集化。 [
还是 returns 一个 data.frame
。所以,我们需要[[
。如果我们看 ?tapply
tapply(X, INDEX, FUN = NULL, ..., default = NA, simplify = TRUE)
哪里
X is an atomic object, typically a vector
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)
-输出