tests/testthat/test-pricesensitivitymeter.R

context("Price sensitivity meter")

dat <- as.matrix(data.frame(`Too cheap` = c(1, 0.5, 0.75, 0.5, 0.25, 0.5, 0.5, 1, 1, 0.1,
                                            1, 0.5, 1, 0, 0.5, 0.25, 1, 2, 0.75, 0.25,
                                            0.75, 0.5, 0.75, 0.25, 1.5, 0.2),
                            `Cheap` = c(1, 2.1, 2, 2, 0.75, 2,0.5, 1.5, 4, 1.5,
                                        0.5, 3.5, 0.9, 2.5, 0.8, 3, 0.25, 5, 2.5, 1,
                                        1, 1, 1, 2, 1, 1),
                            'Expensive' = c(2, 2.8, 5, 2.5, 1.5, 4, 1.5, 2, 5.5, 3,
                                            1.7, 7, 2, 3.5, 1.1, 5, 1, 6, 3, 3,
                                            2, 1.5, 1.5, 3, 1.5, 2.5),
                            'Too expensive' = c(6, 2.5, 3, 2, 2, 3, 5, 3.5, 8, 1.5,
                                                6, 1.2, 4.5, 3, 8, 2, 3, 6, 2, 2,
                                                7, 5, 8, 7, 3, 5)))


test_that("PSM",
{
    expect_warning(PriceSensitivityMeter(dat, check.prices.ordered = TRUE),
                   "should be supplied in increasing order")
    dat[5,1] <- NA
    dat[6,4] <- NA
    expect_error(PriceSensitivityMeter(dat), NA)
    
    dat.missing <- cbind(dat[,1:3], 'Very expensive' = rep(NA, NROW(dat)))
    expect_error(PriceSensitivityMeter(dat.missing), NA)
})

fake <- data.frame(A = 1:10, B = (1:10) + 1, C = (1:10) + 2, D = (1:10) + 3)
test_that("Check proportions",
{
    psm0 <- PriceSensitivityMeter(fake)
    expect_equal(attr(psm0, "ChartData")[,1], c((10:1)/10, 0.0, 0.0, 0.0), check.attributes = FALSE)
    psm1 <- PriceSensitivityMeter(fake, resolution = 0.1)
    expect_equal(attr(psm1, "ChartData")[,3], 
         c(`1` = 0, `1.1` = 0, `1.2` = 0, `1.3` = 0, `1.4` = 0, `1.5` = 0, 
           `1.6` = 0, `1.7` = 0, `1.8` = 0, `1.9` = 0, `2` = 0, `2.1` = 0, 
           `2.2` = 0, `2.3` = 0, `2.4` = 0, `2.5` = 0, `2.6` = 0, `2.7` = 0, 
           `2.8` = 0, `2.9` = 0, `3` = 0.1, `3.1` = 0.1, `3.2` = 0.1, `3.3` = 0.1, 
           `3.4` = 0.1, `3.5` = 0.1, `3.6` = 0.1, `3.7` = 0.1, `3.8` = 0.1, 
           `3.9` = 0.1, `4` = 0.2, `4.1` = 0.2, `4.2` = 0.2, `4.3` = 0.2, 
           `4.4` = 0.2, `4.5` = 0.2, `4.6` = 0.2, `4.7` = 0.2, `4.8` = 0.2, 
           `4.9` = 0.2, `5` = 0.3, `5.1` = 0.3, `5.2` = 0.3, `5.3` = 0.3, 
           `5.4` = 0.3, `5.5` = 0.3, `5.6` = 0.3, `5.7` = 0.3, `5.8` = 0.3, 
           `5.9` = 0.3, `6` = 0.4, `6.1` = 0.4, `6.2` = 0.4, `6.3` = 0.4, 
           `6.4` = 0.4, `6.5` = 0.4, `6.6` = 0.4, `6.7` = 0.4, `6.8` = 0.4, 
           `6.9` = 0.4, `7` = 0.5, `7.1` = 0.5, `7.2` = 0.5, `7.3` = 0.5, 
           `7.4` = 0.5, `7.5` = 0.5, `7.6` = 0.5, `7.7` = 0.5, `7.8` = 0.5, 
           `7.9` = 0.5, `8` = 0.6, `8.1` = 0.6, `8.2` = 0.6, `8.3` = 0.6, 
           `8.4` = 0.6, `8.5` = 0.6, `8.6` = 0.6, `8.7` = 0.6, `8.8` = 0.6, 
           `8.9` = 0.6, `9` = 0.7, `9.1` = 0.7, `9.2` = 0.7, `9.3` = 0.7, 
           `9.4` = 0.7, `9.5` = 0.7, `9.6` = 0.7, `9.7` = 0.7, `9.8` = 0.7, 
           `9.9` = 0.7, `10` = 0.8, `10.1` = 0.8, `10.2` = 0.8, `10.3` = 0.8, 
           `10.4` = 0.8, `10.5` = 0.8, `10.6` = 0.8, `10.7` = 0.8, `10.8` = 0.8, 
           `10.9` = 0.8, `11` = 0.9, `11.1` = 0.9, `11.2` = 0.9, `11.3` = 0.9, 
           `11.4` = 0.9, `11.5` = 0.9, `11.6` = 0.9, `11.7` = 0.9, `11.8` = 0.9, 
           `11.9` = 0.9, `12` = 1, `12.1` = 1, `12.2` = 1, `12.3` = 1, `12.4` = 1, 
           `12.5` = 1, `12.6` = 1, `12.7` = 1, `12.8` = 1, `12.9` = 1, `13` = 1)
         )
    psm2 <- PriceSensitivityMeter(fake, weights = 1:10)
    expect_equal(attr(psm2, "ChartData")[,2],
        c(`1` = 1, `2` = 1, `3` = 0.981818181818182, `4` = 0.945454545454545,
        `5` = 0.890909090909091, `6` = 0.818181818181818, `7` = 0.727272727272727,
        `8` = 0.618181818181818, `9` = 0.490909090909091, `10` = 0.345454545454545,
        `11` = 0.181818181818182, `12` = 0, `13` = 0)
    )
})
NumbersInternational/flipStartup documentation built on May 2, 2024, 11:12 p.m.