SCM Repository

[matrix] Diff of /pkg/Matrix/R/ddenseMatrix.R
 [matrix] / pkg / Matrix / R / ddenseMatrix.R

Diff of /pkg/Matrix/R/ddenseMatrix.R

revision 2106, Wed Jan 23 09:36:04 2008 UTC revision 2112, Mon Feb 18 08:24:46 2008 UTC
# Line 11  Line 11
11            else from            else from
12        })        })
13
14
15  ## d(ouble) to l(ogical):  ## d(ouble) to l(ogical):
16  setAs("dgeMatrix", "lgeMatrix", function(from) d2l_Matrix(from, "dgeMatrix"))  setAs("dgeMatrix", "lgeMatrix", function(from) d2l_Matrix(from, "dgeMatrix"))
17  setAs("dsyMatrix", "lsyMatrix", function(from) d2l_Matrix(from, "dsyMatrix"))  setAs("dsyMatrix", "lsyMatrix", function(from) d2l_Matrix(from, "dsyMatrix"))
# Line 120  Line 121
121
122  ### FIXME: band() et al should be extended from "ddense" to "dense" !  ### FIXME: band() et al should be extended from "ddense" to "dense" !
123  ###        However, needs much work to generalize dup_mMatrix_as_dgeMatrix()  ###        However, needs much work to generalize dup_mMatrix_as_dgeMatrix()
124    ### --> use workaround below: go via "d"(ouble) and back
125
126  ## NB: have extra tril(), triu() methods for symmetric ["dsy" and "dsp"] and  .trilDense <- function(x, k = 0, ...) {
##     for triangular ["dtr" and "dtp"]
setMethod("tril", "ddenseMatrix",
function(x, k = 0, ...) {
127                k <- as.integer(k[1])                k <- as.integer(k[1])
128                dd <- dim(x); sqr <- dd[1] == dd[2]                dd <- dim(x); sqr <- dd[1] == dd[2]
129                stopifnot(-dd[1] <= k, k <= dd[1]) # had k <= 0                stopifnot(-dd[1] <= k, k <= dd[1]) # had k <= 0
130                ## returns "lower triangular" if k <= 0 && sqr                ## returns "lower triangular" if k <= 0 && sqr
131                .Call(ddense_band, x, -dd[1], k)                .Call(ddense_band, x, -dd[1], k)
132            })  }
133    ## NB: have extra tril(), triu() methods for symmetric ["dsy" and "dsp"] and
134  setMethod("triu", "ddenseMatrix",  ##     for triangular ["dtr" and "dtp"]
135    setMethod("tril", "ddenseMatrix", .trilDense)
136    setMethod("tril",       "matrix",
137            function(x, k = 0, ...) {            function(x, k = 0, ...) {
138                  if(is.double(x)) .trilDense(x, k)
139                  else {
140                      r <- .trilDense(x, k)
141                      storage.mode(r) <- storage.mode(x)
142                      r
143                  }})
144    setMethod("tril", "denseMatrix",# all but ddense*
145              function(x, k = 0, ...)
146                  as(.trilDense(as(x, "dMatrix"), k), class(x)))
147
148    .triuDense <- function(x, k = 0, ...) {
149                k <- as.integer(k[1])                k <- as.integer(k[1])
150                dd <- dim(x); sqr <- dd[1] == dd[2]                dd <- dim(x); sqr <- dd[1] == dd[2]
151                stopifnot(-dd[1] <= k, k <= dd[1]) # had k >= 0                stopifnot(-dd[1] <= k, k <= dd[1]) # had k >= 0
152                ## returns "upper triangular" if k >= 0                ## returns "upper triangular" if k >= 0
153                .Call(ddense_band, x, k, dd[2])                .Call(ddense_band, x, k, dd[2])
154            })  }
155    setMethod("triu", "ddenseMatrix", .triuDense)
156    setMethod("triu",       "matrix",
157              function(x, k = 0, ...) {
158                  if(is.double(x)) .triuDense(x, k)
159                  else {
160                      r <- .triuDense(x, k)
161                      storage.mode(r) <- storage.mode(x)
162                      r
163                  }})
164    setMethod("triu", "denseMatrix",# all but ddense*
165              function(x, k = 0, ...)
166                  as(.triuDense(as(x, "dMatrix"), k), class(x)))
167
168  setMethod("band", "ddenseMatrix",  .bandDense <- function(x, k1, k2, ...) {
function(x, k1, k2, ...) {
169                k1 <- as.integer(k1[1])                k1 <- as.integer(k1[1])
170                k2 <- as.integer(k2[1])                k2 <- as.integer(k2[1])
171                dd <- dim(x); sqr <- dd[1] == dd[2]                dd <- dim(x); sqr <- dd[1] == dd[2]
# Line 152  Line 175
175                    as(r, paste(.M.kind(x), "syMatrix", sep=''))                    as(r, paste(.M.kind(x), "syMatrix", sep=''))
176                else                else
177                    r                    r
178            })  }
179
180    setMethod("band", "ddenseMatrix", .bandDense)
181    setMethod("band",       "matrix",
182              function(x, k1, k2, ...) {
183                  if(is.double(x)) .bandDense(x, k1, k2)
184                  else {
185                      r <- .bandDense(x, k1, k2)
186                      storage.mode(r) <- storage.mode(x)
187                      r
188                  }})
189    setMethod("band", "denseMatrix",# all but ddense*
190              function(x, k1, k2, ...)
191                  as(.bandDense(as(x, "dMatrix"), k1, k2), class(x)))
192
193    setMethod("symmpart", signature(x = "ddenseMatrix"),
194              function(x) .Call(ddense_symmpart, x))
195    setMethod("skewpart", signature(x = "ddenseMatrix"),
196              function(x) .Call(ddense_skewpart, x))
197

Legend:
 Removed from v.2106 changed lines Added in v.2112