USCCANA / netdiffuseR

netdiffuseR: Analysis of Diffusion and Contagion Processes on Networks
https://USCCANA.github.io/netdiffuseR
Other
85 stars 21 forks source link

Seg fault in R CMD check #5

Closed gvegayon closed 8 years ago

gvegayon commented 8 years ago

R CMD check on CRAN version 1.16.5 detects the following error

checking examples ... ERROR
Running examples in ‘netdiffuseR-Ex.R’ failed
The error most likely occurred in:

> ### Name: egonet_attrs
> ### Title: Retrieve alter's attributes (network effects)
> ### Aliases: egonet_attrs
> 
> ### ** Examples
> 
> # Creating a random graph
> set.seed(1001)
> diffnet <- rdiffnet(150, 20, seed.graph="small-world")
> 
> # Adding attributes
> indeg <- dgr(diffnet, cmode="indegree")
> head(indeg)
  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
1 1 1 2 1 2 1 1 1 1 1 1 1 1 2 1 1 2 1 2 1
2 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1
3 2 2 2 2 2 1 3 1 2 2 1 2 2 3 3 2 2 3 2 3
4 3 2 3 2 1 2 2 2 2 1 1 2 1 1 2 2 2 1 2 2
5 5 3 3 3 4 3 4 4 2 3 3 3 2 4 5 4 4 3 3 3
6 2 2 2 1 1 2 1 2 2 2 3 3 2 3 2 2 2 2 2 2
> diffnet[["indegree"]] <- indeg
> 
> # Retrieving egonet's attributes (vertices 1 and 20)
> egonet_attrs(diffnet, V=c(1,20))
$`1`
$`1`$`1`
    value id per toa real_threshold indegree
2 1 2 1 15 0.8236725 1
150 1 150 1 20 0.5957844 2

$`1`$`20`
   value id per toa real_threshold indegree
19 1 19 1 12 0.4648842 2
21 1 21 1 18 0.6240292 1

$`2`
$`2`$`1`
    value id per toa real_threshold indegree
2 1 2 2 15 0.8236725 1
150 1 150 2 20 0.5957844 2

$`2`$`20`
   value id per toa real_threshold indegree
19 1 19 2 12 0.4648842 3
21 1 21 2 18 0.6240292 2

$`3`
$`3`$`1`
    value id per toa real_threshold indegree
2 1 2 3 15 0.8236725 1
150 1 150 3 20 0.5957844 2

$`3`$`20`
   value id per toa real_threshold indegree
19 1 19 3 12 0.4648842 3
21 1 21 3 18 0.6240292 1

$`4`
$`4`$`1`
    value id per toa real_threshold indegree
2 1 2 4 15 0.8236725 1
150 1 150 4 20 0.5957844 2

$`4`$`20`
   value id per toa real_threshold indegree
19 1 19 4 12 0.4648842 3
21 1 21 4 18 0.6240292 1

$`5`
$`5`$`1`
    value id per toa real_threshold indegree
2 1 2 5 15 0.8236725 1
150 1 150 5 20 0.5957844 1

$`5`$`20`
   value id per toa real_threshold indegree
1 1 1 5 NA 0.8657018 2
19 1 19 5 12 0.4648842 2

$`6`
$`6`$`1`
    value id per toa real_threshold indegree
2 1 2 6 15 0.8236725 1
150 1 150 6 20 0.5957844 2

$`6`$`20`
   value id per toa real_threshold indegree
19 1 19 6 12 0.4648842 2
21 1 21 6 18 0.6240292 1

$`7`
$`7`$`1`
    value id per toa real_threshold indegree
2 1 2 7 15 0.8236725 1
150 1 150 7 20 0.5957844 2

$`7`$`20`
   value id per toa real_threshold indegree
19 1 19 7 12 0.4648842 3
21 1 21 7 18 0.6240292 1

$`8`
$`8`$`1`
    value id per toa real_threshold indegree
2 1 2 8 15 0.8236725 1
150 1 150 8 20 0.5957844 2

$`8`$`20`
   value id per toa real_threshold indegree
19 1 19 8 12 0.4648842 1
21 1 21 8 18 0.6240292 1

$`9`
$`9`$`1`
    value id per toa real_threshold indegree
2 1 2 9 15 0.8236725 1
150 1 150 9 20 0.5957844 2

$`9`$`20`
   value id per toa real_threshold indegree
19 1 19 9 12 0.4648842 2
21 1 21 9 18 0.6240292 1

$`10`
$`10`$`1`
    value id per toa real_threshold indegree
2 1 2 10 15 0.8236725 1
150 1 150 10 20 0.5957844 3

$`10`$`20`
   value id per toa real_threshold indegree
19 1 19 10 12 0.4648842 2
21 1 21 10 18 0.6240292 1

$`11`
$`11`$`1`
    value id per toa real_threshold indegree
2 1 2 11 15 0.8236725 1
111 1 111 11 NA 0.8859662 3

$`11`$`20`

 *** caught segfault ***
address 0x3033303334, cause 'memory not mapped'

Traceback:
 1: pmatch(as.character(control), c("all", "keepInteger", "quoteExpressions", "showAttributes", "useSource", "warnIncomplete", "delayPromises", "keepNA", "S_compatible", "hexNumeric", "digits17"))
 2: .deparseOpts(control)
 3: deparse(x[[1L]])
 4: mode(expr)
 5: match(x, table, nomatch = 0L)
 6: mode(expr) %in% c("call", "expression", "(", "function")
 7: deparse(substitute(x), width.cutoff = 500L)
 8: paste(deparse(substitute(x), width.cutoff = 500L), collapse = " ")
 9: as.data.frame.AsIs(x[[i]], optional = TRUE, stringsAsFactors = stringsAsFactors)
10: as.data.frame(x[[i]], optional = TRUE, stringsAsFactors = stringsAsFactors)
11: (function (..., row.names = NULL, check.rows = FALSE, check.names = TRUE, fix.empty.names = TRUE, stringsAsFactors = default.stringsAsFactors()) { data.row.names <- if (check.rows && is.null(row.names)) function(current, new, i) { if (is.character(current)) new <- as.character(new) if (is.character(new)) current <- as.character(current) if (anyDuplicated(new)) return(current) if (is.null(current)) return(new) if (all(current == new) || all(current == "")) return(new) stop(gettextf("mismatch of row names in arguments of 'data.frame', item %d", i), domain = NA) } else function(current, new, i) { if (is.null(current)) { if (anyDuplicated(new)) { warning(gettextf("some row.names duplicated: %s --> row.names NOT used", paste(which(duplicated(new)), collapse = ",")), domain = NA) current } else new } else current } object <- as.list(substitute(list(...)))[-1L] mirn <- missing(row.names) mrn <- is.null(row.names) x <- list(...) n <- length(x) if (n < 1L) { if (!mrn) { if (is.object(row.names) || !is.integer(row.names)) row.names <- as.character(row.names) if (anyNA(row.names)) stop("row names contain missing values") if (anyDuplicated(row.names)) stop(gettextf("duplicate row.names: %s", paste(unique(row.names[duplicated(row.names)]), collapse = ", ")), domain = NA) } else row.names <- integer() return(structure(list(), names = character(), row.names = row.names, class = "data.frame")) } vnames <- names(x) if (length(vnames) != n) vnames <- character(n) no.vn <- !nzchar(vnames) vlist <- vnames <- as.list(vnames) nrows <- ncols <- integer(n) for (i in seq_len(n)) { xi <- if (is.character(x[[i]]) || is.list(x[[i]])) as.data.frame(x[[i]], optional = TRUE, stringsAsFactors = stringsAsFactors) else as.data.frame(x[[i]], optional = TRUE) nrows[i] <- .row_names_info(xi) ncols[i] <- length(xi) namesi <- names(xi) if (ncols[i] > 1L) { if (length(namesi) == 0L) namesi <- seq_len(ncols[i]) vnames[[i]] <- if (no.vn[i]) namesi else paste(vnames[[i]], namesi, sep = ".") } else if (length(namesi)) { vnames[[i]] <- namesi } else if (fix.empty.names && no.vn[[i]]) { tmpname <- deparse(object[[i]], nlines = 1L)[1L] if (substr(tmpname, 1L, 2L) == "I(") { ntmpn <- nchar(tmpname, "c") if (substr(tmpname, ntmpn, ntmpn) == ")") tmpname <- substr(tmpname, 3L, ntmpn - 1L) } vnames[[i]] <- tmpname } if (mirn && nrows[i] > 0L) { rowsi <- attr(xi, "row.names") if (any(nzchar(rowsi))) row.names <- data.row.names(row.names, rowsi, i) } nrows[i] <- abs(nrows[i]) vlist[[i]] <- xi } nr <- max(nrows) for (i in seq_len(n)[nrows < nr]) { xi <- vlist[[i]] if (nrows[i] > 0L && (nr%%nrows[i] == 0L)) { xi <- unclass(xi) fixed <- TRUE for (j in seq_along(xi)) { xi1 <- xi[[j]] if (is.vector(xi1) || is.factor(xi1)) xi[[j]] <- rep(xi1, length.out = nr) else if (is.character(xi1) && inherits(xi1, "AsIs")) xi[[j]] <- structure(rep(xi1, length.out = nr), class = class(xi1)) else if (inherits(xi1, "Date") || inherits(xi1, "POSIXct")) xi[[j]] <- rep(xi1, length.out = nr) else { fixed <- FALSE break } } if (fixed) { vlist[[i]] <- xi next } } stop(gettextf("arguments imply differing number of rows: %s", paste(unique(nrows), collapse = ", ")), domain = NA) } value <- unlist(vlist, recursive = FALSE, use.names = FALSE) vnames <- unlist(vnames[ncols > 0L]) if (fix.empty.names && any(noname <- !nzchar(vnames))) vnames[noname] <- paste("Var", seq_along(vnames), sep = ".")[noname] if (check.names) { if (fix.empty.names) vnames <- make.names(vnames, unique = TRUE) else { nz <- nzchar(vnames) vnames[nz] <- make.names(vnames[nz], unique = TRUE) } } names(value) <- vnames if (!mrn) { if (length(row.names) == 1L && nr != 1L) { if (is.character(row.names)) row.names <- match(row.names, vnames, 0L) if (length(row.names) != 1L || row.names < 1L || row.names > length(vnames)) stop("'row.names' should specify one of the variables") i <- row.names row.names <- value[[i]] value <- value[-i] } else if (!is.null(row.names) && length(row.names) != nr) stop("row names supplied are of the wrong length") } else if (!is.null(row.names) && length(row.names) != nr) { warning("row names were found from a short variable and have been discarded") row.names <- NULL } if (is.null(row.names)) row.names <- .set_row_names(nr) else { if (is.object(row.names) || !is.integer(row.names)) row.names <- as.character(row.names) if (anyNA(row.names)) stop("row names contain missing values") if (anyDuplicated(row.names)) stop(gettextf("duplicate row.names: %s", paste(unique(row.names[duplicated(row.names)]), collapse = ", ")), domain = NA) } attr(value, "row.names") <- row.names attr(value, "class") <- "data.frame" value})(value = c("1", "1"), id = c("19", "86"), per = c("11", "11"), toa = c("12", "17"), real_threshold = c("0.4648842", "0.5012968"), indegree = c("3", "3"), check.names = FALSE, fix.empty.names = FALSE, stringsAsFactors = TRUE, row.names = c("19", "86"))
12: do.call(data.frame, c(x, alis))
13: as.data.frame.list(rval, row.names = row.names(x), col.names = names(x), optional = TRUE, fix.empty.names = FALSE, cut.names = TRUE)
14: format.data.frame(x, digits = digits, na.encode = FALSE)
15: as.matrix(format.data.frame(x, digits = digits, na.encode = FALSE))
16: print.data.frame(list(value = c(1, 1), id = c(19, 86), per = c(11L, 11L), toa = c(12L, 17L), real_threshold = c(0.464884191518649, 0.501296792412177), indegree = c(3, 3)))
17: print(list(value = c(1, 1), id = c(19, 86), per = c(11L, 11L), toa = c(12L, 17L), real_threshold = c(0.464884191518649, 0.501296792412177), indegree = c(3, 3)))
An irrecoverable exception occurred. R is aborting now ...
Segmentation fault
gvegayon commented 8 years ago

Seems to be a problem on CRAN's side (already solved)