An aside for encryption tools

An aside for encryption tools#

Discover hidden messages to find your way out

library(dplyr)
Hide code cell output 
Attaching package: ‘dplyr’

The following objects are masked from ‘package:stats’:

    filter, lag

The following objects are masked from ‘package:base’:

    intersect, setdiff, setequal, union

gsheet_url <- "https://docs.google.com/spreadsheets/d/1XuC5QCF-ulwKjhnn3bq01EvfWYQWR7F15c5OVMXK4D4/export?format=csv&gid=1341391250#gid=1341391250"

manor <- read.csv(gsheet_url) %>%
  select(
    room, item, description,
    weight_kg, length_m, emf_reading,
    inspect, key
  )

manor[manor == ""] <- NA

BEWARE! Spooky context coming 👻😱

oOOOOOOOOOooooooooOOOOOOOOOoooooooooooooOOOOOOOOOOoooooooo
ooooooOOOOOOOOOooooooooOOOOOOOOOoooooooooooooOOOOOOOOOOooo
oooooooooooOOOOOOOOOooooooooOOOOOOOOOoooooooooooooOOOOOOOO
OOOoooooooooooOOOOOOOOOooooooooOOOOOOOOOoooooooooooooOOOOO
OOOOOOOOoooooooooooOOOOOOOOOooooooooOOOOOOOOOooooooooooooo

You wake up in fog in a weird looking house. You don’t remember how you got here, must be dreaming… right? You move to take a step, but a loud creeeaaaaaakkk paralyzes you. Quickly, carefully, you glance down; what catches your eye isn’t the beautiful oak floors, but a rolled up piece of paper sticking out of your sock. You pull it out and unroll it. It’s a note.

You try to read the hastily written note. It’s in you’re own handwriting, and the penmanship is as good as it is ever is…but you can’t read it…the only thing you can make out in tiny writing in the corner it says key = 42. Besides that the note reads:

v5.G4UUTG 5GWU G5. G5VGXU8UOG45G Y3UGV58GTU QY29HGd5GY496US G XUGY U39G&5.GSQ4HGGfI'UG2UV GS2.U9GQ85.4TG XUGX5.9UG54GX5\"G 5G2UQ'UG XY9G3Y9U8QR2UG62QSUHGGtUGS5.2T4I G8Y91GRUY4WGV5.4TG5. PG95G XUGS2.U9GQ8U4I G'U8&GTY8US HG

The mention of key = 42 has to mean something about how to decipher the note…. at least that’s what we have to hope.

OOOOOOOOoooooooooooOOOOOOOOOooooooooOOOOOOOOOooooooooooooo
OOOoooooooooooOOOOOOOOOooooooooOOOOOOOOOoooooooooooooOOOOO
oooooooooooOOOOOOOOOooooooooOOOOOOOOOoooooooooooooOOOOOOOO
ooooooOOOOOOOOOooooooooOOOOOOOOOoooooooooooooOOOOOOOOOOooo
oOOOOOOOOOooooooooOOOOOOOOOoooooooooooooOOOOOOOOOOoooooooo

You’ll need some tools before you start investigating.

Run the below cell to load some decryption tools!

# Load
source("https://tiny.utk.edu/caesar_cypher.R")

# Check the needed functions loaded (throw error if missing)
req_funcs <- c("to_chars", "normalize_index", "encode", "decode")
stopifnot(all(req_funcs %in% ls()))

Warning message in file(filename, "r", encoding = encoding):
“cannot open URL 'https://tiny.utk.edu/caesar_cypher.R': HTTP status was '404 Not Found'”

Error in file(filename, "r", encoding = encoding): cannot open the connection to 'https://tiny.utk.edu/caesar_cypher.R'
Traceback:

1. file(filename, "r", encoding = encoding)
2. .handleSimpleError(function (cnd) 
 . {
 .     watcher$capture_plot_and_output()
 .     cnd <- sanitize_call(cnd)
 .     watcher$push(cnd)
 .     switch(on_error, continue = invokeRestart("eval_continue"), 
 .         stop = invokeRestart("eval_stop"), error = NULL)
 . }, "cannot open the connection to 'https://tiny.utk.edu/caesar_cypher.R'", 
 .     base::quote(file(filename, "r", encoding = encoding)))

The encrypted messages you’ll encounter were encoded using a “Caesar cypher”. A Caesar cypher is a simple way to encrypt info by shifting the alphabet. If you want to learn more about it check out this short video: https://www.youtube.com/watch?v=l6jqKRXSShI

We don’t have to concern ourselves with that too much though. Here’s how we’ll use the functions loaded for us above.

# Encrypt a message
encoded <- encode("abc", key = 2)
print(encoded)

# Decrypt the encrypted message using the same key
decode(encoded, key = 2)

msg <- "Rocky Top, you'll always be home sweet home to me!!!"

# Encrypt a message
encoded <- encode(msg, key = 865)
print(encoded)

# Decrypt the encrypted message using the same key
decode(encoded, key = 865)

An intro to the manor 🏚️#

Where you’ve found yourself trapped is known as the Inescaptable* Manor. Below is all you’ll need to get started. Read each comment, run each line of code, and view it’s output to get up to speed.

*it says “table” and its an escape room theme… get it… ?

# Each row is an item you can come across
names(manor)

# Each item has attributes about it's location, weight, description
manor[1, c("room", "item", "description", "weight_kg"), TRUE]

# Each item also has an encrypted message
manor$inspect[1]

# A few items have their encryption key included
manor$key[1]

# Most don't
manor$key[2:16]

# If you use the item's correct key you can decrypt the hidden message
decode(manor$inspect[1], 42)

Start by finding which items don’t have missing keys.

manor %>% 
  filter(!is.na(key)) %>% 
  filter(item != "Note")

There are 3 different items (in addition to the Note) with non NA keys; one item in the Kitchen, one in the Billiard Room, and one in the Library.

Each of these 3 items are the starts of paths to exit this godforsaken manor.

Each path has a section below with starter code.

Start with Path 1 to have a walk through to get started. There is minimal instructions in the Path 2 & Path 3 sections.

Path 1 - Kitchen#

Item 1#

This code finds the only row in the Kitchen with key already provided and deciphers it’s hidden message.

# Filter to the row that you're after
# Here we want a row with non NA value in `key` column 
# and `room` should be "Kitchen"
row <- manor %>% 
  filter(!is.na(key)) %>% 
  filter(room == "Kitchen")

# Assign the value of the key to a special `key` variable
key <- row$key

# Once you have that row number you can decode the message with:
# (assumes you name your row number `i`)
decode(row$inspect, key)

If all went according to plan you should see a message printed in English and not gibberish. All of these messages have clues that lead to the both next item and the key you need to read that item’s message. Some clues are more direct than others.

Item 2#

It’s up to you now. Use the provided code + comments to help, but don’t hesitate to ask for help if you get stuck.

… good luck …

  • Go to item: Piano

  • Key: 101

# Filter to the row the clue leads to
row <- manor %>% 
  filter(item == "Piano")

# Use the key that the clue leads you to
key <- 101

# Decode the row's message with the key
decode(row$inspect, key)

Item 3#

Repeat that process of finding the new row, finding new key, decoding the message for that row using that key. I have faith in you, do you? (you should)

  • Go to item: Bar Cart

  • Key: sqrt(12321) * 88

# Filter to the row the clue leads to
row <- manor %>% 
  filter(item == "Bar Cart")

# Use the key that the clue leads you to
key <- sqrt(12321) * 88

# Decode the row's message with the key
decode(row$inspect, key)

Item 4#

  • Go to item: Fireplace.

  • Key: average weight_kg with NAs replaced with median

# Filter to the row the clue leads to
row <- manor %>% 
  filter(item == "Fireplace")

# Use the key that the clue leads you to
wts <- manor$weight_kg
wts[is.na(wts)] <- median(wts, na.rm = TRUE)
key <- round(mean(wts))

# Decode the row's message with the key
decode(row$inspect, key)

Item 5#

  • Go to item: Ladder.

  • Key: 25 (25^2 = 25^2 + 7^2)

# Filter to the row the clue leads to
row <- manor %>% 
  filter(item == "Ladder")

# Use the key that the clue leads you to
key <- sqrt(7^2 + 24^2)

# Decode the row's message with the key
decode(row$inspect, key)

Item 6#

  • Go to item: Coat Rack

  • Key: number of NAs total in manor df

# Potential items in Hall
manor %>% 
  filter(room == "Hall") %>% 
  pull(item) %>% 
  print()

# Filter to the row the clue leads to
row <- manor %>% 
  filter(item == "Coat Rack")

# Use the key that the clue leads you to
key <- sum(is.na(manor))

# Decode the row's message with the key
decode(row$inspect, key)

Item 7#

  • Go to item: Ball Set

  • Key: 49 = 7*7 (seven stripes X seven solids to find possible pairs)

# Filter to the row the clue leads to
row <- manor %>% 
  filter(item == "Ball Set")

# Use the key that the clue leads you to
stripes <- 7
solids <- 7
key <- stripes * solids

# Decode the row's message with the key
decode(row$inspect, key)

Item 8#

  • Go to item: Wall Sconce

  • Key: number of items with emf_reading >= 5

# Filter to the row the clue leads to
row <- manor %>% 
  filter(item == "Wall Sconce")

# Use the key that the clue leads you to
key <- sum(manor$emf_reading >= 5)

# Decode the row's message with the key
decode(row$inspect, key)

Item 9#

  • Go to item: Vase in Ballroom

  • Key: round(100 x cor(weight, length))

# Filter to the row the clue leads to
row <- manor %>% 
  filter(room == "Ballroom") %>% 
  filter(item == "Vase")

# Use the key that the clue leads you to
cor_val <- cor(manor$weight_kg, manor$length_m, use = "complete.obs")
key <- round(100 * cor_val)

# Decode the row's message with the key
decode(row$inspect, key)

Item 10#

  • Go to item: China

    • Find average emf_reading by room

    • Find 2nd highest average emf_reading (Dining Room)

    • List items in Dining Room

      • China and Chandelier potentially breakable - try key for both

  • Key: 10 x average emf_reading for Dining Room = 10 x 5.1 = 51

# Find average by room and sort
# Dining room has 2nd highest with value of 5.1
manor %>% 
  group_by(room) %>% 
  summarise(avg_emf = mean(emf_reading)) %>% 
  arrange(desc(avg_emf)) %>% 
  head(3)

# China is most breakable; chandelier might be gray area but key will fail 
manor %>% 
  filter(room == "Dining Room") %>% 
  pull(item)

# Find the right row
row <- manor %>% 
  filter(item == "China")

# Use the key that the clue leads you to
key <- 10 * 5.1

# Decode the row's message with the key
decode(row$inspect, key)

Item 11#

  • Go to item: Reading Lamp

  • Key: round(100xR^2) of lm(emf_reading ~ weight_kg + length_m + room)

# Filter to the row the clue leads to
row <- manor %>% 
  filter(item == "Reading Lamp")

# Use the key that the clue leads you to
linear_model <- lm(emf_reading ~ weight_kg + length_m + room, data = manor)
model_summary <- summary(linear_model)
r2 <- model_summary$r.squared
key <- round(100 * r2)

# Decode the row's message with the key
decode(row$inspect, key)

Item 12#

  • Go to item: Watering Can

    • Find items per room

    • Find room with most items (Conservatory)

    • Sort Conservatory items by weight and find 3rd (Watering Can)

  • Key: Convert weight of watering can (5kg) to lbs

# Most items per room. Conservatory has most
manor %>% 
  group_by(room) %>% 
  summarise(n_items = n()) %>% 
  arrange(desc(n_items)) %>% 
  head(3)

# 3rd heaviest item in Conservatory
manor %>% 
  filter(room == "Conservatory") %>% 
  arrange(desc(weight_kg)) %>% 
  head(3) %>% 
  select(item, weight_kg)

# Find the right row
row <- manor %>% 
  filter(item == "Watering Can")

# weight to nearest pound is key
# weight in kg is 5
kg_to_lbs <- 2.20462
key <- round(kg_to_lbs * 5)

# Decode the row's message with the key
decode(row$inspect, key)

Item 13#

  • Go to item: Papers

  • Key: number of pieces of paper in 0.01m tall stack with 0.02cm thick paper

# Filter to the row the clue leads to
row <- manor %>% 
  filter(item == "Papers")

# Use the key that the clue leads you to
stack_height_m <- 0.01
paper_height_cm <- 0.02

stack_height_cm <- stack_height_m * 100
n_pieces <- stack_height_cm / paper_height_cm

key <- n_pieces

# Decode the row's message with the key
decode(row$inspect, key)

Item 14#

  • Go to item: Portrait in Ballroom

  • Key: number of rooms with > 300kgs of items

# Filter to the row the clue leads to
row <- manor %>% 
  filter(room == "Ballroom") %>% 
  filter(item == "Portrait")

# Use the key that the clue leads you to
weights_by_room <- manor %>% 
  group_by(room) %>% 
  summarise(total_weight = sum(weight_kg, na.rm = TRUE)) %>% 
  arrange(desc(total_weight))

key <- sum(weights_by_room$total_weight > 300)

# Decode the row's message with the key
decode(row$inspect, key)

Item 15#

  • Go to item: Window

  • Key: predicted emf_reading for item with weight_kg = 0.5 and length_m = 0.2

# Filter to the row the clue leads to
row <- manor %>% 
  filter(item == "Window")

# Use the key that the clue leads you to
linear_model <- lm(emf_reading ~ weight_kg + length_m, data = manor)

new_item <- data.frame(
  weight_kg = 0.5,
  length_m = 0.2
)
yhat <- predict(linear_model, newdata = new_item)

key <- round(yhat * 10000)

# Decode the row's message with the key
decode(row$inspect, key)

You’ve reached an exit!

Path 2 - Library#

NOTE - UNDER CONSTRUCTION - PATH IS NOT COMPLETE

Item 1#

# Filter to the row that you're after
# Here we want a row with non NA value in `key` column 
# and `room` should be "Kitchen"
row <- manor %>% 
  filter(!is.na(key)) %>% 
  filter(room == "Library")

# Assign the value of the key to a special `key` variable
key <- row$key

# Once you have that row number you can decode the message with:
# (assumes you name your row number `i`)
decode(row$inspect, key)

You’re on you’re own for the rest. Go back and work Path 1 if you’re stuck getting started.

Item 2#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 3#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 4#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 5#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 6#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 7#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 8#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 9#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 10#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 11#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 12#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 13#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 14#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 15#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Path 3 - Billiard Room#

NOTE - UNDER CONSTRUCTION - PATH IS NOT COMPLETE

Item 1#

# Filter to the row that you're after
# Here we want a row with non NA value in `key` column 
# and `room` should be "Kitchen"
row <- manor %>% 
  filter(!is.na(key)) %>% 
  filter(room == "Billiard Room")

# Assign the value of the key to a special `key` variable
key <- row$key

# Once you have that row number you can decode the message with:
# (assumes you name your row number `i`)
decode(row$inspect, key)

You’re on you’re own for the rest. Go back and work Path 1 if you’re stuck getting started.

Item 2#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 3#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 4#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 5#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 6#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 7#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 8#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 9#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 10#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 11#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 12#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 13#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 14#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)

Item 15#

  • Go to item:

  • Key:

# Decode the row's message with the key
decode(row$inspect, key)