r - obsługa błędów tryCatch w obrębie Shiny - r, błyszczący

tło

Używam błyszczącej aplikacji do cut i table niektóre dane.

Zbiór danych znajduje się w shiny kod poniżej, ale główka jest:

> head(df_in)
Report_Year Position   Target
1        2014      CEO 29.27644
2        2014      CEO 29.27644
3        2014      CFO 17.56586
4        2014       CE 17.56586
5        2014      COO 17.56586
6        2014      CEO 46.84231

Używam poniższego oświadczenia do cut i table dane

  df <- df_in %>%
filter(Report_Year == input$v_year,
Position == "CEO") %>%
select(Target) %>%
filter(!is.na(Target)) %>%
mutate(bins = cut(Target, breaks=seq(0, (max(Target)+25), 25))) %>%
select(bins) %>%
table %>%
as.data.frame

>
. Freq
1   (0,25]    0
2  (25,50]    6
3  (50,75]    2
4 (75,100]    1

W danych są Nie wpisy dla Report_Year == 2012, więc gdy użytkownik wybierze 2012 Chcę, aby wyświetlał on komunikat typu "brak danych" lub w tej chwili, gdy będę zadowolony z pustej ramki danych.

Próbowałem tryCatch() oświadczenie, ale oczywiście nie robię tego poprawnie, ponieważ aplikacja ulega awarii, gdy użytkownik wybierze 2012.

Pytanie

Jak powinienem pisać tryCatch?

Błyszcząca aplikacja

library(shiny)
library(dplyr)

ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("v_year", label = "select year", choices = c(2012, 2014), selected = 2014)
),
mainPanel(
dataTableOutput("dt")
)
)
))

server <- shinyServer(function(input, output) {


df <- reactive({

## data
df_in <- structure(list(Report_Year = c(2014L, 2014L, 2014L, 2014L, 2014L,
2014L, 2014L, 2014L, 2014L, 2014L, 2014L, 2014L, 2014L, 2014L,
2014L, 2014L, 2014L, 2014L, 2014L, 2014L, 2014L, 2014L, 2014L,
2014L, 2014L, 2014L, 2014L, 2014L, 2014L, 2014L), Position = c("CEO",
"CEO", "CFO", "CE", "COO", "CEO", "CFO", "BUE", "CE", "CFO",
"CEO", "COO", "CE", "BUE", "COO", "CFO", "CE", "GC", "CEO", "CEO",
"CE", "BUE", "CEO", "CFO", "CE", "GC", "CFO", "CEO", "CEO", "CE"
), Target = c(29.2764408921928, 29.2764408921928, 17.5658645353157,
17.5658645353157, 17.5658645353157, 46.8423054275084, 38.6449019776945,
38.6449019776945, 38.6449019776945, 35.1317290706313, 35.1317290706313,
46.8423054275084, 35.1317290706313, 35.1317290706313, 43.9146613382892,
43.9146613382892, 35.1317290706313, 35.1317290706313, 29.2764408921928,
87.8293226765783, 11.7105763568771, 11.7105763568771, 29.2764408921928,
17.5658645353157, 35.1317290706313, 40.9870172490699, 40.9870172490699,
73.1911022304819, 70.2634581412627, 46.8423054275084)), class = "data.frame", .Names = c("Report_Year",
"Position", "Target"), row.names = c(NA, -30L))

tryCatch({
df <- df_in %>%
filter(Report_Year == input$v_year,
Position == "CEO") %>%
select(Target) %>%
filter(!is.na(Target)) %>%
mutate(bins = cut(Target, breaks=seq(0, (max(Target)+25), 25))) %>%
select(bins) %>%
table %>%
as.data.frame
},
warning=function(w) {
print("Warning")
df <- data.frame()
return(NA)
},
error=function(e) {
print("Error")
df <- data.frame()
return(NULL)
}
)
})

output$dt <- renderDataTable({
df  <- df()
})

})

shinyApp(ui = ui, server = server)

Informacje o sesji

> sessionInfo()
R version 3.2.0 (2015-04-16)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 14.04.2 LTS

locale:
[1] LC_CTYPE=en_AU.utf-8       LC_NUMERIC=C               LC_TIME=en_AU.utf-8        LC_COLLATE=en_AU.utf-8
[5] LC_MONETARY=en_AU.utf-8    LC_MESSAGES=en_AU.utf-8    LC_PAPER=en_AU.utf-8       LC_NAME=C
[9] LC_ADDRESS=C               LC_TELEPHONE=C             LC_MEASUREMENT=en_AU.utf-8 LC_IDENTIFICATION=C

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base

other attached packages:
[1] knitr_1.10.5   rmarkdown_0.7  stringr_1.0.0  extrafont_0.17 scales_0.2.5   tidyr_0.2.0    ggplot2_1.0.1  reshape2_1.4.1
[9] dplyr_0.4.2    shiny_0.12.1

Komunikat o błędzie

Odpowiedzi:

2 dla odpowiedzi № 1

Co powiesz na coś takiego?

server <- shinyServer(function(input, output) {

df_in <- structure(...) # As before

# Filter data according to input$v_year
df <- reactive({
df_in %>%
filter(Report_Year == input$v_year, Position == "CEO") %>%
select(Target) %>%
filter(!is.na(Target))
})

# Prepare bins or return if df is empty
bins <- reactive({
if(nrow(df()) == 0) return()
df() %>%
mutate(bins = cut(Target, breaks=seq(0, (max(Target)+25), 25))) %>%
select(bins) %>%
table %>%
as.data.frame
})

output$dt <- renderDataTable({
bins()
})
})

Ponieważ sprawdzamy, czy df() jest pusty, o ile dane wejściowe są poprawne seq nigdy nie otrzyma pustego argumentu.

---