Search code examples
riconsline-breaksgtmutate

R - Add line breaks (subrows) in a dataframe


I want to add line breaks within a row for certain conditions

Test <- structure(list(A1 = c("SP2", "SP1"), A2 = c(NA_character_, NA_character_
), B1 = c("AP2", "HN2"), B2 = c("HN2", "IP2"), B3 = c("HP2", 
"KN2"), B4 = c("IN2", "KP2"), B5 = c("JN2", "NP2"), B6 = c("KN2", 
"RN2"), B7 = c("KP2", "SN2"), B8 = c("NP2", "TP2"), B9 = c("RN2", 
"AP1"), B10 = c("SN2", "FP1")), row.names = c(NA, -2L), class = "data.frame")

Test
   A1   A2  B1  B2  B3  B4  B5  B6  B7  B8  B9 B10
1 SP2 <NA> AP2 HN2 HP2 IN2 JN2 KN2 KP2 NP2 RN2 SN2
2 SP1 <NA> HN2 IP2 KN2 KP2 NP2 RN2 SN2 TP2 AP1 FP1

Every entry is a code to an icon, which I implemented with gt table.

Test %>% 
  gt() %>%
  #tab_options(column_labels.hidden = TRUE) %>%
  text_transform(
    locations = cells_body(columns = 1:length(Test)),
    fn = function(x) {
      # loop over the elements of the column
      map_chr(x, ~ local_image(
        filename = paste0(.x, ".png"),
        height = 15))})

That ends in this:

enter image description here

My question is now: How can I add a line break when there are more than 3 columns starting with the same letter? My result should be the same for A1 und A2, but B1:B10 should consist of 4 "subrows", so the first 3 columns B1:B3 stay but then B4:B6 should be under B1:B3 and the same with B7:B9, and B10 stands alone in subrow 4.

So my desired output would be:

enter image description here

I know that a combination of Test %>% mutate, "<br>" and fmt_markdown might be right, but I cant find a working solution. The spacing is important, I want that each Group in each row is close together and clearly separated from the other groups.

Can someone help please? The link to download the icons I used is here: ICONS

They are from this website: iconscout.com


Solution

  • I don't have access to the images, but the following should work:

    Test <- Test %>% 
      as_tibble() %>% 
      mutate(row = as.character(row_number())) %>%
      pivot_longer(cols = -row, names_to = "col", values_to = "val") %>% # split col into two columns, letter and index
      filter(!is.na(val)) %>% # remove NA values
      mutate(letter = str_extract(col, "[A-Z]"), # extract letter
             index = str_extract(col, "[0-9]")) %>% # extract index
      select(-col) %>% 
      group_by(row, letter) %>% 
      arrange(index) %>% 
      mutate(val = paste(val, collapse = " ")) %>% 
      ungroup() %>% 
      select(-index) %>% 
      distinct()  %>%
      pivot_wider(names_from = letter, values_from = val) %>%
      mutate(across(everything(), ~str_replace_all(., "(\\S+\\s+\\S+\\s+\\S+)\\s+", "\\1<br>"))) %>%
    select(-row) 
    # then replace the codes with the images here
    
    Test %>%
      gt() %>%
      fmt_markdown(columns = everything())
    

    table with two columns, A and B, with various codes