Diff of /pkg/R/ddenseMatrix.R

Parent Directory | Revision Log | Patch

	revision 856, Tue Aug 16 20:20:13 2005 UTC	revision 954, Wed Sep 28 19:34:31 2005 UTC
#	Line 18	Line 18
18	setMethod("rcond", signature(x = "ddenseMatrix", type = "character"),	setMethod("rcond", signature(x = "ddenseMatrix", type = "character"),
19	function(x, type, ...) callGeneric(as(x, "dgeMatrix"), type))	function(x, type, ...) callGeneric(as(x, "dgeMatrix"), type))
20
21	setMethod("t", signature(x = "ddenseMatrix"),	## Not really useful; now require *identical* class for result:
22	function(x) callGeneric(as(x, "dgeMatrix")))	## setMethod("t", signature(x = "ddenseMatrix"),
23		##        function(x) callGeneric(as(x, "dgeMatrix")))
24
25	setMethod("tcrossprod", signature(x = "ddenseMatrix"),	setMethod("tcrossprod", signature(x = "ddenseMatrix"),
26	function(x) callGeneric(as(x, "dgeMatrix")))	function(x) callGeneric(as(x, "dgeMatrix")))
#	Line 46	Line 47
47	function(x, logarithm, ...)	function(x, logarithm, ...)
48	callGeneric(as(x, "dgeMatrix"), logarithm))	callGeneric(as(x, "dgeMatrix"), logarithm))
49
50	setMethod("expm", signature(x = "ddenseMatrix"),	## now done for "dMatrix":
51	function(x) callGeneric(as(x, "dgeMatrix")))	## setMethod("expm", signature(x = "ddenseMatrix"),
52		##           function(x) callGeneric(as(x, "dgeMatrix")))
53
54	setMethod("Schur", signature(x = "ddenseMatrix", vectors = "missing"),	setMethod("Schur", signature(x = "ddenseMatrix", vectors = "missing"),
55	function(x, vectors, ...) callGeneric(as(x, "dgeMatrix")))	function(x, vectors, ...) callGeneric(as(x, "dgeMatrix")))
#	Line 56	Line 58
58	function(x, vectors, ...) callGeneric(as(x, "dgeMatrix"), vectors))	function(x, vectors, ...) callGeneric(as(x, "dgeMatrix"), vectors))
59
60
61		### NAMESPACE must export this -- also only for R version 2.2.x:
62		if(paste(R.version$major, R.version$minor, sep=".") >= "2.2") {
63		## for R 2.2.x (and later):
64
65		### cbind2
66		setMethod("cbind2", signature(x = "ddenseMatrix", y = "numeric"),
67		function(x, y) {
68		d <- dim(x); nr <- d[1]; nc <- d[2]
69		y <- rep(y, length.out = nr)# 'silent procrustes'
70		## beware of (packed) triangular, symmetric, ...
71		x <- as(x, "dgeMatrix")
72		x@x <- c(x@x, as.double(y))
73		x@Dim[2] <- nc + 1:1
74		if(is.character(dn <- x@Dimnames[[2]]))
75		x@Dimnames[[2]] <- c(dn, "")
76		x
77		})
78		## the same, (x,y) <-> (y,x):
79		setMethod("cbind2", signature(x = "numeric", y = "ddenseMatrix"),
80		function(x, y) {
81		d <- dim(y); nr <- d[1]; nc <- d[2]
82		x <- rep(x, length.out = nr)
83		y <- as(y, "dgeMatrix")
84		y@x <- c(as.double(x), y@x)
85		y@Dim[2] <- nc + 1:1
86		if(is.character(dn <- y@Dimnames[[2]]))
87		y@Dimnames[[2]] <- c("", dn)
88		y
89		})
90
91		setMethod("cbind2", signature(x = "ddenseMatrix", y = "matrix"),
92		function(x, y) callGeneric(x, as(y, "dgeMatrix")))
93		setMethod("cbind2", signature(x = "matrix", y = "ddenseMatrix"),
94		function(x, y) callGeneric(as(x, "dgeMatrix"), y))
95
96		setMethod("cbind2", signature(x = "ddenseMatrix", y = "ddenseMatrix"),
97		function(x, y) {
98		nr <- rowCheck(x,y)
99		ncx <- x@Dim[2]
100		ncy <- y@Dim[2]
101		## beware of (packed) triangular, symmetric, ...
102		hasDN <- !is.null(dnx <- dimnames(x)) |
103		!is.null(dny <- dimnames(y))
104		x <- as(x, "dgeMatrix")
105		y <- as(y, "dgeMatrix")
106		x@x <- c(x@x, y@x)
107		x@Dim[2] <- ncx + ncy
108		if(hasDN) {
109		## R and S+ are different in which names they take
110		## if they differ -- but there's no warning in any case
111		rn <- if(!is.null(dnx[[1]])) dnx[[1]] else dny[[1]]
112		cx <- dnx[[2]] ; cy <- dny[[2]]
113		cn <- if(is.null(cx) && is.null(cy)) NULL
114		else c(if(!is.null(cx)) cx else rep.int("", ncx),
115		if(!is.null(cy)) cy else rep.int("", ncy))
116		x@Dimnames <- list(rn, cn)
117		}
118		x
119		})
120
121		### rbind2 -- analogous to cbind2 --- more to do for @x though:
122
123		setMethod("rbind2", signature(x = "ddenseMatrix", y = "numeric"),
124		function(x, y) {
125		if(is.character(dn <- x@Dimnames[[1]])) dn <- c(dn, "")
126		new("dgeMatrix", Dim = x@Dim + 1:0,
127		Dimnames = list(dn, x@Dimnames[[2]]),
128		x = c(rbind2(as(x,"matrix"), y)))
129		})
130		## the same, (x,y) <-> (y,x):
131		setMethod("rbind2", signature(x = "numeric", y = "ddenseMatrix"),
132		function(x, y) {
133		if(is.character(dn <- y@Dimnames[[1]])) dn <- c("", dn)
134		new("dgeMatrix", Dim = y@Dim + 1:0,
135		Dimnames = list(dn, y@Dimnames[[2]]),
136		x = c(rbind2(x, as(y,"matrix"))))
137		})
138
139		setMethod("rbind2", signature(x = "ddenseMatrix", y = "matrix"),
140		function(x, y) callGeneric(x, as(y, "dgeMatrix")))
141		setMethod("rbind2", signature(x = "matrix", y = "ddenseMatrix"),
142		function(x, y) callGeneric(as(x, "dgeMatrix"), y))
143
144		setMethod("rbind2", signature(x = "ddenseMatrix", y = "ddenseMatrix"),
145		function(x, y) {
146		nc <- colCheck(x,y)
147		nrx <- x@Dim[1]
148		nry <- y@Dim[1]
149		dn <-
150		if(!is.null(dnx <- dimnames(x)) |
151		!is.null(dny <- dimnames(y))) {
152		## R and S+ are different in which names they take
153		## if they differ -- but there's no warning in any case
154		list(if(is.null(rx <- dnx[[1]]) && is.null(ry <- dny[[1]]))
155		NULL else
156		c(if(!is.null(rx)) rx else rep.int("", nrx),
157		if(!is.null(ry)) ry else rep.int("", nry)),
158		if(!is.null(dnx[[2]])) dnx[[2]] else dny[[2]])
159
160		} else list(NULL, NULL)
161		## beware of (packed) triangular, symmetric, ...
162		new("dgeMatrix", Dim = c(nrx + nry, nc), Dimnames = dn,
163		x = c(rbind2(as(x,"matrix"), as(y,"matrix"))))
164		})
165
166		}## R-2.2.x ff

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.856   changed lines   Added in v.954

---

root@r-forge.r-project.org	ViewVC Help
Powered by ViewVC 1.0.0