Проблема с реактивным входом в ShinyDashboard

Я использую следующий набор данных: https://docs.google.com/spreadsheets/d/1C_P5xxzYr7HOkaZFfFiDhanqDSuSIrd2UkiC-6_G2q0/edit

я использую ShinyDashboard и у меня есть selectInput это позволяет мне выбрать определенный тип Candy bar (в столбце Candy в моем наборе данных).

Как мне взять этот выбор Candy, а затем сделать график, который содержит частоту для этого выбранного моноблока для каждого месяца покупки? В моем server.RЯ не уверен, что иметь в этом CandyCount реактивный элемент.

Мой код выглядит следующим образом:

## ui.R ##
library(shinydashboard)
library(rCharts)


dashboardPage(
  dashboardHeader(title = "Dashboard"),

  dashboardSidebar(
    width = 150,
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("bar-chart"))
    )
    ),

  dashboardBody(
    sidebarPanel(
      htmlOutput("candy")
    ),
    mainPanel(
      showOutput("plot2", "polycharts")
    )))

##server.R##
server <- function(input, output, session) { 


  output$candy<- renderUI({
    selectInput(
      inputId = "candy",
      label = "Candy: ",
      choices = as.character(unique(dataset$Candy)),
      selected = "Twix"
    )
  })


    output$plot2 <- renderChart2({
    candySelect<- input$candy
    df <- dataset[dataset$candy == candySelect,]
    p2 <- rPlot(freq~purchase_month, data = df, type = 'line')
    p2$guides(y = list(min = 0, title = ""))
    p2$guides(y = list(title = ""))
    p2$addParams(height = 300, dom = 'chart2')
    return(p2)
  })


  }

1 ответ

Решение

Если вы согласны с использованием ggplot, вы можете сделать что-то вроде этого:

Отредактировано, чтобы иметь динамическую подсказку

## ui.R ##
library(shinydashboard)
library(shinyBS)
require(ggplot2)

dataset <- read.csv("Sample Dataset - Sheet1.csv")

ui <- dashboardPage(
  dashboardHeader(title = "Dashboard"),

  dashboardSidebar(
    width = 150,
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("bar-chart"))
    )
  ),

  dashboardBody(
    sidebarPanel(
      htmlOutput("candy")
    ),
    mainPanel(
      uiOutput("plotUI")
    )
  ))

##server.R##
server <- function(input, output, session) { 

  output$candy<- renderUI({
    selectInput(
      inputId = "candy",
      label = "Candy: ",
      choices = as.character(unique(dataset$Candy)),
      selected = "Twix"
    )
  })

  output$plotUI <- renderUI({
    if(is.null(input$candy)) return(NULL)
    local({
      candySelect <- input$candy
      str1 <- sprintf("The candybar you selected is: %s",candySelect)
      str2 <- sprintf("More about %s <a>here</a>",candySelect)
      print (str1)
      popify(plotOutput('plot'),str1,str2)
    })

  }) 

  observeEvent(input$candy,{
    if(is.null(input$candy)) return(NULL)
    candySelect<- input$candy
    print ('plot')
    # Assuming only one entry for each mont per candybar
    d <- dataset[dataset$Candy==candySelect,]
    output$plot <- renderPlot({
      ggplot(data=d, aes(x=purchase_month,y=freq,group=Candy)) + 
      geom_line() + 
      ggtitle(candySelect)
    })
  })

}

shinyApp(ui = ui, server = server)

Я думаю, это должно работать, в противном случае вы можете связать всплывающие подсказки с помощью jQuery.

Другие вопросы по тегам