lundi 4 juillet 2016

Change length.out in ifelse function

I'm running a simple ifelse function

f <- function(x) {
ifelse(x==shift(x), x + 0.001* sd(x, na.rm = TRUE), x)
}

where shift is from the data.table package

which allows me to change, for each column in a dataframe (usig apply), a value which is exactly the same as the previous one. The problem is that the ifelse function returns a length which is equal to the length of the test. In this case, the length is the one of shift(x) and not x. Therefore I end up with the first element (or the last, if using type = "lead", instead of the default "lag") of each column turned into NA.

Here a MWE:

a <- c(1,2,2,3,4,5,6)
b <- c(4,5,6,7,8,8,9)
data <- data.frame(cbind(a,b))
f <- function(x) {
ifelse(x==shift(x), x + 0.001* sd(x, na.rm = TRUE), x)
}
apply(data, 2, f)

Therefore I thought I could change the ifelse function: I've done a few attempts to change the length.out but I haven't succeeded yet

function (test, yes, no) 
{
if (is.atomic(test)) {
    if (typeof(test) != "logical") 
        storage.mode(test) <- "logical"
    if (length(test) == 1 && is.null(attributes(test))) {
        if (is.na(test)) 
            return(NA)
        else if (test) {
            if (length(yes) == 1 && is.null(attributes(yes))) 
              return(yes)
        }
        else if (length(no) == 1 && is.null(attributes(no))) 
            return(no)
    }
}
else test <- if (isS4(test)) 
    methods::as(test, "logical")
else as.logical(test)
ans <- test
ok <- !(nas <- is.na(test))
if (any(test[ok])) 
    ans[test & ok] <- rep(yes, length.out = length(ans))[test & 
        ok]
if (any(!test[ok])) 
    ans[!test & ok] <- rep(no, length.out = length(ans))[!test & 
        ok]
ans[nas] <- NA
ans
}

Aucun commentaire:

Enregistrer un commentaire