堆栈内存溢出
  繁体   English   中英

使用 shiny 时，如何传递 checkboxGroup 的选定输入值以用作 geom_col() 的 ggplot2 交互中的参数？

[英]How to pass chosen input values of checkboxGroup to be used as an argument in ggplot2 interaction of geom_col() when using shiny?

 原文  2021-02-14 14:38:32  4   1    r/ ggplot2/ shiny/ interaction/ geom-col

问题描述

我正在使用 Shiny 构建一个简单的仪表板以用于我的工作。 一切都很好，直到我发现我无法传递选择的输入以用作 ggplot geom_col()交互 arguments 中的参数。

我的目的是根据checkboxGroup的所选值更改交互 plot，其中所选值将用作 ggplot 中 fill=interaction(....) 的 arguments。

我在这个阶段遇到了问题：

ggplot(data= opsdata2, aes(x=reorder(GUDANG,KUANTUM/1000), y=KUANTUM/1000, 
                                   fill=interaction(get(input$cekgr_fill),sep = "*")
               ))

'get(input$cekgr_fill)' 仅传递第一个参数，而我的目的是在 input$cekgr_fill 中使用至少 2 个 arguments 构建交互条形图，例如：'fill=interaction(JENIS,TH_ADA, sep="*") '。

'get(input$cekgr_fill)' 只传递第一个参数，即：JENIS，并忽略 TH_ADA。

你能帮帮我吗？ 谢谢你。

这是我的代码：

    shinyUI(dashboardPage(

    #Nama Dashboard
     dashboardHeader(title = "OPERASIONAL"),
              
              dashboardSidebar(
                
                checkboxGroupInput("cekgr_gudang", label = h4("Gudang"),
                                   choiceNames = list("Karanganyar","Binong",
                                           "Rancaudik","Tanjungrasa",
                                           "Ciwangi"),
                                   choiceValues = list("Karanganyar","Binong",
                                                       "Rancaudik","Tanjungrasa",
                                                       "Ciwangi")
                                   ),
                 
                checkboxGroupInput("cekgr_komoditas", label = h4("Komoditas"),
                                   choices = c("Beras","Minyak Goreng", 
                                               "Terigu","Gula","Gabah", "Ketan")
                                   ),
                
                checkboxGroupInput("cekgr_tahun","Tahun",
                                  choices = c("2018","2019","2020","2021")
                                  ),
                
                checkboxGroupInput("cekgr_opsional", label = h4("Opsional"),
                                   choices = c("Fumigasi", "Kondisi kualitas")
                                   
                                   ),
               
                checkboxGroupInput("cekgr_fill", label = h4("Fill Grafik"),
                                   choiceNames = c("JENIS","TAHUN"),
                                   choiceValues = c("JENIS", "TH_ADA")
                                   ),
                 
                actionButton("OK","Sikaaat")
                
              ),

    ## BODY

    dashboardBody(
       fluidRow(
       column(
       width = 12,

        box(title = "Grafik Yang Kamu Minta ",
        solidHeader = T,
        width = 8, height = 500,
        collapsible = T,
        plotOutput("grafik1"),
        textOutput("PilihanGudang"),
        textOutput("PilihanKomoditas"),
        textOutput("PilihanTahun"),
        textOutput("FillGrafik"))
  
  
           )
        ))))
              




library(shiny)

# Define server logic required to draw a histogram
shinyServer(function(input, output) {
  
  
    #### Pilihan-pilihan
 
observeEvent(input$OK,{
  
  opsdata1 <- read_xlsx("~/Documents/App-Dashboard-Ops/data_Feb_11.xlsx")
  View(opsdata1)
  
  output$PilihanGudang <- renderText({
    gudangterpilih <- paste(input$cekgr_gudang,collapse = ", ")
    paste("Gudang : ", gudangterpilih)})
  
  
  output$PilihanKomoditas <- renderText({
    komoditasterpilih <- paste(input$cekgr_komoditas, collapse = ", ") 
    paste("Komoditas : ", komoditasterpilih)})
  
  output$PilihanTahun <- renderText({
    tahunterpilih <- paste(input$cekgr_tahun, collapse = ", ") 
    paste("Tahun : ", tahunterpilih)})
  
  output$FillGrafik <- renderText({
    fillterpilih <- paste(input$cekgr_fill, collapse = ", ") 
    paste("Fill : ", fillterpilih)})
   
  
  
  
  opsdata2 <- opsdata1 %>%
    
  
    filter(GUDANG %in% input$cekgr_gudang) %>% 
    filter(JENIS %in% input$cekgr_komoditas) %>% 
    filter(TH_ADA %in% input$cekgr_tahun)
  
  View(opsdata2)
      
  output$grafik1 <- renderPlot({
    
    ggplot(data= opsdata2, aes(x=reorder(GUDANG,KUANTUM/1000), y=KUANTUM/1000, 
                               fill=interaction(get(input$cekgr_fill),sep = "*")
           )) + 
      geom_col() + coord_flip() +
      scale_y_continuous(labels = unit_format(unit = "Ton")) +
      labs(x="",y="",fill="") + 
      theme_clean() + theme(legend.position = "top") 
    
  
  })
  
    
  })
  
  
})



here is my data :

structure(list(GUDANG = c("Karanganyar", "Karanganyar", "Karanganyar",    "Karanganyar", "Rancaudik", "Rancaudik", "Rancaudik", "Tanjungrasa", "Tanjungrasa", "Tanjungrasa", "Tanjungrasa", "Binong", "Binong", "Binong", "Binong", "Binong", "Binong", "Binong", "Ciwangi", "Ciwangi", "Ciwangi"), UNIT = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), TUMPUKAN = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), JENIS = c("Beras", "Beras", "Beras", "Beras", "Beras", "Beras", "Beras", "Beras", "Beras", "Beras", "Ketan", "Beras", "Beras", "Beras", "Beras", "Beras", "Beras", "Ketan", "Beras", "Beras", "Beras"), PSO_KOM_HGL = c("PSO", "PSO", "KOM", "KOM", "PSO", "PSO", "PSO", "PSO", "PSO", "KOM", "KOM", "PSO", "PSO", "PSO", "HGL", "KOM", "PSO", "KOM", "PSO", "PSO", "PSO" ), TH_ADA = c(2020, 2019, 2020, 2020, 2020, 2019, 2018, 2020, 2019, 2020, 2020, 2020, 2019, 2020, 2020, 2018, 2018, 2020, 2019, 2018, 2018), KUALITAS = c("Med_20%", "Med_20%", "Kom_10%", "Kom_10%", "Med_20%", "Med_20%", "Med_5%", "Med_20%", "Med_20%", "Kom_10%", "Kom_15%", "Med_20%", "Med_20%", "Kom_15%", "Kom_15%", "Kom_15%", "Med_5%", "Kom_15%", "Med_20%", "Med_5%", "Med_15%"), KEMASAN = c(50, 50, 10, 25, 50, 50, 50, 50, 50, 10, 25, 50, 50, 10, 50, 5, 50, 25, 50, 50, 50), MEREK = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "WJ", NA, NA, NA, NA, "IBU", NA, "WJ", NA, NA, NA), NEGARA = c("Indonesia", "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Thailand", "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Thailand", "Indonesia", "Indonesia", "Vietnam", "Vietnam"), EXP = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), KONDISI = c("Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik"), KUANTUM = c(10000, 107500, 12810, 4150, 65000, 4391000, 222850, 320000, 3193550, 2580, 37500, 30000, 2513060, 184720, 2040, 182200, 177270, 20000, 529400, 103500, 449755)), row.names = c(NA, -21L), class = c("tbl_df", "tbl", "data.frame"))

1 个解决方案

解决方案1
 0 已采纳  2021-02-14 15:15:23

您需要 select 进行交互的适当变量。 我使用pickerInput到 select 最多 5 个变量进行交互。 如果选择的变量少于 2 个，则会打印一条消息。 也许有一种更优雅的方式来做到这一点。 现在，我已经提供了一个快速的答案。 请试试这个

df1 <- structure(list(GUDANG = c("Karanganyar", "Karanganyar", "Karanganyar", "Karanganyar", "Rancaudik", "Rancaudik", 
                                 "Rancaudik", "Tanjungrasa", "Tanjungrasa", "Tanjungrasa", "Tanjungrasa", "Binong", 
                                 "Binong", "Binong", "Binong", "Binong", "Binong", "Binong", "Ciwangi", "Ciwangi", "Ciwangi"),
                      UNIT = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), 
                      TUMPUKAN = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), 
                      JENIS = c("Beras", "Beras", "Beras", "Beras", "Beras", "Beras", "Beras", "Beras", "Beras", "Beras", 
                                "Ketan", "Beras", "Beras", "Beras", "Beras", "Beras", "Beras", "Ketan", "Beras", "Beras", "Beras"),
                      PSO_KOM_HGL = c("PSO", "PSO", "KOM", "KOM", "PSO", "PSO", "PSO", "PSO", "PSO", "KOM", "KOM", "PSO", 
                                      "PSO", "PSO", "HGL", "KOM", "PSO", "KOM", "PSO", "PSO", "PSO" ), 
                      TH_ADA = c(2020, 2019, 2020, 2020, 2020, 2019, 2018, 2020, 2019, 2020, 2020, 2020, 2019, 2020, 2020, 2018, 2018, 2020, 2019, 2018, 2018), 
                      KUALITAS = c("Med_20%", "Med_20%", "Kom_10%", "Kom_10%", "Med_20%", "Med_20%", "Med_5%", "Med_20%", "Med_20%", "Kom_10%", "Kom_15%", 
                                   "Med_20%", "Med_20%", "Kom_15%", "Kom_15%", "Kom_15%", "Med_5%", "Kom_15%", "Med_20%", "Med_5%", "Med_15%"),
                      KEMASAN = c(50, 50, 10, 25, 50, 50, 50, 50, 50, 10, 25, 50, 50, 10, 50, 5, 50, 25, 50, 50, 50),
                      MEREK = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "WJ", NA, NA, NA, NA, "IBU", NA, "WJ", NA, NA, NA),
                      NEGARA = c("Indonesia", "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Thailand", 
                                 "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Indonesia", "Indonesia", 
                                 "Indonesia", "Indonesia", "Thailand", "Indonesia", "Indonesia", "Vietnam", "Vietnam"),
                      EXP = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), 
                      KONDISI = c("Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", 
                                  "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik", "Baik"), 
                      KUANTUM = c(10000, 107500, 12810, 4150, 65000, 4391000, 222850, 320000, 3193550, 2580, 37500, 30000, 
                                  2513060, 184720, 2040, 182200, 177270, 20000, 529400, 103500, 449755)), 
                 row.names = c(NA, -21L), class = c("tbl_df", "tbl", "data.frame"))

library(shiny)
library(shinydashboard)

ui <- shinyUI(dashboardPage(
  
  #Nama Dashboard
  dashboardHeader(title = "OPERASIONAL"),
  
  dashboardSidebar(
    
    checkboxGroupInput("cekgr_gudang", label = h4("Gudang"),
                       choiceNames = list("Karanganyar","Binong",
                                          "Rancaudik","Tanjungrasa",
                                          "Ciwangi"),
                       choiceValues = list("Karanganyar","Binong",
                                           "Rancaudik","Tanjungrasa",
                                           "Ciwangi")
    ),
    
    checkboxGroupInput("cekgr_komoditas", label = h4("Komoditas"),
                       choices = c("Beras","Minyak Goreng", 
                                   "Terigu","Gula","Gabah", "Ketan")
    ),
    
    checkboxGroupInput("cekgr_tahun","Tahun",
                       choices = c("2018","2019","2020","2021")
    ),
    
    checkboxGroupInput("cekgr_opsional", label = h4("Opsional"),
                       choices = c("Fumigasi", "Kondisi kualitas")
                       
    ),
    
    # checkboxGroupInput("cekgr_fill", label = h4("Fill Grafik"),
    #                    choiceNames = c("JENIS","TAHUN"),
    #                    choiceValues = c("JENIS", "TH_ADA")
    # ),
    
    uiOutput("ivars"),
    
    actionButton("OK","Sikaaat")
    
  ),
  
  ## BODY
  
  dashboardBody(
    fluidRow(
      column(
        width = 12,
        
        box(title = "Grafik Yang Kamu Minta ",
            solidHeader = T,
            width = 8, height = 550,
            collapsible = T,
            plotOutput("grafik1"),
            textOutput("PilihanGudang"),
            textOutput("PilihanKomoditas"),
            textOutput("PilihanTahun"),
            textOutput("FillGrafik"), 
            uiOutput("t1") 
            )
        
      )
    ))))

# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {
  
  output$ivars<-renderUI({
    bb <- colnames(df1)
    pickerInput(inputId = 'cekgr_fill',
                label = 'Select interaction variables',
                choices = c(bb[1:length(bb)]),  
                multiple = TRUE,
                options = pickerOptions(maxOptions = 5,
                                        header = "Please select at least 2 variables",
                                        `style` = "btn-info")
    )
  })

  #### Pilihan-pilihan
  
  observeEvent(input$OK, {
    
    opsdata1 <- df1 # read_xlsx("~/Documents/App-Dashboard-Ops/data_Feb_11.xlsx")
    
    output$PilihanGudang <- renderText({
      gudangterpilih <- paste(input$cekgr_gudang,collapse = ", ")
      paste("Gudang : ", gudangterpilih)})
    
    
    output$PilihanKomoditas <- renderText({
      komoditasterpilih <- paste(input$cekgr_komoditas, collapse = ", ") 
      paste("Komoditas : ", komoditasterpilih)})
    
    output$PilihanTahun <- renderText({
      tahunterpilih <- paste(input$cekgr_tahun, collapse = ", ") 
      paste("Tahun : ", tahunterpilih)})
    
    output$FillGrafik <- renderText({
      fillterpilih <- paste(input$cekgr_fill, collapse = ", ") 
      paste("Fill : ", fillterpilih)})
    
    output$t1 <- renderUI({
      n <- length(input$cekgr_fill)
      if (n < 2) {
        tagList(
          p("A minimum of two variables are required to show interaction", style = "color:red")
        )
      }else return(NULL)
      
    })
    
    output$grafik1 <- renderPlot({
      opsdata2 <- opsdata1 %>%
        filter(GUDANG %in% input$cekgr_gudang) %>% 
        filter(JENIS %in% input$cekgr_komoditas) %>% 
        filter(TH_ADA %in% input$cekgr_tahun)
      n <- length(input$cekgr_fill)
      
      if (n>1) {
        if (n==2) { 
          opsdata2$ivar <- interaction(opsdata2[[input$cekgr_fill[[1]]]], opsdata2[[input$cekgr_fill[[2]]]], sep = "*")
        }else if (n==3){
          opsdata2$ivar <- interaction(opsdata2[[input$cekgr_fill[[1]]]], opsdata2[[input$cekgr_fill[[2]]]], 
                                       opsdata2[[input$cekgr_fill[[3]]]], sep = "*")
        }else if (n==4) {
          opsdata2$ivar <- interaction(opsdata2[[input$cekgr_fill[[1]]]], opsdata2[[input$cekgr_fill[[2]]]], 
                                       opsdata2[[input$cekgr_fill[[3]]]], opsdata2[[input$cekgr_fill[[4]]]], sep = "*")
        }else if (n==5){
          opsdata2$ivar <- interaction(opsdata2[[input$cekgr_fill[[1]]]], opsdata2[[input$cekgr_fill[[2]]]], 
                                       opsdata2[[input$cekgr_fill[[3]]]], opsdata2[[input$cekgr_fill[[4]]]],
                                       opsdata2[[input$cekgr_fill[[5]]]], sep = "*")
        }
        
      }else opsdata2$ivar <- interaction(opsdata2[[input$cekgr_fill]], sep = "*")
      
      ggplot(data= opsdata2, aes(x=reorder(GUDANG,KUANTUM/1000), y=KUANTUM/1000, 
                                 #fill=interaction(.data[[input$cekgr_fill[[1]]]], .data[[input$cekgr_fill[[2]]]], sep = "*")
                                 fill=as.factor(ivar)
      )) + 
        geom_col() + coord_flip() +
        scale_y_continuous(labels = unit_format(unit = "Ton")) +
        labs(x="",y="",fill="") + 
        theme_clean() + theme(legend.position = "top") 
      
    })
    
  })
  
  
})

shinyApp(ui = ui, server = server)

输出

暂无
暂无

声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

相关问题 R shiny 和 ggplot2：如何使 geom_col 的边框透明？ ggplot2：用不同列的值填充 geom_col 如何在 ggplot2 中为 geom_col 的边框着色以避免重叠？ ggplot2 (geom_col) 中的组变量 ggplot：如何为具有 0 值的组插入空白 geom_col ggplot geom_col 的轴值问题 如何使用 ggplot geom_col 避免值插值 plot 负值 如何在ggplot中分组和label geom_col？ geom_col，ggplot2上的n和百分比标签 ggplot2 geom_col填充看似随机的结果
相关标签
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM