pacman::p_load(pacman,dplyr,GGally,ggplot2,ggthemes,ggvis,httr,lubridate,plotly,rio,rmarkdown,shiny,stringr,tidyr,tidyverse,lattice,caret,pls,MASS,yarrr,psych,ggcorrplot,GGally,CCA,CCP)
library(tidyverse)
theme_set(theme_bw(16))
library(CCA)
library(stats)
Y=read.csv("cafeCatacion.csv",sep=",")
Y
## Aroma Flavor Aftertaste Acidity Body Balance
## 1 8.50 8.42 8.47 8.42 8.36 8.75
## 2 8.39 8.36 8.31 8.44 8.39 8.58
## 3 8.31 8.44 8.33 8.42 8.36 8.64
## 4 8.36 8.25 8.17 8.28 8.31 8.39
## 5 8.17 8.08 8.14 8.33 8.33 8.44
## 6 8.39 8.36 8.25 8.33 8.33 8.58
## 7 8.31 8.39 8.31 8.42 8.36 8.67
## 8 8.50 8.44 8.33 8.61 8.56 8.58
## 9 8.44 8.39 8.31 8.47 8.39 8.67
## 10 8.42 8.39 8.28 8.33 8.47 8.50
## 11 8.47 8.14 8.31 8.42 8.19 8.50
## 12 8.53 8.31 8.25 8.47 8.28 8.61
## 13 8.42 8.47 8.39 8.53 8.42 8.64
## 14 8.56 8.47 8.42 8.53 8.33 8.64
## 15 8.16 8.13 8.03 8.16 8.22 8.22
## 16 8.07 7.89 7.89 8.11 8.00 8.25
Y=read.csv("sensorialCSV.csv",sep=",")
Y<-Y[,c('Aroma', 'Flavor', 'Aftertaste', 'Acidity', 'Body', 'Balance')]
X=read.csv("polarCSV.csv",sep=",")
X <- X[, c('A39', 'A47', 'A65', 'A143', 'A37', 'A54', 'A40', 'A48', 'A64', 'A95')]
X
## A39 A47 A65 A143 A37 A54 A40 A48 A64 A95
## 1 3.260 1.525 3.495 0.215 1.310 0.525 1.210 2.310 0.615 0.515
## 2 2.885 1.345 2.805 0.280 1.090 0.700 1.235 2.300 0.400 0.450
## 3 2.845 1.470 3.225 0.290 1.425 0.435 1.230 1.955 0.390 0.395
## 4 2.735 1.420 2.700 0.350 1.235 0.530 1.125 2.070 0.335 0.700
## 5 2.805 1.390 2.795 0.285 1.640 0.500 1.245 2.270 0.370 0.670
## 6 3.250 1.420 3.125 0.255 1.545 0.465 1.205 2.165 0.545 0.420
## 7 2.980 1.495 2.895 0.245 1.445 0.530 1.300 2.250 0.425 0.415
## 8 3.045 1.205 2.270 0.170 1.640 0.180 1.110 2.370 0.365 0.620
## 9 3.100 1.470 2.430 0.310 1.680 0.225 1.290 2.180 0.320 0.725
## 10 2.595 1.555 2.470 0.325 1.420 0.440 1.125 2.155 0.275 0.760
## 11 2.785 1.740 2.905 0.285 1.275 0.575 1.270 2.445 0.270 0.440
## 12 2.570 1.380 2.885 0.260 0.815 0.750 1.165 2.170 0.310 0.340
## 13 2.700 1.375 2.780 0.220 1.095 0.630 1.180 2.205 0.345 0.650
## 14 2.285 1.290 2.905 0.265 1.130 0.490 1.215 2.030 0.250 0.335
## 15 3.440 2.220 2.255 0.375 1.160 0.970 1.640 3.480 0.305 0.370
## 16 3.570 2.345 2.230 0.370 1.305 1.005 1.665 3.295 0.280 0.345
#Correlatsion matrices
mat_cor <-matcor(X,Y)
mat_cor
## $Xcor
## A39 A47 A65 A143 A37 A54
## A39 1.0000000 0.6554153 -0.2430974 0.23475461 0.32154389 0.3258001
## A47 0.6554153 1.0000000 -0.4235804 0.70186886 -0.11420832 0.7405866
## A65 -0.2430974 -0.4235804 1.0000000 -0.43108067 -0.13316370 -0.1765050
## A143 0.2347546 0.7018689 -0.4310807 1.00000000 -0.11436577 0.5385240
## A37 0.3215439 -0.1142083 -0.1331637 -0.11436577 1.00000000 -0.6480715
## A54 0.3258001 0.7405866 -0.1765050 0.53852397 -0.64807151 1.0000000
## A40 0.6871712 0.9203180 -0.4356314 0.61841890 -0.07141556 0.7243334
## A48 0.7128306 0.8987663 -0.5726467 0.50530187 -0.11564476 0.7211490
## A64 0.3855352 -0.2551946 0.6557899 -0.47542945 0.24961204 -0.2036259
## A95 -0.1759641 -0.3548306 -0.2400469 -0.05499792 0.47432590 -0.5625149
## A40 A48 A64 A95
## A39 0.68717122 0.7128306 0.38553521 -0.17596409
## A47 0.92031802 0.8987663 -0.25519459 -0.35483061
## A65 -0.43563142 -0.5726467 0.65578986 -0.24004691
## A143 0.61841890 0.5053019 -0.47542945 -0.05499792
## A37 -0.07141556 -0.1156448 0.24961204 0.47432590
## A54 0.72433340 0.7211490 -0.20362585 -0.56251493
## A40 1.00000000 0.9069347 -0.21906393 -0.46967150
## A48 0.90693471 1.0000000 -0.21429617 -0.34046654
## A64 -0.21906393 -0.2142962 1.00000000 -0.03078416
## A95 -0.46967150 -0.3404665 -0.03078416 1.00000000
##
## $Ycor
## Aroma Flavor Aftertaste Acidity Body Balance
## Aroma 1.0000000 0.7460524 0.8403546 0.8118285 0.5585906 0.7369988
## Flavor 0.7460524 1.0000000 0.8804859 0.7854296 0.8221883 0.8334571
## Aftertaste 0.8403546 0.8804859 1.0000000 0.8529577 0.6921323 0.9119873
## Acidity 0.8118285 0.7854296 0.8529577 1.0000000 0.7165935 0.8201281
## Body 0.5585906 0.8221883 0.6921323 0.7165935 1.0000000 0.6099369
## Balance 0.7369988 0.8334571 0.9119873 0.8201281 0.6099369 1.0000000
##
## $XYcor
## A39 A47 A65 A143 A37 A54
## A39 1.0000000 0.6554153 -0.2430974 0.23475461 0.32154389 0.3258001
## A47 0.6554153 1.0000000 -0.4235804 0.70186886 -0.11420832 0.7405866
## A65 -0.2430974 -0.4235804 1.0000000 -0.43108067 -0.13316370 -0.1765050
## A143 0.2347546 0.7018689 -0.4310807 1.00000000 -0.11436577 0.5385240
## A37 0.3215439 -0.1142083 -0.1331637 -0.11436577 1.00000000 -0.6480715
## A54 0.3258001 0.7405866 -0.1765050 0.53852397 -0.64807151 1.0000000
## A40 0.6871712 0.9203180 -0.4356314 0.61841890 -0.07141556 0.7243334
## A48 0.7128306 0.8987663 -0.5726467 0.50530187 -0.11564476 0.7211490
## A64 0.3855352 -0.2551946 0.6557899 -0.47542945 0.24961204 -0.2036259
## A95 -0.1759641 -0.3548306 -0.2400469 -0.05499792 0.47432590 -0.5625149
## Aroma -0.5839681 -0.6990053 0.3792379 -0.62887411 -0.20192605 -0.5530871
## Flavor -0.4622856 -0.7617719 0.4120765 -0.64983599 0.01466341 -0.6404886
## Aftertaste -0.5235625 -0.7577908 0.6107585 -0.74394789 -0.01010842 -0.6355493
## Acidity -0.5626359 -0.8231224 0.2952953 -0.83367973 0.01259388 -0.6687412
## Body -0.3938414 -0.7948291 0.1135488 -0.63167539 0.30800469 -0.7678494
## Balance -0.3865317 -0.7481447 0.6452713 -0.76472068 0.07659608 -0.6265725
## A40 A48 A64 A95 Aroma
## A39 0.68717122 0.7128306 0.38553521 -0.17596409 -0.58396806
## A47 0.92031802 0.8987663 -0.25519459 -0.35483061 -0.69900535
## A65 -0.43563142 -0.5726467 0.65578986 -0.24004691 0.37923788
## A143 0.61841890 0.5053019 -0.47542945 -0.05499792 -0.62887411
## A37 -0.07141556 -0.1156448 0.24961204 0.47432590 -0.20192605
## A54 0.72433340 0.7211490 -0.20362585 -0.56251493 -0.55308708
## A40 1.00000000 0.9069347 -0.21906393 -0.46967150 -0.74993398
## A48 0.90693471 1.0000000 -0.21429617 -0.34046654 -0.65843948
## A64 -0.21906393 -0.2142962 1.00000000 -0.03078416 0.09781202
## A95 -0.46967150 -0.3404665 -0.03078416 1.00000000 0.11422520
## Aroma -0.74993398 -0.6584395 0.09781202 0.11422520 1.00000000
## Flavor -0.70803987 -0.7165585 0.31124461 0.19633322 0.74605242
## Aftertaste -0.73976350 -0.7455554 0.34699955 0.16507257 0.84035457
## Acidity -0.72219686 -0.6813009 0.08826985 0.16607149 0.81182848
## Body -0.76016726 -0.6300062 0.24951464 0.56269588 0.55859059
## Balance -0.66945620 -0.7659415 0.46185689 0.08474304 0.73699879
## Flavor Aftertaste Acidity Body Balance
## A39 -0.46228563 -0.52356250 -0.56263585 -0.3938414 -0.38653173
## A47 -0.76177193 -0.75779080 -0.82312238 -0.7948291 -0.74814469
## A65 0.41207648 0.61075847 0.29529527 0.1135488 0.64527135
## A143 -0.64983599 -0.74394789 -0.83367973 -0.6316754 -0.76472068
## A37 0.01466341 -0.01010842 0.01259388 0.3080047 0.07659608
## A54 -0.64048861 -0.63554935 -0.66874116 -0.7678494 -0.62657252
## A40 -0.70803987 -0.73976350 -0.72219686 -0.7601673 -0.66945620
## A48 -0.71655855 -0.74555541 -0.68130086 -0.6300062 -0.76594154
## A64 0.31124461 0.34699955 0.08826985 0.2495146 0.46185689
## A95 0.19633322 0.16507257 0.16607149 0.5626959 0.08474304
## Aroma 0.74605242 0.84035457 0.81182848 0.5585906 0.73699879
## Flavor 1.00000000 0.88048587 0.78542960 0.8221883 0.83345711
## Aftertaste 0.88048587 1.00000000 0.85295767 0.6921323 0.91198732
## Acidity 0.78542960 0.85295767 1.00000000 0.7165935 0.82012809
## Body 0.82218832 0.69213230 0.71659349 1.0000000 0.60993686
## Balance 0.83345711 0.91198732 0.82012809 0.6099369 1.00000000
cc1 <- cc(X, Y)
# display the canonical correlations
cc1$cor
## [1] 1.0000000 0.9999989 0.9764184 0.9129563 0.8889617 0.4483559
# canonical vectors
cc1[3:4]
## $xcoef
## [,1] [,2] [,3] [,4] [,5] [,6]
## A39 0.3576318 3.25078984 -5.7811144 -0.4387949 0.34270924 -9.9935065
## A47 2.9182908 -4.11240226 6.1409293 -3.3159651 -1.06119237 0.2802717
## A65 -0.6484942 1.42648556 -4.2616134 5.8258628 -4.02620946 -3.9335123
## A143 -13.4605979 -10.89054857 8.3588310 -7.3223872 -6.03884769 2.4676411
## A37 -2.8839375 -1.32494663 -4.7509842 4.0159167 3.54155701 -2.9980075
## A54 -1.6131111 -1.10934054 -8.8310046 2.6605510 6.32186365 -7.2862833
## A40 13.4408497 -0.09935621 -0.1619236 0.7351876 4.81015378 19.7081362
## A48 -6.3099722 0.91639728 -0.4783565 4.5004884 -4.83376422 1.1558789
## A64 3.6201848 -15.41002387 27.4004137 -10.9823826 7.92726630 27.7373014
## A95 0.1808893 -0.05029105 -1.1272118 6.4723155 0.03950147 1.5795055
##
## $ycoef
## [,1] [,2] [,3] [,4] [,5] [,6]
## Aroma -4.417507 0.6738439 6.8063738 -6.4669100 -3.04943759 -10.356342
## Flavor 5.729784 0.7669384 1.0696626 -11.7446312 -1.23731611 11.303332
## Aftertaste -1.024276 -3.9496336 0.7180681 17.5192074 -12.51126828 8.404172
## Acidity 1.131251 12.8585213 -11.4376832 -0.9328798 0.02539622 5.312731
## Body -9.606595 -1.5065951 6.2833170 5.9211498 8.50245379 -5.473133
## Balance 6.859629 -2.9880390 2.2392399 -0.7222852 10.93502021 -12.414838
# Standarized coefficients of X
std_coef_x<-cc1$xcoef*apply(X,2,sd)
std_coef_x
## [,1] [,2] [,3] [,4] [,5] [,6]
## A39 0.12111154 1.100875631 -1.95776667 -0.1485973 0.116058025 -3.38428760
## A47 0.91653952 -1.291570813 1.92866470 -1.0414360 -0.333285757 0.08802417
## A65 -0.23332840 0.513249920 -1.53332975 2.0961472 -1.448631339 -1.41527888
## A143 -0.75727080 -0.612684105 0.47025390 -0.4119453 -0.339735503 0.13882537
## A37 -0.68691564 -0.315584701 -1.13162137 0.9565380 0.843551872 -0.71408559
## A54 -0.35686931 -0.245419919 -1.95368720 0.5885949 1.398588806 -1.61194781
## A40 2.17986039 -0.016113763 -0.02626105 0.1192340 0.780119108 3.19629981
## A48 -2.67267547 0.388152668 -0.20261446 1.9062438 -2.047407300 0.48958839
## A64 0.35935387 -1.529659961 2.71987351 -1.0901548 0.786891828 2.75331432
## A95 0.02752625 -0.007652878 -0.17152983 0.9849038 0.006011009 0.24035616
# Standarized coefficients of Y
std_coef_y<-cc1$ycoef*apply(Y,2,sd)
std_coef_y
## [,1] [,2] [,3] [,4] [,5] [,6]
## Aroma -0.6218075 0.09485016 0.9580641 -0.9102812 -0.429238356 -1.4577571
## Flavor 0.9535616 0.12763535 0.1780153 -1.9545639 -0.205916502 1.8811221
## Aftertaste -0.1494282 -0.57619884 0.1047565 2.5558186 -1.825227103 1.2260566
## Acidity 0.1491204 1.69499748 -1.5077040 -0.1229713 0.003347704 0.7003190
## Body -1.1997992 -0.18816362 0.7847441 0.7395119 1.061899408 -0.6835575
## Balance 1.0324065 -0.44971394 0.3370161 -0.1087073 1.645772007 -1.8684915
# Calculate structure correlations
struc_cor_x <- cor(X, cc1$scores$xscores)
struc_cor_y <- cor(Y, cc1$scores$yscores)
# Compute redundancy indices
can_cor <- cc1$cor
redundancy_x <- colMeans(struc_cor_x^2) * can_cor^2
redundancy_y <- colMeans(struc_cor_y^2) * can_cor^2
print(redundancy_x)
## [1] 0.097259497 0.186313911 0.189240520 0.081579061 0.081887582 0.005481592
print(redundancy_y)
## [1] 0.131114753 0.364807174 0.345356050 0.045199788 0.040012408 0.007433086
# Total redundancy
total_redundancy_x <- sum(redundancy_x)
total_redundancy_y <- sum(redundancy_y)
# Print results
print(paste("Total redundancy for X:", total_redundancy_x))
## [1] "Total redundancy for X: 0.641762162203502"
print(paste("Total redundancy for Y:", total_redundancy_y))
## [1] "Total redundancy for Y: 0.933923260078981"
# compute canonical loadings
cc2 <- comput(X, Y, cc1)
# display canonical loadings
cc2[3:6]
## $corr.X.xscores
## [,1] [,2] [,3] [,4] [,5] [,6]
## A39 -0.009894824 -0.51844895 -0.29461054 -0.09094885 0.2758585 -0.14013299
## A47 -0.120012779 -0.63607368 -0.53207918 -0.23745803 -0.2677484 0.04832051
## A65 0.639843920 -0.07438062 0.37077013 0.42483636 -0.2012171 -0.23496149
## A143 -0.273390771 -0.66425085 -0.29966698 -0.37272283 -0.1917966 0.13163982
## A37 -0.147535412 -0.08251180 0.05799198 0.38031560 0.6246354 -0.07870764
## A54 0.002802051 -0.47526199 -0.52841512 -0.31380794 -0.3594057 0.11038652
## A40 0.014899394 -0.51527423 -0.67114369 -0.24613419 -0.1051533 0.26551081
## A48 -0.298930925 -0.41612800 -0.57538421 -0.22392423 -0.1584574 0.18398430
## A64 0.374738524 -0.25597360 0.41359373 0.34277777 0.3216539 -0.23055841
## A95 -0.471344922 0.07828054 0.39063500 0.35123120 0.3901148 -0.04788864
##
## $corr.Y.xscores
## [,1] [,2] [,3] [,4] [,5] [,6]
## Aroma 0.1757727 0.6453630 0.6265087 0.01135818 -0.27369710 -0.096120790
## Flavor 0.3492203 0.4928411 0.7097767 0.03424555 0.10147814 0.136217276
## Aftertaste 0.4059457 0.5212831 0.6162211 0.34482794 -0.11422497 0.034754225
## Acidity 0.2527561 0.8771141 0.3300197 0.20417782 0.04178073 0.008024825
## Body -0.1299905 0.5112798 0.6482685 0.21779240 0.35180311 0.116377586
## Balance 0.6231072 0.4764297 0.5166688 0.24873387 0.12770331 -0.044588889
##
## $corr.X.yscores
## [,1] [,2] [,3] [,4] [,5] [,6]
## A39 -0.009894824 -0.51844838 -0.28766316 -0.08303233 0.24522761 -0.06282945
## A47 -0.120012779 -0.63607297 -0.51953191 -0.21678880 -0.23801807 0.02166479
## A65 0.639843920 -0.07438054 0.36202679 0.38785703 -0.17887427 -0.10534636
## A143 -0.273390771 -0.66425011 -0.29260036 -0.34027965 -0.17049984 0.05902148
## A37 -0.147535412 -0.08251170 0.05662444 0.34721152 0.55527697 -0.03528903
## A54 0.002802051 -0.47526146 -0.51595425 -0.28649294 -0.31949788 0.04949244
## A40 0.014899394 -0.51527366 -0.65531706 -0.22470976 -0.09347722 0.11904333
## A48 -0.298930925 -0.41612754 -0.56181574 -0.20443303 -0.14086254 0.08249044
## A64 0.374738524 -0.25597332 0.40384054 0.31294112 0.28593803 -0.10337221
## A95 -0.471344922 0.07828046 0.38142321 0.32065873 0.34679709 -0.02147115
##
## $corr.Y.yscores
## [,1] [,2] [,3] [,4] [,5] [,6]
## Aroma 0.1757727 0.6453637 0.6416396 0.01244110 -0.30788403 -0.21438504
## Flavor 0.3492203 0.4928416 0.7269186 0.03751061 0.11415355 0.30381509
## Aftertaste 0.4059457 0.5212836 0.6311035 0.37770477 -0.12849256 0.07751482
## Acidity 0.2527561 0.8771151 0.3379900 0.22364468 0.04699947 0.01789834
## Body -0.1299905 0.5112803 0.6639249 0.23855732 0.39574608 0.25956522
## Balance 0.6231072 0.4764302 0.5291469 0.27244883 0.14365446 -0.09944978
# tests of canonical dimensions
rho <- cc1$cor
## Define number of observations, number of variables in first set, and number of variables in the second set.
n <- dim(X)[1]
p <- length(X)
q <- length(Y)
## Calculate p-values using the F-approximations of different test statistics:
p.asym(rho, n, p, q, tstat = "Wilks")
## Wilks' Lambda, using F-approximation (Rao's F):
## stat approx df1 df2 p.value
## 1 to 6: 0.000000e+00 Inf 60 5.055523 0.0000000000
## 2 to 6: 2.883199e-09 13.4897188 45 7.576078 0.0004493726
## 3 to 6: 1.300543e-03 1.4187849 32 8.970816 0.3004969314
## 4 to 6: 2.790440e-02 1.0813137 21 9.164491 0.4750815930
## 5 to 6: 1.675831e-01 0.9618552 12 8.000000 0.5407877618
## 6 to 6: 7.989770e-01 0.2516004 5 5.000000 0.9219196494
p.asym(rho, n, p, q, tstat = "Hotelling")
## Warning in pf(approx[rhostart], df1[rhostart], df2[rhostart]): Se han producido
## NaNs
## Hotelling-Lawley Trace, using F-approximation:
## stat approx df1 df2 p.value
## 1 to 6: Inf -Inf 60 -10 NaN
## 2 to 6: 4.511048e+05 3341.5170268 45 2 0.0002992185
## 3 to 6: 2.948083e+01 2.1496441 32 14 0.0646404634
## 4 to 6: 9.024862e+00 1.8622732 21 26 0.0665498091
## 5 to 6: 4.019246e+00 2.1212689 12 38 0.0390126633
## 6 to 6: 2.516004e-01 0.4193341 5 50 0.8330701368
# Canonical variates (linear combinations of X and Y)
X_canon <- as.matrix(X) %*% cc1$xcoef
Y_canon <- as.matrix(Y) %*% cc1$ycoef
# Plot the first canonical variates
plot(X_canon[,1], Y_canon[,1],
xlab = "Canonical Variate 1 (X)",
ylab = "Canonical Variate 1 (Y)",
main = "Scatter plot of first pair of canonical variates")
plot(X_canon[,2], Y_canon[,2],
xlab = "Canonical Variate 2 (X)",
ylab = "Canonical Variate 2 (Y)",
main = "Scatter plot of the second pair of canonical variates")
plot(X_canon[,3], Y_canon[,3],
xlab = "Canonical Variate 3 (X)",
ylab = "Canonical Variate (Y)",
main = "Scatter plot of the third pair of canonical variates")
# Create a data frame of canonical correlations
canon_corr_df <- data.frame(Variable = 1:length(cc1$cor),
Correlation = cc1$cor)
# Bar plot of canonical correlations
ggplot(canon_corr_df, aes(x = as.factor(Variable), y = Correlation)) +
geom_bar(stat = "identity") +
xlab("Canonical Pair") +
ylab("Canonical Correlation") +
ggtitle("Canonical Correlations for Each Canonical Pair")
plt.cc(cc1, var.label = TRUE, d1 = 1, d2 = 2, type = "b")
plt.cc(cc1,d1=1,d2=2, type = "b")
