I'm trying to create a data frame within the if statement , but when I use this data frame in the else scope I get the following error:
Error: $ operator is invalid for atomic vectors
Here is part of my code:
for(i in 1:numOfTrays){
if (i == 1){
parameters <- c(Qin=Qin,A=A)
state <- c(h=h0)
time <- seq(0,200,by=1)
out <- ode(y= state, func = FluidH, parms = parameters, times = time)
Qout <- cbind(out[,1],VFRoutput((out[,2])))
colnames(Qout)<-c("time","Qout")
Qin <- as.data.frame(Qout)
#write.csv(Qin,"Qin")
}
else{
for (j in 1:length(Qin$Qout)){
h <- h0 + ((Qin$Qout[j]-VFRoutput(h0))/A)*Qin$time[j]
I tried to make Qin global with the <<- operator but when I tried to print Qin$Qout from the if statement I got the same error.
Any solutions?
While your example is not reproducible, I would venture a guess that Qout exists before the if statement as a matrix or some sort (perhaps with no column names). Here's a reproducible example:
Qout <- matrix(NA, nrow = 3, ncol = 3)
chk <- TRUE
if (chk) {
out <- as.data.frame(Qout)
} else {
Qout$col1
}
Qout <- matrix(NA, nrow = 3, ncol = 3)
chk <- FALSE
if (chk) {
out <- as.data.frame(Qout)
} else {
Qout$col1
}
Error in Qout$col1 : $ operator is invalid for atomic vectors
So you need to make sure that in else statement, you're dealing with an object that supports $ subsetting - like a data.frame.
Related
Using argparser in R, I'm getting an error when specifying the type of an argument in the call to add_argument but not passing an argument to the script at the MacOSX command line. For example, given this R script:
library(argparser)
p <- arg_parser(description = "A test parser")
p <- add_argument(p, "--alpha", type = "double", help = "alpha for p-value")
p <- add_argument(p, "--sig-digits", type = "integer", help="number of significant digits")
args <- parse_args(p)
print(str(args))
and invoking it at the command line:
Rscript argparser-test.R --alpha 0.1
I am returned the error:
Error in (function (object, class, nargs) :
Invalid argument value: expecting integer but got: (NA).
Calls: parse_args -> mapply -> <Anonymous>
Interestingly, there is no error if you let --alpha take it's default:
Rscript argparser-test.R
Returns:
List of 5
$ : logi FALSE
$ help : logi FALSE
$ opts : logi NA
$ alpha : logi NA
$ sig_digits: logi NA
NULL
Notice the NA value here for sig_digits is type logical, not integer, as defined in the add_argument function.
Am I doing something wrong here? In the mean time, I suppose I will get around this by making the default --sig-digits = -1, then handling that as an exception, but I'd prefer not to.
Update: Actually, -1 throws the same error, which is very frustrating because I want to use a number for the exception that non-sensical. 9999 works, and is unlikely to be input by the user, but actually it's valid.
I experienced this error a month back or so. This is a problem with how optional arguments are parsed by the argparser package. Basically it does respect the order of optional arguments as it should in every situation, and sometimes it thus expects the wrong argument type.
I've opened an issue on the package bitbucket page. I highly suggest upvoting this and adding a comment to help adding to the attention of the issue.
In my issue I provided a possible solution to the problem which amounts to changing parse_args to the following definition (one could pull and recreate the package with this function at which point it would [should] work as expected)
parse_args <- function (parser, argv = commandArgs(trailingOnly = TRUE))
{
stopifnot(is(parser, "arg.parser"))
values <- list()
argv <- preprocess_argv(argv, parser)
arg.flags <- parser$args[parser$is.flag]
x <- as.logical(parser$defaults[parser$is.flag])
x[is.na(x)] <- FALSE
names(x) <- sub("^-+", "", arg.flags)
flag.idx <- match(arg.flags, argv)
flag.idx <- flag.idx[!is.na(flag.idx)]
if (length(flag.idx) > 0) {
x[match(argv[flag.idx], arg.flags)] <- TRUE
argv <- argv[-flag.idx]
}
values <- c(values, x)
if (values$help) {
print(parser)
quit()
}
x <- parser$defaults[parser$is.opt.arg]
arg.opt <- parser$args[parser$is.opt.arg]
names(x) <- sub("^-+", "", arg.opt)
i <- match("--opts", argv)
if (!is.na(i)) {
opts <- readRDS(argv[i + 1])
opts <- opts[!names(opts) %in% c("opts", "help")]
idx <- match(sanitize_arg_names(names(opts)), sanitize_arg_names(names(x)))
if (any(is.na(idx))) {
stop("Extra arguments supplied in OPTS file: (",
paste(setdiff(names(opts), names(x)), collapse = ", "),
").")
}
x[idx] <- opts
}
arg.idx <- match(arg.opt, argv)
arg.idx <- arg.idx[!is.na(arg.idx)]
arg.opt.types <- parser$types[parser$is.opt.arg]
arg.opt.nargs <- parser$nargs[parser$is.opt.arg]
### ###
## Altered section ##
### ###
if (length(arg.idx) > 0) {
# extract values following the optional argument label
x[ind <- match(argv[arg.idx], arg.opt)] <- argv[arg.idx+1];
# convert type of extraced values; x is now a list
x[ind] <- mapply(convert_type,
object = x[ind],
class = arg.opt.types[ind],
nargs = arg.opt.nargs[ind],
SIMPLIFY = FALSE);
# remove extracted arguments
to.remove <- c(arg.idx, arg.idx+1);
argv <- argv[-to.remove];
}
### ###
## Altered section ##
### ###
values <- c(values, x)
x <- argv
args.req <- parser$args[parser$is.req.arg]
args.req.types <- parser$types[parser$is.req.arg]
args.req.nargs <- parser$nargs[parser$is.req.arg]
if (length(x) < length(args.req)) {
print(parser)
stop(sprintf("Missing required arguments: expecting %d values but got %d values: (%s).",
length(args.req), length(x), paste(x, collapse = ", ")))
}
else if (length(x) > length(args.req)) {
print(parser)
stop(sprintf("Extra arguments supplied: expecting %d values but got %d values: (%s).",
length(args.req), length(x), paste(x, collapse = ", ")))
}
else if (length(args.req) > 0) {
names(x) <- args.req
x <- mapply(convert_type, object = x, class = args.req.types,
nargs = args.req.nargs, SIMPLIFY = FALSE)
}
values <- c(values, x)
names(values) <- sanitize_arg_names(names(values))
values
}
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.
Assume I have the following function:
f1 <- function()
{
get.var <- function(v)
{
for(n in 1:sys.nframe())
{
varName <- deparse(substitute(v, env = parent.frame(n)))
if(varName != "v")
{
break
}
}
return(list(name = varName, n = n))
}
f2 <- function(v)
{
print(v)
# get original variable name and environment
obj <- get.var(v)
#below doesn't work as expected - this is where q$a and q$b would be updated
assign(obj$name, v + 1, env = parent.frame(obj$n))
}
f3 <- function(v){ f2(v) }
f4 <- function(v){ f3(v) }
q <- list(a = 2, b = 3)
f4(q$a)
f3(q$b)
}
How can I update the value of q$a and q$b from f2? The situation is that a similar routine is called in some of my code to validate a number of arguments in a nested list. If a value is incorrect the list element needs to be updated to reflect the correct value. It's certainly an ugly way to do it but unfortunately I cannot pass the entire list to each and every validation function.
A somewhat similar question was asked here but the user was passing in a list element instead.
Instead of using assign(obj$name, v + 1, env = parent.frame(obj$n)), I replaced this with eval(parse(text = sprintf("%s <- %d", obj$name, v + 1)), envir = parent.frame(obj$n))
It is horrendously ugly, but it works.
I am using a function from a package. this function returns some values. For example:
k<-dtw(v1,v2, keep.internals=TRUE)
and I can get this value:
k$costMatrix
Does it possible to see the source code of costMatrix? if yes how can I do that?
UPDATE
this is the source code of the function:
function (x, y = NULL, dist.method = "Euclidean", step.pattern = symmetric2,
window.type = "none", keep.internals = FALSE, distance.only = FALSE,
open.end = FALSE, open.begin = FALSE, ...)
{
lm <- NULL
if (is.null(y)) {
if (!is.matrix(x))
stop("Single argument requires a global cost matrix")
lm <- x
}
else if (is.character(dist.method)) {
x <- as.matrix(x)
y <- as.matrix(y)
lm <- proxy::dist(x, y, method = dist.method)
}
else if (is.function(dist.method)) {
stop("Unimplemented")
}
else {
stop("dist.method should be a character method supported by proxy::dist()")
}
wfun <- .canonicalizeWindowFunction(window.type)
dir <- step.pattern
norm <- attr(dir, "norm")
if (!is.null(list(...)$partial)) {
warning("Argument `partial' is obsolete. Use `open.end' instead")
open.end <- TRUE
}
n <- nrow(lm)
m <- ncol(lm)
if (open.begin) {
if (is.na(norm) || norm != "N") {
stop("Open-begin requires step patterns with 'N' normalization (e.g. asymmetric, or R-J types (c)). See papers in citation().")
}
lm <- rbind(0, lm)
np <- n + 1
precm <- matrix(NA, nrow = np, ncol = m)
precm[1, ] <- 0
}
else {
precm <- NULL
np <- n
}
gcm <- globalCostMatrix(lm, step.matrix = dir, window.function = wfun,
seed = precm, ...)
gcm$N <- n
gcm$M <- m
gcm$call <- match.call()
gcm$openEnd <- open.end
gcm$openBegin <- open.begin
gcm$windowFunction <- wfun
lastcol <- gcm$costMatrix[np, ]
if (is.na(norm)) {
}
else if (norm == "N+M") {
lastcol <- lastcol/(n + (1:m))
}
else if (norm == "N") {
lastcol <- lastcol/n
}
else if (norm == "M") {
lastcol <- lastcol/(1:m)
}
gcm$jmin <- m
if (open.end) {
if (is.na(norm)) {
stop("Open-end alignments require normalizable step patterns")
}
gcm$jmin <- which.min(lastcol)
}
gcm$distance <- gcm$costMatrix[np, gcm$jmin]
if (is.na(gcm$distance)) {
stop("No warping path exists that is allowed by costraints")
}
if (!is.na(norm)) {
gcm$normalizedDistance <- lastcol[gcm$jmin]
}
else {
gcm$normalizedDistance <- NA
}
if (!distance.only) {
mapping <- backtrack(gcm)
gcm <- c(gcm, mapping)
}
if (open.begin) {
gcm$index1 <- gcm$index1[-1] - 1
gcm$index2 <- gcm$index2[-1]
lm <- lm[-1, ]
gcm$costMatrix <- gcm$costMatrix[-1, ]
gcm$directionMatrix <- gcm$directionMatrix[-1, ]
}
if (!keep.internals) {
gcm$costMatrix <- NULL
gcm$directionMatrix <- NULL
}
else {
gcm$localCostMatrix <- lm
if (!is.null(y)) {
gcm$query <- x
gcm$reference <- y
}
}
class(gcm) <- "dtw"
return(gcm)
}
but if I write globalCostMatrix I dont get the source code of this function
The easiest way to find how functions work is by looking at the source. You have a good chance that by typing function name in the R console, you will get the function definitions (although not always with good layout, so seeking the source where brackets are present, is a viable option).
In your case, you have a function dtw from the same name package. This function uses a function called globalCostMatrix. If you type that name into R, you will get an error that object was not found. This happens because the function was not exported when the package was created, probably because the author thinks this is not something a regular user would use (but not see!) or to prevent clashes with other packages who may use the same function name.
However, for an interested reader, there are at least two ways to access the code in this function. One is by going to CRAN, downloading the source tarballs and finding the function in the R folder of the tar ball. The other one, easier, is by using getAnywhere function. This will give you the definition of the function just like you're used for other, user accessible functions like dtw.
> library(dtw)
> getAnywhere("globalCostMatrix")
A single object matching ‘globalCostMatrix’ was found
It was found in the following places
namespace:dtw
with value
function (lm, step.matrix = symmetric1, window.function = noWindow,
native = TRUE, seed = NULL, ...)
{
if (!is.stepPattern(step.matrix))
stop("step.matrix is no stepMatrix object")
n <- nrow(lm)
... omitted for brevity
I think you want to see what the function dtw() does with your data. I seems that it creates a data.frame containing a column named costMatrix.
To find out how the data in the column costMatrix was generated, just type and execute dtw (without brackets!). R will show you the source of the function dtw() afterwards.
After some manipulation of data, I want to rename automatically the data taking pieces of name from a string, merging togheter these pieces and then assigning to data. I try to use "if" function in for loop but the code doesn't work. I try to use "grep" as condition in "if" function.
filepath<-c("C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_0.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_1.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_2.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_3.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_4.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_5.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_6.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_1-P1_0.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_1-P1_1.csv",
....)
for(i in filepath){
......
f <- substr(i,10,23) # first piece of name
f2 <- as.character(substr(i,40,57)) # second piece of name
if (grep("W_0",f2)){
m<-c("_sin")
}
if (grep("W_1",f2)){
m<-c("_jan2_febreal")
}
if (grep("W_2",f2)){
m<-c("_real")
}
if (grep("W_3",f2)){
m<-c("_step")
}
if (grep("P1_0",f2,value = FALSE)){
t<-c("_t0.025")
}
if (grepl("P1_1",f2,value = FALSE)){
t<-c("_t0.05")
}
if (grepl("P1_2",f2,value = FALSE)){
t<-c("_t0.1")
}
if (grepl("P1_3",f2,value = FALSE)){
t<-c("_t0.15")
}
if (grepl("P1_4",f2,value = FALSE)){
t<-c("_t0.2")
}
if (grepl("P1_5",f2,value = FALSE)){
t<-c("_t0.25")
}
if (grepl("P1_6",f2,value = FALSE)){
t<-c("_t0.3")
}
}
Outputfilename <- paste(paste(f,m,sep=""),t,sep="")
the result is:
Errore in if (grep("W_1", f2)) { : l'argomento ha lunghezza zero
Without any for loops or if statements, it seems to me you can simply vectorize everything:
f <- substr(filepath,10,23)
m <- t <- character(length(filepath))
m[grepl("W_0",filepath)]<-"_sin"
m[grepl("W_1",filepath)]<-"_jan2_febral"
m[grepl("W_2",filepath)]<-"_real"
m[grepl("W_3",filepath)]<-"_step"
t[grepl("P1_0",filepath)]<-"_t0.025"
t[grepl("P1_1",filepath)]<-"_t0.05"
t[grepl("P1_2",filepath)]<-"_t0.1"
t[grepl("P1_3",filepath)]<-"_t0.15"
t[grepl("P1_4",filepath)]<-"_t0.2"
t[grepl("P1_5",filepath)]<-"_t0.25"
t[grepl("P1_6",filepath)]<-"_t0.3"
Outputfilename <- paste(f,m,t,sep="")
That you can also probably simplify the following way:
f <- substr(filepath,10,23)
m <- t <- character(length(filepath))
w <- array(c(paste("W",0:3,sep="_"),
"_sin", "_jan2_febral", "_real", "_step"), dim=c(4,2))
p <- array(c(paste("P1",0:6,sep="_"),
paste("t_0.",c("025","05","1","15","2","25","3"),sep="")), dim=c(7,2))
for(i in 1:nrow(w)){m[grepl(w[i,1],filepath)] <- w[i,2]}
for(i in 1:nrow(p)){t[grepl(p[i,1],filepath)] <- p[i,2]}
Outputfilename <- paste(f,m,t,sep="")
That you can wrap in a function if you like:
outputfile.namer <- function(filepath,w,p){
# filepath being your vector of file paths
# w and p your correspondance tables for your "W_" and "P_" series respectively
f <- do.call(rbind,strsplit(gsub("C:/Users/","",filepath),split="/"))[,1]
# the preceding is more general than `f <- substr(filepath,10,23)` to grab the name of the User
m <- t <- character(length(filepath))
for(i in 1:nrow(w)){m[grepl(w[i,1],filepath)] <- w[i,2]}
for(i in 1:nrow(p)){t[grepl(p[i,1],filepath)] <- p[i,2]}
paste(f,m,t,sep="")
}