Используйте handle_click в ggvis, чтобы создать интерактивный фильтр в Shiny

У меня есть базовое приложение Shiny, использующее графику ggvis (). Приложение представлено ниже.

Я вижу в документации для ggvis () есть handle_click(vis, on_click = NULL) функция, которую можно передать. Кроме того, on_click - это функция обратного вызова с данными аргументов, местоположением и сеансом.

Что я хотел бы сделать, так это позволить пользователю щелкнуть одну из полосок на графике (одну полосу в месяц) и установить input$monthSelect на месяц полосы, на которой они щелкнули. Если бы я добавлял всплывающую подсказку, я мог бы создать функцию, которая будет принимать данные из слоя, над которым наведен курсор, и я мог бы ссылаться на data$x_, чтобы получить месяц.

Пример этой функции:

update_selection = function(data){
    if(is.null(data)) return(NULL)
    updateSelectInput(session
                     ,"monthSelect"
                     ,selected=data$x_)
  }

и я добавляю его в ggvis через ggvis() %>% handle_click(update_selection(data)), но получаю сообщение об ошибке Error in func() : could not find function "fun".

Как сделать реактивный график?

library(ggvis)
library(dplyr)
library(tidyr)
library(ReporteRs)
data = cocaine
data = within(data,
  {
    month[month==1] = "January"
    month[month==2] = "February"
    month[month==3] = "March"
    month[month==4] = "April"
    month[month==5] = "May"
    month[month==6] = "June"
    month[month==7] = "July"
    month[month==8] = "August"
    month[month==9] = "September"
    month[month==10] = "October"
    month[month==11] = "November"
    month[month==12] = "December"
  }
)

server = function(input, output, session){

  selectedState = reactive(input$stateSelect)

  plotData = reactive({
    data %>%
      group_by(state,month) %>%
      summarise(avgPotency = mean(potency)) %>%
      ungroup() %>%
      spread(month,avgPotency) %>%
      mutate(January = ifelse(is.na(January),0,January)
             ,February = ifelse(is.na(February),0,February)
             ,March = ifelse(is.na(March),0,March)
             ,April = ifelse(is.na(April),0,April)
             ,May = ifelse(is.na(May),0,May)
             ,June = ifelse(is.na(June),0,June)
             ,July = ifelse(is.na(July),0,July)
             ,August = ifelse(is.na(August),0,August)
             ,September = ifelse(is.na(September),0,September)
             ,October = ifelse(is.na(October),0,October)
             ,November = ifelse(is.na(November),0,November)
             ,December = ifelse(is.na(December),0,December)
      ) %>%
      filter(state==selectedState()) %>%
      gather("month","AvgPotency",-state)
  })

  stateVis = reactive({
    plotData() %>% 
      ggvis(x=~month,y=~AvgPotency)
  })
  stateVis %>% bind_shiny("cocaineCounts")

  selectedMonth = reactive(input$monthSelect)
  tableData = reactive({
    data %>%
      filter(state==selectedState() & month==selectedMonth())
  })
  output$cocaineTable = renderUI({
    MyFTable = FlexTable(tableData(),
                         header.cell.props = cellProperties( padding = 2 ),
                         body.cell.props = cellProperties( padding = 2 ))
    return(HTML(as.html(MyFTable)))
  })

}

ui = shinyUI(
  fluidPage(
    column(6,
            selectInput("stateSelect",label="Select a State:",choices = unique(data$state),selected=1)
           ,selectInput("monthSelect",label="Select a Month:",choices = c('January','February','March','April','May','June','July','August','September','October','November','December'),selected=1)
           ,ggvisOutput("cocaineCounts")
    )
    ,column(6,
            uiOutput(outputId = "cocaineTable")
    )
    )
  )

shinyApp(ui = ui, server = server)

person Mark    schedule 09.02.2015    source источник


Ответы (1)


Функцию необходимо обновить, чтобы она могла принимать три аргумента:

update_selection = function(data,location,session){
    if(is.null(data)) return(NULL)
    updateSelectInput(session
                     ,"monthSelect"
                     ,selected=data$x_)
  }

и handle_click () необходимо передать как ggvis() %>% handle_click(update_selection)

Итак, полное рабочее приложение:

library(ggvis)
library(dplyr)
library(tidyr)
library(ReporteRs)
data = cocaine
data = within(data,
  {
    month[month==1] = "January"
    month[month==2] = "February"
    month[month==3] = "March"
    month[month==4] = "April"
    month[month==5] = "May"
    month[month==6] = "June"
    month[month==7] = "July"
    month[month==8] = "August"
    month[month==9] = "September"
    month[month==10] = "October"
    month[month==11] = "November"
    month[month==12] = "December"
  }
)

update_selection = function(data,location,session){
    if(is.null(data)) return(NULL)
    updateSelectInput(session
                     ,"monthSelect"
                     ,selected=data$x_)
  }

server = function(input, output, session){

  selectedState = reactive(input$stateSelect)

  plotData = reactive({
    data %>%
      group_by(state,month) %>%
      summarise(avgPotency = mean(potency)) %>%
      ungroup() %>%
      spread(month,avgPotency) %>%
      mutate(January = ifelse(is.na(January),0,January)
             ,February = ifelse(is.na(February),0,February)
             ,March = ifelse(is.na(March),0,March)
             ,April = ifelse(is.na(April),0,April)
             ,May = ifelse(is.na(May),0,May)
             ,June = ifelse(is.na(June),0,June)
             ,July = ifelse(is.na(July),0,July)
             ,August = ifelse(is.na(August),0,August)
             ,September = ifelse(is.na(September),0,September)
             ,October = ifelse(is.na(October),0,October)
             ,November = ifelse(is.na(November),0,November)
             ,December = ifelse(is.na(December),0,December)
      ) %>%
      filter(state==selectedState()) %>%
      gather("month","AvgPotency",-state)
  })

  stateVis = reactive({
    plotData() %>% 
      ggvis(x=~month,y=~AvgPotency) %>%
        handle_click(update_selection)
  })
  stateVis %>% bind_shiny("cocaineCounts")

  selectedMonth = reactive(input$monthSelect)
  tableData = reactive({
    data %>%
      filter(state==selectedState() & month==selectedMonth())
  })
  output$cocaineTable = renderUI({
    MyFTable = FlexTable(tableData(),
                         header.cell.props = cellProperties( padding = 2 ),
                         body.cell.props = cellProperties( padding = 2 ))
    return(HTML(as.html(MyFTable)))
  })

}

ui = shinyUI(
  fluidPage(
    column(6,
            selectInput("stateSelect",label="Select a State:",choices = unique(data$state),selected=1)
           ,selectInput("monthSelect",label="Select a Month:",choices = c('January','February','March','April','May','June','July','August','September','October','November','December'),selected=1)
           ,ggvisOutput("cocaineCounts")
    )
    ,column(6,
            uiOutput(outputId = "cocaineTable")
    )
    )
  )

shinyApp(ui = ui, server = server)
person Mark    schedule 09.02.2015