The R Project SVN R-packages

Rev

Rev 3543 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 3543 Rev 3782
Line 61... Line 61...
61 
 
 61 
 
62 
setAs("graph", "CsparseMatrix",
 62 
setAs("graph", "CsparseMatrix",
63 
      function(from) as(as(from, "graphNEL"), "CsparseMatrix"))
 63 
      function(from) as(as(from, "graphNEL"), "CsparseMatrix"))
64 
 
 64 
 
65 
setAs("graphNEL", "CsparseMatrix",
 65 
setAs("graphNEL", "CsparseMatrix",
- 
 
 66 
      function(from) as(as(from, "TsparseMatrix"), "CsparseMatrix"))
- 
 
 67 
 
- 
 
 68 
setAs("graphNEL", "TsparseMatrix",
66 
      function(from) {
 69 
      function(from) {
67 
	  nd <- nodes(from)
 70 
          nd <- nodes(from)
68 
          dm <- rep.int(length(nd), 2)
 71 
          dm <- rep.int(length(nd), 2)
69 
	  symm <- edgemode(from) == "undirected"
 72 
	  symm <- edgemode(from) == "undirected"
70 
 
 73 
 
71 
## 	  if(graph.has.weights(from)) {
 74 
 	  if(graph.has.weights(from)) {
- 
 
 75 
	      eWts <- edgeWeights(from)
72 
##               .bail.out.2(.Generic, class(from), to)
 76 
	      lens <- unlist(lapply(eWts, length))
- 
 
 77 
	      i <- rep.int(0:(dm[1]-1), lens) # column indices (0-based)
- 
 
 78 
	      To <- unlist(lapply(eWts, names))
- 
 
 79 
	      j <- as.integer(match(To,nd) - 1:1) # row indices (0-based)
73 
## 	      ## symm <- symm && <weights must also be symmetric>: improbable
 80 
	      ## symm <- symm && <weights must also be symmetric>: improbable
74 
## 	      ## if(symm) new("dsTMatrix", .....) else
 81 
	      ## if(symm) new("dsTMatrix", .....) else
75 
## 	      ##new("dgTMatrix", )
 82 
	      new("dgTMatrix", i = i, j = j, x = unlist(eWts),
- 
 
 83 
		  Dim = dm, Dimnames = list(nd, nd))
76 
## 	  }
 84 
	  }
77 
## 	  else { ## no weights: 0/1 matrix -> logical
 85 
 	  else { ## no weights: 0/1 matrix -> logical
78 
          edges <- lapply(from@edgeL[nd], "[[", "edges")
 86 
              edges <- lapply(from@edgeL[nd], "[[", "edges")
79 
          lens <- unlist(lapply(edges, length))
 87 
              lens <- unlist(lapply(edges, length))
80 
          nnz <- sum(unlist(lens))  # number of non-zeros
 88 
              ## nnz <- sum(unlist(lens))  # number of non-zeros
81 
          i <- unname(unlist(edges) - 1:1) # row indices (0-based)
 89 
              i <- rep.int(0:(dm[1]-1), lens) # column indices (0-based)
82 
          j <- rep.int(0:(dm[1]-1), lens) # column indices (0-based)
 90 
              j <- as.integer(unlist(edges) - 1) # row indices (0-based)
83 
          if(symm) {                    # ensure upper triangle
 91 
              if(symm) {            # symmetric: ensure upper triangle
84 
              tmp <- i
 92 
                  tmp <- i
85 
              flip <- i > j
 93 
                  flip <- i > j
86 
              i[flip] <- j[flip]
 94 
                  i[flip] <- j[flip]
87 
              j[flip] <- tmp[flip]
 95 
                  j[flip] <- tmp[flip]
88 
              dtm <- new("lsTMatrix", i = i, j = j, Dim = dm,
 96 
                  new("nsTMatrix", i = i, j = j, Dim = dm,
89 
                           Dimnames = list(nd, nd), uplo = "U")
 97 
                      Dimnames = list(nd, nd), uplo = "U")
90 
          } else {
 98 
              } else {
91 
	      dtm <- new("lgTMatrix", i = i, j = j, Dim = dm,
 99 
                  new("ngTMatrix", i = i, j = j, Dim = dm,
92 
                           Dimnames = list(nd, nd))
 100 
                      Dimnames = list(nd, nd))
- 
 
 101 
              }
93 
          }
 102 
          }
94 
          as(dtm, "CsparseMatrix")
 - 
 
95 
## 	  }
 - 
 
96 
      })
 103 
      })
97 
 
 104 
 
98 
setAs("sparseMatrix", "graph", function(from) as(from, "graphNEL"))
 105 
setAs("sparseMatrix", "graph", function(from) as(from, "graphNEL"))
99 
setAs("sparseMatrix", "graphNEL",
 106 
setAs("sparseMatrix", "graphNEL",
100 
      function(from) as(as(from, "TsparseMatrix"), "graphNEL"))
 107 
      function(from) as(as(from, "TsparseMatrix"), "graphNEL"))
101 
 
 108 
 
102 
Tsp2grNEL <- function(from) {
 109 
Tsp2grNEL <- function(from) {
103 
    d <- dim(from)
 110 
    d <- dim(from)
104 
    if(d[1] != d[2])
 111 
    if(d[1] != d[2])
105 
	stop("only square matrices can be used as incidence matrices for grphs")
 112 
	stop("only square matrices can be used as incidence matrices for graphs")
106 
    n <- d[1]
 113 
    n <- d[1]
107 
    if(n == 0) return(new("graphNEL"))
 114 
    if(n == 0) return(new("graphNEL"))
108 
    if(is.null(rn <- dimnames(from)[[1]]))
 115 
    if(is.null(rn <- dimnames(from)[[1]]))
109 
	rn <- as.character(1:n)
 116 
	rn <- as.character(1:n)
110 
    from <- uniq(from) ## Need to 'uniquify' the triplets!
 117 
    from <- uniq(from) ## Need to 'uniquify' the triplets!
Line 114... Line 121...
114 
	if(!is(from, "symmetricMatrix")) {
 121 
	if(!is(from, "symmetricMatrix")) {
115 
	    ## a general matrix which happens to be symmetric
 122 
	    ## a general matrix which happens to be symmetric
116 
	    ## ==> remove the double indices
 123 
	    ## ==> remove the double indices
117 
	    from <- tril(from)
 124 
	    from <- tril(from)
118 
	}
 125 
	}
119 
	## every edge is there only once, either upper or lower triangle
 - 
 
120 
	ft1 <- cbind(from@i + 1:1, from@j + 1:1)
 - 
 
121 
	graph::ftM2graphNEL(ft1, W = from@x, V= rn, edgemode= "undirected")
 126 
        eMode <- "undirected"
122 
 
 - 
 
123 
    } else { ## not symmetric
 127 
    } else {
124 
 
 - 
 
125 
	graph::ftM2graphNEL(cbind(from@i + 1:1, from@j + 1:1),
 - 
 
126 
			    W = from@x, V= rn, edgemode= "directed")
 128 
        eMode <- "directed"
127 
    }
 129 
    }
- 
 
 130 
    ## every edge is there only once, either upper or lower triangle
- 
 
 131 
    ft1 <- cbind(rn[from@i + 1:1], rn[from@j + 1:1])
- 
 
 132 
    ## not yet: graph::ftM2graphNEL(.........)
- 
 
 133 
    ftM2graphNEL(ft1, W = from@x, V= rn, edgemode= eMode)
128 
 
 134 
 
129 
}
 135 
}
130 
setAs("TsparseMatrix", "graphNEL", Tsp2grNEL)
 136 
setAs("TsparseMatrix", "graphNEL", Tsp2grNEL)
131 
 
 137 
 
132 
 
 138