Working with Images in R

class: center, middle, inverse, title-slide

# Working with Images in R
## Institute for Geoinformatics, WWU Münster
### Jeroen Ooms
### 2018/10/16

---

# Hello World

About me: PhD Statistics UCLA 2014 (Jan de Leeuw, Mark Hansen). Currently I am postdoc at UC Berkeley with the [rOpenSci](https://ropensci.org/) group.
![team](team.png)

---
background-image: url(unconf.jpg)
background-position: 50% 50%

# The rOpenSci (extended) Family

---

# CRAN Packages

[![pkgscreen](packages2.png)](https://cran.r-project.org/web/checks/check_results_jeroen_at_berkeley.edu.html)

---
background-image: url(screen3.png)
background-position: 50% 50%

# Also this

---
class: inverse, center, middle

# Which sciences use images?

---
background-image: url(sentinel.jpg)
background-position: 50% 50%

# Sattelite Data

---
background-image: url(egypt.jpg)
background-position: 50% 50%

# Terrain
???
*The Copernicus Sentinel-2 satellite takes us over Sharm El Sheikh, Egypt.*
Source: https://www.flickr.com/photos/europeanspaceagency/28779502307/in/photostream/

---
background-image: url(denmark.jpg)
background-position: 50% 50%

# Climate
???
*Denmark scorched: With temperatures soaring and no rain to speak of, Europe is the grip of a heatwave.*
Source: https://www.flickr.com/photos/europeanspaceagency/43584747532/in/photostream/

---
background-image: url(canada.jpg)
background-position: 50% 50%

# Weather
???
Source: https://weather.gc.ca/data/satellite/goes_wcan_1070_100.jpg

---
background-image: url(mriscan.jpg)
background-position: 50% 50%

# Medical

---
background-image: url(baby2.jpg)
background-position: 50% 50%

# Ultrasound
???
*Ultrasound image of a fetus in the womb, viewed at 12 weeks of pregnancy (bidimensional-scan)*
Source: https://en.wikipedia.org/wiki/Ultrasound#/media/File:CRL_Crown_rump_lengh_12_weeks_ecografia_Dr._Wolfgang_Moroder.jpg

---
background-image: url(bacteria2.jpg)
background-position: 50% 50%

# Lab Experiments
???
Source: https://unsplash.com/photos/13UugSL9q7A

---
background-image: url(pollen.jpg)
background-position: 50% 50%

# Microscopy
???
*Pollen prepared and imaged by Louisa Howard of the E. M. Facility. These specimens have been acetolyzed to remove cytoplasm and pollenkit to reveal the intricate wall structure.*
Source: https://www.dartmouth.edu/~emlab/

---
background-image: url('monkey.jpg')
background-position: 50% 50%

# Camera Traps
???
*Forest NEWS camera trap network*
Source: https://forestsnews.cifor.org/?attachment_id=7594

---
background-image: url(hubble.jpg)
background-position: 50% 50%

# Telescope Observations
???
*This view of nearly 10,000 galaxies is the deepest visible-light image of the cosmos. Called the Hubble Ultra Deep Field, this galaxy-studded view represents a "deep" core sample of the universe, cutting across billions of light-years.*

Source: https://www.spacetelescope.org/images/heic0406a/

---
background-image: url(oldmap.jpg)
background-position: 50% 50%

# New Holland
???
*The Matthew Flinders' 1814 General Chart of Australia was the result of centuries of speculation and navigation. It was completed by Lieutenant Phillip Parker King.*

Source: http://www.abc.net.au/news/2014-03-11/record-numbers-visit-map-exhibition-at-national-library-in-canb/5312998

---
background-image: url(manuscript.jpg)
background-position: 50% 50%

# Medieval Manuscript
???
*Pseudo-Marcellus Passio Petri et Pauli in Modern Printed Edition and Weissenburg 48.*
Source: https://brandonwhawk.net/2015/04/20/ocr-and-medieval-manuscripts-establishing-a-baseline/

---
class: inverse, center, middle

# Working with images in R

---

# Some recent packages:

A selection of recent imaging packages interfacing really good libraries:

| R Package | Library / Framework | Scope                            | Maintainer
| ----------|---------------------|----------------------------------|-----------
| magick    | ImageMagick++       | All-round image editing/analysis | rOpenSci
| tesseract | Tesseract           | OCR engine                       | rOpenSci
| pdftools  | poppler             | Read/Render PDF                  | rOpenSci
| av        | ffmpeg libav        | Video                            | rOpenSci
| opencv    | OpenCV              | Vision                           | rOpenSci
| keras     | Keras / Tesseract   | Deep Learning / Vision           | RStudio
| gifski    | Rust / Gifski       | Making GIFs :)                   | Jeroen Ooms
| lime      |                     | Deep Learning Interpretation     | Thomas Lin Pedersen
| gganimate |                     | Animation based on ggplot2       | Thomas Lin Pedersen

Let's show some cool stuff.

---

# Magick

```r
img <- magick::image_read('heart.dcm')
print(image_info(img), n = 2)
```

```
# A tibble: 16 x 7
  format width height colorspace matte filesize density
  <chr>  <int>  <int> <chr>      <lgl>    <int> <chr>  
1 DCM      256    256 Gray       FALSE  1049496 72x72  
2 DCM      256    256 Gray       FALSE  1049496 72x72  
# ... with 14 more rows
```

```r
image_animate(img, fps = 10)
```

![](index_files/figure-html/unnamed-chunk-1-1.gif)

---

# Magick: annotate, compose

Magick allows for all kinds of manipulation and annnotation:

```r
# An overlay image
logo <- image_read('rlogo.png') %>% image_scale('50x50')

# Background image
magick::image_read('heart.dcm') %>%
  image_annotate("This is a heart", gravity = 'northeast',
                 color = 'white', size = 20) %>%
  image_composite(logo, offset = '+200+210') %>%
  image_animate(fps = 10)
```

![](index_files/figure-html/unnamed-chunk-2-1.gif)

---

# Magick: quantize, histogram

```r
# https://www.flickr.com/photos/europeanspaceagency/43584747532/in/photostream/
(denmark <- image_read('denmarkhq.jpg') %>%
  image_scale('x500'))
```

---

# Magick: quantize, histogram

```r
# Quantize image to 6 unique colors
quantized <- image_quantize(denmark, 6, colorspace = 'YCbCr')
quantized
```

---

# Magick: quantize, histogram

```r
library(ggplot2)

count_colors <- function(image){
  data <- image_data(image) %>%
    apply(2:3, paste, collapse= "") %>% 
    as.vector %>% table() %>%  as.data.frame() %>% 
    setNames(c("col", "freq"))
  data$col <- paste("#",data$col, sep="")
  return(data)
}

plot_hist <- function(data){
  img <- image_graph(500, 500)
  plot <- ggplot2::ggplot(data) + 
    geom_bar(aes(col, freq, fill = I(col)), stat = 'identity') +
    theme(axis.title = element_blank(), axis.text.y = element_blank(),
          axis.ticks.y = element_blank())
  print(plot)
  dev.off()
  img
}
```

---

# Magick: quantize, histogram

```r
orig1 <- image_crop(denmark, '480x500')
hist1 <- image_crop(quantized, '480x500') %>% count_colors %>% plot_hist()
image_append(c(orig1, hist1))
```

---

# Magick: quantize, histogram

```r
orig2 <- image_crop(denmark, '480x500+486')
hist2 <- image_crop(quantized, '480x500+486') %>% count_colors %>% plot_hist()
image_append(c(orig2, hist2))
```

---

# Magick: histogram, collage

```r
# devtools::install_github("ThinkR-open/collage")
library(collage)
(edzer <- image_read('edzer.jpg') %>% image_crop('350x350'))
```

---

# Magick: collage

```r
edzer %>% collage_grid()
```

---

# Magick: collage

```r
edzer %>% collage(tiles = tiles_mono(colors())) %>% image_scale('x385')
```

---

# Magick: collage

```r
edzer %>% collage(tiles = kittens) %>% image_scale('x385')
```

---

# Magick: microscopy

```r
(cells <- image_read("uv1a-bovine.jpg"))
```

??? *Bovine Pulmonary Artery Cell Nuclei*
Source: https://www.microscopyu.com/gallery-images/bovine-pulmonary-artery-cell-nuclei-3
Example by Jan Wijffels

---

# Magick: microscopy

```r
cells %>% 
  image_channel(channel = "blue") %>%
  image_morphology(method = "OpenIntensity", kernel = "ConvexHull", iterations = 10) %>%
  image_morphology(method = "Dilate", kernel = "Disk") %>%
  image_morphology(method = "Erode", kernel = "Disk") %>%
  image_fuzzycmeans() %>% image_threshold(type = "white") %>%
  image_connect() %>% image_split(keep_color = FALSE)  %>% 
  image_composite(cells, operator = "Out") %>%
  image_resize('x300') %>% image_animate(fps = 1)
```

![](index_files/figure-html/unnamed-chunk-13-1.gif)

---

# Tesseract: OCR

```r
image_read('ingredients.png')
```

---

# Tesseract: OCR

```r
image_read("ingredients.png") %>%
  image_convert(type = 'grayscale') %>%
  image_ocr() %>%
  cat()
```

```
INGREDIENTS: Enriched Wheat Flour [Flour, Ferrous Sulfate (Iron), B Vitamins (Niacin,
Thiamine Mononitrate (B1), Riboflavin (B2), Folic Acid)] Sugar, Com Syrup, Water, High
Fructose Corn Syrup, Vegetable and/or Animal Shortening (Contains one or more of:
Partially Hydrogenated Soybean, Cottonseed, or Canola Oil, Beef Fat), Dextrose,
Whole Eggs. Contains 2% or Less of: Modified Com Starch, Cellulose Gum, Whey,
Leavenings (Sodium Acid Pyrophosphate, Baking Soda, Monocalcium Phosphate), Salt
Comstarch, Cor Flour, Corn Syrup Solids, Mono- and Diglycerides, Soy Lecithin,
Polysorbate 60, Dextrin, Calcium Caseinate, Sodium Stearoy! Lactylate, Wheat Gluten,
Calcium Sulfate, Natural and Artificial Flavors, Caramel Color, Sorbic Acid (to Retain
Freshness), Color Added (Yellow 5, Red 40).
```

---

# Tesseract: real world use

```r
(camtrap <- image_read('monkey.jpg'))
```

---

# Tesseract: real world use

```r
textstrip <- camtrap %>% 
  image_crop('x12') %>%  
  image_negate()

textstrip
```

```r
textstrip %>%
  image_ocr() %>%
  cat()
```

```
2010-08-27 9:07:40 AM _M 2/3 _ © 16°C
```

---

# OpenCV: Human Detection

```r
library(opencv)
ocv_read('field.jpg')
```

---

# OpenCV: Human Detection

```r
library(opencv)
ocv_read('field.jpg') %>% ocv_hog()
```

---

# OpenCV: Face recognition

```r
ocv_read('faces1.jpg')
```

---

# OpenCV: Face recognition

```r
ocv_read('faces1.jpg') %>% ocv_face()
```

---

# OpenCV: Face recognition (sad faces)

```r
# Try with sad faces
ocv_read('faces2.jpg')
```

---

# OpenCV: Face recognition (sad faces)

```r
# Try with sad faces
ocv_read('faces2.jpg') %>% ocv_face() 
```

---

# OpenCV: Face recognition (sad faces)

```r
# Try with sad faces
ocv_read('faces2.jpg') %>% ocv_facemask()
```

---

# Keras: Classification with Deep Learning

```r
library(keras)

# Pretrained VGG16 model
model <- application_vgg16(
  weights = "imagenet",
  include_top = TRUE
)

# Convert images to Keras array
get_img <- function(x) {
  arrays <- lapply(x, function(path) {
    img <- image_load(path, target_size = c(224,224))
    x <- image_to_array(img)
    x <- array_reshape(x, c(1, dim(x)))
    x <- imagenet_preprocess_input(x)
  })
  do.call(abind::abind, c(arrays, list(along = 1)))
}
```

---
# Keras: Classification with Deep Learning

.pull-left[

```r
image_read('ijsco2.png') %>%
  image_scale('x300')
```

<img src="index_files/figure-html/unnamed-chunk-26-1.png" width="403" />
]

.pull-right[

```r
model %>%
  predict(get_img('ijsco2.png')) %>%
  imagenet_decode_predictions()
```

```
[[1]]
  class_name class_description  score
1  n02971356            carton 0.1238
2  n02123045             tabby 0.0888
3  n02123597       Siamese_cat 0.0842
4  n02124075      Egyptian_cat 0.0709
5  n04265275      space_heater 0.0608
```
]

---
# Keras: Classification with Deep Learning

.pull-left[

```r
image_read('ijsco.png') %>%
  image_scale('x300')
```

<img src="index_files/figure-html/unnamed-chunk-28-1.png" width="401" />
]

.pull-right[

```r
model %>%
  predict(get_img('ijsco.png')) %>%
  imagenet_decode_predictions()
```

```
[[1]]
  class_name class_description  score
1  n02870880          bookcase 0.7704
2  n04004767           printer 0.0453
3  n03018349     china_cabinet 0.0198
4  n02123045             tabby 0.0191
5  n03742115    medicine_chest 0.0178
```
]

---
# Keras: Classification with Deep Learning

.pull-left[

```r
image_read('stove.png') %>%
  image_scale('x300')
```

<img src="index_files/figure-html/unnamed-chunk-30-1.png" width="436" />
]

.pull-right[

```r
model %>%
  predict(get_img('stove.png')) %>%
  imagenet_decode_predictions()
```

```
[[1]]
  class_name class_description  score
1  n03297495    espresso_maker 0.5712
2  n03063689         coffeepot 0.3158
3  n04330267             stove 0.0485
4  n04254120    soap_dispenser 0.0159
5  n03733805     measuring_cup 0.0100
```
]

---
# Keras: Classification with Deep Learning

.pull-left[

```r
image_read('yawn.jpg') %>%
  image_scale('x300')
```

<img src="index_files/figure-html/unnamed-chunk-32-1.png" width="399" />
]

.pull-right[

```r
model %>%
  predict(get_img('yawn.jpg')) %>%
  imagenet_decode_predictions()
```

```
[[1]]
  class_name class_description    score
1  n02486410            baboon 0.832279
2  n02487347           macaque 0.155635
3  n02488291            langur 0.006971
4  n02486261             patas 0.004843
5  n02484975            guenon 0.000148
```
]

---
# Keras: Classification with Deep Learning

.pull-left[

```r
image_read('edzer.jpg') %>%
  image_scale('x300')
```

<img src="index_files/figure-html/unnamed-chunk-34-1.png" width="400" />
]

.pull-right[

```r
model %>%
  predict(get_img('edzer.jpg')) %>%
  imagenet_decode_predictions()
```

```
[[1]]
  class_name class_description   score
1  n04356056        sunglasses 0.75899
2  n04355933          sunglass 0.18416
3  n04584207               wig 0.01545
4  n02883205           bow_tie 0.00559
5  n07892512          red_wine 0.00362
```
]

---
# Keras: Classification with Deep Learning

.pull-left[

```r
image_read('srilanka.jpg') %>%
  image_scale('x300')
```

<img src="index_files/figure-html/unnamed-chunk-36-1.png" width="400" />
]

.pull-right[

```r
model %>%
  predict(get_img('srilanka.jpg')) %>%
  imagenet_decode_predictions()
```

```
[[1]]
  class_name class_description     score
1  n01871265            tusker 0.5108532
2  n02504458  African_elephant 0.2934831
3  n02504013   Indian_elephant 0.1954583
4  n02437312     Arabian_camel 0.0000567
5  n02408429     water_buffalo 0.0000436
```
]

---
# Lime

```r
par(mar=c(0,0,0,0))
image_read('srilanka.jpg') %>% plot()
```

![](index_files/figure-html/unnamed-chunk-38-1.png)

---
# Lime

```r
library(lime)
plot_superpixels('srilanka.jpg', colour = 'white')
```

![](index_files/figure-html/unnamed-chunk-39-1.png)

---

# Lime

```r
model_labels <- readRDS(system.file('extdata', 'imagenet_labels.rds', package = 'lime'))
explainer <- lime('srilanka.jpg', as_classifier(model, model_labels), get_img)
explanation <- explain('srilanka.jpg', explainer, n_labels = 2, n_features = 10)
plot_image_explanation(explanation)
```

![](index_files/figure-html/lime-1.png)

---

# Animated Graphics

```r
library(gganimate)
p <- ggplot(airquality, aes(Day, Temp)) + 
  geom_line(size = 2, colour = 'steelblue') + 
  transition_states(Month, 4, 1) + 
  shadow_mark(size = 1, colour = 'grey')
animate(p, fps = 25, width = 800, height = 350)
```

![](index_files/figure-html/gganimate-1.gif)

---

# AV: everything audio/video

- Generating HQ video from images
 - Screen capturing
 - Minotor / analyize video for event (e.g. camera trap, lab sample changes)
 - Analyze how some measure develops over time
 - Real-time analysis: https://github.com/ropenscilabs/opencv