[R] Delete Rows Dynamically Within a Loop

Uwe Ligges ligges at statistik.tu-dortmund.de
Sat Nov 19 20:13:03 CET 2011


1. Perhaps it is easier to explain what the result should be than 
explaining your algorithm. There may be an easier approach to it.
2. Your code is not reproducible for us, since we do not have the full 
data nor disc, radius, .....

Uwe Ligges





On 18.11.2011 02:20, ftonini wrote:
> 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.
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.



More information about the R-help mailing list