mapproj/0000755000175000017500000000000014167536133012065 5ustar nileshnileshmapproj/MD50000644000175000017500000000456314167536133012405 0ustar nileshnilesh5a84d4adcac11e7d0ca4877a4fc48f05 *DESCRIPTION a66243f26e992c2e09d44b07c8617243 *LICENSE.note 056aeb9f5996f07d32b7b3c52fe6af0b *NAMESPACE 412368c9cb39b1e4afde6ba59a568784 *R/mapproj.r 774a5e45c7620829cb08e6b3664d2e02 *man/map.grid.Rd 69b8d89c345652d60ffcdf355c317545 *man/mapproject.Rd 1e220fbd9ec36780a036ddc43a17ef08 *src/Makevars.debug 963422f3661a1419150ea314b5b3a4c5 *src/aitoff.c 820bbcc1eace6808d0d13e215e54ab64 *src/albers.c 1789fbc55ae7967b57f329ab72b1abf4 *src/azequalarea.c b48479d7ab2d76195ee994ae6a088f07 *src/azequidist.c 9d3d4f7691130561925a077ce7574b24 *src/bicentric.c ca58fbdeacc7b7fea3e49715d440dae8 *src/bonne.c 2ece0e8ed684e1dc05d6c55ead9c0bf1 *src/ccubrt.c 16c4a1feb91f826879571eab500b7de6 *src/complex.c f29465a5f2724f08e4e74df9f7da3956 *src/conic.c 915fc9297f76b043270bba14ae9b677e *src/cubrt.c 46107979fcb61e0b40c8b80a2b8de27c *src/cuts.c dcc266276712c1c206163a2135adfcaf *src/cylequalarea.c 4aeb64bc71c26c294cb1c98ec2cfd422 *src/cylindrical.c 08c8c981c0b3583a218286c653253ab2 *src/eisenlohr.c d13f5814ed16b40e4efc3b6690207685 *src/elco2.c a06090a034194a98c8722783b2057d30 *src/elliptic.c 1d9bfc2b75c5a359d377c54e89a8de46 *src/fisheye.c cea60c90b42c4af4ea5b54726d348c52 *src/gall.c f5b531d076dc5c1cba56cdafdbd8d90a *src/gilbert.c 57df1e02389d4a5d4a16c21a958d210a *src/guyou.c 1d97c7dc429901e3ad46c92d23f54d72 *src/harrison.c 7f4bc8b6a464028cbbfb6af1e7b53f11 *src/hex.c abdfb7e8c7a3d223af25745ea39283d3 *src/homing.c 8106768ea4bdf544cba91021ca34388c *src/init.c 3883049518bbc60de9af2394649203ca *src/lagrange.c 68a3f00baa9ede46c13de50351b3aec5 *src/lambert.c 270fec0e947e395e1ac74950d4cee39c *src/laue.c d1097e5df5f8e8d4f2586a66e8bce3ab *src/lune.c 43884f7426e7089a34ff7a46d6c9b19a *src/map.h cb01919230736df812f057a23c376a38 *src/mapproject.c c9cb7e5d306dea81a01e7aa5de4d18df *src/mercator.c 1aa54f763ad4839773e6ea12ce926fbc *src/mollweide.c ebf89710c52f2558a03dd08afaa13b1c *src/newyorker.c cdfa10318e2136f419986069a0f5d5f4 *src/orthographic.c 05c66f6d7f96b5e7e8edc7b1adda8bf5 *src/perspective.c 0e0ec545cb2dddcab20c826d402345ab *src/polyconic.c 7506438efb2210f480446aacba052164 *src/rectangular.c a2b7e53517cbd01e2beafc89f91bc774 *src/simpleconic.c 6e15d2d163e9fec33cb3313480f032e3 *src/sinusoidal.c 1f63409119b7685fb2ec80f07b3a64d5 *src/tetra.c a3099bccdbab035c3ec6fa12e790eba2 *src/trapezoidal.c abeb12aaff9af6ad10cb0c9b10b51c59 *src/twocirc.c 9e3be978e17cacfebd95156beaef3149 *src/zcoord.c mapproj/DESCRIPTION0000644000175000017500000000103014167536133013565 0ustar nileshnileshPackage: mapproj Title: Map Projections Version: 1.2.8 Date: 2022-01-12 Author: Doug McIlroy. Packaged for R by Ray Brownrigg and Thomas P Minka, transition to Plan 9 codebase by Roger Bivand. Description: Converts latitude/longitude into projected coordinates. Depends: R (>= 3.0.0), maps (>= 2.3-0) Imports: stats, graphics License: Lucent Public License Maintainer: Alex Deckmyn NeedsCompilation: yes Repository: CRAN Packaged: 2022-01-12 10:00:03 UTC; alex Date/Publication: 2022-01-12 11:32:43 UTC mapproj/man/0000755000175000017500000000000014167523243012636 5ustar nileshnileshmapproj/man/map.grid.Rd0000755000175000017500000000426213615152714014633 0ustar nileshnilesh\name{map.grid} \alias{map.grid} \title{ Draw a latitude/longitude grid on a projected map } \description{ Draws a grid on an existing map. } \usage{ map.grid(lim, nx=9, ny=9, labels=TRUE, pretty=TRUE, cex, col, lty, font, ...) } \arguments{ \item{lim}{a vector of 4 numbers specifying limits: \code{c(lon.low, lon.high, lat.low, lat.high)}. \code{lim} can also be a list with a component named \code{range}, such as the result of \code{map}, from which limits are taken. } \item{nx, ny}{the desired number of equally-spaced longitude and latitude lines} \item{labels}{logical to indicate if grid lines should be labeled with longitude/latitude values.} \item{pretty}{If \code{TRUE}, grid lines will be placed at round numbers.} \item{cex, col, lty, font}{passed to arguments to \code{par}} \item{...}{additional arguments passed to \code{lines} and \code{text}, e.g. \code{col} to change the color of the grid and \code{lty} to change the line type.} } \value{ Equally-spaced lines of constant longitude and lines of constant latitude are superimposed on the current map, using the current projection. These lines will appear curved under most projections, and give an idea of how the projection works. } \seealso{\code{\link[maps]{map}}} \examples{ library(maps) m <- map("usa", plot=FALSE) map("usa", project="albers", par=c(39, 45)) map.grid(m) # get unprojected world limits m <- map('world', plot=FALSE) # center on NYC map('world', proj='azequalarea', orient=c(41, -74, 0)) map.grid(m, col=2) points(mapproject(list(y=41, x=-74)), col=3, pch="x", cex=2) map('world', proj='orth', orient=c(41, -74, 0)) map.grid(m, col=2, nx=6, ny=5, label=FALSE, lty=2) points(mapproject(list(y=41, x=-74)), col=3, pch="x", cex=2) # center on Auckland map('world', proj='orth', orient=c(-36.92, 174.6, 0)) map.grid(m, col=2, label=FALSE, lty=2) points(mapproject(list(y=-36.92, x=174.6)), col=3, pch="x", cex=2) m <- map('nz') # center on Auckland map('nz', proj='azequalarea', orient=c(-36.92, 174.6, 0)) points(mapproject(list(y=-36.92, x=174.6)), col=3, pch="x", cex=2) map.grid(m, col=2) } \keyword{aplot} mapproj/man/mapproject.Rd0000755000175000017500000002465314167523206015305 0ustar nileshnilesh\name{mapproject} \alias{mapproject} \title{ Apply a Map Projection } \description{ Converts latitude and longitude into projected coordinates. } \usage{ mapproject(x, y, projection="", parameters=NULL, orientation=NULL) } \arguments{ \item{x,y}{ two vectors giving longitude and latitude coordinates of points on the earth's surface to be projected. A list containing components named \code{x} and \code{y}, giving the coordinates of the points to be projected may also be given. Missing values (\code{NA}s) are allowed. The coordinate system is degrees of longitude east of Greenwich (so the USA is bounded by negative longitudes) and degrees north of the equator. } \item{projection}{ optional character string that names a map projection to use. If the string is \code{""} then the previous projection is used, with parameters modified by the next two arguments. } \item{parameters}{ optional numeric vector of parameters for use with the \code{projection} argument. This argument is optional only in the sense that certain projections do not require additional parameters. If a projection does require additional parameters, these must be given in the \code{parameters} argument. } \item{orientation}{ An optional vector \code{c(latitude,longitude,rotation)} which describes where the "North Pole" should be when computing the projection. Normally this is \code{c(90,0)}, which is appropriate for cylindrical and conic projections. For a planar projection, you should set it to the desired point of tangency. The third value is a clockwise rotation (in degrees), which defaults to the midrange of the longitude coordinates in the map. This means that two maps plotted with their own default orientation may not line up. To avoid this, you should not specify a projection twice but rather default to the previous projection using \code{projection=""}. See the examples. }} \value{ list with components named \code{x} and \code{y}, containing the projected coordinates. \code{NA}s project to \code{NA}s. Points deemed unprojectable (such as north of 80 degrees latitude in the Mercator projection) are returned as \code{NA}. Because of the ambiguity of the first two arguments, the other arguments must be given by name. Each time \code{mapproject} is called, it leaves on frame 0 the dataset \code{.Last.projection}, which is a list with components \code{projection}, \code{parameters}, and \code{orientation} giving the arguments from the call to \code{mapproject} or as constructed (for \code{orientation}). Subsequent calls to \code{mapproject} will get missing information from \code{.Last.projection}. Since \code{map} uses \code{mapproject} to do its projections, calls to \code{mapproject} after a call to \code{map} need not supply any arguments other than the data. } \details{ Each standard projection is displayed with the Prime Meridian (longitude 0) being a straight vertical line, along which North is up. The orientation of nonstandard projections is specified by the three \code{parameters=c(lat,lon,rot)}. Imagine a transparent gridded sphere around the globe. First turn the overlay about the North Pole so that the Prime Meridian (longitude 0) of the overlay coincides with meridian \code{lon} on the globe. Then tilt the North Pole of the overlay along its Prime Meridian to latitude \code{lat} on the globe. Finally again turn the overlay about its "North Pole" so that its Prime Meridian coincides with the previous position of (the overlay) meridian \code{rot}. Project the desired map in the standard form appropriate to the overlay, but presenting information from the underlying globe. In the descriptions that follow each projection is shown as a function call; if it requires parameters, these are shown as arguments to the function. The descriptions are grouped into families. Equatorial projections centered on the Prime Meridian (longitude 0). Parallels are straight horizontal lines. \describe{ \item{mercator()}{equally spaced straight meridians, conformal, straight compass courses} \item{sinusoidal()}{equally spaced parallels, equal-area, same as \code{bonne(0)}} \item{cylequalarea(lat0)}{equally spaced straight meridians, equal-area, true scale on \code{lat0}} \item{cylindrical()}{central projection on tangent cylinder} \item{rectangular(lat0)}{equally spaced parallels, equally spaced straight meridians, true scale on \code{lat0}} \item{gall(lat0)}{parallels spaced stereographically on prime meridian, equally spaced straight meridians, true scale on \code{lat0}} \item{mollweide()}{(homalographic) equal-area, hemisphere is a circle} \item{gilbert()}{sphere conformally mapped on hemisphere and viewed orthographically} } Azimuthal projections centered on the North Pole. Parallels are concentric circles. Meridians are equally spaced radial lines. \describe{ \item{azequidistant()}{equally spaced parallels, true distances from pole} \item{azequalarea()}{equal-area} \item{gnomonic()}{central projection on tangent plane, straight great circles} \item{perspective(dist)}{viewed along earth's axis \code{dist} earth radii from center of earth} \item{orthographic()}{viewed from infinity} \item{stereographic()}{conformal, projected from opposite pole} \item{laue()}{\code{radius = tan(2 * colatitude)} used in xray crystallography} \item{fisheye(n)}{stereographic seen through medium with refractive index \code{n}} \item{newyorker(r)}{\code{radius = log(colatitude/r)} map from viewing pedestal of radius \code{r} degrees} } Polar conic projections symmetric about the Prime Meridian. Parallels are segments of concentric circles. Except in the Bonne projection, meridians are equally spaced radial lines orthogonal to the parallels. \describe{ \item{conic(lat0)}{central projection on cone tangent at \code{lat0}} \item{simpleconic(lat0,lat1)}{equally spaced parallels, true scale on \code{lat0} and \code{lat1}} \item{lambert(lat0,lat1)}{conformal, true scale on \code{lat0} and \code{lat1}} \item{albers(lat0,lat1)}{equal-area, true scale on \code{lat0} and \code{lat1}} \item{bonne(lat0)}{equally spaced parallels, equal-area, parallel \code{lat0} developed from tangent cone} } Projections with bilateral symmetry about the Prime Meridian and the equator. \describe{ \item{polyconic()}{parallels developed from tangent cones, equally spaced along Prime Meridian} \item{aitoff()}{equal-area projection of globe onto 2-to-1 ellipse, based on \code{azequalarea}} \item{lagrange()}{conformal, maps whole sphere into a circle} \item{bicentric(lon0)}{points plotted at true azimuth from two centers on the equator at longitudes \code{+lon0} and \code{-lon0}, great circles are straight lines (a stretched gnomonic projection)} \item{elliptic(lon0)}{points are plotted at true distance from two centers on the equator at longitudes \code{+lon0} and \code{-lon0}} \item{globular()}{hemisphere is circle, circular arc meridians equally spaced on equator, circular arc parallels equally spaced on 0- and 90-degree meridians} \item{vandergrinten()}{sphere is circle, meridians as in \code{globular}, circular arc parallels resemble \code{mercator}} \item{eisenlohr()}{conformal with no singularities, shaped like polyconic} } Doubly periodic conformal projections. \describe{ \item{guyou}{W and E hemispheres are square} \item{square}{world is square with Poles at diagonally opposite corners} \item{tetra}{map on tetrahedron with edge tangent to Prime Meridian at S Pole, unfolded into equilateral triangle} \item{hex}{world is hexagon centered on N Pole, N and S hemispheres are equilateral triangles} } Miscellaneous projections. \describe{ \item{harrison(dist,angle)}{oblique perspective from above the North Pole, \code{dist} earth radii from center of earth, looking along the Date Line \code{angle} degrees off vertical} \item{trapezoidal(lat0,lat1)}{equally spaced parallels, straight meridians equally spaced along parallels, true scale at \code{lat0} and \code{lat1} on Prime Meridian} \item{lune(lat,angle)}{conformal, polar cap above latitude \code{lat} maps to convex lune with given \code{angle} at 90E and 90W} } Retroazimuthal projections. At every point the angle between vertical and a straight line to "Mecca", latitude \code{lat0} on the prime meridian, is the true bearing of Mecca. \describe{ \item{mecca(lat0)}{equally spaced vertical meridians} \item{homing(lat0)}{distances to Mecca are true} } Maps based on the spheroid. Of geodetic quality, these projections do not make sense for tilted orientations. \describe{ \item{sp\_mercator()}{Mercator on the spheroid.} \item{sp\_albers(lat0,lat1)}{Albers on the spheroid.} } } % end details \references{ Richard A. Becker, and Allan R. Wilks, "Maps in S", \emph{AT\&T Bell Laboratories Statistics Research Report, 1991.} \url{ https://web.archive.org/web/20070824013345/http://www.research.att.com/areas/stat/doc/93.2.ps} M. D. McIlroy, Documentation from the \emph{Tenth Edition UNIX Manual, Volume 1,} Saunders College Publishing, 1990. } \examples{ library(maps) # Bonne equal-area projection with state abbreviations map("state",proj='bonne', param=45) data(state) text(mapproject(state.center), state.abb) # this does not work because the default orientations are different: map("state",proj='bonne', param=45) text(mapproject(state.center,proj='bonne',param=45),state.abb) map("state",proj="albers",par=c(30,40)) map("state",par=c(20,50)) # another Albers projection map("world",proj="gnomonic",orient=c(0,-100,0)) # example of orient # see map.grid for more examples # tests of projections added RSB 091101 projlist <- c("aitoff", "albers", "azequalarea", "azequidist", "bicentric", "bonne", "conic", "cylequalarea", "cylindrical", "eisenlohr", "elliptic", "fisheye", "gall", "gilbert", "guyou", "harrison", "hex", "homing", "lagrange", "lambert", "laue", "lune", "mercator", "mollweide", "newyorker", "orthographic", "perspective", "polyconic", "rectangular", "simpleconic", "sinusoidal", "tetra", "trapezoidal") x <- seq(-100, 0, 10) y <- seq(-45, 45, 10) xy <- expand.grid(x=x, y=y) pf <- c(0, 2, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 2, 0, 1, 0, 2, 0, 2, 0, 0, 1, 0, 1, 0, 1, 2, 0, 0, 2) res <- vector(mode="list", length=length(projlist)) for (i in seq(along=projlist)) { if (pf[i] == 0) res[[i]] <- mapproject(xy$x, xy$y, projlist[i]) else if (pf[i] == 1) res[[i]] <- mapproject(xy$x, xy$y, projlist[i], 0) else res[[i]] <- mapproject(xy$x, xy$y, projlist[i], c(0,0)) } names(res) <- projlist lapply(res, function(p) rbind(p$x, p$y)) } \keyword{dplot} mapproj/src/0000755000175000017500000000000014167510441012646 5ustar nileshnileshmapproj/src/map.h0000644000175000017500000001173313615152714013603 0ustar nileshnilesh/* Copyright (C) 2003, Lucent Technologies Inc. and others. * All Rights Reserved. */ /* RSB #pragma lib "/sys/src/cmd/map/libmap/libmap.a$O" #pragma src "/sys/src/cmd/map/libmap"*/ #include #include #include #include #ifndef PI #define PI 3.1415926535897932384626433832795028841971693993751 #endif #define TWOPI (2*PI) #define RAD (PI/180) double hypot(double, double); /* sqrt(a*a+b*b) */ double tan(double); /* not in K&R library */ #define ECC .08227185422 /* eccentricity of earth */ #define EC2 .006768657997 #define FUZZ .0001 #define UNUSED 0.0 /* a dummy double parameter */ struct coord { double l; /* lat or lon in radians*/ double s; /* sin */ double c; /* cos */ }; struct place { struct coord nlat; struct coord wlon; }; typedef int (*proj)(struct place *, double *, double *); struct pindex { /* RSB */ /* index of known projections */ char *name; /* name of projection */ proj (*prog)(double, double); /* pointer to projection function */ int npar; /* number of params */ int (*cut)(struct place *, struct place *, double *); /* function that handles cuts--eg longitude 180 */ int poles; /*1 S pole is a line, 2 N pole is, 3 both*/ int spheroid; /* poles must be at 90 deg if nonzero */ int (*limb)(double *lat, double *lon, double resolution); /* get next place on limb */ /* return -1 if done, 0 at gap, else 1 */ }; proj aitoff(void); proj albers(double, double); int Xazequalarea(struct place *, double *, double *); proj azequalarea(void); int Xazequidistant(struct place *, double *, double *); proj azequidistant(void); proj bicentric(double); proj bonne(double); proj conic(double); proj cylequalarea(double); int Xcylindrical(struct place *, double *, double *); proj cylindrical(void); proj elliptic(double); proj eisenlohr(void); /* RSB */ proj fisheye(double); proj gall(double); proj gilbert(void); proj globular(void); proj gnomonic(void); /* AD int guycut(struct place *, struct place *, double *); */ int Xguyou(struct place *, double *, double *); proj guyou(void); proj harrison(double, double); /* AD int hexcut(struct place *, struct place *, double *); */ proj map_hex(void); proj homing(double); int hlimb(double*, double*, double resolution); proj lagrange(void); proj lambert(double, double); proj laue(void); proj lune(double, double); proj loxodromic(double); /* not in library */ proj mecca(double); int mlimb(double*, double*, double resolution); proj mercator(void); proj mollweide(void); proj newyorker(double); proj ortelius(double, double); /* not in library */ int Xorthographic(struct place *place, double *x, double *y); proj orthographic(void); int olimb(double*, double*, double); proj map_perspective(double); int plimb(double*, double*, double resolution); int Xpolyconic(struct place *, double *, double *); proj polyconic(void); proj rectangular(double); proj simpleconic(double, double); int Xsinusoidal(struct place *, double *, double *); proj sinusoidal(void); proj sp_albers(double, double); proj sp_mercator(void); proj square(void); int Xstereographic(struct place *, double *, double *); proj stereographic(void); int Xtetra(struct place *, double *, double *); /* AD int tetracut(struct place *, struct place *, double *); */ proj tetra(void); proj trapezoidal(double, double); proj vandergrinten(void); proj wreath(double, double); /* not in library */ void findxy(double, double *, double *); void albscale(double, double, double, double); void invalb(double, double, double *, double *); void cdiv(double, double, double, double, double *, double *); void cmul(double, double, double, double, double *, double *); /* RSB void cpow(double, double, double *, double *, double);*/ void map_cpow(double, double, double *, double *, double); void csq(double, double, double *, double *); /* RSB void csqrt(double, double, double *, double *);*/ void map_csqrt(double, double, double *, double *); void ccubrt(double, double, double *, double *); double cubrt(double); int elco2(double, double, double, double, double, double *, double *); void cdiv2(double, double, double, double, double *, double *); void csqr(double, double, double *, double *); void orient(double, double, double); void latlon(double, double, struct place *); void deg2rad(double, struct coord *); /* RSB void sincos(struct coord *);*/ void trig(struct coord *); void normalize(struct place *); void invert(struct place *); void norm(struct place *, struct place *, struct coord *); /* void printp(struct place *); */ void copyplace(struct place *, struct place *); /* AD int picut(struct place *, struct place *, double *); */ /* AD int ckcut(struct place *, struct place *, double); */ double reduce(double); /* RSB void getsyms(char *); int putsym(struct place *, char *, double, int); void filerror(char *s, char *f); void error(char *s); int doproj(struct place *, int *, int *); int cpoint(int, int, int); int plotpt(struct place *, int); int nocut(struct place *, struct place *, double *);*/ extern int (*projection)(struct place *, double *, double *); mapproj/src/cylindrical.c0000644000175000017500000000045013615152714015310 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" int Xcylindrical(struct place *place, double *x, double *y) { if(fabs(place->nlat.l) > 80.*RAD) return(-1); *x = - place->wlon.l; *y = place->nlat.s / place->nlat.c; return(1); } proj cylindrical(void) { return(Xcylindrical); } mapproj/src/newyorker.c0000644000175000017500000000064213615152714015043 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static double a; static int Xnewyorker(struct place *place, double *x, double *y) { double r = PI/2 - place->nlat.l; double s; if(r<.001) /* cheat to plot center */ s = 0; else if(rwlon.s; *y = -s * place->wlon.c; return(1); } proj newyorker(double a0) { a = a0*RAD; return(Xnewyorker); } mapproj/src/cubrt.c0000644000175000017500000000052213615152714014132 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" double cubrt(double a) { double x,y,x1; if(a==0) return(0.); y = 1; if(a<0) { y = -y; a = -a; } while(a<1) { a *= 8; y /= 2; } while(a>1) { a /= 8; y *= 2; } x = 1; do { x1 = x; x = (2*x1+a/(x1*x1))/3; } while(fabs(x-x1)>10.e-15); return(x*y); } mapproj/src/mercator.c0000644000175000017500000000110013615152714014620 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static int Xmercator(struct place *place, double *x, double *y) { if(fabs(place->nlat.l) > 80.*RAD) return(-1); *x = -place->wlon.l; *y = 0.5*log((1+place->nlat.s)/(1-place->nlat.s)); return(1); } proj mercator(void) { return(Xmercator); } static double ecc = ECC; static int Xspmercator(struct place *place, double *x, double *y) { if(Xmercator(place,x,y) < 0) return(-1); *y += 0.5*ecc*log((1-ecc*place->nlat.s)/(1+ecc*place->nlat.s)); return(1); } proj sp_mercator(void) { return(Xspmercator); } mapproj/src/ccubrt.c0000644000175000017500000000035313615152714014277 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" void ccubrt(double zr, double zi, double *wr, double *wi) { double r, theta; theta = atan2(zi,zr); r = cubrt(hypot(zr,zi)); *wr = r*cos(theta/3); *wi = r*sin(theta/3); } mapproj/src/gilbert.c0000644000175000017500000000234213615152714014445 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" int Xgilbert(struct place *p, double *x, double *y) { /* the interesting part - map the sphere onto a hemisphere */ struct place q; q.nlat.s = tan(0.5*(p->nlat.l)); if(q.nlat.s > 1) q.nlat.s = 1; if(q.nlat.s < -1) q.nlat.s = -1; q.nlat.c = sqrt(1 - q.nlat.s*q.nlat.s); q.wlon.l = p->wlon.l/2; /* RSB sincos(&q.wlon);*/ trig(&q.wlon); /* the dull part: present the hemisphere orthogrpahically */ *y = q.nlat.s; *x = -q.wlon.s*q.nlat.c; return(1); } proj gilbert(void) { return(Xgilbert); } /* derivation of the interesting part: map the sphere onto the plane by stereographic projection; map the plane onto a half plane by sqrt; map the half plane back to the sphere by stereographic projection n,w are original lat and lon r is stereographic radius primes are transformed versions r = cos(n)/(1+sin(n)) r' = sqrt(r) = cos(n')/(1+sin(n')) r'^2 = (1-sin(n')^2)/(1+sin(n')^2) = cos(n)/(1+sin(n)) this is a linear equation for sin n', with solution sin n' = (1+sin(n)-cos(n))/(1+sin(n)+cos(n)) use standard formula: tan x/2 = (1-cos x)/sin x = sin x/(1+cos x) to show that the right side of the last equation is tan(n/2) */ mapproj/src/lune.c0000644000175000017500000000321413615152714013757 0ustar nileshnilesh#include /* RSB #include #include */ #include "map.h" // CRAN change 2012-12-10 #define abort() Rf_error("fatal error in mapproj") int Xstereographic(struct place *place, double *x, double *y); static struct place eastpole; static struct place westpole; static double eastx, easty; static double westx, westy; static double scale; static double pwr; /* conformal map w = ((1+z)^A - (1-z)^A)/((1+z)^A + (1-z)^A), where A<1, maps unit circle onto a convex lune with x= +-1 mapping to vertices of angle A*PI at w = +-1 */ /* there are cuts from E and W poles to S pole, in absence of a cut routine, error is returned for points outside a polar cap through E and W poles */ static int Xlune(struct place *place, double *x, double *y) { double stereox, stereoy; double z1x, z1y, z2x, z2y; double w1x, w1y, w2x, w2y; double numx, numy, denx, deny; if(place->nlat.l < eastpole.nlat.l-FUZZ) return -1; Xstereographic(place, &stereox, &stereoy); stereox *= scale; stereoy *= scale; z1x = 1 + stereox; z1y = stereoy; z2x = 1 - stereox; z2y = -stereoy; map_cpow(z1x,z1y,&w1x,&w1y,pwr); map_cpow(z2x,z2y,&w2x,&w2y,pwr); numx = w1x - w2x; numy = w1y - w2y; denx = w1x + w2x; deny = w1y + w2y; cdiv(numx, numy, denx, deny, x, y); return 1; } proj lune(double lat, double theta) { deg2rad(lat, &eastpole.nlat); deg2rad(-90.,&eastpole.wlon); deg2rad(lat, &westpole.nlat); deg2rad(90. ,&westpole.wlon); Xstereographic(&eastpole, &eastx, &easty); Xstereographic(&westpole, &westx, &westy); if(fabs(easty)>FUZZ || fabs(westy)>FUZZ || fabs(eastx+westx)>FUZZ) abort(); scale = 1/eastx; pwr = theta/180; return Xlune; } mapproj/src/lagrange.c0000644000175000017500000000075013615152714014576 0ustar nileshnilesh/* RSB#include #include */ #include "map.h" static int Xlagrange(struct place *place, double *x, double *y) { double z1,z2; double w1,w2,t1,t2; struct place p; copyplace(place,&p); if(place->nlat.l<0) { p.nlat.l = -p.nlat.l; p.nlat.s = -p.nlat.s; } Xstereographic(&p,&z1,&z2); map_csqrt(-z2/2,z1/2,&w1,&w2);/* RSB*/ cdiv(w1-1,w2,w1+1,w2,&t1,&t2); *y = -t1; *x = t2; if(place->nlat.l<0) *y = -*y; return(1); } proj lagrange(void) { return(Xlagrange); } mapproj/src/simpleconic.c0000644000175000017500000000121513615152714015320 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static double r0, a; static int Xsimpleconic(struct place *place, double *x, double *y) { double r = r0 - place->nlat.l; double t = a*place->wlon.l; *x = -r*sin(t); *y = -r*cos(t); return 1; } proj simpleconic(double par0, double par1) { struct coord lat0; struct coord lat1; deg2rad(par0,&lat0); deg2rad(par1,&lat1); if(fabs(lat0.l+lat1.l)<.01) return rectangular(par0); if(fabs(lat0.l-lat1.l)<.01) { a = lat0.s/lat0.l; r0 = lat0.c/lat0.s + lat0.l; } else { a = (lat1.c-lat0.c)/(lat0.l-lat1.l); r0 = ((lat0.c+lat1.c)/a + lat1.l + lat0.l)/2; } return Xsimpleconic; } mapproj/src/mollweide.c0000644000175000017500000000067013615152714015000 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static int Xmollweide(struct place *place, double *x, double *y) { double z; double w; z = place->nlat.l; if(fabs(z)<89.9*RAD) do { /*newton for 2z+sin2z=pi*sin(lat)*/ w = (2*z+sin(2*z)-PI*place->nlat.s)/(2+2*cos(2*z)); z -= w; } while(fabs(w)>=.00001); *y = sin(z); *x = - (2/PI)*cos(z)*place->wlon.l; return(1); } proj mollweide(void) { return(Xmollweide); } mapproj/src/sinusoidal.c0000644000175000017500000000036413615152714015171 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" int Xsinusoidal(struct place *place, double *x, double *y) { *x = - place->wlon.l * place->nlat.c; *y = place->nlat.l; return(1); } proj sinusoidal(void) { return(Xsinusoidal); } mapproj/src/mapproject.c0000644000175000017500000000727714167507607015205 0ustar nileshnilesh#include "R.h" #include "map.h" #define MIN(a,b) (a)<(b)?(a):(b) #define MAX(a,b) (a)>(b)?(a):(b) #define ABS(x) ((x)<0?-(x):(x)) #define RAD2DEG(x) ((x)*180/PI) #define DEG2RAD(x) ((x)*PI/180) /* must be consistent with map.h in maps library */ #define XMIN 0 #define XMAX 1 #define YMIN 2 #define YMAX 3 static int (*projfun)(); struct index { char *name; proj (*prog)(); int npar; } mapindex[] = { {"mercator", mercator, 0}, {"cylindrical", cylindrical, 0}, {"cylequalarea", cylequalarea, 1}, {"rectangular", rectangular, 1}, {"trapezoidal", trapezoidal, 2}, {"lune",lune,2}, {"gall", gall, 1}, {"sinusoidal", sinusoidal, 0}, {"mollweide", mollweide, 0}, {"gilbert", gilbert, 0}, {"azequidistant", azequidistant, 0}, {"azequalarea", azequalarea, 0}, {"gnomonic", gnomonic, 0}, {"perspective", map_perspective, 1}, {"harrison", harrison, 2}, {"orthographic", orthographic, 0}, {"stereographic", stereographic, 0}, {"laue", laue, 0}, {"fisheye", fisheye, 1}, {"newyorker", newyorker, 1}, {"conic", conic, 1}, {"lambert", lambert, 2}, {"albers", albers, 2}, {"bonne", bonne, 1}, {"polyconic", polyconic, 0}, {"aitoff", aitoff, 0}, {"globular", globular, 0}, {"vandergrinten", vandergrinten, 0}, {"eisenlohr", eisenlohr, 0}, {"guyou",guyou,0}, {"square",square,0}, {"tetra",tetra,0}, {"hex",map_hex,0}, {"lagrange",lagrange,0}, {"bicentric", bicentric, 1}, {"elliptic", elliptic, 1}, {"mecca", mecca, 1}, {"simpleconic", simpleconic, 2}, {"homing", homing, 1}, {"sp_mercator", sp_mercator, 0}, {"sp_albers", sp_albers, 2}, {NULL,NULL,0}, }; void setproj(name, par, n, o, error) char **name, **error; double par[], o[]; int *n; { struct index *i, *theproj = 0; static char errbuf[200]; *error = ""; if(**name == 0) { *error = "Null projection specified"; return; } for(i = mapindex; i->name != 0; i++) { if(strncmp(*name, i->name, strlen(*name)) == 0) { if(theproj) { sprintf(errbuf, "Ambiguous projection specified: %s or %s?", theproj->name, i->name); *error = errbuf; return; } if(*n != i->npar) { sprintf(errbuf, "%s projection requires %d parameter%s", i->name, i->npar, i->npar>1?"s":""); *error = errbuf; return; } if(strcmp(i->name, "bicentric") == 0 || strcmp(i->name, "elliptic") == 0) par[0] = -par[0]; switch(*n) { case 0: projfun = (i->prog)(); break; case 1: projfun = (i->prog)(par[0]); break; case 2: projfun = (i->prog)(par[0], par[1]); break; } theproj = i; } } if(theproj == 0) { sprintf(errbuf, "Unknown projection: %s", *name); *error = errbuf; return; } orient(o[0], -o[1], -o[2]); } static int project(lon, lat, x, y) double lon, lat; double *x, *y; { struct place p; if(projfun == 0) { *x = lon; *y = lat; return(1); } lon = DEG2RAD(lon); lat = DEG2RAD(lat); p.wlon.l = -lon; p.wlon.s = sin(-lon); p.wlon.c = cos(-lon); p.nlat.l = lat; p.nlat.s = sin(lat); p.nlat.c = cos(lat); normalize(&p); return((*projfun)(&p, x, y)); } void doproj(lon, lat, n, range, error) double lon[], lat[], range[]; int *n, *error; { int i, ok; double x, y; *error = 0; range[XMIN] = range[YMIN] = FLT_MAX; range[XMAX] = range[YMAX] = -FLT_MAX; for(i = 0; i < *n; i++, lon++, lat++) { if(ISNA(*lon) || ISNA(*lat)) continue; ok = 1 == project(*lon, *lat, &x, &y); if(!ok || ABS(x) > FLT_MAX || ABS(y) > FLT_MAX) { *error = 1; *lon = NA_REAL; *lat = NA_REAL; } else { *lon = x; *lat = y; range[XMIN] = MIN(range[XMIN], x); range[XMAX] = MAX(range[XMAX], x); range[YMIN] = MIN(range[YMIN], y); range[YMAX] = MAX(range[YMAX], y); } } } mapproj/src/cylequalarea.c0000644000175000017500000000055413615152714015470 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static double a; static int Xcylequalarea(struct place *place, double *x, double *y) { *x = - place->wlon.l * a; *y = place->nlat.s; return(1); } proj cylequalarea(double par) { struct coord stdp0; if(par > 89.0) return(0); deg2rad(par, &stdp0); a = stdp0.c*stdp0.c; return(Xcylequalarea); } mapproj/src/bicentric.c0000644000175000017500000000067613615152714014767 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static struct coord center; static int Xbicentric(struct place *place, double *x, double *y) { if(place->wlon.c<=.01||place->nlat.c<=.01) return(-1); *x = -center.c*place->wlon.s/place->wlon.c; *y = place->nlat.s/(place->nlat.c*place->wlon.c); return(*x**x+*y**y<=9); } proj bicentric(double l) { l = fabs(l); if(l>89) return(0); deg2rad(l,¢er); return(Xbicentric); } mapproj/src/orthographic.c0000644000175000017500000000100213615152714015476 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" int Xorthographic(struct place *place, double *x, double *y) { *x = - place->nlat.c * place->wlon.s; *y = - place->nlat.c * place->wlon.c; return(place->nlat.l<0.? 0 : 1); } proj orthographic(void) { return(Xorthographic); } int olimb(double *lat, double *lon, double res) { static int first = 1; /* RSB */ if(first) { *lat = 0; *lon = -180; first = 0; return 0; } *lon += res; if(*lon <= 180) return 1; first = 1; return -1; } mapproj/src/trapezoidal.c0000644000175000017500000000111313615152714015326 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static struct coord stdpar0, stdpar1; static double k; static double yeq; static int Xtrapezoidal(struct place *place, double *x, double *y) { *y = yeq + place->nlat.l; *x = *y*k*place->wlon.l; return 1; } proj trapezoidal(double par0, double par1) { if(fabs(fabs(par0)-fabs(par1))<.1) return rectangular(par0); deg2rad(par0,&stdpar0); deg2rad(par1,&stdpar1); if(fabs(par1-par0) < .1) k = stdpar1.s; else k = (stdpar1.c-stdpar0.c)/(stdpar0.l-stdpar1.l); yeq = -stdpar1.l - stdpar1.c/k; return Xtrapezoidal; } mapproj/src/azequidist.c0000644000175000017500000000045313615152714015200 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" int Xazequidistant(struct place *place, double *x, double *y) { double colat; colat = PI/2 - place->nlat.l; *x = -colat * place->wlon.s; *y = -colat * place->wlon.c; return(1); } proj azequidistant(void) { return(Xazequidistant); } mapproj/src/laue.c0000644000175000017500000000051713615152714013745 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static int Xlaue(struct place *place, double *x, double *y) { double r; if(place->nlat.lnlat.l); if(r>3) return(-1); *x = - r * place->wlon.s; *y = - r * place->wlon.c; return(1); } proj laue(void) { return(Xlaue); } mapproj/src/lambert.c0000644000175000017500000000244213615152714014444 0ustar nileshnilesh/************************************************************ Copyright (C) 1998, Lucent Technologies All rights reserved ************************************************************/ #include "map.h" static struct coord stdp0, stdp1; static double k; static int Xlambert(struct place *place, double *x, double *y) { double r; if(place->nlat.l < -80.*RAD) return(-1); if(place->nlat.l > 89.*RAD) r = 0; /* slovenly */ else r = stdp0.c*exp(0.5*k*log( (1+stdp0.s)*(1-place->nlat.s)/((1-stdp0.s)*(1+place->nlat.s)))); if(stdp1.l<0.) r = -r; *x = - r*sin(k * place->wlon.l); *y = - r*cos(k * place->wlon.l); return(1); } proj lambert(double par0, double par1) { double temp; if(fabs(par0)>fabs(par1)){ temp = par0; par0 = par1; par1 = temp; } deg2rad(par0, &stdp0); deg2rad(par1, &stdp1); if(fabs(par1+par0)<.1) return(mercator()); if(fabs(par1)>89.5) { if(par0>89.5) return(map_perspective(-1.)); else if(par0<-89.5) return 0; /* S pole stereographic */ else return 0; } if(fabs(par1-par0)<.1) /* series expansion about stdp1.s = stdp0.s */ /* thanks to Alex Deckmyn for pointing this out */ k = stdp0.s + 0.5*(stdp1.s - stdp0.s); else k = 2*log(stdp1.c/stdp0.c)/log( (1+stdp0.s)*(1-stdp1.s)/((1-stdp0.s)*(1+stdp1.s))); return(Xlambert); } mapproj/src/cuts.c0000644000175000017500000000221413615152714013771 0ustar nileshnilesh#include /* RSB #include #include */ #include "map.h" // CRAN change 2012-12-10 //extern void abort(void); #define abort() Rf_error("fatal error in mapproj") /* these routines duplicate names found in map.c. they are called from routines in hex.c, guyou.c, and tetra.c, which are in turn invoked directly from map.c. this bad organization arises from data hiding; only these three files know stuff that's necessary for the proper handling of the unusual cuts involved in these projections. the calling routines are not advertised as part of the library, and the library duplicates should never get loaded, however they are included to make the libary self-standing.*/ /* A Deckmyn 2020-01-31 int picut(struct place *g, struct place *og, double *cutlon) { g; og; cutlon; abort(); return 0; } int ckcut(struct place *g1, struct place *g2, double lon) { g1; g2; lon; abort(); return 0; } */ /* RSB double reduce(double x) { x; abort(); return 0; }*/ /* minka: from map.c */ double reduce(double lon) { if(lon>PI) lon -= 2*PI; else if(lon<-PI) lon += 2*PI; return(lon); } mapproj/src/perspective.c0000644000175000017500000000270613615152714015352 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" #define ORTHRAD 1000 static double viewpt; static int Xperspective(struct place *place, double *x, double *y) { double r; if(viewpt<=1+FUZZ && fabs(place->nlat.s)<=viewpt+.01) return(-1); r = place->nlat.c*(viewpt - 1.)/(viewpt - place->nlat.s); *x = - r*place->wlon.s; *y = - r*place->wlon.c; if(r>4.) return(-1); if(fabs(viewpt)>1 && place->nlat.s<1/viewpt || fabs(viewpt)<=1 && place->nlat.s= ORTHRAD) return(Xorthographic); if(fabs(viewpt-1.)<.0001) return(0); return(Xperspective); } /* called from various conformal projections, but not from stereographic itself */ int Xstereographic(struct place *place, double *x, double *y) { double v = viewpt; int retval; viewpt = -1; retval = Xperspective(place, x, y); viewpt = v; return retval; } proj stereographic(void) { viewpt = -1.; return(Xperspective); } proj gnomonic(void) { viewpt = 0.; return(Xperspective); } int plimb(double *lat, double *lon, double res) { static int first = 1; /* RSB */ if(viewpt >= ORTHRAD) return olimb(lat, lon, res); if(first) { first = 0; *lon = -180; if(fabs(viewpt) < .01) *lat = 0; else if(fabs(viewpt)<=1) *lat = asin(viewpt)/RAD; else *lat = asin(1/viewpt)/RAD; } else *lon += res; if(*lon <= 180) return 1; first = 1; return -1; } mapproj/src/complex.c0000644000175000017500000000311113615152714014457 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" /*complex divide, defensive against overflow from * * and /, but not from + and - * assumes underflow yields 0.0 * uses identities: * (a + bi)/(c + di) = ((a + bd/c) + (b - ad/c)i)/(c + dd/c) * (a + bi)/(c + di) = (b - ai)/(d - ci) */ void cdiv(double a, double b, double c, double d, double *u, double *v) { double r,t; if(fabs(c)=y) { if(x==0) { *e1 = *e2 = 0; return; } r = x; s = y/x; } else { r = y; s = x/y; } r *= sqrt(1+ s*s); if(c1>0) { *e1 = sqrt((r+c1)/2); *e2 = c2/(2* *e1); } else { *e2 = sqrt((r-c1)/2); if(c2<0) *e2 = -*e2; *e1 = c2/(2* *e2); } } void map_cpow(double c1, double c2, double *d1, double *d2, double pwr) { double theta = pwr*atan2(c2,c1); double r = pow(hypot(c1,c2), pwr); *d1 = r*cos(theta); *d2 = r*sin(theta); } mapproj/src/albers.c0000644000175000017500000000455313615152714014273 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" /* For Albers formulas see Deetz and Adams "Elements of Map Projection", */ /* USGS Special Publication No. 68, GPO 1921 */ static double r0sq, r1sq, d2, n, den, sinb1, sinb2; static struct coord plat1, plat2; static int southpole; static double num(double s) { if(d2==0) return(1); s = d2*s*s; return(1+s*(2./3+s*(3./5+s*(4./7+s*5./9)))); } /* Albers projection for a spheroid, good only when N pole is fixed */ static int Xspalbers(struct place *place, double *x, double *y) { double r = sqrt(r0sq-2*(1-d2)*place->nlat.s*num(place->nlat.s)/n); double t = n*place->wlon.l; *y = r*cos(t); *x = -r*sin(t); if(!southpole) *y = -*y; else *x = -*x; return(1); } /* lat1, lat2: std parallels; e2: squared eccentricity */ static proj albinit(double lat1, double lat2, double e2) { double r1; double t; for(;;) { if(lat1 < -90) lat1 = -180 - lat1; if(lat2 > 90) lat2 = 180 - lat2; if(lat1 <= lat2) break; t = lat1; lat1 = lat2; lat2 = t; } if(lat2-lat1 < 1) { if(lat1 > 89) return(azequalarea()); return(0); } if(fabs(lat2+lat1) < 1) return(cylequalarea(lat1)); d2 = e2; den = num(1.); deg2rad(lat1,&plat1); deg2rad(lat2,&plat2); sinb1 = plat1.s*num(plat1.s)/den; sinb2 = plat2.s*num(plat2.s)/den; n = (plat1.c*plat1.c/(1-e2*plat1.s*plat1.s) - plat2.c*plat2.c/(1-e2*plat2.s*plat2.s)) / (2*(1-e2)*den*(sinb2-sinb1)); r1 = plat1.c/(n*sqrt(1-e2*plat1.s*plat1.s)); r1sq = r1*r1; r0sq = r1sq + 2*(1-e2)*den*sinb1/n; southpole = lat1<0 && plat2.c>plat1.c; return(Xspalbers); } proj sp_albers(double lat1, double lat2) { return(albinit(lat1,lat2,EC2)); } proj albers(double lat1, double lat2) { return(albinit(lat1,lat2,0.)); } static double scale = 1; static double twist = 0; void albscale(double x, double y, double lat, double lon) { struct place place; double alat, alon, x1,y1; scale = 1; twist = 0; invalb(x,y,&alat,&alon); twist = lon - alon; deg2rad(lat,&place.nlat); deg2rad(lon,&place.wlon); Xspalbers(&place,&x1,&y1); scale = sqrt((x1*x1+y1*y1)/(x*x+y*y)); } void invalb(double x, double y, double *lat, double *lon) { int i; double sinb_den, sinp; x *= scale; y *= scale; *lon = atan2(-x,fabs(y))/(RAD*n) + twist; sinb_den = (r0sq - x*x - y*y)*n/(2*(1-d2)); sinp = sinb_den; for(i=0; i<5; i++) sinp = sinb_den/num(sinp); *lat = asin(sinp)/RAD; } mapproj/src/harrison.c0000644000175000017500000000131513615152714014641 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static double v3,u2,u3,a,b; /*v=view,p=obj,u=unit.y*/ static int Xharrison(struct place *place, double *x, double *y) { double p1 = -place->nlat.c*place->wlon.s; double p2 = -place->nlat.c*place->wlon.c; double p3 = place->nlat.s; double d = b + u3*p2 - u2*p3; double t; if(d < .01) return -1; t = a/d; if(v3*place->nlat.s < 1.) return -1; *y = t*p2*u2 + (v3-t*(v3-p3))*u3; *x = t*p1; if(t < 0) return 0; if(*x * *x + *y * *y > 16) return -1; return 1; } proj harrison(double r, double alpha) { u2 = cos(alpha*RAD); u3 = sin(alpha*RAD); v3 = r; b = r*u2; a = 1 + b; if(r<1.001 || a #include #include */ #include "map.h" static double cirmod(double); static struct place pole; /* map pole is tilted to here */ static struct coord twist; /* then twisted this much */ static struct place ipole; /* inverse transfrom */ static struct coord itwist; void orient(double lat, double lon, double theta) { lat = cirmod(lat); if(lat>90.) { lat = 180. - lat; lon -= 180.; theta -= 180.; } else if(lat < -90.) { lat = -180. - lat; lon -= 180.; theta -= 180; } latlon(lat,lon,&pole); deg2rad(theta, &twist); latlon(lat,180.-theta,&ipole); deg2rad(180.-lon, &itwist); } void latlon(double lat, double lon, struct place *p) { lat = cirmod(lat); if(lat>90.) { lat = 180. - lat; lon -= 180.; } else if(lat < -90.) { lat = -180. - lat; lon -= 180.; } deg2rad(lat,&p->nlat); deg2rad(lon,&p->wlon); } void deg2rad(double theta, struct coord *coord) { theta = cirmod(theta); coord->l = theta*RAD; if(theta==90) { coord->s = 1; coord->c = 0; } else if(theta== -90) { coord->s = -1; coord->c = 0; } else /* RSB sincos(coord);*/ trig(coord); } static double cirmod(double theta) { while(theta >= 180.) theta -= 360; while(theta<-180.) theta += 360.; return(theta); } void /* RSB sincos(struct coord *coord)*/ trig(struct coord *coord) { coord->s = sin(coord->l); coord->c = cos(coord->l); } void normalize(struct place *gg) { norm(gg,&pole,&twist); } void invert(struct place *g) { norm(g,&ipole,&itwist); } void norm(struct place *gg, struct place *pp, struct coord *tw) { register struct place *g; /*geographic coords */ register struct place *p; /* new pole in old coords*/ struct place m; /* standard map coords*/ g = gg; p = pp; if(p->nlat.s == 1.) { if(p->wlon.l+tw->l == 0.) return; g->wlon.l -= p->wlon.l+tw->l; } else { if(p->wlon.l != 0) { g->wlon.l -= p->wlon.l; /* RSB sincos(&g->wlon);*/ trig(&g->wlon); } m.nlat.s = p->nlat.s * g->nlat.s + p->nlat.c * g->nlat.c * g->wlon.c; m.nlat.c = sqrt(1. - m.nlat.s * m.nlat.s); m.nlat.l = atan2(m.nlat.s, m.nlat.c); m.wlon.s = g->nlat.c * g->wlon.s; m.wlon.c = p->nlat.c * g->nlat.s - p->nlat.s * g->nlat.c * g->wlon.c; m.wlon.l = atan2(m.wlon.s, - m.wlon.c) - tw->l; *g = m; } /* RSB sincos(&g->wlon);*/ trig(&g->wlon); if(g->wlon.l>PI) g->wlon.l -= 2*PI; else if(g->wlon.l<-PI) g->wlon.l += 2*PI; } double tan(double x) { return(sin(x)/cos(x)); } /* void printp(struct place *g) { printf("%.3f %.3f %.3f %.3f %.3f %.3f\n", g->nlat.l,g->nlat.s,g->nlat.c,g->wlon.l,g->wlon.s,g->wlon.c); }*/ void copyplace(struct place *g1, struct place *g2) { *g2 = *g1; } mapproj/src/elco2.c0000644000175000017500000000475613615152714014034 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" /* elliptic integral routine, R.Bulirsch, * Numerische Mathematik 7(1965) 78-90 * calculate integral from 0 to x+iy of * (a+b*t^2)/((1+t^2)*sqrt((1+t^2)*(1+kc^2*t^2))) * yields about D valid figures, where CC=10e-D * for a*b>=0, except at branchpoints x=0,y=+-i,+-i/kc; * there the accuracy may be reduced. * fails for kc=0 or x<0 * return(1) for success, return(0) for fail * * special case a=b=1 is equivalent to * standard elliptic integral of first kind * from 0 to atan(x+iy) of * 1/sqrt(1-k^2*(sin(t))^2) where k^2=1-kc^2 */ #define ROOTINF 10.e18 #define CC 1.e-6 int elco2(double x, double y, double kc, double a, double b, double *u, double *v) { double c,d,dn1,dn2,e,e1,e2,f,f1,f2,h,k,m,m1,m2,sy; double d1[13],d2[13]; int i,l; if(kc==0||x<0) return(0); sy = y>0? 1: y==0? 0: -1; y = fabs(y); csq(x,y,&c,&e2); d = kc*kc; k = 1-d; e1 = 1+c; cdiv2(1+d*c,d*e2,e1,e2,&f1,&f2); f2 = -k*x*y*2/f2; csqr(f1,f2,&dn1,&dn2); if(f1<0) { f1 = dn1; dn1 = -dn2; dn2 = -f1; } if(k<0) { dn1 = fabs(dn1); dn2 = fabs(dn2); } c = 1+dn1; cmul(e1,e2,c,dn2,&f1,&f2); cdiv(x,y,f1,f2,&d1[0],&d2[0]); h = a-b; d = f = m = 1; kc = fabs(kc); e = a; a += b; l = 4; for(i=1;;i++) { m1 = (kc+m)/2; m2 = m1*m1; k *= f/(m2*4); b += e*kc; e = a; cdiv2(kc+m*dn1,m*dn2,c,dn2,&f1,&f2); csqr(f1/m1,k*dn2*2/f2,&dn1,&dn2); cmul(dn1,dn2,x,y,&f1,&f2); x = fabs(f1); y = fabs(f2); a += b/m1; l *= 2; c = 1 +dn1; d *= k/2; cmul(x,y,x,y,&e1,&e2); k *= k; cmul(c,dn2,1+e1*m2,e2*m2,&f1,&f2); cdiv(d*x,d*y,f1,f2,&d1[i],&d2[i]); if(k<=CC) break; kc = sqrt(m*kc); f = m2; m = m1; } f1 = f2 = 0; for(;i>=0;i--) { f1 += d1[i]; f2 += d2[i]; } x *= m1; y *= m1; cdiv2(1-y,x,1+y,-x,&e1,&e2); e2 = x*2/e2; d = a/(m1*l); *u = atan2(e2,e1); if(*u<0) *u += PI; a = d*sy/2; *u = d*(*u) + f1*h; *v = (-1-log(e1*e1+e2*e2))*a + f2*h*sy + a; return(1); } void cdiv2(double c1, double c2, double d1, double d2, double *e1, double *e2) { double t; if(fabs(d2)>fabs(d1)) { t = d1, d1 = d2, d2 = t; t = c1, c1 = c2, c2 = t; } if(fabs(d1)>ROOTINF) *e2 = ROOTINF*ROOTINF; else *e2 = d1*d1 + d2*d2; t = d2/d1; *e1 = (c1+t*c2)/(d1+t*d2); /* (c1*d1+c2*d2)/(d1*d1+d2*d2) */ } /* complex square root of |x|+iy */ void csqr(double c1, double c2, double *e1, double *e2) { double r2; r2 = c1*c1 + c2*c2; if(r2<=0) { *e1 = *e2 = 0; return; } *e1 = sqrt((sqrt(r2) + fabs(c1))/2); *e2 = c2/(*e1*2); } mapproj/src/elliptic.c0000644000175000017500000000117413615152714014624 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" struct coord center; static int Xelliptic(struct place *place, double *x, double *y) { double r1,r2; r1 = acos(place->nlat.c*(place->wlon.c*center.c - place->wlon.s*center.s)); r2 = acos(place->nlat.c*(place->wlon.c*center.c + place->wlon.s*center.s)); *x = -(r1*r1 - r2*r2)/(4*center.l); *y = (r1*r1+r2*r2)/2 - (center.l*center.l+*x**x); if(*y < 0) *y = 0; *y = sqrt(*y); if(place->nlat.l<0) *y = -*y; return(1); } proj elliptic(double l) { l = fabs(l); if(l>89) return(0); if(l<1) return(Xazequidistant); deg2rad(l,¢er); return(Xelliptic); } mapproj/src/tetra.c0000644000175000017500000001157013615152714014137 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" /* * conformal map of earth onto tetrahedron * the stages of mapping are * (a) stereo projection of tetrahedral face onto * isosceles curvilinear triangle with 3 120-degree * angles and one straight side * (b) map of this triangle onto half plane cut along * 3 rays from the roots of unity to infinity * formula (z^4+2*3^.5*z^2-1)/(z^4-2*3^.5*z^2-1) * (c) do 3 times for each sector of plane: * map of |arg z|<=pi/6, cut along z>1 into * triangle |arg z|<=pi/6, Re z<=const, * with upper side of cut going into upper half of * of vertical side of triangle and lowere into lower * formula int from 0 to z dz/sqrt(1-z^3) * * int from u to 1 3^.25*du/sqrt(1-u^3) = F(acos((rt3-1+u)/(rt3+1-u)),sqrt(1/2+rt3/4)) * int from 1 to u 3^.25*du/sqrt(u^3-1) = * F(acos((rt3+1-u)/(rt3-1+u)),sqrt(1/2-rt3/4)) * this latter formula extends analytically down to * u=0 and is the basis of this routine, with the * argument of complex elliptic integral elco2 * being tan(acos...) * the formula F(pi-x,k) = 2*F(pi/2,k)-F(x,k) is * used to cross over into the region where Re(acos...)>pi/2 * f0 and fpi are suitably scaled complete integrals */ #define TFUZZ 0.00001 static struct place tpole[4]; /* point of tangency of tetrahedron face*/ static double tpoleinit[4][2] = { 1., 0., 1., 180., -1., 90., -1., -90. }; static struct tproj { double tlat,tlon; /* center of stereo projection*/ double ttwist; /* rotatn before stereo*/ double trot; /*rotate after projection*/ struct place projpl; /*same as tlat,tlon*/ struct coord projtw; /*same as ttwist*/ struct coord postrot; /*same as trot*/ } tproj[4][4] = { {/*00*/ {0.}, /*01*/ {90., 0., 90., -90.}, /*02*/ {0., 45., -45., 150.}, /*03*/ {0., -45., -135., 30.} }, {/*10*/ {90., 0., -90., 90.}, /*11*/ {0.}, /*12*/ {0., 135., -135., -150.}, /*13*/ {0., -135., -45., -30.} }, {/*20*/ {0., 45., 135., -30.}, /*21*/ {0., 135., 45., -150.}, /*22*/ {0.}, /*23*/ {-90., 0., 180., 90.} }, {/*30*/ {0., -45., 45., -150.}, /*31*/ {0., -135., 135., -30.}, /*32*/ {-90., 0., 0., 90.}, /*33*/ {0.} }}; static double tx[4] = { /*where to move facet after final rotation*/ 0., 0., -1., 1. /*-1,1 to be sqrt(3)*/ }; static double ty[4] = { 0., 2., -1., -1. }; static double root3; static double rt3inv; static double two_rt3; static double tkc,tk,tcon; static double f0r,f0i,fpir,fpii; static void twhichp(struct place *g, int *p, int *q) { int i,j,k; double cosdist[4]; struct place *tp; for(i=0;i<4;i++) { tp = &tpole[i]; cosdist[i] = g->nlat.s*tp->nlat.s + g->nlat.c*tp->nlat.c*( g->wlon.s*tp->wlon.s + g->wlon.c*tp->wlon.c); } j = 0; for(i=1;i<4;i++) if(cosdist[i] > cosdist[j]) j = i; *p = j; k = j==0?1:0; for(i=0;i<4;i++) if(i!=j&&cosdist[i]>cosdist[k]) k = i; *q = k; } int Xtetra(struct place *place, double *x, double *y) { int i,j; struct place pl; register struct tproj *tpp; double vr, vi; double br, bi; double zr,zi,z2r,z2i,z4r,z4i,sr,si,tr,ti; twhichp(place,&i,&j); copyplace(place,&pl); norm(&pl,&tproj[i][j].projpl,&tproj[i][j].projtw); Xstereographic(&pl,&vr,&vi); zr = vr/2; zi = vi/2; if(zr<=TFUZZ) zr = TFUZZ; csq(zr,zi,&z2r,&z2i); csq(z2r,z2i,&z4r,&z4i); z2r *= two_rt3; z2i *= two_rt3; cdiv(z4r+z2r-1,z4i+z2i,z4r-z2r-1,z4i-z2i,&sr,&si); map_csqrt(sr-1,si,&tr,&ti); cdiv(tcon*tr,tcon*ti,root3+1-sr,-si,&br,&bi); if(br<0) { br = -br; bi = -bi; if(!elco2(br,bi,tk,1.,1.,&vr,&vi)) return 0; vr = fpir - vr; vi = fpii - vi; } else if(!elco2(br,bi,tk,1.,1.,&vr,&vi)) return 0; if(si>=0) { tr = f0r - vi; ti = f0i + vr; } else { tr = f0r + vi; ti = f0i - vr; } tpp = &tproj[i][j]; *x = tr*tpp->postrot.c + ti*tpp->postrot.s + tx[i]; *y = ti*tpp->postrot.c - tr*tpp->postrot.s + ty[i]; return(1); } /* ADeckmyn int tetracut(struct place *g, struct place *og, double *cutlon) { int i,j,k; if((g->nlat.s<=-rt3inv&&og->nlat.s<=-rt3inv) && (ckcut(g,og,*cutlon=0.)==2||ckcut(g,og,*cutlon=PI)==2)) return(2); twhichp(g,&i,&k); twhichp(og,&j,&k); if(i==j||i==0||j==0) return(1); return(0); } */ proj tetra(void) { register int i; /* RSB */ int j; register struct place *tp; register struct tproj *tpp; double t; root3 = sqrt(3.); rt3inv = 1/root3; two_rt3 = 2*root3; tkc = sqrt(.5-.25*root3); tk = sqrt(.5+.25*root3); tcon = 2*sqrt(root3); elco2(tcon/(root3-1),0.,tkc,1.,1.,&f0r,&f0i); elco2(1.e15,0.,tk,1.,1.,&fpir,&fpii); fpir *= 2; fpii *= 2; for(i=0;i<4;i++) { tx[i] *= f0r*root3; ty[i] *= f0r; tp = &tpole[i]; t = tp->nlat.s = tpoleinit[i][0]/root3; tp->nlat.c = sqrt(1 - t*t); tp->nlat.l = atan2(tp->nlat.s,tp->nlat.c); deg2rad(tpoleinit[i][1],&tp->wlon); for(j=0;j<4;j++) { tpp = &tproj[i][j]; latlon(tpp->tlat,tpp->tlon,&tpp->projpl); deg2rad(tpp->ttwist,&tpp->projtw); deg2rad(tpp->trot,&tpp->postrot); } } return(Xtetra); } mapproj/src/hex.c0000644000175000017500000000456613615152714013613 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" #define BIG 1.e15 #define HFUZZ .0001 static double hcut[3] ; static double kr[3] = { .5, -1., .5 }; static double ki[3] = { -1., 0., 1. }; /*to multiply by sqrt(3)/2*/ static double cr[3]; static double ci[3]; static struct place hem; static struct coord twist; static double rootroot3, hkc; static double w2; static double rootk; static void reflect(int i, double wr, double wi, double *x, double *y) { double pr,pi,l; pr = cr[i]-wr; pi = ci[i]-wi; l = 2*(kr[i]*pr + ki[i]*pi); *x = wr + l*kr[i]; *y = wi + l*ki[i]; } static int Xhex(struct place *place, double *x, double *y) { int ns; register int i;/* RSB */ double zr,zi; double sr,si,tr,ti,ur,ui,vr,vi,yr,yi; struct place p; copyplace(place,&p); ns = place->nlat.l >= 0; if(!ns) { p.nlat.l = -p.nlat.l; p.nlat.s = -p.nlat.s; } if(p.nlat.lplace->wlon.l?0: hcut[1]>=place->wlon.l?1: 2,*x,*y,x,y); return(1); } proj map_hex(void)/* RSB */ { register int i;/* RSB */ double t; double root3; double c,d; struct place p; hcut[2] = PI; hcut[1] = hcut[2]/3; hcut[0] = -hcut[1]; root3 = sqrt(3.); rootroot3 = sqrt(root3); t = 15 -8*root3; hkc = t*(1-sqrt(1-1/(t*t))); elco2(BIG,0.,hkc,1.,1.,&w2,&t); w2 *= 2; rootk = sqrt(hkc); latlon(90.,90.,&hem); latlon(90.,0.,&p); Xhex(&p,&c,&t); latlon(0.,0.,&p); Xhex(&p,&d,&t); for(i=0;i<3;i++) { ki[i] *= root3/2; cr[i] = c + (c-d)*kr[i]; ci[i] = (c-d)*ki[i]; } deg2rad(0.,&twist); return(Xhex); } /* ADeckmyn int hexcut(struct place *g, struct place *og, double *cutlon) { int t,i; if(g->nlat.l>=-HFUZZ&&og->nlat.l>=-HFUZZ) return(1); for(i=0;i<3;i++) { t = ckcut(g,og,*cutlon=hcut[i]); if(t!=1) return(t); } return(1); } */ mapproj/src/conic.c0000644000175000017500000000077113615152714014114 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static struct coord stdpar; static int Xconic(struct place *place, double *x, double *y) { double r; if(fabs(place->nlat.l-stdpar.l) > 80.*RAD) return(-1); r = stdpar.c/stdpar.s - tan(place->nlat.l - stdpar.l); *x = - r*sin(place->wlon.l * stdpar.s); *y = - r*cos(place->wlon.l * stdpar.s); if(r>3) return(0); return(1); } proj conic(double par) { if(fabs(par) <.1) return(Xcylindrical); deg2rad(par, &stdpar); return(Xconic); } mapproj/src/rectangular.c0000644000175000017500000000050013615152714015316 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static double scale; static int Xrectangular(struct place *place, double *x, double *y) { *x = -scale*place->wlon.l; *y = place->nlat.l; return(1); } proj rectangular(double par) { scale = cos(par*RAD); if(scale<.1) return 0; return(Xrectangular); } mapproj/src/twocirc.c0000644000175000017500000000322513615152714014470 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static double quadratic(double a, double b, double c) { double disc = b*b - 4*a*c; return disc<0? 0: (-b-sqrt(disc))/(2*a); } /* for projections with meridians being circles centered on the x axis and parallels being circles centered on the y axis. Find the intersection of the meridian thru (m,0), (90,0), with the parallel thru (0,p), (p1,p2) */ static int twocircles(double m, double p, double p1, double p2, double *x, double *y) { double a; /* center of meridian circle, a>0 */ double b; /* center of parallel circle, b>0 */ double t,bb; if(m > 0) { twocircles(-m,p,p1,p2,x,y); *x = -*x; } else if(p < 0) { twocircles(m,-p,p1,-p2,x,y); *y = -*y; } else if(p < .01) { *x = m; t = m/p1; *y = p + (p2-p)*t*t; } else if(m > -.01) { *y = p; *x = m - m*p*p; } else { b = p>=1? 1: p>.99? 0.5*(p+1 + p1*p1/(1-p)): 0.5*(p*p-p1*p1-p2*p2)/(p-p2); a = .5*(m - 1/m); t = m*m-p*p+2*(b*p-a*m); bb = b*b; *x = quadratic(1+a*a/bb, -2*a + a*t/bb, t*t/(4*bb) - m*m + 2*a*m); *y = (*x*a+t/2)/b; } return 1; } static int Xglobular(struct place *place, double *x, double *y) { twocircles(-2*place->wlon.l/PI, 2*place->nlat.l/PI, place->nlat.c, place->nlat.s, x, y); return 1; } proj globular(void) { return Xglobular; } static int Xvandergrinten(struct place *place, double *x, double *y) { double t = 2*place->nlat.l/PI; double abst = fabs(t); double pval = abst>=1? 1: abst/(1+sqrt(1-t*t)); double p2 = 2*pval/(1+pval); twocircles(-place->wlon.l/PI, pval, sqrt(1-p2*p2), p2, x, y); if(t < 0) *y = -*y; return 1; } proj vandergrinten(void) { return Xvandergrinten; } mapproj/src/gall.c0000644000175000017500000000101113615152714013724 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static double scale; static int Xgall(struct place *place, double *x, double *y) { /* two ways to compute tan(place->nlat.l/2) */ if(fabs(place->nlat.s)<.1) *y = sin(place->nlat.l/2)/cos(place->nlat.l/2); else *y = (1-place->nlat.c)/place->nlat.s; *x = -scale*place->wlon.l; return 1; } proj gall(double par) { double coshalf; if(fabs(par)>80) return 0; par *= RAD; coshalf = cos(par/2); scale = cos(par)/(2*coshalf*coshalf); return Xgall; } mapproj/src/aitoff.c0000644000175000017500000000066513615152714014273 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" #define Xaitwist Xaitpole.nlat static struct place Xaitpole; static int Xaitoff(struct place *place, double *x, double *y) { struct place p; copyplace(place,&p); p.wlon.l /= 2.; /* RSB sincos(&p.wlon);*/ trig(&p.wlon); norm(&p,&Xaitpole,&Xaitwist); Xazequalarea(&p,x,y); *x *= 2.; return(1); } proj aitoff(void) { latlon(0.,0.,&Xaitpole); return(Xaitoff); } mapproj/src/homing.c0000644000175000017500000000406613615152714014303 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static struct coord p0; /* standard parallel */ int first; static double trigclamp(double x) { return x>1? 1: x<-1? -1: x; } static struct coord az; /* azimuth of p0 seen from place */ static struct coord rad; /* angular dist from place to p0 */ static int azimuth(struct place *place) { if(place->nlat.c < FUZZ) { az.l = PI/2 + place->nlat.l - place->wlon.l; /* RSB sincos(&az);*/ trig(&az); rad.l = fabs(place->nlat.l - p0.l); if(rad.l > PI) rad.l = 2*PI - rad.l; /* RSB sincos(&rad);*/ trig(&rad); return 1; } rad.c = trigclamp(p0.s*place->nlat.s + /* law of cosines */ p0.c*place->nlat.c*place->wlon.c); rad.s = sqrt(1 - rad.c*rad.c); if(fabs(rad.s) < .001) { az.s = 0; az.c = 1; } else { az.s = trigclamp(p0.c*place->wlon.s/rad.s); /* sines */ az.c = trigclamp((p0.s - rad.c*place->nlat.s) /(rad.s*place->nlat.c)); } rad.l = atan2(rad.s, rad.c); return 1; } static int Xmecca(struct place *place, double *x, double *y) { if(!azimuth(place)) return 0; *x = -place->wlon.l; *y = fabs(az.s)<.02? -az.c*rad.s/p0.c: *x*az.c/az.s; return fabs(*y)>2? -1: rad.c<0? 0: 1; } proj mecca(double par) { first = 1; if(fabs(par)>80.) return(0); deg2rad(par,&p0); return(Xmecca); } static int Xhoming(struct place *place, double *x, double *y) { if(!azimuth(place)) return 0; *x = -rad.l*az.s; *y = -rad.l*az.c; return place->wlon.c<0? 0: 1; } proj homing(double par) { first = 1; if(fabs(par)>80.) return(0); deg2rad(par,&p0); return(Xhoming); } int hlimb(double *lat, double *lon, double res) { if(first) { *lon = -90; *lat = -90; first = 0; return 0; } *lat += res; if(*lat <= 90) return 1; if(*lon == 90) return -1; *lon = 90; *lat = -90; return 0; } int mlimb(double *lat, double *lon, double res) { int ret = !first; if(fabs(p0.s) < .01) return -1; if(first) { *lon = -180; first = 0; } else *lon += res; if(*lon > 180) return -1; *lat = atan(-cos(*lon*RAD)/p0.s*p0.c)/RAD; return ret; } mapproj/src/guyou.c0000644000175000017500000000336013615152714014166 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static struct place gywhem, gyehem; static struct coord gytwist; static double gyconst, gykc, gyside; static void dosquare(double z1, double z2, double *x, double *y) { double w1,w2; w1 = z1 -1; if(fabs(w1*w1+z2*z2)>.000001) { cdiv(z1+1,z2,w1,z2,&w1,&w2); w1 *= gyconst; w2 *= gyconst; if(w1<0) w1 = 0; elco2(w1,w2,gykc,1.,1.,x,y); } else { *x = gyside; *y = 0; } } int Xguyou(struct place *place, double *x, double *y) { int ew; /*which hemisphere*/ double z1,z2; struct place pl; ew = place->wlon.l<0; copyplace(place,&pl); norm(&pl,ew?&gyehem:&gywhem,&gytwist); Xstereographic(&pl,&z1,&z2); dosquare(z1/2,z2/2,x,y); if(!ew) *x -= gyside; return(1); } proj guyou(void) { double junk; gykc = 1/(3+2*sqrt(2.)); gyconst = -(1+sqrt(2.)); elco2(-gyconst,0.,gykc,1.,1.,&gyside,&junk); gyside *= 2; latlon(0.,90.,&gywhem); latlon(0.,-90.,&gyehem); deg2rad(0.,&gytwist); return(Xguyou); } /* ADeckmyn int guycut(struct place *g, struct place *og, double *cutlon) { int c; c = picut(g,og,cutlon); if(c!=1) return(c); *cutlon = 0.; if(g->nlat.c<.7071||og->nlat.c<.7071) return(ckcut(g,og,0.)); return(1); } */ static int Xsquare(struct place *place, double *x, double *y) { double z1,z2; double r, theta; struct place p; copyplace(place,&p); if(place->nlat.l<0) { p.nlat.l = -p.nlat.l; p.nlat.s = -p.nlat.s; } if(p.nlat.lPI-FUZZ){ *y = -gyside/2; *x = p.wlon.l>0?0:gyside; return(1); } Xstereographic(&p,&z1,&z2); r = sqrt(sqrt(hypot(z1,z2)/2)); theta = atan2(z1,-z2)/4; dosquare(r*sin(theta),-r*cos(theta),x,y); if(place->nlat.l<0) *y = -gyside - *y; return(1); } proj square(void) { guyou(); return(Xsquare); } mapproj/src/bonne.c0000644000175000017500000000125413615152714014117 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" static struct coord stdpar; static double r0; static int /* RSB */ Xbonne(struct place *place, double *x, double *y) { double r, alpha; r = r0 - place->nlat.l; if(r<.001) if(fabs(stdpar.c)<1e-10) alpha = place->wlon.l; else if(fabs(place->nlat.c)==0) alpha = 0; else alpha = place->wlon.l/(1+ stdpar.c*stdpar.c*stdpar.c/place->nlat.c/3); else alpha = place->wlon.l * place->nlat.c / r; *x = - r*sin(alpha); *y = - r*cos(alpha); return(1); } proj bonne(double par) { if(fabs(par*RAD) < .01) return(Xsinusoidal); deg2rad(par, &stdpar); r0 = stdpar.c/stdpar.s + stdpar.l; return(Xbonne); } mapproj/src/init.c0000644000175000017500000000075713615152714013770 0ustar nileshnilesh#include #include /* .C calls */ extern void doproj(void *, void *, void *, void *, void *); extern void setproj(void *, void *, void *, void *, void *); static const R_CMethodDef CEntries[] = { {"doproj", (DL_FUNC) &doproj, 5}, {"setproj", (DL_FUNC) &setproj, 5}, {NULL, NULL, 0} }; void R_init_mapproj(DllInfo *dll) { R_registerRoutines(dll, CEntries, NULL, NULL, NULL); R_useDynamicSymbols(dll, FALSE); R_forceSymbols(dll, TRUE); } mapproj/src/fisheye.c0000644000175000017500000000064013615152714014450 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" /* refractive fisheye, not logarithmic */ static double n; static int Xfisheye(struct place *place, double *x, double *y) { double r; double u = sin(PI/4-place->nlat.l/2)/n; if(fabs(u) > .97) return -1; r = tan(asin(u)); *x = -r*place->wlon.s; *y = -r*place->wlon.c; return 1; } proj fisheye(double par) { n = par; return n<.1? 0: Xfisheye; } mapproj/src/eisenlohr.c0000644000175000017500000000074113615152714015006 0ustar nileshnilesh#include "map.h" int Xeisenlohr(struct place *p, double *x, double *y) { double s1 = -sin(p->wlon.l/2); double c1 = cos(p->wlon.l/2); double s2 = sin(p->nlat.l/2); double c2 = cos(p->nlat.l/2); double t = s2/(c2+sqrt(2*p->nlat.c)*c1); double c = sqrt(2/(1+t*t)); double q = sqrt(p->nlat.c/2); double v = sqrt((c2+q*(c1+s1))/(c2+q*(c1-s1))); double vi = 1/v; *x = -2*log(v) + c*(v-vi); *y = -2*atan(t) + c*t*(v+vi); return 1; } proj eisenlohr() { return Xeisenlohr; } mapproj/src/Makevars.debug0000644000175000017500000000007113615152714015427 0ustar nileshnileshPKG_CFLAGS = -Wall -pedantic -D__USE_GNU -D__USE_ISOC99 mapproj/src/azequalarea.c0000644000175000017500000000043313615152714015307 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" int Xazequalarea(struct place *place, double *x, double *y) { double r; r = sqrt(1. - place->nlat.s); *x = - r * place->wlon.s; *y = - r * place->wlon.c; return(1); } proj azequalarea(void) { return(Xazequalarea); } mapproj/src/polyconic.c0000644000175000017500000000112113615152714015006 0ustar nileshnilesh/* RSB #include #include */ #include "map.h" int Xpolyconic(struct place *place, double *x, double *y) { double r, alpha; double lat2, lon2; if(fabs(place->nlat.l) > .01) { r = place->nlat.c / place->nlat.s; alpha = place->wlon.l * place->nlat.s; *y = place->nlat.l + r*(1 - cos(alpha)); *x = - r*sin(alpha); } else { lon2 = place->wlon.l * place->wlon.l; lat2 = place->nlat.l * place->nlat.l; *y = place->nlat.l * (1+(lon2/2)*(1-(8+lon2)*lat2/12)); *x = - place->wlon.l * (1-lat2*(3+lon2)/6); } return(1); } proj polyconic(void) { return(Xpolyconic); } mapproj/LICENSE.note0000644000175000017500000000142313615152714014032 0ustar nileshnileshThis package is distributed under the Lucent Public License Version 1.02. 1. C code Source code for maps and map projections, included in the Plan 9 distribution at: http://plan9.bell-labs.com/plan9/download.html (sys/src/cmd/map/), downloaded November 1, 2009 by Roger Bivand. Copyrighted and licensed by Lucent Technologies Inc., see http://plan9.bell-labs.com/plan9dist/license.html. All changes marked to satisfy requirement 3 C. The statement: Copyright (C) 2003, Lucent Technologies Inc. and others. All Rights Reserved. is included in file map.h to satisfy requirement 3 B. 2. R interface: The R interface code has been developed as work based on the Lucent Public License Version 1.02 licensed code. It is made available under both the Plan 9 license and GPL (>= 2). mapproj/R/0000755000175000017500000000000013616274127012266 5ustar nileshnileshmapproj/R/mapproj.r0000644000175000017500000000751413616274127014130 0ustar nileshnilesh".Last.projection"<- local({ val <- list(projection = "", parameters = NULL, orientation = NULL) function(new) if(!missing(new)) val <<- new else val }) "mapproject"<- function(x, y, projection = "", parameters = NULL, orientation = NULL) { # minka: cleaned up handling of defaults r <- NULL # LY: change test for list so that x$x format not applied to vector #if(!is.null(x$x)) { if (is.list(x)) { r <- x$range[1:2] y <- x$y x <- x$x } if (length(x) != length(y)) stop("lengths of x and y must match") if (is.null(r)) r <- range(x[!is.na(x)]) new.projection <- (projection != "") if (new.projection) { if (is.null(orientation)) orientation = c(90, 0, mean(r)) else if (length(orientation) != 3) stop("orientation argument must have 3 elements") } else { if (nchar(.Last.projection()$projection) == 0) { #stop("no previous projection") return(list(x = x, y = y)) } p <- .Last.projection() projection <- p$projection if (is.null(parameters)) parameters <- p$parameters else if (length(parameters) != length(p$parameters)) stop(paste("expecting", length(p$parameters), "parameters for", projection, "projection")) if (is.null(orientation)) orientation <- p$orientation else if (length(orientation) != 3) stop("orientation argument must have 3 elements") } error <- .C(C_setproj, as.character(projection), as.double(parameters), as.integer(length(parameters)), as.double(orientation), error = character(1))$error if (error != "") stop(error) .Last.projection(list(projection = projection, parameters = parameters, orientation = orientation)) .C(C_doproj, x = as.double(x), y = as.double(y), as.integer(length(x)), range = double(4), error = integer(1), NAOK = TRUE)[c("x", "y", "range", "error")] } map.grid <- function(lim, nx = 9, ny = 9, labels = TRUE, pretty = TRUE, cex = 1, col = 4, lty = 2, font = 2, ...) { # uses map.wrap from maps package pretty.range <- function(lim, ...) { # like pretty but ensures that the range is identical: # range(pretty.range(x)) == range(x) x <- pretty(lim, ...) if (abs(x[1]-lim[1]) > abs(x[2]-lim[1])) x <- x[-1] n <- length(x) if (abs(x[n]-lim[2]) > abs(x[n-1]-lim[2])) x <- x[-n] x[1] <- lim[1]; x[length(x)] <- lim[2] x } auto.format <- function(x) { # use the minimal number of digits to make x's unique # similar to abbrev for (digits in 0:6) { s <- formatC(x, digits = digits, format = "f") if (all(duplicated(s) == duplicated(x))) break } s } # by default, use limits of last map if (missing(lim)) lim = .map.range() if (is.list(lim)) { # first argument is a map lim <- lim$range } if (lim[2]-lim[1] > 360) { lim[2] <- lim[1] + 360 } if (pretty) { x <- pretty.range(lim[1:2], n = nx) y <- pretty.range(lim[3:4], n = ny) } else { x <- seq(lim[1], lim[2], length.out = nx) y <- seq(lim[3], lim[4], length.out = ny) } p <- mapproject(expand.grid(x = c(seq(lim[1], lim[2], length.out = 100), NA), y = y)) p <- maps::map.wrap(p) lines(p, col = col, lty = lty, ...) lines(mapproject(expand.grid(y = c(seq(lim[3], lim[4], length.out = 100), NA), x = x)), col = col, lty = lty, ...) if (labels) { tx <- x[2] xinc <- median(diff(x)) ty <- y[length(y)-2] yinc <- median(diff(y)) text(mapproject(expand.grid(x = x + xinc*0.05, y = ty + yinc*0.5)), labels = auto.format(x), cex = cex, adj = c(0, 0), col = col, font=font, ...) text(mapproject(expand.grid(x = tx + xinc*0.5, y = y + yinc*0.05)), labels = auto.format(y), cex = cex, adj = c(0, 0), col = col, font=font, ...) } } mapproj/NAMESPACE0000644000175000017500000000033113615152714013275 0ustar nileshnileshuseDynLib("mapproj", .registration=TRUE, .fixes="C_") importFrom("maps", "map.wrap", ".map.range") importFrom("graphics", "lines", "text") importFrom("stats", "median") export(map.grid, mapproject, .Last.projection)