2017-02-16 23 views
0

Я хочу создать поддерживаемую версию dplyr::bind_rows, которая избегает предупреждений Unequal factor levels: coercing to character, когда столбцы факторов присутствуют в dfs, которые мы пытаемся объединить (что также может иметь нефакторный колонны). Вот пример:Связать строки данных с некоторыми столбцами факторов

df1 <- dplyr::data_frame(age = 1:3, gender = factor(c("male", "female", "female")), district = factor(c("north", "south", "west"))) 
df2 <- dplyr::data_frame(age = 4:6, gender = factor(c("male", "neutral", "neutral")), district = factor(c("central", "north", "east"))) 

затем bind_rows_with_factor_columns(df1, df2) возвращает (без предупреждения):

dplyr::data_frame(
    age = 1:6, 
    gender = factor(c("male", "female", "female", "male", "neutral", "neutral")), 
    district = factor(c("north", "south", "west", "central", "north", "east")) 
) 

Вот что я до сих пор:

bind_rows_with_factor_columns <- function(...) { 
    factor_columns <- purrr::map(..., function(df) { 
     colnames(dplyr::select_if(df, is.factor)) 
    }) 

    if (length(unique(factor_columns)) > 1) { 
     stop("All factor columns in dfs must have the same column names") 
    } 

    df_list <- purrr::map(..., function (df) { 
    purrr::map_if(df, is.factor, as.character) %>% dplyr::as_data_frame() 
    }) 

    dplyr::bind_rows(df_list) %>% 
    purrr::map_at(factor_columns[[1]], as.factor) %>% 
    dplyr::as_data_frame() 
} 

мне интересно, если у кого есть какие-либо идеи по как включить пакет forcats, чтобы избежать необходимости принуждать факторы к персонажам, или если у кого-то есть предложения вообще повысить эффективность этого поддерживая ту же функциональность (я хотел бы придерживаться синтаксиса tidyverse). Благодаря!

+0

Почему не просто 'do.call (rbind, список (df1, df2))'? – Sotos

+0

'suppressWarnings' или' purrr :: quietly'? – Axeman

ответ

0

Going ответить на мой собственный вопрос на основе отличное решение от друга:

bind_rows_with_factor_columns <- function(...) { 
    purrr::pmap_df(list(...), function(...) { 
    cols_to_bind <- list(...) 
    if (all(purrr::map_lgl(cols_to_bind, is.factor))) { 
     forcats::fct_c(cols_to_bind) 
    } else { 
     unlist(cols_to_bind) 
    } 
    }) 
}