SCM

SCM Repository

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

Diff of /pkg/R/sparseMatrix.R

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

revision 1473, Fri Sep 1 15:43:32 2006 UTC revision 1474, Fri Sep 1 22:35:29 2006 UTC
# Line 59  Line 59 
59            }            }
60        })        })
61    
 ## FIXME: in the case of NEL or other sparse graphs, we really should *NOT* go  
 ##        via a *dense* adjacency matrix as we do here :  
 setAs("graph", "sparseMatrix",  
       function(from) as(as(from, "graphAM"), "sparseMatrix"))  
 ## but rather  
 if(FALSE) { #------------------------- NOT YET -----------------  
62  setAs("graph", "sparseMatrix",  setAs("graph", "sparseMatrix",
63        function(from) as(as(from, "graphNEL"), "sparseMatrix"))        function(from) as(as(from, "graphNEL"), "sparseMatrix"))
64    }
65    
66  setAs("graphNEL", "sparseMatrix",  setAs("graphNEL", "CsparseMatrix",
67        function(from) {        function(from) {
68            nd <- nodes(from)            nd <- nodes(from)
69              dm <- rep.int(length(nd), 2)
70            symm <- edgemode(from) == "undirected"            symm <- edgemode(from) == "undirected"
71            if(graph.has.weights(from)) {  
72                ## symm <- symm && <weights must also be symmetric>: improbable  ##        if(graph.has.weights(from)) {
73                ## if(symm) new("dsTMatrix", .....) else  ##               .bail.out.2(.Generic, class(from), to)
74                new("dgTMatrix", .....)  ##            ## symm <- symm && <weights must also be symmetric>: improbable
75            }  ##            ## if(symm) new("dsTMatrix", .....) else
76            else { ## no weights: 0/1 matrix -> logical  ##            ##new("dgTMatrix", )
77                if(symm) new("lsTMatrix", .....)  ##        }
78                else     new("lgTMatrix", .....)  ##        else { ## no weights: 0/1 matrix -> logical
79              edges <- lapply(from@edgeL[nd], "[[", "edges")
80              lens <- unlist(lapply(edges, length))
81              nnz <- sum(unlist(lens))  # number of non-zeros
82              i <- unname(unlist(edges) - 1:1) # row indices (0-based)
83              j <- rep.int(0:(dm[1]-1), lens) # column indices (0-based)
84              if(symm) {                    # ensure upper triangle
85                  tmp <- i
86                  flip <- i > j
87                  i[flip] <- j[flip]
88                  j[flip] <- tmp[flip]
89                  dtm <- new("lsTMatrix", i = i, j = j, Dim = dm,
90                               Dimnames = list(nd, nd), uplo = "U")
91              } else {
92                  dtm <- new("lgTMatrix", i = i, j = j, Dim = dm,
93                               Dimnames = list(nd, nd))
94            }            }
95              as(dtm, "CsparseMatrix")
96    ##        }
97        })        })
98  }# not yet  
99    setAs("graphNEL", "sparseMatrix", function(from) as(from, "CsparseMatrix"))
100    
101    
102  setAs("sparseMatrix", "graph", function(from) as(from, "graphNEL"))  setAs("sparseMatrix", "graph", function(from) as(from, "graphNEL"))
103  setAs("sparseMatrix", "graphNEL",  setAs("sparseMatrix", "graphNEL",
# Line 320  Line 335 
335  ## .as.dgC.Fun  ## .as.dgC.Fun
336  setMethod("rowSums", signature(x = "sparseMatrix"), .as.dgC.Fun)  setMethod("rowSums", signature(x = "sparseMatrix"), .as.dgC.Fun)
337  setMethod("rowMeans", signature(x = "sparseMatrix"),.as.dgC.Fun)  setMethod("rowMeans", signature(x = "sparseMatrix"),.as.dgC.Fun)
   

Legend:
Removed from v.1473  
changed lines
  Added in v.1474

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