2015-11-27 2 views
3

фон:

Я имею дело с комбинаторной задачей в R. Для заданного списка наборов, мне нужно, чтобы генерировать все пары за комплект без получения дубликатов.эффективно работать с множествами в R

Пример:

initial_list_of_sets <- list() 
initial_list_of_sets[[1]] <- c(1,2,3) 
initial_list_of_sets[[2]] <- c(2,3,4) 
initial_list_of_sets[[3]] <- c(3,2) 
initial_list_of_sets[[4]] <- c(5,6,7) 
get_pairs(initial_list_of_sets) 
# should return (1 2),(1 3),(2 3),(2 4),(3 4),(5 6),(5 7),(6 7) 

Пожалуйста, обратите внимание, что (3 2) не включены в результаты, так как она математически равна (2 3).

My (работает, но неэффективен) подход до сих пор:

# checks if sets contain a_set 
contains <- function(sets, a_set){ 
    for (existing in sets) { 
    if (setequal(existing, a_set)) { 
     return(TRUE) 
    } 
    } 
    return(FALSE) 
} 

get_pairs <- function(from_sets){ 
    all_pairs <- list() 
    for (a_set in from_sets) { 
    # generate all pairs for current set 
    pairs <- combn(x = a_set, m = 2, simplify = FALSE) 
    for (pair in pairs) { 
     # only add new pairs if they are not yet included in all_pairs 
     if (!contains(all_pairs, pair)) { 
     all_pairs <- c(all_pairs, list(pair)) 
     } 
    } 
    } 
    return(all_pairs) 
} 

Мой вопрос:

Как я имею дело с математическими множествами я не могу использовать оператор %in% вместо моей contains функции, потому что то (2 3) и (3 2) будут разными парами. Однако представляется очень неэффективным перебирать все существующие наборы в contains. Есть ли лучший способ реализовать эту функцию?

+0

да! Я приму свой ответ. Я хотел бы узнать, как R это быстро за кулисами ... – fab

+1

В вашем цикле вы увеличиваете список всякий раз, когда добавляется новое значение, которое обычно не очень эффективно. Я также попытался использовать некоторые уже оптимизированные функции в R ('lapply',' unique', например). – A5C1D2H2I1M1N2O1R2T1

ответ

1

Возможно, вы можете переписать get_pairs функцию как нечто вроде следующего:

myFun <- function(inlist) { 
    unique(do.call(rbind, lapply(inlist, function(x) t(combn(sort(x), 2))))) 
} 

Вот краткое сравнение времени.

n <- 100 
set.seed(1) 

x <- sample(2:8, n, TRUE) 
initial_list_of_sets <- lapply(x, function(y) sample(100, y)) 

system.time(get_pairs(initial_list_of_sets)) 
# user system elapsed 
# 1.964 0.000 1.959 
system.time(myFun(initial_list_of_sets)) 
# user system elapsed 
# 0.012 0.000 0.014 

При необходимости, вы можете split матрицу по строкам, чтобы получить список.

Например:

myFun <- function(inlist) { 
    temp <- unique(do.call(rbind, lapply(inlist, function(x) t(combn(sort(x), 2))))) 
    lapply(1:nrow(temp), function(x) temp[x, ]) 
} 
Смежные вопросы