16 min read

Cluster analysis and image size reduction

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()
color_part y X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 X16 X17 X18 X19 X20 X21 X22 X23 X24 X25 X26 X27 X28 X29 X30 X31 X32 X33 X34 X35 X36 X37 X38 X39 X40 X41 X42 X43 X44 X45 X46 X47 X48 X49 X50 X51 X52 X53 X54 X55 X56 X57 X58 X59 X60 X61 X62 X63 X64 X65 X66 X67 X68 X69 X70 X71 X72 X73 X74 X75 X76 X77 X78 X79 X80 X81 X82 X83 X84 X85 X86 X87 X88 X89 X90 X91 X92 X93 X94 X95 X96 X97 X98 X99 X100 X101 X102 X103 X104 X105 X106 X107 X108 X109 X110 X111 X112 X113 X114 X115 X116 X117 X118 X119 X120 X121 X122 X123 X124 X125 X126 X127 X128 X129 X130 X131 X132 X133 X134 X135 X136 X137 X138 X139 X140 X141 X142 X143 X144 X145 X146 X147 X148 X149 X150 X151 X152 X153 X154 X155 X156 X157 X158 X159 X160 X161 X162 X163 X164 X165 X166 X167 X168 X169 X170 X171 X172 X173 X174 X175 X176 X177 X178 X179 X180 X181 X182 X183 X184 X185 X186 X187 X188 X189 X190 X191 X192 X193 X194 X195 X196 X197 X198 X199 X200 X201 X202 X203 X204 X205 X206 X207 X208 X209 X210 X211 X212 X213 X214 X215 X216 X217 X218 X219 X220 X221 X222 X223 X224 X225 X226 X227 X228 X229 X230 X231 X232 X233 X234 X235 X236 X237 X238 X239 X240 X241 X242 X243 X244 X245 X246 X247 X248 X249 X250 X251 X252 X253 X254 X255 X256 X257 X258 X259 X260 X261 X262 X263 X264 X265 X266 X267 X268 X269 X270 X271 X272 X273 X274 X275 X276 X277 X278 X279 X280 X281 X282 X283 X284 X285 X286 X287 X288 X289 X290 X291 X292 X293 X294 X295 X296 X297 X298 X299 X300 X301 X302 X303 X304 X305 X306 X307 X308 X309 X310 X311 X312 X313 X314 X315 X316 X317 X318 X319 X320
r 213 0.3176471 0.3215686 0.3254902 0.3254902 0.3215686 0.3215686 0.3254902 0.3294118 0.3411765 0.3450980 0.3529412 0.3607843 0.3647059 0.3686275 0.3764706 0.3843137 0.3803922 0.3843137 0.3882353 0.3921569 0.3960784 0.3960784 0.3921569 0.3803922 0.3882353 0.3882353 0.3843137 0.3764706 0.3725490 0.3686275 0.3686275 0.3647059 0.3686275 0.3686275 0.3686275 0.3607843 0.3607843 0.3607843 0.3607843 0.3607843 0.3568627 0.3529412 0.3568627 0.3529412 0.3529412 0.3529412 0.3568627 0.3607843 0.3803922 0.3960784 0.4039216 0.4039216 0.4078431 0.4156863 0.4196078 0.4156863 0.4235294 0.4196078 0.4117647 0.4117647 0.4156863 0.4235294 0.4235294 0.4235294 0.4117647 0.4078431 0.4039216 0.4039216 0.4156863 0.4235294 0.4313725 0.4313725 0.4352941 0.4313725 0.4274510 0.4274510 0.4235294 0.4156863 0.4078431 0.4117647 0.4117647 0.4117647 0.4117647 0.4117647 0.4156863 0.4196078 0.4274510 0.4313725 0.4313725 0.4313725 0.4313725 0.4313725 0.4431373 0.4470588 0.4509804 0.4509804 0.4509804 0.4549020 0.4549020 0.4588235 0.4588235 0.4666667 0.4745098 0.4823529 0.4862745 0.4941176 0.5058824 0.5176471 0.5215686 0.5254902 0.5215686 0.5215686 0.5294118 0.5333333 0.5333333 0.5333333 0.5294118 0.5254902 0.5215686 0.5176471 0.5215686 0.5215686 0.5215686 0.5215686 0.5215686 0.5215686 0.5215686 0.5215686 0.4980392 0.4941176 0.4901961 0.4862745 0.4823529 0.4823529 0.4823529 0.4823529 0.4784314 0.4784314 0.4784314 0.4901961 0.4901961 0.4901961 0.4941176 0.4941176 0.4901961 0.4980392 0.5019608 0.5058824 0.5058824 0.5019608 0.5019608 0.4980392 0.5058824 0.5098039 0.5058824 0.5058824 0.5019608 0.4980392 0.4980392 0.4980392 0.4941176 0.4941176 0.4941176 0.4941176 0.4941176 0.4941176 0.4980392 0.4980392 0.4901961 0.4901961 0.4901961 0.4941176 0.4941176 0.4941176 0.4941176 0.4941176 0.4980392 0.5058824 0.5098039 0.5098039 0.5098039 0.5137255 0.5215686 0.5254902 0.5254902 0.5372549 0.5450980 0.5450980 0.5450980 0.5411765 0.5450980 0.5450980 0.5529412 0.5490196 0.5450980 0.5490196 0.5490196 0.5490196 0.5529412 0.5568627 0.5529412 0.5607843 0.5607843 0.5607843 0.5568627 0.5568627 0.5529412 0.5529412 0.5450980 0.5450980 0.5411765 0.5372549 0.5372549 0.5333333 0.5294118 0.5333333 0.5294118 0.5254902 0.5254902 0.5215686 0.5215686 0.5215686 0.5215686 0.5215686 0.5254902 0.5176471 0.5137255 0.5058824 0.4980392 0.4862745 0.4862745 0.4823529 0.4705882 0.4745098 0.4745098 0.4784314 0.4862745 0.4901961 0.4901961 0.4941176 0.4862745 0.4901961 0.4901961 0.4941176 0.4941176 0.5019608 0.5058824 0.5058824 0.5058824 0.5058824 0.5098039 0.5176471 0.5215686 0.5215686 0.5254902 0.5294118 0.5215686 0.5215686 0.5215686 0.5215686 0.5215686 0.5254902 0.5254902 0.5254902 0.5294118 0.5294118 0.5294118 0.5372549 0.5372549 0.5333333 0.5333333 0.5294118 0.5333333 0.5333333 0.5294118 0.5254902 0.5215686 0.5176471 0.5137255 0.5137255 0.5058824 0.5058824 0.5058824 0.5058824 0.5058824 0.5058824 0.5058824 0.5058824 0.5098039 0.5098039 0.5058824 0.5019608 0.5019608 0.5019608 0.5019608 0.5098039 0.5176471 0.5176471 0.5215686 0.5215686 0.5254902 0.5254902 0.5254902 0.5254902 0.5294118 0.5254902 0.5215686 0.5137255 0.5098039 0.5058824 0.5019608 0.5019608 0.4941176 0.4980392 0.4980392 0.4980392 0.4941176 0.4941176 0.4901961 0.4901961
r 212 0.3176471 0.3215686 0.3215686 0.3215686 0.3215686 0.3215686 0.3294118 0.3333333 0.3450980 0.3490196 0.3568627 0.3647059 0.3686275 0.3725490 0.3803922 0.3882353 0.3843137 0.3843137 0.3882353 0.3921569 0.3960784 0.3960784 0.3960784 0.3843137 0.3921569 0.3921569 0.3882353 0.3803922 0.3764706 0.3725490 0.3686275 0.3686275 0.3803922 0.3803922 0.3686275 0.3686275 0.3686275 0.3686275 0.3686275 0.3686275 0.3647059 0.3607843 0.3647059 0.3607843 0.3607843 0.3607843 0.3647059 0.3725490 0.3921569 0.4039216 0.4156863 0.4156863 0.4196078 0.4274510 0.4313725 0.4313725 0.4235294 0.4196078 0.4196078 0.4196078 0.4235294 0.4274510 0.4274510 0.4235294 0.4117647 0.4078431 0.4078431 0.4078431 0.4196078 0.4274510 0.4313725 0.4313725 0.4392157 0.4352941 0.4313725 0.4352941 0.4274510 0.4196078 0.4117647 0.4156863 0.4156863 0.4156863 0.4156863 0.4196078 0.4196078 0.4274510 0.4352941 0.4352941 0.4392157 0.4392157 0.4392157 0.4431373 0.4549020 0.4588235 0.4627451 0.4627451 0.4549020 0.4588235 0.4627451 0.4666667 0.4705882 0.4745098 0.4823529 0.4901961 0.4980392 0.5019608 0.5137255 0.5215686 0.5294118 0.5294118 0.5294118 0.5254902 0.5411765 0.5411765 0.5450980 0.5450980 0.5411765 0.5372549 0.5294118 0.5294118 0.5254902 0.5254902 0.5215686 0.5215686 0.5215686 0.5215686 0.5215686 0.5176471 0.4980392 0.4941176 0.4901961 0.4862745 0.4823529 0.4862745 0.4862745 0.4862745 0.4823529 0.4823529 0.4823529 0.4941176 0.4941176 0.4980392 0.4980392 0.4980392 0.4980392 0.4980392 0.5058824 0.5098039 0.5098039 0.5098039 0.5098039 0.5058824 0.5098039 0.5137255 0.5137255 0.5098039 0.5058824 0.5058824 0.5019608 0.5019608 0.4980392 0.4980392 0.4980392 0.5019608 0.5019608 0.5019608 0.5019608 0.5019608 0.4941176 0.4941176 0.4980392 0.4980392 0.5019608 0.5019608 0.5019608 0.5058824 0.5058824 0.5098039 0.5176471 0.5176471 0.5176471 0.5215686 0.5254902 0.5333333 0.5294118 0.5450980 0.5490196 0.5490196 0.5490196 0.5490196 0.5490196 0.5529412 0.5568627 0.5529412 0.5529412 0.5529412 0.5529412 0.5568627 0.5568627 0.5607843 0.5568627 0.5568627 0.5686275 0.5647059 0.5647059 0.5607843 0.5607843 0.5568627 0.5607843 0.5607843 0.5607843 0.5568627 0.5529412 0.5490196 0.5490196 0.5490196 0.5372549 0.5333333 0.5333333 0.5294118 0.5294118 0.5254902 0.5294118 0.5254902 0.5294118 0.5215686 0.5176471 0.5098039 0.5058824 0.4941176 0.4901961 0.4862745 0.4784314 0.4784314 0.4784314 0.4823529 0.4862745 0.4901961 0.4901961 0.4941176 0.4862745 0.4862745 0.4901961 0.4941176 0.4941176 0.5019608 0.5058824 0.5058824 0.5058824 0.5058824 0.5058824 0.5176471 0.5176471 0.5215686 0.5254902 0.5254902 0.5254902 0.5254902 0.5254902 0.5294118 0.5294118 0.5333333 0.5333333 0.5333333 0.5372549 0.5372549 0.5372549 0.5450980 0.5450980 0.5411765 0.5372549 0.5372549 0.5411765 0.5372549 0.5372549 0.5333333 0.5294118 0.5254902 0.5215686 0.5215686 0.5176471 0.5176471 0.5176471 0.5176471 0.5176471 0.5176471 0.5176471 0.5176471 0.5254902 0.5215686 0.5215686 0.5176471 0.5176471 0.5176471 0.5176471 0.5254902 0.5254902 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118 0.5333333 0.5333333 0.5294118 0.5254902 0.5215686 0.5176471 0.5098039 0.5058824 0.5058824 0.5058824 0.5019608 0.5019608 0.5019608 0.5019608 0.5019608 0.5019608 0.4980392 0.4980392
r 211 0.3137255 0.3137255 0.3137255 0.3137255 0.3137255 0.3176471 0.3254902 0.3333333 0.3411765 0.3490196 0.3568627 0.3607843 0.3647059 0.3686275 0.3764706 0.3843137 0.3882353 0.3882353 0.3921569 0.3921569 0.3960784 0.4000000 0.3921569 0.3921569 0.4000000 0.3960784 0.3921569 0.3882353 0.3803922 0.3803922 0.3764706 0.3725490 0.3764706 0.3764706 0.3764706 0.3764706 0.3764706 0.3725490 0.3725490 0.3725490 0.3686275 0.3725490 0.3725490 0.3725490 0.3725490 0.3725490 0.3803922 0.3843137 0.4039216 0.4156863 0.4274510 0.4274510 0.4313725 0.4392157 0.4392157 0.4352941 0.4274510 0.4274510 0.4274510 0.4274510 0.4235294 0.4235294 0.4235294 0.4196078 0.4117647 0.4078431 0.4117647 0.4117647 0.4235294 0.4313725 0.4313725 0.4313725 0.4431373 0.4352941 0.4313725 0.4352941 0.4313725 0.4274510 0.4196078 0.4235294 0.4235294 0.4235294 0.4235294 0.4235294 0.4274510 0.4313725 0.4392157 0.4431373 0.4431373 0.4431373 0.4470588 0.4470588 0.4549020 0.4666667 0.4705882 0.4745098 0.4627451 0.4666667 0.4745098 0.4784314 0.4823529 0.4901961 0.4980392 0.5058824 0.5098039 0.5137255 0.5215686 0.5294118 0.5372549 0.5372549 0.5372549 0.5333333 0.5490196 0.5490196 0.5490196 0.5490196 0.5490196 0.5450980 0.5411765 0.5372549 0.5294118 0.5254902 0.5254902 0.5254902 0.5215686 0.5176471 0.5176471 0.5176471 0.5019608 0.4980392 0.4941176 0.4901961 0.4862745 0.4901961 0.4901961 0.4901961 0.4862745 0.4862745 0.4901961 0.4980392 0.4980392 0.5019608 0.5019608 0.5019608 0.5019608 0.5058824 0.5137255 0.5176471 0.5215686 0.5215686 0.5176471 0.5176471 0.5176471 0.5215686 0.5176471 0.5176471 0.5137255 0.5137255 0.5098039 0.5098039 0.5019608 0.5019608 0.5058824 0.5058824 0.5098039 0.5098039 0.5137255 0.5137255 0.5019608 0.5019608 0.5058824 0.5058824 0.5098039 0.5137255 0.5176471 0.5176471 0.5176471 0.5215686 0.5294118 0.5294118 0.5294118 0.5333333 0.5372549 0.5411765 0.5372549 0.5490196 0.5529412 0.5568627 0.5529412 0.5529412 0.5568627 0.5568627 0.5607843 0.5607843 0.5568627 0.5568627 0.5607843 0.5607843 0.5647059 0.5647059 0.5647059 0.5686275 0.5686275 0.5764706 0.5725490 0.5725490 0.5686275 0.5647059 0.5647059 0.5647059 0.5607843 0.5568627 0.5568627 0.5529412 0.5490196 0.5490196 0.5450980 0.5450980 0.5411765 0.5411765 0.5372549 0.5372549 0.5333333 0.5333333 0.5333333 0.5294118 0.5254902 0.5176471 0.5137255 0.5019608 0.4980392 0.4901961 0.4823529 0.4823529 0.4823529 0.4862745 0.4901961 0.4901961 0.4901961 0.4901961 0.4862745 0.4862745 0.4901961 0.4901961 0.4941176 0.5019608 0.5058824 0.5058824 0.5058824 0.5058824 0.5058824 0.5137255 0.5137255 0.5176471 0.5215686 0.5215686 0.5294118 0.5294118 0.5333333 0.5333333 0.5333333 0.5411765 0.5411765 0.5411765 0.5450980 0.5450980 0.5450980 0.5529412 0.5490196 0.5490196 0.5450980 0.5450980 0.5490196 0.5450980 0.5450980 0.5411765 0.5372549 0.5333333 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118 0.5372549 0.5333333 0.5333333 0.5294118 0.5294118 0.5294118 0.5333333 0.5333333 0.5372549 0.5372549 0.5411765 0.5411765 0.5411765 0.5411765 0.5372549 0.5372549 0.5333333 0.5294118 0.5254902 0.5215686 0.5137255 0.5137255 0.5098039 0.5098039 0.5098039 0.5098039 0.5137255 0.5137255 0.5137255 0.5098039 0.5098039 0.5058824
r 210 0.3176471 0.3176471 0.3176471 0.3137255 0.3137255 0.3215686 0.3333333 0.3411765 0.3490196 0.3568627 0.3607843 0.3686275 0.3686275 0.3764706 0.3803922 0.3882353 0.3921569 0.3921569 0.3921569 0.3960784 0.3882353 0.3921569 0.3960784 0.4000000 0.4039216 0.4039216 0.3960784 0.3921569 0.3882353 0.3843137 0.3803922 0.3803922 0.3803922 0.3803922 0.3803922 0.3803922 0.3764706 0.3764706 0.3764706 0.3725490 0.3803922 0.3803922 0.3843137 0.3843137 0.3843137 0.3843137 0.3882353 0.3921569 0.4000000 0.4117647 0.4235294 0.4235294 0.4274510 0.4352941 0.4392157 0.4352941 0.4235294 0.4235294 0.4235294 0.4274510 0.4274510 0.4274510 0.4235294 0.4196078 0.4117647 0.4117647 0.4156863 0.4156863 0.4274510 0.4313725 0.4274510 0.4274510 0.4431373 0.4313725 0.4313725 0.4352941 0.4352941 0.4313725 0.4235294 0.4235294 0.4274510 0.4274510 0.4274510 0.4274510 0.4313725 0.4352941 0.4392157 0.4470588 0.4392157 0.4431373 0.4431373 0.4470588 0.4549020 0.4588235 0.4745098 0.4784314 0.4705882 0.4745098 0.4823529 0.4901961 0.4941176 0.4980392 0.5098039 0.5137255 0.5176471 0.5215686 0.5294118 0.5333333 0.5372549 0.5411765 0.5372549 0.5372549 0.5450980 0.5450980 0.5490196 0.5490196 0.5490196 0.5450980 0.5411765 0.5372549 0.5333333 0.5333333 0.5294118 0.5254902 0.5215686 0.5215686 0.5176471 0.5176471 0.5058824 0.5019608 0.4980392 0.4941176 0.4941176 0.4941176 0.4941176 0.4941176 0.4901961 0.4901961 0.4941176 0.5019608 0.5058824 0.5058824 0.5058824 0.5058824 0.5098039 0.5098039 0.5176471 0.5254902 0.5294118 0.5294118 0.5254902 0.5254902 0.5254902 0.5215686 0.5254902 0.5215686 0.5215686 0.5176471 0.5176471 0.5137255 0.5058824 0.5058824 0.5098039 0.5137255 0.5137255 0.5176471 0.5176471 0.5215686 0.5098039 0.5098039 0.5137255 0.5137255 0.5176471 0.5215686 0.5215686 0.5215686 0.5254902 0.5294118 0.5333333 0.5411765 0.5411765 0.5411765 0.5450980 0.5450980 0.5411765 0.5450980 0.5568627 0.5607843 0.5568627 0.5568627 0.5607843 0.5607843 0.5647059 0.5647059 0.5647059 0.5607843 0.5607843 0.5647059 0.5686275 0.5686275 0.5725490 0.5725490 0.5725490 0.5725490 0.5803922 0.5764706 0.5725490 0.5725490 0.5568627 0.5607843 0.5607843 0.5568627 0.5529412 0.5490196 0.5490196 0.5450980 0.5490196 0.5529412 0.5490196 0.5490196 0.5450980 0.5450980 0.5411765 0.5411765 0.5372549 0.5372549 0.5333333 0.5254902 0.5215686 0.5058824 0.5019608 0.4941176 0.4862745 0.4862745 0.4862745 0.4862745 0.4901961 0.4901961 0.4862745 0.4862745 0.4862745 0.4862745 0.4901961 0.4941176 0.4980392 0.5019608 0.5058824 0.5098039 0.5098039 0.5098039 0.5058824 0.5137255 0.5137255 0.5176471 0.5176471 0.5215686 0.5333333 0.5333333 0.5333333 0.5372549 0.5372549 0.5450980 0.5450980 0.5450980 0.5490196 0.5490196 0.5490196 0.5568627 0.5568627 0.5529412 0.5490196 0.5490196 0.5529412 0.5529412 0.5490196 0.5450980 0.5411765 0.5372549 0.5333333 0.5333333 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118 0.5254902 0.5333333 0.5333333 0.5294118 0.5294118 0.5333333 0.5333333 0.5333333 0.5411765 0.5450980 0.5450980 0.5490196 0.5490196 0.5450980 0.5450980 0.5411765 0.5372549 0.5333333 0.5294118 0.5254902 0.5215686 0.5176471 0.5176471 0.5176471 0.5176471 0.5176471 0.5176471 0.5215686 0.5215686 0.5176471 0.5176471 0.5176471
r 209 0.3176471 0.3176471 0.3176471 0.3176471 0.3215686 0.3294118 0.3411765 0.3529412 0.3568627 0.3647059 0.3686275 0.3725490 0.3764706 0.3764706 0.3843137 0.3882353 0.3843137 0.3843137 0.3843137 0.3882353 0.3921569 0.3960784 0.4000000 0.4000000 0.4078431 0.4000000 0.4000000 0.3960784 0.3921569 0.3921569 0.3882353 0.3882353 0.3882353 0.3882353 0.3882353 0.3882353 0.3843137 0.3843137 0.3803922 0.3803922 0.3843137 0.3882353 0.3921569 0.3921569 0.3882353 0.3882353 0.3960784 0.4000000 0.4039216 0.4156863 0.4235294 0.4274510 0.4196078 0.4274510 0.4313725 0.4274510 0.4274510 0.4274510 0.4235294 0.4235294 0.4274510 0.4235294 0.4196078 0.4117647 0.4078431 0.4156863 0.4117647 0.4156863 0.4274510 0.4313725 0.4235294 0.4235294 0.4352941 0.4235294 0.4235294 0.4313725 0.4352941 0.4313725 0.4274510 0.4196078 0.4274510 0.4274510 0.4274510 0.4313725 0.4352941 0.4392157 0.4431373 0.4431373 0.4431373 0.4431373 0.4470588 0.4509804 0.4588235 0.4627451 0.4705882 0.4745098 0.4745098 0.4784314 0.4901961 0.4941176 0.5019608 0.5058824 0.5137255 0.5215686 0.5254902 0.5294118 0.5333333 0.5372549 0.5411765 0.5411765 0.5411765 0.5372549 0.5450980 0.5490196 0.5490196 0.5490196 0.5490196 0.5450980 0.5411765 0.5372549 0.5372549 0.5372549 0.5333333 0.5294118 0.5254902 0.5254902 0.5215686 0.5176471 0.5098039 0.5058824 0.5019608 0.4980392 0.4980392 0.5019608 0.5019608 0.5019608 0.4941176 0.4941176 0.4980392 0.5058824 0.5098039 0.5098039 0.5098039 0.5098039 0.5137255 0.5176471 0.5215686 0.5254902 0.5333333 0.5333333 0.5333333 0.5333333 0.5294118 0.5254902 0.5254902 0.5254902 0.5254902 0.5215686 0.5215686 0.5176471 0.5098039 0.5137255 0.5137255 0.5176471 0.5176471 0.5215686 0.5254902 0.5254902 0.5176471 0.5176471 0.5176471 0.5215686 0.5215686 0.5215686 0.5215686 0.5215686 0.5294118 0.5372549 0.5411765 0.5450980 0.5450980 0.5450980 0.5490196 0.5490196 0.5450980 0.5490196 0.5529412 0.5647059 0.5607843 0.5607843 0.5607843 0.5647059 0.5647059 0.5647059 0.5647059 0.5686275 0.5686275 0.5647059 0.5647059 0.5686275 0.5764706 0.5764706 0.5764706 0.5764706 0.5725490 0.5725490 0.5686275 0.5725490 0.5647059 0.5647059 0.5607843 0.5607843 0.5647059 0.5607843 0.5607843 0.5568627 0.5529412 0.5529412 0.5568627 0.5529412 0.5490196 0.5490196 0.5450980 0.5450980 0.5411765 0.5411765 0.5333333 0.5294118 0.5176471 0.5098039 0.5019608 0.4980392 0.4901961 0.4901961 0.4862745 0.4862745 0.4901961 0.4862745 0.4862745 0.4862745 0.4862745 0.4862745 0.4901961 0.4941176 0.4980392 0.5058824 0.5098039 0.5098039 0.5137255 0.5137255 0.5098039 0.5176471 0.5176471 0.5215686 0.5215686 0.5215686 0.5372549 0.5372549 0.5372549 0.5411765 0.5411765 0.5490196 0.5490196 0.5490196 0.5529412 0.5529412 0.5529412 0.5607843 0.5568627 0.5529412 0.5490196 0.5490196 0.5529412 0.5529412 0.5490196 0.5450980 0.5411765 0.5372549 0.5372549 0.5333333 0.5333333 0.5333333 0.5333333 0.5333333 0.5333333 0.5333333 0.5333333 0.5333333 0.5254902 0.5254902 0.5215686 0.5215686 0.5294118 0.5294118 0.5333333 0.5333333 0.5411765 0.5411765 0.5490196 0.5490196 0.5490196 0.5490196 0.5450980 0.5450980 0.5372549 0.5372549 0.5294118 0.5254902 0.5215686 0.5215686 0.5176471 0.5176471 0.5176471 0.5215686 0.5215686 0.5215686 0.5215686 0.5215686 0.5215686 0.5176471
r 208 0.3176471 0.3176471 0.3215686 0.3215686 0.3254902 0.3333333 0.3450980 0.3568627 0.3607843 0.3647059 0.3686275 0.3725490 0.3725490 0.3764706 0.3803922 0.3843137 0.3803922 0.3843137 0.3882353 0.3921569 0.3921569 0.3960784 0.4000000 0.3960784 0.4039216 0.4000000 0.4000000 0.4000000 0.3960784 0.3960784 0.3960784 0.3921569 0.3960784 0.3960784 0.3960784 0.4000000 0.3960784 0.3960784 0.3960784 0.3960784 0.3921569 0.3960784 0.3921569 0.3921569 0.3921569 0.3960784 0.4039216 0.4078431 0.4078431 0.4196078 0.4274510 0.4274510 0.4313725 0.4352941 0.4392157 0.4313725 0.4313725 0.4274510 0.4274510 0.4274510 0.4274510 0.4196078 0.4117647 0.4078431 0.4117647 0.4156863 0.4117647 0.4156863 0.4235294 0.4235294 0.4196078 0.4156863 0.4274510 0.4156863 0.4156863 0.4274510 0.4352941 0.4352941 0.4313725 0.4235294 0.4313725 0.4313725 0.4313725 0.4352941 0.4392157 0.4431373 0.4470588 0.4470588 0.4470588 0.4549020 0.4549020 0.4627451 0.4666667 0.4745098 0.4784314 0.4823529 0.4784314 0.4862745 0.4941176 0.5019608 0.5098039 0.5137255 0.5215686 0.5254902 0.5333333 0.5333333 0.5372549 0.5372549 0.5411765 0.5411765 0.5411765 0.5411765 0.5490196 0.5529412 0.5529412 0.5568627 0.5568627 0.5529412 0.5490196 0.5450980 0.5411765 0.5411765 0.5372549 0.5372549 0.5333333 0.5294118 0.5254902 0.5254902 0.5098039 0.5098039 0.5058824 0.5058824 0.5019608 0.5058824 0.5058824 0.5058824 0.5019608 0.5019608 0.5058824 0.5137255 0.5137255 0.5176471 0.5176471 0.5176471 0.5215686 0.5254902 0.5294118 0.5333333 0.5372549 0.5372549 0.5372549 0.5372549 0.5333333 0.5333333 0.5294118 0.5294118 0.5294118 0.5294118 0.5254902 0.5254902 0.5176471 0.5176471 0.5215686 0.5215686 0.5254902 0.5254902 0.5294118 0.5294118 0.5254902 0.5254902 0.5254902 0.5254902 0.5254902 0.5254902 0.5254902 0.5254902 0.5372549 0.5411765 0.5490196 0.5490196 0.5490196 0.5490196 0.5529412 0.5529412 0.5490196 0.5529412 0.5568627 0.5607843 0.5647059 0.5647059 0.5647059 0.5686275 0.5607843 0.5607843 0.5725490 0.5725490 0.5725490 0.5725490 0.5686275 0.5686275 0.5725490 0.5764706 0.5764706 0.5764706 0.5764706 0.5725490 0.5725490 0.5686275 0.5725490 0.5725490 0.5686275 0.5686275 0.5647059 0.5607843 0.5686275 0.5647059 0.5607843 0.5568627 0.5568627 0.5529412 0.5568627 0.5529412 0.5529412 0.5490196 0.5450980 0.5411765 0.5411765 0.5372549 0.5254902 0.5176471 0.5058824 0.4980392 0.4941176 0.4941176 0.4901961 0.4901961 0.4941176 0.4901961 0.4901961 0.4901961 0.4901961 0.4901961 0.4941176 0.4980392 0.5019608 0.5098039 0.5137255 0.5176471 0.5176471 0.5176471 0.5137255 0.5215686 0.5254902 0.5254902 0.5294118 0.5294118 0.5411765 0.5411765 0.5411765 0.5450980 0.5450980 0.5490196 0.5529412 0.5529412 0.5568627 0.5568627 0.5568627 0.5607843 0.5568627 0.5529412 0.5490196 0.5490196 0.5490196 0.5490196 0.5450980 0.5411765 0.5372549 0.5333333 0.5294118 0.5294118 0.5333333 0.5333333 0.5333333 0.5333333 0.5333333 0.5333333 0.5333333 0.5333333 0.5294118 0.5254902 0.5254902 0.5254902 0.5254902 0.5294118 0.5372549 0.5372549 0.5372549 0.5411765 0.5411765 0.5450980 0.5490196 0.5490196 0.5490196 0.5490196 0.5411765 0.5411765 0.5372549 0.5333333 0.5294118 0.5254902 0.5254902 0.5254902 0.5254902 0.5254902 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118 0.5294118

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")