R：将具有相同数据的列组合在一起的功能

Question

Link to original post

在我之前的帖子中（参见上面的链接），我想知道如何组合具有相同数据的列并更改列名以反映范围。我从一个产生的函数开始

并且接受的答案产生了我想要的输出

我应用了同样的功能

library(dplyr)
library(flextable)
library(stringr)
library(tidyverse)

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)
  
}

到更大的数据集

Names <- as.character(c('Adam','Morticia','Morticia','Morticia','Morticia','Morticia','Morticia','Morticia',
'Morticia','Morticia','Morticia','Morticia','Mickey','Minnie','Minnie','Minnie','Minnie','Minnie',
'Lucy', 'Lucy','Lucy','Morticia','Morticia','Morticia','Adam','Gomez','Olive','Olive','Olive',  
'Ricky','Morticia','Adam','Eve','Ricky','Morticia','Morticia','Minnie','Adam','Lucy','Ricky',
'Ricky','Ricky','Ricky','Ricky','Minnie','Adam','Adam', 'Morticia', 'Adam', 'Adam', 'Adam', 'Adam', 
'Adam','Lucy','Olive','Eve','Gomez','Morticia','Mickey','Olive'))

Day <- as.numeric(c(1,1,2,3,6,8,9,10,11,12,13,14,1,1,2,5,6,14,1,1,14,4,4,4,2,1,1,1,14,1,5,2,    
       1,1,4,5,3,2,1,1,14,14,14,14,4,2,2,4,2,2,2,2,14,1,1,14,14,7,14,1))

Store <- as.character(c('None','None','None','None','None','None','None','None','None','None',
'None','None','None','None','None','None','None','None','ACE','ACE','ACE','ACE','Amazon','Amazon',
'Best Buy','CVS','Hobby Lobby','Hobby Lobby','Hobby Lobby','Home Depot','Home Depot',   
'Ikea','Ikea','Ikea','Ikea','Ikea','Ikea','Lowes','Lowes','Petco','Petco','Petco','Petco',
'Petco','Petco','Target','Target','Target','Walgreens','Walgreens','Walgreens','Walgreens',
'Walgreens','Walgreens','Walgreens','Walmart','Walgreens','Walgreens','Walgreens','Walgreens'))

Item <- as.character(c('None','None','None','None','None','None','None','None','None','None','None','None',
'None','None', 'None','None','None','None', 'Hammer','Nails','Plywood', 'Bricks','Frame','Batteries','TV','Advil',
'Brush','Paint','Paint','Level','Wrench','Pillow',  'Blanket','Lamp','Vase','Table','Chair','Screwdriver','Plunger','Cat food',  
'Cat litter','Goldfish','Dog food','Dog treat','Hamster','Rug','Vacuum',
 'Gloves','Tylenol','Napkins','Benadryl','Soap','Soap','Shampoo','Conditioner','Lotion',    
'Lotion','Foil','Lotion','Foil'))


Shop_list <- as.data.frame(cbind(Names, Day, Store, Item), stringsAsFactors=FALSE)

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

flextable(Shop_day)

并得到以下

第 1-14 天和第 3-5 天不应合并

应用我的原始函数让我更接近我想要的输出，

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_fcn ()

flextable(Shop_day)

但是，我现在遇到了相同的问题，即合并相同的日期（特别是第 8-13 天）和新一期的 Days not being ordered 1-14。

我不确定最好的解决方案是修改函数，还是将新函数应用于 flextable 以组合列和相应的列名。

我试图删除重复的列，但仍然无法提出解决方案来解决如何将重复列的名称保留为一个范围或如何以正确的顺序获取列。

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

Answer 1

• 列名不按顺序排列的原因是Day 列是字符类型而不是数字类型。将其转换为数字类将使它们按所需的顺序排列。数字会变成字符，因为在您的数据生成代码中，您使用的是as.data.frame(cbind(....))，其中cbind 将数据转换为矩阵，并且由于矩阵只能包含类型的数据，因此会将数字转换为字符。相反，您应该使用 data.frame(....) 来保持类的类型不变。

• 为了将日期列与相似的值组合在一起，我在根据每天的值创建唯一键后使用rleid。

你可以使用的功能是-

library(tidyverse)
library(data.table)
library(flextable)

Shop_fcn <- function(data){
  Shop_list %>%
    group_by(Day = as.numeric(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)) %>%
    ungroup -> tmp
  
  tmp %>%
    group_by(Day) %>%
    summarise(txt = paste(n_nam, n_item, Store, Item, sep = '-', collapse = ',')) %>%
    mutate(grp = rleid(txt)) %>%
    select(-txt) %>%
    left_join(tmp, by = 'Day') %>%
    group_by(grp) %>%
    mutate(pct = round(n_nam/N_nam*100,digits = 1),
           txt = paste0( n_nam, " (", pct, "%)"),
           Day_n = if(n_distinct(Day) > 1) sprintf('Day %s - %s (N = %s)', first(Day), last(Day), N_nam) else sprintf('Day %s (N=%s)', Day, N_nam)) %>% 
    ungroup %>% 
    select(Day_n, Store, Item, txt) %>%
    pivot_wider(values_from = txt, names_from = Day_n, values_fn = first, values_fill = '') %>%
    arrange(Store, Item) %>% 
    group_by(Store) %>% 
    mutate(Store = if_else(row_number() != 1, "", Store)) %>%
    ungroup()
}

对于您之前帖子中的数据，这将返回 -

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

对于这篇文章中的数据，它返回 -