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

Viewed 133

First I created a function that gives me a cryptography pattern

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

It gives me a Matrix in which every letter (lowcase) is paired with another.

Now i need to create another function that or code or decode in this cryptography, therefore if I have:

    [,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"  

Then if I type in this new function "HOUSE" or "house" it will give me: "qrzcm" and if i type "qrzcm" it gives me "house".

I tried doing the following:

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

But I am struggling putting this to work.

Please help

3 Answers

You need to set a seed, I cannot reproduce your house example. Most likely you need to declare the decoder outside the function, otherwise it will be different every time!

Two things, 1) you need to split your input string to individual characters, and two, you just match them to the first row of your matrix, call out the 2nd row.

Making it into a data.frame doesn't help because the first row is not recognized as a column name.

Do:

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"

Alternatively, you can calculate offsets and apply them to the underlying utf8 bytes

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"

As indicated in the comments, chartr is a good option for this. Also, as indicated in @StupidWolf's answer, a seed would be required, so I wrote the function to include set.seed. Here's one option:

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))
}

Here's the function in action:

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

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

Alternatively, the function can be written like this, using strsplit and match. Notice that I've just extended the lookup table to make it easier to work with.

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 = "")
}

Personally, I like opt1 better because of how it handles longer strings. Because of the use of match in opt2, characters that aren't in the input get matched to NA, possibly resulting in ugly output. Consider the following examples:

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"

In this case, only opt1 is more or less reversible (sans capitalization):

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