diff --git a/CHANGELOG.md b/CHANGELOG.md index 925d0a4..97c0fdb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [dev] - unreleased ### Added ### Changed +- refactored find.match [#193](https://github.com/RECETOX/recetox-aplcms/pull/193) ### Removed ## [0.10.3] - 2023-03-27 diff --git a/R/find.match.R b/R/find.match.R index cc0e69c..e371b83 100644 --- a/R/find.match.R +++ b/R/find.match.R @@ -1,38 +1,38 @@ +find_min_position <- function(distances) { + position <- which.min(distances)[1] + position_x <- position %% nrow(distances) + position_x <- ifelse(position_x == 0, nrow(distances), position_x) + position_y <- ceiling(position / nrow(distances)) + return(c(position_x, position_y)) +} + #' Internal function: finding the best match between a set of detected features and a set of known features. -#' +#' #' Given a small matrix of distances, find the best column-row pairing that minimize the sum of distances of the matched pairs. -#' -#' @param a A matrix of distances. -#' @param unacceptable A distance larger than which cannot be accepted as pairs. -#' @return A matrix the same dimension as the input matrix, with matched position taking value 1, and all other positions taking value 0. -find.match <- function(a, unacceptable) { - find.min.pos<-function(d) - { - pos<-which(d==min(d))[1] - pos.x<-pos %% nrow(d) - if(pos.x == 0) pos.x<-nrow(d) - pos.y<-floor((pos-1)/nrow(d)+1) - pos<-c(pos.x, pos.y) - return(pos) - } - - b<-a*0 - if(ncol(a) == 1) - { - sel<-which(a[,1]==min(a[,1]))[1] - if(a[sel,1] <= unacceptable) b[sel,1]<-1 - }else if(nrow(a)==1){ - sel<-which(a[1,]==min(a[1,]))[1] - if(a[1,sel] <= unacceptable) b[1,sel]<-1 - }else{ - p<-find.min.pos(a) - while(a[p[1],p[2]] <= unacceptable) - { - b[p[1],p[2]]<-1 - a[p[1],]<-1e10 - a[,p[2]]<-1e10 - p<-find.min.pos(a) +#' +#' @param distances A matrix of distances. +#' @param max_distance A distance larger than which cannot be accepted as pairs. +#' @return A binary matrix the same size as the input matrix, with matched position taking value 1, and all other positions taking value 0. +find.match <- function(distances, max_distance) { + matches <- matrix(0, nrow(distances), ncol(distances)) + + if (ncol(distances) == 1) { + sel <- which.min(distances[, 1])[1] + matches[sel, 1] <- as.numeric(distances[sel, 1] <= max_distance) + } else if (nrow(distances) == 1) { + sel <- which(distances[1, ] == min(distances[1, ]))[1] + matches[1, sel] <- as.numeric(distances[1, sel] <= max_distance) + } else { + while (TRUE) { + min_position <- find_min_position(distances) + if (distances[min_position[1], min_position[2]] > max_distance) { + break + } + matches[min_position[1], min_position[2]] <- 1 + distances[min_position[1], ] <- 1e10 + distances[, min_position[2]] <- 1e10 } } - return(b) + + return(matches) } diff --git a/R/semi.sup.R b/R/semi.sup.R index 9dba450..acb7660 100644 --- a/R/semi.sup.R +++ b/R/semi.sup.R @@ -324,7 +324,7 @@ semi.sup <- function( time.matched[is.na(time.matched)]<-aligned$rt_tol_relative/2 - both.matched<-find.match(time.matched, unacceptable=aligned$rt_tol_relative/2) + both.matched<-find.match(time.matched, aligned$rt_tol_relative/2) for(m in 1:length(sel.new)) { @@ -543,7 +543,7 @@ semi.sup <- function( time.matched[is.na(time.matched)]<-aligned$rt_tol_relative/2-0.0000001 - both.matched<-find.match(time.matched, unacceptable=aligned$rt_tol_relative/2) + both.matched<-find.match(time.matched, aligned$rt_tol_relative/2) for(m in 1:length(sel.new)) { diff --git a/man/find.match.Rd b/man/find.match.Rd index 742a240..f5440fb 100644 --- a/man/find.match.Rd +++ b/man/find.match.Rd @@ -4,15 +4,15 @@ \alias{find.match} \title{Internal function: finding the best match between a set of detected features and a set of known features.} \usage{ -find.match(a, unacceptable) +find.match(distances, max_distance) } \arguments{ -\item{a}{A matrix of distances.} +\item{distances}{A matrix of distances.} -\item{unacceptable}{A distance larger than which cannot be accepted as pairs.} +\item{max_distance}{A distance larger than which cannot be accepted as pairs.} } \value{ -A matrix the same dimension as the input matrix, with matched position taking value 1, and all other positions taking value 0. +A binary matrix the same size as the input matrix, with matched position taking value 1, and all other positions taking value 0. } \description{ Given a small matrix of distances, find the best column-row pairing that minimize the sum of distances of the matched pairs.