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 954, Wed Sep 28 19:34:31 2005 UTC revision 956, Fri Sep 30 17:28:00 2005 UTC
# Line 34  Line 34 
34      da      da
35  }  }
36    
37    dimNamesCheck <- function(a, b) {
38        ## assume dimCheck() has happened before
39        nullDN <- list(NULL,NULL)
40        h.a <- !identical(nullDN, dna <- dimnames(a))
41        h.b <- !identical(nullDN, dnb <- dimnames(b))
42        if(h.a || h.b) {
43            if (!h.b) h.a
44            else if(!h.a) h.b
45            else { ## both have non-trivial dimnames
46                r <- dna # "default" result
47                for(j in 1:2) {
48                    dn <- dnb[[j]]
49                    if(is.null(r[[j]]))
50                        r[[j]] <- dn
51                    else if (!is.null(dn) && any(r[[j]] != dn))
52                        warning(gettextf("dimnames [%d] mismatch in %s", j,
53                                         deparse(sys.call(sys.parent()))),
54                                call. = FALSE)
55                }
56                r
57            }
58        }
59        else
60            nullDN
61    }
62    
63  rowCheck <- function(a, b) {  rowCheck <- function(a, b) {
64      da <- dim(a)      da <- dim(a)
65      db <- dim(b)      db <- dim(b)
# Line 56  Line 82 
82      da[2]      da[2]
83  }  }
84    
85    emptyColnames <- function(x)
86    {
87        ## Useful for compact printing of (parts) of sparse matrices
88        ## possibly  dimnames(x) "==" NULL :
89        dimnames(x) <- list(dimnames(x)[[1]], rep("", dim(x)[2]))
90        x
91    }
92    
93  prTriang <- function(x, digits = getOption("digits"),  prTriang <- function(x, digits = getOption("digits"),
94                       justify = "none", right = TRUE)                       justify = "none", right = TRUE)
# Line 166  Line 199 
199      # and keep x@diag      # and keep x@diag
200      x      x
201  }  }
202    
203    fixupDense <- function(m, from) {
204        if(is(m, "triangularMatrix")) {
205            m@uplo <- from@uplo
206            m@diag <- from@diag
207        } else if(is(m, "symmetricMatrix")) {
208            m@uplo <- from@uplo
209        }
210        m
211    }
212    
213    ## -> ./ldenseMatrix.R :
214    l2d_Matrix <- function(from) {
215        stopifnot(is(from, "lMatrix"))
216        fixupDense(new(sub("^l", "d", class(from)),
217                       x = as.double(from@x),
218                       Dim = from@Dim, Dimnames = from@Dimnames,
219                       factors = list()), ## FIXME: treat 'factors' smartly
220                   from)
221    }
222    
223    if(FALSE)# unused
224    l2d_meth <- function(x) {
225        cl <- class(x)
226        as(callGeneric(as(x, sub("^l", "d", cl))), cl)
227    }
228    
229    ## -> ./ddenseMatrix.R :
230    d2l_Matrix <- function(from) {
231        stopifnot(is(from, "dMatrix"))
232        fixupDense(new(sub("^d", "l", class(from)),
233                       Dim = from@Dim, Dimnames = from@Dimnames,
234                       factors = list()), ## FIXME: treat 'factors' smartly
235                   from)
236    }

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

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