I am following code from a textbook called "Data Mining with R" and I've hit a stumbling block when trying to run the sample code myself.
Here is the code so far:
library(quantmod)
getSymbols("^GSPC")
colnames(GSPC) <- c("Open", "High", "Low", "Close", "Volume", "AdjClose")
T.ind <- function(quotes, tgt.margin=.025, n.days=10) {
v <- apply(HLC(quotes), 1, mean)
r <- matrix(NA, ncol=n.days, nrow=NROW(quotes))
for(x in 1:n.days) r[,x] <- Next(Delt(v,k=x), x)
x <- apply(r,1, function(x) sum(x[x>tgt.margin|x < -tgt.margin]))
if (is.xts(quotes))
xts(x, time(quotes))
else x
}
candleChart(last(GSPC, "1 year"), theme="white", TA=NULL)
avgPrice <- function(p) apply(HLC(p), 1, mean)
addAvgPrice <- newTA(FUN=avgPrice, col=1, legend="AvgPrice")
addT.ind <- newTA(FUN=T.ind, col="red", legend="tgtRet")
addAvgPrice(on=1)
addT.ind()
But for the last 2 lines I get the error message:
> addAvgPrice(on=1)
Error in addAvgPrice(on = 1) : could not find function "get.current.chob"
> addT.ind()
Error in addT.ind() : could not find function "get.current.chob"
What is additionally odd is that I ran the code on 1 machine & have no issues but on my main PC I keep getting the error.
I tried googling this error but could not find any real solutions or explanations.
Any insight or assistance would be greatly appreciated.
> get.current.chob
Error: object 'get.current.chob' not found
get.current.chob is in quantmod, so...
> quantmod:::get.current.chob
function ()
{
first.chob <- which(sapply(sys.frames(), function(x) exists("chob",
envir = x)))[1]
if (!is.na(first.chob)) {
lchob <- get("chob", envir = first.chob)
}
else {
gchob <- get.chob()
if (dev.cur() == 1 || length(gchob) < dev.cur())
stop("improperly set or missing graphics device")
current.chob <- which(sapply(gchob, function(x) {
ifelse(class(x) == "chob" && x#device == as.numeric(dev.cur()),
TRUE, FALSE)
}))
if (identical(current.chob, integer(0)))
stop("no current plot")
lchob <- gchob[[current.chob]]
}
return(lchob)
}
<environment: namespace:quantmod>
Related
I have tried looking up an answer to this and have been unable to find a solution to my particular code. I am trying to make a summary table including medians and results of a Mann Whitney U. However I get the error:
Error in unique.default(x, nmax = nmax) : unique() applies only to vectors
The code I am using is below - this is my first time posting so if I have done something wrong with asking my question I apologise.
Thank you for your help.
library("table1")
library("MatchIt")
cog$Type_use <- factor(cog$Type_use, levels=c(0,1,2),
labels = c("Controls", "Patients", "P-value"))
rndr <- function(x, name, ...) {
if (length(x) == 0) {
y <- cog[[name]]
s <- rep("", length(render.default(x=y, name=name, ...)))
if (is.numeric(y)) {
p <- wilcox.test(y ~ cog$Type_use)$p.value
} else {
p <- wilcox.test(table(y ~ cog$Type_use)$p.value)
}
s[2] <- sub(">", "<", format.pval(p, digits=3, eps=0.001))
s
}
render.default(x=x, name=name, ...)
}
rndr.strat <- function(label, n, ...) {
ifelse(n==0, label, render.strat.default(label, n, ...))
}
table1(~ cog$Sex_1_USE + cog$Age.at.assessment_two_use | cog$Type_use,
data=cog, droplevels=F, render=rndr, render.strat=rndr.strat, overall=F)
I am running a lot of regressions through this code
vek <- read_excel("h24.xlsx")
filterfile <- read_excel("filterfile.xlsx")
x <- c(filterfile$Column)
sink("D:/test.csv")
for (temp_var in x){
h24 <- filter(vek,KEY == temp_var)
h24 <- na.omit(h24)
frml <- UNITS ~ h36+ z24+ z36+ pr
if (length(unique(h24$`F`)) > 1) frml <- update.formula(frml, ~ F + .)
if (length(unique(h24$`D`)) > 1) frml <- update.formula(frml, ~ D + .)
lmtest <- lm(frml, data = h24)
print(vif(lmtest))
}
sink()
The print(vif(lmtest)) throws some errors: there are aliased coefficients in the model
In case of these erros, I would like to run alias(lmtest)
Even though there are a few threads about trycatch() I could not fix it. What would be the easiest way to solve this?
tryCatch in R can look up to nice error handling in Python. You can try using tryCatch to catch the error and rerunning your code as necessary. Note that you can inspect if command returned an error and even what error exactly.
throwRandomError <- function(x = 0.5) {
if (runif(1) > x) {
stop("Random error encountered")
} else {
return(x)
}
}
set.seed(2)
ok <- tryCatch(
throwRandomError(x = 0.5),
error = function(e) e
)
bad <- tryCatch(
throwRandomError(x = 0.5),
error = function(e) e
)
str(bad)
List of 2
$ message: chr "Random error encountered"
$ call : language throwRandomError(x = 0.5)
- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"
# Catch any type of class, error, simpleError or condition.
# Only one is probably enough, but left here for redundancy.
if (class(bad) %in% c("error", "simpleError", "condition")) {
print("Rerunning lmtest")
result <- print(alias(lmtest))
}
You could catch specific error by using something along the lines of
if (bad$message == "Random error encountered") {
print("adapting workflow")
}
I am running the following code in R:
pkstwo <- function(x, tol = 1e-06) {
if (is.numeric(x))
x <- as.double(x)
else stop("argument 'x' must be numeric")
p <- rep(0, length(x))
p[is.na(x)] <- NA
IND <- which(!is.na(x) & (x > 0))
if (length(IND))
p[IND] <- .C(stats:::C_pkstwo, length(x[IND]), p = x[IND],
as.double(tol), PACKAGE = "stats")$p
p
}
But when I call pkstwo(0.1) I get the following error:
Error in get(name, envir = asNamespace(pkg), inherits = FALSE) :
object 'C_pkstwo' not found
Could anyone please help me fix this?
The C code is now called C_pKS2, and is used in the private function pkstwo() within ks.test()
Run ks.test with no parentheses to see its R code.
ks.test
Run stats:::C_pKS2 for some more info.
stats:::C_pKS2
edit: added full code
I made an S4 method for 'plot' that appears to be working, except it outputs some stray NULL to the console and I can't figure out where it's coming from. Here's the top level code:
print(plot(x = flux, y = 1, fastplot = TRUE, quietly = TRUE))
And the class:
flux <- setClass(
# Set the class name
"flux",
slots = c(
raw.data = "list",
source.files = "character",
data = "matrix",
time = "POSIXct",
datatype = "character",
metadata = "data.frame"
)
)
And the method:
setMethod("plot",
signature(x = "flux"),
function (x, y, ...) {
CheckFluxObject(x)
params <- LoadDefaults(flux = x)
# Interpret 'plot' arguments
par.restore <- par(no.readonly = TRUE)
on.exit(expr = par(par.restore), add = TRUE)
arguments <- list(...)
if (!("fastplot" %in% names(arguments))) {
fastplot <- FALSE
} else {
fastplot <- arguments$fastplot
arguments$fastplot <- NULL
}
if (!("quietly" %in% names(arguments))) {
quietly <- FALSE
} else {
quietly <- arguments$quietly
arguments$quietly <- NULL
}
par(ask=!(fastplot))
if (!("ylab" %in% arguments)) {
ylab <- params["units"]
} else {
ylab <- arguments$ylab
arguments$ylab <- NULL
}
# Pull relevant 'flux' class object data
data <- slot(x, "data")
if (missing("y")) {
y <- 1:ncol(data)
} else {
stopifnot(
is.integer(y),
all(y %in% 1:ncol(data))
)
}
# Bulk function execution
if (quietly == FALSE) {
message("Plotting data traces:")
}
plot.obj <- plot.new()
print("NULL is in the 'for' loop...")
for (i in y){
main <- colnames(data)[i]
plot.obj <- plot(slot(x, "time"), data[, i], main = main,
xlab = "Time", ylab = ylab, unlist(arguments))
print(plot.obj)
}
print("but is it also here??")
# Clean-up and exit
if (quietly == FALSE) {
message("Done plotting.")
}
if (length(y) == 1) {
invisible(plot.obj)
}
print("or here??")
invisible(NULL)
}
)
The output for that is:
[1] "NULL is in the 'for' loop..."
NULL
[1] "but is it also here??"
[1] "or here??"
NULL
If I throw in another print("what about here??") after the invisible(NULL),
then it does this:
[1] "NULL is in the 'for' loop..."
NULL
[1] "but is it also here??"
[1] "or here??"
[1] "what about here??"
[1] "what about here??"
Is there some behavior of the function return or print commands that I'm not anticipating? The CheckFluxObject function just checks to make sure all the slots are filled.
I'll leave this here till a better answer pops up, if ever:
Apparently the print method for plot objects returns a NULL, and if you're trying to generate a plot within a function it seems like the best way to do that is using invisible(plot.object) or invisible(plot(x, y, ...)), NOT print.
I'm still not sure where the 2nd NULL is coming from...
edit: Found the second one! Just like the print(plot.obj) in the method itself, the print in the top-level code was throwing a NULL. Dropping all of the print commands killed all of the ghosts.
I've been trying to get a parallelized foreach loop running in R, it works fine for approximately ten iterations but then crashes, showing the error:
Error in { : task 7 failed - "missing value where TRUE/FALSE needed"
Calls: %dopar% -> <Anonymous>
Execution halted
I append the results of each loop to a file, which does show the output to be as expected. My script is as followed,using the combn_sub function from this post:
LBRA <- fread(
input = "LBRA.012",
data.table = FALSE)
str_bra <- nrow(LBRA)
br1sums <- colSums(LBRA)
b1non <- which(br1sums == 0)
LBRA_trim <- LBRA[,-b1non]
library(foreach)
library(doMC)
registerDoMC(28)
foreach(X = seq(2, (nrow(LBRA)-1))) %dopar% {
com <- combn_sub(
x = nrow(LBRA),
m = X,
nset = 1000)
out_in <- matrix(
ncol = 2,
nrow = 1)
colnames(out) <- c("SNPs", "k")
for (A in seq(1, ncol(com))){
rowselect <- com[, A]
sub <- LBRA_trim[rowselect, ]
subsum <- colSums(sub)
length <- length(which(subsum != 0)) - 1
out_in <- rbind(out_in, c(length, X))
}
write.table(
file = "plateau.csv",
sep = "\t",
x = out_in,
append = TRUE)
}
I had a similar problem with my foreach call...
tmpcol <- foreach(j = idxs:idxe, .combine=cbind) %dopar% { imp(j) }
Error in { : task 18 failed - "missing value where TRUE/FALSE needed"
Changing the .errorhandling parameter only ignores the error
tmpcol <- foreach(j = idxs:idxe, .combine=cbind, .errorhandling="pass") %dopar% { imp(j) }
Warning message:
In fun(accum, result.18) :
number of rows of result is not a multiple of vector length (arg 2)
I suggest running the function in your foreach call for X=7. The problem in my case was my function, imp(j), was throwing an error (for j=18, it was hitching on an NA calculation) which resulted in the vague output from foreach.
As #Roland points out, it's a very bad idea to write to a file within a foreach loop. Even writing in append mode, the individual cores will attempt to write to the file simultaneously and may clobber each other's input. Instead, capture the results of the foreach statement using the .combine="rbind" option and then write to file after the loop:
cluster <- makeCluster(28, outfile="MulticoreLogging.txt");
registerDoMc(cluster);
foreach_outcome_table <- foreach(X = seq(2, (nrow(LBRA)-1)), .combine="rbind") %dopar% {
print(cat(paste(Sys.info()[['nodename']], Sys.getpid(), sep='-'), "now performing loop", X, "\n"));
com <- combn_sub(x = nrow(LBRA), m = X, nset = 1000);
out_in <- matrix(ncol = 2,nrow = 1);
colnames(out_in) <- c("SNPs", "k");
for (A in seq(1, ncol(com))){
rowselect <- com[, A];
sub <- LBRA_trim[rowselect, ];
subsum <- colSums(sub);
length <- length(which(subsum != 0)) - 1;
out_in <- rbind(out_in, c(length, X));
}
out_in;
}
write.table(file = "plateau.csv",sep = "\t", x = foreach_outcome_table, append = TRUE);
Further, you could replace the inner for loop with a nested foreach loop which would probably be more efficient.
There could be many reasons for the error, "missing value where TRUE/FALSE needed".
What helped for me was to remove the %dopar% and run the same code on a single item. This revealed more/clearer error messages which, I think, get lost when running in parallel. My error had nothing to do with the %dopar% itself.