对于感知任务,我希望模拟多个项目,每个项目由一条绘制的单线和两个“断点”组成,其中线突然改变方向。因此,本质上,直线由三个连接的线段(AB、BC和CD)组成,连接四个坐标(Axy、Bxy、Cxy、Dyx),每个坐标具有不同的斜率。
1) 线的总长度(L)是三条线段(AB、BC和CD)的长度之和,应在项目之间变化,但始终在l1和l2的范围内。
2) 该线应适合并占据一个X*Y大小的矩形。也就是说,至少一个x坐标(Ax、Bx、Cx或Dx)应等于0,至少一个x坐标(Ax、Bx、Cx或Dx)应等于x,至少一个y坐标(Ay、By、Cy或Dy)应为0,至少一个y坐标(Ay、By、Cy或Dy)应等于y;任何x坐标都不应低于0或高于x,任何y坐标都不应低于0或高于y。
我希望在R中这样做。到目前为止,我只管理了一个代码,其中创建了一个随机行,然后代码检查它是否满足所有三个条件。如果没有,它将重新开始。这种方法耗时太长!
有人知道我如何使这段代码更高效吗?下面提供了当前R代码。
#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")
