r объединить уровни факторов из нескольких данных.frame

Question

Как объединить уровни факторов из двух пустых data.frames?

У меня есть большой набор данных, разделенных на отдельные файлы. Мне нужен data.frame, который будет иметь все возможные уровни для столбцов факторов, но я не могу загружать все части сразу, только по частям.

Есть ли способ сделать что-то вроде:

data_structure = NULL 
for (chunk_i in chunks){ 
    # load chunk_i data 

    if(is.null(data_structure)){ 
     data_structure = data_i 
    } else { 
     # at this line factor levels will NOT be combined as I expect 
     # but instead factor levels from 'data' will be stored to 'data_structure' 
     data_structure = rbind(data_structure, data) 
    } 
    rm(data) 

    # empty data frame, since I can't keep all data in memory 
    # I want to keep only metadata, like factor levels 
    data_structure = data_structure[0, ] 
} 

И это data_structure необходимо, чтобы позже convert factors to binary columns так:

result_i = model.matrix(~ . + 0, data=data_i, contrasts.arg = 
       lapply(data_structure, contrasts, contrasts=FALSE)) 

Если уровни фактора А собранные со всех частей данных, то я может быть уверен, что result_i будет иметь точно такие же двоичные столбцы, что и все остальные части данных, даже если в этом конкретном случае data_i имеет меньше уровней факторов в некоторых столбцах.

UPDATE

Сейчас я использую это решение:

all_levels = list() 
for_each_chunk(function(data) { 
    data_levels = Filter(Negate(is.null), sapply(data, levels)) 
    factor_names = unique(c(names(all_levels), names(data_levels))) 
    lapply(factor_names, FUN=function(name){ 
     all_levels[[name]] <<- unique(c(all_levels[[name]], data_levels[[name]])) 
    }) 
}) 

Не так элегантно, как для меня, но не нашли ничего лучшего пока.

Answer 1

Это может быть очень глупое решение, которое я предлагаю. Почему бы вам не сделать стратифицированный образец каждого из каждого куска, а затем прочитать эти куски в единый блок данных. Таким образом, я думаю, что все уровни будут сохранены в метаданных. Вы можете сделать стратифицированную выборку с использованием sampling пакета в R, или вы можете использовать эту функцию, которую я взял из GIT ступицы некоторого времени назад:

stratified <- function(df, group, size, select = NULL, 
         replace = FALSE, bothSets = FALSE) { 
    if (is.null(select)) { 
    df <- df 
    } else { 
    if (is.null(names(select))) stop("'select' must be a named list") 
    if (!all(names(select) %in% names(df))) 
     stop("Please verify your 'select' argument") 
    temp <- sapply(names(select), 
        function(x) df[[x]] %in% select[[x]]) 
    df <- df[rowSums(temp) == length(select), ] 
    } 
    df.interaction <- interaction(df[group], drop = TRUE) 
    df.table <- table(df.interaction) 
    df.split <- split(df, df.interaction) 
    if (length(size) > 1) { 
    if (length(size) != length(df.split)) 
     stop("Number of groups is ", length(df.split), 
      " but number of sizes supplied is ", length(size)) 
    if (is.null(names(size))) { 
     n <- setNames(size, names(df.split)) 
     message(sQuote("size"), " vector entered as:\n\nsize = structure(c(", 
       paste(n, collapse = ", "), "),\n.Names = c(", 
       paste(shQuote(names(n)), collapse = ", "), ")) \n\n") 
    } else { 
     ifelse(all(names(size) %in% names(df.split)), 
      n <- size[names(df.split)], 
      stop("Named vector supplied with names ", 
        paste(names(size), collapse = ", "), 
        "\n but the names for the group levels are ", 
        paste(names(df.split), collapse = ", "))) 
    } 
    } else if (size < 1) { 
    n <- round(df.table * size, digits = 0) 
    } else if (size >= 1) { 
    if (all(df.table >= size) || isTRUE(replace)) { 
     n <- setNames(rep(size, length.out = length(df.split)), 
        names(df.split)) 
    } else { 
     message(
     "Some groups\n---", 
     paste(names(df.table[df.table < size]), collapse = ", "), 
     "---\ncontain fewer observations", 
     " than desired number of samples.\n", 
     "All observations have been returned from those groups.") 
     n <- c(sapply(df.table[df.table >= size], function(x) x = size), 
      df.table[df.table < size]) 
    } 
    } 
    temp <- lapply(
    names(df.split), 
    function(x) df.split[[x]][sample(df.table[x], 
            n[x], replace = replace), ]) 
    set1 <- do.call("rbind", temp) 

    if (isTRUE(bothSets)) { 
    set2 <- df[!rownames(df) %in% rownames(set1), ] 
    list(SET1 = set1, SET2 = set2) 
    } else { 
    set1 
    } 
}