Dear R users,
Suppose I want to randomly generate some data, in matrix form, randomly
swap some of the elements and calculate trace of the matrix for each of
these stages. If the value of trace obtained in the later is bigger than
the former, drop the latter matrix and go back to the former matrix,
swap some elements of the matrix again and calculate the trace. If the
recent trace is smaller than the previous one, accept the matrix as the
current . Use the current matrix and swap elements again. repeat the
whole process for a number of times, say, 10. The output from the
function should display only the original matrix and its value of trace,
trace values of successful swaps and their iteration counts and the
final best matrix that had the smallest value of trace, together with
its trace value.
For example
## original
> matd<-matrix(sample(1:30,30,replace=FALSE),ncol=5,nrow=6,byrow=FALSE)
> matd
[,1] [,2] [,3] [,4] [,5]
[1,] 12 27 29 16 19
[2,] 25 10 7 22 13
[3,] 14 23 3 11 21
[4,] 28 6 5 2 18
[5,] 24 20 1 17 26
[6,] 9 4 30 8 15
> trace<-sum(diag(matd))
> trace
[1] 53
# 1st iteration
[,1] [,2] [,3] [,4] [,5]
[1,] 24 29 20 25 17
[2,] 16 1 30 9 5
[3,] 18 22 2 10 26
[4,] 23 27 19 21 28
[5,] 15 6 8 3 13
[6,] 12 14 7 11 4
> trace<-sum(diag(matd))
> trace
[1] 61
## drop this matrix because 61 > 53
# 2nd iteration
> matd<-matrix(sample(1:30,30,replace=FALSE),ncol=5,nrow=6,byrow=FALSE)
> matd
[,1] [,2] [,3] [,4] [,5]
[1,] 2 28 23 15 14
[2,] 27 9 10 29 7
[3,] 5 18 12 1 11
[4,] 8 4 30 16 24
[5,] 25 19 26 6 13
[6,] 17 22 3 20 21
> trace<-sum(diag(matd))
> trace
[1] 52
## accept this matrix because 52 < 53
### 3rd iteration
> matd<-matrix(sample(1:30,30,replace=FALSE),ncol=5,nrow=6,byrow=FALSE)
> matd
[,1] [,2] [,3] [,4] [,5]
[1,] 1 29 17 8 6
[2,] 21 23 10 7 14
[3,] 22 4 12 26 9
[4,] 3 13 11 30 15
[5,] 5 24 18 16 2
[6,] 20 25 19 27 28
> trace<-sum(diag(matd))
> trace
[1] 68
## drop this matrix because 68 > 52
## 4th iteration
> matd<-matrix(sample(1:30,30,replace=FALSE),ncol=5,nrow=6,byrow=FALSE)
> matd
[,1] [,2] [,3] [,4] [,5]
[1,] 2 6 5 28 15
[2,] 9 12 13 19 24
[3,] 3 22 14 11 29
[4,] 30 20 17 7 23
[5,] 18 27 21 1 10
[6,] 25 16 4 8 26
> trace<-sum(diag(matd))
> trace
[1] 45
## accept this matrix because 45 < 52
The final results will be:
$mat
trace iterations
[1,] 53 0
[2,] 52 2
[3,] 45 4
$ Design_best
[,1] [,2] [,3] [,4] [,5]
[1,] 2 6 5 28 15
[2,] 9 12 13 19 24
[3,] 3 22 14 11 29
[4,] 30 20 17 7 23
[5,] 18 27 21 1 10
[6,] 25 16 4 8 26
$ Original_design
[,1] [,2] [,3] [,4] [,5]
[1,] 12 27 29 16 19
[2,] 25 10 7 22 13
[3,] 14 23 3 11 21
[4,] 28 6 5 2 18
[5,] 24 20 1 17 26
[6,] 9 4 30 8 15
Regards,
Laz
Hello,
Seems simple.
fun <- function(n = 10){
matd <- matrix(sample(1:30,30, replace=FALSE), ncol=5, nrow=6)
res <- list(mat = NULL, Design_best = matd, Original_design = matd)
trace <- sum(diag(matd))
res$mat <- rbind(res$mat, c(trace = trace, iterations = 0))
for(i in seq_len(n)){
matd <- matrix(sample(1:30,30, replace=FALSE), ncol=5, nrow=6)
if(sum(diag(matd)) < trace){
trace <- sum(diag(matd))
res$mat <- rbind(res$mat, c(trace = trace, iterations = i))
res$Design_best <- matd
}
}
res
}
fun()
fun(20)
Hope this helps,
Rui Barradas
Em 19-10-2013 18:41, laz escreveu:> Dear R users,
>
> Suppose I want to randomly generate some data, in matrix form, randomly
> swap some of the elements and calculate trace of the matrix for each of
> these stages. If the value of trace obtained in the later is bigger than
> the former, drop the latter matrix and go back to the former matrix,
> swap some elements of the matrix again and calculate the trace. If the
> recent trace is smaller than the previous one, accept the matrix as the
> current . Use the current matrix and swap elements again. repeat the
> whole process for a number of times, say, 10. The output from the
> function should display only the original matrix and its value of trace,
> trace values of successful swaps and their iteration counts and the
> final best matrix that had the smallest value of trace, together with
> its trace value.
>
> For example
> ## original
> >
matd<-matrix(sample(1:30,30,replace=FALSE),ncol=5,nrow=6,byrow=FALSE)
> > matd
> [,1] [,2] [,3] [,4] [,5]
> [1,] 12 27 29 16 19
> [2,] 25 10 7 22 13
> [3,] 14 23 3 11 21
> [4,] 28 6 5 2 18
> [5,] 24 20 1 17 26
> [6,] 9 4 30 8 15
> > trace<-sum(diag(matd))
> > trace
> [1] 53
>
> # 1st iteration
>
> [,1] [,2] [,3] [,4] [,5]
> [1,] 24 29 20 25 17
> [2,] 16 1 30 9 5
> [3,] 18 22 2 10 26
> [4,] 23 27 19 21 28
> [5,] 15 6 8 3 13
> [6,] 12 14 7 11 4
> > trace<-sum(diag(matd))
> > trace
> [1] 61
>
> ## drop this matrix because 61 > 53
>
> # 2nd iteration
> >
matd<-matrix(sample(1:30,30,replace=FALSE),ncol=5,nrow=6,byrow=FALSE)
> > matd
> [,1] [,2] [,3] [,4] [,5]
> [1,] 2 28 23 15 14
> [2,] 27 9 10 29 7
> [3,] 5 18 12 1 11
> [4,] 8 4 30 16 24
> [5,] 25 19 26 6 13
> [6,] 17 22 3 20 21
> > trace<-sum(diag(matd))
> > trace
> [1] 52
>
> ## accept this matrix because 52 < 53
>
> ### 3rd iteration
> >
matd<-matrix(sample(1:30,30,replace=FALSE),ncol=5,nrow=6,byrow=FALSE)
> > matd
> [,1] [,2] [,3] [,4] [,5]
> [1,] 1 29 17 8 6
> [2,] 21 23 10 7 14
> [3,] 22 4 12 26 9
> [4,] 3 13 11 30 15
> [5,] 5 24 18 16 2
> [6,] 20 25 19 27 28
> > trace<-sum(diag(matd))
> > trace
> [1] 68
>
> ## drop this matrix because 68 > 52
>
> ## 4th iteration
> >
matd<-matrix(sample(1:30,30,replace=FALSE),ncol=5,nrow=6,byrow=FALSE)
> > matd
> [,1] [,2] [,3] [,4] [,5]
> [1,] 2 6 5 28 15
> [2,] 9 12 13 19 24
> [3,] 3 22 14 11 29
> [4,] 30 20 17 7 23
> [5,] 18 27 21 1 10
> [6,] 25 16 4 8 26
> > trace<-sum(diag(matd))
> > trace
> [1] 45
>
> ## accept this matrix because 45 < 52
>
> The final results will be:
> $mat
> trace iterations
> [1,] 53 0
> [2,] 52 2
> [3,] 45 4
>
> $ Design_best
>
> [,1] [,2] [,3] [,4] [,5]
> [1,] 2 6 5 28 15
> [2,] 9 12 13 19 24
> [3,] 3 22 14 11 29
> [4,] 30 20 17 7 23
> [5,] 18 27 21 1 10
> [6,] 25 16 4 8 26
>
> $ Original_design
>
> [,1] [,2] [,3] [,4] [,5]
> [1,] 12 27 29 16 19
> [2,] 25 10 7 22 13
> [3,] 14 23 3 11 21
> [4,] 28 6 5 2 18
> [5,] 24 20 1 17 26
> [6,] 9 4 30 8 15
>
> Regards,
> Laz
>
> ______________________________________________
> 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.