rggplot2shinyinteractiongeom-col
How to pass chosen input values of checkboxGroup to be used as an argument in ggplot2 interaction of geom_col() when using shiny?
I am using Shiny to build a simple dashboard to use in my job. Everything was fine until I found that I couldn't pass chosen input to be used as an argument in ggplot geom_col() interaction arguments.
My purpose is to change interaction plot based on chosen values of checkboxGroup where the chosen values will be used as arguments for fill=interaction(....) in ggplot.
I faced problem at this stage :
ggplot(data= opsdata2, aes(x=reorder(GUDANG,KUANTUM/1000), y=KUANTUM/1000,
fill=interaction(get(input$cekgr_fill),sep = "*")
))
The 'get(input$cekgr_fill)' only pass the first argument only whereas my purposes is to build interaction barplot using at least 2 arguments in input$cekgr_fill, ex: 'fill=interaction(JENIS,TH_ADA, sep="*")'.
The 'get(input$cekgr_fill)' only pass the first argument, i.e : JENIS, and ignore TH_ADA.
Would you please help me? Thank you.
Here is my code :
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"))
Solution
You need to select the appropriate variables for interaction. I have used pickerInput to select a maximum of 5 variables for interaction. If less than 2 variables are selected, a message is printed. Perhaps there is a more elegant way of doing this. For now, I have provided a quick answer. Please try this
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)
- Reformat data to include 2 minute time intervals
- Modify pop-up message in leaflet map
- Is there a fast/clever way to return a logical vector if elements of a vector are in at least one interval?
- Conditional bslib tooltip
- Set CMU Sans Serif font on pdf quarto
- How to remove string before a certain delimiter in R?
- Leaflet map displays wrong location based on lat,long data
- Concatenate while dropping specific value strings
- R and ggplot with st_crop: map cropping does not work as wanted
- Generating a time series in 10 Hz
- Replace with 0 the first calculation in mutate and rollapply in R
- Change radius by site type geom_scatterpie
- How to stop R from executing when value is non-numeric
- How to solve pagedown_chrome_print failed to generate output due to fail to open favicon.ico
- Attempting to calculate ratios in multiple columns in dataframe via a for loop
- How to count the number of occurences in a column using dplyr
- Convert roman numerals to numbers in R
- Arranging character values of multiple columns that contain the same name with R
- Struggling to understand complete predictive model process in R
- Random change in obj_addr() output when including the objects into a list and vectorizing over them
- Pass vector of unquoted column names to a function and use first element
- retrieve list of urls from Amazon S3 bucket using R
- officer - save document - dont overwrite
- Apply function to list depending on values in another list
- How to return multiple columns from one function inside `mutate` and allow me to name the output columns?
- plotting 3-way interaction with ggeffects, theme changes not being applied to all facets
- Speed up R function that combines linestrings into a single linestring
- Find values in data frame that don't contain specific string and replace them in R
- Error downloading a csv in zip from website with get in R
- How to calculate row sums in R with dynamic columns