R Блестящие спасательные реактивные ggplots - PullRequest
Новая
       5

R Блестящие спасательные реактивные ggplots

0 голосов
/ 26 августа 2018

Я пытаюсь выяснить, как сохранить реактивные ggplots в моем проекте R Shiny.Я следовал этому руководству, а также руководству на веб-сайте R Shiny.Тем не менее, я думаю, что у меня могут быть проблемы, так как я использую реактивные графики.

Вот код, который у меня есть.

ui <- fluidPage(

    dashboardBody(
      fluidRow(uiOutput('topbox')),
      fluidRow(
        tabBox(
          id = 'tabset1',
          width = '100%',
          tabPanel('Grades Graph', downloadButton('Download'), plotOutput('individualGraph')),
        )
      )
    )
  )

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

  grades <- reactive({
    req(input$file)
    inFile <- input$file
    if (endsWith(inFile$name, '.xlsx')){
      gradesTbl <- read_excel(inFile$datapath)
      gradesTbl <- gradesTbl %>% 
        arrange(Period, Student, Date, Type) %>% 
        mutate(Date = as.Date(Date))
      return(gradesTbl)
    } else if (endsWith(inFile$name, 'csv')){
      gradesTbl <- read_csv(inFile$datapath)
      gradesTbl <- gradesTbl %>% 
        arrange(Period, Student, Date, Type) %>% 
        mutate(Date = mdy(Date))
      return(gradesTbl)
    }
  })

  output$Download <- downloadHandler(
   filename = function(){
     paste('test', '.png', sep = '')
   },
   content = function(file){
     ggsave(file, plot = output$individualGraph, device = 'png')
   }
  )

  indivdf <- function(){
    data.frame(grades()) %>%
      filter((Student == input$studentVar) & (Period == input$periodVar) & (Type %in% input$typeVar) & (Unit %in% input$unitVar))
  }

  output$individualGraph <- renderPlot({
    req(input$periodVar)
    indivdf() %>%
      ggplot(aes(x = Date, y = Grade,
                 color = Type, shape = Unit)) +
      geom_point(size = 4) +
      ggtitle(paste(input$studentVar, "'s Individual Grades", sep = '')) +
      plotTheme() +
      scale_shape_manual(values = 1:10) +
      facet_wrap(Unit~.) +
      scale_color_manual(values = c('#E51A1D', '#377DB9', '#4EAE4A'))
  })

shinyApp(ui = ui, server = server)

Полный код: здесь , но я думаю, что это все, чтобы показать, что я пытаюсь сделать.Я просто не могу понять, как сохранить эти таблицы и графики, которые являются реактивными.Я чувствую, что это связано с использованием plot = output $ indididualGraph, но я действительно не знаю.

1 Ответ

0 голосов
/ 26 августа 2018

Вам нужно взять код для генерации графика и переместить его из renderPlot в reactive.Затем вы можете вызвать тот же reactive из renderPlot для отображения графика в пользовательском интерфейсе и из вашего downloadHandler для загрузки графика.

См. Пример ниже.Использование одного и того же имени переменной для реактивного (individualGraph()) и выходного возврата (output$individualGraph) может быть не лучшим методом кодирования, но я считаю его более удобным. 

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

    individualGraph <- reactive({
        req(input$periodVar)
        indivdf() %>%
            ggplot(aes(x = Date, y = Grade,
                       color = Type, shape = Unit)) +
            geom_point(size = 4) +
            ggtitle(paste(input$studentVar, "'s Individual Grades", sep = '')) +
            plotTheme() +
            scale_shape_manual(values = 1:10) +
            facet_wrap(Unit~.) +
            scale_color_manual(values = c('#E51A1D', '#377DB9', '#4EAE4A'))
    })

    output$individualGraph <- renderPlot({
        req(individualGraph())
        individualGraph()
    })

    output$Download <- downloadHandler(
        filename = function(){
            paste('test', '.png', sep = '')
        },
        content = function(file){
            req(individualGraph())
            ggsave(file, plot = individualGraph(), device = 'png')
        }
    )

    grades <- reactive({
        req(input$file)
        inFile <- input$file
        if (endsWith(inFile$name, '.xlsx')){
            gradesTbl <- read_excel(inFile$datapath)
            gradesTbl <- gradesTbl %>% 
                arrange(Period, Student, Date, Type) %>% 
                mutate(Date = as.Date(Date))
            return(gradesTbl)
        } else if (endsWith(inFile$name, 'csv')){
            gradesTbl <- read_csv(inFile$datapath)
            gradesTbl <- gradesTbl %>% 
                arrange(Period, Student, Date, Type) %>% 
                mutate(Date = mdy(Date))
            return(gradesTbl)
        }
    })

    indivdf <- function(){
        data.frame(grades()) %>%
            filter((Student == input$studentVar) & (Period == input$periodVar) & (Type %in% input$typeVar) & (Unit %in% input$unitVar))
    }
}
...