Динамическое изменение графиков на основе пользовательского ввода в Shiny - PullRequest
Новая
       6

Динамическое изменение графиков на основе пользовательского ввода в Shiny

0 голосов
/ 03 декабря 2018

Я пытаюсь создать блестящее приложение, которое генерирует графики на основе выбора пользователем подмножества загруженного фрейма данных.Например, у меня есть следующий набор данных: 

library(shiny)
library(data.table)

df <- rbind(
  data.table( cat = rep('X', 40), grp = rep(LETTERS[1:4], each=10), x = rep(1:10, times=4), y = rnorm(40) ),
  data.table( cat = rep('Y', 30), grp = rep(LETTERS[1:3], each=10), x = rep(1:10, times=3), y = rnorm(30) ),  
  data.table( cat = rep('Z', 20), grp = rep(LETTERS[4:6], each=10), x = rep(1:10, times=2), y = rnorm(20) )
)

Основываясь на значении cat, которое пользователь выбирает в пользовательском интерфейсе, я хочу, чтобы блеск создавал диаграммы для каждого значения grp.Таким образом, если пользователь выбирает «X», то будет создано 4 графика;если они выберут «Y», их будет три, а если они выберут «Z», то будет 3.

Я также хочу указать, как генерируется каждый график на основе значения grp.Поэтому, если grp - это A, D или EI, он хочет создать линейный график, в противном случае он должен создать диаграмму рассеяния (только если это значение имеет grp, конечно же).

Ниже приведен код для моего(сломано) блестящее приложение: 

server <- function(input, output) {

  rv <- reactiveValues(
    i  = NULL,
    df = NULL
  )

  observe({ rv$i <- input$i })

  observe({ rv$df <- df[cat == rv$i] })

  output$test <- renderUI({
    plotList <- lapply( LETTERS[1:6], function(x) plotOutput(x) )

    do.call( tagList, unlist(plotList, recursive=FALSE))
  })

  for(i in LETTERS[1:6]){
    local({
      my_i <- i

      output[[my_i]] <- renderPlot({
        if( my_i %in% c('A','D','E')) {
          with(rv$df[grp == my_i], plot(x,y, type='l'))
        } else {
          with(rv$df[grp == my_i], plot(x,y))
        }
      })
    })
  }

}

ui <- fluidPage(
  titlePanel('Title'),

  sidebarLayout(
    sidebarPanel(
      helpText('Select the Category you would like to view.'),

      selectInput('i', 'Category', c('X','Y','Z'), selectize=TRUE)
    ),

    mainPanel(
      uiOutput('test')
    )
  )
)

shinyApp(ui, server)

1 Ответ

0 голосов
/ 06 декабря 2018

Воспроизводимый пример можно найти внизу.

Несколько подсказок:

1) Использование реактивных контекстов:

В вашем цикле for в нижней части кода сервера вы используете реактивную переменную rv, поэтому вам придется запускать код в реактивном контенте.Оберните это в observe().

2) Создайте список выходов:

Если я не ошибаюсь, вы использовали часть кода в этом ответе: динамически добавлять графики на веб-страницу, используя блестящий .

Это хорошая отправная точка.Для части списка тегов может быть проще упростить до: 

output$test <- renderUI({
    lapply(unique(rv$df$grp), plotOutput)
})

Вы также можете добавить tagList(), но это не обязательно здесь, ...

3) Исправление примера данных:

Возможно, вы захотите обновить переменную df: 

  data.table(cat = rep('Z', 20), grp = rep(LETTERS[4:6], each=10), 
             x = rep(1:10, times=2), y = rnorm(20) )

Здесь у вас есть три буквы, поэтому вы можете изменить их на LETTERS[5:6] илиобновите остальные номера.

Полный воспроизводимый пример: 

library(shiny)
library(data.table)

df <- rbind(
  data.table( cat = rep('X', 40), grp = rep(LETTERS[1:4], each=10), x = rep(1:10, times=4), y = rnorm(40) ),
  data.table( cat = rep('Y', 30), grp = rep(LETTERS[1:3], each=10), x = rep(1:10, times=3), y = rnorm(30) ),  
  data.table( cat = rep('Z', 30), grp = rep(LETTERS[4:6], each=10), x = rep(1:10, times=3), y = rnorm(30) )
)
server <- function(input, output) {

  rv <- reactiveValues(
    i  = NULL,
    df = NULL
  )

  observe({ rv$i <- input$i })

  observe({ rv$df <- df[cat == rv$i] })

  observe({
    for(letter in unique(rv$df$grp)){
      local({
        let <- letter
        output[[let]] <- renderPlot({
          if( let %in% c('A','D','E')) {
            with(rv$df[grp == let], plot(x, y, type='l'))
          } else {
            with(rv$df[grp == let], plot(x,y))
          }
        })
      })
    }
  })

  output$test <- renderUI({
    lapply(unique(rv$df$grp), plotOutput)
  })

}

ui <- fluidPage(
  titlePanel('Title'),
  sidebarLayout(
    sidebarPanel(
      helpText('Select the Category you would like to view.'),
      selectInput('i', 'Category', c('X','Y','Z'), selectize=TRUE)
    ),

    mainPanel(
      uiOutput('test')
    )
  )
)

shinyApp(ui, server)
...