[R] How can I avoid the for and If loops in my function?
Jeff Newmiller
jdnewmil at dcn.davis.CA.us
Wed Jun 18 20:25:37 CEST 2014
I don't feel any need to help you if you won't read the Posting Guide and follow its guidance... specifically you provide explanation (good) but not a reproducible example (see e.g. [1]) and you are posting in HTML which often corrupts your code (and is definitely not a what-you-see-is-what-we-see format).
[1] http://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example
---------------------------------------------------------------------------
Jeff Newmiller The ..... ..... Go Live...
DCN:<jdnewmil at dcn.davis.ca.us> Basics: ##.#. ##.#. Live Go...
Live: OO#.. Dead: OO#.. Playing
Research Engineer (Solar/Batteries O.O#. #.O#. with
/Software/Embedded Controllers) .OO#. .OO#. rocks...1k
---------------------------------------------------------------------------
Sent from my phone. Please excuse my brevity.
On June 18, 2014 9:41:02 AM PDT, Laz <lmramba at ufl.edu> wrote:
>Dear R-users,
>
>I have a 3200 by 3200 matrix that was build from a data frame that had
>180 observations, with variables: x, y, blocks (6 blocks) and
>treatments (values range from 1 to 180) I am working on. I build other
>functions that seem to work well. However, I have one function that has
>
>many If loops and a long For loop that delays my results for over 10
>hours ! I need your help to avoid these loops.
>
>########################################################
>## I need to avoid these for loops and if loops here :
>########################################################
>### swapsimple() is a function that takes in a dataframe, randomly
>swaps
>two elements from the same block in a data frame and generates a new
>dataframe called newmatdf
>
>### swapmainF() is a function that calculates the trace of the final N
>by N matrix considering the incident matrices and blocks and treatments
>
>and residual errors in a linear mixed model framework using Henderson
>approach.
>
>funF<- function(newmatdf, n, traceI)
>{
># n = number of iterations (swaps to be made on pairs of elements of
>the
>dataframe, called newmatdf)
># newmatdf : is the original dataframe with N rows, and 4 variables
>(x,y,blocks,genotypes)
> matrix0<-newmatdf
> trace<-traceI ## sum of the diagonal elements of the N by N matrix
>(generated outside this loop) from the original newmatdf dataframe
> res <- list(mat = NULL, Design_best = newmatdf, Original_design =
>matrix0) # store our output of interest
> res$mat <- rbind(res$mat, c(value = trace, iterations = 0)) #
>initialized values
> Des<-list()
> for(i in seq_len(n)){
> ifelse(i==1,
>newmatdf<-swapsimple(matrix0),newmatdf<-swapsimple(newmatdf))
> Des[[i]]<-newmatdf
> if(swapmainF(newmatdf) < trace){
> newmatdf<-Des[[i]]
> Des[[i]]<-newmatdf
> trace<- swapmainF(newmatdf)
> res$mat <- rbind(res$mat, c(trace = trace, iterations = i))
> res$Design_best <- newmatdf
> }
> if(swapmainF(newmatdf) > trace & nrow(res$mat)<=1){
> newmatdf<-matrix0
> Des[[i]]<-matrix0
> res$Design_best<-matrix0
> }
> if(swapmainF(newmatdf)> trace & nrow(res$mat)>1){
> newmatdf<-Des[[length(Des)-1]]
> Des[[i]]<-newmatdf
> res$Design_best<-newmatdf
> }
> }
> res
>}
>
>
>
>The above function was created to:
>Take an original matrix, called matrix0, calculate its trace. Generate
>a new matrix, called newmatdf after swapping two elements of the old
>one and calculate the trace. If the trace of the newmatrix is smaller
>than
>that of the previous matrix, store both the current trace together with
>the older trace and their iteration values. If the newer matrix has a
>trace larger than the previous trace, drop this trace and drop this
>matrix too (but count its iteration).
>Re-swap the old matrix that you stored previously and recalculate the
>trace. Repeat the
> process many times, say 10,000. The final results should be a list
> with the original initial matrix and its trace, the final best
> matrix that had the smallest trace after the 10000 simulations and a
> dataframe showing the values of the accepted traces that
> were smaller than the previous and their respective iterations.
>
>$Original_design
> x y block genotypes
>1 1 1 1 29
>7 1 2 1 2
>13 1 3 1 8
>19 1 4 1 10
>25 1 5 1 9
>31 1 6 2 29
>37 1 7 2 4
>43 1 8 2 22
>49 1 9 2 3
>55 1 10 2 26
>61 1 11 3 18
>67 1 12 3 19
>73 1 13 3 28
>79 1 14 3 10
>------truncated ----
>
>
>the final results after running funF<-
> function(newmatdf,n,traceI) given below looks like this:
>
>
>
>
>ans1
>$mat
> value iterations
> [1,] 1.474952 0
> [2,] 1.474748 1
> [3,] 1.474590 2
> [4,] 1.474473 3
> [5,] 1.474411 5
> [6,] 1.474294 10
> [7,] 1.474182 16
> [8,] 1.474058 17
> [9,] 1.473998 19
>[10,] 1.473993 22
>
>
> ---truncated
>
>
>
>
>
>
>
>
>$Design_best
> x y block genotypes
>1 1 1 1 29
>7 1 2 1 2
>13 1 3 1 18
>19 1 4 1 10
>25 1 5 1 9
>31 1 6 2 29
>37 1 7 2 21
>43 1 8 2 6
>49 1 9 2 3
>55 1 10 2 26
>
>
> ---- truncated
>
>
>
>
>
>
>$Original_design
> x y block genotypes
>1 1 1 1 29
>7 1 2 1 2
>13 1 3 1 8
>19 1 4 1 10
>25 1 5 1 9
>31 1 6 2 29
>37 1 7 2 4
>43 1 8 2 22
>49 1 9 2 3
>55 1 10 2 26
>61 1 11 3 18
>67 1 12 3 19
>73 1 13 3 28
>79 1 14 3 10
>------truncated
>
>
>
>Regards,
>Laz
>
>
> [[alternative HTML version deleted]]
>
>______________________________________________
>R-help at r-project.org mailing list
>https://stat.ethz.ch/mailman/listinfo/r-help
>PLEASE do read the posting guide
>http://www.R-project.org/posting-guide.html
>and provide commented, minimal, self-contained, reproducible code.
More information about the R-help
mailing list