library(ggplot2)
library(readxl)
library(plotly)
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(psych)
##
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha
library(readxl)
dfcie <- read_excel("C:/Users/IngMa/Downloads/RSTUDIO/Cielab_tueste_cafe.xlsx")
View(dfcie)
Chroma \[ r = \sqrt{a^{2}+b^{2}}\] Hue \[\theta = tan^{-1}(\frac{a}{b}) \]
chroma <- function(a, b){
x = (a^2)
y = (b^2)
z = sqrt(x+y)
return(z)
}
ch1 <- chroma(dfcie$a, dfcie$b)
hue <- function (k, l) {
n = atan(k/l)
return(n)
}
h1 <- hue(dfcie$b, dfcie$a)
L<- dfcie[,1]
df1 <- data.frame(L,h1,ch1,dfcie$tueste)
df1
## L h1 ch1 dfcie.tueste
## 1 15.19033 0.7480722 32.29018 verde
## 2 12.32775 0.7911271 29.55308 verde
## 3 13.53224 0.7977737 33.36546 verde
## 4 13.59665 0.7693511 29.34204 verde
## 5 13.34435 0.8144945 28.45274 verde
## 6 12.35368 0.7605873 30.23399 verde
## 7 16.40974 0.7826524 34.35739 verde
## 8 14.14758 0.8387400 32.15757 verde
## 9 11.76321 0.7701170 27.88013 verde
## 10 14.64208 0.7674516 32.06586 verde
## 11 13.25756 0.7817533 33.46825 verde
## 12 14.81445 0.7917086 32.67243 verde
## 13 14.73464 0.8010740 32.74687 verde
## 14 14.48977 0.8133458 30.09405 verde
## 15 14.90084 0.7700990 31.34843 verde
## 16 13.71453 0.7825687 32.92919 verde
## 17 12.89791 0.7701947 31.13403 verde
## 18 12.75656 0.7817248 29.54272 verde
## 19 13.81088 0.7881335 30.80794 verde
## 20 14.20787 0.8290143 32.24589 verde
## 21 14.55915 0.8165097 30.96257 verde
## 22 14.98762 0.8367726 30.15301 verde
## 23 13.99573 0.7810805 33.32562 verde
## 24 12.14807 0.7562150 26.48464 verde
## 25 14.30555 0.8073524 32.83202 verde
## 26 13.03724 0.7470730 28.20362 verde
## 27 15.86314 0.7858145 32.66340 verde
## 28 10.34441 0.7998872 27.32314 verde
## 29 10.06860 0.7884349 25.28551 verde
## 30 12.79393 0.7643224 31.66948 verde
## 31 27.91913 0.8721633 36.54232 claro
## 32 24.13964 0.8112716 38.18454 claro
## 33 27.95413 0.8630906 37.89272 claro
## 34 30.72026 0.8291944 42.59641 claro
## 35 26.47721 0.8418260 36.61186 claro
## 36 30.52662 0.8293775 40.35032 claro
## 37 28.64093 0.8146810 40.26108 claro
## 38 30.14869 0.8578553 40.36756 claro
## 39 30.76106 0.8457257 39.28339 claro
## 40 30.32628 0.8432812 40.68284 claro
## 41 26.68628 0.8548275 36.28885 claro
## 42 32.00197 0.8495827 41.91576 claro
## 43 29.49828 0.8400389 39.12490 claro
## 44 29.22079 0.8481779 38.46102 claro
## 45 28.36850 0.8558675 34.47377 claro
## 46 28.77176 0.8467254 38.13114 claro
## 47 28.46933 0.8507228 38.04637 claro
## 48 28.27001 0.8298000 38.89867 claro
## 49 28.81296 0.8652878 35.29301 claro
## 50 29.26325 0.8334756 39.56621 claro
## 51 29.19522 0.8181597 38.53694 claro
## 52 28.58540 0.8268372 38.18086 claro
## 53 27.82995 0.8264071 38.12356 claro
## 54 26.89016 0.8406499 35.88550 claro
## 55 30.05191 0.8625368 36.56295 claro
## 56 28.55511 0.8415774 38.29227 claro
## 57 27.99610 0.8418444 37.09680 claro
## 58 29.68118 0.8234115 36.98528 claro
## 59 29.15119 0.8413033 37.20435 claro
## 60 30.37395 0.8407752 41.26583 claro
## 61 14.27315 0.7475825 19.87163 medio
## 62 16.21800 0.8482371 23.49304 medio
## 63 16.78749 0.8188454 24.55295 medio
## 64 16.95466 0.8719029 22.50252 medio
## 65 15.52979 0.7553501 22.07605 medio
## 66 16.06353 0.7373361 21.61435 medio
## 67 16.53923 0.7620604 23.05659 medio
## 68 17.93721 0.8216690 24.97770 medio
## 69 16.98306 0.8242375 22.47735 medio
## 70 20.54567 0.7688550 29.42129 medio
## 71 16.69701 0.8209366 20.11665 medio
## 72 17.45207 0.7614353 21.99449 medio
## 73 14.80582 0.7632498 20.40406 medio
## 74 17.38340 0.7976805 23.83570 medio
## 75 18.81798 0.7611407 27.48433 medio
## 76 15.27829 0.8095348 25.75828 medio
## 77 17.37191 0.8074646 25.94727 medio
## 78 17.12319 0.8348585 22.47398 medio
## 79 15.07086 0.8780080 20.21408 medio
## 80 17.06731 0.7882196 23.66820 medio
## 81 16.02542 0.7925799 21.75814 medio
## 82 14.07958 0.7554670 21.52435 medio
## 83 17.20410 0.7391472 22.30371 medio
## 84 17.36174 0.8051933 24.88019 medio
## 85 19.60466 0.7342786 25.14254 medio
## 86 17.15111 0.7749939 23.57896 medio
## 87 15.00786 0.8279841 20.44878 medio
## 88 16.54741 0.7180264 21.69991 medio
## 89 19.20708 0.8236181 25.02320 medio
## 90 15.57479 0.8309550 20.74814 medio
## 91 18.94468 0.7936993 28.40329 oscuro
## 92 17.53108 0.7857908 24.57498 oscuro
## 93 15.67738 0.7691486 22.44342 oscuro
## 94 16.37028 0.8026353 23.09517 oscuro
## 95 18.75271 0.7757886 28.46398 oscuro
## 96 17.17517 0.7497393 22.60838 oscuro
## 97 19.37328 0.8400200 24.69810 oscuro
## 98 19.22570 0.7677115 24.81095 oscuro
## 99 18.79085 0.8015076 23.62731 oscuro
## 100 18.80073 0.7869244 24.08223 oscuro
## 101 17.62222 0.7564268 27.54536 oscuro
## 102 18.23295 0.7557990 24.93081 oscuro
## 103 19.87498 0.7667001 25.98874 oscuro
## 104 18.87336 0.7055609 25.81900 oscuro
## 105 19.84331 0.7600131 27.15064 oscuro
## 106 19.67596 0.7949536 24.98160 oscuro
## 107 19.96478 0.8365323 27.08809 oscuro
## 108 17.28221 0.8332368 26.48606 oscuro
## 109 18.22070 0.8311150 25.34591 oscuro
## 110 20.29963 0.8038209 24.96307 oscuro
## 111 15.62046 0.8058029 23.48658 oscuro
## 112 18.55271 0.7280711 21.63534 oscuro
## 113 22.53165 0.8085676 28.83561 oscuro
## 114 16.67274 0.8365677 23.18006 oscuro
## 115 18.10443 0.8391969 25.78536 oscuro
## 116 17.27482 0.8125544 24.80234 oscuro
## 117 17.96746 0.7841935 26.73317 oscuro
## 118 17.99134 0.7890172 23.49753 oscuro
## 119 20.80618 0.7814427 28.58817 oscuro
## 120 18.36360 0.8237892 22.22414 oscuro
fig1 <- plot_ly(data = df1,
x = ~L,
y = ~ch1,
z = ~h1,
size = 0.9,
color = ~dfcie.tueste)
fig1
## No trace type specified:
## Based on info supplied, a 'scatter3d' trace seems appropriate.
## Read more about this trace type -> https://plotly.com/r/reference/#scatter3d
## No scatter3d mode specifed:
## Setting the mode to markers
## Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode
De acuerdo al gráfico se podrian reducir a 3 clousters para confirmarlo realizamos 2 métodos de agrupamiento
## Número óptimo de clousters
M = df1[,-4]
Ms = scale(M)
fviz_nbclust(Ms,
FUNcluster = kmeans,
method = 'gap_stat',
diss = get_dist(Ms,
'euclidean'))
Con este método confirmamos que se pueden crear 3 clousters y
agruparemos todos los datos
clus1 = kmeans(Ms, 3)
df1$cluster <- clus1$cluster
df1 <- df1[-4]
df1 |>
group_by(cluster) |>
summarise(media_a = mean(ch1),
media_b = mean(h1),
media_L = mean(L),
desv_a = sd(ch1),
desv_b = sd(h1),
desv_L = sd(L),
coeV_a = 100 * desv_a/media_a,
coeV_b = 100 *desv_b/media_b,
coeV_L = 100 *desv_L/media_L)
## # A tibble: 3 × 10
## cluster media_a media_b media_L desv_a desv_b desv_L coeV_a coeV_b coeV_L
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 38.4 0.842 28.8 1.94 0.0153 1.55 5.05 1.81 5.38
## 2 2 25.3 0.823 16.9 3.43 0.0192 2.02 13.6 2.33 11.9
## 3 3 27.2 0.768 15.9 4.12 0.0208 2.71 15.2 2.71 17.1
fig2 <- plot_ly(data = df1,
x = ~L,
y = ~ch1,
z = ~h1,
size = 0.8,
color = ~cluster)
fig2
## No trace type specified:
## Based on info supplied, a 'scatter3d' trace seems appropriate.
## Read more about this trace type -> https://plotly.com/r/reference/#scatter3d
## No scatter3d mode specifed:
## Setting the mode to markers
## Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode
Se observa la agrupación en 3 clousters de aceurdo al Hue y el Chroma:
… .. … … … . ..
df_scale1 <- scale(df1)
d <- dist(df_scale1, method = "euclidean")
fit <- hclust(d, method="ward.D2")
plot(fit)
groups <- cutree(fit, k=3)
rect.hclust(fit, k=3, border="red")
tapply(df1$ch1, groups, mean)
## 1 2 3
## 27.16622 25.26230 38.37024
tapply(df1$h1, groups, mean)
## 1 2 3
## 0.7679318 0.8227090 0.8415492
tapply(df1$L, groups, mean)
## 1 2 3
## 15.85863 16.90728 28.84291