Nothing
R/geosymbols.R
In geo: Draw and Annotate Maps, Especially Charts of the North Atlantic
Defines functions
geosymbols
Documented in
geosymbols
#' Plot different kinds of symbols at the data points.
#'
#' The function plots different kinds of symbols at the data points defined by
#' lat, lon. There are four categories of symbols:
#'
#' \describe{
#' \item{\strong{Default}}{Shapes whose size is proportional to z or sqrt(z).}
#' \item{\strong{Categories}}{Shapes where certain color, shading or size
#' represents certain range of z. Similar to contour program.}
#' \item{\strong{Filled circles}}{Certain size represents certain range of z,
#' specified with fill.circles = TRUE.}
#' \item{\strong{Characters}}{Characters or character strings represent the
#' different ranges of z, specified with characters = TRUE.}
#' }
#'
#' There are seven types of shapes: circles, squares,
#' rectangles, vbars (vertical bars), hbars(horisontal bars) , perbars
#' (perpendicular bars), parbars (parallel bars)
#'
#'
#' @param lat,lon latitude and longitude of data or a dataframe containing
#' latitude and longitude of data (or x and y coordinates), negative for
#' southern latitudes and western longitudes. Expected to contain \$lat and
#' \$lon if not otherwise specified in col.names.
#' @param z Matrix containing values at datapoints.
#' @param levels Values at contourlines. Default value is zero. If levels is
#' zero the program determines the contourlines from the data. If squares,
#' circles, hbars, vbars or perbars are being used levels corresponds to the
#' levels where labels are given.
#' @param reflevels i Some levels for reference?
#' @param labels.only if true only labels are plotted. Default is false.
#' @param cex Size expansion of digits.
#' @param chs Something to do with characters?
#' @param z1 Value 2 at data points. Only used in connection with rectangles.
#' @param circles Max size of circles plotted at data points. Default value
#' used if value <-0 or >100. Size is either proportional to z or sqrt(z).
#' @param squares Max size of squares plotted at data points. Default value
#' used if value <-0 or >100. Size is either proportional to z or sqrt(z).
#' @param rectangles Max size of rectangles plotted at datapoints in inches.
#' The first number gives max height and the second number max width. Values <
#' 0 or > 100 give default values.
#' @param vbars Max size of vertical bars at data points in inches. Values >100
#' give default values. Value <0 gives bars below points.
#' @param hbars Max size of horizontal bars at data points in inches. Values
#' >100 give default values. Value <0 gives bars left of points.
#' @param perbars Max size of bars perpendicular to transsect lines in inches.
#' Values >100 give default values. Value <0 gives different orientation.
#' @param parbars Same as perbars, except the bars are now parallel.
#' @param sqrt If sqrt = TRUE the size of symbol is proportional to sqrt(z)
#' else to z. Default value if FALSE.
#' @param col Color number used, default col = 0.
#' @param maxn If nonzero maxn is the base for the size of symbols, else max(z)
#' is used. Nonzero maxn is used if several plots are to be compared.
#' @param colplot if true range of z is specified by a colour and not size.
#' @param nlevels Number of contourlines. Used if the program has to determine
#' the contourlines. Default value is 10.
#' @param colors Color number for the contourlines. Runs from 0 to 155. A
#' vector one longer than the vector levels. Default is blue-green-yellow- red
#' from lowest to the highest values. Color 0 is white and 1 is black. On black
#' and white plots higher color number means darker color and also when
#' hatching. When hatching the useful range is 10 to 80. When plotting filled
#' circles of different sizes colors means sizes in inches. When levels are not
#' specified directly colors have to be found by the program because even
#' though nlevels = 5 the length of levels can be 7 due to characteristics of
#' the Splus pretty command.
#' @param n Number of vertices in each circle, default value is 25, this
#' parameter is rarely changed by the user.
#' @param maxcol Number of colors used (excluding #0). Default value is 155
#' @param only.positive Logical value. If FALSE then negative values are
#' allowed else negative values are set to zero. Default value is FALSE.
#' @param digits Number of digits used in labels. Default value is zero.
#' @param white If true the first color is white.
#' @param lwd Line width for symbols. Default value is the value when the
#' program was called.
#' @param label.location List with components \$lat and \$lon specifying
#' oppesite corners of a square where the label should be put. (or \$x, \$y)
#' Gives the lower left and upper right corner of the box where the labels are
#' put. Default value is 0 that means no labels are put on the drawing or if
#' geoplot was initialized with cont = TRUE, then labels are put on the left
#' side of the plot. label.location is best given by geolocator or directly by
#' specifying label.location = "locator".
#' @param labels Type of labels 1 or 2. One is default and is usually used
#' except in color with very many colors (more than 10-20) .
#' @param fill.circles If TRUE filled circles of different sizes are plotted.
#' Size of the circles is given directly by the parameter color or found from
#' the data. (maxcol corresponds to the size of the largest circle in this case
#' and is 0.1 by default (changing maxcol to 0.4 makes all the circles 4 times
#' larger.)
#' @param density If density is 1 (or not zero) circles are hatched instead of
#' having different color. Only available with circles. Color does in this case
#' specify the density of hatching. Higher number means denser hatching. The
#' range is from zero to maxcol (155). But the effective range is ca. 10 - 80.
#' @param angle Angle of hatching, default is 45 degrees.
#' @param rotate Rotation of hatching from one level to the next. Default value
#' is 0 but 45 or 90 can be good to better distinquish between different
#' levels.
#' @param outside If TRUE geosymbols will plot outside the specified limits set
#' by geoplot(). If FALSE, which is default, outside points will be skipped.
#' @param minsym Minimum symbol, default is "<", meaning that if levels = c(1,
#' 2), labels will be presented as < 1, 1-2, 2 <, but if minsym = " " labels
#' will be presented as 1, 1-2, 2. See also labels.resolution.
#' @param boundcheck If boundcheck != 0 those points which are out of bounds
#' are returned to the user, if boundcheck = 2 the points are also not plotted,
#' default is boundcheck = 0.
#' @param na.rm If true NA's are removed, default is true.
#' @param label.resolution the resolution (precision) of the label numbers,
#' default is 0, meaning that if levels = c(1, 2), labels will be presented <
#' 1, 1-2, 2 <, if label.resolution = 0.1 labels will be presented < 1, 1.1-2,
#' 2.1<, see also minsym. If label.resolution = "none", the labels will
#' present the lowest number of the interval with each color.
#' @param characters A boolean variable determing whether characters are to be
#' plotted.
#' @param pch Type of symbols for each level.
#' @param marks Type of symbols for each level. The difference between marks
#' and pch is becae when making points on a plot the user can either give pch =
#' 17 or pch = "A". The former type is called marks here but the latter pch.
#' Marks have to be given for each level and set to -1 where pch is to be used.
#' The length of the vector
#' @param charcol The color of the charchters, default is the same as col.
#' @param open.circles Should open.circles be plotted. Default FALSE. NEEDS
#' CHECKING.
#' @param col.names Column names with positions. Default \code{lat, lon}.
#' @param border Should border be plotted? Default FALSE. NEEDS CHECKING.
#' @param bordercol Color of border. Default 0. NEEDS CHECKING.
#' @return No values are returned
#' @seealso \code{\link{geoplot}}, \code{\link{geopolygon}},
#' \code{\link{points}}, \code{\link{geotext}}, \code{\link{geopoints}},
#' \code{\link{geocontour.fill}}, \code{\link{geogrid}},
#' \code{\link{geocontour}}.
#' @keywords aplot
#' @examples
#'
#' \dontrun{ # lodna.2 composes of echo measurements for capelin on the
#' # norther- and easternshores of Iceland. [lat, lon, z]
#'
#' # Show points.
#'
#' geoplot(lodna.2, type = "l", grid = FALSE) # Begin by plotting Iceland.
#' geopoints(lodna.2, pch = "*", col = 150) # See where the points are.
#'
#' ####################################
#' # Example 1, color parbars plot. #
#' ####################################
#'
#' geoplot(lodna.2, type = "l", grid = TRUE) # Begin by plotting Iceland.
#' levels = c(0, 20, 50, 100, 500, 1000)
#'
#' geosymbols(lodna.2, z = lodna.2$z, colplot = TRUE, colors = seven.col,
#' levels = levels, parbars = 0.05, colors = seven.col,
#' label.location = "locator")
#'
#' # "locator" click twice on the map where you want the contour index.
#' # Indicate firstly the upper left corner position then lower right.
#'
#' #######################################
#' # Example 2, black/white perbars plot.#
#' #######################################
#'
#' geoplot(lodna.2, type = "l", grid = FALSE)
#'
#' geosymbols(lodna.2, z = lodna.2$z, perbars = 0.1)
#'
#' # Bars perpendicular to measurement direction
#'
#' #######################################
#' # Example 3, Color Dots. #
#' #######################################
#'
#' # Set up data.
#' attach("/usr/local/reikn/SplusNamskeid")
#' i<-utbrteg$ar == 2004
#'
#' # Set up the plot.
#' geoplot()
#' levels = c(10, 100, 500)
#' colors = c(13, 55, 111, 153)
#' labloc<-list(lat = c(63.95, 65.4), lon = c(-19.8, -17.3))
#'
#' geosymbols(utbrteg[i, ], z = utbrteg[i, "torskur.kg"], circles = 0.05,
#' sqrt = TRUE, colplot = TRUE, levels = levels, colors = colors,
#' label.location = labloc)
#'
#'
#' #######################################
#' # Example 4, Rings around points. #
#' #######################################
#'
#' # Having done the set up data and plot in Example 3.
#'
#' geoplot(utbrteg$lat, utbrteg$lon, pch = ".")
#' geosymbols(utbrteg[i, ], z = utbrteg[i, "torskur.kg"], circles = 0.2,
#' sqrt = TRUE, label.location = labloc)
#'
#' # Circles can be replaced with squares, rectangles, vbars, hbars or
#' # perbars or more than one used simultanuously.
#' }
#' @export geosymbols
geosymbols <-
function(lat, lon = 0, z, levels = NULL, reflevels = NULL, labels.only = FALSE,
cex = 0.6, chs = 0.8, z1 = 0, circles = 0, squares = 0, rectangles = c(
0, 0), vbars = 0, hbars = 0, perbars = 0, parbars = 0, sqrt = FALSE, col =
1, maxn = 0, colplot = FALSE, nlevels = 10, colors = 0, n = 25, maxcol =
155, only.positive = FALSE, digits = 0, white = FALSE, lwd = 1, label.location
= NULL, labels = 1, fill.circles = FALSE, density = 0, angle = 45, rotate
= 0, outside = FALSE, minsym = "<", boundcheck = 0, na.rm = TRUE,
label.resolution = 0, characters = FALSE, pch, marks, charcol = 0,
open.circles = FALSE, col.names = c("lat", "lon"), border = FALSE, bordercol =
0)
{
geopar <- getOption("geopar")
options(warn = -1)
if(!is.null(label.location))
if(is.list(label.location))
label.location <- as.data.frame(label.location)
if(is.data.frame(lat)) {
i <- match(col.names, names(lat))
data <- data.frame(lat = lat[, i[1]], lon = lat[, i[2]])
}
else {
data <- data.frame(lat = lat, lon = lon)
}
if(na.rm) {
# delete na.
ind <- c(1:length(data$lat))
ind <- ind[is.na(data$lat) | is.na(data$lon)]
if(length(ind) > 0) {
data$lat <- data$lat[ - ind]
data$lon <- data$lon[ - ind]
z <- z[ - ind]
}
}
ind <- c(1:length(data$lat))
ind <- ind[is.na(z)]
if(length(ind) > 0) {
data$lat[ind] <- NA
data$lon[ind] <- NA
z[ind] <- mean(z, na.rm = TRUE)
}
if(fill.circles)
colplot <- TRUE
if(open.circles)
colplot <- TRUE
if(density > 0)
colplot <- TRUE
if(maxn == 0)
maxn <- max(abs(z))
if(only.positive) {
ind <- c(1:length(z))
ind <- ind[z < 0]
z[ind] <- 0
}
if(boundcheck != 0) {
dataprj <- Proj(data$lat, data$lon)
ind <- c(1:length(data$lat))
ind <- ind[dataprj$x < geopar$limx[1] | dataprj$x > geopar$
limx[2] | dataprj$y < geopar$limy[1] | dataprj$y >
geopar$limy[2]]
if(length(ind) > 0) {
ind1 <- paste(ind, collapse = ",")
print(paste("points", ind1, "out of bounds"))
}
if(boundcheck == 2) {
if(length(ind) > 0) {
data$lat <- data$lat[ - ind]
data$lon <- data$lon[ - ind]
z <- z[ - ind]
}
}
}
oldpar <- selectedpar()
par(geopar$gpar)
on.exit(par(oldpar))
if(outside)
par(xpd = TRUE)
else par(xpd = FALSE)
if(colplot) {
if(labels.only) {
if(cex != 0)
par(cex = cex)
colsymbol(data$lat, data$lon, z, circles, squares,
rectangles, hbars, vbars, perbars, parbars,
levels, nlevels, colors, white, n, maxcol,
digits, label.location, labels, fill.circles,
density, angle, rotate, minsym,
label.resolution, col, labels.only = TRUE,
open.circles = open.circles, lwd = lwd, border
= border, bordercol = bordercol)
}
else {
if(cex != 0)
par(cex = cex)
colsymbol(data$lat, data$lon, z, circles, squares,
rectangles, hbars, vbars, perbars, parbars,
levels, nlevels, colors, white, n, maxcol,
digits, label.location, labels, fill.circles,
density, angle, rotate, minsym,
label.resolution, col, open.circles =
open.circles, lwd = lwd, border = border,
bordercol = bordercol)
}
}
else {
x <- Proj(data$lat, data$lon, geopar$scale, geopar$b0, geopar$
b1, geopar$l1, geopar$projection)
y <- x$y
x <- x$x
ein.pr.in <- (geopar$limy[2] - geopar$limy[1])/geopar$gpar$
pin[2]
if(!is.null(label.location)) {
if(label.location == "locator" || label.location == 0)
label.location <- geolocator(n = 2)
limits <- Proj(label.location)
xlim <- limits$x
ylim <- limits$y
if(xlim[1] > xlim[2]) {
temp <- xlim[1]
xlim[1] <- xlim[2]
xlim[2] <- temp
}
if(ylim[1] > ylim[2]) {
temp <- ylim[1]
ylim[1] <- ylim[2]
ylim[2] <- temp
}
if(is.null(levels)) {
rg <- range(z)
lrg <- rg[2] - rg[1]
levels <- signif(seq(rg[1] + lrg/10, rg[2] -
lrg/10, length = nlevels), 2)
}
lbox <- length(levels)
boxy <- c(1:lbox)
boxy <- - boxy/lbox + 1
boxy1 <- boxy + 1/(1.2 * lbox)
yloc <- (boxy + boxy1)/2
xloc <- matrix(0.85, length(yloc))
par(adj = 0)
textx <- as.character(levels)
boxx <- c(matrix(0.1, 1, length(boxy)))
boxx <- xlim[1] + abs((xlim[2] - xlim[1])) * boxx
xloc <- xlim[1] + abs((xlim[2] - xlim[1])) * xloc
yloc <- ylim[1] + abs((ylim[2] - ylim[1])) * yloc
boxy <- ylim[1] + (ylim[2] - ylim[1]) * boxy
ll <- (ylim[2] - ylim[1]) * 0.05
if(circles != 0 | squares != 0 | hbars != 0 | vbars !=
0 | perbars != 0)
text(boxx, boxy + ll, textx, cex = chs)
}
if(circles != 0) {
# plot circles.
rg <- range(circles)
rglen <- rg[2] - rg[1]
lev <- seq(rg[1] + rglen/10, rg[2] - rglen/10, length
= 5)
if((circles > 100) | (circles < 0))
circles <- 0.2
#default value.
circles <- ein.pr.in * circles
# size in units
if(sqrt) {
if(!labels.only)
symbols(x, y, circles = circles * sqrt(
abs(z)/maxn), inches = FALSE, add
= TRUE, fg = col, lwd = lwd)
if(!is.null(label.location))
symbols(c(xloc), c(yloc), circles =
circles * sqrt(abs(levels)/
maxn), add = TRUE, inches = FALSE,
lwd = lwd, fg = col)
}
else {
if(!labels.only)
symbols(x, y, circles = circles * (
abs(z)/maxn), add = TRUE, inches
= FALSE, fg = col, lwd = lwd)
if(!is.null(label.location))
symbols(c(xloc), c(yloc), circles = (
circles * abs(levels))/maxn,
add = TRUE, inches = FALSE, lwd = lwd, fg = col)
}
}
if(squares != 0) {
#plot squares.
if((squares > 100) | (squares < 0)) squares <- 0.2
#default value.
squares <- ein.pr.in * squares
# size in units
if(sqrt) {
if(!labels.only)
symbols(x, y, squares = squares * sqrt(
abs(z)/maxn), add = TRUE, inches
= FALSE, fg = col, lwd = lwd)
symbols(c(xloc), c(yloc), squares = squares *
sqrt(abs(levels)/maxn), add = TRUE, inches
= FALSE, lwd = lwd, fg = col)
}
else {
if(!labels.only)
symbols(x, y, squares = squares * (
abs(z)/maxn), add = TRUE, inches
= FALSE, fg = col, lwd = lwd)
symbols(c(xloc), c(yloc), squares = (squares *
abs(levels))/maxn, add = TRUE, inches = FALSE, fg = col,
lwd = lwd)
}
}
if((rectangles[1] != 0) | (rectangles[2] != 0)) {
# plot rectangles
if((rectangles[1] > 100) | (rectangles[1] < 0))
rectangles[1] <- 0.2
# thickness
if((rectangles[2] > 100) | (rectangles[2] < 0))
rectangles[2] <- 0.2
# length
rectangles[1] <- ein.pr.in * rectangles[1]
# size in units
rectangles[2] <- ein.pr.in * rectangles[2]
# size in units
m <- matrix(rectangles[1], length(z), 2)
if(sqrt)
m[, 1] <- rectangles[1] * sqrt(abs(z)/maxn)
else m[, 1] <- (rectangles[1] * abs(z))/maxn
if(length(z1) > 1) {
if(sqrt)
m[, 2] <- rectangles[2] * sqrt(abs(
z1)/max(abs(z1)))
else m[, 2] <- (rectangles[2] * abs(z1))/max(
abs(z1))
}
symbols(x, y, rectangles = m, add = TRUE, inches = FALSE,
fg = col, lwd = lwd)
}
if(vbars != 0) {
# plot vertical bars
if(vbars > 100) vbars <- 0.4
mx <- matrix(NA, 3, length(x))
my <- mx
mx[1, ] <- x
my[1, ] <- y
mx[2, ] <- x
# mlocx<- matrix(NA, 3, length(levels)); mlocy<-mlocx
# mlocx[1, ]<-c(xloc) ; mlocy[1, ]<-c(yloc); mlocx[2, ]<-c(xloc)
r <- ein.pr.in * vbars
# size in units
if(sqrt) {
my[2, ] <- my[1, ] + r * sqrt(abs(z)/maxn)
}
else {
my[2, ] <- my[1, ] + (r * abs(z))/maxn
}
if(!labels.only)
lines(mx, my, col = col, lwd = lwd)
}
if(hbars != 0) {
# plot horizontal bars
if(hbars > 100) hbars <- 0.4
mx <- matrix(NA, 3, length(x))
my <- mx
mx[1, ] <- x
my[1, ] <- y
my[2, ] <- y
# mlocx<- matrix(NA, 3, length(levels)); mlocy<-mlocx
# mlocx[1, ]<-c(xloc) ; mlocy[1, ]<-c(yloc); mlocy[2, ]<-c(yloc)
r <- ein.pr.in * hbars
# size in units
if(sqrt) {
mx[2, ] <- mx[1, ] + r * sqrt(abs(z)/maxn)
}
else {
mx[2, ] <- mx[1, ] + (r * abs(z))/maxn
}
if(!labels.only)
lines(mx, my, col = col, lwd = lwd)
}
if(perbars != 0) {
# plot bars perpendicular to cruiselines
if(perbars > 100) perbars <- 0.4
mx <- matrix(NA, 3, length(x))
my <- mx
mx[1, ] <- x
my[1, ] <- y
# mlocx<- matrix(NA, 3, length(levels)); mlocy<-mlocx
# mlocx[1, ]<-c(xloc) ; mlocy[1, ]<-c(yloc); mlocy[2, ]<-c(yloc)
r <- ein.pr.in * perbars
# size in units
dx <- c(1:length(x))
dx[1] <- x[2] - x[1]
dx[2:(length(x) - 1)] <- x[3:(length(x))] - x[1:(length(
x) - 2)]
dx[length(x)] <- x[length(x)] - x[length(x) - 1]
dy <- c(1:length(y))
dy[1] <- y[2] - y[1]
dy[2:(length(y) - 1)] <- y[3:length(y)] - y[1:(length(
y) - 2)]
dy[length(y)] <- y[length(x)] - y[length(y) - 1]
dxy <- sqrt(dx * dx + dy * dy)
dx <- dx/dxy
dy <- dy/dxy
if(sqrt)
mx[2, ] <- mx[1, ] - dy * r * sqrt(abs(z)/
maxn)
else mx[2, ] <- mx[1, ] - (dy * r * abs(z))/maxn
if(sqrt)
my[2, ] <- my[1, ] + dx * r * sqrt(abs(z)/
maxn)
else my[2, ] <- my[1, ] + (dx * r * abs(z))/maxn
# if(sqrt) mlocx[2, ]<-mlocx[1, ]+r*sqrt(abs(levels)/maxn)
# else mlocx[2, ]<-mlocx[1, ]+r*abs(z)/maxn
if(!labels.only) lines(mx, my, col = col)
}
}
par(oldpar)
if(characters) {
if(missing(marks))
marks <- rep(-1, length(pch))
if(missing(pch))
pch <- rep(" ", length(marks))
if(!is.numeric(levels)) {
if(!is.numeric(z))
ind <- match(z, levels)
else {
if(is.null(reflevels)) {
print("Error")
return()
}
ind <- match(z, reflevels)
}
n <- length(levels)
}
else {
if(charcol != 0)
col <- charcol
n <- length(levels) + 1
levels <- c(-1000000., levels, 1000000.)
ind <- cut(z, levels, labels = FALSE)
}
if(length(col) == 1)
col <- rep(col, n)
if(length(cex) == 1)
cex <- rep(cex, n)
if(!labels.only) {
for(i in 1:n) {
tmp <- data[ind == i, ]
if(nrow(tmp) > 0) {
if(marks[i] < 0)
geopoints(tmp, pch = pch[i],
cex = cex[i], col = col[
i])
else geopoints(tmp, pch = marks[i],
cex = cex[i], col = col[
i])
}
}
}
if(!is.null(label.location)) {
########
if(!is.list(label.location)) if(label.location ==
"locator")
label.location <- geolocator(n = 2)
oldpar <- selectedpar()
on.exit(par(oldpar))
par(geopar$gpar)
paint.window(label.location)
label.location <- Proj(label.location)
## if(is.numeric(levels))
## Pointlabel(levels[2:(length(levels) - 1)],
## digits, label.location$x,
## label.location$y, minsym,
## label.resolution, marks, pch, col,
## cex, chs)
## else Charlabel(levels, label.location$x, label.location$
## y, label, marks, pch, col, cex, chs)
}
}
options(warn = 0)
return(invisible())
}
Try the geo package in your browser
Any scripts or data that you put into this service are public.
geo documentation built on May 29, 2017, 5:36 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions geosymbols
Documented in geosymbols
#' Plot different kinds of symbols at the data points.
#'
#' The function plots different kinds of symbols at the data points defined by
#' lat, lon. There are four categories of symbols:
#'
#' \describe{
#' \item{\strong{Default}}{Shapes whose size is proportional to z or sqrt(z).}
#' \item{\strong{Categories}}{Shapes where certain color, shading or size
#' represents certain range of z. Similar to contour program.}
#' \item{\strong{Filled circles}}{Certain size represents certain range of z,
#' specified with fill.circles = TRUE.}
#' \item{\strong{Characters}}{Characters or character strings represent the
#' different ranges of z, specified with characters = TRUE.}
#' }
#'
#' There are seven types of shapes: circles, squares,
#' rectangles, vbars (vertical bars), hbars(horisontal bars) , perbars
#' (perpendicular bars), parbars (parallel bars)
#'
#'
#' @param lat,lon latitude and longitude of data or a dataframe containing
#' latitude and longitude of data (or x and y coordinates), negative for
#' southern latitudes and western longitudes. Expected to contain \$lat and
#' \$lon if not otherwise specified in col.names.
#' @param z Matrix containing values at datapoints.
#' @param levels Values at contourlines. Default value is zero. If levels is
#' zero the program determines the contourlines from the data. If squares,
#' circles, hbars, vbars or perbars are being used levels corresponds to the
#' levels where labels are given.
#' @param reflevels i Some levels for reference?
#' @param labels.only if true only labels are plotted. Default is false.
#' @param cex Size expansion of digits.
#' @param chs Something to do with characters?
#' @param z1 Value 2 at data points. Only used in connection with rectangles.
#' @param circles Max size of circles plotted at data points. Default value
#' used if value <-0 or >100. Size is either proportional to z or sqrt(z).
#' @param squares Max size of squares plotted at data points. Default value
#' used if value <-0 or >100. Size is either proportional to z or sqrt(z).
#' @param rectangles Max size of rectangles plotted at datapoints in inches.
#' The first number gives max height and the second number max width. Values <
#' 0 or > 100 give default values.
#' @param vbars Max size of vertical bars at data points in inches. Values >100
#' give default values. Value <0 gives bars below points.
#' @param hbars Max size of horizontal bars at data points in inches. Values
#' >100 give default values. Value <0 gives bars left of points.
#' @param perbars Max size of bars perpendicular to transsect lines in inches.
#' Values >100 give default values. Value <0 gives different orientation.
#' @param parbars Same as perbars, except the bars are now parallel.
#' @param sqrt If sqrt = TRUE the size of symbol is proportional to sqrt(z)
#' else to z. Default value if FALSE.
#' @param col Color number used, default col = 0.
#' @param maxn If nonzero maxn is the base for the size of symbols, else max(z)
#' is used. Nonzero maxn is used if several plots are to be compared.
#' @param colplot if true range of z is specified by a colour and not size.
#' @param nlevels Number of contourlines. Used if the program has to determine
#' the contourlines. Default value is 10.
#' @param colors Color number for the contourlines. Runs from 0 to 155. A
#' vector one longer than the vector levels. Default is blue-green-yellow- red
#' from lowest to the highest values. Color 0 is white and 1 is black. On black
#' and white plots higher color number means darker color and also when
#' hatching. When hatching the useful range is 10 to 80. When plotting filled
#' circles of different sizes colors means sizes in inches. When levels are not
#' specified directly colors have to be found by the program because even
#' though nlevels = 5 the length of levels can be 7 due to characteristics of
#' the Splus pretty command.
#' @param n Number of vertices in each circle, default value is 25, this
#' parameter is rarely changed by the user.
#' @param maxcol Number of colors used (excluding #0). Default value is 155
#' @param only.positive Logical value. If FALSE then negative values are
#' allowed else negative values are set to zero. Default value is FALSE.
#' @param digits Number of digits used in labels. Default value is zero.
#' @param white If true the first color is white.
#' @param lwd Line width for symbols. Default value is the value when the
#' program was called.
#' @param label.location List with components \$lat and \$lon specifying
#' oppesite corners of a square where the label should be put. (or \$x, \$y)
#' Gives the lower left and upper right corner of the box where the labels are
#' put. Default value is 0 that means no labels are put on the drawing or if
#' geoplot was initialized with cont = TRUE, then labels are put on the left
#' side of the plot. label.location is best given by geolocator or directly by
#' specifying label.location = "locator".
#' @param labels Type of labels 1 or 2. One is default and is usually used
#' except in color with very many colors (more than 10-20) .
#' @param fill.circles If TRUE filled circles of different sizes are plotted.
#' Size of the circles is given directly by the parameter color or found from
#' the data. (maxcol corresponds to the size of the largest circle in this case
#' and is 0.1 by default (changing maxcol to 0.4 makes all the circles 4 times
#' larger.)
#' @param density If density is 1 (or not zero) circles are hatched instead of
#' having different color. Only available with circles. Color does in this case
#' specify the density of hatching. Higher number means denser hatching. The
#' range is from zero to maxcol (155). But the effective range is ca. 10 - 80.
#' @param angle Angle of hatching, default is 45 degrees.
#' @param rotate Rotation of hatching from one level to the next. Default value
#' is 0 but 45 or 90 can be good to better distinquish between different
#' levels.
#' @param outside If TRUE geosymbols will plot outside the specified limits set
#' by geoplot(). If FALSE, which is default, outside points will be skipped.
#' @param minsym Minimum symbol, default is "<", meaning that if levels = c(1,
#' 2), labels will be presented as < 1, 1-2, 2 <, but if minsym = " " labels
#' will be presented as 1, 1-2, 2. See also labels.resolution.
#' @param boundcheck If boundcheck != 0 those points which are out of bounds
#' are returned to the user, if boundcheck = 2 the points are also not plotted,
#' default is boundcheck = 0.
#' @param na.rm If true NA's are removed, default is true.
#' @param label.resolution the resolution (precision) of the label numbers,
#' default is 0, meaning that if levels = c(1, 2), labels will be presented <
#' 1, 1-2, 2 <, if label.resolution = 0.1 labels will be presented < 1, 1.1-2,
#' 2.1<, see also minsym. If label.resolution = "none", the labels will
#' present the lowest number of the interval with each color.
#' @param characters A boolean variable determing whether characters are to be
#' plotted.
#' @param pch Type of symbols for each level.
#' @param marks Type of symbols for each level. The difference between marks
#' and pch is becae when making points on a plot the user can either give pch =
#' 17 or pch = "A". The former type is called marks here but the latter pch.
#' Marks have to be given for each level and set to -1 where pch is to be used.
#' The length of the vector
#' @param charcol The color of the charchters, default is the same as col.
#' @param open.circles Should open.circles be plotted. Default FALSE. NEEDS
#' CHECKING.
#' @param col.names Column names with positions. Default \code{lat, lon}.
#' @param border Should border be plotted? Default FALSE. NEEDS CHECKING.
#' @param bordercol Color of border. Default 0. NEEDS CHECKING.
#' @return No values are returned
#' @seealso \code{\link{geoplot}}, \code{\link{geopolygon}},
#' \code{\link{points}}, \code{\link{geotext}}, \code{\link{geopoints}},
#' \code{\link{geocontour.fill}}, \code{\link{geogrid}},
#' \code{\link{geocontour}}.
#' @keywords aplot
#' @examples
#'
#' \dontrun{ # lodna.2 composes of echo measurements for capelin on the
#' # norther- and easternshores of Iceland. [lat, lon, z]
#'
#' # Show points.
#'
#' geoplot(lodna.2, type = "l", grid = FALSE) # Begin by plotting Iceland.
#' geopoints(lodna.2, pch = "*", col = 150) # See where the points are.
#'
#' ####################################
#' # Example 1, color parbars plot. #
#' ####################################
#'
#' geoplot(lodna.2, type = "l", grid = TRUE) # Begin by plotting Iceland.
#' levels = c(0, 20, 50, 100, 500, 1000)
#'
#' geosymbols(lodna.2, z = lodna.2$z, colplot = TRUE, colors = seven.col,
#' levels = levels, parbars = 0.05, colors = seven.col,
#' label.location = "locator")
#'
#' # "locator" click twice on the map where you want the contour index.
#' # Indicate firstly the upper left corner position then lower right.
#'
#' #######################################
#' # Example 2, black/white perbars plot.#
#' #######################################
#'
#' geoplot(lodna.2, type = "l", grid = FALSE)
#'
#' geosymbols(lodna.2, z = lodna.2$z, perbars = 0.1)
#'
#' # Bars perpendicular to measurement direction
#'
#' #######################################
#' # Example 3, Color Dots. #
#' #######################################
#'
#' # Set up data.
#' attach("/usr/local/reikn/SplusNamskeid")
#' i<-utbrteg$ar == 2004
#'
#' # Set up the plot.
#' geoplot()
#' levels = c(10, 100, 500)
#' colors = c(13, 55, 111, 153)
#' labloc<-list(lat = c(63.95, 65.4), lon = c(-19.8, -17.3))
#'
#' geosymbols(utbrteg[i, ], z = utbrteg[i, "torskur.kg"], circles = 0.05,
#' sqrt = TRUE, colplot = TRUE, levels = levels, colors = colors,
#' label.location = labloc)
#'
#'
#' #######################################
#' # Example 4, Rings around points. #
#' #######################################
#'
#' # Having done the set up data and plot in Example 3.
#'
#' geoplot(utbrteg$lat, utbrteg$lon, pch = ".")
#' geosymbols(utbrteg[i, ], z = utbrteg[i, "torskur.kg"], circles = 0.2,
#' sqrt = TRUE, label.location = labloc)
#'
#' # Circles can be replaced with squares, rectangles, vbars, hbars or
#' # perbars or more than one used simultanuously.
#' }
#' @export geosymbols
geosymbols <-
function(lat, lon = 0, z, levels = NULL, reflevels = NULL, labels.only = FALSE,
cex = 0.6, chs = 0.8, z1 = 0, circles = 0, squares = 0, rectangles = c(
0, 0), vbars = 0, hbars = 0, perbars = 0, parbars = 0, sqrt = FALSE, col =
1, maxn = 0, colplot = FALSE, nlevels = 10, colors = 0, n = 25, maxcol =
155, only.positive = FALSE, digits = 0, white = FALSE, lwd = 1, label.location
= NULL, labels = 1, fill.circles = FALSE, density = 0, angle = 45, rotate
= 0, outside = FALSE, minsym = "<", boundcheck = 0, na.rm = TRUE,
label.resolution = 0, characters = FALSE, pch, marks, charcol = 0,
open.circles = FALSE, col.names = c("lat", "lon"), border = FALSE, bordercol =
0)
{
geopar <- getOption("geopar")
options(warn = -1)
if(!is.null(label.location))
if(is.list(label.location))
label.location <- as.data.frame(label.location)
if(is.data.frame(lat)) {
i <- match(col.names, names(lat))
data <- data.frame(lat = lat[, i[1]], lon = lat[, i[2]])
}
else {
data <- data.frame(lat = lat, lon = lon)
}
if(na.rm) {
# delete na.
ind <- c(1:length(data$lat))
ind <- ind[is.na(data$lat) | is.na(data$lon)]
if(length(ind) > 0) {
data$lat <- data$lat[ - ind]
data$lon <- data$lon[ - ind]
z <- z[ - ind]
}
}
ind <- c(1:length(data$lat))
ind <- ind[is.na(z)]
if(length(ind) > 0) {
data$lat[ind] <- NA
data$lon[ind] <- NA
z[ind] <- mean(z, na.rm = TRUE)
}
if(fill.circles)
colplot <- TRUE
if(open.circles)
colplot <- TRUE
if(density > 0)
colplot <- TRUE
if(maxn == 0)
maxn <- max(abs(z))
if(only.positive) {
ind <- c(1:length(z))
ind <- ind[z < 0]
z[ind] <- 0
}
if(boundcheck != 0) {
dataprj <- Proj(data$lat, data$lon)
ind <- c(1:length(data$lat))
ind <- ind[dataprj$x < geopar$limx[1] | dataprj$x > geopar$
limx[2] | dataprj$y < geopar$limy[1] | dataprj$y >
geopar$limy[2]]
if(length(ind) > 0) {
ind1 <- paste(ind, collapse = ",")
print(paste("points", ind1, "out of bounds"))
}
if(boundcheck == 2) {
if(length(ind) > 0) {
data$lat <- data$lat[ - ind]
data$lon <- data$lon[ - ind]
z <- z[ - ind]
}
}
}
oldpar <- selectedpar()
par(geopar$gpar)
on.exit(par(oldpar))
if(outside)
par(xpd = TRUE)
else par(xpd = FALSE)
if(colplot) {
if(labels.only) {
if(cex != 0)
par(cex = cex)
colsymbol(data$lat, data$lon, z, circles, squares,
rectangles, hbars, vbars, perbars, parbars,
levels, nlevels, colors, white, n, maxcol,
digits, label.location, labels, fill.circles,
density, angle, rotate, minsym,
label.resolution, col, labels.only = TRUE,
open.circles = open.circles, lwd = lwd, border
= border, bordercol = bordercol)
}
else {
if(cex != 0)
par(cex = cex)
colsymbol(data$lat, data$lon, z, circles, squares,
rectangles, hbars, vbars, perbars, parbars,
levels, nlevels, colors, white, n, maxcol,
digits, label.location, labels, fill.circles,
density, angle, rotate, minsym,
label.resolution, col, open.circles =
open.circles, lwd = lwd, border = border,
bordercol = bordercol)
}
}
else {
x <- Proj(data$lat, data$lon, geopar$scale, geopar$b0, geopar$
b1, geopar$l1, geopar$projection)
y <- x$y
x <- x$x
ein.pr.in <- (geopar$limy[2] - geopar$limy[1])/geopar$gpar$
pin[2]
if(!is.null(label.location)) {
if(label.location == "locator" || label.location == 0)
label.location <- geolocator(n = 2)
limits <- Proj(label.location)
xlim <- limits$x
ylim <- limits$y
if(xlim[1] > xlim[2]) {
temp <- xlim[1]
xlim[1] <- xlim[2]
xlim[2] <- temp
}
if(ylim[1] > ylim[2]) {
temp <- ylim[1]
ylim[1] <- ylim[2]
ylim[2] <- temp
}
if(is.null(levels)) {
rg <- range(z)
lrg <- rg[2] - rg[1]
levels <- signif(seq(rg[1] + lrg/10, rg[2] -
lrg/10, length = nlevels), 2)
}
lbox <- length(levels)
boxy <- c(1:lbox)
boxy <- - boxy/lbox + 1
boxy1 <- boxy + 1/(1.2 * lbox)
yloc <- (boxy + boxy1)/2
xloc <- matrix(0.85, length(yloc))
par(adj = 0)
textx <- as.character(levels)
boxx <- c(matrix(0.1, 1, length(boxy)))
boxx <- xlim[1] + abs((xlim[2] - xlim[1])) * boxx
xloc <- xlim[1] + abs((xlim[2] - xlim[1])) * xloc
yloc <- ylim[1] + abs((ylim[2] - ylim[1])) * yloc
boxy <- ylim[1] + (ylim[2] - ylim[1]) * boxy
ll <- (ylim[2] - ylim[1]) * 0.05
if(circles != 0 | squares != 0 | hbars != 0 | vbars !=
0 | perbars != 0)
text(boxx, boxy + ll, textx, cex = chs)
}
if(circles != 0) {
# plot circles.
rg <- range(circles)
rglen <- rg[2] - rg[1]
lev <- seq(rg[1] + rglen/10, rg[2] - rglen/10, length
= 5)
if((circles > 100) | (circles < 0))
circles <- 0.2
#default value.
circles <- ein.pr.in * circles
# size in units
if(sqrt) {
if(!labels.only)
symbols(x, y, circles = circles * sqrt(
abs(z)/maxn), inches = FALSE, add
= TRUE, fg = col, lwd = lwd)
if(!is.null(label.location))
symbols(c(xloc), c(yloc), circles =
circles * sqrt(abs(levels)/
maxn), add = TRUE, inches = FALSE,
lwd = lwd, fg = col)
}
else {
if(!labels.only)
symbols(x, y, circles = circles * (
abs(z)/maxn), add = TRUE, inches
= FALSE, fg = col, lwd = lwd)
if(!is.null(label.location))
symbols(c(xloc), c(yloc), circles = (
circles * abs(levels))/maxn,
add = TRUE, inches = FALSE, lwd = lwd, fg = col)
}
}
if(squares != 0) {
#plot squares.
if((squares > 100) | (squares < 0)) squares <- 0.2
#default value.
squares <- ein.pr.in * squares
# size in units
if(sqrt) {
if(!labels.only)
symbols(x, y, squares = squares * sqrt(
abs(z)/maxn), add = TRUE, inches
= FALSE, fg = col, lwd = lwd)
symbols(c(xloc), c(yloc), squares = squares *
sqrt(abs(levels)/maxn), add = TRUE, inches
= FALSE, lwd = lwd, fg = col)
}
else {
if(!labels.only)
symbols(x, y, squares = squares * (
abs(z)/maxn), add = TRUE, inches
= FALSE, fg = col, lwd = lwd)
symbols(c(xloc), c(yloc), squares = (squares *
abs(levels))/maxn, add = TRUE, inches = FALSE, fg = col,
lwd = lwd)
}
}
if((rectangles[1] != 0) | (rectangles[2] != 0)) {
# plot rectangles
if((rectangles[1] > 100) | (rectangles[1] < 0))
rectangles[1] <- 0.2
# thickness
if((rectangles[2] > 100) | (rectangles[2] < 0))
rectangles[2] <- 0.2
# length
rectangles[1] <- ein.pr.in * rectangles[1]
# size in units
rectangles[2] <- ein.pr.in * rectangles[2]
# size in units
m <- matrix(rectangles[1], length(z), 2)
if(sqrt)
m[, 1] <- rectangles[1] * sqrt(abs(z)/maxn)
else m[, 1] <- (rectangles[1] * abs(z))/maxn
if(length(z1) > 1) {
if(sqrt)
m[, 2] <- rectangles[2] * sqrt(abs(
z1)/max(abs(z1)))
else m[, 2] <- (rectangles[2] * abs(z1))/max(
abs(z1))
}
symbols(x, y, rectangles = m, add = TRUE, inches = FALSE,
fg = col, lwd = lwd)
}
if(vbars != 0) {
# plot vertical bars
if(vbars > 100) vbars <- 0.4
mx <- matrix(NA, 3, length(x))
my <- mx
mx[1, ] <- x
my[1, ] <- y
mx[2, ] <- x
# mlocx<- matrix(NA, 3, length(levels)); mlocy<-mlocx
# mlocx[1, ]<-c(xloc) ; mlocy[1, ]<-c(yloc); mlocx[2, ]<-c(xloc)
r <- ein.pr.in * vbars
# size in units
if(sqrt) {
my[2, ] <- my[1, ] + r * sqrt(abs(z)/maxn)
}
else {
my[2, ] <- my[1, ] + (r * abs(z))/maxn
}
if(!labels.only)
lines(mx, my, col = col, lwd = lwd)
}
if(hbars != 0) {
# plot horizontal bars
if(hbars > 100) hbars <- 0.4
mx <- matrix(NA, 3, length(x))
my <- mx
mx[1, ] <- x
my[1, ] <- y
my[2, ] <- y
# mlocx<- matrix(NA, 3, length(levels)); mlocy<-mlocx
# mlocx[1, ]<-c(xloc) ; mlocy[1, ]<-c(yloc); mlocy[2, ]<-c(yloc)
r <- ein.pr.in * hbars
# size in units
if(sqrt) {
mx[2, ] <- mx[1, ] + r * sqrt(abs(z)/maxn)
}
else {
mx[2, ] <- mx[1, ] + (r * abs(z))/maxn
}
if(!labels.only)
lines(mx, my, col = col, lwd = lwd)
}
if(perbars != 0) {
# plot bars perpendicular to cruiselines
if(perbars > 100) perbars <- 0.4
mx <- matrix(NA, 3, length(x))
my <- mx
mx[1, ] <- x
my[1, ] <- y
# mlocx<- matrix(NA, 3, length(levels)); mlocy<-mlocx
# mlocx[1, ]<-c(xloc) ; mlocy[1, ]<-c(yloc); mlocy[2, ]<-c(yloc)
r <- ein.pr.in * perbars
# size in units
dx <- c(1:length(x))
dx[1] <- x[2] - x[1]
dx[2:(length(x) - 1)] <- x[3:(length(x))] - x[1:(length(
x) - 2)]
dx[length(x)] <- x[length(x)] - x[length(x) - 1]
dy <- c(1:length(y))
dy[1] <- y[2] - y[1]
dy[2:(length(y) - 1)] <- y[3:length(y)] - y[1:(length(
y) - 2)]
dy[length(y)] <- y[length(x)] - y[length(y) - 1]
dxy <- sqrt(dx * dx + dy * dy)
dx <- dx/dxy
dy <- dy/dxy
if(sqrt)
mx[2, ] <- mx[1, ] - dy * r * sqrt(abs(z)/
maxn)
else mx[2, ] <- mx[1, ] - (dy * r * abs(z))/maxn
if(sqrt)
my[2, ] <- my[1, ] + dx * r * sqrt(abs(z)/
maxn)
else my[2, ] <- my[1, ] + (dx * r * abs(z))/maxn
# if(sqrt) mlocx[2, ]<-mlocx[1, ]+r*sqrt(abs(levels)/maxn)
# else mlocx[2, ]<-mlocx[1, ]+r*abs(z)/maxn
if(!labels.only) lines(mx, my, col = col)
}
}
par(oldpar)
if(characters) {
if(missing(marks))
marks <- rep(-1, length(pch))
if(missing(pch))
pch <- rep(" ", length(marks))
if(!is.numeric(levels)) {
if(!is.numeric(z))
ind <- match(z, levels)
else {
if(is.null(reflevels)) {
print("Error")
return()
}
ind <- match(z, reflevels)
}
n <- length(levels)
}
else {
if(charcol != 0)
col <- charcol
n <- length(levels) + 1
levels <- c(-1000000., levels, 1000000.)
ind <- cut(z, levels, labels = FALSE)
}
if(length(col) == 1)
col <- rep(col, n)
if(length(cex) == 1)
cex <- rep(cex, n)
if(!labels.only) {
for(i in 1:n) {
tmp <- data[ind == i, ]
if(nrow(tmp) > 0) {
if(marks[i] < 0)
geopoints(tmp, pch = pch[i],
cex = cex[i], col = col[
i])
else geopoints(tmp, pch = marks[i],
cex = cex[i], col = col[
i])
}
}
}
if(!is.null(label.location)) {
########
if(!is.list(label.location)) if(label.location ==
"locator")
label.location <- geolocator(n = 2)
oldpar <- selectedpar()
on.exit(par(oldpar))
par(geopar$gpar)
paint.window(label.location)
label.location <- Proj(label.location)
## if(is.numeric(levels))
## Pointlabel(levels[2:(length(levels) - 1)],
## digits, label.location$x,
## label.location$y, minsym,
## label.resolution, marks, pch, col,
## cex, chs)
## else Charlabel(levels, label.location$x, label.location$
## y, label, marks, pch, col, cex, chs)
}
}
options(warn = 0)
return(invisible())
}
Try the geo package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.