Dear R users,
I am stuck here: My first function returns a vector of 5 values.
In my second function, I want to repeat this, a number of times, say 10
so that I have 10 rows and five columns but I keep on getting errors.
See the code and results below:
optm <-function(perm, verbose = FALSE)
{
trace<-c()
for (k in 1:perm){
trace[k]<-Rspatswap(rhox=0.6,rhoy=0.6,sigmasqG=0.081,SsqR=1)[1]
perm[k]<-k
mat<-cbind(trace, perm = seq(perm))
}
if (verbose){
cat("***starting matrix\n")
print(mat)
}
# iterate till done
while(nrow(mat) > 1){
high <- diff(mat[, 'trace']) > 0
if (!any(high)) break # done
# find which one to delete
delete <- which.max(high) + 1L
mat <- mat[-delete, ]
newmat<-apply(mat,2,mean)[1]
sdm<-sd(mat[,1])
sem<-sdm/sqrt(nrow(mat))
maxv<-mat[1,1]
minv<-mat[nrow(mat),1]
}
stats<-cbind(average=newmat,sd=sdm,se=sem,min=minv,max=maxv)
stats
}
>test<-optm(perm=20)
>test
average sd se min max
trace 0.8880286 0.0009178193 0.0004589096 0.8870152 0.889241
itn<-function(it){
siml<-matrix(NA,ncol=5,nrow=length(it))
for(g in 1:it){
siml[g]<-optm(perm=20)
}
siml<-cbind(siml=siml)
siml
}
>ans<-itn(5)
Warning messages:
1: In siml[g] <- optm(perm = 20) :
number of items to replace is not a multiple of replacement length
2: In siml[g] <- optm(perm = 20) :
number of items to replace is not a multiple of replacement length
3: In siml[g] <- optm(perm = 20) :
number of items to replace is not a multiple of replacement length
4: In siml[g] <- optm(perm = 20) :
number of items to replace is not a multiple of replacement length
5: In siml[g] <- optm(perm = 20) :
number of items to replace is not a multiple of replacement length
>ans
[,1] [,2] [,3] [,4] [,5]
[1,] 0.8874234 0.8861666 0.8880521 0.8870958 0.8876469
On 5/31/2013 9:53 PM, jim holtman wrote:
> Is this what you want? I was not clear on your algorithm, but is
> looks like you wanted descending values:
> > testx <-
> + function(n, verbose = FALSE)
> + {
> + mat <- cbind(optA = sample(n, n, TRUE), perm = seq(n))
> + if (verbose){
> + cat("***starting matrix\n")
> + print(mat)
> + }
> + # iterate till done
> + while(nrow(mat) > 1){
> + high <- diff(mat[, 'optA']) > 0
> + if (!any(high)) break # done
> + # find which one to delete
> + delete <- which.max(high) + 1L
> + mat <- mat[-delete, ]
> + }
> + mat
> + }
> > testx(20, verbose = TRUE)
> ***starting matrix
> optA perm
> [1,] 13 1
> [2,] 12 2
> [3,] 7 3
> [4,] 10 4
> [5,] 11 5
> [6,] 4 6
> [7,] 11 7
> [8,] 2 8
> [9,] 6 9
> [10,] 5 10
> [11,] 6 11
> [12,] 18 12
> [13,] 9 13
> [14,] 16 14
> [15,] 18 15
> [16,] 9 16
> [17,] 2 17
> [18,] 7 18
> [19,] 15 19
> [20,] 7 20
> optA perm
> [1,] 13 1
> [2,] 12 2
> [3,] 7 3
> [4,] 4 6
> [5,] 2 8
> [6,] 2 17
> >
>
>
> On Fri, May 31, 2013 at 2:02 PM, Laz <lmra...@ufl.edu
> <mailto:lmra...@ufl.edu>> wrote:
>
> Dear R Users,
>
> I created a function which returns a value every time it's run (A
> simplified toy example is attached on this mail).
>
> For example spat(a,b,c,d) # run the first time and it gives you ans1=
> 10, perm=1 ;
> run the second time and gives you ans2= 7, perm=2 etc
> I store both the result and the iteration on a matrix called vector
> with columns:1==ans, column2==permutation
>
> The rule I want to implement is: compare between ans1 and ans2. If
> ans1>ans2, keep both ans1 and ans2. if ans1<ans2, drop the whole
> row of
> the second permutation (that is drop both ans2 and perm2 but continue
> counting all permutations).
> Re-run the function for the 3rd time and repeat comparison
> between the
> value of the last run and the current value obtained.
> Return matrix ans with the saved ans and their permutations and
> another
> full matrix with all results including the dropped ans and their
> permutation numbers.
>
> I need to repeat this process 1000 times but I am getting stuck below.
> See attached R code.
> The code below works only for the first 6 permutations. suppose I want
> 1000 permutations, where do I keep the loop?
>
>
> Example: Not a perfect code though it somehow works:
> testx<-function(perm){
> optA<-c()
> #while(perm<=2){
> for (k in 1:perm){
> #repeat {
> optA[k]<-sample(1:1000,1,replace=TRUE)
> perm[k]<-k
> }
> mat2<-as.matrix(cbind(optA=optA,perm=perm))
> result<-mat2
> lenm<-nrow(result)
> if(result[1,1]<=result[2,1]) result<-result[1,]
> return(list(mat2=mat2,result=result))
> #}
> if(perm>2){
> mat2<-as.matrix(cbind(optA=optA,perm=perm))
> result<-mat2
> lenm<-nrow(result)
> if(result[1,1]<=result[2,1]) result<-result[1,]
> if(result[lenm-1,1]<=result[lenm,1])
> result<-result[-lenm,]
> if(result[(lenm-2),1]<=result[(lenm-1),1])
> result<-result[-(lenm-1),]
> if(result[(lenm-3),1]<=result[(lenm-2),1])
> result<-result[-(lenm-2),]
> if(result[(lenm-4),1]<=result[(lenm-3),1])
> result<-result[-(lenm-3),]
> if(result[(lenm-5),1]<=result[(lenm-4),1])
> result<-result[-(lenm-4),]
> return(list(mat2=mat2,result=result))
> }
> }
> ## Now calling my function below:
>
> >testx(perm=6)
>
>
>
> $mat2
> optA perm
> [1,] 272 1
> [2,] 858 2
> [3,] 834 3
> [4,] 862 4
> [5,] 650 5
> [6,] 405 6
>
> $result
> optA perm
> 272 1
>
>
> > testx(perm=2)
> $mat2
> optA perm
> [1,] 398 1
> [2,] 816 2
>
> $result
> optA perm
> 398 1
>
>
> [[alternative HTML version deleted]]
>
> ______________________________________________
> R-help@r-project.org <mailto: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.
>
>
>
>
> --
> Jim Holtman
> Data Munger Guru
>
> What is the problem that you are trying to solve?
> Tell me what you want to do, not how you want to do it.
[[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.
