Last updated on 2026-10-24 01:51:29 CEST.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 3.3.9 | 92.60 | 329.71 | 422.31 | OK | |
| r-devel-linux-x86_64-debian-gcc | 3.3.9 | 79.24 | 169.56 | 248.80 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 3.3.9 | 63.00 | 214.65 | 277.65 | OK | |
| r-devel-linux-x86_64-fedora-gcc | 3.3.9 | 84.00 | 198.22 | 282.22 | OK | |
| r-devel-windows-x86_64 | 3.3.9 | 114.00 | 213.00 | 327.00 | OK | --no-examples --no-tests --no-vignettes |
| r-patched-linux-x86_64 | 3.3.9 | 102.37 | 291.28 | 393.65 | OK | |
| r-release-linux-x86_64 | 3.3.9 | 104.47 | 289.50 | 393.97 | OK | |
| r-release-macos-arm64 | 3.3.9 | 21.00 | 62.00 | 83.00 | OK | |
| r-release-macos-x86_64 | 3.3.9 | 64.00 | 361.00 | 425.00 | OK | |
| r-release-windows-x86_64 | 3.3.9 | 111.00 | 166.00 | 277.00 | OK | --no-examples --no-tests --no-vignettes |
| r-oldrel-macos-arm64 | 3.3.9 | 19.00 | 65.00 | 84.00 | OK | |
| r-oldrel-macos-x86_64 | 3.3.9 | 63.00 | 385.00 | 448.00 | OK | |
| r-oldrel-windows-x86_64 | 3.3.9 | 144.00 | 158.00 | 302.00 | OK | --no-examples --no-tests --no-vignettes |
Version: 3.3.9
Check: examples
Result: ERROR
Running examples in ‘BuyseTest-Ex.R’ failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: BuyseMultComp
> ### Title: Adjustment for Multiple Comparisons
> ### Aliases: BuyseMultComp
> ### Keywords: htest
>
> ### ** Examples
>
> #### simulate data ####
> set.seed(10)
> df.data <- simBuyseTest(1e2, n.strata = 3)
>
> #### adjustment for all univariate analyses ####
> ff1 <- treatment ~ TTE(eventtime, status = status, threshold = 0.1)
> ff2 <- update(ff1, .~. + cont(score, threshold = 1))
> BT2 <- BuyseTest(ff2, data= df.data, trace = FALSE)
Error in a$specials[[i]] : subscript out of bounds
Calls: BuyseTest ... EventHistory.frame -> model.design -> delete.response -> off
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 3.3.9
Check: tests
Result: ERROR
Running ‘testthat.R’ [37s/44s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
> ## * load packages
> library(testthat)
> library(BuyseTest)
Loading required package: Rcpp
BuyseTest version 3.3.9
>
> library(lava)
Attaching package: 'lava'
The following objects are masked from 'package:testthat':
compare, expectation
> library(data.table)
Attaching package: 'data.table'
The following object is masked from 'package:base':
%notin%
> library(survival)
Attaching package: 'survival'
The following object is masked from 'package:BuyseTest':
brier
> xx <- capture.output(print(veteran))
> library(riskRegression)
riskRegression version 2026.03.11
> library(prodlim)
> library(mvtnorm)
>
> ## * run tests
> ## setwd("~/Documents/GitHub/BuyseTest/tests/")
> ## source("~/Documents/GitHub/BuyseTest/tests/testthat/test-BuyseTest-engine.R")
> test_check("BuyseTest")
Saving _problems/test-BuysePower-124.R
Saving _problems/test-BuysePower-166.R
Saving _problems/test-BuyseTTEM-47.R
Saving _problems/test-BuyseTTEM-97.R
Saving _problems/test-BuyseTTEM-160.R
Saving _problems/test-BuyseTest-CR-126.R
Saving _problems/test-BuyseTest-CR-149.R
Saving _problems/test-BuyseTest-CR-170.R
Saving _problems/test-BuyseTest-CR-189.R
Saving _problems/test-BuyseTest-PairScore-52.R
Saving _problems/test-BuyseTest-PairScore-93.R
Saving _problems/test-BuyseTest-Pairs-454.R
Saving _problems/test-BuyseTest-Pairs-518.R
Saving _problems/test-BuyseTest-Pairs-542.R
Saving _problems/test-BuyseTest-Pairs-584.R
Saving _problems/test-BuyseTest-checkValues-180.R
Saving _problems/test-BuyseTest-checkValues-265.R
Saving _problems/test-BuyseTest-checkValues-328.R
Saving _problems/test-BuyseTest-checkValues-384.R
Saving _problems/test-BuyseTest-checkValues-445.R
Saving _problems/test-BuyseTest-checkValues-460.R
Saving _problems/test-BuyseTest-correctionTTE-109.R
Saving _problems/test-BuyseTest-correctionTTE-129.R
Saving _problems/test-BuyseTest-correctionTTE-198.R
Saving _problems/test-BuyseTest-correctionTTE-220.R
Saving _problems/test-BuyseTest-engine-48.R
Saving _problems/test-BuyseTest-engine-79.R
Saving _problems/test-BuyseTest-iid-572.R
Saving _problems/test-BuyseTest-iid-647.R
Saving _problems/test-BuyseTest-iid-699.R
Saving _problems/test-BuyseTest-iid-753.R
Saving _problems/test-BuyseTest-operator-64.R
Saving _problems/test-BuyseTest-previousBug-130.R
Saving _problems/test-BuyseTest-previousBug-208.R
Saving _problems/test-BuyseTest-previousBug-247.R
Saving _problems/test-BuyseTest-previousBug-365.R
Saving _problems/test-BuyseTest-previousBug-437.R
Saving _problems/test-BuyseTest-resampling-49.R
Saving _problems/test-BuyseTest-resampling-133.R
Saving _problems/test-BuyseTest-resampling-247.R
Saving _problems/test-BuyseTest-resampling-337.R
Saving _problems/test-BuyseTest-restricted-45.R
Saving _problems/test-BuyseTest-standardization-60.R
Saving _problems/test-BuyseTest-standardization-148.R
Saving _problems/test-BuyseTest-standardization-203.R
Saving _problems/test-BuyseTest-standardization-244.R
Saving _problems/test-BuyseTest-weightObs-33.R
Saving _problems/test-BuyseTest-weightObs-54.R
Saving _problems/test-initSurvival-48.R
[ FAIL 49 | WARN 0 | SKIP 1 | PASS 708 ]
══ Skipped tests (1) ═══════════════════════════════════════════════════════════
• empty test (1):
══ Failed tests ════════════════════════════════════════════════════════════════
── Error ('test-BuysePower.R:118:5'): 1 tte endpoint - Peron ───────────────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::powerBuyseTest(...) at test-BuysePower.R:118:5
2. ├─base::do.call(...)
3. └─base (local) `<fn>`(X = `<int>`, FUN = `<fn>`)
4. └─BuyseTest (local) FUN(X[[i]], ...)
5. └─BuyseTest:::.powerBuyseTest(...)
6. └─BuyseTest:::.BuyseTest(...)
7. └─BuyseTest:::calcPeron(...)
8. └─BuyseTest:::fitTTEM(...)
9. ├─base::do.call(...)
10. └─prodlim (local) `<fn>`(...)
11. └─prodlim::EventHistory.frame(...)
12. └─prodlim::model.design(...)
13. └─stats::delete.response(terms)
14. └─stats (local) off(a$specials[[i]])
── Error ('test-BuysePower.R:160:5'): Multiple endpoints ───────────────────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::powerBuyseTest(...) at test-BuysePower.R:160:5
2. ├─base::do.call(...)
3. └─base (local) `<fn>`(X = `<int>`, FUN = `<fn>`)
4. └─BuyseTest (local) FUN(X[[i]], ...)
5. └─BuyseTest:::.powerBuyseTest(...)
6. └─BuyseTest:::.BuyseTest(...)
7. └─BuyseTest:::calcPeron(...)
8. └─BuyseTest:::fitTTEM(...)
9. ├─base::do.call(...)
10. └─prodlim (local) `<fn>`(...)
11. └─prodlim::EventHistory.frame(...)
12. └─prodlim::model.design(...)
13. └─stats::delete.response(terms)
14. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTTEM.R:47:5'): no strata, survival ────────────────────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. ├─BuyseTest::BuyseTTEM(...) at test-BuyseTTEM.R:47:5
2. └─BuyseTest:::BuyseTTEM.formula(...)
3. └─prodlim::prodlim(object, ...)
4. └─prodlim::EventHistory.frame(...)
5. └─prodlim::model.design(...)
6. └─stats::delete.response(terms)
7. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTTEM.R:96:5'): strata, survival ───────────────────────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. ├─BuyseTest::BuyseTTEM(...) at test-BuyseTTEM.R:96:5
2. └─BuyseTest:::BuyseTTEM.formula(...)
3. └─prodlim::prodlim(object, ...)
4. └─prodlim::EventHistory.frame(...)
5. └─prodlim::model.design(...)
6. └─stats::delete.response(terms)
7. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTTEM.R:160:1'): (code run outside of `test_that()`) ───────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. ├─BuyseTest::BuyseTTEM(...) at test-BuyseTTEM.R:160:1
2. └─BuyseTest:::BuyseTTEM.formula(...)
3. └─prodlim::prodlim(object, ...)
4. └─prodlim::EventHistory.frame(...)
5. └─prodlim::model.design(...)
6. └─stats::delete.response(terms)
7. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-CR.R:126:3'): BuyseTest package and Eva's R code give the same results with one endpoint and one stratum ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-CR.R:126:3
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-CR.R:149:3'): New package version gives the same results as previous one ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-CR.R:149:3
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-CR.R:170:3'): Package give the same results when model.tte is (not) provided as an argument ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─prodlim::prodlim(Hist(time, status) ~ treatment + strata, data = df2) at test-BuyseTest-CR.R:170:3
2. └─prodlim::EventHistory.frame(...)
3. └─prodlim::model.design(...)
4. └─stats::delete.response(terms)
5. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-CR.R:189:3'): When TTE endpoints are analyzed several times with different thresholds, the results are the same than those when analyzed once with lowest threshold ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-CR.R:189:3
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-PairScore.R:52:5'): Full data - no correction ────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-PairScore.R:52:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-PairScore.R:93:5'): Full data ────────────────────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. ├─base::suppressWarnings(...) at test-BuyseTest-PairScore.R:93:5
2. │ └─base::withCallingHandlers(...)
3. └─BuyseTest::BuyseTest(...)
4. └─BuyseTest:::.BuyseTest(...)
5. └─BuyseTest:::calcPeron(...)
6. └─BuyseTest:::fitTTEM(...)
7. ├─base::do.call(...)
8. └─prodlim (local) `<fn>`(...)
9. └─prodlim::EventHistory.frame(...)
10. └─prodlim::model.design(...)
11. └─stats::delete.response(terms)
12. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-Pairs.R:453:5'): check NA - time to event ────────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-Pairs.R:453:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-Pairs.R:517:5'): 2 pairs - Peron - no correction ─────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-Pairs.R:517:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-Pairs.R:541:5'): 2 pairs - Peron - correction ────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-Pairs.R:541:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-Pairs.R:583:5'): Peron - predictible events ──────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-Pairs.R:583:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-checkValues.R:176:9'): BuyseTest - tte (same, Peron, no strata) ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-checkValues.R:176:9
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-checkValues.R:263:9'): BuyseTest - tte (different, Peron, no strata) ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-checkValues.R:263:9
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-checkValues.R:327:9'): BuyseTest - tte (same, Peron, strata) ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-checkValues.R:327:9
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-checkValues.R:383:9'): BuyseTest - mixed (Peron, no strata) ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-checkValues.R:383:9
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-checkValues.R:444:5'): ordering does not matter ──────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-checkValues.R:444:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-checkValues.R:459:5'): BuyseTest - Peron scoring rule with 2 TTE, one without censoring ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-checkValues.R:459:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-correctionTTE.R:107:5'): 1 TTE endpoint - Peron (no correction) ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-correctionTTE.R:107:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-correctionTTE.R:127:5'): 1 TTE endpoint - Peron (IPCW) ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-correctionTTE.R:127:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-correctionTTE.R:197:5'): 2 TTE endpoints - check consistency across threshold when using corrections ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-correctionTTE.R:197:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-correctionTTE.R:219:5'): TTE,cont,TTE endpoints - check consistency across threshold when using corrections ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-correctionTTE.R:219:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-engine.R:47:5'): TTE with decreasing thresholds ──────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-engine.R:47:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-engine.R:78:5'): different TTE with decreasing thresholds ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-engine.R:78:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-iid.R:569:5'): iid with nuisance parameters: 1 TTE ───
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. ├─base::suppressWarnings(...) at test-BuyseTest-iid.R:569:5
2. │ └─base::withCallingHandlers(...)
3. └─BuyseTest::BuyseTest(...)
4. └─BuyseTest:::.BuyseTest(...)
5. └─BuyseTest:::calcPeron(...)
6. └─BuyseTest:::fitTTEM(...)
7. ├─base::do.call(...)
8. └─prodlim (local) `<fn>`(...)
9. └─prodlim::EventHistory.frame(...)
10. └─prodlim::model.design(...)
11. └─stats::delete.response(terms)
12. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-iid.R:644:5'): iid with nuisance parameters: 1 TTE + 1 binary ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. ├─base::suppressWarnings(...) at test-BuyseTest-iid.R:644:5
2. │ └─base::withCallingHandlers(...)
3. └─BuyseTest::BuyseTest(...)
4. └─BuyseTest:::.BuyseTest(...)
5. └─BuyseTest:::calcPeron(...)
6. └─BuyseTest:::fitTTEM(...)
7. ├─base::do.call(...)
8. └─prodlim (local) `<fn>`(...)
9. └─prodlim::EventHistory.frame(...)
10. └─prodlim::model.design(...)
11. └─stats::delete.response(terms)
12. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-iid.R:697:5'): iid with nuisance parameters: 2 TTE ───
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-iid.R:697:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-iid.R:751:5'): iid with nuisance parameters: 1 TTE + strata ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. ├─base::suppressWarnings(...) at test-BuyseTest-iid.R:751:5
2. │ └─base::withCallingHandlers(...)
3. └─BuyseTest::BuyseTest(...)
4. └─BuyseTest:::.BuyseTest(...)
5. └─BuyseTest:::calcPeron(...)
6. └─BuyseTest:::fitTTEM(...)
7. ├─base::do.call(...)
8. └─prodlim (local) `<fn>`(...)
9. └─prodlim::EventHistory.frame(...)
10. └─prodlim::model.design(...)
11. └─stats::delete.response(terms)
12. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-operator.R:63:5'): check - many pairs ────────────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-operator.R:63:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-previousBug.R:129:5'): ordering of tied event does not affect BuyseTest ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-previousBug.R:129:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-previousBug.R:198:5'): Multiple thresholds ───────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-previousBug.R:198:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-previousBug.R:245:5'): 1 TTE endpoint - Gehan (no correction) ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-previousBug.R:245:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-previousBug.R:363:5'): BuyseTest - hierarchical ──────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-previousBug.R:363:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-previousBug.R:437:1'): (code run outside of `test_that()`) ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─prodlim::prodlim(Hist(time, status) ~ treat, data = dt.prodlim) at test-BuyseTest-previousBug.R:437:1
2. └─prodlim::EventHistory.frame(...)
3. └─prodlim::model.design(...)
4. └─stats::delete.response(terms)
5. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-resampling.R:47:5'): permutation ─────────────────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-resampling.R:47:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-resampling.R:131:5'): stratified permutation ─────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-resampling.R:131:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-resampling.R:245:5'): Bootstrap ──────────────────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-resampling.R:245:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-resampling.R:335:5'): stratified bootstrap ───────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-resampling.R:335:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-restricted.R:42:5'): BuyseTest - restriction ─────────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-restricted.R:42:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-standardization.R:60:5'): BuyseTest - standarization (first order, binary outcome) ──
Error in `(function (name.call, status, correction.uninf, cpus, data, endpoint, engine, formula, iid, iidNuisance, keep.pairScore, scoring.rule, pool.strata, model.tte, method.inference, n.resampling, strata.resampling, hierarchical, neutral.as.uninf, add.halfNeutral, operator, censoring, restriction, seed, strata, threshold, multiplicative.threshold, trace, treatment, type, weightEndpoint, weightObs, ...) { if (!data.table::is.data.table(data)) { if (inherits(data, "function")) { stop("Argument 'data' is mispecified. \n", "'data' cannot be a function. \n") } data <- data.table::as.data.table(data) } else { data <- data.table::copy(data) } if ("..rowIndex.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..rowIndex..\". \n") } if ("..NA.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..NA..\". \n") } if ("..strata.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..strata..\". \n") } if ("..weight.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..weight..\". \n") } argnames <- c("treatment", "endpoint", "type", "threshold", "status", "strata") D <- length(endpoint) D.TTE <- sum(type == "tte") level.treatment <- levels(as.factor(data[[treatment]])) if (is.null(strata)) { n.strata <- 1 } else { indexT <- which(data[[treatment]] == level.treatment[2]) indexC <- which(data[[treatment]] == level.treatment[1]) if (any(strata %in% names(data) == FALSE)) { stop("Strata variable(s) \"", paste0(setdiff(strata, names(data)), collapse = "\" \""), "\" not found in argument 'data' \n") } strataT <- interaction(data[indexT, strata, with = FALSE], drop = TRUE, lex.order = FALSE, sep = ".") strataC <- interaction(data[indexC, strata, with = FALSE], drop = TRUE, lex.order = FALSE, sep = ".") level.strata <- levels(strataT) n.strata <- length(level.strata) if (is.null(attr(strata, "match"))) { stop("Undefined value for 'match': contact the package maintainer. \n") } else if (length(attr(strata, "match")) != 1 || attr(strata, "match") %in% 0:1 == FALSE) { stop("Argument 'match' should be a binary variable. \n") } else if (length(attr(strata, "match")) == 1 && attr(strata, "match") > 0 && pool.strata >= 3) { stop("Argument pool.strata should be \"Buyse\", \"CMH\", or \"equal\" in a matched design. \n") } } if (length(status) != D) { stop("BuyseTest: 'status' does not match 'endpoint' size. \n", "length(status): ", length(status), "\n", "length(endpoint) : ", D, "\n") } if (any(is.na(status))) { stop("BuyseTest: 'status' must not contain NA. \n") } index.pb <- which(status[type == "tte"] == "..NA..") if (length(index.pb) > 0) { if (all(attr(censoring, "original")[index.pb] %in% names(data))) { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must indicate a variable in data for TTE endpoints. \n", "'censoring' is used to indicate whether there is left or right censoring. \n", "Consider changing 'censoring =' into 'status =' when in the argument 'formula' \n") } else { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must indicate a variable in data for TTE endpoints. \n", "TTE endoints: ", paste(endpoint[type == "tte"], collapse = " "), "\n", "proposed 'status' for these endoints: ", paste(status[type == "tte"], collapse = " "), "\n") } } index.pb <- which(status[type == "gaussian"] == "..NA..") if (length(index.pb) > 0) { stop("BuyseTest: wrong specification of 'std'. \n", "'std' must indicate a variable in data for Gaussian endpoints. \n", "Gaussian endoints: ", paste(endpoint[type == 4], collapse = " "), "\n", "proposed 'gaussian' for these endoints: ", paste(status[type == 4], collapse = " "), "\n") } if (any(status[type %in% c("bin", "cont")] != "..NA..")) { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must be \"..NA..\" for binary or continuous endpoints. \n", "endoints : ", paste(endpoint[type %in% c("bin", "cont")], collapse = " "), "\n", "proposed 'status' for these endoints: ", paste(status[type %in% c("bin", "cont")], collapse = " "), "\n") } Ustatus.TTE <- unique(status[type == "tte"]) if (any(Ustatus.TTE %in% names(data) == FALSE)) { stop("BuyseTest: variable(s) 'status': \"", paste0(Ustatus.TTE[Ustatus.TTE %in% names(data) == FALSE], collapse = "\" \""), "\" \n", "not found in argument 'data'.\n") } if (is.null(strata)) { if (any(sapply(Ustatus.TTE, function(iS) { sum(data[[iS]] != 0) }) == 0)) { warning("BuyseTest: time to event variables with only censored events \n") } strata.tempo <- rep(1, NROW(data)) } else { strata.tempo <- interaction(as.data.frame(data)[strata]) if (is.factor(strata.tempo)) { strata.tempo <- droplevels(strata.tempo) } if (!is.null(strata) && (attr(strata, "match") == FALSE) && any(sapply(Ustatus.TTE, function(iS) { tapply(data[[iS]], strata.tempo, function(iVec) { sum(iVec != 0) }) }) == 0)) { warning("BuyseTest: time to event variables with only censored events in at least one strata \n") } } if (any(type == "gaus")) { censoring.gaus <- na.omit(censoring[type == "gaus"]) if (length(censoring.gaus) > 0 && any(censoring.gaus %in% names(data) == FALSE)) { stop("BuyseTest: wrong specification of 'iid'. \n", "'iid' must indicate a variable in argument 'data'. \n", "incorrect 'iid' value(s): \"", paste(censoring.gaus[censoring.gaus %in% names(data) == FALSE], collapse = "\" \""), "\" \n") } } else if (any(type == "tte")) { censoring.tte <- censoring[type == "tte"] if (any(is.na(censoring.tte))) { stop("BuyseTest: wrong specification of 'censoring'. \n", "'censoring' must be \"left\", or \"right\" for time to event endpoints. \n", "incorrect 'censoring' value(s): \"", paste(censoring.tte[is.na(censoring.tte)], collapse = "\" \""), "\" \n") } if (any(censoring.tte %in% c("left", "right") == FALSE)) { stop("BuyseTest: wrong specification of 'censoring'. \n", "'censoring' must be \"left\", or \"right\" \n", "incorrect 'censoring' value(s): \"", paste(censoring.tte[censoring.tte %in% c("left", "right") == FALSE], collapse = "\" \""), "\" \n") } } if (any(type[which(!is.na(restriction))] %in% c("tte", "cont") == FALSE)) { stop("Type(s) \"", paste(unique(setdiff(type[which(!is.na(restriction))], c("tte", "cont"))), collapse = "\" \""), "\" do not support argument restriction. \n") } if (any(type[which(!is.na(restriction))] %in% c("tte", "cont") == FALSE)) { stop("Type(s) \"", paste(unique(setdiff(type[which(!is.na(restriction))], c("tte", "cont"))), collapse = "\" \""), "\" do not support argument restriction. \n") } if (cpus > 1) { validInteger(cpus, valid.length = 1, min = 1, max = parallel::detectCores(), method = "BuyseTest") } valid.rule <- c("gehan", "peron", "efron", "latta", names(survival::survreg.distributions)) if (is.na(scoring.rule) || scoring.rule %in% valid.rule == FALSE) { stop("BuyseTest: wrong specification of 'scoring.rule'. \n", "valid values: \"Gehan\" (no survival model)\n", " : \"Peron\", \"Efron\", \"Latta\" (non-parametric survival model)\n", " : \"Exponential\", \"Weibull\", ... (parametric survival model, see argument dist in survival::survreg). \n") } if (any(!is.na(censoring)) && any(stats::na.omit(censoring) == "left") && scoring.rule != "gehan") { warning("The ", scoring.rule, " scoring rule does not support left-censored endpoints \n", "For those endpoints, the Gehan's scoring rule will be used instead.", sep = "") } if (is.na(pool.strata)) { stop("BuyseTest: wrong specification of 'pool.strata'. \n", "valid values: \"Buyse\", \"CMH\", \"equal\", \"standardisation\", \"standardization\", \"var-favorable\", \"var-unfavorable\", \"var-netBenefit\", \"var-winRatio\". \n") } else if (pool.strata == 3) { if (engine != "GPC2_cpp") { stop("BuyseTest: argument 'pool.strata' set to \"standardization\" only available for engine = \"GPC2_cpp\". \n") } if (!is.null(strata) && attr(strata, "match")) { stop("BuyseTest: argument 'pool.strata' set to \"standardization\" is not available for matched data. \n") } } if (!is.null(model.tte)) { endpoint.UTTE <- unique(endpoint[type == "tte"]) D.UTTE <- length(endpoint.UTTE) if (!is.list(model.tte) || length(model.tte) != D.UTTE) { stop("BuyseTest: argument 'model.tte' must be a list containing ", D.UTTE, " elements. \n", "(one for each unique time to event endpoint). \n") } if (is.null(model.tte) || any(names(model.tte) != endpoint.UTTE)) { stop("BuyseTest: argument 'model.tte' must be a named list. \n", "valid sequence of names: \"", paste0(endpoint.UTTE, collapse = "\" \""), "\" \n", "proposed names: \"", paste0(names(model.tte), collapse = "\" \""), "\" \n") } valid.class <- setdiff(utils::methods(generic.function = "BuyseTTEM"), c("BuyseTTEM.formula")) vec.class <- sapply(model.tte, function(iTTE) { any(paste0("BuyseTTEM.", class(model.tte[[1]])) %in% valid.class) }) if (any(vec.class == FALSE)) { stop("BuyseTest: argument 'model.tte' must be a list of \"", paste0(gsub("BuyseTTEM\\.", "", valid.class), collapse = "\", or \""), "\" objects. \n") } test.prodlim.continuous <- sapply(model.tte, function(iModel) { inherits(iModel, "prodlim") & length(iModel$continuous.predictor > 0) }) if (any(test.prodlim.continuous)) { stop("Incorrect model for time to event: cannot handle continuous variables. \n", "Consider setting the argument \"discrete.level\" to a large value when calling prodlim for endpoint(s) \"", paste(names(test.prodlim.continuous)[test.prodlim.continuous], collapse = "\" \""), "\". \n") } } if (any(endpoint %in% names(data) == FALSE)) { stop("Endpoint(s) \"", paste(setdiff(endpoint, names(data)), collapse = "\", \""), "\" could not be found in argument 'data'.") } index.Bin <- which(type == "bin") if (length(index.Bin) > 0) { for (iBin in index.Bin) { if (length(unique(na.omit(data[[endpoint[iBin]]]))) > 2) { stop("Binary endpoint cannot have more than 2 levels. \n", "endpoint: ", endpoint[iBin], "\n") } } } index.Cont <- which(type == "cont") if (length(index.Cont) > 0) { for (iCont in index.Cont) { validNumeric(data[[endpoint[iCont]]], name1 = endpoint[iCont], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") } } index.TTE <- which(type == "tte") status.TTE <- status[type == "tte"] if (length(index.TTE) > 0) { validNames(data, name1 = "data", required.values = status.TTE, valid.length = NULL, refuse.NULL = FALSE, method = "BuyseTest") valid.values.status <- 0:2 for (iTTE in index.TTE) { validNumeric(data[[endpoint[iTTE]]], name1 = endpoint[iTTE], valid.length = NULL, refuse.NA = TRUE, method = "BuyseTest") validNumeric(unique(data[[status.TTE[which(index.TTE == iTTE)]]]), name1 = status.TTE[which(index.TTE == iTTE)], valid.values = valid.values.status, valid.length = NULL, method = "BuyseTest") } } index.Gaus <- which(type == "gaus") if (length(index.Gaus) > 0) { for (iGaus in index.Gaus) { validNumeric(data[[endpoint[iGaus]]], name1 = endpoint[iGaus], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") validNumeric(data[[status[iGaus]]], name1 = status[iGaus], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") } } validNames(data, name1 = "data", required.values = endpoint, valid.length = NULL, method = "BuyseTest") if (!is.null(formula) && any(name.call %in% argnames)) { txt <- paste(name.call[name.call %in% argnames], collapse = "' '") warning("BuyseTest: argument", if (length(txt) > 1) { "s" }, " '", txt, "' ha", if (length(txt) > 1) { "ve" } else { "s" }, " been ignored. \n", "when specified, only argument 'formula' is used. \n") } validLogical(keep.pairScore, valid.length = 1, method = "BuyseTest") validInteger(correction.uninf, valid.length = 1, min = 0, max = 3, method = "BuyseTest") if (length(method.inference) != 1) { stop("Argument 'method.inference' must have length 1. \n") } if (method.inference %in% c("u statistic bebu") == FALSE) { validCharacter(method.inference, valid.length = 1, valid.values = c("none", "u statistic", "permutation", "studentized permutation", "varexact permutation", "bootstrap", "studentized bootstrap"), method = "BuyseTest") } if (pool.strata > 4 && method.inference %in% c("u statistic", "varexact permutation", "studentized permutation", "varexact permutation", "studentized bootstrap")) { stop("Only bootstrap and permutation can be used to quantify uncertainty when weighting strata-specific effects by the inverse of the variance. \n") } if (method.inference == "none" || attr(method.inference, "permutation")) { } else if (is.null(strata) && any(table(data[[treatment]]) <= 5)) { warning("P-value/confidence intervals may not be valid with few observations in a treatment group. \n") } else if (!is.null(strata) && !attr(strata, "match") && any(table(data[[treatment]], strata.tempo) <= 5)) { warning("P-value/confidence intervals may not be valid with few observations in a treatment and strata group. \n") } if (any(!is.na(attr(method.inference, "resampling-strata"))) && any(attr(method.inference, "resampling-strata") %in% names(data) == FALSE)) { stop("Incorrect value for argument 'strata.resampling': must correspond to a column in argument 'data'. \n") } if (any(!is.na(attr(method.inference, "resampling-strata"))) && attr(method.inference, "permutation") && any(attr(method.inference, "resampling-strata") == treatment)) { stop("Argument 'strata.resampling' should not contain the variable used to form the treatment groups when using a permutation test. \n") } if (iid && correction.uninf > 0) { warning("The current implementation of the asymptotic distribution is valid when using a correction. \n", "Standard errors / confidence intervals / p-values may not be correct. \n", "Consider using a resampling approach or checking the control of the type 1 error with powerBuyseTest. \n") } if (method.inference %in% c("bootstrap", "permutation", "stratified bootstrap", "stratified permutation")) { validInteger(n.resampling, valid.length = 1, min = 1, method = "BuyseTest") if (!is.null(seed)) { tol.seed <- attr(seed, "max") if (n.resampling > tol.seed) { stop("Cannot set a seed per sample when considering more than ", tol.seed, " samples. \n") } } } validLogical(hierarchical, valid.length = 1, method = "BuyseTest") validLogical(neutral.as.uninf, valid.length = D, method = "BuyseTest") validLogical(add.halfNeutral, valid.length = 1, method = "BuyseTest") if (any(is.na(operator))) { stop("BuyseTest: wrong specification of 'operator'. \n", "Can be \"<0\" (lower is better), \">0\" (higher is better), \"+\" additive threshold, \"*\" multiplicative threshold \n", "or a combination of the previous such as \"*<0\" (lower is better with multiplicative threshold). \n") } if (any(tapply(restriction, endpoint, function(iRestriction) { length(unique(iRestriction)) }) > 1)) { stop("BuyseTest: wrong specification of 'restriction'. \n", "Should not vary when the same endpoint is used at different priorities.") } validInteger(seed, valid.length = 1, refuse.NULL = FALSE, min = 1, method = "BuyseTest") if (!is.null(strata)) { validNames(data, name1 = "data", required.values = strata, valid.length = NULL, method = "BuyseTest") if (length(level.strata) != length(levels(strataC)) || any(level.strata != levels(strataC))) { stop("BuyseTest: wrong specification of 'strata'. \n", "different levels between Control and Treatment \n", "levels(strataT) : ", paste(levels(strataT), collapse = " "), "\n", "levels(strataC) : ", paste(levels(strataC), collapse = " "), "\n") } if (any(level.strata %in% c("global", "standardise", "standardize"))) { stop("BuyseTest: wrong specification of 'strata'. \n", "\"", paste(intersect(level.strata, c("global", "standardise", "standardize")), collapse = "\" \""), "\" is a reserved name used internally. \n") } } validNumeric(threshold, valid.length = D, min = 0, refuse.NA = TRUE, method = "BuyseTest") if (any(multiplicative.threshold) && any(threshold[multiplicative.threshold] <= 1)) { stop("BuyseTest: wrong specification of 'threshold'. \n", "'threshold' must be at least 1 + 1e-12 when considering multiplicative threshold. \n") } if (any(threshold[type == "bin"] > 1e-12)) { stop("BuyseTest: wrong specification of 'threshold'. \n", "'threshold' must be 1e-12 for binary endpoints (or equivalently NA) \n", "proposed 'threshold' : ", paste(threshold[type == "bin"], collapse = " "), "\n", "binary endpoint(s) : ", paste(endpoint[type == "bin"], collapse = " "), "\n") } vec.test <- tapply(threshold, endpoint, function(x) { test.unsorted <- is.unsorted(rev(x)) test.duplicated <- any(duplicated(x)) return(test.unsorted + test.duplicated) }) if (any(vec.test > 0)) { stop("BuyseTest: wrong specification of 'endpoint' or 'threshold'. \n", "Endpoints must be used with strictly decreasing threshold when re-used with lower priority. \n", "Problematic endpoints: \"", paste0(names(vec.test)[vec.test > 0], collapse = "\" \""), "\"\n") } validInteger(trace, valid.length = 1, min = 0, max = 2, method = "BuyseTest") validCharacter(treatment, valid.length = 1, method = "BuyseTest") validNames(data, name1 = "data", required.values = treatment, valid.length = NULL, method = "BuyseTest") if (length(level.treatment) != 2) { stop("BuyseTest: wrong specification of the group variable (\"", treatment, "\"). \n", "The corresponding column in 'data' must have exactly 2 levels. \n", "Proposed levels : ", paste(level.treatment, collapse = " "), "\n") } if (any(table(data[[treatment]]) == 0)) { txt.stop <- names(which(table(data[[treatment]]) == 0)) stop("BuyseTest: wrong specification of 'data'. \n", "No observation taking level ", txt.stop, " in the treatment variable. \n") } if (any(type %in% c("bin", "cont", "tte", "gaus") == FALSE)) { txt <- type[type %in% c("bin", "cont", "tte", "gaus") == FALSE] stop("BuyseTest: wrong specification of 'type' \n", "valid values: \"binary\" \"continuous\" \"timetoevent\" \n", "incorrect values: \"", paste(txt, collapse = "\" \""), "\" \n") } n.typePerEndpoint <- tapply(type, endpoint, function(x) { length(unique(x)) }) if (any(n.typePerEndpoint > 1)) { message <- paste0("several types have been specified for endpoint(s) ", paste0(unique(endpoint)[n.typePerEndpoint > 1], collapse = ""), "\n") stop("BuyseTest: wrong specification of 'endpoint' or 'type' \n", message) } if (length(weightEndpoint) != D) { stop("BuyseTest: argument 'weightEndpoint' must have length the number of endpoints \n") } if (hierarchical) { if (any(weightEndpoint != 1) || any(is.na(weightEndpoint))) { stop("BuyseTest: all the weights for the endpoints must be 1 when using hierarchical GPC \n") } } if (!is.null(weightObs) && any(weightObs != 1)) { test1 <- is.character(weightObs) && length(weightObs) == 1 && weightObs %in% names(data) test2 <- is.numeric(weightObs) && length(weightObs) == NROW(data) if ((test1 == FALSE) && (test2 == FALSE)) { stop("BuyseTest: argument 'weightObs' must correspond to a column in argument 'data' ", "or must have as many element as rows in argument 'data'. \n") } if (engine == "GPC_cpp") { stop("Cannot weigth observations with engine GPC_cpp. \n") } } if (hierarchical) { if (any(weightEndpoint != 1) || any(is.na(weightEndpoint))) { stop("BuyseTest: all the weights for the endpoints must be 1 when using hierarchical GPC \n") } } return(invisible(TRUE)) })(name.call = c("", "formula", "data", "pool.strata", "trace"), status = "..NA..", status.TTE = character(0), correction.uninf = 0, cpus = 1, D = 1L, D.TTE = 0L, data = structure(list(id = 1:100, Y = c(0.879633322775876, 1.54211587314424, 0.589078351447554, 0.158028772404075, -0.154584643918818, 1.76728726937265, 0.716707476017206, 2.41017422949523, 0.884185357826345, 2.18217608051942, -0.135736453948977, 0.038355269639434, 1.93228223854166, 0.849303646689633, 0.792619256398035, 1.10719207055802, 1.18000713145149, -0.279113302976559, 1.99418833126783, 0.822669517730394, 0.494042537885743, 2.84303882517041, 0.285420591453131, 0.320443469956613, 1.39980925878644, 1.21266630705141, 0.426435595873674, 1.46236582853295, 0.318339521244343, 0.175729727753681, 0.560160440434515, -0.0888944862596638, 2.03149619263257, -1.01839408178679, 1.30655786078977, -1.03644982353759, 0.699023873163389, 0.971720095554994, 0.847905219319001, 0.443103222152607, -0.914359425680012, 1.67658331201856, -1.664972436212, 1.03646959852761, -0.615920105042845, 0.249180998806552, 3.58716654562835, 1.51739561969325, -0.786300530434326, -1.14060553441858, 1.95018710127266, -0.018559832714638, 0.181931625456156, -0.429362147453702, -0.987460310141485, 0.424807703384319, 2.50002880371391, 0.878733305203177, 0.115573152615509, 3.36929062242358, 0.425100377372448, 0.261352899086967, 1.55848304870902, 2.38642265137494, -0.119243048231147, 2.70610246454047, 1.24497296985898, -1.42449465021281, 0.355600398045781, 1.20753833923234, 2.80797839905936, 0.105802367893711, 1.95699880542341, 0.422847064643469, 0.165999157633456, 0.965273971688724, 1.78763960563016, 3.57524500865228, 2.02739243876377, 1.2079083983867, 0.268676578441956, 1.48389557005338, 0.719924803660651, -0.967250029092243, 0.521022742648139, 0.341245395283984, 2.9645873119698, -0.266081999604665, 1.06978824607145, -0.426109497377437, 0.32289603856346, 1.90201177948634, -0.231748173119606, 1.83037316798167, -0.208082786304465, -0.0479844128077416, 1.94115770684428, 0.484152534695351, 0.411974712317515, 0.11892394889108), arm = c(1L, 1L, 1L, 0L, 1L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 0L, 1L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 1L, 0L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 0L, 1L), X = c(1L, 1L, 1L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 1L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 1L, 0L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 1L, 1L, 1L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 1L, 0L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 1L, 0L, 0L)), class = "data.frame", row.names = c(NA, -100L)), endpoint = "Y", endpoint.TTE = character(0), engine = "GPC_cpp", formula = arm ~ cont(Y, threshold = tau) + X, iid = TRUE, iidNuisance = FALSE, index.endpoint = 0, index.status = 0, keep.pairScore = FALSE, keep.survival = FALSE, scoring.rule = "gehan", pool.strata = structure(3, type = "standardization", original = "standardization"), model.tte = NULL, args.model.tte = list(), method.inference = structure("u statistic", permutation = FALSE, bootstrap = FALSE, studentized = FALSE, ustatistic = TRUE, "`resampling-strata`" = NA_character_, hprojection = 1), n.resampling = 1000, hierarchical = TRUE, neutral.as.uninf = TRUE, add.halfNeutral = FALSE, operator = c(`>0` = 1), censoring = NA_character_, restriction = NA_real_, order.Hprojection = 1, precompute = TRUE, seed = NULL, strata = structure("X", match = FALSE), threshold = structure(1e-12, original = 0), multiplicative.threshold = c(`>0` = FALSE), trace = 0, treatment = "arm", type = "cont", Uendpoint = "Y", Ustatus = "..NA..", weightEndpoint = 1, weightObs = NULL, debug = -1)`: BuyseTest: argument 'pool.strata' set to "standardization" only available for engine = "GPC2_cpp".
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-standardization.R:60:5
2. ├─base::do.call(testArgs, args = outArgs)
3. └─BuyseTest (local) `<fn>`(...)
── Error ('test-BuyseTest-standardization.R:148:5'): BuyseTest - standarization (second order, binary outcome, balanced) ──
Error in `(function (name.call, status, correction.uninf, cpus, data, endpoint, engine, formula, iid, iidNuisance, keep.pairScore, scoring.rule, pool.strata, model.tte, method.inference, n.resampling, strata.resampling, hierarchical, neutral.as.uninf, add.halfNeutral, operator, censoring, restriction, seed, strata, threshold, multiplicative.threshold, trace, treatment, type, weightEndpoint, weightObs, ...) { if (!data.table::is.data.table(data)) { if (inherits(data, "function")) { stop("Argument 'data' is mispecified. \n", "'data' cannot be a function. \n") } data <- data.table::as.data.table(data) } else { data <- data.table::copy(data) } if ("..rowIndex.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..rowIndex..\". \n") } if ("..NA.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..NA..\". \n") } if ("..strata.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..strata..\". \n") } if ("..weight.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..weight..\". \n") } argnames <- c("treatment", "endpoint", "type", "threshold", "status", "strata") D <- length(endpoint) D.TTE <- sum(type == "tte") level.treatment <- levels(as.factor(data[[treatment]])) if (is.null(strata)) { n.strata <- 1 } else { indexT <- which(data[[treatment]] == level.treatment[2]) indexC <- which(data[[treatment]] == level.treatment[1]) if (any(strata %in% names(data) == FALSE)) { stop("Strata variable(s) \"", paste0(setdiff(strata, names(data)), collapse = "\" \""), "\" not found in argument 'data' \n") } strataT <- interaction(data[indexT, strata, with = FALSE], drop = TRUE, lex.order = FALSE, sep = ".") strataC <- interaction(data[indexC, strata, with = FALSE], drop = TRUE, lex.order = FALSE, sep = ".") level.strata <- levels(strataT) n.strata <- length(level.strata) if (is.null(attr(strata, "match"))) { stop("Undefined value for 'match': contact the package maintainer. \n") } else if (length(attr(strata, "match")) != 1 || attr(strata, "match") %in% 0:1 == FALSE) { stop("Argument 'match' should be a binary variable. \n") } else if (length(attr(strata, "match")) == 1 && attr(strata, "match") > 0 && pool.strata >= 3) { stop("Argument pool.strata should be \"Buyse\", \"CMH\", or \"equal\" in a matched design. \n") } } if (length(status) != D) { stop("BuyseTest: 'status' does not match 'endpoint' size. \n", "length(status): ", length(status), "\n", "length(endpoint) : ", D, "\n") } if (any(is.na(status))) { stop("BuyseTest: 'status' must not contain NA. \n") } index.pb <- which(status[type == "tte"] == "..NA..") if (length(index.pb) > 0) { if (all(attr(censoring, "original")[index.pb] %in% names(data))) { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must indicate a variable in data for TTE endpoints. \n", "'censoring' is used to indicate whether there is left or right censoring. \n", "Consider changing 'censoring =' into 'status =' when in the argument 'formula' \n") } else { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must indicate a variable in data for TTE endpoints. \n", "TTE endoints: ", paste(endpoint[type == "tte"], collapse = " "), "\n", "proposed 'status' for these endoints: ", paste(status[type == "tte"], collapse = " "), "\n") } } index.pb <- which(status[type == "gaussian"] == "..NA..") if (length(index.pb) > 0) { stop("BuyseTest: wrong specification of 'std'. \n", "'std' must indicate a variable in data for Gaussian endpoints. \n", "Gaussian endoints: ", paste(endpoint[type == 4], collapse = " "), "\n", "proposed 'gaussian' for these endoints: ", paste(status[type == 4], collapse = " "), "\n") } if (any(status[type %in% c("bin", "cont")] != "..NA..")) { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must be \"..NA..\" for binary or continuous endpoints. \n", "endoints : ", paste(endpoint[type %in% c("bin", "cont")], collapse = " "), "\n", "proposed 'status' for these endoints: ", paste(status[type %in% c("bin", "cont")], collapse = " "), "\n") } Ustatus.TTE <- unique(status[type == "tte"]) if (any(Ustatus.TTE %in% names(data) == FALSE)) { stop("BuyseTest: variable(s) 'status': \"", paste0(Ustatus.TTE[Ustatus.TTE %in% names(data) == FALSE], collapse = "\" \""), "\" \n", "not found in argument 'data'.\n") } if (is.null(strata)) { if (any(sapply(Ustatus.TTE, function(iS) { sum(data[[iS]] != 0) }) == 0)) { warning("BuyseTest: time to event variables with only censored events \n") } strata.tempo <- rep(1, NROW(data)) } else { strata.tempo <- interaction(as.data.frame(data)[strata]) if (is.factor(strata.tempo)) { strata.tempo <- droplevels(strata.tempo) } if (!is.null(strata) && (attr(strata, "match") == FALSE) && any(sapply(Ustatus.TTE, function(iS) { tapply(data[[iS]], strata.tempo, function(iVec) { sum(iVec != 0) }) }) == 0)) { warning("BuyseTest: time to event variables with only censored events in at least one strata \n") } } if (any(type == "gaus")) { censoring.gaus <- na.omit(censoring[type == "gaus"]) if (length(censoring.gaus) > 0 && any(censoring.gaus %in% names(data) == FALSE)) { stop("BuyseTest: wrong specification of 'iid'. \n", "'iid' must indicate a variable in argument 'data'. \n", "incorrect 'iid' value(s): \"", paste(censoring.gaus[censoring.gaus %in% names(data) == FALSE], collapse = "\" \""), "\" \n") } } else if (any(type == "tte")) { censoring.tte <- censoring[type == "tte"] if (any(is.na(censoring.tte))) { stop("BuyseTest: wrong specification of 'censoring'. \n", "'censoring' must be \"left\", or \"right\" for time to event endpoints. \n", "incorrect 'censoring' value(s): \"", paste(censoring.tte[is.na(censoring.tte)], collapse = "\" \""), "\" \n") } if (any(censoring.tte %in% c("left", "right") == FALSE)) { stop("BuyseTest: wrong specification of 'censoring'. \n", "'censoring' must be \"left\", or \"right\" \n", "incorrect 'censoring' value(s): \"", paste(censoring.tte[censoring.tte %in% c("left", "right") == FALSE], collapse = "\" \""), "\" \n") } } if (any(type[which(!is.na(restriction))] %in% c("tte", "cont") == FALSE)) { stop("Type(s) \"", paste(unique(setdiff(type[which(!is.na(restriction))], c("tte", "cont"))), collapse = "\" \""), "\" do not support argument restriction. \n") } if (any(type[which(!is.na(restriction))] %in% c("tte", "cont") == FALSE)) { stop("Type(s) \"", paste(unique(setdiff(type[which(!is.na(restriction))], c("tte", "cont"))), collapse = "\" \""), "\" do not support argument restriction. \n") } if (cpus > 1) { validInteger(cpus, valid.length = 1, min = 1, max = parallel::detectCores(), method = "BuyseTest") } valid.rule <- c("gehan", "peron", "efron", "latta", names(survival::survreg.distributions)) if (is.na(scoring.rule) || scoring.rule %in% valid.rule == FALSE) { stop("BuyseTest: wrong specification of 'scoring.rule'. \n", "valid values: \"Gehan\" (no survival model)\n", " : \"Peron\", \"Efron\", \"Latta\" (non-parametric survival model)\n", " : \"Exponential\", \"Weibull\", ... (parametric survival model, see argument dist in survival::survreg). \n") } if (any(!is.na(censoring)) && any(stats::na.omit(censoring) == "left") && scoring.rule != "gehan") { warning("The ", scoring.rule, " scoring rule does not support left-censored endpoints \n", "For those endpoints, the Gehan's scoring rule will be used instead.", sep = "") } if (is.na(pool.strata)) { stop("BuyseTest: wrong specification of 'pool.strata'. \n", "valid values: \"Buyse\", \"CMH\", \"equal\", \"standardisation\", \"standardization\", \"var-favorable\", \"var-unfavorable\", \"var-netBenefit\", \"var-winRatio\". \n") } else if (pool.strata == 3) { if (engine != "GPC2_cpp") { stop("BuyseTest: argument 'pool.strata' set to \"standardization\" only available for engine = \"GPC2_cpp\". \n") } if (!is.null(strata) && attr(strata, "match")) { stop("BuyseTest: argument 'pool.strata' set to \"standardization\" is not available for matched data. \n") } } if (!is.null(model.tte)) { endpoint.UTTE <- unique(endpoint[type == "tte"]) D.UTTE <- length(endpoint.UTTE) if (!is.list(model.tte) || length(model.tte) != D.UTTE) { stop("BuyseTest: argument 'model.tte' must be a list containing ", D.UTTE, " elements. \n", "(one for each unique time to event endpoint). \n") } if (is.null(model.tte) || any(names(model.tte) != endpoint.UTTE)) { stop("BuyseTest: argument 'model.tte' must be a named list. \n", "valid sequence of names: \"", paste0(endpoint.UTTE, collapse = "\" \""), "\" \n", "proposed names: \"", paste0(names(model.tte), collapse = "\" \""), "\" \n") } valid.class <- setdiff(utils::methods(generic.function = "BuyseTTEM"), c("BuyseTTEM.formula")) vec.class <- sapply(model.tte, function(iTTE) { any(paste0("BuyseTTEM.", class(model.tte[[1]])) %in% valid.class) }) if (any(vec.class == FALSE)) { stop("BuyseTest: argument 'model.tte' must be a list of \"", paste0(gsub("BuyseTTEM\\.", "", valid.class), collapse = "\", or \""), "\" objects. \n") } test.prodlim.continuous <- sapply(model.tte, function(iModel) { inherits(iModel, "prodlim") & length(iModel$continuous.predictor > 0) }) if (any(test.prodlim.continuous)) { stop("Incorrect model for time to event: cannot handle continuous variables. \n", "Consider setting the argument \"discrete.level\" to a large value when calling prodlim for endpoint(s) \"", paste(names(test.prodlim.continuous)[test.prodlim.continuous], collapse = "\" \""), "\". \n") } } if (any(endpoint %in% names(data) == FALSE)) { stop("Endpoint(s) \"", paste(setdiff(endpoint, names(data)), collapse = "\", \""), "\" could not be found in argument 'data'.") } index.Bin <- which(type == "bin") if (length(index.Bin) > 0) { for (iBin in index.Bin) { if (length(unique(na.omit(data[[endpoint[iBin]]]))) > 2) { stop("Binary endpoint cannot have more than 2 levels. \n", "endpoint: ", endpoint[iBin], "\n") } } } index.Cont <- which(type == "cont") if (length(index.Cont) > 0) { for (iCont in index.Cont) { validNumeric(data[[endpoint[iCont]]], name1 = endpoint[iCont], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") } } index.TTE <- which(type == "tte") status.TTE <- status[type == "tte"] if (length(index.TTE) > 0) { validNames(data, name1 = "data", required.values = status.TTE, valid.length = NULL, refuse.NULL = FALSE, method = "BuyseTest") valid.values.status <- 0:2 for (iTTE in index.TTE) { validNumeric(data[[endpoint[iTTE]]], name1 = endpoint[iTTE], valid.length = NULL, refuse.NA = TRUE, method = "BuyseTest") validNumeric(unique(data[[status.TTE[which(index.TTE == iTTE)]]]), name1 = status.TTE[which(index.TTE == iTTE)], valid.values = valid.values.status, valid.length = NULL, method = "BuyseTest") } } index.Gaus <- which(type == "gaus") if (length(index.Gaus) > 0) { for (iGaus in index.Gaus) { validNumeric(data[[endpoint[iGaus]]], name1 = endpoint[iGaus], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") validNumeric(data[[status[iGaus]]], name1 = status[iGaus], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") } } validNames(data, name1 = "data", required.values = endpoint, valid.length = NULL, method = "BuyseTest") if (!is.null(formula) && any(name.call %in% argnames)) { txt <- paste(name.call[name.call %in% argnames], collapse = "' '") warning("BuyseTest: argument", if (length(txt) > 1) { "s" }, " '", txt, "' ha", if (length(txt) > 1) { "ve" } else { "s" }, " been ignored. \n", "when specified, only argument 'formula' is used. \n") } validLogical(keep.pairScore, valid.length = 1, method = "BuyseTest") validInteger(correction.uninf, valid.length = 1, min = 0, max = 3, method = "BuyseTest") if (length(method.inference) != 1) { stop("Argument 'method.inference' must have length 1. \n") } if (method.inference %in% c("u statistic bebu") == FALSE) { validCharacter(method.inference, valid.length = 1, valid.values = c("none", "u statistic", "permutation", "studentized permutation", "varexact permutation", "bootstrap", "studentized bootstrap"), method = "BuyseTest") } if (pool.strata > 4 && method.inference %in% c("u statistic", "varexact permutation", "studentized permutation", "varexact permutation", "studentized bootstrap")) { stop("Only bootstrap and permutation can be used to quantify uncertainty when weighting strata-specific effects by the inverse of the variance. \n") } if (method.inference == "none" || attr(method.inference, "permutation")) { } else if (is.null(strata) && any(table(data[[treatment]]) <= 5)) { warning("P-value/confidence intervals may not be valid with few observations in a treatment group. \n") } else if (!is.null(strata) && !attr(strata, "match") && any(table(data[[treatment]], strata.tempo) <= 5)) { warning("P-value/confidence intervals may not be valid with few observations in a treatment and strata group. \n") } if (any(!is.na(attr(method.inference, "resampling-strata"))) && any(attr(method.inference, "resampling-strata") %in% names(data) == FALSE)) { stop("Incorrect value for argument 'strata.resampling': must correspond to a column in argument 'data'. \n") } if (any(!is.na(attr(method.inference, "resampling-strata"))) && attr(method.inference, "permutation") && any(attr(method.inference, "resampling-strata") == treatment)) { stop("Argument 'strata.resampling' should not contain the variable used to form the treatment groups when using a permutation test. \n") } if (iid && correction.uninf > 0) { warning("The current implementation of the asymptotic distribution is valid when using a correction. \n", "Standard errors / confidence intervals / p-values may not be correct. \n", "Consider using a resampling approach or checking the control of the type 1 error with powerBuyseTest. \n") } if (method.inference %in% c("bootstrap", "permutation", "stratified bootstrap", "stratified permutation")) { validInteger(n.resampling, valid.length = 1, min = 1, method = "BuyseTest") if (!is.null(seed)) { tol.seed <- attr(seed, "max") if (n.resampling > tol.seed) { stop("Cannot set a seed per sample when considering more than ", tol.seed, " samples. \n") } } } validLogical(hierarchical, valid.length = 1, method = "BuyseTest") validLogical(neutral.as.uninf, valid.length = D, method = "BuyseTest") validLogical(add.halfNeutral, valid.length = 1, method = "BuyseTest") if (any(is.na(operator))) { stop("BuyseTest: wrong specification of 'operator'. \n", "Can be \"<0\" (lower is better), \">0\" (higher is better), \"+\" additive threshold, \"*\" multiplicative threshold \n", "or a combination of the previous such as \"*<0\" (lower is better with multiplicative threshold). \n") } if (any(tapply(restriction, endpoint, function(iRestriction) { length(unique(iRestriction)) }) > 1)) { stop("BuyseTest: wrong specification of 'restriction'. \n", "Should not vary when the same endpoint is used at different priorities.") } validInteger(seed, valid.length = 1, refuse.NULL = FALSE, min = 1, method = "BuyseTest") if (!is.null(strata)) { validNames(data, name1 = "data", required.values = strata, valid.length = NULL, method = "BuyseTest") if (length(level.strata) != length(levels(strataC)) || any(level.strata != levels(strataC))) { stop("BuyseTest: wrong specification of 'strata'. \n", "different levels between Control and Treatment \n", "levels(strataT) : ", paste(levels(strataT), collapse = " "), "\n", "levels(strataC) : ", paste(levels(strataC), collapse = " "), "\n") } if (any(level.strata %in% c("global", "standardise", "standardize"))) { stop("BuyseTest: wrong specification of 'strata'. \n", "\"", paste(intersect(level.strata, c("global", "standardise", "standardize")), collapse = "\" \""), "\" is a reserved name used internally. \n") } } validNumeric(threshold, valid.length = D, min = 0, refuse.NA = TRUE, method = "BuyseTest") if (any(multiplicative.threshold) && any(threshold[multiplicative.threshold] <= 1)) { stop("BuyseTest: wrong specification of 'threshold'. \n", "'threshold' must be at least 1 + 1e-12 when considering multiplicative threshold. \n") } if (any(threshold[type == "bin"] > 1e-12)) { stop("BuyseTest: wrong specification of 'threshold'. \n", "'threshold' must be 1e-12 for binary endpoints (or equivalently NA) \n", "proposed 'threshold' : ", paste(threshold[type == "bin"], collapse = " "), "\n", "binary endpoint(s) : ", paste(endpoint[type == "bin"], collapse = " "), "\n") } vec.test <- tapply(threshold, endpoint, function(x) { test.unsorted <- is.unsorted(rev(x)) test.duplicated <- any(duplicated(x)) return(test.unsorted + test.duplicated) }) if (any(vec.test > 0)) { stop("BuyseTest: wrong specification of 'endpoint' or 'threshold'. \n", "Endpoints must be used with strictly decreasing threshold when re-used with lower priority. \n", "Problematic endpoints: \"", paste0(names(vec.test)[vec.test > 0], collapse = "\" \""), "\"\n") } validInteger(trace, valid.length = 1, min = 0, max = 2, method = "BuyseTest") validCharacter(treatment, valid.length = 1, method = "BuyseTest") validNames(data, name1 = "data", required.values = treatment, valid.length = NULL, method = "BuyseTest") if (length(level.treatment) != 2) { stop("BuyseTest: wrong specification of the group variable (\"", treatment, "\"). \n", "The corresponding column in 'data' must have exactly 2 levels. \n", "Proposed levels : ", paste(level.treatment, collapse = " "), "\n") } if (any(table(data[[treatment]]) == 0)) { txt.stop <- names(which(table(data[[treatment]]) == 0)) stop("BuyseTest: wrong specification of 'data'. \n", "No observation taking level ", txt.stop, " in the treatment variable. \n") } if (any(type %in% c("bin", "cont", "tte", "gaus") == FALSE)) { txt <- type[type %in% c("bin", "cont", "tte", "gaus") == FALSE] stop("BuyseTest: wrong specification of 'type' \n", "valid values: \"binary\" \"continuous\" \"timetoevent\" \n", "incorrect values: \"", paste(txt, collapse = "\" \""), "\" \n") } n.typePerEndpoint <- tapply(type, endpoint, function(x) { length(unique(x)) }) if (any(n.typePerEndpoint > 1)) { message <- paste0("several types have been specified for endpoint(s) ", paste0(unique(endpoint)[n.typePerEndpoint > 1], collapse = ""), "\n") stop("BuyseTest: wrong specification of 'endpoint' or 'type' \n", message) } if (length(weightEndpoint) != D) { stop("BuyseTest: argument 'weightEndpoint' must have length the number of endpoints \n") } if (hierarchical) { if (any(weightEndpoint != 1) || any(is.na(weightEndpoint))) { stop("BuyseTest: all the weights for the endpoints must be 1 when using hierarchical GPC \n") } } if (!is.null(weightObs) && any(weightObs != 1)) { test1 <- is.character(weightObs) && length(weightObs) == 1 && weightObs %in% names(data) test2 <- is.numeric(weightObs) && length(weightObs) == NROW(data) if ((test1 == FALSE) && (test2 == FALSE)) { stop("BuyseTest: argument 'weightObs' must correspond to a column in argument 'data' ", "or must have as many element as rows in argument 'data'. \n") } if (engine == "GPC_cpp") { stop("Cannot weigth observations with engine GPC_cpp. \n") } } if (hierarchical) { if (any(weightEndpoint != 1) || any(is.na(weightEndpoint))) { stop("BuyseTest: all the weights for the endpoints must be 1 when using hierarchical GPC \n") } } return(invisible(TRUE)) })(name.call = c("", "formula", "data", "pool.strata", "keep.pairScore", "trace"), status = "..NA..", status.TTE = character(0), correction.uninf = 0, cpus = 1, D = 1L, D.TTE = 0L, data = structure(list(id = 1:48, Y = c(0.158028772404075, 1.76728726937265, 0.716707476017206, -0.279113302976559, -1.664972436212, -0.018559832714638, 0.425100377372448, -1.42449465021281, 0.105802367893711, 1.2079083983867, 0.521022742648139, 0.411974712317515, -0.154584643918818, 0.884185357826345, 2.18217608051942, -0.135736453948977, 0.038355269639434, 1.93228223854166, 0.285420591453131, 0.320443469956613, 1.21266630705141, 0.426435595873674, 0.175729727753681, 0.560160440434515, 0.792619256398035, 0.822669517730394, 0.494042537885743, 0.318339521244343, 1.30655786078977, 0.699023873163389, -0.914359425680012, 0.249180998806552, 1.20753833923234, 0.965273971688724, 1.78763960563016, 2.02739243876377, 0.879633322775876, 1.54211587314424, 0.589078351447554, 2.41017422949523, 0.849303646689633, 1.10719207055802, 1.18000713145149, 1.99418833126783, 2.84303882517041, 1.39980925878644, 1.46236582853295, 2.03149619263257), arm = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), X = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L)), row.names = c(NA, -48L), class = "data.frame"), endpoint = "Y", endpoint.TTE = character(0), engine = "GPC_cpp", formula = arm ~ cont(Y, threshold = tau) + X, iid = TRUE, iidNuisance = FALSE, index.endpoint = 0, index.status = 0, keep.pairScore = FALSE, keep.survival = FALSE, scoring.rule = "gehan", pool.strata = structure(3, type = "standardization", original = "standardization"), model.tte = NULL, args.model.tte = list(), method.inference = structure("u statistic", permutation = FALSE, bootstrap = FALSE, studentized = FALSE, ustatistic = TRUE, "`resampling-strata`" = NA_character_, hprojection = 2), n.resampling = 1000, hierarchical = TRUE, neutral.as.uninf = TRUE, add.halfNeutral = FALSE, operator = c(`>0` = 1), censoring = NA_character_, restriction = NA_real_, order.Hprojection = 2, precompute = TRUE, seed = NULL, strata = structure("X", match = FALSE), threshold = structure(1e-12, original = 0), multiplicative.threshold = c(`>0` = FALSE), trace = 0, treatment = "arm", type = "cont", Uendpoint = "Y", Ustatus = "..NA..", weightEndpoint = 1, weightObs = NULL, debug = -1)`: BuyseTest: argument 'pool.strata' set to "standardization" only available for engine = "GPC2_cpp".
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-standardization.R:148:5
2. ├─base::do.call(testArgs, args = outArgs)
3. └─BuyseTest (local) `<fn>`(...)
── Error ('test-BuyseTest-standardization.R:203:5'): BuyseTest - standarization (second order, binary outcome, unbalanced) ──
Error in `(function (name.call, status, correction.uninf, cpus, data, endpoint, engine, formula, iid, iidNuisance, keep.pairScore, scoring.rule, pool.strata, model.tte, method.inference, n.resampling, strata.resampling, hierarchical, neutral.as.uninf, add.halfNeutral, operator, censoring, restriction, seed, strata, threshold, multiplicative.threshold, trace, treatment, type, weightEndpoint, weightObs, ...) { if (!data.table::is.data.table(data)) { if (inherits(data, "function")) { stop("Argument 'data' is mispecified. \n", "'data' cannot be a function. \n") } data <- data.table::as.data.table(data) } else { data <- data.table::copy(data) } if ("..rowIndex.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..rowIndex..\". \n") } if ("..NA.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..NA..\". \n") } if ("..strata.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..strata..\". \n") } if ("..weight.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..weight..\". \n") } argnames <- c("treatment", "endpoint", "type", "threshold", "status", "strata") D <- length(endpoint) D.TTE <- sum(type == "tte") level.treatment <- levels(as.factor(data[[treatment]])) if (is.null(strata)) { n.strata <- 1 } else { indexT <- which(data[[treatment]] == level.treatment[2]) indexC <- which(data[[treatment]] == level.treatment[1]) if (any(strata %in% names(data) == FALSE)) { stop("Strata variable(s) \"", paste0(setdiff(strata, names(data)), collapse = "\" \""), "\" not found in argument 'data' \n") } strataT <- interaction(data[indexT, strata, with = FALSE], drop = TRUE, lex.order = FALSE, sep = ".") strataC <- interaction(data[indexC, strata, with = FALSE], drop = TRUE, lex.order = FALSE, sep = ".") level.strata <- levels(strataT) n.strata <- length(level.strata) if (is.null(attr(strata, "match"))) { stop("Undefined value for 'match': contact the package maintainer. \n") } else if (length(attr(strata, "match")) != 1 || attr(strata, "match") %in% 0:1 == FALSE) { stop("Argument 'match' should be a binary variable. \n") } else if (length(attr(strata, "match")) == 1 && attr(strata, "match") > 0 && pool.strata >= 3) { stop("Argument pool.strata should be \"Buyse\", \"CMH\", or \"equal\" in a matched design. \n") } } if (length(status) != D) { stop("BuyseTest: 'status' does not match 'endpoint' size. \n", "length(status): ", length(status), "\n", "length(endpoint) : ", D, "\n") } if (any(is.na(status))) { stop("BuyseTest: 'status' must not contain NA. \n") } index.pb <- which(status[type == "tte"] == "..NA..") if (length(index.pb) > 0) { if (all(attr(censoring, "original")[index.pb] %in% names(data))) { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must indicate a variable in data for TTE endpoints. \n", "'censoring' is used to indicate whether there is left or right censoring. \n", "Consider changing 'censoring =' into 'status =' when in the argument 'formula' \n") } else { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must indicate a variable in data for TTE endpoints. \n", "TTE endoints: ", paste(endpoint[type == "tte"], collapse = " "), "\n", "proposed 'status' for these endoints: ", paste(status[type == "tte"], collapse = " "), "\n") } } index.pb <- which(status[type == "gaussian"] == "..NA..") if (length(index.pb) > 0) { stop("BuyseTest: wrong specification of 'std'. \n", "'std' must indicate a variable in data for Gaussian endpoints. \n", "Gaussian endoints: ", paste(endpoint[type == 4], collapse = " "), "\n", "proposed 'gaussian' for these endoints: ", paste(status[type == 4], collapse = " "), "\n") } if (any(status[type %in% c("bin", "cont")] != "..NA..")) { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must be \"..NA..\" for binary or continuous endpoints. \n", "endoints : ", paste(endpoint[type %in% c("bin", "cont")], collapse = " "), "\n", "proposed 'status' for these endoints: ", paste(status[type %in% c("bin", "cont")], collapse = " "), "\n") } Ustatus.TTE <- unique(status[type == "tte"]) if (any(Ustatus.TTE %in% names(data) == FALSE)) { stop("BuyseTest: variable(s) 'status': \"", paste0(Ustatus.TTE[Ustatus.TTE %in% names(data) == FALSE], collapse = "\" \""), "\" \n", "not found in argument 'data'.\n") } if (is.null(strata)) { if (any(sapply(Ustatus.TTE, function(iS) { sum(data[[iS]] != 0) }) == 0)) { warning("BuyseTest: time to event variables with only censored events \n") } strata.tempo <- rep(1, NROW(data)) } else { strata.tempo <- interaction(as.data.frame(data)[strata]) if (is.factor(strata.tempo)) { strata.tempo <- droplevels(strata.tempo) } if (!is.null(strata) && (attr(strata, "match") == FALSE) && any(sapply(Ustatus.TTE, function(iS) { tapply(data[[iS]], strata.tempo, function(iVec) { sum(iVec != 0) }) }) == 0)) { warning("BuyseTest: time to event variables with only censored events in at least one strata \n") } } if (any(type == "gaus")) { censoring.gaus <- na.omit(censoring[type == "gaus"]) if (length(censoring.gaus) > 0 && any(censoring.gaus %in% names(data) == FALSE)) { stop("BuyseTest: wrong specification of 'iid'. \n", "'iid' must indicate a variable in argument 'data'. \n", "incorrect 'iid' value(s): \"", paste(censoring.gaus[censoring.gaus %in% names(data) == FALSE], collapse = "\" \""), "\" \n") } } else if (any(type == "tte")) { censoring.tte <- censoring[type == "tte"] if (any(is.na(censoring.tte))) { stop("BuyseTest: wrong specification of 'censoring'. \n", "'censoring' must be \"left\", or \"right\" for time to event endpoints. \n", "incorrect 'censoring' value(s): \"", paste(censoring.tte[is.na(censoring.tte)], collapse = "\" \""), "\" \n") } if (any(censoring.tte %in% c("left", "right") == FALSE)) { stop("BuyseTest: wrong specification of 'censoring'. \n", "'censoring' must be \"left\", or \"right\" \n", "incorrect 'censoring' value(s): \"", paste(censoring.tte[censoring.tte %in% c("left", "right") == FALSE], collapse = "\" \""), "\" \n") } } if (any(type[which(!is.na(restriction))] %in% c("tte", "cont") == FALSE)) { stop("Type(s) \"", paste(unique(setdiff(type[which(!is.na(restriction))], c("tte", "cont"))), collapse = "\" \""), "\" do not support argument restriction. \n") } if (any(type[which(!is.na(restriction))] %in% c("tte", "cont") == FALSE)) { stop("Type(s) \"", paste(unique(setdiff(type[which(!is.na(restriction))], c("tte", "cont"))), collapse = "\" \""), "\" do not support argument restriction. \n") } if (cpus > 1) { validInteger(cpus, valid.length = 1, min = 1, max = parallel::detectCores(), method = "BuyseTest") } valid.rule <- c("gehan", "peron", "efron", "latta", names(survival::survreg.distributions)) if (is.na(scoring.rule) || scoring.rule %in% valid.rule == FALSE) { stop("BuyseTest: wrong specification of 'scoring.rule'. \n", "valid values: \"Gehan\" (no survival model)\n", " : \"Peron\", \"Efron\", \"Latta\" (non-parametric survival model)\n", " : \"Exponential\", \"Weibull\", ... (parametric survival model, see argument dist in survival::survreg). \n") } if (any(!is.na(censoring)) && any(stats::na.omit(censoring) == "left") && scoring.rule != "gehan") { warning("The ", scoring.rule, " scoring rule does not support left-censored endpoints \n", "For those endpoints, the Gehan's scoring rule will be used instead.", sep = "") } if (is.na(pool.strata)) { stop("BuyseTest: wrong specification of 'pool.strata'. \n", "valid values: \"Buyse\", \"CMH\", \"equal\", \"standardisation\", \"standardization\", \"var-favorable\", \"var-unfavorable\", \"var-netBenefit\", \"var-winRatio\". \n") } else if (pool.strata == 3) { if (engine != "GPC2_cpp") { stop("BuyseTest: argument 'pool.strata' set to \"standardization\" only available for engine = \"GPC2_cpp\". \n") } if (!is.null(strata) && attr(strata, "match")) { stop("BuyseTest: argument 'pool.strata' set to \"standardization\" is not available for matched data. \n") } } if (!is.null(model.tte)) { endpoint.UTTE <- unique(endpoint[type == "tte"]) D.UTTE <- length(endpoint.UTTE) if (!is.list(model.tte) || length(model.tte) != D.UTTE) { stop("BuyseTest: argument 'model.tte' must be a list containing ", D.UTTE, " elements. \n", "(one for each unique time to event endpoint). \n") } if (is.null(model.tte) || any(names(model.tte) != endpoint.UTTE)) { stop("BuyseTest: argument 'model.tte' must be a named list. \n", "valid sequence of names: \"", paste0(endpoint.UTTE, collapse = "\" \""), "\" \n", "proposed names: \"", paste0(names(model.tte), collapse = "\" \""), "\" \n") } valid.class <- setdiff(utils::methods(generic.function = "BuyseTTEM"), c("BuyseTTEM.formula")) vec.class <- sapply(model.tte, function(iTTE) { any(paste0("BuyseTTEM.", class(model.tte[[1]])) %in% valid.class) }) if (any(vec.class == FALSE)) { stop("BuyseTest: argument 'model.tte' must be a list of \"", paste0(gsub("BuyseTTEM\\.", "", valid.class), collapse = "\", or \""), "\" objects. \n") } test.prodlim.continuous <- sapply(model.tte, function(iModel) { inherits(iModel, "prodlim") & length(iModel$continuous.predictor > 0) }) if (any(test.prodlim.continuous)) { stop("Incorrect model for time to event: cannot handle continuous variables. \n", "Consider setting the argument \"discrete.level\" to a large value when calling prodlim for endpoint(s) \"", paste(names(test.prodlim.continuous)[test.prodlim.continuous], collapse = "\" \""), "\". \n") } } if (any(endpoint %in% names(data) == FALSE)) { stop("Endpoint(s) \"", paste(setdiff(endpoint, names(data)), collapse = "\", \""), "\" could not be found in argument 'data'.") } index.Bin <- which(type == "bin") if (length(index.Bin) > 0) { for (iBin in index.Bin) { if (length(unique(na.omit(data[[endpoint[iBin]]]))) > 2) { stop("Binary endpoint cannot have more than 2 levels. \n", "endpoint: ", endpoint[iBin], "\n") } } } index.Cont <- which(type == "cont") if (length(index.Cont) > 0) { for (iCont in index.Cont) { validNumeric(data[[endpoint[iCont]]], name1 = endpoint[iCont], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") } } index.TTE <- which(type == "tte") status.TTE <- status[type == "tte"] if (length(index.TTE) > 0) { validNames(data, name1 = "data", required.values = status.TTE, valid.length = NULL, refuse.NULL = FALSE, method = "BuyseTest") valid.values.status <- 0:2 for (iTTE in index.TTE) { validNumeric(data[[endpoint[iTTE]]], name1 = endpoint[iTTE], valid.length = NULL, refuse.NA = TRUE, method = "BuyseTest") validNumeric(unique(data[[status.TTE[which(index.TTE == iTTE)]]]), name1 = status.TTE[which(index.TTE == iTTE)], valid.values = valid.values.status, valid.length = NULL, method = "BuyseTest") } } index.Gaus <- which(type == "gaus") if (length(index.Gaus) > 0) { for (iGaus in index.Gaus) { validNumeric(data[[endpoint[iGaus]]], name1 = endpoint[iGaus], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") validNumeric(data[[status[iGaus]]], name1 = status[iGaus], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") } } validNames(data, name1 = "data", required.values = endpoint, valid.length = NULL, method = "BuyseTest") if (!is.null(formula) && any(name.call %in% argnames)) { txt <- paste(name.call[name.call %in% argnames], collapse = "' '") warning("BuyseTest: argument", if (length(txt) > 1) { "s" }, " '", txt, "' ha", if (length(txt) > 1) { "ve" } else { "s" }, " been ignored. \n", "when specified, only argument 'formula' is used. \n") } validLogical(keep.pairScore, valid.length = 1, method = "BuyseTest") validInteger(correction.uninf, valid.length = 1, min = 0, max = 3, method = "BuyseTest") if (length(method.inference) != 1) { stop("Argument 'method.inference' must have length 1. \n") } if (method.inference %in% c("u statistic bebu") == FALSE) { validCharacter(method.inference, valid.length = 1, valid.values = c("none", "u statistic", "permutation", "studentized permutation", "varexact permutation", "bootstrap", "studentized bootstrap"), method = "BuyseTest") } if (pool.strata > 4 && method.inference %in% c("u statistic", "varexact permutation", "studentized permutation", "varexact permutation", "studentized bootstrap")) { stop("Only bootstrap and permutation can be used to quantify uncertainty when weighting strata-specific effects by the inverse of the variance. \n") } if (method.inference == "none" || attr(method.inference, "permutation")) { } else if (is.null(strata) && any(table(data[[treatment]]) <= 5)) { warning("P-value/confidence intervals may not be valid with few observations in a treatment group. \n") } else if (!is.null(strata) && !attr(strata, "match") && any(table(data[[treatment]], strata.tempo) <= 5)) { warning("P-value/confidence intervals may not be valid with few observations in a treatment and strata group. \n") } if (any(!is.na(attr(method.inference, "resampling-strata"))) && any(attr(method.inference, "resampling-strata") %in% names(data) == FALSE)) { stop("Incorrect value for argument 'strata.resampling': must correspond to a column in argument 'data'. \n") } if (any(!is.na(attr(method.inference, "resampling-strata"))) && attr(method.inference, "permutation") && any(attr(method.inference, "resampling-strata") == treatment)) { stop("Argument 'strata.resampling' should not contain the variable used to form the treatment groups when using a permutation test. \n") } if (iid && correction.uninf > 0) { warning("The current implementation of the asymptotic distribution is valid when using a correction. \n", "Standard errors / confidence intervals / p-values may not be correct. \n", "Consider using a resampling approach or checking the control of the type 1 error with powerBuyseTest. \n") } if (method.inference %in% c("bootstrap", "permutation", "stratified bootstrap", "stratified permutation")) { validInteger(n.resampling, valid.length = 1, min = 1, method = "BuyseTest") if (!is.null(seed)) { tol.seed <- attr(seed, "max") if (n.resampling > tol.seed) { stop("Cannot set a seed per sample when considering more than ", tol.seed, " samples. \n") } } } validLogical(hierarchical, valid.length = 1, method = "BuyseTest") validLogical(neutral.as.uninf, valid.length = D, method = "BuyseTest") validLogical(add.halfNeutral, valid.length = 1, method = "BuyseTest") if (any(is.na(operator))) { stop("BuyseTest: wrong specification of 'operator'. \n", "Can be \"<0\" (lower is better), \">0\" (higher is better), \"+\" additive threshold, \"*\" multiplicative threshold \n", "or a combination of the previous such as \"*<0\" (lower is better with multiplicative threshold). \n") } if (any(tapply(restriction, endpoint, function(iRestriction) { length(unique(iRestriction)) }) > 1)) { stop("BuyseTest: wrong specification of 'restriction'. \n", "Should not vary when the same endpoint is used at different priorities.") } validInteger(seed, valid.length = 1, refuse.NULL = FALSE, min = 1, method = "BuyseTest") if (!is.null(strata)) { validNames(data, name1 = "data", required.values = strata, valid.length = NULL, method = "BuyseTest") if (length(level.strata) != length(levels(strataC)) || any(level.strata != levels(strataC))) { stop("BuyseTest: wrong specification of 'strata'. \n", "different levels between Control and Treatment \n", "levels(strataT) : ", paste(levels(strataT), collapse = " "), "\n", "levels(strataC) : ", paste(levels(strataC), collapse = " "), "\n") } if (any(level.strata %in% c("global", "standardise", "standardize"))) { stop("BuyseTest: wrong specification of 'strata'. \n", "\"", paste(intersect(level.strata, c("global", "standardise", "standardize")), collapse = "\" \""), "\" is a reserved name used internally. \n") } } validNumeric(threshold, valid.length = D, min = 0, refuse.NA = TRUE, method = "BuyseTest") if (any(multiplicative.threshold) && any(threshold[multiplicative.threshold] <= 1)) { stop("BuyseTest: wrong specification of 'threshold'. \n", "'threshold' must be at least 1 + 1e-12 when considering multiplicative threshold. \n") } if (any(threshold[type == "bin"] > 1e-12)) { stop("BuyseTest: wrong specification of 'threshold'. \n", "'threshold' must be 1e-12 for binary endpoints (or equivalently NA) \n", "proposed 'threshold' : ", paste(threshold[type == "bin"], collapse = " "), "\n", "binary endpoint(s) : ", paste(endpoint[type == "bin"], collapse = " "), "\n") } vec.test <- tapply(threshold, endpoint, function(x) { test.unsorted <- is.unsorted(rev(x)) test.duplicated <- any(duplicated(x)) return(test.unsorted + test.duplicated) }) if (any(vec.test > 0)) { stop("BuyseTest: wrong specification of 'endpoint' or 'threshold'. \n", "Endpoints must be used with strictly decreasing threshold when re-used with lower priority. \n", "Problematic endpoints: \"", paste0(names(vec.test)[vec.test > 0], collapse = "\" \""), "\"\n") } validInteger(trace, valid.length = 1, min = 0, max = 2, method = "BuyseTest") validCharacter(treatment, valid.length = 1, method = "BuyseTest") validNames(data, name1 = "data", required.values = treatment, valid.length = NULL, method = "BuyseTest") if (length(level.treatment) != 2) { stop("BuyseTest: wrong specification of the group variable (\"", treatment, "\"). \n", "The corresponding column in 'data' must have exactly 2 levels. \n", "Proposed levels : ", paste(level.treatment, collapse = " "), "\n") } if (any(table(data[[treatment]]) == 0)) { txt.stop <- names(which(table(data[[treatment]]) == 0)) stop("BuyseTest: wrong specification of 'data'. \n", "No observation taking level ", txt.stop, " in the treatment variable. \n") } if (any(type %in% c("bin", "cont", "tte", "gaus") == FALSE)) { txt <- type[type %in% c("bin", "cont", "tte", "gaus") == FALSE] stop("BuyseTest: wrong specification of 'type' \n", "valid values: \"binary\" \"continuous\" \"timetoevent\" \n", "incorrect values: \"", paste(txt, collapse = "\" \""), "\" \n") } n.typePerEndpoint <- tapply(type, endpoint, function(x) { length(unique(x)) }) if (any(n.typePerEndpoint > 1)) { message <- paste0("several types have been specified for endpoint(s) ", paste0(unique(endpoint)[n.typePerEndpoint > 1], collapse = ""), "\n") stop("BuyseTest: wrong specification of 'endpoint' or 'type' \n", message) } if (length(weightEndpoint) != D) { stop("BuyseTest: argument 'weightEndpoint' must have length the number of endpoints \n") } if (hierarchical) { if (any(weightEndpoint != 1) || any(is.na(weightEndpoint))) { stop("BuyseTest: all the weights for the endpoints must be 1 when using hierarchical GPC \n") } } if (!is.null(weightObs) && any(weightObs != 1)) { test1 <- is.character(weightObs) && length(weightObs) == 1 && weightObs %in% names(data) test2 <- is.numeric(weightObs) && length(weightObs) == NROW(data) if ((test1 == FALSE) && (test2 == FALSE)) { stop("BuyseTest: argument 'weightObs' must correspond to a column in argument 'data' ", "or must have as many element as rows in argument 'data'. \n") } if (engine == "GPC_cpp") { stop("Cannot weigth observations with engine GPC_cpp. \n") } } if (hierarchical) { if (any(weightEndpoint != 1) || any(is.na(weightEndpoint))) { stop("BuyseTest: all the weights for the endpoints must be 1 when using hierarchical GPC \n") } } return(invisible(TRUE)) })(name.call = c("", "formula", "data", "pool.strata", "trace"), status = "..NA..", status.TTE = character(0), correction.uninf = 0, cpus = 1, D = 1L, D.TTE = 0L, data = structure(list(id = 1:100, Y = c(0.879633322775876, 1.54211587314424, 0.589078351447554, 0.158028772404075, -0.154584643918818, 1.76728726937265, 0.716707476017206, 2.41017422949523, 0.884185357826345, 2.18217608051942, -0.135736453948977, 0.038355269639434, 1.93228223854166, 0.849303646689633, 0.792619256398035, 1.10719207055802, 1.18000713145149, -0.279113302976559, 1.99418833126783, 0.822669517730394, 0.494042537885743, 2.84303882517041, 0.285420591453131, 0.320443469956613, 1.39980925878644, 1.21266630705141, 0.426435595873674, 1.46236582853295, 0.318339521244343, 0.175729727753681, 0.560160440434515, -0.0888944862596638, 2.03149619263257, -1.01839408178679, 1.30655786078977, -1.03644982353759, 0.699023873163389, 0.971720095554994, 0.847905219319001, 0.443103222152607, -0.914359425680012, 1.67658331201856, -1.664972436212, 1.03646959852761, -0.615920105042845, 0.249180998806552, 3.58716654562835, 1.51739561969325, -0.786300530434326, -1.14060553441858, 1.95018710127266, -0.018559832714638, 0.181931625456156, -0.429362147453702, -0.987460310141485, 0.424807703384319, 2.50002880371391, 0.878733305203177, 0.115573152615509, 3.36929062242358, 0.425100377372448, 0.261352899086967, 1.55848304870902, 2.38642265137494, -0.119243048231147, 2.70610246454047, 1.24497296985898, -1.42449465021281, 0.355600398045781, 1.20753833923234, 2.80797839905936, 0.105802367893711, 1.95699880542341, 0.422847064643469, 0.165999157633456, 0.965273971688724, 1.78763960563016, 3.57524500865228, 2.02739243876377, 1.2079083983867, 0.268676578441956, 1.48389557005338, 0.719924803660651, -0.967250029092243, 0.521022742648139, 0.341245395283984, 2.9645873119698, -0.266081999604665, 1.06978824607145, -0.426109497377437, 0.32289603856346, 1.90201177948634, -0.231748173119606, 1.83037316798167, -0.208082786304465, -0.0479844128077416, 1.94115770684428, 0.484152534695351, 0.411974712317515, 0.11892394889108), arm = c(1L, 1L, 1L, 0L, 1L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 0L, 1L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 1L, 0L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 0L, 1L), X = c(1L, 1L, 1L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 1L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 1L, 0L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 1L, 1L, 1L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 1L, 0L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 1L, 0L, 0L)), class = "data.frame", row.names = c(NA, -100L)), endpoint = "Y", endpoint.TTE = character(0), engine = "GPC_cpp", formula = arm ~ cont(Y, threshold = tau) + X, iid = TRUE, iidNuisance = FALSE, index.endpoint = 0, index.status = 0, keep.pairScore = FALSE, keep.survival = FALSE, scoring.rule = "gehan", pool.strata = structure(3, type = "standardization", original = "standardization"), model.tte = NULL, args.model.tte = list(), method.inference = structure("u statistic", permutation = FALSE, bootstrap = FALSE, studentized = FALSE, ustatistic = TRUE, "`resampling-strata`" = NA_character_, hprojection = 2), n.resampling = 1000, hierarchical = TRUE, neutral.as.uninf = TRUE, add.halfNeutral = FALSE, operator = c(`>0` = 1), censoring = NA_character_, restriction = NA_real_, order.Hprojection = 2, precompute = TRUE, seed = NULL, strata = structure("X", match = FALSE), threshold = structure(1e-12, original = 0), multiplicative.threshold = c(`>0` = FALSE), trace = 0, treatment = "arm", type = "cont", Uendpoint = "Y", Ustatus = "..NA..", weightEndpoint = 1, weightObs = NULL, debug = -1)`: BuyseTest: argument 'pool.strata' set to "standardization" only available for engine = "GPC2_cpp".
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-standardization.R:203:5
2. ├─base::do.call(testArgs, args = outArgs)
3. └─BuyseTest (local) `<fn>`(...)
── Error ('test-BuyseTest-standardization.R:244:5'): BuyseTest - standarization (tte outcome) ──
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-standardization.R:244:5
2. └─BuyseTest:::.BuyseTest(...)
3. └─BuyseTest:::calcPeron(...)
4. └─BuyseTest:::fitTTEM(...)
5. ├─base::do.call(...)
6. └─prodlim (local) `<fn>`(...)
7. └─prodlim::EventHistory.frame(...)
8. └─prodlim::model.design(...)
9. └─stats::delete.response(terms)
10. └─stats (local) off(a$specials[[i]])
── Error ('test-BuyseTest-weightObs.R:32:5'): same weight for all ──────────────
Error in `(function (name.call, status, correction.uninf, cpus, data, endpoint, engine, formula, iid, iidNuisance, keep.pairScore, scoring.rule, pool.strata, model.tte, method.inference, n.resampling, strata.resampling, hierarchical, neutral.as.uninf, add.halfNeutral, operator, censoring, restriction, seed, strata, threshold, multiplicative.threshold, trace, treatment, type, weightEndpoint, weightObs, ...) { if (!data.table::is.data.table(data)) { if (inherits(data, "function")) { stop("Argument 'data' is mispecified. \n", "'data' cannot be a function. \n") } data <- data.table::as.data.table(data) } else { data <- data.table::copy(data) } if ("..rowIndex.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..rowIndex..\". \n") } if ("..NA.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..NA..\". \n") } if ("..strata.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..strata..\". \n") } if ("..weight.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..weight..\". \n") } argnames <- c("treatment", "endpoint", "type", "threshold", "status", "strata") D <- length(endpoint) D.TTE <- sum(type == "tte") level.treatment <- levels(as.factor(data[[treatment]])) if (is.null(strata)) { n.strata <- 1 } else { indexT <- which(data[[treatment]] == level.treatment[2]) indexC <- which(data[[treatment]] == level.treatment[1]) if (any(strata %in% names(data) == FALSE)) { stop("Strata variable(s) \"", paste0(setdiff(strata, names(data)), collapse = "\" \""), "\" not found in argument 'data' \n") } strataT <- interaction(data[indexT, strata, with = FALSE], drop = TRUE, lex.order = FALSE, sep = ".") strataC <- interaction(data[indexC, strata, with = FALSE], drop = TRUE, lex.order = FALSE, sep = ".") level.strata <- levels(strataT) n.strata <- length(level.strata) if (is.null(attr(strata, "match"))) { stop("Undefined value for 'match': contact the package maintainer. \n") } else if (length(attr(strata, "match")) != 1 || attr(strata, "match") %in% 0:1 == FALSE) { stop("Argument 'match' should be a binary variable. \n") } else if (length(attr(strata, "match")) == 1 && attr(strata, "match") > 0 && pool.strata >= 3) { stop("Argument pool.strata should be \"Buyse\", \"CMH\", or \"equal\" in a matched design. \n") } } if (length(status) != D) { stop("BuyseTest: 'status' does not match 'endpoint' size. \n", "length(status): ", length(status), "\n", "length(endpoint) : ", D, "\n") } if (any(is.na(status))) { stop("BuyseTest: 'status' must not contain NA. \n") } index.pb <- which(status[type == "tte"] == "..NA..") if (length(index.pb) > 0) { if (all(attr(censoring, "original")[index.pb] %in% names(data))) { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must indicate a variable in data for TTE endpoints. \n", "'censoring' is used to indicate whether there is left or right censoring. \n", "Consider changing 'censoring =' into 'status =' when in the argument 'formula' \n") } else { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must indicate a variable in data for TTE endpoints. \n", "TTE endoints: ", paste(endpoint[type == "tte"], collapse = " "), "\n", "proposed 'status' for these endoints: ", paste(status[type == "tte"], collapse = " "), "\n") } } index.pb <- which(status[type == "gaussian"] == "..NA..") if (length(index.pb) > 0) { stop("BuyseTest: wrong specification of 'std'. \n", "'std' must indicate a variable in data for Gaussian endpoints. \n", "Gaussian endoints: ", paste(endpoint[type == 4], collapse = " "), "\n", "proposed 'gaussian' for these endoints: ", paste(status[type == 4], collapse = " "), "\n") } if (any(status[type %in% c("bin", "cont")] != "..NA..")) { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must be \"..NA..\" for binary or continuous endpoints. \n", "endoints : ", paste(endpoint[type %in% c("bin", "cont")], collapse = " "), "\n", "proposed 'status' for these endoints: ", paste(status[type %in% c("bin", "cont")], collapse = " "), "\n") } Ustatus.TTE <- unique(status[type == "tte"]) if (any(Ustatus.TTE %in% names(data) == FALSE)) { stop("BuyseTest: variable(s) 'status': \"", paste0(Ustatus.TTE[Ustatus.TTE %in% names(data) == FALSE], collapse = "\" \""), "\" \n", "not found in argument 'data'.\n") } if (is.null(strata)) { if (any(sapply(Ustatus.TTE, function(iS) { sum(data[[iS]] != 0) }) == 0)) { warning("BuyseTest: time to event variables with only censored events \n") } strata.tempo <- rep(1, NROW(data)) } else { strata.tempo <- interaction(as.data.frame(data)[strata]) if (is.factor(strata.tempo)) { strata.tempo <- droplevels(strata.tempo) } if (!is.null(strata) && (attr(strata, "match") == FALSE) && any(sapply(Ustatus.TTE, function(iS) { tapply(data[[iS]], strata.tempo, function(iVec) { sum(iVec != 0) }) }) == 0)) { warning("BuyseTest: time to event variables with only censored events in at least one strata \n") } } if (any(type == "gaus")) { censoring.gaus <- na.omit(censoring[type == "gaus"]) if (length(censoring.gaus) > 0 && any(censoring.gaus %in% names(data) == FALSE)) { stop("BuyseTest: wrong specification of 'iid'. \n", "'iid' must indicate a variable in argument 'data'. \n", "incorrect 'iid' value(s): \"", paste(censoring.gaus[censoring.gaus %in% names(data) == FALSE], collapse = "\" \""), "\" \n") } } else if (any(type == "tte")) { censoring.tte <- censoring[type == "tte"] if (any(is.na(censoring.tte))) { stop("BuyseTest: wrong specification of 'censoring'. \n", "'censoring' must be \"left\", or \"right\" for time to event endpoints. \n", "incorrect 'censoring' value(s): \"", paste(censoring.tte[is.na(censoring.tte)], collapse = "\" \""), "\" \n") } if (any(censoring.tte %in% c("left", "right") == FALSE)) { stop("BuyseTest: wrong specification of 'censoring'. \n", "'censoring' must be \"left\", or \"right\" \n", "incorrect 'censoring' value(s): \"", paste(censoring.tte[censoring.tte %in% c("left", "right") == FALSE], collapse = "\" \""), "\" \n") } } if (any(type[which(!is.na(restriction))] %in% c("tte", "cont") == FALSE)) { stop("Type(s) \"", paste(unique(setdiff(type[which(!is.na(restriction))], c("tte", "cont"))), collapse = "\" \""), "\" do not support argument restriction. \n") } if (any(type[which(!is.na(restriction))] %in% c("tte", "cont") == FALSE)) { stop("Type(s) \"", paste(unique(setdiff(type[which(!is.na(restriction))], c("tte", "cont"))), collapse = "\" \""), "\" do not support argument restriction. \n") } if (cpus > 1) { validInteger(cpus, valid.length = 1, min = 1, max = parallel::detectCores(), method = "BuyseTest") } valid.rule <- c("gehan", "peron", "efron", "latta", names(survival::survreg.distributions)) if (is.na(scoring.rule) || scoring.rule %in% valid.rule == FALSE) { stop("BuyseTest: wrong specification of 'scoring.rule'. \n", "valid values: \"Gehan\" (no survival model)\n", " : \"Peron\", \"Efron\", \"Latta\" (non-parametric survival model)\n", " : \"Exponential\", \"Weibull\", ... (parametric survival model, see argument dist in survival::survreg). \n") } if (any(!is.na(censoring)) && any(stats::na.omit(censoring) == "left") && scoring.rule != "gehan") { warning("The ", scoring.rule, " scoring rule does not support left-censored endpoints \n", "For those endpoints, the Gehan's scoring rule will be used instead.", sep = "") } if (is.na(pool.strata)) { stop("BuyseTest: wrong specification of 'pool.strata'. \n", "valid values: \"Buyse\", \"CMH\", \"equal\", \"standardisation\", \"standardization\", \"var-favorable\", \"var-unfavorable\", \"var-netBenefit\", \"var-winRatio\". \n") } else if (pool.strata == 3) { if (engine != "GPC2_cpp") { stop("BuyseTest: argument 'pool.strata' set to \"standardization\" only available for engine = \"GPC2_cpp\". \n") } if (!is.null(strata) && attr(strata, "match")) { stop("BuyseTest: argument 'pool.strata' set to \"standardization\" is not available for matched data. \n") } } if (!is.null(model.tte)) { endpoint.UTTE <- unique(endpoint[type == "tte"]) D.UTTE <- length(endpoint.UTTE) if (!is.list(model.tte) || length(model.tte) != D.UTTE) { stop("BuyseTest: argument 'model.tte' must be a list containing ", D.UTTE, " elements. \n", "(one for each unique time to event endpoint). \n") } if (is.null(model.tte) || any(names(model.tte) != endpoint.UTTE)) { stop("BuyseTest: argument 'model.tte' must be a named list. \n", "valid sequence of names: \"", paste0(endpoint.UTTE, collapse = "\" \""), "\" \n", "proposed names: \"", paste0(names(model.tte), collapse = "\" \""), "\" \n") } valid.class <- setdiff(utils::methods(generic.function = "BuyseTTEM"), c("BuyseTTEM.formula")) vec.class <- sapply(model.tte, function(iTTE) { any(paste0("BuyseTTEM.", class(model.tte[[1]])) %in% valid.class) }) if (any(vec.class == FALSE)) { stop("BuyseTest: argument 'model.tte' must be a list of \"", paste0(gsub("BuyseTTEM\\.", "", valid.class), collapse = "\", or \""), "\" objects. \n") } test.prodlim.continuous <- sapply(model.tte, function(iModel) { inherits(iModel, "prodlim") & length(iModel$continuous.predictor > 0) }) if (any(test.prodlim.continuous)) { stop("Incorrect model for time to event: cannot handle continuous variables. \n", "Consider setting the argument \"discrete.level\" to a large value when calling prodlim for endpoint(s) \"", paste(names(test.prodlim.continuous)[test.prodlim.continuous], collapse = "\" \""), "\". \n") } } if (any(endpoint %in% names(data) == FALSE)) { stop("Endpoint(s) \"", paste(setdiff(endpoint, names(data)), collapse = "\", \""), "\" could not be found in argument 'data'.") } index.Bin <- which(type == "bin") if (length(index.Bin) > 0) { for (iBin in index.Bin) { if (length(unique(na.omit(data[[endpoint[iBin]]]))) > 2) { stop("Binary endpoint cannot have more than 2 levels. \n", "endpoint: ", endpoint[iBin], "\n") } } } index.Cont <- which(type == "cont") if (length(index.Cont) > 0) { for (iCont in index.Cont) { validNumeric(data[[endpoint[iCont]]], name1 = endpoint[iCont], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") } } index.TTE <- which(type == "tte") status.TTE <- status[type == "tte"] if (length(index.TTE) > 0) { validNames(data, name1 = "data", required.values = status.TTE, valid.length = NULL, refuse.NULL = FALSE, method = "BuyseTest") valid.values.status <- 0:2 for (iTTE in index.TTE) { validNumeric(data[[endpoint[iTTE]]], name1 = endpoint[iTTE], valid.length = NULL, refuse.NA = TRUE, method = "BuyseTest") validNumeric(unique(data[[status.TTE[which(index.TTE == iTTE)]]]), name1 = status.TTE[which(index.TTE == iTTE)], valid.values = valid.values.status, valid.length = NULL, method = "BuyseTest") } } index.Gaus <- which(type == "gaus") if (length(index.Gaus) > 0) { for (iGaus in index.Gaus) { validNumeric(data[[endpoint[iGaus]]], name1 = endpoint[iGaus], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") validNumeric(data[[status[iGaus]]], name1 = status[iGaus], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") } } validNames(data, name1 = "data", required.values = endpoint, valid.length = NULL, method = "BuyseTest") if (!is.null(formula) && any(name.call %in% argnames)) { txt <- paste(name.call[name.call %in% argnames], collapse = "' '") warning("BuyseTest: argument", if (length(txt) > 1) { "s" }, " '", txt, "' ha", if (length(txt) > 1) { "ve" } else { "s" }, " been ignored. \n", "when specified, only argument 'formula' is used. \n") } validLogical(keep.pairScore, valid.length = 1, method = "BuyseTest") validInteger(correction.uninf, valid.length = 1, min = 0, max = 3, method = "BuyseTest") if (length(method.inference) != 1) { stop("Argument 'method.inference' must have length 1. \n") } if (method.inference %in% c("u statistic bebu") == FALSE) { validCharacter(method.inference, valid.length = 1, valid.values = c("none", "u statistic", "permutation", "studentized permutation", "varexact permutation", "bootstrap", "studentized bootstrap"), method = "BuyseTest") } if (pool.strata > 4 && method.inference %in% c("u statistic", "varexact permutation", "studentized permutation", "varexact permutation", "studentized bootstrap")) { stop("Only bootstrap and permutation can be used to quantify uncertainty when weighting strata-specific effects by the inverse of the variance. \n") } if (method.inference == "none" || attr(method.inference, "permutation")) { } else if (is.null(strata) && any(table(data[[treatment]]) <= 5)) { warning("P-value/confidence intervals may not be valid with few observations in a treatment group. \n") } else if (!is.null(strata) && !attr(strata, "match") && any(table(data[[treatment]], strata.tempo) <= 5)) { warning("P-value/confidence intervals may not be valid with few observations in a treatment and strata group. \n") } if (any(!is.na(attr(method.inference, "resampling-strata"))) && any(attr(method.inference, "resampling-strata") %in% names(data) == FALSE)) { stop("Incorrect value for argument 'strata.resampling': must correspond to a column in argument 'data'. \n") } if (any(!is.na(attr(method.inference, "resampling-strata"))) && attr(method.inference, "permutation") && any(attr(method.inference, "resampling-strata") == treatment)) { stop("Argument 'strata.resampling' should not contain the variable used to form the treatment groups when using a permutation test. \n") } if (iid && correction.uninf > 0) { warning("The current implementation of the asymptotic distribution is valid when using a correction. \n", "Standard errors / confidence intervals / p-values may not be correct. \n", "Consider using a resampling approach or checking the control of the type 1 error with powerBuyseTest. \n") } if (method.inference %in% c("bootstrap", "permutation", "stratified bootstrap", "stratified permutation")) { validInteger(n.resampling, valid.length = 1, min = 1, method = "BuyseTest") if (!is.null(seed)) { tol.seed <- attr(seed, "max") if (n.resampling > tol.seed) { stop("Cannot set a seed per sample when considering more than ", tol.seed, " samples. \n") } } } validLogical(hierarchical, valid.length = 1, method = "BuyseTest") validLogical(neutral.as.uninf, valid.length = D, method = "BuyseTest") validLogical(add.halfNeutral, valid.length = 1, method = "BuyseTest") if (any(is.na(operator))) { stop("BuyseTest: wrong specification of 'operator'. \n", "Can be \"<0\" (lower is better), \">0\" (higher is better), \"+\" additive threshold, \"*\" multiplicative threshold \n", "or a combination of the previous such as \"*<0\" (lower is better with multiplicative threshold). \n") } if (any(tapply(restriction, endpoint, function(iRestriction) { length(unique(iRestriction)) }) > 1)) { stop("BuyseTest: wrong specification of 'restriction'. \n", "Should not vary when the same endpoint is used at different priorities.") } validInteger(seed, valid.length = 1, refuse.NULL = FALSE, min = 1, method = "BuyseTest") if (!is.null(strata)) { validNames(data, name1 = "data", required.values = strata, valid.length = NULL, method = "BuyseTest") if (length(level.strata) != length(levels(strataC)) || any(level.strata != levels(strataC))) { stop("BuyseTest: wrong specification of 'strata'. \n", "different levels between Control and Treatment \n", "levels(strataT) : ", paste(levels(strataT), collapse = " "), "\n", "levels(strataC) : ", paste(levels(strataC), collapse = " "), "\n") } if (any(level.strata %in% c("global", "standardise", "standardize"))) { stop("BuyseTest: wrong specification of 'strata'. \n", "\"", paste(intersect(level.strata, c("global", "standardise", "standardize")), collapse = "\" \""), "\" is a reserved name used internally. \n") } } validNumeric(threshold, valid.length = D, min = 0, refuse.NA = TRUE, method = "BuyseTest") if (any(multiplicative.threshold) && any(threshold[multiplicative.threshold] <= 1)) { stop("BuyseTest: wrong specification of 'threshold'. \n", "'threshold' must be at least 1 + 1e-12 when considering multiplicative threshold. \n") } if (any(threshold[type == "bin"] > 1e-12)) { stop("BuyseTest: wrong specification of 'threshold'. \n", "'threshold' must be 1e-12 for binary endpoints (or equivalently NA) \n", "proposed 'threshold' : ", paste(threshold[type == "bin"], collapse = " "), "\n", "binary endpoint(s) : ", paste(endpoint[type == "bin"], collapse = " "), "\n") } vec.test <- tapply(threshold, endpoint, function(x) { test.unsorted <- is.unsorted(rev(x)) test.duplicated <- any(duplicated(x)) return(test.unsorted + test.duplicated) }) if (any(vec.test > 0)) { stop("BuyseTest: wrong specification of 'endpoint' or 'threshold'. \n", "Endpoints must be used with strictly decreasing threshold when re-used with lower priority. \n", "Problematic endpoints: \"", paste0(names(vec.test)[vec.test > 0], collapse = "\" \""), "\"\n") } validInteger(trace, valid.length = 1, min = 0, max = 2, method = "BuyseTest") validCharacter(treatment, valid.length = 1, method = "BuyseTest") validNames(data, name1 = "data", required.values = treatment, valid.length = NULL, method = "BuyseTest") if (length(level.treatment) != 2) { stop("BuyseTest: wrong specification of the group variable (\"", treatment, "\"). \n", "The corresponding column in 'data' must have exactly 2 levels. \n", "Proposed levels : ", paste(level.treatment, collapse = " "), "\n") } if (any(table(data[[treatment]]) == 0)) { txt.stop <- names(which(table(data[[treatment]]) == 0)) stop("BuyseTest: wrong specification of 'data'. \n", "No observation taking level ", txt.stop, " in the treatment variable. \n") } if (any(type %in% c("bin", "cont", "tte", "gaus") == FALSE)) { txt <- type[type %in% c("bin", "cont", "tte", "gaus") == FALSE] stop("BuyseTest: wrong specification of 'type' \n", "valid values: \"binary\" \"continuous\" \"timetoevent\" \n", "incorrect values: \"", paste(txt, collapse = "\" \""), "\" \n") } n.typePerEndpoint <- tapply(type, endpoint, function(x) { length(unique(x)) }) if (any(n.typePerEndpoint > 1)) { message <- paste0("several types have been specified for endpoint(s) ", paste0(unique(endpoint)[n.typePerEndpoint > 1], collapse = ""), "\n") stop("BuyseTest: wrong specification of 'endpoint' or 'type' \n", message) } if (length(weightEndpoint) != D) { stop("BuyseTest: argument 'weightEndpoint' must have length the number of endpoints \n") } if (hierarchical) { if (any(weightEndpoint != 1) || any(is.na(weightEndpoint))) { stop("BuyseTest: all the weights for the endpoints must be 1 when using hierarchical GPC \n") } } if (!is.null(weightObs) && any(weightObs != 1)) { test1 <- is.character(weightObs) && length(weightObs) == 1 && weightObs %in% names(data) test2 <- is.numeric(weightObs) && length(weightObs) == NROW(data) if ((test1 == FALSE) && (test2 == FALSE)) { stop("BuyseTest: argument 'weightObs' must correspond to a column in argument 'data' ", "or must have as many element as rows in argument 'data'. \n") } if (engine == "GPC_cpp") { stop("Cannot weigth observations with engine GPC_cpp. \n") } } if (hierarchical) { if (any(weightEndpoint != 1) || any(is.na(weightEndpoint))) { stop("BuyseTest: all the weights for the endpoints must be 1 when using hierarchical GPC \n") } } return(invisible(TRUE)) })(name.call = c("", "formula", "data", "method.inference", "weightObs", "trace"), status = c("..NA..", "..NA.."), status.TTE = character(0), correction.uninf = 0, cpus = 1, D = 2L, D.TTE = 0L, data = structure(list(trt = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2), celltype = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L), levels = c("squamous", "smallcell", "adeno", "large"), class = "factor"), time = c(72, 411, 228, 126, 118, 10, 82, 110, 314, 100, 42, 8, 144, 25, 11, 30, 384, 4, 54, 13, 123, 97, 153, 59, 117, 16, 151, 22, 56, 21, 18, 139, 20, 31, 52, 287, 18, 51, 122, 27, 54, 7, 63, 392, 10, 8, 92, 35, 117, 132, 12, 162, 3, 95, 177, 162, 216, 553, 278, 12, 260, 200, 156, 182, 143, 105, 103, 250, 100, 999, 112, 87, 231, 242, 991, 111, 1, 587, 389, 33, 25, 357, 467, 201, 1, 30, 44, 283, 15, 25, 103, 21, 13, 87, 2, 20, 7, 24, 99, 8, 99, 61, 25, 95, 80, 51, 29, 24, 18, 83, 31, 51, 90, 52, 73, 8, 36, 48, 7, 140, 186, 84, 19, 45, 80, 52, 164, 19, 53, 15, 43, 340, 133, 111, 231, 378, 49), status = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), karno = c(60, 70, 60, 60, 70, 20, 40, 80, 50, 70, 60, 40, 30, 80, 70, 60, 60, 40, 80, 60, 40, 60, 60, 30, 80, 30, 50, 60, 80, 40, 20, 80, 30, 75, 70, 60, 30, 60, 80, 60, 70, 50, 50, 40, 40, 20, 70, 40, 80, 80, 50, 80, 30, 80, 50, 80, 50, 70, 60, 40, 80, 80, 70, 90, 90, 80, 80, 70, 60, 90, 80, 80, 50, 50, 70, 70, 20, 60, 90, 30, 20, 70, 90, 80, 50, 70, 60, 90, 50, 30, 70, 20, 30, 60, 40, 30, 20, 60, 70, 80, 85, 70, 70, 70, 50, 30, 40, 40, 40, 99, 80, 60, 60, 60, 60, 50, 70, 10, 40, 70, 90, 80, 50, 40, 40, 60, 70, 30, 60, 30, 60, 80, 75, 60, 70, 80, 30), diagtime = c(7, 5, 3, 9, 11, 5, 10, 29, 18, 6, 4, 58, 4, 9, 11, 3, 9, 2, 4, 4, 3, 5, 14, 2, 3, 4, 12, 4, 12, 2, 15, 2, 5, 3, 2, 25, 4, 1, 28, 8, 1, 7, 11, 4, 23, 19, 10, 6, 2, 5, 4, 5, 3, 4, 16, 5, 15, 2, 12, 12, 5, 12, 2, 2, 8, 11, 5, 8, 13, 12, 6, 3, 8, 1, 7, 3, 21, 3, 2, 6, 36, 13, 2, 28, 7, 11, 13, 2, 13, 2, 22, 4, 2, 2, 36, 9, 11, 8, 3, 2, 4, 2, 2, 1, 17, 87, 8, 2, 5, 3, 3, 5, 22, 3, 3, 5, 8, 4, 4, 3, 3, 4, 10, 3, 4, 4, 15, 4, 12, 5, 11, 10, 1, 5, 18, 4, 3), age = c(69, 64, 38, 63, 65, 49, 69, 68, 43, 70, 81, 63, 63, 52, 48, 61, 42, 35, 63, 56, 55, 67, 63, 65, 46, 53, 69, 68, 43, 55, 42, 64, 65, 65, 55, 66, 60, 67, 53, 62, 67, 72, 48, 68, 67, 61, 60, 62, 38, 50, 63, 64, 43, 34, 66, 62, 52, 47, 63, 68, 45, 41, 66, 62, 60, 66, 38, 53, 37, 54, 60, 48, 52, 70, 50, 62, 65, 58, 62, 64, 63, 58, 64, 52, 35, 63, 70, 51, 40, 69, 36, 71, 62, 60, 44, 54, 66, 49, 72, 68, 62, 71, 70, 61, 71, 59, 67, 60, 69, 57, 39, 62, 50, 43, 70, 66, 61, 81, 58, 63, 60, 62, 42, 69, 63, 45, 68, 39, 66, 63, 49, 64, 65, 64, 67, 65, 37), prior = c(0, 10, 0, 10, 10, 0, 10, 0, 0, 0, 0, 10, 0, 10, 10, 0, 0, 0, 10, 0, 0, 0, 10, 0, 0, 10, 0, 0, 10, 10, 0, 0, 0, 0, 0, 10, 0, 0, 0, 0, 0, 0, 0, 0, 10, 10, 0, 0, 0, 0, 10, 0, 0, 0, 10, 0, 0, 0, 0, 10, 0, 10, 0, 0, 0, 0, 0, 10, 10, 10, 0, 0, 10, 0, 10, 0, 10, 0, 0, 0, 0, 0, 0, 10, 0, 0, 10, 0, 10, 0, 10, 0, 0, 0, 10, 10, 0, 0, 0, 0, 0, 0, 0, 0, 0, 10, 0, 0, 10, 0, 0, 0, 10, 0, 0, 0, 0, 0, 0, 0, 0, 10, 0, 0, 0, 0, 10, 10, 0, 0, 10, 10, 0, 0, 10, 0, 0), weight = c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)), row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86", "87", "88", "89", "90", "91", "92", "93", "94", "95", "96", "97", "98", "99", "100", "101", "102", "103", "104", "105", "106", "107", "108", "109", "110", "111", "112", "113", "114", "115", "116", "117", "118", "119", "120", "121", "122", "123", "124", "125", "126", "127", "128", "129", "130", "131", "132", "133", "134", "135", "136", "137"), class = "data.frame"), endpoint = c("prior", "time"), endpoint.TTE = character(0), engine = "GPC_cpp", formula = trt ~ bin(prior) + cont(time) + celltype, iid = TRUE, iidNuisance = FALSE, index.endpoint = c(0, 1), index.status = c(0, 0), keep.pairScore = FALSE, keep.survival = FALSE, scoring.rule = "gehan", pool.strata = structure(0, type = "buyse", original = NA), model.tte = NULL, args.model.tte = list(), method.inference = structure("u statistic", permutation = FALSE, bootstrap = FALSE, studentized = FALSE, ustatistic = TRUE, "`resampling-strata`" = NA_character_, hprojection = 1), n.resampling = 1000, hierarchical = TRUE, neutral.as.uninf = c(TRUE, TRUE), add.halfNeutral = FALSE, operator = c(`>0` = 1, `>0` = 1), censoring = c(NA_character_, NA_character_), restriction = c(NA_real_, NA_real_), order.Hprojection = 1, precompute = TRUE, seed = NULL, strata = structure("celltype", match = FALSE), threshold = structure(c(1e-12, 1e-12), original = c(NA_real_, NA_real_)), multiplicative.threshold = c(`>0` = FALSE, `>0` = FALSE), trace = 0, treatment = "trt", type = c("bin", "cont"), Uendpoint = c("prior", "time"), Ustatus = "..NA..", weightEndpoint = c(1, 1), weightObs = "weight", debug = -1)`: Cannot weigth observations with engine GPC_cpp.
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-weightObs.R:32:5
2. ├─base::do.call(testArgs, args = outArgs)
3. └─BuyseTest (local) `<fn>`(...)
── Error ('test-BuyseTest-weightObs.R:53:5'): individual specific weight ───────
Error in `(function (name.call, status, correction.uninf, cpus, data, endpoint, engine, formula, iid, iidNuisance, keep.pairScore, scoring.rule, pool.strata, model.tte, method.inference, n.resampling, strata.resampling, hierarchical, neutral.as.uninf, add.halfNeutral, operator, censoring, restriction, seed, strata, threshold, multiplicative.threshold, trace, treatment, type, weightEndpoint, weightObs, ...) { if (!data.table::is.data.table(data)) { if (inherits(data, "function")) { stop("Argument 'data' is mispecified. \n", "'data' cannot be a function. \n") } data <- data.table::as.data.table(data) } else { data <- data.table::copy(data) } if ("..rowIndex.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..rowIndex..\". \n") } if ("..NA.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..NA..\". \n") } if ("..strata.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..strata..\". \n") } if ("..weight.." %in% names(data)) { stop("BuyseTest: Argument 'data' must not contain a column \"..weight..\". \n") } argnames <- c("treatment", "endpoint", "type", "threshold", "status", "strata") D <- length(endpoint) D.TTE <- sum(type == "tte") level.treatment <- levels(as.factor(data[[treatment]])) if (is.null(strata)) { n.strata <- 1 } else { indexT <- which(data[[treatment]] == level.treatment[2]) indexC <- which(data[[treatment]] == level.treatment[1]) if (any(strata %in% names(data) == FALSE)) { stop("Strata variable(s) \"", paste0(setdiff(strata, names(data)), collapse = "\" \""), "\" not found in argument 'data' \n") } strataT <- interaction(data[indexT, strata, with = FALSE], drop = TRUE, lex.order = FALSE, sep = ".") strataC <- interaction(data[indexC, strata, with = FALSE], drop = TRUE, lex.order = FALSE, sep = ".") level.strata <- levels(strataT) n.strata <- length(level.strata) if (is.null(attr(strata, "match"))) { stop("Undefined value for 'match': contact the package maintainer. \n") } else if (length(attr(strata, "match")) != 1 || attr(strata, "match") %in% 0:1 == FALSE) { stop("Argument 'match' should be a binary variable. \n") } else if (length(attr(strata, "match")) == 1 && attr(strata, "match") > 0 && pool.strata >= 3) { stop("Argument pool.strata should be \"Buyse\", \"CMH\", or \"equal\" in a matched design. \n") } } if (length(status) != D) { stop("BuyseTest: 'status' does not match 'endpoint' size. \n", "length(status): ", length(status), "\n", "length(endpoint) : ", D, "\n") } if (any(is.na(status))) { stop("BuyseTest: 'status' must not contain NA. \n") } index.pb <- which(status[type == "tte"] == "..NA..") if (length(index.pb) > 0) { if (all(attr(censoring, "original")[index.pb] %in% names(data))) { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must indicate a variable in data for TTE endpoints. \n", "'censoring' is used to indicate whether there is left or right censoring. \n", "Consider changing 'censoring =' into 'status =' when in the argument 'formula' \n") } else { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must indicate a variable in data for TTE endpoints. \n", "TTE endoints: ", paste(endpoint[type == "tte"], collapse = " "), "\n", "proposed 'status' for these endoints: ", paste(status[type == "tte"], collapse = " "), "\n") } } index.pb <- which(status[type == "gaussian"] == "..NA..") if (length(index.pb) > 0) { stop("BuyseTest: wrong specification of 'std'. \n", "'std' must indicate a variable in data for Gaussian endpoints. \n", "Gaussian endoints: ", paste(endpoint[type == 4], collapse = " "), "\n", "proposed 'gaussian' for these endoints: ", paste(status[type == 4], collapse = " "), "\n") } if (any(status[type %in% c("bin", "cont")] != "..NA..")) { stop("BuyseTest: wrong specification of 'status'. \n", "'status' must be \"..NA..\" for binary or continuous endpoints. \n", "endoints : ", paste(endpoint[type %in% c("bin", "cont")], collapse = " "), "\n", "proposed 'status' for these endoints: ", paste(status[type %in% c("bin", "cont")], collapse = " "), "\n") } Ustatus.TTE <- unique(status[type == "tte"]) if (any(Ustatus.TTE %in% names(data) == FALSE)) { stop("BuyseTest: variable(s) 'status': \"", paste0(Ustatus.TTE[Ustatus.TTE %in% names(data) == FALSE], collapse = "\" \""), "\" \n", "not found in argument 'data'.\n") } if (is.null(strata)) { if (any(sapply(Ustatus.TTE, function(iS) { sum(data[[iS]] != 0) }) == 0)) { warning("BuyseTest: time to event variables with only censored events \n") } strata.tempo <- rep(1, NROW(data)) } else { strata.tempo <- interaction(as.data.frame(data)[strata]) if (is.factor(strata.tempo)) { strata.tempo <- droplevels(strata.tempo) } if (!is.null(strata) && (attr(strata, "match") == FALSE) && any(sapply(Ustatus.TTE, function(iS) { tapply(data[[iS]], strata.tempo, function(iVec) { sum(iVec != 0) }) }) == 0)) { warning("BuyseTest: time to event variables with only censored events in at least one strata \n") } } if (any(type == "gaus")) { censoring.gaus <- na.omit(censoring[type == "gaus"]) if (length(censoring.gaus) > 0 && any(censoring.gaus %in% names(data) == FALSE)) { stop("BuyseTest: wrong specification of 'iid'. \n", "'iid' must indicate a variable in argument 'data'. \n", "incorrect 'iid' value(s): \"", paste(censoring.gaus[censoring.gaus %in% names(data) == FALSE], collapse = "\" \""), "\" \n") } } else if (any(type == "tte")) { censoring.tte <- censoring[type == "tte"] if (any(is.na(censoring.tte))) { stop("BuyseTest: wrong specification of 'censoring'. \n", "'censoring' must be \"left\", or \"right\" for time to event endpoints. \n", "incorrect 'censoring' value(s): \"", paste(censoring.tte[is.na(censoring.tte)], collapse = "\" \""), "\" \n") } if (any(censoring.tte %in% c("left", "right") == FALSE)) { stop("BuyseTest: wrong specification of 'censoring'. \n", "'censoring' must be \"left\", or \"right\" \n", "incorrect 'censoring' value(s): \"", paste(censoring.tte[censoring.tte %in% c("left", "right") == FALSE], collapse = "\" \""), "\" \n") } } if (any(type[which(!is.na(restriction))] %in% c("tte", "cont") == FALSE)) { stop("Type(s) \"", paste(unique(setdiff(type[which(!is.na(restriction))], c("tte", "cont"))), collapse = "\" \""), "\" do not support argument restriction. \n") } if (any(type[which(!is.na(restriction))] %in% c("tte", "cont") == FALSE)) { stop("Type(s) \"", paste(unique(setdiff(type[which(!is.na(restriction))], c("tte", "cont"))), collapse = "\" \""), "\" do not support argument restriction. \n") } if (cpus > 1) { validInteger(cpus, valid.length = 1, min = 1, max = parallel::detectCores(), method = "BuyseTest") } valid.rule <- c("gehan", "peron", "efron", "latta", names(survival::survreg.distributions)) if (is.na(scoring.rule) || scoring.rule %in% valid.rule == FALSE) { stop("BuyseTest: wrong specification of 'scoring.rule'. \n", "valid values: \"Gehan\" (no survival model)\n", " : \"Peron\", \"Efron\", \"Latta\" (non-parametric survival model)\n", " : \"Exponential\", \"Weibull\", ... (parametric survival model, see argument dist in survival::survreg). \n") } if (any(!is.na(censoring)) && any(stats::na.omit(censoring) == "left") && scoring.rule != "gehan") { warning("The ", scoring.rule, " scoring rule does not support left-censored endpoints \n", "For those endpoints, the Gehan's scoring rule will be used instead.", sep = "") } if (is.na(pool.strata)) { stop("BuyseTest: wrong specification of 'pool.strata'. \n", "valid values: \"Buyse\", \"CMH\", \"equal\", \"standardisation\", \"standardization\", \"var-favorable\", \"var-unfavorable\", \"var-netBenefit\", \"var-winRatio\". \n") } else if (pool.strata == 3) { if (engine != "GPC2_cpp") { stop("BuyseTest: argument 'pool.strata' set to \"standardization\" only available for engine = \"GPC2_cpp\". \n") } if (!is.null(strata) && attr(strata, "match")) { stop("BuyseTest: argument 'pool.strata' set to \"standardization\" is not available for matched data. \n") } } if (!is.null(model.tte)) { endpoint.UTTE <- unique(endpoint[type == "tte"]) D.UTTE <- length(endpoint.UTTE) if (!is.list(model.tte) || length(model.tte) != D.UTTE) { stop("BuyseTest: argument 'model.tte' must be a list containing ", D.UTTE, " elements. \n", "(one for each unique time to event endpoint). \n") } if (is.null(model.tte) || any(names(model.tte) != endpoint.UTTE)) { stop("BuyseTest: argument 'model.tte' must be a named list. \n", "valid sequence of names: \"", paste0(endpoint.UTTE, collapse = "\" \""), "\" \n", "proposed names: \"", paste0(names(model.tte), collapse = "\" \""), "\" \n") } valid.class <- setdiff(utils::methods(generic.function = "BuyseTTEM"), c("BuyseTTEM.formula")) vec.class <- sapply(model.tte, function(iTTE) { any(paste0("BuyseTTEM.", class(model.tte[[1]])) %in% valid.class) }) if (any(vec.class == FALSE)) { stop("BuyseTest: argument 'model.tte' must be a list of \"", paste0(gsub("BuyseTTEM\\.", "", valid.class), collapse = "\", or \""), "\" objects. \n") } test.prodlim.continuous <- sapply(model.tte, function(iModel) { inherits(iModel, "prodlim") & length(iModel$continuous.predictor > 0) }) if (any(test.prodlim.continuous)) { stop("Incorrect model for time to event: cannot handle continuous variables. \n", "Consider setting the argument \"discrete.level\" to a large value when calling prodlim for endpoint(s) \"", paste(names(test.prodlim.continuous)[test.prodlim.continuous], collapse = "\" \""), "\". \n") } } if (any(endpoint %in% names(data) == FALSE)) { stop("Endpoint(s) \"", paste(setdiff(endpoint, names(data)), collapse = "\", \""), "\" could not be found in argument 'data'.") } index.Bin <- which(type == "bin") if (length(index.Bin) > 0) { for (iBin in index.Bin) { if (length(unique(na.omit(data[[endpoint[iBin]]]))) > 2) { stop("Binary endpoint cannot have more than 2 levels. \n", "endpoint: ", endpoint[iBin], "\n") } } } index.Cont <- which(type == "cont") if (length(index.Cont) > 0) { for (iCont in index.Cont) { validNumeric(data[[endpoint[iCont]]], name1 = endpoint[iCont], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") } } index.TTE <- which(type == "tte") status.TTE <- status[type == "tte"] if (length(index.TTE) > 0) { validNames(data, name1 = "data", required.values = status.TTE, valid.length = NULL, refuse.NULL = FALSE, method = "BuyseTest") valid.values.status <- 0:2 for (iTTE in index.TTE) { validNumeric(data[[endpoint[iTTE]]], name1 = endpoint[iTTE], valid.length = NULL, refuse.NA = TRUE, method = "BuyseTest") validNumeric(unique(data[[status.TTE[which(index.TTE == iTTE)]]]), name1 = status.TTE[which(index.TTE == iTTE)], valid.values = valid.values.status, valid.length = NULL, method = "BuyseTest") } } index.Gaus <- which(type == "gaus") if (length(index.Gaus) > 0) { for (iGaus in index.Gaus) { validNumeric(data[[endpoint[iGaus]]], name1 = endpoint[iGaus], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") validNumeric(data[[status[iGaus]]], name1 = status[iGaus], valid.length = NULL, refuse.NA = FALSE, method = "BuyseTest") } } validNames(data, name1 = "data", required.values = endpoint, valid.length = NULL, method = "BuyseTest") if (!is.null(formula) && any(name.call %in% argnames)) { txt <- paste(name.call[name.call %in% argnames], collapse = "' '") warning("BuyseTest: argument", if (length(txt) > 1) { "s" }, " '", txt, "' ha", if (length(txt) > 1) { "ve" } else { "s" }, " been ignored. \n", "when specified, only argument 'formula' is used. \n") } validLogical(keep.pairScore, valid.length = 1, method = "BuyseTest") validInteger(correction.uninf, valid.length = 1, min = 0, max = 3, method = "BuyseTest") if (length(method.inference) != 1) { stop("Argument 'method.inference' must have length 1. \n") } if (method.inference %in% c("u statistic bebu") == FALSE) { validCharacter(method.inference, valid.length = 1, valid.values = c("none", "u statistic", "permutation", "studentized permutation", "varexact permutation", "bootstrap", "studentized bootstrap"), method = "BuyseTest") } if (pool.strata > 4 && method.inference %in% c("u statistic", "varexact permutation", "studentized permutation", "varexact permutation", "studentized bootstrap")) { stop("Only bootstrap and permutation can be used to quantify uncertainty when weighting strata-specific effects by the inverse of the variance. \n") } if (method.inference == "none" || attr(method.inference, "permutation")) { } else if (is.null(strata) && any(table(data[[treatment]]) <= 5)) { warning("P-value/confidence intervals may not be valid with few observations in a treatment group. \n") } else if (!is.null(strata) && !attr(strata, "match") && any(table(data[[treatment]], strata.tempo) <= 5)) { warning("P-value/confidence intervals may not be valid with few observations in a treatment and strata group. \n") } if (any(!is.na(attr(method.inference, "resampling-strata"))) && any(attr(method.inference, "resampling-strata") %in% names(data) == FALSE)) { stop("Incorrect value for argument 'strata.resampling': must correspond to a column in argument 'data'. \n") } if (any(!is.na(attr(method.inference, "resampling-strata"))) && attr(method.inference, "permutation") && any(attr(method.inference, "resampling-strata") == treatment)) { stop("Argument 'strata.resampling' should not contain the variable used to form the treatment groups when using a permutation test. \n") } if (iid && correction.uninf > 0) { warning("The current implementation of the asymptotic distribution is valid when using a correction. \n", "Standard errors / confidence intervals / p-values may not be correct. \n", "Consider using a resampling approach or checking the control of the type 1 error with powerBuyseTest. \n") } if (method.inference %in% c("bootstrap", "permutation", "stratified bootstrap", "stratified permutation")) { validInteger(n.resampling, valid.length = 1, min = 1, method = "BuyseTest") if (!is.null(seed)) { tol.seed <- attr(seed, "max") if (n.resampling > tol.seed) { stop("Cannot set a seed per sample when considering more than ", tol.seed, " samples. \n") } } } validLogical(hierarchical, valid.length = 1, method = "BuyseTest") validLogical(neutral.as.uninf, valid.length = D, method = "BuyseTest") validLogical(add.halfNeutral, valid.length = 1, method = "BuyseTest") if (any(is.na(operator))) { stop("BuyseTest: wrong specification of 'operator'. \n", "Can be \"<0\" (lower is better), \">0\" (higher is better), \"+\" additive threshold, \"*\" multiplicative threshold \n", "or a combination of the previous such as \"*<0\" (lower is better with multiplicative threshold). \n") } if (any(tapply(restriction, endpoint, function(iRestriction) { length(unique(iRestriction)) }) > 1)) { stop("BuyseTest: wrong specification of 'restriction'. \n", "Should not vary when the same endpoint is used at different priorities.") } validInteger(seed, valid.length = 1, refuse.NULL = FALSE, min = 1, method = "BuyseTest") if (!is.null(strata)) { validNames(data, name1 = "data", required.values = strata, valid.length = NULL, method = "BuyseTest") if (length(level.strata) != length(levels(strataC)) || any(level.strata != levels(strataC))) { stop("BuyseTest: wrong specification of 'strata'. \n", "different levels between Control and Treatment \n", "levels(strataT) : ", paste(levels(strataT), collapse = " "), "\n", "levels(strataC) : ", paste(levels(strataC), collapse = " "), "\n") } if (any(level.strata %in% c("global", "standardise", "standardize"))) { stop("BuyseTest: wrong specification of 'strata'. \n", "\"", paste(intersect(level.strata, c("global", "standardise", "standardize")), collapse = "\" \""), "\" is a reserved name used internally. \n") } } validNumeric(threshold, valid.length = D, min = 0, refuse.NA = TRUE, method = "BuyseTest") if (any(multiplicative.threshold) && any(threshold[multiplicative.threshold] <= 1)) { stop("BuyseTest: wrong specification of 'threshold'. \n", "'threshold' must be at least 1 + 1e-12 when considering multiplicative threshold. \n") } if (any(threshold[type == "bin"] > 1e-12)) { stop("BuyseTest: wrong specification of 'threshold'. \n", "'threshold' must be 1e-12 for binary endpoints (or equivalently NA) \n", "proposed 'threshold' : ", paste(threshold[type == "bin"], collapse = " "), "\n", "binary endpoint(s) : ", paste(endpoint[type == "bin"], collapse = " "), "\n") } vec.test <- tapply(threshold, endpoint, function(x) { test.unsorted <- is.unsorted(rev(x)) test.duplicated <- any(duplicated(x)) return(test.unsorted + test.duplicated) }) if (any(vec.test > 0)) { stop("BuyseTest: wrong specification of 'endpoint' or 'threshold'. \n", "Endpoints must be used with strictly decreasing threshold when re-used with lower priority. \n", "Problematic endpoints: \"", paste0(names(vec.test)[vec.test > 0], collapse = "\" \""), "\"\n") } validInteger(trace, valid.length = 1, min = 0, max = 2, method = "BuyseTest") validCharacter(treatment, valid.length = 1, method = "BuyseTest") validNames(data, name1 = "data", required.values = treatment, valid.length = NULL, method = "BuyseTest") if (length(level.treatment) != 2) { stop("BuyseTest: wrong specification of the group variable (\"", treatment, "\"). \n", "The corresponding column in 'data' must have exactly 2 levels. \n", "Proposed levels : ", paste(level.treatment, collapse = " "), "\n") } if (any(table(data[[treatment]]) == 0)) { txt.stop <- names(which(table(data[[treatment]]) == 0)) stop("BuyseTest: wrong specification of 'data'. \n", "No observation taking level ", txt.stop, " in the treatment variable. \n") } if (any(type %in% c("bin", "cont", "tte", "gaus") == FALSE)) { txt <- type[type %in% c("bin", "cont", "tte", "gaus") == FALSE] stop("BuyseTest: wrong specification of 'type' \n", "valid values: \"binary\" \"continuous\" \"timetoevent\" \n", "incorrect values: \"", paste(txt, collapse = "\" \""), "\" \n") } n.typePerEndpoint <- tapply(type, endpoint, function(x) { length(unique(x)) }) if (any(n.typePerEndpoint > 1)) { message <- paste0("several types have been specified for endpoint(s) ", paste0(unique(endpoint)[n.typePerEndpoint > 1], collapse = ""), "\n") stop("BuyseTest: wrong specification of 'endpoint' or 'type' \n", message) } if (length(weightEndpoint) != D) { stop("BuyseTest: argument 'weightEndpoint' must have length the number of endpoints \n") } if (hierarchical) { if (any(weightEndpoint != 1) || any(is.na(weightEndpoint))) { stop("BuyseTest: all the weights for the endpoints must be 1 when using hierarchical GPC \n") } } if (!is.null(weightObs) && any(weightObs != 1)) { test1 <- is.character(weightObs) && length(weightObs) == 1 && weightObs %in% names(data) test2 <- is.numeric(weightObs) && length(weightObs) == NROW(data) if ((test1 == FALSE) && (test2 == FALSE)) { stop("BuyseTest: argument 'weightObs' must correspond to a column in argument 'data' ", "or must have as many element as rows in argument 'data'. \n") } if (engine == "GPC_cpp") { stop("Cannot weigth observations with engine GPC_cpp. \n") } } if (hierarchical) { if (any(weightEndpoint != 1) || any(is.na(weightEndpoint))) { stop("BuyseTest: all the weights for the endpoints must be 1 when using hierarchical GPC \n") } } return(invisible(TRUE)) })(name.call = c("", "formula", "data", "method.inference", "weightObs", "trace"), status = c("..NA..", "..NA.."), status.TTE = character(0), correction.uninf = 0, cpus = 1, D = 2L, D.TTE = 0L, data = structure(list(trt = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2), celltype = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L), levels = c("squamous", "smallcell", "adeno", "large"), class = "factor"), time = c(72, 411, 228, 126, 118, 10, 82, 110, 314, 100, 42, 8, 144, 25, 11, 30, 384, 4, 54, 13, 123, 97, 153, 59, 117, 16, 151, 22, 56, 21, 18, 139, 20, 31, 52, 287, 18, 51, 122, 27, 54, 7, 63, 392, 10, 8, 92, 35, 117, 132, 12, 162, 3, 95, 177, 162, 216, 553, 278, 12, 260, 200, 156, 182, 143, 105, 103, 250, 100, 999, 112, 87, 231, 242, 991, 111, 1, 587, 389, 33, 25, 357, 467, 201, 1, 30, 44, 283, 15, 25, 103, 21, 13, 87, 2, 20, 7, 24, 99, 8, 99, 61, 25, 95, 80, 51, 29, 24, 18, 83, 31, 51, 90, 52, 73, 8, 36, 48, 7, 140, 186, 84, 19, 45, 80, 52, 164, 19, 53, 15, 43, 340, 133, 111, 231, 378, 49), status = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), karno = c(60, 70, 60, 60, 70, 20, 40, 80, 50, 70, 60, 40, 30, 80, 70, 60, 60, 40, 80, 60, 40, 60, 60, 30, 80, 30, 50, 60, 80, 40, 20, 80, 30, 75, 70, 60, 30, 60, 80, 60, 70, 50, 50, 40, 40, 20, 70, 40, 80, 80, 50, 80, 30, 80, 50, 80, 50, 70, 60, 40, 80, 80, 70, 90, 90, 80, 80, 70, 60, 90, 80, 80, 50, 50, 70, 70, 20, 60, 90, 30, 20, 70, 90, 80, 50, 70, 60, 90, 50, 30, 70, 20, 30, 60, 40, 30, 20, 60, 70, 80, 85, 70, 70, 70, 50, 30, 40, 40, 40, 99, 80, 60, 60, 60, 60, 50, 70, 10, 40, 70, 90, 80, 50, 40, 40, 60, 70, 30, 60, 30, 60, 80, 75, 60, 70, 80, 30), diagtime = c(7, 5, 3, 9, 11, 5, 10, 29, 18, 6, 4, 58, 4, 9, 11, 3, 9, 2, 4, 4, 3, 5, 14, 2, 3, 4, 12, 4, 12, 2, 15, 2, 5, 3, 2, 25, 4, 1, 28, 8, 1, 7, 11, 4, 23, 19, 10, 6, 2, 5, 4, 5, 3, 4, 16, 5, 15, 2, 12, 12, 5, 12, 2, 2, 8, 11, 5, 8, 13, 12, 6, 3, 8, 1, 7, 3, 21, 3, 2, 6, 36, 13, 2, 28, 7, 11, 13, 2, 13, 2, 22, 4, 2, 2, 36, 9, 11, 8, 3, 2, 4, 2, 2, 1, 17, 87, 8, 2, 5, 3, 3, 5, 22, 3, 3, 5, 8, 4, 4, 3, 3, 4, 10, 3, 4, 4, 15, 4, 12, 5, 11, 10, 1, 5, 18, 4, 3), age = c(69, 64, 38, 63, 65, 49, 69, 68, 43, 70, 81, 63, 63, 52, 48, 61, 42, 35, 63, 56, 55, 67, 63, 65, 46, 53, 69, 68, 43, 55, 42, 64, 65, 65, 55, 66, 60, 67, 53, 62, 67, 72, 48, 68, 67, 61, 60, 62, 38, 50, 63, 64, 43, 34, 66, 62, 52, 47, 63, 68, 45, 41, 66, 62, 60, 66, 38, 53, 37, 54, 60, 48, 52, 70, 50, 62, 65, 58, 62, 64, 63, 58, 64, 52, 35, 63, 70, 51, 40, 69, 36, 71, 62, 60, 44, 54, 66, 49, 72, 68, 62, 71, 70, 61, 71, 59, 67, 60, 69, 57, 39, 62, 50, 43, 70, 66, 61, 81, 58, 63, 60, 62, 42, 69, 63, 45, 68, 39, 66, 63, 49, 64, 65, 64, 67, 65, 37), prior = c(0, 10, 0, 10, 10, 0, 10, 0, 0, 0, 0, 10, 0, 10, 10, 0, 0, 0, 10, 0, 0, 0, 10, 0, 0, 10, 0, 0, 10, 10, 0, 0, 0, 0, 0, 10, 0, 0, 0, 0, 0, 0, 0, 0, 10, 10, 0, 0, 0, 0, 10, 0, 0, 0, 10, 0, 0, 0, 0, 10, 0, 10, 0, 0, 0, 0, 0, 10, 10, 10, 0, 0, 10, 0, 10, 0, 10, 0, 0, 0, 0, 0, 0, 10, 0, 0, 10, 0, 10, 0, 10, 0, 0, 0, 10, 10, 0, 0, 0, 0, 0, 0, 0, 0, 0, 10, 0, 0, 10, 0, 0, 0, 10, 0, 0, 0, 0, 0, 0, 0, 0, 10, 0, 0, 0, 0, 10, 10, 0, 0, 10, 10, 0, 0, 10, 0, 0), weight = c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)), row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86", "87", "88", "89", "90", "91", "92", "93", "94", "95", "96", "97", "98", "99", "100", "101", "102", "103", "104", "105", "106", "107", "108", "109", "110", "111", "112", "113", "114", "115", "116", "117", "118", "119", "120", "121", "122", "123", "124", "125", "126", "127", "128", "129", "130", "131", "132", "133", "134", "135", "136", "137"), class = "data.frame"), endpoint = c("prior", "time"), endpoint.TTE = character(0), engine = "GPC_cpp", formula = trt ~ bin(prior) + cont(time) + celltype, iid = TRUE, iidNuisance = FALSE, index.endpoint = c(0, 1), index.status = c(0, 0), keep.pairScore = FALSE, keep.survival = FALSE, scoring.rule = "gehan", pool.strata = structure(0, type = "buyse", original = NA), model.tte = NULL, args.model.tte = list(), method.inference = structure("u statistic", permutation = FALSE, bootstrap = FALSE, studentized = FALSE, ustatistic = TRUE, "`resampling-strata`" = NA_character_, hprojection = 1), n.resampling = 1000, hierarchical = TRUE, neutral.as.uninf = c(TRUE, TRUE), add.halfNeutral = FALSE, operator = c(`>0` = 1, `>0` = 1), censoring = c(NA_character_, NA_character_), restriction = c(NA_real_, NA_real_), order.Hprojection = 1, precompute = TRUE, seed = NULL, strata = structure("celltype", match = FALSE), threshold = structure(c(1e-12, 1e-12), original = c(NA_real_, NA_real_)), multiplicative.threshold = c(`>0` = FALSE, `>0` = FALSE), trace = 0, treatment = "trt", type = c("bin", "cont"), Uendpoint = c("prior", "time"), Ustatus = "..NA..", weightEndpoint = c(1, 1), weightObs = "weight", debug = -1)`: Cannot weigth observations with engine GPC_cpp.
Backtrace:
▆
1. └─BuyseTest::BuyseTest(...) at test-BuyseTest-weightObs.R:53:5
2. ├─base::do.call(testArgs, args = outArgs)
3. └─BuyseTest (local) `<fn>`(...)
── Error ('test-initSurvival.R:48:5'): (code run outside of `test_that()`) ─────
<subscriptOutOfBoundsError/error/condition>
Error in `a$specials[[i]]`: subscript out of bounds
Backtrace:
▆
1. └─prodlim::prodlim(...) at test-initSurvival.R:48:5
2. └─prodlim::EventHistory.frame(...)
3. └─prodlim::model.design(...)
4. └─stats::delete.response(terms)
5. └─stats (local) off(a$specials[[i]])
[ FAIL 49 | WARN 0 | SKIP 1 | PASS 708 ]
Error:
! Test failures.
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc