天梭椭圆投影的一个示例?


9

我正在尝试通过天梭(Tissot)指标计算等角投影的变形。我曾尝试上的指示以下这篇文章(除其他事项外),但它超出了我的理解作为一个业余。

因此,我想知道是否有人会为一个等长的经纬度(例如,您最喜欢的并且在等长角投影上变形的那个)计算单个Tissot椭圆。我不完全了解变量是什么以及它们来自何处,因此了解实际的方程式将非常有用。

我试图理解这些方程,以便可以将它们插入正在编写的映射程序中。我在此线程中提出了一些一般性问题,但我认为一个具体的示例将帮助我弄清楚其余的问题。

一如既往,非常感谢。

NCashew

Answers:


8

作为记录,这里有一个完整的,经过注释的Tissot indicatrix(及相关)计算的实现R,并带有一个实例。等式的来源是约翰·斯奈德的地图投影-工作手册。

天梭

tissot <- function(lambda, phi, prj=function(z) z+0, asDegrees=TRUE, A = 6378137, f.inv=298.257223563, ...) {
  #
  # Compute properties of scale distortion and Tissot's indicatrix at location `x` = c(`lambda`, `phi`)
  # using `prj` as the projection.  `A` is the ellipsoidal semi-major axis (in meters) and `f.inv` is
  # the inverse flattening.  The projection must return a vector (x, y) when given a vector (lambda, phi).
  # (Not vectorized.)  Optional arguments `...` are passed to `prj`.
  #
  # Source: Snyder pp 20-26 (WGS 84 defaults for the ellipsoidal parameters).
  # All input and output angles are in degrees.
  #
  to.degrees <- function(x) x * 180 / pi
  to.radians <- function(x) x * pi / 180
  clamp <- function(x) min(max(x, -1), 1)                             # Avoids invalid args to asin
  norm <- function(x) sqrt(sum(x*x))
  #
  # Precomputation.
  #
  if (f.inv==0) {                                                     # Use f.inv==0 to indicate a sphere
    e2 <- 0 
  } else {
    e2 <- (2 - 1/f.inv) / f.inv                                       # Squared eccentricity
  }
  if (asDegrees) phi.r <- to.radians(phi) else phi.r <- phi
  cos.phi <- cos(phi.r)                                               # Convenience term
  e2.sinphi <- 1 - e2 * sin(phi.r)^2                                  # Convenience term
  e2.sinphi2 <- sqrt(e2.sinphi)                                       # Convenience term
  if (asDegrees) units <- 180 / pi else units <- 1                    # Angle measurement units per radian
  #
  # Lengths (the metric).
  #
  radius.meridian <- A * (1 - e2) / e2.sinphi2^3                      # (4-18)
  length.meridian <- radius.meridian                                  # (4-19)
  radius.normal <- A / e2.sinphi2                                     # (4-20)
  length.normal <- radius.normal * cos.phi                            # (4-21)
  #
  # The projection and its first derivatives, normalized to unit lengths.
  #
  x <- c(lambda, phi)
  d <- numericDeriv(quote(prj(x, ...)), theta="x")
  z <- d[1:2]                                                         # Projected coordinates
  names(z) <- c("x", "y")
  g <- attr(d, "gradient")                                            # First derivative (matrix)
  g <- g %*% diag(units / c(length.normal, length.meridian))          # Unit derivatives
  dimnames(g) <- list(c("x", "y"), c("lambda", "phi"))
  g.det <- det(g)                                                     # Equivalent to (4-15)
  #
  # Computation.
  #
  h <- norm(g[, "phi"])                                               # (4-27)
  k <- norm(g[, "lambda"])                                            # (4-28)
  a.p <- sqrt(max(0, h^2 + k^2 + 2 * g.det))                          # (4-12) (intermediate)
  b.p <- sqrt(max(0, h^2 + k^2 - 2 * g.det))                          # (4-13) (intermediate)
  a <- (a.p + b.p)/2                                                  # (4-12a)
  b <- (a.p - b.p)/2                                                  # (4-13a)
  omega <- 2 * asin(clamp(b.p / a.p))                                 # (4-1a)
  theta.p <- asin(clamp(g.det / (h * k)))                             # (4-14)
  conv <- (atan2(g["y", "phi"], g["x","phi"]) + pi / 2) %% (2 * pi) - pi # Middle of p. 21
  #
  # The indicatrix itself.
  # `svd` essentially redoes the preceding computation of `h`, `k`, and `theta.p`.
  #
  m <- svd(g)
  axes <- zapsmall(diag(m$d) %*% apply(m$v, 1, function(x) x / norm(x)))
  dimnames(axes) <- list(c("major", "minor"), NULL)

  return(list(location=c(lambda, phi), projected=z, 
           meridian_radius=radius.meridian, meridian_length=length.meridian,
           normal_radius=radius.normal, normal_length=length.normal,
           scale.meridian=h, scale.parallel=k, scale.area=g.det, max.scale=a, min.scale=b, 
           to.degrees(zapsmall(c(angle_deformation=omega, convergence=conv, intersection_angle=theta.p))),
           axes=axes, derivatives=g))
}
indicatrix <- function(x, scale=1, ...) {
  # Reprocesses the output of `tissot` into convenient geometrical data.
  o <- x$projected
  base <- ellipse(o, matrix(c(1,0,0,1), 2), scale=scale, ...)             # A reference circle
  outline <- ellipse(o, x$axes, scale=scale, ...)
  axis.major <- rbind(o + scale * x$axes[1, ], o - scale * x$axes[1, ])
  axis.minor <- rbind(o + scale * x$axes[2, ], o - scale * x$axes[2, ])
  d.lambda <- rbind(o + scale * x$derivatives[, "lambda"], o - scale * x$derivatives[, "lambda"])
  d.phi <- rbind(o + scale * x$derivatives[, "phi"], o - scale * x$derivatives[, "phi"])
  return(list(center=x$projected, base=base, outline=outline, 
              axis.major=axis.major, axis.minor=axis.minor,
              d.lambda=d.lambda, d.phi=d.phi))
}
ellipse <- function(center, axes, scale=1, n=36, from=0, to=2*pi) {
  # Vector representation of an ellipse at `center` with axes in the *rows* of `axes`.
  # Returns an `n` by 2 array of points, one per row.
  theta <- seq(from=from, to=to, length.out=n)
  t((scale * t(axes))  %*% rbind(cos(theta), sin(theta)) + center)
}
#
# Example: analyzing a GDAL reprojection.
#
library(rgdal)

prj <- function(z, proj.in, proj.out) {
  z.pt <- SpatialPoints(coords=matrix(z, ncol=2), proj4string=proj.in)
  w.pt <- spTransform(z.pt, CRS=proj.out)
  return(w.pt@coords[1, ])
}
r <- tissot(130, 54, prj,                # Longitude, latitude, and reprojection function
       proj.in=CRS("+init=epsg:4267"),   # NAD 27
       proj.out=CRS("+init=esri:54030")) # World Robinson projection

i <- indicatrix(r, scale=10^4, n=71)
plot(i$outline, type="n", asp=1, xlab="Easting", ylab="Northing")
polygon(i$base, col=rgb(0, 0, 0, .025), border="Gray")
lines(i$d.lambda, lwd=2, col="Gray", lty=2)
lines(i$d.phi, lwd=2, col=rgb(.25, .7, .25), lty=2)
lines(i$axis.major, lwd=2, col=rgb(.25, .25, .7))
lines(i$axis.minor, lwd=2, col=rgb(.7, .25, .25))
lines(i$outline, asp=1, lwd=2)
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.