R应用具有多个动态和静态参数的函数

时间:2015-05-18 09:01:59

标签: r apply

我想将distancePointSegment函数应用于vector中的所有点,两者都在下面的代码段中给出。该函数接受6个值,其中2个是动态的(列/行特定),4个是静态的。

# Function that I want to apply:
distancePointSegment <- function(px, py, x1, y1, x2, y2) {
  ## px,py is the point to test.
  ## x1,y1,x2,y2 is the line to check distance.
  ##
  ## Returns distance from the line, or if the intersecting point on the line nearest
  ## the point tested is outside the endpoints of the line, the distance to the
  ## nearest endpoint.
  ##
  ## Returns 9999 on 0 denominator conditions.
  lineMagnitude <- function(x1, y1, x2, y2) sqrt((x2-x1)^2+(y2-y1)^2)
  ans <- NULL
  ix <- iy <- 0   # intersecting point
  lineMag <- lineMagnitude(x1, y1, x2, y2)
  if( lineMag < 0.00000001) {
    warning("short segment")
    return(9999)
  }
  u <- (((px - x1) * (x2 - x1)) + ((py - y1) * (y2 - y1)))
  u <- u / (lineMag * lineMag)
  if((u < 0.00001) || (u > 1)) {
    ## closest point does not fall within the line segment, take the shorter distance
    ## to an endpoint
    ix <- lineMagnitude(px, py, x1, y1)
    iy <- lineMagnitude(px, py, x2, y2)
    if(ix > iy)  ans <- iy
    else ans <- ix
  } else {
    ## Intersecting point is on the line, use the formula
    ix <- x1 + u * (x2 - x1)
    iy <- y1 + u * (y2 - y1)
    ans <- lineMagnitude(px, py, ix, iy)
  }
  ans
}

# my data points
vector <- c(134.2, 156.1, 165.2, 186, 220.8, 237.1, 239.6, 327.7, 376.2, 
396.1, 424.5, 460.2, 563.4, 565.7, 818.6, 819.7, 1120.4, 1279.5, 
1640.7)
point_coords <- rbind(1:length(cl$height), vector)

x1 = point_coords[1,1]
y1 = point_coords[2,1]
x2 = point_coords[1,length(vector)]
y2 = point_coords[2,length(vector)]

我尝试了这两种语法,但都不起作用:

apply(point_coords, MARGIN=2, FUN= function(col) {distancePointSegment(col[1], col[2], x1, y1, x2, y2)}, x1=x1, x2=x2,y1=y1,y2=y2)

apply(point_coords, MARGIN=2, FUN= distancePointSegment, px=x[1], py=x[2], x1=x1, x2=x2, y1=y1, y2=y2)

有人能指出我正确的方向吗?这里的逻辑是什么?

P.S:此问题与an earlier one相关联,但这是一个更通用的案例,包含多个动态和静态参数。

1 个答案:

答案 0 :(得分:1)

您可以使用mapply

mapply(FUN= distancePointSegment, point_coords[1,], point_coords[2,],
       MoreArgs = list(x1=x1, x2=x2, y1=y1, y2=y2))

或者更改您的功能并使用apply

# Function that I want to apply:
distancePointSegment <- function(p, x1, y1, x2, y2) {
  px <- p[1] #the coordinates are passed as a vector to the function
  py <- p[2]
  ## px,py is the point to test.
  ## x1,y1,x2,y2 is the line to check distance.
  ##
  ## Returns distance from the line, or if the intersecting point on the line nearest
  ## the point tested is outside the endpoints of the line, the distance to the
  ## nearest endpoint.
  ##
  ## Returns 9999 on 0 denominator conditions.
  lineMagnitude <- function(x1, y1, x2, y2) sqrt((x2-x1)^2+(y2-y1)^2)
  ans <- NULL
  ix <- iy <- 0   # intersecting point
  lineMag <- lineMagnitude(x1, y1, x2, y2)
  if( lineMag < 0.00000001) {
    warning("short segment")
    return(9999)
  }
  u <- (((px - x1) * (x2 - x1)) + ((py - y1) * (y2 - y1)))
  u <- u / (lineMag * lineMag)
  if((u < 0.00001) || (u > 1)) {
    ## closest point does not fall within the line segment, take the shorter distance
    ## to an endpoint
    ix <- lineMagnitude(px, py, x1, y1)
    iy <- lineMagnitude(px, py, x2, y2)
    if(ix > iy)  ans <- iy
    else ans <- ix
  } else {
    ## Intersecting point is on the line, use the formula
    ix <- x1 + u * (x2 - x1)
    iy <- y1 + u * (y2 - y1)
    ans <- lineMagnitude(px, py, ix, iy)
  }
  ans
}

# my data points
vector <- c(134.2, 156.1, 165.2, 186, 220.8, 237.1, 239.6, 327.7, 376.2, 
            396.1, 424.5, 460.2, 563.4, 565.7, 818.6, 819.7, 1120.4, 1279.5, 
            1640.7)
point_coords <- rbind(seq_along(vector), vector) #changed for reproducibility

x1 = point_coords[1,1]
y1 = point_coords[2,1]
x2 = point_coords[1,length(vector)]
y2 = point_coords[2,length(vector)]

apply(point_coords, MARGIN=2, FUN= distancePointSegment,
      x1=x1, x2=x2, y1=y1, y2=y2)