Imap with multiple ifelse for 3 tiems 4 subplots and facets rows and columns in R

Question

Based on this post for gglikert. There the group1 column had 2 levels and group2 has 3. Now if i implement it with 3 levels in group1 and 4 levels in group2

library(ggstats)
library(dplyr)
library(ggplot2)
library(tidyverse)
library(patchwork)

# Define Likert scale levels
likert_levels <- c(
  "Strongly disagree",
  "Disagree",
  "Neither agree nor disagree",
  "Agree",
  "Strongly agree"
)

# Generate sample data
set.seed(42)
df <- tibble(
  q4 = sample(likert_levels, 150, replace = TRUE, prob = 1:5),
  q5 = sample(c(likert_levels, NA), 150, replace = TRUE),
  q6 = sample(likert_levels, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0))
) |>
  mutate(across(everything(), ~ factor(.x, levels = likert_levels)))

# Add grouping variables
df_group <- df
df_group$group1 <- sample(c("Friday", "Saturday", "Sunday"), 150, replace = TRUE)
df_group$group2 <- sample(c("Abu Dhabi - UAE", "Buenos Aires - Argentina", " San Sebastian - Spain","New York City - USA"), 150, replace = TRUE)

# Generate Likert plots with conditional faceting for group1 and group2
plots <- df_group |>
  split(~ group1 + group2) |>
  imap(\(x, y) {
    # Create the plot with the corresponding facet layer
    gglikert(x,
             q4:q6,
             labels_size = 3,
             sort = "descending"
    ) +
      facet_grid(group2 ~ group1, scales = "free_y")
  })

# Combine plots with patchwork
combined_plot <- wrap_plots(
  plots,
  ncol = length(unique(df_group$group1)),
  nrow = length(unique(df_group$group2)),
  guides = "collect"
) &
  theme(
    legend.position = "bottom",
    # Remove y-axis text for columns 2 and 3
    strip.text.y.right = element_blank(), # Remove facet strip text on the right
    axis.text.y.right = element_blank(),  # Remove y-axis text on the right
    axis.ticks.y.right = element_blank() # Remove y-axis ticks on the right
  )

# Display the combined plot
combined_plot

i receive this.

So the facet cols "Friday", "Saturday", "Sunday" appear in every row and in every column . and the rows "Abu Dhabi - UAE", "Buenos Aires - Argentina", " San Sebastian - Spain","New York City - USA" do not show at all.They must be shown in last column.Also the y axis text must be present only in the first column.

How can i modify the imap() with the ifelse in order to be properly shown as here?

Any help ?

Answer 1

Based on my updated answer to your previous question you can achieve your desired result like so where I now generalized the approach even further my getting rid of the magic numbers. Hence, in principle the code should now work for any number of groups:

library(tidyverse)
library(ggstats)
library(patchwork)

ncol <- n_distinct(df_group$group1)

df_split <- df_group |>
  split(~ group1 + group2)

df_split |>
  map2(seq_along(df_split), \(x, y) {
    facet_layer <- if (y == ncol) {# Top right
      facet_grid(
        group2 ~ group1,
        scales = "free_y"
      )
    } else if (y < ncol) { # Top row
      facet_wrap(
        ~group1,
        scales = "free_y",
        nrow = 1
      )
    } else if (y %% ncol == 0) { # Last column
      facet_wrap(
        ~group2,
        strip.position = "right",
        scales = "free_y",
        nrow = 1
      )
    }

    gglikert(x,
      q4:q6,
      labels_size = 3,
      sort = "descending"
    ) +
      facet_layer
  }) |>
  wrap_plots(
    ncol = ncol, guides = "collect"
  ) &
  theme(legend.position = "bottom")