Preferences

#farei una PCA/interpreterei gli assi
quantiles=20
res<-WH.MultiplePCA_discr(Fin_tibble,list.of.vars = c(2:13),quantiles = quantiles,ncp_in = 8)

head(res$eig)
##        eigenvalue percentage of variance cumulative percentage of variance
## comp 1  7.6702762              33.811457                          33.81146
## comp 2  2.3769981              10.478080                          44.28954
## comp 3  1.2412899               5.471748                          49.76129
## comp 4  0.9320211               4.108456                          53.86974
## comp 5  0.6490077               2.860900                          56.73064
## comp 6  0.6018761               2.653139                          59.38378

Expected vs perceived quality

resL12<-WH.MultiplePCA_discr(Fin_tibble,list.of.vars = c(14:15),quantiles = 20,ncp_in = 5)

head(resL12$eig)
##        eigenvalue percentage of variance cumulative percentage of variance
## comp 1  1.8125071              41.440313                          41.44031
## comp 2  0.8045132              18.394012                          59.83433
## comp 3  0.3468366               7.929910                          67.76424
## comp 4  0.1981391               4.530159                          72.29439
## comp 5  0.1450994               3.317485                          75.61188
## comp 6  0.1154191               2.638888                          78.25077

EYE-iris plots

Eye-iris plot is a polar plot for showing the stacked percentage barcharts of the ratings assigned to a set of items.

How to read

The dashed line represents the 50/% of preferences. The more the Eye-Iris is dominated by the green the more the rating is high.

Problems: low and medium-low rating frequencies are over-represented (perceptually, the plot is more sensitive to low ratings).

Performance plots of the first factorial plane of items

### EYE-iris plots
## 126 and 142 the farthest
Performance_plot(Fin_tibble[,2:13],selected = 91,labels=labs)+
  Performance_plot(Fin_tibble[,2:13],selected = 92,labels=labs)+
  Performance_plot(Fin_tibble[,2:13],selected = 14,labels=labs)+
  Performance_plot(Fin_tibble[,2:13],selected = 142,labels=labs)+
  Performance_plot(Fin_tibble[,2:13],selected = 5,labels=labs)+
  Performance_plot(Fin_tibble[,2:13],selected = 126,labels=labs)+
    Performance_plot(Fin_tibble[,2:13],selected = 162,labels=labs)+
  Performance_plot(Fin_tibble[,2:13],selected = 133,labels=labs)+
    Performance_plot(Fin_tibble[,2:13],selected = 79,labels=labs)

Performance plots on the first plane considering L1 and L2 (expected and perceived)

Note: we use the same units described above

Performance_plot(Fin_tibble[,14:15],selected = 91,labels=labs)+
  Performance_plot(Fin_tibble[,14:15],selected = 92,labels=labs)+
  Performance_plot(Fin_tibble[,14:15],selected = 14,labels=labs)+
  Performance_plot(Fin_tibble[,14:15],selected = 142,labels=labs)+
  Performance_plot(Fin_tibble[,14:15],selected = 5,labels=labs)+
  Performance_plot(Fin_tibble[,14:15],selected = 126,labels=labs)+
    Performance_plot(Fin_tibble[,14:15],selected = 162,labels=labs)+
  Performance_plot(Fin_tibble[,14:15],selected = 133,labels=labs)+
    Performance_plot(Fin_tibble[,14:15],selected = 79,labels=labs)

Plotterei gli EYE-iris al posto dei punti sui piani fattoriali

 nn<-nrow(Fin_tibble)

for(i in 1:nn){
  fname<-paste0("./Images/im_",i,".png")
  pp<-Performance_plot(Fin_tibble[,2:13],selected = i,labels=labs)
    
#CairoPNG(filename = fname, bg = "transparent")
ggsave(filename = fname,
       plot = pp,
       width = 3, 
       height = 3,
       dpi=100#,bg='transparent'
      )
}

 df_im<-data.frame(ID=c(1:nn)) %>% mutate(adr=paste0("./Images/im_",ID,".png"))

The green-eye-plots on the map

df<-as.data.frame(res$ind$coord)
df<-cbind(df,df_im)
df<-cbind(df,allcat=categ$allcat,SY=categ$SY)
df$labels<-Fin_tibble$LAB
p<-ggplot(df,aes(x=.data[[names(df)[1]]], 
              y=.data[[names(df)[2]]]))+
  #geom_point()+
  #geom_text(aes(label=ID))+
  geom_point_img(aes(
    x = .data[[names(df)[1]]],
    y = .data[[names(df)[2]]],
    img = adr
  ), size = 1.2,alpha=0.6)+
  theme_minimal()
p

A plot with background eyes

First plane of MFA

a tentative with trajectories

library(plotly)
ggplotly(ggplot(df,aes(x=.data[[names(df)[1]]], 
              y=.data[[names(df)[2]]],color=allcat))+geom_path(show.legend = F)+
           geom_text(aes(label=SY)))
ggplotly(ggplot(df,aes(x=.data[[names(df)[1]]], 
              y=.data[[names(df)[2]]],color=SY))+geom_point(show.legend = F,aes(text=allcat,text2=c(1:nrow(df))))
           )

3D plots

fig <- plot_ly(df, x = ~Dim.1, y = ~Dim.2, z = ~Dim.3, color = ~allcat,size=1,
               hoverinfo = 'text',
               text = ~paste('Cat:', allcat, '<br>Sea:', SY))
fig <- fig %>% add_markers()
fig <- fig %>% layout(scene = list(xaxis = list(title = 'Dim.1'),
                     yaxis = list(title = 'Dim.2'),
                     zaxis = list(title = 'Dim.3')))

fig

Time series

# df_ts<-df %>% select(adr, allcat,SY) %>% pivot_wider(names_from = SY,values_from = adr,values_fill = NA)
# PATH="Images/im_2.png"
# df_ts$E_15[1]<-paste0("<img src=\"",df_ts$E_15[1],"\" height=\"52\"></img>")
# df_ts$E_15[2]<-paste0("<img src=\"",PATH,"\" height=\"52\"></img>")
df_3<-df %>% filter(grepl("BARI",allcat))%>%filter(grepl("Leisure",allcat))%>%  select(adr, allcat,SY)
p2<-ggplot(df_3,aes(x=SY, 
              y=allcat))+
  #geom_point()+
  #geom_text(aes(label=ID))+
  geom_point_img(aes(
    x = SY,
    y = allcat,
    img = adr
  ), size = 3.5,alpha=0.6)+coord_fixed(ratio=1)+
  theme_minimal()+ggtitle("BARI Leisure")+xlab("")+ylab("")
p2

df_3<-df %>% filter(grepl("BARI",allcat))%>%filter(grepl("Business",allcat))%>%  select(adr, allcat,SY)
p2<-ggplot(df_3,aes(x=SY, 
              y=allcat))+
  #geom_point()+
  #geom_text(aes(label=ID))+
  geom_point_img(aes(
    x = SY,
    y = allcat,
    img = adr
  ), size = 3.5,alpha=0.6)+coord_fixed(ratio=1)+
  theme_minimal()+ggtitle("BARI Business")+xlab("")+ylab("")
p2

df_4<-df %>% filter(grepl("BRINDISI",allcat))%>% filter(grepl("Leisure",allcat))%>% select(adr, allcat,SY)
p3<-ggplot(df_4,aes(x=SY, 
              y=allcat))+
  #geom_point()+
  #geom_text(aes(label=ID))+
  geom_point_img(aes(
    x = SY,
    y = allcat,
    img = adr
  ), size = 3.5,alpha=0.6)+coord_fixed(ratio=1)+
  theme_minimal()+ggtitle("BRINDISI Leisure")+xlab("")+ylab("")
p3

df_4<-df %>% filter(grepl("BRINDISI",allcat))%>% filter(grepl("Business",allcat))%>% select(adr, allcat,SY)
p3<-ggplot(df_4,aes(x=SY, 
              y=allcat))+
  #geom_point()+
  #geom_text(aes(label=ID))+
  geom_point_img(aes(
    x = SY,
    y = allcat,
    img = adr
  ), size = 3.5,alpha=0.6)+coord_fixed(ratio=1)+
  theme_minimal()+ggtitle("BRINDISI Business")+xlab("")+ylab("")
p3

Estrai gli scores dalle due PCA

Plot of inertia

round(res$eig[which(res$eig[,3]<81),],3)
##         eigenvalue percentage of variance cumulative percentage of variance
## comp 1       7.670                 33.811                            33.811
## comp 2       2.377                 10.478                            44.290
## comp 3       1.241                  5.472                            49.761
## comp 4       0.932                  4.108                            53.870
## comp 5       0.649                  2.861                            56.731
## comp 6       0.602                  2.653                            59.384
## comp 7       0.512                  2.259                            61.642
## comp 8       0.456                  2.009                            63.652
## comp 9       0.409                  1.804                            65.455
## comp 10      0.359                  1.581                            67.036
## comp 11      0.310                  1.367                            68.403
## comp 12      0.297                  1.309                            69.712
## comp 13      0.286                  1.263                            70.975
## comp 14      0.263                  1.161                            72.136
## comp 15      0.258                  1.139                            73.275
## comp 16      0.232                  1.025                            74.300
## comp 17      0.212                  0.934                            75.234
## comp 18      0.192                  0.846                            76.079
## comp 19      0.184                  0.809                            76.888
## comp 20      0.179                  0.789                            77.677
## comp 21      0.171                  0.753                            78.431
## comp 22      0.160                  0.707                            79.137
## comp 23      0.145                  0.641                            79.778
## comp 24      0.145                  0.637                            80.416
library(DT)
library(colorspace)
contr_1<-as.data.frame(round(res$quanti.var$contrib,4))

COS2_vars_1<-as.data.frame(round(res$quanti.var$cos2,4))
coord_1<-as.data.frame(round(res$quanti.var$coord,4))
correl_1<-as.data.frame(round(res$quanti.var$cor,4))

Coordinates

dt<-datatable(coord_1,  caption = 'Coordinates.',
              extensions = 'Scroller', options = list(
                pageLength = 15,
  deferRender = TRUE,
  scrollY = 600,
  scroller = TRUE
))

for (x in colnames(coord_1)) {
  
  #v <- full_seq(unique(COS2_coord_1[[x]]), .01)
  v<-seq(min(coord_1[[x]]), max(coord_1[[x]]), by = 0.01)
  #browser()
  
  cs <- diverging_hsv(length(v),
  h = c(180, 330) )
  l_cs<-length(cs)

  dt <- dt %>% 
    formatStyle(x, backgroundColor = styleInterval(v[1:(l_cs-1)], cs), fontSize = '80%')
}

dt 
 # brks <- quantile(COS2_coord_1$Dim.1, probs = seq(.05, .95, .05), na.rm = TRUE)
 # clrs <- round(seq(255, 40, length.out = length(brks) + 1), 0) %>%
 #   {paste0("rgb(255,", ., ",", ., ")")}
 # 
 # DT::datatable(COS2_coord_1)%>% formatStyle('Dim.1', backgroundColor = styleInterval(brks, clrs))

Contributions

dt<-datatable(contr_1,  caption = 'Contributes.',
              extensions = 'Scroller', options = list(
                pageLength = 15,
  deferRender = TRUE,
  scrollY = 600,
  scroller = TRUE
))

for (x in colnames(contr_1)) {
  
  #v <- full_seq(unique(COS2_coord_1[[x]]), .01)
  v<-seq(min(contr_1[[x]]), max(contr_1[[x]]), by = 0.5)
  #browser()
  
  cs <- diverging_hsv(length(v),
  h = c(180, 330) )
  l_cs<-length(cs)

  dt <- dt %>% 
    formatStyle(x, backgroundColor = styleInterval(v[1:(l_cs-1)], cs), fontSize = '80%')
}

dt

cos2

dt<-datatable(COS2_vars_1,  caption = 'Squared cosines',
              extensions = 'Scroller', options = list(
                pageLength = 15,
  deferRender = TRUE,
  scrollY = 600,
  scroller = TRUE
))

for (x in colnames(COS2_vars_1)) {
  
  #v <- full_seq(unique(COS2_coord_1[[x]]), .01)
  v<-seq(min(COS2_vars_1[[x]]), max(COS2_vars_1[[x]]), by = 0.05)
  #browser()
  
   cs <- sequential_hcl(length(v),
                       c = c(100, NA, 30), l = c(55, 90), power = c(1.1, NA),
  h = c(15, 50),rev=T)
  l_cs<-length(cs)

  dt <- dt %>% 
    formatStyle(x, backgroundColor = styleInterval(v[1:(l_cs-1)], cs), fontSize = '80%')
}

dt

Corr

dt<-datatable(correl_1,  caption = 'Correlations',
              extensions = 'Scroller', options = list(
                pageLength = 15,
  deferRender = TRUE,
  scrollY = 600,
  scroller = TRUE
))

for (x in colnames(correl_1)) {
  
  #v <- full_seq(unique(COS2_coord_1[[x]]), .01)
  v<-seq(min(correl_1[[x]]), max(correl_1[[x]]), by = 0.01)
  #browser()
  
  cs <- diverging_hsv(length(v),
  h = c(180, 330) )
  l_cs<-length(cs)

  dt <- dt %>% 
    formatStyle(x, backgroundColor = styleInterval(v[1:(l_cs-1)], cs), fontSize = '80%')
}

dt

Explanatory statistics for each variable

Contributes of vars to the axes

# contr_1<-as.data.frame(round(res$quanti.var$contrib,4))
# COS2_vars_1<-as.data.frame(round(res$quanti.var$cos2,4))
# coord_1<-as.data.frame(round(res$quanti.var$coord,4))
# correl_1<-as.data.frame(round(res$quanti.var$cor,4))
vars<-nrow(contr_1)/(quantiles+1)
Contr_var_1<-matrix(0,vars,ncol(res$quanti.var$contrib))
tmp_rn<-character()
for (i in 1:vars){
  ini<-(i-1)*(quantiles+1)+1
  fin<-(i)*(quantiles+1)
  tmp_rn<-c(tmp_rn,sub(".Min", "", row.names(res$quanti.var$contrib)[ini]))
  for (j in 1:ncol(res$quanti.var$contrib)){
    
    Contr_var_1[i,j]<-round(sum(res$quanti.var$contrib[c(ini:fin),j]),2)
  }
  
  
}
row.names(Contr_var_1)<-tmp_rn
colnames(Contr_var_1)<-colnames(res$quanti.var$contrib)

dt<-datatable(Contr_var_1,  caption = 'Contr_vars',
              extensions = 'Scroller', options = list(
                pageLength = 15,
  deferRender = TRUE,
  scrollY = 300,
  scroller = TRUE
))
dt

Plot dei coseni al quadrato (R2)

# COS2_vars_1<-as.data.frame(round(res$quanti.var$cos2,4))
# COS2_vars_1
vars<-nrow(contr_1)/(quantiles+1)
tmp_rn<-character()
QUA<-rep(c(0:quantiles)/quantiles,vars)
for (i in 1:vars){
  ini<-(i-1)*(quantiles+1)+1
  fin<-(i)*(quantiles+1)
  tmp_rn<-c(tmp_rn,rep(sub(".Min", "", row.names(res$quanti.var$contrib)[ini]),quantiles+1))
  
}
COS2_vars_1$VARS<-factor(tmp_rn)
COS2_vars_1$QUA<-round(QUA,3)
COS2_vars_1_pv<-pivot_longer(COS2_vars_1,cols = -c(VARS,QUA))
ggplot(COS2_vars_1_pv, aes(x=QUA,y=value))+geom_bar(stat="identity",aes(fill=value))+facet_grid(rows=vars(VARS),cols=vars(name))+
  ggtitle("Plot of Cos2 of quantiles of variables")+theme_minimal()

correlations

# COS2_vars_1<-as.data.frame(round(res$quanti.var$cos2,4))
# COS2_vars_1
vars<-nrow(correl_1)/(quantiles+1)
tmp_rn<-character()
QUA<-rep(c(0:quantiles)/quantiles,vars)
for (i in 1:vars){
  ini<-(i-1)*(quantiles+1)+1
  fin<-(i)*(quantiles+1)
  tmp_rn<-c(tmp_rn,rep(sub(".Min", "", row.names(res$quanti.var$contrib)[ini]),quantiles+1))
  
}
correl_1$VARS<-factor(tmp_rn)
correl_1$QUA<-round(QUA,3)
correl_1_pv<-pivot_longer(correl_1,cols = -c(VARS,QUA))
ggplot(correl_1_pv, aes(x=QUA,y=value))+geom_bar(stat="identity",aes(fill=value))+facet_grid(rows=vars(VARS),cols=vars(name))+
  ggtitle("Plot of correl of quantiles of variables")+
  scale_fill_gradient2(low = "red",mid = "white",high = "darkgreen",midpoint = 0,limits=c(-1,1))+
  theme_minimal()

Costruisci la frontiera e mettici i punti in base agli scores

To be done!!

res_L1<-WH.1d.PCA_discr(Fin_tibble, var=14, quantiles = quantiles,plots = T)
## We do a PCA on variable --->  L1

res_L2<-WH.1d.PCA_discr(Fin_tibble, var=15, quantiles = quantiles,plots = T)
## We do a PCA on variable --->  L2

Scores_on_1_2_FACT<-res$ind$coord[,1:2]
Scores_on_1_2_L12<-resL12$ind$coord[,1:2]
Scores_on_1_2_L1<-res_L1$PCAout$ind$coord[,1]
Scores_on_1_2_L2<-res_L2$PCAout$ind$coord[,1]
ALL_1_2<-cbind(Scores_on_1_2_FACT,Scores_on_1_2_L1,Scores_on_1_2_L2)
colnames(ALL_1_2)<-c("Dim.1","Dim.2","L12.1","L12.2")
ggplotly(ggplot(as.data.frame(round(ALL_1_2,3)))+geom_point(aes(x=L12.1,y=Dim.1,text=c(1:nrow(ALL_1_2)))))
ggplotly(ggplot(as.data.frame(ALL_1_2))+geom_point(aes(x=L12.1,y=Dim.2,text=c(1:nrow(ALL_1_2)))))
ggplotly(ggplot(as.data.frame(ALL_1_2))+geom_point(aes(x=L12.2,y=Dim.1,text=c(1:nrow(ALL_1_2)))))
ggplotly(ggplot(as.data.frame(ALL_1_2))+geom_point(aes(x=L12.2,y=Dim.2,text=c(1:nrow(ALL_1_2)))))
df<-as.data.frame(round(ALL_1_2,3))

fig <- plot_ly(df, x = ~Dim.1, y = ~Dim.2, z = ~L12.1, 
               marker=#list(size=5,color='red'),
               list(color=~L12.1, colorscale = c('#FFE1A1', '#683531'), showscale = TRUE,size=5),
               hoverinfo = 'text', 
               text = ~paste('ID:', c(1:nrow(df))))
fig <- fig %>% add_markers()
fig <- fig %>% layout(scene = list(xaxis = list(title = 'Dim.1'),
                     yaxis = list(title = 'Dim.2'),
                     zaxis = list(title = 'L1')))

fig
scatter3d(x = df$Dim.1, z = df$Dim.2, y = df$L12.1, 
          grid = T,surface=F)

Pred

Best

Performance_plot(Fin_tibble[,2:13],selected = 92,labels=labs)+
  Performance_plot(Fin_tibble[,2:13],selected = 126,labels=labs)

Worst

Performance_plot(Fin_tibble[,2:13],selected = 142,labels=labs)+
  Performance_plot(Fin_tibble[,2:13],selected = 87,labels=labs)

L1 e L2

Best

Performance_plot(Fin_tibble[,14:15],selected = 92,labels=labs)+
  Performance_plot(Fin_tibble[,14:15],selected = 126,labels=labs)

Worst

Performance_plot(Fin_tibble[,14:15],selected = 142,labels=labs)+
  Performance_plot(Fin_tibble[,14:15],selected = 87,labels=labs)