This notebook contains the first code sample found in Chapter 6, Section 1 of Deep Learning with R. Note that the original text features far more content, in particular further explanations and figures: in this notebook, you will only find source code and related comments.


One-hot encoding is the most common, most basic way to turn a token into a vector. You already saw it in action in our initial IMDB and Reuters examples from chapter 3 (done with words, in our case). It consists in associating a unique integer index to every word, then turning this integer index i into a binary vector of size N, the size of the vocabulary, that would be all-zeros except for the i-th entry, which would be 1.

Of course, one-hot encoding can be done at the character level as well. To unambiguously drive home what one-hot encoding is and how to implement it, here are two toy examples of one-hot encoding: one for words, the other for characters.

Word level one-hot encoding (toy example):

# This is our initial data; one entry per "sample"
# (in this toy example, a "sample" is just a sentence, but
# it could be an entire document).
samples <- c("The cat sat on the mat.", "The dog ate my homework.")
  
# First, build an index of all tokens in the data.
token_index <- list()
for (sample in samples)
  # Tokenizes the samples via the strsplit function. In real life, you'd also
  # strip punctuation and special characters from the samples.
  for (word in strsplit(sample, " ")[[1]])
    if (!word %in% names(token_index))
      # Assigns a unique index to each unique word. Note that you don't
      # attribute index 1 to anything.
      token_index[[word]] <- length(token_index) + 2 
# Vectorizes the samples. You'll only consider the first max_length 
# words in each sample.
max_length <- 10
# This is where you store the results.
results <- array(0, dim = c(length(samples), 
                            max_length, 
                            max(as.integer(token_index))))
for (i in 1:length(samples)) {
  sample <- samples[[i]]
  words <- head(strsplit(sample, " ")[[1]], n = max_length)
  for (j in 1:length(words)) {
    index <- token_index[[words[[j]]]]
    results[[i, j, index]] <- 1
  }
}

Character level one-hot encoding (toy example):

samples <- c("The cat sat on the mat.", "The dog ate my homework.")
ascii_tokens <- c("", sapply(as.raw(c(32:126)), rawToChar))
token_index <- c(1:(length(ascii_tokens)))
names(token_index) <- ascii_tokens
max_length <- 50
results <- array(0, dim = c(length(samples), max_length, length(token_index)))
for (i in 1:length(samples)) {
  sample <- samples[[i]]
  characters <- strsplit(sample, "")[[1]]
  for (j in 1:length(characters)) {
    character <- characters[[j]]
    results[i, j, token_index[[character]]] <- 1
  }
}

Note that Keras has built-in utilities for doing one-hot encoding text at the word level or character level, starting from raw text data. This is what you should actually be using, as it will take care of a number of important features, such as stripping special characters from strings, or only taking into the top N most common words in your dataset (a common restriction to avoid dealing with very large input vector spaces).

Using Keras for word-level one-hot encoding:

library(keras)
samples <- c("The cat sat on the mat.", "The dog ate my homework.")
# Creates a tokenizer, configured to only take into account the 1,000 
# most common words, then builds the word index.
tokenizer <- text_tokenizer(num_words = 1000) %>%
  fit_text_tokenizer(samples)
# Turns strings into lists of integer indices
sequences <- texts_to_sequences(tokenizer, samples)
# You could also directly get the one-hot binary representations. Vectorization 
# modes other than one-hot encoding are supported by this tokenizer.
one_hot_results <- texts_to_matrix(tokenizer, samples, mode = "binary")
# How you can recover the word index that was computed
word_index <- tokenizer$word_index
cat("Found", length(word_index), "unique tokens.\n")
Found 9 unique tokens.

A variant of one-hot encoding is the so-called “one-hot hashing trick”, which can be used when the number of unique tokens in your vocabulary is too large to handle explicitly. Instead of explicitly assigning an index to each word and keeping a reference of these indices in a dictionary, one may hash words into vectors of fixed size. This is typically done with a very lightweight hashing function. The main advantage of this method is that it does away with maintaining an explicit word index, which saves memory and allows online encoding of the data (starting to generate token vectors right away, before having seen all of the available data). The one drawback of this method is that it is susceptible to “hash collisions”: two different words may end up with the same hash, and subsequently any machine learning model looking at these hashes won’t be able to tell the difference between these words. The likelihood of hash collisions decreases when the dimensionality of the hashing space is much larger than the total number of unique tokens being hashed.

Word-level one-hot encoding with hashing trick (toy example):

library(hashFunction)
samples <- c("The cat sat on the mat.", "The dog ate my homework.")
# We will store our words as vectors of size 1000.
# Note that if you have close to 1000 words (or more)
# you will start seeing many hash collisions, which
# will decrease the accuracy of this encoding method.
dimensionality <- 1000
max_length <- 10
results <- array(0, dim = c(length(samples), max_length, dimensionality))
for (i in 1:length(samples)) {
  sample <- samples[[i]]
  words <- head(strsplit(sample, " ")[[1]], n = max_length)
  for (j in 1:length(words)) {
    # Hash the word into a "random" integer index
    # that is between 0 and 1,000
    index <- abs(spooky.32(words[[i]])) %% dimensionality
    results[[i, j, index]] <- 1
  }
}
LS0tCnRpdGxlOiAiT25lLWhvdCBlbmNvZGluZyBvZiB3b3JkcyBvciBjaGFyYWN0ZXJzIgpvdXRwdXQ6IAogIGh0bWxfbm90ZWJvb2s6IAogICAgdGhlbWU6IGNlcnVsZWFuCiAgICBoaWdobGlnaHQ6IHRleHRtYXRlCi0tLQoKYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9CmtuaXRyOjpvcHRzX2NodW5rJHNldCh3YXJuaW5nID0gRkFMU0UsIG1lc3NhZ2UgPSBGQUxTRSkKYGBgCgoqKioKClRoaXMgbm90ZWJvb2sgY29udGFpbnMgdGhlIGZpcnN0IGNvZGUgc2FtcGxlIGZvdW5kIGluIENoYXB0ZXIgNiwgU2VjdGlvbiAxIG9mIFtEZWVwIExlYXJuaW5nIHdpdGggUl0oaHR0cHM6Ly93d3cubWFubmluZy5jb20vYm9va3MvZGVlcC1sZWFybmluZy13aXRoLXIpLiBOb3RlIHRoYXQgdGhlIG9yaWdpbmFsIHRleHQgZmVhdHVyZXMgZmFyIG1vcmUgY29udGVudCwgaW4gcGFydGljdWxhciBmdXJ0aGVyIGV4cGxhbmF0aW9ucyBhbmQgZmlndXJlczogaW4gdGhpcyBub3RlYm9vaywgeW91IHdpbGwgb25seSBmaW5kIHNvdXJjZSBjb2RlIGFuZCByZWxhdGVkIGNvbW1lbnRzLgoKKioqCgoKT25lLWhvdCBlbmNvZGluZyBpcyB0aGUgbW9zdCBjb21tb24sIG1vc3QgYmFzaWMgd2F5IHRvIHR1cm4gYSB0b2tlbiBpbnRvIGEgdmVjdG9yLiBZb3UgYWxyZWFkeSBzYXcgaXQgaW4gYWN0aW9uIGluIG91ciBpbml0aWFsIElNREIgYW5kIFJldXRlcnMgZXhhbXBsZXMgZnJvbSBjaGFwdGVyIDMgKGRvbmUgd2l0aCB3b3JkcywgaW4gb3VyIGNhc2UpLiBJdCBjb25zaXN0cyBpbiBhc3NvY2lhdGluZyBhIHVuaXF1ZSBpbnRlZ2VyIGluZGV4IHRvIGV2ZXJ5IHdvcmQsIHRoZW4gdHVybmluZyB0aGlzIGludGVnZXIgaW5kZXggaSBpbnRvIGEgYmluYXJ5IHZlY3RvciBvZiBzaXplIE4sIHRoZSBzaXplIG9mIHRoZSB2b2NhYnVsYXJ5LCB0aGF0IHdvdWxkIGJlIGFsbC16ZXJvcyBleGNlcHQgZm9yIHRoZSBpLXRoIGVudHJ5LCB3aGljaCB3b3VsZCBiZSAxLgoKT2YgY291cnNlLCBvbmUtaG90IGVuY29kaW5nIGNhbiBiZSBkb25lIGF0IHRoZSBjaGFyYWN0ZXIgbGV2ZWwgYXMgd2VsbC4gVG8gdW5hbWJpZ3VvdXNseSBkcml2ZSBob21lIHdoYXQgb25lLWhvdCBlbmNvZGluZyBpcyBhbmQgaG93IHRvIGltcGxlbWVudCBpdCwgaGVyZSBhcmUgdHdvIHRveSBleGFtcGxlcyBvZiBvbmUtaG90IGVuY29kaW5nOiBvbmUgZm9yIHdvcmRzLCB0aGUgb3RoZXIgZm9yIGNoYXJhY3RlcnMuCgpXb3JkIGxldmVsIG9uZS1ob3QgZW5jb2RpbmcgKHRveSBleGFtcGxlKToKCmBgYHtyfQojIFRoaXMgaXMgb3VyIGluaXRpYWwgZGF0YTsgb25lIGVudHJ5IHBlciAic2FtcGxlIgojIChpbiB0aGlzIHRveSBleGFtcGxlLCBhICJzYW1wbGUiIGlzIGp1c3QgYSBzZW50ZW5jZSwgYnV0CiMgaXQgY291bGQgYmUgYW4gZW50aXJlIGRvY3VtZW50KS4Kc2FtcGxlcyA8LSBjKCJUaGUgY2F0IHNhdCBvbiB0aGUgbWF0LiIsICJUaGUgZG9nIGF0ZSBteSBob21ld29yay4iKQogIAojIEZpcnN0LCBidWlsZCBhbiBpbmRleCBvZiBhbGwgdG9rZW5zIGluIHRoZSBkYXRhLgp0b2tlbl9pbmRleCA8LSBsaXN0KCkKZm9yIChzYW1wbGUgaW4gc2FtcGxlcykKICAjIFRva2VuaXplcyB0aGUgc2FtcGxlcyB2aWEgdGhlIHN0cnNwbGl0IGZ1bmN0aW9uLiBJbiByZWFsIGxpZmUsIHlvdSdkIGFsc28KICAjIHN0cmlwIHB1bmN0dWF0aW9uIGFuZCBzcGVjaWFsIGNoYXJhY3RlcnMgZnJvbSB0aGUgc2FtcGxlcy4KICBmb3IgKHdvcmQgaW4gc3Ryc3BsaXQoc2FtcGxlLCAiICIpW1sxXV0pCiAgICBpZiAoIXdvcmQgJWluJSBuYW1lcyh0b2tlbl9pbmRleCkpCiAgICAgICMgQXNzaWducyBhIHVuaXF1ZSBpbmRleCB0byBlYWNoIHVuaXF1ZSB3b3JkLiBOb3RlIHRoYXQgeW91IGRvbid0CiAgICAgICMgYXR0cmlidXRlIGluZGV4IDEgdG8gYW55dGhpbmcuCiAgICAgIHRva2VuX2luZGV4W1t3b3JkXV0gPC0gbGVuZ3RoKHRva2VuX2luZGV4KSArIDIgCgojIFZlY3Rvcml6ZXMgdGhlIHNhbXBsZXMuIFlvdSdsbCBvbmx5IGNvbnNpZGVyIHRoZSBmaXJzdCBtYXhfbGVuZ3RoIAojIHdvcmRzIGluIGVhY2ggc2FtcGxlLgptYXhfbGVuZ3RoIDwtIDEwCgojIFRoaXMgaXMgd2hlcmUgeW91IHN0b3JlIHRoZSByZXN1bHRzLgpyZXN1bHRzIDwtIGFycmF5KDAsIGRpbSA9IGMobGVuZ3RoKHNhbXBsZXMpLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1heF9sZW5ndGgsIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgbWF4KGFzLmludGVnZXIodG9rZW5faW5kZXgpKSkpCgpmb3IgKGkgaW4gMTpsZW5ndGgoc2FtcGxlcykpIHsKICBzYW1wbGUgPC0gc2FtcGxlc1tbaV1dCiAgd29yZHMgPC0gaGVhZChzdHJzcGxpdChzYW1wbGUsICIgIilbWzFdXSwgbiA9IG1heF9sZW5ndGgpCiAgZm9yIChqIGluIDE6bGVuZ3RoKHdvcmRzKSkgewogICAgaW5kZXggPC0gdG9rZW5faW5kZXhbW3dvcmRzW1tqXV1dXQogICAgcmVzdWx0c1tbaSwgaiwgaW5kZXhdXSA8LSAxCiAgfQp9CmBgYAoKQ2hhcmFjdGVyIGxldmVsIG9uZS1ob3QgZW5jb2RpbmcgKHRveSBleGFtcGxlKToKCmBgYHtyfQpzYW1wbGVzIDwtIGMoIlRoZSBjYXQgc2F0IG9uIHRoZSBtYXQuIiwgIlRoZSBkb2cgYXRlIG15IGhvbWV3b3JrLiIpCgphc2NpaV90b2tlbnMgPC0gYygiIiwgc2FwcGx5KGFzLnJhdyhjKDMyOjEyNikpLCByYXdUb0NoYXIpKQp0b2tlbl9pbmRleCA8LSBjKDE6KGxlbmd0aChhc2NpaV90b2tlbnMpKSkKbmFtZXModG9rZW5faW5kZXgpIDwtIGFzY2lpX3Rva2VucwoKbWF4X2xlbmd0aCA8LSA1MAoKcmVzdWx0cyA8LSBhcnJheSgwLCBkaW0gPSBjKGxlbmd0aChzYW1wbGVzKSwgbWF4X2xlbmd0aCwgbGVuZ3RoKHRva2VuX2luZGV4KSkpCgpmb3IgKGkgaW4gMTpsZW5ndGgoc2FtcGxlcykpIHsKICBzYW1wbGUgPC0gc2FtcGxlc1tbaV1dCiAgY2hhcmFjdGVycyA8LSBzdHJzcGxpdChzYW1wbGUsICIiKVtbMV1dCiAgZm9yIChqIGluIDE6bGVuZ3RoKGNoYXJhY3RlcnMpKSB7CiAgICBjaGFyYWN0ZXIgPC0gY2hhcmFjdGVyc1tbal1dCiAgICByZXN1bHRzW2ksIGosIHRva2VuX2luZGV4W1tjaGFyYWN0ZXJdXV0gPC0gMQogIH0KfQpgYGAKCk5vdGUgdGhhdCBLZXJhcyBoYXMgYnVpbHQtaW4gdXRpbGl0aWVzIGZvciBkb2luZyBvbmUtaG90IGVuY29kaW5nIHRleHQgYXQgdGhlIHdvcmQgbGV2ZWwgb3IgY2hhcmFjdGVyIGxldmVsLCBzdGFydGluZyBmcm9tIHJhdyB0ZXh0IGRhdGEuIFRoaXMgaXMgd2hhdCB5b3Ugc2hvdWxkIGFjdHVhbGx5IGJlIHVzaW5nLCBhcyBpdCB3aWxsIHRha2UgY2FyZSBvZiBhIG51bWJlciBvZiBpbXBvcnRhbnQgZmVhdHVyZXMsIHN1Y2ggYXMgc3RyaXBwaW5nIHNwZWNpYWwgY2hhcmFjdGVycyBmcm9tIHN0cmluZ3MsIG9yIG9ubHkgdGFraW5nIGludG8gdGhlIHRvcCBOIG1vc3QgY29tbW9uIHdvcmRzIGluIHlvdXIgZGF0YXNldCAoYSBjb21tb24gcmVzdHJpY3Rpb24gdG8gYXZvaWQgZGVhbGluZyB3aXRoIHZlcnkgbGFyZ2UgaW5wdXQgdmVjdG9yIHNwYWNlcykuCgpVc2luZyBLZXJhcyBmb3Igd29yZC1sZXZlbCBvbmUtaG90IGVuY29kaW5nOgoKYGBge3J9CmxpYnJhcnkoa2VyYXMpCgpzYW1wbGVzIDwtIGMoIlRoZSBjYXQgc2F0IG9uIHRoZSBtYXQuIiwgIlRoZSBkb2cgYXRlIG15IGhvbWV3b3JrLiIpCgojIENyZWF0ZXMgYSB0b2tlbml6ZXIsIGNvbmZpZ3VyZWQgdG8gb25seSB0YWtlIGludG8gYWNjb3VudCB0aGUgMSwwMDAgCiMgbW9zdCBjb21tb24gd29yZHMsIHRoZW4gYnVpbGRzIHRoZSB3b3JkIGluZGV4Lgp0b2tlbml6ZXIgPC0gdGV4dF90b2tlbml6ZXIobnVtX3dvcmRzID0gMTAwMCkgJT4lCiAgZml0X3RleHRfdG9rZW5pemVyKHNhbXBsZXMpCgojIFR1cm5zIHN0cmluZ3MgaW50byBsaXN0cyBvZiBpbnRlZ2VyIGluZGljZXMKc2VxdWVuY2VzIDwtIHRleHRzX3RvX3NlcXVlbmNlcyh0b2tlbml6ZXIsIHNhbXBsZXMpCgojIFlvdSBjb3VsZCBhbHNvIGRpcmVjdGx5IGdldCB0aGUgb25lLWhvdCBiaW5hcnkgcmVwcmVzZW50YXRpb25zLiBWZWN0b3JpemF0aW9uIAojIG1vZGVzIG90aGVyIHRoYW4gb25lLWhvdCBlbmNvZGluZyBhcmUgc3VwcG9ydGVkIGJ5IHRoaXMgdG9rZW5pemVyLgpvbmVfaG90X3Jlc3VsdHMgPC0gdGV4dHNfdG9fbWF0cml4KHRva2VuaXplciwgc2FtcGxlcywgbW9kZSA9ICJiaW5hcnkiKQoKIyBIb3cgeW91IGNhbiByZWNvdmVyIHRoZSB3b3JkIGluZGV4IHRoYXQgd2FzIGNvbXB1dGVkCndvcmRfaW5kZXggPC0gdG9rZW5pemVyJHdvcmRfaW5kZXgKCmNhdCgiRm91bmQiLCBsZW5ndGgod29yZF9pbmRleCksICJ1bmlxdWUgdG9rZW5zLlxuIikKYGBgCgpBIHZhcmlhbnQgb2Ygb25lLWhvdCBlbmNvZGluZyBpcyB0aGUgc28tY2FsbGVkICJvbmUtaG90IGhhc2hpbmcgdHJpY2siLCB3aGljaCBjYW4gYmUgdXNlZCB3aGVuIHRoZSBudW1iZXIgb2YgdW5pcXVlIHRva2VucyBpbiB5b3VyIHZvY2FidWxhcnkgaXMgdG9vIGxhcmdlIHRvIGhhbmRsZSBleHBsaWNpdGx5LiBJbnN0ZWFkIG9mIGV4cGxpY2l0bHkgYXNzaWduaW5nIGFuIGluZGV4IHRvIGVhY2ggd29yZCBhbmQga2VlcGluZyBhIHJlZmVyZW5jZSBvZiB0aGVzZSBpbmRpY2VzIGluIGEgZGljdGlvbmFyeSwgb25lIG1heSBoYXNoIHdvcmRzIGludG8gdmVjdG9ycyBvZiBmaXhlZCBzaXplLiBUaGlzIGlzIHR5cGljYWxseSBkb25lIHdpdGggYSB2ZXJ5IGxpZ2h0d2VpZ2h0IGhhc2hpbmcgZnVuY3Rpb24uIFRoZSBtYWluIGFkdmFudGFnZSBvZiB0aGlzIG1ldGhvZCBpcyB0aGF0IGl0IGRvZXMgYXdheSB3aXRoIG1haW50YWluaW5nIGFuIGV4cGxpY2l0IHdvcmQgaW5kZXgsIHdoaWNoIHNhdmVzIG1lbW9yeSBhbmQgYWxsb3dzIG9ubGluZSBlbmNvZGluZyBvZiB0aGUgZGF0YSAoc3RhcnRpbmcgdG8gZ2VuZXJhdGUgdG9rZW4gdmVjdG9ycyByaWdodCBhd2F5LCBiZWZvcmUgaGF2aW5nIHNlZW4gYWxsIG9mIHRoZSBhdmFpbGFibGUgZGF0YSkuIFRoZSBvbmUgZHJhd2JhY2sgb2YgdGhpcyBtZXRob2QgaXMgdGhhdCBpdCBpcyBzdXNjZXB0aWJsZSB0byAiaGFzaCBjb2xsaXNpb25zIjogdHdvIGRpZmZlcmVudCB3b3JkcyBtYXkgZW5kIHVwIHdpdGggdGhlIHNhbWUgaGFzaCwgYW5kIHN1YnNlcXVlbnRseSBhbnkgbWFjaGluZSBsZWFybmluZyBtb2RlbCBsb29raW5nIGF0IHRoZXNlIGhhc2hlcyB3b24ndCBiZSBhYmxlIHRvIHRlbGwgdGhlIGRpZmZlcmVuY2UgYmV0d2VlbiB0aGVzZSB3b3Jkcy4gVGhlIGxpa2VsaWhvb2Qgb2YgaGFzaCBjb2xsaXNpb25zIGRlY3JlYXNlcyB3aGVuIHRoZSBkaW1lbnNpb25hbGl0eSBvZiB0aGUgaGFzaGluZyBzcGFjZSBpcyBtdWNoIGxhcmdlciB0aGFuIHRoZSB0b3RhbCBudW1iZXIgb2YgdW5pcXVlIHRva2VucyBiZWluZyBoYXNoZWQuCgpXb3JkLWxldmVsIG9uZS1ob3QgZW5jb2Rpbmcgd2l0aCBoYXNoaW5nIHRyaWNrICh0b3kgZXhhbXBsZSk6CgpgYGB7cn0KbGlicmFyeShoYXNoRnVuY3Rpb24pCgpzYW1wbGVzIDwtIGMoIlRoZSBjYXQgc2F0IG9uIHRoZSBtYXQuIiwgIlRoZSBkb2cgYXRlIG15IGhvbWV3b3JrLiIpCgojIFdlIHdpbGwgc3RvcmUgb3VyIHdvcmRzIGFzIHZlY3RvcnMgb2Ygc2l6ZSAxMDAwLgojIE5vdGUgdGhhdCBpZiB5b3UgaGF2ZSBjbG9zZSB0byAxMDAwIHdvcmRzIChvciBtb3JlKQojIHlvdSB3aWxsIHN0YXJ0IHNlZWluZyBtYW55IGhhc2ggY29sbGlzaW9ucywgd2hpY2gKIyB3aWxsIGRlY3JlYXNlIHRoZSBhY2N1cmFjeSBvZiB0aGlzIGVuY29kaW5nIG1ldGhvZC4KZGltZW5zaW9uYWxpdHkgPC0gMTAwMAptYXhfbGVuZ3RoIDwtIDEwCgpyZXN1bHRzIDwtIGFycmF5KDAsIGRpbSA9IGMobGVuZ3RoKHNhbXBsZXMpLCBtYXhfbGVuZ3RoLCBkaW1lbnNpb25hbGl0eSkpCgpmb3IgKGkgaW4gMTpsZW5ndGgoc2FtcGxlcykpIHsKICBzYW1wbGUgPC0gc2FtcGxlc1tbaV1dCiAgd29yZHMgPC0gaGVhZChzdHJzcGxpdChzYW1wbGUsICIgIilbWzFdXSwgbiA9IG1heF9sZW5ndGgpCiAgZm9yIChqIGluIDE6bGVuZ3RoKHdvcmRzKSkgewogICAgIyBIYXNoIHRoZSB3b3JkIGludG8gYSAicmFuZG9tIiBpbnRlZ2VyIGluZGV4CiAgICAjIHRoYXQgaXMgYmV0d2VlbiAwIGFuZCAxLDAwMAogICAgaW5kZXggPC0gYWJzKHNwb29reS4zMih3b3Jkc1tbaV1dKSkgJSUgZGltZW5zaW9uYWxpdHkKICAgIHJlc3VsdHNbW2ksIGosIGluZGV4XV0gPC0gMQogIH0KfQpgYGAKCgo=