[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