Проблема с Reactive входа в ShinyDashboard

Question

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

Я использую ShinyDashboard и у меня есть selectInput, что позволяет мне выбрать определенный тип моноблока (в колонке 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) 
    }) 


    } 

Answer 1

Если все в порядке с помощью ggplot вы могли бы сделать что-то вроде этого:

Edited иметь динамический всплывающей подсказки

## 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.