在 shiny 中使用 tapply 生成摘要输出
using tapply inside shiny to produce summary outputs
下面的代码是可重现的:
library(shiny)
library(Rcpp)
library(ggmap)
library(htmlwidgets)
library(leaflet)
crime2 <- crime[1:50,]
ui <- fluidPage(
titlePanel("Unusual Observations"),
sidebarLayout(
sidebarPanel(
helpText("Create maps with
information from the Crime Data"),
selectInput("var",
label = "Choose a variable to display",
choices = c("Hour",
"Number"),
selected = "Hour"),
sliderInput("range",
label = "Range of interest:",
min = 0, max = 10, value = c(1, 2))
),
mainPanel(leafletOutput("map"))
),
verbatimTextOutput("stats")
)
server <- function(input, output) {
output$map <- renderLeaflet({
data <- switch(input$var,
"hour" = crime2$hour,
"number" = crime2$number)
getColor <- function(data){sapply(data, function(var){
if(input$var< input$range[1]) {
"green"
} else if(input$var <= input$range[2]) {
"orange"
} else {
"red"
} })
}
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = getColor(crime2)
)
leaflet(crime2) %>%
addTiles() %>%
addAwesomeMarkers(~lon, ~lat, icon=icons)
})
output$stats <- renderPrint({
with(crime2, tapply(input$var, list(type), summary))
})
}
shinyApp(ui=ui, server=server)
对于统计输出,我收到一条错误消息:
Error: arguments must have same length.
有谁知道如何解决这个问题?除此之外,我还让所有小部件都显示为红色,但我还有另一个 post 询问小部件问题。如果有人能帮我解决这个问题,我将不胜感激。先感谢您!
调试中:
如果我们调试您的代码,我看到您尝试这样做:
crime2 <- crime[1:50,]
with(crime2, tapply("Hour", list(type), summary))
除了 shiny,我猜你想要的输出是:
with(crime2, tapply(X = hour, INDEX = type, FUN = summary))
在 shiny 中你想通过输入访问,所以用一个字符。因此,您可以将代码重写为:
tapply(X = unlist(crime2["hour"]), INDEX = crime2$type, FUN = summary)
或动态:
tapply(X = unlist(crime2[input$var]), INDEX = crime2$type, FUN = summary)
.
完整的可重现示例为:
(input$var
必须将选项更改为小写才能启用索引,...)
library(shiny)
library(Rcpp)
library(ggmap)
library(htmlwidgets)
library(leaflet)
crime2 <- crime[1:50,]
ui <- fluidPage(
titlePanel("Unusual Observations"),
sidebarLayout(
sidebarPanel(
helpText("Create maps with
information from the Crime Data"),
selectInput("var",
label = "Choose a variable to display",
choices = c("hour",
"number"),
selected = "hour"),
sliderInput("range",
label = "Range of interest:",
min = 0, max = 10, value = c(1, 2))
),
mainPanel(leafletOutput("map"))
),
verbatimTextOutput("stats")
)
server <- function(input, output) {
output$map <- renderLeaflet({
data <- switch(input$var,
"hour" = crime2$hour,
"number" = crime2$number)
getColor <- function(data){sapply(data, function(var){
if(input$var< input$range[1]) {
"green"
} else if(input$var <= input$range[2]) {
"orange"
} else {
"red"
} })
}
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = getColor(crime2)
)
leaflet(crime2) %>%
addTiles() %>%
addAwesomeMarkers(~lon, ~lat, icon=icons)
})
output$stats <- renderPrint({
tapply(X = unlist(crime2[input$var]), INDEX = crime2$type, FUN = summary)
})
}
shinyApp(ui = ui, server = server)
下面的代码是可重现的:
library(shiny)
library(Rcpp)
library(ggmap)
library(htmlwidgets)
library(leaflet)
crime2 <- crime[1:50,]
ui <- fluidPage(
titlePanel("Unusual Observations"),
sidebarLayout(
sidebarPanel(
helpText("Create maps with
information from the Crime Data"),
selectInput("var",
label = "Choose a variable to display",
choices = c("Hour",
"Number"),
selected = "Hour"),
sliderInput("range",
label = "Range of interest:",
min = 0, max = 10, value = c(1, 2))
),
mainPanel(leafletOutput("map"))
),
verbatimTextOutput("stats")
)
server <- function(input, output) {
output$map <- renderLeaflet({
data <- switch(input$var,
"hour" = crime2$hour,
"number" = crime2$number)
getColor <- function(data){sapply(data, function(var){
if(input$var< input$range[1]) {
"green"
} else if(input$var <= input$range[2]) {
"orange"
} else {
"red"
} })
}
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = getColor(crime2)
)
leaflet(crime2) %>%
addTiles() %>%
addAwesomeMarkers(~lon, ~lat, icon=icons)
})
output$stats <- renderPrint({
with(crime2, tapply(input$var, list(type), summary))
})
}
shinyApp(ui=ui, server=server)
对于统计输出,我收到一条错误消息:
Error: arguments must have same length.
有谁知道如何解决这个问题?除此之外,我还让所有小部件都显示为红色,但我还有另一个 post 询问小部件问题。如果有人能帮我解决这个问题,我将不胜感激。先感谢您!
调试中:
如果我们调试您的代码,我看到您尝试这样做:
crime2 <- crime[1:50,]
with(crime2, tapply("Hour", list(type), summary))
除了 shiny,我猜你想要的输出是:
with(crime2, tapply(X = hour, INDEX = type, FUN = summary))
在 shiny 中你想通过输入访问,所以用一个字符。因此,您可以将代码重写为:
tapply(X = unlist(crime2["hour"]), INDEX = crime2$type, FUN = summary)
或动态:
tapply(X = unlist(crime2[input$var]), INDEX = crime2$type, FUN = summary)
.
完整的可重现示例为:
(input$var
必须将选项更改为小写才能启用索引,...)
library(shiny)
library(Rcpp)
library(ggmap)
library(htmlwidgets)
library(leaflet)
crime2 <- crime[1:50,]
ui <- fluidPage(
titlePanel("Unusual Observations"),
sidebarLayout(
sidebarPanel(
helpText("Create maps with
information from the Crime Data"),
selectInput("var",
label = "Choose a variable to display",
choices = c("hour",
"number"),
selected = "hour"),
sliderInput("range",
label = "Range of interest:",
min = 0, max = 10, value = c(1, 2))
),
mainPanel(leafletOutput("map"))
),
verbatimTextOutput("stats")
)
server <- function(input, output) {
output$map <- renderLeaflet({
data <- switch(input$var,
"hour" = crime2$hour,
"number" = crime2$number)
getColor <- function(data){sapply(data, function(var){
if(input$var< input$range[1]) {
"green"
} else if(input$var <= input$range[2]) {
"orange"
} else {
"red"
} })
}
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = getColor(crime2)
)
leaflet(crime2) %>%
addTiles() %>%
addAwesomeMarkers(~lon, ~lat, icon=icons)
})
output$stats <- renderPrint({
tapply(X = unlist(crime2[input$var]), INDEX = crime2$type, FUN = summary)
})
}
shinyApp(ui = ui, server = server)