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:<jdnew...@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 <lmra...@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@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. ______________________________________________ R-help@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.
