Perceptual Mapping
R Markdown
Perceptual maps are a great way to visualize where a brand stands in relation to it’s competitors and is a useful tool to gain a marketing advantage. If a brand aspires to be associated with certain attributes or gain ground on a competitor a perceptual map is a great way to know where you are in the minds of customers and allocate marketing resources accordingly.
Read in the data file
# create path object
path <- "g:/Portfolio Projects/P-Maps/Source Data/CARS DATA.xlsx"
# get the sheet names
sheets.names<- excel_sheets(path)
# list of all sheets' contents
sheets<- lapply(excel_sheets(path), read_excel, path = path)## New names:
## • `` -> `...1`# convert each object in list (the sheets...) to workable dataframe
dfs<- lapply(sheets,as.data.frame)
# name the list objects using the sheet names extracted above
names(dfs) <- sheets.names
# rename the first column in each dataframe to "Attributes"
for(i in 1:length(dfs)){
colnames(dfs[[i]])[1] <- "Attributes"
# create data.frame objects from each item in list (each sheet in the excel workbook)
x <- dfs[[i]]
eval(parse(text = paste(names(dfs)[[i]],"<- x")))
}View the data
# examine column labels
names(CARS)## [1] "Attributes" "Lexus" "Audi" "Land Rover" "Genesis"
## [6] "Cadillac" "BMW"# view the data table
kable(CARS, caption = "Examine the source data")| Attributes | Lexus | Audi | Land Rover | Genesis | Cadillac | BMW |
|---|---|---|---|---|---|---|
| Status and Prestige | 0.21 | 0.22 | 0.26 | 0.57 | 0.63 | 0.24 |
| Emotional Fulfillment | 0.53 | 0.62 | 0.62 | 0.61 | 0.43 | 0.54 |
| Passion | 0.69 | 0.53 | 0.22 | 0.45 | 0.54 | 0.63 |
| Elegance | 0.27 | 0.68 | 0.42 | 0.42 | 0.35 | 0.26 |
| Exclusivity | 0.27 | 0.70 | 0.47 | 0.55 | 0.43 | 0.22 |
| Performance | 0.41 | 0.35 | 0.66 | 0.56 | 0.47 | 0.63 |
| Comfort | 0.29 | 0.27 | 0.61 | 0.21 | 0.45 | 0.54 |
| Craftsmanship | 0.29 | 0.21 | 0.27 | 0.47 | 0.45 | 0.68 |
| Sophistication | 0.34 | 0.43 | 0.28 | 0.61 | 0.23 | 0.31 |
| Security | 0.29 | 0.65 | 0.58 | 0.44 | 0.38 | 0.68 |
| Individuality | 0.60 | 0.68 | 0.48 | 0.28 | 0.24 | 0.47 |
| Timelessness | 0.46 | 0.53 | 0.25 | 0.55 | 0.45 | 0.32 |
Prepare for the principle component analysis (PCA)
################################## Global data
# store the attribute names
Global.names<- CARS$Attributes
# select and standardize data, need to subset the data to perform the following tranformations
# data must be only numeric, the attributes are added back in later as column headers
# subset the data to exclude the attribute column
Global<- CARS[2:length(CARS)]
# ensure all values are numeric by converting
Global <- as.data.frame(sapply(Global, as.numeric))
str(Global)## 'data.frame': 12 obs. of 6 variables:
## $ Lexus : num 0.21 0.53 0.69 0.27 0.27 0.41 0.29 0.29 0.34 0.29 ...
## $ Audi : num 0.22 0.62 0.53 0.68 0.7 0.35 0.27 0.21 0.43 0.65 ...
## $ Land Rover: num 0.26 0.62 0.22 0.42 0.47 0.66 0.61 0.27 0.28 0.58 ...
## $ Genesis : num 0.57 0.61 0.45 0.42 0.55 0.56 0.21 0.47 0.61 0.44 ...
## $ Cadillac : num 0.63 0.43 0.54 0.35 0.43 0.47 0.45 0.45 0.23 0.38 ...
## $ BMW : num 0.24 0.54 0.63 0.26 0.22 0.63 0.54 0.68 0.31 0.68 ...# calculate row means
rowmean<- rowMeans(Global)
rowmean## [1] 0.3550000 0.5583333 0.5100000 0.4000000 0.4400000 0.5133333 0.3950000
## [8] 0.3950000 0.3666667 0.5033333 0.4583333 0.4266667# set multiplier
standard <- 100
# subtract each value by the row mean
new.Global <- sweep(Global, 1, rowmean,"-")
# multiply each value by 100
Global.map <- sweep(new.Global, 2, standard,"*")
# transpose
Global.map.t <- as.data.frame(t(Global.map))
# set column name for attributes
colnames(Global.map.t) <- Global.names
# let's take a look at the transposed data
kable(Global.map.t, caption = "Transposed data for the PCA")| Status and Prestige | Emotional Fulfillment | Passion | Elegance | Exclusivity | Performance | Comfort | Craftsmanship | Sophistication | Security | Individuality | Timelessness | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Lexus | -14.5 | -2.833333 | 18 | -13 | -17 | -10.333333 | -10.5 | -10.5 | -2.666667 | -21.333333 | 14.166667 | 3.333333 |
| Audi | -13.5 | 6.166667 | 2 | 28 | 26 | -16.333333 | -12.5 | -18.5 | 6.333333 | 14.666667 | 22.166667 | 10.333333 |
| Land Rover | -9.5 | 6.166667 | -29 | 2 | 3 | 14.666667 | 21.5 | -12.5 | -8.666667 | 7.666667 | 2.166667 | -17.666667 |
| Genesis | 21.5 | 5.166667 | -6 | 2 | 11 | 4.666667 | -18.5 | 7.5 | 24.333333 | -6.333333 | -17.833333 | 12.333333 |
| Cadillac | 27.5 | -12.833333 | 3 | -5 | -1 | -4.333333 | 5.5 | 5.5 | -13.666667 | -12.333333 | -21.833333 | 2.333333 |
| BMW | -11.5 | -1.833333 | 12 | -14 | -22 | 11.666667 | 14.5 | 28.5 | -5.666667 | 17.666667 | 1.166667 | -10.666667 |
PCA
# FINAL Global map data
prcomp_Global<- prcomp(Global.map.t)
colnames(Global.map.t)## [1] "Status and Prestige" "Emotional Fulfillment" "Passion"
## [4] "Elegance" "Exclusivity" "Performance"
## [7] "Comfort" "Craftsmanship" "Sophistication"
## [10] "Security" "Individuality" "Timelessness"# plot the PCA object
Global.plot <- autoplot(prcomp_Global,geom = 'path', data = Global.map.t,
label = TRUE, label.vjust=-.5, label.colour = 'black', label.size = 5,
loadings = TRUE, loadings.label = TRUE, loadings.label.vjust=-.5, loadings.colour = 'gray', loadings.label.colour = 'black',
loadings.label.size = 4)
Global.plot
Rotations
If the client wants attributes or brands in a certain quadrant, we have a few options for rotation
Let’s flip the plot around for fun
# set the astetics of the plot
# there are several themes to use, void is simple and removes all elements of the plot
Global.plot<- Global.plot + theme_void()
Global.plot
############### rotate plot, comments are relative to original plot
# rotate left to right
Global.plot.1 <- Global.plot + scale_x_reverse()
Global.plot.1
# rotate on axis top left to bottom right
Global.plot.2 <- Global.plot + coord_flip()
Global.plot.2
# rotate on axis top to bottom
Global.plot.3 <- Global.plot + scale_y_reverse()
Global.plot.3
# select plot to export to PowerPoint, we'll just stick with the original plot
which.Global.plot <- Global.plot
which.Global.plot
Export your pretty plot to PowerPoint!
# create editable ppt
doc <-read_pptx()
doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme")
doc <- ph_with(doc,value = "Perceptual Map", location = ph_location_type(type = "title"))
doc <- ph_with(doc,value = "Slide 1", location = ph_location_type(type = "sldNum"))
doc <- ph_with(doc, dml(ggobj = which.Global.plot), location = ph_location_type(type = "body"))
################################## Global
# final ppt document
print(doc, target = "g:/Portfolio Projects/P-Maps/Cars Data.pptx")