tests/testthat/test-pSceptical.R

In ReplicationSuccess: Design and Analysis of Replication Studies

test_that("Output of function 'pSceptical' stays the same.", {
    zo <- seq(-4, 4, 2)
    grid <- expand.grid(
        zr = seq(-4, 4, 2),
        c = c(0.5, 2),
        alternative = c("one.sided", "two.sided"),
        type = c("golden", "nominal", "controlled"),
        stringsAsFactors = FALSE
    )
    out <- lapply(
        seq_len(nrow(grid)),
        function(i) {
            pSceptical(
                zo = zo,
                zr = grid[i, "zr"],
                c = grid[i, "c"],
                alternative = grid[i, "alternative"],
                type = grid[i, "type"]
            )
        }
    )
    res <- list(
        c(4.92521679461104e-05, 0.00860230836312371, 0.5, 0.991397691636876,
        0.999950747832054), c(0.00860230836312371, 0.0257599721993693,
        0.5, 0.974240027800631, 0.991397691636876), c(0.5, 0.5, 0.5,
        0.5, 0.5), c(0.991397691636876, 0.974240027800631, 0.5, 0.0257599721993693,
        0.00860230836312371), c(0.999950747832054, 0.991397691636876,
        0.5, 0.00860230836312371, 4.92521679461104e-05), c(0.000528949538842483,
        0.0165499416760937, 0.5, 0.983450058323906, 0.999471050461157
        ), c(0.0165499416760937, 0.050780864777783, 0.5, 0.949219135222217,
        0.983450058323906), c(0.5, 0.5, 0.5, 0.5, 0.5), c(0.983450058323906,
        0.949219135222217, 0.5, 0.050780864777783, 0.0165499416760937
        ), c(0.999471050461157, 0.983450058323906, 0.5, 0.0165499416760937,
        0.000528949538842483), c(9.85043358922208e-05, 0.0172046167262474,
        1, 0.0172046167262474, 9.85043358922208e-05), c(0.0172046167262474,
        0.0515199443987386, 1, 0.0515199443987386, 0.0172046167262474
        ), c(1, 1, 1, 1, 1), c(0.0172046167262474, 0.0515199443987386,
        1, 0.0515199443987386, 0.0172046167262474), c(9.85043358922208e-05,
        0.0172046167262474, 1, 0.0172046167262474, 9.85043358922208e-05
        ), c(0.00105789907768497, 0.0330998833521875, 1, 0.0330998833521875,
        0.00105789907768497), c(0.0330998833521875, 0.101561729555566,
        1, 0.101561729555566, 0.0330998833521875), c(1, 1, 1, 1, 1),
        c(0.0330998833521875, 0.101561729555566, 1, 0.101561729555566,
        0.0330998833521875), c(0.00105789907768497, 0.0330998833521875,
        1, 0.0330998833521875, 0.00105789907768497), c(0.00110127465875785,
        0.0305443593405044, 0.5, 0.969455640659496, 0.998898725341242
        ), c(0.0305443593405044, 0.0629176070193166, 0.5, 0.937082392980683,
        0.969455640659496), c(0.5, 0.5, 0.5, 0.5, 0.5), c(0.969455640659496,
        0.937082392980683, 0.5, 0.0629176070193166, 0.0305443593405044
        ), c(0.998898725341242, 0.969455640659496, 0.5, 0.0305443593405044,
        0.00110127465875785), c(0.00502103908823513, 0.0469488618047047,
        0.5, 0.953051138195295, 0.994978960911765), c(0.0469488618047047,
        0.0990142962787227, 0.5, 0.900985703721277, 0.953051138195295
        ), c(0.5, 0.5, 0.5, 0.5, 0.5), c(0.953051138195295, 0.900985703721277,
        0.5, 0.0990142962787227, 0.0469488618047047), c(0.994978960911765,
        0.953051138195295, 0.5, 0.0469488618047047, 0.00502103908823513
        ), c(0.0022025493175157, 0.0610887186810087, 1, 0.0610887186810087,
        0.0022025493175157), c(0.0610887186810087, 0.125835214038633,
        1, 0.125835214038633, 0.0610887186810087), c(1, 1, 1, 1,
        1), c(0.0610887186810087, 0.125835214038633, 1, 0.125835214038633,
        0.0610887186810087), c(0.0022025493175157, 0.0610887186810087,
        1, 0.0610887186810087, 0.0022025493175157), c(0.0100420781764703,
        0.0938977236094095, 1, 0.0938977236094095, 0.0100420781764703
        ), c(0.0938977236094095, 0.198028592557445, 1, 0.198028592557445,
        0.0938977236094095), c(1, 1, 1, 1, 1), c(0.0938977236094095,
        0.198028592557445, 1, 0.198028592557445, 0.0938977236094095
        ), c(0.0100420781764703, 0.0938977236094095, 1, 0.0938977236094095,
        0.0100420781764703), c(5.76488833772132e-05, 0.0111484571656534,
        0.5, 0.988851542834347, 0.999942351116623), c(0.0111484571656534,
        0.0329134788284658, 0.5, 0.967086521171534, 0.988851542834347
        ), c(0.5, 0.5, 0.5, 0.5, 0.5), c(0.988851542834347, 0.967086521171534,
        0.5, 0.0329134788284658, 0.0111484571656534), c(0.999942351116623,
        0.988851542834347, 0.5, 0.0111484571656534, 5.76488833772132e-05
        ), c(6.28541268221632e-05, 0.00789852693213247, 0.5, 0.992101473067868,
        0.999937145873178), c(0.00789852693213247, 0.0353760980517222,
        0.5, 0.964623901948278, 0.992101473067868), c(0.5, 0.5, 0.5,
        0.5, 0.5), c(0.992101473067868, 0.964623901948278, 0.5, 0.0353760980517222,
        0.00789852693213247), c(0.999937145873178, 0.992101473067868,
        0.5, 0.00789852693213247, 6.28541268221632e-05), c(0.000115297766754426,
        0.0222969143313067, 1, 0.0222969143313067, 0.000115297766754426
        ), c(0.0222969143313067, 0.0658269576569316, 1, 0.0658269576569316,
        0.0222969143313067), c(1, 1, 1, 1, 1), c(0.0222969143313067,
        0.0658269576569316, 1, 0.0658269576569316, 0.0222969143313067
        ), c(0.000115297766754426, 0.0222969143313067, 1, 0.0222969143313067,
        0.000115297766754426), c(0.000125708253644326, 0.0157970538642649,
        1, 0.0157970538642649, 0.000125708253644326), c(0.0157970538642649,
        0.0707521961034444, 1, 0.0707521961034444, 0.0157970538642649
        ), c(1, 1, 1, 1, 1), c(0.0157970538642649, 0.0707521961034444,
        1, 0.0707521961034444, 0.0157970538642649), c(0.000125708253644326,
        0.0157970538642649, 1, 0.0157970538642649, 0.000125708253644326)
    )
    expect_equal(
        out,
        res
    )
})

test_that("Output of function 'zSceptical' stays the same.", {
    grid <- expand.grid(
        zo = seq(-4, 4, 2),
        zr = seq(-4, 4, 2),
        c = c(0.5, 2),
        stringsAsFactors = FALSE
    )
    out <- lapply(
        seq_len(nrow(grid)),
        function(i) {
            zSceptical(zo = grid[i, "zo"],
                       zr = grid[i, "zr"],
                       c = grid[i, "c"])
        })
    expect_equal(
        out,
        list(
            3.06146745892072, 1.87285276984854, 0, 1.87285276984854,
            3.06146745892072, 1.87285276984854, 1.53073372946036, 0,
            1.53073372946036, 1.87285276984854, 0, 0, 0, 0, 0, 1.87285276984854,
            1.53073372946036, 0, 1.53073372946036, 1.87285276984854,
            3.06146745892072, 1.87285276984854, 0, 1.87285276984854,
            3.06146745892072, 2.57437701162233, 1.67518610156176, 0,
            1.67518610156176, 2.57437701162233, 1.67518610156176, 1.28718850581117,
            0, 1.28718850581117, 1.67518610156176, 0, 0, 0, 0, 0, 1.67518610156176,
            1.28718850581117, 0, 1.28718850581117, 1.67518610156176,
            2.57437701162233, 1.67518610156176, 0, 1.67518610156176,
            2.57437701162233
        )
    )
})

test_that("numeric test for pSceptical(): 1", {
    expect_equal(object = pSceptical(zo = sqrt(12.19), zr = sqrt(3.99), c = 1,
                                     alternative = "two.sided",
                                     type = "nominal"),
                 expected = 0.083, tol = 0.01)
    expect_equal(object = pSceptical(zo = 2.33, zr = 2.33, c = 1,
                                     alternative = "one.sided",
                                     type = "nominal"),
                 expected = 0.05, tol = 0.01)
})