On Sat, 25 Jun 2016 at 01:22 Michael Sumner <mdsum...@gmail.com> wrote:
> The internal "cycles" function that I have here reproduces your correct > ordering: > > > > On Fri, 24 Jun 2016 at 23:46 Paolo Piras <paolo.pi...@uniroma3.it> wrote: > >> Hi folks, >> I write in order to know if there is a solution to the following spatial >> sampling problem: >> I have a polygon that is not ordered; however, I know the "links" (or >> edges) between points; >> I need to sample 2000 points within the polygon. Using spsample() and >> Polygon() I need an ordered polygon which is not the case. >> I tried to use the links information in order to dynamically (and >> generalizing the problem) obtain the correct >> order but I did'nt get effective solution. I dont want an "estimate" of >> the hull from points or other heuristic strategies; I want to use the links >> info in order to properly sort my points. >> Here below a fully reproducible example. >> >> library(sp) >> >> pol<-matrix(c(30.24854,33.90530,27.48992,30.21646,40.03200,39.26215,33.52038,39.10177,39.99992,47.02477,47.44176,55.17230,57.38561,55.30061,57.25730,57.38561,28.45223,21.78023,31.21084,33.96946,22.10100,22.96708,40.86600,40.06407,40.83392,38.13946,24.79546,29.70323,30.60138,33.61661,31.65992,32.68638),ncol=2) >> plot(pol,asp=1) >> text(pol[,1],pol[,2],c(1:nrow(pol))) ### as you can see the polygon is >> not ordered >> >> links<-matrix(c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,2,6,1,3,11,5,4,7,8,9,12,13,15,10,16,14),ncol=2) >> for(i in 1:nrow(links)){ >> >> segments(pol[links[i,1],1],pol[links[i,1],2],pol[links[i,2],1],pol[links[i,2],2]) >> } # Fortunately I will have always these links >> #### now I would like to sampling,regularly, say 2000 points in the >> polygon >> sfe1<-spsample(Polygon(pol),2000,type="regular") >> points(sfe1@coords) ### of course this is not what I want. >> #### using an "ad hoc" ordering >> correct<-c(1,2,6,5,11,12,13,15,16,14,10,9,8,7,4,3) ## this is just an "ad >> hoc" solution; I need to generalize using the links information >> sfe1<-spsample(Polygon(pol[correct,]),2000,type="regular") >> points(sfe1@coords,col=2,pch=19,cex=0.3) ### this is what I want. >> >> > > This "detect cycles" function reproduces your "correct" indexing from the > links matrix: > > cycles <- function(aa) { > ii <- 1 > set0 <- ii > visited <- logical(nrow(aa)) > while(!all(visited)) { > i0 <- ii > repeat { > ii <- which(aa[,1] == aa[ii, 2]) > if (ii == i0) { > set0 <- c(set0, NA_integer_) > break; > } > set0 <- c(set0, ii) > } > visited <- seq(nrow(aa)) %in% na.omit(set0) > ii <- which(!visited)[1L] > if (!is.na(ii)) set0 <- c(set0, ii) > } > set0 > } > > > I found a better way, though it's wasteful on the non-sparse matrix for links, it gives the right answer (here in a list as there may be more than one cycle). cycles2 <- function(links) { require(ggm) if (any(is.na(links))) stop("missing value/s in links") mat <- matrix(0L, max(links), max(links)) mat[links] <- 1 lapply(ggm::fundCycles(mat), function(xa) rev(xa[ , 1L])) } cycles2(links) I think you've spurred me onto finding solutions to my own issues, hope it's of interest. Thanks, Mike. > cycles(links) > # [1] 1 2 6 5 11 12 13 15 16 14 10 9 8 7 4 3 NA > > I can't remember now what I was thinking with the finish-up in this > function - clearlyl I didn't quite get it right given that NA at the end - > but it's something I've been using now and then - detect "cycles" in a > list of edges. There's probably something in the igraph package that's much > more powerful and faster. Very keen to hear what you learn here. > > (I was using this to re-compose polygonal rings from meshes in the > RTriangle package, it takes input just like your pol/link vertices/edges > structure, and builds a constrained Delaunay triangulation.) > > Cheers, Mike. > > > This is an ad hoc solution; as I will have many different polygons >> (thounsed) and all different (some very irregular) but always with links >> information I would like to know if there is a solution to get the correct >> order using links. >> Thanks in advance for any advice >> All the best >> Paolo >> >> >> [[alternative HTML version deleted]] >> >> _______________________________________________ >> R-sig-Geo mailing list >> R-sig-Geo@r-project.org >> https://stat.ethz.ch/mailman/listinfo/r-sig-geo >> > -- > Dr. Michael Sumner > Software and Database Engineer > Australian Antarctic Division > 203 Channel Highway > Kingston Tasmania 7050 Australia > > -- Dr. Michael Sumner Software and Database Engineer Australian Antarctic Division 203 Channel Highway Kingston Tasmania 7050 Australia [[alternative HTML version deleted]] _______________________________________________ R-sig-Geo mailing list R-sig-Geo@r-project.org https://stat.ethz.ch/mailman/listinfo/r-sig-geo