>问题
在某些健康数据集中，一列可以对个别病例感兴趣的各种疾病表现进行分类。在一些总结中，将这些表现的各种组合制成表格是有益的，包括计算给定病例是否"大于"或"小于"一系列关键表现。
在 SAS 中，可以为列分配multilabel格式，这样可以允许在procedure steps期间同时汇总各种重叠的类别。我一直在努力在 R 中找到一个令人满意的解决方案来复制 SAS 的此功能。我知道链接在一起的dplyr或base函数的组合可以制表和附加不同的组合，从而有效地创建一个数据集，该数据集复制表示所有重叠级别所需的行。
目的
创建一个函数，以便轻松创建考虑目标类别的各种重叠级别的数据集。这将允许将下面提供的示例数据转换为附加正确行的新数据集，并且可以在组内提供检查，以查看某个分组是否与被视为新分组一部分的所有所需级别匹配。
library(tibble)
# Example data (Repeat groups)
exampleData <- tibble(group = c(1, 1, 1, 2, 3, 3),
condition = factor(c('A', 'B', 'C', 'A', 'B', 'Q'), ordered = F))
# Initial output
# A tibble: 6 x 2
group condition
<dbl> <fct>
1 1 A
2 1 B
3 1 C
4 2 A
5 3 B
6 3 Q
# Function to add new level combinations, based upon the levels within each group.
create_multilevelFactor(exampleData , target_col = 'condition', group_col = 'group', new_levels = list('AB' = c('A', 'B'), 'QB' = c('Q', 'B')))
# Desired output
# A tibble: 8 x 3
group condition track_col
<dbl> <chr> <dbl>
1 1 A 1
2 1 B 1
3 1 C 1
4 2 A 1
5 3 B 1
6 3 Q 1
7 1 AB 2
8 3 QB 3
您会注意到原始因子水平仍然存在，如果存在组合，则在命名列表中包含正确水平的组将形成一个新行。在更现实的例子中，AB的分组可以被认为是具有"至少A或B疾病表现">的第1组。
挑战
我怀疑其他人可能对此功能有类似的需求，并且像我一样，要么对更简单的方法一无所知，要么没有遇到易于使用的现有解决方案。在我对这个问题的思考过程中，我创建了一个函数(尝试主要使用baseR(，尽管不优雅，但它创建了上述所需的输出。
我希望其他人可以使用替代方法提供更理想的解决方案，或者提高该功能的鲁棒性和更广泛的适用性。
以下函数为该问题提供了一个有效的解决方案，尽管不优雅。我倾向于过度思考过程，这可能反映在这里的答案中。
此函数将接收初始数据集，并根据是否提供了分组函数，它将创建一个新数据集，其中包含用于聚合因子水平的各种组合的附加行(如果这些水平存在于分组中(。 可以以列表形式提供各种新级别，并且附加列可以轻松查看除了原始行之外还添加了哪些新级别。
#-----------------------------------------------------------#
# Create function for multilevel labelling of factor groups #
#-----------------------------------------------------------#
# target_col is a character string for the column of interest to be adjusted
# group_col is a character string for the column to check levels that exist within groupings
# new_levels is a list that uses name and value pairs to determine how new levels should be aggregated
# collapse will ensure that only unique combinations of the new level is appended
# track will add a flag to ensure one can easily see the new combinations that were appended
create_multilevelFactor <- function(data, target_col, new_levels , group_col, collapse = T, track = T) {
#
# Do some basic checks on inputs
#
# Check if new_levels is provided as a list
if(!is.list(new_levels)) stop('The provided set of levels is not in a list format, please provide as a list')
# Check if target_col is a factor
if(!is.factor(data[[target_col]])) stop('The target column for multiple levels is not a factor, convert to a factor before proceeding.')
# Check if levels are in list
for(i in 1:length(new_levels)) {
if(length(setdiff(levels(factor(new_levels[[i]])),
levels(factor(data[[target_col]])))) > 0) { # If levels in provided list contain a level not in the column, then throw error
stop('Levels in list do not match the levels in the target column')
}
}
# State if grouping col was provided and its purpose
if(!missing(group_col)) { message(paste0('The following column is used as a grouping variable for summarizing multilevel factoring: ',
group_col, '. If you do not want labels determined by those within groupings, leave argument blank.'))
}
#
# Main
#
# Set new column for tracking if desired
if(track == T) {track_col <- rep(NA,nrow(data)); data$track_col <- 1; trackColIndex <- 1;}
OutData <- as.data.frame(NULL) # Empy data frame to fill and append later
# Loop for all new levels of interest to add
for(i in 1:length(new_levels)){
tempData <- data # Look at fresh data every pass
levelIndex <- which(levels(tempData[[target_col]]) %in% new_levels [[i]]) # Index of matches
# If grouping provided, do necessary splits and rbinds
if(!missing(group_col)) {
tempData <- split(tempData, tempData[[group_col]]) # Split if there are groupings
tempData <- lapply(tempData, function(x) {
if(!(length(setdiff(levels(factor(new_levels [[i]])), levels(factor(x[[target_col]])))) > 0)) { # If the grouping does not have all the levels for the new grouping, then do nothing
levels(x[[target_col]])[levelIndex] <- names(new_levels )[i]
x
}
})
tempData <- do.call(rbind, tempData) # If didnt match necessary group conditions, will bring back empty
rownames(tempData) <- NULL # Correct row names for tibble
} else { # If not grouping
levels(tempData[[target_col]])[levelIndex] <- names(new_levels )[i]
}
tempData <- tempData[tempData[[target_col]] %in% names(new_levels )[i],] # Only keep new factor levels (could be empty if no group matches)
if(collapse == T) tempData <- unique(tempData[(tempData[[target_col]] %in% names(new_levels )[i]),]) # Collapse to unique combinations if desired
if(track == T){track_col <- rep(NA, nrow(tempData)); tempData$track_col <- trackColIndex+1; trackColIndex <- trackColIndex+1;} # Add track column to the new rows
OutData <- suppressWarnings(dplyr::bind_rows(OutData, tempData)) # Append all the new rows
}
# Append new rows to the original rows
OutData <- suppressWarnings(dplyr::bind_rows(data, OutData)) #
return(OutData)
}
使用最初提供的示例数据，这可以生成以下输出：
#Original data
library(tibble)
# Example data (Repeat groups)
exampleData <- tibble(group = c(1, 1, 1, 2, 3, 3),
condition = factor(c('A', 'B', 'C', 'A', 'B', 'Q'), ordered = F))
# Original data
# A tibble: 6 x 2
group condition
<dbl> <fct>
1 1 A
2 1 B
3 1 C
4 2 A
5 3 B
6 3 Q
##################
newData <- create_multilevelFactor(exampleData,
target_col = 'condition',
group_col = 'group',
new_levels = list('AB' = c('A', 'B'), 'QB' = c('Q', 'B')),
collapse = T, track = T)
newData
# Data with grouping argument
# A tibble: 8 x 3
group condition track_col
<dbl> <chr> <dbl>
1 1 A 1
2 1 B 1
3 1 C 1
4 2 A 1
5 3 B 1
6 3 Q 1
7 1 AB 2
8 3 QB 3
addmargins(table(newData$group,newData$condition))
A AB B C Q QB Sum
1 1 1 1 1 0 0 4
2 1 0 0 0 0 0 1
3 0 0 1 0 1 1 3
Sum 2 1 2 1 1 1 8
newData <- create_multilevelFactor(exampleData,
target_col = 'condition',
new_levels = list('AB' = c('A', 'B'), 'QB' = c('Q', 'B')),
collapse = T, track = T)
newData
# Without grouping argument
# A tibble: 11 x 3
group condition track_col
<dbl> <chr> <dbl>
1 1 A 1
2 1 B 1
3 1 C 1
4 2 A 1
5 3 B 1
6 3 Q 1
7 1 AB 2
8 2 AB 2
9 3 AB 2
10 1 QB 3
11 3 QB 3
newData <- create_multilevelFactor(exampleData,
target_col = 'condition',
new_levels = list('AB' = c('A', 'B'), 'QB' = c('Q', 'B')),
collapse = F, track = T)
newData
# Without collapse and grouping argument
# A tibble: 13 x 3
group condition track_col
<dbl> <chr> <dbl>
1 1 A 1
2 1 B 1
3 1 C 1
4 2 A 1
5 3 B 1
6 3 Q 1
7 1 AB 2
8 1 AB 2
9 2 AB 2
10 3 AB 2
11 1 QB 3
12 3 QB 3
13 3 QB 3