R 中的数字到字母的刻字函数

Numeric to Alphabetic Lettering Function in R

我编写了一个函数,它处理从 1 到 702 的整数,以非常具体的方式将数字转换为字母。以下是我希望字母功能如何工作的一些示例:

我们将此功能用于 "numbering" / "lettering" 我们的报告附录。我想让它更通用,这样它就可以处理任何大小的正整数。如果我可以轻松地将原始数字转换为以 26 为基数,这会更容易,但我没有在 R 中看到一种简单的方法。

appendix_lettering <- function(number) {
  if (number %in% 1:26) {
    return(LETTERS[[number]])
  } else if (number %in% 27:702) {
    first_digit <- (floor((number - 1) / 26))
    second_digit <- ((number - 1) %% 26) + 1
    first_letter <- LETTERS[[first_digit]]
    second_letter <- LETTERS[[second_digit]]
    return(paste0(first_letter, second_letter))
  }
}

有没有人建议我如何最轻松地改进此函数以处理任何正整数(或至少更多)?

这种方法效果很好,尽管它与您的原始功能关系不大。它并不完美,但可以很容易地推广到任意数量的字母。此版本可以处理最多 26+26^2+26^3+26^4+26^5+26^6 = 321272406 的任何数字,即最多 6 个字母。

首先,我们定义一个函数来确定字母数量并调整数量,以删除字母数量较少的组合。

例如考虑数字 702。它是 "ZZ" 个字母,但只有 26^2 = 676 个可能的两个字母组合 - 因此,我们必须预先减去 26 个单个字母以获得 "adjusted number"。现在,如果调整后的数字是,例如1,我们有 5 个字母,结果单词是 "AAAAA",对于 2,它是 "AAAAB" 等等。

函数如下:

checknum <- function(num) {
  adnum<-num; #adjusted number
  n_lett<-1; #number of letters
  if(log(adnum,base=26) > 1) {adnum<-adnum-26; n_lett<-2}
  if(log(adnum,base=26) > 2) {adnum<-adnum-26^2; n_lett<-3}
  if(log(adnum,base=26) > 3) {adnum<-adnum-26^3; n_lett<-4}
  if(log(adnum,base=26) > 4) {adnum<-adnum-26^4; n_lett<-5}
  if(log(adnum,base=26) > 5) {adnum<-adnum-26^5; n_lett<-6}
  return(list(adnum=adnum,n_lett=n_lett))
} #this function can be adjusted for more letters or maybe improved in its form

applett2 <- function(num) {
  n_lett<-checknum(num)$n_lett;
  adnum<-checknum(num)$adnum-1;
  out<-c(rep(1,n_lett));
  for(i in 1:n_lett) {
    out[i]<-(floor(adnum/(26^(n_lett-i)))%%26)+1;
  }
  return(paste(LETTERS[out],collapse=""))
} #main function that creates the letters

applett2(26+26^2+26^3+26^4)
# "ZZZZ"
applett2(1234567)
# "BRFGI"

可以使用模运算符 (%%) 和除法在 R 中编写一个短函数来进行转换。 R 是 1 索引的,这使得它有点棘手,而且表示并不是真正的基础,因为 0 不存在,如果我们有 A = 0 而不是我们会有 BA=26 而没有 AAAB

以下函数解决了这个问题并符合您的定义。

base26_conversion <- function(number){
  result <- "";
  base <- 26
  number <- number - 1
  repeat{
    result <- paste0(LETTERS[(number) %% base + 1], result)
    number <- floor(number / base) - 1
    if (!(number > -1)){
      break
    }
  }
  return(result)
}

取模运算符会提取当前"digit"加1会修正索引得到对应的字母。除法会将小数点在 26 进制中移动一位。减 1 确保排除“0”。

该函数为您的函数的整个输入范围提供匹配字符串,并且应该概括为任何正数。

这是一个可能的解决方案:

dec2abc<- function(number){
    digit<- LETTERS[(number-1)%%26+1]
    number<- (number - 1 - (number-1)%%26)/26
    while (number > 26){
        digit<- paste0(LETTERS[(number-1)%%26+1], digit)
        number<- (number - 1 - (number-1)%%26)/26 
        }
    digit<- paste0(LETTERS[number], digit)
    return(digit)
}

这适用于任何正整数,但我认为您添加的数字越多,您将测试计算机的记忆能力。

这里有一些备选方案:

1) encode 设 b 为基数。这里 b = 26。然后有 b^k 个有 k 个字母的附录 所以对于编号为 x 的特定附录,如果 n 是 b + b^2 + ... + b^n >= x 的最小整数。这个不等式的 LHS 是一个几何级数,因此有一个封闭形式的解。用该表达式替换 LHS 并求解 n 的结果方程给出以下代码中 n 的公式。然后我们从 k < n 的数字中减去所有 b^k 项,并使用类似 APL 的 encode 函数找到 here(以及网络上的其他地方)。 encode 进行基数转换,给出 digits,基数 base 中的数字向量。最后将每个数字加 1 并将其用作对 LETTERS.

的查找
app2 <- function(number, base = 26) {
    n <- ceiling(log((1/(1 - base) - 1 - number) * (1 - base), base = base)) - 1
    digits <- encode(number - sum(base^seq(0, n-1)), rep(base, n))
    paste(LETTERS[digits + 1], collapse = "")
}

sapply(1:29, app2) # test

给予:

[1] "A"  "B"  "C"  "D"  "E"  "F"  "G"  "H"  "I"  "J"  "K"  "L"  "M"  "N"  "O" 
[16] "P"  "Q"  "R"  "S"  "T"  "U"  "V"  "W"  "X"  "Y"  "Z"  "AA" "AB" "AC"

要尝试的另一个测试是:

sapply(1:60, app2, base = 3)

2) 递归解决方案 这是递归工作的替代方案。它计算附录编号的最后一个字母,然后将其删除并递归计算其左侧的部分。

app2r <- function(number, base = 26, suffix = "") {
   number1 <- number - 1
   last_digit <- number1 %% base
   rest <- number1 %/% base
   suffix <- paste0(LETTERS[last_digit + 1], suffix)
   if (rest > 0) Recall(rest, base, suffix) else suffix
}

# tests
identical(sapply(1:29, app2r), sapply(1:29, app2))
## [1] TRUE
identical(sapply(1:60, app2r, base = 3), sapply(1:60, app2, base = 3))
## [1] TRUE