## 8.3CA Analysis

CA and its inference analysis (boot, CI, TI, eigenvalue tests, scree) can be done by InPosition. Also, note that there are 2 ways to perform CA: symmetric and asymmetric (find definition above). We should perform both for either rows or columns or both. In the case of this sensory profile dataset where there is subjectivity to be balanced in both rows and columns, it is recommended that we do both tests (symmetry and asymmetry) for both rows and columns.

### 8.3.1Run CA

We will perform CA in 2 ways: Symmetric and Asymmetric using epCA. Note that the results include multiple components like
“ExPosition.Data” - All ExPosition classes output (data, factor scores, contributions, etc…)
“Plotting.Data” - All ExPosition & prettyGraphs plotting data (constraints, colors, etc…)
For Inference Analysis we can use epCA.inference.battery() to obtain multiple result components.
In order to do epCA for rows instead of columns, we can simply transpose the data set as “t(data)”

SYMMETRIC CA

``````#Preliminary CA
resCA.sym           <- epCA(wk1, symmetric = TRUE, graphs = FALSE)

#Inference Battery for Columns (J)
resCAinf.sym.col    <- epCA.inference.battery(wk1, symmetric = TRUE, graphs = FALSE)

#Inference Battery for Rows (I)
resCAinf.sym.row    <- epCA.inference.battery(t(wk1), symmetric = TRUE, graphs = FALSE)``````

ASYMMETRIC CA

``````#Preliminary CA
resCA.asym           <- epCA(wk1, symmetric = FALSE, graphs = FALSE)
resCA.asym2           <- epCA(t(wk1), symmetric = FALSE, graphs = FALSE)

#Inference Battery for Columns (J)
resCAinf.asym.col    <- epCA.inference.battery(wk1, symmetric = FALSE, graphs = FALSE)

#Inference Battery for Rows (I)
resCAinf.asym.row    <- epCA.inference.battery(t(wk1), symmetric = FALSE, graphs = FALSE)``````

### 8.3.2Scree Plot

Even with included permutation test, our scree plot does not show any significant component

``````#Symmetry
scree1   <- PlotScree(ev = resCA.sym\$ExPosition.Data\$eigs,
p.ev = resCAinf.sym.col\$Inference.Data\$components\$p.vals,
title = "Explained Variance per Dimension + Permutation Test",
plotKaiser = TRUE,
color4Kaiser = "hotpink")`````` ``````scree1
scree1   <- recordPlot()

#Asymmetry

#scree2   <- PlotScree(ev = resCA.asym\$ExPosition.Data\$eigs,
#                     p.ev = resCAinf.asym.col\$Inference.Data\$components\$p.vals,
#                     title = "Explained Variance per Dimension + Permutation Test (No Significant Component)")
#scree2
#scree2   <- recordPlot()``````

We see that there is no significant component for this dataset.

### 8.3.3Permutation Test

Wanted to take a look into the eigenvalues to make sure that no component is actually significant.

Columns:

``````zeDim = 1
pH1 <- prettyHist(
distribution = resCAinf.sym.col\$Inference.Data\$components\$eigs.perm[,zeDim],
observed = resCAinf.sym.col\$Fixed.Data\$ExPosition.Data\$eigs[zeDim],
xlim = c(0, 0.1), # needs to be set by hand
breaks = 10,
border = "white",
main = paste0("Permutation Test for Eigenvalue ",zeDim, " Sym Col"),
xlab = paste0("Eigenvalue ",zeDim),
ylab = "",
counts = FALSE,
cutoffs = c( 0.975),
observed.col = "hotpink"
)`````` ``````pH1 <- recordPlot()

zeDim = 2
pH2 <- prettyHist(
distribution = resCAinf.sym.col\$Inference.Data\$components\$eigs.perm[,zeDim],
observed = resCAinf.sym.col\$Fixed.Data\$ExPosition.Data\$eigs[zeDim],
xlim = c(0, 0.1), # needs to be set by hand
breaks = 10,
border = "white",
main = paste0("Permutation Test for Eigenvalue ",zeDim, " Sym Col"),
xlab = paste0("Eigenvalue ",zeDim),
ylab = "",
counts = FALSE,
cutoffs = c( 0.975),
observed.col = "hotpink"
)`````` ``````pH2 <- recordPlot()

#Rows:
zeDim = 1
pH3 <- prettyHist(
distribution = resCAinf.sym.row\$Inference.Data\$components\$eigs.perm[,zeDim],
observed = resCAinf.sym.row\$Fixed.Data\$ExPosition.Data\$eigs[zeDim],
xlim = c(0, 0.1), # needs to be set by hand
breaks = 10,
border = "white",
main = paste0("Permutation Test for Eigenvalue ",zeDim, " Sym Row"),
xlab = paste0("Eigenvalue ",zeDim),
ylab = "",
counts = FALSE,
cutoffs = c( 0.975),
observed.col = "hotpink"
)`````` ``````pH3 <- recordPlot()

zeDim = 2
pH4 <- prettyHist(
distribution = resCAinf.asym.row\$Inference.Data\$components\$eigs.perm[,zeDim],
observed = resCAinf.asym.row\$Fixed.Data\$ExPosition.Data\$eigs[zeDim],
xlim = c(0, 0.1), # needs to be set by hand
breaks = 10,
border = "white",
main = paste0("Permutation Test for Eigenvalue ",zeDim, " Sym Row"),
xlab = paste0("Eigenvalue ",zeDim),
ylab = "",
counts = FALSE,
cutoffs = c( 0.975),
observed.col = "hotpink"
)`````` ``pH4 <- recordPlot()``

### 8.3.4Factor Scores

Set-Up:

Here we will list all of the components required to plot the Factor Scores and reassign to variables for easy handling.

``````#Factor scores needed
Fj.a <- resCA.asym\$ExPosition.Data\$fj
Fi   <- resCA.sym\$ExPosition.Data\$fi
Fj   <- resCA.sym\$ExPosition.Data\$fj

# Asym map opposite row -col
t.Fj.a <- resCA.asym2\$ExPosition.Data\$fj
t.Fi   <- resCA.asym2\$ExPosition.Data\$fi
t.Fj   <- resCA.asym2\$ExPosition.Data\$fj

# constraints -----
# first get the constraints correct
constraints.sym  <- minmaxHelper(mat1 = Fi, mat2  = Fj)
constraints.asym <- minmaxHelper(mat1 = Fi, mat2  = Fj.a)
constraints.asym2 <- minmaxHelper(mat1 = t.Fi, mat2  = t.Fj.a)

# Get some colors ----
col.var <- prettyGraphsColorSelection(n.colors = nrow(Fi))

# baseMaps ----
colnames(Fi)   <- paste("Dimension ", 1:ncol(Fi))
colnames(Fj)   <- paste("Dimension ", 1:ncol(Fj))
colnames(Fj.a) <- paste("Dimension ", 1:ncol(Fj.a))``````

#### 8.3.4.1Asymmetric Factor Scores

Notes:

First, we will make an Asymmetric plot with Simplex (kind of like a Tolerance Interval for all variable - technically, it is flattening all dimentsion) so that we can compare col-to-row.

Interpretations:

We can interpret asymmetric plot by assessing the proximity (distance between) each data points (can be done for both rows and columns).
Some noticeable points of observation:
• We see that most observation cluster around center of gravity. • Some observation also stay very near to components and can be broken into 3 main groups. • Some of these observation groups are relatively close to some respective characteristics. • For observations, we see small eigen values (this is because CA uses chi-square probability)

Asymmetric map with that makes Simplex polygon from column:

``````# Your asymmetric factor scores
asymMap  <- createFactorMapIJ(Fi,
Fj.a,
constraints  =  constraints.asym,
col.labels.j = "darkgreen",
col.points.j = "darkgreen",
col.points.i = "hotpink")

# set drawing order, goal is to flatten the simplex:
polygonorder <- c(5,8,13,4,2,6)

# Make the simplex visible
zePoly.J <-  PTCA4CATA::ggdrawPolygon(Fj.a,
order2draw = polygonorder, # this parameter determines which point to draw first
color = 'darkgreen',
size = .2,
fill =  'darkgreen',
alpha = .05)

# Labels
labels4CA <- createxyLabels(resCA = resCA.asym)

# Combine all elements you want to include in this plot
asymMap.simplex  <-  asymMap\$baseMap + zePoly.J +
asymMap\$I_points +
asymMap\$J_labels +
asymMap\$J_points +
labels4CA +
ggtitle('Asymmetric Map with Simplex (From Emotions')

asymMap.simplex`````` ``asymMap.simplex <- recordPlot()``

Asymmetric map with that makes Simplex polygon from rows:

We prefer to draw asymmetric map from either rows or columns that have less levels. Here the rows have less levels

``````# Your asymmetric factor scores
asymMap2  <- createFactorMapIJ(t.Fi,
t.Fj.a,
constraints  =  constraints.asym2,
col.labels.j = "hotpink",
col.points.j = "hotpink",
col.points.i = "darkgreen")

# set drawing order, goal is to flatten the simplex:
polygonorder2 <- c(1,7,6,3,2)

# Make the simplex visible
zePoly.J <-  PTCA4CATA::ggdrawPolygon(t.Fj.a,
order2draw = polygonorder2, # this parameter determines which point to draw first
color = 'hotpink',
size = .2,
fill =  'hotpink',
alpha = .05)

# Labels
labels4CA <- createxyLabels(resCA = resCA.asym)

# Combine all elements you want to include in this plot
asymMap.simplex2  <-  asymMap2\$baseMap + zePoly.J +
asymMap2\$I_points +
asymMap2\$J_labels +
asymMap2\$J_points +
labels4CA +
ggtitle('Asymmetric Map with Simplex (From Products)')

asymMap.simplex2`````` ``asymMap.simplex2 <- recordPlot()``

Let’s also check Dimension 3 and 4:

``````# Your asymmetric factor scores
asymMap3  <- createFactorMapIJ(t.Fi,
t.Fj.a,
col.labels.j = "hotpink",
col.points.j = "hotpink",
col.points.i = "darkgreen",
axis1 = 3,
axis2 = 4
)

# set drawing order, goal is to flatten the simplex:
polygonorder3 <- c(5,7,4,3)

# Make the simplex visible
zePoly.J.extra <-  PTCA4CATA::ggdrawPolygon(t.Fj.a[,3:4],
order2draw = polygonorder3, # this parameter determines which point to draw first
color = 'hotpink',
size = .2,
fill =  'hotpink',
alpha = .05)

# Labels
labels4CA <- createxyLabels(resCA = resCA.asym, x_axis = 3, y_axis = 4)

# Combine all elements you want to include in this plot
asymMap.simplex3  <-  asymMap3\$baseMap + zePoly.J.extra +
asymMap3\$I_points +
asymMap3\$J_labels +
asymMap3\$J_points +
labels4CA +
ggtitle('Asymmetric Map with Simplex (From Products) - D3 & D4')

asymMap.simplex3`````` ``asymMap.simplex3 <- recordPlot()``

Asym for D1 and D3:

``````# Your asymmetric factor scores
asymMap4  <- createFactorMapIJ(t.Fi,
t.Fj.a,
col.labels.j = "hotpink",
col.points.j = "hotpink",
col.points.i = "darkgreen",
axis1 = 1,
axis2 = 3
)

# set drawing order, goal is to flatten the simplex:
polygonorder4 <- c(3,5,7,2,1)

# Make the simplex visible
zePoly.J.extra <-  PTCA4CATA::ggdrawPolygon(t.Fj.a[,c(1,3)],
order2draw = polygonorder4, # this parameter determines which point to draw first
color = 'hotpink',
size = .2,
fill =  'hotpink',
alpha = .05)

# Labels
labels4CA <- createxyLabels(resCA = resCA.asym, x_axis = 1, y_axis = 3)

# Combine all elements you want to include in this plot
asymMap.simplex4  <-  asymMap4\$baseMap + zePoly.J.extra +
asymMap4\$I_points +
asymMap4\$J_labels +
asymMap4\$J_points +
labels4CA +
ggtitle('Asymmetric Map with Simplex (From Products) - D1 & D3')

asymMap.simplex4`````` ``asymMap.simplex4 <- recordPlot()``

#### 8.3.4.2Symmetric Factor Scores

Notes:

Since we have a relatively large number of rows and cols, it is a good idea to plot rows and cols separately. On the other hand, if we have a small number of rows and cols, we can do a biplot where 2 maps are on top of each other. Reason: since it is a symmetric map, we can put them on a same plane without issues.

``````# create symmetric Map:
symMap <- createFactorMapIJ(Fi,
Fj,
col.labels.j = "darkgreen",
col.points.j = "darkgreen",
col.points.i = "hotpink",
col.labels.i = "hotpink",
text.cex.i = 3,
text.cex.j = 3)

labels4CA <- createxyLabels(resCA = resCA.asym)

# plot the row factor scores
symMap.row <- symMap\$baseMap  +
symMap\$I_labels + symMap\$I_points +
ggtitle('Symmetric: Row') +
labels4CA

# plot the columns factor scores with confidence intervals
symMap.col <- symMap\$baseMap +
symMap\$J_labels + symMap\$J_points +
ggtitle('Symmetric: Column') +
labels4CA

sidebyside <-  grid.arrange(
symMap.row, symMap.col,
ncol = 2,nrow = 1,
top = textGrob("Factor scores", gp = gpar(fontsize = 18, font = 3))
)`````` ``````biplot     <- symMap\$baseMap  +
symMap\$I_labels + symMap\$I_points +
symMap\$J_labels + symMap\$J_points +
ggtitle('Factor Scores Biplot (Rows and Cols)') +
labels4CA

sidebyside ``````
``````## TableGrob (2 x 2) "arrange": 3 grobs
##   z     cells    name                  grob
## 1 1 (2-2,1-1) arrange        gtable[layout]
## 2 2 (2-2,2-2) arrange        gtable[layout]
## 3 3 (1-1,1-2) arrange text[GRID.text.12558]``````
``````sidebyside <- recordPlot()

symMap.row `````` ``````symMap.row <- recordPlot()

symMap.col `````` ``````symMap.col <- recordPlot()

biplot`````` ``biplot     <- recordPlot() ``

Let’s also check Dimension 3 and 4:

``````# create symmetric Map:
symMap <- createFactorMapIJ(Fi,
Fj,
col.labels.j = "darkgreen",
col.points.j = "darkgreen",
col.points.i = "hotpink",
col.labels.i = "hotpink",
text.cex.i = 3,
text.cex.j = 3,
axis1 = 3,
axis2 = 4)

labels4CA <- createxyLabels(resCA = resCA.asym, x_axis = 3, y_axis = 4)

# plot the row factor scores
symMap.row2 <- symMap\$baseMap  +
symMap\$I_labels + symMap\$I_points +
ggtitle('Symmetric: Row - D3 & D4') +
labels4CA

# plot the columns factor scores with confidence intervals
symMap.col2 <- symMap\$baseMap +
symMap\$J_labels + symMap\$J_points +
ggtitle('Symmetric: Column - D3 & D4') +
labels4CA

sidebyside2 <-  grid.arrange(
symMap.row2, symMap.col2,
ncol = 2,nrow = 1,
top = textGrob("Factor scores - D3 & D4", gp = gpar(fontsize = 18, font = 3))
)`````` ``````biplot2     <- symMap\$baseMap  +
symMap\$I_labels + symMap\$I_points +
symMap\$J_labels + symMap\$J_points +
ggtitle('Factor Scores Biplot (Rows and Cols) - D3 & D4') +
labels4CA

sidebyside2 ``````
``````## TableGrob (2 x 2) "arrange": 3 grobs
##   z     cells    name                  grob
## 1 1 (2-2,1-1) arrange        gtable[layout]
## 2 2 (2-2,2-2) arrange        gtable[layout]
## 3 3 (1-1,1-2) arrange text[GRID.text.13030]``````
``````sidebyside2 <- recordPlot()

symMap.row2 `````` ``````symMap.row <- recordPlot()

symMap.col2 `````` ``````symMap.col2 <- recordPlot()

biplot2`````` ``biplot2     <- recordPlot() ``

Recolor to tell a story about products similarities (D1,2 - rows):

``````#color for product groups based on proximity
prod.color <- dplyr::recode(wk0\$Products,
"Nutriday Bebible" = "firebrick1",
"Alquería Niños" = 'firebrick1',
"Yogo Yogo" = 'firebrick1',
"Seedy strawberry" = "thistle2",
"Jammy strawberry" = "turquoise3",
"Sweet strawberry" = "thistle2",
"Candied strawberry" = "turquoise3",
"Fruity strawberry"= "thistle2"
)

# create symmetric Map:
symMap <- createFactorMapIJ(Fi,
Fj,
col.points.i = prod.color,
col.labels.i = prod.color,
text.cex.i = 3,
text.cex.j = 3)

labels4CA <- createxyLabels(resCA = resCA.asym)

# plot the row factor scores
symMap.row3 <- symMap\$baseMap  +
symMap\$I_labels + symMap\$I_points +
ggtitle('Symmetric: Row - Products Groups on Component 1') +
labels4CA

symMap.row3 `````` ``symMap.row3 <- recordPlot()``

Recolor to tell a story about positive vs negative emotions (D3,4 - columns):

``````#Recolor positive vs negative emotions:
emo.color <- dplyr::recode(colnames(wk0[,-1]),
"Happy" = "turquoise3",
"Pleasantly surprised" = "turquoise3",
"Refreshed" = "turquoise3",
"Calm" = "turquoise3",
"Comforted" = "turquoise3",
"Disgusted" = 'firebrick1',
"Energetic" = "turquoise3",
"Joy" = "turquoise3",
"Interested" = "turquoise3",
"Irritated" = 'firebrick1',
"Relaxed" = "turquoise3",
"Sad" = 'firebrick1',
"Well-being" = "turquoise3")

# create symmetric Map:
symMap <- createFactorMapIJ(Fi,
Fj,
col.labels.j = emo.color,
col.points.j = emo.color,
text.cex.i = 3,
text.cex.j = 3,
axis1 = 3,
axis2 = 4)

labels4CA <- createxyLabels(resCA = resCA.asym, x_axis = 3, y_axis = 4)

# plot the columns factor scores with confidence intervals
symMap.col3 <- symMap\$baseMap +
symMap\$J_labels + symMap\$J_points +
ggtitle('Symmetric: Column - D3 & D4 - Positive VS Negative Emotion') +
labels4CA

symMap.col3 `````` ``symMap.col3 <- recordPlot()``

#### 8.3.4.3Contributions and bootstrap ratios barplots

Contribution barplots:

Make the barplots:

``````signed.ctrI <- resCA.sym\$ExPosition.Data\$ci * sign(resCA.sym\$ExPosition.Data\$fi)
signed.ctrJ <- resCA.sym\$ExPosition.Data\$cj * sign(resCA.sym\$ExPosition.Data\$fj)

#matching color scheme:
sweet.col <- rep("darkseagreen",13)
sweet.row <- rep("hotpink",8)

# plot contributions of rows for component 1
ctrI.1 <- PrettyBarPlot2(signed.ctrI[,1],
threshold = 1 / NROW(signed.ctrI),
font.size = 3,
color4bar = sweet.row,
ylab = 'Contributions',
ylim = c(1.2*min(signed.ctrI), 1.2*max(signed.ctrI))
) + ggtitle("Component 1", subtitle = 'rows')

# plot contributions of columns for component 1
ctrJ.1 <- PrettyBarPlot2(signed.ctrJ[,1],
threshold = 1 / NROW(signed.ctrJ),
font.size = 3,
color4bar = sweet.col,
ylab = 'Contributions',
ylim = c(1.2*min(signed.ctrJ), 1.2*max(signed.ctrJ))
) + ggtitle("", subtitle = 'columns')

# plot contributions of rows for component 2
ctrI.2 <- PrettyBarPlot2(signed.ctrI[,2],
threshold = 1 / NROW(signed.ctrI),
font.size = 3,
color4bar = sweet.row,
ylab = 'Contributions',
ylim = c(1.2*min(signed.ctrI), 1.2*max(signed.ctrI))
) + ggtitle("Component 2", subtitle = 'rows')

# plot contributions of columns for component 2
ctrJ.2 <- PrettyBarPlot2(signed.ctrJ[,2],
threshold = 1 / NROW(signed.ctrJ),
font.size = 3,
color4bar = sweet.col,
ylab = 'Contributions',
ylim = c(1.2*min(signed.ctrJ), 1.2*max(signed.ctrJ))
) + ggtitle("", subtitle = 'columns')``````

Combine them:

``````grid.arrange(
as.grob(ctrI.1),as.grob(ctrJ.1),as.grob(ctrI.2),as.grob(ctrJ.2),
ncol = 2,nrow = 2,
top = textGrob("Contributions", gp = gpar(fontsize = 18, font = 3))
)`````` ``Ctr.IJ <- recordPlot()``

Bootstrap Ratio

``````BR.I <- resCAinf.sym.row\$Inference.Data\$fj.boots\$tests\$boot.ratios
BR.J <- resCAinf.sym.col\$Inference.Data\$fj.boots\$tests\$boot.ratios

sweet.row1 <- rep("hotpink",13)

laDim = 1

# Plot the bootstrap ratios for Dimension 1
ba001.BR1.I <- PrettyBarPlot2(BR.I[,laDim],
threshold = 2,
font.size = 3,
color4bar = sweet.row,
ylab = 'Bootstrap ratios'
#ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle(paste0('Component ', laDim), subtitle = 'rows')

ba002.BR1.J <- PrettyBarPlot2(BR.J[,laDim],
threshold = 2,
font.size = 3,
color4bar = sweet.col,
ylab = 'Bootstrap ratios'
#ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle("", subtitle = 'columns')

# Plot the bootstrap ratios for Dimension 2
laDim = 2
ba003.BR2.I <- PrettyBarPlot2(BR.I[,laDim],
threshold = 2,
font.size = 3,
color4bar = sweet.row,
ylab = 'Bootstrap ratios'
#ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle(paste0('Component ', laDim), subtitle = 'rows')

ba004.BR2.J <- PrettyBarPlot2(BR.J[,laDim],
threshold = 2,
font.size = 3,
color4bar = sweet.col,
ylab = 'Bootstrap ratios'
#ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle("", subtitle = 'columns')``````

Combine them:

``````grid.arrange(
as.grob(ba001.BR1.I),as.grob(ba002.BR1.J),as.grob(ba003.BR2.I),as.grob(ba004.BR2.J),
ncol = 2,nrow = 2,
top = textGrob("Bootstrap ratios", gp = gpar(fontsize = 18, font = 3))
)`````` ``BR.IJ <- recordPlot() # you need this line to be able to save them in the end``

Combine them all:

``````grid.arrange(
as.grob(ctrI.1),as.grob(ctrJ.1),as.grob(ctrI.2),as.grob(ctrJ.2),as.grob(ba001.BR1.I),as.grob(ba002.BR1.J),as.grob(ba003.BR2.I),as.grob(ba004.BR2.J),
ncol = 4,nrow = 2,
top = textGrob("Contribution                &                Bootstrap Ratios", gp = gpar(fontsize = 18, font = 3))
)`````` ``combine <- recordPlot()``

Repeat for Dimension 3 and 4:

Make the barplots:

``````signed.ctrI <- resCA.sym\$ExPosition.Data\$ci * sign(resCA.sym\$ExPosition.Data\$fi)
signed.ctrJ <- resCA.sym\$ExPosition.Data\$cj * sign(resCA.sym\$ExPosition.Data\$fj)

#matching color scheme:
sweet.col <- rep("darkseagreen",13)
sweet.row <- rep("hotpink",8)

# plot contributions of rows for component 1
ctrI.1 <- PrettyBarPlot2(signed.ctrI[,3],
threshold = 1 / NROW(signed.ctrI),
font.size = 3,
color4bar = sweet.row,
ylab = 'Contributions',
ylim = c(1.2*min(signed.ctrI), 1.2*max(signed.ctrI))
) + ggtitle("Component 1", subtitle = 'rows')

# plot contributions of columns for component 1
ctrJ.1 <- PrettyBarPlot2(signed.ctrJ[,3],
threshold = 1 / NROW(signed.ctrJ),
font.size = 3,
color4bar = sweet.col,
ylab = 'Contributions',
ylim = c(1.2*min(signed.ctrJ), 1.2*max(signed.ctrJ))
) + ggtitle("", subtitle = 'columns')

# plot contributions of rows for component 2
ctrI.2 <- PrettyBarPlot2(signed.ctrI[,4],
threshold = 1 / NROW(signed.ctrI),
font.size = 3,
color4bar = sweet.row,
ylab = 'Contributions',
ylim = c(1.2*min(signed.ctrI), 1.2*max(signed.ctrI))
) + ggtitle("Component 2", subtitle = 'rows')

# plot contributions of columns for component 2
ctrJ.2 <- PrettyBarPlot2(signed.ctrJ[,4],
threshold = 1 / NROW(signed.ctrJ),
font.size = 3,
color4bar = sweet.col,
ylab = 'Contributions',
ylim = c(1.2*min(signed.ctrJ), 1.2*max(signed.ctrJ))
) + ggtitle("", subtitle = 'columns')``````

Combine them:

``````grid.arrange(
as.grob(ctrI.1),as.grob(ctrJ.1),as.grob(ctrI.2),as.grob(ctrJ.2),
ncol = 2,nrow = 2,
top = textGrob("Contributions", gp = gpar(fontsize = 18, font = 3))
)`````` ``Ctr.IJ <- recordPlot()``

Bootstrap Ratio

``````BR.I <- resCAinf.sym.row\$Inference.Data\$fj.boots\$tests\$boot.ratios
BR.J <- resCAinf.sym.col\$Inference.Data\$fj.boots\$tests\$boot.ratios

sweet.row1 <- rep("hotpink",13)

laDim = 3

# Plot the bootstrap ratios for Dimension 1
ba001.BR1.I <- PrettyBarPlot2(BR.I[,laDim],
threshold = 2,
font.size = 3,
color4bar = sweet.row,
ylab = 'Bootstrap ratios'
#ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle(paste0('Component ', laDim), subtitle = 'rows')

ba002.BR1.J <- PrettyBarPlot2(BR.J[,laDim],
threshold = 2,
font.size = 3,
color4bar = sweet.col,
ylab = 'Bootstrap ratios'
#ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle("", subtitle = 'columns')

# Plot the bootstrap ratios for Dimension 2
laDim = 4
ba003.BR2.I <- PrettyBarPlot2(BR.I[,laDim],
threshold = 2,
font.size = 3,
color4bar = sweet.row,
ylab = 'Bootstrap ratios'
#ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle(paste0('Component ', laDim), subtitle = 'rows')

ba004.BR2.J <- PrettyBarPlot2(BR.J[,laDim],
threshold = 2,
font.size = 3,
color4bar = sweet.col,
ylab = 'Bootstrap ratios'
#ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle("", subtitle = 'columns')``````

Combine them:

``````grid.arrange(
as.grob(ba001.BR1.I),as.grob(ba002.BR1.J),as.grob(ba003.BR2.I),as.grob(ba004.BR2.J),
ncol = 2,nrow = 2,
top = textGrob("Bootstrap ratios", gp = gpar(fontsize = 18, font = 3))
)`````` ``BR.IJ <- recordPlot() # you need this line to be able to save them in the end``

Combine them all:

``````grid.arrange(
as.grob(ctrI.1),as.grob(ctrJ.1),as.grob(ctrI.2),as.grob(ctrJ.2),as.grob(ba001.BR1.I),as.grob(ba002.BR1.J),as.grob(ba003.BR2.I),as.grob(ba004.BR2.J),
ncol = 4,nrow = 2,
top = textGrob("Contribution                &                Bootstrap Ratios", gp = gpar(fontsize = 18, font = 3))
)`````` ``combine <- recordPlot()``

#### 8.3.4.4Save to PPTX

``````savedList <- saveGraph2pptx(file2Save.pptx = 'AllFigures_CA_4',
title = 'All Figures for CA',
addGraphNames = TRUE)``````