1 2# IGraph R package 3# Copyright (C) 2012 Gabor Csardi <csardi.gabor@gmail.com> 4# 334 Harvard street, Cambridge, MA 02139 USA 5# 6# This program is free software; you can redistribute it and/or modify 7# it under the terms of the GNU General Public License as published by 8# the Free Software Foundation; either version 2 of the License, or 9# (at your option) any later version. 10# 11# This program is distributed in the hope that it will be useful, 12# but WITHOUT ANY WARRANTY; without even the implied warranty of 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14# GNU General Public License for more details. 15# 16# You should have received a copy of the GNU General Public License 17# along with this program; if not, write to the Free Software 18# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 19# 02110-1301 USA 20# 21################################################################### 22 23# This is a sparse data frame. It is like a regular data frame, 24# but it allows for some columns to be constant, and then it 25# stores that column more economically. 26 27sdf <- function(..., row.names = NULL, NROW = NULL) { 28 29 cols <- list(...) 30 31 if (is.null(names(cols)) || any(names(cols) == "") || 32 any(duplicated(names(cols)))) { 33 stop("Columns must be have (unique) names") 34 } 35 36 lens <- sapply(cols, length) 37 n1lens <- lens[ lens != 1 ] 38 39 if (length(unique(n1lens)) > 1) { 40 stop("Columns must be constants or have the same length") 41 } 42 43 if (length(n1lens) == 0) { 44 if (is.null(NROW)) { 45 stop("Cannot determine number of rows") 46 } 47 attr(cols, "NROW") <- NROW 48 } else { 49 if (!is.null(NROW) && n1lens[1] != NROW) { 50 stop("NROW does not match column lengths") 51 } 52 attr(cols, "NROW") <- unname(n1lens[1]) 53 } 54 55 class(cols) <- "igraphSDF" 56 attr(cols, "row.names") <- row.names 57 58 cols 59} 60 61#' @method as.data.frame igraphSDF 62 63as.data.frame.igraphSDF <- function(x, row.names, optional, ...) { 64 as.data.frame(lapply(x, rep, length.out=attr(x, "NROW"))) 65} 66 67#' @method "[" igraphSDF 68 69`[.igraphSDF` <- function(x, i, j, ..., drop=TRUE) { 70 if (!is.character(j)) { 71 stop("The column index must be character") 72 } 73 if (!missing(i) && !is.numeric(i)) { 74 stop("The row index must be numeric") 75 } 76 if (missing(i)) { 77 rep(x[[j]], length.out=attr(x, "NROW")) 78 } else { 79 if (length(x[[j]])==1) { 80 rep(x[[j]], length(i)) 81 } else { 82 x[[j]][i] 83 } 84 } 85} 86 87#' @method "[<-" igraphSDF 88 89`[<-.igraphSDF` <- function(x, i, j, value) { 90 if (!is.character(j)) { 91 stop("The column index must be character") 92 } 93 if (!missing(i) && !is.numeric(i)) { 94 stop("Row index must be numeric, if given") 95 } 96 if (missing(i)) { 97 if (length(value) != attr(x, "NROW") && length(value) != 1) { 98 stop("Replacement value has the wrong length") 99 } 100 x[[j]] <- value 101 } else { 102 if (length(value) != length(i) && length(value) != 1) { 103 stop("Replacement value has the wrong length") 104 } 105 tmp <- rep(x[[j]], length=attr(x, "NROW")) 106 tmp[i] <- value 107 if (length(unique(tmp)) == 1) { 108 tmp <- tmp[1] 109 } 110 x[[j]] <- tmp 111 } 112 113 x 114} 115