Search code examples
rfunctionloopsextractpurrr

R: Storing outputs from a function containing a loop (or removing the loop)


EDIT: Now solved, solution below.

I've been given a function for R which I need to run multiple times for different inputs, and extract the outputs (which will later go into a data frame). Reproducible example below.

The two issues are:

  1. I can't tell how to output the data from the function below to something that can be read from, like a matrix, string, other object, etc. I've read about outputting things to lists, but (as well as not being able to capture the output in an object) this seems to fall foul of the second issue, which is that:
  2. the function contains a loop, and so when I do try and output the numbers, I often only get the output from the first iteration of the loop, when I need all the outputs (most of the times there will just be two sets of numbers, but there are sometimes more).

Is anyone able to please kindly advise how to re-work this function so it outputs an object I can read the values from? Perhaps the loop could be replaced with a map/lapply function or similar, but I'm really struggling to wrap my head around writing these.

Reproducible example (note, requires the cmprsk and survival packages):

numbercruncher<-function(y,ev)
{
  est<-round(y$est*100,1)
  low<-round((exp(log(y$est)-1.96*sqrt(y$var)/y$est))*100,1)
  up<-round((exp(log(y$est)+1.96*sqrt(y$var)/y$est))*100,1)
  d<-nrow(est)/2
  for (i in 1:d){
    rws<-i+d*(ev-1)
    cat("group",i,fill=TRUE)
    out<-t(rbind(est[rws,],low[rws,],up[rws,]))
    colnames(out)<-c("value1","value2","value3")
    print(out)
  }
}

set.seed(1234)
v <-sample(0:2, 1500, replace = TRUE)
t <-sample(0:90, 1500, replace = TRUE)
g <- sample(0:4, 1500, replace = TRUE)

incidence.model <- cuminc(t, v, g, cencode = 0)

incidence.y<-timepoints(incidence.model,times=c(90))

numbercruncher(incidence.y,1)

Output:

     value1 value2 value3
[1,]   48.3   41.7     56
group 2
     value1 value2 value3
[1,]   46.9     40     55
group 3
     value1 value2 value3
[1,]   50.1   42.1   59.6
group 4
     value1 value2 value3
[1,]   49.7   41.2     60
group 5
     value1 value2 value3
[1,]   43.6   37.3   50.9

In this example I would ideally end up with a vector of all the value1s, another with all the value2s, and one with all the value3s.

Thank you for your time and your help!

SOLVED using '<<'

numbercruncher<-function(y,ev)
{
  out.final <<- numeric()
  est<-round(y$est*100,1)
  low<-round((exp(log(y$est)-1.96*sqrt(y$var)/y$est))*100,1)
  up<-round((exp(log(y$est)+1.96*sqrt(y$var)/y$est))*100,1)
  d<-nrow(est)/2
  for (i in 1:d){
    rws<-i+d*(ev-1)
    cat("group",i,fill=TRUE)
    out<-t(rbind(est[rws,],low[rws,],up[rws,]))
    colnames(out)<-c("value1","value2","value3")
    print(out)
    out.final <<- append(out.final, out)
  }
}

set.seed(1234)
v <-sample(0:2, 1500, replace = TRUE)
t <-sample(0:90, 1500, replace = TRUE)
g <- sample(0:4, 1500, replace = TRUE)

incidence.model <- cuminc(t, v, g, cencode = 0)

incidence.y<-timepoints(incidence.model,times=c(90))

numbercruncher(incidence.y,1)

This gives a numeric vector which can be converted to a matrix using:

out.final.matrix <- matrix(out.final, ncol = 3, byrow = TRUE)

Solution

  • Per your resolved solution, it is advised in R to avoid the scoping assignment operator, <<-, which can be hard to maintain code for debugging and side effect reasons. Additionally, avoid growing objects inside loops with append.

    Consider instead to call an apply function like sapply or vapply for simplified vectors (since all elements are numeric) to gather returned elements. You might be able to do away with rbind and t calls. (Please note below is untested.)

    numbercruncher <- function(y, ev)
    {
      est <- round(y$est * 100, 1)
      low <- round((exp(log(y$est) - 1.96 * sqrt(y$var) / y$est)) * 100, 1)
      up <- round((exp(log(y$est) + 1.96 * sqrt(y$var) / y$est)) * 100, 1)
      d <- nrow(est) / 2
    
      results <- sapply(1:d, function(i) {
        rws <- i+d*(ev-1)
        cat("group",i,fill=TRUE)
    
        # RETURN NAMED VECTOR
        out <- c(value1=est[rws,], value2=low[rws,], value3=up[rws,])
        return(out)  # REDUNDANT LINE BUT ILLUSTRATIVE
      })
    
      return(results)  # REDUNDANT LINE BUT ILLUSTRATIVE
    }
    
    out.final2 <- numbercruncher(incidence.y,1)
    

    Try swapping sapply for vapply for faster return (again, untested):

    results <- vapply(1:d, function(i) {
        rws <- i+d*(ev-1)
        cat("group",i,fill=TRUE)
    
        # RETURN NAMED VECTOR
        out <- c(value1=est[rws,], value2=low[rws,], value3=up[rws,])
        return(out)
    
    }, numeric(3))
    

    Output above is same content as OP's. Instead of a vector of 15, above results in a matrix of 3 X 5 which can easily be converted to vector.

    out.final
    #  [1] 48.3 41.7 56.0 46.9 40.0 55.0 50.1 42.1 59.6 49.7 41.2 60.0 43.6 37.3 50.9
    
    out.final2
    #        [,1] [,2] [,3] [,4] [,5]
    # value1 48.3 46.9 50.1 49.7 43.6
    # value2 41.7 40.0 42.1 41.2 37.3
    # value3 56.0 55.0 59.6 60.0 50.9
    
    identical(out.final, as.vector(out.final2))
    # [1] TRUE