StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

PO
text
Body
copied!<p>Ok, several coffeebreaks later, here's some buggy code that does what you want. The cleanup I'll leave to you.</p> <pre><code>ranpoly <- function(numsegs=10,plotit=TRUE) { require(spatstat) # temp fix: put the first seg into segset. Later make it a constrained random. segset<-psp(c(0,1,1,0,.25),c(0,0,1,1,0),c(1,1,0,0,1),c(0,1,1,0,.75),owin(c(0,1),c(0,1)) ) #frame the frame for (jj in 1: numsegs) { # randomly select a segment to start from, a point on the seg, the slope,and direction # later... watch for slopes that immediately exit the frame endx <-sample(c(-0.2,1.2),1) #force 'x1' outside the frame # watch that sample() gotcha if(segset$n<=5) sampset <- c(5,5) else sampset<-5:segset$n startseg<-sample(sampset,1) #don't select a frame segment # this is slope of segment to be constructed slope <- tan(runif(1)*2*pi-pi) # range +/- Inf # get length of selected segment seglen<-lengths.psp(segset)[startseg] startcut <- runif(1) # grab the coords of starting point (similar triangles) startx<- segset$ends$x0[startseg] + (segset$ends$x1[startseg]-segset$ends$x0[startseg])*startcut #seglen starty<- segset$ends$y0[startseg] + (segset$ends$y1[startseg]-segset$ends$y0[startseg])*startcut #seglen # make a psp object with that startpoint and slope; will adjust it after finding intersections endy <- starty + slope*(endx-startx) newpsp<-psp(startx,starty,endx,endy,segset$window,check=FALSE) # don't calc crossing for current element of segset hits <- crossing.psp(segset[-startseg],newpsp) segdist <- dist(cbind(c(startx,hits$x),c(starty,hits$y))) # dig back to get the crosspoint desired -- have to get matrixlike object out of class "dist" object # And, as.matrix puts a zero in location 1,1 kill that row. cutx <- hits$x[ which.min( as.matrix(segdist)[-1,1] )] cuty <- hits$y[which.min(as.matrix(segdist)[-1,1] )] segset <- superimpose(segset,psp(startx,starty,cutx,cuty,segset$window)) } #end jj loop if(plotit) plot(segset,col=rainbow(numsegs)) return(invisible(segset)) } </code></pre>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload