R语言计算种族入学占比写入Excel后百分比列空白问题求助

用户希望计算各种族群体的入学占比，原始数据如下：

building <- c(1, 2)
total_enrollment <- c(100, 200)
black_count <- c(32, 69)
hispanic_count <- c(10, 19)
white_count <- c(44, 86)
asian_count <- c(5, 12)
nativeamerican_count <- c(4, 7)
multiracial_count <- c(5, 7)

school_racial_breakdown <- data.frame(building, total_enrollment, black_count, hispanic_count, white_count,
                                      asian_count, nativeamerican_count, multiracial_count)

编写的计算代码如下：

library(writexl)

cols <- c('black_count', 'hispanic_count', 'white_count', 'asian_count', 'nativeamerican_count', 'multiracial_count')

school_racial_breakdown[,paste0(cols, 'Percent')] <- lapply(cols, function(x) school_racial_breakdown[,x]/school_racial_breakdown[,2]) 

write_xlsx(school_racial_breakdown, 'Demographic File.xlsx')

但写入Excel后，百分比列显示空白，需排查原因并修复。

问题原因 #

lapply()返回的结果是列表（list）类型，直接将列表赋值给数据框的新列时，这些列会被存储为list列。而writexl包无法正确导出list类型的列，导致Excel中对应位置显示空白。

修复方案 #

需要将计算结果转换为向量（vector）类型再赋值给数据框，有两种常见实现方式：

方法1：使用sapply()替代lapply() #

sapply()会自动将列表结果简化为矩阵，赋值到数据框时会自动拆分为多个向量列：

library(writexl)

cols <- c('black_count', 'hispanic_count', 'white_count', 'asian_count', 'nativeamerican_count', 'multiracial_count')

# 用sapply替代lapply，自动简化结果为矩阵
school_racial_breakdown[,paste0(cols, 'Percent')] <- sapply(cols, function(x) school_racial_breakdown[,x]/school_racial_breakdown[,2]) 

write_xlsx(school_racial_breakdown, 'Demographic File.xlsx')

方法2：在lapply()中显式转换为向量 #

如果坚持用lapply()，可以在函数内部将结果转为向量，再用do.call(cbind, ...)合并为矩阵后赋值：

library(writexl)

cols <- c('black_count', 'hispanic_count', 'white_count', 'asian_count', 'nativeamerican_count', 'multiracial_count')

# 显式转换为向量并合并为矩阵
percent_cols <- lapply(cols, function(x) as.vector(school_racial_breakdown[,x]/school_racial_breakdown[,2]))
school_racial_breakdown[,paste0(cols, 'Percent')] <- do.call(cbind, percent_cols)

write_xlsx(school_racial_breakdown, 'Demographic File.xlsx')

可选：用dplyr实现更简洁的计算 #

如果习惯使用tidyverse语法，mutate()配合across()可以更直观地完成计算，且结果自动适配数据框格式：

library(writexl)
library(dplyr)

cols <- c('black_count', 'hispanic_count', 'white_count', 'asian_count', 'nativeamerican_count', 'multiracial_count')

school_racial_breakdown <- school_racial_breakdown %>%
  mutate(across(all_of(cols), ~ .x / total_enrollment, .names = "{col}Percent"))

write_xlsx(school_racial_breakdown, 'Demographic File.xlsx')

内容的提问来源于stack exchange，提问作者ra_learns