R: Simulating line segment conditional - r

Question

For a perceptual task, I wish to simulate multiple items, each consisting of a plotted single line with two 'breaking points' where the line abruptly changes direction. So in essence the line consists of three connected line segments (AB, BC, and CD), connecting four coordinates (Axy, Bxy, Cxy, Dyx), each with a different slope.
The line must agree with the following three conditions:
1) The total length of the line (L), which is the sum of the length of the three line segments (AB, BC, and CD) should vary between items, but always fall within the range of l1 and l2.
2) The line should fit within and take up an X*Y sized rectangle. That is, at least one x-coordinate (Ax, Bx, Cx, or Dx) should equal 0, at least one x-coordinate (Ax, Bx, Cx, or Dx) should equal X, at least one y-coordinate (Ay, By, Cy, or Dy) should be 0, at least one y-coordinate (Ay, By, Cy, or Dy) should equal Y; none of the x-coordinates should be lower than 0 or higher than X, none of the y-coordinates should be lower than 0 or higher than Y.
3) The line segments may not cross. That is, line segment AB and CD may not cross (as line BC is connected at one end to both other line segments, it cannot cross them).
I wish to do this in R. So far I've only managed a code wherein a random line is created and the code then checks if it meets all three conditions. If not, it starts anew. This method takes way too long!
Does anyone have an idea how I could make this code more efficient? Current R-code provided below.
#START WHILE LOOP
STOP = FALSE
CONDITION_COUNTER <- c(0,0,0)
while(STOP==FALSE){ #start condition checking loop
#SETTINGS:
l1 = 8 #minimum length L
l2 = 12 #maximum length L
L = runif(1,l1,l2) #length L
X = 5 #width square for length L
Y = 7 #heigth square for length L
#CREATE LINE SEGMENT:
Ax <- runif(1,0,X) #x-coordinate point A
Ay <- runif(1,0,Y) #y-coordinate point A
Bx <- runif(1,0,X) #x-coordinate point B
By <- runif(1,0,Y) #y-coordinate point B
Cx <- runif(1,0,X) #x-coordinate point C
Cy <- runif(1,0,Y) #y-coordinate point C
Dx <- runif(1,0,X) #x-coordinate point D
Dy <- runif(1,0,Y) #y-coordinate point D
#CHECK CONDITION 01 (line has to equal length L)
AB = sqrt((Ax-Bx)^2 + (Ay-By)^2) #length line segment AB
BC = sqrt((Bx-Cx)^2 + (By-Cy)^2) #length line segment BC
CD = sqrt((Cx-Dx)^2 + (Cy-Dy)^2) #length line segment CD
CONDITION_COUNTER[1] <- L == AB + BC + CD #Condition 1 satisfied (1) or not (0)?
#CHECK CONDITION 02 (line has to fill the square)
c1 = sum(c(Ax, Bx, Cx, Dx) == 0) > 0 #does one point have x-coordinate 0?
c2 = sum(c(Ax, Bx, Cx, Dx) == X) > 0 #does one point have x-coordinate X?
c3 = sum(c(Ay, By, Cy, Dy) == 0) > 0 #does one point have y-coordinate 0?
c4 = sum(c(Ay, By, Cy, Dy) == Y) > 0 #does one point have y-coordinate Y?
CONDITION_COUNTER[2] <- sum(c(c1,c2,c3,c4)) == 4 #Condition 2 satisfied (1) or not (0)?
#CHECK CONDITION 03 (line segments may not cross)
a <- max(c(Ax,Bx)); b <- min(c(Ax,Bx)); x <- a-b; x
a <- c(Ay,By)[which.max(c(Ax,Bx))]; b <- c(Ay,By)[which.min(c(Ax,Bx))]; y <- a-b; y
slopeAB <- y/x
InterceptAB <- Ay - slopeAB * Ax
c <- max(c(Cx,Dx)); d <- min(c(Cx,Dx)); x <- c-d; x
c <- c(Cy,Dy)[which.max(c(Cx,Dx))]; d <- c(Cy,Dy)[which.min(c(Cx,Dx))]; y <- c-d; y
slopeCD <- y/x
InterceptCD <- Cy - slopeCD * Cx
intersection <- (InterceptAB - InterceptCD)/(slopeCD - slopeAB) #what is the hypothetical x-coordinate of intersection?
c1 <- min(c(Ax,Bx)) <= intersection & intersection <= max(c(Ax,Bx)) #does AB contain that x-coordinate? (TRUE=yes, FALSE=no)
c1 <- (c1 -1)*-1
CONDITION_COUNTER[3] <- c1
CHECK <- (sum(CONDITION_COUNTER) == 3) #check if all conditions are met
if(CHECK == TRUE){STOP <- TRUE} #if all conditions are met, stop loop
} #END WHILE LOOP
#Plot:
plot(-1:10, -1:10, xaxt='n',yaxt='n',bty='n',pch='',ylab='',xlab='', col="white")
segments(Ax,Ay,Bx,By, lwd=2) #segment AB
segments(Bx,By,Cx,Cy, lwd=2) #segment BC
segments(Cx,Cy,Dx,Dy, lwd=2) #segment CD
#Add square that it has to fill
segments(0,0,X,0, col="red")
segments(0,0,0,Y, col="red")
segments(X,0,X,Y, col="red")
segments(0,Y,X,Y, col="red")

Answer 1

Since your constraints force the picture to look like your image (or perhaps a rotated copy) you can think of the problem as one of picking 4 numbers (a location on each edge) rather than 8. Intersections would be impossible, so no need to check. Pick the first three points, and then pause to check if it is
possible to extend it to the fourth (given the length constraints). As a safety valve, put a bound on the number of attempts to find a feasible solution:
dis <- function(x0,y0,x1,y1){
sqrt(sum((c(x1,y1)-c(x0,y0))^2))
}
broken.line <- function(X,Y,l1,l2,attempts = 1000){
Ax <- 0
By <- 0
Cx <- X
Dy <- Y
for(i in 1:attempts){
Ay <- runif(1,0,Y)
Bx <- runif(1,0,X)
Cy <- runif(1,0,Y)
L <- dis(Ax,Ay,Bx,By) + dis(Bx,By,Cx,Cy)
d.min <- Y - Cy #min dist to top edge
if(l1 < L + d.min && L + d.min < l2){
#it is feasible to complete this
#configuration -- calulate how much
#of top edge is a valid choice
#d.max is farthest that last point
#can be from the upper right corner:
d.max <- sqrt((l2 - L)^2 - d.min^2)
Dx <- runif(1,max(0,X-d.max),X)
points <- c(Ax,Bx,Cx,Dx,Ay,By,Cy,Dy)
return(matrix(points,ncol = 2))
}
}
NULL #can't find a feasible solution
}
It is fairly quick. With your parameters it can generate tens of thousands of solutions per second. For a quick test:
> m <- broken.line(5,7,8,12)
> m
[,1] [,2]
[1,] 0.000000 1.613904
[2,] 1.008444 0.000000
[3,] 5.000000 3.627471
[4,] 3.145380 7.000000
> plot(m,type = 'l')
Graph: