In [1]:
#Leemos los datos del catalogo de ultravista
dat <- read.table('ultravista_catalog.dat',na.strings='---')
dat <- dat[,-c(1,2,3)]

names <-  c('ra','dec','Xpos','Ypos','F','E(B-V)', 
            'Yap2','e_Yap2','Yap7','e_Yap7','Ymag','e_Ymag','Yr','Ysf',
            'Jap2','e_Jap2','Jap7','e_Jap7','Jmag','e_Jmag','Jr','Jsf',
            'Hap2','e_Hap2','Hap7','e_Hap7','Hmag','e_Hmag','Hr','Hsf',
            'Kap2','e_Kap2','Kap7','e_Kap7','Kmag','e_Kmag','Kr','Ksf',
            'Nap2','e_Nap2','Nap7','e_Nap7','Nmag','e_Nmag','Nr','Nsf')      
colnames(dat) <- names

In [2]:
dat <- na.omit(dat) #Sacamos las filas que no tienen alguna observacion

#Desenrojecemos
Av <- 3.1*dat$'E(B-V)'
dat$Y <- dat$Yap2-0.39*Av
dat$J <- dat$Jap2-0.28*Av
dat$H <- dat$Hap2-0.184*Av
dat$K <- dat$Kap2-0.118*Av

#Calculamos los colores
dat$Y.J <- dat$Y-dat$J
dat$H.K <- dat$H-dat$K

In [3]:
summary(dat)


       ra             dec             Xpos            Ypos      
 Min.   :149.3   Min.   :1.589   Min.   : 6394   Min.   : 7157  
 1st Qu.:149.7   1st Qu.:1.954   1st Qu.:16847   1st Qu.:15914  
 Median :150.0   Median :2.242   Median :24527   Median :22831  
 Mean   :150.0   Mean   :2.228   Mean   :25058   Mean   :22500  
 3rd Qu.:150.4   3rd Qu.:2.509   3rd Qu.:32846   3rd Qu.:29242  
 Max.   :150.8   Max.   :2.828   Max.   :42669   Max.   :36893  
     F               E(B-V)             Yap2           e_Yap2        
 Mode :logical   Min.   :0.01579   Min.   :12.40   Min.   : 0.00000  
 FALSE:160920    1st Qu.:0.01822   1st Qu.:22.37   1st Qu.: 0.01000  
 TRUE :4517      Median :0.01921   Median :23.42   Median : 0.02600  
 NA's :0         Mean   :0.01916   Mean   :23.14   Mean   : 0.04957  
                 3rd Qu.:0.02015   3rd Qu.:24.20   3rd Qu.: 0.05350  
                 Max.   :0.02352   Max.   :32.29   Max.   :83.17100  
      Yap7           e_Yap7               Ymag            e_Ymag        
 Min.   :10.33   Min.   :   0.0000   Min.   : 9.902   Min.   :  0.0000  
 1st Qu.:21.76   1st Qu.:   0.0202   1st Qu.:21.913   1st Qu.:  0.0131  
 Median :22.80   Median :   0.0520   Median :23.056   Median :  0.0316  
 Mean   :22.57   Mean   :   0.2103   Mean   :22.786   Mean   :  0.0624  
 3rd Qu.:23.62   3rd Qu.:   0.1107   3rd Qu.:23.970   3rd Qu.:  0.0612  
 Max.   :34.61   Max.   :2499.1421   Max.   :34.780   Max.   :995.3500  
       Yr                Ysf               Jap2           e_Jap2        
 Min.   :-238.709   Min.   : 0.0000   Min.   :12.98   Min.   :  0.0000  
 1st Qu.:   3.629   1st Qu.: 0.0000   1st Qu.:22.08   1st Qu.:  0.0106  
 Median :   4.289   Median : 0.0000   Median :23.13   Median :  0.0277  
 Mean   :   4.651   Mean   : 0.4987   Mean   :22.84   Mean   :  0.0512  
 3rd Qu.:   5.251   3rd Qu.: 0.0000   3rd Qu.:23.90   3rd Qu.:  0.0560  
 Max.   : 299.544   Max.   :19.0000   Max.   :33.62   Max.   :437.0173  
      Jap7           e_Jap7              Jmag           e_Jmag        
 Min.   :10.87   Min.   :  0.0000   Min.   :10.23   Min.   :  0.0000  
 1st Qu.:21.56   1st Qu.:  0.0233   1st Qu.:21.68   1st Qu.:  0.0147  
 Median :22.61   Median :  0.0606   Median :22.82   Median :  0.0354  
 Mean   :22.36   Mean   :  0.1802   Mean   :22.54   Mean   :  0.0598  
 3rd Qu.:23.41   3rd Qu.:  0.1263   3rd Qu.:23.70   3rd Qu.:  0.0666  
 Max.   :33.03   Max.   :883.2588   Max.   :33.66   Max.   :451.9294  
       Jr                Jsf               Hap2           e_Hap2        
 Min.   :-419.843   Min.   : 0.0000   Min.   :12.56   Min.   : 0.00000  
 1st Qu.:   3.470   1st Qu.: 0.0000   1st Qu.:21.78   1st Qu.: 0.01290  
 Median :   4.075   Median : 0.0000   Median :22.88   Median : 0.03520  
 Mean   :   4.394   Mean   : 0.4998   Mean   :22.58   Mean   : 0.06195  
 3rd Qu.:   4.932   3rd Qu.: 0.0000   3rd Qu.:23.67   3rd Qu.: 0.07280  
 Max.   : 298.538   Max.   :19.0000   Max.   :31.53   Max.   :90.14130  
      Hap7           e_Hap7              Hmag            e_Hmag         
 Min.   :10.35   Min.   :   0.000   Min.   : 9.925   Min.   :  0.00000  
 1st Qu.:21.35   1st Qu.:   0.031   1st Qu.:21.445   1st Qu.:  0.01880  
 Median :22.46   Median :   0.085   Median :22.606   Median :  0.04700  
 Mean   :22.22   Mean   :   0.337   Mean   :22.324   Mean   :  0.07647  
 3rd Qu.:23.29   3rd Qu.:   0.182   3rd Qu.:23.502   3rd Qu.:  0.08940  
 Max.   :34.94   Max.   :7165.640   Max.   :31.485   Max.   :176.24360  
       Hr               Hsf              Kap2           e_Kap2        
 Min.   :-50.937   Min.   : 0.000   Min.   :12.69   Min.   : 0.00000  
 1st Qu.:  3.308   1st Qu.: 0.000   1st Qu.:21.47   1st Qu.: 0.01040  
 Median :  3.881   Median : 0.000   Median :22.62   Median : 0.02980  
 Mean   :  4.155   Mean   : 0.493   Mean   :22.32   Mean   : 0.04559  
 3rd Qu.:  4.659   3rd Qu.: 0.000   3rd Qu.:23.46   3rd Qu.: 0.06430  
 Max.   :299.083   Max.   :19.000   Max.   :30.37   Max.   :33.33920  
      Kap7           e_Kap7              Kmag           e_Kmag         
 Min.   :10.75   Min.   :   0.000   Min.   :10.25   Min.   :   0.0000  
 1st Qu.:21.11   1st Qu.:   0.026   1st Qu.:21.17   1st Qu.:   0.0155  
 Median :22.31   Median :   0.079   Median :22.37   Median :   0.0409  
 Mean   :22.09   Mean   :   0.358   Mean   :22.08   Mean   :   0.0757  
 3rd Qu.:23.21   3rd Qu.:   0.179   3rd Qu.:23.28   3rd Qu.:   0.0800  
 Max.   :34.56   Max.   :5776.448   Max.   :34.01   Max.   :3004.2468  
       Kr               Ksf               Nap2           e_Nap2         
 Min.   :  0.004   Min.   : 0.0000   Min.   :12.48   Min.   :   0.0000  
 1st Qu.:  3.227   1st Qu.: 0.0000   1st Qu.:22.52   1st Qu.:   0.0000  
 Median :  3.762   Median : 0.0000   Median :23.56   Median :   0.0445  
 Mean   :  3.969   Mean   : 0.4924   Mean   :23.55   Mean   :   0.2009  
 3rd Qu.:  4.465   3rd Qu.: 0.0000   3rd Qu.:24.71   3rd Qu.:   0.1455  
 Max.   :298.500   Max.   :19.0000   Max.   :36.20   Max.   :2338.4114  
      Nap7           e_Nap7              Nmag            e_Nmag         
 Min.   :10.35   Min.   :   0.000   Min.   : 9.885   Min.   :   0.0000  
 1st Qu.:21.47   1st Qu.:   0.000   1st Qu.:22.020   1st Qu.:   0.0000  
 Median :22.41   Median :   0.099   Median :23.091   Median :   0.0619  
 Mean   :22.33   Mean   :   0.851   Mean   :23.012   Mean   :   0.2642  
 3rd Qu.:23.25   3rd Qu.:   0.302   3rd Qu.:24.122   3rd Qu.:   0.1790  
 Max.   :34.37   Max.   :9484.573   Max.   :35.488   Max.   :1351.3698  
       Nr                Nsf                Y               J        
 Min.   :-463.814   Min.   : 0.0000   Min.   :12.38   Min.   :12.97  
 1st Qu.:   3.783   1st Qu.: 0.0000   1st Qu.:22.35   1st Qu.:22.07  
 Median :   5.534   Median : 0.0000   Median :23.39   Median :23.11  
 Mean   :   8.973   Mean   : 0.7882   Mean   :23.11   Mean   :22.82  
 3rd Qu.:  13.092   3rd Qu.: 1.0000   3rd Qu.:24.18   3rd Qu.:23.89  
 Max.   : 298.390   Max.   :19.0000   Max.   :32.27   Max.   :33.61  
       H               K              Y.J               H.K          
 Min.   :12.55   Min.   :12.68   Min.   :-6.6878   Min.   :-5.50744  
 1st Qu.:21.77   1st Qu.:21.46   1st Qu.: 0.1201   1st Qu.: 0.07906  
 Median :22.87   Median :22.61   Median : 0.2609   Median : 0.26647  
 Mean   :22.57   Mean   :22.32   Mean   : 0.2911   Mean   : 0.25049  
 3rd Qu.:23.66   3rd Qu.:23.46   3rd Qu.: 0.4203   3rd Qu.: 0.42206  
 Max.   :31.52   Max.   :30.37   Max.   : 7.8935   Max.   : 6.89146  

In [4]:
library('hexbin')
colores <- subset(dat, dat$Y.J > -1 & 
           dat$Y.J < 1 & dat$H.K > -1 & 
           dat$H.K < 1)

plot(hexbin(colores$Y.J,colores$H.K,xbins=200), xlab = 'Y-J', ylab = 'H-K')



In [5]:
sub = subset(dat, (dat$H.K > -0.5 & dat$H.K < 0.7 & dat$Y.J > -0.5 & dat$Y.J < 0.7))
hist(sub$H.K, breaks=50)
# plot(density(aux$H.K, bandwidth=0.0001), log = 'y', xlim=c(-0.5,1))



In [6]:
library('mclust')
set.seed(28890) #Pongamos una semilla "a mano"

ind <- sample(1:length(sub$Y), size = 5000) #Hago un sampleo random por q sino no me da la ram
aux <- sub[ind,]
aux <- subset(aux, select = c('Y.J', 'H.K', 'Jr')) #Pruebo solo con los colores
aux <- subset(aux, aux$Jr < 10 & aux$Jr > 0) #Pongo limites logicos en el radio
mc <- Mclust(aux, G = 2:3)


Package 'mclust' version 5.2.3
Type 'citation("mclust")' for citing this R package in publications.

In [7]:
mc$G #Vemos que encuentra 3 clusters


3

In [8]:
plot(mc)



In [9]:
p1 <- mc$z[,1] #Vector con las probabilidades de pertenecer al grupo 1
p2 <- mc$z[,2] #Vector con las probabilidades de pertenecer al grupo 2
p3 <- mc$z[,3] #Vector con las probabilidades de pertenecer al grupo 3

class <- mc$classification
aux <- data.frame(aux, class, p1, p2, p3)

aux1 <- subset(aux, aux$class == 1)
aux2 <- subset(aux, aux$class == 2)
aux3 <- subset(aux, aux$class == 3)

In [10]:
hx1 <- hexbin(aux1$Y.J,aux1$H.K,xbins=200)
hx2 <- hexbin(aux2$Y.J,aux2$H.K,xbins=200)
hx3 <- hexbin(aux3$Y.J,aux3$H.K,xbins=200)
hx <- hexbin(colores$Y.J,colores$H.K,xbins=200)

In [11]:
plot(hx@xcm,hx@ycm,col=rgb(0,0,0,hx@count/(max(hx@count))), pch=20)
points(hx1@xcm,hx1@ycm,col=rgb(1,0,0,hx1@count/(max(hx@count))), pch=20)
points(hx2@xcm,hx2@ycm,col=rgb(0,0,1,hx2@count/(max(hx@count))), pch=20)
points(hx3@xcm,hx3@ycm,col=rgb(0,1,0,hx3@count/(max(hx@count))), pch=20)



In [12]:
aux1 <- subset(aux1, aux1$p1 > 0.5 ) #Me quedo con los que tienen mayor probabilidad
aux2 <- subset(aux2, aux2$p2 > 0.5) #Me quedo con los que tienen mayor probabilidad
aux3 <- subset(aux3, aux3$p3 > 0.5) #Me quedo con los que tienen mayor probabilidad

In [13]:
plot(hx@xcm, hx@ycm, col = rgb(0,0,0,hx@count/(max(hx@count))), pch = 20)
points(aux1$Y.J, aux1$H.K, col = rgb(1,0,0), pch=20, cex = 0.5)
points(aux2$Y.J, aux2$H.K, col = rgb(0,0,1), pch=20, cex = 0.5)
points(aux3$Y.J, aux3$H.K, col = rgb(0,1,0), pch=20, cex = 0.5)



In [14]:
# Usando el modelo de clustering creado con 5000 observaciones random, predecimos la clasificaion de todas
prediction <- predict(mc, newdata = subset(dat, select = c('Y.J', 'H.K', 'Jr')))

In [15]:
dat_pred <- data.frame(dat, class = prediction$classification, p1 = prediction$z[,1], p2 = prediction$z[,2],
                 p3 = prediction$z[,3])

In [25]:
# Veamos como quedaron los datos
dat1 <- subset(dat_pred, dat_pred$class == 1 & dat_pred$p1 > 0.9 & dat_pred$p2 < 0.1 & dat_pred$p3 < 0.1)
dat2 <- subset(dat_pred, dat_pred$class == 2 & dat_pred$p2 > 0.9 & dat_pred$p1 < 0.1 & dat_pred$p3 < 0.1)
dat3 <- subset(dat_pred, dat_pred$class == 3 & dat_pred$p3 > 0.9 & dat_pred$p1 < 0.1 & dat_pred$p2 < 0.1)

In [26]:
plot(hx@xcm, hx@ycm, col = rgb(0,0,0,hx@count/(max(hx@count))), pch = 20)
points(dat1$Y.J, dat1$H.K, col = rgb(1,0,0,0.1), pch=20, cex = 0.1)
points(dat2$Y.J, dat2$H.K, col = rgb(0,0,1,0.1), pch=20, cex = 0.1)
points(dat3$Y.J, dat3$H.K, col = rgb(0,1,0,0.1), pch=20, cex = 0.1)



In [19]:
#Guardo los datos con las clasificaciones
write.table(dat_pred, file = 'ultravista_catalog_class.dat', row.names = F, quote = F)