group_by не выполняется на основе selectInput в блестящем коде R - PullRequest
0 голосов
/ 09 апреля 2020

Может кто-нибудь предложить изменения в приведенном ниже коде? Я пытаюсь использовать selectInput в качестве интерактивного для tableOutput и plotOutput? В настоящее время я вижу ярлык и группу ggplot по сводной таблице, обновляющейся до выбранного варианта, но фактическое число не обновляется.

Я рассмотрел предложение по использованию реактивной () для выполнения набора данных и его передачи. renderPlot и renderTable, но не повезло.


    # Define UI for application 
    ui = dashboardPage(
        #The title of the dashboard
        dashboardHeader(
            title = "SuperStore Dashboard",
            titleWidth = 200
        ),
        dashboardSidebar(
            #Sidebar content of the dashboard
            sidebarMenu(
                menuItem("Performance Dashboard", tabName = "dashboard", icon = icon("dashboard")),
                menuItem("Recommender System", tabName = "dashboard", icon = icon("bar-chart-o"))
            )
        ),
        dashboardBody(
            tabsetPanel(
                id = "tabs",
                tabPanel(
                    title = "Performance Dashboard",
                    value = "page1",
                    fluidRow(),
                    fluidRow(
                        title = "Profit % by Segments",
                        status = "primary",
                        solidHeader = TRUE, 
                        collapsible = TRUE,
                        selectInput(inputId = "segmentInput",
                                    label = "Select Segment",
                                    choices = c("Segment","Category","Region"),
                                    selected = "Category"),
                        plotOutput("profitBySegment", width = "100%")
                    ),
                    fluidRow(
                        box(
                            title = "Profit % by Segments Table",
                            status = "primary",
                            solidHeader = TRUE, 
                            collapsible = TRUE,
                            selectInput(inputId = "segmentTabInput",
                                        label = "Select Segment",
                                        choices = c("Segment","Category","Region"),
                                        selected = "Segment"),
                            tableOutput("profitBySegmentTable")
                        )
                    )
                )
            )
        )
    )

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

        #creating the plotOutput content
        supstore_df_byProfit = reactive({

                supstore_df_new %>%
                group_by(Profit_pct_range, input$segmentInput) %>%
                summarise(Orders = n_distinct(Order.ID)) %>%
                mutate(Orders.pct = round( (Orders/sum(Orders) * 100), 1)) %>%
                arrange(desc(Orders.pct))
        })

        #Plot1
        output$profitBySegment <- renderPlot({
            #plot
            ggplot(supstore_df_byProfit(),
                   aes(reorder(Profit_pct_range, -Orders), Orders, fill=input$segmentInput)) + 
                geom_bar(position="stack", stat="identity") +
                scale_fill_manual(values = c("#0073C2FF", "#EFC000FF", "#999999"))+
                theme_pubclean() +
                labs(x="Profit Range", y="Orders", title="Distribution of Orders by Profit%") +
                geom_text(aes(label=paste0(Orders.pct,"%",sep=" ")), size=3.2, color='black', fontface='bold', position = position_stack(vjust = 0.5))
        })

        #segmentTabInput
        supstore_df_byProfit2 = reactive({

            supstore_df_new %>%
                group_by(Profit_pct_range, input$segmentTabInput) %>%
                summarise(Orders = n_distinct(Order.ID)) %>%
                mutate(Orders.pct = round( (Orders/sum(Orders) * 100), 1)) %>%
                arrange(desc(Orders.pct))
        })    
        #Plot2
        output$profitBySegmentTable <- renderTable({
            head(supstore_df_byProfit2(), 5)
        })
    }

    # Run the application 
    shinyApp(ui = ui, server = server)

...