R : 라인 세그먼트 조건부 시뮬레이션

Question

지각 작업을 위해 여러 항목을 시뮬레이트하고 각 항목에 선이 갑자기 방향이 바뀌는 두 개의 '중단 점'이있는 플롯 된 단일 선으로 구성됩니다. 따라서 본질적으로 선은 서로 다른 사면을 가진 네 개의 좌표 (Axy, Bxy, Cxy, Dyx)를 연결하는 세 개의 연결된 선 세그먼트 (AB, BC 및 CD)로 구성됩니다.

라인은 다음과 같은 세 가지 조건에 동의해야

1) 세 개의 선분 (AB, BC, 및 CD)의 길이의 합이다 라인 (L)의 전체 길이, 항목간에 다양하지만 항상 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

(혹은 회전 된 사본) 당신이 아닌 8 교차점 것 (각 가장자리에 위치) 4 개 개의 숫자를 따기 중 하나로 문제를 생각할 수 불가능할 것이므로 확인하실 필요가 없습니다. 처음 세 점을 선택하고 잠시 멈춰서 이 네 번째 길이로 확장 될 수 있는지 확인하십시오 (길이 제한이 있음). 안전 밸브로서 실현 가능한 해결책을 찾으려는 횟수를 경계해야합니다 :

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

그래프 : 빠른 테스트를 위해 내가 그것을 완료 관리하기 전에