Idea

This post is a remake of this casestudy: https://fallstudien.netlify.com/fallstudie_bildanalyse/bildanalyse

brought to you by Karsten Lübke.

The main purpose is to replace the base R command that Karsten used with a more tidyverse-friendly style. I think that’s easier (for me).

We will compute a cluster analysis to find the typical RGB color per cluster.

WARNING

There’s still a bug in the code. That’s why the image at the end appear blurred. I suspect that rows and columns need to be transposed.

Load packages

library(tidyverse)

Setup

library(jpeg)
library(scales)
library(mosaic)
library(tidyverse)
library(knitr)

Get iris photo

Download a photo of a iris, such as this one: https://commons.wikimedia.org/wiki/File:Blood_iris.jpg

iris_url <- "https://upload.wikimedia.org/wikipedia/commons/thumb/b/b0/Blood_iris.jpg/320px-Blood_iris.jpg"
iris_path <- paste0(here::here(),"/static/img/iris.jpg")
img <- download.file(url = iris_url, destfile = iris_path)

Read the image:

img <- readJPEG(iris_path)

knitr::include_graphics("/img/iris.jpg")

What are the dimensions?

dimension <- dim(img)  # 1: rows, 2: cols, 3: layers
dimension
#> [1] 213 320   3

Note that the first dimension indicate rows, second the columns, and third the RGB value.

Note that we have a 3D data cube.

Reshape to data frame (2D)

In order to work with the data, better transform to a 2D variant.

That’s how it should like like after pivoting to the long form:

Note that we have a 3D data cube.

img_df <-map_df(1:3, ~ bind_rows(data.frame(img[,, .])))
dim(img_df)
#> [1] 639 320

Now the rows is 3 times the original numbers of rows, as we have now a long-format data frame.

We need to note that the first 213 rows are the “r” color part, the next the “g” part, and the last ones the “b” part:

img_df <- img_df %>% 
  mutate(color_part = rep(c("r", "g", "b"), 
                          each = dimension[1]),  # nr of rows
         y = rep(dimension[1]:1, times = dimension[3]))  # nr of rgb parts

dim(img_df)
#> [1] 639 322

Move the interesting columns to the front:

img_df <- img_df %>% select(color_part, y, everything())

img_df %>% head() %>% 
  kable()

Check

tally(~ color_part, data = img_df)
#> color_part
#>   b   g   r 
#> 213 213 213

tally(~ y, data = img_df) %>% all(. == 3)
#> [1] TRUE

Reshape to long format

The long format is the standard for many operations, such as the cluster analysis. So, let’s reshape:

Pivot to long format

img_df_long <- img_df %>% 
  pivot_longer(cols = -c(color_part, y),
               names_to = "x",
               values_to = "value")

dim(img_df_long)
#> [1] 204480      4

The number of rows of this data frame should be the product of

• the number of rows by
• the number of columns by
• the number of color parts (ie., rgb)

of the original data frame. Let’s check:

nrow(img_df_long) == dimension[1] * dimension[2] * dimension[3]
#> [1] TRUE

OK.

head(img_df_long)
#> # A tibble: 6 x 4
#>   color_part     y x     value
#>   <chr>      <int> <chr> <dbl>
#> 1 r            213 X1    0.318
#> 2 r            213 X2    0.322
#> 3 r            213 X3    0.325
#> 4 r            213 X4    0.325
#> 5 r            213 X5    0.322
#> 6 r            213 X6    0.322

Transfer col_nr values to pure numbers:

img_df_long2 <- img_df_long %>% 
  mutate(x = parse_number(x))
head(img_df_long2)
#> # A tibble: 6 x 4
#>   color_part     y     x value
#>   <chr>      <int> <dbl> <dbl>
#> 1 r            213     1 0.318
#> 2 r            213     2 0.322
#> 3 r            213     3 0.325
#> 4 r            213     4 0.325
#> 5 r            213     5 0.322
#> 6 r            213     6 0.322

Checks

summarise(img_df_long2, n_distinct(x))
#> # A tibble: 1 x 1
#>   `n_distinct(x)`
#>             <int>
#> 1             320
summarise(img_df_long2, n_distinct(y))
#> # A tibble: 1 x 1
#>   `n_distinct(y)`
#>             <int>
#> 1             213
summarise(img_df_long2, n_distinct(color_part))
#> # A tibble: 1 x 1
#>   `n_distinct(color_part)`
#>                      <int>
#> 1                        3

Check:

count(img_df_long2, color_part)
#> # A tibble: 3 x 2
#>   color_part     n
#>   <chr>      <int>
#> 1 b          68160
#> 2 g          68160
#> 3 r          68160

Spread RGB parts in separate columns

img_rgb <- img_df_long2 %>% 
  pivot_wider(names_from = "color_part",
              values_from = "value")

head(img_rgb)
#> # A tibble: 6 x 5
#>       y     x     r     g     b
#>   <int> <dbl> <dbl> <dbl> <dbl>
#> 1   213     1 0.318 0.333 0.278
#> 2   213     2 0.322 0.337 0.282
#> 3   213     3 0.325 0.341 0.286
#> 4   213     4 0.325 0.341 0.286
#> 5   213     5 0.322 0.337 0.282
#> 6   213     6 0.322 0.337 0.282

k-Means

We have 3 dimensions, so we would like to kind’a find a number of bee swarms in a room. Let’s take 16 clusters.

set.seed(1896)
k_means <- kmeans(img_rgb[,c("r","g","b")], centers = 16, 
                  iter.max = 25, nstart = 10)

Here are the colors:

k_means$centers %>%
  rgb() %>%
  show_col()

Frequencies of colors

gf_col(k_means$size ~ 1:16, fill = rgb(k_means$centers))

Compress colors

Now we replace the colors of the pixels by the cluster center colors. By that, we will end up with 16 colors only, thereby compressing the image.

First, add the cluster to which each pixel belongs to the data frame:

img_rgb <- img_rgb %>% 
  mutate(cluster = k_means$cluster)

dim(img_rgb)
#> [1] 68160     6

head(img_rgb)
#> # A tibble: 6 x 6
#>       y     x     r     g     b cluster
#>   <int> <dbl> <dbl> <dbl> <dbl>   <int>
#> 1   213     1 0.318 0.333 0.278       6
#> 2   213     2 0.322 0.337 0.282       6
#> 3   213     3 0.325 0.341 0.286       6
#> 4   213     4 0.325 0.341 0.286       6
#> 5   213     5 0.322 0.337 0.282       6
#> 6   213     6 0.322 0.337 0.282       6

Extract the cluster centers with their colors:

centers_rgb <- k_means$centers %>% 
  as_tibble() %>% 
  mutate(cluster = 1:16)

Define the new image as the image where each pixel gets the color of its cluster center color:

img_new <- img_rgb %>% 
  select(x, y, cluster) %>% 
  full_join(centers_rgb) %>% 
  select(r, g, b) %>% 
  as.matrix()

Check

Let’s check that the row number remained the same:

nrow(img_new) == nrow(img_rgb)
#> [1] TRUE

Initialize 3D data cube for image

We now convert to a matrix, as we need a (3D) matrix again to write the jpg image:

img_new_array <- array(NA, dimension)
dim(img_new_array)
#> [1] 213 320   3

Write to 3D array

for(i in 1:3) img_new_array[,,i] <- matrix(img_new[,i], 
                                           nrow=dimension[1]) 

Write to file

file_output_path <- paste0(here::here(), "/static/img/iris_reduced.jpg")
writeJPEG(img_new_array, file_output_path)

knitr::include_graphics("/img/iris_reduced.jpg")