R/playfair.R

In cryptography: Encrypts and Decrypts Text Ciphers

#' Playfair Cipher
#'
#' @description This can be used to encrypt or decrypt a Playfair cipher. A Playfair cipher is a polygraphic substitution cipher
#' that maps digrams of text to other elements of an encryption matrix which is generated by a keyword.
#'
#'
#' @param message a character vector to be encrypted or decrypted
#' @param key a character vector to be used as the encryption key
#' @param encrypt (Default: `TRUE`) TRUE will encrypt the message, while FALSE will decrypt the message.
#'
#' @return A character vector of either plaintext that has been encrypted or ciphertext that has been decrypted.
#' @export
#'
#' @examples
#' playfair("SUPERSECRETMESSAGE", "safety", encrypt = TRUE)
#' playfair("YSQFNTFDQTGRTAAFDT", "safety", encrypt = FALSE)
#' playfair("$%^Att&(a09Ck___He86re", "safety", encrypt = TRUE)
#' playfair("FSSFKPLSQT", "safety", encrypt = FALSE)
#'
playfair <- function(message, key, encrypt = TRUE) {

  # stop if message is not a character vector
  if (!is.character(message) || !is.vector(message) || length(message) != 1) {
    stop("message must be a character vector")
  }

  # stop if the key is not a character vector
  if (!is.character(key) || !is.vector(key) || length(key) != 1) {
    stop("key must be a character vector")
  }

  # stop if encrypt is not boolean
  if (!is.logical(encrypt)) {
    stop("encrypt must be TRUE or FALSE")
  }

  # generating the encryption matrix from the key input
  encryption.matrix <- KeyMatrix(key)

  # converting the message input to digrams under necessary playfair conditions
  digrams <- playfair_digram(message)

  # storing the dimensions of the digrams elements' position in the encryption matrix
  digrams.row <- vector("list", length(digrams))
  for (i in 1:length(digrams)) {
    digrams.row[[i]] <- c(which(encryption.matrix == digrams[[i]][1], arr.ind=TRUE)[1],
                           which(encryption.matrix == digrams[[i]][2], arr.ind=TRUE)[1])
  }

  digrams.col <- vector("list", length(digrams))
  for (i in 1:length(digrams)) {
    digrams.col[[i]] <- c(which(encryption.matrix == digrams[[i]][1], arr.ind=TRUE)[2],
                           which(encryption.matrix == digrams[[i]][2], arr.ind=TRUE)[2])
  }

  # calling encryption method
  if (encrypt == TRUE) {

    # creating object to store ciphertext
    ciphertext <- vector("character", length(digrams)*2)

    for (i in 1:length(digrams)) {

      # algorithm for when rows and columns are both unequal
      if (digrams.row[[i]][1] != digrams.row[[i]][2] &
          digrams.col[[i]][1] != digrams.col[[i]][2]) {
        ciphertext[(i*2)-1] <- encryption.matrix[digrams.row[[i]][1], digrams.col[[i]][2]]
        ciphertext[i*2] <- encryption.matrix[digrams.row[[i]][2], digrams.col[[i]][1]]
      }

      # algorithm for when rows are equal and columns are unequal
      if (digrams.row[[i]][1] == digrams.row[[i]][2] &
          digrams.col[[i]][1] != digrams.col[[i]][2]) {
        ciphertext[(i*2)-1] <- encryption.matrix[digrams.row[[i]][1], (digrams.col[[i]][1]%%5) + 1]
        ciphertext[i*2] <- encryption.matrix[digrams.row[[i]][2], (digrams.col[[i]][2]%%5)+1]
      }

      # algorithm for when rows are unequal and columns are equal
      if (digrams.row[[i]][1] != digrams.row[[i]][2] &
          digrams.col[[i]][1] == digrams.col[[i]][2]) {
        ciphertext[(i*2)-1] <- encryption.matrix[(digrams.row[[i]][1]%%5)+1, digrams.col[[i]][1]]
        ciphertext[i*2] <- encryption.matrix[(digrams.row[[i]][2]%%5)+1, digrams.col[[i]][2]]
      }
    }
    output <- paste(ciphertext, collapse = "")
  }

  # calling decryption method
  if (encrypt == FALSE) {

    # creating object to store plaintext
    plaintext <- vector("character", length(digrams)*2)

    for (i in 1:length(digrams)) {

      # algorithm for when rows and columns are both unequal
      if (digrams.row[[i]][1] != digrams.row[[i]][2] &
          digrams.col[[i]][1] != digrams.col[[i]][2]) {
        plaintext[(i*2)-1] <- encryption.matrix[digrams.row[[i]][1], digrams.col[[i]][2]]
        plaintext[i*2] <- encryption.matrix[digrams.row[[i]][2], digrams.col[[i]][1]]
      }

      # algorithm for when rows are equal and columns are unequal
      if (digrams.row[[i]][1] == digrams.row[[i]][2] &
          digrams.col[[i]][1] != digrams.col[[i]][2]) {
        plaintext[(i*2)-1] <- encryption.matrix[digrams.row[[i]][1], ((digrams.col[[i]][1]-2)%%5+1)]
        plaintext[i*2] <- encryption.matrix[digrams.row[[i]][2], ((digrams.col[[i]][2]-2)%%5+1)]
      }

      # algorithm for when rows are unequal and columns are equal
      if (digrams.row[[i]][1] != digrams.row[[i]][2] &
          digrams.col[[i]][1] == digrams.col[[i]][2]) {
        plaintext[(i*2)-1] <- encryption.matrix[((digrams.row[[i]][1]-2)%%5+1), digrams.col[[i]][1]]
        plaintext[i*2] <- encryption.matrix[((digrams.row[[i]][2]-2)%%5+1), digrams.col[[i]][2]]
      }
    }
    output <- paste(plaintext, collapse = "")
  }
  return(output)
}

# Function to generate the key matrix from the given key
KeyMatrix <- function(key) {
  # taking only A-Za-z characters and changing them to uppercase
  key <- toupper(gsub("[^A-Za-z]", "", key))

  # creating string with all letters in order of input to key matrix
  key <- c(strsplit(key, "")[[1]], toupper(letters))

  # replacing J with I as necessary for 5x5 encryption matrix
  key[key == "J"] <- "I"

  # removing repeated letters
  key <- key[!duplicated(key)]

  # inputting letters into key matrix
  keyMatrix <- matrix(key, nrow=5, ncol=5, byrow = TRUE)

  return(keyMatrix)
}

# function to convert input text to digrams from playfair conditions
playfair_digram <- function(message) {
  message <- toupper(gsub("[^A-Za-z]", "", message))

  message.fixed <- strsplit(message,"")[[1]]

  message.fixed[message.fixed == "J"] <- "I"

  repeat {
  for (i in 2:length(message.fixed))
  {
    if (message.fixed[i-1]==message.fixed[i] & i%%2 == 0)
    {
      message.fixed <- c(message.fixed,(""))
      for (j in length(message.fixed):i)
      {
        message.fixed[j] <- message.fixed[j-1]
      }
      if (message.fixed[i-1] != "X") {
        message.fixed[i] <- "X"
      }
      if (message.fixed[i-1] == "X") {
        message.fixed[i] <- "Z"
      }
    }
  }
  if (message.fixed[length(message.fixed)]=="X" & length(message.fixed)%%2!=0) {
    message.fixed <- c(message.fixed,("Z"))
  }
  if (length(message.fixed)%%2!=0) {
    message.fixed <- c(message.fixed,("X"))
  }
  if (message.fixed[i-1] != message.fixed[i] & (i)%%2 == 0) {
    break
  }

  }

  # putting the resulting characters into pairs
  digrams <- vector("list", length(message.fixed)/2)
  for (i in 1:(length(message.fixed)/2)) {
      digrams[[i]] <- c(message.fixed[i*2-1],message.fixed[i*2])
  }

  return(digrams)
}