R-Cran: Как я могу повернуть график?

Question

Я заинтересован в вычислении максимального расстояния внутри многоугольника по произвольному направлению (альфа).

Следующая ссылка решила мой вопрос. https://gis.stackexchange.com/questions/32552/how-to-calculate-the-maximum-distance-within-a-polygon-in-x-direction-east-west. (первый ответ: R-код, выполненный для выполнения расчетов и создания иллюстраций)

Единственный недостаток заключается в том, что перед запуском скрипта мне нужно повернуть свой многоугольник, поскольку он находит максимум в направлении x.

Сценарий также отображает многоугольник с максимальным расстоянием по осям x.

Как я не добился успеха в редактировании функции Plot, есть ли способ повернуть график, чтобы установить одно и то же направление для максимального найденного расстояния и настраиваемого направления?

Спасибо

- воспроизводимый пример ---

добавить следующие строки с моим полигоном (х, у координаты повернуты альфа = 30 градусов таким же образом, автор 1-го для Answer предлагает).

# --- modified lines ------ 
x <- c(29, -3, -9, -33, -11, -3, 30) 
y <- c(13, -38, -37, -22, 32, 39, 13) 
df = data.frame(x,y) 
p.raw = list(cbind(x=df$x, y=df$y)) 

#scale <- 10 
#p.raw = list(scale * cbind(x=c(0:10,7,6,0), y=c(3,0,0,-1,-1,-1,0,-0.5,0.75,1,4,1.5,0.5,3)), 
#    scale *cbind(x=c(1,1,2.4,2,4,4,4,4,2,1), y=c(0,1,2,1,1,0,-0.5,1,1,0)), 
#    scale *cbind(x=c(6,7,6,6), y=c(.5,2,3,.5))) 

#p.raw = list(cbind(x=c(0,2,1,1/2,0), y=c(0,0,2,1,0))) 
#p.raw = list(cbind(x=c(0, 35, 100, 65, 0), y=c(0, 50, 100, 50, 0))) 

# --- modified lines ------ 

к сценарию R по предыдущей ссылке.

# 
# Plotting functions. 
# 
points.polygon <- function(p, ...) { 
    points(p$v, ...) 
} 
plot.polygon <- function(p, ...) { 
    apply(p$e, 1, function(e) lines(matrix(e[c("x.min", "x.max", "y.min", "y.max")], ncol=2), ...)) 
} 
expand <- function(bb, e=1) { 
    a <- matrix(c(e, 0, 0, e), ncol=2) 
    origin <- apply(bb, 2, mean) 
    delta <- origin %*% a - origin 
    t(apply(bb %*% a, 1, function(x) x - delta)) 
} 
# 
# Convert polygon to a better data structure. 
# 
# A polygon class has three attributes: 
# v is an array of vertex coordinates "x" and "y" sorted by increasing y; 
# e is an array of edges from (x.min, y.min) to (x.max, y.max) with y.max >= y.min, sorted by y.min; 
# bb is its rectangular extent (x0,y0), (x1,y1). 
# 
as.polygon <- function(p) { 
    # 
    # p is a list of linestrings, each represented as a sequence of 2-vectors 
    # with coordinates in columns "x" and "y". 
    # 
    f <- function(p) { 
    g <- function(i) { 
     v <- p[(i-1):i, ] 
     v[order(v[, "y"]), ] 
    } 
    sapply(2:nrow(p), g) 
    } 
    vertices <- do.call(rbind, p) 
    edges <- t(do.call(cbind, lapply(p, f))) 
    colnames(edges) <- c("x.min", "x.max", "y.min", "y.max") 
    # 
    # Sort by y.min. 
    # 
    vertices <- vertices[order(vertices[, "y"]), ] 
    vertices <- vertices[!duplicated(vertices), ] 
    edges <- edges[order(edges[, "y.min"]), ] 

    # Maintaining an extent is useful. 
    bb <- apply(vertices <- vertices[, c("x","y")], 2, function(z) c(min(z), max(z))) 

    # Package the output. 
    l <- list(v=vertices, e=edges, bb=bb); class(l) <- "polygon" 
    l 
} 
# 
# Compute the maximal horizontal interior segments of a polygon. 
# 
fetch.x <- function(p) { 
    # 
    # Update moves the line from the previous level to a new, higher level, changing the 
    # state to represent all edges originating or strictly passing through level `y`. 
    # 
    update <- function(y) { 
    if (y > state$level) { 
     state$level <<- y 
     # 
     # Remove edges below the new level from state$current. 
     # 
     current <- state$current 
     current <- current[current[, "y.max"] > y, ] 
     # 
     # Adjoin edges at this level. 
     # 
     i <- state$i 
     while (i <= nrow(p$e) && p$e[i, "y.min"] <= y) { 
     current <- rbind(current, p$e[i, ]) 
     i <- i+1 
     } 
     state$i <<- i 
     # 
     # Sort the current edges by x-coordinate. 
     # 
     x.coord <- function(e, y) { 
     if (e["y.max"] > e["y.min"]) { 
      ((y - e["y.min"]) * e["x.max"] + (e["y.max"] - y) * e["x.min"])/(e["y.max"] - e["y.min"]) 
     } else { 
      min(e["x.min"], e["x.max"]) 
     } 
     } 
     if (length(current) > 0) { 
     x.array <- apply(current, 1, function(e) x.coord(e, y)) 
     i.x <- order(x.array) 
     current <- current[i.x, ] 
     x.array <- x.array[i.x]  
     # 
     # Scan and mark each interval as interior or exterior. 
     # 
     status <- FALSE 
     interior <- numeric(length(x.array)) 
     for (i in 1:length(x.array)) { 
      if (current[i, "y.max"] == y) { 
      interior[i] <- TRUE 
      } else { 
      status <- !status 
      interior[i] <- status 
      } 
     } 
     # 
     # Simplify the data structure by retaining the last value of `interior` 
     # within each group of common values of `x.array`. 
     # 
     interior <- sapply(split(interior, x.array), function(i) rev(i)[1]) 
     x.array <- sapply(split(x.array, x.array), function(i) i[1]) 

     print(y) 
     print(current) 
     print(rbind(x.array, interior)) 


     markers <- c(1, diff(interior)) 
     intervals <- x.array[markers != 0] 
     # 
     # Break into a list structure. 
     # 
     if (length(intervals) > 1) { 
      if (length(intervals) %% 2 == 1) 
      intervals <- intervals[-length(intervals)] 
      blocks <- 1:length(intervals) - 1 
      blocks <- blocks - (blocks %% 2) 
      intervals <- split(intervals, blocks) 
     } else { 
      intervals <- list() 
     } 
     } else { 
     intervals <- list() 
     } 
     # 
     # Update the state. 
     # 
     state$current <<- current 
    } 
    list(y=y, x=intervals) 
    } # Update() 

    process <- function(intervals, x, y) { 
    # intervals is a list of 2-vectors. Each represents the endpoints of 
    # an interior interval of a polygon. 
    # x is an array of x-coordinates of vertices. 
    # 
    # Retains only the intervals containing at least one vertex. 
    between <- function(i) { 
     1 == max(mapply(function(a,b) a && b, i[1] <= x, x <= i[2])) 
    } 
    is.good <- lapply(intervals$x, between) 
    list(y=y, x=intervals$x[unlist(is.good)]) 
    #intervals 
    } 
    # 
    # Group the vertices by common y-coordinate. 
    # 
    vertices.x <- split(p$v[, "x"], p$v[, "y"]) 
    vertices.y <- lapply(split(p$v[, "y"], p$v[, "y"]), max) 
    # 
    # The "state" is a collection of segments and an index into edges. 
    # It will updated during the vertical line sweep. 
    # 
    state <- list(level=-Inf, current=c(), i=1, x=c(), interior=c()) 
    # 
    # Sweep vertically from bottom to top, processing the intersection 
    # as we go. 
    # 
    mapply(function(x,y) process(update(y), x, y), vertices.x, vertices.y) 
} 

# --- modified lines ------ 
x <- c(29, -3, -9, -33, -11, -3, 30) 
y <- c(13, -38, -37, -22, 32, 39, 13) 
df = data.frame(x,y) 
p.raw = list(cbind(x=df$x, y=df$y)) 

#scale <- 10 
#p.raw = list(scale * cbind(x=c(0:10,7,6,0), y=c(3,0,0,-1,-1,-1,0,-0.5,0.75,1,4,1.5,0.5,3)), 
#    scale *cbind(x=c(1,1,2.4,2,4,4,4,4,2,1), y=c(0,1,2,1,1,0,-0.5,1,1,0)), 
#    scale *cbind(x=c(6,7,6,6), y=c(.5,2,3,.5))) 

#p.raw = list(cbind(x=c(0,2,1,1/2,0), y=c(0,0,2,1,0))) 
#p.raw = list(cbind(x=c(0, 35, 100, 65, 0), y=c(0, 50, 100, 50, 0))) 

# --- modified lines ------ 

p <- as.polygon(p.raw) 

results <- fetch.x(p) 
# 
# Find the longest. 
# 
dx <- matrix(unlist(results["x", ]), nrow=2) 
length.max <- max(dx[2,] - dx[1,]) 
# 
# Draw pictures. 
# 
segment.plot <- function(s, length.max, colors, ...) { 
    lapply(s$x, function(x) { 
    col <- ifelse (diff(x) >= length.max, colors[1], colors[2]) 
    lines(x, rep(s$y,2), col=col, ...) 
    }) 
} 
gray <- "#f0f0f0" 
grayer <- "#d0d0d0" 
plot(expand(p$bb, 1.1), type="n", xlab="x", ylab="y", main="After the Scan") 
sapply(1:length(p.raw), function(i) polygon(p.raw[[i]], col=c(gray, "White", grayer)[i])) 
apply(results, 2, function(s) segment.plot(s, length.max, colors=c("Red", "#b8b8a8"), lwd=4)) 
plot(p, col="Black", lty=3) 
points(p, pch=19, col=round(2 + 2*p$v[, "y"]/scale, 0)) 
points(p, cex=1.25) 

Результирующий график показывает максимальное расстояние в виде красного сегмента в направлении оси x. Поскольку мне это нужно в исходном направлении (поверните назад на альфа 30 градусов), я смотрю на максимальное расстояние координаты x, y, чтобы выполнить обратное вращение на -алью.

я получаю максимальное расстояние сегмент координаты х от:

dx <- matrix(unlist(results["x", ]), nrow=2) 
length.max <- max(dx[2,] - dx[1,]) 

Я не в состоянии получить координату.

apply(results, 2, function(s) segment.plot(s, length.max, colors=c("Red", "#b8b8a8"), lwd=2)) 

Итак, я ищу способ поворота полученных осей графика по альфа.

Answer 1

Я взял небольшой многоугольник из ?polygon. Попробуйте это, чтобы повернуть его

x <- c(1:9, 8:1) 
y <- c(1, 2*(5:3), 2, -1, 17, 9, 8, 2:9) 
# plot(x, y) 
# polygon(x, y) 
vertices <- matrix(c(x, y), byrow = T, nrow = 2) 

rotate <- function(point, theta, degree = F) { 
    if (degree) theta <- theta * pi/180 
    rotate.matrix <- matrix(c(cos(theta), -sin(theta), sin(theta), cos(theta)), byrow = T, nrow = 2) 
    rotate.point <- rotate.matrix %*% point 
    rotate.point 
} 

rotate.vertices <- apply(vertices, 2, rotate, theta = 1.3) 
# plot(rotate.vertices[1, ], rotate.vertices[2, ], xlim = c(-20, 20), ylim = c(-20, 20)) 
# polygon(rotate.vertices[1, ], rotate.vertices[2, ]) 

Параметр theta это угол, на который вы вращаете полигон. Если вы предпочитаете градусы для радианов, обязательно установите degree = T.