R/mulamba_function.R

In AgronomiaR/IS:

#' Indice de selecao de Mulamba e Mock
#'
#' @param dados data.frame com medias ou saida da PCA
#' @param orde vetor de dados especificando se maiores valores indicam melhor atributo ou não
#' @export
#' @example
#'
#' resp1=c(10,11,12,7,6,5,4,4,5,12,7,16,5,4,4,5)
#' resp2=c(10,11,12,7,6,5,4,5,5,12,7,6,15,4,4,5)
#' resp3=c(10,11,12,7,6,5,4,4,5,12,7,6,10,4,7,5)
#' resp4=c(6,1,2,7,6,3,4,3,5,12,7,6,5,14,4,15)
#' trat=rep(paste("T",1:16))
#' dados=data.frame(trat,resp1,resp2,resp3,resp4)
#' library(IS)
#' a=mulamba(dados,orde = c("1","1","1","d"))
#' plot_mulamba(a,dados,ps=30)
#' plot_mulamba2(a,dados,ps = 35)

# function (dados, orde = NULL)
# {
#   if (is.null(orde) == TRUE) {
#     orde = rep("d", length(colnames(dados[, -1])))
#   }
#   scores1 = dados
#   scores = scores1[, -1]
#   sc = data.frame(1:length(rownames(scores)))
#   for (i in 1:length(colnames(scores))) {
#     if (orde[i] == "d") {
#       ord = length(rownames(scores)):1
#     }
#     else {
#       ord = 1:length(rownames(scores))
#     }
#     a = cbind(scores1[order(scores[, i]), c(1, i + 1)], ord)
#     rownames(a) = a[, 1]
#     a = a[as.vector(scores1[[1]]), ]
#     sc[, i] = a[, 3]
#   }
#   colnames(sc) = colnames(scores)
#   rownames(sc) = scores1[[1]]
#   mulamba = rowSums(sc)
#   sc$mulamba = mulamba
#   sc = sc[order(sc$mulamba, decreasing = T), ]
#   print(sc)
# }

# mulamba=function(dados,decreasing=NULL,weight=NULL){
#   if(is.null(weight)==TRUE){weight=rep(1,length(colnames(dados[,-1])))}
#   if(is.null(decreasing)==TRUE){decreasing=rep(F,length(colnames(dados[,-1])))}
#   scores1=dados
#   scores=scores1[,-1]
#   sc=data.frame(1:length(rownames(scores)))
#
#   for(i in 1:length(colnames(scores))){
#     if(isTRUE(decreasing[i])==TRUE){ord=length(rownames(scores)):1}else{ord=1:length(rownames(scores))}
#     a=cbind(scores1[order(scores[,i]),c(1,i+1)],ord)
#     rownames(a)=a[,1]
#     a=a[as.vector(scores1[[1]]),]
#     sc[,i]=a[,3]*weight[i]}
#
#   colnames(sc)=colnames(scores)
#   rownames(sc)=scores1[[1]]
#   mulamba=rowSums(sc)
#   sc$mulamba=mulamba
#   sc=sc[order(sc$mulamba,decreasing = T),]
#   print(sc)}

mulamba=function(dados,decreasing=NULL,weight=NULL){
  if(is.null(weight)==TRUE){weight=rep(1,length(colnames(dados[,-1])))}
  if(is.null(decreasing)==TRUE){decreasing=rep(F,length(colnames(dados[,-1])))}
  scores1=dados
  scores=scores1[,-1]
  sc=data.frame(1:length(rownames(scores)))

  for(i in 1:length(colnames(scores))){
    b=data.frame(table(scores[,i]),
                 id=1:length(table(scores[,i])/2),
                 idi=length(table(scores[,i])/2):1)
    colnames(b)[1]=colnames(scores)[i]
    if(isTRUE(decreasing[i])==TRUE){ord=length(rownames(scores)):1}else{ord=1:length(rownames(scores))}
    a=cbind(scores1[order(scores[,i]),c(1,i+1)],ord)
    a=merge(b,a,by.x = colnames(scores)[i])
    rownames(a)=a[,5]
    ordem=as.vector(as.character(scores1[[1]]))
    a=a[ordem,]
    sc[,i]=if(isTRUE(decreasing[i])==TRUE){a[,4]*weight[i]}else{a[,3]*weight[i]}}

  colnames(sc)=colnames(scores)
  rownames(sc)=scores1[[1]]
  mulamba=rowSums(sc)
  sc$mulamba=mulamba
  sc=sc[order(sc$mulamba,decreasing = T),]
  print(sc)}