CODEWITHSUNDEEP
rapplyuser-defined-functions
Jacob
Jacob

Reputation: 183

applying user defined function without for loop

I am trying to use a custom function to solve for multiple permutations of the arguments.

The function (yield.n) works fine when I call it one time such as: yield.n(naa, F, M, S, Y) naa is a large data frame (750000 x 17), F, M, and Y are numeric objects and S is a vector.

I would like to solve with this function for various values of Y. I tried multiple permutations of the apply family, but I cannot come up with functional code. If I run a for loop for values of Y (code blow) it solves correctly but is very slow. 

yn.out <- NULL                                        
    for(yr in 50:150){                               
           yr.out <- yield.n(naa, ssf, M, S, yr)         
           yr.out <- cbind(yr.out, yr)                       
           yn.out <- rbind(yn.out, yr.out)
        }

yn.out <- as.data.frame(yn.out)

How do I get an apply function to work on this to solve for multiple values of Y?

The code for the function is as follows (but I am not sure that is relevant to the problem at hand). 

function(naa, F, M, S, Y){
    yr <- Y
    naa.lci <- aggregate(naa[, 1:16], list(naa$year),
                         "quantile", probs = .05)
    naa.m   <-  aggregate(naa[, 1:16], list(naa$year),
                          "quantile", probs = .5)
    naa.uci <- aggregate(naa[, 1:16], list(naa$year),
                         "quantile", probs = .9)
    yield.n.lci <- round(sum(((F*S)/(M + (F*S))) * (1- exp(-M-(F*S))) *
                             naa.lci[yr, 2:17]))
    yield.n.m   <- round(sum(((F*S)/(M + (F*S))) * (1- exp(-M-(F*S))) *
                             naa.m[yr, 2:17]))
    yield.n.uci <- round(sum(((F*S)/(M + (F*S))) * (1- exp(-M-(F*S))) *
                             naa.uci[yr, 2:17]))
    yield.out <- cbind(yield.n.lci, yield.n.m, yield.n.uci)
    return(yield.out)
}

Upvotes: 0

Views: 53

Answers (1)

Ronak Shah
Ronak Shah

Reputation: 388817

Try the following : 

yn.out <- do.call(rbind, lapply(50:150, function(y) 
                  cbind(yield.n(naa, F, M, S, y), yr = y)))

Or using purrr::map_df

yn.out <- purrr::map_df(50:150, ~cbind(yield.n(naa, F, M, S, .x), yr = .x))

Upvotes: 1

Related Questions