context("PCA Biplot")
# same table as correspondence analysis
x0 <- matrix(c(0.3004, 0.6864, 0.4975, 0.2908, 0.2781, 0.2642, 0.1916,
0.284, 0.3514, 0.2534, 0.2089,
c( 0.0198, 0.4604, 0.2151, 0.5235, 0.1151,
0.12, 0.5457, 0.3041, 0.06312, 0.384, 0.06064),
c( 0.01114, 0.4111, 0.1904, 0.4494, 0.06931,
0.1112, 0.4716, 0.2859, 0.0495, 0.3296, 0.03837),
c( 0.01114, 0.2373, 0.089, 0.2707, 0.05322,
0.06436, 0.2756, 0.1656, 0.02967, 0.1916,
0.02228), c( 0.0198, 0.177, 0.07054, 0.0297, 0.0396,
0.02719, 0.0136, 0.02847, 0.0198, 0.02847,
0.02472), c( 0.4543, 0.1275, 0.07673, 0.02847, 0.07293,
0.1077, 0.01609, 0.05198, 0.321, 0.01856,
0.0297),
c( 0.06807, 0.1089, 0.06064, 0.0198, 0.1174,
0.04084, 0.01609, 0.01733, 0.03465,
0.01361, 0.03589), c( 0.08168, 0.224, 0.1015, 0.04579, 0.04815,
0.04084, 0.03094, 0.05562, 0.05322,
0.04084, 0.02847)),nrow=8,byrow=TRUE)
x.with.labels <- x0
dimnames(x.with.labels) <- list(Brand=c('Coke','V',"Red Bull",
"Lift Plus",'Diet.Coke',
'Fanta','Lift','Pepsi'),
Attribute=c('Kids', 'Teens',
"Enjoy life",
'Picks you up',
'Refreshes',
'Cheers you up',
'Energy', 'Up-to-date',
'Fun', 'When tired',
'Relax'))
test_that("Row and column labels",
{
res0 <- PrincipalComponentsBiplot(x.with.labels, row.names.to.remove = "NET", column.names.to.remove = "NET")
expect_equal(attr(res0, "ChartType"), "X Y Scatter")
expect_equal(length(attr(attr(res0, "ChartData"), "scatter.variable.indices")), 4)
expect_equal(res0$row.column.names, c("Brand", "Attribute"))
xd <- array(runif(9), dim = c(3, 3, 3), dimnames = list(A = c("a","a","a"), B = c("a","a","a"), C = c("a","a","a")))
attr(xd, "name") <- "My so cool table from Q"
attr(xd, "questions") <- "What's the meaning of life?"
expect_warning(res00 <- PrincipalComponentsBiplot(xd), "^Multiple statistic")
expect_equal(res00$row.column.names, c("A", "B"))
})
x1 <- structure(c(25.0764525993884, 25.6880733944954, 27.3846153846154,
23.9263803680982, 27.6923076923077, 19.9386503067485, 0, 0.305810397553517,
0.307692307692308, 0.613496932515337, 0, 0, 0, 0, 0, 0, 0, 0.920245398773006,
28.7461773700306, 22.0183486238532, 22.4615384615385, 22.6993865030675,
15.0769230769231, 23.6196319018405, 7.03363914373089, 19.8776758409786,
15.3846153846154, 16.5644171779141, 23.6923076923077, 17.7914110429448,
14.3730886850153, 20.4892966360856, 20.9230769230769, 19.3251533742331,
23.6923076923077, 17.7914110429448, 5.81039755351682, 4.28134556574923,
2.76923076923077, 2.45398773006135, 3.38461538461538, 3.68098159509202,
4.28134556574923, 1.8348623853211, 1.53846153846154, 2.14723926380368,
2.46153846153846, 0.920245398773006, 5.19877675840979, 2.75229357798165,
4, 5.52147239263804, 2.15384615384615, 8.58895705521472, 2.75229357798165,
1.52905198776758, 2.46153846153846, 4.29447852760736, 0.615384615384615,
3.37423312883436, 3.05810397553517, 0.917431192660551, 2.15384615384615,
2.14723926380368, 0.923076923076923, 3.37423312883436, 3.6697247706422,
0.305810397553517, 0.615384615384615, 0.306748466257669, 0.307692307692308,
0, 100, 100, 100, 100, 100, 100), .Dim = c(6L, 13L), statistic = "Row %", .Dimnames = list(
c("Coke", "Diet Coke", "Coke Zero", "Pepsi", "Diet Pepsi",
"Pepsi Max"), c("Functional", "Price: Expensive", "Price: Inexpensive",
"Evaluative: Positive", "Evaluative: Negative", "Other",
"Reliable", "Fun", "Energising", "Sexy", "Strong", "Classic",
"NET")), name = "Q1. Fragments coded", questions = c("Q1. Fragments coded",
"SUMMARY"))
# corresponds to Example 2 on wiki
x3 <- structure(c(17.6551724137931, 23.3103448275862, 16.9655172413793,
17.7931034482759, 11.3103448275862, 34.2068965517241, 9.51724137931034,
15.7241379310345, 3.72413793103448, 32.9655172413793, 10.4827586206897,
4.55172413793103, 11.3103448275862, 22.6206896551724, 11.1724137931034,
10.7586206896552, 14.3448275862069, 37.6551724137931, 63.3103448275862,
93.6551724137931, 13.6551724137931, 22.2068965517241, 10.2068965517241,
11.5862068965517, 9.79310344827586, 29.1034482758621, 6.20689655172414,
35.7241379310345, 2.06896551724138, 33.2413793103448, 9.24137931034483,
3.58620689655172, 7.72413793103448, 32.1379310344828, 9.24137931034483,
8.27586206896552, 12.2758620689655, 37.3793103448276, 72, 93.3793103448276,
20.2758620689655, 37.9310344827586, 12.2758620689655, 20.8275862068966,
11.1724137931034, 39.448275862069, 5.93103448275862, 88.2758620689655,
2.48275862068966, 46.4827586206897, 9.51724137931034, 3.72413793103448,
8.27586206896552, 65.3793103448276, 10.2068965517241, 8.27586206896552,
13.3793103448276, 57.3793103448276, 24.2758620689655, 97.9310344827586,
34.2068965517241, 37.5172413793103, 41.7931034482759, 37.6551724137931,
32.9655172413793, 26.3448275862069, 47.448275862069, 3.58620689655172,
35.448275862069, 52.1379310344828, 44, 62.8965517241379, 23.448275862069,
24.551724137931, 48.551724137931, 44.6896551724138, 49.2413793103448,
40.2758620689655, 6.48275862068965, 98.2068965517241, 16.551724137931,
25.9310344827586, 27.7241379310345, 38.2068965517241, 36, 25.5172413793103,
11.8620689655172, 13.5172413793103, 6.89655172413793, 33.9310344827586,
21.5172413793103, 16, 11.1724137931034, 22.0689655172414, 16.2758620689655,
20.4137931034483, 25.6551724137931, 37.5172413793103, 28, 95.0344827586207,
78.3448275862069, 45.2413793103448, 27.0344827586207, 13.9310344827586,
20.9655172413793, 51.1724137931034, 63.8620689655172, 1.93103448275862,
71.8620689655172, 34.2068965517241, 39.1724137931035, 60.8275862068966,
69.5172413793103, 19.3103448275862, 46.0689655172414, 57.6551724137931,
37.2413793103448, 49.7931034482759, 4.96551724137931, 99.0344827586207,
13.9310344827586, 19.7241379310345, 32.2758620689655, 36, 36.8275862068965,
20.8275862068966, 9.24137931034483, 14.2068965517241, 4.13793103448276,
30.4827586206897, 15.1724137931034, 10.0689655172414, 9.51724137931034,
18.2068965517241, 12.551724137931, 12.1379310344828, 23.1724137931034,
33.3793103448276, 47.1724137931034, 94.4827586206897, 20.6896551724138,
23.8620689655172, 43.1724137931034, 34.7586206896552, 51.8620689655172,
19.1724137931034, 45.1034482758621, 3.17241379310345, 43.3103448275862,
33.9310344827586, 44.2758620689655, 53.6551724137931, 21.1034482758621,
15.5862068965517, 42.6206896551724, 43.8620689655172, 50.0689655172414,
35.0344827586207, 11.3103448275862, 98.0689655172414, 94.7586206896552,
95.448275862069, 95.1724137931034, 98.7586206896552, 96.4137931034483,
97.7931034482759, 98.2068965517241, 99.0344827586207, 98.3448275862069,
97.6551724137931, 85.3793103448276, 95.7241379310345, 91.0344827586207,
95.8620689655172, 94.8965517241379, 95.448275862069, 98.2068965517241,
94.7586206896552, 92.6896551724138, 99.0344827586207), .Dim = c(20L,
9L), statistic = "%", .Dimnames = list(c("Bureaucratic", "Slow service",
"Friendly", "Low prices", "Fashionable", "Unfashionable", "Reliable",
"Here today, gone tomorrow", "Good coverage", "Network often down",
"The best phones", "Conveniently located stores", "High prices",
"Unreliable", "Meet all my communication needs", "Leaders in mobile phone technology",
"I like them", "I hate them", "Don't know much about them", "NET"
), c("AAPT/Cellular One", "New Tel", "One-tel", "Optus", "Orange (Hutchison)",
"Telstra (Mobile Net)", "Virgin Mobile", "Vodafone", "NET")), name = "q20", questions = c("q20",
"SUMMARY"))
for (output in c("Scatterplot", "Moonplot", "Text"))
test_that(paste0("PrincipalComponentsBiplot is OK (mainly GetTidyTwoDimensionalArray) with ", output),
{
expect_error(PrincipalComponentsBiplot(x1, output = output), NA)
expect_error(PrincipalComponentsBiplot(x1, output = output, row.names.to.remove = "NET", column.names.to.remove = "NET"), NA)
})
test_that("Check PrincipalBiplot values",
{
res1 <- PrincipalComponentsBiplot(x3, normalization = "None")
expect_equal(dim(res1$colcoords), c(8,8))
expect_equal(dim(res1$rowcoords), c(19,8))
expect_equal(unname(round(res1$colcoords[,1], digits=2)), c(0.29,0.41,0.54,-0.29,0.11,-0.48,0.19,-0.31))
expect_equal(unname(round(res1$colcoords[,2], digits=2)), c(0.12,0.03,-0.46,0.21,0.31,-0.56,0.42,0.39))
res2 <- PrincipalComponentsBiplot(x3, row.names.to.remove = "Don't know much about them, NET")
expect_equal(dim(res2$colcoords), c(8,8))
expect_equal(dim(res2$rowcoords), c(18,8))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.