在 Shiny 中按日期范围计算平均值和中位数
Calculate mean and median by date range in Shiny
只想为数据表计算按选定日期范围分组的数值变量的均值和中位数，而不是传单数据。传单地图有效（只需要缩小即可看到假的 long/lat 图，但现在不用担心）。
我为数据表 median/mean 数据总和创建了第二个数据帧 df10。
到目前为止，我尝试过更改输入函数来为均值创建单独的变量，但发现它很麻烦，而且对我的需要来说不是必需的。
试图在此处使用 colMeans(dataset()[,which(sapply(dataset(), class) != "Date")])
错误是"invalid 'x' type in 'x && y"。它与 colmeans
有关
### Generate a dataset ###
start_date <- as.Date('2018-01-01')
end_date <- as.Date('2019-05-10')
set.seed(1984)
date1 <- as.Date(sample( as.numeric(start_date): as.numeric(end_date), 988,
replace = T), origin = '1970-01-01')
group <- rep(letters[1:26], each = 38)
x1 <- runif(n = 988, min = 3.26, max = 10)
x2 <- runif(n = 988, min = 3.26, max = 10)
x3 <- runif(n = 988, min = 3.26, max = 10)
x4 <- runif(n = 988, min = 3.26, max = 10)
x5 <- runif(n = 988, min = 3.26, max = 10)
latitude <- runif(988,40.75042,50.75042)
longitude <- runif(988,-73.98928,-63.98928)
dataframe <- cbind(data.frame(date1,group,x1,x2,x3,x4,x5,latitude,longitude))
df10 <- cbind(data.frame(date1,group,x1,x2,x3,x4,x5))
library(lubridate)
dataframe$date <- ymd(dataframe$date1)
df10$date <- ymd(df10$date1)
library(shiny)
library(leaflet)
library(DT)
dataframe$defectrateLvl <- cut(dataframe$x1,
c(3.26,6,100), include.lowest = T,
labels = c('3.26-6x','6x+'))
beatCol <- colorFactor(palette = c('yellow', 'red'), dataframe$defectrateLvl)
ui <- fluidPage(
dateInput(inputId = "date", label="Select a date", value = "2019-03-01", min = "2018-01-01", max = "2019-05-10",
format = "yyyy-mm-dd", startview = "month",
language = "en", width = NULL),
leafletOutput("map"),
fluidRow(
dateRangeInput("daterange","Date range:",start=Sys.Date()-10, end=Sys.Date() -1),
DT::dataTableOutput("tbl")
)
)
server <- shinyServer(function (input, output,session) {
dailyData <- reactive(dataframe[dataframe$date == format(input$date, '%Y/%m/%d'), ] )
output$map <- renderLeaflet({
dataframe <- dailyData() # Added this in attempt to integrate
dataframe %>% leaflet() %>%
setView(lng = -73.98928, lat = 40.75042, zoom = 10) %>%
addProviderTiles("CartoDB.Positron", options = providerTileOptions(noWrap = TRUE)) %>%
addCircleMarkers(
lng=~dataframe$longitude, # Longitude coordinates
lat=~dataframe$latitude, # Latitude coordinates
#radius=~defectrateLvl, # Total count
popup =~ dataframe$group,
color = ~beatCol(dataframe$defectrateLvl),
fillOpacity=0.5 # Circle Fill Opacity
)
})
output$tbl<-DT::renderDataTable({
dataset <- reactive({df10 })
dataset() %>% group_by(group) %>%
filter(date > input$daterange[1],
date < input$daterange[2])
#sapply(Filter(is.numeric, df6), mean)
colMeans(dataset()[,which(sapply(dataset(), class) !="date","date1","group")])
})
})
shinyApp(ui, server)
我希望数值变量按均值汇总，如果可能的话按中位数汇总，但目前这不太重要。任何帮助将不胜感激。
错误是由最后一个函数引起的。
colMeans(df[,which(sapply(df, class) !="date","date1","group")])
此代码会将函数应用于所有不属于 class xy 的列。 "date" 或 "group" 是列名。
ColMeans也会产生一个数值向量，这会导致错误，因为DT只能显示一个矩阵或者一个data.frame。我为您提供了创建数据框的代码。但总的来说，我会考虑使用 dplyr 来创建结果。这要容易得多。
这是一个有效的解决方案，但是您必须更改日期输入，因为预定义的选择会创建一个 data.frame 和 0 行。
library(lubridate)
library(shiny)
library(leaflet)
library(DT)
library(dplyr)
### Generate a dataset ###
start_date <- as.Date('2018-01-01')
end_date <- as.Date('2019-05-10')
set.seed(1984)
date1 <- as.Date(sample( as.numeric(start_date): as.numeric(end_date), 988,
replace = T), origin = '1970-01-01')
group <- rep(letters[1:26], each = 38)
x1 <- runif(n = 988, min = 3.26, max = 10)
x2 <- runif(n = 988, min = 3.26, max = 10)
x3 <- runif(n = 988, min = 3.26, max = 10)
x4 <- runif(n = 988, min = 3.26, max = 10)
x5 <- runif(n = 988, min = 3.26, max = 10)
latitude <- runif(988,40.75042,50.75042)
longitude <- runif(988,-73.98928,-63.98928)
dataframe <- cbind(data.frame(date1,group,x1,x2,x3,x4,x5,latitude,longitude))
df10 <- cbind(data.frame(date1,group,x1,x2,x3,x4,x5))
dataframe$date <- ymd(dataframe$date1)
df10$date <- ymd(df10$date1)
dataframe$defectrateLvl <- cut(dataframe$x1,
c(3.26,6,100), include.lowest = T,
labels = c('3.26-6x','6x+'))
beatCol <- colorFactor(palette = c('yellow', 'red'), dataframe$defectrateLvl)
ui <- fluidPage(
dateInput(inputId = "date", label="Select a date", value = "2019-03-01", min = "2018-01-01", max = "2019-05-10",
format = "yyyy-mm-dd", startview = "month",
language = "en", width = NULL),
leafletOutput("map"),
fluidRow(
dateRangeInput("daterange","Date range:",start=Sys.Date()-10, end=Sys.Date() -1),
DT::dataTableOutput("tbl")
)
)
server <- shinyServer(function (input, output,session) {
dailyData <- reactive(dataframe[dataframe$date == format(input$date, '%Y/%m/%d'), ] )
output$map <- renderLeaflet({
dataframe <- dailyData() # Added this in attempt to integrate
dataframe %>% leaflet() %>%
setView(lng = -73.98928, lat = 40.75042, zoom = 10) %>%
addProviderTiles("CartoDB.Positron", options = providerTileOptions(noWrap = TRUE)) %>%
addCircleMarkers(
lng=~dataframe$longitude, # Longitude coordinates
lat=~dataframe$latitude, # Latitude coordinates
#radius=~defectrateLvl, # Total count
popup =~ dataframe$group,
color = ~beatCol(dataframe$defectrateLvl),
fillOpacity=0.5 # Circle Fill Opacity
)
})
dataset <- reactive({df10 })
output$tbl <-DT::renderDataTable({
df <- dataset()
df <- df %>%
group_by(group) %>%
filter(date > input$daterange[1],
date < input$daterange[2])
#sapply(Filter(is.numeric, df6), mean)
result <- data.frame(colMeans(df[which(sapply(df, class)=="numeric")]))
colnames(result)[1] <- "Result"
result
#colMeans(df[,which(sapply(df, class) !="date","date1","group")])
})
})
shinyApp(ui, server)
只想为数据表计算按选定日期范围分组的数值变量的均值和中位数，而不是传单数据。传单地图有效（只需要缩小即可看到假的 long/lat 图，但现在不用担心）。
我为数据表 median/mean 数据总和创建了第二个数据帧 df10。
到目前为止，我尝试过更改输入函数来为均值创建单独的变量，但发现它很麻烦，而且对我的需要来说不是必需的。
试图在此处使用 colMeans(dataset()[,which(sapply(dataset(), class) != "Date")])
错误是"invalid 'x' type in 'x && y"。它与 colmeans
### Generate a dataset ###
start_date <- as.Date('2018-01-01')
end_date <- as.Date('2019-05-10')
set.seed(1984)
date1 <- as.Date(sample( as.numeric(start_date): as.numeric(end_date), 988,
replace = T), origin = '1970-01-01')
group <- rep(letters[1:26], each = 38)
x1 <- runif(n = 988, min = 3.26, max = 10)
x2 <- runif(n = 988, min = 3.26, max = 10)
x3 <- runif(n = 988, min = 3.26, max = 10)
x4 <- runif(n = 988, min = 3.26, max = 10)
x5 <- runif(n = 988, min = 3.26, max = 10)
latitude <- runif(988,40.75042,50.75042)
longitude <- runif(988,-73.98928,-63.98928)
dataframe <- cbind(data.frame(date1,group,x1,x2,x3,x4,x5,latitude,longitude))
df10 <- cbind(data.frame(date1,group,x1,x2,x3,x4,x5))
library(lubridate)
dataframe$date <- ymd(dataframe$date1)
df10$date <- ymd(df10$date1)
library(shiny)
library(leaflet)
library(DT)
dataframe$defectrateLvl <- cut(dataframe$x1,
c(3.26,6,100), include.lowest = T,
labels = c('3.26-6x','6x+'))
beatCol <- colorFactor(palette = c('yellow', 'red'), dataframe$defectrateLvl)
ui <- fluidPage(
dateInput(inputId = "date", label="Select a date", value = "2019-03-01", min = "2018-01-01", max = "2019-05-10",
format = "yyyy-mm-dd", startview = "month",
language = "en", width = NULL),
leafletOutput("map"),
fluidRow(
dateRangeInput("daterange","Date range:",start=Sys.Date()-10, end=Sys.Date() -1),
DT::dataTableOutput("tbl")
)
)
server <- shinyServer(function (input, output,session) {
dailyData <- reactive(dataframe[dataframe$date == format(input$date, '%Y/%m/%d'), ] )
output$map <- renderLeaflet({
dataframe <- dailyData() # Added this in attempt to integrate
dataframe %>% leaflet() %>%
setView(lng = -73.98928, lat = 40.75042, zoom = 10) %>%
addProviderTiles("CartoDB.Positron", options = providerTileOptions(noWrap = TRUE)) %>%
addCircleMarkers(
lng=~dataframe$longitude, # Longitude coordinates
lat=~dataframe$latitude, # Latitude coordinates
#radius=~defectrateLvl, # Total count
popup =~ dataframe$group,
color = ~beatCol(dataframe$defectrateLvl),
fillOpacity=0.5 # Circle Fill Opacity
)
})
output$tbl<-DT::renderDataTable({
dataset <- reactive({df10 })
dataset() %>% group_by(group) %>%
filter(date > input$daterange[1],
date < input$daterange[2])
#sapply(Filter(is.numeric, df6), mean)
colMeans(dataset()[,which(sapply(dataset(), class) !="date","date1","group")])
})
})
shinyApp(ui, server)
我希望数值变量按均值汇总，如果可能的话按中位数汇总，但目前这不太重要。任何帮助将不胜感激。
错误是由最后一个函数引起的。
colMeans(df[,which(sapply(df, class) !="date","date1","group")])
此代码会将函数应用于所有不属于 class xy 的列。 "date" 或 "group" 是列名。
ColMeans也会产生一个数值向量，这会导致错误，因为DT只能显示一个矩阵或者一个data.frame。我为您提供了创建数据框的代码。但总的来说，我会考虑使用 dplyr 来创建结果。这要容易得多。
这是一个有效的解决方案，但是您必须更改日期输入，因为预定义的选择会创建一个 data.frame 和 0 行。
library(lubridate)
library(shiny)
library(leaflet)
library(DT)
library(dplyr)
### Generate a dataset ###
start_date <- as.Date('2018-01-01')
end_date <- as.Date('2019-05-10')
set.seed(1984)
date1 <- as.Date(sample( as.numeric(start_date): as.numeric(end_date), 988,
replace = T), origin = '1970-01-01')
group <- rep(letters[1:26], each = 38)
x1 <- runif(n = 988, min = 3.26, max = 10)
x2 <- runif(n = 988, min = 3.26, max = 10)
x3 <- runif(n = 988, min = 3.26, max = 10)
x4 <- runif(n = 988, min = 3.26, max = 10)
x5 <- runif(n = 988, min = 3.26, max = 10)
latitude <- runif(988,40.75042,50.75042)
longitude <- runif(988,-73.98928,-63.98928)
dataframe <- cbind(data.frame(date1,group,x1,x2,x3,x4,x5,latitude,longitude))
df10 <- cbind(data.frame(date1,group,x1,x2,x3,x4,x5))
dataframe$date <- ymd(dataframe$date1)
df10$date <- ymd(df10$date1)
dataframe$defectrateLvl <- cut(dataframe$x1,
c(3.26,6,100), include.lowest = T,
labels = c('3.26-6x','6x+'))
beatCol <- colorFactor(palette = c('yellow', 'red'), dataframe$defectrateLvl)
ui <- fluidPage(
dateInput(inputId = "date", label="Select a date", value = "2019-03-01", min = "2018-01-01", max = "2019-05-10",
format = "yyyy-mm-dd", startview = "month",
language = "en", width = NULL),
leafletOutput("map"),
fluidRow(
dateRangeInput("daterange","Date range:",start=Sys.Date()-10, end=Sys.Date() -1),
DT::dataTableOutput("tbl")
)
)
server <- shinyServer(function (input, output,session) {
dailyData <- reactive(dataframe[dataframe$date == format(input$date, '%Y/%m/%d'), ] )
output$map <- renderLeaflet({
dataframe <- dailyData() # Added this in attempt to integrate
dataframe %>% leaflet() %>%
setView(lng = -73.98928, lat = 40.75042, zoom = 10) %>%
addProviderTiles("CartoDB.Positron", options = providerTileOptions(noWrap = TRUE)) %>%
addCircleMarkers(
lng=~dataframe$longitude, # Longitude coordinates
lat=~dataframe$latitude, # Latitude coordinates
#radius=~defectrateLvl, # Total count
popup =~ dataframe$group,
color = ~beatCol(dataframe$defectrateLvl),
fillOpacity=0.5 # Circle Fill Opacity
)
})
dataset <- reactive({df10 })
output$tbl <-DT::renderDataTable({
df <- dataset()
df <- df %>%
group_by(group) %>%
filter(date > input$daterange[1],
date < input$daterange[2])
#sapply(Filter(is.numeric, df6), mean)
result <- data.frame(colMeans(df[which(sapply(df, class)=="numeric")]))
colnames(result)[1] <- "Result"
result
#colMeans(df[,which(sapply(df, class) !="date","date1","group")])
})
})
shinyApp(ui, server)