tests/testthat/test-principalcomponentsbiplot.R

In NumbersInternational/flipDimensionReduction: Algorithms for dimension reduction

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))
    })