Как установить значения по умолчанию для построения ggplot в блестящем? - PullRequest
Новая
       28

Как установить значения по умолчанию для построения ggplot в блестящем?

0 голосов
/ 21 февраля 2019

Я пытался сделать свое первое блестящее приложение, используя данные из отчета World Happiness.Я хотел сделать 2 вкладки:

  1. График с использованием реактивных значений
  2. Таблица с использованием реактивных значений

Я почти преуспел, за исключением .. когда я запускаюВ коде сначала есть ошибка оценки, и она исчезает после того, как я нажимаю на кнопку действия.Думаю, мне нужны какие-то значения по умолчанию для графика и таблицы.

Есть ли способ избежать дублирования кода для вкладок?Могут ли они иметь одинаковые реактивные значения?Я попробовал, но таблица обновлялась только тогда, когда я нажимал кнопку на 1-й вкладке, а не на второй.Буду признателен, если вы предложите лучший способ справиться с этим.

Вот код: 

`ui <- fluidPage(
       titlePanel(tags$h3("Happiness")), 
       tabsetPanel(
         tabPanel("Plot", "tab1", 
           sidebarLayout(
             sidebarPanel(
               selectInput("factor1", "Choose a value:", choices = c("GDPpc", "Family","Life.Expectancy","Freedom", "Generosity", "Trust"), selected = "Family"), 
               sliderInput(inputId = "happiness1", label = "Choose level of happiness", 
                         min = 0, max = 8, value = 7, step = 0.1), 
               actionButton("button1", "Update")
             ),
             mainPanel(
             # tags$img(height = , width = )
             plotlyOutput("plot1")
             )
           )
           ),
         tabPanel("Table", "tab2", 
           sidebarLayout(
             sidebarPanel(
               selectInput("factor2", "Choose a value:", choices = c("GDPpc", "Family","Life.Expectancy", 
                                                                   "Freedom", "Generosity", "Trust"), selected = "Family"), 
               sliderInput(inputId = "happiness2", label = "Choose level of happiness", 
                         min = 0, max = 8, value = 7, step = 0.1), 
               actionButton("button2", "Update")
             ),
             mainPanel(
               tableOutput("table1")
               )
             )
             )
        )
        )`

Итак, вы видите, мой интерфейс довольно тяжел для такого простого приложения .. 

`server <- function(input, output) {
inputFactor1 <- eventReactive(input$button1, {
  inputFactor1 <-  input$factor1
  })

inputHappiness1 <- eventReactive(input$button1, {
  inputHappiness1 <- input$happiness1
  })

df1 <- reactive({
report %>%
  filter(Happiness.Score >= inputHappiness1()) %>%
  dplyr:: select( "Country", "Continent", "Happiness.Score", inputFactor1(), "GDPpc")
})

observe({
output$plot1 <- renderPlotly({
  p <- ggplot(df1(), aes(x = df1()[,4], y = Happiness.Score))
  p <- p + geom_point(size = 2, aes(text = paste("Country:", df1()[,1]), color = Continent,  alpha = 0.85)) + 
    labs(title = "How happy is the country?", x = names(df1())[4], y = "Happiness Score") + 
    theme_light(base_size = 12) + ylim(2,8) 
  ggplotly(p, tooltip = c("text", "y"))
})
})

inputFactor2 <- eventReactive(input$button2, {
  inputFactor2 <-  input$factor2
  })

inputHappiness2 <- eventReactive(input$button2, {
  inputHappiness2 <- input$happiness2
  })

df2 <- reactive({
report %>%
  filter(Happiness.Score >= inputHappiness2()) %>%
  dplyr:: select( "Country", "Continent", "Happiness.Score", inputFactor2(), "GDPpc")
 })

output$table1 <- renderTable({
head(df2())
})
}

shinyApp(ui = ui, server = server)`

Вот ссылка на приложение

1 Ответ

0 голосов
/ 21 февраля 2019

Я подозреваю, что проблемы лежат (лежат), когда вы дважды используете eventReactive, и наблюдатель сработает при любом изменении.Что мы можем сделать, это следующее:

  1. В целом избавиться от observe, вам это не нужно, так как именно оно вызывает ошибки, поскольку изначально значения равны null, если выЕсли вы хотите обработать ошибку, то лучше всего использовать функцию req() или try-catch
  2. Избавьтесь от реактивов для входов, они не являются действительно необходимыми, так как вы уже можете использовать input
  3. Оберните df1 и df2 в eventReactive вокруг нажатия кнопки

Код: 

library(shiny)
library(plotly)

ui <- fluidPage(
  HTML('<script> document.title = "Happiness"; </script>'),
  titlePanel(tags$h3("Happiness")), 
  tabsetPanel(
    tabPanel("Plot", "tab1", 
             sidebarLayout(
               sidebarPanel(
                 selectInput("factor1", "Choose a value:", choices = c("GDPpc", "Family","Life.Expectancy","Freedom", "Generosity", "Trust"), selected = "Family"), 
                 sliderInput(inputId = "happiness1", label = "Choose level of happiness", 
                             min = 0, max = 8, value = 7, step = 0.1), 
                 actionButton("button1", "Update")
               ),
               mainPanel(
                 plotlyOutput("plot1")
               )
             )
    ),
    tabPanel("Table", "tab2", 
             sidebarLayout(
               sidebarPanel(
                 selectInput("factor2", "Choose a value:", choices = c("GDPpc", "Family","Life.Expectancy", 
                                                                       "Freedom", "Generosity", "Trust"), selected = "Family"), 
                 sliderInput(inputId = "happiness2", label = "Choose level of happiness", 
                             min = 0, max = 8, value = 7, step = 0.1), 
                 actionButton("button2", "Update")
               ),
               mainPanel(
                 tableOutput("table1")
               )
             )
    )
  )
)

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

  df1 <- eventReactive(input$button1,{
    report %>%
      filter(Happiness.Score >= input$happiness1) %>%
      dplyr:: select( "Country", "Continent", "Happiness.Score", input$factor1, "GDPpc")
  })

  output$plot1 <- renderPlotly({
    req(df1())
    p <- ggplot(df1(), aes(x = df1()[,4], y = Happiness.Score))
    p <- p + geom_point(size = 2, aes(text = paste("Country:", df1()[,1]), color = Continent,  alpha = 0.85)) + 
      labs(title = "How happy is the country?", x = names(df1())[4], y = "Happiness Score") + 
      theme_light(base_size = 12) + ylim(2,8) 
    ggplotly(p, tooltip = c("text", "y"))
  })

  df2 <- eventReactive(input$button2,{
    report %>%
      filter(Happiness.Score >= input$happiness2) %>%
      dplyr:: select( "Country", "Continent", "Happiness.Score", input$factor2, "GDPpc")
  })

  output$table1 <- renderTable({
    req(df2())
    head(df2())
  })
}

shinyApp(ui = ui, server = server)
...