rfunctiondplyrr-markdownr-flextable

If there are consecutive columns that are equal, how to keep just one and assign a new column name


I have a data set of customers, what stores they shopped at, what they purchased at each store, and on what day.

Shop_list <- data.frame (Names  = c('Adam','Eve','Lucy','Ricky','Gomez','Morticia','Adam','Eve','Lucy','Ricky',
                        'Adam','Eve','Ricky','Gomez','Adam','Eve','Lucy','Adam','Eve','Lucy','Adam','Eve','Lucy'),
                  Day = c(1,1,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,5,5,5,6,6,6),
                  Store= c('None','None','None','None','None','None','Lowes',
                          'Home Depot','Lowes','Home Depot','Lowes',
                          'Home Depot','Home Depot','Lowes','None',
                          'Home Depot','None','None','None','Home Depot',
                          'Home Depot','None','None'),
                  Item= c('None','None','None','None','None','None','Wood','Soil','Nails','Pots','Nails',
                        'Pots','Soil','Wood','None','Seeds','None','None','None','Seeds','Seeds','None','None'),
              stringsAsFactors=FALSE
)

I have written a function that summarizes this data ,

library(dplyr)
library(flextable)

Shop_fcn <- function(data){
  data %>%
    group_by(Day) %>%
    mutate(N_nam = n_distinct(Names)) %>%
    group_by(Names, Day, N_nam, Store, Item) %>%
    summarize(n_item = n()) %>%
    group_by(Day, N_nam, Store, Item) %>%
    summarize(n_nam = n(),
              n_item = sum(n_item))%>%
    mutate(pct = round(n_nam/N_nam*100,digits = 1),
           txt = paste0( n_nam, " (", pct, "%)"),
           Day_n = (paste0("Day ", Day," (N=",  N_nam, ")")))%>%
    ungroup %>% select(Day_n , Store, Item, txt) %>%
    pivot_wider(values_from = txt, names_from = Day_n) %>%
    mutate_at(vars(starts_with(c("Day"))), ~if_else(is.na(.), "", .)) %>%
    arrange(Store, Item) %>% 
    group_by(store2 = Store) %>% 
    mutate(Store = if_else(row_number() != 1, "", Store))%>%
    ungroup() %>% select(-store2)
}

Shop_day <- Shop_list %>%
  bind_rows(Shop_list) %>%
  Shop_fcn ()

flextable(Shop_day)

and I get the following output.

enter image description here

The columns for Day 2 and 3 are equal, as are the columns for Days 4, 5 , and 6.I am trying to make it so that the column titles for the columns with the same info read as Day 2 - 3 (N=4) and Day 4 - 6 (N=3).

So far, I've tried to remove the columns that are duplicated

Shop_nodup <- Shop_day[!duplicated(as.list(Shop_day))]
flextable(Shop_nodup)

Which gives me

enter image description here

The duplicate columns are gone, but I can't figure out a way to specify in the column titles to specify the range of Days that the column covers (Day 2 - 3 (N=4) and Day 4 - 6 (N=3) )


Solution

  • If we need to change the title, make the changes as below

    library(stringr)
    Shop_fcn <- function(data){
      data %>%
        group_by(Day) %>%
        mutate(N_nam = n_distinct(Names)) %>%
        group_by(Names, Day, N_nam, Store, Item) %>%
        summarize(n_item = n()) %>%
        group_by(Day, N_nam, Store, Item) %>%
        summarize(n_nam = n(),
                  n_item = sum(n_item))%>%
        mutate(pct = round(n_nam/N_nam*100,digits = 1),
               txt = paste0( n_nam, " (", pct, "%)"),
               Day_n = (paste0("Day ", Day," (N=",  N_nam, ")")))%>%
        ungroup %>% 
        select(Day_n , Store, Item, txt) %>%
        group_by(Store, Item, txt) %>%
        summarise(Day_n = if(n() > 1) 
         sprintf('Day %s %s', paste(range(readr::parse_number(unique(Day_n))), 
         collapse=' - '), 
           str_remove(first(Day_n), '^[^(]+')) else Day_n) %>%
        pivot_wider(values_from = txt, names_from = Day_n) %>%
        mutate_at(vars(starts_with(c("Day"))), ~if_else(is.na(.), "", .)) %>%
        arrange(Store, Item) %>% 
        group_by(store2 = Store) %>% 
        mutate(Store = if_else(row_number() != 1, "", Store))%>%
        ungroup() %>%
        select(Store, Item, str_sort(names(.)[-(1:2)], numeric = TRUE), -store2)
    
    }
    

    -testing

    Shop_day <- Shop_list %>%
      bind_rows(Shop_list) %>%
      Shop_fcn ()
    
    flextable(Shop_day)
    

    -output

    enter image description here