/
scattersplot.R
100 lines (94 loc) · 5.42 KB
/
scattersplot.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
#····································································
# scattersplot.R (npsp package)
#····································································
# scattersplot S3 generic
# scattersplot.default
# scattersplot.SpatialPointsDataFrame
#
# (c) R. Fernandez-Casal
# Created: Oct 2017; Modified: Apr 2023
#
# NOTE: Press Ctrl + Shift + O to show document outline in RStudio
#····································································
#' Exploratory scatter plots
#'
#' Draws (in a 2 by 2 layout) the following plots:
#' a scatter plot with a color scale, the scatter plots of the response against the (first two)
#' coordinates and the histogram of the response values.
#' @param x object used to select a method.
#' @param ... additional graphical parameters (to be passed to \code{\link{spoints}}).
#' @return No return value, called for side effects (generate the plot).
#' @seealso \code{\link{splot}}, \code{\link{spoints}}, \code{\link[stats]{lowess}},
#' \code{\link[stats]{density}}
#' @keywords hplot
#' @export
#····································································
scattersplot <- function(x, ...) {
UseMethod("scattersplot")
} # S3 generic function scattersplot
#····································································
#' @rdname scattersplot
#' @method scattersplot default
#' @param z vector of data (response variable).
#' @param main an overall title for the plot.
#' @param xlab a title for the axis corresponding to the first coordinate.
#' @param ylab a title for the axis corresponding to the second coordinate.
#' @param zlab a title for the axis corresponding to the response.
#' @param col color table used to set up the color scale (see \code{\link{spoints}}).
#' @param lowess logical. If \code{TRUE}, a \code{\link[stats]{lowess}} smooth is added to
#' the plots of the response against the coordinates.
#' @param density logical. If \code{TRUE}, a kernel \code{\link[stats]{density}} estimate
#' is added to the histogram.
#' @param omd a vector of the form \code{c(x1, x2, y1, y2)} giving the region inside outer margins
#' in normalized device coordinates (i.e. fractions of the device region).
#' @details Standard generic function with a default method, in which argument \code{x}
#' is a matrix with the spatial coordinates (each row is a point).
#' @export
scattersplot.default <- function(x, z, main, xlab, ylab, zlab,
col = hot.colors(128), lowess = TRUE, density = FALSE,
omd = c(0.05, 0.95, 0.01, 0.95), ...) {
#····································································
if (missing(xlab)) xlab <- paste0(deparse(substitute(x)), "[, 1]")
if (missing(ylab)) ylab <- paste0(deparse(substitute(x)), "[, 2]")
if (missing(zlab)) zlab <- deparse(substitute(z))
if (missing(main)) main <- paste("Exploratory plots of", zlab)
old.par <- par(mfrow = c(2,2), omd = omd)
on.exit(par(old.par))
# Scatter plot with a color scale
spoints(x[, 1], x[, 2], z, xlab = xlab, ylab = ylab,
col = col, reset = FALSE, ...)
# plot(z, x[, 2], z, xlab = main, ylab = xlab))
plot(x[, 2], z, xlab = ylab, ylab = zlab)
if (lowess) lines(lowess(x[, 2], z), lty = 2, lwd = 2, col = 'blue')
plot(x[, 1], z, xlab = xlab, ylab = zlab)
if (lowess) lines(lowess(x[, 1], z), lty = 2, lwd = 2, col = 'blue')
hist(z, xlab = zlab, main = "", freq = !density)
if (density) lines(density(z), col = 'blue')
par(old.par)
title(main = main)
}
#····································································
#' @rdname scattersplot
#' @method scattersplot SpatialPointsDataFrame
#' @param data.ind integer (or character) with the index (or name) of the data component.
#' @details \code{scattersplot.SpatialPointsDataFrame} sets default values for some of the arguments
# from attributes of the object \code{x} (if present; see e.g. \code{\link{precipitation}}).
#' from attributes of the object \code{x} (if present; see e.g. \code{precipitation}).
#' @export
scattersplot.SpatialPointsDataFrame <- function(x, data.ind = 1,
main, xlab, ylab, zlab, col = hot.colors(128), lowess = TRUE, density = FALSE,
omd = c(0.05, 0.95, 0.01, 0.95), ...) {
#····································································
if(dimensions(x) != 2)
stop("function only works for two-dimensional 'SpatialPointsDataFrame'")
if(!is.null(labels <- attr(x, "labels"))) {
if(missing(main)) main <- labels$name
if(missing(xlab)) xlab <- labels$x[1]
if(missing(ylab)) ylab <- labels$x[2]
if(missing(zlab)) zlab <- labels$y
}
# Coordenadas de los datos
coord <- coordinates(x)
scattersplot.default(coord, x[[data.ind]], main = main, xlab = xlab, ylab = ylab, zlab = zlab,
col = col, lowess = lowess, density = density, omd = omd, ...)
}