Динамически удалять элементы в цикле R - PullRequest
1 голос
/ 18 ноября 2011

Хорошо, ребята, по запросу, я добавлю больше информации, чтобы вы понимали, почему простая векторная операция невозможна.Это не легко объяснить в нескольких словах, но давайте посмотрим.У меня есть огромное количество очков в двухмерном пространстве.Я делю свое пространство в сетке с заданным разрешением, скажем, 100м.Основной цикл, в котором я не уверен, является ли он обязательным или нет (любая альтернатива приветствуется), состоит в том, чтобы пройти через КАЖДУЮ ячейку / пиксель, который содержит как минимум 2 точки (сейчас я использую метод quadratcount в пакете spatstat).Внутри этого цикла, таким образом, для каждой из этих непустых ячеек я должен найти и сохранить не более 10 пар «мужчина-женщина», которые находятся в пределах 3 метров друг от друга.3-метровый буфер может быть создан с помощью функции «диск» в spatstat.Чтобы выбрать точки, попадающие в буфер, вы можете использовать метод pnt.in.poly в пакете SDMTools.Все это потому, что пиксели имеют максимальную емкость, которую нельзя превышать.Поскольку в каждой ячейке может быть сотни или тысячи точек, я пытаюсь найти умный способ использовать другой цикл / аналогичный метод, чтобы: 1) проходить каждую точку за раз 2) создавать буфер для выбора точек с разным полом 3) Сохраните ближайшую пару мужчина-женщина (0-1) в другом фрейме данных (называемом new_colonies). 4) Удалите эти точки из фрейма данных, чтобы они сжимались, и мне больше не нужно их рассматривать 5), как только этот новый фрейм данныхДостигнув 10 строк, остановите все и перейдите к следующей ячейке (таким образом пропуская все оставшиеся точки. Вот код, который я разработал для запуска в каждой ячейке (сейчас это занимает слишком много времени):

head (df,20):

 X       Y Sex ID
2  583058.2 2882774   1  1
3  582915.6 2883378   0  2
4  582592.8 2883297   1  3
5  582793.0 2883410   1  4
6  582925.7 2883397   1  5
7  582934.2 2883277   0  6
8  582874.7 2883336   0  7
9  583135.9 2882773   1  8
10 582955.5 2883306   1  9
11 583090.2 2883331   0 10
12 582855.3 2883358   1 11
13 582908.9 2883035   1 12
14 582608.8 2883715   0 13
15 582946.7 2883488   1 14
16 582749.8 2883062   0 15
17 582906.4 2883317   0 16
18 582598.9 2883390   0 17
19 582890.2 2883413   0 18
20 582752.8 2883361   0 19
21 582953.1 2883230   1 20

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

for(i in 1:dim(df)[1]) {

new_colonies <- data.frame(ID1=0,ID2=0,X=0,Y=0) 

discbuff <- disc(radius, centre=c(df$X[i], df$Y[i])) 

#define the points and polygon
pnts = cbind(df$X[-i],df$Y[-i])
polypnts = cbind(x = discbuff$bdry[[1]]$x, y = discbuff$bdry[[1]]$y)
out = pnt.in.poly(pnts,polypnts)
out$ID <- df$ID[-i]

if (any(out$pip == 1)) {

pnt.inBuffID <- out$ID[which(out$pip == 1)] 
cond <- df$Sex[i] != df$Sex[pnt.inBuffID]

if (any(cond)){

eucdist <- sqrt((df$X[i] - df$X[pnt.inBuffID][cond])^2 + (df$Y[i] - df$Y[pnt.inBuffID][cond])^2)

IDvect <- pnt.inBuffID[cond]
new_colonies_temp <- data.frame(ID1=df$ID[i], ID2=IDvect[which(eucdist==min(eucdist))], 
                 X=(df$X[i] + df$X[pnt.inBuffID][cond][which(eucdist==min(eucdist))]) / 2, 
                 Y=(df$Y[i] + df$Y[pnt.inBuffID][cond][which(eucdist==min(eucdist))]) / 2)

new_colonies <- rbind(new_colonies,new_colonies_temp)

if (dim(new_colonies)[1] == maxdensity) break

}
}
}

new_colonies <- new_colonies[-1,]

Любая помощь приветствуется!Спасибо Франческо

Ответы [ 3 ]

4 голосов
/ 18 ноября 2011

В вашем случае я бы не беспокоился об удалении очков по ходу дела, пропуски являются критически важной вещью.Я также не стал бы создавать новый data.frame по частям, как вы, кажется, делаете.Обе эти вещи сильно вас тормозят.Наличие вектора выбора намного эффективнее (возможно, часть data.frame, который вы предварительно установили в FALSE).

df$sel <- FALSE

Теперь, когда вы проходите через него, вы устанавливаете для df $ sel значение TRUE для каждого элемента.ты хочешь сохранить.Просто перейдите к следующей ячейке, когда найдете свои 10. Удаление значений по мере их выполнения будет занимать много времени и занимать много памяти, как и медленно растущий новый data.frame.Когда вы все закончите, просматривая их, вы можете просто выбрать свои данные на основе столбца выбора.

df <- df[ df$sel, ]

(или, возможно, сделать копию data.frame в этот момент)

Вы также можете использовать функцию dist для вычисления матрицы расстояний.

из ?dist

"Эта функция вычисляет и возвращает матрицу расстояний, вычисленную с использованием указанногомера расстояния для вычисления расстояний между строками матрицы данных. "

2 голосов
/ 18 ноября 2011

Я предполагаю, что вы делаете что-то достаточно сложное, что цикл for действительно необходим ...

Итак, вот один довольно простой подход: сначала просто собрать строки для удаления (или сохранения), изатем удалите строки впоследствии.Как правило, это будет намного быстрее, так как вы не изменяете data.frame на каждой итерации цикла.

df <- generateTheDataFrame()

keepRows <- rep(TRUE, nrow(df))
for(i in seq_len(nrow(df))) {
  rows <- findRowsToDelete(df, df[i,]) 
  keepRows[rows] <- FALSE
}

# Delete afterwards
df <- df[keepRows, ]

... и если вам действительно нужно работать с сокращенными данными в каждой итерации, простоизмените часть цикла на:

for(i in seq_len(nrow(df))) {
  if (keepRows[i]) {
      rows <- findRowsToDelete(df[keepRows, ], df[i,]) 
      keepRows[rows] <- FALSE
  }
}
1 голос
/ 18 ноября 2011

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

Однако, как очень простое исправление, вы рассматривали циклическое перемещение по фрейму данных назад?

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...