Intermittent errors with ggplot2, segfault: memory not mapped - r

I've been having an issue in a Shiny R application where I am getting intermittent errors when the application is supposed to render a ggplot2 plot.
The errors I've been seeing include:
Error in eval(expr, envir, enclos) :
arguments imply differing number of rows: 136, 129
and
Error in eval(expr, envir, enclos) :
Results must be all atomic, or all data frames
I'm seeing the same errors in my Shiny app.
After lots of searching, I found a recent post here that seems to reproduce the same set of errors:
http://cowboyjob.com/post/6523856/Reupping-my-question-from-a-few-hours-ago-I-have-word-from-another-channel-that
I also found this question, which may be related: Tracing root cause for R segfault
The code in that first link is as follows:
library(ggplot2)
set.seed(12345678)
sessionInfo()
littledata = data.frame(x=1:128, y=rlnorm(128))
bigdata = data.frame(x=1:129, y=rlnorm(129))
# plots as expected
lp = ggplot(littledata, aes(x, y))+geom_histogram(stat="identity", binwidth=1)
for (i in 1:20){
print(i)
try(print(lp+ggtitle(paste("128 points", i))))
}
# always warns "position_stack requires constant width",
# intermittently throws error, hangs, or segfaults.
# See below for details.
bp = ggplot(bigdata, aes(x, y))+geom_histogram(stat="identity", binwidth=1)
for(i in 1:20){
print(i)
try(print(bp+ggtitle(paste("129 points", i))))
}
## End demo code
For the machine I'm working on, here is the output from that code block:
> source('~/R/testing/segfault_test.R')
[1] 1
[1] 2
[1] 3
[1] 4
[1] 5
[1] 6
[1] 7
[1] 8
[1] 9
[1] 10
[1] 11
[1] 12
[1] 13
[1] 14
[1] 15
[1] 16
[1] 17
[1] 18
[1] 19
[1] 20
[1] 1
Error in eval(expr, envir, enclos) : replacement has length zero
In addition: Warning messages:
1: package ‘ggplot2’ was built under R version 3.1.2
2: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
[1] 2
[1] 3
[1] 4
[1] 5
Error in eval(expr, envir, enclos) :
Results must be all atomic, or all data frames
In addition: Warning messages:
1: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
2: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
3: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
4: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
[1] 6
[1] 7
Error in eval(expr, envir, enclos) :
arguments imply differing number of rows: 136, 129
In addition: Warning messages:
1: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
2: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
[1] 8
Error in eval(expr, envir, enclos) :
Results must be all atomic, or all data frames
In addition: Warning message:
In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
[1] 9
[1] 10
[1] 11
Error in eval(expr, envir, enclos) :
arguments imply differing number of rows: 136, 129
In addition: Warning messages:
1: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
2: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
3: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
[1] 12
[1] 13
Error in eval(expr, envir, enclos) :
Results must be all atomic, or all data frames
In addition: Warning messages:
1: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
2: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
[1] 14
[1] 15
Error in eval(expr, envir, enclos) :
arguments imply differing number of rows: 136, 129
In addition: Warning messages:
1: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
2: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
[1] 16
[1] 17
[1] 18
Error in eval(expr, envir, enclos) :
arguments imply differing number of rows: 136, 129
In addition: Warning messages:
1: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
2: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
3: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
[1] 19
[1] 20
Warning messages:
1: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
2: In loop_apply(n, do.ply) :
position_stack requires constant width: output may be incorrect
>
From this output, we can see that the first loop runs without any issues; however, the second loop with 129 points gives errors on some of the plots.
When I embed several ggplot plots into my shiny app, I'm seeing these errors show-up, often resulting in a segmentation fault.
Here's what I see in the javascript console when running the app on the shiny-server:
Error in eval(substitute(expr), envir, enclos) :
Results must be all atomic, or all data frames
*** caught segfault ***
address 0x2, cause 'memory not mapped'
Traceback:
1: dim(x)
2: FUN(X[[211L]], ...)
3: lapply(res, NROW)
4: unlist(lapply(res, NROW))
5: list_to_dataframe(res, attr(.data, "split_labels"), .id, id_as_factor)
6: ldply(.data = pieces, .fun = .fun, ..., .progress = .progress, .inform = .inform, .parallel = .parallel, .paropts = .paropts)
7: ddply(munched, .(group), function(df) { data.frame(solid = identical(unique(df$linetype), 1), constant = nrow(unique(df[, c("alpha", "colour", "size", "linetype")])) == 1)})
8: get(x, envir = this, inherits = inh)(this, ...)
9: GeomPath$draw(data, scales, coordinates, arrow, ...)
10: get(x, envir = this, inherits = inh)(this, ...)
11: .$draw(...)
12: get(x, envir = this, inherits = inh)(this, ...)
13: (function (...) get(x, envir = this, inherits = inh)(this, ...))(data = data, scales = scales, coordinates = cs)
14: do.call(.$geom$draw_groups, c(data = list(as.name("data")), scales = list(as.name("scales")), coordinates = list(as.name("cs")), .$geom_params))
15: get(x, envir = this, inherits = inh)(this, ...)
16: layer$make_grob(df, scales = panel$ranges[[panel_i]], cs = plot$coord)
17: .fun(piece, ...)
18: (function (i) { piece <- pieces[[i]] if (.inform) { res <- try(.fun(piece, ...)) if (inherits(res, "try-error")) { piece <- paste(capture.output(print(piece)), collapse = "\n") stop("with piece ", i, ": \n", piece, call. = FALSE) } } else { res <- .fun(piece, ...) } progress$step() res})(1L)
19: eval(substitute(expr), envir, enclos)
20: evalq((function (i) { piece <- pieces[[i]] if (.inform) { res <- try(.fun(piece, ...)) if (inherits(res, "try-error")) { piece <- paste(capture.output(print(piece)), collapse = "\n") stop("with piece ", i, ": \n", piece, call. = FALSE) } } else { res <- .fun(piece, ...) } progress$step() res})(1L), <environment>)
21: doTryCatch(return(expr), name, parentenv, handler)
22: tryCatchOne(expr, names, parentenv, handlers[[1L]])
23: tryCatchList(expr, classes, parentenv, handlers)
24: tryCatch(evalq((function (i) { piece <- pieces[[i]] if (.inform) { res <- try(.fun(piece, ...)) if (inherits(res, "try-error")) { piece <- paste(capture.output(print(piece)), collapse = "\n") stop("with piece ", i, ": \n", piece, call. = FALSE) } } else { res <- .fun(piece, ...) } progress$step() res})(1L), <environment>), error = .rcpp_error_recorder)
25: withCallingHandlers(tryCatch(evalq((function (i) { piece <- pieces[[i]] if (.inform) { res <- try(.fun(piece, ...)) if (inherits(res, "try-error")) { piece <- paste(capture.output(print(piece)), collapse = "\n") stop("with piece ", i, ": \n", piece, call. = FALSE) } } else { res <- .fun(piece, ...) } progress$step() res})(1L), <environment>), error = .rcpp_error_recorder), warning = .rcpp_warning_recorder)
aborting ...
Segmentation fault (core dumped)
The output of my sessionInfo() command is as follows:
R version 3.1.1 (2014-07-10)
Platform: x86_64-redhat-linux-gnu (64-bit)
locale:
[1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
[5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8 LC_PAPER=en_US.UTF-8 LC_NAME=C
[9] LC_ADDRESS=C LC_TELEPHONE=C LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] ggplot2_1.0.1
loaded via a namespace (and not attached):
[1] colorspace_1.2-6 digest_0.6.8 grid_3.1.2 gtable_0.1.2 labeling_0.3 MASS_7.3-35
[7] munsell_0.4.2 plyr_1.8.2 proto_0.3-10 Rcpp_0.11.6 reshape2_1.4.1 scales_0.2.4
[13] stringr_0.6.2 tools_3.1.2
Has anyone else run into this? It's been driving me nuts (intermittently!) over the last few days. I've tried this with different versions of R (3.1.1 - 3.2.0), Rcpp (0.11.6, 0.11.5), plyr (1.8.1 - 1.8.2) as well as two different (Red Hat) Linux machines, and can reproduce the error on both.
Any help or suggestions are much appreciated.
EDIT:
I've done clean-installs of R and all packages on the machines I'm working on (based on an older suggestion found in issue #1006 of hadley/ggplot2)
I'm using version tracking and have the identical code base for the Shiny application on an OSX laptop as well as two different RedHat Linux machines.
I have had no problems running on OSX; so I used packrat to replicate the package library to the two RedHat machines and all three are running R-3.1.2, but this does not resolve the problem.
The Shiny application still crashes with the following output in the JS console:
Warning in run(timeoutMs) :
Removed 1 rows containing missing values (geom_path).
Error: Results must be all atomic, or all data frames
Execution halted
Here are results from the Javascript Console:
67: try(handler(binary, message))
68: (function (handle, binary, message) { for (handler in .wsconns[[as.character(handle)]]$.messageCallbacks) { result <- try(handler(binary, message)) if (inherits(result, "try-error")) { .wsconns[[as.character(handle)]]$close() return() } }})("266303168", FALSE, "{\"method\":\"update\",\"data\":{\".clientdata_output_out035b13d236a68453_width\":386,\".clientdata_output_out035b13d236a68453_height\":400,\".clientdata_output_out45a459f761c2bcff_width\":386,\".clientdata_output_out45a459f761c2bcff_height\":400,\".clientdata_output_out0b680f21f3d73958_width\":386,\".clientdata_output_out0b680f21f3d73958_height\":400,\".clientdata_output_out785a5b0a4a8d2872_width\":386,\".clientdata_output_out785a5b0a4a8d2872_height\":400,\".clientdata_output_out4d4c261305d448a2_width\":386,\".clientdata_output_out4d4c261305d448a2_height\":400,\".clientdata_output_outae8b99c9ab2044d8_width\":386,\".clientdata_output_outae8b99c9ab2044d8_height\":400,\".clientdata_output_oute11f4c69b81158cc_width\":386,\".clientdata_output_oute11f4c69b81158cc_height\":400,\".clientdata_output_out1beb34c46b1bdebd_width\":386,\".clientdata_output_out1beb34c46b1bdebd_height\":400,\".clientdata_output_out9b9abdc2e1b58daa_width\":386,\".clientdata_output_out9b9abdc2e1b58daa_height\":400,\".clientdata_output_out035b13d236a68453_hidden\":false,\".clientdata_output_out45a459f761c2bcff_hidden\":false,\".clientdata_output_out0b680f21f3d73958_hidden\":false,\".clientdata_output_out785a5b0a4a8d2872_hidden\":false,\".clientdata_output_out4d4c261305d448a2_hidden\":false,\".clientdata_output_outae8b99c9ab2044d8_hidden\":false,\".clientdata_output_oute11f4c69b81158cc_hidden\":false,\".clientdata_output_out1beb34c46b1bdebd_hidden\":false,\".clientdata_output_out9b9abdc2e1b58daa_hidden\":false}}")
69: eval(substitute(expr), envir, enclos)
70: evalq((function (handle, binary, message) { for (handler in .wsconns[[as.character(handle)]]$.messageCallbacks) { result <- try(handler(binary, message)) if (inherits(result, "try-error")) { .wsconns[[as.character(handle)]]$close() return() } }})("266303168", FALSE, "{\"method\":\"update\",\"data\":{\".clientdata_output_out035b13d236a68453_width\":386,\".clientdata_output_out035b13d236a68453_height\":400,\".clientdata_output_out45a459f761c2bcff_width\":386,\".clientdata_output_out45a459f761c2bcff_height\":400,\".clientdata_output_out0b680f21f3d73958_width\":386,\".clientdata_output_out0b680f21f3d73958_height\":400,\".clientdata_output_out785a5b0a4a8d2872_width\":386,\".clientdata_output_out785a5b0a4a8d2872_height\":400,\".clientdata_output_out4d4c261305d448a2_width\":386,\".clientdata_output_out4d4c261305d448a2_height\":400,\".clientdata_output_outae8b99c9ab2044d8_width\":386,\".clientdata_output_outae8b99c9ab2044d8_height\":400,\".clientdata_output_oute11f4c69b81158cc_width\":386,\".clientdata_output_oute11f4c69b81158cc_height\":400,\".clientdata_output_out1beb34c46b1bdebd_width\":386,\".clientdata_output_out1beb34c46b1bdebd_height\":400,\".clientdata_output_out9b9abdc2e1b58daa_width\":386,\".clientdata_output_out9b9abdc2e1b58daa_height\":400,\".clientdata_output_out035b13d236a68453_hidden\":false,\".clientdata_output_out45a459f761c2bcff_hidden\":false,\".clientdata_output_out0b680f21f3d73958_hidden\":false,\".clientdata_output_out785a5b0a4a8d2872_hidden\":false,\".clientdata_output_out4d4c261305d448a2_hidden\":false,\".clientdata_output_outae8b99c9ab2044d8_hidden\":false,\".clientdata_output_oute11f4c69b81158cc_hidden\":false,\".clientdata_output_out1beb34c46b1bdebd_hidden\":false,\".clientdata_output_out9b9abdc2e1b58daa_hidden\":false}}"), <environment>)
71: doTryCatch(return(expr), name, parentenv, handler)
72: tryCatchOne(expr, names, parentenv, handlers[[1L]])
73: tryCatchList(expr, classes, parentenv, handlers)
74: tryCatch(evalq((function (handle, binary, message) { for (handler in .wsconns[[as.character(handle)]]$.messageCallbacks) { result <- try(handler(binary, message)) if (inherits(result, "try-error")) { .wsconns[[as.character(handle)]]$close() return() } }})("266303168", FALSE, "{\"method\":\"update\",\"data\":{\".clientdata_output_out035b13d236a68453_width\":386,\".clientdata_output_out035b13d236a68453_height\":400,\".clientdata_output_out45a459f761c2bcff_width\":386,\".clientdata_output_out45a459f761c2bcff_height\":400,\".clientdata_output_out0b680f21f3d73958_width\":386,\".clientdata_output_out0b680f21f3d73958_height\":400,\".clientdata_output_out785a5b0a4a8d2872_width\":386,\".clientdata_output_out785a5b0a4a8d2872_height\":400,\".clientdata_output_out4d4c261305d448a2_width\":386,\".clientdata_output_out4d4c261305d448a2_height\":400,\".clientdata_output_outae8b99c9ab2044d8_width\":386,\".clientdata_output_outae8b99c9ab2044d8_height\":400,\".clientdata_output_oute11f4c69b81158cc_width\":386,\".clientdata_output_oute11f4c69b81158cc_height\":400,\".clientdata_output_out1beb34c46b1bdebd_width\":386,\".clientdata_output_out1beb34c46b1bdebd_height\":400,\".clientdata_output_out9b9abdc2e1b58daa_width\":386,\".clientdata_output_out9b9abdc2e1b58daa_height\":400,\".clientdata_output_out035b13d236a68453_hidden\":false,\".clientdata_output_out45a459f761c2bcff_hidden\":false,\".clientdata_output_out0b680f21f3d73958_hidden\":false,\".clientdata_output_out785a5b0a4a8d2872_hidden\":false,\".clientdata_output_out4d4c261305d448a2_hidden\":false,\".clientdata_output_outae8b99c9ab2044d8_hidden\":false,\".clientdata_output_oute11f4c69b81158cc_hidden\":false,\".clientdata_output_out1beb34c46b1bdebd_hidden\":false,\".clientdata_output_out9b9abdc2e1b58daa_hidden\":false}}"), <environment>), error = .rcpp_error_recorder)
75: withCallingHandlers(tryCatch(evalq((function (handle, binary, message) { for (handler in .wsconns[[as.character(handle)]]$.messageCallbacks) { result <- try(handler(binary, message)) if (inherits(result, "try-error")) { .wsconns[[as.character(handle)]]$close() return() } }})("266303168", FALSE, "{\"method\":\"update\",\"data\":{\".clientdata_output_out035b13d236a68453_width\":386,\".clientdata_output_out035b13d236a68453_height\":400,\".clientdata_output_out45a459f761c2bcff_width\":386,\".clientdata_output_out45a459f761c2bcff_height\":400,\".clientdata_output_out0b680f21f3d73958_width\":386,\".clientdata_output_out0b680f21f3d73958_height\":400,\".clientdata_output_out785a5b0a4a8d2872_width\":386,\".clientdata_output_out785a5b0a4a8d2872_height\":400,\".clientdata_output_out4d4c261305d448a2_width\":386,\".clientdata_output_out4d4c261305d448a2_height\":400,\".clientdata_output_outae8b99c9ab2044d8_width\":386,\".clientdata_output_outae8b99c9ab2044d8_height\":400,\".clientdata_output_oute11f4c69b81158cc_width\":386,\".clientdata_output_oute11f4c69b81158cc_height\":400,\".clientdata_output_out1beb34c46b1bdebd_width\":386,\".clientdata_output_out1beb34c46b1bdebd_height\":400,\".clientdata_output_out9b9abdc2e1b58daa_width\":386,\".clientdata_output_out9b9abdc2e1b58daa_height\":400,\".clientdata_output_out035b13d236a68453_hidden\":false,\".clientdata_output_out45a459f761c2bcff_hidden\":false,\".clientdata_output_out0b680f21f3d73958_hidden\":false,\".clientdata_output_out785a5b0a4a8d2872_hidden\":false,\".clientdata_output_out4d4c261305d448a2_hidden\":false,\".clientdata_output_outae8b99c9ab2044d8_hidden\":false,\".clientdata_output_oute11f4c69b81158cc_hidden\":false,\".clientdata_output_out1beb34c46b1bdebd_hidden\":false,\".clientdata_output_out9b9abdc2e1b58daa_hidden\":false}}"), <environment>), error = .rcpp_error_recorder), warning = .rcpp_warning_recorder)
aborting ...
One additional item I've noticed; the shiny app I'm running is like a monte-carlo simulation - and the more runs I pass through, the greater the chance that the application crashes. Fewer runs tend to be successful all the way through; it appears as though it may be related to memory allocation.
EDIT 2:
Reverting to older versions of Rcpp, plyr, and ggplot seems to resolve it on all three machines (OSX & Red Hat); I haven't tested to see if it's possible to upgrade one of the three from this point.
Rcpp 0.11.3
plyr 1.8.1
ggplot2 0.9.3
I can't post the code, because SO won't let me post more than two links, but I've installed using the following for all 3 packages:
install.packages(<<url to source tarball>>,repos = NULL,type="source")`

This error was caused by a bug, which was affecting the plyr package used by ggplot2. Hadley has fixed this in the latest development version by reverting to an older version of loop_apply.
The current fix is to install the development version of plyr:
devtools::install_github("hadley/plyr")
Fixed in commit: https://github.com/hadley/plyr/commit/3256bb524dbe04982ad54300057dd1e1bf852906

Related

Only receive unique warning messages

Warning messages are a good information i want to know. But i just want to know it one time!
So this function throws 2 different warnings and repeats it 20 times.
How can i tell R to only print unique warnings. Im looking for a gerenal solution.
Warning messages:
1: NAs introduced by coercion
2: In sqrt(-1) : NaNs produced
Here is my example:
foobar <- function(n=20) {
for (i in 1:n) {
as.numeric("b")
sqrt(-1)
}
}
foobar()
To return only unique warning strings, use
unique(warnings())
Now, a problem you may have is that your function has more than 50 warnings, in which case warnings() will not catch them all. To workaround this, you can increase nwarnings in options to e.g. 10000 as suggested in the help page of warnings.
options(nwarnings = 10000)
Example:
foobar <- function(n=20) {
warning("First warning")
for (i in 1:n) {
as.numeric("b")
sqrt(-1)
}
warning("Last warning")
}
foobar(60)
unique(warnings())
## Warning messages:
## 1: In foobar(60) : First warning
## 2: NAs introduced by coercion
## 3: In sqrt(-1) : NaNs produced
op <- options(nwarnings = 10000)
foobar(60)
unique(warnings())
## Warning messages:
## 1: In foobar(60) : First warning
## 2: NAs introduced by coercion
## 3: In sqrt(-1) : NaNs produced
## 4: In foobar(60) : Last warning
options(op)

Error in unserialize(socklist[[n]]) : error reading from connection

I'm using R and I'm running a parallel code on 7 cores on a Linux machine.
When using a small dataset, my code takes about 2 hours and works fine.
When using a 6x larger dataset, the codes takes much longer (probably because it needs to swap), but then will randomly end, sometimes at 10%, sometimes at 18, 20, 30% or so. Looks totally random. RAM usage is usually at about 90%, SWAP usage at <50%.
I'm using foreach with the doSNOW backend.
This is the error code:
Error in unserialize(socklist[[n]]) : error reading from connection
Calls: %dopar% ... tryCatch -> tryCatchList -> tryCatchOne -> <Anonymous>
Execution halted
*** caught bus error ***
address 0x7f829d2adbd0, cause 'non-existent physical address'
An irrecoverable exception occurred. R is aborting now ...
And this is the SNOW outfile obtained by setting outfile="outfile.out" in the makeCluster call:
starting worker for localhost:11567
Type: EXEC
Loading required package: MASS
Loading required package: survival
Loading required package: sp
Attaching package: 'raster'
The following objects are masked from 'package:MASS':
area, select
Attaching package: 'data.table'
The following object is masked from 'package:raster':
shift
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
Type: EXEC
*** caught bus error ***
address 0x7ffada863636, cause 'non-existent physical address'
Traceback:
1: .Call("Rsx_nc4_get_vara_double", as.integer(ncid), as.integer(varid), as.integer(c.start), as.integer(c.count), fixmiss, imvstate, as.double(passed_missval), PACKAGE = "ncdf4")
2: ncvar_get_inner(ncid2use, varid2use, nc$var[[li]]$missval, addOffset, scaleFact, start = start, count = count, verbose = verbose, signedbyte = signedbyte, collapse_degen = collapse_degen)
3: getfun(nc, varid = zvar, start = start, count = count)
4: .readBrickCellsNetCDF(x, cells, layer, nl)
5: .cellValues(x, i)
6: .doExtract(x, i, drop = drop)
7: por[i]
8: por[i]
9: as.vector(por[i])
10: mainF(as.vector(por[i]))
11: eval(expr, envir, enclos)
12: eval(.doSnowGlobals$expr, envir = .doSnowGlobals$exportenv)
13: doTryCatch(return(expr), name, parentenv, handler)
14: tryCatchOne(expr, names, parentenv, handlers[[1L]])
15: tryCatchList(expr, classes, parentenv, handlers)
16: tryCatch(eval(.doSnowGlobals$expr, envir = .doSnowGlobals$exportenv), error = function(e) e)
17: fun(quote(list(i = 23339L)))
18: do.call("fun", lapply(args, enquote))
19: docall(msg$data$fun, msg$data$args)
20: doTryCatch(return(expr), name, parentenv, handler)
21: tryCatchOne(expr, names, parentenv, handlers[[1L]])
22: tryCatchList(expr, classes, parentenv, handlers)
23: tryCatch(docall(msg$data$fun, msg$data$args), error = handler)
24: doTryCatch(return(expr), name, parentenv, handler)
25: tryCatchOne(expr, names, parentenv, handlers[[1L]])
26: tryCatchList(expr, classes, parentenv, handlers)
27: tryCatch({ msg <- recvData(master) cat(paste("Type:", msg$type, "\n")) if (msg$type == "DONE") { closeNode(master) break } else if (msg$type == "EXEC") { success <- TRUE handler <- function(e) { success <<- FALSE structure(conditionMessage(e), class = c("snow-try-error", "try-error")) } t1 <- proc.time() value <- tryCatch(docall(msg$data$fun, msg$data$args), error = handler) t2 <- proc.time() value <- list(type = "VALUE", value = value, success = success, time = t2 - t1, tag = msg$data$tag) sendData(master, value) }}, interrupt = function(e) NULL)
28: slaveLoop(makeSOCKmaster(master, port))
29: eval(expr, envir, enclos)
30: eval(quote({ master <- "localhost" port <- "" snowlib <- Sys.getenv("R_SNOW_LIB") outfile <- Sys.getenv("R_SNOW_OUTFILE") args <- commandArgs() pos <- match("--args", args) args <- args[-(1:pos)] for (a in args) { pos <- regexpr("=", a) name <- substr(a, 1, pos - 1) value <- substr(a, pos + 1, nchar(a)) switch(name, MASTER = master <- value, PORT = port <- value, SNOWLIB = snowlib <- value, OUT = outfile <- value) } if (!(snowlib %in% .libPaths())) .libPaths(c(snowlib, .libPaths())) library(methods) library(snow) if (port == "") port <- getClusterOption("port") sinkWorkerOutput(outfile) cat("starting worker for", paste(master, port, sep = ":"), "\n") slaveLoop(makeSOCKmaster(master, port))}), new.env())
31: eval(expr, envir, enclos)
32: eval(expr, p)
33: eval.parent(substitute(eval(quote(expr), envir)))
34: local({ master <- "localhost" port <- "" snowlib <- Sys.getenv("R_SNOW_LIB") outfile <- Sys.getenv("R_SNOW_OUTFILE") args <- commandArgs() pos <- match("--args", args) args <- args[-(1:pos)] for (a in args) { pos <- regexpr("=", a) name <- substr(a, 1, pos - 1) value <- substr(a, pos + 1, nchar(a)) switch(name, MASTER = master <- value, PORT = port <- value, SNOWLIB = snowlib <- value, OUT = outfile <- value) } if (!(snowlib %in% .libPaths())) .libPaths(c(snowlib, .libPaths())) library(methods) library(snow) if (port == "") port <- getClusterOption("port") sinkWorkerOutput(outfile) cat("starting worker for", paste(master, port, sep = ":"), "\n") slaveLoop(makeSOCKmaster(master, port))})
An irrecoverable exception occurred. R is aborting now ...
The code is using 7 threads out of 8 of a local machine. The foreach call is made like so:
#Packages
packageVec <- c("RcppRoll", "FAdist", "fitdistrplus", "minpack.lm", "raster", "foreach", "data.table")
#Register cluster
cl <- makeCluster(nThreads, outfile=paste0(dischargefile, ".out"))
registerDoSNOW(cl)
#Create progress bar
pb <- txtProgressBar(max = ncells, style = 3)
progress <- function(n) setTxtProgressBar(pb, n)
SNOWopts <- list(progress = progress)
#Compute
a <-
foreach(i=cells, .packages=packageVec, .combine='rbind', .options.snow = SNOWopts) %dopar% {
mainF(as.vector(por[i]))
}
stopCluster(cl)
mainF() function description
It's hard to produce a MRE for this function, as it is complicated. The code is here, and I'll describe what the function does below. I want to stress the fact that all of this works wonderfully on a small dataset, but fails on a large dataset, even if it contains the same data of the small dataset replicated several times.
mainF() is a function whose input, por[i], is a 125000 element vector and whose output a 244 element vector. This function basically performs 240 rolling means on the input vector (using RcppRoll) and takes the maxima (using data.table) for each time slice (usually 15) for each mean, fits the data to a given distribution (using FAdist, raster and fitdistrplus), performs another loop for calculating another 240 values and fits (using minpack.lm) those values to a function to obtain more parameters. The 240 elements returned and the 4 fit parameters (2 for each fits) are returned.
How can I fix the above error? What does it mean?

Is it possible to call S4 method directly?

Trying to build a gausspr model and using predict to predict the output. Copying code from predict.gausspr documentation.
data(promotergene)
## create test and training set
ind <- sample(1:dim(promotergene)[1],20)
genetrain <- promotergene[-ind, ]
genetest <- promotergene[ind, ]
## train a support vector machine
gene <- gausspr(Class~.,data=genetrain,kernel="rbfdot",
kpar=list(sigma=0.015))
## predict gene type probabilities on the test set
genetype <- predict(gene,genetest,type="probabilities")
This works fine. Now, when i try to call predict.gausspr directly it's failing. Is it possible to call this S4 method directly ?
Also, is this case with any S4 method or something special in this case ?
> genetype <- predict.gausspr(gene,genetest,type="probabilities")
Error: could not find function "predict.gausspr"
kernlab package is loaded properly and am able to do ?predict.gausspr and see the notes
I guess you mean the gausspr() function from the kernlab package. Using the snippet from ?gausspr I see
library(kernlab)
data(iris)
test <- gausspr(Species~., data=iris, var=2)
predict(test, iris[,-5])
test is indeed an S4 object
> isS4(test)
[1] TRUE
> class(test)
[1] "gausspr"
attr(,"package")
[1] "kernlab"
Discovering S4 methods
S4 methods are discovered using showMethods() and selectMethod() (output edited for brevity)
> showMethods("predict")
Function: predict (package stats)
object="ANY"
object="gausspr"
object="kfa"
object="kha"
object="kpca"
object="kqr"
object="ksvm"
object="lssvm"
object="onlearn"
object="rvm"
> showMethods(class=class(test), where=search())
Function: alphaindex (package kernlab)
object="gausspr"
...
Function: predict (package stats)
object="gausspr"
...
> selectMethod("predict", class Method Definition:
function (object, ...)
{
.local <- function (object, newdata, type = "response", coupler = "minpair")
{
sc <- 0
type <- match.arg(type, c("response", "probabilities",
"votes", "variance"))
...
If there was no relevant predict,gausspr method, then we would end up at predict,ANY-method, which actually invokes the S3 methods discovered by methods("predict").
The help page is discovered with
?"predict,gausspr-method"
Debugging S4 methods
traceback / recover
If a method fails and you'd like to debug it, then usually the simplest thing to do is to use ?traceback to find out where the error occurs, and ?recover to identify the problem in more detail. Here's an error
> predict(test, mtcars)
Error in eval(expr, envir, enclos) : object 'Sepal.Length' not found
and we can see the 'call stack' from 1 (the generic 'predict') to 2 (the method 'predict,gausspr-mehtod') to 3 (the .local function, defined inside the gausspr method), etc.
> traceback()
9: eval(expr, envir, enclos)
8: eval(predvars, data, env)
7: model.frame.default(object, data, xlev = xlev)
6: model.frame(object, data, xlev = xlev)
5: model.matrix.default(delete.response(terms(object)), as.data.frame(newdata),
na.action = na.action)
4: model.matrix(delete.response(terms(object)), as.data.frame(newdata),
na.action = na.action)
3: .local(object, ...)
2: predict(test, mtcars)
1: predict(test, mtcars)
Set the error option (see ?options) to recover and try again, choosing the frame number inside the .local function to be in the body of the method.
> options(error=recover)
> predict(test, mtcars)
Error in eval(expr, envir, enclos) : object 'Sepal.Length' not found
Enter a frame number, or 0 to exit
1: predict(test, mtcars)
2: predict(test, mtcars)
3: .local(object, ...)
4: model.matrix(delete.response(terms(object)), as.data.frame(newdata), na.act
5: model.matrix.default(delete.response(terms(object)), as.data.frame(newdata)
6: model.frame(object, data, xlev = xlev)
7: model.frame.default(object, data, xlev = xlev)
8: eval(predvars, data, env)
9: eval(expr, envir, enclos)
Selection: 3
Called from: eval(predvars, data, env)
Browse[1]> ls()
[1] "coupler" "ncols" "newdata" "nrows" "object" "oldco" "sc"
[8] "type"
Restore normal error behavior with options(error=NULL).
debug / trace
There are a couple of things to do to debug S4 methods. The first is to use the debugger on the selected methods
debug(selectMethod("predict", class(test)))
The second is to trace the method
trace("predict", browser, signature=class(test))
(stop tracing with untrace("predict", signature=class(test))
In this particular case you'll see that the body of the function is in a nested function called .local. Setting the debugger on the outer function is not enough, instead one needs to break in the outer function, then step through until .local has been defined but not evaluated, and set the debugger on .local, like (editing the output for brevity)
> trace(predict, browser, signature=class(test))
Tracing specified method for function "predict" in environment
<namespace:stats>
Warning: Tracing only in the namespace; to untrace you will need:
untrace("predict", where = getNamespace("stats"))
[1] "predict"
attr(,"package")
[1] "stats"
> predict(test, iris[,-5])
Tracing predict(test, iris[, -5]) on entry
Called from: eval(expr, envir, enclos)
Browse[1]> n
debug: {
.local <- function (object, newdata, type = "response", coupler = "minpair")
{
sc <- 0
type <- match.arg(type, c("response", "probabilities",
...
Browse[2]> n
debug: .local(object, ...)
Browse[2]> debug(.local)
Browse[2]> n
debugging in: .local(object, ...)
debug: {
sc <- 0
type <- match.arg(type, c("response", "probabilities", "votes",
...
Browse[3]>
The author of the kernlab package did not provide an S3-style function predict.gausspr, even though the S4 guidelines (?setMethod) suggest that they do. This would have simplified debugging, e.g., debug(kernlab:::predict.gausspr).

traceback() returns useless information for error happened during source()

I am surprised by how hard it is to find where the error happened exactly in R when I am sourcing a file. For example:
> source('Data-Generation.R')
... # some output here
Error in as.matrix(X) %*% coefs[ix_X] : non-conformable arguments
At least in this case, I can find where it is by searching for it because I have as.matrix(X) %*% coefs[ix_X] only once in my code. Anyway, if I try to pinpoint where it happened with traceback():
> traceback()
4: eval(expr, envir, enclos)
3: eval(ei, envir)
2: withVisible(eval(ei, envir))
1: source("Data-Generation.R")
which is useless information.
Am I doing something wrong?
Edited: I am looking for a solution which will produce a message that Python would yield:
$ python .\test.py
1
Traceback (most recent call last):
File ".\test.py", line 5, in <module>
1/0
ZeroDivisionError: integer division or modulo by zero
Set echo = TRUE:
source(textConnection("i <- 1
y*x
3+4"), echo=TRUE)
#> i <- 1
#
#> y*x
#Error in eval(expr, envir, enclos) : object 'y' not found
verbose = TRUE might also be useful:
source(textConnection("i <- 1
y*x
3+4"), verbose=TRUE)
#'envir' chosen:<environment: R_GlobalEnv>
#--> parsed 3 expressions; now eval(.)ing them:
#
#>>>> eval(expression_nr. 1 )
# =================
#
#> i <- 1
#curr.fun: symbol <-
# .. after ‘expression(i <- 1)’
#
#>>>> eval(expression_nr. 2 )
# =================
#
#> y*x
#Error in eval(expr, envir, enclos) : object 'y' not found

quantmod::chart_Series() bug?

I would like to chart SPX using quantmod::chart_Series() and below draw changes in GDP and 12 month SMA of changes of GDP. No matter how I try to do it (what combinations I use) eithe errors occur or quantmod::chart_Series() displays just partial plot.
require(quantmod)
FRED.symbols <- c("GDPC96")
getSymbols(FRED.symbols, src="FRED")
SPX <- getSymbols("^GSPC", auto.assign=FALSE, from="1900-01-01")
subset="2000/"
chart_Series(SPX, subset=subset)
add_TA(GDPC96)
add_TA(ROC(GDPC96, type="discrete"))
add_TA(SMA(ROC(GDPC96, type="discrete"), n=4), on=3, col="blue")
EDIT: Actually, it seems to me that this is a quantmod::chart_series() problem when using quarterly data:
subset <- "2000/"
chart_Series(to.quarterly(SPX, drop.time=TRUE), subset=subset)
add_TA(SMA(Cl(to.quarterly(SPX, drop.time=TRUE))))
> subset <- "2000/"
> chart_Series(to.quarterly(SPX, drop.time=TRUE), subset=subset)
> add_TA(SMA(Cl(to.quarterly(SPX, drop.time=TRUE))))
Error in xy.coords(x, y) : 'x' and 'y' lengths differ
In addition: Warning messages:
1: In as_numeric(H) : NAs introduced by coercion
2: In as_numeric(H) : NAs introduced by coercion
3: In as_numeric(H) : NAs introduced by coercion
This does produce SPX plot on main panel, but leaves empty second and third panel.
Then I tried to play around with having same index on data, same lengths etc.
chart_Series(head(to.quarterly(SPX, drop.time="TRUE"), -1), subset=subset)
add_TA(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE))
add_TA(ROC(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE), type="discrete"))
add_TA(SMA(ROC(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE), type="discrete"), n=4), on=3, col="blue")
And result is errors all over:
> chart_Series(head(to.quarterly(SPX, drop.time="TRUE"), -1), subset=subset)
> add_TA(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE))
Error in xy.coords(x, y) : 'x' and 'y' lengths differ
In addition: Warning messages:
1: In as_numeric(H) : NAs introduced by coercion
2: In as_numeric(H) : NAs introduced by coercion
3: In as_numeric(H) : NAs introduced by coercion
> add_TA(ROC(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE), type="discrete"))
Error in xy.coords(x, y) : 'x' and 'y' lengths differ
In addition: Warning messages:
1: In as_numeric(H) : NAs introduced by coercion
2: In as_numeric(H) : NAs introduced by coercion
3: In as_numeric(H) : NAs introduced by coercion
> add_TA(SMA(ROC(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE), type="discrete"), n=4), on=3, col="blue")
Error in xy.coords(x, y) : 'x' and 'y' lengths differ
In addition: Warning messages:
1: In as_numeric(H) : NAs introduced by coercion
2: In as_numeric(H) : NAs introduced by coercion
3: In as_numeric(H) : NAs introduced by coercion
Using
tail(to.quarterly(SPX, drop.time="TRUE"))
tail(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE))
tail(ROC(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE), type="discrete"))
tail(SMA(ROC(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE), type="discrete"), n=4))
dput(to.quarterly(SPX, drop.time="TRUE"))
dput(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE))
dput(ROC(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE), type="discrete"))
dput(SMA(ROC(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE), type="discrete"), n=4))
all looks good to me.
My sessionInfo():
> sessionInfo()
R version 2.15.0 (2012-03-30)
Platform: x86_64-pc-linux-gnu (64-bit)
locale:
[1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
[3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
[5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
[7] LC_PAPER=en_US.UTF-8 LC_NAME=en_US.UTF-8
[9] LC_ADDRESS=en_US.UTF-8 LC_TELEPHONE=en_US.UTF-8
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=en_US.UTF-8
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] quantmod_0.3-18 TTR_0.21-0 xts_0.8-7 zoo_1.7-7
[5] Defaults_1.1-1 rj_1.1.0-4
loaded via a namespace (and not attached):
[1] grid_2.15.0 lattice_0.20-0 tools_2.15.0
Any ideas what might be the solution for these issues?
EDIT: This seems to be a quantmod::chart_Series() bug. If I do this:
subset <- "1990/"
test <- cbind(head(to.quarterly(SPX, drop.time="TRUE"), -1)[subset],
to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE)[subset],
ROC(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE), type="discrete")[subset],
SMA(ROC(to.quarterly(GDPC96, drop.time="TRUE", OHLC=FALSE), type="discrete"), n=4)[subset])
test$test <- 1
subset <- "2000/"
chart_Series(OHLC(test), subset=subset)
add_TA(test$test)
add_TA(test$GDPC96)
> test$test <- 1
> subset <- "2000/"
> chart_Series(OHLC(test), subset=subset)
> add_TA(test$test)
Error in xy.coords(x, y) : 'x' and 'y' lengths differ
In addition: Warning messages:
1: In as_numeric(H) : NAs introduced by coercion
2: In as_numeric(H) : NAs introduced by coercion
3: In as_numeric(H) : NAs introduced by coercion
> add_TA(test$GDPC96)
Error in xy.coords(x, y) : 'x' and 'y' lengths differ
In addition: Warning messages:
1: In as_numeric(H) : NAs introduced by coercion
2: In as_numeric(H) : NAs introduced by coercion
3: In as_numeric(H) : NAs introduced by coercion
> traceback()
14: stop("'x' and 'y' lengths differ") at chart_Series.R#510
13: xy.coords(x, y) at chart_Series.R#510
12: plot.xy(xy.coords(x, y), type = type, ...) at chart_Series.R#510
11: lines.default(ta.x, as.numeric(ta.y[, i]), col = col, ...) at chart_Series.R#510
10: lines(ta.x, as.numeric(ta.y[, i]), col = col, ...) at chart_Series.R#510
9: plot_ta(x = current.chob(), ta = get("x"), on = NA, taType = NULL,
col = 1) at replot.R#238
8: eval(expr, envir, enclos) at replot.R#238
7: eval(aob, env) at replot.R#238
6: FUN(X[[12L]], ...) at replot.R#230
5: lapply(x$Env$actions, function(aob) {
if (attr(aob, "frame") > 0) {
x$set_frame(attr(aob, "frame"), attr(aob, "clip"))
env <- attr(aob, "env")
if (is.list(env)) {
env <- unlist(lapply(env, function(x) eapply(x, eval)),
recursive = FALSE)
}
eval(aob, env)
}
}) at replot.R#230
4: plot.replot(x, ...)
3: plot(x, ...)
2: print.replot(<environment>)
1: print(<environment>)
Any ideas on how to get this fixed?
I had a similar error several days ago. I found that the problem was in add_TA with the line:
ta.x <- as.numeric(na.approx(ta.adj[, 1]))
na.approx uses approx with rule = 1 by default, which leaves trailing NAs in the list if the last timestamp in the original data is before the last timestamp in the TA data. Changing that line to set rule = 2 fixed the problem.
ta.x <- as.numeric(na.approx(ta.adj[, 1], rule=2))
I just wrote a long "answer" confirming your problems, even after some data massaging, and even using the older chartSeries function. Then I realized that add_TA() is perhaps the wrong function. This approach works:
par(mfrow=c(2,1))
chart_Series(SPX)
chart_Series(GDPC96)
(See R/quantmod: multiple charts all using the same y-axis for an alternative approach using the layout command.)
Or with the subset:
par(mfrow=c(2,1))
chart_Series(SPX,subset="2000/")
chart_Series(GDPC96,subset="2000/")
(NB. the two datasets end at different place, so don't quite line up.)
Incidentally, there is one definite bug in chart_Series with quarterly data: the x-axis labels look like "%n%b%n2010".
q.SPX=to.quarterly(SPX)
chart_Series(q.SPX)

Resources