fastrtext︱R语言使用facebook的fasttext快速文本分类算法

# From Cran
install.packages("fastrtext")

# From Github
# install.packages("devtools")
devtools::install_github("pommedeterresautee/fastrtext")

The following arguments are mandatory:
  -input              training file path
  -output             output file path

  The following arguments are optional:
  -verbose            verbosity level [2]

  The following arguments for the dictionary are optional:
  -minCount           minimal number of word occurences [5]
  -minCountLabel      minimal number of label occurences [0]
  -wordNgrams         max length of word ngram [1]
  -bucket             number of buckets [2000000]
  -minn               min length of char ngram [3]
  -maxn               max length of char ngram [6]
  -t                  sampling threshold [0.0001]
  -label              labels prefix [__label__]

  The following arguments for training are optional:
  -lr                 learning rate [0.05]
  -lrUpdateRate       change the rate of updates for the learning rate [100]
  -dim                size of word vectors [100]
  -ws                 size of the context window [5]
  -epoch              number of epochs [5]
  -neg                number of negatives sampled [5]
  -loss               loss function {ns, hs, softmax} [ns]
  -thread             number of threads [12]
  -pretrainedVectors  pretrained word vectors for supervised learning []
  -saveOutput         whether output params should be saved [0]

  The following arguments for quantization are optional:
  -cutoff             number of words and ngrams to retain [0]
  -retrain            finetune embeddings if a cutoff is applied [0]
  -qnorm              quantizing the norm separately [0]
  -qout               quantizing the classifier [0]
  -dsub               size of each sub-vector [2]

library(fastrtext)

data("train_sentences")
data("test_sentences")

# prepare data
tmp_file_model <- tempfile()

train_labels <- paste0("__label__", train_sentences[,"class.text"])
train_texts <- tolower(train_sentences[,"text"])
train_to_write <- paste(train_labels, train_texts)
train_tmp_file_txt <- tempfile()
writeLines(text = train_to_write, con = train_tmp_file_txt)

test_labels <- paste0("__label__", test_sentences[,"class.text"])
test_texts <- tolower(test_sentences[,"text"])
test_to_write <- paste(test_labels, test_texts)

# learn model
execute(commands = c("supervised", "-input", train_tmp_file_txt, "-output", tmp_file_model, "-dim", 20, "-lr", 1, "-epoch", 20, "-wordNgrams", 2, "-verbose", 1))

## 
Read 0M words
## Number of words:  5060
## Number of labels: 15
## 
Progress: 100.0%  words/sec/thread: 1457520  lr: 0.000000  loss: 0.300770  eta: 0h0m

# load model
model <- load_model(tmp_file_model)
# prediction are returned as a list with words and probabilities
predictions <- predict(model, sentences = test_to_write)

print(head(predictions, 5))
## [[1]]
## __label__OWNX 
##     0.9980469 
## 
## [[2]]
## __label__MISC 
##     0.9863281 
## 
## [[3]]
## __label__MISC 
##     0.9921875 
## 
## [[4]]
## __label__OWNX 
##     0.9082031 
## 
## [[5]]
## __label__AIMX 
##      0.984375

# Compute accuracy
mean(sapply(predictions, names) == test_labels)

# because there is only one category by observation, hamming loss will be the same
get_hamming_loss(as.list(test_labels), predictions)
## [1] 0.8316667

model <- load_model(model_test_path)
print(head(get_labels(model), 5))
#> [1] "__label__MISC" "__label__OWNX" "__label__AIMX" "__label__CONT"
#> [5] "__label__BASE"

model <- load_model(model_test_path)
print(head(get_parameters(model), 5))
#> $learning_rate
#> [1] 0.05
#> 
#> $learning_rate_update
#> [1] 100
#> 
#> $dim
#> [1] 20
#> 
#> $context_window_size
#> [1] 5
#> 
#> $epoch
#> [1] 20
#> 

library(fastrtext)

    data("train_sentences")
    data("test_sentences")
    texts <- tolower(train_sentences[,"text"])
    tmp_file_txt <- tempfile()
    tmp_file_model <- tempfile()
    writeLines(text = texts, con = tmp_file_txt)
    execute(commands = c("skipgram", "-input", tmp_file_txt, "-output", tmp_file_model, "-verbose", 1))

 model <- load_model(tmp_file_model)

 # test word extraction
    dict <- get_dictionary(model)
    print(head(dict, 5))
## [1] "the"  "</s>" "of"   "to"   "and"

 # print vector
  print(get_word_vectors(model, c("time", "timing")))

 # test word distance
  get_word_distance(model, "time", "timing")
##            [,1]
## [1,] 0.02767485

library(fastrtext)
model_test_path <- system.file("extdata", "model_unsupervised_test.bin", package = "fastrtext")
model <- load_model(model_test_path)
get_nn(model, "time", 10)
#>      times       size   indicate     access    success   allowing   feelings 
#>  0.6120564  0.5041215  0.4941387  0.4777856  0.4719051  0.4696053  0.4652924 
#>   dictator      amino accuracies 
#>  0.4595046  0.4582702  0.4535145 

library(fastrtext)
model_test_path <- system.file("extdata", "model_unsupervised_test.bin", package = "fastrtext")
model <- load_model(model_test_path)
get_analogies(model, "experience", "experiences", "result")
#>  results 
#> 0.726607