On 22/03/2021 1:59 a.m., Jim Lemon wrote:
Hi Goyani,
You are setting "PRE" to the return value of "if" which is one of TRUE
(1), FALSE(0) or NULL.

That's not true at all.  The statement was

    PRE<- if(missing(GAY)){
      (GA/GA) * 100
    } else {
      (GA/GAY) * 100
    }

so the result is (GA/GA) * 100 or (GA/GAY)*100.

Because GAY is always missing in your example,

If that's true and GA isn't missing, the result will always be 100.

Duncan Murdoch

"PRE" is always set to 1. Then you always want to pass 1 in the sample
list, and that will not assign anything to PRE. By correcting the "if"
clause and defining matrices that are unlikely to be singular, I can
run a "for" loop as follows:

selection.index<- function(ID, phen_mat, gen_mat, weight_mat, GAY){
  p<-as.matrix(phen_mat)
  g<-as.matrix(gen_mat)
  w<-as.matrix(weight_mat)
  bmat<- solve(phen_mat) %*% gen_mat %*% weight_mat
  GA<- 2.063 * t(bmat) %*% g %*% w / (t(bmat) %*% p %*% bmat)^0.5
  if(missing(GAY)) PRE<-(GA/GA) * 100
  else PRE<-(GA/GAY) * 100
  result<-list(ID=ID,b=matrix(round(bmat,4),nrow=1),
   GA=round(GA,4),PRE=round(PRE,4))
  return(data.frame(result))
}

pmat<-matrix(sample(1:16,16),4)
gmat<-matrix(sample(17:32),16,4)
wmat<-matrix(sample(1:4,4),4)

mi<-combn(1:4,2)
sc<-list()
for(i in 1:ncol(matindx)) {
  as.numeric(ID<-paste0(mi[,i]))
  sc[[i]]<-selection.index(ID,pmat[mi[,i],mi[,i]],gmat[mi[,i],mi[,i]],
   wmat[mi[,i]],1)
}

This produces output for me. Good luck with whatever you are doing with this.

Jim





On Mon, Mar 22, 2021 at 2:51 PM Goyani Zankrut <zankru...@gmail.com> wrote:

Greetings of the day,
Thank you for your response, Sir.
The full problem statement is given below:

In our case, I'm taking 4 traits.
library(arrangements)
a<- combinations(4,2) # gives 6 pairwise combinations
class(a) # it's a "matrix" "array"

now hypothetical data of three matrix for further calculation:
pmat<- matrix(1:16, nrow = 4)
gmat<- matrix(17:32, nrow = 4)
wmat<- matrix(1:4, nrow = 4)

My custom function for further calculations:
selection.index<- function(ID, phen_mat, gen_mat, weight_mat, GAY){
   ID = toString(ID)
   p<- as.matrix(phen_mat)
   g<- as.matrix(gen_mat)
   w<- as.matrix(weight_mat)
   bmat<- solve(phen_mat) %*% gen_mat %*% weight_mat
   GA<- 2.063 * t(bmat) %*% g %*% w / (t(bmat) %*% p %*% bmat)^0.5
   PRE<- if(missing(GAY)){
     (GA/GA) * 100
   } else {
     (GA/GAY) * 100
   }
   result<- list("ID" = ID, "b" = matrix(round(bmat,4), nrow = 1), "GA" = round(GA,4), 
"PRE" = round(PRE,4))
   return(data.frame(result))
}

Now I want to store this data into a list for further calculation:
sc<- list()
sc[[1]]<- selection.index(ID = 12, phen_mat = pmat[c(1,2),c(1,2)], gen_mat = 
gmat[c(1,2),c(1,2)], weight_mat = wmat[c(1,2),1])
sc[[2]]<- selection.index(ID = 13, phen_mat = pmat[c(1,3),c(1,3)], gen_mat = 
gmat[c(1,3),c(1,3)], weight_mat = wmat[c(1,3),1])
sc[[3]]<- selection.index(ID = 14, phen_mat = pmat[c(1,4),c(1,4)], gen_mat = 
gmat[c(1,4),c(1,4)], weight_mat = wmat[c(1,4),1])
sc[[4]]<- selection.index(ID = 23, phen_mat = pmat[c(2,3),c(2,3)], gen_mat = 
gmat[c(2,3),c(2,3)], weight_mat = wmat[c(2,3),1])
sc[[5]]<- selection.index(ID = 24, phen_mat = pmat[c(2,4),c(2,4)], gen_mat = 
gmat[c(2,4),c(2,4)], weight_mat = wmat[c(2,4),1])
sc[[6]]<- selection.index(ID = 34, phen_mat = pmat[c(3,4),c(3,4)], gen_mat = 
gmat[c(3,4),c(3,4)], weight_mat = wmat[c(3,4),1])
above list code is monotonous and time consuming for large data combination 
cycles like (7,2) = 21 combinations, (10,2) = 45 combinations. So I want to use 
the matrix a's each row as a vector in the selection.index function and result 
stores in a list.

I hope now you will understand the full problem. I have checked the 
selection.index which has no issues and works well.
Thank you.


______________________________________________
R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
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 -- To UNSUBSCRIBE and more, see
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.

Reply via email to