Предположим, у вас есть эти data.frame:
d <- data.frame(ID=c(1,1,1,2,2,3,3,4,4,6,6,6,8,8),FP=-c(1,2,3,1,2,3,2,1,4,1,4,3,1,4)*100)
Если вы создадите матрицу непредвиденных расходов:
table(d$FP,d$ID)
1 2 3 4 6 8
-400 0 0 0 1 1 1
-300 1 0 1 0 1 0
-200 1 1 1 0 0 0
-100 1 1 0 1 1 1
Вы видите, что набор имен столбцов строки '-400'(c(4,6,8)) является подмножеством набора имен столбцов строки' -100 '(c(1,2,4,6,8)).
В таких случаях мне нужно удалить строки' superset ', т.е. здесь строка' -100 '.
Аналогично, вы можете видеть, что набор имен строк столбца '8' (c(-400,-100)) является подмножеством набора имен строк столбца '6' (c(-400,-300,-100)).
В таких случаяхВ случаях, когда мне нужно удалить столбцы «подмножество», то есть здесь столбец «8», но с дополнительным соображением я объясню ниже.
Важно, мне нужно сделать это до / без создание матрицы, потому что с типом d data.frames, который я использую, это часто вызывает проблемы с памятью.
Способ, которым я в настоящее время делаю удаление надмножества непосредственно на исходных данных, следующий:
- агрегирует данные по
FP, используя unique в качестве функции, предотвращая упрощение для vecтор;сортировка по длине - удаление дублированных наборов идентификаторов, поскольку любой дубликат по определению также является циклом
- надстроек для каждого набора идентификаторов во всех других наборах идентификаторов большей длины и удаляет последние, если ониsupersets
Т.е.:
t1 <- d
duprows <- aggregate(ID~FP,t1,function(x) {sort(unique(x))}, simplify=FALSE)
t1 <- t1[t1$FP %in% duprows[!(duplicated(duprows$ID)),][["FP"]],]
duprows["NIDs"] <- sapply(duprows[["ID"]],length)
duprows <- duprows[order(duprows[["NIDs"]]),]
# not run
#duprows
# FP ID NIDs
#1 -400 4, 6, 8 3
#2 -300 1, 3, 6 3
#3 -200 1, 2, 3 3
#4 -100 1, 2, 4, 6, 8 5
i = 1
Nconsts <- dim(duprows)[[1]]
while (i <= (Nconsts-1)) {
FPs_to_remove = numeric()
current_NIDs = duprows[["NIDs"]][i]
#find the index of the first NIDs greater than the current one
greater_NIDs_index = which(duprows[["NIDs"]]>current_NIDs)[1]
if (is.na(greater_NIDs_index)) {break} else {
ID.i = unlist(duprows[["ID"]][i])
for (j in greater_NIDs_index:Nconsts) {
ID.j = unlist(duprows[["ID"]][j])
matches = (ID.i %in% ID.j)
if (all(matches)) {
FPs_to_remove = c(FPs_to_remove, duprows[["FP"]][j]) }
}
duprows = duprows[!(duprows[["FP"]] %in% FPs_to_remove),]
Nconsts = dim(duprows)[[1]]
i = i + 1
}
}
t1 <- t1[t1$FP %in% duprows$FP,]
# not run
#duprows
# FP ID NIDs
#1 -400 4, 6, 8 3
#2 -300 1, 3, 6 3
#3 -200 1, 2, 3 3
В этом примере это работает достаточно быстро, но, как вы можете себе представить, с большими наборами данных это довольно катастрофично.
Вопрос : можете ли вы предложить более эффективный способ достижения того же результата?
Я посмотрел виньетки из пакета data.table, которые мне посоветовали в другом посте для другого заданияи в этом случае это действительно значительно ускорило вычисления.На самом деле я мог бы использовать тот же пакет для удаления дубликатов строк.Однако для вышеупомянутой задачи я не вижу непосредственного способа воспользоваться быстрыми операциями data.table.Любое предложение будет очень кстати.
Как я уже говорил, другая связанная задача, которую мне нужно выполнить, - это удаление столбцов subset , но с дополнительным рассмотрением числового свойства P.
Я принял стратегию, аналогичную приведенной выше:
- агрегирует данные по
ID, используя unique в качестве функции, предотвращающей упрощение для вектора;сортировка по длине, а теперь также по убыванию P и ID в случае наличия связей в P - удаляет дублированные наборы FP, потому что любой дубликат по определению также является подмножеством;наибольшее значение
P сохраняется, потому что строки уже отсортированы - цикл для каждого набора FP на всех других наборах FP большей длины, и удалите первый, если он является подмножеством и имеет меньшее значение
P
Т.е.:
P_vs_id <- data.frame(ID=c(1,2,3,4,6,8),P=c(0.5,0.8,0.1,0.6,0.9,0.75))
dupcols <- aggregate(FP~ID,t1,function(x) {sort(unique(x))}, simplify=FALSE)
dupcols <- merge(dupcols,P_vs_id,by="ID")
dupcols["NFPs"] <- sapply(dupcols[["FP"]],length)
dupcols <- dupcols[order(dupcols$NFPs,-dupcols$P,dupcols$ID),]
t1 <- t1[t1$ID %in% dupcols[!(duplicated(dupcols$FP)),][["ID"]],]
В этом примере был удален столбец с ID 4, который был дубликатом ID 8 и имел более низкий P.
Затем для точки 3:
dupcols <- aggregate(FP~ID,t1,function(x) {sort(unique(x))}, simplify=FALSE)
dupcols <- merge(dupcols,P_vs_id,by="ID")
dupcols["NFPs"] <- sapply(dupcols[["FP"]],length)
dupcols <- dupcols[order(dupcols$NFPs,-dupcols$P,dupcols$ID),]
# not run
#dupcols
# ID FP P NFPs
#2 2 -200 0.80 1
#4 8 -400 0.75 1
#3 6 -400, -300 0.90 2
#1 1 -300, -200 0.50 2
i = 1
NIDs <- dim(dupcols)[[1]]
while (i <= (NIDs-1)) {
current_NFPs = dupcols[["NFPs"]][i]
#find the index of the first NFPs larger than the current one
larger_NFPs_index = which(dupcols[["NFPs"]]>current_NFPs)[1]
if (is.na(larger_NFPs_index)) {break} else {
FP.i = unlist(dupcols[["FP"]][i])
P.i = unlist(dupcols[["P"]][i])
j = larger_NFPs_index
flag = 0
while (j <= NIDs) {
FP.j = unlist(dupcols[["FP"]][j])
P.j = unlist(dupcols[["P"]][j])
matches = (FP.i %in% FP.j)
if (all(matches) & (P.i <= P.j)) {
dupcols = dupcols[-i,]
flag = 1
break} else {j = j + 1}
}
NIDs = dim(dupcols)[[1]]
if (flag == 0) {i = i + 1}
}
}
# not run
#dupcols
# ID FP P NFPs
#2 2 -200 0.80 1
#3 6 -400, -300 0.90 2
#1 1 -300, -200 0.50 2
t1 <- t1[(t1$ID %in% dupcols$ID),]
В этом примере был удален столбец с ID 8, который соответствовал набору поднаборов FP из FP * из 1080 * 6 ибыл ниже P.Он не удалил столбец с ID 2, несмотря на тот факт, что это подмножество столбца с ID 1, потому что первый имеет более высокий P.
Опять же, все прошло довольно хорошодля этого небольшого data.frame, но для типа данных, которые я обрабатываю, это может занять несколько часов.
Мне удалось немного ускорить его, исключив из проверки наборы FP.i, которые никогда не могут быть подмножествами каких-либодругой набор, но это оказало лишь незначительное влияние.
И учтите, что часто необходимо несколько раз повторить удаление надмножества и подмножества, потому что, как вы можете себе представить, удаление определенных строк или определенных столбцов иногда приводит к некоторому изменению матрицыэто делает необходимым дальнейший запуск.
Итак ... любая помощь, делающая это более эффективным, действительно будет много значить.
Спасибо!
РЕДАКТИРОВАТЬ после дальнейшего изучения
Я обнаружил, что xtabs может создавать разреженные матрицы на случай непредвиденных обстоятельств;возможно, это обойдёт ошибки памяти, которые я получил с полными матрицами.Затем, поскольку описанные выше задачи, по-видимому, довольно сильно связаны с концепцией линейной зависимости, я мог бы, возможно, использовать пакет Matrix для выполнения QR-декомпозиции и взять его оттуда.
Похоже ли это на хорошийпуть вперед?Или QR будет таким же плохим, как мои петли?
Я еще раз (и короткую попытку) посмотрел на data.table.Помимо ускорения поиска данных в исходном файле data.frame, я не знаю, можно ли улучшить описанные мной операции.Я нашел, как написать функцию, которая сообщает, должна ли быть удалена данная строка или нет, но потом мне не удалось заставить ее работать в data.table;Я все еще недостаточно знаком с синтаксисом.
EDIT 2
Подход матричной алгебры оказался тупиком, по крайней мере, настолько, насколькоЯ мог бы сказать.
С другой стороны, немного изучив синтаксис data.table, я создал скрипт, который работает значительно лучше, чем приведенный выше (см. Ниже).
Тем не менее, я подозреваю,Я не использую потенциал data.table в лучшем виде, поэтому, если любой опытный пользователь не возражает проверить приведенный ниже сценарий и посоветовать, что можно сделать лучше, было бы замечательно.
d <- data.frame(ID=c(1,1,1,2,2,3,3,4,4,6,6,6,8,8),FP=-c(1,2,3,1,2,3,2,1,4,1,4,3,1,4)*100)
#
# SETUP
#
require(data.table)
# transfer or original data.frame data into a data.table
t1 <- data.table(d)
#
# REMOVE DUPLICATED ROWS
#
# count of how many ID's there are for each FP group
t1[,NIDs:=length(ID),by="FP"]
# sort
setorder(t1,NIDs,FP,ID)
# remove FP's that contain duplicate sets of ID's (duplicate rows)
duprows <- t1[,.(ID=list(c(ID))),by="FP"]
duprows[,is.dupl:=duplicated(ID)]
t1 <- t1[(FP %in% duprows[is.dupl == FALSE,FP])]
#
# REMOVE DUPLICATED COLUMNS
#
# count of how many FP's there are for each ID group
t1[,NFPs:=length(FP),by="ID"]
# sort
setorder(t1,-NFPs,ID,FP)
# remove ID's that contain duplicate sets of FP's (duplicate columns)
dupcols <- t1[,.(FP=list(c(FP))),by="ID"]
dupcols[,is.dupl:=duplicated(FP)]
t1 <- t1[(ID %in% dupcols[is.dupl == FALSE,ID])]
#
# REMOVE SUPERSET ROWS
#
# count of how many ID's there are for each FP group
t1[,NIDs:=length(ID),by="FP"]
# sort
setorder(t1,NIDs,FP,ID)
# for each FP group, write the first and last ID (they are already sorted)
t1[,ID.f:=first(c(ID)),by="FP"]
t1[,ID.l:=last(c(ID)),by="FP"]
# create an index for each FP group
t1[,FP.ind:=.GRP,by="FP"]
# initialise FP_to_remove column
t1[,FP_to_remove:=FALSE]
# mark FP groups that contain at least one ID corresponding to only one FP: the ID's in such FP groups can never be a subset of the ID's in another FP group
t1[,unique_ID:=any(NFPs==1),by="FP"]
# calculate the maximal FP group index
FP.ind.max <- t1[nrow(t1),FP.ind]
# for each FP group, check if its ID's are a subset of the ID's of other FP groups, and if so, mark the latter for removal
i = 1
while (i < FP.ind.max) {
FP.i = t1[FP.ind == i,FP][1]
ID.i = t1[FP == FP.i,c(ID),by=FP]$V1
NIDs.i = t1[FP.ind == i,NIDs][1]
ID.f.i = t1[FP.ind == i,ID.f][1]
ID.l.i = t1[FP.ind == i,ID.l][1]
if ((t1[FP.ind == i,unique_ID][1] == FALSE) & (t1[FP.ind == i,FP_to_remove][1] == FALSE)) {
t1[(ID.f <= ID.f.i & ID.l >= ID.l.i & FP.ind > i & NIDs > NIDs.i & FP_to_remove == FALSE),FP_to_remove:=all(ID.i %in% c(ID)),by=FP.ind]
}
i = i + 1
}
t1 <- t1[FP_to_remove == FALSE]
#
# REMOVE DUPLICATED COLUMNS (which may appear after removing superset rows)
#
# count of how many FP's there are for each ID group
t1[,NFPs:=length(FP),by="ID"]
# sort
setorder(t1,-NFPs,ID,FP)
# remove ID's that contain duplicate sets of FP's (duplicate columns)
dupcols <- t1[,.(FP=list(c(FP))),by="ID"]
dupcols[,is.dupl:=duplicated(FP)]
t1 <- t1[(ID %in% dupcols[is.dupl == FALSE,ID])]
#
# REMOVE SUBSET COLUMNS
#
# count of how many ID's there are for each FP group
t1[,NIDs:=length(ID),by="FP"]
# create an index for each ID group
t1[,ID.ind:=.GRP,by="ID"]
# for each ID group, write the first and last FP (they are already sorted)
t1[,FP.f:=first(c(FP)),by="ID"]
t1[,FP.l:=last(c(FP)),by="ID"]
# initialise ID_to_remove column
t1[,ID_to_remove:=FALSE]
# mark ID groups that contain at least one FP corresponding to only one ID: the FP's in such ID groups can never be a subset of the FP's in another ID group
t1[,unique_FP:=any(NIDs==1),by="ID"]
# calculate the maximal ID group index
ID.ind.max <- t1[nrow(t1),ID.ind]
# for each ID group, check if its FP's are a superset of the FP's of other ID groups, and if so, mark the latter for removal
i = 1
while (i < ID.ind.max) {
ID.i = t1[ID.ind == i,ID][1]
FP.i = t1[ID == ID.i,c(FP),by=ID]$V1
NFPs.i = t1[ID.ind == i,NFPs][1]
FP.f.i = t1[ID.ind == i,FP.f][1]
FP.l.i = t1[ID.ind == i,FP.l][1]
if (t1[ID.ind == i,ID_to_remove][1] == FALSE) {
t1[(unique_FP == FALSE & FP.f >= FP.f.i & FP.l <= FP.l.i & ID.ind > i & NFPs < NFPs.i & ID_to_remove == FALSE),ID_to_remove:=all(c(FP) %in% FP.i),by=ID.ind]
}
i = i + 1
}
t1 <- t1[ID_to_remove == FALSE]