To allow to easily do this in R, BNOSAC created an R wrapper around the whisper.cpp code. This R package is available at https://github.com/bnosac/audio.whisper and can be installed as follows. 

remotes::install_github("bnosac/audio.whisper")

The following code shows how you can transcribe an example 16-bit wav file with a fragment of a speech by JFK available here. 

library(audio.whisper)
model <- whisper("tiny")
path  <- system.file(package = "audio.whisper", "samples", "jfk.wav")
trans <- predict(model, newdata = path, language = "en", n_threads = 2)
trans
$n_segments
[1] 1

$data
 segment         from           to                                                                                                       text
       1 00:00:00.000 00:00:11.000  And so my fellow Americans ask not what your country can do for you ask what you can do for your country.

$tokens
 segment      token token_prob
       1        And  0.7476438
       1         so  0.9042299
       1         my  0.6872202
       1     fellow  0.9984470
       1  Americans  0.9589157
       1        ask  0.2573057
       1        not  0.7678108
       1       what  0.6542882
       1       your  0.9386917
       1   counstry  0.9854987
       1        can  0.9813995
       1         do  0.9937403
       1        for  0.9791515
       1        you  0.9925495
       1        ask  0.3058807
       1       what  0.8303462
       1        you  0.9735528
       1        can  0.9711444
       1         do  0.9616748
       1        for  0.9778513
       1       your  0.9604713
       1    country  0.9923630
       1          .  0.4983074

Another example based on a Micro Machines commercial from the 1980's.

I've always wanted to get the transcription of the performances of Francis E. Dec available on UbuWeb Sound - Francis E. Dec like this performance: https://www.ubu.com/media/sound/dec_francis/Dec-Francis-E_rant1.mp3. This is how you can now do that from R.

library(av)
download.file(url = "https://www.ubu.com/media/sound/dec_francis/Dec-Francis-E_rant1.mp3", 
              destfile = "rant1.mp3", mode = "wb")
av_audio_convert("rant1.mp3", output = "output.wav", format = "wav", sample_rate = 16000)

trans <- predict(model, newdata = "output.wav", language = "en", 
                 duration = 30 * 1000, offset = 7 * 1000, 
                 token_timestamps = TRUE)
trans
$n_segments
[1] 11

$data
segment         from           to                                                             text
      1 00:00:07.000 00:00:09.000                                             Look at the picture.
      2 00:00:09.000 00:00:11.000                                                   See the skull.
      3 00:00:11.000 00:00:13.000                                        The part of bone removed.
      4 00:00:13.000 00:00:16.000                     The master race Frankenstein radio controls.
      5 00:00:16.000 00:00:18.000                           The brain thoughts broadcasting radio.
      6 00:00:18.000 00:00:21.000        The eyesight television. The Frankenstein earphone radio.
      7 00:00:21.000 00:00:25.000  The threshold brain wash radio. The latest new skull reforming.
      8 00:00:25.000 00:00:28.000                            To contain all Frankenstein controls.
      9 00:00:28.000 00:00:31.000                     Even in thin skulls of white pedigree males.
     10 00:00:31.000 00:00:34.000                                   Visible Frankenstein controls.
     11 00:00:34.000 00:00:37.000            The synthetic nerve radio, directional and an alloop.

$tokens
segment         token token_prob   token_from     token_to
      1          Look  0.4281234 00:00:07.290 00:00:07.420
      1            at  0.9485379 00:00:07.420 00:00:07.620
      1           the  0.9758387 00:00:07.620 00:00:07.940
      1       picture  0.9734664 00:00:08.150 00:00:08.580
      1             .  0.9688568 00:00:08.680 00:00:08.910
      2           See  0.9847929 00:00:09.000 00:00:09.420
      2           the  0.7588121 00:00:09.420 00:00:09.840
      2         skull  0.9989663 00:00:09.840 00:00:10.310
      2             .  0.9548351 00:00:10.550 00:00:11.000
      3           The  0.9914295 00:00:11.000 00:00:11.170
      3          part  0.9789217 00:00:11.560 00:00:11.600
      3            of  0.9958754 00:00:11.600 00:00:11.770
      3          bone  0.9759618 00:00:11.770 00:00:12.030
      3       removed  0.9956936 00:00:12.190 00:00:12.710
      3             .  0.9965582 00:00:12.710 00:00:12.940
...

Maybe in the near future we will put it on CRAN, currently it is only at https://github.com/bnosac/audio.whisper.

Get in touch if you are interested in this and let us know what you plan to use it for. 

The recogito R package provides tools to manipulate and annotate images and text in shiny. It is a htmlwidgets R wrapper around the excellent recogito-js and annotorious javascript libraries as well as it's integration with openseadragon.
You can use the package to set up shiny apps which

• annotate areas of interest (rectangles / polygons) in images with specific labels
• annotate text using tags and relations between these tags (for entity labelling / entity linking).

The video below shows the image manipulation functionality in action in a shiny app which allows to align image areas with chunks of transcribed handwritten texts.

Although the package was orginally designed to extract information from handwritten text documents from the 18th-19th century, you can probably use it in other domains as well.
To get you started install the package from CRAN and read the README.

install.packages("recogito")

The following code shows an example app which shows an url and allows you to annotate areas of interest. Enjoy.

library(shiny)
library(recogito)
url <- "https://upload.wikimedia.org/wikipedia/commons/a/a0/Pamphlet_dutch_tulipomania_1637.jpg"
ui <- fluidPage(openseadragonOutput(outputId = "anno", height = "700px"),
                tags$h3("Results"),
                verbatimTextOutput(outputId = "annotation_result"))
server <- function(input, output) {
 current_img <- reactiveValues(url = url)
 output$anno <- renderOpenSeaDragon({
   annotorious(inputId = "results", src = current_img$url, tags = c("IMAGE", "TEXT"), type = "openseadragon")
 })
 output$annotation_result <- renderPrint({
   read_annotorious(input$results)
 })
}
shinyApp(ui, server)

You can view the presentation below.

NEW, since 2020, you can now access courses Text Mining with R and Advanced R programming online through our online school, let us know here if you want to obtain access.

{aridoc engine="pdfjs" width="100%" height="550"}images/bnosac/blog/R_doc2vec.pdf{/aridoc}

• In case you are reading this at a blog aggregator, head to https://www.bnosac.be/index.php/blog/103-doc2vec-in-R directly to see the presentation. 
• If you are reading this, you might as well be interested in applying word2vec in R: head to http://www.bnosac.be/index.php/blog/100-word2vec-in-r for details.

Enjoy.

The current release (0.8.4-1 on CRAN: https://cran.r-project.org/package=udpipe) makes sure default models which are used are the ones trained on version 2.5 of universal dependencies. Other features of the release are detailed in the NEWS item. This is what dependency parsing looks like on some sample text.

library(udpipe)
x <- udpipe("The package provides a dependency parsers built on data from universaldependencies.org", "english")
View(x)
library(ggraph)
library(ggplot2)
library(igraph)
library(textplot)
plt <- textplot_dependencyparser(x, size = 4, title = "udpipe R package - dependency parsing")
plt

During the years, the toolkit has now also incorporated many functionalities for commonly used data manipulations on texts which are enriched with the output of the parser.  Namely functionalities and algorithms for collocations, token co-occurrence, document term matrix handling, term frequency inverse document frequency calculations,  information retrieval metrics, handling of multi-word expressions, keyword detection (Rapid Automatic Keyword Extraction, noun phrase extraction, syntactical patterns) sentiment scoring and semantic similarity analysis.

Many add-on R packages

The udpipe package is loosely coupled with other NLP R packages which BNOSAC released in the last 4 years on CRAN. Loosely coupled means that none of the packages have hard dependencies of one another making it easy to install and maintain and allowing you to use only the packages and tools that you want.

Hereby a small list of loosely coupled packages by BNOSAC which contain functions and documentation where the udpipe package is used as a preprocessing step.

- BTM: Biterm Topic Modelling
- crfsuite: Build named entity recognition models using conditional random fields
- nametagger: Build named entity recognition models using markov models
- torch.ner: Named Entity Recognition using torch
- word2vec: Training and applying the word2vec algorithm
- ruimtehol: Text embedding techniques using Starspace
- textrank: Text summarisation and keyword detection using textrank
- brown: Brown word clustering on texts
- sentencepiece: Byte Pair Encoding and Unigram tokenisation using sentencepiece
- tokenizers.bpe: Byte Pair Encoding tokenisation using YouTokenToMe
- text.alignment: Find text similarities using Smith-Waterman
- textplot: Visualise complex relations in texts

Model building example

To showcase the loose integration, let's use the udpipe package alongside the word2vec package to build a udpipe model by ourselves on the German GSD treebank which is described at https://universaldependencies.org/treebanks/de_gsd/index.html and contains a set of CC BY-SA licensed annotated texts from news articles, wiki entries and reviews.
More information at https://universaldependencies.org.

Download the treebank.

library(utils)
settings <- list()
settings$ud.train    <- "https://raw.githubusercontent.com/UniversalDependencies/UD_German-GSD/r2.6/de_gsd-ud-train.conllu"
settings$ud.dev      <- "https://raw.githubusercontent.com/UniversalDependencies/UD_German-GSD/r2.6/de_gsd-ud-dev.conllu"
settings$ud.test     <- "https://raw.githubusercontent.com/UniversalDependencies/UD_German-GSD/r2.6/de_gsd-ud-test.conllu"
## Download the conllu files
download.file(url = settings$ud.train, destfile = "train.conllu")
download.file(url = settings$ud.dev,   destfile = "dev.conllu")
download.file(url = settings$ud.test,  destfile = "test.conllu")

Build a word2vec model using out R package word2vec

• Create wordvectors on the downloaded training dataset as these are used for training the dependency parser
• Save the word vectors to disk
• Inspect a bit the word2vec model by showing similarities to some German words

library(udpipe)
library(word2vec)
txt <- udpipe_read_conllu("train.conllu")
txt <- paste.data.frame(txt, term = "token", group = c("doc_id", "paragraph_id", "sentence_id"), collapse = " ")
txt <- txt$token
w2v <- word2vec(txt, type = "skip-gram", dim = 50, window = 10, min_count = 2, negative = 5, iter = 15, threads = 1)
write.word2vec(w2v, file = "wordvectors.vec", type = "txt", encoding = "UTF-8")
predict(w2v, c("gut", "freundlich"), type = "nearest", top = 20)

And train the model

• Using the hyperparameters for the tokeniser, parts of speech tagger & lemmatizer and the dependency parser as shown here: https://github.com/bnosac/udpipe/tree/master/inst/models-ud-2.5
• Note that model training takes a while (8hours up to 3days) depending on the size of the treebank and your hyperparameter settings. This example was run on a Windows i5 CPU laptop with 1.7Ghz, so no GPU needed, which makes this model building process still accessible for anyone with a simple PC.

print(Sys.time())
m <- udpipe_train(file = "de_gsd-ud-2.6-20200924.udpipe", 
                  files_conllu_training = "train.conllu", 
                  files_conllu_holdout  = "dev.conllu",
                  annotation_tokenizer = list(dimension = 64, epochs = 100, segment_size=200, initialization_range = 0.1, 
                                              batch_size = 50, learning_rate = 0.002, learning_rate_final=0, dropout = 0.1, 
                                              early_stopping = 1),
                  annotation_tagger = list(models = 2, 
                                           templates_1 = "lemmatizer", 
                                           guesser_suffix_rules_1 = 8, guesser_enrich_dictionary_1 = 4, 
                                           guesser_prefixes_max_1 = 4, 
                                           use_lemma_1 = 1,provide_lemma_1 = 1, use_xpostag_1 = 0, provide_xpostag_1 = 0, 
                                           use_feats_1 = 0, provide_feats_1 = 0, prune_features_1 = 1, 
                                           templates_2 = "tagger", 
                                           guesser_suffix_rules_2 = 8, guesser_enrich_dictionary_2 = 4, 
                                           guesser_prefixes_max_2 = 0, 
                                           use_lemma_2 = 1, provide_lemma_2 = 0, use_xpostag_2 = 1, provide_xpostag_2 = 1, 
                                           use_feats_2 = 1, provide_feats_2 = 1, prune_features_2 = 1),
                  annotation_parser = list(iterations = 30, 
                                           embedding_upostag = 20, embedding_feats = 20, embedding_xpostag = 0, 
                                           embedding_form = 50, embedding_form_file = "wordvectors.vec", 
                                           embedding_lemma = 0, embedding_deprel = 20, learning_rate = 0.01, 
                                           learning_rate_final = 0.001, l2 = 0.5, hidden_layer = 200, 
                                           batch_size = 10, transition_system = "projective", transition_oracle = "dynamic", 
                                           structured_interval = 8))
print(Sys.time())

You can see the logs of this run here. Now your model is ready, you can use it on your own terms and you can start using it to annotate your text.

model <- udpipe_load_model("de_gsd-ud-2.6-20200924.udpipe")
texts <- data.frame(doc_id = c("doc1", "doc2"), text = c("Die Wissenschaft ist das beste, was wir haben.", "Von dort war Kraftstoff in das Erdreich gesickert."), stringsAsFactors = FALSE)
anno  <- udpipe(texts, model, trace = 10)
View(anno)

Enjoy!

Thanks to Slav Petrov, Wolfgang Seeker, Ryan McDonald, Joakim Nivre, Daniel Zeman, Adriane Boyd for creating and distributing the UD_German-GSD treebank and to the UDPipe authors in particular Milan Straka.

Have you always wanted to be able to draw like you are in art school? Let me show how to quickly do this.

If you want to reproduce this, the following snippets show how. Steps are as follows

1. Install the packages from CRAN

install.packages("image.ContourDetector")
install.packages("magick")
install.packages("sp")

2. Get an image, put it into grey scale, pass the pixels to the function an off you go.

library(magick)
library(image.ContourDetector)
library(sp)
img <- image_read("https://cdn.mos.cms.futurecdn.net/9sUwFGNJvviJks7jNQ7AWc-1200-80.jpg")
mat <- image_data(img, channels = "gray")
mat <- as.integer(mat, transpose = TRUE)
mat <- drop(mat)
contourlines <- image_contour_detector(mat)
plt <- plot(contourlines)
class(plt)

3. If you want to have the same image as shown at the top of the article:

Put the 3 images (original, combined, contour lines only) together in 1 plot using the excellent magick R package:

plt <- image_graph(width = image_info(img)$width, height = image_info(img)$height)
plot(contourlines)
dev.off()

plt_combined <- image_graph(width = image_info(img)$width, height = image_info(img)$height)
plot(img)
plot(contourlines, add = TRUE, col = "red", lwd = 5)
dev.off()

combi <- image_append(c(img, plt_combined, plt))
combi
image_write(combi, "example-contourlines.png", format = "png")

You can view the presentation below.

NEW, since 2020, you can now access courses Text Mining with R and Advanced R programming online through our online school, let us know here if you want to obtain access.

{aridoc engine="pdfjs" width="100%" height="550"}images/bnosac/blog/R_word2vec.pdf{/aridoc}

• In case you are reading this at a blog aggregator, head to https://www.bnosac.be/index.php/blog/100-word2vec-in-R directly to see the presentation.
• If you are reading this, you might as well be interested in applying doc2vec: head to http://www.bnosac.be/index.php/blog/103-doc2vec-in-r for details.

Enjoy.

• text cooccurences
• text clusters (in casu biterm clusters)
• dependency parsing results
• text correlations and text frequencies

Some examples of these plots are shown in the gif.

More details can be found in the pdf presentation shown below.

{aridoc engine="pdfjs" width="100%" height="550"}images/bnosac/blog/textplot-examples.pdf{/aridoc}

Enjoy.

Biterm Topic Models are especially usefull if you want to find topics in collections of short texts. Short texts are typically a twitter message, a short answer on a survey, the title of an email, search questions, ... . For these types of short texts traditional topic models like Latent Dirichlet Allocation are less suited as most information is available in short word combinations. The R package BTM finds topics in such short texts by explicitely modelling word-word co-occurrences (biterms) in a short window.

The update which was pushed to CRAN a few weeks ago now allows to explicitely provide a set of biterms to cluster upon. Let us show an example on clustering a subset of R package descriptions on CRAN. The resulting cluster visualisation looks like this.

If you want to reproduce this, the following snippets show how to do this. Steps are as follows

1. Get some data of R packages and their description in plain text

## Get list of packages in the NLP/Machine Learning Task Views
library(ctv)
pkgs <- available.views()
names(pkgs) <- sapply(pkgs, FUN=function(x) x$name)
pkgs <- c(pkgs$NaturalLanguageProcessing$packagelist$name, pkgs$MachineLearning$packagelist$name)

## Get package descriptions of these packages
library(tools)
x <- CRAN_package_db()
x <- x[, c("Package", "Title", "Description")]
x$doc_id <- x$Package
x$text   <- tolower(paste(x$Title, x$Description, sep = "\n"))
x$text   <- gsub("'", "", x$text)
x$text   <- gsub("<.+>", "", x$text)
x        <- subset(x, Package %in% pkgs)

2. Use the udpipe R package to perform Parts of Speech tagging on the package title and descriptions and use udpipe as well for extracting cooccurrences of nouns, adjectives and verbs within 3 words distance.

library(udpipe)
library(data.table)
library(stopwords)
anno    <- udpipe(x, "english", trace = 10)
biterms <- as.data.table(anno)
biterms <- biterms[, cooccurrence(x = lemma,
                                  relevant = upos %in% c("NOUN", "ADJ", "VERB") & 
                                             nchar(lemma) > 2 & !lemma %in% stopwords("en"),
                                  skipgram = 3),
                   by = list(doc_id)]

3. Build the biterm topic model with 9 topics and provide the set of biterms to cluster upon

library(BTM)
set.seed(123456)
traindata <- subset(anno, upos %in% c("NOUN", "ADJ", "VERB") & !lemma %in% stopwords("en") & nchar(lemma) > 2)
traindata <- traindata[, c("doc_id", "lemma")]
model     <- BTM(traindata, biterms = biterms, k = 9, iter = 2000, background = TRUE, trace = 100)

4. Visualise the biterm topic clusters using the textplot package available at https://github.com/bnosac/textplot. This creates the plot show above.

library(textplot)
library(ggraph)
plot(model, top_n = 10,
     title = "BTM model", subtitle = "R packages in the NLP/Machine Learning task views",
     labels = c("Garbage", "Neural Nets / Deep Learning", "Topic modelling", 
                "Regression/Classification Trees/Forests", "Gradient Descent/Boosting", 
                "GLM/GAM/Penalised Models", "NLP / Tokenisation",
                "Text Mining Frameworks / API's", "Variable Selection in High Dimensions"))

Enjoy!

• As a Belgian, I was interested to see how Corona might impact our lives in the next weeks and out of curiosity I was interested to see how we are doing compared to other countries regarding containment of the Corona virus outspread - especially since we still do not have a government in Belgium after elections 1 year ago. 
• In what follows, I'll be showing some graphs using data available at https://github.com/CSSEGISandData/COVID-19 (it provides up-to-date statistics on Corona cases). If you want to reproduce this, pull the repository and just execute the following R code shown.

Data

Let's see first if the data is exactly what is shown at our National Television.

library(data.table)
library(lattice)
x <- list.files("csse_covid_19_data/csse_covid_19_daily_reports/", pattern = ".csv", full.names = TRUE)
x <- data.frame(file = x, date = substr(basename(x), 1, 10), stringsAsFactors = FALSE)
x <- split(x$file, x$date)
x <- lapply(x, fread)
x <- rbindlist(x, fill = TRUE, idcol = "date")
x$date <- as.Date(x$date, format = "%m-%d-%Y")
x <- setnames(x, 
              old = c("date", "Country/Region", "Province/State", "Confirmed", "Deaths", "Recovered"),
              new = c("date", "region", "subregion", "confirmed", "death", "recovered"))
x <- subset(x, subregion %in% "Hubei" | 
               region %in% c("Belgium", "France", "Netherlands", "Spain", "Singapore", "Germany", "Switzerland", "Italy"))
x$area <- ifelse(x$subregion %in% "Hubei", x$subregion, x$region)
x <- x[!duplicated(x, by = c("date", "area")), ]
x <- x[, c("date", "area", "confirmed", "death", "recovered")]
subset(x, area %in% "Belgium" & confirmed > 1)

Yes, the data from https://github.com/CSSEGISandData/COVID-19  looks correct indeed. Same numbers as reported on the Belgian Television. 

Exponential number of cases of Corona

• Now is the outbreak really exponential? Let's make some graphs.

What is clear when looking at the plots is that indeed infections happen at a exponential scale except in Singapore where the government managed to completely isolate the Corona cases, while in Belgium and other European countries the government lacked the opportunity to isolate the Corona cases and we are now in a phase of trying to slow down to reduce and spread the impact.

You can reproduce the plot as follows

trellis.par.set(strip.background = list(col = "lightgrey"))
xyplot(confirmed ~ date | area, data = x, type = "b", pch = 20, 
       scales = list(y = list(relation = "free", rot = 0), x = list(rot = 45, format = "%A %d/%m")), 
       layout = c(5, 2), main = sprintf("Confirmed cases of Corona\n(last date in this graph is %s)", max(x$date)))

Compare to other countries - onset

It is clear that the onset of Corona is different in each country. Let's define the onset (day 0) as the day where 75 persons had Corona in the country. That will allow us to compare different countries. In Belgium we started to have more than 75 patients with Corona on Friday 2020-03-06.  In the Netherlands that was one day earlier. 

Reproduce as follows:

x <- x[order(x$date, x$area, decreasing = TRUE), ]
x <- x[, days_since_case_onset := as.integer(date - min(date[confirmed > 75])), by = list(area)]
x <- x[, newly_confirmed := as.integer(confirmed - shift(confirmed, n = 1, type = "lead")), by = list(area)]
onset <- subset(x, days_since_case_onset == 0, select = c("date", "area", "confirmed"))
onset[order(onset$date), ]

Compare to other countries - what can we expect?

• Now are we doing better than other countries in the EU?

Following plot shows the log of the number of people diagnosed as having Corona since the onset date shown above. It looks like Belgium has learned a bit from the issues in Italy but it still hasn't learned the way to deal with the virus outbreak the same as e.g. Singapore has done (a country which learned from the SARS outbreak).

Based on the blue line, we can expect Belgium to have next week between roughly 1100 confirmed cases (log(1100)=7) or if we follow the trend of France that would be roughly 3000 (log(3000)=8) patients with Corona. We hope that it is only the first.

Reproduce as follows:

xyplot(log(confirmed) ~ days_since_case_onset | "Log(confirmed cases) of Corona since onset of sick person nr 75", 
 groups = area,
 data = subset(x, days_since_case_onset >= 0 & 
                  area %in% c("Hubei", "France", "Belgium", "Singapore", "Netherlands", "Italy")), 
 xlab = "Days since Corona onset (confirmed case 75)", ylab = "Log of number of confirmed cases",
 auto.key = list(space = "right", lines = TRUE),
 type = "b", pch = 20, lwd = 2) 

Compared to the Netherlands

• Now, are we doing better than The Netherlands?

Currently it looks like we are. But time will tell. Given the trend shown above, I can only hope everyone in Belgium follows the government guidelines as strict as possible.

Reproduce as follows:

xyplot(newly_confirmed ~ date | "Newly confirmed cases of Corona", groups = area,
 data = subset(x, area %in% c("Belgium", "Netherlands") & date > as.Date("2020-03-01")), 
 xlab = "Date", ylab = "Number of new Corona cases",
 scales = list(x = list(rot = 45, format = "%A %d/%m", at = seq(as.Date("2020-03-01"), Sys.Date(), by = "day"))), 
 auto.key = list(space = "right", lines = TRUE),
 type = "b", pch = 20, lwd = 2)