CODEWITHSUNDEEP
roptimizationmatrixcorrelation
d.putto
d.putto

Reputation: 7595

maximizing matrix diagonal elements in R

Edit : a related question is How to move larger values close to matrix diagonal in a correlation matrix This question is about achieving same but in R

Given a matrix (or table in R )

m <- matrix(c(5,25,8,4,2,10,20,3,1),ncol=3,byrow=TRUE)
colnames(m) <- c("L","M","H")
rownames(m) <- c("A","B","C")
tax <- as.table(m)
tax
   L  M  H
A  5 25  8
B  4  2 10
C 20  3  1

I want to rearrange the matrix such that the diagonal elements are maximum.

   H  L  M
B 10  4  2
C  1 20  3
A  8  5 25

Is there any easy to use function in R ?

Upvotes: 1

Views: 2251

Answers (4)

ThomasIsCoding
ThomasIsCoding

Reputation: 102920

You can simply use order + which.max to rearrange the rows and columns like below

> m[order(apply(m, 2, which.max)), order(apply(m, 1, which.max))]
   H  L  M
B 10  4  2
C  1 20  3
A  8  5 25

Upvotes: 0

T.Humar
T.Humar

Reputation: 1

I recently came across a similar problem and wrote a simple function to maximize the sum of the elements in the diagonal of a square matrix. It does not check whether the matrix is squared (it could be easily implemented). Also, be careful with very large matrices since the number of permutations is the factorial of the number of columns.

maxDiag <- function(x) {
  n <- ncol(x)
  per <- gtools::permutations(n,n)
  d <- apply(per,1,function(y) sum(diag(x[,y])))
  return(x[,per[which.max(d),]])
}

Upvotes: 0

ArdernHB
ArdernHB

Reputation: 21

I don't think Rohit Arora's solution is doing exactly what you want because it will be led by the maximum value of the preceding row. As a result, it's not in fact maximising the diagonal in a optimisation sense.

I found this answer to a similar question elsewhere and I thought it might be useful:

http://r.789695.n4.nabble.com/reordering-of-matrix-rows-to-maximize-the-sum-of-the-diagonal-tt2062867.html#a2065679

pMatrix.min <- function(A, B) { 
#finds the permutation P of A such that ||PA - B|| is minimum in Frobenius norm 
# Uses the linear-sum assignment problem (LSAP) solver in the "clue" package 

# Returns P%*%A and the permutation vector `pvec' such that 
# A[pvec, ] is the permutation of A closest to B 
    n <- nrow(A) 
    D <- matrix(NA, n, n) 
    for (i in 1:n) { 
        for (j in 1:n) { 
        D[j, i] <- (sum((B[j, ] - A[i, ])^2)) 
        }
    } 
    vec <- c(solve_LSAP(D)) 
    list(A=A[vec,], pvec=vec) 
} 

require(clue)  # need this package to solve the LSAP 

#An example
A <- matrix(sample(1:25, size=25, rep=FALSE),  5,  5) 

B <- diag(1, nrow(A)) # this choice of B maximizes the trace of permuted A 

X <- pMatrix.min(A,B) 

A  # original square matrix 

X$A  # permuted A such that its trace is maximum among all permutations

It uses the Hungarian method to optimise the reordering of the matrix A to the target matrix B.

NB This is my first post so I don't have the reputation to comment on the previous answer, but I hope this helps!

Upvotes: 2

Kumar
Kumar

Reputation: 189

matrix.sort <- function(matrix) {

    if (nrow(matrix) != ncol(matrix)) stop("Not diagonal")
    if(is.null(rownames(matrix))) rownames(matrix) <- 1:nrow(matrix)

    row.max <- apply(matrix,1,which.max)
    if(all(table(row.max) != 1)) stop("Ties cannot be resolved")

    matrix[names(sort(row.max)),]
}

Upvotes: 2

Related Questions