knitr::opts_chunk$set(echo = TRUE)
if(!require("tidyverse")) {install.packages("tidyverse"); library("tidyverse")}
if(!require("haven")) {install.packages("haven"); library("haven")}
if(!require("Hmisc")) {install.packages("Hmisc"); library("Hmisc")}
if(!require("sjlabelled")) {install.packages("sjlabelled"); library("sjlabelled")}
if(!require("DescTools")) {install.packages("DescTools"); library("DescTools")}
if(!require("psych")) {install.packages("psych"); library("psych")}
if(!require("MASS")) {install.packages("MASS"); library("MASS")}
if(!require("dplyr")) {install.packages("dplyr"); library("dplyr")}
if(!require("REdaS")) {install.packages("REdaS"); library("REdaS")}
if(!require("scatterplot3d")) {install.packages("scatterplot3d"); library("scatterplot3d")}
# clean up working environment
rm(list = ls())
# Generate data
mydatc7_case <- data.frame(Price = c(3, 6, 2, 4, 7, 5, 6, 3, 7, 3, 7, 7, 6, 3, 4, 4, 3, 6, 7, 5, 3, 6, 4, 6, 6, 6, 5, 6, 3, 7, 2, 6, 5, 5, 4, 7, 5, 4, 2, 3, 3, 7, 3, 6, 4, 2, 3, 4, 6, 1, 2, 2, 3, 2, 5, 1, 3, 3, 5, 7, 3, 2, 3, 2, 6, 2, 3, 7, 5, 3, 6, 5, 6, 6, 4, 5, 5, 5, 6, 7, 5, 7, 5, 7, 6, 6, 6, 6, 7, 6, 5, 5, 4, 7, 7, 7, 5, 5, 6, 5, 2, 6, 5, 5, 4, 4, 6, 5, 5, 5, 6, 6, 5, 4, 5, 4, 7, 4, 5, 5, 3, 5, 6, 4, 5, 3, 5),
Refreshing = c(3, 6, 3, 3, 5, 4, 5, 3, 6, 4, 1, 7, 5, 3, 6, 3, 4, 3, 7, 2, 4, 2, 3, 2, 5, 2, 2, 5, 4, 7, 2, 5, 3, 4, 6, 4, 5, 5, 2, 6, 7, 7, 5, 2, 5, 7, 7, 6, 7, 7, 2, 4, 6, 4, 4, 3, 6, 7, 4, 5, 5, 7, 1, 2, 4, 1, 4, 4, 3, 4, 2, 3, 3, 4, 2, 3, 3, 5, 4, 5, 4, 6, 2, 5, 2, 4, 6, 2, 6, 6, 4, 4, 5, 6, 4, 7, 2, 4, 4, 2, 2, 4, 6, 4, 3, 7, 5, 5, 1, 4, NA, 5, 3, 1, 3, 4, 5, 4, 3, 3, 3, 5, 7, 3, 4, 4, 4),
Delicious = c(5, 5, 3, 3, 5, 5, 6, 3, 6, 4, 4, 3, 4, 4, 2, 4, 4, 5, 3, 3, 4, 5, 4, 4, 7, 6, 4, 6, 6, 4, 5, 4, 4, 4, 4, 6, 4, 4, 2, 3, 3, 7, 3, 3, 4, 5, 5, 6, 5, 1, 2, 4, 2, 3, 5, 3, 4, 3, 4, 6, 5, 3, 3, 2, 4, 2, 6, 6, 6, 3, 6, 4, 5, 5, 4, 4, 4, 5, 5, 4, 4, 6, 5, 4, 6, 5, 6, 6, 2, 6, 4, 4, 4, 7, 2, 7, 5, 4, 4, 6, 5, 6, 5, 4, 4, 4, 4, 4, 4, 4, 3, 4, 3, 4, 5, 4, 4, 4, 4, 5, 3, 5, 5, 4, 4, 4, 4),
Healthy = c(4, 2, 3, 4, 7, 2, 5, 4, 2, 4, 5, 7, 3, 3, 4, 4, 4, 4, 2, 4, 4, 2, 3, 5, 3, 4, 4, 4, 2, NA, 4, 1, 4, 4, 4, 4, 3, 3, 2, 3, 1, 3, 2, 2, 5, 6, 6, 4, 4, NA, 6, 4, 2, 5, 3, 3, 4, 1, 4, 3, 4, 2, 6, 6, 4, 2, 4, 4, 5, 4, 4, 4, 5, 1, 2, 3, 5, 4, 5, 5, 4, 3, 2, 4, 4, 6, 4, 4, 4, 6, 3, 5, 4, 1, 6, 4, 2, 5, 6, 3, 4, 3, 4, 4, 3, 4, 4, 5, 3, 4, 4, 4, 4, 3, 6, 4, 4, 3, 4, 4, 4, 5, 5, 3, 6, 4, 1),
Bitter = c(1, 2, 2, 4, 3, 5, 6, 3, 3, 2, 1, 1, 1, 1, 1, 4, 3, 4, 1, 4, 3, 3, 4, 6, 3, 6, 6, 6, 6, 4, 3, 1, 4, 4, 4, 5, 4, 4, 3, 7, 4, 7, 3, 4, 5, 5, 1, 6, 2, 7, 6, 4, 2, 2, 3, 1, 6, 4, 4, 6, 3, 6, 5, 6, 4, 2, 6, 5, 7, 2, 6, 5, 3, 5, 5, 4, 2, 5, 5, 3, 4, 2, 3, 3, 5, 6, 6, 6, 3, 3, 3, 3, 3, 7, 1, 5, 3, 3, 7, 5, 3, 5, 5, 4, 3, 4, 5, 4, 6, 5, 2, 4, 3, 1, 7, 4, 4, 2, 3, 4, 4, 4, 5, 3, 4, 4, 4),
Light = c(2, 5, 3, 3, 6, 4, 5, 2, 7, 5, 4, 3, 2, 4, 3, 4, 3, 4, 2, 4, 4, 4, 5, 6, 2, 6, 5, 6, 4, 6, 5, 3, 3, 5, 4, 5, 3, 5, 2, 5, 6, 7, 3, 3, 5, 6, 7, 7, 6, 7, 5, 6, 4, 5, 4, 7, 6, 6, 4, 6, 5, 7, 5, 5, 4, 4, 6, 6, 6, 4, 6, 5, 6, 6, 3, 3, 1, 4, 4, 5, 4, 6, 5, 4, 6, 5, 6, 6, 4, 6, 5, 4, 3, 7, 2, 7, 2, 4, 5, 4, 5, 4, 5, 4, 5, 4, 4, 4, 4, 5, 6, 3, 4, 2, 5, 4, 4, 2, 3, 3, 5, 5, 5, 3, 5, 4, 4),
Crunchy = c(3, 2, 5, 5, 5, 3, 6, 3, 5, 5, 1, 1, NA, 2, 1, 4, 3, 4, 5, 5, 3, 2, 4, 3, 3, 4, 4, 4, 6, 7, 3, 4, 4, 4, 3, 5, 1, 5, 6, 4, 3, 7, 5, 5, 5, 5, 6, 4, 6, 7, 5, 4, 5, 7, 5, 5, 7, 3, 3, 4, 6, 7, 6, 5, 4, 5, 7, 4, 2, 5, 4, 3, 3, 6, 5, 6, 4, 6, 6, 6, 3, 1, 2, 4, 2, 5, 3, 4, 3, 2, 4, 3, 3, 2, 3, 7, 2, 4, 6, 6, 3, 3, NA, 4, 3, 1, 5, 5, 5, 4, 5, 5, 3, 3, 7, 4, 4, 3, 3, 5, 3, 3, 5, 4, 5, 4, 1),
Exotic = c(1, 1, 1, 2, 1, 7, 5, 1, 1, 1, 1, 1, 1, 3, 2, 4, 7, 3, 1, 3, 1, 1, 7, 1, 1, 6, 6, 5, 7, 1, 1, 1, 1, 4, 1, 1, 1, 1, 6, 7, 7, 1, 7, 1, 1, 7, 7, 5, 7, 7, 7, 2, 7, 2, 2, 7, 7, 7, 5, 1, 7, 7, NA, 7, NA, 7, 7, 1, 7, 2, 5, 1, 6, 7, 1, 1, 7, 5, 1, 1, 1, 1, 1, 1, 7, 1, 1, NA, 1, NA, 1, 1, NA, 7, 1, 1, 1, 1, 1, 7, 1, 1, 1, NA, 1, 1, 1, 7, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 5, 5, 5, 1, 1, 1, 1),
Sweet = c(3, 6, 3, 4, 5, 7, 6, 3, 6, 4, 3, 4, 3, 4, 4, 4, 5, 4, 1, 3, 1, 3, 4, 5, 3, 5, 5, 4, 2, 5, 4, 3, 2, 4, 4, 3, 3, 3, 3, 4, 4, 6, 2, 5, 3, 5, 5, 5, 6, 1, 4, 4, 3, 4, 4, 7, 6, 4, 3, 5, 5, 7, 5, 4, 4, 2, 6, 5, 6, 4, 5, 4, 4, 3, 5, 5, 4, 4, 5, 5, 3, 2, 4, 5, 6, 6, 4, 5, 4, 4, 6, 4, 4, 7, 5, 6, 3, 4, 5, 3, 4, 3, 2, 4, 3, 3, 4, 3, 4, 4, 3, 4, 3, 3, 6, 4, 5, 2, 3, 5, 4, 4, 5, 3, 4, 4, 1),
Fruity = c(4, 7, 2, 4, 5, 3, 5, 3, 3, 4, 5, 5, 1, 2, 4, 4, 5, 4, 1, 3, 3, 4, 4, 4, 1, 5, 4, 4, 4, 1, 5, 3, 2, 4, 4, 5, 3, 6, 2, 4, 5, 6, 4, 5, 6, 6, 6, 5, 5, 7, 6, 4, 6, 4, 4, 7, 7, 5, 3, 5, 5, 7, 4, 6, 4, 5, 7, 5, 3, 3, 5, 4, 4, 3, 4, 4, 1, 3, 6, 3, 2, 3, 5, 4, 3, 3, 2, 5, 4, 4, 5, 3, 3, 7, 2, 6, 4, 3, 6, 3, 5, 7, 4, 4, 3, 3, 4, 3, 4, 4, 4, 1, 4, 3, 6, 4, 5, 2, 3, 4, 3, 4, 5, 4, 4, 4, 4),
Respondent = c(1, 3, 4, 7, 11, 12, 16, 18, 2, 4, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 2, 8, 10, 11, 13, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 4, 7, 8, 10, 12, 13, 14, 16, 2, 6, 7, 8, 9, 12, 13, 14, 15, 16, 17, 18, 1, 2, 3, 4, 6, 8, 10, 11, 12, 13, 14, 15, 16, 17, 1, 2, 3, 4, 5, 6, 8, 9, 11, 13, 17, 18, 4, 5, 7, 9, 12, 13, 14, 15, 16, 17, 18, 1, 2, 3, 4, 6, 8, 9, 13, 17, 18),
Flavor = c(1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11))
# print(mydatc7_case)
# Set labels
mydatc7_case$Flavor <- factor(mydatc7_case$Flavor,
levels = c(1:11),
labels = c("Milk",
"Espresso",
"Biscuit",
"Orange",
"Strawberry",
"Mango",
"Cappuccino",
"Mousse",
"Caramel",
"Nougat",
"Nut"))
mydatc7_case[, c(1:11)] <- sapply(mydatc7_case[,c(1:11)], as.numeric)
print(mydatc7_case)
## Price Refreshing Delicious Healthy Bitter Light Crunchy Exotic Sweet Fruity
## 1 3 3 5 4 1 2 3 1 3 4
## 2 6 6 5 2 2 5 2 1 6 7
## 3 2 3 3 3 2 3 5 1 3 2
## 4 4 3 3 4 4 3 5 2 4 4
## 5 7 5 5 7 3 6 5 1 5 5
## 6 5 4 5 2 5 4 3 7 7 3
## 7 6 5 6 5 6 5 6 5 6 5
## 8 3 3 3 4 3 2 3 1 3 3
## 9 7 6 6 2 3 7 5 1 6 3
## 10 3 4 4 4 2 5 5 1 4 4
## 11 7 1 4 5 1 4 1 1 3 5
## 12 7 7 3 7 1 3 1 1 4 5
## 13 6 5 4 3 1 2 NA 1 3 1
## 14 3 3 4 3 1 4 2 3 4 2
## 15 4 6 2 4 1 3 1 2 4 4
## 16 4 3 4 4 4 4 4 4 4 4
## 17 3 4 4 4 3 3 3 7 5 5
## 18 6 3 5 4 4 4 4 3 4 4
## 19 7 7 3 2 1 2 5 1 1 1
## 20 5 2 3 4 4 4 5 3 3 3
## 21 3 4 4 4 3 4 3 1 1 3
## 22 6 2 5 2 3 4 2 1 3 4
## 23 4 3 4 3 4 5 4 7 4 4
## 24 6 2 4 5 6 6 3 1 5 4
## 25 6 5 7 3 3 2 3 1 3 1
## 26 6 2 6 4 6 6 4 6 5 5
## 27 5 2 4 4 6 5 4 6 5 4
## 28 6 5 6 4 6 6 4 5 4 4
## 29 3 4 6 2 6 4 6 7 2 4
## 30 7 7 4 NA 4 6 7 1 5 1
## 31 2 2 5 4 3 5 3 1 4 5
## 32 6 5 4 1 1 3 4 1 3 3
## 33 5 3 4 4 4 3 4 1 2 2
## 34 5 4 4 4 4 5 4 4 4 4
## 35 4 6 4 4 4 4 3 1 4 4
## 36 7 4 6 4 5 5 5 1 3 5
## 37 5 5 4 3 4 3 1 1 3 3
## 38 4 5 4 3 4 5 5 1 3 6
## 39 2 2 2 2 3 2 6 6 3 2
## 40 3 6 3 3 7 5 4 7 4 4
## 41 3 7 3 1 4 6 3 7 4 5
## 42 7 7 7 3 7 7 7 1 6 6
## 43 3 5 3 2 3 3 5 7 2 4
## 44 6 2 3 2 4 3 5 1 5 5
## 45 4 5 4 5 5 5 5 1 3 6
## 46 2 7 5 6 5 6 5 7 5 6
## 47 3 7 5 6 1 7 6 7 5 6
## 48 4 6 6 4 6 7 4 5 5 5
## 49 6 7 5 4 2 6 6 7 6 5
## 50 1 7 1 NA 7 7 7 7 1 7
## 51 2 2 2 6 6 5 5 7 4 6
## 52 2 4 4 4 4 6 4 2 4 4
## 53 3 6 2 2 2 4 5 7 3 6
## 54 2 4 3 5 2 5 7 2 4 4
## 55 5 4 5 3 3 4 5 2 4 4
## 56 1 3 3 3 1 7 5 7 7 7
## 57 3 6 4 4 6 6 7 7 6 7
## 58 3 7 3 1 4 6 3 7 4 5
## 59 5 4 4 4 4 4 3 5 3 3
## 60 7 5 6 3 6 6 4 1 5 5
## 61 3 5 5 4 3 5 6 7 5 5
## 62 2 7 3 2 6 7 7 7 7 7
## 63 3 1 3 6 5 5 6 NA 5 4
## 64 2 2 2 6 6 5 5 7 4 6
## 65 6 4 4 4 4 4 4 NA 4 4
## 66 2 1 2 2 2 4 5 7 2 5
## 67 3 4 6 4 6 6 7 7 6 7
## 68 7 4 6 4 5 6 4 1 5 5
## 69 5 3 6 5 7 6 2 7 6 3
## 70 3 4 3 4 2 4 5 2 4 3
## 71 6 2 6 4 6 6 4 5 5 5
## 72 5 3 4 4 5 5 3 1 4 4
## 73 6 3 5 5 3 6 3 6 4 4
## 74 6 4 5 1 5 6 6 7 3 3
## 75 4 2 4 2 5 3 5 1 5 4
## 76 5 3 4 3 4 3 6 1 5 4
## 77 5 3 4 5 2 1 4 7 4 1
## 78 5 5 5 4 5 4 6 5 4 3
## 79 6 4 5 5 5 4 6 1 5 6
## 80 7 5 4 5 3 5 6 1 5 3
## 81 5 4 4 4 4 4 3 1 3 2
## 82 7 6 6 3 2 6 1 1 2 3
## 83 5 2 5 2 3 5 2 1 4 5
## 84 7 5 4 4 3 4 4 1 5 4
## 85 6 2 6 4 5 6 2 7 6 3
## 86 6 4 5 6 6 5 5 1 6 3
## 87 6 6 6 4 6 6 3 1 4 2
## 88 6 2 6 4 6 6 4 NA 5 5
## 89 7 6 2 4 3 4 3 1 4 4
## 90 6 6 6 6 3 6 2 NA 4 4
## 91 5 4 4 3 3 5 4 1 6 5
## 92 5 4 4 5 3 4 3 1 4 3
## 93 4 5 4 4 3 3 3 NA 4 3
## 94 7 6 7 1 7 7 2 7 7 7
## 95 7 4 2 6 1 2 3 1 5 2
## 96 7 7 7 4 5 7 7 1 6 6
## 97 5 2 5 2 3 2 2 1 3 4
## 98 5 4 4 5 3 4 4 1 4 3
## 99 6 4 4 6 7 5 6 1 5 6
## 100 5 2 6 3 5 4 6 7 3 3
## 101 2 2 5 4 3 5 3 1 4 5
## 102 6 4 6 3 5 4 3 1 3 7
## 103 5 6 5 4 5 5 NA 1 2 4
## 104 5 4 4 4 4 4 4 NA 4 4
## 105 4 3 4 3 3 5 3 1 3 3
## 106 4 7 4 4 4 4 1 1 3 3
## 107 6 5 4 4 5 4 5 1 4 4
## 108 5 5 4 5 4 4 5 7 3 3
## 109 5 1 4 3 6 4 5 1 4 4
## 110 5 4 4 4 5 5 4 1 4 4
## 111 6 NA 3 4 2 6 5 1 3 4
## 112 6 5 4 4 4 3 5 1 4 1
## 113 5 3 3 4 3 4 3 1 3 4
## 114 4 1 4 3 1 2 3 1 3 3
## 115 5 3 5 6 7 5 7 1 6 6
## 116 4 4 4 4 4 4 4 1 4 4
## 117 7 5 4 4 4 4 4 3 5 5
## 118 4 4 4 3 2 2 3 1 2 2
## 119 5 3 4 4 3 3 3 1 3 3
## 120 5 3 5 4 4 3 5 1 5 4
## 121 3 3 3 4 4 5 3 5 4 3
## 122 5 5 5 5 4 5 3 5 4 4
## 123 6 7 5 5 5 5 5 5 5 5
## 124 4 3 4 3 3 3 4 1 3 4
## 125 5 4 4 6 4 5 5 1 4 4
## 126 3 4 4 4 4 4 4 1 4 4
## 127 5 4 4 1 4 4 1 1 1 4
## Respondent Flavor
## 1 1 Milk
## 2 3 Milk
## 3 4 Milk
## 4 7 Milk
## 5 11 Milk
## 6 12 Milk
## 7 16 Milk
## 8 18 Milk
## 9 2 Espresso
## 10 4 Espresso
## 11 7 Espresso
## 12 8 Espresso
## 13 9 Espresso
## 14 10 Espresso
## 15 11 Espresso
## 16 12 Espresso
## 17 13 Espresso
## 18 14 Espresso
## 19 15 Espresso
## 20 16 Espresso
## 21 1 Biscuit
## 22 3 Biscuit
## 23 4 Biscuit
## 24 5 Biscuit
## 25 6 Biscuit
## 26 7 Biscuit
## 27 8 Biscuit
## 28 9 Biscuit
## 29 10 Biscuit
## 30 11 Biscuit
## 31 12 Biscuit
## 32 13 Biscuit
## 33 14 Biscuit
## 34 15 Biscuit
## 35 16 Biscuit
## 36 17 Biscuit
## 37 18 Biscuit
## 38 2 Orange
## 39 8 Orange
## 40 10 Orange
## 41 11 Orange
## 42 13 Orange
## 43 1 Strawberry
## 44 2 Strawberry
## 45 3 Strawberry
## 46 4 Strawberry
## 47 5 Strawberry
## 48 6 Strawberry
## 49 7 Strawberry
## 50 8 Strawberry
## 51 9 Strawberry
## 52 10 Strawberry
## 53 11 Strawberry
## 54 12 Strawberry
## 55 13 Strawberry
## 56 14 Strawberry
## 57 15 Strawberry
## 58 16 Strawberry
## 59 17 Strawberry
## 60 18 Strawberry
## 61 4 Mango
## 62 7 Mango
## 63 8 Mango
## 64 10 Mango
## 65 12 Mango
## 66 13 Mango
## 67 14 Mango
## 68 16 Mango
## 69 2 Cappuccino
## 70 6 Cappuccino
## 71 7 Cappuccino
## 72 8 Cappuccino
## 73 9 Cappuccino
## 74 12 Cappuccino
## 75 13 Cappuccino
## 76 14 Cappuccino
## 77 15 Cappuccino
## 78 16 Cappuccino
## 79 17 Cappuccino
## 80 18 Cappuccino
## 81 1 Mousse
## 82 2 Mousse
## 83 3 Mousse
## 84 4 Mousse
## 85 6 Mousse
## 86 8 Mousse
## 87 10 Mousse
## 88 11 Mousse
## 89 12 Mousse
## 90 13 Mousse
## 91 14 Mousse
## 92 15 Mousse
## 93 16 Mousse
## 94 17 Mousse
## 95 1 Caramel
## 96 2 Caramel
## 97 3 Caramel
## 98 4 Caramel
## 99 5 Caramel
## 100 6 Caramel
## 101 8 Caramel
## 102 9 Caramel
## 103 11 Caramel
## 104 13 Caramel
## 105 17 Caramel
## 106 18 Caramel
## 107 4 Nougat
## 108 5 Nougat
## 109 7 Nougat
## 110 9 Nougat
## 111 12 Nougat
## 112 13 Nougat
## 113 14 Nougat
## 114 15 Nougat
## 115 16 Nougat
## 116 17 Nougat
## 117 18 Nougat
## 118 1 Nut
## 119 2 Nut
## 120 3 Nut
## 121 4 Nut
## 122 6 Nut
## 123 8 Nut
## 124 9 Nut
## 125 13 Nut
## 126 17 Nut
## 127 18 Nut
# Figure 7.24 - Correlation matrix and significance of correlations
Correlation_matrix <- cor(as.matrix(mydatc7_case[, -which(colnames(mydatc7_case) %in% c("Respondent", "Flavor"))]), use = "complete.obs")
Correlation_matrix <- Hmisc::rcorr(as.matrix(mydatc7_case[complete.cases(mydatc7_case), -which(colnames(mydatc7_case) %in% c("Respondent", "Flavor"))]), type = "pearson")
# Show more decimals
decimal_length <- 5
print(Correlation_matrix);
## Price Refreshing Delicious Healthy Bitter Light Crunchy Exotic Sweet
## Price 1.00 0.17 0.44 0.09 0.13 0.05 -0.14 -0.35 0.15
## Refreshing 0.17 1.00 0.13 -0.01 0.02 0.31 0.11 0.09 0.18
## Delicious 0.44 0.13 1.00 -0.02 0.39 0.41 0.04 -0.01 0.29
## Healthy 0.09 -0.01 -0.02 1.00 0.09 0.09 0.12 -0.09 0.21
## Bitter 0.13 0.02 0.39 0.09 1.00 0.46 0.30 0.24 0.36
## Light 0.05 0.31 0.41 0.09 0.46 1.00 0.22 0.32 0.54
## Crunchy -0.14 0.11 0.04 0.12 0.30 0.22 1.00 0.23 0.29
## Exotic -0.35 0.09 -0.01 -0.09 0.24 0.32 0.23 1.00 0.24
## Sweet 0.15 0.18 0.29 0.21 0.36 0.54 0.29 0.24 1.00
## Fruity -0.12 0.17 0.14 0.06 0.31 0.55 0.27 0.23 0.47
## Fruity
## Price -0.12
## Refreshing 0.17
## Delicious 0.14
## Healthy 0.06
## Bitter 0.31
## Light 0.55
## Crunchy 0.27
## Exotic 0.23
## Sweet 0.47
## Fruity 1.00
##
## n= 116
##
##
## P
## Price Refreshing Delicious Healthy Bitter Light Crunchy Exotic
## Price 0.0670 0.0000 0.3348 0.1538 0.6090 0.1226 0.0000
## Refreshing 0.0670 0.1709 0.9246 0.8293 0.0007 0.2571 0.3452
## Delicious 0.0000 0.1709 0.8391 0.0000 0.0000 0.6659 0.8831
## Healthy 0.3348 0.9246 0.8391 0.3633 0.3636 0.1924 0.3295
## Bitter 0.1538 0.8293 0.0000 0.3633 0.0000 0.0012 0.0107
## Light 0.6090 0.0007 0.0000 0.3636 0.0000 0.0175 0.0006
## Crunchy 0.1226 0.2571 0.6659 0.1924 0.0012 0.0175 0.0117
## Exotic 0.0000 0.3452 0.8831 0.3295 0.0107 0.0006 0.0117
## Sweet 0.1202 0.0528 0.0013 0.0271 0.0000 0.0000 0.0013 0.0101
## Fruity 0.1822 0.0655 0.1456 0.5467 0.0008 0.0000 0.0036 0.0134
## Sweet Fruity
## Price 0.1202 0.1822
## Refreshing 0.0528 0.0655
## Delicious 0.0013 0.1456
## Healthy 0.0271 0.5467
## Bitter 0.0000 0.0008
## Light 0.0000 0.0000
## Crunchy 0.0013 0.0036
## Exotic 0.0101 0.0134
## Sweet 0.0000
## Fruity 0.0000
formatC(Correlation_matrix$r, format = "f", digits = decimal_length);
## Price Refreshing Delicious Healthy Bitter Light
## Price "1.00000" "0.17067" "0.44283" "0.09035" "0.13327" "0.04798"
## Refreshing "0.17067" "1.00000" "0.12799" "-0.00888" "0.02023" "0.30989"
## Delicious "0.44283" "0.12799" "1.00000" "-0.01906" "0.39459" "0.41464"
## Healthy "0.09035" "-0.00888" "-0.01906" "1.00000" "0.08517" "0.08512"
## Bitter "0.13327" "0.02023" "0.39459" "0.08517" "1.00000" "0.46260"
## Light "0.04798" "0.30989" "0.41464" "0.08512" "0.46260" "1.00000"
## Crunchy "-0.14416" "0.10606" "0.04051" "0.12188" "0.29807" "0.22036"
## Exotic "-0.35390" "0.08842" "-0.01380" "-0.09133" "0.23620" "0.31534"
## Sweet "0.14510" "0.18031" "0.29459" "0.20518" "0.36416" "0.53651"
## Fruity "-0.12473" "0.17157" "0.13596" "0.05653" "0.30657" "0.54902"
## Crunchy Exotic Sweet Fruity
## Price "-0.14416" "-0.35390" "0.14510" "-0.12473"
## Refreshing "0.10606" "0.08842" "0.18031" "0.17157"
## Delicious "0.04051" "-0.01380" "0.29459" "0.13596"
## Healthy "0.12188" "-0.09133" "0.20518" "0.05653"
## Bitter "0.29807" "0.23620" "0.36416" "0.30657"
## Light "0.22036" "0.31534" "0.53651" "0.54902"
## Crunchy "1.00000" "0.23333" "0.29448" "0.26804"
## Exotic "0.23333" "1.00000" "0.23805" "0.22909"
## Sweet "0.29448" "0.23805" "1.00000" "0.46883"
## Fruity "0.26804" "0.22909" "0.46883" "1.00000"
formatC(Correlation_matrix$P, format = "f", digits = decimal_length);
## Price Refreshing Delicious Healthy Bitter Light
## Price " NA" "0.06699" "0.00000" "0.33476" "0.15381" "0.60901"
## Refreshing "0.06699" " NA" "0.17093" "0.92460" "0.82930" "0.00071"
## Delicious "0.00000" "0.17093" " NA" "0.83911" "0.00001" "0.00000"
## Healthy "0.33476" "0.92460" "0.83911" " NA" "0.36334" "0.36362"
## Bitter "0.15381" "0.82930" "0.00001" "0.36334" " NA" "0.00000"
## Light "0.60901" "0.00071" "0.00000" "0.36362" "0.00000" " NA"
## Crunchy "0.12261" "0.25715" "0.66591" "0.19245" "0.00116" "0.01746"
## Exotic "0.00010" "0.34523" "0.88313" "0.32955" "0.01069" "0.00056"
## Sweet "0.12018" "0.05275" "0.00133" "0.02714" "0.00006" "0.00000"
## Fruity "0.18220" "0.06555" "0.14561" "0.54671" "0.00082" "0.00000"
## Crunchy Exotic Sweet Fruity
## Price "0.12261" "0.00010" "0.12018" "0.18220"
## Refreshing "0.25715" "0.34523" "0.05275" "0.06555"
## Delicious "0.66591" "0.88313" "0.00133" "0.14561"
## Healthy "0.19245" "0.32955" "0.02714" "0.54671"
## Bitter "0.00116" "0.01069" "0.00006" "0.00082"
## Light "0.01746" "0.00056" "0.00000" "0.00000"
## Crunchy " NA" "0.01171" "0.00133" "0.00363"
## Exotic "0.01171" " NA" "0.01007" "0.01337"
## Sweet "0.00133" "0.01007" " NA" "0.00000"
## Fruity "0.00363" "0.01337" "0.00000" " NA"
formatC(Correlation_matrix$n, format = "f", digits = decimal_length)
## Price Refreshing Delicious Healthy Bitter
## Price "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Refreshing "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Delicious "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Healthy "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Bitter "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Light "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Crunchy "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Exotic "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Sweet "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Fruity "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Light Crunchy Exotic Sweet Fruity
## Price "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Refreshing "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Delicious "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Healthy "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Bitter "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Light "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Crunchy "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Exotic "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Sweet "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
## Fruity "116.00000" "116.00000" "116.00000" "116.00000" "116.00000"
# Significance (1-tailed) -> see Abb. 7.24
formatC((Correlation_matrix$P/2), format = "f", digits = decimal_length);
## Price Refreshing Delicious Healthy Bitter Light
## Price " NA" "0.03350" "0.00000" "0.16738" "0.07690" "0.30450"
## Refreshing "0.03350" " NA" "0.08547" "0.46230" "0.41465" "0.00036"
## Delicious "0.00000" "0.08547" " NA" "0.41955" "0.00001" "0.00000"
## Healthy "0.16738" "0.46230" "0.41955" " NA" "0.18167" "0.18181"
## Bitter "0.07690" "0.41465" "0.00001" "0.18167" " NA" "0.00000"
## Light "0.30450" "0.00036" "0.00000" "0.18181" "0.00000" " NA"
## Crunchy "0.06130" "0.12857" "0.33296" "0.09622" "0.00058" "0.00873"
## Exotic "0.00005" "0.17262" "0.44156" "0.16477" "0.00535" "0.00028"
## Sweet "0.06009" "0.02638" "0.00066" "0.01357" "0.00003" "0.00000"
## Fruity "0.09110" "0.03277" "0.07280" "0.27336" "0.00041" "0.00000"
## Crunchy Exotic Sweet Fruity
## Price "0.06130" "0.00005" "0.06009" "0.09110"
## Refreshing "0.12857" "0.17262" "0.02638" "0.03277"
## Delicious "0.33296" "0.44156" "0.00066" "0.07280"
## Healthy "0.09622" "0.16477" "0.01357" "0.27336"
## Bitter "0.00058" "0.00535" "0.00003" "0.00041"
## Light "0.00873" "0.00028" "0.00000" "0.00000"
## Crunchy " NA" "0.00586" "0.00067" "0.00181"
## Exotic "0.00586" " NA" "0.00504" "0.00669"
## Sweet "0.00067" "0.00504" " NA" "0.00000"
## Fruity "0.00181" "0.00669" "0.00000" " NA"
# KMO
psych::KMO(Correlation_matrix$r)
## Kaiser-Meyer-Olkin factor adequacy
## Call: psych::KMO(r = Correlation_matrix$r)
## Overall MSA = 0.7
## MSA for each item =
## Price Refreshing Delicious Healthy Bitter Light Crunchy
## 0.49 0.55 0.67 0.49 0.77 0.74 0.74
## Exotic Sweet Fruity
## 0.66 0.80 0.77
# Bartlett's test of sphericity
REdaS::bart_spher(as.matrix(mydatc7_case[complete.cases(mydatc7_case), -which(colnames(mydatc7_case) %in% c("Respondent", "Flavor"))]));
## Bartlett's Test of Sphericity
##
## Call: REdaS::bart_spher(x = as.matrix(mydatc7_case[complete.cases(mydatc7_case),
##
## Call: -which(colnames(mydatc7_case) %in% c("Respondent", "Flavor"))]))
##
## X2 = 266.331
## df = 45
## p-value < 2.22e-16
cortest.bartlett(as.matrix(mydatc7_case[complete.cases(mydatc7_case), -which(colnames(mydatc7_case) %in% c("Respondent", "Flavor"))]))
## R was not square, finding R from data
## $chisq
## [1] 266.3314
##
## $p.value
## [1] 3.467025e-33
##
## $df
## [1] 45
# Anti-image covariances
psych::KMO(mydatc7_case[complete.cases(mydatc7_case),
-which(colnames(mydatc7_case) %in% c("Respondent", "Flavor"))])$ImCov
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 0.59511910 -0.15854533 -0.22926341 -0.04784765 -0.07943144 0.04883994
## [2,] -0.15854533 0.83109756 0.03618037 0.04664133 0.13735841 -0.16055254
## [3,] -0.22926341 0.03618037 0.60118103 0.09979526 -0.13354703 -0.15449654
## [4,] -0.04784765 0.04664133 0.09979526 0.90774612 -0.02897362 -0.03836779
## [5,] -0.07943144 0.13735841 -0.13354703 -0.02897362 0.64403426 -0.11777913
## [6,] 0.04883994 -0.16055254 -0.15449654 -0.03836779 -0.11777913 0.44483972
## [7,] 0.10770834 -0.08978713 0.01015827 -0.08059895 -0.16031222 0.04272705
## [8,] 0.23356371 -0.05778845 0.02508358 0.11385634 -0.10531499 -0.08982740
## [9,] -0.11662590 0.01091501 -0.03021477 -0.13138422 -0.01902041 -0.12036809
## [10,] 0.10459112 -0.02621980 0.04223290 0.03546997 -0.04318135 -0.18272600
## [,7] [,8] [,9] [,10]
## [1,] 0.10770834 0.23356371 -0.11662590 0.10459112
## [2,] -0.08978713 -0.05778845 0.01091501 -0.02621980
## [3,] 0.01015827 0.02508358 -0.03021477 0.04223290
## [4,] -0.08059895 0.11385634 -0.13138422 0.03546997
## [5,] -0.16031222 -0.10531499 -0.01902041 -0.04318135
## [6,] 0.04272705 -0.08982740 -0.12036809 -0.18272600
## [7,] 0.80157224 -0.05103461 -0.10824214 -0.05884648
## [8,] -0.05103461 0.70291783 -0.09865870 0.04669852
## [9,] -0.10824214 -0.09865870 0.58098665 -0.15497775
## [10,] -0.05884648 0.04669852 -0.15497775 0.60883678
# Anti-image correlation matrix diagonals - they should be > 0.5
X <- cor(as.matrix(mydatc7_case[, -which(colnames(mydatc7_case) %in% c("Respondent", "Flavor"))]), use = "complete.obs")
iX <- MASS::ginv(X)
S2 <- diag(diag((iX^-1)))
AIS <- S2 %*% iX %*% S2 # anti-image covariance matrix
IS <- X + AIS - 2*S2 # image covariance matrix
Dai <- sqrt(diag(diag(AIS)))
IR <- ginv(Dai) %*% IS %*% ginv(Dai) # image correlation matrix
AIR <- ginv(Dai)%*% AIS %*% ginv(Dai) # anti-image correlation matrix
# print(diag(AIR), row.names = FALSE) # should all be = 1
print(AIR)
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 1.00000000 -0.22543716 -0.38329236 -0.06509932 -0.12830276 0.09492299
## [2,] -0.22543716 1.00000000 0.05118520 0.05369857 0.18774776 -0.26405196
## [3,] -0.38329236 0.05118520 1.00000000 0.13509059 -0.21462343 -0.29875442
## [4,] -0.06509932 0.05369857 0.13509059 1.00000000 -0.03789362 -0.06037857
## [5,] -0.12830276 0.18774776 -0.21462343 -0.03789362 1.00000000 -0.22004529
## [6,] 0.09492299 -0.26405196 -0.29875442 -0.06037857 -0.22004529 1.00000000
## [7,] 0.15594665 -0.11000610 0.01463341 -0.09448782 -0.22312118 0.07155332
## [8,] 0.36111966 -0.07560713 0.03858643 0.14253541 -0.15652489 -0.16064039
## [9,] -0.19833985 0.01570778 -0.05112503 -0.18091640 -0.03109441 -0.23676991
## [10,] 0.17375704 -0.03685980 0.06980682 0.04771206 -0.06895905 -0.35111399
## [,7] [,8] [,9] [,10]
## [1,] 0.15594665 0.36111966 -0.19833985 0.17375704
## [2,] -0.11000610 -0.07560713 0.01570778 -0.03685980
## [3,] 0.01463341 0.03858643 -0.05112503 0.06980682
## [4,] -0.09448782 0.14253541 -0.18091640 0.04771206
## [5,] -0.22312118 -0.15652489 -0.03109441 -0.06895905
## [6,] 0.07155332 -0.16064039 -0.23676991 -0.35111399
## [7,] 1.00000000 -0.06798939 -0.15861416 -0.08423619
## [8,] -0.06798939 1.00000000 -0.15438320 0.07138392
## [9,] -0.15861416 -0.15438320 1.00000000 -0.26057685
## [10,] -0.08423619 0.07138392 -0.26057685 1.00000000
# MSA(i) = Measure of sampling adequacy
psych::KMO(mydatc7_case[complete.cases(mydatc7_case),
-which(colnames(mydatc7_case) %in% c("Respondent", "Flavor"))])$MSAi
## Price Refreshing Delicious Healthy Bitter Light Crunchy
## 0.4912073 0.5524121 0.6746529 0.4916552 0.7709889 0.7406290 0.7438986
## Exotic Sweet Fruity
## 0.6556747 0.7951751 0.7656017
# Plot data
plot(mydatc7_case[complete.cases(mydatc7_case),
-which(colnames(mydatc7_case) %in% c("Respondent", "Flavor"))],
cex.main = 1,
cex.lab = 1,
cex.axis = 1)
pc1 <- psych::principal(mydatc7_case[complete.cases(mydatc7_case),
-which(colnames(mydatc7_case) %in% c("Respondent", "Flavor"))],
nfactors = length(mydatc7_case[complete.cases(mydatc7_case),
-which(colnames(mydatc7_case) %in% c("Respondent", "Flavor"))]),
rotate = "varimax")
# pc1 has two columns, h2 and u2
# Scree plot
# type ="b" will show both the line and the points
plot(pc1$values, type = "b",
cex.main = 1,
cex.lab = 1,
cex.axis = 1,
ylab = "Eigenvalue",
xlab = "Factor Number"); axis(1, seq(1,12,1)); abline(h = 1, col = "blue")
# Eliminating the variable ‘refreshing' (see Figure 7.28 ff.)
pc2 <- psych::principal(mydatc7_case[complete.cases(mydatc7_case),
-which(colnames(mydatc7_case) %in% c("Respondent", "Flavor", "Refreshing"))],
nfactors = 3,
rotate = "varimax",
missing = FALSE,
scores = TRUE,
oblique.scores = FALSE)
print.psych(pc2, cut = 0.3, sort = FALSE)
## Principal Components Analysis
## Call: psych::principal(r = mydatc7_case[complete.cases(mydatc7_case),
## -which(colnames(mydatc7_case) %in% c("Respondent", "Flavor",
## "Refreshing"))], nfactors = 3, rotate = "varimax", scores = TRUE,
## missing = FALSE, oblique.scores = FALSE)
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC2 RC3 h2 u2 com
## Price 0.87 0.77 0.23 1.0
## Delicious 0.48 0.68 0.74 0.26 2.0
## Healthy 0.90 0.83 0.17 1.0
## Bitter 0.69 0.51 0.49 1.2
## Light 0.82 0.69 0.31 1.0
## Crunchy 0.48 -0.32 0.31 0.42 0.58 2.5
## Exotic 0.50 -0.53 0.61 0.39 2.5
## Sweet 0.73 0.61 0.39 1.3
## Fruity 0.70 0.53 0.47 1.2
##
## RC1 RC2 RC3
## SS loadings 2.90 1.69 1.12
## Proportion Var 0.32 0.19 0.12
## Cumulative Var 0.32 0.51 0.63
## Proportion Explained 0.51 0.30 0.20
## Cumulative Proportion 0.51 0.80 1.00
##
## Mean item complexity = 1.5
## Test of the hypothesis that 3 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.09
## with the empirical chi square 74.74 with prob < 4.1e-11
##
## Fit based upon off diagonal values = 0.88
# Figure 7.29 - Eigenvalues and total variance explained (based on 9 variables)
print(pc2$values); print(pc2$Vaccounted)
## [1] 2.9214300 1.6876728 1.0994267 0.8263770 0.7017472 0.5776647 0.4726125
## [8] 0.3740604 0.3390088
## RC1 RC2 RC3
## SS loadings 2.8998590 1.6897533 1.1189171
## Proportion Var 0.3222066 0.1877504 0.1243241
## Cumulative Var 0.3222066 0.5099569 0.6342810
## Proportion Explained 0.5079870 0.2960050 0.1960079
## Cumulative Proportion 0.5079870 0.8039921 1.0000000
# Scree plot (type = "b" will show both the line and the points)
plot(pc2$values, type = "b",
cex.main = 1,
cex.lab = 1,
cex.axis = 1,
ylab = "Eigenvalue",
xlab = "Factor Number"); axis(1, seq(1,9,1)); abline(h = 1, col = "blue")
# Figure 7.33 - Varimax-rotated factor matrix in the case study (3 factors)
psych::print.psych(pc2, cut = 0.3, sort = FALSE); pc2$Structure
## Principal Components Analysis
## Call: psych::principal(r = mydatc7_case[complete.cases(mydatc7_case),
## -which(colnames(mydatc7_case) %in% c("Respondent", "Flavor",
## "Refreshing"))], nfactors = 3, rotate = "varimax", scores = TRUE,
## missing = FALSE, oblique.scores = FALSE)
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC2 RC3 h2 u2 com
## Price 0.87 0.77 0.23 1.0
## Delicious 0.48 0.68 0.74 0.26 2.0
## Healthy 0.90 0.83 0.17 1.0
## Bitter 0.69 0.51 0.49 1.2
## Light 0.82 0.69 0.31 1.0
## Crunchy 0.48 -0.32 0.31 0.42 0.58 2.5
## Exotic 0.50 -0.53 0.61 0.39 2.5
## Sweet 0.73 0.61 0.39 1.3
## Fruity 0.70 0.53 0.47 1.2
##
## RC1 RC2 RC3
## SS loadings 2.90 1.69 1.12
## Proportion Var 0.32 0.19 0.12
## Cumulative Var 0.32 0.51 0.63
## Proportion Explained 0.51 0.30 0.20
## Cumulative Proportion 0.51 0.80 1.00
##
## Mean item complexity = 1.5
## Test of the hypothesis that 3 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.09
## with the empirical chi square 74.74 with prob < 4.1e-11
##
## Fit based upon off diagonal values = 0.88
##
## Loadings:
## RC1 RC2 RC3
## Price 0.869
## Delicious 0.483 0.677 -0.210
## Healthy 0.902
## Bitter 0.690 0.192
## Light 0.825
## Crunchy 0.480 -0.316 0.307
## Exotic 0.496 -0.531 -0.291
## Sweet 0.734 0.103 0.253
## Fruity 0.697 -0.186
##
## RC1 RC2 RC3
## SS loadings 2.900 1.690 1.119
## Proportion Var 0.322 0.188 0.124
## Cumulative Var 0.322 0.510 0.634
print(pc2$weights)
## RC1 RC2 RC3
## Price -0.01246155 0.512721497 0.06008499
## Delicious 0.16745530 0.400628334 -0.23454686
## Healthy -0.01356016 0.009861118 0.80779588
## Bitter 0.23832943 0.103385397 -0.06349173
## Light 0.28807114 0.042267595 -0.08898109
## Crunchy 0.15732990 -0.204833960 0.26311279
## Exotic 0.19553140 -0.314463385 -0.27039032
## Sweet 0.24130684 0.040996100 0.18937268
## Fruity 0.24225938 -0.123808376 0.03472799
print(pc2$Vaccounted)
## RC1 RC2 RC3
## SS loadings 2.8998590 1.6897533 1.1189171
## Proportion Var 0.3222066 0.1877504 0.1243241
## Cumulative Var 0.3222066 0.5099569 0.6342810
## Proportion Explained 0.5079870 0.2960050 0.1960079
## Cumulative Proportion 0.5079870 0.8039921 1.0000000
# Get final facto scores
pc3 <- psych::fa(mydatc7_case[complete.cases(mydatc7_case),
-which(colnames(mydatc7_case) %in% c("Respondent", "Flavor", "Refreshing"))],
nfactors = 3,
rotate = "varimax",
scores = TRUE,
fm = "pa",
oblique.scores = FALSE,
max.iter = 25)
psych::print.psych(pc3, cut = 0.3, sort = FALSE); pc3$Structure
## Factor Analysis using method = pa
## Call: psych::fa(r = mydatc7_case[complete.cases(mydatc7_case), -which(colnames(mydatc7_case) %in%
## c("Respondent", "Flavor", "Refreshing"))], nfactors = 3,
## rotate = "varimax", scores = TRUE, max.iter = 25, fm = "pa",
## oblique.scores = FALSE)
## Standardized loadings (pattern matrix) based upon correlation matrix
## PA1 PA2 PA3 h2 u2 com
## Price 0.76 0.67 0.33 1.3
## Delicious 0.32 0.72 0.64 0.36 1.5
## Healthy 0.43 0.19 0.81 1.1
## Bitter 0.55 0.38 0.62 1.4
## Light 0.76 0.64 0.36 1.2
## Crunchy 0.42 0.21 0.79 1.3
## Exotic 0.50 0.39 0.61 2.1
## Sweet 0.66 0.32 0.57 0.43 1.6
## Fruity 0.64 0.42 0.58 1.1
##
## PA1 PA2 PA3
## SS loadings 2.29 1.35 0.47
## Proportion Var 0.25 0.15 0.05
## Cumulative Var 0.25 0.40 0.46
## Proportion Explained 0.56 0.33 0.11
## Cumulative Proportion 0.56 0.89 1.00
##
## Mean item complexity = 1.4
## Test of the hypothesis that 3 factors are sufficient.
##
## The degrees of freedom for the null model are 36 and the objective function was 2.22 with Chi Square of 246.57
## The degrees of freedom for the model are 12 and the objective function was 0.13
##
## The root mean square of the residuals (RMSR) is 0.03
## The df corrected root mean square of the residuals is 0.06
##
## The harmonic number of observations is 116 with the empirical chi square 9.8 with prob < 0.63
## The total number of observations was 116 with Likelihood Chi Square = 14.53 with prob < 0.27
##
## Tucker Lewis Index of factoring reliability = 0.963
## RMSEA index = 0.042 and the 90 % confidence intervals are 0 0.109
## BIC = -42.51
## Fit based upon off diagonal values = 0.98
## Measures of factor score adequacy
## PA1 PA2 PA3
## Correlation of (regression) scores with factors 0.91 0.88 0.67
## Multiple R square of scores with factors 0.82 0.78 0.45
## Minimum correlation of possible factor scores 0.64 0.55 -0.11
##
## Loadings:
## PA1 PA2 PA3
## Price -0.159 0.765 0.248
## Delicious 0.324 0.718 -0.156
## Healthy 0.428
## Bitter 0.552 0.267
## Light 0.764 0.228
## Crunchy 0.424 -0.121 0.125
## Exotic 0.498 -0.274 -0.251
## Sweet 0.657 0.181 0.324
## Fruity 0.635 0.113
##
## PA1 PA2 PA3
## SS loadings 2.290 1.347 0.465
## Proportion Var 0.254 0.150 0.052
## Cumulative Var 0.254 0.404 0.456
# Figure 7.34 - Regression coefficients for calculating the factor scores
print(pc3$weights)
## PA1 PA2 PA3
## Price -0.183648742 0.51053176 0.27644659
## Delicious 0.095249867 0.45613599 -0.36153240
## Healthy 0.005579656 -0.01854654 0.29157920
## Bitter 0.158403937 0.04651137 -0.02565495
## Light 0.354183358 0.07149491 -0.06343294
## Crunchy 0.108946943 -0.05361525 0.09045635
## Exotic 0.160509425 -0.09420793 -0.23212076
## Sweet 0.256783514 -0.01912736 0.36506779
## Fruity 0.169749440 -0.04645702 0.08062295
# Figure 7.35 SPSS data editor with the factor scores of the first 28 persons in the case study
print(pc3$scores)
## PA1 PA2 PA3
## 1 -1.114854734 -0.376257460 -0.49305402
## 2 0.297993498 0.696666729 0.40108097
## 3 -0.905299822 -1.369359969 -0.34618545
## 4 -0.433423089 -0.798807603 0.50651355
## 5 0.330426902 1.004902296 1.40713422
## 6 0.606124372 0.270809563 -0.19866505
## 7 1.070603533 0.928105710 0.46953385
## 8 -1.201163146 -1.047243252 0.02118486
## 9 0.605993432 1.560197543 0.11366384
## 10 0.024187181 -0.656966822 0.05852873
## 11 -1.158391920 0.662160795 0.57689811
## 12 -1.287297615 0.185919763 1.65722568
## 14 -0.669483492 -0.624279346 -0.57596292
## 15 -1.090419249 -1.123793322 0.61735449
## 16 -0.042289591 -0.403608481 -0.08068711
## 17 0.154944206 -0.929522230 -0.17888764
## 18 -0.257195912 0.659080443 0.05712207
## 19 -2.369747308 0.241360339 -0.26263484
## 20 -0.550790607 -0.411965008 0.20158028
## 21 -1.005737860 -0.532127009 -0.94499433
## 22 -0.831332749 0.817411995 -0.59874149
## 23 0.398865312 -0.446505068 -0.61981139
## 24 0.384880996 0.519051083 0.86383632
## 25 -1.478612302 1.524149670 -0.99943995
## 26 1.043151884 1.043623389 -0.29474559
## 27 0.619939760 -0.059436689 0.12249911
## 28 0.658608784 1.128272240 -0.54840896
## 29 0.345707665 -0.029875018 -2.05891332
## 31 0.294833366 -0.533436157 -0.49496036
## 32 -1.346166289 0.304482710 -0.38116282
## 33 -1.248681834 0.072684670 -0.27697181
## 34 0.100638791 -0.028490225 0.04772312
## 35 -0.300300846 -0.258965827 0.12935153
## 36 -0.070152650 1.462689927 -0.12089804
## 37 -1.145455012 0.144463384 -0.33512126
## 38 0.139367846 -0.314426661 -0.19189909
## 39 -0.768851766 -1.977119219 -0.62678149
## 40 0.726483997 -1.064471967 -0.54009849
## 41 0.735734399 -1.067170905 -0.98763700
## 42 1.584990830 1.870349558 0.26425375
## 43 -0.514365223 -1.274071359 -1.11994563
## 44 -0.413923872 -0.136485189 0.84305284
## 45 0.244898130 -0.314343948 0.23880931
## 46 1.594848738 -0.790054801 -0.20292971
## 47 1.421466917 -0.564104488 0.04779420
## 48 1.472337760 0.486726726 -0.60091361
## 49 0.982212836 0.427184104 0.38472484
## 51 0.993288524 -1.940616988 0.44681525
## 52 0.583828099 -0.871750357 -0.34341094
## 53 0.011991742 -1.712227267 -0.44785568
## 54 0.270518693 -1.481539443 0.43769698
## 55 -0.232810999 0.323180724 -0.17586259
## 56 1.933821852 -1.956222112 0.20173759
## 57 1.953395822 -0.909629343 0.27386160
## 58 0.735734399 -1.067170905 -0.98763700
## 59 -0.490352978 -0.033802532 -0.39870607
## 60 0.612135543 1.562958046 0.10605263
## 61 0.967447742 -0.550129607 -0.39487780
## 62 2.441642747 -1.547320434 0.19375846
## 64 0.993288524 -1.940616988 0.44681525
## 66 -0.194300726 -1.986866398 -0.96616522
## 67 2.112338505 -0.148478908 -0.32942460
## 68 0.519419188 1.520282381 0.34496887
## 69 1.137776900 0.820566787 -0.30024505
## 70 -0.373557032 -1.093088214 0.25909637
## 71 0.981028284 1.080085645 -0.20490553
## 72 -0.060384800 0.144630444 0.24205373
## 73 0.282928902 0.646858957 -0.12575520
## 74 0.414444462 0.666562271 -1.30490292
## 75 -0.126551861 -0.339874795 0.11845824
## 76 -0.263754792 -0.094980621 0.59166215
## 77 -1.302939258 -0.318574959 0.04551690
## 78 0.102105837 0.254505061 -0.25174034
## 79 0.306857332 0.594378340 0.96440020
## 80 -0.187684133 0.631591189 1.25297580
## 81 -0.860188436 0.145255106 -0.09697707
## 82 -0.836653923 1.666164815 -0.98243898
## 83 -0.133730805 0.498692207 -0.47644003
## 84 -0.472950709 0.630799467 1.01483161
## 85 0.823403230 1.100634134 -0.31723110
## 86 0.432586528 0.780854978 1.17900134
## 87 0.095791812 1.375794376 -0.36379278
## 89 -0.904612289 -0.080117100 1.27276407
## 91 0.336506957 0.003451604 0.73911875
## 92 -0.630485292 0.054392846 0.48544261
## 94 1.913407029 1.808064157 -0.67510744
## 95 -1.649759502 -0.218614249 2.01399794
## 96 1.395286810 1.799195878 0.51887802
## 97 -1.233316543 0.390001208 -0.68075585
## 98 -0.558844836 0.019136960 0.54492417
## 99 0.684688043 0.308854032 1.41143958
## 100 0.100474628 0.591331399 -1.24214395
## 101 0.294833366 -0.533436157 -0.49496036
## 102 -0.117951136 1.105863867 -0.47621708
## 105 -0.464923907 -0.172767065 -0.46804797
## 106 -0.766001258 -0.140267461 -0.33311503
## 107 -0.292286333 0.344651867 0.58221883
## 108 -0.218553557 -0.191436467 -0.23621487
## 109 -0.083442946 0.064501807 0.16849648
## 110 0.011255656 0.109374558 0.30153529
## 112 -1.012352587 0.363507160 0.47142895
## 113 -0.793965325 -0.330215352 0.33563658
## 114 -1.436065475 -0.386600688 -0.29744429
## 115 1.153005313 0.316369657 1.28034411
## 116 -0.228660390 -0.294221713 0.18883309
## 117 -0.130374786 0.553144357 0.87707471
## 118 -1.661497310 -0.309936079 -0.65665575
## 119 -1.094890455 0.031275947 0.02275810
## 120 -0.251652597 0.306652831 0.45374570
## 121 0.122563598 -1.022714650 -0.20719888
## 122 0.174864585 0.336680971 -0.18003339
## 123 0.621425630 0.569286345 0.44153124
## 124 -0.790053218 -0.345816626 -0.25814340
## 125 -0.005548934 0.017245356 0.82314130
## 126 -0.112533359 -0.617047438 0.01402698
## 127 -1.175758041 0.221898567 -1.34204665
factor_scores_results <- as.data.frame(as.matrix(pc3$scores)) %>%
rownames_to_column(., var = "ID")
factor_scores_results$ID <- as.numeric(factor_scores_results$ID)
mydatc7_case.2 <- mydatc7_case %>%
mutate(ID = c(1:nrow(mydatc7_case))) %>%
dplyr::select(ID, everything())
mydatc7_case.2$ID <- as.numeric(mydatc7_case.2$ID)
# Final results incl. factor scores
mydatc7_case.3 <- full_join(mydatc7_case.2, factor_scores_results, by = "ID")
head(mydatc7_case.3)
## ID Price Refreshing Delicious Healthy Bitter Light Crunchy Exotic Sweet
## 1 1 3 3 5 4 1 2 3 1 3
## 2 2 6 6 5 2 2 5 2 1 6
## 3 3 2 3 3 3 2 3 5 1 3
## 4 4 4 3 3 4 4 3 5 2 4
## 5 5 7 5 5 7 3 6 5 1 5
## 6 6 5 4 5 2 5 4 3 7 7
## Fruity Respondent Flavor PA1 PA2 PA3
## 1 4 1 Milk -1.1148547 -0.3762575 -0.4930540
## 2 7 3 Milk 0.2979935 0.6966667 0.4010810
## 3 2 4 Milk -0.9052998 -1.3693600 -0.3461854
## 4 4 7 Milk -0.4334231 -0.7988076 0.5065136
## 5 5 11 Milk 0.3304269 1.0049023 1.4071342
## 6 3 12 Milk 0.6061244 0.2708096 -0.1986651
### Figure 7.37 Means of the factor scores for each chocolate flavor
mydatc7_case.4 <- mydatc7_case.3 %>%
group_by(Flavor) %>%
summarise(m_PA1 = mean(PA1, na.rm = TRUE),
m_PA2 = mean(PA2, na.rm = TRUE),
m_PA3 = mean(PA3, na.rm = TRUE))
print(mydatc7_case.4)
## # A tibble: 11 x 4
## Flavor m_PA1 m_PA2 m_PA3
## <fct> <dbl> <dbl> <dbl>
## 1 Milk -0.169 -0.0864 0.221
## 2 Espresso -0.604 -0.0765 0.199
## 3 Biscuit -0.224 0.320 -0.407
## 4 Orange 0.484 -0.511 -0.416
## 5 Strawberry 0.656 -0.603 -0.0763
## 6 Mango 1.14 -0.776 -0.117
## 7 Cappuccino 0.0759 0.249 0.107
## 8 Mousse -0.0215 0.726 0.162
## 9 Caramel -0.232 0.315 0.0794
## 10 Nougat -0.303 0.0549 0.367
## 11 Nut -0.417 -0.0812 -0.0889
# Data
data <- mydatc7_case.4
# Create column indicating point color
with(data, {
s3d <- scatterplot3d::scatterplot3d(z = data$m_PA1, x = data$m_PA2, y = data$m_PA3, # x y and z axis
pch = 19,
type = "h",
lty.hplot = 2, # lines to the horizontal plane
scale.y = .75, # scale y axis (reduce by 25%)
main = "Three-dimensional representation of the chocolate flavors in the factor space",
zlab = "m_PA1",
xlab = "m_PA2",
ylab = "m_PA3",
cex.main = 1,
cex.lab = 1,
cex.axis = 1)
s3d.coords <- s3d$xyz.convert(z = data$m_PA1, x = data$m_PA2, y = data$m_PA3)
text(s3d.coords$x,
s3d.coords$y, # x and y coordinates
labels = data$Flavor,
pos = , cex = 1)
})
plot(pc3, labels = colnames(mydatc7_case[complete.cases(mydatc7_case),
-which(colnames(mydatc7_case) %in% c("Respondent", "Flavor", "Refreshing"))]), cex = 1.3)