R/AAAClasses.R

In raster: Geographic Data Analysis and Modeling

# R classes for raster (grid) type spatial data
# Robert J. Hijmans
# November 2008
# Version 1.0
# Licence GPL v3


setClass("Extent",
	representation (
		xmin = "numeric",
		xmax = "numeric",
		ymin = "numeric",
		ymax = "numeric"
	),	
	prototype (	
		xmin = 0,
		xmax = 1,
		ymin = 0,
		ymax = 1
	),
	validity = function(object)	{
		c1 <- (object@xmin <= object@xmax)
		c2 <- (object@ymin <= object@ymax)
		# fix to not break dependencies
		if (is.na(c1)) c1 <- TRUE
		if (is.na(c2)) c2 <- TRUE
		if (!c1) { stop("invalid extent: xmin >= xmax") }
		if (!c2) { stop("invalid extent: ymin >= ymax") }
		return(c1 & c2)
		# fix to not break dependencies
		#v <- c(object@xmin, object@xmax, object@ymin, object@ymax)
		#c3 <- all(!is.infinite(v))
		#if (!c3) { stop("invalid extent: infinite value") }		
		#return(c1 & c2 & c3)
	}
)




setClass(".Rotation",
	representation (
		geotrans = "numeric",
		transfun = "function"
	)
)


setClass ("BasicRaster",
	representation (
		title = "character",
		extent = "Extent",
		rotated = "logical",
		rotation = ".Rotation",
		ncols ="integer",
		nrows ="integer",
		crs = "CRS",
		#srs = "character",
		#srs = ".RasterSRS",
		history = "list",
		#meta = "list",
		z = "list"
	),
	prototype (	
		crs = CRS(doCheckCRSArgs=FALSE),
		rotated = FALSE,
		ncols= as.integer(1),
		nrows= as.integer(1),
		history = list(),
		#meta = list(),
		z = list()
	),
	validity = function(object) {
		methods::validObject(extent(object))
		c1 <- (object@ncols > 0)
		if (!c1) { stop("ncols < 1") }
		c2 <- (object@nrows > 0)
		if (!c2) { stop("nrows < 1") }		
		return(c1 & c2)
	}
)

setClass ("Raster", contains = c("BasicRaster", "VIRTUAL") )

	
setClass(".RasterFile", 
	representation (
		name ="character",
		datanotation="character",
		byteorder ="character",
		nodatavalue ="numeric", # on disk, in ram it is NA
		NAchanged ="logical",
		nbands ="integer",
		bandorder ="character",
		offset="integer",
		toptobottom="logical",
		blockrows="integer",
		blockcols="integer",
		driver ="character",
		open = "logical"
		),
	prototype (	
	    name = "",
		datanotation="FLT4S",
		byteorder = .Platform$endian,
		nodatavalue = -Inf,
		NAchanged = FALSE,
		nbands = as.integer(1),
		bandorder = "BIL",
		offset = as.integer(0),
		toptobottom = TRUE,
		blockrows = as.integer(0),
		blockcols= as.integer(0),
		driver = "", 
		open = FALSE
	),
	validity = function(object) {
		c1 <- object@datanotation %in% c("LOG1S", "INT1S", "INT2S", "INT4S", "INT1U", "INT2U", "FLT4S", "FLT8S")
		return(c1)
	}
)


setClass(".SingleLayerData", 
	representation (
		values="vector", 
		offset="numeric",
		gain="numeric",
		
		inmemory="logical",
		fromdisk="logical",
		
		isfactor = "logical",
		attributes = "list",
		
		haveminmax = "logical",
		min = "vector",
		max = "vector",
		band = "integer",
		unit = "character",
		names = "vector"
		),
	prototype (	
		values=vector(),
		offset=0,
		gain=1,
		
		inmemory=FALSE,
		fromdisk=FALSE,

		isfactor = FALSE,
		attributes = list(),
		
		haveminmax = FALSE,
		min = c(Inf),
		max = c(-Inf),
		band = as.integer(1),
		unit = "",
		names=c("")
		
	),	
	validity = function(object) {
	}
)




setClass (".RasterLegend",
	representation (
		type = "character",
		values = "vector",
		color = "vector",
		names = "vector",
		colortable = "vector"
		),
	prototype (
		)
	)
	

	
setClass ("RasterLayer",
	contains = "Raster",
	representation (
		file = ".RasterFile",
		data = ".SingleLayerData",
		legend = ".RasterLegend"
	)
)



setClass(".MultipleRasterData", 
	representation (
		values="matrix", 
		offset="numeric",
		gain="numeric",
		inmemory="logical",
		fromdisk="logical",
		nlayers="integer",
		dropped = "vector",
		isfactor = "logical",
		attributes = "list",
		haveminmax = "logical",
		min = "vector",
		max = "vector",
		unit = "vector",
		names= "vector"
		
		),
	prototype (	
		values=matrix(NA,0,0),
		offset=0,
		gain=1,
		#indices =vector(mode="numeric"),
		inmemory=FALSE,
		fromdisk=FALSE,
		nlayers=as.integer(0),
		dropped=NULL,
		isfactor = FALSE,
		attributes = list(),
		haveminmax = FALSE,
		min = c(Inf),
		max = c(-Inf),
		unit = c(""),
		names = c("")
	),	
	validity = function(object) {
	}
)


setClass ("RasterBrick",
	contains = "Raster",
	representation (
		file = ".RasterFile",
		data = ".MultipleRasterData",
		legend = ".RasterLegend"
	)
)

	
	
setClass ("RasterStack",
	contains = "Raster",
	representation (
	    filename ="character",
		layers ="list"
		),
	prototype (
		filename="",
		layers = list()
		),
	validity = function(object) {
		if (length(object@layers) > 1) {
			cond <- compareRaster(object@layers, extent=TRUE, rowcol=TRUE, tolerance=0.05, stopiffalse=FALSE, showwarning=FALSE) 
		} else {
			cond <- TRUE
		}
		return(cond)
	}
)



setClassUnion("RasterStackBrick", c("RasterStack", "RasterBrick"))



setClassUnion("SpatialVector", c("SpatialPoints", "SpatialLines", "SpatialPolygons"))


setClass (".RasterList",
	contains = "list",
	representation (),
	prototype (),
	validity = function(object) {
		s <- sapply(object, function(x) inherits(x, "Raster"))
		return( sum(s) == length(s))
	}
)