gmaps/0000755000175100001440000000000011511141535011374 5ustar hornikusersgmaps/man/0000755000175100001440000000000011511141535012147 5ustar hornikusersgmaps/man/gradientLegendGrob.Rd0000644000175100001440000000314710757362232016203 0ustar hornikusers\name{gradientLegendGrob} \alias{gradientLegendGrob} \alias{grid.gradientLegendGrob} \alias{widthDetails.gradientLegendGrob} \alias{heightDetails.gradientLegendGrob} \title{Gradient Legend Grobs} \description{ gradientLegendGrob creates a gradient legend grid graphics object. } \usage{ gradientLegendGrob<-function( at=seq(0,1,length=5), axis.min=min(at), axis.max=max(at), labels=as.character(at), col.fun=grey, delta=.01, vertical=F, reverse=F, name=NULL, gp=NULL, vp=NULL, ...) grid.gradientLegendGrob(...) widthDetails.gradientLegendGrob(x) heightDetails.gradientLegendGrob(x) } \arguments{ \item{at}{where to place tick marks.} \item{axis.min}{To specify the axis minimun.} \item{axis.max}{To specify the axis maximum.} \item{labels}{specifies specific labels for tick marks.} \item{col.fun}{function to specify gradient.} \item{delta}{defines level of precision of gradient, smaller is a finer gradient} \item{vertical}{controls orientation False implies a horizontal orientation.} \item{reverse}{controls which side to put the axis on. If true puts the axis on the opposite of the default which depends on the argument for vertical.} \item{name}{the name of the object.} \item{gp}{grid graphics parameters, ie. a \link[grid]{gpar} object.} \item{vp}{Viewport for the object. used to embed within other objects.} \item{...}{other parameters passed on, mostly just ignored.} \item{x}{A GradientLegendGrob object} } \seealso{ \code{\link{USALevelPlot}}, \code{\link{mapGrob}}, \link[=colorfunctions]{Color Functions} } \keyword{dplot} \keyword{color} gmaps/man/colorfunctions.Rd0000644000175100001440000000071710757362232015524 0ustar hornikusers\name{colorfunctions} \alias{colorfunctions} \alias{reds} \alias{blues} \alias{greens} \title{Color Functions} \description{ Color functions for turning numerical variables into color codes. } \usage{ reds(level) greens(level) blues(level) } \arguments{ \item{level}{Number between 0 and 1} } \seealso{ \code{\link{USALevelPlot}}, \code{\link[grDevices]{grey}}, \code{\link[grDevices]{rgb}}, \code{\link[grDevices]{hsv}} } \keyword{color}gmaps/man/mapGrob.Rd0000644000175100001440000000266311511141531014030 0ustar hornikusers\name{mapGrob} \alias{mapGrob} \alias{grid.mapGrob} \alias{validDetails.mapGrob} \title{Map grid graphics objects} \description{ mapGrob is the representation of a map object in the grid graphics system. } \usage{ mapGrob( database = "world", regions=".", exact=F, xlim=NULL, ylim=NULL, name=NULL, fill.col=NA, gp=NULL, vp=NULL, asp=1, ...) grid.mapGrob(...) validDetails.mapGrob(x) } \arguments{ \item{database}{Any of the valid maps databases.} \item{regions}{A vector of the regions to be included in the map.} \item{exact}{A logical specifying if regions should be matched exactly or partially.} \item{xlim}{x range on the map objecct, ussually correspondes to longitude.} \item{ylim}{y range on the map objecct, ussually correspondes to latitude.} \item{name}{the name of the object.} \item{fill.col}{color to use to fill the map with. Superceeds \code{gp\$fill} if specified.} \item{gp}{grid graphics parameters, ie. a \link[grid]{gpar} object.} \item{vp}{Viewport for the object. used to embed within other objects.} \item{asp}{aspect ratio for the map.} \item{...}{other parameters passed onto the map function.} \item{x}{A mapGrob object} } \seealso{ \code{\link[grid]{Grid}}, \code{\link[maps]{map}} } \examples{ #The four corners area of the United States colored. grid.mapGrob("state",c("utah","new mexico","arizona","colorado"),fill.col=rainbow(4)) } \keyword{dplot} gmaps/man/USALevelPlot.Rd0000644000175100001440000000326010760150140014713 0ustar hornikusers\name{USALevelPlot} \alias{USALevelPlot} \alias{grid.USALevelPlot} \title{USA Level Plot} \description{ USALevelPlot produces a mapGrob object for a map of the United States where the . } \usage{ USALevelPlot( states, levels, col.fun=grey, alaska='alaska'\%in\%tolower(states), hawaii='hawaii'\%in\%tolower(states), normalize=TRUE, name=NULL, vp=NULL, gp=NULL, asp=1.4, ...) grid.USALevelPlot(...) } \arguments{ \item{states}{List of the full names of the states.} \item{levels}{The response variable to use to color code the states} \item{col.fun}{A color function that takes the response variable and returns a color code.} \item{alaska}{include an inset of alaska?} \item{hawaii}{include an inset of Hawaii?} \item{normalize}{Does the response variable need to be transformed to between 0 and 1. If False and levels is outside of [0,1] may cause errors depending on the col.fun.} \item{name}{the name of the object.} \item{vp}{Viewport for the object. used to embed within other objects.} \item{gp}{grid graphics parameters, ie. a \link[grid]{gpar} object.} \item{asp}{aspect ratio for the map.} \item{...}{other parameters passed on.} } \seealso{ \link[=colorfunctions]{Color Functions}, \code{\link{mapGrob}}, \code{\link[maps]{map}} } \examples{ #maps of Arrests by state for arrests per 100,000 for Murder data(USArrests) attach(USArrests) grid.newpage() grid.frame(name="map") grid.pack("map",USALevelPlot(states=rownames(USArrests),levels=Murder,col.fun=reds),height=unit(1,'null')) grid.pack("map",gradientLegendGrob(at=quantile(Murder),col.fun=reds),side="bottom",height=unit(.2,'npc')) detach(USArrests) } \keyword{hplot}gmaps/NAMESPACE0000644000175100001440000000042210757362232012623 0ustar hornikusers#Namespace for gmaps package export( grid.mapGrob, mapGrob, validDetails.mapGrob, USALevelPlot, grid.USALevelPlot, gradientLegendGrob, grid.gradientLegendGrob, widthDetails.gradientLegendGrob, heightDetails.gradientLegendGrob, reds,blues,greens ) gmaps/R/0000755000175100001440000000000011511141535011575 5ustar hornikusersgmaps/R/gradientLegend.R0000644000175100001440000000737210755331730014654 0ustar hornikusers#Gradient Legends #by Andrew Redd #C 2007 #TODO #1. make width Calculation #2. make magrin calculation more presice for longer tick marks #3. Add Valid Details function gradientLegendGrob<-function( at=seq(0,1,length=5), #where to place tick marks axis.min=min(at), #to specify minimun axis.max=max(at), #to specify maximum labels=as.character(at),#specify labels for tick marks col.fun=grey, #function to specify gradient delta=.01, #defines level of precicion of gradient vertical=F, #controls orientation reverse=F, #controls which side to put the axis on name=NULL, gp=NULL, vp=NULL, ... ){ #generate Rectangles if(delta<=0||delta>=1)stop("delta must be between 0 and 1.") if(length(at)!=length(labels))stop("labels and at must be of the same length") z<-(seq(0,1,by=delta)-delta/2)[-1] y<-if(vertical) unit(z,"npc") else unit(0.5,"npc") x<-if(!vertical)unit(z,"npc") else unit(0.5,"npc") height<-if(vertical) delta else unit(1.5,"char") width <-if(!vertical) delta else unit(1.5,"char") just<-if(vertical) if(reverse) c("right","center") else c("left","center") else if(reverse) c("center","top") else c("center","bottom") cols<-col.fun(z) gp1<-do.call(gpar,append(list(col=NA,fill=cols),gp)) #make Gradient legvp<-viewport(name="legvp",width=unit(1,"npc")-unit(1,"char"),height=unit(1,"npc")-unit(1,"char")) #make Gradient Border rectangles<-rectGrob(name="gradient",x=x,y=y,height=height,width=width,just=just,gp=gp1,vp=legvp) border<-if(vertical)rectGrob(name="gradBorder",x=x,width=width,just=just,vp=legvp) else rectGrob(name="gradBorder",y=y,height=height,just=just,vp=legvp) #Make Ticks ticks<-if(is.numeric(at)){ w<- (at-axis.min)/(axis.max-axis.min) x0<-if(!vertical) unit(w,"npc") else unit(.5,"npc") x1<-if(!vertical) unit(w,"npc") else unit(.5,"npc")+if(reverse) unit(.4,"lines") else unit(-.4,"lines") y0<-if(vertical) unit(w,"npc") else unit(.5,"npc") y1<-if(vertical) unit(w,"npc") else unit(.5,"npc")+if(reverse) unit(.4,"lines") else unit(-.4,"lines") segmentsGrob(x0=x0,x1=x1,y0=y0,y1=y1,vp=legvp,name="ticks") } else NULL #Make Labels axis.labels<-if(all(!is.na(labels))){ w<- (at-axis.min)/(axis.max-axis.min) x<-if(!vertical) unit(w,"npc") else if(reverse) unit(.5,"npc")+unit(.5,"lines") else unit(.5,"npc")-unit(.5,"lines") y<-if(vertical) unit(w,"npc") else if(reverse) unit(.5,"npc")+unit(.5,"lines") else unit(.5,"npc")-unit(.5,"lines") just<-if(vertical) if(reverse)c("left","center") else c("right","center") else if(reverse)c("center","bottom") else c("center","top") textGrob(labels,x=x,y=y,just=just,name="labels",vp=legvp) } else NULL gTree(at=at,axis.min=axis.min,axis.max=axis.max,col.fun=col.fun,delta=delta,vertical=vertical,reverse=reverse, childrenvp=legvp, children=gList(rectangles,border,ticks,axis.labels), name=name,gp=gp,vp=vp, cl="gradientLegendGrob") } grid.gradientLegendGrob<-function(...){ grad<-gradientLegendGrob(...) grid.draw(grad) invisible(grad) } widthDetails.gradientLegendGrob<-function(x){ if(x$vertical) unit(1,"null") else{ convertUnit(unit(0.1,"lines"),"inches","x")+widthDetails(x$children[[2]])+widthDetails(x$children[[3]])+widthDetails(x$children[[4]]) } } heightDetails.gradientLegendGrob<-function(x){ if(!x$vertical) unit(1,"null") else{ convertUnit(unit(0.1,"lines"),"inches","x")+widthDetails(x$children[[2]])+widthDetails(x$children[[3]])+widthDetails(x$children[[4]]) } } #grid.gradientLegendGrob() #grid.gradientLegendGrob(vertical=T) #g0<-grid.gradientLegendGrob(vertical=T,reverse=T) #grid.gradientLegendGrob(1:5,col.fun=hsv,delta=1/1000) #rb<-function(p)rgb(p,0,1-p) #g1<-grid.gradientLegendGrob(1:10,col.fun=rb) #widthDetails(g1) #widthDetails(g0)gmaps/R/mapGrob.R0000644000175100001440000000570011510430241013303 0ustar hornikusers#mapGrob functions #Andrew Redd #Version 0.0.2 #TODO # #support function for helping grid graphics convert.coordinates.for.grid<-function(cod,regions=".",...){ x=cod$x y=cod$y id<-numeric(0) id.marker<-1 for(i in 1:length(x)){ if (is.na(x[i])){ id[i]<-id.marker id.marker<-id.marker+1 }else{ id[i]<-id.marker } } region.id<-rep(NA,length(id)) if(identical(regions,".")){ region.id<-id region.names<-cod$names } else if(length(regions)==1){ region.names<-regions region.id<-rep(1,length(id)) } else { region.names<-regions regions<-tolower(regions) region.map<-1:length(regions) names(region.map)<-regions for(r in regions){ name.matches<-grep(r,cod$names) region.id[id %in% name.matches]<-region.map[r] } } list(x=x,y=y,range=cod$range,names=cod$names,id=id,region.id=region.id,region.names=region.names) } makeMapViewports<-function(coord,asp=1){ xrange<-coord$range[1:2] yrange<-coord$range[3:4] vpStack( viewport(name="maplayout",layout=grid.layout(1,1, widths=diff(xrange), heights=diff(yrange)*asp, respect=TRUE)), viewport(name="mapvp",layout.pos.row=1,layout.pos.col=1, xscale=xrange, yscale=yrange)) } makeMapPolygons<-function(coord,fill.col=NULL,gp=NULL){ n<-length(coord$region.names) if(!is.null(fill.col))fill.cols<-rep(fill.col,n) polygons<-vector("list",n) for(i in 1:n){ polygons[[i]]<-if(any(coord$region.id==i))polygonGrob( name=paste("mappolygon",coord$region.names[i],sep=":"), unit(coord$x[coord$region.id==i],"native"), unit(coord$y[coord$region.id==i],"native"), gp=if(is.null(fill.col)) gp else gpar(fill=fill.col[i],gp), vp=vpPath("maplayout","mapvp")) else NULL } do.call("gList",polygons) } mapGrob<-function( database = "world", regions=".", exact=F, xlim=NULL, ylim=NULL, name=NULL, fill.col=NA,#superceeds gp$fill if specified gp=NULL, vp=NULL, asp=1, ...) { #validity checks if(!require(maps))stop("maps package is required") if(!require(grid))stop("grid graphics is required") #Get Coordinates for plotting regions c1<-map(database=database,regions=regions,exact=exact,fill=T,xlim=xlim,ylim=ylim,plot=F,...) coord<-convert.coordinates.for.grid(c1, regions) # Aspect Ratio if(missing(asp)){ xrange <- range(coord$x, na.rm = TRUE) yrange <- range(coord$y, na.rm = TRUE) aspect <- 1/cos((mean(yrange) * pi)/180) } else aspect<-asp #Grob generation #mapvp<-viewport(height=unit(1,"npc"),width=unit(1,"npc"),xscale=coord$range[1:2],yscale=coord$range[3:4],name="map") #map<-gTree(,vp=mapvp) mapvp<-makeMapViewports(coord,asp=aspect) mappolys<-makeMapPolygons(coord,fill.col=fill.col,gp=gp) gTree(coord=coord,name=name,gp=gp,vp=vp, childrenvp=mapvp, children=mappolys, cl="mapGrob") } grid.mapGrob<-function(...){ map<-mapGrob(...) grid.draw(map) invisible(map) } validDetails.mapGrob<-function(x){ x } gmaps/R/usa.level.plot.R0000644000175100001440000000455110760150140014575 0ustar hornikusersUSALevelPlot<-function( states, levels, col.fun=grey, alaska='alaska'%in%tolower(states), hawaii='hawaii'%in%tolower(states), normalize=TRUE, name=NULL, vp=NULL, gp=NULL, asp=1.4, ... ){ #validity checks if(!require(grid))stop("grid package is required!") if(!require(maps))stop("maps package is required!") if(!require(mapdata, quietly = TRUE))message("Higher resolution could be obtained if the mapdata package were installed.") #Contiguous USA if(!normalize && (min(levels)<0 || max(levels)>1))stop("Levels out of range, use normalize=TRUE") lnorm<-if(normalize) (levels-min(levels))/diff(range(levels)) else levels col<-col.fun(lnorm) map<-mapGrob("state",regions=states,name="mapUSAContiguous",fill.col=col,gp=gp,vp=vp,asp=asp,...) #Alaska if(alaska ){ if(length(grep("alaska",tolower(states)))==0)stop("alaska=TRUE option specified but Alaska data could not be found.") alaskavp<-viewport(x=unit(0,"npc"),y=unit(0,"npc"),width=unit(.3,"snpc"),height=unit(.3,"snpc"), name="alaskavp",just=c("left","bottom")) alaskafill<-col[grep("alaska",tolower(states))] alaskamap<-mapGrob(if(require(mapdata, quietly = TRUE)) "worldHires" else "world" ,"USA:Alaska",exact=F, name="mapUSAAlaska",xlim=c(-178,-130.01306),ylim=c(50,72), fill.col=alaskafill,gp=gp, vp=vpStack(map$childrenvp,alaskavp),asp=1) map<-addGrob(map,alaskamap) } #Hawaii if(hawaii){ if(length(grep("hawaii",tolower(states)))==0)stop("hawaii=TRUE option specified but Hawaii data could not be found.") hawaiivp<-viewport(x=unit(.3,"snpc"),y=unit(0,"snpc"),width=unit(.3,"snpc"),height=unit(.3,"snpc"), name="hawaiivp",just=c("left","bottom")) hawaiifill<-col[grep("hawaii",tolower(states))] hawaiimap<-mapGrob(if(require(mapdata, quietly = TRUE)) "worldHires" else "world" ,"Hawaii",exact=F, name="mapUSAHawaii",xlim=c(-161.2,-154.7),ylim=c(18.9,23.2), fill.col=hawaiifill,gp=gp, vp=vpStack(map$childrenvp,hawaiivp),asp=1) map<-addGrob(map,hawaiimap) } #plot results map } grid.USALevelPlot<-function(...){ map<-USALevelPlot(...) grid.draw(map) invisible(map) } #examples/test code #data(state) #p<-rbeta(50,5,2) #map1<-grid.USALevelPlot(state.name,p,normalize=F) #grid.newpage() #map2<-grid.USALevelPlot(state.name,p,normalize=T,alaska=T,hawaii=T,col.fun=function(x)hsv(0,x)) #childNames(map2) gmaps/R/colorfunctions.R0000644000175100001440000000022410757362232014777 0ustar hornikusers#Color functions for gmaps package reds<-function(level)rgb(level,0,0) greens<-function(level)rgb(0,level,0) blues<-function(level)rgb(0,0,level)gmaps/DESCRIPTION0000644000175100001440000000130711511312103013072 0ustar hornikusersPackage: gmaps Type: Package Title: Wrapper and auxilliary functions for maps package to work with grid graphics system. Version: 0.2 Date: 2011-01-03 Author: Andrew Redd Maintainer: Andrew Redd Depends: maps, grid Suggests: mapdata Description: The gmaps package extends the functionality of the maps package for the grid graphics system. This enables more advanced plots and more functionality. It also makes use of the grid structure to fix problems encountered with the traditional graphics system, such as resizing of graphs. License: GPL (>= 2) Packaged: 2011-01-05 19:15:41 UTC; aredd Repository: CRAN Date/Publication: 2011-01-06 10:06:59