Actualizado Tue May 14 09:47:36 2019

library(tidyverse)

CARGA DEL DATASET

wineq_dataset <- read_csv("data/harbetson_MF.csv")
names(wineq_dataset)[5:9]<-c("FT","AT","SPP","LPP","TT")
wineq_dataset

El dataset provisto contiene 602 registros y un total de 371 variables predictoras. Esta situación puede complicar la aplicacion de algunos algoritmos de Machine learning, es por eso que la idea es tratar primero de eliminar (si es posible) algunas variables predictoras.

Distribucion de las variables predictoras

Resulta dificil, graficar las 371 variables, por lo que se realiza un sampling solo a los efectos de la visualizacion.

wineq_dataset %>% select(1,sample(10:380,100) %>% sort()) %>% reshape2::melt(id="ID") %>%
ggplot()+
  geom_boxplot(aes(x=as.factor(variable),y=value,fill=as.factor(variable)),size=0.2)+
  geom_point(aes(x=as.factor(variable),y=value,text=ID),color='red',size=0.1)+
  theme_bw()+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  theme(legend.position = "none")
Ignoring unknown aesthetics: text

#ggplotly()

Se observan dos cosas:

  1. Hacia el final del espectro, los valores de las mediciones se acercan mucho a cero. Aquellas variables predictoras con variabilizada cercana a cero, podrian eliminarse. Habria que verificar para estas longitudes de onda aplica.
  2. Los outliers parecen presentar un patron. Puede tratarse siempre de las mismos observaciones que presentan anomalias en todas las longitudes de onda del espectro?

Analisis de los Outliers

Se obtienen los indentificadores de las observaciones que son outliers para cada longitud de onda y se calculan el numero total de veces que una observacion fue considerada como outlier en todas las longitudes de onda consideradas.

id_table_outliers<-wineq_dataset %>% select(1,10:380) %>% 
      #map(~  boxplot.stats(.x)$out) 
      map(~ which (.x %in% boxplot.stats(.x)$out)) %>% unlist()  %>% as.vector() %>% unique()

Sobre las 602 observaciones hay un total de 128 observaciones que son outliers en al menos una longitud de onda. Existen algunos observaciones que presentan anomalias en las 371 longitudes de onda.

Heatmap de las observaciones consideradas como outliers

El color amarillo claro indica mayor numero de longitudes de onda donde una observacion fue considerada outlier.

LS0tCnRpdGxlOiAiRXN0aW1hY2lvbiBGZW5vbGVzIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgpBY3R1YWxpemFkbyBgciBkYXRlKClgCmBgYHtyfQpsaWJyYXJ5KHRpZHl2ZXJzZSkKYGBgCiMgQ0FSR0EgREVMIERBVEFTRVQKYGBge3J9CndpbmVxX2RhdGFzZXQgPC0gcmVhZF9jc3YoImRhdGEvaGFyYmV0c29uX01GLmNzdiIpCm5hbWVzKHdpbmVxX2RhdGFzZXQpWzU6OV08LWMoIkZUIiwiQVQiLCJTUFAiLCJMUFAiLCJUVCIpCmBgYAoKYGBge3J9CndpbmVxX2RhdGFzZXQKYGBgCgpFbCBkYXRhc2V0IHByb3Zpc3RvIGNvbnRpZW5lIGByIG5yb3cod2luZXFfZGF0YXNldClgIHJlZ2lzdHJvcyB5IHVuIHRvdGFsIGRlIGByIDM4MCAtIDlgIHZhcmlhYmxlcyBwcmVkaWN0b3Jhcy4gRXN0YSBzaXR1YWNpw7NuIHB1ZWRlIGNvbXBsaWNhciBsYSBhcGxpY2FjaW9uIGRlIGFsZ3Vub3MgYWxnb3JpdG1vcyBkZSBNYWNoaW5lIGxlYXJuaW5nLCBlcyBwb3IgZXNvIHF1ZSBsYSBpZGVhIGVzIHRyYXRhciBwcmltZXJvIGRlIGVsaW1pbmFyIChzaSBlcyBwb3NpYmxlKSBhbGd1bmFzIHZhcmlhYmxlcyBwcmVkaWN0b3Jhcy4KCiMgRGlzdHJpYnVjaW9uIGRlIGxhcyB2YXJpYWJsZXMgcHJlZGljdG9yYXMKClJlc3VsdGEgZGlmaWNpbCwgZ3JhZmljYXIgbGFzIGByIDM4MCAtIDlgIHZhcmlhYmxlcywgcG9yIGxvIHF1ZSBzZSByZWFsaXphIHVuIHNhbXBsaW5nIHNvbG8gYSBsb3MgZWZlY3RvcyBkZSBsYSB2aXN1YWxpemFjaW9uLgoKYGBge3IgZmlnLmhlaWdodD0zLCBmaWcud2lkdGg9MTZ9CndpbmVxX2RhdGFzZXQgJT4lIHNlbGVjdCgxLHNhbXBsZSgxMDozODAsMTAwKSAlPiUgc29ydCgpKSAlPiUgcmVzaGFwZTI6Om1lbHQoaWQ9IklEIikgJT4lCgpnZ3Bsb3QoKSsKICBnZW9tX2JveHBsb3QoYWVzKHg9YXMuZmFjdG9yKHZhcmlhYmxlKSx5PXZhbHVlLGZpbGw9YXMuZmFjdG9yKHZhcmlhYmxlKSksc2l6ZT0wLjIpKwogIGdlb21fcG9pbnQoYWVzKHg9YXMuZmFjdG9yKHZhcmlhYmxlKSx5PXZhbHVlLHRleHQ9SUQpLGNvbG9yPSdyZWQnLHNpemU9MC4xKSsKICB0aGVtZV9idygpKwogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpKwogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9ICJub25lIikKI2dncGxvdGx5KCkKYGBgClNlIG9ic2VydmFuIGRvcyBjb3NhczoKCjEuIEhhY2lhIGVsIGZpbmFsIGRlbCBlc3BlY3RybywgbG9zIHZhbG9yZXMgZGUgbGFzIG1lZGljaW9uZXMgc2UgYWNlcmNhbiBtdWNobyBhIGNlcm8uIEFxdWVsbGFzIHZhcmlhYmxlcyBwcmVkaWN0b3JhcyBjb24gdmFyaWFiaWxpemFkYSBjZXJjYW5hIGEgY2VybywgcG9kcmlhbiBlbGltaW5hcnNlLiBIYWJyaWEgcXVlIHZlcmlmaWNhciBwYXJhIGVzdGFzIGxvbmdpdHVkZXMgZGUgb25kYSBhcGxpY2EuCjIuIExvcyBvdXRsaWVycyBwYXJlY2VuIHByZXNlbnRhciB1biBwYXRyb24uIFB1ZWRlIHRyYXRhcnNlIHNpZW1wcmUgZGUgbGFzIG1pc21vcyBvYnNlcnZhY2lvbmVzIHF1ZSBwcmVzZW50YW4gYW5vbWFsaWFzIGVuIHRvZGFzIGxhcyBsb25naXR1ZGVzIGRlIG9uZGEgZGVsIGVzcGVjdHJvPwoKIyBBbmFsaXNpcyBkZSBsb3MgT3V0bGllcnMKICBTZSBvYnRpZW5lbiBsb3MgaW5kZW50aWZpY2Fkb3JlcyBkZSBsYXMgb2JzZXJ2YWNpb25lcyBxdWUgc29uIG91dGxpZXJzIHBhcmEgY2FkYSBsb25naXR1ZCBkZSBvbmRhIHkgc2UgY2FsY3VsYW4gZWwgbnVtZXJvIHRvdGFsIGRlIHZlY2VzIHF1ZSB1bmEgb2JzZXJ2YWNpb24gZnVlIGNvbnNpZGVyYWRhIGNvbW8gb3V0bGllciBlbiB0b2RhcyBsYXMgbG9uZ2l0dWRlcyBkZSBvbmRhIGNvbnNpZGVyYWRhcy4KCmBgYHtyfQppZF90YWJsZV9vdXRsaWVyczwtd2luZXFfZGF0YXNldCAlPiUgc2VsZWN0KDEsMTA6MzgwKSAlPiUgCiAgICAgICNtYXAofiAgYm94cGxvdC5zdGF0cygueCkkb3V0KSAKICAgICAgbWFwKH4gd2hpY2ggKC54ICVpbiUgYm94cGxvdC5zdGF0cygueCkkb3V0KSkgJT4lIHVubGlzdCgpICAlPiUgYXMudmVjdG9yKCkgJT4lIHVuaXF1ZSgpCmBgYAoKYGBge3IgcmVzdWx0cz0nYXNpcyd9Cgp0YWJsZV9vdXRsaWVyczwtd2luZXFfZGF0YXNldCAlPiUgc2VsZWN0KDEsMTA6MzgwKSAlPiUgCiAgICAgICNtYXAofiAgYm94cGxvdC5zdGF0cygueCkkb3V0KSAKICAgICAgbWFwKH4gd2hpY2ggKC54ICVpbiUgYm94cGxvdC5zdGF0cygueCkkb3V0KSkgJT4lIHVubGlzdCgpICU+JSB0YWJsZSgpICAlPiUgdW5saXN0KCkgJT4lIGFzLnZlY3RvcigpIyAlPiUgbWF0cml4KG5jb2w9MTYsbnJvdz04KQpkYXRhLmZyYW1lKGlkPWlkX3RhYmxlX291dGxpZXJzLG51bl9vdXRfdmFscj10YWJsZV9vdXRsaWVycykKYGBgClNvYnJlIGxhcyBgciBucm93KHdpbmVxX2RhdGFzZXQpYCBvYnNlcnZhY2lvbmVzIGhheSB1biB0b3RhbCBkZSAxMjggb2JzZXJ2YWNpb25lcyBxdWUgc29uIG91dGxpZXJzIGVuIGFsIG1lbm9zIHVuYSBsb25naXR1ZCBkZSBvbmRhLgpFeGlzdGVuIGFsZ3Vub3Mgb2JzZXJ2YWNpb25lcyBxdWUgcHJlc2VudGFuIGFub21hbGlhcyBlbiBsYXMgMzcxIGxvbmdpdHVkZXMgZGUgb25kYS4gCgoKIyMgSGVhdG1hcCBkZSBsYXMgb2JzZXJ2YWNpb25lcyBjb25zaWRlcmFkYXMgY29tbyBvdXRsaWVycwpFbCBjb2xvciBhbWFyaWxsbyBjbGFybyBpbmRpY2EgbWF5b3IgbnVtZXJvIGRlIGxvbmdpdHVkZXMgZGUgb25kYSBkb25kZSB1bmEgb2JzZXJ2YWNpb24gZnVlIGNvbnNpZGVyYWRhIG91dGxpZXIuCgpgYGB7cn0KdGFibGVfb3V0bGllcnMgJT4lIGhlYXRtYXAoUm93diA9IE5BLCBDb2x2ID0gTkEseGxhYiA9ICIiLGxhYlJvdz0iIixsYWJDb2w9IiIpCmBgYAoKCgpgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQp3aGljaCh3aW5lcV9kYXRhc2V0ICU+JSBzZWxlY3QoMzAwOjM4MCkgJWluJSBib3hwbG90KHdpbmVxX2RhdGFzZXQgJT4lIHNlbGVjdCgzMDA6MzgwKSxwbG90PUZBTFNFKSRvdXQpCmBgYAoKCmBgYHtyIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CndpbmVxX2RhdGFzZXQgJT4lIGdyb3VwX2J5KEVzcGVjdHJvLFZhcmllZGFkKSAlPiUgc3VtbWFyaXNlKHRvdGFsPW4oKSkgJT4lCmBgYAoKYGBge3IgZXZhbD1GQUxTRSwgZmlnLndpZHRoPTIwLCBpbmNsdWRlPUZBTFNFfQoKbGlicmFyeShnZ2NvcnJwbG90KQp3aW5lcV9kYXRhc2V0ICU+JSBzZWxlY3QoLVNQUCwtTFBQLC1BVCwtSUQsLVRULC1GVCkgJT4lIHJlc2hhcGUyOjptZWx0KCkgJT4lIGdyb3VwX2J5KHZhcmlhYmxlLEVzcGVjdHJvLFZhcmllZGFkKSAlPiUgc3VtbWFyaXNlKHNkPXNkKHZhbHVlKSkgJT4lIGFycmFuZ2Uoc2QpICU+JQoKZ2dwbG90KCkrCiAgZ2VvbV9jb2woYWVzKHg9YXMuZmFjdG9yKHZhcmlhYmxlKSx5PXNkLGZpbGw9YXMuZmFjdG9yKHZhcmlhYmxlKSksc2l6ZT0wLjIpKwogIHRoZW1lX2J3KCkrCiAgdGhlbWUoYXhpcy50ZXh0LnggPSBlbGVtZW50X3RleHQoYW5nbGUgPSA0NSwgaGp1c3QgPSAxKSkrCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gIm5vbmUiKSsKICBmYWNldF9ncmlkKH5Fc3BlY3RybytWYXJpZWRhZCkKCmBgYApgYGB7ciBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQpsaWJyYXJ5KGNhcmV0KQpsaWJyYXJ5KGQzaGVhdG1hcCkKCndpbmVxX2RhdGFzZXRbLDEwOjM4MF0gJT4lIHJlc2hhcGUyOjptZWx0KCkgJT4lIGdyb3VwX2J5KHZhcmlhYmxlKSAlPiUgc3VtbWFyaXNlKHNkPXNkKHZhbHVlKSkgJT4lIHNlbGVjdChzZCkgJT4lIHVubGlzdCgpICU+JSBhcy52ZWN0b3IoKSAlPiUgbWF0cml4KG5jb2w9Nyxucm93PTUzKSAlPiUgaGVhdG1hcChSb3d2ID0gTkEsIENvbHYgPSBOQSkKCmE8LW5lYXJaZXJvVmFyKHdpbmVxX2RhdGFzZXRbLDEwOjM4MF0sc2F2ZU1ldHJpY3M9IFRSVUUpCmE8LW5lYXJaZXJvVmFyKHdpbmVxX2RhdGFzZXRbLDEwOjM4MF0sc2F2ZU1ldHJpY3M9IFRSVUUsIHVuaXF1ZUN1dCA9IDM0LCBmcmVxQ3V0ID0gMC4yKSsKICAKYQpgYGAKCg==