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 1564, Thu Sep 14 15:52:48 2006 UTC revision 1565, Fri Sep 15 14:02:48 2006 UTC
# Line 63  Line 63 
63        function(from) as(as(from, "graphNEL"), "CsparseMatrix"))        function(from) as(as(from, "graphNEL"), "CsparseMatrix"))
64    
65  setAs("graphNEL", "CsparseMatrix",  setAs("graphNEL", "CsparseMatrix",
66          function(from) as(as(from, "TsparseMatrix"), "CsparseMatrix"))
67    
68    setAs("graphNEL", "TsparseMatrix",
69        function(from) {        function(from) {
70            nd <- nodes(from)            nd <- nodes(from)
71            dm <- rep.int(length(nd), 2)            dm <- rep.int(length(nd), 2)
72            symm <- edgemode(from) == "undirected"            symm <- edgemode(from) == "undirected"
73    
74  ##        if(graph.has.weights(from)) {            if(graph.has.weights(from)) {
75  ##               .bail.out.2(.Generic, class(from), to)                eWts <- edgeWeights(from)
76  ##            ## symm <- symm && <weights must also be symmetric>: improbable                lens <- unlist(lapply(eWts, length))
77  ##            ## if(symm) new("dsTMatrix", .....) else                i <- rep.int(0:(dm[1]-1), lens) # column indices (0-based)
78  ##            ##new("dgTMatrix", )                To <- unlist(lapply(eWts, names))
79  ##        }                j <- as.integer(match(To,nd) - 1:1) # row indices (0-based)
80  ##        else { ## no weights: 0/1 matrix -> logical                ## symm <- symm && <weights must also be symmetric>: improbable
81                  ## if(symm) new("dsTMatrix", .....) else
82                  new("dgTMatrix", i = i, j = j, x = unlist(eWts),
83                      Dim = dm, Dimnames = list(nd, nd))
84              }
85              else { ## no weights: 0/1 matrix -> logical
86            edges <- lapply(from@edgeL[nd], "[[", "edges")            edges <- lapply(from@edgeL[nd], "[[", "edges")
87            lens <- unlist(lapply(edges, length))            lens <- unlist(lapply(edges, length))
88            nnz <- sum(unlist(lens))  # number of non-zeros                ## nnz <- sum(unlist(lens))  # number of non-zeros
89            i <- unname(unlist(edges) - 1:1) # row indices (0-based)                i <- rep.int(0:(dm[1]-1), lens) # column indices (0-based)
90            j <- rep.int(0:(dm[1]-1), lens) # column indices (0-based)                j <- as.integer(unlist(edges) - 1) # row indices (0-based)
91            if(symm) {                    # ensure upper triangle                if(symm) {            # symmetric: ensure upper triangle
92                tmp <- i                tmp <- i
93                flip <- i > j                flip <- i > j
94                i[flip] <- j[flip]                i[flip] <- j[flip]
95                j[flip] <- tmp[flip]                j[flip] <- tmp[flip]
96                dtm <- new("nsTMatrix", i = i, j = j, Dim = dm,                    new("nsTMatrix", i = i, j = j, Dim = dm,
97                             Dimnames = list(nd, nd), uplo = "U")                             Dimnames = list(nd, nd), uplo = "U")
98            } else {            } else {
99                dtm <- new("ngTMatrix", i = i, j = j, Dim = dm,                    new("ngTMatrix", i = i, j = j, Dim = dm,
100                             Dimnames = list(nd, nd))                             Dimnames = list(nd, nd))
101            }            }
102            as(dtm, "CsparseMatrix")            }
 ##        }  
103        })        })
104    
105  setAs("sparseMatrix", "graph", function(from) as(from, "graphNEL"))  setAs("sparseMatrix", "graph", function(from) as(from, "graphNEL"))
# Line 116  Line 123 
123              ## ==> remove the double indices              ## ==> remove the double indices
124              from <- tril(from)              from <- tril(from)
125          }          }
126            eMode <- "undirected"
127        } else {
128            eMode <- "directed"
129        }
130          ## every edge is there only once, either upper or lower triangle          ## every edge is there only once, either upper or lower triangle
131          ft1 <- cbind(from@i + 1:1, from@j + 1:1)      ft1 <- cbind(rn[from@i + 1:1], rn[from@j + 1:1])
132          ## not yet: graph::ftM2graphNEL(.........)          ## not yet: graph::ftM2graphNEL(.........)
133          ftM2graphNEL(ft1, W = from@x, V= rn, edgemode= "undirected")      ftM2graphNEL(ft1, W = from@x, V= rn, edgemode= eMode)
   
     } else { ## not symmetric  
   
         ## not yet: graph::ftM2graphNEL(.........)  
         ftM2graphNEL(cbind(from@i + 1:1, from@j + 1:1),  
                             W = from@x, V= rn, edgemode= "directed")  
     }  
134    
135  }  }
136  setAs("TsparseMatrix", "graphNEL", Tsp2grNEL)  setAs("TsparseMatrix", "graphNEL", Tsp2grNEL)

Legend:
Removed from v.1564  
changed lines
  Added in v.1565

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