Как применить selectInput для подмножества набора данных в пузырьковой диаграмме с расщепленными упаковками Shiny R (hpackedbubble) - PullRequest
0 голосов
/ 26 февраля 2020

Как применить selectInput для набора данных поднабора в пузырьковой диаграмме с разделенными упаковками блестящий R (hpackedbubble) Приложения не показывают пузырьковую диаграмму после добавления указанного типа c выбора типа к набору данных набора.

пример для этого сайта: https://rdrr.io/cran/hpackedbubble/src/inst/examples/hpackedbubble/app.R

library(hpackedbubble)
library(colourpicker)
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("CARBON EMISSIONS AROUND THE WORLD (2014)"),

    # Sidebar with a slider input for number of bins
    sidebarLayout(
        sidebarPanel(
# I added this :
            selectInput(
                inputId = "countries",
                label = "Choose A country",
                choices = unique(CO2$country),
                selected = unique(CO2$country[1])
            ),
            selectInput(
                inputId = "theme",
                label = "Choose A Theme",
                choices = c("darkgreen",
                            "darkblue",
                            "avocado",
                            "darkunica",
                            "gray",
                            "gridlight",
                            "grid",
                            "sandsignika",
                            "sunset"),
                selected = "sunset"
            ),
            textInput(
                inputId = "title",
                label = "Input Chart Title: ",
                placeholder = "Chart title:",
                value = "CARBON EMISSIONS AROUND THE WORLD (2014)"
            ),
            selectInput(
                inputId = "titleAlign",
                label = "Title Alignment: ",
                choices = c("left", "center", "right"),
                selected = 'center'
            ),
            textInput(
                inputId = "titleSize",
                label = "Title Size: ",
                placeholder = "20px",
                value = "20px"
            ),
            colourInput(
                inputId = "titleColor",
                label = "Title Color: ",
                value = "#333333",
                showColour = "background",
                allowTransparent = TRUE
            ),
            textInput(
                inputId = "subtitle",
                label = "Input Subtitle: ",
                placeholder = "https://www.czxa.top",
                value = ""
            ),
            selectInput(
                inputId = "subtitleAlign",
                label = "Subtitle Alignment: ",
                choices = c("left", "center", "right"),
                selected = "center"
            ),
            textInput(
                inputId = "subtitleSize",
                label = "Subtitle Size: ",
                placeholder = "10px",
                value = ""
            ),
            colourInput(
                inputId = "subtitleColor",
                label = "Subtitle Color: ",
                value = "#666666",
                showColour = "background",
                allowTransparent = TRUE
            ),
            textInput(
                inputId = "pointFormat",
                label = "The HTML of the point's line in the tooltip: ",
                placeholder = "<b>{point.name}:</b> {point.y}",
                value = "<b>{point.name}:</b> {point.y}m CO<sub>2</sub>"
            ),
            selectInput(
                inputId = "split",
                label = "Split or not?",
                choices = c(0, 1),
                selected = 1,
            ),
            textInput(
                inputId = "height",
                label = "Height: ",
                placeholder = "500px",
                value = "500px"
            ),
            textInput(
                inputId = "width",
                label = "Width: ",
                placeholder = "100%",
                value = "100%"
            ),
            textInput(
                inputId = "packedbubbleMinSize",
                label = "Minimum bubble size: ",
                placeholder = "10%",
                value = "50%"
            ),
            textInput(
                inputId = "packedbubbleMaxSize",
                label = "Maximum bubble size: ",
                placeholder = "120%",
                value = "250%"
            ),
            textInput(
                inputId = "packedbubbleZMin",
                label = "The minimum for the Z value range: ",
                placeholder = 0,
                value = 0
            ),
            textInput(
                inputId = "packedbubbleZMax",
                label = "The maximum for the Z value range: ",
                placeholder = 1000,
                value = 1000
            ),
            textInput(
                inputId = "gravitational",
                label = "Gravitational const used in the barycenter force of the algorithm: ",
                placeholder = "0.0625",
                value = "0.0625"
            ),
            selectInput(
                inputId = "seriesInteraction",
                label = "Whether series should interact with each other or not: ",
                choices = c(0, 1),
                selected = 1,
            ),
            selectInput(
                inputId = "dragBetweenSeries",
                label = "In case of split series, this option allows user to drag and drop points between series, for changing point related series: ",
                choices = c(0, 1),
                selected = 1,
            ),
            selectInput(
                inputId = "parentNodeLimit",
                label = "Whether bubbles should interact with their parentNode to keep them inside: ",
                choices = c(0, 1),
                selected = 1,
            ),
            selectInput(
                inputId = "dataLabels",
                label = "Options for the series data labels, appearing next to each data point. 1 means to true, 0 means to false: ",
                choices = c(0, 1),
                selected = 1,
            ),
            textInput(
                inputId = "dataLabelsformat",
                label = "Data labels' format: ",
                placeholder = "{point.name}",
                value = '{point.name}'
            ),
            textInput(
                inputId = "dataLabelsFilter",
                label = "Show data labels while 'value' larger than dataLabelsFilter. defaults to 250: ",
                placeholder = 100,
                value = 100
            ),
            colourInput(
                inputId = "dataLabelsColor",
                label = "Data Labels' Color: ",
                value = "black",
                showColour = "background",
                allowTransparent = TRUE
            )
        ),

        # Show a plot of the generated distribution
        mainPanel(
            hpackedbubbleOutput("shinybubble", height = "800px")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
    output$shinybubble <- renderHpackedbubble({
        hpackedbubble(
# To subsetting here 
            cat = CO2$continent[CO2$continent==input$countries],
            name = CO2$country,
            value = CO2$CO2,
            theme = input$theme,
            title = input$title,
            titleAlign = input$titleAlign,
            titleSize = input$titleSize,
            titleColor = input$titleColor,
            subtitle = input$subtitle,
            subtitleAlign = input$subtitleAlign,
            subtitleSize = input$subtitleSize,
            subtitleColor = input$subtitleColor,
            pointFormat = input$pointFormat,
            split = input$split,
            packedbubbleMinSize = input$packedbubbleMinSize,
            packedbubbleMaxSize = input$packedbubbleMaxSize,
            packedbubbleZMin = input$packedbubbleZMin,
            packedbubbleZmax = input$packedbubbleZmax,
            gravitational = input$gravitational,
            seriesInteraction = input$seriesInteraction,
            dragBetweenSeries = input$dragBetweenSeries,
            parentNodeLimit = input$parentNodeLimit,
            dataLabels = input$dataLabels,
            dataLabelsformat = input$dataLabelsformat,
            dataLabelsFilter = input$dataLabelsFilter,
            dataLabelsColor = input$dataLabelsColor,
            height = input$height,
            width = input$width
        )
    })
}

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



# # Define UI for application that draws a histogram
# ui <- fluidPage(
# 
#     # Application title
#     titlePanel("Old Faithful Geyser Data"),
# 
#     # Sidebar with a slider input for number of bins 
#     sidebarLayout(
#         sidebarPanel(
#             selectizeInput(inputId = "variable_names", 
#                            label = "Names of Variable", 
#                            choices = unique(sup_d$Supplier), 
#                            selected = unique(sup_d$Supplier)[1])
#         ),
# 
#         # Show a plot of the generated distribution
#         mainPanel(
#             hpackedbubbleOutput("shinybubble")
#         )
#     )
# )
# 
# # Define server logic required to draw a histogram
# server <- function(input, output) {
# 
#     output$shinybubble <-  renderHpackedbubble({
#         hpackedbubble(
#         # generate bins based on input$bins from ui.R
#         sup_d[Supplier==input$variable_names,], sup_d$HERMES_CARAT[sup_d$Supplier==input$variable_names], 
#                       sup_d$SUM[sup_d$Supplier==input$variable_names],
#                       title = "CARBON EMISSIONS AROUND THE WORLD (2014)",
#                       pointFormat = "<b>{point.name}:</b> {point.y}m CO<sub>2</sub>",
#                       dataLabelsFilter = 100,
#                       packedbubbleMinSize = "50%",
#                       packedbubbleMaxSize = "150%",
#                       theme = "sunset",
#                       packedbubbleZMin = 0,
#                       packedbubbleZmax = 1000, split = 1,
#                       gravitational = 0.02,
#                       parentNodeLimit = 1,
#                       dragBetweenSeries = 0,
#                       seriesInteraction = 0,
#                       width = "100%")
#     })
# }
# 
# # Run the application 
# shinyApp(ui = ui, server = server)

Скрипт здесь не работает:

server <- function(input, output) {
    output$shinybubble <- renderHpackedbubble({
        hpackedbubble(
            cat = CO2$continent[CO2$continent==input$countries], <--- Here from : CO2$continent,
            name = CO2$country,
            value = CO2$CO2, ......

Цель: Моя цель состоит в отражении страны за страной с помощью выбора. например, показать группу пузырьков только «Европа» после выбранного «Европа»

...