Only receive unique warning messages - r

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)

Related

R within group sum of squares kmeans

I have the following code, which is giving me the an error:
# Read input dataset from CSV file
input_dataset <-
read.csv("C:\\Users\\sw029693\\Desktop\\Overtime_work_hrs_analytics\\input_dataset.csv", header = TRUE)
wss <- (nrow(input_dataset)-1)*sum(apply(input_dataset,2,var))
which gives the following error:
Warning messages:
1: In FUN(newX[, i], ...) : NAs introduced by coercion
2: In FUN(newX[, i], ...) : NAs introduced by coercion
3: In FUN(newX[, i], ...) : NAs introduced by coercion
4: In FUN(newX[, i], ...) : NAs introduced by coercion
5: In FUN(newX[, i], ...) : NAs introduced by coercion
> wss
[1] NA
> colnames(input_dataset)
[1] "client" "domain" "user_name"
"cdf_display" "position" "shift_start"
[7] "shift_end" "shift_length_avg" "patients_seen_cnt"
It looks like the wss is NA, I am not sure why. Any ideas?

K-means only supports numerical data.
You columns user_name etc. probably are not numerical.
Bring your data into the appropriate format first.

R, warning sequencing in for loop

In R, a function inside for loop is not printing warnings in sequence.
for(i in sample(-2:2)){
cat(sprintf("running for %d\n", i))
j= sqrt(i)
}
#running for 0
#running for -2
#running for 1
#running for -1
#running for 2
#Warning messages:
#1: In sqrt(i) : NaNs produced
#2: In sqrt(i) : NaNs produced
The warning messages are printed at the end and it is not clear for which values we get warning. I am looking for warning massege sequence as
#running for 0
#running for -2
#Warning messages:
#1: In sqrt(i) : NaNs produced
#running for 1
#running for -1
#Warning messages:
#2: In sqrt(i) : NaNs produced
#running for 2
How can I force R to print warning in sequential way (or print warning immediately after the execution of code)?

There is a immediate. parameter in the warning function especially for that purpose, try setting in your function
if (i < 5) warning("A warning", immediate. = TRUE)
eg.
foo <- function(i){
if (i < 5) warning("A warning", immediate. = TRUE)
i }
for (i in 3:7){
cat(sprintf("running for %d\n", i))
foo(i)
}
# running for 3
# Warning in foo(i) : A warning
# running for 4
# Warning in foo(i) : A warning
# running for 5
# running for 6
# running for 7
Edit: Per your new update, you will probably need to wrap your function up into tryCatch, something like
set.seed(222)
for(i in sample(-2:2)){
cat(sprintf("running for %d\n", i))
tryCatch(sqrt(i), warning = function(w) message(paste(w, "\n")))
}
# running for 2
# running for -2
# simpleWarning in sqrt(i): NaNs produced
#
#
# running for -1
# simpleWarning in sqrt(i): NaNs produced
#
#
# running for 1
# running for 0

From ?options the option warn is listed to fill this role. It's not really the best option; tryCatch is most likely cleaner provided the warnings are being used correctly but it's useful for debugging.
warn: sets the handling of warning messages. If warn is negative all
warnings are ignored. If warn is zero (the default) warnings are
stored until the top–level function returns. If 10 or fewer warnings
were signalled they will be printed otherwise a message saying how
many were signalled. An object called last.warning is created and can
be printed through the function warnings. If warn is one, warnings are
printed as they occur. If warn is two or larger all warnings are
turned into errors.
options(warn=1)
for(i in sample(-2:2)){
cat(sprintf("running for %d\n", i))
j <- sqrt(i)
}
#running for -2
#Warning in sqrt(i) : NaNs produced
#running for 2
#running for 0
#running for 1
#running for -1
#Warning in sqrt(i) : NaNs produced
You could also use something like:
currentWarnLevel <- getOptions("warn")
# code that should print warn straight away
options(warn = currentWarnLevel)
If you're using a custom logger I found it best to override options(warning.expression) and using withCallingHandlers and then reset warning.expression.

nError in importing signals with createAffyIntensityFile (GWASTools)

I am using the GWASTools package and I am facing an error to import my signal file. I tried to mimetize my real data set in the follow example:
library(GWASTools)
snp.anno <- 'snpID chromosome position snpName
AX-100676796 1 501997 AX-100676796
AX-100120875 1 503822 AX-100120875
AX-100067350 1 504790 AX-100067350'
snp.anno <- read.table(text=snp.anno, header=T)
signals <- 'probeset_id sample1.CEL sample1.CEL sample1.CEL
AX-100676796-A 2126.7557 1184.8638 1134.2687
AX-100676796-B 427.1864 2013.8512 1495.0654
AX-100120875-A 1775.5816 2013.8512 651.1691
AX-100120875-B 335.9226 2013.8512 1094.7429
AX-100067350-A 2365.7755 2695.0053 2758.1739
AX-100067350-B 2515.4818 2518.2818 28181.289 '
p1summ <- read.table(text=signals, header=T)
write.table(p1summ, "del.txt", sep="\t", col.names=T, row.names=F, quote=F)
p1summ <- createAffyIntensityFile("del.txt", snp.annotation=snp.anno)
Error: all(snp.annotation$snpID == sort(snp.annotation$snpID)) is not TRUE
In addition: Warning messages:
1: In .checkSnpAnnotation(snp.annotation) : coerced snpID to type integer
2: In .checkSnpAnnotation(snp.annotation) :
coerced chromosome to type integer
I used the probe Names with 'A' and 'B' pattern also, the error was the same:
snp.annoab <- 'snpID chromosome position snpName
AX-100676796-A 1 501997 AX-100676796-A
AX-100676796-B 1 501997 AX-100676796-B
AX-100120875-A 1 503822 AX-100120875-A
AX-100120875-B 1 503822 AX-100120875-B
AX-100067350-A 1 504790 AX-100067350-A
AX-100067350-B 1 504790 AX-100067350-B'
snp.annoab <- read.table(text=snp.annoab, header=T)
p1summ <- createAffyIntensityFile("del.txt", snp.annotation=snp.annoab)
Error: all(snp.annotation$snpID == sort(snp.annotation$snpID)) is not TRUE
In addition: Warning messages:
1: In .checkSnpAnnotation(snp.annotation) : coerced snpID to type integer
2: In .checkSnpAnnotation(snp.annotation) :
coerced chromosome to type integer
In my real dataset the error is slight different, but do not work anyway:
Error: length(snp.annotation$snpID) == length(unique(snp.annotation$snpID)) is not TRUE
In addition: Warning messages:
1: In .checkSnpAnnotation(snp.annotation) : NAs introduced by coercion
2: In .checkSnpAnnotation(snp.annotation) : coerced snpID to type integer
3: In .checkSnpAnnotation(snp.annotation) : NAs introduced by coercion
4: In .checkSnpAnnotation(snp.annotation) :
coerced chromosome to type integer
And the strange thing is that:
> length(snp.annotation$snpID) == length(unique(snp.annotation$snpID))
[1] TRUE
Thus, seems that the error is not in agreement with the command (to check if the length is the same). I am missing some important detail in the format of my inputs? I would be grateful for any help. Thank you!

Intermittent errors with ggplot2, segfault: memory not mapped

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

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