R уникальных комбинаций из заданных диапазонов быстро и используя меньше системных ресурсов

Question

Это дополнительный вопрос здесь: https://stackoverflow.com/a/55912086/3988575

У меня есть такой набор данных:

ID=as.character(c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20))
IQ=c(120.5,128.1,126.5,122.5,127.1,129.7,124.2,123.7,121.7,122.3,120.9,122.4,125.7,126.4,128.2,129.1,121.2,128.4,127.6,125.1)
Section=c("A","A","B","B","A","B","B","A","B","A","B","B","A","A","B","B","A","B","B","A")
zz=data.frame(ID,IQ,Section)
zz_new=do.call("rbind", replicate(zz, n=30, simplify = FALSE))

То, что я хотел бы сделать, это сопоставить людей по диапазону их IQ (который был предыдущим вопросом).

Теперь я хочу создать несколько уровней диапазонов. Например, один диапазон может быть 10 IQ-классов: 120-121,121-122,122-123 .... 129-130. Другим примером является один класс IQ: 120-130. Все возможные комбинации вышеперечисленного можно получить:

IQ_Class=c(120,121,122,123,124,125,126,127,128,129,130)
n = length(IQ_Class)-2
all_combin=expand.grid(replicate(n, 0:1, simplify = FALSE))
all_combin$First=1
all_combin$Last=1
all_combin_new=all_combin[c("First",names(all_combin)[1:(length(names(all_combin))-2)],"Last")] #Reorder columns
all_combin_new = t((apply(all_combin_new,1,function(x)(x*IQ_Class)))) #Multiply by IQ classes
all_combin_new = apply(all_combin_new, 1, function(x) { x[x!=0] })

Обратите внимание, что конечный объект all_combin_new предоставляет список списков всех классов (всего 512 классов).

Теперь я хочу взять один класс (один элемент из all_combin_new) и создать все комбинации идентификаторов в этом конкретном классе IQ по их разделам. Сохраните этот набор данных, возьмите следующий класс из all_combin_new и повторите операцию.

Из предыдущего ответа я смог изменить код для рассмотрения комбинаций по разделам, изменив следующее в предыдущем вопросе:

zz1=list("list",length(all_combin_new))
for (i in 1:length(all_combin_new)){ #changed this line to run for all combinations in all_combin_new
  zz2=all_combin_new[[i]]
  zz11=zz_new%>%
    mutate(ID=as.character(ID),vec=as.character(cut(IQ,zz2,right=F)))%>%
    group_by(vec,Section)%>% #Changed this line
    summarize(if(n()>1)list(data.frame(t(combn(ID,2)),stringsAsFactors = F))
              else list(data.frame(X1=ID,X2=ID,stringsAsFactors = F)))%>%
    unnest()%>%
    bind_cols(read.csv(text=gsub("[^0-9,]","",.$vec),h=F))
  zz1[[i]]=as.data.frame(zz11)
}

Мой фактический набор данных имеет около 10K (по сравнению с zz_new здесь) наблюдений с 20 секциями (что приводит к 2 ^ 18 = 262144 диапазонам IQ по сравнению с длиной списка all_combin_new здесь = 512). Это вызывает две основные проблемы:

а) Время: скорость очень низкая. Есть ли способ увеличить скорость?

b) Размер создаваемых объектов: в моих тестах, даже если не считать большое количество комбинаций, списки становятся слишком большими и код не выполняется. Какие альтернативные подходы я мог бы использовать здесь? Обратите внимание, что в списке, который я здесь получаю, мне также необходимо выполнить дальнейшие вычисления.

Любая помощь будет оценена. Заранее спасибо.

P.S. Пожалуйста, дайте мне знать, если какая-то часть неясна или какая-либо часть кода имеет некоторые непреднамеренные ошибки.

Answer 1

Редактировать: Теперь с циклом, чтобы пройти все комбинации IQ и включить Section в качестве ключа при соединении.

Я использовал пример данных в связанном вопросе. Вместо того, чтобы составлять список и циклы, он делает все сразу.

Обратите внимание, что есть декартово произведение, поэтому оно может все еще иметь проблемы с памятью. Если у вас возникли проблемы, вы всегда можете попробовать data.table, поскольку у вас могут быть неравные объединения.

library(tidyverse)

zz <- tibble(ID=1:12
                 ,IQ=c(120.5,123,125,122.5,122.1,121.7,123.2,123.7,120.7,122.3,120.1,122)
                 ,Section=c("A","A","B","B","A","B","B","A","B","A","B","B")
)

IQ_Class <- c(120,122,124,126)

IQ_Classes <- data.frame(First = 1
             ,expand.grid(replicate(length(IQ_Class)-2, 0:1, simplify = FALSE))
             ,Last = 1)

IQ_Classes <- IQ_Classes * IQ_Class[col(IQ_Classes)]                    

IQ_Classes_List <- apply(IQ_Classes, 1, function(x) { x[x!=0] })

all_combos <- lapply(IQ_Classes_List
                     , function(IQs) 
                       {
                       z_cut <- zz%>%
                         mutate(cut_range = cut(IQ, IQ_Class, right = F, labels = F))

                       inner_join(z_cut
                                  , z_cut %>%
                                    select(V2 = ID, cut_range, Section)
                                  , by = c('cut_range', 'Section'))%>%
                         filter(V2 > ID) %>%
                         mutate(Previous_IQ_class = IQs[cut_range],
                                Next_Class = IQs[cut_range+1])
                       }
                     )%>%
  bind_rows(.id = 'IQ_List')