模糊比较 R 中的名称 - 如何在矩阵中找到最高可能的总和(有边界条件)

fuzzy comparing names in R - how to find highest possible sum in a matrix (with boundary conditions)

我有一个相似度得分矩阵,如下所示:

我需要在这个矩阵中找到最高可能的分数总和。不过,总和必须满足一个条件:

如果一个数字已被用于求和,则其行或列或任何之前的行或列的数字都不能再用于求和。这是因为名称的顺序很重要。

我可以从任何数字开始,但该值左侧和上方的所有值以及同一行和同一列中的值都将被取消资格。

此系统的最大可能总和为 130 (10 + 100 + 10 + 10)。这就是我最终想要的数字。

我目前的策略是计算所有可能的和,然后简单地select最高的。但是我如何编码我上面描述的条件呢?有道理吗?

以下是允许(绿色)和不允许(红色)金额的更多示例:

有效总和的另一个例子:

  1. 我从左上角开始。我选择10。 我无法再添加同一列中的 12 或 11。
  2. 我选择剩下的一个号码。 12. 我不能再从该列和行(以及之前的列和行)中选择 100、11、10 或 25。我现在只能选择 22 或 10 作为最后添加的数字。
  3. 如果我选22,我的总和是44。如果我选​​10,我的总和是32。

我使用这个系统的原因是因为我正在尝试创建一种算法来比较人的全名并为其分配他们是同一个人的概率 - 完全基于姓名信息。

我当前的代码如下所示:

library(tidyverse)
library(stringdist)

string.compare <- function(Var1, Var2){
  
  string1 <- Var1 %>% tolower() %>% trimws() %>% str_replace_all(pattern = "[[:punct:]]", replacement = "")  %>% strsplit(" ") %>% unlist()
  string2 <- Var2 %>% tolower() %>% trimws() %>% str_replace_all(pattern = "[[:punct:]]", replacement = "")  %>% strsplit(" ") %>% unlist()
  
  compare <- array(NA, dim = c(length(string1), 
                               length(string2)), dimnames = list(string1, 
                                                                 string2))
  compare[] <- do.call(mapply, 
                      c(list(FUN = string.score),
                        expand.grid(dimnames(compare), stringsAsFactors = FALSE)))
  
  sums <- func_calc_sums(compare)  # This is where is need help. How to write this function?
  
  output(max(sums))
}

string.score <- function(Var1, Var2){
  phonetic.weight <- 50 # this is an important variable. it determines the weight of the phonetic comparison. 100 = no weight, 0 = phonetic is all that matters.
  
  if(is.null(Var1) | is.null(Var2) | is.na(Var1) | is.na(Var2) | Var1 == "" | Var2 == ""){ # if one of the entries is empty, score 0
    return(0)
  } else if(Var1 == substr(Var2, 1, 1)){ # if Var1 is an abbreviation of Var2, score 10
    return(10)
  } else if(nchar(Var1) == 1){ # if Var1 is an abbreviation but not of Var2, score 0
    return(0)
  } else if(Var2 == substr(Var1, 1, 1)){ # if Var2 is an abbreviation of Var1, score 10
    return(10)
  } else if(phonetic(Var1) == phonetic(Var2)){ # If Var1 and Var2 are phonetically similar, give score based on stringdist
    return(round(100 - (phonetic.weight * stringdist(Var1, Var2, method = "osa") / nchar(Var1)), 0))
  } else {  # If Var1 and Var2 are not phonetically similar, give a score based on stringdist but lower
    return(round(100 - (100 * stringdist(Var1, Var2, method = "osa") / nchar(Var1)), 0))
  }
}

如果你输入例如Var1 <- " a. michelle hernandes s. "Var2 <- " Alexa michelle h. sanchez"然后通过函数string.compare输入运行(该函数还没有完成,你必须执行一行一行的代码)它会首先清理字符串,然后将它们拆分成单独的单词。

这些词被分配为矩阵的行名和列名,其评分系统为 运行 string.score。然后你最终得到这个 post.

开头的矩阵

听起来您正在寻找 Needleman–Wunsch dynamic programming algorithm。只需将匹配分数设置为相似度函数的值,并将 mismatch/insertion/deletion 分数设置为 0。

算法实现起来并不难,网上可以找到很多代码示例。

我有两个可能有用的建议:

  1. Roman Cheplyaka 在 github 上的 R 中提到了 Needleman-Wunsch 算法的实现。您可以在这里找到它:https://gist.github.com/juliuskittler/ed53696ac1e590b413aac2dddf0457f6
  2. 您可以尝试使用此处描述的最大路径和函数递归地解决问题:https://lucidmanager.org/data-science/project-euler-18/

我认为您必须显式插入您提到的约束以阻止这些路径符合条件。这是数据集上默认函数的 运行:

testmat <- matrix(data = c(10, 0, 0 , 0, 12, 100, 12, 25, 11, 11, 10, 22, 0, 0,
                           0, 10),
                  ncol = 4, 
                  nrow = 4,
                  byrow = T)

path.sum <- function(triangle) {
  for (rij in nrow(triangle):2) {
    for (kol in 1:(ncol(triangle)-1)) {
      triangle[rij - 1,kol] <- max(triangle[rij,kol:(kol + 1)]) + triangle[rij - 1, kol]
    }
    triangle[rij,] <- NA
  }
  return(max(triangle, na.rm = TRUE))
}

> path.sum(testmat)
[1] 130