Рассчитать среднее значение и медиану по диапазону дат в Shiny

Хотите рассчитать среднее значение и медиану числовых переменных, сгруппированных по выбранному диапазону дат, только для данных, а не для данных брошюры. Карта листовки работает (просто нужно уменьшить масштаб, чтобы увидеть фальшивые графики долготы/широты, но сейчас не беспокойтесь об этом).

Я создал второй фрейм данных 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)

Я ожидаю, что числовые переменные будут суммированы по среднему и, если возможно, по медиане, но в настоящее время это менее важно. Любая помощь будет принята с благодарностью.

пожалуйста, исправьте свой код, в нем много ошибок. Ошибки скобок, отсутствующие наборы данных (например, df7)

DSGym 30.05.2019 06:00

ваш код все еще не работает. Не хватает запятой и квадратных скобок...

DSGym 30.05.2019 18:45

@DSGym Я обновил код. Спасибо, что указали на это.

Technological_Unemployment 30.05.2019 19:00

спасибо, теперь сработало. Помогает ли вам решение?

DSGym 30.05.2019 20:20

@DSGym да, это так. Спасибо! Просто любопытно, могу ли я использовать процесс result2 <- data.frame(colMedians(df[which(sapply(df, class)= = "numeric")])) таким же образом? Я попробовал это, но не работал.

Technological_Unemployment 30.05.2019 22:08

Отлично, пожалуйста, примите ответ :). Это тоже должно работать, вы правильно изменили имена переменных? Не могу проверить, так как сижу в телефоне

DSGym 30.05.2019 22:09

Я выбрал ваш ответ :). Видимо, я неправильно обозначил медианную переменную. ``` результат <- data.frame(colMeans(df[который(sapply(df, class)= = "numeric")])) result2 <- data.frame(colMedians(df[который(sapply(df, class) = = "numeric")])) colnames(result)[1] <- "result" colnames(result2)[2] <- "result2" result result2 ``` Хорошего вечера.

Technological_Unemployment 30.05.2019 22:25

Собираюсь сделать это завтра

DSGym 30.05.2019 22:28

Доброе утро. result <- data.frame(colMedians(as.matrix(df[which(sapply(df, class)= = "numeric")]))) Это работает => функция colMedians принимает на вход только матрицу, а dplyr возвращает data.frame

DSGym 31.05.2019 07:55

Превосходно. Я также использовал метод dplyr, чтобы расширить свое понимание Shiny. Спасибо за уделенное время.

Technological_Unemployment 31.05.2019 15:10
Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
0
10
928
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Ошибка вызвана последней функцией.

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

Этот код применит функцию ко всем столбцам, не относящимся к классу 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)

Другие вопросы по теме