💾 Archived View for republic.circumlunar.space › users › johngodlee › posts › 2021-01-25-playfair.gm… captured on 2023-09-28 at 16:20:09. Gemini links have been rewritten to link to archived content

-=-=-=-=-=-=-

Playfair cipher in R

DATE: 2021-01-25

AUTHOR: John L. Godlee

I was designing a treasure hunt as a Christmas present. I wanted to create a Playfair cipher as the final clue which when decoded would reveal the location of the Christmas present.

I used R to construct a function which produces a cipher matrix and key lookup table, and an encoded message. Here is a brief description of how the playfair cipher works:

Start with a matrix of letters:

a|J|N|G|o|k S|R|h|B|Z|b x|E|w|z|u|f d|l|t|W|H|p r|K|n|I|c|M s|q|g|P|T|D

and a lookup table:

keypair|letter wD|A bM|B aq|C sB|T

and an encoded message: sJgfSP

Find each pair of characters in the encoded message in the matrix, here starting with aq:

a|J|N|G|o|k S|R|h|B|Z|b x|E|w|z|u|f d|l|t|W|H|p r|K|n|I|c|M s|q|g|P|T|D

and take the "opposite" corners of the box formed by the keypair. In this case the answers are aq, wD, and sB.

Then take the output keypairs and match them in the lookup table. The answer here is CAT.

My function actually uses a slightly adapted version of the Playfair cipher. The differences are:

In my version if two key values are on the same row or column in the matrix they are simply swapped round, rather than transposed to the right or down.
In my version the matrix is 6x6 rather than 5x5 and uses a sample of 36 uppercase and lowercase letters rather than 25 (-J) uppercase letters.

Here is the function, which takes the message to be encoded as its single argument. It returns the encoded message, the matrix and the key lookup table:

#' Create a playfair-style cipher
#'
#' @param x character string to encode
#'
#' @return list with three slots: (1) encoded message (2) decoder matrix 
#'     (3) decoder lookup table
#'
#' @details Creates a cipher based on the original playfair cipher. 
#'     Unlike the original playfair cipher this method produces a 
#'     6x6 grid of upper and lowercase letters. Additionally, the 
#'     behaviour when a keypair appear on the same row or column of 
#'     the decoder matrix is different. In this version keypairs which
#'     appear on the same row or column are merely swapped rather than
#'     transposed as in the original cipher. 
#'     Messages to be encoded are converted to uppercase and all
#'     non-alphabet characters are stripped out.
#'
#' @examples
#' x <- "This is a test"
#' playfair(x)
#' 
#' @export
#' 
playfair <- function(x) {
  # List all letters, upper and lowercase (52 chr)
  all_chr <- c(letters, LETTERS)

  # Create 6x6 matrix of distinct letters
  mat <- matrix(sample(all_chr, 6*6), 6, 6)

  # Get all pairwise combinations of grid positions
  locs_pairs <- matrix(combn(seq(length(mat)), 2), ncol = 2)
  locs_clean <- unique(locs_pairs[locs_pairs[,1] != locs_pairs[,2],])

  # Randomly sample pairs of grid positions 
  # 26 times to create windows for each letter
  locs_letters <- locs_clean[sample(nrow(locs_clean), 26),]

  # Order the pairs to always take the top left of each pair
  locs_pairs <- apply(locs_letters, 1, function(y) {
    c(min(y), max(y))
    })

  # Search matrix for grid positions to get letter combinations
  combins <- apply(locs_pairs, 2, function(y) {
    paste0(mat[y[1]], mat[y[2]])
  })

  # Make tidy dataframe of letter codes
  code_df <- data.frame(input = combins,
    output = LETTERS)

  # Split x into component characters, 
  # remove spaces and non-letter characters
  x_string <- unlist(strsplit(toupper(x), 
    split = ""))
  x_string_clean <- x_string[x_string %in% LETTERS]
  decoded <- code_df[match(x_string_clean, code_df$output), "input"]

  # For each character, encode
  out <- unlist(lapply(decoded, function(i) {
    # Split string
    i_split <- unlist(strsplit(i, split = ""))

    # Find locations in matrix
    letter_one <- c(which(mat == i_split[1], arr.ind = TRUE))
    letter_two <- c(which(mat == i_split[2], arr.ind = TRUE))

    # Get opposite locations
    if (letter_one[1] == letter_two[1]) {
      opp_one <- mat[letter_one[1], letter_two[2]]
      opp_two <- mat[letter_two[1], letter_one[2]]
    } else {
      opp_one <- mat[letter_two[1], letter_one[2]]
      opp_two <- mat[letter_one[1], letter_two[2]]
    }

    # Combine into one string
    out <- paste0(opp_one, opp_two)

    out
  }))
  return(list(code = out, matrix = mat, key = code_df))
}