Maëlle Salmon

In this new post, we're taking a break from modern birding data in
[ourbirder's series](/tags/birder)... let's exploregorgeous drawings
from a natural history collection! Armed withrOpenSci's packages binding
powerful C++ libraries and open taxonomydata, how much information can
we automatically extract from images?Maybe not much, but we'll at least
have explored image manipulation,optical character recognition (OCR),
language detection, taxonomic nameresolution with rOpenSci's packages.

## Free natural history images and appropriate R tooling!

A long time ago I had bookmarked the [Flickr account of the
BiodiversityHeritage Library
(BHL)](https://www.flickr.com/people/biodivlibrary/).So many beautiful
images of biodiversity, moreover free to use! Inparticular, I
[downloaded all pictures from one of the Birds
ofAustraliaalbums](https://www.flickr.com/photos/biodivlibrary/sets/72157694191194992).

I wanted to try to extract the bird names from images using packages
ofJeroen Ooms', rOpenSci's post-doc hacker & C(++)-bindings wizard.
Forthat I worked with [`magick`](https://github.com/ropensci/magick)
forimage manipulation,
[`tesseract`](https://github.com/ropensci/tesseract)for optical
character recognition
(OCR),[`cld2`](https://github.com/ropensci/cld2)/[`cld3`](https://github.com/ropensci/cld3)for
language detection... Quite the armory! We'll also sprinkle sometaxonomy
magic by Scott Chamberlain, one of rOpenSci's co-founders, toresolve the
names extracted.

## OCR bird naming workflow, piece by piece

In this section, we explain the different elements of our R
workflow:preparing images, extracting text, resolving taxonomic names.

### Image preparation

I saved the pictures locally in a "birds" folder. Yes, I
click-buttonedinstead of using [the Flickr
API](https://www.flickr.com/services/api/)for which e.g. Jim Hester
wrote a [minimal Rwrapper](https://github.com/jimhester/flickrr)... I
don't do *everything*with R scripts (yet).

::: {.highlight}
``` {.chroma tabindex="0"}
library("magrittr")filenames <- fs::dir_ls("birds")
```
:::

Each image shows a bird and its name. Images are either landscape-
orportrait-oriented, but for the sake of simplicity, I'll act as if
theywere all portrait-oriented. *A possible easy and lazy fix here would
beto duplicate images rotated (`magick::image_rotate`) in all
possibledirections and then to apply the workflow to all 4 versions of
eachimage, hoping to get good data from one of the rotated versions.*

::: {.highlight}
``` {.chroma tabindex="0"}
magick::image_read(filenames[1])
```
:::

<figure>
<img src="/img/blog-images/2018-08-28-birds-ocr/unnamed-chunk-2-1.png"
width="1376" />
</figure>

From that image, I wanted to extract the name indicated below the
bird.To maximize the efficiency of OCR, I shall first prepare the
image,since the [accuracy of OCR depends on the quality of the
inputimage](https://cran.r-project.org/web/packages/tesseract/vignettes/intro.html#preprocessing_with_magick)which
can be influenced a bit. This part could be tweaked even more, andin
real life examples it'll be worth spending time trying different`magick`
functions and parameter values. Since I have in mind the caseof a bunch
of images to be batch-processed, nothing is done by hand.

::: {.highlight}
``` {.chroma tabindex="0"}
crop_bird <- function(filename){  image <- magick::image_read(filename)    height <- magick::image_info(image)$height    # crop the top of the image  image <- magick::image_crop(image,                      paste0("+0+",round(0.75*height))) %>%    # convert the image to black and white    magick::image_convert(type = "grayscale") %>%    # increase brightness    magick::image_modulate(brightness = 120) %>%    magick::image_enhance() %>%    magick::image_median() %>%    magick::image_contrast()     # we'll need the filename later  attr(image, "filename") <- filename    return(image)}crop_bird(filenames[1])
```
:::

<figure>
<img src="/img/blog-images/2018-08-28-birds-ocr/unnamed-chunk-3-1.png"
width="1376" />
</figure>

It does look cleaner now!

### Text extraction

Now is the actual OCR step! The `tesseract` package provides bindings
tothe [Tesseract
OCRengine](https://en.wikipedia.org/wiki/Tesseract_(software)),
freesoftware currently sponsored by Google. It is a powerful engine,
with aton of parameters. Here again, tweaking a lot is warranted.
Particularlyuseful reads are
[`tesseract`vignette](https://cran.r-project.org/web/packages/tesseract/vignettes/intro.html)and
this [Wiki page of Tesseract about improving the quality of
theoutput](https://github.com/tesseract-ocr/tesseract/wiki/ImproveQuality).The
[`hocr` package](https://github.com/dmi3kno/hocr) might be ofinterest
for post-processing of OCR results.

Below, the only option changed from default is the [page
segmentationmode](https://github.com/tesseract-ocr/tesseract/wiki/ImproveQuality#page-segmentation-method)choosing
1 for "Automatic page segmentation with Orientation and scriptdetection
(OSD)". When using Latin instead of English training data theresults
were not as good.

One can use either `tesseract::ocr` for a file path, url, or raw
vectorto image, or `magick::image_ocr` for a `magick` object which is
quitehandy in our pipeline.

The function below also filters results of the OCR using
languagedetection. By only keeping text recognized as either Latin or
English byone of the two language detection packages `cld2` and `cld3`
that areinterfaces to Google compact language detectors 2 and 3, one
gets afirst quality filter. If not doing that, the output would contain
moreunusable text.

::: {.highlight}
``` {.chroma tabindex="0"}
get_names <- function(image){  filename <- attr(image, "filename")  ocr_options <- list(tessedit_pageseg_mode = 1)     text <- magick::image_ocr(image, options = ocr_options)  text <- stringr::str_split(text, "\n", simplify = TRUE)  text <- stringr::str_remove_all(text, "[0-9]")  text <- stringr::str_remove_all(text, "[:punct:]")  text <- trimws(text)  text <- stringr::str_remove_all(text, "~")  text <- text[text != ""]  text <- tolower(text)    # remove one letter words  # https://stackoverflow.com/questions/31203843/r-find-and-remove-all-one-to-two-letter-words  text <- stringr::str_remove_all(text, " *\\b[[:alpha:]]{1,2}\\b *")  text <- text[text != ""]    # keep only the words that are recognized as either Latin  # or English by cld2 or cld3  if(length(text) > 0){    results <- tibble::tibble(text = text,                 cld2 = cld2::detect_language(text),                 cld3 = cld3::detect_language(text),                 filename = filename)    results[results $cld2 %in% c("la", "en") |          results$cld3 %in% c("la", "en"),]  }else{    return(NULL)  }    }(results1 <- filenames[1] %>%  magick::image_read() %>%  get_names())
```
:::

    ## NULL

Nothing! Now if we replace `magick::image_read` with the
previouslydefined `crop_bird` function that crops and cleans the
image...

::: {.highlight}
``` {.chroma tabindex="0"}
(results2 <- filenames[1] %>%  crop_bird() %>%  get_names())
```
:::

    ## # A tibble: 2 x 4##   text                 cld2  cld3  filename                          ##   <chr>                <chr> <chr> <chr>                             ## 1 climacteris picumnus <NA>  la    birds/n115_w1150_42399797481_o.jpg## 2 brown tree creeper   en    <NA>  birds/n115_w1150_42399797481_o.jpg

We get a result! So we see that the image transformation was
quiteuseful.

Now, these names look fine, but how to be sure they're actuallytaxonomic
names?

### Taxonomic name resolution

The [`taxize` package](https://github.com/ropensci/taxize/) by
ScottChamberlain, is a taxonomic toolbelt for R, providing access to
manyfantastic data sources and tools for taxonomy. One of them, the
GlobalName Resolver, provides, well, resolution of taxonomic names,
sadly notcommon names. `taxize::gnr_resolve` has many options, of which
only oneis used below: `best_match_only = TRUE` means it'll only return
the bestmatch from the different data sources.

::: {.highlight}
``` {.chroma tabindex="0"}
latin <- results2$text[results2$cld2 == "la"|                         results2$cld3 == "la"]taxize::gnr_resolve(latin,  best_match_only = TRUE)
```
:::

    ## # A tibble: 1 x 5##   user_supplied_name submitted_name  matched_name   data_source_tit~ score## * <chr>              <chr>           <chr>          <chr>            <dbl>## 1 climacteris picum~ Climacteris pi~ Climacteris p~ NCBI             0.988

English names could be cleaned up a bit using the
[`spelling`package](https://github.com/ropensci/spelling), also an
rOpenScipackage, since `spelling::spell_check_text` would output
possible typos.

## OCR bird naming workflow in action!

First the two steps image processing and OCR are applied to all images.

::: {.highlight}
``` {.chroma tabindex="0"}
bird_names <- purrr::map(filenames, crop_bird) %>%  purrr::map_df(get_names)
```
:::

Out of 51 images only 17 are present in the final table with
possiblenames which is a bit disheartening, but one could surely do
better inthe image processing and OCR tweaking steps! Maybe one could
frame theparameter search [as a machine
learningproblem](https://twitter.com/dmi3k/status/1024919690768990209).
Pleasealso keep in mind that such natural history images are quite hard
toparse.

The name resolution information can be added to this table.

::: {.highlight}
``` {.chroma tabindex="0"}
safe_resolve <- function(text){    results <- taxize::gnr_resolve(text,                                 best_match_only = TRUE)    if(nrow(results) == 0){    list(NULL)  }else{    list(results)  }}bird_names <- dplyr::group_by(bird_names, text) %>%  dplyr::mutate(gnr = ifelse(cld2 == "la" | cld3 == "la",                             safe_resolve(text),                             list(NULL)))
```
:::

We do not get much resolution, but we knew the names weren't very goodto
start with. A better (untested here!) idea here might be to get afull
list of names of Australian birds, potentially leveraging [the`taxizedb`
package by ScottChamberlain](https://github.com/ropensci/taxizedb), and
to thenfuzzy-match them with the names we have.

::: {.highlight}
``` {.chroma tabindex="0"}
unique(bird_names$gnr)
```
:::

    ## [[1]]## # A tibble: 1 x 5##   user_supplied_name submitted_name  matched_name   data_source_tit~ score## * <chr>              <chr>           <chr>          <chr>            <dbl>## 1 climacteris picum~ Climacteris pi~ Climacteris p~ NCBI             0.988## ## [[2]]## [1] NA## ## [[3]]## NULL## ## [[4]]## # A tibble: 1 x 5##   user_supplied_na~ submitted_name  matched_name  data_source_title  score## * <chr>             <chr>           <chr>         <chr>              <dbl>## 1 austrodicaeum ii~ Austrodicaeum ~ Austrodicaeu~ The Interim Regis~  0.75## ## [[5]]## # A tibble: 1 x 5##   user_supplied_name submitted_name  matched_name   data_source_tit~ score## * <chr>              <chr>           <chr>          <chr>            <dbl>## 1 melithreptus laet~ Melithreptus l~ Melithreptus ~ CU*STAR          0.988## ## [[6]]## # A tibble: 1 x 5##   user_supplied_na~ submitted_name matched_name  data_source_title   score## * <chr>             <chr>          <chr>         <chr>               <dbl>## 1 rad isdlvorniode  Rad isdlvorni~ Rad Baker & ~ The Interim Regist~  0.75

## Conclusion

### rOpenSci packages supporting this (and your) workflow

In this post, we made use of R packages quite useful to
wrangleinformation from diverse formats:

- [`magick`](https://github.com/ropensci/magick) for imagemanipulation,

- [`tesseract`](https://github.com/ropensci/tesseract) for
  opticalcharacter recognition (OCR),

- [`cld2`](https://github.com/ropensci/cld2)/[`cld3`](https://github.com/ropensci/cld3)for
  language detection.

We also used [a function
from`taxize`](https://github.com/ropensci/taxize) allowing us to use
[theGlobal Name Resolver](https://resolver.globalnames.org/about).
Discovermore packages from our suite [here](/packages/).

### Applicability of this OCR bird naming workflow

Actually, the BHL itself provides OCR output for its collection,
see[thisexample](https://www.biodiversitylibrary.org/item/250938#page/37/mode/1up).I
wasn't able to find information about the software powering this
OCR.What I *was* able to find out is that the BHL uses
[purposefulgaming](https://biodivlib.wikispaces.com/Purposeful+Gaming)
in [its
OCRworkflow](https://biodivlib.wikispaces.com/file/view/Workflowdiagram.pdf).The
raw OCR results aren't much better than what we got in this postwhich is
comforting.

### More data from the Biodiversity Heritage Library

If you're interested in other types of data from the BHL, in addition
tothe images, have a look at the
[`rbhl`paclage](https://github.com/ropensci/rbhl), part of rOpenSci's
suite,that interacts with the BHL API. One can e.g. search all books by
thesame author as the one we used images from.

::: {.highlight}
``` {.chroma tabindex="0"}
author <- rbhl::bhl_authorsearch("Gregory M Mathews")books <- rbhl::bhl_getauthortitles(creatorid = author$CreatorID)head(books$FullTitle)
```
:::

    ## [1] "A manual of the birds of Australia,"                                                                                                                                                                                                                                          ## [2] "A list of the birds of the Phillipian sub-region : which do not occur in Australia. "                                                                                                                                                                                         ## [3] "A manual of the birds of Australia /"                                                                                                                                                                                                                                         ## [4] "A list of the birds of Australia : containing the names and synonyms connected with each genus, species, and subspecies of birds found in Australia, at present known to the author /"                                                                                        ## [5] "Austral avian record; a scientific journal devoted primarily to the study of the Australian avifauna."                                                                                                                                                                        ## [6] "Arcana, or, The museum of natural history : containing the most recent discovered objects : embellished with coloured plates, and corresponding descriptions : with extracts relating to animals, and remarks of celebrated travellers; combining a general survey of nature."

Or we could get all books whose title contains the words "birds"
and"australia".

::: {.highlight}
``` {.chroma tabindex="0"}
australia_birds <- rbhl::bhl_booksearch(title = "birds Australia")head(australia_birds$FullTitle)
```
:::

    ## [1] "Handbook to the birds of Australia. : [Supplementary material in Charles Darwin's copy]."## [2] "An introduction to The birds of Australia /"                                             ## [3] "The useful birds of southern Australia : with notes on other birds /"                    ## [4] "The Birds of Australia"                                                                  ## [5] "The birds of Australia,"                                                                 ## [6] "The birds of Australia,"

And to get the OCR results of the pages of the book we used, we
couldwrite:

::: {.highlight}
``` {.chroma tabindex="0"}
library("magrittr")# ocr=TRUE to extract OCR for all pagesrbhl::bhl_getitempages("250938", ocr = TRUE) %>%  # for each page transform the type into a string  dplyr::group_by(PageUrl) %>%  dplyr::mutate(page_type = toString(PageTypes[[1]])) %>%  # keep only the illustration pages  # that are like the ones we used   dplyr::filter(page_type == "Illustration") %>%  # from the data.frame extract the OCR  dplyr::pull(OcrText) %>%  head()
```
:::

    ## [1] "491 \nFAL CUNCULUS LEUCOGASTER. \n( WHITE -BELLIED £ If BIKE - TIT) \nFALCUNCULUS FRONTATUS. \nSHRIKE - TIT). \n"                                                                                                                   ## [2] "492 \nA** \nOREOICA GUTTURALIS. \n(CRESTED BELL-BIRD). \n"                                                                                                                                                                          ## [3] "APHELOCEPHALA LEUCOPSIS \n( WHITE FACE ). \n"                                                                                                                                                                                       ## [4] "* \nAPHELOCEPHALA PE CTORALIS. \n(CHE <3 TNUT -BREASTED WHITEFA CEj. \nAPHELOCEPHALA NIGRICINCTA. \n(BE A CK-BAH.DED WHITE FA CEj. \n"                                                                                              ## [5] "H . Gronvold. del. \nWitherLy & C° \nSPHENOSTOMA CRIS TATUM \n(WEDGE BIEL). \n"                                                                                                                                                     ## [6] "49 6 \nH \n(jronvolcl. del. \nN E O SIT TA LE CJ C O CE PHAI.A. \n( WHITE ¦ HE AID EE THE EH UN HE FL). \nNEOSHTA ALBATA \n(F IE E> T Ft E EE UNNEFlj. \nNEOSITTA CHRYSOPTERA \nf OFi. A. NGE - wing-e d tree runner). \nWitWLjA \n"

So there's quite a lot to explore!

### More birding soon!

Stay tuned for the next post in this series, about getting and usingbird
taxonomic and trait data in R! In the meantime, happy birding!


In this new post, we’re taking a break from modern birding data in ourbirder’s series… let’s exploregorgeous drawings from a natural history collection!

Messaggi di Rogue Scholar

What's this bird? Classify old natural history drawings with R