SCM

SCM Repository

[matrix] Diff of /pkg/R/Auxiliaries.R
ViewVC logotype

Diff of /pkg/R/Auxiliaries.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 956, Fri Sep 30 17:28:00 2005 UTC revision 1198, Mon Jan 23 15:01:02 2006 UTC
# Line 40  Line 40 
40      h.a <- !identical(nullDN, dna <- dimnames(a))      h.a <- !identical(nullDN, dna <- dimnames(a))
41      h.b <- !identical(nullDN, dnb <- dimnames(b))      h.b <- !identical(nullDN, dnb <- dimnames(b))
42      if(h.a || h.b) {      if(h.a || h.b) {
43          if (!h.b) h.a          if (!h.b) dna
44          else if(!h.a) h.b          else if(!h.a) dnb
45          else { ## both have non-trivial dimnames          else { ## both have non-trivial dimnames
46              r <- dna # "default" result              r <- dna # "default" result
47              for(j in 1:2) {              for(j in 1:2) {
# Line 215  Line 215 
215      stopifnot(is(from, "lMatrix"))      stopifnot(is(from, "lMatrix"))
216      fixupDense(new(sub("^l", "d", class(from)),      fixupDense(new(sub("^l", "d", class(from)),
217                     x = as.double(from@x),                     x = as.double(from@x),
218                     Dim = from@Dim, Dimnames = from@Dimnames,                     Dim = from@Dim, Dimnames = from@Dimnames),
                    factors = list()), ## FIXME: treat 'factors' smartly  
219                 from)                 from)
220        ## FIXME: treat 'factors' smartly {not for triangular!}
221  }  }
222    
223  if(FALSE)# unused  if(FALSE)# unused
# Line 230  Line 230 
230  d2l_Matrix <- function(from) {  d2l_Matrix <- function(from) {
231      stopifnot(is(from, "dMatrix"))      stopifnot(is(from, "dMatrix"))
232      fixupDense(new(sub("^d", "l", class(from)),      fixupDense(new(sub("^d", "l", class(from)),
233                     Dim = from@Dim, Dimnames = from@Dimnames,                     Dim = from@Dim, Dimnames = from@Dimnames),
                    factors = list()), ## FIXME: treat 'factors' smartly  
234                 from)                 from)
235        ## FIXME: treat 'factors' smartly {not for triangular!}
236    }
237    
238    
239    try_as <- function(x, classes, tryAnyway = FALSE) {
240        if(!tryAnyway && !is(x, "Matrix"))
241            return(x)
242        ## else
243        ok <- canCoerce(x, classes[1])
244        while(!ok && length(classes <- classes[-1])) {
245            ok <- canCoerce(x, classes[1])
246        }
247        if(ok) as(x, classes[1]) else x
248    }
249    
250    if(paste(R.version$major, R.version$minor, sep=".") < "2.3")
251        ## This will be in R 2.3.0
252    canCoerce <- function(object, Class) {
253      ## Purpose:  test if 'object' is coercable to 'Class', i.e.,
254      ##           as(object, Class) will {typically} work
255      ## ----------------------------------------------------------------------
256      ## Author: John Chambers, Date:  6 Oct 2005
257       is(object, Class) ||
258       !is.null(selectMethod("coerce", c(class(object), Class),
259                             optional = TRUE,
260                             useInherited = c(from = TRUE, to = FALSE)))
261    }
262    
263    .is.triangular <- function(object, upper = TRUE) {
264        ## pretest: is it square?
265        d <- dim(object)
266        if(d[1] != d[2]) return(FALSE)
267        ## else slower test
268        if(!is.matrix(object))
269            object <- as(object,"matrix")
270        ## == 0 even works for logical & complex:
271        if(upper)
272            all(object[lower.tri(object)] == 0)
273        else
274            all(object[upper.tri(object)] == 0)
275    }
276    
277    .is.diagonal <- function(object) {
278        d <- dim(object)
279        if(d[1] != (n <- d[2])) FALSE
280        else all(object[rep(c(FALSE, rep.int(TRUE,n)), length = n^2)] == 0)
281  }  }

Legend:
Removed from v.956  
changed lines
  Added in v.1198

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge