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