r语言 - 按日期范围计算平均值和中位数(以 Shiny 为单位)

Question

想要计算按所选日期范围分组的数值变量的平均值和中位数，仅适用于数据表，而不是传单数据。传单地图有效(只需要缩小以查看假的长/纬度图，但现在不用担心(。

我为数据表的中位数/平均值总和创建了第二个数据帧df10。

到目前为止，尝试更改输入函数以为平均值创建单独的变量，但发现它很麻烦，并且不需要我的需求。

尝试在此处使用colMeans(dataset()[,which(sapply(dataset(), class) != "Date")]) Shiny 计算数据框中列的平均值

错误是"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)

我希望将数值变量按平均值汇总，如果可能的话按中位数进行汇总，但这在此时不太重要。 任何帮助将不胜感激。

Answer 1

错误是由最后一个函数引起的。

colMeans(df[,which(sapply(df, class) !="date","date1","group")])

此代码会将函数应用于不属于 xy 类的所有列。 "date"或"group"是列名。

ColMeans还生成一个数字向量，这将导致错误，因为DT只能显示矩阵或 data.frame。我为您提供了一个用于创建数据帧的代码。但是在 generell 中，我会考虑使用 dplyr 来创建您的结果。这要容易得多。

这是一个有效的解决方案，但是您必须更改日期输入，因为预定义的选择会创建一个包含 0 行的 data.frame。

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)