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

Question

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

Check `chartr`. E.g. [Replace characters using gsub, how to create a function?](https://stackoverflow.com/a/6954528/1851712) — Henrik, Jun 19 '20 at 15:51
Thats a really good link @Henrik. Thanks for sharing. Not aware of this function — StupidWolf, Jun 19 '20 at 16:22
It seems like it might make it much easier if the coding was uni-directional so that instead of having a 2x13 matrix where the encoding for a letter might have to be looked up "upwards" and "downwards", wouldn't it be easier to have a 2x26 matrix so that encoding is always from row 1 to row 2 and decoding from row 2 to row 1. Given the randomness, it can happen that a letter's encoding is the same letter, but would that be a big problem? Then I think it would be much easier to implement the `chartr` function. — Valeri Voev, Jun 19 '20 at 18:37

StupidWolf · Accepted Answer · 2020-06-19T16:19:54.927

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"

thank you for the answer, but what if I want to match the elements of the second row with the elements of the first row too? — rauls__, Jun 19 '20 at 16:13
you're welcome :) oh you mean decode? you can change the code right? — StupidWolf, Jun 19 '20 at 16:16
Ok.. i put in a quick fix. However, it only works if all your letters can be found.. doesn't account for situations where the input is wrong — StupidWolf, Jun 19 '20 at 16:20

score 1 · Answer 2 · answered Jun 19 '20 at 15:55

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"

score 1 · Answer 3 · answered Jun 20 '20 at 06:16

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?"

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

3 Answers3