R 中的数字到字母的刻字函数
Numeric to Alphabetic Lettering Function in R
我编写了一个函数,它处理从 1 到 702 的整数,以非常具体的方式将数字转换为字母。以下是我希望字母功能如何工作的一些示例:
- 1 -> A,
- 2 -> B,
- 27 -> AA,
- 29 -> 空调,
- 等等。
我们将此功能用于 "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
而没有 AA
、AB
等
以下函数解决了这个问题并符合您的定义。
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
我编写了一个函数,它处理从 1 到 702 的整数,以非常具体的方式将数字转换为字母。以下是我希望字母功能如何工作的一些示例:
- 1 -> A,
- 2 -> B,
- 27 -> AA,
- 29 -> 空调,
- 等等。
我们将此功能用于 "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
而没有 AA
、AB
等
以下函数解决了这个问题并符合您的定义。
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