如何将一个单词中的所有字母替换为在先前函数中创建的一对?

How to substitute all letters in a word for a pair created in an previous function?

首先我创建了一个函数,它给我一个密码学模式

plugboard <- function(){
  matrix(sample(letters, 26), nrow = 2, ncol = 13)
} 

它给了我一个矩阵,其中每个字母(小写字母)都与另一个字母配对。

现在我需要创建另一个函数,或者在这个密码学中编码或解码,因此如果我有:

    [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
[1,] "v"  "h"  "k"  "a"  "w"  "l"  "f"  "d"  "u"  "r"   "t"   "m"   "s"  
[2,] "p"  "q"  "b"  "g"  "x"  "y"  "i"  "n"  "z"  "o"   "j"   "e"   "c"  

然后如果我输入这个新函数 "HOUSE" 或 "house" 它将给我: "qrzcm" 如果我输入 "qrzcm" 它会给我 "house".

我尝试执行以下操作:

ATdecoder <- function(word){
  word <- x
  pat <- data.frame(plugboard())
  tolower(x)
  x = gsub(pat$V1, pat$V2, x)
}

但我很难让它发挥作用。

请帮忙

您需要设置种子,我无法复制您的房屋示例。很可能你需要在函数外声明解码器,否则每次都会不同!

两件事,1) 您需要将输入字符串拆分为单个字符,第二,您只需将它们与矩阵的第一行匹配,调出第二行。

将它变成 data.frame 没有帮助,因为第一行不被识别为列名。

做:

plugboard <- function(){
  matrix(sample(letters, 26), nrow = 2, ncol = 13)
}

set.seed(111)
pat <- plugboard()

pat

     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
[1,] "n"  "s"  "e"  "h"  "m"  "d"  "y"  "i"  "a"  "v"   "r"   "u"   "p"  
[2,] "t"  "o"  "c"  "q"  "j"  "w"  "x"  "z"  "g"  "l"   "f"   "k"   "b"  

ATdecoder <- function(word,pat){
  x <- unlist(strsplit(tolower(word),""))
  if(all(x %in% pat[1,])){
  paste(pat[2,match(x,pat[1,])],collapse="")
  }else{
  paste(pat[1,match(x,pat[2,])],collapse="")
  }
}

ATdecoder("pave",pat)
[1] "bglc"
> ATdecoder("bglc",pat)
[1] "pave"

或者,您可以计算偏移量并将其应用于底层 utf8 字节

plugboard <- c("v","h","k","a","w","l","f","d","u","r","t","m","s",
               "p","q","b","g","x","y","i","n","z","o","j","e","c" )


offsets <- utf8ToInt(paste0(plugboard[c(14:26, 1:13)], collapse = "")) - 
  utf8ToInt(paste0(plugboard, collapse = ""))


ATdecoder <- function(word){

  word <- tolower(word)

  bytes <- utf8ToInt(word)

  myOffsets <- offsets[match(strsplit(word, "")[[1]], plugboard)]

  paste0(intToUtf8(bytes + myOffsets), collapse = "")

}

ATdecoder("house")
[1] "qrzcm"

ATdecoder("HOUSE")
[1] "qrzcm"

ATdecoder("qrzcm")
[1] "house"

如评论中所述,chartr 是一个不错的选择。此外,如@StupidWolf 的回答所示,需要 seed,因此我编写了包含 set.seed 的函数。这是一个选项:

opt1 <- function(word, seed = 1) {
  set.seed(seed)
  a <- matrix(sample(letters, 26), nrow = 2, ncol = 13)
  b <- apply(a, 1, paste, collapse = "")
  chartr(paste(b, collapse = ""), paste(rev(b), collapse = ""), tolower(word))
}

下面是函数的作用:

opt1("house")
# [1] "ianes"
opt1(opt1("house"))
# [1] "house"

## Different seed
opt1("house", 2)
# [1] "batlr"

或者,函数可以这样写,使用 strsplitmatch。请注意,我刚刚扩展了查找 table 以使其更易于使用。

opt2 <- function(word, seed = 1) {
  set.seed(seed)
  a <- matrix(sample(letters, 26), nrow = 2, ncol = 13)
  a <- cbind(a, a[2:1, ])
  s_word <- strsplit(tolower(word), "", TRUE)[[1]]
  paste(a[2, ][match(s_word, a[1, ])], collapse = "")
}

就我个人而言,我更喜欢 opt1 因为它处理较长字符串的方式。由于在 opt2 中使用了 match,输入中不存在的字符会与 NA 匹配,可能会导致难看的输出。考虑以下示例:

opt1("This is a string, isn't it?")
# [1] "rihe he o erthuj, heu'r hr?"
opt2("This is a string, isn't it?")
# [1] "riheNAheNAoNAerthujNANAheuNArNAhrNA"

在这种情况下,只有 opt1 或多或少是可逆的(无大写):

opt1("rihe he o erthuj, heu'r hr?")
# [1] "this is a string, isn't it?"