[R] Delete Rows Dynamically Within a Loop

ftonini f_tonini at hotmail.com
Fri Nov 18 02:20:54 CET 2011


Ok guys, as requested, I will add more info so that you understand why a
simple vector operation is not possible. It's not easy to explain in few
words but let's see. I have a huge amount of points over a 2D space. 
I divide my space in a grid with a given resolution,say, 100m. The main loop
that I am not sure if it's mandatory or not (any alternative is welcomed) is
to go through EACH cell/pixel that contains at least 2 points (right now I
am using the method quadratcount within the package spatstat). 
Inside this loop, thus for each one of this non empty cells, I have to find
and keep only a maximum of 10 Male-Female pairs that are within 3 meters
from each other. The 3-meter buffer can be done using the "disc" function
within spatstat. To select points falling inside a buffer you can use the
method pnt.in.poly within the SDMTools package. All that because pixels have
a maximum capacity that cannot be exceeded. Since in each cell there can be
hundreds or thousands of points I am trying to find a smart way to use
another loop/similar method to:
1)go trough each point at a time 2)create a buffer a select points with
different sex 3)Save the closest Male-Female (0-1) pair in another dataframe
(called new_colonies) 4)Remove those points from the dataframe so that it
shrinks and I don't have to consider them anymore 5) as soon as that new
dataframe reaches 10 rows stop everything and go to the next cell (thus
skipping all remaining points. Here is the code that I developed to be run
within each cell (right now it takes too long):

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,]


--
View this message in context: http://r.789695.n4.nabble.com/Delete-Rows-Dynamically-Within-a-Loop-tp4081777p4081777.html
Sent from the R help mailing list archive at Nabble.com.



More information about the R-help mailing list