Полностью в блестящем - R - текст, вызывающий ошибку, если данные отсутствуют - PullRequest
Новая
       6

Полностью в блестящем - R - текст, вызывающий ошибку, если данные отсутствуют

0 голосов
/ 05 ноября 2018

Я делаю блестящее приложение, которое фильтрует и суммирует много данных. Это работает по большей части. Но я ограничен законами, ограничивающими то, что отображается на графиках, поэтому я отфильтровываю все, что ниже 5 (как видно в коде). Это приводит к тому, что некоторые переменные отображаются как ноль, и поскольку у меня есть текст в add_trace, он выдает ошибка (столбец text должен иметь длину 0, а не 1). Я пытаюсь найти текстовый вывод, если график пуст, или предотвратить появление ошибки.

Это также может помочь мне, если я смогу просто визуализировать что-то еще (пользовательское сообщение), если вывод выдаст ошибку.

Вот воспроизводимый пример,
Ошибка появится, если вы смените школу на Хогвартс.

Мои данные: 

mydata <- structure(list(year = c("2001", "2002", "2001", "2002", "2001","2002", "2001", "2002", "2001", "2002", "2001", "2002", "2001", "2002", "2001", "2002", "2001", "2002", "2001", "2001", "2002"), school = structure(c(2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Beauxbatons", "Hogwarths"), class = "factor"), grade = c(67, 69, 72, 90, 75, 85, 13, 45, 12, 90, 75, 85, 13, 45, 12, 67, 69, 72, 67, 69, 72), magic = structure(c(1L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("black", "white"), class = "factor")), row.names = c(NA, -21L), class = c("tbl_df", "tbl", "data.frame"))

мое блестящее приложение: 

library(shiny)
library(tidyverse)

ui <- fluidPage(

    selectInput("school",
            label = h3("Choose a school"),
            choices = levels(mydata$school)
    ),
    ### Choose type of magic
    selectInput("magic",
                label = "Choose magic type",
                choices = levels(mydata$magic)),


    plotlyOutput("plot_school")

)

server <- function(input, output) {

    output$plot_school <- renderPlotly({

            mydata %>%
                    filter(school == input$school, magic == input$magic) %>% 
                    group_by(year) %>% 
                    summarise(m = mean(grade), n=n()) %>%
                    filter(n > 5) %>% 
                    plot_ly(type = "scatter") %>%
                    add_trace(
                            x = ~ year,
                            y = ~ m,
                            text = ~paste('number: ', n),
                            type = 'bar'
                    )
    }) 
}
# Run the application 
shinyApp(ui = ui, server = server)

1 Ответ

0 голосов
/ 05 ноября 2018

Вы можете сделать это, используя validate. Он проверяет условие, используя need, продолжает работу, если условие выполнено, в противном случае отображается пользовательское сообщение для пользователя.

Вы можете сначала отфильтровать данные на основе (n > 5). Затем проверьте, есть ли в этих данных строки. Если да, постройте его, а если нет, бросьте сообщение. 

output$plot_school <- renderPlotly({

    filtered_data <- mydata %>%
        filter(school == input$school, magic == input$magic) %>% 
        group_by(year) %>% 
        summarise(m = mean(grade), n=n()) %>%
        filter(n > 5)

    # Add validate - checks if number of rows in filtered_data is > 0
    # If not, displays "Data insufficient for plot"
    validate(
      need( nrow(filtered_data) > 0, "Data insufficient for plot")
    )

    # Create plot
    filtered_data %>%
      plot_ly(type = "scatter") %>%
      add_trace(
        x = ~ year,
        y = ~ m,
        text = ~paste('number: ', n),
        type = 'bar'
      )
  })

Подробнее о проверке здесь .

...