- if (ls_mode == "exact")
- {
- #distances[i,j] = distance between m column i and ref column j
- distances = apply( m_ref, 2, function(col) ( sqrt(colSums((m-col)^2)) ) )
- assignment = .hungarianAlgorithm(distances)
- col <- m[,assignment]
- if (is.list(Ms)) Ms[[i]] <- col else Ms[,,i] <- col
- }
- else
- {
- # Greedy matching:
- # approx1: li[[i]][,j] is assigned to m[,k] minimizing dist(li[[i]][,j],m[,k'])
- # approx2: m[,j] is assigned to li[[i]][,k] minimizing dist(m[,j],li[[i]][,k'])
- available_indices = 1:K
- for (j in 1:K)
- {
- distances =
- if (ls_mode == "approx1")
- {
- apply(as.matrix(m[,available_indices]), 2,
- function(col) ( sqrt(sum((col - m_ref[,j])^2)) ) )
- }
- else #approx2
- {
- apply(as.matrix(m_ref[,available_indices]), 2,
- function(col) ( sqrt(sum((col - m[,j])^2)) ) )
- }
- indMin = which.min(distances)
- if (ls_mode == "approx1")
- {
- col <- m[ , available_indices[indMin] ]
- if (is.list(Ms)) Ms[[i]][,j] <- col else Ms[,j,i] <- col
- }
- else #approx2
- {
- col <- available_indices[indMin]
- if (is.list(Ms)) Ms[[i]][,col] <- m[,j] else Ms[,col,i] <- m[,j]
- }
- available_indices = available_indices[-indMin]
- }
- }