caesar <- function(x, n = 1, preserve_spaces = TRUE, dict = NULL, preset = NULL) {

  # Catching errors
  if (length(x) == 0) {
    stop("Please provide a vector of length greater than zero to shift.")
  } else if (!is.atomic(x) | !(is.character(x) | is.numeric(x))) {
    stop("x must be a numeric or character vector.")
  }

  if (!is.null(dict) & !is.null(preset)) {
    warning("Both a dict and a preset was provided, only the dict will be used.")
  }

  if (n == 0) {
    message("Shifting by zero doesn't do anything...")
    return(x)
  }
  
  if (!is.character(x)) { x <- as.character(x) }
  
  x <- strsplit(x, "")
  unlistX <- unlist(x)
  
  # Set the dictionary as needed
  if (is.null(dict) & is.null(preset)) {
    dict <- sort(unique(unlistX))
  } else if (!is.null(preset)) {
    if (preset == "alphanumeric")   { dict <- rawToChar(as.raw(c(48:57, 65:90, 97:122))) } 
    else if (preset == "keyboard")  { dict <- rawToChar(as.raw(32:126)) } 
    else if (preset == "letters")   { dict <- rawToChar(as.raw(c(65:90, 97:122))) } 
    else if (preset == "lowercase") { dict <- rawToChar(as.raw(c(97:122))) } 
    else if (preset == "uppercase") { dict <- rawToChar(as.raw(c(65:90))) } 
    else {
      stop("It looks like you may have a typo in your presets. 
            You can double-check the presets by running ?caesar in your console.")
    }
  }

  if (length(dict) == 1) { dict <- unlist(strsplit(dict, "")) }

  if (!all(unlistX %in% dict)) {
    stop("Not all values of x are in the character set. Please choose a different character set.")
  }
  
  x <- lapply(x, function(y) {
      # We need to preserve spaces as requested
      if (preserve_spaces) {
        isSpace <- which(dict == " ")
        if (length(isSpace > 0)) { dict <- dict[-which(dict == " ")] }
      }

      # Do the shifting
      y <- sapply(y, function(z) {
          if (preserve_spaces & z == " ") { return(" ") }
          hop <- which(z == dict) + n
          hop <- hop %% length(dict)
          if (hop == 0) { hop <- length(dict) }
          return(dict[hop])
        })
      y <- paste0(y, collapse = "")
      return(y)
    })

  x <- unlist(x, recursive = FALSE)

  return(x)
}

test_that("Shift 0 warns and works", {
  expect_message(caesar("abcde", 0))
  expect_equal(caesar("abcde", 0), "abcde")
})
test_that("Shift 1 works", {
  expect_equal(caesar("abcde", 1), "bcdea")
})
test_that("Shift -1 works", {
  expect_equal(caesar("abcde", -1), "eabcd")
})

test_that("Spaces are preserved", {
  expect_equal(caesar("a b c", 1), "b c a")
})
test_that("Spaces are not preserved", {
  expect_equal(caesar("a b c", 1, preserve_spaces = FALSE), "baca ")
})

test_that("Vector length is preserved", {
  expect_equal(caesar(c("a", "b", "c"), 1), c("b", "c", "a"))
})

test_that("When no dictionary is provided, x is used", {
  expect_equal(caesar("abcde", 1), "bcdea")
})

test_that("Cannot provide both a dict and a preset", {
  expect_warning(caesar("abcde", 1, dict = "abcde", preset = "letters"))
})

test_that("The alphanumeric preset works", {
  expect_equal(caesar("abc123", 1, preset = "alphanumeric"), "bcd234")
})
test_that("The keyboard preset works", {
  expect_equal(caesar("abc123!@#", 1, preset = "keyboard"), "bcd234\"A$")
})
test_that("The letters preset works", {
  expect_equal(caesar("abcABC", 1, preset = "letters"), "bcdBCD")
})
test_that("The lowercase preset works", {
  expect_equal(caesar("abcde", 1, preset = "lowercase"), "bcdef")
})
test_that("The uppercase preset works", {
  expect_equal(caesar("ABCDE", 1, preset = "uppercase"), "BCDEF")
})
test_that("A typo in the preset gives an error", {
  expect_error(caesar("abc", 1, preset = "abc"))
})

test_that("dict must contain all values in x", {
  expect_error(caesar("abc", 1, dict = "def"))
})

test_that("x cannot be empty", {
  expect_error(caesar(c(), 1))
})
test_that("x must be a vector", {
  expect_error(caesar(list("abc"), 1))
})
test_that("x must be a character or numeric vector", {
  expect_error(caesar(c(TRUE), 1))
})

atbash <- function(x) {

  if (length(x) == 0) {
    stop("Please provide a vector of length greater than zero.")
  } else if (!is.atomic(x) & !is.character(x)) {
    stop("x must be a character vector.")
  }

  x <- strsplit(x, "")

  x <- lapply(x, function(y) {
    y <- sapply(y, function(z) {
        if (z %in% c(letters, LETTERS)) {
          if (grepl("[A-Z]", z)) { z <- LETTERS[27 - which(LETTERS == z)] } 
          else { z <- letters[27 - which(letters == z)] }
        }
        return(z)
      })
    y <- paste0(y, collapse = "")
    return(y)
  })

  x <- unlist(x, recursive = FALSE)

  return(x)
}

test_that("Letters are flipped", {
  expect_equal(atbash("az"), "za")
})

test_that("Spaces are preserved", {
  expect_equal(atbash("a b c"), "z y x")
})
test_that("Punctuation is preserved", {
  expect_equal(atbash("a.b"), "z.y")
})

test_that("Vector length is preserved", {
  expect_equal(atbash(c("a", "b", "c")), c("z", "y", "x"))
})

test_that("Must be a character vector of length greater than zero", {
  expect_error(atbash(c(TRUE)))
  expect_error(atbash(c(123)))
  expect_error(atbash(c()))
})

railfence <- function(x, n = 1, decrypt = FALSE) {

  if (length(x) == 0) { stop("Please provide a vector of length greater than zero") } 
  else if (!is.atomic(x) & !is.character(x)) { stop("x must be a character vector.") }

  if (length(n) != 1 || n < 1 || n %% 1 != 0) { 
    stop("n must be a single integer greater than or equal to 1") 
  }

  if (!is.logical(decrypt)) { stop("decrypt must be logical") }

  if (!decrypt) { x <- .railfence_encrypt(x, n) } 
  else { x <- .railfence_decrypt(x, n) }

  return(x)
}

#' @keywords internal
.railfence_encrypt <- function(x, n) {
  x <- strsplit(x, "")

  x <- lapply(x, function(y) {
    nx <- length(y)
    z <- c(1, rep_len(c(2:n, (n - 1):1), nx - 1))
    y <- data.frame("x" = y, "pos" = z)
    y <- y[order(y$pos), ]
    y <- paste0(y$x, collapse = "")
    return(y)
  })

  x <- unlist(x, recursive = FALSE)

  return(x)
}

#' @keywords internal
.railfence_decrypt <- function(x, n) {
  x <-
    lapply(x, function(s) {
      s <- unlist(strsplit(s, ""))
      m <- matrix(NA, n, length(s))
      j <- 1
      dir <- 1
      for (i in 1:length(s)) {
        m[j, i] <- "*"

        if (dir == 1) {
          if (j == n) {
            dir <- -1
            j <- j - 1
          } else {
            j <- j + 1
          }
        } else {
          if (j == 1) {
            dir <- 1
            j <- j + 1
          } else {
            j <- j - 1
          }
        }
      }
      k <- 1
      for (j in 1:nrow(m)) {
        for (i in 1:ncol(m)) {
          if (!is.na(m[j, i])) {
            m[j, i] <- s[k]
            k <- k + 1
          }
        }
      }
      m <- as.vector(m)
      m <- paste(m[!is.na(m)], collapse = "")

      return(m)
    })

  x <- unlist(x, recursive = FALSE)

  return(x)
}

test_that("encryption works", {
  expect_equal(railfence("abc def ghij", 3), "adgb e hjcfi")
  expect_equal(railfence(c("abc", "def", "ghij"), 2), c("acb", "dfe", "gihj"))
})
test_that("decryption works", {
  expect_equal(railfence("adgb e hjcfi", 3, decrypt = TRUE), "abc def ghij")
  expect_equal(railfence(c("acb", "dfe", "gihj"), 2, decrypt = TRUE),
               c("abc", "def", "ghij"))
})

test_that("must be a vector with length > 0", {
  expect_error(railfence(c(), 3))
  expect_error(railfence(matrix(NA, 1, 1), 3))
})

test_that("n must be a single integer greater than or equal to 1", {
  expect_error(railfence("abc", 0))
  expect_error(railfence("abc", 1.5))
  expect_error(railfence("abc", 0:3))
})

test_that("decrypt must be logical", {
  expect_error(railfence("abc", 3, "true"))
})

vigenere <- function(x, key, decrypt = FALSE, keep_punctuation = FALSE) {

  if (length(x) == 0) {
    stop("Please provide a vector of length greater than zero for x")
  } else if (!is.atomic(x) & !is.character(x) & !is.matrix(x)) {
    stop("x must be a character vector.")
  }

  if (length(key) != 1) {
    stop("Please provide a vector of length one for key")
  } else if (!is.character(key) & (is.matrix(key) | !is.atomic(key))) {
    stop("key must be a character vector.")
  }

  if (!is.logical(decrypt)) {
    stop("decrypt must be logical")
  }
  if (!is.logical(keep_punctuation)) {
    stop("decrypt must be logical")
  }

  square <-
    suppressMessages(matrix(sapply(0:25, function(x) {
      caesar(letters, x)
    }), 26, 26))

  key <- tolower(key)

  if (!decrypt) {
    x <- .vigenere_encrypt(x, key, square, keep_punctuation)
  } else {
    x <- .vigenere_decrypt(x, key, square, keep_punctuation)
  }

  return(x)
}

#' @keywords internal
.vigenere_encrypt <- function(x, key, square, keep_punctuation) {
  x <- lapply(x, function(x) {
    x <- unlist(strsplit(x, ""))
    if (!keep_punctuation) { x <- x[grepl("[A-z]", x)] }
    lowerX <- tolower(x)

    key <- unlist(strsplit(key, ""))
    key <- .rep_key(x, key)
    r <- sapply(key, .get_letter)
    c <- sapply(lowerX, .get_letter)
    
    x <- sapply(1:length(x), function(i) {
      if (c[i] == 0) { y <- x[i] } 
      else { y <- square[r[i], c[i]] }
      if (keep_punctuation & grepl("[A-Z]", x[i])) { return(toupper(y)) }
      else { return(y) }
    })
    x <- paste0(x, collapse = "")
    return(x)
  })
  x <- unlist(x, recursive = FALSE)
  return(x)
}

#' @keywords internal
.vigenere_decrypt <- function(x, key, square, keep_punctuation) {
  x <- lapply(x, function(x) {
    x <- unlist(strsplit(x, ""))
    if (!keep_punctuation) { x <- x[grepl("[A-z]", x)] }
    lowerX <- tolower(x)

    key <- unlist(strsplit(key, ""))
    key <- .rep_key(x, key)
    r <- sapply(key, .get_letter)

    x <- mapply(function(r, x, lowerX) {
      i <- square[1, which(square[r, ] == lowerX)]
      if (keep_punctuation & grepl("[A-Z]", x)) { i <- toupper(i) }
      else if (keep_punctuation & length(i) == 0) { i <- x }
      return(i)
    }, r, x, lowerX)
    x <- paste0(x, collapse = "")
    return(x)
  })
  x <- unlist(x, recursive = FALSE)
  return(x)
}

#' @keywords internal
.get_letter <- function(y) {
  y <- which(letters == y)
  if (length(y) == 0) { return(0) }
  else { return(y) }
}

#' @keywords internal
.rep_key <- function(x, key) {
  rep_key <- c()
  k <- 1
  return_key <- sapply(1:length(x), function(i) {
    ki <- k %% length(key)
    if (ki == 0) { ki <- length(key) }

    if (!grepl("[A-z]", x[i])) {
      rep_key <- c(rep_key, "")
    } else {
      rep_key <- c(rep_key, key[ki])
      k <<- k + 1
    }
    return(rep_key)
  })

  return(return_key)
}

test_that("Punctuation is preserved for encryption", {
  expect_equal(vigenere("Test.message", "key", keep_punctuation = TRUE), "Diqd.qccwyqi")
  expect_equal(vigenere("testmessage", "key", keep_punctuation = FALSE), "diqdqccwyqi")
})
test_that("Punctuation is not preserved for encryption", {
  expect_equal(vigenere("Test.message", "key", keep_punctuation = FALSE), "diqdqccwyqi")
  expect_equal(vigenere("testmessage", "key", keep_punctuation = FALSE), "diqdqccwyqi")
})

test_that("Punctuation is preserved for decryption", {
  expect_equal(vigenere("Diqd.qccwyqi", "key", decrypt = TRUE, keep_punctuation = TRUE), "Test.message")
  expect_equal(vigenere("diqdqccwyqi", "key", decrypt = TRUE, keep_punctuation = TRUE), "testmessage")
})
test_that("Punctuation is not preserved for decryption", {
  expect_equal(vigenere("Diqd.qccwyqi", "key", decrypt = TRUE, keep_punctuation = FALSE), "testmessage")
  expect_equal(vigenere("diqdqccwyqi", "key", decrypt = TRUE, keep_punctuation = TRUE), "testmessage")
})

test_that("x must be a vector with length > 0", {
  expect_error(vigenere(c(), "key"))
  expect_error(vigenere(matrix(NA, 1, 1), "key"))
})
test_that("key must be a vector with length == 1", {
  expect_error(vigenere("testmessage", c()))
  expect_error(vigenere("testmessage", matrix(NA, 1, 1)))
})

test_that("decrypt must be a boolean", {
  expect_equal(vigenere("Test.message", "key", decrypt = FALSE, keep_punctuation = TRUE), "Diqd.qccwyqi")
  expect_equal(vigenere("Diqd.qccwyqi", "key", decrypt = TRUE, keep_punctuation = TRUE), "Test.message")
  expect_error(vigenere("testmessage", "key", decrypt = 1))
})

test_that("keep_punctuation must be a boolean", {
  expect_equal(vigenere("Test.message", "key", decrypt = FALSE, keep_punctuation = TRUE), "Diqd.qccwyqi")
  expect_equal(vigenere("Diqd.qccwyqi", "key", decrypt = TRUE, keep_punctuation = FALSE), "testmessage")
  expect_error(vigenere("testmessage", "key", keep_punctuation = 1))
})

running_key <- function(x, key, decrypt = FALSE, keep_punctuation = FALSE) {
  if (length(x) != 1) { stop("Please provide a vector of length one for x") 
  } else if (!is.atomic(x) & !is.character(x) & !is.matrix(x)) {
    stop("x must be a character vector.")
  }

  if (length(key) != 1) { stop("Please provide a vector of length one for key") 
  } else if (!is.character(key) & (is.matrix(key) | !is.atomic(key))) {
    stop("key must be a character vector.")
  }

  y <- unlist(strsplit(x, ""))
  y <- y[grepl("[A-z]", y)]

  k <- unlist(strsplit(key, ""))
  k <- k[grepl("[A-z]", k)]

  if(length(k) >= length(y)) {
    x <- vigenere(x, paste0(k, collapse = ""), decrypt = decrypt, keep_punctuation = keep_punctuation)
    return(x)
  } else {
    stop(paste("The key must have an equal or greater number of letters to the text. The key has",
               length(k), "characters and the message has", length(y), "characters."))
  }
}

test_that("Encryption works", {
  expect_equal(running_key("testmessage", "thisisakeytothecipher"), "mlaluwsceex")
})

test_that("Decryption works", {
  expect_equal(running_key("mlaluwsceex", "thisisakeytothecipher", decrypt = TRUE), "testmessage")
})

test_that("Key must be longer than x", {
  expect_error(running_key("testmessage", "key"))
})