1# Author: Robert J. Hijmans
2# Date :  April 2012
3# Version 1.0
4# Licence GPL v3
5
6
7
8setMethod ('print', 'Raster',
9	function(x, ...) {
10		if (inherits(x, 'RasterStack')) {
11			show(x)
12		} else {
13			if (x@file@driver == 'netcdf') {
14				nc <- ncdf4::nc_open(x@file@name, suppress_dimvals = TRUE)
15				print(nc)
16				ncdf4::nc_close(nc)
17			} else if (any(is.factor(x))) {
18				cat('factor levels (value attributes)\n')
19				f <- x@data@attributes
20				for (i in 1:length(f)) {
21					ff <- f[[i]]
22					if (!is.null(ff)) {
23						if (nrow(ff) > 15) {
24							ff <- ff[1:15,]
25						}
26						print(ff)
27					}
28				}
29			# cat('levels      :' , paste(object@data@levels, collapse=', '), '\n')
30			# cat('labels      :' , paste(object@data@labels, collapse=', '), '\n')
31			} else {
32				methods::callNextMethod(x, ...)
33			}
34		}
35	}
36)
37
38
39
40setMethod ('show' , 'Spatial',
41	function(object) {
42		.printSpatial(object)
43	}
44)
45
46
47setMethod ('show' , 'SpatialPoints',
48	function(object) {
49		.printSpatial(object)
50	}
51)
52
53setMethod ('show' , 'SpatialPointsDataFrame',
54	function(object) {
55		.printSpatial(object)
56	}
57)
58
59setMethod ('print' , 'Spatial',
60	function(x, ...) {
61		.printSpatial(x)
62	}
63)
64
65
66.printSpatial <- function(x, ...) {
67
68	cat('class       :' , class(x), '\n')
69	isRaster <- hasData <- FALSE
70	nc <- 0
71	if (.hasSlot(x, 'data')) {
72		nc <- ncol(x@data)
73		hasData <- TRUE
74	}
75	ln <- 1
76	if (inherits(x, 'SpatialPixels')) {
77		isRaster <- TRUE
78		cr <- x@grid@cells.dim
79		cat ('dimensions  : ', cr[2], ', ', cr[1], ', ', nrow(x@coords), ', ', nc, '  (nrow, ncol, npixels, nlayers)\n', sep="" )
80		cs <- x@grid@cellsize
81		cat ('resolution  : ', cs[1], ', ', cs[2], '  (x, y)\n', sep="")
82
83	} else if (inherits(x, 'SpatialGrid')) {
84		isRaster <- TRUE
85		cr <- x@grid@cells.dim
86		cat ('dimensions  : ', cr[2], ', ', cr[1], ', ', prod(cr), ', ', nc, '  (nrow, ncol, ncell, nlayers)\n', sep="" )
87		cs <- x@grid@cellsize
88		cat ('resolution  : ', cs[1], ', ', cs[2], '  (x, y)\n', sep="")
89
90	} else {
91		nf <- length(x)
92		cat('features    :' , nf, '\n')
93	}
94
95	e <- sp::bbox(x)
96	if (nf > 0) {
97		cat('extent      : ' , e[1,1], ', ', e[1,2], ', ', e[2,1], ', ', e[2,2], '  (xmin, xmax, ymin, ymax)\n', sep="")
98	}
99
100	cat('crs         :' , x@proj4string@projargs, '\n')
101
102	if (hasData) {
103		x <- x@data
104		maxnl <- 15
105
106		if (! isRaster) {
107			cat('variables   : ', nc, '\n', sep="" )
108		}
109		if (nc > 0) {
110			if (nc > maxnl) {
111				x <- x[, 1:maxnl]
112			}
113			ln <- colnames(x)
114			if (nc > maxnl) {
115				ln <- c(ln[1:maxnl], '...')
116				x <- x[, 1:maxnl]
117			}
118			wrn <- getOption('warn')
119			on.exit(options('warn' = wrn))
120			options('warn'=-1)
121
122			# r <- apply(x, 2, range, na.rm=TRUE)
123			# can give bad sorting (locale dependent)
124			# because as.matrix can add whitespace to numbers
125
126			rangefun <- function(x) {
127				if(is.factor(x)) {
128					range(as.character(x), na.rm=TRUE)
129				} else {
130					range(x, na.rm=TRUE)
131				}
132			}
133			r <- sapply(x, rangefun)
134			i <- r[1,] == "Inf"
135			r[,i] <- NA
136
137			minv <- as.vector(r[1, ])
138			maxv <- as.vector(r[2, ])
139			if (nc > maxnl) {
140				minv <- c(minv, '...')
141				maxv <- c(maxv, '...')
142			}
143
144			w <- pmax(nchar(ln), nchar(minv), nchar(maxv))
145			w[is.na(w)] <- 2
146			m <- rbind(ln, minv, maxv)
147
148			# a loop because 'width' is not recycled by format
149			for (i in 1:ncol(m)) {
150				m[,i] <- format(m[,i], width=w[i], justify="right")
151			}
152
153			cat('names       :', paste(m[1,], collapse=', '), '\n')
154			if (nf > 1) {
155				cat('min values  :', paste(m[2,], collapse=', '), '\n')
156				cat('max values  :', paste(m[3,], collapse=', '), '\n')
157			} else if (nf == 1) {
158				cat('value       :', paste(m[2,], collapse=', '), '\n')
159			}
160		}
161	}
162}
163
164
165