mapproj/0000755000175100001440000000000012557635736011763 5ustar hornikusersmapproj/src/0000755000175100001440000000000012061445766012542 5ustar hornikusersmapproj/src/tetra.c0000744000175100001440000001155312557624474014040 0ustar hornikusers/* 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); } 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/newyorker.c0000744000175100001440000000064212557624474014743 0ustar hornikusers/* 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/homing.c0000744000175100001440000000406612557624474014203 0ustar hornikusers/* 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/fisheye.c0000744000175100001440000000064012557624474014350 0ustar hornikusers/* 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/conic.c0000744000175100001440000000077112557624474014014 0ustar hornikusers/* 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/bonne.c0000744000175100001440000000125412557624474014017 0ustar hornikusers/* 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/polyconic.c0000744000175100001440000000112112557624474014706 0ustar hornikusers/* 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/src/laue.c0000744000175100001440000000051712557624474013645 0ustar hornikusers/* 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/gilbert.c0000744000175100001440000000234212557624474014345 0ustar hornikusers/* 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/lambert.c0000644000175100001440000000244212557624474014343 0ustar hornikusers/************************************************************ 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/lagrange.c0000744000175100001440000000075012557624474014476 0ustar hornikusers/* 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/perspective.c0000744000175100001440000000270612557624474015252 0ustar hornikusers/* 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/aitoff.c0000744000175100001440000000066512557624474014173 0ustar hornikusers/* 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/complex.c0000744000175100001440000000311112557624474014357 0ustar hornikusers/* 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/elliptic.c0000744000175100001440000000117412557624474014524 0ustar hornikusers/* 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/simpleconic.c0000744000175100001440000000121512557624474015220 0ustar hornikusers/* 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/rectangular.c0000744000175100001440000000050012557624474015216 0ustar hornikusers/* 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/cylequalarea.c0000744000175100001440000000055412557624474015370 0ustar hornikusers/* 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/mollweide.c0000744000175100001440000000067012557624474014700 0ustar hornikusers/* 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/azequidist.c0000744000175100001440000000045312557624474015100 0ustar hornikusers/* 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/lune.c0000744000175100001440000000321112557624474013654 0ustar hornikusers#include /* RSB #include #include */ #include "map.h" // CRAN change 2012-12-10 #define abort() 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/hex.c0000744000175100001440000000455012557624474013504 0ustar hornikusers/* 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); } 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/mapproject.c0000744000175100001440000000731712557624474015070 0ustar hornikusers#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] = SINGLE_XMAX; range[XMAX] = range[YMAX] = -SINGLE_XMAX; 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) > SINGLE_XMAX || ABS(y) > SINGLE_XMAX) { *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/eisenlohr.c0000744000175100001440000000074112557624474014706 0ustar hornikusers#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.debug0000744000175100001440000000007107746356516015332 0ustar hornikusersPKG_CFLAGS = -Wall -pedantic -D__USE_GNU -D__USE_ISOC99 mapproj/src/harrison.c0000744000175100001440000000131512557624474014541 0ustar hornikusers/* 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 "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/trapezoidal.c0000744000175100001440000000111312557624474015226 0ustar hornikusers/* 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/sinusoidal.c0000744000175100001440000000036412557624474015071 0ustar hornikusers/* 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/map.h0000744000175100001440000001165612557624474013507 0ustar hornikusers/* 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); int guycut(struct place *, struct place *, double *); int Xguyou(struct place *, double *, double *); proj guyou(void); proj harrison(double, double); 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 *); 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 *); int picut(struct place *, struct place *, double *); 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/bicentric.c0000744000175100001440000000067612557624474014667 0ustar hornikusers/* 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/cylindrical.c0000744000175100001440000000045012557624474015210 0ustar hornikusers/* 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/cuts.c0000744000175100001440000000215512557624474013675 0ustar hornikusers#include /* RSB #include #include */ #include "map.h" // CRAN change 2012-12-10 //extern void abort(void); #define abort() 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.*/ 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/albers.c0000744000175100001440000000454712557624474014176 0ustar hornikusers/* 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 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/orthographic.c0000744000175100001440000000100212557624474015376 0ustar hornikusers/* 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/zcoord.c0000744000175100001440000000516712557624474014225 0ustar hornikusers/* RSB #include #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/gall.c0000744000175100001440000000101112557624474013624 0ustar hornikusers/* 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/guyou.c0000744000175100001440000000334312557624474014067 0ustar hornikusers/* 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); } 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/mercator.c0000744000175100001440000000110012557624474014520 0ustar hornikusers/* 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/azequalarea.c0000744000175100001440000000043312557624474015207 0ustar hornikusers/* 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/elco2.c0000744000175100001440000000475612557624474013734 0ustar hornikusers/* 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/cubrt.c0000744000175100001440000000052212557624474014032 0ustar hornikusers/* 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/ccubrt.c0000744000175100001440000000035312557624474014177 0ustar hornikusers/* 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/NAMESPACE0000644000175100001440000000027012547306277013173 0ustar hornikusersuseDynLib("mapproj") importFrom("maps", "map.wrap", ".map.range") importFrom("graphics", "lines", "text") importFrom("stats", "median") export(map.grid, mapproject, .Last.projection) mapproj/R/0000755000175100001440000000000012061453111012133 5ustar hornikusersmapproj/R/mapproj.r0000744000175100001440000000765612547306357014027 0ustar hornikusers".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("setproj", as.character(projection), as.double(parameters), as.integer(length(parameters)), as.double(orientation), error = character(1), PACKAGE = "mapproj")$error if(error != "") stop(error) .Last.projection(list(projection = projection, parameters = parameters, orientation = orientation)) .C("doproj", x = as.double(x), y = as.double(y), as.integer(length(x)), range = double(4), error = integer(1), NAOK = TRUE, PACKAGE = "mapproj")[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], len = nx) y <- seq(lim[3], lim[4], len = ny) } p = mapproject(expand.grid(x = c(seq(lim[1], lim[2], len = 100), NA), y = y)) p = map.wrap(p) lines(p, col = col, lty = lty, ...) lines(mapproject(expand.grid(y = c(seq(lim[3], lim[4], len = 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/MD50000644000175100001440000000450612557635736012300 0ustar hornikusers811a774f6cf9db1499b741977f06ca9c *DESCRIPTION a66243f26e992c2e09d44b07c8617243 *LICENSE.note 9ef1d82ebae14331d0c16e6db465e422 *NAMESPACE 02ba9c7c2134d825bfc288ac3ea83b56 *R/mapproj.r 774a5e45c7620829cb08e6b3664d2e02 *man/map.grid.Rd 1fcc23d01eee11a5bc21a4283ca5a410 *man/mapproject.Rd 1e220fbd9ec36780a036ddc43a17ef08 *src/Makevars.debug 963422f3661a1419150ea314b5b3a4c5 *src/aitoff.c 4cad728b0ed706ee2002f3d977647d27 *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 e6951853f5a5dcafc7cc57dbf01277f1 *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 0e24b313e28539a09403b948e3d44cca *src/guyou.c 1d97c7dc429901e3ad46c92d23f54d72 *src/harrison.c b130df782ad891ab0e13af5c6f5e573e *src/hex.c abdfb7e8c7a3d223af25745ea39283d3 *src/homing.c 3883049518bbc60de9af2394649203ca *src/lagrange.c 68a3f00baa9ede46c13de50351b3aec5 *src/lambert.c 270fec0e947e395e1ac74950d4cee39c *src/laue.c 6073a029d500a0b7c69c2bc6c7eed9bd *src/lune.c fa9e51aea2a9c9f2a4b8489e2e4ad052 *src/map.h 38950e1951a6f2e28dc46fdcbe3ec473 *src/mapproject.c c9cb7e5d306dea81a01e7aa5de4d18df *src/mercator.c 1aa54f763ad4839773e6ea12ce926fbc *src/mollweide.c ebf89710c52f2558a03dd08afaa13b1c *src/newyorker.c cdfa10318e2136f419986069a0f5d5f4 *src/orthographic.c 6120ddf84594040daf2459b020acbe54 *src/perspective.c 0e0ec545cb2dddcab20c826d402345ab *src/polyconic.c 7506438efb2210f480446aacba052164 *src/rectangular.c a2b7e53517cbd01e2beafc89f91bc774 *src/simpleconic.c 6e15d2d163e9fec33cb3313480f032e3 *src/sinusoidal.c 638ff48404e1c396b3ed0069d405558f *src/tetra.c a3099bccdbab035c3ec6fa12e790eba2 *src/trapezoidal.c abeb12aaff9af6ad10cb0c9b10b51c59 *src/twocirc.c 9e3be978e17cacfebd95156beaef3149 *src/zcoord.c mapproj/DESCRIPTION0000744000175100001440000000100612557635736013467 0ustar hornikusersPackage: mapproj Title: Map Projections Version: 1.2-4 Date: 2015-08-02 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: maps (>= 2.3-0) Imports: stats, graphics License: Lucent Public License Maintainer: Alex Deckmyn NeedsCompilation: yes Packaged: 2015-08-03 08:41:32 UTC; alex Repository: CRAN Date/Publication: 2015-08-03 12:01:02 mapproj/LICENSE.note0000644000175100001440000000142312061311541013703 0ustar hornikusersThis 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/man/0000755000175100001440000000000011514777402012523 5ustar hornikusersmapproj/man/mapproject.Rd0000744000175100001440000002460112547070013015151 0ustar hornikusers\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{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/man/map.grid.Rd0000744000175100001440000000426212547073272014521 0ustar hornikusers\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}