#r #ggplot2 #shiny #interaction #geom-col
#r #ggplot2 #блестящий #взаимодействие #geom-col
Вопрос:
Я использую Shiny для создания простой панели мониторинга для использования в моей работе. Все было хорошо, пока я не обнаружил, что не могу передать выбранные входные данные для использования в качестве аргумента в geom_col() аргументах взаимодействия ggplot.
Моя цель — изменить график взаимодействия на основе выбранных значений checkboxGroup , где выбранные значения будут использоваться в качестве аргументов для fill=interaction(….) в ggplot.
На этом этапе я столкнулся с проблемой :
ggplot(data= opsdata2, aes(x=reorder(GUDANG,KUANTUM/1000), y=KUANTUM/1000,
fill=interaction(get(input$cekgr_fill),sep = "*")
))
‘get (input $cekgr_fill)’ передает только первый аргумент, тогда как мои цели — построить график взаимодействия, используя как минимум 2 аргумента во входных данных $ cekgr_fill, например:
‘fill=взаимодействие (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:
Вам необходимо выбрать соответствующие переменные для взаимодействия. Я использовал pickerInput для выбора максимум 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)
Комментарии:
1. Если вы хотите протестировать мой код, запустите код и проверьте все параметры в GUDANG. Проверьте Beras и Ketan в KOMODITAS. Проверьте 2019 и 2020 годы в TAHUN. Проверьте JENIS и TAHUN в FILL GRAFIK.
2. Вау, это работает. Спасибо. У меня есть новые вопросы: 1. Что, если у меня будет больше вариантов при ЗАПОЛНЕНИИ графических полей, а не два. Должен ли я добавить больше кода или аргумента в ‘interaction ()’? 2. Что делать, если у меня есть 5 вариантов / вариантов в FILL GRAFIK, но я хочу создать график панели взаимодействия с 3 переменными, поэтому есть два варианта, которые не отмечены, должен ли я снова изменить код? Как заставить код автоматически обнаруживать и запускать без изменения аргумента / кода во взаимодействии () ? Я имею в виду, что код обладает гибкостью и дает пользователю свободу определять, сколько взаимодействий он / она будет создавать без изменения кода.
3. Спасибо YBS. Я буду иметь это в виду.
4. Спасибо YBS. Это работает хорошо. Я думаю, этого достаточно, чтобы удовлетворить мои потребности. 😊
5. @deny1110, считается вежливым принять ответ, который ответил на ваш OP. Это помогает другим, кто ищет решение для того же / похожего запроса. Кроме того, люди могут захотеть помочь вам в ваших будущих запросах.