#source("http://bioconductor.org/biocLite.R")
#biocLite()
#biocLite("EBImage")

Yo elegí una libreria indie para manejar imagenes. Pero para que se puedan ver en el reporte uso “pixmap”.

library(EBImage)

## Loading required package: abind

library(pixmap)

cargamos la imagen

edgar<-readImage("/home/fou/Desktop/9/Multivariado/edgarin.jpg")
edgar

## Image
##   colormode: Color 
##   storage.mode: double 
##   dim: 2240 1344 3 
##   nb.total.frames: 3 
##   nb.render.frames: 1 
## 
## imageData(object)[1:5,1:6,1]:
##           [,1]      [,2]      [,3]      [,4]      [,5]      [,6]
## [1,] 0.9411765 0.9372549 0.9372549 0.9372549 0.9333333 0.9294118
## [2,] 0.9411765 0.9372549 0.9372549 0.9372549 0.9294118 0.9254902
## [3,] 0.9372549 0.9372549 0.9333333 0.9294118 0.9254902 0.9215686
## [4,] 0.9333333 0.9333333 0.9294118 0.9254902 0.9215686 0.9137255
## [5,] 0.9294118 0.9294118 0.9254902 0.9215686 0.9176471 0.9137255

#display(edgar)
plot(pixmapRGB(edgar))

vemos que es una arreglo tridimensional y la pasamos a escala de grises

pic<-as.matrix(edgar[,,1])
head(pic)

## Image
##   colormode: Color 
##   storage.mode: double 
##   dim: 6 1 
##   nb.total.frames: 1 
##   nb.render.frames: 1 
## 
## imageData(object)[1:5,1:1]:
## [1] 0.9411765 0.9411765 0.9372549 0.9333333 0.9294118

colorMode(edgar)<-Grayscale
#display(edgar)
plot(pixmapGrey(edgar))

nos quedamos con la primer capa

library(amap)
m1<-pca(pic)

veamos la gráfica codo

screeplot(m1)

plot(log(1:length(m1$eig),base=1.3),m1$eig/sum(m1$eig),type="o",col="purple",xlab="# componente",ylab="% var de la componente")

plot(log(1:length(m1$eig),base=1.3),cumsum(m1$eig)/sum(m1$eig),type="b",col="blue",xlab="# componente",ylab="% var explicado")

según con treinta componentes basta

componentes<-m1$loadings[,1:30]
compress<-as.Image(pic%*%componentes)

veamos la imagen compresa

compress

## Image
##   colormode: Grayscale 
##   storage.mode: double 
##   dim: 2240 30 
##   nb.total.frames: 1 
##   nb.render.frames: 1 
## 
## imageData(object)[1:5,1:6]:
##          [,1]     [,2]      [,3]      [,4]      [,5]      [,6]
## [1,] 18.37649 26.86229 0.5016189 -2.638858 -2.443864 -2.771095
## [2,] 18.37085 26.86746 0.4979342 -2.630319 -2.446255 -2.789739
## [3,] 18.36403 26.86616 0.4845997 -2.633758 -2.446896 -2.784664
## [4,] 18.36530 26.86135 0.4875076 -2.635166 -2.443909 -2.791641
## [5,] 18.35426 26.84697 0.5033636 -2.629238 -2.453972 -2.804934

#display(compress)
plot(pixmapGrey(compress))

no se ve nada! y la descomprimimos

descompress<-as.Image(compress%*%t(componentes))
#display(descompress)
plot(pixmapGrey(descompress))

A pesar de que Edgar no luce tan bien en esta foto, como usualmente se ve, sólo usamos 30 componentes, es menos del \(\frac{1344*30+2240*30}{1344*2240} \sim 4\)% del espacio de almacenamiento original de la foto.

Repitamos la compresión de la imagen pero con 85 componentes para utilizar un espacio de memoria aproximado del \(\frac{1344*85+2240*85}{1344*2240} \sim 10\)% original

componentes<-m1$loadings[,1:85]
compress<-as.Image(pic%*%componentes)

veamos la imagen compresa

compress

## Image
##   colormode: Grayscale 
##   storage.mode: double 
##   dim: 2240 85 
##   nb.total.frames: 1 
##   nb.render.frames: 1 
## 
## imageData(object)[1:5,1:6]:
##          [,1]     [,2]      [,3]      [,4]      [,5]      [,6]
## [1,] 18.37649 26.86229 0.5016189 -2.638858 -2.443864 -2.771095
## [2,] 18.37085 26.86746 0.4979342 -2.630319 -2.446255 -2.789739
## [3,] 18.36403 26.86616 0.4845997 -2.633758 -2.446896 -2.784664
## [4,] 18.36530 26.86135 0.4875076 -2.635166 -2.443909 -2.791641
## [5,] 18.35426 26.84697 0.5033636 -2.629238 -2.453972 -2.804934

#display(compress)
plot(pixmapGrey(compress))

y la descomprimimos

descompress<-as.Image(compress%*%t(componentes))
#display(descompress)
plot(pixmapGrey(descompress))

Y la calidad es buena considerando que se ahorro 90% de espacio en memoria.

Repitamos la compresión de la imagen pero con 300 componentes para utilizar un espacio de memoria aproximado del \(\frac{1344*300+2240*300}{1344*2240}\sim 36\)% original

componentes<-m1$loadings[,1:300]
compress<-as.Image(pic%*%componentes)

veamos la imagen compresa

compress

## Image
##   colormode: Grayscale 
##   storage.mode: double 
##   dim: 2240 300 
##   nb.total.frames: 1 
##   nb.render.frames: 1 
## 
## imageData(object)[1:5,1:6]:
##          [,1]     [,2]      [,3]      [,4]      [,5]      [,6]
## [1,] 18.37649 26.86229 0.5016189 -2.638858 -2.443864 -2.771095
## [2,] 18.37085 26.86746 0.4979342 -2.630319 -2.446255 -2.789739
## [3,] 18.36403 26.86616 0.4845997 -2.633758 -2.446896 -2.784664
## [4,] 18.36530 26.86135 0.4875076 -2.635166 -2.443909 -2.791641
## [5,] 18.35426 26.84697 0.5033636 -2.629238 -2.453972 -2.804934

#display(compress)
plot(pixmapGrey(compress))

y la descomprimimos

descompress<-as.Image(compress%*%t(componentes))
#display(descompress)
plot(pixmapGrey(descompress))

Que se ve mucho mejor