Fiabilidad

Usando 3 clusters

library(dplyr)
petal_length<-
  seq(min(iris$Petal.Length),max(iris$Petal.Length),by=0.01)
petal_width <-
  seq(min(iris$Petal.Width),max(iris$Petal.Width),by=0.01)
set.seed(161)
cluster_x<-
  sample(petal_length,size = 3 )
cluster_y<-
  sample(petal_width,size = 3 )
plot(iris$Petal.Length,
     iris$Petal.Width,
     pch=16,
     xlab = "Petal length",
     ylab = "Petal Width",
     main = "Iris Dataset")
points(cluster_x,cluster_y,col=1:3,pch=17,cex=2)

df<- tibble(petal_length=iris$Petal.Length,
            petal_width=iris$Petal.Width)
df<-
  df %>% 
  rowwise %>% 
  mutate(distance_1 = sqrt((petal_length-cluster_x[1])^2+(petal_width-cluster_y[1])^2 ),
         distance_2 = sqrt((petal_length-cluster_x[2])^2+(petal_width-cluster_y[2])^2),
         distance_3 = sqrt((petal_length-cluster_x[3])^2+(petal_width-cluster_y[3])^2),
         cluster= which.min(c(distance_1,distance_2,distance_3) ),
         centroid_dist = c(distance_1,distance_2,distance_3)[cluster],
         centroid_dist = centroid_dist^2) %>% 
  ungroup()
plot(df$petal_length,df$petal_width,col=df$cluster,
     pch=16,
     xlab = "Petal length",
     ylab = "Petal Width",
     main = "Iris Dataset") 
points(cluster_x,cluster_y,col=1:3,pch=17,cex=2)

Run 1

new_clusters<-
  df %>% 
  group_by(cluster) %>% 
  summarise(avg_x = mean(petal_length),
            avg_y = mean(petal_width)) %>% 
  ungroup()
cluster_x<-
  new_clusters %>% pull(avg_x)
cluster_y<-
  new_clusters %>% pull(avg_y)
df<- tibble(petal_length=iris$Petal.Length,
            petal_width=iris$Petal.Width)
df<-
  df %>% 
  rowwise %>% 
  mutate(distance_1 = sqrt((petal_length-cluster_x[1])^2+(petal_width-cluster_y[1])^2 ),
         distance_2 = sqrt((petal_length-cluster_x[2])^2+(petal_width-cluster_y[2])^2),
         distance_3 = sqrt((petal_length-cluster_x[3])^2+(petal_width-cluster_y[3])^2),
         cluster= which.min(c(distance_1,distance_2,distance_3) )) %>% 
  ungroup()
plot(df$petal_length,df$petal_width,col=df$cluster,
     pch=16,
     xlab = "Petal length",
     ylab = "Petal Width",
     main = "Iris Dataset") 
points(cluster_x,cluster_y,col=1:3,pch=17,cex=2)

Run 2

new_clusters<-
  df %>% 
  group_by(cluster) %>% 
  summarise(avg_x = mean(petal_length),
            avg_y = mean(petal_width)) %>% 
  ungroup()
cluster_x<-
  new_clusters %>% pull(avg_x)
cluster_y<-
  new_clusters %>% pull(avg_y)
df<- tibble(petal_length=iris$Petal.Length,
            petal_width=iris$Petal.Width)
df<-
  df %>% 
  rowwise %>% 
  mutate(distance_1 = sqrt((petal_length-cluster_x[1])^2+(petal_width-cluster_y[1])^2 ),
         distance_2 = sqrt((petal_length-cluster_x[2])^2+(petal_width-cluster_y[2])^2),
         distance_3 = sqrt((petal_length-cluster_x[3])^2+(petal_width-cluster_y[3])^2),
         cluster= which.min(c(distance_1,distance_2,distance_3) )) %>% 
  ungroup()
plot(df$petal_length,df$petal_width,col=df$cluster,
     pch=16,
     xlab = "Petal length",
     ylab = "Petal Width",
     main = "Iris Dataset") 
points(cluster_x,cluster_y,col=1:3,pch=17,cex=2)

Run 3

new_clusters<-
  df %>% 
  group_by(cluster) %>% 
  summarise(avg_x = mean(petal_length),
            avg_y = mean(petal_width)) %>% 
  ungroup()
cluster_x<-
  new_clusters %>% pull(avg_x)
cluster_y<-
  new_clusters %>% pull(avg_y)
df<- tibble(petal_length=iris$Petal.Length,
            petal_width=iris$Petal.Width)
df<-
  df %>% 
  rowwise %>% 
  mutate(distance_1 = sqrt((petal_length-cluster_x[1])^2+(petal_width-cluster_y[1])^2 ),
         distance_2 = sqrt((petal_length-cluster_x[2])^2+(petal_width-cluster_y[2])^2),
         distance_3 = sqrt((petal_length-cluster_x[3])^2+(petal_width-cluster_y[3])^2),
         cluster= which.min(c(distance_1,distance_2,distance_3) ),
         centroid_dist = c(distance_1,distance_2,distance_3)[cluster],
         centroid_dist = centroid_dist^2) %>% 
  ungroup()
plot(df$petal_length,df$petal_width,col=df$cluster,
     pch=16,
     xlab = "Petal length",
     ylab = "Petal Width",
     main = "Iris Dataset") 
points(cluster_x,cluster_y,col=1:3,pch=17,cex=2)

Comparando con el dataset clasificado por la etiqueta Species:

plot(iris$Petal.Length,iris$Petal.Width,
     pch=16,
     xlab = "Petal length",
     ylab = "Petal Width",
     main = "Iris Dataset",
     col=iris$Species) 

df %>% summarise(sum(centroid_dist))
LS0tDQp0aXRsZTogIkstbWVhbnMgY29uIDMgQ2x1c3RlcnMiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQojIyBGaWFiaWxpZGFkDQoNCiMjIyBVc2FuZG8gMyBjbHVzdGVycw0KDQpgYGB7cn0NCmxpYnJhcnkoZHBseXIpDQoNCmBgYA0KDQpgYGB7cn0NCnBldGFsX2xlbmd0aDwtDQogIHNlcShtaW4oaXJpcyRQZXRhbC5MZW5ndGgpLG1heChpcmlzJFBldGFsLkxlbmd0aCksYnk9MC4wMSkNCg0KcGV0YWxfd2lkdGggPC0NCiAgc2VxKG1pbihpcmlzJFBldGFsLldpZHRoKSxtYXgoaXJpcyRQZXRhbC5XaWR0aCksYnk9MC4wMSkNCmBgYA0KDQpgYGB7cn0NCnNldC5zZWVkKDE2MSkNCmNsdXN0ZXJfeDwtDQogIHNhbXBsZShwZXRhbF9sZW5ndGgsc2l6ZSA9IDMgKQ0KY2x1c3Rlcl95PC0NCiAgc2FtcGxlKHBldGFsX3dpZHRoLHNpemUgPSAzICkNCg0KcGxvdChpcmlzJFBldGFsLkxlbmd0aCwNCiAgICAgaXJpcyRQZXRhbC5XaWR0aCwNCiAgICAgcGNoPTE2LA0KICAgICB4bGFiID0gIlBldGFsIGxlbmd0aCIsDQogICAgIHlsYWIgPSAiUGV0YWwgV2lkdGgiLA0KICAgICBtYWluID0gIklyaXMgRGF0YXNldCIpDQpwb2ludHMoY2x1c3Rlcl94LGNsdXN0ZXJfeSxjb2w9MTozLHBjaD0xNyxjZXg9MikNCmBgYA0KDQoNCmBgYHtyfQ0KZGY8LSB0aWJibGUocGV0YWxfbGVuZ3RoPWlyaXMkUGV0YWwuTGVuZ3RoLA0KICAgICAgICAgICAgcGV0YWxfd2lkdGg9aXJpcyRQZXRhbC5XaWR0aCkNCmRmPC0NCiAgZGYgJT4lIA0KICByb3d3aXNlICU+JSANCiAgbXV0YXRlKGRpc3RhbmNlXzEgPSBzcXJ0KChwZXRhbF9sZW5ndGgtY2x1c3Rlcl94WzFdKV4yKyhwZXRhbF93aWR0aC1jbHVzdGVyX3lbMV0pXjIgKSwNCiAgICAgICAgIGRpc3RhbmNlXzIgPSBzcXJ0KChwZXRhbF9sZW5ndGgtY2x1c3Rlcl94WzJdKV4yKyhwZXRhbF93aWR0aC1jbHVzdGVyX3lbMl0pXjIpLA0KICAgICAgICAgZGlzdGFuY2VfMyA9IHNxcnQoKHBldGFsX2xlbmd0aC1jbHVzdGVyX3hbM10pXjIrKHBldGFsX3dpZHRoLWNsdXN0ZXJfeVszXSleMiksDQogICAgICAgICBjbHVzdGVyPSB3aGljaC5taW4oYyhkaXN0YW5jZV8xLGRpc3RhbmNlXzIsZGlzdGFuY2VfMykgKSwNCiAgICAgICAgIGNlbnRyb2lkX2Rpc3QgPSBjKGRpc3RhbmNlXzEsZGlzdGFuY2VfMixkaXN0YW5jZV8zKVtjbHVzdGVyXSwNCiAgICAgICAgIGNlbnRyb2lkX2Rpc3QgPSBjZW50cm9pZF9kaXN0XjIpICU+JSANCiAgdW5ncm91cCgpDQoNCmBgYA0KDQpgYGB7cn0NCnBsb3QoZGYkcGV0YWxfbGVuZ3RoLGRmJHBldGFsX3dpZHRoLGNvbD1kZiRjbHVzdGVyLA0KICAgICBwY2g9MTYsDQogICAgIHhsYWIgPSAiUGV0YWwgbGVuZ3RoIiwNCiAgICAgeWxhYiA9ICJQZXRhbCBXaWR0aCIsDQogICAgIG1haW4gPSAiSXJpcyBEYXRhc2V0IikgDQpwb2ludHMoY2x1c3Rlcl94LGNsdXN0ZXJfeSxjb2w9MTozLHBjaD0xNyxjZXg9MikNCg0KYGBgDQoNCiMjIyMgUnVuIDEgIyMjIyMjIw0KYGBge3J9DQpuZXdfY2x1c3RlcnM8LQ0KICBkZiAlPiUgDQogIGdyb3VwX2J5KGNsdXN0ZXIpICU+JSANCiAgc3VtbWFyaXNlKGF2Z194ID0gbWVhbihwZXRhbF9sZW5ndGgpLA0KICAgICAgICAgICAgYXZnX3kgPSBtZWFuKHBldGFsX3dpZHRoKSkgJT4lIA0KICB1bmdyb3VwKCkNCg0KY2x1c3Rlcl94PC0NCiAgbmV3X2NsdXN0ZXJzICU+JSBwdWxsKGF2Z194KQ0KY2x1c3Rlcl95PC0NCiAgbmV3X2NsdXN0ZXJzICU+JSBwdWxsKGF2Z195KQ0KDQpgYGANCg0KYGBge3J9DQpkZjwtIHRpYmJsZShwZXRhbF9sZW5ndGg9aXJpcyRQZXRhbC5MZW5ndGgsDQogICAgICAgICAgICBwZXRhbF93aWR0aD1pcmlzJFBldGFsLldpZHRoKQ0KDQpkZjwtDQogIGRmICU+JSANCiAgcm93d2lzZSAlPiUgDQogIG11dGF0ZShkaXN0YW5jZV8xID0gc3FydCgocGV0YWxfbGVuZ3RoLWNsdXN0ZXJfeFsxXSleMisocGV0YWxfd2lkdGgtY2x1c3Rlcl95WzFdKV4yICksDQogICAgICAgICBkaXN0YW5jZV8yID0gc3FydCgocGV0YWxfbGVuZ3RoLWNsdXN0ZXJfeFsyXSleMisocGV0YWxfd2lkdGgtY2x1c3Rlcl95WzJdKV4yKSwNCiAgICAgICAgIGRpc3RhbmNlXzMgPSBzcXJ0KChwZXRhbF9sZW5ndGgtY2x1c3Rlcl94WzNdKV4yKyhwZXRhbF93aWR0aC1jbHVzdGVyX3lbM10pXjIpLA0KICAgICAgICAgY2x1c3Rlcj0gd2hpY2gubWluKGMoZGlzdGFuY2VfMSxkaXN0YW5jZV8yLGRpc3RhbmNlXzMpICkpICU+JSANCiAgdW5ncm91cCgpDQoNCmBgYA0KDQpgYGB7cn0NCnBsb3QoZGYkcGV0YWxfbGVuZ3RoLGRmJHBldGFsX3dpZHRoLGNvbD1kZiRjbHVzdGVyLA0KICAgICBwY2g9MTYsDQogICAgIHhsYWIgPSAiUGV0YWwgbGVuZ3RoIiwNCiAgICAgeWxhYiA9ICJQZXRhbCBXaWR0aCIsDQogICAgIG1haW4gPSAiSXJpcyBEYXRhc2V0IikgDQpwb2ludHMoY2x1c3Rlcl94LGNsdXN0ZXJfeSxjb2w9MTozLHBjaD0xNyxjZXg9MikNCg0KYGBgDQoNCiMjIyMgUnVuIDIgIyMjIyMjIw0KDQpgYGB7cn0NCm5ld19jbHVzdGVyczwtDQogIGRmICU+JSANCiAgZ3JvdXBfYnkoY2x1c3RlcikgJT4lIA0KICBzdW1tYXJpc2UoYXZnX3ggPSBtZWFuKHBldGFsX2xlbmd0aCksDQogICAgICAgICAgICBhdmdfeSA9IG1lYW4ocGV0YWxfd2lkdGgpKSAlPiUgDQogIHVuZ3JvdXAoKQ0KDQpjbHVzdGVyX3g8LQ0KICBuZXdfY2x1c3RlcnMgJT4lIHB1bGwoYXZnX3gpDQpjbHVzdGVyX3k8LQ0KICBuZXdfY2x1c3RlcnMgJT4lIHB1bGwoYXZnX3kpDQoNCmBgYA0KDQpgYGB7cn0NCmRmPC0gdGliYmxlKHBldGFsX2xlbmd0aD1pcmlzJFBldGFsLkxlbmd0aCwNCiAgICAgICAgICAgIHBldGFsX3dpZHRoPWlyaXMkUGV0YWwuV2lkdGgpDQoNCmRmPC0NCiAgZGYgJT4lIA0KICByb3d3aXNlICU+JSANCiAgbXV0YXRlKGRpc3RhbmNlXzEgPSBzcXJ0KChwZXRhbF9sZW5ndGgtY2x1c3Rlcl94WzFdKV4yKyhwZXRhbF93aWR0aC1jbHVzdGVyX3lbMV0pXjIgKSwNCiAgICAgICAgIGRpc3RhbmNlXzIgPSBzcXJ0KChwZXRhbF9sZW5ndGgtY2x1c3Rlcl94WzJdKV4yKyhwZXRhbF93aWR0aC1jbHVzdGVyX3lbMl0pXjIpLA0KICAgICAgICAgZGlzdGFuY2VfMyA9IHNxcnQoKHBldGFsX2xlbmd0aC1jbHVzdGVyX3hbM10pXjIrKHBldGFsX3dpZHRoLWNsdXN0ZXJfeVszXSleMiksDQogICAgICAgICBjbHVzdGVyPSB3aGljaC5taW4oYyhkaXN0YW5jZV8xLGRpc3RhbmNlXzIsZGlzdGFuY2VfMykgKSkgJT4lIA0KICB1bmdyb3VwKCkNCg0KYGBgDQoNCmBgYHtyfQ0KcGxvdChkZiRwZXRhbF9sZW5ndGgsZGYkcGV0YWxfd2lkdGgsY29sPWRmJGNsdXN0ZXIsDQogICAgIHBjaD0xNiwNCiAgICAgeGxhYiA9ICJQZXRhbCBsZW5ndGgiLA0KICAgICB5bGFiID0gIlBldGFsIFdpZHRoIiwNCiAgICAgbWFpbiA9ICJJcmlzIERhdGFzZXQiKSANCnBvaW50cyhjbHVzdGVyX3gsY2x1c3Rlcl95LGNvbD0xOjMscGNoPTE3LGNleD0yKQ0KDQpgYGANCg0KIyMjIyBSdW4gMyAjIyMjIyMjDQoNCmBgYHtyfQ0KbmV3X2NsdXN0ZXJzPC0NCiAgZGYgJT4lIA0KICBncm91cF9ieShjbHVzdGVyKSAlPiUgDQogIHN1bW1hcmlzZShhdmdfeCA9IG1lYW4ocGV0YWxfbGVuZ3RoKSwNCiAgICAgICAgICAgIGF2Z195ID0gbWVhbihwZXRhbF93aWR0aCkpICU+JSANCiAgdW5ncm91cCgpDQoNCmNsdXN0ZXJfeDwtDQogIG5ld19jbHVzdGVycyAlPiUgcHVsbChhdmdfeCkNCmNsdXN0ZXJfeTwtDQogIG5ld19jbHVzdGVycyAlPiUgcHVsbChhdmdfeSkNCg0KYGBgDQoNCmBgYHtyfQ0KZGY8LSB0aWJibGUocGV0YWxfbGVuZ3RoPWlyaXMkUGV0YWwuTGVuZ3RoLA0KICAgICAgICAgICAgcGV0YWxfd2lkdGg9aXJpcyRQZXRhbC5XaWR0aCkNCg0KZGY8LQ0KICBkZiAlPiUgDQogIHJvd3dpc2UgJT4lIA0KICBtdXRhdGUoZGlzdGFuY2VfMSA9IHNxcnQoKHBldGFsX2xlbmd0aC1jbHVzdGVyX3hbMV0pXjIrKHBldGFsX3dpZHRoLWNsdXN0ZXJfeVsxXSleMiApLA0KICAgICAgICAgZGlzdGFuY2VfMiA9IHNxcnQoKHBldGFsX2xlbmd0aC1jbHVzdGVyX3hbMl0pXjIrKHBldGFsX3dpZHRoLWNsdXN0ZXJfeVsyXSleMiksDQogICAgICAgICBkaXN0YW5jZV8zID0gc3FydCgocGV0YWxfbGVuZ3RoLWNsdXN0ZXJfeFszXSleMisocGV0YWxfd2lkdGgtY2x1c3Rlcl95WzNdKV4yKSwNCiAgICAgICAgIGNsdXN0ZXI9IHdoaWNoLm1pbihjKGRpc3RhbmNlXzEsZGlzdGFuY2VfMixkaXN0YW5jZV8zKSApLA0KICAgICAgICAgY2VudHJvaWRfZGlzdCA9IGMoZGlzdGFuY2VfMSxkaXN0YW5jZV8yLGRpc3RhbmNlXzMpW2NsdXN0ZXJdLA0KICAgICAgICAgY2VudHJvaWRfZGlzdCA9IGNlbnRyb2lkX2Rpc3ReMikgJT4lIA0KICB1bmdyb3VwKCkNCg0KYGBgDQoNCmBgYHtyfQ0KcGxvdChkZiRwZXRhbF9sZW5ndGgsZGYkcGV0YWxfd2lkdGgsY29sPWRmJGNsdXN0ZXIsDQogICAgIHBjaD0xNiwNCiAgICAgeGxhYiA9ICJQZXRhbCBsZW5ndGgiLA0KICAgICB5bGFiID0gIlBldGFsIFdpZHRoIiwNCiAgICAgbWFpbiA9ICJJcmlzIERhdGFzZXQiKSANCnBvaW50cyhjbHVzdGVyX3gsY2x1c3Rlcl95LGNvbD0xOjMscGNoPTE3LGNleD0yKQ0KDQpgYGANCg0KQ29tcGFyYW5kbyBjb24gZWwgZGF0YXNldCBjbGFzaWZpY2FkbyBwb3IgbGEgZXRpcXVldGEgU3BlY2llczoNCmBgYHtyfQ0KcGxvdChpcmlzJFBldGFsLkxlbmd0aCxpcmlzJFBldGFsLldpZHRoLA0KICAgICBwY2g9MTYsDQogICAgIHhsYWIgPSAiUGV0YWwgbGVuZ3RoIiwNCiAgICAgeWxhYiA9ICJQZXRhbCBXaWR0aCIsDQogICAgIG1haW4gPSAiSXJpcyBEYXRhc2V0IiwNCiAgICAgY29sPWlyaXMkU3BlY2llcykgDQoNCmBgYA0KDQpgYGB7cn0NCmRmICU+JSBzdW1tYXJpc2Uoc3VtKGNlbnRyb2lkX2Rpc3QpKQ0KYGBgDQoNCg==