Question

对于感知任务，我希望模拟多个项目，每个项目由一条带有两个“断点”的绘制单行组成，其中该行突然改变方向。因此，本质上该线由三个连接的线段（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.

3）线段可能不会交叉。也就是说，线段AB和CD可能不交叉（因为线BC的一端连接到其他两个线段，它们不能交叉它们。）

我希望在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")

Answer 1

由于您的约束会使图片看起来像您的图像（或者可能是旋转的副本），您可以将问题视为选择4个数字（每个边缘上的位置）而不是8个。交叉点是不可能的，因此无需检查。选择前三个点，然后暂停以检查它是否是可以将它扩展到第四个（给定长度限制）。作为一个安全阀，限制尝试寻找可行解决方案的次数：

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
}

这很快。使用您的参数，它每秒可以生成数万个解决方案。快速测试：

> 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')

图表：

R：模拟线段条件

1 个答案: